;-*-MIDAS-*-

TITLE GMSGS
		;COPY ALL RECENT SYSTEM MESSAGES INTO A USER'S
		;MAIL FILE, AND ADVANCE THE USER'S DATE-FILE
		;TO INDICATE HE HAS SEEN THOSE MESSAGES.
		;ALSO, IF THERE ARE ANY MESSAGES, TYPE OUT
		;"THERE ARE MESSAGES", UNLESS THE COMMAND LINE CONTAINS
		;"/S" FOR "SILENT".

		;NORMALLY, MESSAGES GO AT THE FRONT, LATEST FIRST,
		;BUT IF THE COMMAND STRING HAS "/R" IN IT, THE MESSAGES
		;GO AT THE END, EARLIEST FIRST.

		;UNLESS, OF COURSE, THE USER SPECIFIES /G, TO CAUSE THEM TO BE
		;WRITTEN TO THE FILE <HSNAME>;<XUNAME> GMSGS.  USE OF THIS
		;OPTION IS HIGHLY RECOMMENDED, SINCE IT PREVENTS CLOBBERING
		;YOUR MAIL FILE WITH TIMING CONFLICTS WITH COMSAT.

		;THE USER TO SNARF THE MESSAGES OF MAY BE SPECIFIED IN THE
		;COMMAND STRING, OR MAY BE ALLOWED TO DEFAULT TO THE
		;XUNAME.

		;THE NAMES OF THE MACHINES WHOSE MESSAGES SHOULD BE SNARFED
		;(SUCH AS *AI, *DM, *MC, *ML, OR * FOR ALL MACHINES)
		;MAY ALSO BE SPECIFIED.

		;IF /D IS SPECIFIED, THEN THE DISTRIB:
		;AND EXPIRES: FIELDS OF MESSAGES (NORMALLY HIDDEN)
		;WILL BE SHOWN.

		;IF /M IS SPECIFIED, THE MESSAGES ARE MAILED THROUGH THE COMSAT
		;TO THE USER, INSTEAD OF PUT DIRECTLY IN HIS MAIL FILE.

		;/G MAKES GMSGS NOT BREAK THE MAIL FILE, AND WRITE TO A GMSGS
		;FILE INSTEAD.

		;/N MAKES GMSGS TYPE (THERE IS MAIL) IF THE USER'S
		;MAIL FILE IS INITIALLY MORE RECENT THAN HIS MSGS FILE.

		;/T MAKES GMSGS PRINT THE MESSAGES ON THE TELETYPE
		;INSTEAD OF PUTTING THEM IN THE MAIL FILE

		;/Z SWITCH: SHOW SYS:SYSTEM MAIL AND THE LIKE.  THIS IS
		;MOSTLY FOR THE BENEFIT OF ZMAIL

;This program is also a Chaosnet server
;Connect to contact name GMSGS, space, hsname, semicolon, xuname, space, jcl line.
;Any teletype output will come back down the Chaosnet connection.
;EOF will be sent and "finished" after the file is written and
;before the program dies.

loc 40
0 ? 0 ? 0 ? 0
-crtlen,,crtab

loc 100
.INSRT RMS;MACROS >
.insrt syseng;msgs >
.insrt system;chsdef >

crtab: msgs"critic
crtlen==.-crtab

chaos:	0	;-1 if this is a Chaos server
pktbuf:	block %cpmxw

INC==1		;DISK INPUT (MESSAGES AND MAIL FILE)
OUTC==2		;DISK OUTPUT
FDRC==3		;INPUT OF .MSGS. DIRECTORY
TYOC==4		;TYPEOUT
MSGC==5		;Channel to open SYS;:MSGS TIMES on.
CHSI==6		;Chaosnet input
CHSO==TYOC	;Chaosnet output is TYOC
ERRC==7		;ERR device
LOCKC==10	;LOCK device

IFNDEF PDLL,PDLL==60	;PDL LENGTH.
IFNDEF CMDL,CMDL==10	;JCL-COMMAND BUFFER LENGTH.

BEG:	MOVE P,[-PDLL,,PDL-1]
	.SUSET [.RHSNAM,,HSNAME]
	.SUSET [.RXUNAM,,USER]
	.SUSET [.RJNAME,,A]
	CAMN A,[SIXBIT /EXPIRE/]
	 JRST [	SYSCAL RQDATE,MOVEM MSGTDT	;READ IN TODAY'S DATE.
	 	 .LOSE %LSSYS 
		CALL EXPIRE
		.LOGOUT 1, ]
	CAME A,[SIXBIT/CHAOS/]
	 JRST BEG0
	SETOM CHAOS		;We are a Chaosnet server
	.CALL [SETZ ? 'CHAOSO ? MOVEI CHSI ? MOVEI CHSO ? SETZI 5 ]
	 .LOGOUT 1,
	MOVE A,[.BYTE 8 ? %COLSN ? 0 ? 0 ? 5]
	MOVEM A,PKTBUF
	MOVE A,[.BYTE 8 ? "G ? "M ? "S ? "G]
	MOVEM A,PKTBUF+%CPKDT
	MOVE A,[.BYTE 8 ? "S]
	MOVEM A,PKTBUF+%CPKDT+1
	.CALL [ SETZ ? 'PKTIOT ? MOVEI CHSO ? SETZI PKTBUF ]
	 .LOSE %LSSYS
	.CALL [ SETZ ? 'NETBLK ? MOVEI CHSO ? MOVEI %CSLSN ? SETZM A ]
	 CAIA
	  CAIE A,%CSRFC
	   .LOGOUT 1,
	MOVSI A,%COOPN_10.
	MOVEM A,PKTBUF
	.CALL [ SETZ ? 'PKTIOT ? MOVEI CHSO ? SETZI PKTBUF ]
	 .LOSE %LSSYS
	.CALL [ SETZ ? 'PKTIOT ? MOVEI CHSI ? SETZI PKTBUF ]
	 .LOSE %LSSYS
	;The connection is now open and the RFC is in PKTBUF
	MOVE A,[240800,,PKTBUF+%CPKDT+1]
	LDB C,[$CPKNB+PKTBUF]
	SUBI C,6		;GMSGS space
	MOVE B,[440600,,HSNAME]	;Get hsname
	SETZM HSNAME
CHJCL0:	ILDB D,A
	CAIN D,";
	 SOJA C,CHJCL1
	CAIGE D,140
	 SUBI D,40
	TLNE B,770000
	 IDPB D,B
	SOJG C,CHJCL0
CHJCL1:	MOVE B,[440600,,USER]	;Get xuname
	SETZM USER
CHJCL2:	ILDB D,A
	CAIN D,40
	 SOJA C,CHJCL3
	CAIGE D,140
	 SUBI D,40
	TLNE B,770000
	 IDPB D,B
	SOJG C,CHJCL2
CHJCL3:	MOVE B,[440700,,CMD]	;Rest of RFC is JCL
CHJCL4:	ILDB D,A
	IDPB D,B
	SOJG C,CHJCL4
	MOVEI D,^M
	IDPB D,B
BEG0:	SYSCAL RQDATE,MOVEM MSGTDT ;READ IN TODAY'S DATE.
	 SETOM MSGTDT
	SKIPGE MSGTDT
	 JRST [	MOVEI A,[ASCIZ /The system does not know the date right now -- GMSGS.
/]
		CALL TELL
		JRST NOMSGS]

	CALL MORCOR	;GET SOME CORE TO HACK WITH

	CALL EXPIRE	;DELETE EXPIRED MESSAGES.
	.SUSET [.ROPTIO,,A]
	TLO A,%OPLOK\%OPLKF
	.SUSET [.SOPTIO,,A]
	SKIPE CHAOS
	 JRST BEG1
	SETZM CMD
	TLNE A,%OPCMD
	 .BREAK 12,[5,,CMD]
BEG1:	SYSCAL SSTATU,[ REPEAT 6,[? %CLOUT,,B]]
	  .LOSE %LSSYS
	MOVEM B,ITSNAM   ;DISCOVER WHICH ITS WE'RE ON.
	MOVE A,[.BYTE 7 ? ^M]
	SKIPN CMD
	 MOVEM A,CMD	;NO COMMAND STRING JUST LIKE A BLANK COMMAND STRING.
	MOVE A,[440700,,CMD]
	MOVEM A,CMDBP	;PREPARE TO READ IT.
	SAVE P		;SAVE POINTER TO LAST THING BELOW OUR ARGS
MSGSR1:	CALL RDSIX	;READ AN ARG (A SIXBIT WORD) AND PUSH IT IF NOT BLANK.
	JUMPE A,MSGSR2
	LDB B,[360600,,A]
	CAIE B,'*	;1ST CHAR NOT STAR => IT'S THE USER'S NAME.
	 JRST [	MOVEM A,USER
		SKIPN CHAOS
		 .BREAK 12,[..RMAIL,,ITSNAM]  ;find out where his mail goes.
		JRST MSGSR2]
	SETOM SPCDST	;IF IT'S *AI, ETC, SAY WE GOT A SPECIFIED KEYWORD
	EXCH A,(P)	;AND "PUSH" IT UNDERNEATH THE SAVED STACK POINTER.
	SAVE A
MSGSR2:	CAIE I,^M	;LOOP AROUND TILL CR IS REACHED.
	 JRST MSGSR1
	MOVE B,ITSNAM	;Remember our ITS name
	LSH B,-6
	TLO B,(SIXBIT/*/)
	REST D
	CAMN D,P	;NOW, IF THERE WERE NO ARGS PUSHED,
	 SAVE B		;PUSH THE "*AI", ETC. AS A DEFAULT.
	SAVE D		;(UNDERNEATH THE SAVED STACK POINTER, OF COURSE)
	SKIPE CHAOS
	 JRST .+3
	  .OPEN TYOC,['!TTY]
	   .LOSE %LSSYS

;SET UP FOR READING IN APPROPRIATE MSGS FILES.
	SKIPN GMSGSF
	 SKIPE TTYF
	  SETZM MAILF	;/T OVERRIDES /M (ELSE /T/M WOULD DO GARBAGE).
	SKIPE TTYF
	 SETOM SILNT	;NO NEED TO TELL IF OUTPUT TO TTY
	MOVE B,[SIXBIT /GMSGS/]
	SKIPE GMSGSF	;IF WE'RE WINNING, NOT CLOBBERING OUR MAIL FILE
	 MOVEM B,MALNAM	; USE THIS FILENAME INSTEAD
	MOVEI B,BUFBOT	;INITIALIZE THE INPUT BUFFER.
	MOVEM B,BUFMID	;SAY THAT NOTHING IS IN IT YET.
	MOVEI B,MEMTOP
	MOVEM B,BUFTOP	;SAY HOW MUCH SPACE THERE IS TO READ INTO.
	 SKIPE TTYF
	  JRST MSG0	;DON'T READ IN EXISTING MAIL FILE IF /T
	SKIPN MAILF	;DON'T READ IN EXISTING MAIL FILE IF /M
	 SKIPN REVERS	;IN BACKWARDS MODE, THE EXISTING MAIL FILE
	  JRST MSG0
	CALL LODOLD	;GOES AT THE FRONT.
	MOVE B,BUFMID
	CAIN B,BUFBOT	;IF IT EXISTS AND IS NONEMPTY,
	 JRST MSG0
	CALL ENDFIL	;REMOVE TRAILING ^C'S, ^L'S FROM IT.
	MOVEI A,40	;BUT ENDFIL INSERTS AN EXTRA ^_;
	DPB A,D		;REPLACE IT WITH A SPACE.
	JRST MSG0

;DEFINITIONS FOR MSGS

UNFN1==0	;COPIED FROM ITS, NEAR QSKO
UNFN2==1
UNRNDM==2
UNDATE==3
UNLINK==1
UNIGFL==200064	;BITS IN RH OF UNRNDM, SET => FILE INACCESSABLE.
LUNBLK==5	;LENGTH OF NAME-BLOCK.

MSG0:	move a,user
	movei b,msgc
	move c,[-msglen,,msgpag]
	call msgs"usrget
	  .lose
	movem a,msgloc
	move c,msgs"me$mdt(a)
	movem c,msgdat		;print a file iff more recent than msgdat.
	SETOM MSGLDT		;NO FILES TYPED YET.
	SKIPE NOTIFF		;IF /N, MAYBE SAY "THERE IS MAIL".
	 CALL THRSML

;READ IN THE .MSGS. (OR WHATEVER SNAME) DIRECTORY.
	.SUSET [.SSNAM,,MSGSNM]
	.OPEN FDRC,MSGF2	;OPEN DIR. IN IMAGE BLOCK MODE.
	 JSR OPNERR
MSGS1:	MOVE D,[-2000,,VPAGAD]
	.IOT FDRC,D		;READ THE WHOLE DIR.
	.CLOSE FDRC,
	MOVEI A,VPAGAD
	ADD A,VPAGAD+1	;ADDR. OF 1ST NAME-ENTRY.
	MOVEI B,VPAGAD+2000	;ADDR AFTER LAST.
	MOVSI C,400000	;DON'T INCLUDE ACCESS DATE IN SORT KEY.
	PUSHJ P,SORT
	MOVEI A,VPAGAD-LUNBLK
	ADD A,VPAGAD+1	;ONE OF THESE ADDR'S IS THE BEGINNING;
	MOVEI D,VPAGAD+2000	;THE OTHER IS THE END.
	SKIPE REVERS		;IT DEPENDS WHICH DIRECTION WE'RE GOING.
	 EXCH A,D		;FILES ARE REALLY LATEST FIRST NOW
	MOVEM D,LAST		;SO REVERSE MEANS DOWNWARD IN CORE ADDRESSES
	MOVEI D,LUNBLK
	MOVEM D,INCREM
	SKIPE REVERS
	 MOVNS INCREM
MSGSNF:	ADD A,INCREM	;LOOK AT NEXT FILE.
	CAMN A,LAST
	 JRST MSGSX		;IF ALL SEEN.
	SKIPN D,UNFN1(A)
	 JRST MSGSNF		;IGNORE IF FN1 BLANK.
	MOVEM D,MSGF3+1	;SAVE FN1 FOR OPEN.
	SKIPN D,UNFN2(A)
	 JRST MSGSNF
	MOVEM D,MSGF3+2
	LDB D,[360600,,MSGF3+1]
	CAIN D,'_		;IGNORE FILE IF FN1 STARTS WITH _.
	 JRST MSGSNF
	MOVE D,UNRNDM(A)
	TLNE D,UNLINK\UNIGFL
	 JRST MSGSNF		;IGNORE LINKS AND INACCESSABLE FILES.
	MOVE C,UNDATE(A)
	CAMG C,MSGDAT
	 JRST MSGSNF		;IF PRINTED MESSAGES SINCE WAS CREATED, SKIP.

;DROPS THROUGH
;THE FILE WE'RE LOOKING AT IS RECENT ENOUGH; PUT IT IN USER'S MAIL FILE.
	.OPEN	INC,MSGF3
	 JRST	MSGSNF
	CALL INCO1
	call sdist
	 jrst [	.access inc,[0]
		call inco1
		jrst msgsd1 ]
MSGSD3:	MOVE B,[404040,,404040]
	MOVE C,[440600,,B]	;READ IN 1 SIXBIT WORD FROM THE FILE.
MSGSD5:	CALL INCI
	CAIL D,140
	 SUBI D,40
	CAIE D,",
	 CAIG D,40
	  JRST MSGSD4
	TLNE C,770000
	 IDPB D,C
	JRST MSGSD5

MSGSD4:	XOR B,[404040,,404040]
	JUMPE B,MSGSD6		;IGNORE NULL WORDS.
	MOVE G,P		;NOW COMPARE THE WORD AGAINST THE ARGS ON THE STACK.
	POP G,C			;GET THE POINTER TO BENEATH THE ARGS, FOR END TEST
MSGSD7:	CAMN B,(G)		;POP 1 ARG AND COMPARE
	 JRST MSGSDW		;MATCH => IGNORE REST OF DISTRIB: LINE, AND PRINT MESSAGE
	POP G,H
	CAMN H,[SIXBIT/*/]
	 JRST MSGSDW		;KEYWORD * MATCHES ANYTHING
	CAME G,C
	 JRST MSGSD7
MSGSD6:	CAIL D,40		;THIS WORD LOSES.  IF NOT AT END OF LINE, READ ANOTHER.
	 JRST MSGSD3
				;THE WHOLE DISTRIB: LOSES - DON'T PRINT THIS FILE.
	CALL MSGEXP		;EVEN THOUGH WE WON'T PRINT IT, DELETE IT IF OLD ENOUGH.
	 JFCL
	JRST MSGSNF

;COME HERE IF THE FILE'S DISTRIB:  SAYS WE SHOULD PRINT IT.
MSGSDW:	CALL MSGEXP		;DON'T PRINT, AND MAYBE EVEN DELETE FILE, IF EXPIRED.
	 JRST MSGSNF
	CALL MSGIL		;NOT EXPIRED; SKIP PAST THE "EXPIRES:" LINE.
	 JRST MSGSNF		;NOTHING ELSE LEFT?
	JRST MSGSD1		;PRINT THE FILE.

;TEST FILE ON INC FOR HAVING EXPIRED.  SKIP IF IT HASN'T.
;IF IT HAS EXPIRED AND HAS BEEN BACKED UP ON TAPE, DELETE IT.
MSGEXP:	CALL MSGIL		;SKIP THE REST OF THE "DISTRIB:" LINE.
	 JRST MSGEXD		;NO MORE IN FILE => SAY IT LOSES.
	MOVEI G,40
	CALL MSGI1		;SKIP PAST "EXPIRES: ".
	 JRST MSGEXD		 ;NO SPACE FINDABLE?
	MOVE G,[CALL INCI]
	CALL RDATE		;READ THE EXPIRATION DATE.
	CAML C,MSGTDT		;EXPIRED BEFORE NOW?
	 JRST POPJ1		;NO, FILE SHOULD BE PRINTED.
MSGEXD:	SYSCAL RDMPBT,[MOVEI INC ? MOVEM C]
	 RET
	JUMPE C,CPOPJ		;EXPIRED BUT NOT DUMPED => DON'T PRINT.
;	SYSCAL DELETE,[MSGF3 ? MSGF3+1 ? MSGF3+2]
	 JFCL
	RET			;ALREADY ON BACKUP TAPE => DELETE IT TOO.


;IGNORE ONE LINE FROM THE FILE ON INC.
MSGIL:	MOVEI G,^J
MSGI1:	CALL INCI		;IGNORE UP TO THE CHAR IN G.
	CAIE D,^L
	 CAIN D,^C
	  RET
	CAIE D,(G)
	 JRST MSGI1
POPJ1:	AOS (P)
	RET

; CALL SDIST
; Search for "DISTRIB: " field in message from INC, possibly skipping
; unfortunate "Recieved:" fields.  Skip if found.
sdst3:	caie d,^C		; File ran out?
	 cain d,^L
	  popj p,
sdst2:	call inci		; Search for start of new line
	caie d,^J
	 jrst sdst3
sdist:	call inci
	caie d,"R		; Perhaps "Recieved:"
	 cain d,"r		; "recieved:" also possible I guess...
	  jrst sdst2		; OK before the "DISTRIB: "
	caie d,"D		; Either "DISTRIB: " line, or unknown
	 popj p,
sdst4:	;; See that rest of line is "ISTRIB: ", if not, give up.
irp ch,,["I,"S,"T,"R,"I,"B,72,40]
	call inci
	caie d,ch
	 popj p,
termin
	aos (p)
	popj p,

;READ AHEAD INTO INCTB FROM THE FILLE OPEN ON INC.
INCO1:	SAVE D
INCPP:	MOVE D,[440700,,INCTB]
	MOVEM D,INCIP
	MOVE D,[-INCL,,INCTB]
	.IOT INC,D
	HRRM D,INCEP
	MOVEI D,^C	;STORE ^C AFTER LAST WD READ.
	DPB D,INCEP
POPDJ:	REST D
	RET

;READ 1 CHAR FROM BLOCK-MODE INC.
INCI:	MOVE D,INCIP	;UNLESS PTR IS AT END OF BUFFER,
	CAMN D,[010700,,INCTB+INCL-1]
	 CALL INCO1
	ILDB D,INCIP
	POPJ P,

INCL==100
INCTB:	BLOCK INCL	;BUFFER FOR I/O USING INCI.
	ASCIC//
INCEP:	350700,,
INCIP:	0

;READ A DATE USING READ-CHAR INSTRICTION IN G. DATE RETURNED IN C.
;CHAR THAT TERMINATED THE DATE IS LEFT IN D.
RDATE:	SETZ D,
	SAVE D
	CALL MSGNUM	;CREATION MONTH.
	DPB C,[270400,,(P)]
	CALL MSGNUM	;CREATION DAY.
	DPB C,[220500,,(P)]
	CAIE D,^M	;IF USER ISN'T SPEC'ING THE YEAR,
	 JRST RDATE1
	MOVE C,MSGTDT
	LDB C,[330700,,C]	;USE TODAY'S YEAR.
	JRST RDATE2

RDATE1:	CALL MSGNUM	;CREATION YEAR.
RDATE2:	DPB C,[330700,,(P)]
	CALL MSGNUM	;HOUR.
	IMULI C,3600.
	ADDM C,(P)
	CALL MSGNUM	;MINUTE.
	IMULI C,60.
	ADDM C,(P)
	CALL MSGNUM	;SECOND
	ADD C,(P)
	ADDI C,(C)	;DOUBLE THE R.H.
POP1J:	SUB P,[1,,1]
	RET

;READ IN A DECIMAL NUMBER, STOPPING AT A NON-DIGIT.
;USE THE INSTRUCTION IN G TO READ 1 CHARACTER.
MSGNUM:	SETZ C,
	CAIN D,^M	;DON'T GO ON PAST CR.
	 RET
MSGNU1:	XCT G
	CAIL D,"0
	 CAILE D,"9		;TERMINATE ON NON-DIGIT.
	  RET
	IMULI C,10.
	ADDI C,-"0(D)
	JRST MSGNU1

;A FILE'S DISTRIB LOOKS GOOD, AND IT HASN'T EXPIRED, SO PRINT IT.
MSGSD1:	HRRZ B,BUFMID	;FIRST, MAKE SURE THERE'S SPACE FOR THE NAME OF THE FILE.
	ADDI B,4
	CAML B,BUFTOP
	 CALL MORCOR
	HRRZ B,BUFMID
	SOS B
	PUSH B,[ASCII/MSG: /]
	HRLI B,010700	;THEN, PUT IN THE NAME OF THE FILE.
	MOVE C,MSGF3+1
	CALL SIXOUT
	MOVEI C,40
	IDPB C,B
	MOVE C,MSGF3+2
	CALL SIXOUT	;WE HAVE USED 5+6+1+6 = 17 CHARS SO FAR.
	MOVE C,[^M^J*2]	;FILL UP 4TH WORD WITH A CRLF.
	IORM C,(B)
	SKIPN SHODIST	;IF USER SPECIFIED /D,
	 JRST MSGHID
	HRRZM B,BUFMID
	AOS BUFMID
	.OPEN INC,MSGF3
	 JRST MSGRND
	CALL LODFIL	;READ IN WHOLE FILE, SHOWING DISTRIB.
	JRST MSGRND

MSGHID:	MOVE C,B	;IF HE DIDN'T SPECIFY, READ IN FILE BUT
	HRLI C,010700	;DISCARD THE DISTRIB: AND EXPIRES:.
MSGRLP:	HRRZM C,BUFMID	;SINCE THEY MIGHT NOT BE MULTIPLE OF 5 CHARS
	AOS BUFMID	;WE MUST TRANSFER A CHARACTER AT A TIME.
	MOVEI B,2(C)
	CAML B,BUFTOP
	 CALL MORCOR
	MOVE B,[ASCIC//]
	MOVEM B,1(C)
	CALL INCI
	CAIN D,^C
	 JRST MSGRND
	IDPB D,C
	JRST MSGRLP

MSGRND:	.CLOSE INC,
	CALL ENDFIL
	MOVEM D,LSTEPT
	SETZM MSGLDT		;INDICATE AT LEAST ONE MESSAGE HAS BEEN FOUND.
	JRST MSGSNF		;SEE IF THERE ARE MORE OF THEM.


MSGF2:	6,,SIXBIT/   DSK.FILE.(DIR)/


;COME HERE AFTER HANDLING ALL THE MSGS THAT ARE TO BE HANDLED.
;WRITE THEM OUT IF THERE ARE ANY.
MSGSX:	move g,p
	skipe spcdst
	 call arc	;process any mailing list files.
	  caia
	   hrrzm p,msgldt
	SKIPE SYSMLF	;/Z ?
	 PUSHJ P,GSYSML
	SKIPGE MSGLDT	;Did we find anything?  either an announcement or a mailing list?
	 JRST MSGSX5
	SKIPE TTYF	;If so, output the data as appropriate.
	 JRST [	SYSCAL OPEN,[ [3,,OUTC] ? [SIXBIT/TTY/]]
		 .LOSE %LSFIL
		CALL WRITE1	;OUTPUT THE BUFFERFULL OF MESSAGES TO THE TTY.
		JRST WRITE2]
	SKIPE MAILF	;MAYBE PASS THE MESSAGES TO THE COMSAT.
	 JRST WRMAIL
	SKIPN REVERS	;IN NORMAL ORDER, LOAD OLD MAIL FILE AFTER MESSAGES
	 CALL LODOLD
;ALL THE NEW CONTENTS OF <USER> <MACHINE>MAIL ARE NOW IN THE BUFFER.
WRITE:	SYSCAL OPEN,[ [3,,OUTC] ? [sixbit /DSK/] ? ['_GMSGS] ? ['OUTPUT] ? hsname]
	 JSR OPNERR
	CALL WRITE1	;OUTPUT THE BUFFERFULL OF MESSAGES
			;TRANSLATE NORMAL NAMES TO FIND OUT WHAT TO RENMWO TO.
	SYSCAL TRANS,[%CLBIT,,.UAO ? [sixbit /DSK/] ? USER ? MALNAM ? HSNAME
			%CLOUT,,A ? %CLOUT,,A ? %CLOUT,,B]
	 .LOSE %LSSYS
	SYSCAL RENMWO,[1000,,OUTC ? A ? B]
	 .LOSE %LSFIL
WRITE2:	.CLOSE OUTC,
	SKIPE NOTIFF	;IF /N, READ TIME ONCE AGAIN, SO MSGS WILL BE LATER
	 SYSCAL RQDATE,[MOVEM MSGTDT]	;THAN THE MAIL FILE WE JUST WROTE.
	  JFCL

;NOW UPDATE THE USER'S DATE-FILE.
MSGSX5:	move a,msgloc		   ;Set the date for this user in the database
	syscal RQDATE,[%clout,,msgs"me$mdt(a)]	;to the current date
	 .lose %lssys
	call msgs"unmap		   ;All done with the :MSGS database
	  jfcl		;  Can't happen, always skips
MSGSX3:	SKIPGE MSGLDT
	 JRST NOMSGS

;NOW INFORM USER THAT THERE WERE MESSAGES.
	MOVEI A,[ASCIZ/
(There are messages)
/]
	SKIPN SILNT
	 CALL TELL
	DPAUSE
	SKIPN CHAOS
	 .BREAK 16,340000
CHDUN:	.CALL [SETZ ? 'FINISH ? SETZI CHSO ]
	 .LOGOUT 1, ;.LOSE %LSSYS - temporary fix by cstacy
	MOVSI A,%COEOF_10.
	MOVEM A,PKTBUF
	.CALL [SETZ ? 'PKTIOT ? MOVEI CHSO ? SETZI PKTBUF]
	 .LOSE %LSSYS
	.CALL [SETZ ? 'FINISH ? SETZI CHSO ]
	 .LOSE %LSSYS
	.LOGOUT 1,

;JSR HERE IF ERROR OPENING FILE
OPNERR:	0
	SKIPN CHAOS
	 JRST OPNER1
	.OPEN ERRC,[.UAI,,'ERR ? 1]
	 .LOSE %LSFIL
	MOVEI A,[ASCIZ/FILE SYSTEM ERROR: /]
	PUSHJ P,TELL
OPNER0:	.IOT ERRC,A
	CAIGE A,40
	 JRST CHDUN		;File names could be nice--hard to get, though
	.IOT TYOC,A
	JRST OPNER0

OPNER1:	SOS OPNERR
	SOS OPNERR
	.CALL [SETZ ? SIXBIT/LOSE/ ? MOVEI %LSFIL ? SETZ OPNERR]
	 .LOSE %LSSYS

TELL:	HRLI A,440700
TELL1:	ILDB B,A
	JUMPE B,CPOPJ
	SKIPN CHAOS
	 JRST TELL2
	CAIN B,^M
	 TROA B,200	;LISP MACHINE CHARACTER SET
	CAIE B,^J
TELL2:	 .IOT TYOC,B
	JRST TELL1

NOMSGS:	DPAUSE		;COME HERE IF THERE ARE NO MESSAGES.
	SKIPN CHAOS
	 .BREAK 16,140000
	JRST CHDUN

THRSML:	CALL LODOLO	;IS THERE AN OLD MAIL FILE?
	 CAIA
	  RET		;NO.
	SYSCAL RFDATE,[MOVEI INC ? MOVEM A]
	 RET
	CAMG A,MSGDAT	;IS IT MORE RECENT THAN PREVIOUS GMSGS?
	 RET
	MOVEI A,[ASCIZ /
(There is mail)
/]
	JRST TELL

WRITE1:	MOVEI A,BUFBOT		; A: origin of stuff to output
WRITE9:	MOVE B,BUFMID
	SUBM A,B		; B: -<amount to output>
	JUMPE B,CPOPJ		; None => Done
	HRLI A,(B)		; A: AOBJN
	TLO A,700000		; Round AOBJN down to safe negative range
	.IOT OUTC,A		; A: new origin
	JRST WRITE9		; Go try to output more

; This old code zeros your mail file if it gets longer than 128K!
; 	MOVN B,BUFMID
; 	ADDI B,BUFBOT	;-<# WORDS READ INTO BUFFER>
; 	HRLZS B
; 	HRRI B,BUFBOT	;AOBJN PTR TO FILLED PART OF BUFFER.
; 	.IOT OUTC,B
; 	RET

WRMAIL:	MOVE D,LSTEPT	;COME HERE TO MAIL THE MESSAGES.
	MOVEI A,40
	DPB A,D		;FLUSH THE ^_ AT THE END OF THE LAST MESSAGE.
	MOVE D,[440700,,MAILBF]
	SETZ C,		;C COUNTS CHARS PUT IN STRING.
	MOVEI A,[ASCIZ/FROM:QR"/]
	CALL WRMLAS
	MOVE A,USER
	CALL WRMLSX
	MOVEI A,[ASCIZ/
TO:"/]
	CALL WRMLAS
	SKIPN A,NAMBBP	;NAME SPECIFIED ON JCL?
	 JRST WRMAI3
	MOVEI G,0	;TERMINATE WITH A 0
	DPB G,NAMEBP
	CALL WRMLA1
	JRST WRMAI4

WRMAI3:	MOVE A,USER
	CALL WRMLSX
WRMAI4:	MOVEI A,[ASCIZ/
TEXT;-1/]
	CALL WRMLAS
	MOVEI A,40	;PAD UNTIL EXACTLY 2 CHARS LEFT IN WORD
WRMAI2:	HLRZ C,D
	CAIN C,170700
	 JRST WRMAI1
	IDPB A,D
	JRST WRMAI2

WRMAI1:	MOVEI A,[ASCIZ/
/]
	CALL WRMLAS	;THEN PUT A CRLF IN THOSE 2.
	SYSCAL OPEN,[[3,,OUTC] ? ['DSK,,] ? ['_GMSGS] ? ['OUTPUT] ? ['.MAIL.]]
	 JSR OPNERR
	MOVNI D,1-MAILBF(D)
	MOVSS D
	HRRI D,MAILBF
	.IOT OUTC,D
	CALL WRITE1
	SYSCAL RENMWO,[ MOVEI OUTC ? [SIXBIT/MAIL/] ? [SIXBIT/>/]]
	 .LOSE %LSFIL
	JRST WRITE2

;OUTPUT ASCIZ STRING <- A THROUGH BP IN D.
WRMLAS:	HRLI A,440700
WRMLA1:	ILDB B,A
	JUMPE B,CPOPJ
	IDPB B,D
	JRST WRMLA1

;OUTPUT SIXBIT WORD IN A THROUGH BP IN D.
WRMLSX:	SETZ B,
	ROTC A,6
	ADDI B,40
	IDPB B,D
	JUMPN A,WRMLSX
	RET

;Get system messages of the SYS:SYSTEM MAIL type as if they were *MSGS
GSYSML:	IRPS FN1,,[SYSTEM LOCAL NET]
	MOVE A,[.BAI,,'SYS]
	MOVE B,[SIXBIT/FN1/]
	MOVE C,[SIXBIT/MAIL/]
	.OPEN INC,A
	 CAIA
	  PUSHJ P,GSYSM1
	TERMIN
	.CLOSE INC,
	POPJ P,

GSYSM1:	HRLZM A,SYMINF
	MOVEM B,SYMINF+1
	MOVEM C,SYMINF+2
	.CALL [SETZ ? 'RFDATE ? MOVEI INC ? SETZM C]
	 .LOSE %LSSYS
	CAMG C,MSGDAT
	 POPJ P,		;Old message
	;Create a bogus header, author@machine date Re: filename
	MOVEM C,SYMINF+3
	.CALL [SETZ ? SIXBIT/RAUTH/ ? MOVEI INC ? SETZM SYMINF+4]
	 .LOSE %LSSYS
	HRRZ B,BUFMID		;First, make sure there's space
	ADDI B,30
	CAML B,BUFTOP
	 CALL MORCOR
	HRRZ B,BUFMID		;B byte pointer to message output
	HRLI B,440700
	MOVE D,SYMINF+4
	CALL SIXTYP
	MOVEI D,[ASCIZ/@MIT-/]
	CALL ASZTYP
	.CALL [SETZ ? 'SSTATU ? REPEAT 5,[MOVEM D ? ] SETZM D]
	 .LOSE %LSSYS
	CALL SIXTYP
	MOVEI D,40
	IDPB D,B
	MOVEI A,"/
	LDB D,[270400,,SYMINF+3]	;MONTH
	CALL 2DTYP
	IDPB A,B
	LDB D,[220500,,SYMINF+3]	;DAY
	CALL 2DTYP
	IDPB A,B
	LDB D,[330700,,SYMINF+3]	;YEAR
	CALL 2DTYP
	MOVEI A,40
	IDPB A,B
	MOVEI A,":
	HRRZ D,SYMINF+3
	LSH D,-1		;TIME IN SECONDS
	IDIVI D,3600.
	PUSH P,E
	CALL 2DTYP		;HOURS
	IDPB A,B
	POP P,D
	IDIVI D,60.
	PUSH P,E
	CALL 2DTYP		;MINUTES
	IDPB A,B
	POP P,D
	CALL 2DTYP		;SECONDS
	MOVEI D,[ASCIZ/ Re: [This is the file /]
	CALL ASZTYP
	MOVE D,SYMINF
	CALL SIXTYP
	MOVEI D,[ASCIZ/: /]
	CALL ASZTYP
	MOVE D,SYMINF+1
	CALL SIXTYP
	MOVEI A,40
	IDPB A,B
	MOVE D,SYMINF+2
	CALL SIXTYP
	MOVEI A,"]
	IDPB A,B
	;4 more characters to go, but must get to word boundary for LODFIL
	;Output spaces as needed
GSYSM2:	HLRZ A,B
	CAIN A,350700
	 JRST GSYSM3
	MOVEI A,40
	IDPB A,B
	JRST GSYSM2

GSYSM3:	MOVEI D,[ASCIZ/

/]
	CALL ASZTYP
	AOS B
	HRRZM B,BUFMID
	;Gasp.  Header all done, output text of file.
	CALL LODFIL
	.CLOSE INC,
	CALL ENDFIL
	MOVEM D,LSTEPT
	SETZM MSGLDT		;INDICATE AT LEAST ONE MESSAGE HAS BEEN FOUND.
	RET

SWPS==LUNBLK

;SORT THE .MSGS. DIRECTORY
;A POINTS TO FIRST ENTRY
;B POINTS TO LAST ENTRY + 1
;C HAS ONE BIT SET, THAT BIT MOST SIGNIFICANT BIT TO SORT ON
 ;IN PRACTICE, C WILL HOLD 4000,, .

SORT:	HRLM B,(P)	;SAVE UPPER BOUND
	CAIL A,-SWPS(B)
	JRST SORT7	;ONE OR ZERO ENTRIES
	PUSH P,A	;SAVE LOWER BOUND
SORT3:	TDNE C,UNDATE(A)	;BIT SET IN LOWER ENTRY?
	JRST SORT4	;NO, INCREMENT TO NEXT AND MAYBE TRY AGAIN
	SUBI B,SWPS	;YES, NOW BACK UP UPPER POINT	
	TDNN C,UNDATE(B)	;BIT CLEAR IN UPPER ENTRY?
	JRST SORT5	;NO, CHECK FOR END, DECREMENT B, AND TRY AGAIN
REPEAT SWPS,[		;BIT SET IN LOWER ENTRY AND CLEAR IN UPPER => EXCHANGE ENTRIES
	MOVE D,.RPCNT(A)
	EXCH D,.RPCNT(B)
	MOVEM D,.RPCNT(A)
]
SORT4:	ADDI A,SWPS	;INCREMENT LOWER BOUND POINTER TO NEXT ENTRY
SORT5:	CAME A,B	;ANY MORE ENTRIES LEFT?
	JRST SORT3	;YES, GO PROCESS THEM
		;A AND B NOW BOTH POINT TO FIRST ENTRY WITH BIT SET
	ROT C,-1	;ROTATE BIT INDICATOR TO NEXT (LESS SIGNIFICANT) BIT
	POP P,A		;RESTORE LOWER BOUND OF ENTIRE SORT
	JUMPL C,SORT6	;JUMP IF NO MORE KEY TO SORT ON
	PUSHJ P,SORT	;SORT BOTTOM PART OF TABLE
	HLRZ B,(P)	;RESTORE UPPER BOUND (SORT CLOBBERED A TO MIDDLE)
	PUSHJ P,SORT	;SORT TOP PART OF TABLE
SORT6:	ROT C,1		;BACK UP KEY AGAIN SO AS TOO "NOT CLOBBER C"
SORT7:	HLRZ A,(P)	;MAKE A POINT ABOVE TABLE ENTRIES SORTED
	POPJ P,

; Grab the lock for the inbox we will be hacking.
lock:	push p,a
	push p,b
	move a,user		; FN1
	rot a,1
	add a,malnam		; FN2
	rot a,1
	add a,hsname		; DIR
	idivi a,777773		; Largest prime < 1,,0
	hrli b,(sixbit /MBX/)
	skipe locknm
	 jrst lock2
	movem b,locknm
	;; Open LOCK:MBXxxx in hang mode:
lock1:	syscal open,[moves a ? movsi 10\.uao ? movei lockc
			[sixbit /LOCK/] ? move locknm]
	 cain a,%ensdv		; No LOCK device in this ITS?
	  jrst lock3		; Then pretend we won anyway (we're no
				; worse off than we used to be!)
	syscal lose,[movei %lssys(a) ? movei lock1]
	 .lose %lssys

lock2:	came b,locknm		; Already holding a lock, better be this
	 .lose			; one!
lock3:	pop p,b
	pop p,a
	popj p,

ifn 0,[	;; (Nothing needs to do this now, we just hold the lock until the
	;; job is killed.)
; Unlock any lock being held.
unlock:	skipn locknm		; If not holding a lock, caller may be
	 .lose			; badly confused!
	setzm locknm
	.close lockc,
	popj p,
] ; ifn 0

;TRY TO LOAD THE OLD MAIL FILE, IF THERE IS ONE.
LODOLD:	CALL LODOLO
	 CALL LODFIL
	RET

;OPEN THE OLD MAIL FILE, DETERMINE WHICH DEVICE TO WRITE NEW ONE ON.
;SKIP IF THERE IS NO OLD MAIL FILE.
LODOLO:	call lock		; Start by locking this inbox
lodol3:	syscal OPEN,[ %clbit,,.bai ? %climm,,inc ? [sixbit /DSK/]
		      user ? MALNAM ? hsname ? %clerr,,b]
	  caia
	    ret
	cain b,%ensfl
	 jrst popj1	;There's no old file. Write the new one on DSK.
	syscal lose,[movei %lsfil ? movei lodol3]	;Lose if file locked.
	 .lose %lssys

;READ INTO THE BUFFER THE FILE OPEN ON INC. ALL FILES READ INTO THE
;BUFFER GET READ IN AT BUFMID, AND BUFMID IS ADVANCED TO POINT AFTER
;THE FILE READ IN.
LODFIL:	MOVN B,BUFTOP
	ADD B,BUFMID	;-<AMOUNT OF MEMORY SPACE AVAIL ABOVE FILLED PART OF BUFFER>
	HRLZS B
	HRR B,BUFMID	;<AOBJN PTR TO UNFILLED PART OF BUFFER>
	.IOT INC,B
	HRRZM B,BUFMID	;UPDATE BUFMID, SINCE WE JUST FILLED MORE OF THE BUFFER.
	JUMPL B,CPOPJ	;IF WE REACHED EOF, WE'RE FINISHED.
	CALL MORCOR
	JRST LODFIL	;READ IN MORE OF THE FILE.

;GET 1 MORE K OF CORE.
MORCOR:	MOVE B,BUFTOP	;OTHERWISE WE FILLED UP THE BUFFER, SO GET MORE MEMORY.
	LSH B,-12
	.CORE 1(B)	;GET 1 MORE K OF CORE.
	 JRST [MOVEI C,30. ? .SLEEP C, ? JRST .-1]
	MOVEI B,2000	;BE AWARE WE NOW HAVE 1K MORE SPACE.
	ADDM B,BUFTOP
	RET

;AFTER LOADING A FILE, SET UP TO CONCATENATE ANOTHER FILE TO IT.
;LEAVE IN D A B.P. TO THE ^_ WHICH IS PUT AT THE END OF THE FILE,
;IN CASE CALLER DESIRES TO REPLACE IT WITH A SPACE.
ENDFIL:	MOVE B,BUFMID	;NOW STRIP OFF TRAILING ^C'S AND ^L'S
	HRLI B,350700	;B.P. TO CHAR AFTER THE LAST CHAR READ IN.
UNPAD:	DBP7 B
	LDB C,B
	CAIE C,^C	;GO BACKWARDS TILL REACH THE FIRST NON-^C NON-^L.
	 CAIN C,^L
	  JRST UNPAD
	JUMPE C,UNPAD	;^@ ALSO COUNTS AS PADDING.
	PUSH P,B
	JRST UNPAD2

UNPAD1:	DBP7 B		;THEN PEEK BACK AT THE END OF THE LAST LINE
UNPAD2:	LDB D,B
	CAIE D,^M
	 CAIN D,^J
	  JRST UNPAD1
	CAIN D,40
	 JRST UNPAD1
	POP P,B
	MOVEI C,^_	;UNLESS LAST LINE ENDS IN A ^_, INSERT ONE.
	CAIN D,^_	;IF ALREADY A ^_, USE A SPACE INSTEAD.
	 MOVEI C,40	;REPLACE THE FIRST ^C OR ^L WITH IT.
	IDPB C,B
	MOVE D,B
PAD:	TLNN B,760000	;THEN FILL SPACE IN WORD, AFTER THAT CHAR, WITH BLANKS.
	 AOJA B,ENDFI1
	MOVEI C,40
	IDPB C,B
	JRST PAD

ENDFI1:	HRRZM B,BUFMID	;NOW PUT CRLF AFTER THE MESSAGE,
	ADDI B,1	;FIRST MAKING SURE THERE'S ROOM IN CORE.
	CAML B,BUFTOP
	 CALL MORCOR
	MOVE B,[.BYTE 7 ? 40 ? 40 ? 40 ? ^M ? ^J]
	MOVEM B,@BUFMID
	AOS BUFMID
	RET

;C HAS A SIXBIT WORD; TYPE IT IN ASCII ONTO THE B.P. IN B,
;ALWAYS USING 6 CHARACTERS.
SIXOUT:	MOVEI E,6
SIXOU1:	ROTC C,6
	ANDI D,77
	ADDI D,40
	IDPB D,B
	SOJG E,SIXOU1
	RET

;SIMILAR BUT FLUSHES TRAILING SPACES.  OUTPUTS FROM D.
SIXTYP:	SETZ C,
	LSHC C,6
	ADDI C,40
	IDPB C,B
	JUMPN D,SIXTYP
	RET

ASZTYP:	HRLI D,440700
ASZTY1:	ILDB C,D
	JUMPE C,CPOPJ
	IDPB C,B
	JRST ASZTY1

2DTYP:	IDIV D,100.
	MOVE D,E
	IDIVI D,10.
	ADDI D,"0
	ADDI E,"0
	IDPB D,B
	IDPB E,B
	RET

;The * names which specify topics also specify mailing list archive files to look at.
;These are actually links on .MSGS. which point to the real files.
;If the user specifies *FOO, look for a file .MSGS.;_FOO >.
;G points to the word in the stack which follows the list of names
;and contains a pointer to the first of the names.
;If an archive file is updated since we last looked,
;then a notification message is put in the user's mail file.
;We skip if there was any new archive file.
arc:	pop g,a
	setz b,			;B gets -1 if we find anything.
arc1:	save a
	save g
	save b
	move c,1(a)		;Take name and replace "*" with "_".
	tlz c,770000
	tlo c,<'_>_12.
	syscal open,[%climm,,inc ? %clbit,,.bai ? ['dsk,,] ? c ? [sixbit />/] ? ['.MSGS.]]
	 jrst arc2		;ignore any files that don't exist.
	syscal rfdate,[%climm,,inc ? %clout,,c]
	 .lose %lsfil
	camg c,msgdat		;is this file more recent than our last look?
	 jrst arc2
	move c,buftop
	sub c,bufmid
	caige c,100		;Make sure we have at least 100 words of memory,
	 call morcor		;which will be more than enough.
	move c,bufmid
	move d,bufmid
	hrli d,arcmsg		;copy our phony message into the output.
	blt d,arcmsl-1(c)
	movei d,arcfil(c)
	hrli d,440700
	syscal rfname,[%climm,,inc ? %clout,,arcdev
		%clout,,arcf1 ? %clout,, arcf2 ? %clout,,arcsnm]
	 .lose %lsfil
	movei b,arcdev		;Get file's names and output into phony message.
	call rfn"pfn
	movei b,40		;Replace zero terminator with a space.
	idpb b,d
	movei c,arcmsl(c)
	movem c,bufmid
	hrli c,170700
	sos c
	movem c,lstept		;Save pointer to the ^_ ending the phony message.
	.close inc,
	setom (p)
arc2:	rest b
	rest g
	rest a
	add a,[1,,1]		;After all files, return
	came a,g
	 jrst arc1
	skipe b			;skipping if the flag was set.
	 aos (p)
	popj p,

arcdev:	0			;These words get the real file names of the
arcf1:	0			;file which has new material in it.
arcf2:	0
arcsnm:	0

arcmsg:	ascii /There is new material in the file  / ;35 characters
arcfil==.-arcmsg
	ascii /                         / ;25 chars.  Space for filename.
	ascii /

/
arcmsl==.-arcmsg	

rfn"$$pfn==1
rfn"psixtp:	popj p,

.insrt syseng;rfn

;READ A SIXBIT NAME FROM THE COMMAND STRING INTO A.
;PROCESS ANY SWITCHES THAT MAY OCCUR - THEY TERMINATE THE NAME.
;IF WE FIND A WORD THAT DOESN'T START WITH *,
;WE LEAVE A BP TO ILDB THE FIRST CHARACTER IN NAMBBP AND A BP TO THE TERMINATOR IN NAMEBP.
RDSIX:	SETZ A,
	SETZ H,
	SETZ C,
	MOVE B,[440600,,A]
	MOVE G,CMDBP
RDSIX1:	MOVE C,G
	ILDB I,G
	CAIE I,",	;COMMA, SPACE AND CONTROL CHARS END A NAME.
	 CAIG I,40
	  JRST RDSIX2
	CAIN I,"/	;SLASH BEGINS A SWITCH
	 JRST RDSWIT
	SKIPN H		;REMEMBER BP TO CHAR BEFORE START OF NON-NULL TEXT OF THIS WORD.
	 MOVE H,C
	CAIL I,140	;CONVERT LOWER CASE TO UPPER.
	 SUBI I,40
	SUBI I,40	;CONVERT TO SIXBIT
	TLNE B,770000	;IGNORE LETTERS AFTER THE 6TH.
	 IDPB I,B
	JRST RDSIX1

RDSIX2:	MOVEM G,CMDBP	;MARK WHAT WE HAVE JUST READ AS DONE WITH.
	JUMPE H,CPOPJ	;IF WE FOUND A NON-NULL WORD,
	MOVE B,H
	ILDB B,B	;AND IT DIDN'T START WITH "*",
	CAIN B,"*
	 POPJ P,
	MOVEM H,NAMBBP	;REMEMBER POINTERS TO START AND END AS THE ASCII FOR
	MOVEM G,NAMEBP	;THE SPECIFIED USER'S NAME.
CPOPJ:	RET

RDSWIT:	MOVEM C,CMDBP	;IF WE ALREADY HAVE A NON-NULL NAME, THE SWITCH TERMINATES IT,
	JUMPN A,CPOPJ	;SO RETURN.  NEXT CALL TO RDSIX WILL HANDLE THE SWITCH.
	ILDB I,G	;HANDLE A SWITCH
	CAIE I,^C
	 CAIN I,^M	;MUSTN'T FAIL TO NOTICE END OF COMMAND STRING
	  JRST RDSIX2	;EVEN IF IT'S IN A SWITCH.
	CAIL I,140
	 SUBI I,40
	CAIN I,"D
	 SETOM SHODIS	;/D => SHOW DISTRIB: AND EXPIRES: FIELDS.
	CAIN I,"R
	 SETOM REVERS	;/R => REVERSE ORDER (MESSAGES GO AT END)
	CAIN I,"S
	 SETOM SILNT	;/S => DON'T TYPE ANYTHING OUT.
	CAIN I,"M
	 SETOM MAILF	;/M => MAIL THE MESSAGES THROUGH THE COMSAT INSTEAD OF DIRECTLY.
	CAIN I,"G	;/G => USE GMSGS FILE INSTEAD OF CLOBBERING MAIL FILE
	  SETOM GMSGSF
;;UNCOMMENT THE NEXT BIT WHEN BABYL UNDERSTANDS GMSGS FILES
;	SKIPN MAILF
;	 SKIPE GMSGSF
;	  CAIA
;	   SYSCAL OPEN,[%CLIMM,,INC ? [SIXBIT /DSK/] ? XUNAME
;			[SIXBIT /BABYL/] ? HSNAME]
;	    CAIA
;	     SETOM GMSGSF
	CAIN I,"N
	 SETOM NOTIFF	;/N => IF MAIL FILE IS MORE RECENT THAN MSGS, NOTIFY USER.
	CAIN I,"T
	 SETOM TTYF	;/T => PRINT MSGS ON TTY INSTEAD.
	CAIN I,"Z	;/Z => SHOW SYS:SYSTEM MAIL AND THE LIKE (MAINLY FOR ZMAIL)
	 SETOM SYSMLF
	JRST RDSIX1

	;DELETES ALL EXPIRED MESSAGES FROM .MSGS.;
	;A MESSAGE EXPIRES AT THE TIME IT SAYS IT DOES IN THE "EXPIRES:"
	;FIELD, OR 30 DAYS AFTER IT WAS WRITTEN.
	;THE DATE AND TIME EXPIRE WAS LAST RUN IS RECORDED BY
	;THE DATE OF THE FILE .MSGS.;_LAST_ EXPIRE
	;UNLESS THERE IS A JCL COMMAND STRING "OVERRIDE<CR>",
	;IF IT IS MORE THAN 3 DAYS SINCE THE DATE AND TIME
	;REMEMBERED BY THAT FILE, NOTHING WILL BE DELETED
	;AND A COMPLAINT WILL BE MAILED TO BUG-EXPIRE.

DIRBFL==2000	;LENGTH OF BUFFER FOR READING .MSGS.; U.F.D.

; First see if today's date is reasonable.  If the date known by the
; system is wrong, we could massacre .MSGS.; completely.  We defend
; against that by storing the date of the last EXPIRE doneas the
; creation date of .MSGS.;_LAST_ EXPIRE.  If the current date is less
; than a day since then, we just don't bother to do anything (why waste
; time reaping too often?).  If the current date is more than 3 days
; since then, we assume that something very strange is going on.  In
; that case, we send a message to BUG-EXPIRE reporting what happened,
; and rename .MSGS.;_LAST_ EXPIRE to .MSGS.;_LAST_ EXPIR?, which has the
; effect of preventing any more messages from being sent to BUG-EXPIRE
; redundantly, without losing the information of when the last EXPIRE
; was done.  This condition must be fixed manually by a human, by
; creating a new _LAST_ EXPIRE file.  A day later, a reap will be done.
; Since dates are kept as days since start of century, there is a
; problem with wraparound at the start of a century, which is checked
; for specially.

EXPIRE:	MOVE A,MSGTDT
	CALL QTONUM	;GET DAY AND YEAR AS NUMBER IN B
	MOVE E,B
	SYSCAL OPEN,[[.UAI,,INC] ? ['DSK,,] ? [SIXBIT /_LAST_/] ? ['EXPIRE] ? ['.MSGS.]]
	 POPJ P,
	SYSCAL RFDATE,[MOVEI INC ? MOVEM A]
	 POPJ P,
	.CLOSE INC,
	CALL QTONUM	;Compare with date of last running of EXPIRE.
	CAIGE E,3	;If today's date just wrapped around, special action needed.
	 JRST [	SUB B,E
		JUMPL B,DATEOK
		JUMPE B,CPOPJ
		CAIL B,MAXDAT-3	;See if date of prev. run is close enough to wrapping.
		 JRST DATEOK
		JRST DATEBD]
	CAMLE B,E
	 JRST DATELS	;Previous run is in the future???
	CAMN B,E	;Don't bother reaping twice in a day.
	 POPJ P,
	ADDI B,3
	CAML B,E	;More than 3 days ago => suspect that hardware forgot the date.
	 JRST DATEOK
DATEBD:	SKIPA A,[-DISTRL,,DISTRS]
DATELS:	 MOVE A,[-INSANL,,INSANE]
COMPLN:	SYSCAL OPEN,[[.BAO,,INC] ? ['DSK,,] ? [SIXBIT /MAIL/] ? [SIXBIT />/] ? ['.MAIL.]]
	 .LOSE %LSFIL
	.IOT INC,A
	.CLOSE INC,
	SYSCAL DELETE,[['DSK,,] ? [SIXBIT /_LAST_/] ? [SIXBIT /EXPIR?/] ? ['.MSGS.]]
	 JFCL
	SYSCAL RENAME,[['DSK,,] ? [SIXBIT /_LAST_/] ? [SIXBIT /EXPIRE/] ? ['.MSGS.]
		[SIXBIT /_LAST_/] ? [SIXBIT /EXPIR?/]]
	 JFCL
	POPJ P,

DISTRS:	ASCIC /FROM-JOB:GMSGS
FROM:Q"BUG-GMSGS
TO:"SYS-OPERATING-TROUBLE
SUBJECT:Is I.T.S. mistaken as to today's date?
TEXT;-1
Although GMSGS is supposed to delete expired messages from .MSGS.
automatically every day, it detected that the date of its previous run
was more than three days in the past.  This may or may not indicate
that something is still wrong;  just in case, GMSGS didn't do anything.
Please make sure that I.T.S. knows the correct date, using
PDSET if necessary, and then create a new file .MSGS.;_LAST_ EXPIRE.
/
DISTRL==.-DISTRS

INSANE:	ASCIC /FROM-JOB:GMSGS
FROM:Q"BUG-GMSGS
TO:"BUG-GMSGS
TO:"SYS-OPERATING-TROUBLE
SUBJECT:Is I.T.S. mistaken as to today's date?
TEXT;-1
Although GMSGS is supposed to delete expired messages from .MSGS.
automatically every day, it detected that the date of its previous run
was IN THE FUTURE???  Something must be wrong, so GMSGS didn't do anything.
Please make sure that I.T.S. knows the correct date, using
PDSET if necessary, and then create a new file .MSGS.;_LAST_ EXPIRE.
/
INSANL==.-INSANE

;Come here after deciding that it's actually safe to delete files.
DATEOK:	MOVE A,MSGTDT
	CALL QTONUM
	MOVEM B,TODAY		;COMPUTE # DAYS SINCE START OF CENTURY.
	SYSCAL OPEN,[[.BII,,INC] ? ['DSK,,] ? ['.FILE.] ? [SIXBIT /(DIR)/] ? ['.MSGS.]]
	 JFCL
	MOVE A,[-DIRBFL,,VPAGAD]
	.IOT INC,A		;READ IN THE .MSGS.; DIRECTORY
	.CLOSE INC,
	MOVEI I,VPAGAD-LUNBLK
	ADD I,VPAGAD+1		;GET ADDRESS OF 1ST NAME-ENTRY IN DIRECTORY.
EXPIRL:	ADDI I,LUNBLK		;LOOK AT NEXT FILE.
	CAIN I,VPAGAD+DIRBFL
	 JRST EXPIRD
	SKIPE UNFN1(I)
	 SKIPN UNFN2(I)
	  JRST EXPIRL		;IGNORE FILES THAT AREN'T REALLY IN EXISTENCE.
	LDB D,[360600,,UNFN1(I)]
	CAIN D,'_		;IGNORE FILE IF FN1 STARTS WITH _.
	 JRST EXPIRL
	MOVE D,UNRNDM(I)	;IGNORE LINKS AND INACCESSIBLE FILES.
	TLNE D,UNLINK\UNIGFL
	 JRST EXPIRL
	SYSCAL OPEN,[[10+.BAI,,INC] ? ['DSK,,] ? UNFN1(I) ? UNFN2(I) ? ['.MSGS.]]
	 JRST EXPIRL		;10 BIT SAYS DON'T CHANGE REF DATE.
	CALL INCO1		;INITIALIZE BUFFERED READING OF FILE WITH INCI.
	call sdist		;DOES THE FILE START WITH "DISTRIB: "?
	 jrst expns		;NO "DISTRIB:" => FILE DOESNT SAY WHEN IT
				; EXPIRES SO USE CREATION DATE + 30 DAYS.
	CALL MSGIL		;SKIP THE REST OF THE "DISTRIB:" LINE.
	 JRST EXPIR1		;NO MORE IN FILE => SAY IT HAS EXPIRED ALREADY.
	MOVEI G,40
	CALL MSGI1		;SKIP PAST "EXPIRES: ".
	 JRST EXPIR1		 ;NO SPACE FINDABLE?
	MOVE G,[CALL INCI]
	CALL RDATE		;READ THE EXPIRATION DATE.
	MOVE A,C
	CALL QTONUM		;TURN INTO NUMBER OF DAYS.
	JRST EXPLCT

EXPNS:	MOVE A,UNDATE(I)
	CALL QTONUM		;TURN FILE DATE INTO NUMBER
	ADDI B,30.		;GET DATE OF 30 DAYS AFTER FILE CREATED.
EXPLCT:	CAMGE B,TODAY		;EXPIRED BEFORE NOW?
	 JRST EXPIR1
	MOVE C,TODAY
	CAIL B,MAXDAT-100.	;IF EXP. DATE IS JUST BELOW WRAPAROUND, AND TODAY'S
	 CAIL C,100.		;DATE JUST AFTER IT, FILE HAS EXPIRED.
	  JRST EXPIRL
EXPIR1:	SYSCAL RDMPBT,[MOVEI INC ? MOVEM C]
	 JRST EXPIRL
	JUMPE C,EXPIRL		;EXPIRED BUT NOT ON BACKUP TAPE => DON'T DELETE
	SYSCAL DELETE,[['DSK,,] ? UNFN1(I) ? UNFN2(I) ? ['.MSGS.]]
	 JFCL
	JRST EXPIRL

;Here when have deleted all appropriate files on .MSGS.;
EXPIRD:	MOVE A,[.UAI,,INC]
	.CALL EXPFIL	;Open _LAST_ EXPIRE for reading.
	 .LOSE %LSFIL	;I know it's there! I saw it.
	SYSCAL SFDATE,[MOVEI INC ? MOVE MSGTDT]
	 .LOSE %LSFIL	;Set its creation date to right now.
	POPJ P,

EXPFIL:	SETZ ? SIXBIT/OPEN/ ? A
	['DSK,,] ? [SIXBIT /_LAST_/] ? ['EXPIRE] ? SETZ ['.MSGS.]

;CONVERT DISK-FORMAT DATE (RQDATE, RFDATE), IN A,
;TO NUMBER OF DAYS SINCE START OF CENTURY (APPROX), IN B.
;APPROXIMATION IGNORES LEAP YEARS, ASSUMING 366 DAYS PER YEAR;
;IT IS MONOTONIC, BUT CAN JUMP BY 1 DAY AT END OF FEB.
;THEREFORE, ADDING A SMALL INTEGER TO
;THE OUTPUT OF QTONUM INTRODUCES AN INACCURACY OF 1 DAY.
QTONUM:	SAVE C
	LDB B,[330700,,A]
	IMULI B,366.		;ADD # DAYS IN COMPLETE PAST YEARS (APPROX)
	LDB C,[270400,,A]
	ADD B,MONTAB(C)		;ADD EXACT # DAYS IN COMPLETE PAST MONTHS
	CAILE C,6		;FOR CONCISENESS, LENGTH OF JAN THRU MAY ISN'T
	 ADDI B,31.+29.+31.+30.+31.+30.	;INCLUDED IN TABLE FOR 2ND HALF YEAR.
	LDB C,[220500,,A]
	ADDI B,-1(C)		;ADD IN # OF DAYS IN THIS MONTH.
	REST C
	RET

MONTAB:	0		;EXTRA WORD, SINCE MONTHS NUMBERED STARTING FROM 1.
	0 ? 31. ? 31.+29. ? 31.+29.+31. ? 31.+29.+31.+30. ? 31.+29.+31.+30.+31.
	0 ? 31. ? 31.+31. ? 31.+31.+30. ? 31.+31.+30.+31. ? 31.+31.+30.+31.+30.

MAXDAT==100.*366.	;VALUE AT WHICH DAY COUNTS WRAP AROUND TO 0, BECAUSE
;THE QDATES THEY ARE COMPUTED FROM DO LIKEWISE.
;WHEN COMPARING TWO DATES, MUST CHECK FOR POSSIBILITY THAT THE LATER ONE
;HAS WRAPPED AROUND, BUT THE EARLIER ONE HAS NOT.  IN SUCH A CASE, THE
;LATER DATE IS NEAR ZERO AND THE EARLIER ONE IS JUST BELOW MAXDAT.

TODAY:	0		;TODAY'S DATE, AS # DAYS FROM START OF CENTURY.

PDL:	BLOCK PDLL
CMD:	BLOCK CMDL	;DDT'S COMMAND READ INTO THIS BLOCK.

.GLOBAL PAT,PATCH,PATCHE
PAT:
PATCH:	BLOCK 40
PATCHE:	-1


CMDBP:	0		;BP FOR READING CMD.

;; The next three words must be in this order.
ITSNAM:	0		;THE ITS TO MAIL IT TO.
USER:	0		;NAME OF USER WHOSE MAIL IS BEING SNARFED.
HSNAME:	0		;DIR TO FIND MAIL-FILE ON.
MALNAM:	SIXBIT /MAIL/	;SECOND FILENAME TO USE (MAIL OR GMSGS) (SEE /G SW)

LOCKNM:	0		; Name of currently held LOCK: device lock.

REVERS:	0		;-1 => /R PUT MESSAGES AT END, EARLIEST FIRST.
			;NORMALLY MESSAGES GO AT FRONT OF MAIL FILE,
			;LATEST FIRST. SET BY "R" SWITCH IN COMMAND LINE.
GMSGSF:	0		;-1 => /G SWITCH: WRITE GMSGS FILE INSTEAD OF MAIL FILE
MAILF:	0		;-1 => /M SWITCH: MAIL THE MESSAGES THROUGH THE COMSAT.
TTYF:	0		;-1 => /T SWITCH: TYPE MESSAGES INSTEAD.
SILNT:	0		;-1 => /S DON'T TYPE OUT "THERE ARE MESSAGES"
SPCDST:	0		;-1 => KEYWORDS FOR DISTRIB: WERE SPEC'D IN COMMAND.
NOTIFF:	0		;-1 => /N SWITCH: NOTIFY USER IF HE HAS NON-GMSGS
				;NEW MAIL (ARRIVED SINCE LAST GMSGS).
SHODIS:	0		;-1 => /D SWITCH: SHOW DISTRIB: AND EXPIRES: FIELDS.
SYSMLF:	0		;-1 => /Z SWITCH: SHOW SYS:SYSTEM MAIL AND THE LIKE
NAMBBP:	0		;NONZERO => BYTE PTR TO START OF NAME
NAMEBP:	0		;NONZERO => BYTE PTR TO END OF NAME
DEBUG:	0		;-1 => DEBUGGING.

;:MSGS STUFF
MSGDAT:	0	;DATE S.T. EARLIER MSGS AREN'T TYPED.
MSGLDT:	0	;BEFORE 1ST FILE, -1; ELSE DATE OF LAST FILE STARTED.
MSGTDT:	0	;TODAY'S DATE AND TIME.

MSGF3:	SIXBIT/  "DSK/
	0?0
MSGSNM:	SIXBIT /.MSGS./	;F.D. TO LOOK IN
MSGLOC:	0		;LOCATION OF THIS USER'S ENTRY IN :MSGS TIMES

SYMINF:	BLOCK 5		;INFORMATION ABOUT SYSTEM MAIL BEING PROCESSED
VPAGAD:	BLOCK 2000	;.MSGS.; DIRECTORY READ IN HERE.
LAST:	0		;ADDRESS OF FIRST THING WE'LL LOOK AT
			;THAT IS NOT A FILEBLOCK.
			;VPAGAD+2000 IF INCREM > 0,
			;<ADDR OF 1ST FILEBLOCK>-LUNBLK IF INCREM < 0.
INCREM:	0		;INCREMENT FROM ONE FILEBLOCK TO THE NEXT.
			;EITHER LUNBLK OR -LUNBLK.
	CONSTA
	VARIAB

MAILBF:	REPEAT 10.,ASCII/     /	;BUFFER FOR HEADER OF FILE TO WRITE ON .MAIL.
LSTEPT:	0		;POINTER TO ^_ AT END OF LAST MESSAGE SAVED HERE.

BUFMID:	BUFBOT		;POINTS INTO BUFFER, AT BEGINNING OF EMPTY PART.
BUFTOP:	MEMTOP		;POINTS AT TOP OF EMPTY PART (=TOP OF MEMORY)
msgpag==<.+1777>&-2000/2000
msglen=20

MEMTOP=<msgpag+msglen>*2000
BUFBOT==memtop  ;BEGINNING OF BUFFER.
		;IN THE BUFFER, THE PART FROM BUFBOT TO @(BUFMID)-1 IS FILLED.
		;THE PART FROM @(BUFMID) TO @(BUFTOP)-1 IS EMPTY.

	END BEG