github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-04 07:43:02 +00:00
Code Issues Releases Wiki Activity
Files
5f4d858daf498a4526d8be487e0b0256970f66eb
PDP-10.its/src/sysen2/gunner.mta381
Lars Brinkhoff 5f4d858daf GUNNER - gun down dead demons. 
Also garbage collect disowned Zork jobs, poke FI hardware when IMP is
down, etc.
2020-09-20 19:37:27 +02:00

6041 lines
122 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE GUNNER
.SYMTAB 2700.,3000.
; GUNNER is a replacement for the original muddle gunner, which knows only
; about COMBAT. This version will find any dead demon, and do more or less
; the right thing with it. In particular:
; for COMBAT it tries to look like the current incarnation: rename the
; offending plan to GUNNED >, and send mail to the author of the plan.
; In addition, it sends mail to the COMBAT maintainer (clr).
; for BATCHN it kills all inferiors (with the exception of the garbage
; collector, should it exist) and closes the script channel, sending mail
; to swg.
; for COMSYS it closes all channels, unlocks the locks (via location
; 3+40addr), and sends mail to poor pdl.
; COMSYS is currently just left lying around for pdl to look at....
; other demons are just gunned down; mail is sent to swg.
; mail is always sent to taa.
; Whereupon, the demon is caused to recons itself.
; A fairly disgusting algorithm is used to decide if a demon is permanently
; losing, in which case the above actions are suppressed: the demon is
; disowned, and mail is sent (with some additional history information);
; the demon is left down in this case.
; It is possible to communicate with the gunner via the CLI device, if one
; knows what one is doing...
O=0
A=1
B=2
C=3
D=4
E=5
F=6
G=7
T=6
TT=7 ; FOR NETWRK PACKAGE
PBLOCK=10
LOSTBL=11
SOU1=12
SOU2=13
DEM=14 ; DEMON NAME
T=15 ; OFFSET INTO DEMON TABLE
U=16 ; SYSTEM USER INDEX
P=17
.XCREF O,A,B,C,D,E,F,G,T,P
; CONSTANTS FOR ERRCHK (FROM MUDDLE)
TB==12
FRAMLN==7
FSAV==-7
ABSAV==-5
TATOM==47
TCHST==46
TFIX==1
TFALSE==21
TCHAN==26
TENTR==4
TDEFER==22
TINTH==101
; OFFSETS INTO CHANNEL
CHANNO==1
DIRECT==3
RNAME1==15
RNAME2==17
RDEVIC==21
RSNAME==23
IF1 [
DEFINE PURE
IMPLOC==.
LOC PURLOC
TERMIN
DEFINE IMPURE
PURLOC==.
LOC IMPLOC
TERMIN
DEFINE GETYP AC,ADR
LDB AC,[221500,,ADR]
TERMIN
; DECREMENT BYTE POINTER
DEFINE DBP AC
ADD AC,[70000,,]
TLNE AC,400000
ADD AC,[347777,,-1]
TERMIN
]
; CHANNELS
DSKI==0
DSKO==1
USRI==2
USRO==3
CLAI==4
USRHNG==5
CLIO==6
ERRI==7
LOGCHN==10 ; LOGGING
TTYCHN==11
TTYO==12
; DEFINITIONS FOR DEMON STATS TABLE
DEMNAM==0
DEMCT==1
WINCT==2
LOSCT==3
DATST==4 ; FIRST WORD OF DATA
DATLEN==2 ; LENGTH OF EACH DATA ENTRY
LOSLEN==DATST+4*DATLEN
; OFFSETS INTO DATA ENTRY
LOSPC==0 ; LOSING PC
LOSTM==1 ; TIME LOSS WAS DISCOVERED
; DEFINITIONS FOR PROCESS TABLE
PROCES==0 ; INSTRUCTION TO EXECUTE
NXTRUN==1 ; TIME UNTIL NEXT RUN
INTRVL==2 ; TIME BETWEEN RUNS
ITERS==3 ; NUMBER OF TIMES RUN
PRNAME==4 ; NAME OF PROCESS (FOR CLI HACKING)
FLSOP==5 ; IF -1, HANG ON EXISTENCE OF TAA GT
PRCTIM==6 ; TIME OF FIRST RUN, IN 30THS AFTER MIDNIGHT
PLEN==7 ; LENGTH OF BLOCK
; RANDOMS
SN2311==43 ; DEVICE CODE FOR DSK DEVICE CHANNELS
SNUSR==61 ; DEVICE CODE FOR NON-FOREIGN USR DEVICE CHANNELS
SNMSP==31 ; DEVICE CODE FOR IPC DEVICE
BUSRC==100000 ; USER-SETTABLE BIT IN LH OF USTP
IOSDEV==000600 ; LH OF BYTE POINTER TO DEVICE CODE IN IOS WORD
; CONSTANT STRING OUTPUT
DEFINE SOUT CHAN,TXT
MOVE SOU1,[440700,,[ASCII /TXT/]]
MOVEI SOU2,.LENGTH /TXT/
.CALL [SETZ
SIXBIT /SIOT/
MOVSI %TJDIS
MOVEI CHAN
SOU1
SETZ SOU2]
JSR LOSE
TERMIN
LOC 40
0
JSR UUOH
JSR TSINT
LOC 100
IMPLOC==.
PURLOC==10000
PURBEG==PURLOC ; STUFF FOR PURE/IMPURE
; PAGES FOR RANDOM MAPPING. MAYBE SOMEDAY THIS SHOULD BE FLUSHED
; IN FAVOR OF A CORE ALLOCATOR.
SYSLEN==200
SYSPAG==200
PWPAGE==0
;MAPPAG=99. ; FOR DEFUNCT GUNCHER
;MAPBEG=MAPPAG*2000
;MMPPG=MAPPAG+1
;MMPADD=MMPPG*2000
.INSRT SYSTEM;FSDEFS >
.INSRT TAA;PWFILE >
$$ARPA==1
$$HSTMAP==1
$$HSTSIX==1
PURE
.INSRT SYSENG;NETWRK >
SUBTTL Variables
IMPURE
NXTPRC: 0 ; NEXT PROCESS SCHEDULED
CURPRC: 0 ; CURRENT PROCESS, OR 0
UUOBPT: 0 ; BUFFER POINTERS FOR EMIT, EMIT6, ETC.
UUOLFT: 0
LOC44: 0
MPVFLG: 0 ; MPV MIGHT HAPPEN BECAUSE DOING UNLOCKING
DEBUGF: 0 ; DEBUGGING
GUNVER: .FNAM2 ; GUNNER VERSION
SIXBIT /ITS/
SYSVER: 0
GUNAUT: 0 ; AUTHOR OF GUNNER FILE
SLPALL: -1 ; GUNNER IS RUNNING IF THIS IS -1, ELSE SLEEPING
CLHUNG: 0 ; IF -1, HANGING ON EXISTENCE OF TAA GT
GDOWN: 0 ; -1 IF SYSTEM CLAIMS TO BE GOING DOWN
SLPTIM: 0 ; TIME TO SLEEP
CMIN: 0 ; USED TO ACCUMULATE NEXT SLPTIM
LPOINT: -2,,LUNAME ; POINTER TO NEXT TWO WORDS, FOR LOGGER
LUNAME: 0 ; CONTAINS UNAME OF MUNGED JOB
LJNAME: 0 ; JNAME
DUNAME: 0 ; UNAME OF JOB WHEN DISOWNED
DJNAME: 0 ; JNAME
FRAME: BLOCK FRAMLN ; BLOCK FOR READING FRAME IN ERRCHK
ARGS: BLOCK 20. ; BLOCK FOR ARG PTRS
RANDBK: BLOCK 40. ; BLOCK FOR READING IN RANDOM STRUCTURES
STRNBK: BLOCK 20. ; BLOCK FOR READING IN STRINGS
; SWITCHES USED WHEN SENDING MAIL. ZEROED WHENEVER DEMON FOUND TO HACK.
BLTBEG:
SNDTWO: 0 ; -1 WHEN HAVE SENT FIRST MAIL (TO DEMON OWNER)
BADUPC: 0 ; PC WHEN GUNNED
GUNNED: 0 ; IF -1, JOB WAS GUNNED DOWN
DISOWN: 0 ; IF -1, JOB WAS DISOWNED
LEFT: 0 ; IF -1, JOB WAS LEFT AROUND
BATCH: 0 ; -1 INDICATES THIS TYPE OF JOB (SPECIAL HACKING)
COMBAT: 0
LOKKIL: 0
INFKIL: 0 ; # OF INFERIORS KILLED FOR A JOB (IF DISOWNED)
CHNKIL: 0 ; # OF CHANNELS CLOSED FOR JOB
OVERTI: 0 ; JOB RAN MORE THAN TWO HOURS (FOR COMBAT)
FN1: 0 ; FIRST FILE NAME OF PLAN
FN2: 0 ; SECOND FILE NAME OF PLAN
RFN2: 0 ; SECOND FILE NAME OF 'GUNNED'
BLTEND:
LOSER: 0 ; SNAME IN PLAN: SEND MAIL HERE, TOO.
; SEPARATE BLOCK, SINCE ERRCHK SETS THESE
BLTBG1:
GOTJOB: 0 ; -1 IF WE HAVE JOB AS INFERIOR
VALLEN: 0 ; LENGTH OF .VALUE STRING OR ARGS TO ERROR
LOSFLG: 0 ; .LOSE EXECUTED
INTFLG: 0 ; FATAL INTERRUPT
BLTEN1:
ERRFLG: 0 ; -1 IF JOB GOT ERROR
SNDSAV: 0 ; SAVED P, IN CASE IOC ERROR WHEN MAILING OR DUMPING
NAMSAV: 0 ; HACKER BEING SENT TO
FILFLS: 0 ; IF -1, DO DELEWO ON DSKO IF IOC
VALBLN==150.
VALBUF: BLOCK VALBLN ; BUFFER FOR .VALUE STRINGS, IF APPLICABLE.
; TABLE OF DEMON OWNERS: WHOM SHALL I SEND TO?
PURE
OWNTAB:
COMNAM: SIXBIT /COMSYS/
SIXBIT /PDL/
ZONNAM: SIXBIT /ZONE/
SIXBIT /CLR/
BATNAM: SIXBIT /BATCHN/
SIXBIT /SWG/
;NCOMNA: SIXBIT /NCOMSY/
; SIXBIT /PDL/
SURNAM: SIXBIT /SURVEY/
SIXBIT /SWG/
SNDNAM: SIXBIT /SURSND/
SIXBIT /SWG/
INQNAM: SIXBIT /INQUPD/
SIXBIT /PDL/
GUNNAM: SIXBIT /GUNNER/
SIXBIT /TAA/
OWNPTR: OWNTAB-.,,OWNTAB
; TABLE OF POSSIBLE FIRST NAMES OF PLANS FOR COMBAT, IN ORDER
PLNTAB: SIXBIT /RIOT/
SIXBIT /RWASTE/
SIXBIT /PLAN/
SIXBIT /WASTE/
PLNNAM: PLNTAB-.,,PLNTAB
IMPURE
EXBLK: 0 ; BLOCK STUFFED INTO JOB TO BE EXECUTED
.BREAK 16,600000
.BREAK 16,600000
EXLEN==.-EXBLK ; LENGTH OF BLOCK
; BLOCK FOR SAVING INFERIOR'S INTERRUPT STATUS: MASKS AND PENDING INTERRUPTS
INTBLK:
IPIRQC: 0
IIFPIR: 0
IMASK2: 0
IMASK: 0
INFRUN: 0 ; IF -1, INFERIOR IS RUNNING
RNDBLK: BLOCK 3 ; USED BY APTOFI
APCNT: 0 ; USED BY APTOFI WHEN FINDS FILE LOCKED OR SOMETHING
; BLOCK FOR DEMON STATS. ALLOCATED WHEN A NEW DEMON IS OBSERVED, IN BLOCKS OF
; LOSLEN (CURRENTLY 12.) WORDS.
LOSCNT==15 ; 15 DEMONS???
LOSBLK: BLOCK LOSCNT*LOSLEN
PDLLEN==100.
PDL: BLOCK PDLLEN
INBLEN==100.
INBUF: BLOCK INBLEN/5
INBPTR: 440700,,INBUF
CLIBLN==12
CLIBUF: BLOCK CLIBLN
PTABLE: PUSHJ P,IDLSRV ? 0 ? <5*60.>*30. ? 0 ? SIXBIT /IDLSRV/ ? 0 ? 0
PUSHJ P,DEMSCN ? 0 ? <15.*60.>*30. ? 0 ? SIXBIT /DEMSCN/ ? 0 ? 0
PUSHJ P,RNDFLS ? 0 ? <5*60.>*30. ? 0 ? SIXBIT /RNDFLS/ ? 0 ? 0
PUSHJ P,ALOG ? 0 ? <5*60.>*30. ? 0 ? SIXBIT /ALOG/ ? 0 ? 0
PUSHJ P,NCPUP ? 0 ? <5*60.>*30. ? 0 ? SIXBIT /NCPUP/ ? 0 ? 0
PUSHJ P,HOURLY ? 0 ? <60.*60.>*30. ? 0 ? SIXBIT /HOURLY/ ? 0 ? 0
; PUSHJ P,MSCAN ? 0 ? 0 ? 0 ? SIXBIT /MSCAN/ ? 0 ? 0
; PUSHJ P,ZTSCAN ? 0 ? <10.*60.>*30. ? 0 ? SIXBIT /ZTSCAN/ ? 0 ? 0
; PUSHJ P,ZKCLN ? 0 ? <24.*60.>*<60.*30.>
; 0 ? SIXBIT /ZKCLN/ ? 0 ? <9.*60.>*<60.*30.>
; PUSHJ P,ZKFLS ? 0 ? <24.*60.>*<60.*30.>
; 0 ? SIXBIT /ZKFLS/ ? 0 ? <<9.*60.>+10.>*<60.*30.>
DAYPNT: PUSHJ P,DAYPRC ? 0 ? <24.*60.>*<60.*30.>
0 ? SIXBIT /DAYPRC/ ? 0 ? <5*60.>*30.
; THIS IS CONSED ONTO PPTR ONLY WHEN NEEDED
CLIPRC: PUSHJ P,CLIHAK ? 377777777777 ? 377777777777
0 ? SIXBIT /CLSCAN/ ? 0 ? 0
PPTR: PTABLE-CLIPRC,,PTABLE
CYEAR: 0 ; USED TO PREVENT DEATH DUE TO DAYLIGHT TIME
SUBTTL Startup & main loop
PURE
START: .CALL [SETZ
SIXBIT /RAUTH/
MOVEI 1
SETZM GUNAUT]
JFCL
.CLOSE 1, ; SINCE DEMON STILL HAS CHANNEL FOR SYMBOLS
MOVE P,[-PDLLEN,,PDL]
.SUSET [.RSUPPR,,A]
JUMPGE A,[SETOM DEBUGF
JRST DOSTRT]
SETZM DEBUGF
.CALL [SETZ
SIXBIT /LOGIN/
[SIXBIT /GUNNER/]
SETZ [0]]
.LOGOUT ; GO AWAY, SINCE I ALREADY EXIST
.CALL [SETZ
SIXBIT /STDMST/
[SIXBIT /GUNNER/]
[1,,2]
SETZI 1]
.LOSE 1000
DOSTRT: .SUSET [.SMASK,,[%PIRUN+%PIRLT+%PIIOC+%PIMPV+%PIDWN+%PICLI+%PIILO+%PIPAR+%PIWRO]]
.SUSET [.SMSK2,,[377,,<1_USRHNG>+<1_USRI>]]
.RSYSI A, ; GET SYSTEM VERSION
CAME A,SYSVER
JRST [PUSHJ P,INIT ; GO INITIALIZE
MOVE A,[-3,,GUNVER]
LOG A,[ASCIZ /initialization./]
JRST .+1]
.SUSET [.SRTMR,,[120000000.]] ; RUN-TIMER
.CALL [SETZ
SIXBIT /OPEN/
[10+.BII,,USRI]
[SIXBIT /USR/]
[SIXBIT /GUNNER/]
SETZ [SIXBIT /GUNNED/]] ; OPEN DEAD GUNNER?
JRST BEGIN ; NOT THERE
.CLOSE USRI,
LOG [ASCIZ /Dead gunner found./]
BEGIN: SKIPE DEBUGF
PUSHJ P,DEBUG
MOVE A,@TIME
MOVEI B,0
CAIG A,8.*1800.
MOVEI B,1
MOVE A,[-1,,GUNAUT]
LOG A,@[[ASCIZ /UP/] ; I'M UP
[ASCIZ /up after system crash./]](B)
PUSHJ P,PRCINI ; INITIALIZE ANY PROCESSES THAT NEED IT
MLOOP: .RYEAR A,
TDC A,CYEAR
TLNE A,100000 ; SKIP IF NO CHANGE IN DST
JRST [LOG [ASCIZ /Rescheduling due to DST./]
PUSHJ P,PRCINI
JRST .+1]
MOVE PBLOCK,PPTR
MOVEI A,777777
MOVEM A,CMIN
PLOOP: MOVE A,NXTRUN(PBLOCK)
SUB A,SLPTIM ; TIME TO NEXT RUN
JUMPG A,PEND ; NOT YET
MOVE A,PRNAME(PBLOCK) ; PROCESS NAME
MOVEM A,CURPRC ; FOR LOGGER
SKIPGE FLSOP(PBLOCK) ; HANGING?
JRST PLOOP1 ; YES
XCT PROCES(PBLOCK) ; RUN IT. IF SKIPS, TIME TO NEXT RUN IS IN A
PLOOP1: MOVE A,INTRVL(PBLOCK) ; TIME TO NEXT RUN, SINCE JUST RAN
AOS ITERS(PBLOCK)
PEND: CAMG A,CMIN ; SHORTEST TIME SO FAR?
JRST [MOVEM A,CMIN ; YES
MOVE B,PRNAME(PBLOCK)
MOVEM B,NXTPRC
JRST .+1] ; SET UP NEXT PROCESS SCHEDULED
MOVEM A,NXTRUN(PBLOCK)
ADD PBLOCK,[PLEN,,PLEN]
JUMPL PBLOCK,PLOOP ; DONE?
SETZM CURPRC
MOVE A,CMIN
MOVEM A,SLPTIM
AOSE SLPALL ; ANYTHING INTERESTING HAPPEN WHILE RUNNING?
JRST RERUN ; YES
.SLEEP A, ; NO, BACK TO SLEEP
SLPCON: SETOM SLPALL ; NOW RUNNING
JRST MLOOP
; COME HERE TO MAKE SECOND QUICK PASS, IN CASE CLI-AGE HAPPENED WHILE RUNNING
RERUN: SETOM SLPALL
SETZM SLPTIM
JRST MLOOP
; INITIALIZE PROCESSES THAT RUN AT SPECIFIC TIME RATHER THAN SPECIFIC
; INTERVAL
PRCINI: PUSH P,A
PUSH P,B
PUSH P,C
.CALL [SETZ
SIXBIT /RQDATE/
SETZM A]
.LOSE %LSSYS
.RYEAR B,
MOVEM B,CYEAR
HRRZS A
IMULI A,15. ; 30THS SINCE MIDNIGHT
MOVE B,PPTR
PRCILP: SKIPG C,PRCTIM(B)
JRST PRCENL
SUB C,A
SKIPGE C
ADD C,[24.*60.*60.*30.] ; WON'T BE UNTIL TOMORROW
MOVEM C,NXTRUN(B)
PRCENL: ADD B,[PLEN,,PLEN]
JUMPL B,PRCILP
POP P,C
POP P,B
POP P,A
POPJ P,
SUBTTL Interpreter for CLI input
IMPURE
SACT: 0
SPRC: 0
SPT: -2,,SACT
PURE
CLIHAK: MOVE A,PPTR
ADD A,[PLEN,,0] ; TAKE THIS OUT OF THE PROCESS TABLE
MOVEM A,PPTR
MOVE A,CLIBUF+3 ; PROCESS ID
CAMN A,[-1]
JRST CLIALL ; ALL PROCESSES
TLNN A,-1
JRST CLIFIX
MOVE B,PPTR
MOVEI C,
CLISLP: CAMN A,PRNAME(B) ; THIS PROCESS?
JRST CLIFND
ADD B,[PLEN,,PLEN]
JUMPGE B,CPOPJ ; NOT A VALID PROCESS
AOJA C,CLISLP
CLIFND: MOVE A,C
CLIFIX: IMULI A,PLEN
ADDI A,PTABLE ; POINT TO PROCESS BLOCK
MOVE B,PRNAME(A)
MOVEM B,SPRC ; NAME OF CROCK MUNGING
MOVE B,CLIBUF+4 ; FUNCTION
CAMN B,[-1] ; HANG INDEFINITELY?
JRST [MOVE B,[377777,,777777]
MOVEM B,NXTRUN(A)
MOVE B,[SIXBIT /HANG/]
MOVEM B,SACT ; FOR LOGGER
JRST CLILOG]
CAMN B,[-2]
JRST [SETOM FLSOP(A) ; CAUSE IT TO HANG ON EXISTENCE OF JOB
.CALL [SETZ
SIXBIT /OPEN/
[10+.BII,,USRHNG]
[SIXBIT /USR/]
CLIBUF
SETZ CLIBUF+1]
SETZM FLSOP(A) ; UNHANG
SETZM NXTRUN(A) ; AND RUN IMMEDIATELY
MOVE B,[SIXBIT /JOBHNG/]
MOVEM B,SACT
JRST CLILOG]
IMULI B,1800. ; CONVERT TO 30'THS
MOVEM B,NXTRUN(A)
MOVE B,[SIXBIT /SLEEP/]
MOVEM B,SACT
CLILOG: MOVE B,SPT
LOG B,0
POPJ P,
; COME HERE IF PROCESS WAS -1-->DO FOR EVERYBODY
CLIALL: MOVE A,[SIXBIT /ALL/]
MOVEM A,SPRC
MOVE A,CLIBUF+4
MOVE B,[SIXBIT /SLEEP/]
CAMN A,[-2]
JRST [MOVE B,[SIXBIT /JOBHNG/]
MOVEI A, ; IF HANG, RUN IMMEDIATELY AFTER UNHANGING
JRST CLASTR]
CAMN A,[-1]
JRST [MOVE A,[377777,,777777]
MOVE B,[SIXBIT /HANG/]
JRST .+1]
CLASTR: MOVEM B,SACT
MOVE B,PPTR
CLALOP: SKIPG PRCTIM(B)
SETZM NXTRUN(B)
ADD B,[PLEN,,PLEN]
JUMPL B,CLALOP
MOVEM A,INTRVL(PBLOCK)
MOVEM A,CMIN ; CAUSE SUPPLIED NUMBER TO BE TIME TO NEXT RUN
MOVE A,CLIBUF+4
CAME A,[-2] ; IS OP HANG?
JRST CLILOG
CLHANG: MOVE B,SPT
LOG B,0
SETOM CLHUNG
.CALL [SETZ
SIXBIT /OPEN/
[10+.BII,,USRHNG]
[SIXBIT /USR/]
CLIBUF
SETZ CLIBUF+1]
POPJ P, ; NOT THERE, SO DON'T HANG
SKIPE CLHUNG
.HANG ; HANG UNTIL IT GOES AWAY
PUSHJ P,PRCINI ; RESYNCHRONIZE
MOVE B,SPT
LOG B,[ASCIZ /done./]
POPJ P,
SUBTTL Demon-scanning
DEMSCN: MOVE T,DEMTAB
SCNLOP: SKIPE DEM,(T) ; IS THIS A DEMON?
PUSHJ P,DEMHAK ; YES, GO HACK IT
ADD T,DMTLL
JUMPL T,SCNLOP
POPJ P,
; COME HERE WITH DEMON NAME IN DEM, POINTER TO DEMON TABLE ENTRY IN T.
; IF DEMON NEEDS TO GO AWAY, DO THE RIGHT THING.
DEMHAK: SKIPG U,1(T) ; USER INDEX
POPJ P, ; NOT >0, SO DEMON IS DOWN
SETZM BLTBG1 ; CAN'T BE IN MAIN BLT HACK
MOVE A,[BLTBG1,,BLTBG1+1]
BLT A,BLTEN1
PUSHJ P,LSINIT ; MAKE/FIND AN ENTRY IN LOSTBL FOR IT
SKIPL @SUPPRO ; A REAL DAEMON DOESN'T HAVE A SUPERIOR
POPJ P, ; SO DON'T EXAMINE IT FOR A WHILE
SKIPL @APRC ; TEST SIGN BIT OF APRC: SET IF DISOWNED
JRST [PUSHJ P,ERRCHK ; GO CHECK FOR ERRORS
JRST ZONHAK ; STILL ALIVE, SEE IF IT'S ZONE RUN OVERTIME
JRST GOTON1] ; ERRCHK GETS THE DEMON. GOTON1 DOESN'T
; CHECK DISABLED
MOVE A,@USTP ; GET USTP FOR THIS JOB
TLNN A,BUSRC ; TEST STOPPED BIT
JRST DEMWIN ; DEMON IS WINNING: SEE IF THIS IS INTERESTING
; JOB IS NOW KNOWN TO BE DISOWNED AND STOPPED.
GOTONE: SKIPGE WINCT(LOSTBL) ; HAVE WE DISABLED IT?
POPJ P, ; YES
GOTON1: SETZM BLTBEG ; NO, SO CLOBBER MAIL SWITCHES
MOVE A,[BLTBEG,,BLTBEG+1]
BLT A,BLTEND ; ZERO SWITCHES
SKIPE ERRFLG
JRST GETPC ; ALREADY HAVE THESE IF ERRFLG
MOVE A,@UNAME
MOVEM A,LUNAME ; SAVE DEAD JOB'S UNAME
MOVE A,@JNAME
MOVEM A,LJNAME ; AND JNAME
GETPC: MOVE A,@UPC ; AND UPC
MOVEM A,BADUPC
SKIPE ERRFLG
JRST WINCHK ; IF ERROR, ALREADY GOT IT
PUSHJ P,GETJOB ; OWN JOB
JRST WINCHK
PUSHJ P,VALCHK ; CHECK FOR .VALUE, .LOSE, FATAL INTERRUPT
WINCHK: PUSHJ P,WINNER ; GO SEE IF I'M A LOSER
JRST DISABL ; YES, SO DISABLE ME
;;; TO PREVENT COMPLETE DEATH OVER CHRISTMAS, NORMALLY RESTART COMSYS.
; CAMN DEM,[SIXBIT /COMSYS/]
; JRST COMHAK
; Just leave comsys corpse around, so PDL can look at it.
CAMN DEM,[SIXBIT /COMSYS/]
JRST DISAB1 ; JUST LEAVE THIS ONE LYING AROUND
CAMN DEM,[SIXBIT /BATCHN/]
JRST BATHAK ; SPECIAL HACKS REQUIRED FOR BATCHN
CAMN DEM,[SIXBIT /ZONE/]
JRST ZONHK1 ; AND COMBAT
SETOM GUNNED
.UCLOSE USRO, ; FLUSH JOB
JFCL
.CALL DEMSIG ; SIGNAL NEW ONE
JFCL
MOVEI A,0
PUSHJ P,SNDMAL ; SEND MAIL
MOVE A,LPOINT
LOG A,[ASCIZ /restarted./]
POPJ P, ; AND LEAVE
; COME HERE TO DISABLE DEMON IF CHOMPING: LEAVE IT AROUND, SEND SPECIAL MAIL.
DISABL: SETOM LEFT ; SAY WE LEFT JOB AROUND
DISAB1: SETOM WINCT(LOSTBL) ; CLOBBER ENTRY IN TABLE
MOVEI A,0
PUSHJ P,SNDMAL
.DISOWN USRO,
JFCL
MOVE A,LPOINT
LOG A,[ASCIZ /disabled./]
POPJ P, ; AND DEPART
; COME HERE IF DEMON IS UP AND RUNNING: POSSIBLY HACK ITS LOSTBL ENTRY.
DEMWIN: AOSG A,WINCT(LOSTBL) ; INCREASE # OF WINNAGES
JRST [PUSH P,B
PUSH P,C
MOVE B,@UNAME
MOVE C,@JNAME
MOVE A,[-2,,B]
LOG A,[ASCIZ / back up./]
POP P,C
POP P,B
JRST RECONS] ; DEMON WAS DISABLED LAST TIME, SO RE-INIT
SKIPE @FLSINS ; IS IT REALLY RUNNING?
JRST DMRUN ; SEE IF SLEEP OR HANG
DMWON: AOS DEMCT(LOSTBL) ; NUMBER OF SURVEYS WHEN DEMON UP AND RUNNING
CAIG A,4 ; MORE THAN 4 WINS AND STILL AROUND?
POPJ P, ; LET IT GO
; RE-INITIALIZE DEMON'S BLOCK, AFTER RECONSAGE OR NUMEROUS WINNAGES
RECONS: SETZM WINCT(LOSTBL)
HRLZI A,WINCT(LOSTBL)
HRRI A,WINCT+1(LOSTBL)
BLT A,LOSLEN-1(LOSTBL)
AOS WINCT(LOSTBL)
POPJ P,
DMRUN: MOVE O,@LSUUO
TLZ O,777 ; TURN OFF AC FIELDS AND INDIRECT BIT
CAME O,[.SLEEP] ; SLEEPING?
CAMN O,[.HANG] ; HANGING?
JRST [SOS WINCT(LOSTBL) ; DON'T COUNT THIS
POPJ P,]
JRST DMWON ; SEE IF TIME TO RECONS
SUBTTL Error hack for muddle
; SEE IF CURRENT JOB IS STOPPED BECAUSE OF MUDDLE ERROR. IF SO,
; DETACH IT, STOP IT, AND PICK UP THE ARGUMENTS TO ERROR.
ERRCHK: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,F
MOVE A,@LSUUO ; GET LAST UUO EXECUTED
TLZ A,777
CAME A,[.SLEEP]
JRST ERRCKO ; NOT ASLEEP
MOVE A,@UPC ; GET PC
TLNE A,%PCUSR ; EXEC MODE?
JRST ERRCKO ; NO, SO NOT ASLEEP
HRRZ A,@SUUOH ; GET RETURN PC FOR UUO
SUBI A,1 ; POINT TO INSTRUCTION
MOVE B,U
IDIV B,L
TRO B,400000 ; GET A JOB SPEC
.CALL [SETZ
SIXBIT /USRMEM/
B
A
SETZM C]
JRST ERRCKO ; ??
CAME C,[XCT 35(2)] ; IS THIS ASLEEP BECAUSE BLOCKED?
JRST ERRCKO ; NO
MOVE A,@UNAME
MOVEM A,LUNAME
MOVE A,@JNAME
MOVEM A,LJNAME
.CALL [SETZ
SIXBIT /DETACH/
SETZ B] ; DETACH IT
JRST ERRCKO ; ??
PUSHJ P,GETJOB ; PICK IT UP
JRST ERRCKO ; ??
.USET USRO,[.SUSTP,,[BUSRC,,0]] ; STOP IT
SETOM ERRFLG
SETZM VALBUF
.CALL [SETZ
SIXBIT /USRMEM/
B
MOVEI TB
SETZM A] ; GET TB IN A
JSR LOSE
.CALL [SETZ
SIXBIT /USRMEM/
B
MOVEI FSAV+1(A)
SETZM A] ; GET PREVIOUS FRAME
JSR LOSE
HRRZI A,-FRAMLN(A) ; POINT TO ITS TOP
.ACCESS USRI,A ; ACCESS THERE
MOVE C,[-FRAMLN,,FRAME]
.IOT USRI,C ; READ IT IN
HLRZ A,FRAME ; LOOK AT TYPE IN 1ST WORD
CAIE A,TENTR ; IS IT REALLY A FRAME?
JRST ERRCKO ; NO
PUSHJ P,FRMFIX ; IF ATTEMPT-TO-DEFER..., GET RIGHT FRAME
JRST ERRCKO ; POSSIBILITY OF DEATH?
MOVE A,FRAME+FRAMLN+ABSAV ; GET ARG POINTER
CAMGE A,[-20.,,0] ; IS THERE ROOM FOR ALL THE ARGS?
JRST [HRLI A,-20.
JRST .+1] ; NO
.ACCESS USRI,A
MOVE C,[-20.,,ARGS]
.IOT USRI,C ; READ IN THE ARG POINTERS
; A CONTAINS AN AOBJN PONTER TO A BLOCK (IN OUR CORE) OF ARG POINTERS.
; B-F ARE FREE. SUITABLE STRINGS WANT TO GO INTO VALBUF.
MOVE B,[440700,,VALBUF]
MOVEM B,UUOBPT
MOVEI C,5*VALBLN ; # CHARS LEFT
MOVEM C,UUOLFT ; SET UP FOR UUOS
HRRI A,ARGS
ERRLOP: PUSHJ P,PRINT
PUSHJ P,CICRLF ; PRINT A CR
ADD A,[2,,2]
JUMPL A,ERRLOP
MOVE C,UUOLFT ; # CHARS LEFT IN BUFFER
SUBI C,5*VALBLN
MOVNM C,VALLEN
MOVE C,LPOINT
LOG C,[ASCIZ /called ERROR./]
AOS -6(P)
ERRCKO: POP P,F
POP P,E
POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
; HACK TO SEE IF ERROR FRAME IS ATTEMPT-TO-DEFER-UNDEFERABLE-INTERRUPT. IF
; SO, SKIP TWO MORE FRAMES, TO GET REAL ERROR FRAME.
FRMFIX: PUSH P,A
PUSH P,B
PUSH P,C
MOVE A,FRAME+FRAMLN+ABSAV ; GET ARG POINTER FOR OUR FRAME
HLRE B,A
CAME B,[-6] ; HAS THREE ARGS IF WE WANT IT (?)
JRST FRMFXW
.ACCESS USRI,A
MOVE B,[-6,,ARGS]
.IOT USRI,B ; READ IN THE ARG BLOCK
HLRZ B,ARGS ; TYPE OF FIRST ARG
CAIE B,TATOM ; MUST BE ATOM
JRST FRMFXW
HLRZ B,ARGS+2 ; TYPE OF SECOND ARG
CAIE B,TINTH ; MUST BE IHEADER
JRST FRMFXW
HLRZ B,ARGS+4
CAIE B,TATOM
JRST FRMFXW
MOVE B,ARGS+1
.ACCESS USRI,B
CAMGE B,[-40.,,0]
HRLI B,-40.
MOVEI C,RANDBK
HLL C,B
.IOT USRI,C
HLRE C,B
ADDI C,3
CAME C,[-10] ; LENGTH OF PNAME OF DESIRED ATOM
JRST FRMFXW
HRLS C
HRRI C,RANDBK+3 ; AOBJN POINTER TO PNAME
MOVE B,[-10,,[ASCIZ /ATTEMPT-TO-DEFER-UNDEFERABLE-INTERRUPT/]]
FRMFLP: MOVE A,(B)
CAME A,(C)
JRST FRMFXW
AOBJP B,FRMFXC
AOBJN C,FRMFLP
FRMFXC: HRRZ A,FRAME+FRAMLN+FSAV+1 ; POINTER TO PREVIOUS FRAME
.CALL [SETZ
SIXBIT /USRMEM/
MOVEI USRI
MOVEI FSAV+1(A)
SETZM A]
JRST FRMFXL
HRRZI A,-FRAMLN(A) ; POINT TO ITS TOP
.ACCESS USRI,A ; ACCESS THERE
MOVE C,[-FRAMLN,,FRAME]
.IOT USRI,C ; READ IT IN
HLRZ A,FRAME ; LOOK AT TYPE IN 1ST WORD
CAIE A,TENTR ; IS IT REALLY A FRAME?
JRST FRMFXL ; NO
FRMFXW: AOS -3(P)
FRMFXL: POP P,C
POP P,B
POP P,A
POPJ P,
; ROUTINES FOR STUFFING VARIOUS FROBS INTO VALBUF
; CONVENTIONS: BYTE POINTER FOR OUTPUT IN UUOBPT, CHARS REMAINING IN UUOLFT,
; POINTER TO PAIR IN A
; GET A FIX
PFIX: JUMPE D,[EMIT "0
JRST PFIXO]
JUMPL D,[EMIT "-
MOVMS D
JRST .+1]
MOVE F,POWTAB
PFIXL1: IDIV D,(F)
JUMPE D,[MOVE D,E
AOBJN F,PFIXL1]
EMIT "0(D)
MOVE D,E
AOBJP F,PFIXO
PFIXL2: IDIV D,(F)
EMIT "0(D)
MOVE D,E
AOBJN F,PFIXL2
PFIXO: POPJ P,
; ATOM
PATOM: .ACCESS USRI,D
CAMGE D,[-40.,,0]
HRLI D,-40. ; MAX LENGTH
MOVEI E,RANDBK
HLL E,D
.IOT USRI,E ; READ IN THE ATOM
HLRE E,D
ADDI E,3
MOVNS E
IMULI E,5 ; MAX # CHARS
HRRI D,RANDBK+3
HRLI D,440700 ; MAKE A BP
PATOML: ILDB F,D ; PICK UP A CHAR
JUMPE F,PATOMD ; NULL --> END OF PNAME
EMIT (F)
SOJG E,PATOML
PATOMD: POPJ P,
; STRING
PCHST: EMIT ""
JUMPE E,PCHSTO ; EMPTY STRING
PUSH P,A
PUSH P,B
PUSH P,C
LDB A,[360600,,D]
CAIN A,1
JRST [MOVEI A,44
ADDI D,1
HRLI D,440700
JRST .+1]
MOVNS A
ADDI A,44 ; # UNUSED BITS (ILDB PTR) IN 1ST WD
IDIVI A,7 ; # UNUSED CHARS
ADDI A,(E) ; --> # CHARS WE HAVE TO READ
CAILE A,100.
JRST [SUBI A,100.
SUBI E,(A)
MOVEI A,100.
JRST .+1]
IDIVI A,5
SKIPE B
ADDI A,1 ; --> # WORDS WE HAVE TO READ
MOVNS A
HRLS A
HRRI A,STRNBK
.ACCESS USRI,D
.IOT USRI,A
HRRI D,STRNBK
POP P,C
POP P,B
POP P,A
PCHSTL: ILDB F,D
EMIT (F)
SOJG E,PCHSTL
PCHSTO: EMIT ""
POPJ P,
PFALSE: EMITS [ASCIZ /#FALSE (/]
JUMPE D,PFALSO
PUSH P,A
PFLOOP: .ACCESS USRI,D ; POINT TO A PAIR
MOVE E,[-2,,RANDBK]
.IOT USRI,E ; READ IT IN
GETYP D,RANDBK ; GET THE TYPE
CAIN D,TDEFER
JRST [PUSH P,RANDBK ; HACK DEFERS
.ACCESS USRI,RANDBK+1
MOVE E,[-2,,RANDBK]
.IOT USRI,E
MOVEI A,RANDBK
PUSHJ P,PRINT
POP P,RANDBK
JRST PF1]
MOVEI A,RANDBK
PUSHJ P,PRINT ; PRINT THE PAIR
EMIT 40 ; SPACE
PF1: HRRZ D,RANDBK ; GET THE NEXT ONE
JUMPN D,[EMIT 40
JRST PFLOOP]
POP P,A
PFALSO: EMIT ")
POPJ P,
PCHAN: EMITS [ASCIZ /#CHANNEL [/]
PUSH P,A
MOVE A,D
.ACCESS USRI,D
HRRI D,RANDBK
.IOT USRI,D ; READ IN THE CHANNEL
HRRI A,RANDBK
MOVE D,CHANNO(A)
PUSHJ P,PFIX ; PRINT THE CHANNEL #
EMIT 40
MOVE D,DIRECT(A)
HRRZ E,DIRECT-1(A)
PUSHJ P,PCHST ; DIRECTION
EMIT 40
MOVEI A,RNAME1(A)
HRLI A,-10
PCHLOP: MOVE D,(A)
HRRZ E,-1(A)
PUSHJ P,PCHST
EMIT 40
ADD A,[2,,2]
JUMPL A,PCHLOP
EMIT "]
POP P,A
POPJ P,
PRINT: PUSH P,D
PUSH P,E
PUSH P,F
GETYP E,(A)
MOVE D,1(A)
CAIN E,TFIX
JRST [PUSHJ P,PFIX
JRST PRINTO]
CAIN E,TCHST
JRST [HRRZ E,(A)
PUSHJ P,PCHST
JRST PRINTO]
CAIN E,TATOM
JRST [PUSHJ P,PATOM
JRST PRINTO]
CAIN E,TCHAN
JRST [PUSHJ P,PCHAN
JRST PRINTO]
CAIN E,TFALSE
JRST [PUSHJ P,PFALSE
JRST PRINTO]
PUSHJ P,UNKPRT ; DON'T KNOW HOW TO PRINT THIS TYPE
PRINTO: POP P,F
POP P,E
POP P,D
POPJ P,
UNKPRT: PUSH P,POWTAB
MOVE D,OCTTAB
MOVEM D,POWTAB
EMIT "*
HLRZ D,(A)
PUSHJ P,PFIX
EMITS [ASCIZ /*,,*/]
HRRZ D,(A)
PUSHJ P,PFIX
EMITS [ASCIZ \*/*\]
HLRZ D,1(A)
PUSHJ P,PFIX
EMITS [ASCIZ /*,,*/]
HRRZ D,1(A)
PUSHJ P,PFIX
EMIT "*
POP P,POWTAB
POPJ P,
CICRLF: EMIT ^M
EMIT ^J
POPJ P,
SUBTTL UUO handler
; UUOS FOR THIS CROCK: EMIT TYPE, FOR CREATING STRINGS TO BE OUTPUT,
; AND LOG, FOR LOGGING OUR ACTIONS.
; ASSUME BPTR IN UUOBPT, COUNT IN UUOLFT, EFFECTIVE ADDRESS IS INTERESTING.
UUOCT==0
UUOTAB: JRST ILUUO
IRPS X,,[EMIT EMITS EMIT6 EMITO LOG]
UUOCT==UUOCT+1
X=UUOCT_33
JRST U!X
TERMIN
UUOMAX==.-UUOTAB
IMPURE
UACSAV: BLOCK 17 ; AC'S
UJPCSV: 0
UUOAC: 0 ; AC FIELD OF INSTRUCTION
UUOD: 0
UUOE: 0 ; CONTENTS OF EFFECTIVE ADDRESS
UUOH: 0
JRST UUOPUR
PURE
UUOPUR: MOVEM O,UACSAV
MOVE O,[A,,UACSAV+A]
BLT O,UACSAV+P-1 ; SAVE EVERYTHING BUT P
LDB F,[330600,,40] ; OP CODE
CAIL F,UUOMAX
MOVEI F,0
SKIPN F
.SUSET [.RJPC,,UJPCSV] ; READ JPC IF ILLEGAL
MOVEI D,@40 ; GET EFFECTIVE ADDRESS
MOVEM D,UUOD
CAIG D,P ; AN AC?
JRST [MOVE D,UACSAV(D) ; GET OUT OF SAVED STUFF
JRST UUOP]
MOVE D,(D)
UUOP: MOVEM D,UUOE
LDB E,[270400,,40] ; AC FIELD
MOVEM E,UUOAC
JRST @UUOTAB(F) ; GO TO PROPER ROUT
UUORET: MOVE O,[UACSAV+A,,A]
BLT O,P-1
MOVE O,UACSAV
JRST @UUOH
ILUUO: JSR LOSE
; TAKE EFFECTIVE ADDRESS, STUFF IT OUT
UEMIT: SKIPG UUOLFT
JRST UUORET
MOVE D,UUOD
IDPB D,UUOBPT
SOS UUOLFT
JRST UUORET
UEMITS: SKIPG UUOLFT
JRST UUORET
MOVE D,UUOD
HRLI D,440700
ULOOP: ILDB E,D
JUMPE E,UUORET
IDPB E,UUOBPT
SOSG UUOLFT
JRST UUORET
JRST ULOOP
; EFFECTIVE ADDRESS CONTAINS SIXBIT
UEMIT6: SKIPG UUOLFT
JRST UUORET
MOVE E,UUOE
UEM6LP: JUMPE E,UUORET
MOVEI D,0
LSHC D,6
ADDI D,40
IDPB D,UUOBPT
SOSLE UUOLFT
JRST UEM6LP
JRST UUORET
; EFFECTIVE ADDRESS CONTAINS OCTAL
UEMITO: SKIPG UUOLFT
JRST UUORET
MOVE E,UUOE
TLNN E,-1 ; ANYTHING IN LEFT HALF?
JRST UEMTOR
PUSH P,E
HLRZS E
PUSHJ P,UEMTOP
MOVEI E,",
IDPB E,UUOBPT
IDPB E,UUOBPT
SOS UUOLFT
SOS UUOLFT
POP P,E
HRRZS E
UEMTOR: PUSHJ P,UEMTOP
JRST UUORET
UEMTOP: JUMPE E,[MOVEI D,"0
IDPB D,UUOBPT
SOS UUOLFT
POPJ P,]
PUSH P,A
MOVEI A,0
MOVE D,[-6,,[100000 ? 10000 ? 1000 ? 100 ? 10 ? 1]]
UEMTOL: IDIV E,(D)
JUMPE A,[JUMPE E,UEMTOE
JRST .+1] ; SUPPRESS LEADING 0'S
MOVNI A,1
ADDI E,"0
IDPB E,UUOBPT
SOSG UUOLFT
POPJ P,
UEMTOE: MOVE E,F
AOBJN D,UEMTOL
POP P,A
POPJ P,
SUBTTL Logging code--LOG UUO
; UUO TAKES IN AC AOBJN POINTER TO WORDS OF SIXBIT; EFFECTIVE ADDRESS
; POINTS TO ASCIZ PRINTED OUT AFTER THE SIXBIT. AC FIELD IS IN UUOAC;
; ACS ARE IN UACSAV-UACSAV+16. AC FIELD OF 0 --> ARG OF 0, REGARDLESS
; OF CONTENTS OF 0.
; PROCESS EXECUTING THE LOG IS STORED IN CURPRC; IF 0, USE 'GUNNER'
; INSTEAD.
IMPURE
LOGPTR: 0 ; BPTR INTO BUFFER
LOGLFT: 0 ; SPACE LEFT IN BUFFER, IN CHARACTERS
LOGMAP: 0 ; -1 WHEN ALL INITIALIZED
LOGPSV: 0 ; SAVED P, FOR RETURN FROM IOC'S
LOGNAM: SIXBIT /GUNSCR/
LOGNM2: 0 ; CURRENT NAME 2, SET BY LOGINI
LOGDIR: SIXBIT /HUDINI/
LOGATT: 0 ; -1 IF ATTACHED
LOGOPN: 0 ; NON-ZERO IF TTY CHANNEL OPEN
LOGPAG: BLOCK 2
LOGFRS: BLOCK 2 ; PAGE #S OF BUFFER AND FIRST PAGE
PURE
ULOG: .SUSET [.RTTY,,A] ; FIND OUT IF ATTACHED
SETZM LOGATT
SKIPL A
JRST [PUSHJ P,LOGTTY
JRST LOGCON]
SETZM LOGOPN
MOVEM P,LOGPSV
SKIPL LOGMAP
PUSHJ P,LOGINI ; INITIALIZE WORLD
LOGCON: PUSHJ P,LOGDAT ; STUFF OUT THE DATE
SKIPN A,CURPRC
MOVE A,[SIXBIT /GUNNER/]
PUSHJ P,LOGSIX ; SIXBIT OUT
MOVEI A,[ASCIZ /: /]
PUSHJ P,LOGASC
SKIPN B,UUOAC ; AC FIELD
JRST ULOGS ; NOTHING THERE
MOVE B,UACSAV(B) ; PICK UP THE AC
JUMPGE B,ULOGS
HRRZ A,B
CAIG A,17
ADDI A,UACSAV ; REFERRING TO OLD AC'S
HRR B,A
ULOGL6: MOVE A,(B)
PUSHJ P,LOGSIX
MOVEI A,40
PUSHJ P,LOGCHR
AOBJN B,ULOGL6
ULOGS: SKIPN A,UUOD ; EFFECTIVE ADDRESS
JRST ULOGO
PUSHJ P,LOGASC
ULOGO: MOVEI A,[ASCIZ /
/]
PUSHJ P,LOGASC
SKIPGE LOGATT
JRST ULOGO1
.CALL [SETZ
SIXBIT /PGWRIT/
MOVSI 1
SETZ LOGPAG]
JSR LOSE
.CALL [SETZ
SIXBIT /PGWRIT/
MOVSI 1
SETZ LOGFRS]
JSR LOSE
ULOGO1: SETZM LOGPSV
JRST UUORET
; SUBROUTINES FOR LOGGER
; OPEN TTY CHANNEL
LOGTTY: SETOM LOGATT
SKIPE LOGOPN
POPJ P,
.CALL [SETZ
SIXBIT /OPEN/
[.UAO,,TTYO]
[SIXBIT /TTY/]
[SIXBIT /TTY/]
SETZ [SIXBIT /TTY/]]
.LOSE %LSFIL
SETOM LOGOPN
POPJ P,
; PUT THE DATE OUT
LOGDAT: PUSH P,A
PUSH P,B
.RDATIM A,
EXCH A,B
PUSHJ P,LOGSIX ; YYMMDD
MOVEI A,40
PUSHJ P,LOGCHR
MOVE A,B
PUSHJ P,LOGSIX
MOVEI A,40
PUSHJ P,LOGCHR
POP P,B
POP P,A
POPJ P,
; SIXBIT IN A
LOGSIX: PUSH P,A
PUSH P,B
MOVE B,A
LOGSXL: MOVEI A,0
LSHC A,6
ADDI A,40
PUSHJ P,LOGCHR
JUMPE B,LOGSXO
JRST LOGSXL
LOGSXO: POP P,B
POP P,A
POPJ P,
; POINTER TO ASCIZ IN A
LOGASC: PUSH P,A
PUSH P,B
MOVE B,A
HRLI B,440700
LOGASL: ILDB A,B
JUMPE A,LOGSXO ; SAVE ACS PUSHED
PUSHJ P,LOGCHR
JRST LOGASL
; CHARACTER IN A.
LOGCHR: SKIPGE LOGATT
JRST [.IOT TTYO,A
POPJ P,]
SKIPG LOGLFT ; ROOM LEFT IN BUFFER?
PUSHJ P,LOGGRO ; GROW FILE
IDPB A,LOGPTR
SOS LOGLFT
AOS @LOGFRS+1
POPJ P,
; FILE-HANDLING ROUTINES FOR LOGGER
; CREATE LOG FILE: HUDINI;GUNSCR YYMM (IF NOT THERE), DO APPROPRIATE
; MAPPINGS
LOGINI: PUSH P,A
PUSH P,B
PUSH P,C
SKIPE LOGPAG
JRST LOGIN1
MOVE A,[LOGPAG,,1]
PUSHJ P,PGFIND
MOVE A,[LOGFRS,,1]
PUSHJ P,PGFIND
LOGIN1: .RDATE A,
TRZ A,7777 ; FLUSH DATE
MOVEM A,LOGNM2
.CALL [SETZ
SIXBIT /OPEN/
[.BII,,LOGCHN]
[SIXBIT /DSK/]
LOGNAM
LOGNM2
SETZ LOGDIR] ; DOES LOG FILE EXIST?
JRST LOGNEW ; NO, MAKE NEW ONE
.CALL [SETZ
SIXBIT /OPEN/
[.BIO+100000,,LOGCHN]
[SIXBIT /DSK/]
LOGNAM
LOGNM2
SETZ LOGDIR]
JRST LOGNEW ; SIGH
LOGDOM: .CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBNDW+%CBNDR
MOVEI %JSELF
MOVE LOGFRS
MOVEI LOGCHN
SETZI 0] ; MAP IN THE FIRST PAGE
JSR LOSE
SKIPN A,@LOGFRS+1
JRST [MOVEI A,7
MOVEM A,@LOGFRS+1 ; GOBBLE THE FIRST WORD (+ CR)
JRST .+1]
IDIVI A,5*2000 ; GET PAGE # OF BUFFER END IN A,
; CHARS ON IT IN B
SKIPN B
SUBI A,1 ; RIGHT ON PAGE BOUNDARY
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBNDW+%CBNDR
MOVEI %JSELF
MOVE LOGPAG
MOVEI LOGCHN
SETZ A] ; MAP IN THE LAST PAGE
JSR LOSE
SETZM LOGLFT
JUMPE B,LOGMDN
MOVEI A,5*2000
SUB A,B ; # CHARS LEFT IN PAGE
MOVEM A,LOGLFT
MOVE A,LOGPAG+1
HRLI A,440700
IDIVI B,5 ; WORDS IN B, LEFTOVER CHARS IN C
ADD A,B
JUMPE C,LOGMDN
IBP A
SOJG C,.-1 ; INCREMENT APPROPRIATELY
LOGMDN: MOVEM A,LOGPTR
.CLOSE LOGCHN,
SETOM LOGMAP
POP P,C
POP P,B
POP P,A
POPJ P,
; MAKE A NEW FILE. DATE IS IN A
LOGNEW: .CALL [SETZ
SIXBIT /OPEN/
[.BIO,,LOGCHN]
[SIXBIT /DSK/]
LOGNAM
LOGNM2
SETZ LOGDIR]
JSR LOSE
PUSH P,A
MOVEI A,1 ; SAY THIS IS FOR NEW FILE
PUSHJ P,LOGBFM ; MAKE THE CROCK BE 1 PAGE LONGER
POP P,A
JRST LOGDOM ; NOW GO DO THE MAPPING
; MAKE THE FILE BE ONE PAGE BIGGER THAN IT NOW IS. A IS 1 OR 0, DEPENDING
; ON WHETHER OR NOT WE'RE MAKING A NEW FILE
LOGBFM: PUSH P,A
PUSH P,B
PUSH P,C
MOVE C,-2(P)
.CALL [SETZ
SIXBIT /FILLEN/
MOVEI LOGCHN
SETZM A]
JSR LOSE
.ACCESS LOGCHN,A
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI 0
MOVEI %JSELF
SETZ LOGPAG]
JFCL
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBNDR
MOVEI %JSELF
MOVE LOGPAG
SETZI %JSNEW]
JSR LOSE
MOVE A,[ASCII /
/]
MOVE B,LOGPAG+1
ADD C,B
MOVEM A,(C)
HRLI A,(C)
HRRI A,1(C)
BLT A,1777(B)
HRRI A,(C)
HRLI A,440700
SKIPN -2(P)
JRST LOGBFD
MOVEI O,^M
IDPB O,A
MOVEI O,^J
IDPB O,A
LOGBFD: MOVE A,B
HRLI A,-2000
.IOT LOGCHN,A ; PRINT IT OUT
.CALL [SETZ
SIXBIT /FINISH/
SETZI LOGCHN] ; MAKE SURE IT'S ALL OUT
JSR LOSE
.CALL [SETZ
SIXBIT /FILLEN/
MOVEI LOGCHN
SETZM A]
JSR LOSE
SUBI A,1
LSH A,-12
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBNDW+%CBNDR
MOVEI %JSELF
MOVE LOGPAG
MOVEI LOGCHN
SETZ A]
JSR LOSE
POP P,C
POP P,B
POP P,A
POPJ P,
; GROW THE LOG FILE IF NEEDED. FROBS POINTERS APPROPRIATELY
LOGGRO: .CALL [SETZ
SIXBIT /PGWRIT/
MOVSI 1
SETZ LOGPAG] ; CAUSE CURRENT PAGE TO GO OUT
JSR LOSE
.CALL [SETZ
SIXBIT /OPEN/
[.BIO+100000,,LOGCHN]
[SIXBIT /DSK/]
LOGNAM
LOGNM2
SETZ LOGDIR]
JRST [PUSHJ P,LOGINI
POPJ P,]
PUSH P,A
MOVEI A,0
PUSHJ P,LOGBFM ; GROW THE FILE
MOVEI A,5*2000
MOVEM A,LOGLFT
MOVE A,LOGPAG+1
HRLI A,440700
MOVEM A,LOGPTR
.CLOSE LOGCHN,
POP P,A
POPJ P,
SUBTTL Daily processing
; PROCESS RUNS ABOUT MIDNIGHT. RESYNCHRONIZES TIME TO NEXT RUN FOR FIXED-TIME
; PROCESSES, FOR NO GOOD REASON; ON FIRST OF MONTH, STARTS A NEW LOG.
DAYPRC: PUSHJ P,PRCINI
MOVSI A,TTYCT
DAYTLB: SKIPL TTYLOK(A)
JRST DAYTLE
SETZM TTYLOK(A)
HRRZ B,A
IDIVI B,10
ADDI B,20
LSH B,6
ADDI C,20
IOR B,C
LSH B,30
MOVE C,[-1,,B]
LOG C,[ASCIZ /TTY unlocked./]
DAYTLE: AOBJN A,DAYTLB
PUSH P,A
.CALL [SETZ
SIXBIT /RQDATE/
SETZM A]
.LOSE %LSSYS
LDB A,[220500,,A] ; DAY OF MONTH
CAIE A,1 ; FIRST?
JRST [LOG [ASCIZ /ran./]
JRST DAYPR1]
LOG [ASCIZ /log closed./]
SETZM LOGMAP ; SAY LOG FILE NOT INITIALIZED
LOG [ASCIZ /log opened./]
; CHECK FOR NEW PARAMETER FILE.
DAYPR1: .CALL [SETZ
SIXBIT /OPEN/
[.UAI,,DSKI]
[SIXBIT /DSK/]
INIFN1
INIFN2
SETZ INIDIR]
JRST [LOG [ASCIZ /Parameter file missing?/]
JRST DAYPRO]
.CALL [SETZ
SIXBIT /RFDATE/
MOVEI DSKI
SETZM A]
JSR LOSE
.CLOSE DSKI,
CAME A,PARMIN
SETZM PARMIN ; CAUSE IT TO RE-INITIALIZE
DAYPRO: SETZM BDTHER
POP P,A
MOVE A,DAYPNT+NXTRUN ; TIME TO NEXT RUN IS HERE, ACCURATELY.
AOS (P)
POPJ P,
HOURLY: LOG [ASCIZ /OK/]
POPJ P,
SUBTTL Statistics code for demons
; LSINIT TAKES A DEMON NAME IN DEM, AND FINDS OR ALLOCATES A BLOCK FOR IT
; IN LOSBLK, WITH A POINTER TO SAME IN LOSTBL.
LSINIT: MOVE LOSTBL,[-LOSLEN*LOSCNT,,LOSBLK]
LSILOP: CAMN DEM,DEMNAM(LOSTBL) ; HAVE WE FOUND THE RIGHT BLOCK?
POPJ P, ; YES, SO FLUSH
SKIPN (LOSTBL) ; IS THIS BLOCK EMPTY?
JRST [MOVEM DEM,DEMNAM(LOSTBL)
POPJ P,] ; YES, SO WIN ANYWAY
ADD LOSTBL,[LOSLEN,,LOSLEN]
JUMPL LOSTBL,LSILOP
JSR LOSE ; WE JUST RAN OUT OF SPACE
; WINNER UPDATES THE TABLE ENTRY OF THE CURRENT DEMON, WHICH IS KNOWN TO BE
; DEAD. THIS INVOLVES SAVING THE DATA IN THE TABLE FOR IT, AND DECIDING
; WHETHER THE DEMON SHOULD STAY DOWN. IF THE DEMON SHOULD NOT STAY DOWN
; (IF THE DEMON IS A WINNER), WINNER SKIPS.
WINNER: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
SKIPE A,WINCT(LOSTBL)
JRST [CAIL A,3
SOS WINCT(LOSTBL)
JRST .+1] ; SO THIS LOSSAGE WON'T GET RECYCLED NEXT TIME
AOS A,LOSCT(LOSTBL)
SUBI A,1
IMULI A,DATLEN
ADDI A,DATST(LOSTBL) ; POINT TO NEXT DATA BLOCK IN ENTRY
MOVE B,@UPC ; GET PC
MOVEM B,LOSPC(A)
.CALL [SETZ ; SAVE AWAY TIME OF LOSSAGE
SIXBIT /RQDATE/
SETZM LOSTM(A)]
.LOSE 1000
MOVE A,LOSCT(LOSTBL)
CAIG A,1
JRST WINWIN ; ONLY ONE LOSS. LET IT LIVE.
CAIL A,4
JRST WINOUT ; FOUR LOSSES. FLUSH IT.
; THE NUMBER OF LOSSES IS NOW KNOWN TO BE 2 OR 3.
MOVE B,WINCT(LOSTBL)
SKIPN ERRFLG ; RARELY FLUSH IF ERROR JUST CALLED
CAIL B,4
JRST WINWIN ; FOUR WINS. DON'T FLUSH IT.
CAIG B,1
JRST WINOUT ; 0 OR 1 WINS. FLUSH IT.
HRRZ B,DATST+LOSPC(LOSTBL) ; GET FIRST LOSING PC
HRRZ C,DATST+DATLEN+LOSPC(LOSTBL)
CAIN B,(C)
JRST WINOUT ; WE HAVE TWO PC'S THE SAME, SO FLUSH
HRRZ D,DATST+<2*DATLEN>+LOSPC(LOSTBL)
CAIN B,(D)
JRST WINOUT
CAIN C,(D)
JRST WINOUT
WINWIN: AOS -4(P)
WINOUT: POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
SUBTTL COMSYS code
COMHAK: SKIPN GOTJOB
POPJ P,
MOVE B,[.RIOC+1,,C] ; IOC IS NORMALLY ZERO FOR CLOSED CHANNEL
CCHNLP: .USET USRO,B
JUMPE C,CCHNLE
LDB D,[220400,,B] ; CHANNEL NUMBER
LSH D,27
IOR D,[.CLOSE]
MOVEM D,EXBLK
MOVEI E,CHNKIL
PUSHJ P,INFEXE ; DO THE CLOSE
CCHNLE: ADD B,[1,,0]
TLNE B,17
JRST CCHNLP
MOVE A,@OPTION ; CHECK THE OPTION WORD
TLNN A,OPTLOK
JRST COMDON
.CALL [SETZ
SIXBIT /USRVAR/
MOVEI USRO
MOVEI .ROPTIO
MOVEI 0
SETZ [TLZ OPTLOK]]
JSR LOSE
HRRZ A,@40ADDR
ADDI A,3
.ACCESS USRI,A
MOVE B,[-2,,C]
.IOT USRI,B ; READ IN LOCS 43 & 44
MOVEM D,LOC44
SETOM MPVFLG ; IF CHOMPAGE OCCURS, WE'LL KNOW WHY
JUMPE C,UNLOK2 ; NO LOCKS--GO TO CRITICAL CODE
MOVEI A,(C)
MOVEI E,LOKKIL
MOVEI F,1000
UNLOK1: .ACCESS USRI,A
MOVE B,[-2,,C]
.IOT USRI,B
TLZ D,000757 ; FLUSH INDEX AND AC FIELDS
TLNE D,777000 ; IF 0 OPCODE, MAKE IT BE SETOM
JRST UNLOK3
TLZ D,777000
TLO D,476000
UNLOK3: HLL A,D ; OPCODE INTO A (WHERE THE ADDRESS LIVES)
MOVEM A,EXBLK
PUSHJ P,INFEXE ; DO THIS UNLOCK
TRNN D,-1
JRST UNLOK2
HRRZ A,D
SOJG F,UNLOK1 ; STOP AFTER 512, REGARDLESS
UNLOK2: SKIPN A,LOC44 ; PICK UP AOBJN POINTER
JRST COMDON
HRRZ F,@UPC
UNLOKL: MOVE B,[-2,,C]
.ACCESS USRI,A
.IOT USRI,B
CAIL F,(C) ; BEFORE END OF CRITICAL SECTION?
JRST UNLOKE
HLRZS C
CAIGE F,(C) ; AFTER BEGINNING?
JRST UNLOKE
MOVEM D,EXBLK
PUSHJ P,INFEXE ; DO THE UNLOCK
UNLOKE: ADD A,[2,,2]
JUMPL A,UNLOKL
COMDON: SETZM MPVFLG
PUSHJ P,DISJO1
MOVE A,COMNAM+1
PUSHJ P,SNDMAL
POPJ P,
SUBTTL BATCHN code
; COME HERE TO HACK BATCHN: CLOSES INFERIORS AND SCRIPT, LEAVES CORPSE
; AROUND DISOWNED.
BATHAK: SETOM BATCH
SKIPN GOTJOB ; GOT JOB?
POPJ P, ; FAILED. OH, WELL.
MOVE B,[.RIOS+1,,C] ; GET WORD FOR USETTING .IOS
BCHNLP: .USET USRO,B ; GET IOS IN C
LDB C,[IOSDEV,,C] ; GET DEVICE CODE IN C
CAIN C,SNUSR
PUSHJ P,INFFLS ; GO FLUSH INFERIOR
CAIN C,SN2311
PUSHJ P,CHNFLS ; GO FLUSH CHANNEL (IF WRITE/WRITE-OVER MODE)
ADD B,[1,,0] ; AOS CHANNEL NUMBER
TLNE B,17 ; SEE IF ALL DONE
JRST BCHNLP
PUSHJ P,DISJOB ; DO DISOWN AND START NEW ONE.
MOVE A,BATNAM+1
PUSHJ P,SNDMAL ; SEND MAIL
POPJ P, ; AND DEPART
; FLUSH INFERIOR OPEN ON CHANNEL SPECIFIED IN LOW 4 BITS OF LH OF B.
; STUFF .UCLOSE ? .BREAK ? .BREAK IN STARTING AT LOC 26, START JOB
; THERE (AFTER TURNING OFF ALL INTERRUPTS).
INFFLS: LDB D,[220400,,B] ; GET CHANNEL NUMBER IN D
LSH D,27 ; INTO AC FIELD
IOR D,[.UCLOSE]
MOVEM D,EXBLK
MOVEI E,INFKIL
; ALTHOUGH THIS ROUTINE IS NORMALLY JRSTED TO (AND DOES A POPJ),
; WE PUSHJ TO IT, IT WILL TASTEFULLY POPJ AND WE MAY CONTINUE FROBBING.
; IPCOFF DOES SO.
INFEXE: PUSH P,D
MOVE D,[-EXLEN,,EXBLK]
.ACCESS USRO,[26] ; ACCESS TO SUITABLE LOCATION
.IOT USRO,D ; STUFF IT IN
.USET USRO,[.RPIRQC,,IPIRQC]
.USET USRO,[.RIFPIR,,IIFPIR]
.USET USRO,[.RMSK2,,IMASK2]
.USET USRO,[.RMASK,,IMASK]
.USET USRO,[.SPIRQC,,[0]]
.USET USRO,[.SIFPIR,,[0]]
.USET USRO,[.SMSK2,,[0]]
.USET USRO,[.SMASK,,[0]] ; SAVE & CLEAR INTERRUPTS
.USET USRO,[.RUPC,,G]
.USET USRO,[.SUPC,,[26]] ; SET PC
SETOM INFRUN
.USET USRO,[.SUSTP,,[0]] ; START JOB (WILL INTERRUPT WHEN DONE)
SKIPE INFRUN
.HANG
SKIPE MPVFLG
JRST [.USET USRO,[.RPIRQC,,D]
JRST .+1]
.USET USRO,[.SPIRQC,,IPIRQC]
.USET USRO,[.SIFPIR,,IIFPIR]
.USET USRO,[.SMASK,,IMASK]
.USET USRO,[.SMSK2,,IMASK2] ; RESTORE INTERRUPTS
.USET USRO,[.SUPC,,G] ; RESTORE PC
SKIPE MPVFLG
JRST [TDNN D,[%PIWRO+%PIMPV]
JRST .+1
POP P,D
SUB P,[1,,1]
JRST COMDON] ; FLUSH IF JOB GOT ERROR
AOS (E) ; ADD 1 TO FROBS KILLED
POP P,D
POPJ P, ; DEPART
; HERE TO FLUSH SCRIPT CHANNEL IF EXISTS. GETS FILE NAME FROM SYSTEM,
; IF IT'S 'NBATCH LOG', THEN DOES CLOSE.
CHNFLS: LDB D,[220400,,B] ; GET CHANNEL NUMBER
.CALL [SETZ ; GET FILE NAME
SIXBIT /RFNAME/
MOVEI USRO ; JOB
D ; CHANNEL #
MOVEM
MOVEM E
SETZM F]
POPJ P, ; GIVE UP
CAME E,[SIXBIT /NBATCH/]
POPJ P,
CAME F,[SIXBIT /LOG/]
POPJ P,
LSH D,27
IOR D,[.CLOSE]
MOVEM D,EXBLK ; STUFF .CLOSE OUT
MOVEI E,CHNKIL
JRST INFEXE ; AND GO DO IT.
; CLOSE IPC CHANNEL IF EXISTS, SO WILL BE ABLE TO MUDINQ AT NEW DEMON. THIS
; IS CALLED BY DISJOB.
IPCOFF: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
MOVEI E,C ; HACK, HACK
MOVE A,[.RIOS+1,,B]
IPCLOP: .USET USRO,A
LDB C,[000600,,B] ; ISOLATE DEVICE CODE
CAIN C,SNMSP ; IPC DEVICE?
JRST IPCOF1 ; YES, GO CLOSE IT
IPCCON: ADD A,[1,,0]
TLNE A,17 ; CHECKED ALL CHANNELS?
JRST IPCLOP ; NO
POP P,E
POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
IPCOF1: LDB C,[220400,,A] ; GET CHANNEL NUMBER
LSH C,27
IOR C,[.CLOSE] ; CONS UP .CLOSE
MOVEM C,EXBLK
PUSHJ P,INFEXE ; GO TO ROUTINE
JRST IPCCON ; AND LOOK FOR MORE.
SUBTTL COMBAT code
; CHECK TO SEE IF COMBAT RAN OVERTIME: PAST RUNTIMER SETTING
ZONHAK: CAME DEM,[SIXBIT /ZONE/]
JRST DEMWIN
MOVE B,@UTRNTM ; GET RUN TIME
CAMG B,[250000.*60.*5] ; FIVE MINUTES FOR START-UP
JRST DEMWIN ; NO
SKIPLE @RTIMER ; SEE IF NO RUNTIME INTERRUPT ENABLED.
JRST DEMWIN ; STILL ENABLED, SO GO AWAY.
SETZM BLTBEG
MOVE A,[BLTBEG,,BLTBEG+1]
BLT A,BLTEND ; CLEAR BLOCK
SETOM OVERTI
MOVE A,@UNAME
MOVEM A,LUNAME
MOVE A,@JNAME
MOVEM A,LJNAME
SETOM GUNNED
MOVEI A,@USTP
HRLI A,[0 ? 100000,,0]
.IFSET A,
JFCL
JRST ZONHK2
; FLUSH COMBAT, RENAME APPROPRIATE PLAN, ETC.
ZONHK1: SKIPN GOTJOB
SETOM GUNNED
ZONHK2: SETOM COMBAT
HLRO A,LUNAME
CAMN A,[-1] ; WAS THE CROCK LOGGED IN?
JRST RESTAR
MOVE A,PLNNAM
RNMLP: .CALL [SETZ ; DON'T CHASE LINKS
SIXBIT /OPEN/
[.UAI+<1_4>,,DSKI]
[SIXBIT /DSK/]
(A)
[SIXBIT /</]
SETZ [SIXBIT /COMBAT/]]
JRST [AOBJN A,RNMLP
JRST RESTAR]
.CALL [SETZ
SIXBIT /FILBLK/
MOVEI DSKI
MOVEM FN1
MOVEM FN2
SETZM A]
JSR LOSE
TLNE A,1 ; TEST LINK BIT
JRST
MOVEI C,INBLEN
MOVE D,INBPTR
.CALL [SETZ
SIXBIT /SIOT/
MOVEI DSKI
D
SETZ C]
JSR LOSE
MOVEI C,INBLEN
MOVE D,INBPTR
NMLOOP: ILDB E,D
CAIN E,"" ; LOOK FOR QUOTES
JRST RNMNAM
SOJGE C,NMLOOP
JRST RESTAR ; DIDN'T FIND IT, SO RESTART
RNMNAM: MOVE F,[440600,,G]
MOVEI G,0
SIXLOP: ILDB E,D
CAIN E,""
JRST SIXLP1
SUBI E,40
CAIL E,100
SUBI E,40
IDPB E,F
TLNE F,770000
JRST SIXLOP
SIXLP1: MOVEM G,LOSER ; SO THE CHOMPER CAN BE TOLD.
DORENM: .CALL [SETZ
SIXBIT /RENAME/
[SIXBIT /DSK/]
FN1
FN2
[SIXBIT /COMBAT/]
[SIXBIT /GUNNED/]
SETZ [SIXBIT />/]]
JRST RESTAR
SKIPN LOSER
JRST RESTAR
.CALL [SETZ
SIXBIT /RFNAME/
MOVEI DSKI
MOVEM
MOVEM
SETZM RFN2]
JSR LOSE
; COME HERE TO SEND OUT MAIL AND RESTART DEMON.
RESTAR: SKIPN GUNNED
JRST [PUSHJ P,DISJOB
JRST RESTA1]
MOVE A,U
IDIV A,L
.GUN A, ; DONE, FLUSH THE CRETIN
SETZM GUNNED
.CALL DEMSIG ; AND START A NEW ONE
JFCL
RESTA1: MOVE A,ZONNAM+1 ; GET NAME TO SEND TO
PUSHJ P,SNDMAL
POPJ P,
SUBTTL Utilities
; UTILITIES FOR OWNING AND DISOWNING JOBS.
; GETJOB: TRY TO CONS UP (AS AN INFERIOR) THE JOB WHOSE JNAME IS IN DEM
; AND WHOSE SYSTEM INDEX IS IN U. IF SUCCEED, SKIP.
GETJOB: PUSH P,A
PUSH P,B
PUSH P,C
MOVE A,U
IDIV A,L ; GET USER INDEX IN A
ADDI A,400000
.CALL [SETZ ; TRY TO OPEN FOR WRITING
SIXBIT /OPEN/
[.BIO,,USRO]
[SIXBIT /USR/]
A
SETZI 0]
JRST GETOUT ; FAILED
.CALL [SETZ
SIXBIT /OPEN/
[.BII,,USRI]
[SIXBIT /USR/]
A
SETZI 0]
JRST GETOUT
.CALL [SETZ ; GET JOB NAMES, ETC.
SIXBIT /RFNAME/
MOVEI USRI
MOVEM
MOVEM DUNAME
MOVEM DJNAME
MOVEM
SETZM C]
JRST GETOUT
TRNE C,<1_3> ; SEE IF REALLY INFERIOR
JRST GETOUT
SETOM GOTJOB
AOS -3(P)
JRST GETPOP
GETOUT: .CLOSE USRI,
.CLOSE USRO,
GETPOP: POP P,C
POP P,B
POP P,A
POPJ P,
; COME HERE TO DISOWN CURRENT JOB, AND START UP NEW DEMON (NAME IS IN DEM)
DISJOB: PUSHJ P,IPCOFF ; NEED TO CLOSE ANY IPC CHANNELS
DISJO1: .USET USRO,[.SUPC,,BADUPC] ; RESTORE UPC
.DISOWN USRI,
JFCL
.CALL [SETZ
SIXBIT /STDMST/
DEM
[-1]
SETZI 0]
JFCL
.CALL DEMSIG
JFCL
PUSH P,A
MOVE A,LPOINT
LOG A,[ASCIZ /restarted./]
POP P,A
POPJ P,
DEMSIG: SETZ
SIXBIT /DEMSIG/
DEM
SETZI 0
; IF JOB .VALUE'ED, GET THE STRING IT SENT. PUT LENGTH IN VALLEN, STRING
; IN VALBUF.
VALCHK: PUSH P,A
PUSH P,B
PUSH P,C
MOVE A,[440700,,VALBUF]
MOVEM A,UUOBPT
MOVEI A,5*VALBLN
MOVEM A,UUOLFT
MOVE B,@SV40 ; HAS LAST UUO, WITH EFFECTIVE ADDRESS
LDB A,[271500,,B] ; GET OPCODE IN B
CAIE A,1064 ; FOR .VALUE
JRST LOSCHK
GETVST: MOVE A,LPOINT
LOG A,[ASCIZ /.valued./]
TLZ B,-1 ; TURN OFF LH, LEAVE EFFECTIVE ADDRESS
JUMPE B,VALCOT
.ACCESS USRI,B
MOVE A,[-VALBLN,,VALBUF]
.IOT USRI,A
VALLOP: ILDB C,UUOBPT
JUMPE C,VALLOT
SOS UUOLFT
AOJA A,VALLOP
VALLOT: MOVEI A,40
DPB A,UUOBPT
SOS UUOLFT
PUSHJ P,ACOUT ; CONTENTS OF AC'S
MOVE A,UUOLFT
SUBI A,5*VALBLN
MOVNM A,VALLEN
VALCOT: POP P,C
POP P,B
POPAJ: POP P,A
POPJ P,
; HACK TO INTERPRET .LOSES
LOSCHK: CAIE A,1062 ; .LOSE IS .CALL 2,
JRST INTCHK
PUSH P,D
PUSH P,E ; FOR HACKING IN VALBUF
PUSH P,F
MOVE D,LPOINT
LOG D,[ASCIZ /called .LOSE./]
SETOM LOSFLG ; SAY .LOSE HAPPENED
EMITS [ASCIZ /ERROR: /] ; HEADER
HRRZ A,@VAL ; GET THE MAGIC BITS
TRNN A,%LSSYS
JRST LOSTWO ; FUNNY CASES
; NOW IS CASE OF %LSSYS OR %LSFIL
TRNN A,77 ; SEE IF LUSER SUPPLIED ERROR CODE
JRST [PUSHJ P,GETERR ; RETURN ERROR CODE IN D
JRST .+2]
LDB D,[000600,,A] ; PICK UP USER ERROR CODE
PUSH P,D ; SAVE ERROR CODE
HLRZ D,@VAL
.ACCESS USRI,D
MOVE D,[-1,,E]
.IOT USRI,D ; READ THE INSTRUCTION INTO C
LDB D,[301400,,E] ; GET THE OPCODE AND AC
CAIE D,0430 ; .CALL 0,?
JRST NOCALL ; NO
EMIT6 @LSCALL ; NAME OF LAST .CALL 0,
EMITS [ASCIZ /: /]
NOCALL: TRNN A,400 ; INTERESTED IN FILE NAME?
JRST NOFILE
PUSH P,[0]
PUSH P,[0]
PUSH P,[0]
PUSH P,[0] ; BLOCK FOR FILE NAME
CAIE D,430
JRST DRFNAM ; CAN GET NAME FROM RFNAME ON .BCHN
MOVE A,@LSCALL
CAME A,[SIXBIT /OPEN/] ; IF .CALL OPEN, SPECIAL HAIR
CAMN A,[SIXBIT /RENAME/]
JRST GTARGS
CAMN A,[SIXBIT /DELETE/]
JRST GTARGS
; GET FILE NAME ON 14xx WHEN NOT OPEN, RENAME, DELETE
DRFNAM: .USET USRI,[.RBCHN,,A] ; GET .BCHN
.CALL [SETZ
SIXBIT /RFNAME/
MOVEI USRI
A
MOVEM -3(P) ; DEVICE
MOVEM -2(P)
MOVEM -1(P)
SETZM (P)]
JFCL
; HERE TO PRINT FILE NAME. GTARGS REJOINS COMMON CODE AT THIS POINT
PFNAME: SKIPN -3(P) ; IF DEVICE IS 0, NO FILE NAME HERE
JRST PFNAMD ; SO FLUSH
EMIT 40
EMIT6 -3(P) ; PRINT DEVICE
EMIT ":
SKIPN (P)
JRST PFNM1
EMIT6 (P)
EMIT ";
PFNM1: SKIPN -2(P)
JRST PFNAMD
EMIT6 -2(P)
EMIT 40
SKIPE -1(P)
EMIT6 -1(P)
PFNAMD: SUB P,[4,,4] ; FLUSH FILE NAME BLOCK
EMITS [ASCIZ / - /]
; REJOIN HERE IF .LOSE 10xx. ERROR CODE IS (P)
NOFILE: POP P,D
.CALL [SETZ
SIXBIT /OPEN/
[.UAI,,ERRI]
[SIXBIT /ERR/]
MOVEI 4 ; WE SUPPLY ERROR CODE
SETZ D] ; AND HERE IT IS
JRST ERRLOS
.CALL [SETZ
SIXBIT /SIOT/
MOVEI ERRI
UUOBPT ; BPTR
SETZ UUOLFT] ; LENGTH
JRST ERRLOS
MOVEI A,0
ERRPAD: MOVE B,UUOBPT
ERRPDL: DPB A,B ; MAKE SURE ASCIZ
AOS UUOLFT
DBP B ; AND FLUSH A CHARACTER
LDB O,B
CAIG O,40
JRST ERRPDL
MOVEM B,UUOBPT
ERRLOS: .CLOSE ERRI,
PUSHJ P,ACOUT ; PRINT THE AC'S
POP P,F
POP P,E
POP P,D
MOVE C,UUOLFT
SUBI C,5*VALBLN
MOVNM C,VALLEN ; LENGTH OF STRING IN VALBUF
JRST VALCOT ; ALL DONE
; FUNNY CASES OF .LOSE--B, C SACRED, A HAS MAGIC BITS
LOSTWO: JUMPE A,ERRLOS ; NOTHING
CAILE A,37 ; INTERRUPT?
JRST ERRLOS ; GARBAGE
SUBI A,1
EMITS @INTTAB(A) ; DESCRIBE THIS INTERRUPT
JRST ERRLOS ; AND RETURN
INTTAB: [ASCIZ /.VAL 0?/] ; 4.9
[ASCIZ /%PIRLT: Real time interrupt/] ; 4.8
[ASCIZ /%PIRUN: Run time interrupt/] ; 4.7
[ASCIZ /???: Unknown interrupt/] ; 4.6
[ASCIZ /???: Unknown interrupt/] ; 4.5
[ASCIZ /%PIDCL: Deferred call/] ; 4.4
[ASCIZ /%PIATY: TTY returned by superior/] 4.3
[ASCIZ /%PITTY: Attempt to use tty when not possessing it/] ;4.2
[ASCIZ /%PIPAR: Parity error/] ; 4.1
[ASCIZ /%PIFOV: Arithmetic floating overflow/] ; 3.9
[ASCIZ /%PIWRO: Pure write/] ; 3.8
[ASCIZ /%PIFET: Pure page trap/] ; 3.7
[ASCIZ /%PITRP: System uuo to user trap/] ; 3.6
[ASCIZ /Arm tip break 1/] ; 3.5
[ASCIZ /Arm tip break 2/] ; 3.4
[ASCIZ /Arm tip break 3/] ; 3.3
[ASCIZ /%PIDBG: System being debugged/] ; 3.2
[ASCIZ /%PILOS: .LOSE UUO or LOSE system call executed/] ; 3.1
[ASCIZ /%PICLI: CLI device interrupt/] ; 2.9
[ASCIZ /%PIPDL: Pdl overflow/] ; 2.8
[ASCIZ /%PILTP: Program stop or hit stop on E&S display/] ; 2.7
[ASCIZ /%PIMAR: MAR interrupt/] ; 2.6
[ASCIZ /%PIMPV: Memory protection violation/] ; 2.5
[ASCIZ /%PICLK: Slow clock interrupt/] ; 2.4
[ASCIZ /%PI1PR: Single instruction proceed interrupt/] ; 2.3
[ASCIZ /%PIBRK: .BREAK executed/] ; 2.2
[ASCIZ /%PIOOB: Illegal user address/] ; 2.1
[ASCIZ \%PIIOC: Input/output channel error\] ; 1.9
[ASCIZ /%PIVAL: .VALUE uuo executed/] ; 1.8
[ASCIZ /%PIDWN: System going down or being revived/] ; 1.7
[ASCIZ /%PIILO: Illegal operation/] ; 1.6
[ASCIZ /%PIDIS: Display memory protection violation/] ; 1.5
[ASCIZ /%PIARO: Arithmetic overflow/] ; 1.4
[ASCIZ /%PIB42: Bad location 42/] ; 1.3
[ASCIZ /%PIC.Z: Control-Z typed/] ; 1.2
[ASCIZ /%PITYI: Interrupt character typed/] ; 1.1
; OTHER HACKS FOR .LOSE
; GET ERROR CODE INTO D IF NOT USER-SUPPLIED (USUAL CASE)
GETERR: .USET USRI,[.RBCHN,,D] ; READ CHANNEL #
HRLI D,.RIOS(D)
HRRI D,D
.USET USRI,D ; GET IOS WORD FOR IT
LDB D,[220600,,D] ; RIGHT 6 BITS OF LH ARE ERROR CODE
POPJ P,
; GET FILE NAMES FROM .CALL OPEN &C. TOP FOUR LOCS ON STACK ARE FOR
; STORING SAME; D, E, F CAN BE CLOBBERED.
; WHEN CALLED, D IS OPCODE (.CALL 0,), E IS INSTRUCTION EXECUTED
GTARGS: PUSH P,A
PUSH P,B
MOVE A,E
PUSHJ P,GEADDR ; EFFECTIVE ADDRESS OF BLOCK INTO A
MOVE E,A ; SAVE IT
PUSHJ P,GCADDR ; GET CONTENTS OF ADDRESS IN A INTO A
JRST GEARGO ; BLOCK IS NXM???
CAME A,[SETZ] ; BETTER BE SETZ
JRST GEARGO
ADDI E,2
MOVEI F,0 ; #ARGS FOUND
MOVEI D,-5(P) ; ADDRESS OF BLOCK OF FILE NAMES
ARGLOP: MOVE A,E
PUSHJ P,GCADDR ; GET ARGUMENT INTO A
JRST GEARGO
LDB O,[330300,,A] ; GET THE BITS
SOJG O,NXTARG ; MUST BE 0 OR 1000 TO BE INTERESTING
JUMPE F,[MOVEI F,1
JRST NXTARG] ; SKIP FIRST ARG
PUSH P,A
PUSHJ P,GEADDR ; GET ADDRESS
TLNE A,1000 ; IMMEDIATE?
JRST FNDARG ; ALL WE NEED
PUSHJ P,GCADDR ; GET THE REAL THING
MOVEI A,0
FNDARG: MOVEM A,(D)
ADDI D,1
ADDI F,1
POP P,A
NXTARG: CAIL F,5
JRST GEARGO ; FOUND FOUR ARGS
JUMPL A,GEARGO ; ALL DONE
ADDI E,1
JRST ARGLOP
GEARGO: POP P,B
POP P,A
JRST PFNAME ; GO PRINT NAME
; TAKES ADDRESS IN A, RETURNS CONTENTS IN A. IF NXM, THEN DOESN'T SKIP
GCADDR: PUSH P,B
PUSH P,A
CAIG A,17
JRST GCUSAC ; MAKE SURE WE GET THE RIGHT AC
GCADD0: LSH A,-12 ; TURN INTO PAGE #
HRLI A,.RPMAP(A)
HRRI A,A
.USET USRI,A ; GET PMAP ENTRY
JUMPE A,[POP P,A ; NO SUCH PAGE
JRST GCADDO]
POP P,A
.ACCESS USRI,A
MOVE B,[-1,,A]
.IOT USRI,B
AOS -1(P) ; SKIP RETURN ON SUCCESS
GCADDO: POP P,B
POPJ P,
GCUSAC: MOVE B,@UPC
TLNE B,%PCUSR ; USER MODE PC?
JRST GCADD0 ; GO THROUGH NORMAL CODE
POP P,A
ADD A,UUOACS
MOVE A,@A
JRST GCADDO
; TAKES INSN IN A, RETURNS EFFECTIVE ADDRESS IN A
GEADDR: PUSH P,B
PUSH P,C
PUSH P,D
GEADDL: TLNN A,37 ; SKIP IF INDEX/INDIRECT
JRST GEADDO ; NO, ALL DONE
LDB B,[220400,,A] ; AC #
LDB C,[260100,,A] ; INDIRECT BIT
JUMPE B,GENOAC
ADD B,UUOACS ; UUOACS+n(U)
MOVE B,@B ; GET CONTENTS OF AC n
ADD A,B ; ALMOST EFFECTIVE ADDRESS
GENOAC: TLZ A,-1
JUMPE C,GEADDO ; NO INDIRECTION, SO DONE
PUSHJ P,GCADDR ; GET LOCATION POINTED TO INTO A
JRST GEADDO ; NXM??
SOJG D,GEADDL ; TRY AGAIN, PREVENTING INFINITE LOOPS
GEADDO: TLZ A,-1
POP P,D
POP P,C
POP P,B
POPJ P,
; PRINT CONTENTS OF AC'S
ACOUT: PUSH P,A
PUSH P,E
EMITS [ASCIZ /
ACs:
/]
MOVEI E,0
ACLOP: MOVE A,E
EMITO E
EMITS [ASCIZ \/ \]
PUSHJ P,GCADDR ; GET AC IN A
JFCL
EMITO A
EMITS [ASCIZ /
/]
CAIGE E,17
AOJA E,ACLOP
POP P,E
POP P,A
POPJ P,
; CASE OF FATAL INTERRUPTS
INTCHK: MOVE A,[%PIDCL\%PITTY\%PIPAR\%PIWRO\%PIFET\%PITRP\%PILOS\%PIMAR\%PIMPV\%PI1PR\%PIBRK\%PIOOB\%PIIOC\%PIVAL\%PIILO\%PIDIS\%PIB42\%PIC.Z] ; CLASS 1 & 2 INTERRUPTS
MOVE B,@MSKST
ANDCM B,@IDF1 ; BITS ON FOR INTERRUPTS HANDLED
ANDCM A,B ; BITS ON FOR FATAL INTERRUPTS
AND A,@PIRQC ; FATAL INTERRUPTS PENDING
JUMPE A,VALCOT ; NONE
PUSH P,D
PUSH P,E
PUSH P,F
MOVE D,LPOINT
LOG D,[ASCIZ /received fatal interrupt./]
SETOM INTFLG
MOVE D,A
MOVEI F,0
MOVE B,[440700,,VALBUF]
MOVEM B,UUOBPT
MOVEI C,5*VALBLN
MOVEM C,UUOLFT
EMITS [ASCIZ /Fatal interrupts: /]
INTLOP: JFFO D,.+2
JRST INTCHA ; NO MORE
JUMPE F,.+2
EMITS [ASCIZ /, /]
ADD F,E
EMITS @SINTAB ; SHORT NAMES, INDEXED OFF F
LSH D,1(E)
AOJA F,INTLOP
INTCHA: PUSHJ P,ACOUT
POP P,F
POP P,E
POP P,D
MOVE C,UUOLFT
SUBI C,5*VALBLN
MOVNM C,VALLEN
JRST VALCOT
SINTAB: MOVE @.+1(F)
[ASCIZ /[4.9]/] ; 4.9
[ASCIZ /%PIRLT/] ; 4.8
[ASCIZ /%PIRUN/] ; 4.7
[ASCIZ /[4.6]/] ; 4.6
[ASCIZ /[4.5]/] ; 4.5
[ASCIZ /%PIDCL/] ; 4.4
[ASCIZ /%PIATY/] ; 4.3
[ASCIZ /%PITTY/] ; 4.2
[ASCIZ /%PIPAR/] ; 4.1
[ASCIZ /%PIFOV/] ; 3.9
[ASCIZ /%PIWRO/] ; 3.8
[ASCIZ /%PIFET/] ; 3.7
[ASCIZ /%PITRP/] ; 3.6
[ASCIZ /[3.5]/] ; 3.5
[ASCIZ /[3.4]/] ; 3.4
[ASCIZ /[3.3]/] ; 3.3
[ASCIZ /%PIDBG/] ; 3.2
[ASCIZ /%PILOS/] ; 3.1
[ASCIZ /%PICLI/] ; 2.9
[ASCIZ /%PIPDL/] ; 2.8
[ASCIZ /%PILTP/] ; 2.7
[ASCIZ /%PIMAR/] ; 2.6
[ASCIZ /%PIMPV/] ; 2.5
[ASCIZ /%PICLK/] ; 2.4
[ASCIZ /%PI1PR/] ; 2.3
[ASCIZ /%PIBRK/] ; 2.2
[ASCIZ /%PIOOB/] ; 2.1
[ASCIZ \%PIIOC\] ; 1.9
[ASCIZ /%PIVAL/] ; 1.8
[ASCIZ /%PIDWN/] ; 1.7
[ASCIZ /%PIILO/] ; 1.6
[ASCIZ /%PIDIS/] ; 1.5
[ASCIZ /%PIARO/] ; 1.4
[ASCIZ /%PIB42/] ; 1.3
[ASCIZ /%PIC.Z/] ; 1.2
[ASCIZ /%PITYI/] ; 1.1
SUBTTL Mail routines
; SEND THE RIGHT MAIL TO ALL THE RIGHT PEOPLE.
SNDMAL: MOVEM P,SNDSAV ; TO ALLOW RECOVERY FROM IOC ERRORS
JUMPE A,GETNAM ; IF NO NAME PROVIDED, SEARCH FOR IT.
SNDML1: PUSH P,[SIXBIT /MAIL/] ; NAME TWO
PUSH P,A ; NAME ONE
PUSH P,A ; SNAME
MOVEM A,NAMSAV
PUSHJ P,APTOFI ; GET TO END OF MAIL FILE
POPJ P,
SOUT DSKO,[
From GUNNER ]
HRLZ A,GUNVER
SKIPN A
MOVE A,GUNVER
PUSHJ P,SXPRNT ; INCLUDE OUR VERSION NUMBER
.IOT DSKO,[" ]
PUSHJ P,DTPRNT
SOUT DSKO,[
]
MOVE A,LUNAME
PUSHJ P,SXPRNT
.IOT DSKO,[" ]
MOVE A,LJNAME
PUSHJ P,SXPRNT
SKIPE LEFT ; DEMON CHOMPED?
JRST OBIT
SKIPE OVERTI ; COMBAT RAN OVERTIME?
JRST [SOUT DSKO,[ ran two hours.]
JRST SNDFAT]
SOUT DSKO,[ died.]
SKIPE ERRFLG
JRST [SOUT DSKO,[
ERROR called]
MOVE B,VALLEN
JRST VALPRT]
SKIPG B,VALLEN
JRST NOVAL
SKIPE INTFLG
JRST [SOUT DSKO,[
UPC ]
JRST VALFIN]
SKIPE LOSFLG ; SKIP IF NOT .LOSE
JRST [SOUT DSKO,[
.LOSE with UPC ]
JRST VALFIN]
SOUT DSKO,[
.VALUE with UPC ]
VALFIN: MOVE A,BADUPC
PUSHJ P,OCPRNT
VALPRT: SOUT DSKO,[:
]
MOVE A,[440700,,VALBUF]
.CALL [SETZ
SIXBIT /SIOT/
MOVEI DSKO
A
SETZ B]
JSR LOSE
SOUT DSKO,[
]
JRST SNDFAT
NOVAL: SOUT DSKO,[
PC was ]
MOVE A,BADUPC
PUSHJ P,OCPRNT
SNDFAT: SKIPE GUNNED
JRST [SOUT DSKO,[
]
JRST COMCHK]
SOUT DSKO,[ Disowned as ]
MOVE A,DUNAME
PUSHJ P,SXPRNT
.IOT DSKO,[" ]
MOVE A,DJNAME
PUSHJ P,SXPRNT
SOUT DSKO,[.
]
SKIPN A,LOKKIL
JRST CKBAT
PUSHJ P,DCPRNT
SOUT DSKO,[ lock]
MOVE A,LOKKIL
CAIE A,1
.IOT DSKO,["s]
SOUT DSKO,[ unlocked.
]
CKBAT: SKIPN A,CHNKIL
JRST CKBAT1
PUSHJ P,DCPRNT
SOUT DSKO,[ channel]
MOVE A,CHNKIL
CAIE A,1
.IOT DSKO,["s]
SOUT DSKO,[ closed.
]
CKBAT1: SKIPN BATCH
JRST COMCHK
SKIPN A,INFKIL
JRST SNDDON
PUSHJ P,DCPRNT
SOUT DSKO,[ inferior]
MOVE A,INFKIL
CAIE A,1
.IOT DSKO,["s]
SOUT DSKO,[ killed.
]
JRST SNDDON
COMCHK: SKIPN COMBAT
JRST SNDDON
SKIPN A,FN1
JRST SNDDON
PUSHJ P,SXPRNT
.IOT DSKO,[" ]
MOVE A,FN2
PUSHJ P,SXPRNT
SOUT DSKO,[ renamed to ]
MOVE A,[SIXBIT /GUNNED/]
PUSHJ P,SXPRNT
.IOT DSKO,[" ]
MOVE A,RFN2
PUSHJ P,SXPRNT
SOUT DSKO,[.
]
SNDDON: .IOT DSKO,[^_]
.CLOSE DSKO,
; SEND ON CLI DEVICE IF GUY IS AROUND
MOVEI A,DSKO
MOVE B,NAMSAV
MOVE C,[SIXBIT /HACTRN/]
PUSHJ P,CLIOPE
JRST NOCLI
PUSHJ P,DTPRNT ; PRINT DATE
SOUT DSKO,[--]
MOVE A,LUNAME
PUSHJ P,SXPRNT
SOUT DSKO,[ ]
MOVE A,LJNAME
PUSHJ P,SXPRNT
SOUT DSKO,[ just died. See your mail file for details.
]
.CLOSE DSKO,
NOCLI: SKIPN SNDTWO
JRST [SETOM SNDTWO ; SEND MAIL TO TAA
MOVE A,[SIXBIT /TAA/]
JRST SNDML1]
SKIPN COMBAT
JRST SNDPPJ
SKIPN A,LOSER
JRST SNDPPJ
SETZM LOSER
JRST SNDML1
SNDPPJ: SETZM SNDSAV
POPJ P,
; GENERATE MESSAGE FOR REALLY DEAD DEMON
OBIT: PUSH P,A
PUSH P,B
PUSH P,C
SOUT DSKO,[ lost completely. Disowned as ]
MOVE A,DUNAME
PUSHJ P,SXPRNT
.IOT DSKO,[" ]
MOVE A,DJNAME
PUSHJ P,SXPRNT
.IOT DSKO,[".]
SOUT DSKO,[
Losing times and pc's were:
]
MOVEI C,DATST(LOSTBL)
MOVE B,LOSCT(LOSTBL)
LPLOOP: MOVE A,LOSTM(C)
PUSHJ P,DTPRN1 ; ENTRY TO DTPRNT FOR ARGUMENT
SOUT DSKO,[, ]
MOVE A,LOSPC(C)
PUSHJ P,OCPRNT
SOUT DSKO,[
]
SOJLE B,LPDONE
ADDI C,DATLEN
JRST LPLOOP
LPDONE: POP P,C
POP P,B
POP P,A
JRST SNDDON
; FIND SOMEONE TO SEND TO
GETNAM: PUSH P,B
MOVE B,OWNPTR
GETNLP: CAMN DEM,(B)
JRST [MOVE A,1(B)
POP P,B
JRST SNDML1]
ADD B,[2,,2]
JUMPL B,GETNLP
MOVE A,[SIXBIT /SWG/]
POP P,B
JRST SNDML1
; UTILITIES FOR WRITING FILE: APPEND TO FILE, DATE PRINTER, SIXBIT PRINTER,
; NUMBER PRINTERS.
; PRINT SUPPLIED DATE ON DSKO
DTPRN1: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
MOVE B,A
JRST DTPRN2
; PRINT DATE ON DSKO
DTPRNT: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
.CALL [SETZ ; GET DATE
SIXBIT /RQDATE/
SETZM B]
JSR LOSE
DTPRN2: HRRZ C,B
IDIVI C,7200. ; HOURS SINCE MIDNIGHT IN C
MOVE A,C
CAIG A,9.
.IOT DSKO,["0]
PUSHJ P,DCPRNT
.IOT DSKO,[":]
MOVE C,D
IDIVI C,120. ; MINUTES SINCE BEGINNING OF HOUR
MOVE A,C
CAIG A,9.
.IOT DSKO,["0]
PUSHJ P,DCPRNT
.IOT DSKO,[":]
ASH D,-1
MOVE A,D
CAIG A,9.
.IOT DSKO,["0]
PUSHJ P,DCPRNT
.IOT DSKO,[" ]
LDB A,[270400,,B] ; MONTH
PUSHJ P,DCPRNT
.IOT DSKO,["/]
LDB A,[220500,,B]
PUSHJ P,DCPRNT ; DAY
.IOT DSKO,["/]
LDB A,[330700,,B]
PUSHJ P,DCPRNT
POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
POPJ P,
; SIXBIT IS IN A. PRINT IT.
SXPRNT: PUSH P,B
PUSH P,C
MOVE C,[440600,,A]
SXPLOP: ILDB B,C
JUMPE B,SXPOUT
ADDI B,40
.IOT DSKO,B
TLNE C,770000
JRST SXPLOP
SXPOUT: POP P,C
POP P,B
POPJ P,
; OCTAL STUFF IS IN A.
OCPRNT: PUSH P,B
PUSH P,C
TLNE A,777777
JRST OCPRN1
MOVE C,OCTTAB
JRST DCPLP1
OCPRN1: MOVE B,A
HLRZ A,B
PUSHJ P,OCPRNT
SOUT DSKO,[,,]
HRRZ A,B
PUSHJ P,OCPRNT
POP P,C
POP P,B
POPJ P,
; DECIMAL STUFF IS IN A.
DCPRNT: PUSH P,B
PUSH P,C
MOVE C,POWTAB
DCPLP1: IDIV A,(C)
JUMPE A,[MOVE A,B
AOBJN C,DCPLP1
.IOT DSKO,["0]
JRST DCPOUT]
DCPLP2: ADDI A,"0
.IOT DSKO,A
AOBJN C,[MOVE A,B
IDIV A,(C)
JRST DCPLP2]
DCPOUT: POP P,C
POP P,B
POPJ P,
PT: 10000000000. ? 1000000000.
100000000. ? 10000000.
1000000. ? 100000. ? 10000. ? 1000. ? 100. ? 10. ? 1.
OT: 1000000 ? 100000 ? 10000 ? 1000 ? 100 ? 10 ? 1
OCTTAB: OT-.,,OT
IMPURE
POWTAB: PT-OT,,PT
PURE
; OPEN <FOO>;<BAR> <BLETCH>, WHERE ARGS ARE (P), -1(P), -2(P).
; SKIPS IF SUCCESSFUL.
APTOFI: PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
MOVNI B,2
MOVEM B,APCNT
APTOF1: .CALL [SETZ
SIXBIT /OPEN/
[.BII,,DSKI]
[SIXBIT /DSK/]
MOVE -6(P)
MOVE -7(P)
MOVE -5(P)
SETZB B]
JRST APERCK
.CALL [SETZ
SIXBIT /FILLEN/
MOVEI DSKI
SETZM C]
JSR LOSE
JUMPE C,APREOP
SUBI C,2
.ACCESS DSKI,C
MOVE B,[-2,,RNDBLK]
.IOT DSKI,B
MOVE B,[440700,,RNDBLK]
MOVEI E,0
ENDLOP: ILDB D,B
JUMPE D,APREOP
CAIN D,^C
JRST APREOP
AOJA E,ENDLOP
APREOP: .CLOSE DSKI,
.CALL [SETZ
SIXBIT /OPEN/
[.UAO+100000,,DSKO]
[SIXBIT /DSK/]
MOVE -6(P)
MOVE -7(P)
MOVE -5(P)
SETZB B]
JRST IMGFLD
JUMPE C,APDONE
IMULI C,5
ADDI C,(E)
.ACCESS DSKO,C
APWON: AOS -4(P) ; WON, SO SKIP
APDONE: POP P,E
POP P,D
POP P,C
POP P,B
POP P,A
SUB P,[3,,3]
JRST (A)
; COME HERE IF FIRST OPEN FAILED. CODE IS IN B.
APERCK: CAIE B,%ENSFL ; FILE NOT FOUND?
JRST APDONE ; NO, SO CHOMP IMMEDIATE.
.CALL [SETZ
SIXBIT /OPEN/
[.UAO,,DSKO]
[SIXBIT /DSK/]
MOVE -6(P)
MOVE -7(P)
MOVE -5(P)
SETZB B]
JRST APDONE
JRST APWON
; COME HERE IF OPEN FOR WRITE-OVER FAILED.
IMGFLD: AOSLE APCNT ; WE'RE ONLY ALLOWED TO TRY TWICE
JRST APDONE ; OH, WELL
MOVEI B,10.*30.
.SLEEP B,
JRST APTOF1 ; AND TRY AGAIN.
; OPEN CHOMPER ON CLI DEVICE. CHANNEL IN A, UNAME IN B, JNAME IN C. SKIP
; IF SUCCESSFUL
CLIOPE: .CALL [SETZ
SIXBIT /OPEN/
[.BII+10,,USRI]
[SIXBIT /USR/]
MOVE B
SETZ C]
POPJ P,
PUSH P,D
.USET USRI,[.RMASK,,D]
.CLOSE USRI,
TRNN D,%PICLI
JRST CLIOPO
.CALL [SETZ
SIXBIT /OPEN/
MOVSI .UAO
MOVE A
[SIXBIT /CLI/]
MOVE B
SETZ C]
JRST CLIOPO
AOS -1(P)
CLIOPO: POP P,D
POPJ P,
SUBTTL Zork garbage collector
; FIND DISOWNED ZORKS; WHEN THEY'VE BEEN AROUND AWHILE (10-15 MIN.), GUN THEM
; DOWN. BUILD TABLE: EACH ENTRY CONTAINS UNAME, JNAME, USER INDEX. SCAN
; THE TABLE, AND GUN DOWN ANY EXISTING JOBS FOUND IN IT; THEN BUILD A NEW
; ONE.
ZKTENT==3
ZKTLEN==ZKTENT*10.
IMPURE
ZKTAB: BLOCK ZKTLEN
PURE
ZKUNM==0
ZKJNM==1
ZKUIND==2
ZTSCAN: MOVE A,[-ZKTLEN,,ZKTAB]
ZTSLOP: SKIPG U,ZKUIND(A)
JRST ZTSCN
SKIPL @APRC ; STILL DISOWNED?
JRST ZTLEND
MOVE B,ZKUNM(A)
CAME B,@UNAME ; UNAME SAME?
JRST ZTLEND
MOVE B,ZKJNM(A)
CAME B,@JNAME ; JNAME SAME?
JRST ZTLEND
ZTSUPR: SKIPGE B,@SUPPRO ; PICK UP SUPERIOR
JRST ZKFLUS ; AIN'T ONE
HRRZS B ; CLEAR LH
MOVE U,B
JRST ZTSUPR ; FIND SUPERIOR OF SUPERIOR
ZKFLUS: MOVE B,U
IDIV B,L
SKIPL @APRC ; GUNNING ISN'T TO BE DONE LIGHTLY
JRST ZTLEND
.GUN B,
JFCL
MOVE C,ZKUNM(A)
MOVE D,ZKJNM(A)
MOVE E,[-2,,C]
LOG E,[ASCIZ /logged out./]
ZTLEND: ADD A,[ZKTENT,,ZKTENT]
JUMPL A,ZTSLOP
ZTSCN: SETZM ZKTAB
MOVE A,[ZKTAB,,ZKTAB+1]
BLT A,ZKTAB+ZKTLEN-1 ; ZERO TABLE
MOVE C,[-ZKTLEN,,ZKTAB] ; POINTER TO TABLE
MOVE U,MSENTS ; SOME SORT OF MAX
ZTSLP: SOJL U,ZTSDON ; ALL DONE?
SKIPG B,@MSUSER ; GET USER INDEX
JRST ZTSLP ; NOT THIS ONE
MOVE A,@MSRED2
CAME A,[SIXBIT /ZORK/]
JRST ZTSLP
EXCH B,U
SKIPL @APRC ; DISOWNED?
JRST [EXCH B,U
JRST ZTSLP]
MOVE A,@UNAME
MOVEM A,ZKUNM(C)
MOVE A,@JNAME
MOVEM A,ZKJNM(C)
MOVEM U,ZKUIND(C)
EXCH B,U ; RESTORE B,U
ADD C,[ZKTENT,,ZKTENT] ; UPDATE TABLE POINTER
JUMPL C,ZTSLP ; GO TO NEXT
ZTSDON: POPJ P, ; FINISHED SCAN, SO RETURN
; RUN AT 9 AM OF WORKDAYS--LOOKS FOR ZORKS (BY SCANNING THE
; MSP TABLES), TELLS OWNERS IT'S TIME TO THINK ABOUT GOING AWAY.
ZKCLN: .CALL [SETZ
SIXBIT /RQDATE/
SETZM A]
JSR LOSE
HRRZS A
CAIL A,<8.*60.+30.>*120. ; BEFORE 0830?
CAIL A,<19.*60.+30.>*120. ; NOT AFTER 1930?
JRST [LOG [ASCIZ /Why am I running now?/]
POPJ P,]
PUSHJ P,HOLIDA ; SKIP IF HOLIDAY OR WEEKEND
CAIA
POPJ P, ; UNINTERESTING
PUSHJ P,ZKSCAN
PUSHJ P,ZKCSND ; ARGUMENT TO ZKSCAN
POPJ P,
; USER INDEX OF TOP-LEVEL JOB IS IN U
ZKCSND: PUSH P,D
PUSH P,E
PUSH P,F
PUSH P,A
MOVE D,@UNAME
MOVE E,@JNAME
MOVE F,[-2,,D] ; FOR LOGGER
MOVE A,@MSKST ; INTERRUPT WORD
TRNN A,%PICLI ; LISTENING?
JRST ZKSFAL
.CALL [SETZ
SIXBIT /OPEN/
[.UAO,,CLIO]
[SIXBIT /CLI/]
MOVE D
SETZ E]
JRST ZKSFAL ; OH WELL
.CALL [SETZ
SIXBIT /OPEN/
[.BII,,DSKI]
[SIXBIT /DSK/]
[SIXBIT /.FILE./]
[SIXBIT /(DIR)/]
SETZ @XUNAME]
JRST ZKCNOD
.CLOSE DSKI,
SOUT CLIO,[The working day is starting. Please finish your zorking soon, so
you won't interfere with other users. Thank you.]
JRST ZKCSDN
ZKCNOD: SOUT CLIO,[The working day is starting. Please conclude your game within the
next ten minutes, so you won't interfere with the system's regular
users. If you are still here in ten minutes, you will not still be
here in eleven. Thank you.]
ZKCSDN: .CLOSE CLIO,
LOG F,[ASCIZ /told to flush./]
ZKCDON: POP P,A
POP P,F
POP P,E
POP P,D
POPJ P,
ZKSFAL: LOG F,[ASCIZ /wasn't listening./]
JRST ZKCDON
; SCAN FOR ZORKS, EXECUTING SUPPLIED INSTRUCTION ON EACH ONE FOUND
ZKSCAN: PUSH P,A
PUSH P,B
MOVE U,MSENTS ; MAX # OF MSP USERS
ZKSLOP: SOJL U,ZKSDON
SKIPG B,@MSUSER ; USER INDEX-->B
JRST ZKSLOP
MOVE A,@MSRED2
CAME A,[SIXBIT /ZORK/]
JRST ZKSLOP
EXCH B,U ; GOT ONE
ZKSPLP: SKIPGE A,@SUPPRO ; SUPERIOR?
JRST ZKSFND ; NOPE
HRRZ U,A ; TRY FOR SUPERIOR OF THE SUPERIOR
JRST ZKSPLP
ZKSFND: XCT @-2(P) ; EXECUTE THE SUPPLIED INSTRUCTION
EXCH B,U ; RESTORE MSENTS TO U
JRST ZKSLOP
ZKSDON: POP P,B
POP P,A
AOS (P)
POPJ P,
; RUN AT 9:10--FLUSH ZORKS REMAINING AFTER WARNING (IF NOT LOGGED IN TO
; DIRECTORY)
ZKFLS: PUSHJ P,HOLIDA
CAIA
POPJ P,
PUSHJ P,ZKSCAN
PUSHJ P,ZKGUN
POPJ P,
ZKGUN: .CALL [SETZ
SIXBIT /OPEN/
[.BII,,DSKI]
[SIXBIT /DSK/]
[SIXBIT /.FILE./]
[SIXBIT /(DIR)/]
SETZ @XUNAME] ; SEE IF LOGGED IN TO DIRECTORY
JRST ZKGUND ; NO
.CLOSE DSKI,
POPJ P,
ZKGUND: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
MOVE A,U
IDIV A,L
MOVE B,@UNAME
MOVE C,@JNAME
MOVE D,[-2,,B]
.GUN A,
JRST [LOG D,[ASCIZ /vanished./]
JRST ZKGUNO]
LOG D,[ASCIZ /logged out./]
ZKGUNO: POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
SUBTTL Initialization
; SET UP FOR DEBUGGING--STOP GUNNER IF UP; KEEP IT FROM COMING UP IF
; NOT
DEBUG: .CALL [SETZ
SIXBIT /OPEN/
[.BIO,,CLIO]
[SIXBIT /CLI/]
[SIXBIT /GUNNER/]
SETZ [SIXBIT /GUNNER/]]
POPJ P,
MOVE A,[-3,,DEBUGB]
.IOT CLIO,A
.CLOSE CLIO,
CPOPJ: POPJ P,
DEBUGB: SIXBIT /\\\\\\/ ? -1 ? -2
; SKIP IF THIS IS A WEEKEND OR HOLIDAY
HOLID1: PUSH P,A
JRST HOLCHK
HOLIDA: PUSH P,A
.RYEAR A,
LDB A,[320300,,A] ; GET DAY OF WEEK
JUMPE A,WEKEND
CAIN A,6
JRST WEKEND
HOLCHK: .RDATE A,
.CALL [SETZ
SIXBIT /OPEN/
[.BII,,DSKI]
[SIXBIT /DSK/]
[SIXBIT /HLIDAY/]
A
SETZ [SIXBIT /COMBAT/]]
JRST NORMAL
.CLOSE DSKI,
WEKEND: AOS -1(P)
NORMAL: POP P,A
POPJ P,
; MAP IN SYSTEM, EVAL SYMBOLS, PDUMP.
; THERE ARE CURRENTLY THREE CLASSES OF SYMBOLS:
; THE FIRST, USER VARIABLES, ARE SAVED WITH U IN THE LEFT HALF; WE INDIRECT
; THROUGH THEM TO PICK UP THE CURRENT JOB'S VARIABLES. 400000 IS ADDED TO
; THESE
; MEMBERS OF THE SECOND GROUP ARE SPECIAL (DEMON TABLE STUFF)
; MEMBERS OF THE THIRD GROUP AREN'T AFFECTED BY WHERE THE SYSTEM IS MAPPED
; IN: L, PRIMARILY.
IMPURE
PUREQ: 0
PURE
INIT: MOVEM A,SYSVER
SKIPE PUREQ
JRST INIT1
MOVEI B,<<PURBEG+1777>_-12>-<<IMPEND+1777>_-12>
JUMPE B,INIPUR
JUMPL B,[.VALUE]
HRLOI B,-1(B)
EQVI B,<IMPEND+1777>_-12 ; AOBJN POINTER TO PAGES TO FLUSH
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI 0
MOVEI %JSELF
SETZ B]
JFCL
INIPUR: HRLOI A,<<<PUREND+1777>_-12>-<<PURBEG+1777>_-12>>-1
EQVI A,<PURBEG+1777>_-12
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBNDR
MOVEI %JSELF
A
SETZI %JSELF]
.LOSE %LSSYS
SETOM PUREQ
INIT1: MOVE A,USRVAR
USRLOP: MOVE B,(A)
.EVAL B,
.VALUE
ADDI B,400000
HRLI B,U
MOVEM B,1(A)
ADD A,[2,,2]
JUMPL A,USRLOP
MOVE A,SYSLOC
SYSLOP: MOVE B,(A)
.EVAL B,
.VALUE
ADDI B,400000
MOVEM B,1(A)
ADD A,[2,,2]
JUMPL A,SYSLOP
MOVE A,SYSCON
SYSCLP: MOVE B,(A)
.EVAL B,
.VALUE
MOVEM B,1(A)
ADD A,[2,,2]
JUMPL A,SYSCLP
HRLS DMTLL ; MAKE DMTLL BE FOO,,FOO
MOVN A,DMLNG
HRLI A,(A)
HRR A,DMTTBL
MOVEM A,DEMTAB ; AOBJN POINTER TO DEMON TABLE
MOVE A,TNTVAR
TNTLOP: MOVE B,(A)
.EVAL B,
.VALUE
ADDI B,400000
HRLI B,A
MOVEM B,1(A)
ADD A,[2,,2]
JUMPL A,TNTLOP
MOVE A,[-SYSLEN,,SYSPAG]
MOVEI B,0
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBRED
MOVEI %JSELF
A
MOVEI %JSABS
SETZ B]
.LOSE 1000
SKIPE DEBUGF
POPJ P, ; DON'T DUMP IF DEBUGGING
.CALL [SETZ
SIXBIT /OPEN/
[.UIO,,DSKO]
[SIXBIT /DSK/]
[SIXBIT /_GUNNE/]
[SIXBIT /DUMP/]
SETZ [SIXBIT /SYS/]]
POPJ P,
MOVEM P,SNDSAV
SETOM FILFLS ; SAYS DELETE FILE ON DSKO IF ERROR
MOVEI A,0
.CALL [SETZ
SIXBIT /PDUMP/
MOVEI %JSELF
MOVEI DSKO
SETZ A]
JRST INITLS
.IOT DSKO,[JUMPA START]
.IOT DSKO,[JUMPA START]
.CALL [SETZ
SIXBIT /SAUTH/
MOVEI DSKO
SETZ [SIXBIT /TAA/]]
JFCL
.CALL [SETZ
SIXBIT /RENMWO/
MOVEI DSKO
[SIXBIT /ATSIGN/]
SETZ [SIXBIT /GUNNER/]]
JRST INITLS
INITOT: .CLOSE DSKO,
SETZM SNDSAV
SETZM FILFLS
POPJ P,
INITLS: .CALL [SETZ
SIXBIT /DELEWO/
SETZI DSKO]
JFCL
JRST INITOT
; TABLES FOR EVAL
IMPURE
; GROUP 1: VALUE SAVED HAS U IN LH, 400000 ADDED.
USRTAB: SQUOZE 0,APRC
APRC: 0
SQUOZE 0,USTP
USTP: 0
SQUOZE 0,UNAME
UNAME: 0
SQUOZE 0,XUNAME
XUNAME: 0
SQUOZE 0,XJNAME
XJNAME: 0
SQUOZE 0,JNAME
JNAME: 0
SQUOZE 0,UTRNTM ; RUN TIME
UTRNTM: 0
SQUOZE 0,FLSINS
FLSINS: 0
SQUOZE 0,LSUUO
LSUUO: 0 ; LAST UUO EXECUTED
SQUOZE 0,UPC
UPC: 0
SQUOZE 0,RTIMER
RTIMER: 0
SQUOZE 0,SV40
SV40: 0
SQUOZE 0,OPTION
OPTION: 0
SQUOZE 0,SUUOH
SUUOH: 0
SQUOZE 0,40ADDR
40ADDR: 0
SQUOZE 0,VALUE
VAL: 0 ; USED FOR .LOSE HACKING
SQUOZE 0,UUOACS ; USER ACS
UUOACS: 0
SQUOZE 0,IOCHNM ; JOB'S CHANNELS
IOCHNM: 0
SQUOZE 0,LSCALL ; NAME OF LAST .CALL EXECUTED
LSCALL: 0
SQUOZE 0,PIRQC
PIRQC: 0
SQUOZE 0,IDF1
IDF1: 0
SQUOZE 0,MSUSER
MSUSER: 0 ; IPC ENTRIES FOR ZORK SCAN
SQUOZE 0,MSRED2
MSRED2: 0 ; JNAME LISTENING UNDER
SQUOZE 0,SUPPRO
SUPPRO: 0 ; SUPERIOR PROCESS
SQUOZE 0,MSKST ; .MASK
MSKST: 0
SQUOZE 0,UTMPTR
UTMPTR: 0 ; DECIDE IF SYSTEM JOB OR NOT
USRVAR: USRTAB-.,,USRTAB
; GROUP 2: VALUE SAVED HAS 400000 ADDED. ABSOLUTE LOCATIONS IN SYSTEM
SYSTAB: SQUOZE 0,DMTTBL
DMTTBL: 0
SQUOZE 0,MMMPG
MMMPG: 0 ; TABLE OF MMP PAGES
SQUOZE 0,MMPMX
MMPMX: 0 ; # OF MMP ENTRIES IN USE
SQUOZE 0,MEMPNT
MEMPNT: 0
SQUOZE 0,TIME
TIME: 0
SQUOZE 0,USRHI
USRHI: 0
SQUOZE 0,IMPUP
IMPUP: 0
SQUOZE 0,LOSRCE
LOSRCE: 0
SQUOZE 0,IDLRCE
IDLRCE: 0
SQUOZE 0,SLOADU
SLOADU: 0
SQUOZE 0,SUSRS
SUSRS: 0
SQUOZE 0,QIRRCV
QIRRCV: 0 ; # IRRECOVS
SQUOZE 0,PARERR
PARERR: 0
SYSLOC: SYSTAB-.,,SYSTAB
; GROUP 3: LOCATION-INDEPENDENT VALUES
SYSCTB: SQUOZE 0,L
L: 0
SQUOZE 0,DMLNG
DMLNG: 0
SQUOZE 0,DMTLL
DMTLL: 0
SQUOZE 0,USTP
USTP1: 0 ; UNMODIFIED VALUE, FOR DOING IFSETS
SQUOZE 0,NMMP
NMMP: 0 ; MAX # OF MMP PAGES
SQUOZE 0,MMPLOK
MMPLOK: 0 ; PAGE LOCKED IN CORE
SQUOZE 0,MMPSHR
MMPSHR: 0 ; PAGE SHARED WITH FILE
SQUOZE 0,MSENTS
MSENTS: 0 ; MAX # OF IPC USERS
SQUOZE 0,NCT ; # TTYS IN SYSTEM
NCT: 0
SQUOZE 0,NFSTTY
NFSTTY: 0 ; TTY # OF FIRST STY
SQUOZE 0,IMPSTL
IMPSTL: 0 ; # NET SOCKETS
SQUOZE 0,NETDUI
NETDUI: 0
SQUOZE 0,NETDBO
NETDBO: 0
SQUOZE 0,NSTTYS
NSTTYS: 0 ; # STYS IN SYSTEM
SQUOZE 0,USRRCE
USRRCE: 0
SYSCON: SYSCTB-.,,SYSCTB
DEMTAB: 0 ; AOBJN POINTER TO DEMON TABLE
; GROUP 4: INDEXED (A) RATHER THAN (U)
TNTABL: SQUOZE 0,TTYSTS
TTYSTS: 0 ; TTYSTS WORD
SQUOZE 0,TTITM
TTITM: 0 ; TIME CHARACTER WAS LAST TYPED ON TTY
SQUOZE 0,TTLTM ; TIME OF LAST OUTPUT TO TTY. USED BECAUSE
TTLTM: 0 ; TYPING ON FREE TTY SETS TTITM.
SQUOZE 0,TTYTYP
TTYTYP: 0 ; TTYTYPE WORD
SQUOZE 0,TTYOPT
TTYOPT: 0
SQUOZE 0,STYSTS
STYSTS: 0 ; STYSTS (WHO OWNS A STY?)
SQUOZE 0,IMSOC1
IMSOC1: 0 ; WHO OWNS A SOCKET?
SQUOZE 0,IMSOC4
IMSOC4: 0
SQUOZE 0,IMPHTN
IMPHTN: 0
TNTVAR: TNTABL-.,,TNTABL
PURE
REPEAT 0,[
SUBTTL Randomness
ADDRS: -3,,.+1
GPSPTR
-11,,F
GGPPTR
-11,,20
GBSPTR
-11,,32
GOT: 0
GOT1: 0
GOTCT: 0
IOFF=MAPBEG
GPSPTR=IOFF+5
GGPPTR=IOFF+17
GBSPTR=IOFF+500 ; KILL MORE OF PAGE
IDSPTR=IOFF+602
AMAZE=IOFF+665
UNMPTR=IOFF+1757
MSCAN: MOVN A,NMMP ; MAX # PAGES TO MAP
HRLS A
HRRI A,MMPPG ; PAGE WHERE MAPPING STARTS
MOVE B,MMMPG ; POINTER TO TABLE OF MMP PAGES
MMPLOP: SKIPN C,(B) ; PAGE HERE?
JRST MMPGOT ; NO, SO DONE
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBRED
MOVEI %JSELF
MOVEI (A)
MOVEI %JSABS
SETZ C]
JSR LOSE
AOBJP A,MMPGOT ; MAPPED MAX #?
AOJA B,MMPLOP ; NO, SO GO TO NEXT
MMPGOT: MOVN A,@MMPMX ; # ENTRIES IN USE
HRLS A
HRRI A,MMPADD ; AOBJN POINTER TO MMP
LOOP: SKIPL B,(A) ; SKIPS IF PUBLIC PAGE
JRST CHK2 ; NOT PUBLIC, SO CHECK FOR NEW-STYLE
TRNE B,200000 ; MEMPNT?
JRST MEMPHK ; MAYBE
LOOPC: LDB C,[1000,,B] ; PAGE #
LDB U,[101100,,B] ; JOB #
TRO U,400000 ; MAKE JOB SPEC
.CALL [SETZ
SIXBIT /CORTYP/
U
C
MOVEM B
MOVEM B
MOVEM B
SETZM B]
JRST LOOP1
TLZ B,-1
CAIG B,1
JRST LOOP1 ; NO SHARERS, SO UNINTERESTING
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBNDW
MOVEI %JSELF
MOVEI MAPPAG
U
SETZ C]
JRST LOOP1
; MOVE B,ADDRS
;TSTLUP: MOVE O,1(B)
; MOVE C,(B)
; CAME O,(C)
; JRST LOOP1
; AOS B
; AOBJN B,TSTLUP
GOTIT: PUSH P,A
MOVE D,[MMPADD,,GPSPTR]
BLT D,GBSPTR
GOTIT1: SETOM GOT
SETOM GOT1
AOS GOTCT
PUSH P,[SIXBIT /LOADED/]
PUSH P,[SIXBIT /_TTYS_/]
PUSH P,[SIXBIT /IMLAC/]
PUSHJ P,APTOFI
JRST [POP P,A
JRST LOOP1] ; OH, WELL
.RDATI A,
PUSHJ P,SXPRNT
.IOT DSKO,[" ]
MOVE A,B
PUSHJ P,SXPRNT
SOUT DSKO,[ I got: ]
SKIPN C,UNMPTR
MOVE C,IDSPTR
ADDI C,IOFF
UNMLUP: MOVE A,(C)
JUMPE A,UNMLU1
PUSHJ P,SXPRNT
.IOT DSKO,[" ]
UNMLU1: AOBJN C,UNMLUP
SOUT DSKO,[
]
.CLOSE DSKO,
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI 0
MOVEI %JSELF
SETZI MAPPAG]
JSR LOSE
POP P,A
JRST LOOP1
; CHECK HERE FOR NEW-STYLE. MMP ENTRY IS IN B, A IS PROBABLY SACRED.
CHK2: TSNN B,MMPLOK
JRST LOOP1 ; NOPE
TSNN B,MMPSHR
JRST LOOP1
HRRZS B
TRZN B,400000 ; MMP OR MEMPNT POINTER?
JRST CHK21
TRZ B,200000
MOVSI C,2200
HRR C,MEMPNT
ADDI C,(B)
LDB B,C
TRNE B,400000
JRST LOOP1
CHK21: LDB C,[1000,,B] ; PAGE #
LDB U,[101100,,B] ; JOB #
TRO U,400000
.CALL [SETZ
SIXBIT /CORTYP/
U
C
MOVEM D
MOVEM E
MOVEM F
SETZM G]
JSR LOSE
JUMPGE D,LOOP1 ; NOT R/W, SO FLUSH IMMEDIATE
HRRZS G
CAIG G,1
JRST LOOP1 ; NOT SHARED, SO FLUSH
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBNDR
MOVEI %JSELF
MOVEI MAPPAG
U
SETZ C] ; PICK IT UP
JRST LOOP1 ; OH, WELL
PUSHJ P,PGCHK
JRST LOOP1
LSH C,12
ADDI C,<GBSPTR-IOFF>
MOVE D,PGBLOK
PGLOOP: .CALL [SETZ
SIXBIT /USRMEM/
MOVSI 400000
U
C
SETZ (D)]
JRST LOOP1
AOBJP D,GOTIT1
AOJA C,PGLOOP
PGCHK: POPJ P, ; FOR NOW
PGWDS: ASCII /THANK/
ASCII /YOU, /
ASCII /RMS, /
ASCII /FOR /
ASCII /MAKIN/
ASCII /G THI/
ASCII /S ALL/
ASCII /POSSI/
ASCII /BLE./
REPEAT <GBSPTR-GPSPTR>-<.-PGWDS>,[
ASCII /MAZER/]
PGBLOK: PGWDS-.,,PGWDS
MEMPHK: TRZN B,400000 ; SKIP IF MMP OR MEMPNT
JRST LOOPC
TRZ B,200000
MOVSI C,2200
HRR C,MEMPNT
ADDI C,(B)
LDB B,C
TRNN B,400000
JRST LOOPC
LOOP1: ADD A,[2,,2]
JUMPL A,LOOP
MOVN A,NMMP
SUBI A,1
HRLS A
HRRI A,MAPPAG ; MMP AND MAP PAGE MUST BE NEXT DOOR
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI
MOVEI %JSELF
SETZ A]
JSR LOSE
MSCHED: SKIPE GOT
JRST [MOVEI A,<300.*30.> ; FIVE MINUTES
JRST MSCHE1]
SKIPE GOT1
JRST [SETZM GOT1 ; IF GOT ONE, SCHED FOR FIVE MIN AGAIN
MOVEI A,<300.*30.>
JRST MSCHE1]
.RTIME A,
CAMGE A,[SIXBIT /060000/]
JRST MNIGHT
CAMG A,[SIXBIT /210000/]
JRST MWEEKN
MNIGHT: MOVEI A,<1800.*30.> ; THIRTY MINUTES
JRST MSCHE1
MWEEKN: MOVEI A,<7200.*30.> ; TWO HOURS
MSCHE1: MOVEM A,INTRVL(PBLOCK) ; STUFF IT OUT
.CALL [SETZ
SIXBIT /OPEN/
[.BII,,DSKI]
[SIXBIT /DSK/]
[SIXBIT /_TECO_/]
[SIXBIT /OUTPUT/]
SETZ [SIXBIT /RWK/]]
POPJ P,
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBNDR+%CBNDW
MOVEI %JSELF
MOVEI MAPPAG
SETZI DSKI]
JRST [.CLOSE DSKI,
POPJ P,]
.CLOSE DSKI,
MOVE A,[SIXBIT /FOOBAR/]
MOVEM A,MAPBEG
MOVE A,[MAPBEG,,MAPBEG+1]
BLT A,MAPBEG+1777
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI 0
MOVEI %JSELF
SETZI MAPPAG]
POPJ P,
POPJ P,
] ; END OF REPEAT 0,
SUBTTL Interrupt handler
IMPURE
TSINT: 0
TSINTR: 0
JRST TSINTP
PURE
TSINTP: EXCH A,TSINT
JUMPL A,TSWRD2
TLNE A,%PJRUN ; RUN TIME INTERRUPT
JRST TSRUN
TLNE A,%PJWRO
JSR LOSE ; SIGH
TLNE A,%PJRLT
JRST TSRLT
TRNN A,%PIIOC ; IOC INTERRUPT?
JRST TSMPVQ
SKIPN SNDSAV ; WRITING TO DISK?
JRST LOGERR ; NO, SEE IF LOGGER CHOMPED
.DISMIS [.+1]
.CLOSE DSKI, ; FLUSH EVERYTHING
SKIPE FILFLS ; FILE NEEDS TO GO AWAY?
JRST [.CALL [SETZ
SIXBIT /DELEWO/
SETZI DSKO]
JFCL
JRST .+1]
.CLOSE DSKO,
MOVE P,SNDSAV
SETZM SNDSAV
SETZM FILFLS
EXCH A,TSINT
POPJ P,
LOGERR: SKIPN LOGPSV
JSR LOSE ; FATAL INTERRUPT
.DISMIS [.+1]
.CLOSE LOGCHN,
MOVE P,LOGPSV
SETZM LOGPSV
EXCH A,TSINT
JRST UUORET ; RETURN FROM THE UUO
IMPURE
LSTTIM: 0
PURE
TSRUN: PUSH P,A
PUSH P,B
PUSH P,C
.CALL [SETZ
SIXBIT /RQDATE/
SETZM A]
JFCL
HLRZ B,A
HLRZ C,LSTTIM
CAIN C,(B)
JSR LOSE ; USED LOTS OF TIME IN SAME DAY?
MOVEM A,LSTTIM
.SUSET [.SRTMR,,[120000000.]]
POP P,C
POP P,B
POP P,A
JRST TSOUT
TSMPVQ: TRNN A,%PIMPV
JRST TSSDWN
SKIPN MPVFLG
JSR LOSE ; MPV WHEN NOT PERMITTED
EXCH A,TSINT
.DISMIS [COMDON] ; FORGET IT
TSSDWN: TRNN A,%PIDWN
JRST TSCLI
.CALL [SETZ
SIXBIT /SSTATU/
SETZM A]
.VALUE
JUMPGE A,[SETOM GDOWN
JRST TSOUT] ; GOING DOWN, SO IGNORE
SKIPE GDOWN
JRST [SETZM GDOWN ; DON'T RUN IF IT WAS 5KILL->REVIVE
JRST TSOUT]
PUSHJ P,PRCINI ; RE-INITIALIZE IF RUN AT FIXED TIME
SETZM SLPTIM ; CAUSE EVERYTHING TO RUN
MOVE A,PPTR
TSSDW1: SKIPN PRCTIM(A)
SETZM NXTRUN(A) ; RUN IMMEDIATELY IF FIXED-INTERVAL
ADD A,[PLEN,,PLEN]
JUMPL A,TSSDW1
MOVE P,[-PDLLEN,,PDL] ; RE-INITIALIZE PDL
SETZM CURPRC
LOG [ASCIZ /system revived. Rescheduling./]
.DISMIS [MLOOP] ; RESTART
TSCLI: .CALL [SETZ
SIXBIT /OPEN/
[.BII,,CLAI]
[SIXBIT /CLA/]
[SIXBIT /GUNNER/]
SETZ [SIXBIT /GUNNER/]]
JRST TSOUT ; SCREW IT
MOVE A,[-CLIBLN,,CLIBUF]
.IOT CLAI,A
.CLOSE CLAI,
MOVE A,CLIBUF
CAME A,[SIXBIT /TAA/]
JRST TSOUT
MOVE A,CLIBUF+1
CAME A,[SIXBIT /GT/]
CAMN A,[SIXBIT /GUNNER/]
JRST TSCLIC
JRST TSOUT
TSCLIC: MOVE A,CLIBUF+2
CAME A,[SIXBIT /\\\\\\/]
JRST TSOUT
MOVE A,PPTR
SUB A,[PLEN,,0] ; MAKE THE TABLE LONGER
MOVEM A,PPTR
SETZM NXTRUN+CLIPRC ; RUN IMMEDIATELY
AOSE SLPALL ; ARE WE CURRENTLY RUNNING?
JRST WAKEUP
JRST TSOUT ; YES--JUST WAIT IT OUT
WAKEUP: EXCH A,TSINT
JUMPGE A,NOTSLP ; IF A WAS > 0, WE WEREN'T ASLEEP YET
MOVNS A
SUB A,@TIME ; HOW LONG DID WE HAVE LEFT TO SLEEP?
EXCH A,SLPTIM
SUBM A,SLPTIM ; MAKE SLPTIM ACCURATE
.DISMIS [SLPCON] ; GO RUN
NOTSLP: SETZM SLPTIM
.DISMIS [SLPCON]
TSWRD2: TLNN A,377 ; INFERIOR INTERRUPT
JRST TSCHAN
.USET USRO,[.RPIRQC,,A]
TRNN A,%PIBRK
JRST [TDNN A,[%PIWRO+%PIPAR+%PIMPV+%PIILO]
JSR LOSE ; I DON'T UNDERSTAND
JRST TSMPVQ] ; IF INFERIOR GOT THIS, UNLOCK CHECK
SETZM INFRUN
TSOUT: EXCH A,TSINT
.DISMIS TSINTR
TSCHAN: TRNN A,1_USRHNG ; INTERRUPT ON USRHNG CHANNEL?
JRST TSFOR
SETZM CLHUNG
MOVE A,PPTR
TSCHLP: SETZM FLSOP(A) ; UNHANG ALL PROCESSES
ADD A,[PLEN,,PLEN]
JUMPL A,TSCHLP
JRST TSOUT
TSFOR: SKIPN CHKFOR ; DOES ANYBODY CARE?
JRST TSOUT
TRNN A,1_USRI
JRST TSOUT
EXCH A,TSINT
.DISMIS CHKFOR
; REAL-TIME INTERRUPT HANDLER. TRY TO KEEP IDLSRV FROM HANGING UP.
IMPURE
IDLTTY: -1
LSTTTY: -1
PURE
TSRLT: PUSH P,A
PUSH P,B
SKIPGE A,IDLTTY ; <0 --> NOT IN IDLSRV
JRST [MOVE B,[400000,,[0 ? 0 ? 0 ? 0]]
.REALT B, ; FLUSH INTERRUPT
JFCL
JRST TSRLTO]
CAME A,LSTTTY ; STILL ON THE SAME ONE?
JRST TSRLTO ; NO, SO WINNING
HLRZ B,@TSINTR ; PICK UP INSTRUCTION
CAIE B,(.CALL)
JRST TSRLTO
HRRZ B,@TSINTR
MOVE B,1(B)
CAME B,[SIXBIT /SIOT/]
JRST TSRLTO
SKIPL TTYLOK(A)
JRST TSRLFL ; ALREADY FLUSHED, SO DON'T LOG
PUSH P,C
MOVE B,A
IDIVI B,10
ADDI B,20
LSH B,6
ADDI C,20
IOR B,C
LSH B,30
MOVE C,[-1,,B]
LOG C,[ASCIZ /TTY flushed./]
POP P,C
SETOM TTYLOK(A) ; FLUSH THE LOSER
TSRLFL: AOS TSINTR
AOS TSINTR
TSRLTO: MOVEM A,LSTTTY
POP P,B
POP P,A
JRST TSOUT
SUBTTL Lossage handler
; JSR HERE WHEN FATAL HAPPENS. WILL SAVE THINGS AWAY, CHANGE JNAME, AND
; START UP A NEW ONE.
IMPURE
LOSSUP: 0
BADCHN: 0
BADERR: 0
LOSE: 0
JRST LOSEP
PURE
LOSEP: .SUSET [.RBCHN,,BADCHN]
.CALL [SETZ
SIXBIT /STATUS/
MOVE BADCHN
SETZM BADERR] ; TRY TO GET LAST ERROR
JFCL
.SUSET [.RSUPPR,,LOSSUP]
SKIPL LOSSUP
.VALUE ; LOSING WITH SUPERIOR
.SUSET [.SJNAME,,[SIXBIT /GUNNED/]]
.CALL [SETZ
SIXBIT /STDMST/
[SIXBIT /GUNNER/]
[-1]
SETZI 1]
.LOSE %LSSYS
.CALL [SETZ
SIXBIT /DEMSIG/
[SIXBIT /GUNNER/]
SETZI 0]
.LOSE %LSSYS
.VALUE
SUBTTL Autologout
;
; There are five classes of users:
; 1) Non-logged-in network users.
; 2) Logged-in network users: logged in, but not to a directory, from the
; net.
; 3) Local users: coming from a hardwired terminal, or logged into a
; directory from the net.
; 4) XXFILE and .BATCH: STYs in use by programs other than telnet
; servers.
; 5) HACTRNs: trees, either net or hardwired, with only a hactrn. They
; will be logged out, rather than detached.
; Class 4 is never touched: the program running it is assumed to do
; reasonable things.
; Associated with each of the other classes is a time: after a tree has
; been 'idle' (see below) for that period of time, some action is taken,
; depending on the class.
; 3: Local users will be detached, but bit 1.4 of the DETACH call will
; not be set; the tree will not be killed automatically.
; 2: Network users will be detached, with bit 1.4 of the DETACH call on.
; The tree will be killed after an hour (this bit is also set when,
; for example, the network dies and net users are detached).
; 1: Others will be gunned down.
;
; For classes 2 and 3, the idle time is determined by examining, first,
; the IDLTIM TTY variable--the time since a character was last typed on
; the controlling TTY. Since this would screw people who are PCOMPing or
; otherwise crunching (listing a long file on a hardcopy terminal, for
; example), we also examine time used by the tree. To make the procedure
; reasonably useful, time used by jobs such as WHOIML, WHOLIN, and VTTIME
; will be deducted before deciding whether anything is really running in
; the tree. A warning is given some time before detaching (5 minutes
; seems reasonable). I suspect that times for these classes would be at
; least two hours (possibly less for class 2). Local trees that aren't
; logged in might want to have a shorter lifetime.
; For class 1, there are two varieties of idleness. If a tree exists in
; this class for a sufficient period, it probably should be flushed with a
; warning; if such a tree is idle, for some lesser period, it should just
; go away.
; Note that it might be desirable, if resources are low, to reduce the
; times on classes 1 and 2 (resources are, in this case, available STYs
; and network sockets).
;
TUNAME==0 ; UNAME OF TOP-LEVEL JOB
TJNAME==1 ; JNAME
TUIND==2 ; SYSTEM INDEX
RUNTIM==3 ; TOTAL RUNTIME OF TREE, AS ADJUSTED
ORUNTI==4
ADJUST==5 ; ADJUST RUNTIME FOR WHOIML & SUCH (0 OR USER INDEX)
CLASS==6 ; 1-5
STATUS==7 ; USED BY CLASS HANDLERS
CRTIME==10 ; TIME THIS ENTRY WAS MADE
ENTSIZ==11
; USER CLASSES
$CHACT==6 ; HACTRN-ONLY
$CPROG==5 ; XXFILE & .BATCH
$CLOCL==4 ; "LOCAL" USER
$CNET==3 ; NET USER
$CNNLG==2 ; NET, NOT LOGGED IN
$CLNLG==1 ; LOCAL, NOT LOGGED IN
INITM==10. ; 10 MINUTES BEFORE WE NOTICE A TREE
PARMEN==2 ; # WORDS FOR EACH PARAMETER ENTRY
NTSHRT==0
NTLONG==PARMEN ; OFFSETS INTO 'BLOCKS' FOR NET USERS--CHOOSE ONE
IMPURE
TTYTAB: BLOCK 31 ; ONE WORD/TTY
JOBTAB: BLOCK 100 ; ONE WORD/JOB (FOR BUILDING JOB TREES)
; PARAMETERS FOR THIS CROCK. INITIALIZED FROM FILE TAA;GUNNER INIT (FOR NOW),
; WHICH CONTAINS BUNCHES OF DECIMAL NUMBERS, IN THE ORDER GIVEN HERE. IF THE
; FILE IS RECREATED, DAYPRC WILL CLOBBER THE CREATION SWITCH, AND ALOG WILL
; RE-INITIALIZE AFTER THAT.
PARMTB: <CPUFDG-SOCMIN>-1,,CPUFDG
PARMIN: 0 ; IF NON-ZERO, CREATION DATE OF INIT FILE.
INIDIR: SIXBIT /TAA/
INIFN1: SIXBIT /GUNNER/
INIFN2: SIXBIT /INIT/
CPUFDG: 125000. ; AMOUNT OF CPU TIME USED & STILL BE IDLE
1 ; (IN 4 MICROSECOND UNITS)
; ALLOWED IDLE TIMES
NLCTIM: 30.*60.*30. ; NOT LOGGED IN
1800.
LOCTIM: 90.*60.*30. ; 90 MINS FOR LOCAL USERS
1800.
; LOGGED-IN NET USERS
CHNLGD: 30.*60.*30.
1800.
60.*60.*30. ; 30 MINUTES IF SHORT ON RESOURCES, ELSE 60
1800.
; NON-LOGGED-IN NET USERS
CHNNLD: 15.*60.*30.
1800.
30.*60.*30.
1800.
; HACTRN-ONLY TREES
HACTIM: 30.*60.*30. ; 30 MINUTES, THEN LOGOUT
1800.
; MIN # OF STYS AND NET SOCKETS. IF LE THIS, USE SHORTER TIMES BEFORE
; FLUSHING NET USERS
STYMIN: 3 ; SINCE TWO CURRENTLY PATCHED OUT
1
SOCMIN: 3
1
PURE
ALOG: SKIPN PARMIN ; NEED TO INITIALIZE?
PUSHJ P,ALOGIN ; DO IT
PUSHJ P,TBUILD ; SET UP JOBTAB TO HAVE CURRENT TREE STRUCTURE
MOVE A,NCT ; TOTAL # TTYS
SUBI A,1
ALOGL: SKIPGE @TTYSTS ; SKIP IF TTY IS IN USE
JRST ALOGFL
HRRZ U,@TTYSTS ; USER INDEX-->U
MOVE B,@XUNAME
CAMN B,[SIXBIT /GSB/]
JRST ALOGFL
MOVE B,@TIME ; SYSTEM TIME
SUB B,@TTITM ; GET IDLE TIME
CAIG B,INITM*1800. ; MORE THAN INITM (10) MINUTES?
JRST ALOGFL ; FLUSH ENTRY, IF IT HAD ONE
PUSHJ P,MAKENT ; MAKE ENTRY/UPDATE OLD ONE (RETURN PTR IN B)
JRST ALOGEL ; MAKENT SKIPS IF OLD; ELSE DON'T CHECK CPU
MOVE C,RUNTIM(B) ; PICK UP MOST RECENT RUNTIME
SUB C,ORUNTI(B) ; GET INCREMENT
CAMLE C,CPUFDG ; PAST CUTOFF?
JRST [MOVE C,@TIME
MOVEM C,CRTIME(B)
SETZM STATUS(B)
JRST ALOGEL] ; YES. RESET CREATION TIME TO NOW.
MOVE C,CLASS(B)
XCT CLASSH(C) ; FROB FOR THIS CLASS
JRST ALOGFL ; IF NO SKIP, FLUSH ENTRY (LOGGED OUT)
ALOGEL: SOJGE A,ALOGL
POPJ P,
; FLUSH TTY ENTRY IF IT'S NO LONGER INTERESTING
ALOGFL: SKIPN B,TTYTAB(A)
JRST ALOGEL ; NO ENTRY
PUSHJ P,FREES ; FREE THE STORAGE
SETZM TTYTAB(A) ; ZERO THE POINTER
JRST ALOGEL
; MAKE STRUCTURE CONTAINING JOB TREES
TBUILD: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,U
SETOM JOBTAB
MOVE A,[JOBTAB,,JOBTAB+1]
BLT A,JOBTAB+100-1
MOVEI U,0
MOVEI A,0
TBLOOP: SKIPN @UNAME
JRST TBENDL ; THIS JOB DOESN'T EXIST
SKIPGE B,@SUPPRO ; GET ITS SUPERIOR
JRST TBENDL ; ISN'T ONE
HRRZS B
IDIV B,L ; MAKE INDEX
SKIPGE C,JOBTAB(B) ; DOES MY SUPERIOR ALREADY HAVE A POINTER?
JRST [MOVEM A,JOBTAB(B)
MOVEM B,JOBTAB(A) ; NO, MAKE US POINT TO EACH OTHER
JRST TBENDL]
MOVEM C,JOBTAB(A) ; YES--I GET HIS OLD POINTER
MOVEM A,JOBTAB(B) ; AND HE GETS ME
TBENDL: ADD U,L
CAMGE U,@USRHI ; DONE?
AOJA A,TBLOOP ; NO
POP P,U
POP P,C
POP P,B
POP P,A
POPJ P,
MAKENT: PUSH P,A
PUSH P,C
PUSH P,D
PUSH P,E
NEWENT: SKIPE B,TTYTAB(A) ; OLD ENTRY?
JRST MAKVAL ; VALIDATE
PUSHJ P,GETS ; GET STORAGE (IN B)
MOVEM B,TTYTAB(A) ; SAVE POINTER
PUSHJ P,GETTOP
MOVE C,@UNAME
MOVEM C,TUNAME(B)
MOVE C,@JNAME
MOVEM C,TJNAME(B)
MOVEM U,TUIND(B)
MOVE C,@TIME
MOVEM C,CRTIME(B) ; CURRENT TIME
MOVE C,U
IDIV C,L
SKIPGE U,JOBTAB(C)
JRST [MOVE U,TUIND(B)
JRST NEWCLS] ; NO INFERIORS
FUDLOP: MOVE E,U
IMUL U,L
MOVE D,@XJNAME
CAME D,[SIXBIT /WHOIML/]
CAMN D,[SIXBIT /WHOLIN/]
JRST DOFUDG
CAME D,[SIXBIT /P/]
CAMN D,[SIXBIT /VTTIME/]
JRST DOFUDG
CAME D,[SIXBIT /PEEK/]
CAMN D,[SIXBIT /OS/]
JRST DOFUDG
CAMN D,[SIXBIT /H19WHO/]
JRST DOFUDG
CAMN C,JOBTAB(E) ; BACK AROUND?
JRST DOFUD1 ; IF SO, DONE
MOVE U,JOBTAB(E)
JRST FUDLOP
DOFUDG: MOVEM U,ADJUST(B) ; SAVE AWAY INDEX
DOFUD1: MOVE U,C
IMUL U,L
NEWCLS: PUSHJ P,GCLASS ; FILL IN THE CLASS
JRST MAKINI ; DONE
; VALIDATE AN EXISTING ENTRY--MAKE SURE IT'S POINTING AT THE RIGHT
; TREE
MAKVAL: AOS -4(P) ; SKIP IF OLD ENTRY
PUSHJ P,GETTOP ; PUT IN U IDX OF TOP-LEVEL JOB ON TTY IN A
CAME U,TUIND(B) ; USER INDEX SAME?
JRST MAKVLL ; LOSE
MOVE D,TUNAME(B)
CAME D,@UNAME
JRST MAKVLL
MOVE C,TJNAME(B)
CAME C,@JNAME
JRST MAKVLL
SKIPN U,ADJUST(B) ; WHOIML-TYPE JOB?
JRST MAKINI
CAMN D,@UNAME ; SAME TREE?
JRST MAKINI
MAKVLL: PUSHJ P,FREES
SETZM TTYTAB(A)
JRST NEWENT ; MUST BE A NEW ONE
; FILL IN THE RUNTIME STUFF. ASSUMES TREE'S BLOCK IN B, U POINTS TO TOP-LEVEL
MAKINI: MOVE A,RUNTIM(B)
MOVEM A,ORUNTI(B)
MOVE U,TUIND(B)
MOVE C,U
IDIV C,L
MOVE A,@UTRNTM
SKIPGE D,JOBTAB(C) ; ANYTHING ELSE IN TREE?
JRST MAKIDN ; NO, DONE
MAKINL: MOVE U,D
IMUL U,L
CAME U,ADJUST(B) ; DON'T INCLUDE WHOIML ETC.
ADD A,@UTRNTM
CAMN C,JOBTAB(D) ; HAVE WE GONE AROUND THE LOOP?
JRST MAKIDN
MOVE D,JOBTAB(D) ; NO
JRST MAKINL
MAKIDN: MOVEM A,RUNTIM(B) ; GOT RUNTIME
MOVE U,TUIND(B) ; MAKE SURE THE USER INDEX IS IN U
POP P,E
POP P,D
POP P,C
POP P,A
POPJ P,
; GET (INTO U) INDEX OF TOP-LEVEL JOB IN TREE POINTED TO BY U.
GETTOP: PUSH P,A
GETTOL: SKIPG A,@SUPPRO
JRST GETTOT
HRRZ U,A
JRST GETTOL
GETTOT: POP P,A
POPJ P,
; DECIDE WHICH CLASS A TREE IS IN. U POINTS TO TOP JOB, B POINTS TO
; DATA BLOCK, A IS TTY#
GCLASS: PUSH P,C
PUSH P,D
MOVE C,@TTYSTS ; GET TTYSTS
TLNN C,%TSCNS ; IS THIS A CONSOLE (AS OPPOSED TO DEVICE?)
JRST [MOVEI C,$CPROG ; NO
JRST GCLASO]
MOVE C,@XUNAME
CAMN C,[SIXBIT /MUDDLE/]
JRST [MOVEI C,$CPROG
JRST GCLASO]
HLRO C,@UNAME
AOJE C,GCLAS1 ; IF NOT LOGGED IN, DO THAT INSTEAD
MOVE C,U
IDIV C,L
SKIPGE D,JOBTAB(C) ; ANY INFERIORS?
JRST [MOVEI C,$CHACT
JRST GCLASO] ; NO, HACTRN-ONLY
CAME C,JOBTAB(D) ; JUST TWO JOBS IN TREE?
JRST GCLAS1 ; NO
SKIPE ADJUST(B) ; IS THERE A WHOIML?
JRST [MOVEI C,$CHACT
JRST GCLASO] ; YES, SO STILL A CHOMPER
GCLAS1: MOVE C,@TTYTYP
TRNN C,%TYSTY ; IS IT A STY?
JRST [HLRO D,@UNAME
MOVEI C,$CLNLG
AOJE D,GCLASO
MOVEI C,$CLOCL
JRST GCLASO] ; NO, LOCAL
PUSH P,A
SUB A,NFSTTY ; GET STY #
MOVE C,@STYSTS
POP P,A
TLNN C,%SSUSE ; IN USE?
JRST [MOVEI C,$CPROG
JRST GCLASO] ; SHOULD NEVER GET HERE
MOVEI D,0
PUSHJ P,NETQ ; DOES OWNER HAVE NET SOCKETS?
JRST [MOVEI C,$CPROG
JRST GCLASO] ; NO
JFCL ; HERE, DON'T CARE HOW MANY SKIPS
HLRO C,@UNAME
AOJE C,[MOVEI C,$CNNLG
JRST GCLASO] ; NON-LOGGED-IN NET USER
.CALL [SETZ
SIXBIT /OPEN/
[.BII,,DSKI]
[SIXBIT /DSK/]
[SIXBIT /.FILE./]
[SIXBIT /(DIR)/]
SETZ @XUNAME] ; LOGGED IN TO DIRECTORY?
JRST [MOVEI C,$CNET
JRST GCLASO]
.CLOSE DSKI,
MOVEI C,$CLOCL ; YES, LOCAL USER
GCLASO: MOVEM C,CLASS(B)
POP P,D
POP P,C
POPJ P,
; STYSTS IN C. DOES OWNER HAVE NET SOCKETS? TAKES HOST IN D, SKIPS
; TWICE IF MATCH.
IMPURE
HSTNUM: 0
PURE
NETQ: PUSH P,A
PUSH P,B
PUSH P,D
PUSH P,E
PUSH P,U
HRRZ U,C ; USER INDEX
MOVEI E,0
HRLOI A,17
EQVI A,@IOCHNM ; AOBJN POINTER TO CHANNELS
NETQL: HRRZ B,(A) ; IOT INDEX
CAML B,NETDUI
CAMLE B,NETDBO ; SKIP IF NET CHANNEL
JRST NETQLE
JUMPN E,NETQ1
AOS -5(P)
MOVEI E,1
NETQ1: HLRZ B,(A) ; SOCKET NUMBER
EXCH B,A
LDB A,[321000,,@IMSOC4] ; INDEX INTO HOST TABLE
CAIN A,377
JRST NETQ2
HRRZ A,@IMPHTN ; REAL HOST #
MOVEM A,HSTNUM
SKIPN D,-2(P)
JRST NETHWN
JUMPG D,[CAME A,D
JRST NETQ2
JRST NETHWN]
NETHLP: CAMN A,(D)
JRST NETHWN
AOBJN D,NETHLP
JRST NETQ2
NETHWN: SKIPN E
AOS -5(P)
AOS -5(P)
JRST NETQO
NETQ2: EXCH A,B
NETQLE: AOBJN A,NETQL
NETQO: POP P,U
POP P,E
POP P,D
POP P,B
POP P,A
POPJ P,
; FREE STORAGE STUFF FOR THIS
IMPURE
FREBOT: 0
FRECHN: 0
STOPAG: BLOCK 2
PURE
; PUT IN B POINTER TO ENTSIZ WORDS OF STORAGE, ZEROED
GETS: PUSH P,A
PUSH P,C
SKIPN A,STOPAG+1
PUSHJ P,MAKPAG
SKIPN B,FRECHN ; RECYCLE?
JRST GETNEW
MOVE A,(B)
MOVEM A,FRECHN ; REST THE CHAIN
SETZM (B)
HRL A,B
HRRI A,1(B)
BLT A,ENTSIZ-1(B) ; ZERO IT
GETSOT: POP P,C
POP P,A
POPJ P,
GETNEW: MOVE B,FREBOT
MOVE C,STOPAG+1
CAIL B,2000-ENTSIZ(C)
JSR LOSE ; OUT OF MEMORY
ADDI B,ENTSIZ
EXCH B,FREBOT
JRST GETSOT
MAKPAG: MOVE A,[STOPAG,,1]
PUSHJ P,PGFIND
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBNDW+%CBNDR
MOVEI %JSELF
MOVE STOPAG
SETZI %JSNEW]
JSR LOSE
MOVE A,STOPAG+1
MOVEM A,FREBOT
MOVE A,STOPAG
POPJ P,
; FREE STORAGE POINTED TO BY B
FREES: PUSH P,A
MOVE A,FRECHN
MOVEM A,(B)
MOVEM B,FRECHN
POP P,A
POPJ P,
SUBTTL Logout classes
; ROUTINE FOR EACH OF THE FIVE CLASSES. CALLED WITH POINTER TO TREE'S
; BLOCK IN B, SHOULDN'T CLOBBER ANY AC'S. A HAS TTY NUMBER. IF THE ROUTINE
; DOESN'T SKIP, THE BLOCK IN QUESTION WILL BE FLUSHED. THIS IS USEFUL IF
; THE TREE HAS BEEN DETACHED OR SOMETHING, OR IF IT ISN'T REALLY IDLE.
; DISPATCH TABLE--XCT'ED
CLASSH: JSR LOSE ; CHOMP
PUSHJ P,CHLNLG ; LOCAL USER, NOT LOGGED IN
PUSHJ P,CHNNLG ; NET USER, NOT LOGGED IN
PUSHJ P,CHNET ; NET USER
PUSHJ P,CHLOCL ; LOCAL USER
CAIA ; XXFILE & .BATCH--ALWAYS SKIP
PUSHJ P,CHHACT ; HACTRN-ONLY TREE
; HACTRN ONLY TREE
CHHACT: PUSH P,C
PUSH P,E
MOVE C,HACTIM
MOVEI E,[ASCIZ /(HACTRN only) logged out./]
JRST CHLNLC
; LOCAL (ON LOCAL TERMINAL), NOT LOGGED IN.
CHLNLG: PUSH P,C
PUSH P,E
MOVE C,NLCTIM
MOVEI E,[ASCIZ /(local user) logged out./]
CHLNLC: PUSH P,D
PUSH P,F
MOVE D,[PUSHJ P,DOGUN]
MOVEI F,[ASCIZ /logged out/]
HRLI F,.LENGTH /logged out/
PUSHJ P,DOLOGO
AOS -4(P)
POP P,F
POP P,D
POP P,E
POP P,C
POPJ P,
; LOCAL USER (MAY BE LOGGED IN FROM NET, IF HAS DIRECTORY)<29>
IMPURE
LOCDET: SETZ
SIXBIT /DETACH/
LOCDCB: MOVSI 0
LOCDJB: SETZI 0 ; MUNGED BY CHLOCL
PURE
CHLOCL: PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,F
MOVEI C,0
HRRM C,LOCDCB
MOVE C,U
IDIV C,L
TRO C,400000
HRRM C,LOCDJB ; SET UP DETACH
MOVE C,LOCTIM
MOVE D,[.CALL LOCDET]
MOVEI E,[ASCIZ /(local user) detached./] ; ACTION MESSAGE
MOVEI F,[ASCIZ /detached/]
HRLI F,.LENGTH /detached/
PUSHJ P,DOLOGO ; CHECK THIS GUY. SKIPS IF WE SHOULDN'T
AOS -4(P)
POP P,F
POP P,E
POP P,D
POP P,C
POPJ P,
; GENERAL ROUTINE. TAKES ALLOWED IDLE TIME IN C, INSTRUCTION TO XCT IN D,
; STRING IN E (FOR LOGGER), IN F (FOR MESSAGE)
DOLOGO: PUSH P,C
PUSH P,D
PUSH P,E
MOVE U,TUIND(B)
SKIPE STATUS(B) ; HAS HE BEEN WARNED?
JRST DOLOGF ; YES. FLUSH HIM.
MOVE C,@TIME
SUB C,CRTIME(B) ; HOW LONG AGO WAS THIS NOTICED?
CAMGE C,-2(P) ; COMPARE TO ALLOWED TIME
JRST DOLOGL ; NOT LONG ENOUGH. LEAVE WITHOUT SKIPPING.
PUSHJ P,WARN ; WARN THE CHOMPER
SETOM STATUS(B)
JRST DOLOGL ; LEAVE WITHOUT SKIPPING.
DOLOGW: AOS -3(P)
DOLOGL: POP P,E
POP P,D
POP P,C
POPJ P,
; FLUSH A USER (USING INSTRUCTION SUPPLIED AS SECOND ARG)
DOLOGF: MOVE D,-1(P)
PUSHJ P,DOFLUS ; ROUTINE FOR FLUSHING
JRST DOLOGL
JRST DOLOGW
; WARN A CHOMPER. F HAS LENGTH,,STRING FOR 'YOU WILL BE ___ IN 5 MINUTES.'
WARN: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
MOVEI A,DSKO
MOVE B,@UNAME
MOVE C,@JNAME
MOVE D,[-2,,B]
PUSHJ P,CLIOPE ; OPEN CLI DEVICE
JRST [LOG D,[ASCIZ /couldn't be warned./]
JRST NTWARO]
SOUT DSKO,[<5B>essage from GUNNER GUNNER, ]
PUSHJ P,DTPRNT
SOUT DSKO,[
You will be ]
HLR E,F
HRLI F,440700
.CALL [SETZ
SIXBIT /SIOT/
MOVEI DSKO
F
SETZ E]
JSR LOSE
SOUT DSKO,[ in five minutes if your idleness continues.]
.CLOSE DSKO,
LOG D,[ASCIZ /warned./]
NTWARO: POP P,E
POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
; ROUTINE TO FLUSH A USER & TELNET SERVER. INSTRUCTION TO FLUSH USER IS IN
; D, STRING FOR LOGGER IN E. U HAS UIND, A HAS TTY #. SKIPS IF SUCCEEDS
DOFLUS: PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,F
MOVEI F,0
MOVE C,@TTYTYP
TRNN C,%TYSTY ; IS IT A STY?
JRST DOFLU1 ; NO
PUSH P,A
SUB A,NFSTTY ; GET STY #
MOVE C,@STYSTS
POP P,A
TLNN C,%SSUSE
JRST DOFLUO ; ??
HRRZ F,C ; PUT UIND OF STY OWNER IN F
DOFLU1: MOVE C,[-2,,D]
MOVE D,@UNAME
MOVE E,@JNAME
XCT -2(P) ; ATTEMPT TO FLUSH
JRST [LOG C,[ASCIZ /flush instruction failed./]
JRST DOFLUO]
AOS -4(P)
LOG C,@-1(P)
JUMPE F,DOFLUO
PUSH P,G
IDIV F,L
POP P,G
.GUN F, ; FLUSH STY OWNER
JRST [LOG C,[ASCIZ /TELNET server disappeared./]
JRST DOFLUO]
LOG C,[ASCIZ /TELNET server killed./]
DOFLUO: POP P,F
POP P,E
POP P,D
POP P,C
POPJ P,
; NET USERS
; LOGGED-IN
IMPURE
NETDET: SETZ
SIXBIT /DETACH/
MOVSI 10 ; KILL IN AN HOUR
NETDJB: SETZI 0 ; PUT <JOB> IN HERE
PURE
CHNET: PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,F
MOVEI C,CHNLGD ; CUTOFF TIMES TO USE
MOVE D,U
IDIV D,L
TRO D,400000
HRRM D,NETDJB ; SET UP DETACH
MOVE D,[.CALL NETDET]
MOVEI E,[ASCIZ /(net user) detached./] ; FOR LOGGER
MOVEI F,[ASCIZ /detached/] ; FOR WARNING
HRLI F,.LENGTH /detached/
PUSHJ P,NTLOGO ; SKIPS IF WE SHOULDN'T
AOS -4(P)
POP P,F
POP P,E
POP P,D
POP P,C
POPJ P,
; NOT LOGGED IN
CHNNLG: PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,F
MOVEI C,CHNNLD ; CUTOFFS
MOVE D,[PUSHJ P,DOGUN]
MOVEI E,[ASCIZ /(net user) logged out./]
MOVEI F,[ASCIZ /logged out/]
HRLI F,.LENGTH /logged out/
PUSHJ P,NTLOGO
AOS -4(P)
POP P,F
POP P,E
POP P,D
POP P,C
POPJ P,
DOGUN: PUSH P,A
PUSH P,B
MOVE A,U
IDIV A,L
.GUN A,
JRST DOGUNL
AOS -2(P)
DOGUNL: POP P,B
POP P,A
POPJ P,
; REAL WORK FOR NETWORK STUFF
; ARGS:
; C: ADDRESS OF CUTOFF TIMES--ONE FOR SCARCE RESOURCES, ONE OTHERWISE
; D: INSTRUCTION TO FLUSH USER. SHOULD SKIP IF SUCCEEDS
; E: STRING TO PUT IN LOG
; F: STRING FOR 'YOU WILL BE XX IN FIVE MINUTES. LENGTH IN LH.
; SKIPS IF CALLER SHOULDN'T. CALLER SHOULDN'T SKIP IF ENTRY WANTS TO BE
; FLUSHED.
; B HAS BLOCK FOR TREE, U HAS UIND OF TOP-LEVEL JOB.
; A HAS TTY NUMBER
NTLOGO: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,F
SKIPE STATUS(B)
JRST NTLOGF ; ALREADY WARNED, SO FLUSH
PUSHJ P,NETRES ; # FREE STYS IN A, # FREE NET SOCKETS IN B
CAML A,STYMIN ; SKIP IF NOT ENOUGH FREE STYS
CAMGE B,SOCMIN ; SKIP IF ENOUGH SOCKETS
JRST [MOVE C,NTSHRT(C) ; PICK UP ONE FOR HARD TIMES
JRST .+2]
MOVE C,NTLONG(C) ; OTHER
MOVE B,-4(P) ; GET BLOCK BACK IN B
MOVE D,@TIME
SUB D,CRTIME(B) ; HOW LONG HAS THIS BEEN AROUND?
CAMGE D,C ; LONG ENOUGH?
JRST NTLOGL ; NO. DON'T SKIP
PUSHJ P,WARN ; WARN THE CRETIN. STRING IS IN F.
SETOM STATUS(B)
JRST NTLOGL
NTLOGW: AOS -6(P)
NTLOGL: POP P,F
POP P,E
POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
NTLOGF: MOVE D,-2(P)
MOVE E,-1(P)
PUSHJ P,DOFLUS ; GO FLUSH HIM
JRST NTLOGL
JRST NTLOGW
; RETURN IN A THE NUMBER OF FREE STYS, IN B THE NUMBER OF FREE NET SOCKETS.
NETRES: PUSH P,C
PUSH P,D
MOVEI C,0
MOVE A,NSTTYS
SUBI A,1
NETRSL: MOVE D,@STYSTS
TLNN D,%SSUSE ; IS STY IN USE?
ADDI C,1
SOJGE A,NETRSL
PUSH P,C ; # OF FREE STYS.
MOVEI C,0
MOVE A,IMPSTL
SUBI A,1
NETRIL: SKIPN @IMSOC1 ; IMSOC1 IS 0 IF SOCKET FREE
ADDI C,1
SOJGE A,NETRIL
MOVE B,C
POP P,A
POP P,D
POP P,C
POPJ P,
; INITIALIZE FROM TAA;GUNNER INIT (ACTUALLY, FROM INIDIR;INIFN1 INIFN2) WHEN
; NEEDED.
ALOGIN: PUSH P,A
PUSH P,B
PUSH P,C
.CALL [SETZ
SIXBIT /OPEN/
[.UAI,,DSKI]
[SIXBIT /DSK/]
INIFN1
INIFN2
SETZ INIDIR]
JRST ALOGIL
.CALL [SETZ
SIXBIT /FILLEN/
MOVEI DSKI
SETZM A]
JRST ALOGIL ; LOSE
; USE VALBUF TO READ IN FILE
CAILE A,5*VALBLN
MOVEI A,5*VALBLN
PUSH P,A
MOVE B,[440700,,VALBUF]
.CALL [SETZ
SIXBIT /SIOT/
MOVEI DSKI
B
SETZ A]
JSR LOSE
SUB A,(P)
MOVNS A ; # CHARS READ
.CALL [SETZ
SIXBIT /RFDATE/
MOVEI DSKI
SETZM B]
JSR LOSE
PUSH P,B ; SAVE AWAY CREATION DATE
.CLOSE DSKI,
MOVE B,[440700,,VALBUF]
MOVE C,PARMTB
PUSH P,D
PUSH P,E
MOVEI E,0
ALGILL: ILDB D,B ; GET A CHAR
CAIL D,"0
CAILE D,"9
JRST [JUMPE E,ALGILC
IMUL E,1(C)
MOVEM E,(C)
ADD C,[PARMEN,,PARMEN]
JUMPGE C,ALGILD ; FILLED EVERYTHING UP
MOVEI E,0
JRST ALGILC]
IMULI E,10.
ADDI E,-"0(D)
ALGILC: SOJG A,ALGILL
IMUL E,1(C)
MOVEM E,(C)
ALGILD: POP P,E
POP P,D
POP P,PARMIN ; CREATION DATE
POP P,A
LOG [ASCIZ /initialized parameters./]
ALOGIL: .CLOSE DSKI,
POP P,C
POP P,B
POP P,A
POPJ P,
SUBTTL Logout illicit randoms
IMPURE
PWCREA: 0 ; CREATION DATE OF PWORD FILE
PWVERS: 0 ; NAME 2 OF PWORD FILE
PWWLEN: 0 ; # WORDS IN PWORD FILE
PWCHKD: 0 ; -1 IF CHECKED PWORD FILE THIS RUN
PWLEN: 0 ; # PAGES OF FILE MAPPED
PWPAG: BLOCK 2 ; PAGE # OF PWORD FILE
HSTMPD: BLOCK 2 ; PAGE # IF HOST TABLE MAPPED
RTBELN==4 ; WORDS/ENTRY
RNDUNM==0
RNDXUN==1 ; OFFSETS INTO RNDTAB ENTRIES
RNDIDX==2 ; USER IDX, FOR WARNED TABLE
RNDTIM==2 ; TIME OF DAY, FOR RNDTAB
RNDHST==3
RNDTPG: BLOCK 2 ; PAGE # OF RNDTAB
RNDCNT: 0 ; - LENGTH OF RNDTAB
RWTAB: BLOCK 8.*RTBELN ; TABLE FOR PEOPLE WHO'VE BEEN
; WARNED, NOT HAD MAIL SENT.
RWTABP: RWTAB
RWTABE:
CHKFOR: 0 ; FOR INTERRUPT HANDLER
PURE
WINHTB: 54000
WINHST: WINHTB-.,,WINHTB
; Net-random hacker. This operates off two tables, rwtab and rndtab
; (which has an aobjn pointer in rndptr). It first scans rwtab for
; people who were warned last pass, and sends mail to user-accounts
; about them. Any such person is copied to rndtab, so mail won't be
; sent again. It then scans the network ttys, building a new version of
; rwtab, and warning people whose names are entered there.
RNDFLS: SETZM PWCHKD
MOVEI A,RWTAB ; PICK UP POINTER TO TABLE
RNDL1B: SKIPN U,RNDIDX(A) ; GET INDEX IN U
JRST RNDFL1 ; NO MORE ENTRIES, SO BUILD NEW ONE
MOVE B,@XUNAME
CAME B,RNDXUN(A) ; COMPARE XUNAMES
JRST RNDMLE ; NOPE, SKIP THIS ONE
MOVE B,@UNAME ; AND UNAMES
CAME B,RNDUNM(A)
JRST RNDMLE
; NOW HAVE LOSER IN A, WITH INDEX IN U. SEND MAIL, PUT HIM IN RNDTAB.
PUSHJ P,ACCCHK ; AFTER CHECKING HIS ACCOUNT AGAIN
POPJ P, ; NO PWORD FILE?
JRST RMDAY ; GO SEND MAIL TO USER-ACCOUNTS
JRST RMFLS
JRST RNDMLE ; MAGICALLY GOT ACCOUNT?
RMDAY: MOVNI B,1
CAIA
RMFLS: MOVEI B,0
PUSH P,B
MOVE B,[-2,,C]
MOVE C,@UNAME
MOVE D,@XUNAME
.CALL [SETZ
SIXBIT /OPEN/
[.UAO,,DSKO]
[SIXBIT /DSK/]
[SIXBIT /_GUNTM/]
[SIXBIT />/]
SETZ [SIXBIT /COMSYS/]]
JRST [LOG B,[ASCIZ /Open in COMSYS failed./]
POP P,B
JRST RNDMLE]
PUSH P,A
PUSH P,B
PUSHJ P,RNDMAL
JRST [POP P,B
POP P,A
LOG B,[ASCIZ /couldn't send mail./]
POP P,B
JRST RNDMLE]
POP P,B
POP P,A
LOG B,[ASCIZ /mail sent./]
POP P,B
JRST RNDMOV
; SEND MAIL. A AND B ARE ALREADY SAVED, DSKO IS OPEN.
RNDMAL: MOVEM P,SNDSAV ; IN CASE OF IOC
PUSH P,C
PUSH P,D
SOUT DSKO,["WHEN-ORIGINATED"
]
.CALL [SETZ
SIXBIT /RQDATE/
SETZM C]
JSR LOSE ; I'D LIKE TO SEE THIS...
; FOLLOWING CODE IS STOLEN FROM ITIME PACKAGE, WHICH IS HOW COMSYS
; GETS DATES AND TIMES.
MOVEI D,15020. ; 1/1/00
LDB A,[330700,,C] ; YEAR, MOD 100
MOVE O,A
IDIVI A,4
IMULI A,<<366.+365.>+<365.+365.>>
ADD D,A
MOVE A,B
IMULI A,365.
ADD D,A
CAIE B,0
ADDI D,1
LDB A,[270400,,C]
MOVE O,A
ADDI A,[0 ? 31. ? 59. ? 90. ? 120. ? 151. ? 181. ? 212.
243. ? 273. ? 304. ? 334.]
ADD D,-1(A)
JUMPN B,TLAB
CAIL O,3
ADDI D,1
TLAB: LDB A,[220500,,C]
ADDI D,-1(A)
HRRZ A,C
LSH A,-1
MUL A,[1,,0]
DIVI A,<24.*3600.>
CAIL B,<12.*3600.>
ADDI A,1
HRRZ B,A
HRL B,D
; COMSYS-FORMAT TIME IS NOW IN B
MOVE A,B
PUSHJ P,DCPRNT
SOUT DSKO,[
"SENDER"
"GUNNER"
"FROM"
"GUNNER"
"TO"
("ACCOUNTS-NOTIFICATION")
"ACTION-TO"
("ACCOUNTS-NOTIFICATION")
"SCHEDULE" ("SENDING")
"SUBJECT" "]
MOVE A,@XUNAME
PUSHJ P,SXPRNT
SOUT DSKO,["
"TEXT" "]
MOVE A,@XUNAME
PUSHJ P,SXPRNT
SOUT DSKO,[ was using DM ]
CAME A,@UNAME
JRST [.IOT DSKO,["(]
SOUT DSKO,[as ]
MOVE A,@UNAME
PUSHJ P,SXPRNT
.IOT DSKO,[")]
.IOT DSKO,[" ]
JRST .+1]
SOUT DSKO,[from ]
MOVE B,-4(P)
MOVE A,RNDHST(B)
PUSHJ P,SXPRNT
PUSH P,B
MOVE A,@UTMPTR
SUB A,USRRCE
SUB A,NFSTTY ; GET STY #
HRRZ A,@STYSTS ; USER INDEX OF OWNER
IDIV A,L
TRO A,400000 ; JOB SPEC, FOR OPEN
MOVEI B,NOFNAM
MOVEM B,CHKFOR ; IN CASE JOB GOES AWAY
POP P,B
.CALL [SETZ
SIXBIT /OPEN/
[.BII+10,,USRI]
[SIXBIT /USR/]
MOVE A
SETZI 0]
JRST NOFNAM
.ACCESS USRI,[100]
MOVE C,[-1,,A]
.IOT USRI,C
CAME A,[SIXBIT /TERMID/]
JRST NOFNAM
MOVE C,[-1,,A]
.ACCESS USRI,[124]
.IOT USRI,C
.CLOSE USRI,
JUMPE A,NOFNAM
CAME A,@XUNAME
CAMN A,@UNAME
JRST NOFNAM
.IOT DSKO,[" ]
.IOT DSKO,["(]
SOUT DSKO,[logged in there as ]
PUSHJ P,SXPRNT
.IOT DSKO,[")]
NOFNAM: .CLOSE USRI,
SETZM CHKFOR
SOUT DSKO,[
just now without a proper account and did not leave within
five minutes when requested to do so.
"]
.CALL [SETZ
SIXBIT /RENMWO/
MOVEI DSKO
[SIXBIT /M/]
SETZ [SIXBIT />/]]
JSR LOSE
.CLOSE DSKO,
SETZM SNDSAV
POP P,D
POP P,C
AOS (P)
POPJ P,
; MAIL-SENDING ROUTINES JRST HERE WHEN DONE TO FILL IN TABLE ENTRIES
RNDMOV: MOVE B,RNDCNT
SKIPE C,RNDTPG+1
JRST RNDMV0
PUSH P,A
MOVE A,[RNDTPG,,3]
PUSHJ P,PGFIND
POP P,A
MOVE C,RNDTPG+1
RNDMV0: SUB C,B
SUBI B,RTBELN
MOVEM B,RNDCNT ; UPDATE RNDPTR
PUSH P,C
ADDI C,RTBELN
LSH C,-12 ; GET PAGE #
PUSH P,C ; SAVE FOR LATER
HRLI C,.RPMAP(C)
HRRI C,B
.SUSET C ; STUFF FOR PAGE INTO B
POP P,C
JUMPE B,[.CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBNDW+%CBNDR
MOVEI %JSELF
MOVE C
SETZI %JSNEW]
JSR LOSE
JRST RNDMV1]
JUMPG B,[JSR LOSE] ; RAN INTO PW DATA BASE, SIGH.
RNDMV1: POP P,C ; POINTER TO ENTRY
MOVE B,@XUNAME
MOVEM B,RNDXUN(C)
MOVE B,@UNAME
MOVEM B,RNDUNM(C)
.CALL [SETZ
SIXBIT /RQDATE/
SETZM RNDTIM(C)]
JFCL
RNDMLE: ADDI A,RTBELN
CAIGE A,RWTABE
JRST RNDL1B
RNDFL1: SETZM RWTAB
MOVE A,[RWTAB,,RWTAB+1]
BLT A,RWTABE-1 ; CLEAR RWTAB
MOVEI A,RWTAB
MOVEM A,RWTABP ; POINTER TO FREE ENTRY
; NOW FIND PEOPLE WHO ARE LOGGED IN W/O ACCOUNTS, HAVEN'T ALREADY
; HAD MAIL SENT. TELL THEM TO GO AWAY.
MOVE A,NSTTYS
HRLOI A,-1(A)
EQV A,NFSTTY ; AOBJN PTR TO STYS
RFLOOP: SKIPGE @TTYSTS ; SKIP IF TTY IS IN USE
JRST RFLEND
HRRZ U,@TTYSTS ; USER INDEX
HLRO B,@UNAME
AOJE B,RFLEND ; NOT LOGGED IN
MOVE C,@TTYSTS
TLNN C,%TSCNS ; SKIP IF CONSOLE
JRST RFLEND ; NO, NOT INTERESTING
PUSH P,A
SUB A,NFSTTY
MOVE C,@STYSTS
POP P,A
MOVE D,WINHST ; HOST #'S FOR `GOOD' SITES
PUSHJ P,NETQ ; ANY NET SOCKETS FOR STY OWNER?
JRST RFLEND ; NO
CAIA
JRST RFLEND ; DON'T LOOK AT PEOPLE FROM XX
PUSHJ P,GETTOP ; GET TOP OF TREE
PUSHJ P,ACCCHK ; SKIP IF VALID ACCOUNT
POPJ P, ; NO PWORD FILE?
JRST RWARN
JRST RWARND
RFLEND: AOBJN A,RFLOOP
POPJ P,
; FLUSH USER IN U: KNOWN CHOMPER
RWARND: MOVNI B,1
CAIA
RWARN: MOVEI B,0
PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
SKIPN A,RNDTPG+1
JRST RWLOP2
HRL A,RNDCNT
MOVE B,@UNAME
MOVE C,@XUNAME
RWLOP: CAMN B,RNDUNM(A)
CAME C,RNDXUN(A) ; SAME LOSER?
JRST RWLOP1 ; NO
JRST RLOGD ; YES, SO IGNORE HIM
RWLOP1: ADD A,[RTBELN,,RTBELN]
JUMPL A,RWLOP
RWLOP2: SKIPE HSTMPD
JRST RFLUS1
.CALL [SETZ
SIXBIT /OPEN/
[.BII,,DSKI]
[SIXBIT /DSK/]
[SIXBIT /HOSTS2/]
[SIXBIT />/]
SETZ [SIXBIT /SYSBIN/]]
JSR LOSE
.CALL [SETZ
SIXBIT /FILLEN/
MOVEI DSKI
SETZM A]
JSR LOSE
.CLOSE DSKI,
ADDI A,1777
LSH A,-12
HRLI A,HSTMPD ; ADDRESS OF POINTER
PUSHJ P,PGFIND ; GET PAGES
MOVE A,HSTMPD
MOVEI B,DSKI
PUSHJ P,NETWRK"HSTMAP
JSR LOSE
LOG [ASCIZ /Loaded hostname table./]
RFLUS1: MOVEI A,DSKO
MOVE B,@UNAME
MOVE C,@JNAME
PUSHJ P,CLIOPE
JRST RLOGS
SKIPE -3(P)
JRST [SOUT DSKO,[<5B>essage from GUNNER:
You do not have a daytime account here at DM. If you do not log out within
five minutes, you will be reported to USER-ACCOUNTS. If you are not a
legitimate member of LCS or AI, you may lose your other ITS account(s).
If you need assistance, send a message to USER-ACCOUNTS:
:MAIL USER-ACCOUNTS <CR> subject <ESC> message <ESC> <ESC>]
JRST RLOGS]
SOUT DSKO,[<5B>essage from GUNNER:
You do not have an account here at DM. If you do not log out within
five minutes, you will be reported to USER-ACCOUNTS. If you are not a
legitimate member of LCS or AI, you may lose your other ITS account(s).
If you need assistance, send a message to USER-ACCOUNTS:
:MAIL USER-ACCOUNTS <CR> subject <ESC> message <ESC> <ESC>]
RLOGS: .CLOSE DSKO,
MOVE A,HSTNUM
PUSHJ P,NETWRK"HSTSIX ; HOST NAME-->A
JFCL
MOVE T,[-3,,A]
LOG T,[ASCIZ /notified./]
MOVE D,RWTABP ; BUILD ENTRY IN RWTAB
MOVEM B,RNDUNM(D)
MOVE B,@XUNAME
MOVEM B,RNDXUN(D)
MOVEM U,RNDIDX(D)
MOVEM A,RNDHST(D)
ADDI D,RTBELN
MOVEM D,RWTABP
RLOGD: POP P,E
POP P,D
RLOGD1: POP P,C
POP P,B
POP P,A
JRST RFLEND
; GIVEN UNAME (USER INDEX IN U), CHECK FOR EXISTENCE OF VALID
; ACCOUNT. SKIPS TWICE IF VALID, NOT AT ALL IF DB MISSING.
ACCCHK: PUSHJ P,GETDB
POPJ P,
AOS (P)
PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
MOVE A,@XUNAME
DIGLOP: MOVEI B,0
ROTC A,-6
ROT B,6
JUMPE B,.-2
CAIL B,20
CAILE B,31
JRST REMAKE
JUMPE A,[MOVE A,@XUNAME
JRST SCRNAM]
JRST DIGLOP
REMAKE: ROT B,-6
ROTC A,6
TLNN A,770000
JRST .-2
SCRNAM: ROT A,13
ADD A,[742532,,732643] ; GET FUNNY FORM IN A
MOVE D,PWPAG+1
MOVE B,PWCNT(D) ; NUMBER OF ENTRIES
ADDI B,PWLENG
HRLOI B,-1(B)
EQVI B,PWNAME(D) ; AOBJN POINTER TO ENTRIES
ACCLOP: CAME A,(B) ; MATCH?
JRST ACCEL
LDB A,[PI$STA+3(B)] ; GET ACCOUNT STATUS
CAIE A,PS%OK
CAIN A,PS%SYS
JRST ACCEXS
JRST ACCOL ; NO ACCOUNT
ACCEXS: MOVE C,2(B) ; PICK UP FLAGS
TLNE C,%PFDAY ; CAN ALWAYS BE LOGGED IN?
JRST ACCOW1 ; YES, WINNER
AOS -4(P) ; OK FOR NIGHTS, ANYWAY
LDB A,[PI$GRP+3(B)] ; GROUP #
.CALL [SETZ
SIXBIT /RQDATE/
SETZM B] ; GET DATE
JSR LOSE
TLZ B,-1 ; HALF-SECONDS PAST MIDNIGHT
IDIVI B,3600. ; HALF-HOURS PAST MIDNIGHT
ADDI A,PWGRDM
ADDI A,(D) ; ADDRESS OF GROUP RESTRICTION WORD
.RYEAR C, ; DAY OF WEEK
LDB C,[320300,,C]
JUMPE C,[LDB O,[DM$SNS(A)] ; SUNDAY RESTRICTION START
LDB A,[DM$SNE(A)]
JRST CHKRST]
CAIN C,6
JRST [LDB O,[DM$STS(A)]
LDB A,[DM$STE(A)]
JRST CHKRST] ; SATURDAY
LDB O,[DM$WDS(A)]
LDB A,[DM$WDE(A)]
; START OF RESTRICTION IS IN O, END IN A, TIME IN B
CHKRST: CAIN O,77 ; no restriction?
JRST ACCOW
CAIL O,(B) ; SKIP IF RESTRICTION NOT STARTED YET
CAIL A,(B) ; SKIP IF RESTRICTION NOT ENDED YET
JRST ACCOW ; ACCOUNT IS OK
PUSHJ P,HOLID1 ; IF HOLIDAY, NO RESTRICTIONS
CAIA
JRST ACCOW ; WEEKEND/HOLIDAY
JRST ACCOL ; CAN'T BE ON
ACCEL: ADD B,[PWLENG,,PWLENG]
JUMPL B,ACCLOP
JRST ACCOL
ACCOW1: AOS -4(P)
ACCOW: AOS -4(P) ; THIRD SKIP
ACCOL: POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
; MAP IN PWORD DATA FILE IF NEEDED. SKIPS IF FAILS
DBOPEN: SETZ
SIXBIT /OPEN/
[.BII,,DSKI]
[SIXBIT /DSK/]
[SIXBIT / 0PWRD/]
[SIXBIT />/]
SETZ [SIXBIT /SYSENG/]
GETDB: PUSH P,A
SKIPE PWCHKD
JRST GETDBW
SETOM PWCHKD
.CALL DBOPEN
JRST DBGONE
.CALL [SETZ
SIXBIT /RFDATE/
MOVEI DSKI
SETZM A]
JSR LOSE
CAMN A,PWCREA
JRST GETDBW ; WON
MOVEM A,PWCREA
.CALL [SETZ
SIXBIT /RFNAME/
MOVEI DSKI
MOVEM A
MOVEM A
SETZM A] ; SECOND FILE NAME
JSR LOSE
CAMN A,PWVERS ; SAME?
JRST [.CALL [SETZ
SIXBIT /FILLEN/
MOVEI DSKI
SETZM A]
JSR LOSE
CAMN A,PWWLEN
JRST GETDBW ; SAME VERSION, LENGTH, SO GOOD
JRST .+2] ; GET A NEW ONE
MOVEM A,PWVERS
SKIPN A,PWLEN ; ANYTHING MAPPED?
JRST GETDBN ; NO, GO GET NEW ONE
HRLOI A,-1(A) ; OTHERWISE, UNMAP OLD
EQV A,PWPAG
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI 0
MOVEI %JSELF
SETZ A]
JSR LOSE
MOVE A,PWPAG
PUSHJ P,PGGIVE
GETDBN: .CALL [SETZ
SIXBIT /FILLEN/
MOVEI DSKI
SETZM A]
JSR LOSE
MOVEM A,PWWLEN
ADDI A,1777
ASH A,-12
MOVEM A,PWLEN
HRLI A,PWPAG
PUSHJ P,PGFIND
MOVE A,PWLEN
HRLOI A,-1(A)
EQV A,PWPAG
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBNDR
MOVEI %JSELF
A
SETZI DSKI]
JSR LOSE
LOG [ASCIZ /loaded new pw database./]
GETDBW: .CLOSE DSKI,
AOS -1(P)
GETDBO: POP P,A
POPJ P,
DBGONE: SKIPE PWLEN
JRST [LOG [ASCIZ /PWORD file gone. Using existing version./]
JRST GETDBW]
LOG [ASCIZ /PWORD file missing. Can't run./]
JRST GETDBO
SUBTTL NCPUP
IMPURE
NETITS==12.
NETITR: 0
NETTRY: -1 ; IF -1, CAN TRY TO BRING IT UP
NETSAV: 0
PURE
NCPUP: SKIPN A,@IMPUP ; IS NET NOW DOWN?
JRST [SETOM NETTRY
SKIPE NETSAV
LOG [ASCIZ /net back up./]
SETZM NETSAV
POPJ P,]
SKIPN NETSAV ; SKIP IF NET WAS DOWN
JRST [MOVEM A,NETSAV ; WASN'T; SAVE THIS
LOG [ASCIZ /net down./]
POPJ P,]
SKIPN NETTRY ; TRIED AND FAILED BEFORE
JRST [SOSL NETITR
POPJ P,
JRST .+1]
JUMPG A,NETDWN
LOG [ASCIZ /net dead./] ; NCPUP SAYS THIS STATE PERMANENT
SETZM NETTRY ; LET THE HUMANS DO IT
POPJ P,
NETDWN: .SUSET [.SDF1,,[-1]] ; DEFER INTERRUPTS
HRLI A,400000
.IOTLSR A, ; HORROR OF HORRORS!
MOVEI A,0
CONSZ 424,77 ; SEE IF UP
JRST [.IOTLSR A, ; YES
.SUSET [.SDF1,,[0]] ; RE-ENABLE INTERRUPTS
LOG [ASCIZ /net hardware claims to be up./]
POPJ P,]
CONO 424,22 ; TRY IT
MOVEI B,5*30.
.SLEEP B,
CONSZ 424,77 ; DID THIS WIN?
JRST [.IOTLSR A, ; YES
.SUSET [.SDF1,,[0]]
LOG [ASCIZ /net brought back up./]
SETZM NETSAV
SETOM NETTRY
POPJ P,]
.IOTLSR A, ; SIGH
.SUSET [.SDF1,,[0]]
SETZM NETTRY
MOVEI A,NETITS
MOVEM A,NETITR ; WAIT AN HOUR, TRY AGAIN
LOG [ASCIZ /NCP won't come up./]
POPJ P,
SUBTTL Display cruft on free terminals
IMPURE
QIRRCS: 0 ; SAVED # OF IRRECOVS
PARERS: 0 ; SAVED # OF MEM ERRORS
LODBUF: BLOCK 2
OUTBUF: BLOCK 16.
OUTPTR: 0
OUTCT: 0
ENDSTR: ASCIZ /V HUE/
VPOSPT: 170700,,ENDSTR
PURE
CHECK==0
VT100==1
HEATH==2
RESERV==3
; FOR COMPUTING UPTIME
SPD==24.*60.*60.
MONLNG: 31. ? 28. ? 31. ? 30. ? 31. ? 30. ? 31. ? 31. ? 30. ? 31. ? 30. ? 31.
IMPURE
TTYP: RESERV ; SYSTEM CONSOLE
RESERV ; T01 --LPT
VT100 ; T02 --PDL
VT100 ; T03 --AV
VT100 ; T04 --SANGAL
VT100 ; T05 --DEAD IMLAC
RESERV ; T06 --DEAD IMLAC
VT100 ; T07 --MARC
VT100 ; T10 --STU
VT100 ; T11 --MEYER (ACTUALLY A VT52)
VT100 ; T12 --JAN
HEATH ; T13 --BAHRAM
RESERV ; T14 ??
RESERV ; T15 --DEAD IMLAC
VT100 ; T16 --ILSON
RESERV ; T17 --DEAD IMLAC
VT100 ; T20 --LICK
TTYCT=TTYP-.
TTYLOK: BLOCK -TTYCT ; -1 IF TTY HUNG UP
TINI: BLOCK -TTYCT ; SAVED TTITM
TLRSV: BLOCK -TTYCT ; # OF LINES CURRENTLY RESERVED ON SCREEN
TPOS: BLOCK -TTYCT ; SAVED CURSOR POSITION
BDLEN: 0
BDLINE: 0 ; # LINES NEEDED FOR BIRTHDAY STUFF (1 OR 2)
BDBUF: BLOCK 32. ; STUFF FOR BIRTHDAY TEXT (GENERATED BY BATCH DAEMON)
BDTHER: 0 ; -1 IF LOADED, ELSE 0
BDNEW: 0 ; -1 IF NEED TO REDO BIRTHDAYS FOR CURRENT TTYS
LSTRUN: 0 ; TIME AT END OF LAST RUN.
PURE
IDLSRV: MOVE A,@QIRRCV ; # IRRECOV
CAMN A,QIRRCS ; CHANGE?
JRST IDLSR1
SETZM LODBUF
SUB A,QIRRCS
MOVE B,@QIRRCV
MOVEM B,QIRRCS
JUMPL A,[LOG [ASCIZ /Disk errors reset./]
JRST IDLSR1]
PUSHJ P,NUMSTF
MOVE B,[-1,,LODBUF]
MOVEI C,[ASCIZ /new disk errors./]
CAIN A,1
MOVEI C,[ASCIZ /new disk error./]
LOG B,(C)
IDLSR1: MOVE A,@PARERR
CAMN A,PARERS
JRST IDLSR2
SETZM LODBUF
SUB A,PARERS
MOVE B,@PARERR
MOVEM B,PARERS
PUSHJ P,NUMSTF
MOVE B,[-1,,LODBUF]
MOVEI C,[ASCIZ /new parity errors./]
CAIN A,1
MOVEI C,[ASCIZ /new parity error./]
LOG B,(C)
IDLSR2: MOVE A,[440700,,OUTBUF]
MOVEM A,OUTPTR
SETZM OUTCT
PUSHJ P,TTYDAT ; GET DATE & TIME INTO BUFFER
MOVEI A,[ASCIZ / Load /]
PUSHJ P,TTYTXT
MOVE A,@SLOADU
IDIVI A,100.
CAIGE A,4
JRST IDLNLG
PUSH P,A
PUSH P,B
PUSH P,OUTPTR
PUSH P,OUTCT
MOVE C,[440700,,LODBUF]
MOVEM C,OUTPTR
PUSHJ P,TTYDEC
MOVEI A,".
PUSHJ P,TTYCHR
CAIGE B,10.
JRST [MOVEI A,"0
PUSHJ P,TTYCHR
JRST .+1]
MOVEI A,(B)
PUSHJ P,TTYDEC
MOVEI A,0
IDPB A,OUTPTR
LOG LODBUF
POP P,OUTCT
POP P,OUTPTR
POP P,B
POP P,A
IDLNLG: PUSHJ P,TTYDEC
MOVEI A,".
PUSHJ P,TTYCHR
CAIGE B,10.
JRST [MOVEI A,"0
PUSHJ P,TTYCHR
JRST .+1]
MOVEI A,(B)
PUSHJ P,TTYDEC
MOVEI A,[ASCIZ / Lost=/]
PUSHJ P,TTYTXT
MOVE A,@LOSRCE
PUSHJ P,TTYPCT ; LOST TIME
MOVEI A,[ASCIZ / Idle=/]
PUSHJ P,TTYTXT
MOVE A,@IDLRCE
PUSHJ P,TTYPCT ; IDLE TIME
MOVEI A,[ASCIZ / /]
PUSHJ P,TTYTXT
MOVE A,@SUSRS
PUSHJ P,TTYDEC ; # USERS
MOVEI A,"+
PUSHJ P,TTYCHR
MOVEI A,0
MOVEI U,0
TTYSYL: SKIPN @UNAME ; MAKE SURE THERE'S A JOB HERE
JRST TTYSYC
MOVE B,@UTMPTR ; RESOURCE WORD
SUB B,USRRCE
SUB B,NCT
JUMPL B,TTYSYC
JUMPE B,[SKIPL @SUPPRO ; ONLY COUNT TREES
JRST TTYSYC
MOVE C,@JNAME
CAME C,[SIXBIT /TELSER/] ; DON'T COUNT TELNET SERVERS
AOJA A,TTYSYC
JRST TTYSYC]
TTYSYC: ADD U,L
CAMGE U,@USRHI
JRST TTYSYL
PUSHJ P,TTYDEC
MOVEI A,[ASCIZ / users /]
PUSHJ P,TTYTXT
MOVEI A,0 ; COUNT MUDDLES AND ZORKS
MOVEI B,0
MOVE U,MSENTS
SUBI U,1
TTYCLP: SKIPG @MSUSER
JRST TTYCLE
ADDI A,1
MOVE C,@MSRED2
; CAMN C,[SIXBIT /ZORK/]
; ADDI B,1
TTYCLE: SOJGE U,TTYCLP
PUSH P,B
PUSH P,A
PUSHJ P,TTYDEC
MOVEI A,[ASCIZ / MUDDLE/]
PUSHJ P,TTYTXT
POP P,B
MOVEI A,[ASCIZ /s /]
CAIN B,1
MOVEI A,[ASCIZ / /]
PUSHJ P,TTYTXT
SKIPN A,(P)
JRST [SUB P,[1,,1]
JRST TTYLP1]
PUSHJ P,TTYDEC
MOVEI A,[ASCIZ / ZORK/]
PUSHJ P,TTYTXT
POP P,B
MOVEI A,[ASCIZ /s /]
CAIN B,1
MOVEI A,[ASCIZ / /]
PUSHJ P,TTYTXT
TTYLP1: MOVEI A,[ASCIZ /Up /]
PUSHJ P,TTYTXT
UPTIME: .CALL [SETZ
SIXBIT /RQDATE/
MOVEM E
SETZM F]
JSR LOSE
SETZB C,D
LDB A,[UNMON E]
SOJLE A,UPTIM1
MONLOP: ADD C,MONLNG-1(A)
CAIN A,2
JRST [PUSH P,A ; FUDGE FOR FEBRUARY
.RYEAR A,
TLNE A,200000 ; SKIP IF NOT LEAP YEAR
ADDI C,1
POP P,A
JRST .+1]
SOJG A,MONLOP
UPTIM1: LDB A,[UNDAY E]
ADD C,A
IMULI C,SPD
HRRZ A,E
LSH A,-1
ADD C,A
LDB B,[UNMON F]
SOJLE B,UPTIM2
MONLP1: ADD D,MONLNG-1(B)
CAIN B,2
JRST [PUSH P,A
.RYEAR A,
TLNE A,200000
ADDI D,1
POP P,A
JRST .+1] ; CHOMP!
SOJG B,MONLP1
UPTIM2: LDB B,[UNDAY F]
ADD D,B
IMULI D,SPD
HRRZ B,F
LSH B,-1
ADD D,B
CAMGE C,D
ADD C,[SPD*365.]
SUB C,D ; UPTIME IN SECONDS
MOVE A,C
IDIVI A,SPD ; DAYS IN A
JUMPE A,UPHOUR
PUSHJ P,TTYDEC
MOVEI A,"!
PUSHJ P,TTYCHR
UPHOUR: MOVE A,B
IDIVI A,3600.
CAIG A,9.
JRST [PUSH P,A
MOVEI A,"0
PUSHJ P,TTYCHR
POP P,A
JRST .+1]
PUSHJ P,TTYDEC
MOVEI A,":
PUSHJ P,TTYCHR
MOVE A,B
IDIVI A,60.
CAIG A,9.
JRST [PUSH P,A
MOVEI A,"0
PUSHJ P,TTYCHR
POP P,A
JRST .+1]
PUSHJ P,TTYDEC
SETZM BDNEW
SKIPL BDTHER ; CURRENT BIRTHDAY DATA?
PUSHJ P,BDINIT ; NO, GO GET IT
MOVE A,[200000,,[300. ? 0 ? 0 ? 0]]
.REALT A,
JFCL
MOVSI A,TTYCT ; MAKE A BE -N,,0
TTYLOP: MOVE B,TTYP(A)
SETOM IDLTTY
CAIE B,RESERV ; LPT & SUCH
SKIPGE TTYLOK(A) ; HUNG TERMINALS
JRST TTYEND
SKIPGE TINI(A)
JRST TTYEND ; TINI<0->TTY CAN'T BE USED
SKIPL @TTYSTS
JRST [SETZM TINI(A)
JRST TTYEND] ; TTY IS IN USE
HRRZM A,IDLTTY
MOVE C,@TTITM
CAME C,TINI(A)
JRST [SKIPN TINI(A)
JRST TTYINI
MOVE C,LSTRUN ; LAST TIME WE RAN
ADDI C,45. ; PLUS A SECOND OR SO FUDGE
CAMG C,@TTLTM ; OUTPUT SINCE THEN?
JRST TTYINI ; YES, NEED INIT
JRST .+1]
PUSHJ P,TTYOPE ; OPEN
JRST [SETZM TINI(A) ; LOST
JRST TTYEND] ; SIGH
SKIPE BDNEW
PUSHJ P,BDTINI ; HACK BIRTHDAY STUFF
MOVE B,[440700,,[ASCIZ /TL/]] ; GO TO TOP, CLEAR THAT LINE
MOVEI C,4
.CALL [SETZ
SIXBIT /SIOT/
MOVSI %TJDIS
MOVEI TTYCHN
B
SETZ C]
JSR LOSE
TTYCOM: MOVE B,[440700,,OUTBUF] ; SPIT OUT STRING
MOVE C,OUTCT
.CALL [SETZ
SIXBIT /SIOT/
MOVEI TTYCHN
B
SETZ C]
JSR LOSE
MOVE B,TPOS(A)
ADDI B,10
DPB B,VPOSPT ; SET UP STRING--GO TO BOTTOM
MOVE B,[440700,,ENDSTR] ; GO THERE
MOVEI C,6
SKIPE BDNEW
MOVEI C,8. ; CLEAR TO EOS IF NEW BD
.CALL [SETZ
SIXBIT /SIOT/
MOVSI %TJDIS
MOVEI TTYCHN
B
SETZ C]
JSR LOSE
.CLOSE TTYCHN, ; AND CLOSE
TTYEND: AOBJN A,TTYLOP
MOVE A,[400000,,[0 ? 0 ? 0 ? 0]]
.REALT A,
JFCL
SETOM IDLTTY
SETOM LSTTTY
MOVE A,@TIME
MOVEM A,LSTRUN
POPJ P,
; INITIALIZE THE TTY FOR USE BY THIS--MAKE A BLANK LINE ON TOP, ETC.
TTYINI: MOVEI B,1
MOVEM B,TLRSV(A)
MOVE B,@TTITM
MOVEM B,TINI(A) ; SAVE AWAY TIME LAST USED
MOVE B,TTYP(A)
CAIE B,CHECK ; VT100 OR HEATH?
JRST VTINI ; YES, SPECIAL HACKING
MOVE B,@TTYOPT
TLNN B,%TOLID ; LINE INSERT/DELETE?
JRST [SETOM TINI(A) ; NO, CAN'T USE
JRST TTYEND]
PUSHJ P,TTYOPE ; OPEN IT
JRST TTYEND ; FAILED, SIGH
PUSHJ P,TTYPOS ; GET VPOS
MOVE B,[440700,,[ASCIZ /T[/]]
MOVEI C,4
.CALL [SETZ
SIXBIT /SIOT/
MOVSI %TJDIS
MOVEI TTYCHN
B
SETZ C]
JSR LOSE
TTYINO: PUSHJ P,BDTINI
MOVE C,[440700,,[ASCII /T/]]
MOVEI B,2
.CALL TTYDIS
JSR LOSE
JRST TTYCOM
; INITIALIZE VT100/HEATH. MUCH EXTRA HAIR.
VTINI: PUSHJ P,TTYOPE
JRST TTYEND
PUSHJ P,TTYPOS
MOVE B,[440700,,[ASCIZ /T/]] ; TOP OF SCREEN
MOVEI C,2
.CALL [SETZ
SIXBIT /SIOT/
MOVSI %TJDIS
MOVEI TTYCHN
B
SETZ C]
JSR LOSE
MOVE B,[440700,,[ASCIZ /I/]] ; REVERSE INDEX OPERATION
MOVE C,TTYP(A)
CAIE C,VT100
MOVE B,[440700,,[ASCIZ /L/]] ; HEATH INSERT LINE
MOVEI C,2
.CALL [SETZ
SIXBIT /SIOT/
MOVSI %TJSIO
MOVEI TTYCHN
B
SETZ C]
JSR LOSE
JRST TTYINO
; OPEN TTY (# IN A)
IMPURE
TNM: SIXBIT /TTY/
PURE
TTYOPE: PUSH P,B
PUSH P,C
PUSH P,D
HRRZ B,A
MOVE D,[360600,,TNM]
IDIVI B,10
ADDI B,20
IDPB B,D
ADDI C,20
IDPB C,D
.CALL [SETZ
SIXBIT /OPEN/
[.UAO,,TTYCHN]
TNM
TNM
SETZ TNM]
JRST TTYOPD
AOS -3(P)
TTYOPD: POP P,D
POP P,C
POP P,B
POPJ P,
; PRINT A PERCENTAGE (AS NN%)
TTYPCT: PUSH P,B
ADDI A,9830.
IDIVI A,19661.
PUSHJ P,TTYDEC
MOVEI A,"%
PUSHJ P,TTYCHR
POP P,B
POPJ P,
; DUMP A CHARACTER
TTYCHR: IDPB A,OUTPTR
AOS OUTCT
POPJ P,
; DUMP ASCIZ
TTYTXT: PUSH P,B
MOVE B,A
HRLI B,440700
TTYTXL: ILDB A,B
JUMPE A,TTYTXO
PUSHJ P,TTYCHR
JRST TTYTXL
TTYTXO: POP P,B
POPJ P,
; NUMBERS (<100)
TTYDEC: PUSH P,[10.]
CAIA
TTYOCT: PUSH P,[8.]
PUSH P,B
PUSH P,C
MOVE C,-2(P)
IMUL C,-2(P)
IDIV A,C
JUMPE A,TTYND1
ADDI A,"0
PUSHJ P,TTYCHR
TTYND1: MOVE A,B
IDIV A,-2(P)
JUMPE A,TTYND2
ADDI A,"0
PUSHJ P,TTYCHR
TTYND2: MOVEI A,"0(B)
PUSHJ P,TTYCHR
POP P,C
POP P,B
SUB P,[1,,1]
POPJ P,
; PRINT A DATE
TTYDAT: PUSH P,B
.CALL [SETZ
SIXBIT /RQDATE/
SETZM B]
JSR LOSE
LDB A,[270400,,B]
PUSHJ P,TTYDEC ; MONTH
MOVEI A,"/
PUSHJ P,TTYCHR
LDB A,[220500,,B] ; DAY
PUSHJ P,TTYDEC
; MOVEI A,"/ ; DON'T DO YEAR
; PUSHJ P,TTYCHR
; LDB A,[330700,,B]
; PUSHJ P,TTYDEC
MOVEI A,40
PUSHJ P,TTYCHR
HRRZ A,B
IDIVI A,7200. ; HOURS IN B
JUMPE A,[MOVEI A,[ASCIZ /00/]
PUSHJ P,TTYTXT
JRST TTYDMN]
PUSHJ P,TTYDEC
TTYDMN: MOVEI A,":
PUSHJ P,TTYCHR
MOVEI A,(B)
IDIVI A,120.
CAIGE A,10.
JRST [PUSH P,A
MOVEI A,"0
PUSHJ P,TTYCHR
POP P,A
PUSHJ P,TTYDEC
JRST TTYDTE]
PUSHJ P,TTYDEC
TTYDTE: POP P,B
POPJ P,
; READ CURSOR POSITION, SAVE AWAY SUITABLY HACKED VERTICAL POS IN
; TPOS TABLE
TTYPOS: .CALL [SETZ
SIXBIT /RCPOS/
MOVEI TTYCHN
SETZM B]
JSR LOSE
HLRZS B ; VERTICAL POS ONLY
SUBI B,1
CAIGE B,1
MOVEI B,1
MOVEM B,TPOS(A) ; SAVED VERTICAL POS, MIN 2
POPJ P,
; STUFFNUMBER IN A INTO LODBUF AS SIXBIT
NUMSTF: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
MOVE D,POWTAB
MOVE C,[440600,,LODBUF]
NUMSL1: IDIV A,(D)
JUMPN A,NUMST2
MOVE A,B
AOBJN D,NUMSL1
NUMST2: ADDI A,20
IDPB A,C
AOBJP D,NUMSLE
MOVE A,B
IDIV A,(D)
JRST NUMST2
NUMSLE: POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
; INITIALIZE BIRTHDAY STUFF
BDINIT: SETZM BDTHER
SETZM BDLINE
SETOM BDNEW
SETZM BDLEN
.CALL [SETZ
SIXBIT /OPEN/
[.UAI,,DSKI]
[SIXBIT /DSK/]
[SIXBIT /BIRTH/]
[SIXBIT /DAYS/]
SETZ [SIXBIT /HUDINI/]]
POPJ P,
.CALL [SETZ
SIXBIT /RFDATE/
MOVEI DSKI
SETZM A]
JSR LOSE
.CALL [SETZ
SIXBIT /RQDATE/
SETZM B]
JSR LOSE
HLRZS A
HLRZS B
CAME A,B
JRST [.CLOSE DSKI,
POPJ P,] ; OLD FILE, DON'T USE IT
MOVEI A,161.
MOVE B,[100700,,BDLINE] ; HACK: FIRST CHAR IS # LINES
.CALL [SETZ
SIXBIT /SIOT/
MOVEI DSKI
B
SETZ A]
JSR LOSE
.CLOSE DSKI,
MOVNS A
ADDI A,160.
JUMPE A,BDINDN
MOVEI C,5
BDINLP: LDB D,B
CAIE D,^C
JRST BDINDN
DBP B
SOJLE A,BDINDN
SOJG C,BDINLP
BDINDN: MOVEM A,BDLEN
MOVE A,BDLINE
IDIVI A,2
MOVEM A,BDLINE
SETOM BDTHER
LOG [ASCIZ /loaded new birthday list./]
POPJ P,
; SET UP BIRTHDAY DATA ON TTY IN A
BDTINI: PUSH P,B
PUSH P,C
PUSH P,D
MOVE B,TLRSV(A)
SUBI B,1
CAME B,BDLINE ; SKIP IF CORRECT # LINES THERE
JRST BDCHAN
JUMPE B,BDTINO ; AND NO BIRTHDAYS TO PRINT
MOVEI B,4
MOVE C,[440700,,[ASCII /TD/]]
.CALL TTYDIS
JSR LOSE
BDPRIN: SKIPN BDLEN
JRST BDTINO
MOVEI B,2
MOVE C,[440700,,[ASCII /L/]]
.CALL TTYDIS
JSR LOSE
MOVE B,BDLEN
MOVE C,[440700,,BDBUF]
.CALL [SETZ
SIXBIT /SIOT/
MOVEI TTYCHN
C
SETZ B]
JSR LOSE
BDTINO: POP P,D
POP P,C
POP P,B
POPJ P,
BDCHAN: SUB B,BDLINE ; B IS CURRENT LINES AVAILABLE
JUMPG B,BDFLUS ; IF TOO MANY LINES, FLUSH SOME.
MOVNS B ; GET # LINES TO ADD
ADDM B,TLRSV(A) ; SO ADD HERE
ADDM B,TPOS(A)
PUSH P,B
MOVE B,TTYP(A)
CAIN B,CHECK
JRST [MOVEI B,2
IMUL B,(P)
MOVEI B,4(B) ; RIGHT # CHARS
MOVE C,[440700,,[ASCII /TD[[/]]
.CALL TTYDIS
JSR LOSE
POP P,B
JRST BDPRIN]
MOVE C,[440700,,[ASCII /TD/]]
MOVEI B,4
.CALL TTYDIS
JSR LOSE
MOVE C,TTYP(A)
CAIE C,VT100
JRST [MOVE C,[440700,,[ASCII /LL/]]
MOVEI B,32.
IMUL B,(P)
.CALL TTYSIO
JSR LOSE
JRST BDCHNO]
MOVE C,[440700,,[ASCII /</]]
MOVEI B,15.
.CALL TTYSIO
JSR LOSE
MOVEI B,32.
IMUL B,(P)
MOVE C,[440700,,[ASCII /MM/]]
.CALL TTYSIO
JSR LOSE
MOVE C,[440700,,[ASCII /[?2lY! /]]
MOVEI B,12.
.CALL TTYSIO
JSR LOSE
BDCHNO: POP P,B
JRST BDPRIN
BDFLUS: PUSH P,B
MOVNS B ; B HAS # LINES TO FLUSH
ADDM B,TPOS(A)
ADDM B,TLRSV(A)
MOVE B,TTYP(A)
CAIN B,CHECK
JRST [MOVEI B,2
IMUL B,(P)
MOVEI B,4(B)
MOVE C,[440700,,[ASCII /TD\\/]]
.CALL TTYDIS
JSR LOSE
JRST BDFLUO]
CAIN B,HEATH
JRST BDFLUH
MOVE C,[440700,,[ASCII /Z/]]
MOVEI B,2
.CALL TTYDIS
JSR LOSE
MOVE C,[440700,,[ASCII /<DD/]]
MOVEI B,2
IMUL B,(P)
MOVEI B,14.(B)
.CALL TTYSIO
JSR LOSE
MOVE C,[440700,,[ASCII /[?2lY! /]]
MOVEI B,12.
.CALL TTYSIO
JSR LOSE
BDFLUO: POP P,B
JRST BDPRIN
BDFLUH: MOVE C,[440700,,[ASCII /TD/]]
MOVEI B,4
.CALL TTYDIS
JSR LOSE
MOVE C,[440700,,[ASCII /MM/]]
MOVEI B,32.
IMUL B,(P)
.CALL TTYSIO
JSR LOSE
JRST BDFLUO
TTYDIS: SETZ
SIXBIT /SIOT/
MOVSI %TJDIS
MOVEI TTYCHN
C
SETZ B
TTYSIO: SETZ
SIXBIT /SIOT/
MOVSI %TJSIO
MOVEI TTYCHN
C
SETZ B
SUBTTL Core allocator
; Takes pointer,,# pages in A. Returns page # in A, or dies if
; can't find enough. Maintains table of pages:
; -1,,n free
; 0 static
; pointer,,n allocated
; `pointer' is pointer to location to update if this page has to be moved
; to make room for a large block. `n' is sequence number: a block of 2
; free pages will have entries -1,,2 and -1,,1.
PGFIND: PUSH P,A
PUSH P,B
PUSH P,C
HRLZI B,-NPAGES
HRRZS A
SKIPN A
JSR LOSE
PGFLOP: SKIPL C,PAGTAB(B)
JRST USEDPG
HRRZS C
CAIGE C,(A)
JRST USEDPG
HLRZ C,-2(P)
HRRZM B,(C)
HRRZ A,B
LSH A,12
MOVEM A,1(C)
MOVE C,-2(P)
PGULOP: MOVEM C,PAGTAB(B)
ADDI B,1
SUBI C,1
TRNE C,-1
JRST PGULOP
POP P,C
POP P,B
POP P,A
POPJ P,
USEDPG: JUMPE C,MAINPG
PUSH P,A
HRR A,C
HRLS A
ADD B,A
POP P,A
JUMPL B,PGFLOP
JSR LOSE
MAINPG: AOBJN B,PGFLOP
JSR LOSE
PGGIVE: PUSH P,A
PUSH P,B
PUSH P,C
SKIPL A
CAILE A,NPAGES
JSR LOSE
SKIPG B,PAGTAB(A)
JSR LOSE
TLZ B,-1 ; # PAGES IN BLOCK
ADD A,B
SKIPL C,PAGTAB(A) ; NEXT ENTRY
JRST [MOVE C,B
JRST PGGIV1] ; NOT FREE
ADD C,B ; # PAGES IN FREE BLOCK
PGGIV1: TLO C,-1 ; FREE INDICATOR
MOVE A,-2(P)
PGGLOP: MOVEM C,PAGTAB(A)
ADDI A,1
SUBI C,1
SOJG B,PGGLOP
SKIPG A,-2(P)
JRST PGGDON
HRRZ B,PAGTAB(A)
SUBI A,1
PGGIV2: SKIPL PAGTAB(A)
JRST PGGDON
ADDM B,PAGTAB(A)
SOJG A,PGGIV2
PGGDON: POP P,C
POP P,B
POP P,A
POPJ P,
CONSTA
PUREND==. ; LAST WORD OF PURENESS
IMPURE
VARIAB
; CONSTANTS AND TABLE FOR PAGE ALLOCATOR
MAPPNB==<PUREND+1777>/2000
MAPPNE==SYSPAG-1
IMPEND==.+SYSPAG
IMPENP==<IMPEND+1777>/2000
PURBEP==<<PURBEG+1777>/2000>
PURENP==MAPPNB
NPAGES=SYSPAG
FREBL1==PURBEP-IMPENP
FREBL2==MAPPNE-PURENP
PAGTAB: BLOCK IMPENP
REPEAT FREBL1,[-1,,FREBL1-.RPCNT
]
BLOCK PURENP-PURBEP
REPEAT FREBL2,[-1,,FREBL2-.RPCNT
]
END START
Reference in New Issue View Git Blame Copy Permalink