Google
 

Trailing-Edge - PDP-10 Archives - BB-Y390U-BM - t20src/mailer.mac
There are 23 other files named mailer.mac in the archive. Click here to see a list.
;Edit 19 to MAILER.MAC by TGRADY on Wed 1-Aug-84
;		Fix edit 16 bug that smashes MAIL.TXT files
;Edit 17 to MAILER.MAC by TGRADY on Wed 1-Aug-84, for SPR #17857
;		Add UFPGS before CLOSF's of MAIL.TXT to avoide file damage.
;Edit 16 to MAILER.MAC by TGRADY on Thu 31-May-84, for SPR #20047
;		Insert ERJMP's after JSYS's that could ITRAP.
;Edit 15 to MAILER.MAC by TGRADY on Wed 30-May-84, for SPR #16574
;		SPR 16574 - Illegal Instruction Trap in ONQ:
;Edit 14 to MAILER.MAC by LOMARTIRE on Thu 8-Mar-84, for SPR #19908
;		Make sure all TTMSGs are protected against crashing MAILER
;Edit 13 to MAILER.MAC by LOMARTIRE on Mon 27-Jun-83, for SPR #18367
;		Add new error message for when assigning PID to channel fails
;Edit 12 to MAILER.MAC by LOMARTIRE on Mon 27-Jun-83, for SPR #18610
;		Add ERJMP to prevent TTMSG from crashing MAILER
;<5.UTILITIES>MAILER.MAC.2, 28-Oct-81 15:14:12, EDIT BY GRANT
;Change major version to 5
; UPD ID= 186, FARK:<4-WORKING-SOURCES.UTILITIES>MAILER.MAC.2,   3-Sep-80 14:16:23 by ZIMA
;Edit 11 - do CHKAC to prevent deleting improper files.
;<4.UTILITIES>MAILER.MAC.37,  3-Jan-80 15:25:58, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.UTILITIES>MAILER.MAC.36, 20-Sep-79 13:20:35, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.35, 20-Sep-79 13:18:36, Edit by LCAMPBELL
; Remove initial dashes from msgs (violates RFC733)
;<4.UTILITIES>MAILER.MAC.34, 19-Sep-79 12:32:41, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.33, 19-Sep-79 12:28:10, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.32, 19-Sep-79 12:25:17, Edit by LCAMPBELL
; If MAIL.TXT busy, wait for up to 20 seconds before giving up
;<4.UTILITIES>MAILER.MAC.31, 16-Aug-79 14:35:13, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.30, 16-Aug-79 14:25:23, Edit by LCAMPBELL
; Insure CRLF before =======
;<4.UTILITIES>MAILER.MAC.29, 16-Aug-79 11:34:53, Edit by LCAMPBELL
; Eliminate ALL nulls from mail
;<4.UTILITIES>MAILER.MAC.28, 15-Aug-79 18:14:32, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.27, 15-Aug-79 18:07:42, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.26, 15-Aug-79 18:01:42, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.24, 15-Aug-79 17:28:17, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.23, 15-Aug-79 17:26:10, Edit by LCAMPBELL
; TCO 4.2402 - Don't insert spurious nulls into MAIL.TXT
;<4.UTILITIES>MAILER.MAC.22, 25-Jun-79 17:12:08, Edit by LCAMPBELL
; Prettier date/time in headers
;<4.UTILITIES>MAILER.MAC.21, 29-May-79 09:55:43, Edit by OSMAN
;TCO 4.2260 - Don't check TT%DAM when outputting mail announcement
;<4.UTILITIES>MAILER.MAC.20,  4-May-79 14:43:48, Edit by LCAMPBELL
; Don't put unwanted dashes into header
;<4.UTILITIES>MAILER.MAC.19,  1-May-79 13:26:27, EDIT BY OSMAN
;tco 4.2242 - Don't go arggggggh when bogus user number received
;<4.UTILITIES>MAILER.MAC.18,  4-Apr-79 13:28:26, Edit by LCAMPBELL
; Upper/lowercase header fields
;<4.UTILITIES>MAILER.MAC.17, 12-Mar-79 14:23:54, Edit by LCAMPBELL
; At OVRQTA, save D before IDIVI, since remainder goes in D
;<4.UTILITIES>MAILER.MAC.16, 10-Mar-79 14:06:09, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.UTILITIES>MAILER.MAC.15,  9-Mar-79 10:28:57, EDIT BY MILLER
;ONE MORE CHANGE TO OVRQTA. DO PAGE COMPUTATIONS CORRECTLY
;<4.UTILITIES>MAILER.MAC.14,  9-Mar-79 10:18:17, EDIT BY MILLER
;MORE FIXED. GET PAGE NUMBER CORRECTLY AT OVRQTA
;<4.UTILITIES>MAILER.MAC.13,  8-Feb-79 10:15:55, EDIT BY MILLER
;FIX OVER QUOTA HANDLING (AGAIN). USE CHFDB TO SET EOF POINTER
;<4.UTILITIES>MAILER.MAC.12, 23-Jan-79 16:09:18, Edit by KONEN
;UPDATE VERSION NUMBER FOR RELEASE 4
;<4.UTILITIES>MAILER.MAC.11, 23-Oct-78 19:52:38, Edit by HESS
;TCO 4.2062 - ADD COMMA TO END OF TO: AND CC: LINES THAT ARE CONTINUED
;<4.UTILITIES>MAILER.MAC.10, 20-Oct-78 10:52:58, Edit by HESS
;TCO 4.2056 CHECK 'REFUSE SYSTEM-MESSAGES' AND SET LAST WRITER STRING
;<4.UTILITIES>MAILER.MAC.9, 21-Sep-78 11:07:31, EDIT BY MILLER
;TCO 1897 AGAIN. MAKE SURE JFN IS IN A AT OVRQT1
;<4.UTILITIES>MAILER.MAC.8, 19-Jul-78 19:44:21, EDIT BY MILLER
;TURN ON CAPS BEFORE DOING CHFDB
;<4.UTILITIES>MAILER.MAC.7,  3-Apr-78 09:51:56, EDIT BY MILLER
;TCO 1897. FIX QUOTA PROBLEM
;<4.UTILITIES>MAILER.MAC.6,  3-Apr-78 09:48:00, EDIT BY MILLER
;OPENF MAIL FILE FOR READ AND WRITE
;<4.UTILITIES>MAILER.MAC.5,  3-Apr-78 09:42:46, EDIT BY MILLER
;FIX TYPEO
;<4.UTILITIES>MAILER.MAC.4,  3-Apr-78 09:42:12, EDIT BY MILLER
;COMPUTE EOF OF MAIL FILE FROM FDB DATA
;<4.UTILITIES>MAILER.MAC.3, 31-Mar-78 13:11:54, EDIT BY MILLER
;<4.UTILITIES>MAILER.MAC.2, 31-Mar-78 13:07:05, EDIT BY MILLER
;<4.UTILITIES>MAILER.MAC.1, 31-Mar-78 13:05:21, EDIT BY MILLER



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	TITLE MAILER
	SEARCH MONSYM,MACSYM
	SALL
	.REQUIRE SYS:MACREL
	IFNDEF .PSECT,<
	.DIRECT .XTABM>

; VERSION NUMBER DEFINITIONS

VMAJOR==5		;MAJOR VERSION OF MAILER
VMINOR==0		;MINOR VERSION NUMBER
VEDIT==^D18		;EDIT NUMBER
VWHO==0			;GROUP WHO LAST EDITED PROGRAM (0=DEC DEVELOPMENT)

VMAILR== <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT

;DEFINE REGISTERS

A==1
B==2
C==3
D==4
W==5
W1==6
W2==7
W3==10
W4==11
W5==12
W6==13
P==17
NOACK==2			;NO MESSAGES COULD BE SENT
NOACK1==1			;ONE OR MORE IDS WERE BAD
NOACKQ==1			;QUOTA EXCEEDED
NOACKB==0			;STANDARD MEANINGLESS ERROR
.IPCSN==67			;INFO WEND NAME FUNCTION
MAXTRY==5
SYSCOD==-2			;SPECIAL CODE FOR SYSTEM MESSAGE


MESS==10000			;MESSAGE BUFFER
USERS==^D512
USRBLK=11000
FILBUF==USRBLK+USERS
FILSIZ==^D50
BIGBUF==FILBUF+FILSIZ
SIZE==^D500000/5		;SIZE OF MESSAGE BUFFER
AREA==BIGBUF+SIZE		;FREE SPACE AREA
FRESIZ==5000			;LEAVE LOTS OF ROOM

;**;[18] Add 6 lines to JERR MACRO definition		TJG	1-Aug-84
;**;[16] Define JERR Macro to ERJMP after JSYS'S	TJG	31-MAY-84

DEFINE JERR ($TXT),<
	 ERJMP [PUSH P,A	;;Save Ac's
		PUSH P,B	;;
		PUSH P,C	;;
		CALL JSERR0	;;USE STANDARD ROUTINE TO TYPE JSYS ERROR
		TMSG <$TXT>	;;PRINT SPECIFIC MESSAGE
		PUSH P,C	;;Restore ac's
		PUSH P,B	;;
		PUSH P,A	;;
		JRST .+1 ]
>
EOFPTR:	BLOCK 1			;HOLD EOF VALUE
GETSIZ:	BLOCK 2			;TO HOLD FDB DATA
FREHD:	Z AREA

FLAGWD:	0			;FLAG WORD
CONDIR:	BLOCK 1			;SAVE CONNECTED DIR HERE
SYSDIR:	BLOCK 1			;REMEMBER SYSTEM NUMBER HERE
SYSDI1:	BLOCK 1			;DIR OF SYSTEM
STACK:	BLOCK 20		;PDL FOR MAILER

DEFPKT:				;PACKET TO DEFINE MAILER
	4			;ASSIGN TO THIS JOB
	0
	ASCIZ /[SYSTEM]MAILER/	;MY NAME
ENDPKT:				;END OF PACKET
SAVPID:	Z 0			;SAVE USSER'S PID
JFN:	Z 0			;WHERE TO DAVE JFN
SAV:	BLOCK 1			;SAVE SP
GTINF:	BLOCK <.JICPJ-.JITNO+1>	 ;GETJI STORES DATA HERE
USRBUF:	ASCII /PS:</
	BLOCK 11		;WHERE TO FORM USER NAME FOR RCDIR
ERRORS:	Z 0			;ERROR COUNT
MYPID:	Z 0		;MY ID
SENDQ:	Z 0
ERRSTK:	BLOCK ^D200
LEVTAB:	ADD1
	ADD1
	ADD1
CHNTAB:	1,,GOTONE
ADD1:	Z 0
FRMNAM:	BLOCK 1
FRMMSG:	BLOCK 30		;HOLD FROM MESSAGE HERE
;**;[11] Add one line at FRMMSG: +1L	JGZ	2-SEP-80
CHKBLK:	.CKAWR			;[11] CHECK FOR WRITE ACCESS TO FILE
	BLOCK	.CKAUD		;[11] REST OF CHKAC BLOCK

OPDEF RET [POPJ P,]
OPDEF CALL [PUSHJ P,]
	RELOC 1000-140		;SSTART ON A CLEAN PAGE
;CODE

;PROGRAM ENTRY VECTOR

ENTVEC:	JRST MAILER		;STARTING LOCATION
	JRST MAILER		;REENTER LOCATION
	VMAILR			;VERSION NUMBER
ALLOC:	SETZB W4,W5		;POINTER AND SIZE OF BLOCK
	MOVEI W,FREHD		;WHERE IT ALL STARTS
LOOK:	HRRZ W2,(W)		;WHERE NEXT BLOCK IS
	JUMPE W2,FINAL		;AT THE END. LOOK AT WHAT WE HAVD
	HLRZ W1,(W2)		;COUNT
	CAIN W1,(A)		;EXACT MATCH?
	JRST USEIT		;YES. DO IT
	CAIG W1,(A)		;BIG ENOUGH?
	JRST NOPE		;NO. FOO

;FOUND A CANDIDATE. SEE IF HE'S BETTER THAN THE LAST

	SKIPE W5		;GOT ONE YET?
	CAIGE W1,(W5)		;YES. THIS ONE BETTER?
	SKIPA W5,W1		;YES. USE IT
	JRST NOPE		;NO
	MOVE W4,W		;REMEMBER POINTER
NOPE:	HRRZ W,(W)		;GET NEXT BLOCK
	JRST LOOK		;GO PROCESS IT
FINAL:	SKIPN W1,W5		;FOUND A GOOD ONE?
	RET			;NO. BOMB TIME
	MOVE W,W4		;POINTER
USEIT:	HRRZ W4,(W)		;AREA TO ALLOCATE
	MOVNI W1,(A)		;NUMBRE OF WORDS NEEDED
	HRLZS W1		;NEGATIVE TO LEFT HALF
	ADD W1,(W4)		;DO IT
	ADDI W4,(A)		;WHERE NRW BLOCK IS
	TLNE W1,-1		;ANYTHING LEFT?
	MOVEM W1,(W4)		;YES. MAKE IT A NEW BLOCK
	HRRZ W5,(W)
	HRLZM A,(W5)		;ASSIGNED BLOCK
	HRRM W4,(W)		;LINK IN NEW FREE BLOCK
	MOVEI A,(W5)		;WHAT WE ASSIGNED
	AOS (P)
	RET			;GOOD RETURN
;THIS IS THE DEALLOCATE CODE. INPUT IS A=POINTER TO BLOCK

DEALL:	MOVEI W,FREHD
LOOK1:	HRRZ W1,(W)		;BLOCK HEAD
	JUMPE W1,HERE		;IF AT THE END IT GOES HERE
	CAIL W1,(A)		;PAST THIS BLOCK?
	JRST HERE		;YES. PU IT IN HERE
	MOVE W,W1		;NO. STEP
	JRST LOOK1		;GO DO MORE
HERE:	CAIN W,FREHD		;AT THE TOP?
	JRST LNKDWN		;YES. CANT MERGE UP
	HLRZ W1,(W)		;GET SIZE OF PREVIOUS
	ADDI W1,(W)		;TO THE END
	CAIE W1,(A)		;UP TO THE BLOCK RELEASING?
	JRST LNKDWN		;NO. LINK IT IN
	HLRZ W2,(A)		;DO THE MERGE
	HLRZ W1,(W)
	ADDI W1,(W2)		;NEW TOTAL SIZE
	SETZM (A)		;BLOT OUT THIS HEADER
	HRLM W1,(W)		;NEW COUNT
	JRST SEEDWN		;TRY TO MERGE DOWN
LNKDWN:	HRRZ W2,(W)		;LINK TO NEXT
	HRRM A,(W)		;PUT THIS NEW BLOCK IN
	HRRM W2,(A)		;AND PUT OLD LINK IN IT
	MOVE W,A		;NEW BASE BLOCK
SEEDWN:	HLRZ W1,(W)		;COUNRT
	ADDI W1,(W)		;END OF THIS BLOCK
	HRRZ W2,(W)		;NEXT BLOCK
	CAIE W1,(W2)		;THIS IT?
	RET			;NO. DONE
	HLRZ W3,(W2)		;YES. MUST MERGE THEM
	HLRZ W1,(W)		;COUNT OF PREVIOUS
	ADDI W3,(W1)		;NEW COUNT OF MERGED BLOCKS
	HRLM W3,(W)
	HRRZ W3,(W2)		;ITS LINK
	HRRM W3,(W)		;NEW DOWN LINK FOR THIS GUY
	SETZM (W2)		;CLEAR IT
	RET			;ALL DONE

DOUSR:	MOVEI W,0		;WORK
	MOVEI C,","		;FOR CONVENIENCE
TOPOF:	SKIPN B,(D)		;WORK TO DO?
	POPJ P,			;NO. GO BACK
	SKIPE W			;NEED A COMMA?
	IDPB C,A		;YES. PUT IT IN
	CAMN B,[SYSCOD]		;IS THIS SYSTEM?
	JRST SPCUSR		;YES. GO DO IT
	MOVEM A,SAV		;SAVE BYTE POINTER IN CASE FAILING DIRST CLOBBERS IT
	DIRST			;CONVERT TO A STRING
	 JRST BAH		;WONT CONVERT
	CAMN B,SYSDIR		;IS THIS SYSTEM?
	 IFNSK.			; If no skip, it is SYSTEM
	 MOVE B,[SYSCOD]	;YES. GET INTERNAL VALUE
	 MOVEM B,0(D)	;STORE IT
	 ENDIF.			;
TOPOF1:	AOS W
	ADDI D,1		;NEXT ONE
	CAIGE W,7		;MOR ON THIS LINE?
	JRST TOPOF		;YES
	HRROI B,[ASCIZ /,
    /]
	SETZ C,			; STOP ON NULL
	SKIPE (D)		; only do this if usernames still left
	SOUT
	 JERR <MAILER SOUT% ERROR IN TOPOF1 ROUTINE>
	JRST DOUSR

BAH:	AOS W1,ERRORS		;A BADDY
	SETOM (D)		;DONT TRY AGAIN
	AOS D			;DO NEXT ONE NEXT
	HRRZM A,ERRSTK-1(W1)	;PUT IN REASON
	AOS W1,ERRORS		;NEXT LOC
	MOVEM B,ERRSTK-1(W1)
	SKIPE W			;AT START OF LINE?
	BKJFN			;NO. ERASE THE COMMA
	 JFCL			;WILL WORK
	MOVE A,SAV		;GET BYTE POINTER THAT FAILING DIRST CLOBBERED
	JRST TOPOF

;SPECIAL USER CODE FOUND

SPCUSR:	HRROI B,[ASCIZ /SYSTEM/] ;YES. GET THE NAME
	SETZ C,
	SOUT			;PUT IT IN
	 JERR <MAILER SOUT% ERROR IN SPCUSR ROUTINE>
	MOVEI C,","		;PUT BACK THE PUNCTUATION
	JRST TOPOF1		;AND GO BACK IN
MAILER:	RESET
	HRROI A,FRMMSG		;GET FROM MESSAGE BUFFER
	HRROI B,[ASCIZ /
[You have a message from /]
	SETZ C,
	SOUT			;MOVE MESSAGE TO THE BUFFER
	 JERR <MAILER SOUT% ERROR IN MAIN LINE ROUTINE>
	MOVEM A,FRMNAM		;SAVE PLACE TO PUT NAME
	MOVE P,[IOWD 20,STACK]
	MOVX A,RC%EMO		;EXACT MATCH PLEASE
	HRROI B,[ASCIZ /SYSTEM/] ;GET USER CODE FOR SYSTEM
	RCUSR			;GET IT
	 ERJMP [SETZ C,		;NO SUCH DIR
		JRST .+1]	;AND MERGE IN
	TXNE A,RC%NOM!RC%AMB	;FOUND IT?
	SETZ C,			;NO
	MOVEM C,SYSDIR		;REMEMBER THE NUMBER
	MOVX A,RC%EMO		;EXACT MATCH AGAIN
	HRROI B,[ASCIZ /PS:<SYSTEM>/]
	RCDIR			;NOW GET DIRECTORY DESCRIPTOR
	 ERJMP [SETZ C,
		JRST .+1]	;NO SUCH DIR
	TXNE A,RC%NOM!RC%AMB	;DID IT MATCH
	SETZ C,			;NO
	MOVEM C,SYSDI1		;SAVE DIRECTORY NUMBER
	MOVEI A,400000		;SELF
	MOVE B,[LEVTAB,,CHNTAB]	;INT LOCS
	SIR
	 JERR <MAILER SIR% ERROR IN MAIN LINE ROUTINE>
	MOVSI B,(1B0)		;ENABLE 0 ONLY
	AIC
	 JERR <MAILER AIC% ERROR IN MAIN LINE ROUTINE>
	EIR			;TRUN IT ALL ON
	 JERR <MAILER EIR% ERROR IN MAIN LINE ROUTINE>
	MOVSI A,FRESIZ		;SIZE OF FREE AREA
	MOVEM A,AREA		;INITIALIZE FREE AREA
	MOVSI W,(1B5)		;GET ME A PID
	SETZB W1,W2		;ZERO FOR TWO PIDS
MAIL1:	MOVE W3,[ENDPKT-DEFPKT,,DEFPKT]
	MOVEI A,4
	MOVEI B,W		;THE PACKET
	MSEND			;DO IT
	 JRST [	MOVEI A,^D500	;SLEEP FOR AWHILE
		DISMS
		SKIPN W1	;GOT A PID?
		JRST MAILER	;NO. START OVER
		SETZ W,		;YES. INIT HEADER
		JRST MAIL1]	;AND SEND IT AGAIN
	MOVEM W1,MYPID		;SAVE ASSIGNED PID

;NOW GET SOME MESSAGES TO ACT UPON

MAIN:	MOVEI A,7
	MOVEI B,D
	MOVE W,MYPID		;RECEIVE ON MY ID
	MOVEI D,.MUQRY		;DO A QUERY
	MUTIL			;DO IT
	 JRST NONE		;NONE WAITING
	MOVEI A,7
	MOVEI B,W		;FOR GETTING THE MESSAGE
	MOVE W3,[1000,,MESS]	;FO THE MESSAGE
	MOVE W2,MYPID		;RECEIVER'S PID
	SETZ W6,		;MAKE SURE IPCF STORES HERE
	MRECV			;GET A MESSAGE
	 JFCL			;????????

;RECEIVED A MESSAGE. SEE WHAT IT IS 

	TRNN W,7B32		;MAYBE FROM INFO?
	JRST NOTINF		;NO  GO ON
	TRNN W,77B29		;AN ERROR CONDITION?
	JRST MAIN		;NO. DONT LOOK AT IT
	MOVE B,W
	ANDI B,7B32		;LOOK AT SENDER INFO
	CAIE B,20		;FORM INFO?
	JRST MAIN		;NO. MUST BE A LOST MESSAGE
	ANDI W,77B29		;LOOK AT ERROR
	CAIE W,<.IPCSN>B29	;INFO RESSTART?
	JRST [	HRROI A,[ASCIZ /
?MAILER: UNKNOWN ERROR CONDITION FROM INFO
/]
		PSOUT
		HALTF]
	SETZB W,W2		;YES. MUST START AGAIN
	MOVE W1,MYPID
	JRST MAIL1		;SEND OFF MY NAME THEN
;NO MESSAGES WAITING

NONE:	SKIPE SENDQ		;REPLIES WATING?
	JRST DOQ1		;YES. GO DO THEM
	MOVEI W,.MUPIC		;ENABLE FOR INTS
	MOVE W1,MYPID
	SETZ W2,		;ON CHANNEL 0
	MOVEI A,3
	MOVEI B,W		;WHERE THE PACKET ISS
	MUTIL			;DO IT
;**;[13]  Replace 1 line with 4 at NONE:+8		DML	27-JUN-83
	 JRST [	HRROI A,[ASCIZ /
?MAILER: Unable to assign PID to channel
/]				;[13] POINT TO MESSAGE
		PSOUT		;[13] PRINT IT
		HALTF]		;[13] DIE
	WAIT			;WAIT HERE FOR INT
GOTONE:	SETO W2,		;RELEASE CHANNEL
	MUTIL
	 JFCL
	MOVEI A,MAIN		;MAIN LOOP
	MOVEM A,ADD1
	DEBRK			;GO GET IT
;MESSAGE NOT FROM INFO. MUST BE WORK TO DO

NOTINF:	MOVEM W1,SAVPID		;NO. SAVE IT FOR LATER
	SKIPN W6		;GOT A CONNECTED DIR IN W6?
	JRST [	HLRZ W6,W4	;NO. ASSUME OLD STYLE IPCF THEN
		HRRZS W4	;AND ISOLATE USER NUMBER
		JRST .+1]	;AND PROCEED
	MOVEM W6,CONDIR		;SAVE CONNECTED DIR HERE
	SETZM ERRORS		;NO ERRORS TO START
	MOVSI A,100001		;OLD FILE
	HRROI B,MESS		;WHERE THE FILE NAME IS
	SETZM JFN		;NO JFN TO START
	GTJFN			;GET THE FILE NAME
	 JRST NACK		;CANT DO IT
	MOVEM A,JFN		;STASH AWAY JFN
	MOVE B,[440000,,200000]	;OPENF BITS
	OPENF			;GET FILE
	 JRST [	MOVE A,JFN
		RLJFN
		 JFCL
		SETZM JFN	;NO FILE OPENED
		JRST NACK]	;CANT DO IT

;**;[11] Add several lines at NOTINF: +21L	JGZ	2-SEP-80
	MOVEM A,CHKBLK+.CKAUD	;[11] JFN
	MOVX A,CK%JFN+.CKAUD+1	;[11] FLAGS AND BLOCK LENGTH
	MOVEI B,CHKBLK		;[11] ADDRESS OF ARGUMENT BLOCK
	MOVEM W4,CHKBLK+.CKALD	;[11] STORE USER NUMBER
	MOVEM W6,CHKBLK+.CKACD	;[11] STORE CONNECTED DIR
	MOVEM W5,CHKBLK+.CKAEC	;[11] STORE ENABLED CAPS
	CHKAC			;[11] CHECK ACCESS
	 ERJMP [		;[11] FAILURE
CHKFAI:		MOVE A,JFN	;[11] GET BACK JFN
		CLOSF		;[11] CLOSE IT NOW
		 NOP		;[11] IGNORE ERRORS HERE
		SETZM JFN	;[11] NO JFN
		JRST NACK]	;[11] AND GIVE UP
	JUMPE A,CHKFAI		;[11] FAIL IF CHKAC SAID NO ACCESS

;GOT FILE OPEN. NOW BUILD MESSAGE

	SETZM ERRORS		;NO ERRORS
	HRROI B,[ASCIZ /Date: /]
	HRROI A,BIGBUF
	SETZ C,
	SOUT			;PUT MESSAGE IN BUFFER
	 JERR <MAILER SOUT% ERROR IN NOTINF ROUTINE TO COPY DATE: STRING>
	SETO B,
	MOVSI C,(OT%4YR!OT%SPA!OT%NCO!OT%NSC!OT%SCL!OT%TMZ)	;FORMAT BITS
	ODTIM			;PUT THE TIME IN THE FILE
	 JERR <MAILER ODTIM ERROR IN CHKFAI ROUTINE>
	HRROI B,[ASCIZ /
From: /]
	SETZ C,
	SOUT			;PUT IN SENDER'S NAME
	 JERR <MAILER SOUT% ERROR IN NOTINF ROUTINE TO COPY FROM: STRING>
	MOVE B,W4		;LOGGED IN DIRECTORY
	MOVEM A,SAV		;MAYBE DIRST WILL FAIL, SO SAVE BYTE POINTER NOW
	DIRST			;PUT IT IN
	 CAIA			;FAILED, DON'T UPDATE BYTE POINTER WITH ERROR CODE!
	MOVEM A,SAV		;STASH AWAY SP
	MOVE A,FRMNAM		;GET PLACE TO PUT NAME IN FROM MESSAGE
	MOVE B,W4		;USER NUMBER
	DIRST			;PUT IT IN
	 MOVE A,FRMNAM		;FAILED, GET BYTE POINTER BACK (ERROR CODE CLOBBERED IT)
	HRROI B,[ASCIZ /]
/]
	SETZ C,
	SOUT			;TERMINATE THE MESSAGE
	 JERR <MAILER SOUT% ERROR IN NOTINF ROUTINE COPYING ^G>
	IDPB C,A		;AND APPEND A NULL

;NOW GET LIST OF TO'S 
	MOVE A,JFN		;THE FILE'S JFN
	BIN			;GET FLAG WORD FIRST
	 JERR <MAILER BIN% ERROR READING FLAG WORD>
	MOVEM B,FLAGWD		;SAVE IT FOR POSTERITY
	MOVE B,[POINT ^D36,USRBLK] ;WHERE TO PUT THEM
	MOVEI C,USERS-1		;MAX NUMBER
	SETZ D,
	SIN			;READ IN USER'S TO SEND TO
	 JERR <MAILER SIN% ERROR READING USER NUMBERS>
	JUMPN C,ALLIN		;IF ALL IN GO
	MOVEI B,(B)		; SKIP OVER THE EXTRAS
	SIN			;SKIP OVER THE REST OF THEM
	 JERR <MAILER SIN% ERROR SKIPPING USER NUMBERS>
ALLIN:	MOVEI D,(B)		;SAVE END VALUE
	GTSTS			;GET FILE STATUS
	 JERR <MAILER GTSTS% ERROR IN ALLIN ROUTINE>
	CAIE D,USRBLK		;NO USER'S GIVEN?
	TLNE B,1000		;EOF?
	JRST NACK		;YES. BOMB
	MOVE A,SAV		;GET OLD POINTER
	HRROI B,[ASCIZ /
To: /]
	PUSH P,C		;SAVE COUNT OF WORDS LEFT
	SETZ C,
	SOUT			;PREPARE FOR HEADER
	 JERR <MAILER SOUT% ERROR COPYING TO: STRING>
	MOVEI D,USRBLK		;BEGINNING OF THEM
	PUSHJ P,DOUSR		;PROCESSS USER NAMES
	MOVEM A,SAV		;STASSH AWAY POINTER AGAIN
	POP P,C			;GET BACK THE COUNT
ONEUSR:	PUSH P,D		;SAVE POINTER
	MOVE A,JFN
	MOVEI B,(D)
	HRLI B,444400		;REBUIL STRING POINTER
	SETZ D,
	MOVE W,C		;SAVE COUNT
	SKIPE C			;ROOM LEFT?
	SIN			;GET CC LIST
	 JERR <MAILER SIN% ERROR READING CC: USERS>
	SETZM 1(B)		;GUARANTEE A DOUBLE ZERO
	POP P,D			;GET USER LIST BACK
	JUMPN C,DOCC		;LESS THAN 100?
	MOVEI B,(B)		; NULL POINTER
	SIN			;READ IN THE REST
	 JERR <MAILER SIN% ERROR IN ONEUSR ROUTINE>
DOCC:	GTSTS			;EOF?
	 JERR <MAILER GTSTS% ERROR IN DOCC ROUTINE>
	TLNE B,1000
	JRST NACK		;YES. BOMB IT
	MOVE A,SAV
	CAIN W,1(C)		;FOUND ANY CC'S?
	JRST ONMSG		;NO. GO AWAY
	HRROI B,[ASCIZ /
cc: /]
	SETZ C,
	SOUT			;PUT IN HEADER
	 JERR <MAILER SOUT% ERROR IN DOCC ROUTINE>
	PUSHJ P,DOUSR		;DO CC LIST AS WELL
ONMSG:	HRROI B,[ASCIZ /
/]
	SETZ C,
	SOUT			;MESSAGE SEPARATOR
	 JERR <MAILER SOUT% ERROR IN ONMSG ROUTINE>
	PUSH P,A		; save current msg pointer
	MOVE A,JFN		;FILE JFN
	MOVEI B,7		; set to 7-bit bytes
	SFBSZ			; so ASCII SIN will work
	 JFCL
	POP P,B			; restore msg pointer
	MOVE C,[SIZE*5]		;MAXIMUM SIZE OF MESSAGE
	SETZM D			;STOP ON A NULL
	SIN			;GET MESSAGE
;**;[18] Change one line at ONMSG:+13L		TJG	1-Aug-84
	 ERCAL CHKEOF		;[18] Check for EOF
	MOVNI W,1		; backup over null at end of msg text
	ADJBP W,B		;  ..
	MOVE B,W		;  ..
	LDB A,B			; get ending byte of mail
	CAIE A,12		; line feed?
	JRST [	MOVEI A,15		; no, append CRLF to mail
		IDPB A,B		;  ..
		MOVEI A,12		;  ..
		IDPB A,B		;  ..
		JRST .+1]
	; ..
;BIGBUF NOW CONTAINS THE ENTIRE MESSAGE. USRBLK CONTAINS THE
;LIST OF USERS TO GET THIS MESSAGE. SEND IT TO EACH

OVER:	PUSHJ P,DELFIL		;GET RID OF THE FILE
	MOVE A,[POINT 7,[ASCIZ /   ========
/]]
	SETZ C,
	SIN			;TIE OFF THE MESSAGE
	 JERR <MAILER SIN% ERROR WHILE TERMINATING MESSAGE TEXT>
	MOVEI W,(B)		;GET FINAL WORD
	SUBI W,BIGBUF		;CALCULATE NUMBER OF complete WORDS
	IMULI W,5		;calculate number of bytes
	LDB B,[POINT 6,B,5]	; get bits to the right of last byte
	IDIVI B,^D7		; compute no. of unused bytes in this word
	MOVEI C,^D5		; bytes in a word
	SUB C,B			; compute bytes used in this word
	ADD W,C			; adjust char count for partial word

;NOW W HAS COUNT OF CHARACTERS IN MSG
;NOW SET TO SEND SOME MESSAGES

	MOVEI D,USRBLK		;WHERE THE USER NAMES AR	 STORED
SNDOFF:	SKIPN B,(D)		;GET USER
	JRST FINIS		;ALL DONE
	AOS D			;BUMP TO THE NEXT
	CAMN B,[-1]		;BAD ENTRY?
	JRST SNDOFF		;YES
	CAME B,[SYSCOD]		;IS IT SYSTEM?
	JRST NOSYS3		;NO. NO SPECIAL CHECKING THEN
	TRNE W5,600000		;YES. IS THIS FROM A PRIVILEGED GUY?
	JRST NOSYS3		;YES. ALLOW IT THEN
	MOVE W1,CONDIR		;GET CONNECTED DIR
	CAME W1,SYSDI1		;IS IT SYSTEM?
	CAMN W4,SYSDIR		;LOGGED IN AS SYSTEM?
	JRST NOSYS3		;YES. ALLOW THIS SEND THEN
	MOVEI A,CAPX1		;NO. MUST BE PRIVILEGED
	JRST OOPS2		;TELL USER OF THE PROBLEM
NOSYS3:	CAMN B,[SYSCOD]
	JRST [	HRROI B,[ASCIZ /PS:<SYSTEM>MAIL.TXT/] ;YES
		MOVX A,GJ%DEL!GJ%SHT+1 ;GET GTJFN BITS
		JRST NOSYS2]	;GO DO IT THEN
	MOVEI C,"<"
	MOVE A,[POINT 7,FILBUF]
	IDPB C,A
	MOVE C,A		;SAVE BYTE POINTER IN CASE DIRST FAILS
	DIRST			;PUT IN DIRECTORY NUMBER
	 MOVE A,C		;DIRST SHOULDN'T FAIL, BUT IF IT DOES...
	MOVEI C,">"
	IDPB C,A
	HRROI B,[ASCIZ /MAIL.TXT/]
	SETZ C,
	SOUT			;BUIL FILL FILE SPEC
	 JERR <MAILER SOUT% ERROR BUILDING MAIL.TXT FILE NAME>
	HRROI B,FILBUF
	MOVX A,GJ%OLD!GJ%DEL!GJ%SHT+1 ;GTJFN BITS
NOSYS2:	GTJFN			;GET FILE HANDLE
	 JRST OOPS2		;CAN'T DO IT
	MOVE C,A
	MOVEI W1,^D40		; Number of 1/2 sec waits if file busy
NOSYS1:	MOVE B,[070000,,300000]	;WRITE AND READ
	OPENF
	 JRST [	CAIN A,OPNX9		; File busy error?
		SOJGE W1,[MOVEI A,^D500		; Yes, wait 1/2 second
			DISMS			; Unless timed out (SOJG)
			MOVE A,C		; Fetch JFN again
			JRST NOSYS1]		; Go try again
		EXCH A,C
		RLJFN		;ERROR
		 JFCL
		MOVE A,C	;ERROR CODE AGAIN
		JRST OOPS2]	;AND GO GIVE ERROR
	TXNN W5,SC%WHL!SC%OPR	;PRIVILEGED USER?
	CALL CAPOFF		;NO. TURN OFF LOCAL CAPS THEN
;HAVE FILE OPENED .NOW WRITE IT

	MOVE A,C		;THE JFN
	PUSH P,C		;SAVE IN CASE OF ERROR
	MOVE B,[2,,.FBBYV]	;GET 2 WORDS
	MOVEI C,GETSIZ		;WHERE TO GET IT
	GTFDB			;READ FILE DATA
	 JERR <MAILER GTFDB% ERROR GETTING MAIL.TXT FILE DATA>
	LOAD C,FB%BSZ,GETSIZ	;GET FILE BYTE SIZE
	CAIN C,7		; already the right byte size?
	JRST [	MOVE B,GETSIZ+1		; yes, use exact byte count
		JRST OKSIZ]
	MOVEI B,44		;BITS PER WORD
	IDIVI B,0(C)		;COMPUTE TOTAL BYTES PER WORD
	EXCH B,GETSIZ+1		;GET BYTES IN B
	IDIV B,GETSIZ+1		;COMPUTE WORDS
	IMULI B,5		;NOW COMPUTE # OF CHARACTERS
OKSIZ:	MOVEM B,EOFPTR		;SAVE IT
	SFPTR			;SET TO EOF
	 JFCL
	SETOM B			;GET DATE AND TIME
	MOVSI C,(OT%TMZ)	;IN THIS FORM
	ODTIM
	 ERJMP OVRQTA		;ERROR
	MOVEI B,","
	BOUT			;SEPARATE TIME FROM COUNT
	 ERJMP OVRQTA		;ERROR
	RFPTR			;READ POSITION IN FILE
	 JFCL
	ADDI B,6		;AT LEAST 6 DIGITS FOR COUNT
	IDIVI B,5		;GET PART OF WORD IN C
	MOVNS C			;GET NEGITIVE OF REMAINDER
	ADDI C,5+6		;GET WIDTH OF COUNT FIELD
	HRL C,C			;GET IN RIGHT POSITION FOR NOUT
	TXO C,NO%LFL!NO%ZRO	;PUT IN LEADING ZEROS
	MOVE B,W		;NUMBER OF CHARS
	HRRI C,12		;IN DECIMAL
	NOUT
	 ERJMP OVRQTA		;ERROR
	POP P,A			;RESTORE JFN
	HRROI B,[ASCIZ /;000000000000
/]
	MOVEI C,0		;PUT ON THE FLAG FIELD
	SOUT
	 ERJMP OVRQT1		;ERROR
	MOVE B,[POINT 7,BIGBUF]
	MOVN C,W		;GET NEGATIVE WORD COUNT
	SOUT			;WRITE ALL WORDS
	 ERJMP OVRQT1		;ERROR
	CALL CAPON		;ALL CAPS ON NOW
	HRLI A,.FBCTL		;CHANGE STATUS BITS
	MOVX B,FB%DEL		;CHANGE DELETED BIT
	SETZ C,			;MAKE IT A ZERO(UNDELETE)
	TXO A,CF%NUD		;DONT'T UPDATE DIR (SFUST/CLOSF WILL)
	CHFDB			;DO IT
	 JERR <MAILER CHFDB% ERROR WHILE UNDELETING MAIL.TXT>
	MOVX B,FB%PRM		;CHANGE PERMANENT BIT
	MOVX C,FB%PRM		;TO BE SET
	CHFDB
	 JERR <MAILER CHFDB% ERROR SETTING MAIL.TXT PERMANENT BIT>
	PUSH P,A		;SAVE JFN
	MOVE B,W4		;USER NUMBER OF SENDER
	HRROI A,FILBUF		;PUT STRING HERE
	DIRST
	 JFCL
	HRROI B,FILBUF		;POINT AT IT

;**;[17] Change 1 line at OKSIZ:+47L		TJG	31-MAY-84

	MOVE A,(P)		;[17]Restore JFN
	HRLI A,.SFLWR		;SET LAST WRITER
	SFUST			; TO BE SENDER
	 JERR <MAILER SFUST% ERROR SETTING LAST FILE WRITER OF MAIL.TXT>
	MOVEI A,(A)		;JFN ONLY

;**;[17] Add 6 lines at OKSIZ:+52L			TJG	31-MAY-84

	HRLZ A,0(P)		;[17]GET THE JFN
	MOVX B,^D512		;[17]ALL SHORT FILE PAGES
	UFPGS			;[17]UPDATE FILE PAGES TO DISK
	 JERR <MAILER UFPGS% ERROR IN OKSIZ ROUTINE>
	POP P,A			;[17]Restore JFN
	HRRZS A			;[17]Clear left half bits.
	CLOSF			;CLOSE THE OUTPUT FILE
	 JFCL
	; ..
;ROUTINE TO SEND MESSAGES TO ANY LOGGED IN USERS

	MOVE A,-1(D)		;GET USER 
	CAMN A,[SYSCOD]
;**;[14]  Replace 6 lines with 9 at TOPDIR:-7		DML	8-MAR-84
	IFNSK.			;[14]
	  SETO A,		;[14] IS SYSTEM
	  HRROI B,[ASCIZ /
[New Message-of-the-Day available]
/]				;[14]
	  TTMSG			;[14] DO IT
	   ERJMP .+1		;[14] IGNORE ERROR
	  JRST SNDOFF		;[14] AND DONE
	ENDIF.			;[14]
	SETZ W6,		;INIT JOB NUMBER FOR SCAN
TOPDIR:	MOVEI A,0(W6)		;JOB NUMBER
	MOVE B,[-<.JICPJ-.JITNO+1>,,GTINF] ;GET VALUES FROM MONITOR
	MOVEI C,.JITNO		;GET TERM # AND LOGGED IN DIR
	GETJI			;GET THEM
	 ERJMP [CAIN A,GTJIX3	;OUT OF RANGE?
		JRST SNDOFF	;YES. ALL DONE
		AOJA W6,TOPDIR]	;NO. DO NEXT ONE THEN
	SKIPL GTINF+<.JICPJ-.JITNO> ;IS THIS A PTY?
	AOJA W6,TOPDIR		;YES. SKIP IT THEN
	DMOVE A,GTINF		;GET GETJI DATA IN REGS
	JUMPL A,[AOJA W6,TOPDIR] ;IF DETACHED, GO ON.
	CAME B,-1(D)		;IS THIS LOGGED INTO THE SAME DIR?
	AOJA W6,TOPDIR		;NO. SKIP IT THEN
	TRO A,(1B0)		; MAKE IT A DEVICE DESIGNATOR
	RFMOD			; GET MODE BITS
	 JERR <MAILER RFMOD% ERROR READING USER TERMINAL MODE>
	TXNN B,TT%ALK		; IS HE ACCEPTING?
	AOJA W6,TOPDIR		;NO. DON'T TELL HIM THEN
	MOVEI B,.MORNT		;SEE IF HE WANTS MESSAGES
	MTOPR
	 JERR <MAILER MTOPR% ERROR GETTING USER TERMINAL MODE>
	JUMPN C,INCDIR		;JUMP IF NO MESSAGE
	HRROI B,FRMMSG		;GET MESSAGE BLOCK
	TTMSG			;SEND TO THIS USER
;**;[12]  Add 1 line after INCDIR:-1			DML	27-JUN-83
	 ERJMP .+1		;[12] IGNORE ERROR
INCDIR:	AOJA W6,TOPDIR		;DO ALL JOBS
;**;[18] Add 12 lines at OVRQTA-1L		TJG	1-Aug-84
; Here to check for EOF reading message text

CHKEOF:	SAVEAC <A,B,C>		;[18] Save these
	MOVX A,.FHSLF		;[18] Our own fork
	GETER%			;[18] Get our last error
	HRRZS B			;[18] Isolate the error code
	CAIN B,IOX4		;[18] Was it Eof?
	IFSKP.			;[18] Skip means no
	 CALL JSERR0		;[18] Print the error string
	 TMSG <MAILER SIN% ERROR IN ALLIN0 ROUTINE>
	ENDIF.			;[18] Otherwise
	RET

;HERE ON QUOTA ERROR

;	A/ JFN

OVRQTA:	POP P,A			;GET THE JFN
OVRQT1:	CALL CAPON		;MAKE SURE ALL CAPS ARE ENABLED
	RFBSZ			;GET CURRENT BYTE SIZE
	 NOP
	MOVEI C,^D36
	PUSH P,D		;SAVE THIS REG
	IDIVI C,0(B)		;COMPUTE BYTES PER WORD
	PUSH P,C		;SAVE THIS FOR LATER
	RFPTR			;GET CURRENT EOF POINTER
	 JFCL
	IDIV B,0(P)		;COMPUTE WORDS
	LSH B,-11		;MAKE IT A PAGE NUMBER
	MOVE C,EOFPTR		;GET ORIGINAL EOF POINTER
	IDIV C,0(P)		;COMPUTE WORD #
	ADJSP P,-1		;CLEAN UP STACK
	POP P,D			;RESTORE REG
	LSH C,-11		;GET PAGE NUMBER
	SUB B,C			;COMPUTE # OF PAGES ADDED
	JUMPE B,OVRQT2		;IF NONE, ALL SET
	EXCH B,C		;GET ARGS IN PROPER REGS
	TXO C,1B0		;REPEAT COUNT FOR PMAP
	HRL B,A
	ADDI B,1		;STARTING PAGE
	SETOM A
	PMAP			;ZAP THE FILE PAGES
	 JERR <MAILER PMAP% ERROR IN OVRQTA ROUTINE>
	HLRZ A,B		;JFN AGAIN

;EXTRA PAGES NOW DELETED. CHANGE FDB

OVRQT2:	HRLI A,.FBBYV		;MAKE SURE BYTE SIZE IS CORRECT
	MOVX B,FB%BSZ		;SET BYTE SIZE
	MOVX C,FLD(7,FB%BSZ)	;SET IT TO 7-BIT BYTES
	CHFDB			;DO IT
	 ERJMP OVRQT0		;IF FAILED, SKIP IT
	HRLI A,.FBSIZ		;NOW SET THE SIZE
	SETOM B			;SET ENTIRE WORD
	MOVE C,EOFPTR		;AND BACK TO ORIGINAL COUNT
	CHFDB			;DO IT
	 ERJMP OVRQT0		;IF FAILED, FILE IS SCREWED UP
OVRQT0:	HRRZS A			;GET JFN ONLY

;**;[17] Add 7 lines at OVRQT0:+1		TJG	31-MAY-84

	PUSH P,A		;[17]SAVE JFN
	HRLZS A			;[17]PUT JFN INTO LEFT HALF
	MOVX B,^D512		;[17]ALL SHORT FILE PAGES
	UFPGS			;[17]UPDATE FILE PAGES TO DISK
	 JERR <MAILER UFPGS% ERROR IN OVRQT0 ROUTINE>
	POP P,A			;[17]GET THE JFN BACK
	CLOSF			;CLOSE THE FILE
	 JFCL
	MOVSI B,NOACKQ		;QUOTA FAILURE
	JRST OOPS		;AND DONE

;ROUTINES TO ADD ERROR ENTRIES TO RETURN MESSAGE. AN ENTRY IS OF
;THE FORM:
;	WORD 0		FLAGS,,CODE
;	WORD 1		USER I.D.
;THE FLAGS DEFINE THE TYPE OF THE FAILURE. IF NOACKB IS SET IN THE
;FLAGS, THE CODE WROD IS A STANDARD JSYS ERROR CODE OR A 0
;IF AN INDETERMINATE ERROR OCCURRED.

OOPS2:	MOVEI B,0(A)		;GET ERROR CODE
	TLOA B,NOACKB		;STANDARD ERROR CODE WITH RH CODE TOO
OOPS1:	MOVSI B,NOACKB		;STAMDARD ERROR CODE
OOPS:	AOS W1,ERRORS
	MOVEM B,ERRSTK-1(W1)	;PUT IT IN
	AOS W1,ERRORS
	MOVE B,-1(D)		;GET USER CODE
	MOVEM B,ERRSTK-1(W1)	;STORE IT
	JRST SNDOFF
DELFIL:	SKIPN A,JFN		;FILE TO DELETE?
	POPJ P,			;NO. GO BACK IMMEDIATELY
	PUSH P,B		;SAVE BUFFER POINTER
	MOVE B,FLAGWD		;GET FLAG WORD
	TRNN B,1		;WANT IT DELETED?
	DELF			;YES. SO DO IT
	 JERR <MAILER DELF% ERROR IN DELFIL ROUTINE>
	MOVE A,JFN		;GET JFN BACK IF IT FAILED
	CLOSF			;AND CLOSE IT
	 JFCL			;AGAIN, DONT CARE
	SETZM JFN		;NO MORE FILE
	POP P,B			;GET IT BACK
	POPJ P,			;ALL DONE THIS OPERATION
;ROUTINE TO CONVERT A USER NUMBER INTO A DIRECTORY NUMBER.
;ACCEPTS:	A/ USER NUMBER
;RETURNS:	+1 WITH 	A/DIRECTORY NUMBER

USRDIR:	MOVE B,A		;MOVE USER NUMBER
	MOVE A,[POINT 7,USRBUF,27] ;WHERE TO FORM STRING
	DIRST			;GET THE USER NAME
	 JRST POPJ1		;WHO KNOWS HOW THIS CAN HAPPEN
	MOVEI B,">"		;TO TIE IT OFF
	IDPB B,A		;END OF STRING
	SETZ B,
	IDPB B,A		;FINAL STRING
	HRROI B,USRBUF		;THE WHOLE THING
	MOVX A,RC%EMO		;GET THE NUMBER
	RCDIR			;GET IT
	 ERJMP POPJ1		;WHO KNOWS
	TXNE A,RC%AMB!RC%NOM	;DID IT FIND IT?
	JRST POPJ1		;NO. BOMB OUT
	MOVE A,C		;THE NUMBER
	AOS (P)			;SKIP RETURN
POPJ1:	RET			;AND DONE
;ALL MESSAGES SENT. NOW SEND OFF THE REPLY.

NACK:	SETZM ERRORS
	PUSHJ P,DELFIL		;GET RID OF THE INPUT FILE
	MOVEI W,<NOACK>B29	;TOTAL WIPEOUT
	SKIPA
FINIS:	SETZ W,
	SKIPE ERRORS		;ANY ERRORS FOUND?
	MOVEI W,<NOACK1>B29	;YESS. SAY SO
	MOVE W1,MYPID
	MOVE W2,SAVPID		;WHO SENT IT
	HRL W3,ERRORS		;GET COUNT
	SKIPN ERRORS
	MOVSI W3,1		;MUST BE A MESSSAGE
	HRRI W3,ERRSTK		;COMPLETE THE MESSSAGE
	SKIPE SENDQ		;A SEND QUEUE AROUND?
	JRST QUEIT		;YES. GO QUEUE THIS ONE
	MOVEI A,4
	MOVEI B,W
SENDM:	MSEND			;SEND IT OFF
	 JRST [	CAIE A,IPCFX4	;PID DROPPED?
		CAIN A,IPCFX5	;OR DISABLED?
		JRST .+1	;YES
		JRST ADDQ]	;NO. ADD IT TO THE QUEUE
	CAIN B,W		;FROM THE QUEUE?
	JRST MAIN		;NO. GO ON
	MOVEI B,(W4)		;THE PACKET

;REQUEST FORM SEND Q
KILLIT:	HRRZ A,-4(B)		;QUEUE LINK
	HRRM A,SENDQ
	SKIPN A
	SETZM SENDQ		;QUEU IS EMPTY
	MOVEI A,-4(B)		;BLOCK HEAD
	CALL DEALL		;RELEASE IT
	SKIPN SENDQ		;MORE ON THE QUEUE?
	JRST MAIN		;NO. ALL DONE
;ROUTINES TO HANDLE SEND FAILURES

DOQ1:	MOVEI A,^D500		;DELAY FOR A WHILE
	DISMS			;""
DOQ:	HRRZ B,SENDQ		;TOP OF SEND QUEUE
	MOVE W1,2(B)		;HEADER
	MOVE W3,1(B)		;RECEIVE QUEUE
	MOVE W2,MYPID
	HLRZ W4,(B)		;COUNT
	SUBI W4,4		;SIZE OF THE MESSAGE
	HRLZS W4
	MOVEI W4,4(B)		;WHERE THE MESSAGE STARTS
	MOVEI B,W1		;WHERE THE HEADER IS
	JRST SENDM		;SEND IT
ADDQ:	CAIE B,W		;NEED TO QUEU IT?
	JRST NOQ		;NO
QUEIT:	CALL ONQ		;YES. PUT IT ON THE QUEUE
	 JRST [	HRROI A,[ASCIZ /
?MAILER: FREE SPACE EXHAUSTED
/]
		PSOUT

;**;[15] Replace 1 line with 5 at QUEIT:+2		TJG	30-MAY-84

		MOVEI A,4	;[TJG] The length of the packet
		MOVEI A,W	;[TJG] and the address
		MSEND%		;[TJG] Send an answer, so they won't hang
		 ERJMP DOQ1	;[TJG] Ignore errors
		JRST DOQ ]	;[TJG] And continue...
	JRST DOQ		;GO SEND SOME
NOQ:	CAIE A,IPCFX7		;HISS FAULT?
	JRST MAIN		;NO. GO DO MORE INPUT
	MOVE B,W4		;GETPOINTER
	AOS W4,-1(B)		;UP RETRY COUNT
	CAIL W4,MAXTRY		;MAXIMUM RETRYS/
	JRST KILLIT		;YES. ZAP IT
	HRRZ W4,-4(B)		;UNQUEUE IT
	HRRM A,SENDQ		;PUT NEXT ON THE TOP
	SKIPN A			;QUEUE NOW EMPTY?
	SETZM SENDQ		;YES
	MOVEI A,-4(B)		;BLOCK HEAD
	CALL INITQ		;PUT IT ON THE QUEUE
	JRST MAIN		;TRY MORE
;THIS ROUITNE QUEUES ENTRIES ON THE SEND QUEUE

ONQ:	HLRZ B,W3		;SIZE NEEDED
	MOVEI A,4(B)		;TOTAL SIZE NEEDED
	PUSH P,W		;SAVE HEADER
	CALL ALLOC		;GET SPACE
	 JRST [ POP P,W		;[TJG] Restore old header
		RET ]		;[TJG] Fail Return
	SETZM 3(A)		;INIT RETRY COUNT
	POP P,W
	MOVEM W,2(A)		;SAVE HEADER
	MOVE W,SAVPID
	MOVEM W,1(A)		;SAVE DESTINATION PID
	MOVSI W,ERRSTK		;WHERE MESSAGE COMES FORM
	HRRI W,4(B)		;WHERE IT IS GOING
	MOVE W1,ERRORS		;NUMBER OF WORDS
	ADDI W1,-1(B)		;LAST WORD STORED
	BLT W,(W1)		;DO IT
INITQ:	HLRZ C,SENDQ		;GET TAIL
	HRLM A,SENDQ		;NEW TAIL
	SKIPN C			;QUEUE EMPTY?
	MOVEI C,SENDQ		;YES
	HRRM A,(C)		;AMKE THE LINK
	AOS (P)

	RET			;AND DONE
;ROUTINES TO MANIPULATE LOCAL CAPS

;TURN OFF LOCAL CAPS

CAPOFF:	SAVEAC <A,B,C>
	MOVEI A,.FHSLF		;SELF
	RPCAP			;GET CURRENT CAPS
	 JERR <MAILER RPCAP% ERROR IN CAPOFF ROUTINE>
	HLLZS C			;TURN OFF SPECIAL CAPS
	EPCAP			;DO IT
	 JERR <MAILER EPCAP% ERROR IN CAPOFF ROUTINE>
	RET			;DONE

;TURN ON LOCAL CAPS

CAPON:	SAVEAC <A,B,C>
	MOVEI A,.FHSLF
	RPCAP			;GET LOCAL CAPS
	 JERR <MAILER RPCAP% ERROR IN CAPON ROUTINE>
	MOVE C,B		;GET ALL CAPS
	EPCAP
	 JERR <MAILER EPCAP% ERROR IN CAPON ROUTINE>
	RET			;DONE
	END <3,,ENTVEC>