Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - utilities/fortune.mid
There are no other files named fortune.mid in the archive.
TITLE BYE

O=0
Z=0
A=1
B=2
C=3
D=4
E=5
F=6
G=7
RDTIM=15	; how long system has been up
CNT=16
P=17

SPD=24.*60.*60.

INSIZ==100.	; input buffer size
OUTSIZ==100.	; output buffer size
PDLSIZ==20	; pdl
ISIZ==600

TYI==1		; TTY input
TYO==2		; TTY output
DSKI==3		; fortune file
IDX==4		; index file input
ODX==5		; index file output

PRINT=1000,,	; useful uuo

IF1,[ITS==0
     PRINTC /BYE for ITS? (Y OR N)/
     .TTYMAC A
     IFSE A,Y,[ITS==1]
     TERMIN
]

IF1,[
  IFE ITS,[
	.TNXDF
	.DECSAV
]]
LOC 41
	JSR UUOH
IFN ITS,[
	JSR TSINT
]
LOC 140
JCL:	BLOCK	10
XSNAME:	BLOCK	10
DISK:	SIXBIT "DSK"
BYEFIL:	SIXBIT "LNS"
	SIXBIT ".BYE."
BYESNM:	SIXBIT "USERS1"
IDXFIL:	SIXBIT "INDEX"
	SIXBIT ".BYE."
IDXTMP:	SIXBIT "_TEMP_"
IDXNAM:	0				; -1 when hacking index file name in jcl
NAME1:	0
CLEARS:	0				; -1-->clear screen before printing
NOTOMO:	0				; funny first line

START:	MOVE	P,[-PDLSIZ,,PDL-1]
IFN ITS,[.SUSET	[.SMSK2,,[<1_TYI>]]
	.OPEN	TYO,.+1
	 (1+SIXBIT /TTY/)
	.OPEN	TYI,.+1
	 (SIXBIT /TTY/)
	.SUSET	[.ROPTIO,,A]
	TLNE	A,OPTCMD
	 PUSHJ	P,JCLHAK		; GO HACK JCL
	.SUSET	[.RXUNAM,,A]
	CAMG	A,[-1]
	CAMGE	A,[-1,,0]
	 SKIPA
	HRRI	A,-1
	MOVEM	A,FOO
	.CALL	[SETZ ? 'SSTATU ? MOVEM ? MOVEM ? MOVEM ? MOVEM
		 SETZM	RDTIM]	;  time system up
	 JRST NOREC
; see if record-breaking uptime
CHKREC:	.CALL	RECORD
	 JRST	NOREC
	.CALL	GETREC
	 JRST	NOREC
	TLNE	A,177000
	 JRST	NOREC	;SYSTEM DOESN'T STAY UP FOR YEARS ON END
	LDB	B,[220500,,A]	;GET NUMBER OF DAYS
	IMULI	B,<SPD*2>
	ADDI	B,(A)		;B := PREVIOUS RECORD IN HALF SEC
	IMULI	B,15.		;CONVERT TO JIFFIES
	CAML	B,RDTIM
	 JRST	NOREC
	MOVE	A,RDTIM		;NEW RECORD!  STORE ON DISK
	IDIVI	A,15.
	IDIVI	A,<SPD*2>
	HRLZ	A,A		;DAYS IN LH
	HRR	A,B			;1/2 SECONDS IN RH
	.CALL	SETREC
	 JFCL
	.CLOSE	17,
]
IFE ITS,[
	RESET
	PUSHJ	P,JCLHAK
	SETO	A,
	MOVE	B,[-1,,D]
	MOVEI	C,2
	GETJI
	 HALTF
	MOVE	B,D
	HRROI	A,USRNM
	DIRST
	 HALTF
	MOVE	A,[440700,,USRNM]
USRLP0:	MOVE	B,[440600,,FOO]
	SETZM	FOO
USRLP:	ILDB	C,A
	CAIN	C,".
	 JRST	USRLP0
	JUMPE	C,NOREC
	ADDI	C,"A-'A
	TLNE	B,770000
	IDPB	C,B
	JRST	USRLP
]

; "Say goodnight, Dick"  "Goodnight, Dick"
NOREC:	SKIPN	CLEARS
	 JRST	NOREC1
IFN ITS,[
	MOVE	A,[440700,,[ASCII /C/]]
	MOVEI	B,2
	.CALL	[SETZ
		 SIXBIT	/SIOT/
		 MOVSI	%TJDIS
		 MOVEI	TYO
		 A
		 SETZ	B]
	 .LOSE	1000
]
IFE ITS,[
	MOVEI	1,.PRIOU	;ENTER HERE FOR THINGS THAT BLANK INCIDENTALLY
	RFMOD			;CHANGE TO
	PUSH	P,2
	TRZ	2,TT%DAM	;BINARY MODE
	SFMOD
	GTTYP
	HRROI	1,BLNKTB(2)	;GET RIGHT MAGIC
	PSOUT
	MOVEI	1,.PRIOU
	POP	P,2
	SFMOD
]

NOREC1:	
IFN ITS,[
	PRINT	[ASCIZ /
/]
.RTIME	A,
]
IFE ITS,[
	SETZB	A,D
	SETO	B,
	ODCNV
	HRRZM	C,DOW'
	MOVE	Z,[440600,,A]
	HRRZ	B,D			; GET THE SECS PAST MIDNIGHT
	IDIVI	B,3600.
	PUSHJ	P,DSTUFF
	MOVE	B,C
	IDIVI	B,60.
	PUSHJ	P,DSTUFF
]
	CAMG	A,[SIXBIT /180000/]
	 JRST	.+3
	PRINT	[ASCIZ /Good night, /]
	 JRST	GEND
	CAMG	A,[SIXBIT /164500/]
	 JRST	AFTERN
	SKIPE	NOTOMO
	 JRST	[PRINT	[ASCIZ /So long, /]
		 JRST	GEND]
	PRINT	[ASCIZ /See you /]
IFN ITS,[
	.RYEAR	A,
	LDB	A,[320300,,A]
]
IFE ITS,[
	MOVE	A,DOW
	ADDI	A,1
]
	PRINT	@WEEK(A)
	PRINT	[ASCIZ /day, /]
	JRST	GEND

IFE ITS,[
DSTUFF:	PUSH	P,C
	IDIVI	B,10.
	ADDI	B,'0
	IDPB	B,Z
	ADDI	C,'0
	IDPB	C,Z
	POP	P,C
	POPJ	P,
]

AFTERN:	CAMG	A,[SIXBIT /120000/]
	 JRST	.+3
	PRINT	[ASCIZ /Good afternoon, /]
	JRST	GEND
	CAMG	A,[SIXBIT /112000/]
	 JRST	.+3
	PRINT	[ASCIZ /Enjoy your lunch, /]
	JRST	GEND
	CAMG	A,[SIXBIT /070000/]
	 JRST	.+3
	PRINT	[ASCIZ /Good morning, /]
	JRST	GEND
	CAMG	A,[SIXBIT /040000/]
	 JRST	.+3
	PRINT	[ASCIZ /You're here either awfully early or awfully late, /]
	JRST	GEND
	PRINT	[ASCIZ /Hope you get a good night's sleep, /]

; print uname or nickname of loser
GEND:	PUSHJ	P,UNMOUT
	PRINT	[ASCIZ / ... /]

FORTUN:	PUSHJ	P,FILEO
	PUSHJ	P,BEGR		;MOVE THRU FILE FROM ACCESS TO A NEW FORTUNE AND PRINT
IFN ITS,[
	.CALL	[SETZ
		SIXBIT /CNSGET/
		1000,,TYO
		2000,,RES1
		2000,,RES2
		2000,,RES3
		2000,,RES4
		402000,,RES5]
	.VALUE [ASCIZ /:BUG!  PLEASE REPORT TO NUL:
/]
	MOVE	A,RES3
	CAIE	A,5	;SKIP IF TV
	 JRST	EXIT
	ADDI	C,35.*2
	.SLEEP	C,
]
EXIT:	
IFN ITS,[
	.BREAK	16,124000
]
IFE ITS,[
	HALTF
	JRST	START
]

IFN ITS,[
FILEO:	.CALL	[SETZ
		 SIXBIT "OPEN"
		 ["&,,DSKI]
		 DISK
		 BYEFIL
		 BYEFIL+1
		 BYESNM
		 SETZB LSTERR]
	 JRST	EXIT
	.CALL	[SETZ
		 SIXBIT "OPEN"
		 ["&,,IDX]
		 DISK
		 IDXFIL
		 IDXFIL+1
		 BYESNM
		 SETZB LSTERR]
	 JRST	NEWIDX		; no index file at all!!!

	.CALL	[SETZ
		 SIXBIT "RFDATE"
		 MOVEI DSKI
		 MOVEM A
		 SETZB LSTERR]
	 JRST	EXIT
	.CALL	[SETZ
		 SIXBIT "RFDATE"
		 MOVEI IDX
		 MOVEM B
		 SETZB LSTERR]
	 JRST	EXIT
	CAML	A,B		; index created after file?
	 JRST	NEWIDX
	.CALL	[SETZ
		SIXBIT /FILLEN/
		1000,,IDX
		402000,,NWDS']
	 JRST	EXIT
CPOPJ:	POPJ P,
]

IFE ITS,[
FILEO:	MOVEI	A,GTJBYE
	MOVSI	B,(GJ%OLD)
	MOVEM	B,GTJIDX
	MOVE	B,F1PTR
	GTJFN
	 HALTF
	MOVE	B,[444400,,OF%RD]
	OPENF
	 HALTF
	MOVEM	A,BYEJFN'
	MOVEI	A,GTJIDX
	MOVE	B,F2PTR
	GTJFN
	 JRST	NEWIDX
	MOVE	B,[444400,,OF%RD]
	OPENF
	 HALTF
	MOVEM	A,IDXJFN'
	MOVEI	B,D
	MOVEI	C,1
	RFTAD
	MOVE	A,BYEJFN
	MOVEI	B,E
	RFTAD
	CAMGE	D,E
	 JRST	NEWIDX
	MOVE	A,IDXJFN
	SIZEF
	 HALTF
	MOVEM	B,NWDS'
CPOPJ:	POPJ	P,

GTJBYE:	GJ%OLD
	.NULIO,,.NULIO
	0
	-1,,BYEDIR
	-1,,BYEFN1
	-1,,BYEFN2
	0
	0
	0

BYEDIR:	ASCIZ /UNSUPPORTED/
BYEFN1:	ASCIZ /BYE/
BYEFN2:	ASCIZ /LNS/
USRNM:	BLOCK	5

GTJIDX:	GJ%OLD
	.NULIO,,.NULIO
	0
	-1,,BYEDIR
	-1,,IDXFN1
	-1,,IDXFN2
	0
	0
	0

IDXFN1:	ASCIZ /BYE/
IDXFN2:	ASCIZ /IDX/
]
;  Interpretation of jcl:  <fortune file>,<index file> /<SW>..  Defaults are as before;
; both are assumed to be on DSK, and both live in the same directory.  If the
; directory is to be changed, it must be specified in the fortune file name;
; directory names are ignored in the index file name.  The second file names
; are assumed to be whatever was specified in the fortune file names, unless
; something else is provided for the index file.  Thus:
; :bye taa;,foo bar  makes the directory be taa.  The fortunes are in lns .bye.,
; and the index is in foo bar.  :bye taa;foo bar causes the fortunes to be in
; taa;foo bar, and the index to be in taa;index bar.  Etc.
; The only switch currently implemented is /C, which clears the screen before
; printing.

IFN ITS,[
JCLHAK:	.BREAK	12,[..RJCL,,JCL]
	MOVE	A,[10700,,JCL-1]
JCLRDO:	SETZM	NAME1
JCLLOP:	PUSHJ	P,GETSYL	; get a name in c, terminator in d
	JUMPE	C,JCLTRM	; no name, just a terminator
	CAIE	D,";
	 JRST	JCLFNM
	SKIPN	IDXNAM
	 MOVEM	C,BYESNM
	JRST	JCLLOP
JCLFNM:	SKIPE	NAME1
	 JRST	JCLFN2
	SETOM	NAME1
	SKIPN	IDXNAM
	 JRST	[MOVEM	C,BYEFIL
		 JRST	JCLTRM]
	MOVEM	C,IDXFIL
JCLTRM:	CAIN	D,",		; comma-->finished first, do second
	 JRST	[SETOM	IDXNAM
		 JRST	JCLRDO]
	CAIE	D,40
	 CAIN	D,11
	  JRST	JCLLOP		; space and tab just break
	CAIN	D,"/		; switch hacking
	 JRST	SWLOOP
	POPJ	P,		; otherwise done
JCLFN2:	MOVEM	C,IDXFIL+1	; always clobber idx file 2nd file name
	SKIPN	IDXNAM
	 MOVEM	C,BYEFIL+1	; only do quotes file when specified
	JRST	JCLTRM

SWLOOP:	ILDB	D,A
	JUMPE	D,CPOPJ
	CAIE	D,^M
	 CAIN	D,^C
	  POPJ	P,
	CAIN	D,"/
	 JRST	SWLOOP
	CAIE	D,"N
	 CAIN	D,"n
	  JRST	[SETOM	NOTOMO
		 JRST	SWLOOP]
	CAIE	D,"C
	 CAIN	D,"c
	  JRST	[SETOM	CLEARS
		 JRST	SWLOOP]
	JRST	SWLOOP

GETSYL:	MOVE	B,[440600,,C]
	MOVEI	C,0
GETLOP:	ILDB	D,A
	JUMPE	D,CPOPJ
	CAIE	D,^M
	 CAIN	D,3
	  POPJ	P,
	CAIE	D,";
	 CAIN	D,",
	  POPJ	P,
	CAIN	D,"/
	 POPJ	P,			; start a switch
	CAIE	D,40
	 CAIN	D,11
	  JRST	[JUMPN	C,CPOPJ
		 JRST	GETLOP]		; padding, don't stop unless you have something
	SUBI	D,40
	CAIL	D,100
	 SUBI	D,40
	TLNE	B,770000
	 IDPB	D,B
	JRST	GETLOP
]

IFE ITS,[

; 20x jcl is somewhat different from ITS style.
; Basically, it is /switch lines-file,index-file.
; However, do defaults are used, so the name had better be
; fully specified.

JCLHAK:	SETZ	A,
	RSCAN
	 JFCL
	JUMPE	A,CPOPJ			; NO JCL, FLUSH
	MOVN	C,A
	MOVEI	A,.PRIIN
	MOVE	B,[440700,,JCL]
	SIN				; READ JCL
	MOVE	A,[440700,,JCL]		; INTO JCL BLOCK
	ILDB	B,A			; PARSE IT 
	JUMPE	B,CPOPJ
	CAIE	B,40			; FIRST FLUSH LEADING 'BYE '
	 JRST	.-3
	MOVEM	A,F1PTR'		; SAVE POINTER TO FIRST FILE NAME
JCLH1:	ILDB	B,A	
	JUMPE	B,CPOPJ			; FUNNY HACK NOW FOR TTY FNM READING
	CAIN	B,"/
	 PUSHJ	P,XSWTCH
	CAIE	B,",			; FIND SEPARATOR
	 JRST	JCLH1
	MOVEI	B,0
	DPB	B,A
	MOVEM	A,F2PTR'
	POPJ	P,

XSWTCH:	ILDB	B,A
	CAIE	B,"c
	 CAIN	B,"C
	  JRST	[SETOM	CLEARS
		 JRST	XSWTCH]
	CAIE	B,"N
	 CAIN	B,"n
	  JRST	[SETOM	NOTOMO
		 JRST	XSWTCH]
	ILDB	B,A
	CAIN	B,40
	 JRST	.-2
	ADD	A,[070000,,0]
	JUMPGE	A,.+3
	SOS	A
	HRLI	A,010700
	MOVEM	A,F1PTR
	POPJ	P,
]

; here to print a randomly selected fortune
; IDX should be the index file
; DSKI should be the fortune file
BEGR:	
IFN ITS,[
	.CALL	[SETZ
		 SIXBIT /SSTATU/
		 2000,,0
		 2000,,0
		 2000,,0
		 2000,,0
		 SETZM,,A]	; SYS UPTIME IN SECONDS
	 JFCL
	.PDTIME	B,
]
IFE ITS,[
	TIME
	MOVE	B,A
	GTAD
]
	ROT	B,3
	XOR	A,B
IFN ITS,[
	.CALL	[SETZ
		 SIXBIT /CORBLK/
		 MOVEI 200000
		 MOVEI -1
		 MOVEI 200
		 MOVEI 400000
		 SETZI 0]
	 JRST	DODIV
	MOVE	C,[-40,,400100]
	XOR	A,(C)
	AOBJN	C,.-1
	ANDI	B,377	
	ROT	A,(B)
]
DODIV:	MOVMS	A
	IDIV	A,NWDS

; get the character location of the fortune
; B/ number of fortune to use

IFN ITS,[
	.ACCESS	IDX,B
]
IFE ITS,[
	MOVE	A,IDXJFN
	MOVEM	A,DSKIJF
	SFPTR
	 HALTF
]
	MOVE	A,[-1,,IDACS']		; get the the access of this fortune
IFN ITS,[
	.IOT	IDX,A
]
IFE ITS,[
	PUSHJ	P,XIOTI
	 A
]
	MOVE	B,IDACS
	HLRZ	D,B			; length to D
	TLZ	B,-1			; clear length from access
	IDIVI	B,5
IFN ITS,[
	.ACCESS	DSKI,B
]
IFE ITS,[
	MOVE	A,BYEJFN
	MOVEM	A,DSKIJF
	SFPTR
	 HALTF
]
	MOVE	A,[-ISIZ,,INLINS]
IFN ITS,[
	.IOT	DSKI,A
]
IFE ITS,[
	PUSHJ	P,XIOTI
	 A
]
; here to print the fortune
	MOVE	A,[440700,,INLINS]
	SOJL	C,BEGR3
BEGR2:	IBP	A
	SOJGE	C,BEGR2
BEGR3:	
IFN ITS,[
	.CALL	[SETZ ? SIXBIT "SIOT" ? MOVEI TYO ? A ? D ? SETZB LSTERR]
	 POPJ	P,
	.CALL	[SETZ ? SIXBIT "FINISH" ? SETZI TYO]
	 POPJ	P,
]
IFE ITS,[
	MOVE	B,A
	MOVEI	A,.PRIOU
	MOVN	C,D
	SOUT
	PRINT	[ASCIZ /

/]
]
	POPJ	P,

; print the luser's uname if we don't know him
UNMOUT:	MOVE	A,FOO
	MOVE	B,[440600,,A]
	MOVE	C,[-6,,NAMCHR]
UNMLOA:	ILDB	0,B
	JUMPE	0,UNMEND
	CAIL	0,'0
	CAILE	0,'9
	JRST	NONNUM
	JUMPN	D,NONNUM+1
	SKIPA	D,C
NONNUM:	SETZ	D,
	MOVEM	0,(C)
	AOBJN	C,UNMLOA

UNMEND:	SETZ	A,
	MOVE	B,[440600,,A]
	MOVE	C,[-6,,NAMCHR]
UNMDMP:	CAMN	C,D
	JRST	UNMXIT
	MOVE	0,(C)
	IDPB	0,B
	AOBJN	C,UNMDMP
UNMXIT:	SETZ	B,

SERC:	HLR	Z,NAMES(B)
	CAMN	A,@Z
	JRST	GOT1
	AOS	B
	CAIG	B,LUNM-NAMES
	 JRST	SERC
	MOVE	D,[440600,,FOO]
SERCL:	ILDB	A,D
	JUMPE	A,CPOPJ
	ADDI	A,40
IFN ITS,[
	.IOT	TYO,A
]
IFE ITS,[
	PBOUT
]
	TLNE	D,760000
	 JRST	SERCL
	POPJ	P,

GOT1:	HRR	Z,NAMES(B)
	PRINT	@Z
	POPJ	P,
; here to make a new index
NEWIDX:	
IFN ITS,[
	.CLOSE	IDX,
	.CALL	[SETZ
		 SIXBIT "OPEN"
		 [7,,ODX]
		 DISK
		 IDXFIL
		 IDXTMP
		 BYESNM
		 SETZB LSTERR]
	 JRST	EXIT
]
IFE ITS,[
	MOVEI	A,GTJIDX
	MOVSI	B,(GJ%FOU)
	MOVEM	B,(A)
	MOVE	B,F2PTR
	GTJFN
	 HALTF
	MOVE	B,[444400,,OF%WR]
	OPENF
	 HALTF
	MOVEM	A,IDXJFN
]
	SETZ	CNT,			; access count in characters
	MOVEI	G,0			; used to accumulate length of fortune
	MOVEI	F,<5*INSIZ>+1
	MOVEI	C,<5*INSIZ>+1		; F is # chars used this buffer; C is # in it
	MOVE	E,[-OUTSIZ,,OUTBUF]

OUTLUP:	PUSHJ	P,GETCHR		; returns char in B, uses bptr in D
	 JRST	OUTEND			; no more characters
	JUMPE	B,OUTPTR		; if ^@, then output count for previous fortune
	CAIN	B,177
	 JRST	OUTPT1			; if , interpret next char specially
	AOJA	G,OUTLUP		; aos length of current fortune

OUTEND:	
IFN ITS,[
	.CLOSE	DSKI,			; here at eof
]
IFE ITS,[
	MOVE	A,BYEJFN
	CLOSF
	 HALTF
]
	HRRZS	E			; clean up output buffer
	SUBI	E,OUTBUF
	MOVNS	E
	HRLS	E
	HRRI	E,OUTBUF
IFN ITS,[
	.IOT	ODX,E
	.CALL	[SETZ			; rename and close
		 SIXBIT "RENMWO"
		 MOVEI ODX
		 IDXFIL
		 IDXFIL+1
		 SETZB LSTERR]
	 JRST	EXIT
	.CLOSE	ODX,
]
IFE ITS,[
	MOVE	A,IDXJFN
	MOVEM	A,DSKOJF'
	PUSHJ	P,XIOT
	 E
	CLOSF
	 HALTF
]
	JRST	FORTUN			; now give fortune

OUTPT1:	PUSHJ	P,GETCHR		; just read <rubout>, so need next character
	 JRST	OUTPTR			; nothing there, so ignore it
	TLNN	G,-1
	 JRST	OUTPT2			; ignore if after first fortune
	SUBI	B,"0			; turn into a number
OUTPT2:	SOJL	B,OUTPT3		; done?
	MOVSM	G,(E)			; stuff out pointer
	AOBJN	E,OUTPT2		; buffer full?
	MOVE	E,[-OUTSIZ,,OUTBUF]	; yes, print it out
IFN ITS,[
	.IOT	ODX,E
]
IFE ITS,[
	MOVE	A,IDXJFN
	MOVEM	A,DSKOJF
	PUSHJ	P,XIOT
	 E
]
	MOVE	E,[-OUTSIZ,,OUTBUF]
	JRST	OUTPT2			; and see if need to stuff again

OUTPT3:	PUSHJ	P,GETCHR
	 JRST	OUTEND			; all out of characters
	JUMPE	B,OUTBCK		; if followed by , flush that, too
	ADD	D,[70000,,0]
	TLNE	D,400000
	 ADD	D,[347777,,-1]		; replace the character in the buffer
	SUBI	F,1
	SOJA	CNT,OUTBCK		; and re-enter main loop

OUTPTR:	TLNN	G,-1			; doesn't skip if on first fortune (doc)
	 JRST	OUTBCK
	MOVEI	B,1			; default
	JRST	OUTPT2
OUTBCK:	HRLZI	G,(CNT)			; cnt is maintained by GETCHR
	JRST	OUTLUP

; CALL TO GET CHARACTER FROM FILE BEING INDEXED.
GETCHR:	CAMGE	F,C
	 JRST	GETCH1
	CAIGE	C,<5*INSIZ>
	 POPJ	P,			; no more characters
	MOVE	C,[-INSIZ,,INBUF]
IFN ITS,[
	.IOT	DSKI,C
]
IFE ITS,[
	MOVE	A,BYEJFN
	MOVEM	A,DSKIJF'
	PUSHJ	P,XIOTI
	 C
]
	HRRZS	C
	SUBI	C,INBUF
	JUMPE	C,CPOPJ			; didn't read any new ones
	IMULI	C,5
	MOVEI	F,0
	MOVE	D,[440700,,INBUF]
GETCH1:	ILDB	B,D
	ADDI	F,1
	ADDI	CNT,1			; aos char address in file
POPJ1:	AOS	(P)
	POPJ	P,

IFE ITS,[
; DO TWENEX IOTING
; IN (P) IS THE WORD WHICH ITS WOULD LIKE

XIOTI:	PUSH	P,[SIN]
	PUSH	P,[DSKIJF]
	JRST	XIOT1

XIOT:	PUSH	P,[SOUT]
	PUSH	P,[DSKOJF]
XIOT1:	MOVE	O,[A,,XACS]
	BLT	O,XACS+16
	MOVE	A,-2(P)
	MOVE	A,(A)
	MOVE	O,XACS-1(A)
	MOVE	A,@(P)
	HRRZ	B,O
	TLO	B,444400
	HLRE	C,O
	SKIPE	C			; DON'T PRINT IF 0 LENGTH
	 XCT	-1(P)
	HRRI	C,1(B)
	MOVE	B,-2(P)
	MOVE	B,(B)
	MOVEM	C,XACS-1(B)		; FIXUP THE POINTER
	MOVE	O,[XACS,,A]
	BLT	O,16			; NOT P, PLEASE
	SUB	P,[2,,2]
	JRST	POPJ1

XACS:	BLOCK	17
]
NAMCHR: BLOCK 6
IFN ITS,[
FOO:	-1
]
IFE ITS,[
FOO:	0
]

; days of week
WEEK:	[ASCIZ /Mon/]
	[ASCIZ /Tues/]
	[ASCIZ /Wednes/]
	[ASCIZ /Thurs/]
	[ASCIZ /Fri/]
	[ASCIZ /Mon/]
	[ASCIZ /Sun/]
DEFINE NAME S,/A
	[SIXBIT /!S!/],,[ASCIZ /!A!/]
TERMIN

NAMES:	NAME AC,Arvola
	NAME AMOEBA,Fred
	NAME ANDERS,Tim
	NAME AS,Alan
	NAME AV,Al
	NAME BERN,Bahram
	NAME BH,Brian
	NAME BHATT,Sandeep
	NAME BKD,Bruce
	NAME BRD1,Bill
	NAME BTB,Brian
	NAME CBF,Charles
	NAME CLR,Chris
	NAME CLUSER,Random
	NAME DJC,Dan
	NAME DJM,Dennis
	NAME DK,Deepak
	NAME DLD,Dave
	NAME DSY,Dave
	NAME EAK,Earl
	NAME EBM,Eliot
	NAME ECC,Eugene
	NAME EF,Edward
	NAME EWC,Edward
	NAME FURST,Sheldo
	NAME GALLEY,Stu
	NAME GEK,Gail
	NAME GEOFF,Geoff
	NAME IMAINT,Poor hardware hacker
	NAME JCRL,Lick
	NAME JCS,Craig
	NAME JDS,John
	NAME JF,Jerry
	NAME JJ,Jerry
	NAME JJK,Jim
	NAME JMB,Joel
	NAME JSK,Jay
	NAME KLH,Coeurl
	NAME KWC,Ken
	NAME LICK,Lick
	NAME LISKOV,Barb
	NAME MARC,Marc
	NAME MD,Mike
	NAME MMH,Mike
	NAME MN,Margie
	NAME MOON,David
	NAME MSB,Mike
	NAME PDL,Dave
	NAME RANDY,Randy
	NAME RDG,Rich
	NAME RMF,Matthias
	NAME RMM,Bob
	NAME RRA,Russell
	NAME RRS,Rick
	NAME RLW,Bob
	NAME RWS,Bob
	NAME SBZ,Stan
	NAME SEC,Scott
	NAME SKS,Sunil
	NAME SMS,Susan
	NAME SWG,Stu
	NAME TAA,Tim
	NAME TAA.JTP,Joy
	NAME TAL,Tom
	NAME TK,Thomas
	NAME TKJ,Tod
	NAME TOBY,Toby
	NAME URSHB,Steve
	NAME WJL,Bill
LUNM:	NAME ______,fellow victim of hack-o-mania
; uuo handler
UUOH:	0
	MOVE	A,40
	HRLI	A,440700
LO:	ILDB	B,A
	JUMPE	B,@UUOH
IFN ITS,[
	CAIE	B,^J
	.IOT	TYO,B
	CAIN	B,^M
	.IOT	TYO,[^J]
]
IFE ITS,[
	EXCH	A,[.PRIOU]
	BOUT
	EXCH	A,[.PRIOU]
]	
	JRST	LO

; interrupt handler
IFN ITS,[
TSINT:	0
	0
	EXCH	A,TSINT
	JUMPGE	A,INTOUT
	TRNN	A,<1_TYI>
	 JRST	INTOUT
	MOVEI	A,TYI
	.ITYIC	A,
	 JRST	INTOUT
	CAIE	A,^S
	 JRST	INTOUT
	.RESET	TYO,
	.BREAK	16,124000
INTOUT:	EXCH	A,TSINT
	.DISMI	TSINT+1

RECORD:	SETZ
	SIXBIT/OPEN/
	[.UII,,17]
	[SIXBIT/SYS/]
	[SIXBIT/RECORD/]
	SETZ [SIXBIT/TIME/]

GETREC:	SETZ
	'RFDATE	
	MOVEI 17
	SETZM A

SETREC:	SETZ
	'SFDATE
	MOVEI 17
	SETZ A

]
RES1:	-1
RES2:	-1
RES3:	-1
RES4:	-1
RES5:	-1

LSTERR:	0

INLINS:	BLOCK ISIZ+1

PDL:	BLOCK PDLSIZ
INBUF:	BLOCK INSIZ
OUTBUF:	BLOCK OUTSIZ

IFE ITS,[
BLNKTB:	REPEAT	4, <.BYTE 7 ? 15 ? 12 ? 0>	; 0-3
	<.BYTE	7 ? 177 ? 220-176 ? 0>		; 4 IMLACS
	<.BYTE	7 ? 35 ? 36 ? 0>		; 5 DM
	<.BYTE	7 ? 33 ? "H ? 33 ? "J ? 0>	; 6 HP2640
	REPEAT	4 ? <.BYTE 7 ? 15 ? 12 ? 0>	; 7-10
	<.BYTE	7 ? 33 ? "H ? 33 ? "J ? 0>	; 11 VT50
	<.BYTE	7 ? 15 ? 12 ? 0>		; 12
	<.BYTE	7 ? 33 ? "( ? 177 ? 0>		; 13 LP
	<.BYTE	7 ? 15 ? 12 ? 0>		; 14
	<.BYTE	7 ? 33 ? "H ? 33 ? "J ? 0>	; 15 VT52
	<.BYTE	7 ? 15 ? 12 ? 0>		; 16 GLASS TTY
	<.BYTE	7 ? 33 ? "H ? 33 ? "J ? 0>	; 17 FOX
	<.BYTE	7 ? 33 ? "H ? 33 ? "J ? 0>	; 18 VT100
	<.BYTE 7 ? 15 ? 12 ? 0>	; ETC		; 19 ?
	<.BYTE	7 ? 33 ? "H ? 33 ? "J ? 0>	; 20 HEATH
	<.BYTE 7 ? 15 ? 12 ? 0>			; 21 ?
]

	END START