zork-1978-01/zork/ar1.random/gunner.94

TITLE GUNNER

; 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.
;  other demons are just gunned down; mail is sent to mb.
;  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.
O=0
A=1
B=2
C=3
D=4
E=5
F=6
G=7
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

; CHANNELS
DSKI==0
DSKO==1
USRI==2
USRO==3

; PAGE FOR RANDOM MAPPING
MAPPAG=100.
MAPBEG=MAPPAG*2000

; 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
NXTRUN==1
INTRVL==2
ITERS==3
PLEN==4			; 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]
	 .LOSE	1000
TERMIN

LOC	42
	JSR	TSINT
LOC	100

SUBTTL	VARIABLES

LOC44:	0
MPVFLG:	0		; MPV MIGHT HAPPEN BECAUSE DOING UNLOCKING
DEBUGF:	0		; DEBUGGING
SYSVER:	0		; SYSTEM VERSION
SLPTIM:	0		; TIME TO SLEEP
TIMLFT:	0		; TIME LEFT BEFORE GOING AWAY (IN 30'THS)
CMIN:	0		; USED TO ACCUMULATE NEXT SLPTIM
LUNAME:	0		; CONTAINS UNAME OF MUNGED JOB
LJNAME:	0		; JNAME
DUNAME:	0		; UNAME OF JOB WHEN DISOWNED
DJNAME:	0		; JNAME

; SWITCHES USED WHEN SENDING MAIL.  ZEROED WHENEVER DEMON FOUND TO HACK.
BLTBEG:
SNDTWO:	0		; -1 WHEN HAVE SENT FIRST MAIL (TO DEMON OWNER)
GOTJOB:	0		; -1 IF WE HAVE JOB AS INFERIOR
BADUPC:	0		; PC WHEN GUNNED
VALLEN:	0		; LENGTH OF .VALUE STRING, OR 0
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.
SNDSAV:	0		; SAVED P, IN CASE IOC ERROR WHEN SENDING MAIL.
VALBLN==20.
VALBUF:	BLOCK	VALBLN	; BUFFER FOR .VALUE STRINGS, IF APPLICABLE.
; TABLE OF DEMON OWNERS:  WHOM SHALL I SEND TO?
OWNTAB:
COMNAM:	SIXBIT	/COMSYS/
	SIXBIT	/PDL/
ZONNAM:	SIXBIT	/ZONE/
	SIXBIT	/CLR/
BATNAM:	SIXBIT	/BATCHN/
	SIXBIT	/SWG/
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

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==20
PDL:	BLOCK	PDLLEN
INBLEN==100.
INBUF:	BLOCK	INBLEN/5
INBPTR:	440700,,INBUF

PTABLE:	PUSHJ P,DEMSCN ? 0 ? <15.*60.>*30. ? 0
	PUSHJ P,MSCAN ? 0 ? 0 ? 0
PPTR:	PTABLE-.,,PTABLE

SUBTTL	STARTUP & MAIN LOOP

START:	.CLOSE	1,		; SINCE DEMON STILL HAS CHANNEL FOR SYMBOLS
	MOVE	P,[-PDLLEN,,PDL]
	PUSHJ	P,SETUP		; WILL SKIP IF DEMON SHOULD STAY UP
	 .LOGOUT
	.CALL	[SETZ
		 SIXBIT	/LOGIN/
		 [SIXBIT /GUNNER/]
		 SETZ	[0]]
	 SETOM	DEBUGF
	.SUSET	[.SMASK,,[%PIIOC+%PIMPV]]
	.SUSET	[.SMSK2,,[377,,0]]
	.RSYSI	A,		; GET SYSTEM VERSION
	CAME	A,SYSVER
	 JRST	INIT		; GO INITIALIZE
BEGIN:	SKIPE	DEBUGF
	 PUSHJ	P,DEBUG
MLOOP:	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
	XCT	PROCES(PBLOCK)		; RUN IT
	MOVE	A,INTRVL(PBLOCK)	; TIME TO NEXT RUN, SINCE JUST RAN
	AOS	ITERS(PBLOCK)
PEND:	CAMG	A,CMIN		; SHORTEST TIME SO FAR?
	 MOVEM	A,CMIN		; YES
	MOVEM	A,NXTRUN(PBLOCK)
	ADD	PBLOCK,[PLEN,,PLEN]
	JUMPL	PBLOCK,PLOOP	; DONE?
	MOVE	A,TIMLFT
	SUB	A,SLPTIM
	MOVEM	A,TIMLFT
	MOVE	A,CMIN
	MOVEM	A,SLPTIM
	CAMLE	A,TIMLFT
	 JRST	[PUSHJ	P,SETUP	; MAYBE DONE
		  .LOGOUT
		 JRST	.+1]
	.SLEEP	A,
	JRST	MLOOP

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
	PUSHJ	P,LSINIT	; MAKE AN ENTRY IN LOSTBL FOR IT, OR FIND EXISTING
	SKIPL	@APRC		; TEST SIGN BIT OF APRC:  SET IF DISOWNED
	 JRST	ZONHAK		; GO CHECK FOR COMBAT OVERTIME
	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.
	SKIPGE	WINCT(LOSTBL)	; HAVE WE DISABLED IT?
	 POPJ	P,		; YES
	SETZM	BLTBEG		; NO, SO CLOBBER MAIL SWITCHES
	MOVE	A,[BLTBEG,,BLTBEG+1]
	BLT	A,BLTEND	; ZERO SWITCHES
	MOVE	A,@UNAME
	MOVEM	A,LUNAME	; SAVE DEAD JOB'S UNAME
	MOVE	A,@JNAME
	MOVEM	A,LJNAME	; AND JNAME
	MOVE	A,@UPC		; AND UPC
	MOVEM	A,BADUPC
	PUSHJ	P,GETJOB	; OWN JOB
	 JRST	WINCHK
	PUSHJ	P,VALCHK	; CHECK FOR .VALUE
WINCHK:	PUSHJ	P,WINNER	; GO SEE IF I'M A LOSER
	 JRST	DISABL		; YES, SO DISABLE ME
	CAMN	DEM,[SIXBIT /COMSYS/]
	 JRST	COMHAK
	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
	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
	SETOM	WINCT(LOSTBL)	; CLOBBER ENTRY IN TABLE
	MOVEI	A,0
	PUSHJ	P,SNDMAL
	.DISOWN	USRI,
	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	RECONS		; DEMON WAS DISABLED LAST TIME, SO WE NEED TO 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, EITHER AFTER RECONSAGE OR AFTER 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	STATS CODE

; 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
	.VALUE			; 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)
	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]]
	 .VALUE
	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
	TLNN	D,-1
	 HRLI	D,476000
	HLL	A,D		; CONS THE 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), THE PERCEPTIVE
; OBSERVER WILL NOTICE THAT IF 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:  MORE THAN WHATEVER RUNTIMER WAS SET FOR.
ZONHAK:	CAME	DEM,[SIXBIT /ZONE/]
	 JRST	DEMWIN
	MOVE	B,@UTRNTM		; GET RUN TIME
	CAMG	B,[250000.*60.*5]	; GREATER THAN FIVE MINUTES? (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	GUNNED
	SETOM	OVERTI
	MOVE	A,@UNAME
	MOVEM	A,LUNAME
	MOVE	A,@JNAME
	MOVEM	A,LJNAME
	JRST	ZONHK2
; FLUSH COMBAT, RENAME APPROPRIATE PLAN, ETC.
ZONHK1:	SKIPN	GOTJOB
	 SETOM	GUNNED
ZONHK2:	SETOM	COMBAT
	HLRO	A,LUNAME
	CAMN	A,[-1]			; WAS THE CROCK LOGGED IN?
	 JRST	RESTAR
	MOVE	A,PLNNAM
RNMLP:	.CALL	[SETZ			; DON'T CHASE LINKS
		 SIXBIT	/OPEN/
		 [.UAI+<1_4>,,DSKI]
		 [SIXBIT /DSK/]
		 (A)
		 [SIXBIT /</]
		 SETZ	[SIXBIT /COMBAT/]]
	 JRST	[AOBJN	A,RNMLP
		 JRST	RESTAR]
	.CALL	[SETZ
		 SIXBIT	/FILBLK/
		 MOVEI	DSKI
		 MOVEM	FN1
		 MOVEM	FN2
		 SETZM	A]
	 .LOSE	1000
	TLNE	A,1			; TEST LINK BIT
	 JRST	
	MOVEI	C,INBLEN
	MOVE	D,INBPTR
	.CALL	[SETZ
		 SIXBIT	/SIOT/
		 MOVEI	DSKI
		 D
		 SETZ	C]
	 .LOSE	1000
	MOVEI	C,INBLEN
	MOVE	D,INBPTR
NMLOOP:	ILDB	E,D
	CAIN	E,""				; LOOK FOR QUOTES
	 JRST	RNMNAM
	SOJGE	C,NMLOOP
	JRST	RESTAR				; DIDN'T FIND IT, SO GO TO RESTART
RNMNAM:	MOVE	F,[440600,,G]
	MOVEI	G,0
SIXLOP:	ILDB	E,D
	CAIN	E,""
	 JRST	SIXLP1
	SUBI	E,40
	CAIL	E,100
	 SUBI	E,40
	IDPB	E,F
	TLNE	F,770000
	 JRST	SIXLOP
SIXLP1:	MOVEM	G,LOSER				; SO THE CHOMPER CAN BE TOLD.
DORENM:	.CALL	[SETZ
		 SIXBIT	/RENAME/
		 [SIXBIT /DSK/]
		 FN1
		 FN2
		 [SIXBIT /COMBAT/]
		 [SIXBIT /GUNNED/]
		 SETZ	[SIXBIT />/]]
	 JRST	RESTAR
	SKIPN	LOSER
	 JRST	RESTAR
	.CALL	[SETZ
		 SIXBIT	/RFNAME/
		 MOVEI	DSKI
		 MOVEM
		 MOVEM
		 SETZM	RFN2]
	 .LOSE	1000

; COME HERE TO SEND OUT MAIL AND RESTART DEMON.
RESTAR:	SKIPN	GUNNED
	 PUSHJ	P,DISJOB
	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 THAT ARE AROUND
DISJO1:	.DISOWN	USRI,
	 JFCL
	.CALL	[SETZ
		 SIXBIT	/STDMST/
		 DEM
		 [-1]
		 SETZI	0]
	 JFCL
	.CALL	DEMSIG
	 JFCL
	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	B,@SV40			; HAS LAST UUO, WITH EFFECTIVE ADDRESS
	LDB	A,[301400,,B]		; GET OPCODE IN B
	CAIE	A,0432			; FOR .VALUE
	 JRST	VALCOT
GETVST:	TLZ	B,-1			; TURN OFF LH, LEAVING ONLY EFFECTIVE ADDRESS
	JUMPE	B,VALCOT
	.ACCESS	USRI,B
	MOVE	A,[-VALBLN,,VALBUF]
	.IOT	USRI,A
	MOVE	B,[440700,,VALBUF]
	MOVEI	A,0
VALLOP:	ILDB	C,B
	JUMPE	C,VALLOT
	AOJA	A,VALLOP
VALLOT:	MOVEM	A,VALLEN
VALCOT:	POP	P,C
	POP	P,B
POPAJ:	POP	P,A
	POPJ	P,

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
	PUSHJ	P,APTOFI		; GET TO END OF MAIL FILE
	 POPJ	P,
	SOUT	DSKO,[
From GUNNER  ]
	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	B,VALLEN
	 JRST	[SOUT	DSKO,[
.VALUE with UPC ]
		 MOVE	A,BADUPC
		 PUSHJ	P,OCPRNT
		 SOUT	DSKO,[:
]
		 MOVE	A,[440700,,VALBUF]
		 .CALL	[SETZ
			 SIXBIT	/SIOT/
			 MOVEI	DSKO
			 A
			 SETZ	B]
		  .LOSE	1000
		 SOUT	DSKO,[
]
		 JRST	SNDFAT]
	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
	CAIN	A,1
	 .IOT	DSKO,["s]
	SOUT	DSKO,[ unlocked.
]
CKBAT:	SKIPN	A,CHNKIL
	 JRST	CKBAT1
	PUSHJ	P,DCPRNT
	SOUT	DSKO,[ channel]
	MOVE	A,CHNKIL
	CAIN	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
	CAIN	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,
	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 /MB/]
	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]
	 .LOSE	1000
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
	CAILE	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:	1000000. ? 100000. ? 10000. ? 1000. ? 100. ? 10. ? 1.
POWTAB:	PT-.,,PT
OT:	1000000 ? 100000 ? 10000 ? 1000 ? 100 ? 10 ? 1
OCTTAB:	OT-.,,OT


; OPEN <FOO>;<BAR> <BLETCH>, WHERE ARGS ARE (P), -1(P), -2(P).  SKIPS IF SUCCESSFUL.
APTOFI:	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	PUSH	P,E
	MOVNI	B,2
	MOVEM	B,APCNT
APTOF1:	.CALL	[SETZ
		 SIXBIT	/OPEN/
		 [.BII,,DSKI]
		 [SIXBIT /DSK/]
		 MOVE	-6(P)
		 MOVE	-7(P)
		 MOVE	-5(P)
		 SETZB	B]
	 JRST	APERCK
	.CALL	[SETZ
		 SIXBIT	/FILLEN/
		 MOVEI	DSKI
		 SETZM	C]
	 .LOSE	1000
	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.


SUBTTL	INITIALIZATION

; SET UP FOR DEBUGGING--STOP GUNNER IF UP; KEEP IT FROM COMING UP IF
; NOT
DEBUG:	.CALL	[SETZ
		 SIXBIT	/OPEN/
		 [.BII,,USRI]
		 [SIXBIT /USR/]
		 [SIXBIT /GUNNER/]
		 SETZ	[SIXBIT	/GUNNER/]]
	 JRST	KEEPDN
	.USET	USRI,[.RUIND,,A]	; GET USER INDEX
	IMUL	A,L
	ADD	A,USTP1			; LOCATION OF USTP WORD
	HRLI	A,[0 ? BUSRC,,0]	; BLOCK FOR IFSET
	.IFSET	A,
	 .LOSE	1000
KEEPDN:	.CALL	[SETZ
		 SIXBIT	/OPEN/
		 [.BIO,,DSKO]
		 [SIXBIT /DSK/]
		 [SIXBIT /GUNNER/]
		 [SIXBIT /DOWN/]
		 SETZ	[SIXBIT /COMBAT/]]
	 .LOSE	1400
	.CLOSE	DSKO,
	POPJ	P,

; COME HERE TO DO PROPER STDMST'S, ETC., DECIDE IF DEMON SHOULD STAY
; UP (SKIP IF IT SHOULD).
; DEMON IS DEFINED TO RUN FROM 6PM-9AM, WEEKENDS, HOLIDAYS.  COMPUTES
; TIME REQUIRED TO RUN UNTIL IT KNOWS IT SHOULD GO DOWN.  BEFORE
; GOING DOWN, IT CHECKS AGAIN.

SETUP:	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	.CALL	[SETZ
		 SIXBIT	/OPEN/
		 [.BII,,DSKI]
		 [SIXBIT /DSK/]
		 [SIXBIT /GUNNER/]
		 [SIXBIT /DOWN/]
		 SETZ	[SIXBIT	/COMBAT/]]
	 JRST	SETUP2		; FILE DOESN'T EXIST, SO MIGHT COME UP
	.CLOSE	DSKI,
	JRST	SETUPO
SETUP2:	.CALL	[SETZ
		 SIXBIT	/RQDATE/
		 SETZM	A]
	 .LOSE	1000
	HRRZ	B,A
	CAIL	B,2*3600.*18.	; IS IT PAST 6 PM?
	 JRST	[MOVEI	C,2*3600.*24.
		 SUB	C,B	; NUMBER OF HALF-SECS LEFT TODAY
		 ADDI	C,<2*3600.*9.>+<120.*14.>
		 JRST	SETUP1]	; HAVE # HALF-SECONDS TO STAY UP, SO GO DO IT.
	CAIGE	B,2*3600.*9.	; BEFORE 9AM?
	 JRST	[MOVEI	C,<2*3600.*9.>+<120.*14.>
		 SUB	C,B
		 JRST	SETUP1]
	.RYEAR	A,
	LDB	A,[320300,,A]	; GET DAY OF WEEK
	JUMPE	A,WEKEND
	CAIN	A,6
	 JRST	WEKEND
	.RDATE	A,
	.CALL	[SETZ
		 SIXBIT	/OPEN/
		 [.BII,,DSKI]
		 [SIXBIT /DSK/]
		 [SIXBIT /HLIDAY/]
		 A
		 SETZ	[SIXBIT	/COMBAT/]]
	 JRST	STDOWN
	.CLOSE	DSKI,
WEKEND:	MOVEI	C,<2*3600.*24.>+<2*3600.*9.>+<120.*14.>
	SUB	C,B
; NUMBER OF HALF-SECONDS TO STAY UP IS IN C.
SETUP1:	IMULI	C,15.		; CONVERT TO 30THS
	MOVEM	C,TIMLFT	; TIME LEFT TO RUN
	.CALL	[SETZ
		 SIXBIT	/STDMST/
		 [SIXBIT /GUNNER/]
		 [<24.*30.>,,1]
		 SETZI	<24.*30.>]
	 .LOSE	1000
	AOS	-4(P)
SETUPO:	POP	P,D
	POP	P,C
	POP	P,B
	POP	P,A
	POPJ	P,
	
; COME HERE IF WANT TO STAY DOWN.
STDOWN:	MOVEI	A,<18.*2.*3600.>+<2*120.>	; SIX PM+EPSILON
	SUB	A,B			; HALF-SEC UNTIL 6
	IDIVI	A,240.			; TWO MIN. UNTIL 6
	.CALL	[SETZ
		 SIXBIT	/STDMST/
		 [SIXBIT /GUNNER/]
		 [<24.*30.>,,0]
		 SETZ	A]
	 .LOSE	1000
	JRST	SETUPO

; 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.

INIT:	MOVEM	A,SYSVER
	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,[-200,,200]
	MOVEI	B,0
	.CALL	[SETZ
		 SIXBIT	/CORBLK/
		 MOVEI	%CBRED
		 MOVEI	%JSELF
		 A
		 MOVEI	%JSABS
		 SETZ	B]
	 .LOSE	1000
	JRST	BEGIN

; TABLES FOR EVAL

; 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,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,40ADDR
40ADDR:	0
USRVAR:	USRTAB-.,,USRTAB

; GROUP 2: VALUE SAVED HAS 400000 ADDED.  REFERS TO ABSOLUTE LOCATIONS IN SYSTEM
SYSTAB:	SQUOZE	0,DMTTBL
DMTTBL:	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
SYSCON:	SYSCTB-.,,SYSCTB
DEMTAB:	0			; AOBJN POINTER TO DEMON TABLE

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+31
IDSPTR=IOFF+602
AMAZE=IOFF+665
UNMPTR=IOFF+1757

MSCAN:	MOVEI	A,400002	; MAYBE SOMEDAY THIS WILL BE HAND-CRAFTED
	SETZM	GOT
LOOP:	.CALL	[SETZ
		 SIXBIT	/CORBLK/
		 MOVEI	%CBNDW
		 MOVEI	%JSELF
		 MOVEI	MAPPAG
		 A
		 SETZI	2]
	 JRST	LOOP1
	MOVE	B,ADDRS
TSTLUP:	MOVE	O,1(B)
	MOVE	C,(B)
	CAME	O,(C)
	 JRST	LOOP1
	AOS	B
	AOBJN	B,TSTLUP
GOTIT:	MOVE	D,[START,,GPSPTR]
	BLT	D,GBSPTR
	SETOM	GOT
	SETOM	GOT1
	AOS	GOTCT
	PUSH	P,[SIXBIT /LOADED/]
	PUSH	P,[SIXBIT /_TTYS_/]
	PUSH	P,[SIXBIT /IMLAC/]
	PUSHJ	P,APTOFI
	 JRST	MSCHED			; 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]
	 .LOSE	1000
	JRST	MSCHED

LOOP1:	CAIGE	A,400000+60.
	 AOJA	A,LOOP
MSCHED:	SKIPE	GOT
	 JRST	[MOVEI	A,<300.*30.>	; FIVE MINUTES
		 JRST	MSCHE1]
	SKIPE	GOT1
	 JRST	[SETZM	GOT1		; IF GOT ONE LAST TIME, 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
	POPJ	P,

SUBTTL	INTERRUPT HANDLER

TSINT:	0
TSINTR:	0
	EXCH	A,TSINT
	JUMPL	A,TSWRD2
	TRNN	A,%PIIOC	; IOC INTERRUPT?
	 JRST	TSMPVQ
	SKIPN	SNDSAV		; WRITING TO DISK?
	 JRST	FATAL1		; NO, SO CHOMP
	.DISMIS	[.+1]
	.CLOSE	DSKI,		; FLUSH EVERYTHING
	.CLOSE	DSKO,
	MOVE	P,SNDSAV
	SETZM	SNDSAV
	EXCH	A,TSINT
	POPJ	P,
TSMPVQ:	SKIPN	MPVFLG
	 JRST	FATAL
	EXCH	A,TSINT
	.DISMIS	[COMDON]	; FORGET IT
FATAL:	
FATAL1:	.VALUE

TSWRD2:	TLNN	A,377		; INFERIOR INTERRUPT
	 JRST	TSOUT
	.USET	USRO,[.RPIRQC,,A]
	TRNN	A,%PIBRK
	 JRST	[TDNN	A,[%PIWRO+%PIPAR+%PIMPV+%PIILO]
		  JRST	FATAL
		 JRST	TSMPVQ]	; IF INFERIOR GOT SOMETHING LIKE THIS, UNLOCK CHECK
	SETZM	INFRUN
TSOUT:	EXCH	A,TSINT
	.DISMIS	TSINTR

END	START