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 //]] 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 ; , 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,<_-12>-<_-12> JUMPE B,INIPUR JUMPL B,[.VALUE] HRLOI B,-1(B) EQVI B,_-12 ; AOBJN POINTER TO PAGES TO FLUSH .CALL [SETZ SIXBIT /CORBLK/ MOVEI 0 MOVEI %JSELF SETZ B] JFCL INIPUR: HRLOI A,<<_-12>-<_-12>>-1 EQVI A,_-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, 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 -<.-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: -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)ī 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,[Ķ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 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,[Ķ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 subject message ] JRST RLOGS] SOUT DSKO,[Ķ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 subject message ] 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==/2000 MAPPNE==SYSPAG-1 IMPEND==.+SYSPAG IMPENP==/2000 PURBEP==</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