diff --git a/build/basics.tcl b/build/basics.tcl index 9f2b87c6..9878bee1 100644 --- a/build/basics.tcl +++ b/build/basics.tcl @@ -144,6 +144,9 @@ respond "*" ":link channa;ts netime,channa;rakash netime\r" respond "*" ":link dragon;hourly modems,channa;ts modems\r" +respond "*" ":midas channa;rakash papsav_sysen3;papsav\r" +expect ":KILL" + # sources dump tape now creates dragon directory and populates # with an initial dragon; dragon hoard file, which is required # by PFT diff --git a/doc/programs.md b/doc/programs.md index b405a98c..e4cca085 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -210,6 +210,7 @@ - OTHELLO, the original Othello game -- simpler than Go. - PALX, PDP-11 cross assembler. - PANDA, user account management program. +- PAPSAV, daemon to record system events in file system. - PC, SUDS printed circuit board program. - PDSET, set time and date. - PEEK, system monitoring. diff --git a/src/sysen3/papsav.1 b/src/sysen3/papsav.1 new file mode 100644 index 00000000..2a3b6cc7 --- /dev/null +++ b/src/sysen3/papsav.1 @@ -0,0 +1,397 @@ + title papsav + + ; Source reconstructed by EJS on 2018-12-15 from CHANNA;RAKASH PAPSAV binary + ; Original PAPSAV inserted SYSENG; CALRET >. Reconstructed version does not, + ; due to issues with the .CALL macro. The original PAPSAV shared some code + ; with SYSEN1;SYSMSG > (which also inserted SYSENG; CALRET >). Where applicable, + ; the source from SYSMSG was used in this reconstruction. + +t1=1 +t=2 +tt=3 +a=4 +.prsva=4 +b=5 +c=6 +f=7 +pt=10 +ch=11 +count=12 +.prsvz=13 + +;;; Registers Used Internally by the System + +P=17 ;PushDown List Pointer +.CF.=16 ;Current Stack Frame Pointer +.PF.=15 ;Previous Stack Frame Pointer +.AP.=14 ;Argument List Pointer + +TYIC==2 ; TTY INPUT CHANNEL +TYOC==1 ; tty output channel +TYO=<.IOT TYOC,> ; INSTRUCTION TO OUTPUT A CHAR + + ;;; MAIN PROGRAM + +i==4 +l==5 +v==6 +lim==7 + + loc 100 + +;;; Entry Operator + +.ENTR.: MOVEI TT,1(P) ;save registers between frames + HRLI TT,.PRSVA + ADD P, [.PF.-.PRSVA+1,,.PF.-.PRSVA+1] ;protect reg save area + BLT TT,0(P) + MOVE .AP.,T1 ;set called routine's registers + MOVE .PF.,.CF. + MOVE .CF.,P + ADD P,0(T) ;adjust stack + JUMPL P,1(T) ;and go to called routine + .SUSET [.SIPIRQ,,[%PIPDL]] + JRST 1(T) + +;;; Return Operator + +.RETN.: MOVE P,.CF. ;pop frame off + MOVE .CF.,.PF. + MOVSI TT, -<.PF.-.PRSVA>(P) ;restore registers + HRRI TT,.PRSVA + BLT TT,.PF. + SUB P, [.PF.-.PRSVA+1,,.PF.-.PRSVA+1] ;pop regs off + POPJ P, ;and return + +CONSTANTS + + 0 +FMTBL: 0 ;0 end of message + TYPOCT ;1 full word octal + TYPDEC ;2 full wd decimal + TYPHAF ;3 " with commas + TYCRLF ;4 do cr + CPOPJ ;5 ? + TYPSIX ;6 sixbit + TYPASZ ;7 asciz + +CPOPJ: POPJ P, + +feep: asciz/** / +CRLF: asciz/ +/ + +CMACMA: ASCIZ/,,/ + +SEP: ASCIZ/----- +/ + +bletch: asciz\ +WRONG SYSTEM VERSION - REPURIFY +\ + +MEMHOL: ASCIZ\ +WARNING: THERE IS A HOLE IN MEMORY +\ + + loc 164 + +STACK==100 ;DEFAULT TO 100 WORDS +pdl: BLOCK STACK + + loc 264 ; not sure why removing this causes errors + +sysmsg: move .cf.,[-stack,,pdl-1] ; setup current stack frame pointer + move p,[-stack,,pdl-1] ; setup current PDL pointer + + .call [setz ? sixbit/OPEN/ ? [.uao,,tyoc] + [sixbit/DSK/] ? [sixbit/CDATA/] ? [sixbit/>/] ? setz [sixbit/DRAGON/]] + .value + + pushj p,ritual ; assurance of purity + movei count,1 + lsh count,0 ; instruction patched through abstb1 (SYSMLN) + movei pt,0 ; instruction patched through abstb1 (SYSMBF) + jrst papsav + +g00002: + skipn a,(pt) + jrst nxloop + jumpge a,g00002+5 + movei t1,[feep] + pushj p,type + hllz f,.prsva + hrli a,440700 + movei c,t1(pt) +loop1: + ildb b,.prsva + jumpe b,g00013 + caie b,"~ + jrst loop1+6 + pushj p,argot + jrst g00011 + tyo b +g00011: + jrst loop1 +g00013: + tlnn f,gotit+4 + jrst g00014 + tyo [" ] + pushj p,argot + jrst g00013 +g00014: + movei t1,[crlf] + pushj p,type +nxloop: + addi pt,4 + sojg count,g00002 +g00003: + movei t1,[sep] + pushj p,type + +papsav: movei c,0 ; instrucxtion patched by abstb1 (SYSCON) + move pt,(c) ; instrucxtion patched by abstb1 (TOOP) + +syfndl: PUSHJ P,SYGET + tyo a + cain a,^M ; is it a CR + tyo [^J] ; emit a linefeed + jrst syfndl + +syget0: camn pt,(c) ; instruction patched by abstb1 (TOIP) + .hang + camn pt,(c) ; instruction patched by abstb1 (TOBEP) + subi pt,0 ; instruction patched by abstb1 (TOBL) + ildb a,pt + popj p, + +SYGET: PUSHJ P,SYGET0 + trnn a,200 ; and do special char processing + popj p, ; normal char, just return + CAIN A,%TDFS ; cursor forward one column + jrst [movei a,40 ? popj p,] + CAIN A,%TDMV0 ; move cursor, followed by new vert pos, new hor pos + JRST SYGET1 + CAILE A,%TDMV1 ; dummy command created by TYMOV + JRST SYGET +SYGET1: PUSHJ P,SYGET0 ; gobble cursor motion + PUSHJ P,SYGET0 ; assuming intr level has processed + trze a,200 + jrst syget1 + CAIE A,0 ; skip if is probably crlf + skipa a,[" ] ; otherwise is probably space + MOVEI A,^M ; now change cursor motion to crlf +CPOPJX: POPJ P, + +KILL: .BREAK 16,040000 + +ARGOT: LDB B,[300300,,F] ; pick up arg type code + movei t1,[36,,-7 ? 10] + pushj p,@fmtbl(b) ; display the argument + LSH F,3 ; advance to next type code + AOJA C,CPOPJX ; advance to next arg + +TYPE: jsp t,.entr. ; print an asciz string + 0 + movei a,@(.ap.) ; set up BP to string + tloa a,440700 +LOOP: tyo b + ildb b,a ; get next char + jumpn b,loop ; and if not done, type it + jrst .retn. ; return + +;;; ROUTINES TO FORMAT DATA IN WONDROUS WAYS + +TYPOCT: jsp t,.entr. + 0 + hlrz a,@(.ap.) ;get left half in a + hrrz b,@(.ap.) ;get right half in b + jumpe a,typoc1 ;if left half is 0, skip emitting it + movei t1,[.cf.,,-11 ? [8.]] ;emit left half + pushj p,typnum + movei t1,[cmacma] ;emit ,, + pushj p,type +typoc1: movei t1,[.cf.,,-10 ? [8.]] ;emit right half + pushj p,typnum + jrst .retn. + +typdec: jsp t,.entr. + 0 + skipl .prsva,@(.ap.) ; put minus sign if needed + jrst typde1 + tyo ["-] ; output minus sign + movms a +typde1: movei t1,[.cf.,,-11 ? [10.]] ; base 10 + pushj p,typnum + jrst .retn. + +typnum: jsp t,.entr. + 0 + move a,@(.ap.) + pushj p,frob + jrst .retn. + +FROB: idiv a,@t1(.ap.) ;divide by radix + hrlm b,(p) + skipe a + pushj p,frob + hlrz b,(p) + addi b,"0 + tyo b + popj p, + +TYPHAF: jsp t,.entr. + 0 + move a,@(.ap.) + tlnn a,-1 ; if has left half + jrst typha1 + hlrz b,a + movei t1,nogood+35 ; this address is a hack to prevent midas from + pushj p,typoct ; allocating another constant + tyo [",] + tyo [",] +typha1: hrrzs a + movei t1,nogood+32 ; this address is a hack to prevent midas from + pushj p,typoct ; allocating another constant + jrst .retn. + +TYCRLF: jsp t,.entr. + 0 + movei t1,[crlf] ; emit CRLF + pushj p,type + jrst .retn. + +TYPSIX: jsp t,.entr. + 0 + move b,@(.ap.) +6LOOP: setz a, + lshc a,6 + addi a,40 + tyo a + jumpn b,6loop + jrst .retn. + +TYPASZ: jsp t,.entr. + 0 + move a,@(.ap.) ; can't indirect param + movei t1,[36,,-11] + pushj p,type + jrst .retn. + + ;;; PURIFICATION RITUAL + +pure: 0 + +OITSVR: 0 ;ITS version purified for +OUSRST: 0 ;extra check + +RITUAL: jsp t,.entr. + 0 + skipe pure + jrst .+2 + pushj p,purify + MOVE TT, [SQUOZE 0,ITSVRS] ;SEE IF SYSTEM CHANGED + .EVAL TT, + JFCL + MOVE T, [SQUOZE 0,USRSTG] ;see if user page map changed + .EVAL T, + JFCL + CAMN TT,OITSVR ;is ITS version the same> + CAME T,OUSRST ;and user page map + JRST NOGOOD ; nope, error out + jrst .retn. ; all good, return + +NOGOOD: movei t1,[bletch] ; wrong system version, purify + pushj p,type + jrst kill + +constants + + loc 602 + +abstb1: ; system message buffer + sysmsg+7 + ; tty output ptr + syget0 + ; end of buffer + syget0+2 + ; output buffer output pointer + papsav+1 + +immeds: ; tty output buffer length + syget0+3 + ; system tty number + papsav + ; log 2 of number of 4-word blocks + sysmsg+6 +abstb2: + +purify: jsp t,.entr. + 0 + MOVEI LIM, IMMEDS-ABSTB1 ;LIMIT ON REMAPPABLENESS + MOVSI I, /2 ;SCAN ABSTAB +EVLOOP: MOVE V,ABSTB1(I) ; get symbol + .EVAL V, ; evaluate it + .VALUE ; not there??? + CAIG LIM,(I) ; skip following code + JRST EVLP00 ; if immediate symbol + CAIGE V,REMAPT ; remap low core + SUBI V,REMAPT ; into high core +EVLP00: ADDI I, 1 + MOVE TT,ABSTB1(I) ; follow patch list +PLOOP: skipn l,tt + jrst evlpnx + HRRZ TT,(L) ; loc to patch + HRRM V,(L) ; patch it + JRST PLOOP ; and try again + +EVLPNX: AOBJN I,EVLOOP ; next symbol + +; HAVING PATCHED, SET UP PAGE TABLE +; FOR NOW, WE DON'T ACTUALLY PURIFY ANY PAGES... + + setom pure + MOVE v, [SQUOZE 0,ITSVRS] ; get its version symbol + .eval v, ; evaluate it + .value ; what??? + movem v,oitsvr ; store its version + MOVE V, [SQUOZE 0,USRSTG] ;see if user page map changed + .EVAL V, + .VALUE + MOVEM V,OUSRST + + SETZM V + movei tt,1 + hrli tt,-177 + move t,tt +getmor: + .call [setz ? sixbit/CORBLK/ ? %climm,,%cbred+%cbndr ? %climm,,%jself ? tt ? %climm,,400000 ? setz t] + JRST .+2 ; error return + JRST GOTIT + + .SUSET [.RBCHN,,V] ; find out what lost + .call [setz ? sixbit/STATUS/ ? v ? setzm v] ; get error code + .VALUE + LDB V,[270600,,V] + CAIE V,%eropg ; can't get that address + .VALUE ; no - unclear + ADD TT,[40,,40] ; yes - biting MD10's have a 32K hole! + MOVE T,TT + JUMPL TT,GETMOR + +gotit: skipe v + movei t1,[memhol] ; memory hole message + pushj p,type ; print it + MOVEI TT, <1000000-REMAPT>_-10. ;DO REMAPPAGE + HRLI TT, - + SETZ T, + .call [setz ? sixbit/CORBLK/ ? %climm,,%cbred+%cbndr ? %climm,,%jself ? tt ? %climm,,400000 ? setz t] + .VALUE + jrst .retn. + +CONSTANTS +VARIABLES + +REMAPT=<.+1777>&776000 ;FIRST NON USED PAGE + +END SYSMSG