Google
 

Trailing-Edge - PDP-10 Archives - AP-4172F-BM - 3a-sources/mail.mac
There are 20 other files named mail.mac in the archive. Click here to see a list.
;<3-UTILITIES>MAIL.MAC.7,  8-Nov-77 10:47:39, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-UTILITIES>MAIL.MAC.6, 26-Oct-77 11:07:12, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-UTILITIES>MAIL.MAC.5, 30-Sep-77 11:23:06, EDIT BY MILLER
;<3-UTILITIES>MAIL.MAC.4, 30-Sep-77 11:05:19, EDIT BY MILLER
;MORE HELP TEXT IMPROVEMENTS
;<3-UTILITIES>MAIL.MAC.3, 30-Sep-77 11:00:53, EDIT BY MILLER
;FIX HELP TEXT TO SAY "CTRL/Z"
;<3-UTILITIES>MAIL.MAC.2, 25-Aug-77 11:35:22, EDIT BY KIRSCHEN
;FIX VERSION NUMBERS FOR RELEASE 3
;<3-UTILITIES>MAIL.MAC.1, 19-Jul-77 13:05:03, EDIT BY MILLER
;TCO 1842. ALLOW PARTIAL RECOGNIITON OF USER NAMES
;<2-UTILITIES>MAIL.MAC.21, 20-Jan-77 14:21:00, EDIT BY HURLEY
;FIX HELP MESSAGE
;<2-UTILITIES>MAIL.MAC.20, 27-Dec-76 17:06:24, EDIT BY HURLEY
;<2-UTILITIES>MAIL.MAC.19,  8-Oct-76 10:14:22, EDIT BY MILLER
;FIX FILE NAME ERROR RECOVERY
;<2-UTILITIES>MAIL.MAC.18, 28-Sep-76 15:19:12, EDIT BY MILLER
;<2-UTILITIES>MAIL.MAC.17, 28-Sep-76 10:24:43, EDIT BY MILLER
;INIT USRBLK CORRECTLY
;<2-UTILITIES>MAIL.MAC.16, 27-Sep-76 13:35:28, EDIT BY MILLER
;ALWAYS RETRY ON ERRORS
;<2-UTILITIES>MAIL.MAC.15, 23-Sep-76 09:13:19, EDIT BY MILLER
;MORE RELEASE 2
;<2-UTILITIES>MAIL.MAC.14, 22-Sep-76 16:59:17, EDIT BY MILLER
;<2-UTILITIES>MAIL.MAC.13, 22-Sep-76 11:37:07, EDIT BY MILLER
;FIX UP OUTPUT
;<2-UTILITIES>MAIL.MAC.12, 21-Sep-76 13:42:31, EDIT BY MILLER
;FIX CHKSLF
;<2-UTILITIES>MAIL.MAC.11, 20-Sep-76 11:48:38, EDIT BY MILLER
;<2-UTILITIES>MAIL.MAC.10, 20-Sep-76 11:30:07, EDIT BY MILLER
;MAKE COUNT CORRECT WHEN RECOGNIZING NAMES
;<2-UTILITIES>MAIL.MAC.9, 20-Sep-76 11:18:34, EDIT BY MILLER
;<2-UTILITIES>MAIL.MAC.8, 20-Sep-76 11:17:54, EDIT BY MILLER
;MAKE SPECIAL CHECK FOR SYSTEM
;<2-UTILITIES>MAIL.MAC.7, 14-Sep-76 12:25:00, EDIT BY MILLER
;MORE,MORE,MORE
;<2-UTILITIES>MAIL.MAC.6, 13-Sep-76 17:05:06, EDIT BY MILLER
;FIX TYPOS
;<2-UTILITIES>MAIL.MAC.5, 13-Sep-76 17:03:51, EDIT BY MILLER
;MORE FIXES
;<2-UTILITIES>MAIL.MAC.4, 13-Sep-76 15:15:11, EDIT BY MILLER
;MORE OF THE SAME
;<2-UTILITIES>MAIL.MAC.3, 10-Sep-76 12:00:57, Edit by HESS
;TCO 1523 - CONVERT FOR RELEASE 2
;<1A-UTILITIES>MAIL.MAC.23,  6-MAY-76 10:57:39, EDIT BY HURLEY
;<1A-UTILITIES>MAIL.MAC.19,  8-APR-76 11:12:02, EDIT BY HURLEY
;TCO 1244 - ADD .DIRECT .XTABM FOR MACRO 50 ASSEMBLIES




;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 MAIL
	SEARCH MONSYM,MACSYM
	SALL
	IFNDEF .PSECT,<
	.DIRECT .XTABM>

;PROGRAM VERSION DEFINITIONS

PRGVER==3			;VERSION 2
PRGEDT==4			;EDIT 3
PRGMIN==0			;MINOR VERSION
PRGCST==0			;CUSTOMER ID


DEFINE ASSIGN(A,B,C)
<A=B
B==B+C
>
;DEFINE REGISTERS

F==0
A==1
B==2
C==3
D==4
W==5
W1==6
W2==7
W3==10
P==17

;DEFINE VALUES IN F

S.PRF==1
S.END==2
S.SAW==4
S.BLA==10
S.ERR==20

NACK1==2			;TOATL WIPEOUT FORM MAILER
NACK2==3			;QUOTA EXCEEDED

;LOCAL STORAGE

ARG:	6		;TEXTI ARG BLOCK
	RD%RBF+RD%JFN+RD%BEL+RD%BRK+RD%PUN
	.PRIIN,,.PRIOU
OBUF:	-1,,BIGBUF
	SIZE*5		;CHAR COUNT
	-1,,BIGBUF	;TOP OF BUFFER
RBUFF:	0		;^R DISJOINT BUFFER
DATA==10000
USERS==^D100
ASSIGN USRBLK,DATA,USERS+1
PDSL==^D20			;SIZE OF PDL
SAVW:	Z 0
PARTRM:	Z 0
SAVCNT:	Z 0
SYSCOD==-2			;SPECIAL SYSTEM CODE
NOACKB==0			;DEFAULT MESSAGE TYPE
MINMSG==1			;FIRST ERROR MESSAGE
MSGTBL:	[ASCIZ / Quota exceeded/]
MAXMSG==.-MSGTBL+MINMSG		;LAST MESSAGE +1

PIDGET:	IP%CPD			;GET PID
	0
	0			;TO INFO
	ENDMSG-.,,.+1		;FOR INFO
	1,,1			;GET PID FOR NAME
	0			;NO COPY
	ASCIZ /[SYSTEM]MAILER/
ENDMSG:
CPYJFN:	BLOCK 1
PDL:	BLOCK PDSL
SIZE==1000*^D50			;STRING AREA
ASSIGN BIGBUF,DATA,SIZE
CURR:	Z 0			;SAVE CURRENT STRING POINTRE
DIRSTR:	BLOCK ^D32		;FOR FILE NAME
ASSIGN HOLD,DATA,100000		;FOR OLD MESSAGES

;DEFINE ENTRY VECTOR

ENTVEC:	JRST START		;MAIN ENTRY
	JRST RETRY		;REENTER POINT
	PRGVER_^D24+PRGMIN_^D18+PRGEDT+PRGCST_^D33

;CODE

	RELOC 1000-140		;ON A CLEAN PAGE
START:	RESET			;CLEAR THE WORLD
	MOVE P,[IOWD PDSL,PDL]	;STACK
	MOVEI A,100
	RFCOC
	TRZ C,3B19		;DONT ECHO ESC
	SFCOC
	MOVE A,[ASCII /PS:</]	;GET DEVICE STRING
	MOVEM A,BIGBUF		;PUT IT IN THE BUFFER
	GJINF			;GET LOGGED IN DIRECTORY
	MOVE B,A		;GET USER NUMBER
	MOVE A,[POINT 7,BIGBUF,27] ;WHERE TO PUT USER NAME
	DIRST			;GET THE NAME
	 JFCL
	HRROI B,[ASCIZ />MAIL.CPY/] ;THE FILE NAME
	SETZ C,
	SOUT			;MAKE NAME
	MOVX A,GJ%FOU!GJ%SHT
	HRROI B,BIGBUF		;WHERE NAME IS
	GTJFN			;GET A JFN
	 JRST CANT		;OOPS. FAILED
	MOVEM A,CPYJFN		;SAVE IT FOR LATER
	MOVE B,[440000,,300000]
	OPENF			;MAKE SURE IT WILL OPEN
	 JRST CANT		;WON'T
	MOVSI A,(RD%RBF!RD%JFN!RD%BEL!RD%BRK!RD%PUN)
	MOVEM A,ARG+1		;SET UP FLAGS
	HRROI A,BIGBUF
	MOVEM A,ARG+5		;TOP OF BUFFER VALUE
	HRROI A,[ASCIZ /To: /]
	MOVEM A,RBUFF		;^R MESSAGE
	PSOUT
	SETZ F,			;NO FLAGS
	PUSHJ P,INDIR1		;GET LIST OF TO NAMES
	 JRST START		;MUST HAVE SOME
TRYTO:	JUMPE A,START		;SAME HERE

;GOT USER LIST . VERIFY AND PUT IN USRBLK

	MOVE W,[-USERS,,USRBLK]	;WHERE THEY ARE GOING
	MOVEI W3,USRBLK		;PURGE THEM
	PUSHJ P,REAL		;CONVERT TO NUMBERS
	 JRST [	CALL INDIR2	;TR,TRY AGAIN
		 JRST START
		JRST TRYTO]	;AGAIN
	SKIPN USRBLK		;GOT AT LEAST ONE?
	JRST START		;NO. ASK FOR MORE
	ADD W,[1,1]		;MOVE TO NEXT
CCAGN:	HRROI A,[ASCIZ /CC: /]
	MOVEM A,RBUFF		;MAKE THIS ^R BUFFER
	PSOUT			;GET COPIES TO
	PUSH P,W		;SAVE USRBLK POINTER
	PUSHJ P,INDIR1		;GET THEM
	 JRST [	POP P,W
		JRST CCAGN]	;MUST TYPE SOMETHING
	POP P,W
TRYCC:	MOVEI W3,USRBLK		;PURGE DUPLICATES
	JUMPE A,TRYCC1
	PUSHJ P,REAL		;YES. CONVERT EM
	 JRST [	PUSH P,W
		CALL INDIR2
		 JRST [	POP P,W
			JRST CCAGN]
		POP P,W
		JRST TRYCC]
TRYCC1:	ADD W,[1,,1]
	MOVE A,[USRBLK,,BIGBUF+1]
	BLT A,BIGBUF-USRBLK+1(W) ;NAMES TO MESSAGE BUFFER
	SUBI W,USRBLK		;RELATIVE POINT IN BLOCK
	MOVEI B,BIGBUF+1(W)	;WHERE TO START IN BIGBUF
	SETZM BIGBUF		;NO FLAGS BY DEFAULT
	HRLI B,440700		;SP FOR TEXT
	JRST DOSTUF		;AND GO DI IT

;SUBROUTINE TO PROCESS USER NAMES

INDIR2:	MOVE D,[POINT 7,BIGBUF]
	MOVE B,D
	MOVEI C,SIZE*5
INDIR3:	ILDB A,B		;GET A BYTE
	JUMPE A,INDIR4		;IF AT THE END, DONE
	MOVE D,B		;COPY IT
	SOJA C,INDIR3		;DO ALL OF IT
INDIR1:	MOVE D,[POINT 7,BIGBUF]	;BUFFER HEAD
	MOVEI C,SIZE*5		;INITAIL SIZE FOR RDTXT
INDIR4:	MOVEM D,CURR
INDIR:	MOVE B,CURR
	MOVEM B,OBUF		;START OF BUFFER
	HRRZM C,ARG+4		;PUT IN CUREENT COUNT
	MOVEI A,ARG		;BLOCK ADDRESS
	TEXTI			;GET THE INPUT
	 JRST [	MOVEI A,"?"	;IMPOSSSIBLE FAILURE
		PBOUT
		HALTF]		;GIVE UP
	MOVE C,ARG+1		;PICK UP THE FLAGS
	HRR C,ARG+4		;AND THE COUNT
	MOVE B,OBUF		;AND BUFFER POINTER
	TLNN C,(RD%BTM)		;SAW A BRAEK?
	POPJ P,			;NO. GIVE IT UP

;GOT A BREAK. NOW PROCESS THE NAME

	LDB W,B			;GET THE BREAK
	HRRZ W1,C		;GET COUNT
	CAIN W1,SIZE*5-1	;FIRST CHARACTER?
	CAIE W,"?"		;YES. DOES HE WANT HELP?
	SKIPA			;NO
	JRST HLPHIM		;YES. GO DO IT
AFTER:	CAIE W,"@"		;POSSIBLE FILE NAME?
	JRST AFTER1		;NO
	MOVE A,B		;YES. LOOK AT THE PREVIOUS
	BKJFN			;DO IT
	 JFCL
	LDB W1,A		;GET PREVIOUS
	MOVEI W,(A)		;GET WORD POSITION
	CAIE W1,","		;UP TO A TERMINATER?
	CAIGE W,BIGBUF		;NO. AT START OF BUFFER?
	SKIPA B,A		;YES. DO A FILE
	JRST COMMON		;NO. USE THE CHARACTER
	PUSHJ P,GETFIL		;GET THE FILE THEN
	 JRST [	MOVEM B,CURR	;UPDATE POINTER
		CALL RETYPE	;PUT OUT THE LINE AGAIN
		AOS C		;DISCOUNT THE CHARACTER
		JRST INDIR]	;AND PROCEED
	JRST EOL		;WRAP UP,BUT ALLOW CONTINUATION
AFTER1:	CAIN W,","		;COMMA?
	JRST COMMA		;YES. GO DO IT
	CAIN W,33		;ESCAPE?
	JRST RECOG		;YES. GO DO SOME WORK
	CAIN W,12		;EOL?
	JRST EOL		;YES.
COMMON:	MOVEM B,CURR		;SAVE CURRENT 
	JRST INDIR		;GO GET MORE

;BREAK CHARACTRE PROCESSING ROUTINES

COMMA:	JRST COMMON		;GO DO MORE
EOL:	HRRZ W,C		;AN EOL. SEE IF ANYTHING AROUND
	SETZ A,			;NULL RETUHRN
	CAIL W,SIZE*5-2		;EMPTY?
	JRST CPOPJ1		;YES. GO BACK
	MOVE A,B		;GET POINTER
	BKJFN			;OVER THE LF
	 JFCL
	LDB W,A			;LOOK AT PREVIOUS
	CAIN W,15		;CR THER3 TOO?
	BKJFN			;YES. ZAP IT TOO
	 JFCL
	MOVEI B,(A)		;SEE IF BUFFER IS NULL
	CAIGE B,BIGBUF		;STILL IN THE BUFFER?
	POPJ P,			;NO. MUST BE NULL THEN
	LDB B,A			;GET PREVIOUS
	CAIE B,","		;CONTINUATION?
	JRST CPOPJ1		;NO. GO BACK
	MOVEM A,CURR		;NEW CURRENT
	JRST INDIR		;GO DO MORE THEN
RECOG:	SETZ A,
	DPB A,B			;TIE OFF STRUNG
	MOVE A,B
	BKJFN			;OVER THE NULL
	 JFCL
	MOVE W,A		;SAVE END OF STRING
MRBAK:	LDB W1,A		;LOOK AT BYTE
	CAIE W1," "		;UP TO PREVIUOS?
	CAIN W1,","		;UP TO PREVIOUS?
	JRST ATIT		;YES
	CAIN W1,"	"	; A TAB?
	JRST ATIT		;YES. BREAK THEN
	HRRZ W1,A		;NO. SEE IF IN BIGBUF
	CAIGE W1,BIGBUF
	JRST ATIT1		;TOO FAR
	BKJFN
	 JFCL
	JRST MRBAK
ATIT1:	MOVE A,[POINT 7,BIGBUF]
ATIT:	MOVEM A,CURR		;NEW CURR
	MOVE B,CURR		;WHERE IT STRTS
	MOVX A,RC%PAR		;DO PARTIAL RECOGNITION
	MOVE D,C		;SAVE COUNT
	RCUSR			;GET THE NAME
	 ERJMP NOREC		;BAD NAME STRING
	MOVE C,D		;RESTORE COUNT
	TXNE A,RC%NOM		;MATCH?
	JRST NOREC		;NO - TRY NOREC
	TXNE A,RC%AMB		;AMBIGUOUS
	JRST [	MOVE A,W	;YES. GET PREVIOUS TAIL
		PSOUT		;FINISH OFF STRING
		MOVEI A,7
		PBOUT		;SAY SO
		MOVEM B,CURR	;SAVE PARTIAL NAME
		JRST INDIR]	;GO BACK TO GET MORE

;GOT NAME

	MOVEM B,CURR		;UPDATE POINTER
	MOVE A,W		;WHERE THE USER STOPPED
	PSOUT			;PRINT THE REST FOR HIM
	JRST INDIR		;GO GET MORE

CPOPJ1:	AOS (P)
	POPJ P,			;GOOD RETURN

NOREC:	MOVE B,CURR
	MOVEI A,[1,,1
		[ASCIZ /SYSTEM/],,0]
	TBLUK			;SEE IF THIS IS SYSTEM
	 ERJMP NOREC1		;IF ERROR, IT ISN'T
	TXNE B,TL%EXM		;EXACT MATCH?
	JRST [	MOVEM W,CURR	;YES. SAVE END OF STRING
		MOVE C,D	;RESTORE COUNT
		JRST INDIR]	;AND DONE
	TXNN B,TL%ABR		;AN SUBSTIRNG?
	JRST NOREC1		;NO. ERROR THEN
	MOVE A,C		;YES.
	PSOUT			;OUTPUT THE REST
	MOVE A,CURR		;THE START OF IT ALL
	HRROI B,[ASCIZ /SYSTEM/]
	SETZ C,
	SOUT			;FILL IN THE STRING
	MOVE C,D		;RESTORE COUNT
	MOVEM A,CURR		;UPDATE TEXTI BLOCK
	JRST INDIR		;AND DONE
NOREC1:	HRROI A,[ASCIZ / ?
/]
	PSOUT
	CALL RETYPE
	MOVE C,D
	JRST INDIR

RETYPE:	MOVE A,RBUFF		;GET ^R STRING
	PSOUT
	SETZ A,
	MOVE B,CURR		;APPEND NULL TO CURRENT STRING
	IDPB A,B
	HRROI A,BIGBUF		;STRING SO FAR
	PSOUT
	RET			;AND DONE
REAL:	SETZ F,			;NO FLAGS
	MOVEM W,SAVW		;SAVE ENTRY VALUE
	MOVE D,[POINT 7,BIGBUF]
LOOP:	PUSHJ P,BLKOUT		;GET RID OF BLANKS
	MOVEM D,CURR		;TOP OF PROCESSING LOOP
	TRZ F,S.BLA		;NO BLANK
LOOP1:	ILDB A,D		;GET  BYTE
	JUMPE A,EOL1		;FAKE EOL IF AT NULL BYTE
	CAIE A,"	"	;TAB?
	CAIN A," "		;A BLANK
	JRST [	SETZ A,		;YES. GET A NULL
		DPB A,D		;TIE OFF THIS NAME
		PUSHJ P,BLKOUT	;PURGE BLANKS
		ILDB A,D	;GET REAL TERMONATOR
		TRO F,S.BLA	;REMEMBER THE BLANK
		JRST .+1]	;AND PROCEED
	CAIN A,","		;END OF NAME/
	JRST ENDOF		;YES
	CAIE A,15
	CAIN A,12		;ENDOF THEM ALL?
	JRST [	TRZN F,S.SAW	;JUST SAW A COMMA?
		JRST EOL1	;NO. GO DO THE NAME
		CAIN A,15	;WAS IT A CR?
		IBP D		;YES. SKIP THE LF
		JRST LOOP]	;GO TRY ANOTHER NAME
	TRZ F,S.SAW		;SAY NOT ON A TWRMNAOER
	TRNN F,S.BLA		;BLANK WAS LAST?
	JRST LOOP1		;GET MORE BYTES
	MOVE A,D		;YES
	BKJFN			;MUST SEE THIS AGAIN
	 JFCL
	MOVE D,A		;GET THIS BACK
	JRST ENDOFF		;AND GO DO IT
EOL1:	TRO F,S.END		;NO MORE
ENDOF:	TRO F,S.SAW		;SAW A COMMA
ENDOFF:	SETZ A,
	MOVE B,CURR		;STRINF POINTER
	LDB C,D			;SAVE TERMINATER
	MOVEM C,PARTRM		;SAVE TERMINATER
	MOVE C,D		;COPY PTR
	DPB A,D			;TIE OFF OLD STRING
	TRNE F,S.END		;AT THE END YET?
	IDPB A,C		;YES. ANOTHER NULL FOR GOOD KEEPING
	PUSHJ P,CHKSLF		;CHECK FOR SELF
	JUMPN C,SELF1		;NON-0 MEANS SELF
	MOVX A,RC%EMO		;EXACT MATCH ONLY
	RCUSR			;GET NAME
	 ERJMP BADUSR		;BAD NAME STRING
	TXNE A,RC%AMB!RC%NOM
	JRST BADUSR		;NO MATCH
SELF1:	JUMPE W3,NOPURG		;PURGING?
	MOVEI W2,(W3)		;YES. GET START OF PURGE LIST
CUSER:	CAIN W2,0(W)		;IS THIS THE END?
	JRST NOPURG		;YES. ALL DONE
	CAME C,(W2)		;THIS A MATCH?
	AOJA W2,CUSER		;NO. GO DO THE NEXT
	HRROI A,[ASCIZ /%Duplicate name purged - /]
	PSOUT			;YES. PURGE IT
	JRST NOUSR		;AND GO WRAP UP
NOPURG:	MOVEM C,(W)		;STORE NUMBER
	TRNE F,S.END		;MORE TO DO?
	JRST FINNAM		;YES. GO FINISH IT UP
	MOVE C,PARTRM		;GET TERMINATER
	DPB C,D			;RESTORE IT
	AOBJN W,LOOP		;GET MORE
	HRROI A,[ASCIZ /
%Too many user names. 100 is maximum.
/]
	PSOUT			;TOO MANY. SSAY SO
	POPJ P,			;ALL DONE
BADUSR:	MOVE B,CURR		;GET THE STRING
	MOVEI A,[1,,1
		[ASCIZ /SYSTEM/],,0]
	TBLUK			;SEE IF THIS IS SYETEM
	MOVE C,[SYSCOD]		;ASSUME IT IS SYSTEM
	TXNE B,TL%EXM		;IS IT?
	JRST SELF1		;YES. GO USE IT
	HRROI A,[ASCIZ /?Illegal user name - /]
	PSOUT			;VAD NAME
	TRO F,S.ERR		;REMEMBER AN ERROR
NOUSR:	MOVE A,CURR		;POINTER TO THE NAME
	PSOUT
	HRROI A,[ASCIZ /
/]
	PSOUT			;CLEAN UP THE TYPESCRIPT
	MOVE A,CURR
NOUSR1:	ILDB C,D		;GET NEXT BYTE
	IDPB C,A		;COPY
	JUMPN C,NOUSR1		;DO ALL OF STRING
	MOVE D,CURR		;NEW BEGINNING
	TRNN F,S.END		;MORE/
	JRST LOOP		;YES
	SKIPA
FINNAM:	ADD W,[1,,1]		;MOVE TO THE NEXT
	MOVEM D,CURR		;SAVE CURRENT INSERT POINT
	TRNE F,S.ERR		;FOUND AN ERROR?
	JRST [	MOVE W,SAVW	;YES
		CALL RETYPE	;OUTPUT THE STUFF
		JRST FINN1]	;GO ARRANGE FOR REPARSE
	AOS 0(P)
FINN1:	SETZM (W)		;TIE IT OFF
	POPJ P,

;CHECK FOR USER NAME OF "." - MEANS SAME AS PRESENTLY LOGGED IN

CHKSLF:	PUSH P,B		;SAVE ORIG STRING PTR
	ILDB A,B		;GET FIRST CHAR
	CAIE A,"."		;DOT?
	JRST CHKS1		;NO, NOT SELF
	ILDB A,B		;SECOND CHAR
	JUMPN A,CHKS1		;NULL?
	MOVEM B,0(P)		;UPDATE STRING PTR
	PUSH P,D
	GJINF			;GET CURRENT USER NUMBER IN A
	POP P,D
	MOVE C,A		;GET LOGGED IN USER NUMBER
	POP P,B			;RESTORE STRING PTR
	POPJ P,

CHKS1:	POP P,B			;RESTORE ORIG STRING PTR
	SETZ C,			;SAY NOT SELF
	POPJ P,
;PURGE BLANKS

BLKOUT:	ILDB A,D		;GET A BYTE
	CAIE A," "		;BLANK
	CAIN A,"	"	;OR TAB?
	JRST BLKOUT		;YES. KEEP GOING
	MOVE A,D
	BKJFN
	 JFCL
	MOVE D,A		;KEEP THIS ONE
	POPJ P,			;DONE

;DO MESSAGE STUFF

DOSTUF:	HRROI A,[ASCIZ /Subject: /]
	PSOUT
	MOVEI A,100
	PUSH P,B		;SAVE SP
	RFCOC
	TLZ C,(3B2)		;TURN OFF ^R ECHO
	TRO C,3B19		;TURN ON ECHO FOR ESC
	SFCOC
	POP P,B
	HRROI A,[ASCIZ /Subject: /]
	SETZ C,
	SIN			;PUT IT IN
DOSBJ:	PBIN			;GET HIS BYTE
	CAIN A,"R"-100		;WANT RETYPE?
SUBCR:	JRST [	HRROI A,[ASCIZ /
Subject: /]
		PSOUT		;YES. DO IT
		JRST DOSBJ]	;AND TRY AGAIN
	CAIN A,"?"		;WANT HELP?
	JRST [	HRROI A,[ASCIZ /

Type a single line terminated with a <CR> which summarizes
the message you are sending.

Subject: /]
		PSOUT		;HELP HIM
		JRST DOSBJ]	;GO DO IT AGAIN
	MOVEI A,100		;PRIMARY
	BKJFN			;RE EAT THAT BYTE
	 JFCL
	MOVE A,B		;BUFFER
	MOVE B,[RD%RBF+RD%BEL+SIZE*5] ;FLAGS AND COUNT
	HRROI C,[ASCIZ /Subject: /]
	RDTTY			;GET THE SUBJECT MATTER
	 JFCL			;????
	TLNN B,(RD%BTM)		;GOT A REAL BREAK CHARACTER?
	JRST [	MOVE B,A	;NO. SAVE BUFFER
		JRST SUBCR]	;GO DO IT
	MOVE D,B		;SAVE FLAGS AND COUNT
	MOVE B,A		;MOVE BUFFER POINTER
	HRROI A,[ASCIZ /
/]
	SETZ C,
	SIN			;PUT IN SPACING
	MOVE W2,B		;SAVE WHERE MESSAGE STARTS
	MOVE W3,D		;SAVE THIS TOO
STUFF2:	HRROI A,[ASCIZ 'Message (Terminate with ESC or CTRL/Z):

']
	PSOUT			;PRIOM@T FOR MESSAGE
STUFF3:	MOVE A,B		;BUFFER ADDRESS
	MOVE B,D
	HRLI B,(RD%JFN+RD%BRK+RD%PUN) ;BREAK STUFF
	HRRZS D		;SAVE COUNT FOR INDIRECT STUFF
	SETZ C,			; NO ^R BUFFER
	SETZM RBUFF		; NO ^R BUFFER
	RDTTY			;GET HIS MESSAGE
	 JFCL
	LDB W,A			;GET TERMINATOR
	HRRZ W1,B		;GET NEW COUNT
	CAIE W1,-1(D