Google
 

Trailing-Edge - PDP-10 Archives - bb-d868b-bm_tops20_v3a_2020_dist - 3a-sources/mailer.mac
There are 23 other files named mailer.mac in the archive. Click here to see a list.
;<3-UTILITIES>MAILER.MAC.6,  8-Nov-77 10:47:45, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-UTILITIES>MAILER.MAC.5, 26-Oct-77 11:07:42, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-UTILITIES>MAILER.MAC.4, 30-Sep-77 09:45:21, EDIT BY CROSSLAND
;REMOVE TIME ZONE ON DATE:  FIELD
;<3-UTILITIES>MAILER.MAC.3, 28-Sep-77 02:32:10, EDIT BY CROSSLAND
;CONVERT TO ARPA SYTLE MAIL.TXT FILE FORMAT
;<3-UTILITIES>MAILER.DIF.2, 25-Sep-77 02:06:36, EDIT BY CROSSLAND
;<3-UTILITIES>MAILER.MAC.2, 25-Aug-77 11:31:42, EDIT BY KIRSCHEN
;FIX VERSION NUMBERS FOR RELEASE 3
;<3-UTILITIES>MAILER.MAC.1, 22-Aug-77 17:02:39, EDIT BY MILLER
;TCO 1857. CHECK FOR NULLS AND USE TTMSG
;<2-UTILITIES>MAILER.MAC.22, 27-Dec-76 17:06:30, EDIT BY HURLEY
;<2-UTILITIES>MAILER.MAC.21, 22-Dec-76 13:47:33, EDIT BY HURLEY
;<2-UTILITIES>MAILER.MAC.20, 13-Oct-76 09:57:47, EDIT BY MILLER
;<2-UTILITIES>MAILER.MAC.19, 13-Oct-76 09:46:23, EDIT BY MILLER
;AND MORE
;<2-UTILITIES>MAILER.MAC.18, 13-Oct-76 09:35:48, EDIT BY MILLER
;MORE FIXES
;<2-UTILITIES>MAILER.MAC.17, 23-Sep-76 09:05:04, EDIT BY MILLER
;CREATE MAIL.TXT IN SYSTEM IF IT DOESN'T EXIST
;<2-UTILITIES>MAILER.MAC.16, 21-Sep-76 13:32:03, EDIT BY MILLER
;<2-UTILITIES>MAILER.MAC.15, 21-Sep-76 11:52:03, EDIT BY MILLER
;DON'T TELL PTYS "YOU HAVE A MESSAGE"
;<2-UTILITIES>MAILER.MAC.14, 20-Sep-76 11:54:12, EDIT BY MILLER
;<2-UTILITIES>MAILER.MAC.13, 20-Sep-76 10:58:46, EDIT BY MILLER
;MAKE IT WORK FOR 1B OR 2 FORMS OF USER NAME
;<2-UTILITIES>MAILER.MAC.12, 20-Sep-76 10:46:33, EDIT BY MILLER
;<2-UTILITIES>MAILER.MAC.11, 20-Sep-76 10:43:14, EDIT BY MILLER
;MAKE SPECIAL CHECK FOR SYSTEM MESSAGE
;<2-UTILITIES>MAILER.MAC.10, 16-Sep-76 15:46:00, EDIT BY MILLER
;RETURN CAPX1 FOR ATTEMPT TO SEND TO SYSTEM
;<2-UTILITIES>MAILER.MAC.9, 16-Sep-76 14:06:22, EDIT BY MILLER
;CHECK FOR RCUSR FAILURE IN USRDIR
;<2-UTILITIES>MAILER.MAC.8, 16-Sep-76 12:59:33, EDIT BY MILLER
;MAKE IT WORK WITH OLD OR NEW IPCF FORMATS
;<2-UTILITIES>MAILER.MAC.7, 16-Sep-76 10:08:46, EDIT BY MILLER
;FIX FROM MESSAGE
;<2-UTILITIES>MAILER.MAC.6, 16-Sep-76 09:36:44, EDIT BY MILLER
;MORE RELEASE 2 CHANGES
;<2-UTILITIES>MAILER.MAC.5, 14-Sep-76 15:07:39, EDIT BY MILLER
;FEED GTDAL A DIR # INSTEAD OF A USER #
;<2-UTILITIES>MAILER.MAC.4, 13-Sep-76 11:45:08, EDIT BY MILLER
;MORE OF THE SAME
;<2-UTILITIES>MAILER.MAC.3, 13-Sep-76 11:36:59, EDIT BY MILLER
;CHANGE TO WORK ON MULTIPLE STRUCTURES
;<1B-UTILITIES>MAILER.MAC.4,  9-Jul-76 09:39:06, EDIT BY HURLEY
;INCREASED VERSION NUMBER FOR RELEASE 1B
;<1B-UTILITIES>MAILER.MAC.3, 14-JUN-76 13:55:36, EDIT BY JMCCARTHY
;<1B-UTILITIES>MAILER.MAC.2,  8-JUN-76 16:23:43, EDIT BY HURLEY
;TCO 1371 - USERS DON'T ALWAYS KNOW THEY HAVE A MESSAGE
;<1A-UTILITIES>MAILER.MAC.26,  6-MAY-76 10:58:03, EDIT BY HURLEY
;<1A-UTILITIES>MAILER.MAC.22,  8-APR-76 11:12:53, EDIT BY HURLEY
;TCO 1244 - ADD .DIRECT .XTABM FOR MACRO 50 ASSEMBLIES
;<1A-UTILITIES>MAILER.MAC.21, 31-MAR-76 10:09:40, EDIT BY HURLEY
;TCO # 1227 - ADD TOPS-20 ENTRY VECTOR AND VERSION NUMBER
;<V-SOURCES>MAILER.MAC.20, 27-FEB-76 14:17:39, EDIT BY MILLER
;TCO 1121. MAKE [YOU HAVE A MESSAGE] GO TO ALL APPROPRIATE JOBS
;<V-SOURCES>MAILER.MAC.18, 19-DEC-75 12:59:11, 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 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	TITLE MAILER
	SEARCH MONSYM,MACSYM
	SALL
	IFNDEF .PSECT,<
	.DIRECT .XTABM>

; VERSION NUMBER DEFINITIONS

VMAJOR==3		;MAJOR VERSION OF MAILER
VMINOR==0		;MINOR VERSION NUMBER
VEDIT==6		;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
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

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
	DIRST			;CONVERT TO A STRING
	 JRST BAH		;WONT CONVERT
	CAMN B,SYSDIR		;IS THIS SYSTEM?
	JRST [	MOVE B,[SYSCOD]	;YES. GET INTERNAL VALUE
		MOVEM B,0(D)	;STORE IT
		JRST .+1]	;AND PROCEED
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
	SOUT
	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
	JRST TOPOF

;SPECIAL USER CODE FOUND

SPCUSR:	HRROI B,[ASCIZ /SYSTEM/] ;YES. GET THE NAME
	SETZ C,
	SOUT			;PUT IT IN
	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
	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
	MOVSI B,(1B0)		;ENABLE 0 ONLY
	AIC
	EIR			;TRUN IT ALL ON
	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
	 JFCL
	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

;GOT FILE OPEN. NOW BUILD MESSAGE

	SETZM ERRORS		;NO ERRORS
	HRROI B,[ASCIZ /   --------
DATE: /]
	HRROI A,BIGBUF
	SETZ C,
	SOUT			;PUT MESSAGE IN BUFFER
	SETO B,
	MOVSI C,(OT%NSC)	;FORMAT BITS
	ODTIM			;PUT THE TIME IN THE FILE
	HRROI B,[ASCIZ /
FROM: /]
	SETZ C,
	SOUT			;PUT IN SENDER'S NAME
	MOVE B,W4		;LOGGED IN DIRECTORY
	DIRST			;PUT IT IN
	 JFCL
	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
	 JFCL
	HRROI B,[ASCIZ /]
/]
	SETZ C,
	SOUT			;TERMINATE THE MESSAGE
	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
	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
	JUMPN C,ALLIN		;IF ALL IN GO
	MOVEI B,(B)		; SKIP OVER THE EXTRAS
	SIN			;SKIP OVER THE REST OF THEM
ALLIN:	MOVEI D,(B)		;SAVE END VALUE
	GTSTS			;GET FILE STATUS
	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
	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
	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
DOCC:	GTSTS			;EOF?
	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
	PUSHJ P,DOUSR		;DO CC LIST AS WELL
ONMSG:	HRROI B,[ASCIZ /
   _____
/]
	SETZ C,
	SOUT			;MESSAGE SEPARATOR
	MOVEI B,0
	TLNE A,(70B5)		;NOW AT LAST BYTE IN WORD
	JRST [	IDPB B,A	;NO, PAD ANOTHER NULL
		JRST .-1]
	MOVE B,A
	HRLI B,(POINT 36,0,35)	;CHANGE TO 36-BIT
	MOVE A,JFN		;FILE JFN
	MOVEI C,SIZE		;MAXIMUM SIZE OF MESSAGE
	SETZM D			;STOP ON A NULL
	SIN			;GET MESSAGE
	MOVE C,B		;SAVE POINTER
	GTSTS			;GET FILE STATUS
	TXNN B,GS%EOF		;AT EOF NOW?
	JRST NACK		;NO. FOUND A NULL THEN
	MOVE B,C		;RESTORE POINTER
	; ..
;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 36,[ASCIZ /   ========
/]]
	MOVNI C,3		;WRITE 3 WORDS
	SIN			;TIE OFF THE MESSAGE
	SETZ C			;PUT ON NULL AT END
	IDPB C,B		;PUT A ZERO ON THE END
	MOVEI W,(B)		;GET FINAL WORD
	SUBI W,BIGBUF-1		;CALCULATE NUMBER OF WORDS
	IMULI W,5		;CHARACTERS PER 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 NOSYS		;NO. NO SPECIAL CHECKING THEN
	TRNE W5,600000		;YES. IS THIS FROM A PRIVILEGED GUY?
	JRST NOSYS1		;YES. ALLOW IT THEN
	MOVE W1,CONDIR		;GET CONNECTED DIR
	CAME W1,SYSDI1		;IS IT SYSTEM?
	CAMN W4,SYSDIR		;LOGGED IN AS SYSTEM?
	JRST NOSYS1		;YES. ALLOW THIS SEND THEN
	MOVEI A,CAPX1		;NO. MUST BE PRIVILEGED
	JRST OOPS2		;TELL USER OF THE PROBLEM
NOSYS:	TRNE W5,600000		;IS SENDER PRIVILEGED?
	JRST NOSYS1		;YES. DON'T CHECK ALLOCATION THEN
	MOVE A,B		;GET DIRECTORY NUMBER
	CALL USRDIR		;GET DIR NUMBER FROM USER NUMBER
	 JRST OOPS1		;UNKNOWN FAILURE
	GTDAL			;GET THE ALLOCATION
	CAIL B,0(A)		;WITHIN ALLOCATION?
	JRST [	MOVSI B,NOACKQ	;QUOTA ERROR
		JRST OOPS]	;GIVE THE INDICATION
	MOVE B,-1(D)		;GET BACK DIRECTORY NUMBER
NOSYS1:	CAMN B,[SYSCOD]		;IS THIS TO SYSTEM?
	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
	DIRST			;PUT IN DIRECTORY NUMBER
	 JFCL			;WILL GO
	MOVEI C,">"
	IDPB C,A
	HRROI B,[ASCIZ /MAIL.TXT/]
	SETZ C,
	SOUT			;BUIL FILL FILE SPEC
	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
	MOVE B,[070000,,20000]	;APPEND
	OPENF
FILERR:	 JRST [	EXCH A,C
		RLJFN		;ERROR
		 JFCL
		MOVE A,C	;ERROR CODE AGAIN
		JRST OOPS2]	;AND GO GIVE ERROR
;HAVE FILE OPOEND .NOW WRITE IT

	MOVE A,C		;THE JFN
	PUSH P,C		;SAVE IN CASE OF ERROR
	SETO B,0		;PUT CURRENT TIME ON IT
	MOVSI C,(OT%TMZ)	;IN THIS FORM
	ODTIM
	MOVEI B,","
	BOUT			;SEPARATE TIME FROM COUNT
	RFPTR			;READ POSITION IN FILE
	 JRST [	POP P,C		;GET JFN IN C
		JRST FILERR]	;GO GIVE ERROR MESSAGE
	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
	 JFCL
	POP P,A			;RESTORE JFN
	HRROI B,[ASCIZ /;000000000000
/]
	MOVEI C,0		;PUT ON THE FLAG FIELD
	SOUT
	MOVE B,[POINT 7,BIGBUF]
	MOVN C,W		;GET NEGATIVE WORD COUNT
	SOUT			;WRITE ALL WORDS
	HRLI A,.FBCTL		;CHANGE STATUS BITS
	MOVX B,FB%DEL		;CHANGE DELETED BIT
	SETZ C,			;MAKE IT A ZERO(UNDELETE)
	CHFDB			;DO IT
	MOVX B,FB%PRM		;CHANGE PERMANENT BIT
	MOVX C,FB%PRM		;TO BE SET
	CHFDB
	MOVEI A,(A)		;JFN ONLY
	CLOSF			;CLOSSE THE OUTPUT FILE
	 JFCL
	; ..
;ROUTINE TO SEND MESSAGES TO ANY LOGGED IN USERS

	MOVE A,-1(D)		;GET USER 
	CAMN A,[SYSCOD]
	JRST [	SETO A,		;IS SYSTEM
		HRROI B,[ASCIZ /
[New Message-of-the-Day available]
/]
		TTMSG		;DO IT
		JRST SNDOFF]	;AND DONE
	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
	TXNE B,TT%DAM		; IS HE IN ASCII?
	TXNN B,TT%ALK		; IS HE ACCEPTING?
	AOJA W6,TOPDIR		;NO. DON'T TELL HIM THEN
	HRROI B,FRMMSG		;GET MESSAGE BLOCK
	TTMSG			;SEND TO THIS USER
INCDIR:	AOJA W6,TOPDIR		;DO ALL JOBS

;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
	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
		HALTF]
	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 THJE SEND QUEUEU

ONQ:	HLRZ B,W3		;SIZE NEEDED
	MOVEI A,4(B)		;TOTAL SIZE NEEDED
	PUSH P,W		;SAEV HEADER
	CALL ALLOC		;GET SPACE
	 RET			;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
	END <3,,ENTVEC>