Google
 

Trailing-Edge - PDP-10 Archives - BB-5255D-BM - 4-sources/sndmsg.mac
There are 11 other files named sndmsg.mac in the archive. Click here to see a list.
;<4.ARPA-UTILITIES>SNDMSG.MAC.3,  4-Jan-80 09:48:27, EDIT BY R.ACE
;UPDATE COPYRIGHT DATES
;<4.ARPA-UTILITIES>SNDMSG.MAC.2, 10-Jul-79 05:33:50, EDIT BY R.ACE
;UPDATE COPYRIGHT NOTICE FOR RELEASE 4
;<HACKS>SNDMSG.MAC.4,  1-Jun-78 23:48:06, EDIT BY JBORCHEK
;PUT VERSION NUMBER IN ENTRY VECTOR
;<3.ARPA-UTILITIES>SNDMSG.MAC.4, 14-Nov-77 10:19:35, EDIT BY CROSSLAND
;CORRECT COPYRIGHT NOTICE
;<3.ARPA-UTILITIES>SNDMSG.MAC.3, 26-Oct-77 02:40:01, EDIT BY CROSSLAND
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-UTILITIES>SNDMSG.MAC.2, 30-Sep-77 11:16:54, EDIT BY CROSSLAND
;MAKE WORK WITH MULTIPLE STRUCTURES.  MAIL FILES MUST BE ON PS:
;<A-SOURCES>SNDMSG.MAC.8, 30-Dec-76 22:08:55, EDIT BY CROSSLAND
;CONVERT VERSION NUMBER TO DEC STYLE VERSION NUMBER
;<A-UTILITIES>SNDMSG.MAC.7,  3-Dec-76 14:46:27, EDIT BY CLEMENTS
; REMOVE ABILITY TO CALL TECO AS A SUBR UNLESS ASSEMBLED WITH
; TECSUB==1, BECAUSE DEC TECO DOESN'T HAVE THE REQUIRED ENTRY POINT
; CHANGE ALL .SAV TO .EXE
;<A-UTILITIES>SNDMSG.MAC.5, 23-Nov-76 11:57:38, EDIT BY CLEMENTS
; PUT IN 1B9 IN CAPS OF TIMER FORK
; CHANGE NAME OF MAIL FILE TO MAIL.TXT
; ALSO MAIL.CPY
;<2MURPHY>SNDMSG.MAC.10, 10-Sep-76 18:23:35, EDIT BY MURPHY
;CHANGE STENEX TO MONSYM,MACSYM
;<FRENCH>FWDSND.MAC;19     3-Jun-76 11:58:03    EDIT BY FRENCH
;ADDED ALL OF THE FORWARDING STUFF (NOLCL:,FWDIT:,MEDOIT:,ETC)
;<SOURCES>SNDMSG.MAC;41    30-JUN-75 12:30:30    EDIT BY JOHNSON
; Make sure all flags in F are zeroed at start of ADDMSG.
;  Thus text will NOT be raised.
;<SOURCES>SNDMSG.MAC;40    17-JUN-75 14:04:36    EDIT BY PLUMMER
; DONT STOP WAKING ON FORMATTING CONTROLS SO ^H STILL WORKS
; ... OLD HEADERS DELETED

;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 SNDMSG
	SUBTTL R.S.Tomlinson
	SEARCH MONSYM,MACSYM

VWHO==0			;LAST EDITED BY DEC
VMAJOR==3		;MAJOR VERSION #
VMINOR==0		;REVISION #
VEDIT==55		;EDIT NUMBER

	LOC	<.JBVER==137>
VERSIO:	<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT ;VERSIONS FOR TYPEOUT
	RELOC

	SALL
;	.DIRECT .FLBLST
	.REQUIRE SYS:MACREL

IFNDEF TECSUB,<TECSUB==0>;ONE TO ALLOW TECO TO EDIT MESSAGE BODY -
			;BUT DEC TECO DOESN'T HAVE THE RIGHT ENTRY
			; POINT TO BE CALLED AS AN INFERIOR

; Accumulators

F=0
A=1
B=2
C=3
D=4
X=5
PTR=6
EPTR=7
Y=10
BPTR=11
FLG=12
SF=15
R=16
P=17

;LINE EDITING CHARACTERS

CDELCH==.CHDEL			;RUBOUT
CDELLN=="U"-100			;CTRL-U
CRTYPE=="R"-100			;CTRL-R

;MAPPING PARAMETERS FOR USE OF MAILBOX.EXE
FWDPAG==100			;PAGE TO BE MAPPED
FWDADR==FWDPAG*1000		;FIST ADDRESS

; Flags in F

QUIETF==400000
COMMAF==200000
BUFFUL==100000
FRWRDF==40000
QFILEF==20000
EDEOLF==10000
CCUSRF==4000
EOFF==2000
STHSTF==1000
BLANKF==400
NCFRMF==200			; NEED TO CONFIRM GENERAL DELIVERY
FRSTCH==100			; FIRST CHARACTER SEEN BY INSTR
AMBIGF==40			;IN HOST NAME RECOGNIZER
MATCHF==20			; ..
NUMF==10
RAISEF==4
FULLF==2
USEATF==1

; FLAGS IN FLG

NTLOGF==400000
RVRSF==200000
SUBJF==100000
TEXTF== 40000
WTBSYF==20000

;CHARACTER CODES
CR==15
LF==12
TAB==11
FILCHR=="*"			;CHARACTER TO SIGNAL FILE NAME IN ADDRESS INPUT

; Parameters

NFILS==10			; Number of input files open at once
NUSRS==500			; NUMBER OF USERS
NDIST==^D20			; MAXIMUM NUMBER OF DISTRIBUTION LISTS
NHSTTB==2000			;SPACE FOR HOST NAME TABLES
PDLL==100			;LENGTH OF STACK
MAXMSG==^D250000		; MAXIMUM MESSAGE SIZE
USRDUP==0			;INDICATES A DUPLICATE USER
USRTO==1			;INDICATES A "TO" USER
USRCC==2			;INDICATES A "CC" USER
USRFL==3			;INDICATES A FILE ADDRESS (NOT USER)

DEFINE FMSG (MSG)<
	HRROI B,[ASCIZ \MSG\]
	SETZ C,
	SOUT>

;MACRO TO SKIP IF CHAR IN AC ARG IS NEITHER "@" NOR, IF NOTLGF IS SET,
; THE CHAR IN SPATCR.
DEFINE SKPNAT (ARG)<
 TRNE FLG,NTLOGF		;;IS NTLOGF SET?
	 CAME ARG,SPATCR	;;YES.  IS IT THE SPECIAL CHAR?
	CAIN ARG,"@"		;;IS IT "@"
>

;MACRO TO ENCLOSE GROUP OF STATEMENTS SUCH THAT ^O DURING GROUP
; NOT ONLY CLEARS OUTPUT BUFFER, BUT ALSO SKIPS REST OF STATEMENT
; GROUP.
;RESTRICTION: STATEMENT GROUP (STMNTS) CANNOT CONTAIN A NESTED
; "TYPOUT" CALL
DEFINE TYPOUT(STMNTS,%SKPLB)<
 MOVEI A,101			;;EMPTY OUTPUT BUFF 1ST, SO ^O DURING
	DOBE			;;PREVIOUS TYPE WON'T GET THIS TOO
	MOVEM P,SAVEP2
	MOVE R,[XWD 10000,%SKPLB]
	MOVEM R,SUPRET		;;SET DEBRK ADDRESS
	STMNTS
	MOVEI A,101		;;EMPTY OUTPUT BUFF, SO ^O DURING
	DOBE			;THIS WON'T GET NEXT TYPE TOO
%SKPLB:	SETZM SUPRET
	MOVE P,SAVEP2
>

DEFINE CLSALL<
 MOVEI A,400000
	CLZFF
>

DEFINE UNMAP<
 SETO A,
	MOVE B,[400000,,FLAGPG]
	PMAP
>
DEFINE UNMAP1<
 SETO A,
	MOVE B,[400000,,FWDPAG]
	PMAP
>
DEFINE KILLML<
 MOVE A,FLGMLS
	TLNN A,400000		;MAILBOX.EXE FORK ?
	JRST .+8		;NO
	UNMAP1			;YES, KILL IT ALL
	MOVE A,FKMLSV		;FORK HANDLE
	KFORK
	MOVE A,FLMLSV		;JFN
	HRLI A,(1B0)
	CLOSF
	JFCL
	SETZM FLGMLS		;RESET MAILBOX.EXE FLAG
>

ENTVEC:	JRST SNDMSG		;NORMAL STARTING ADDRESS
	JRST GRIPE
	<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT ;VERSIONS FOR TYPEOUT
REPEAT 0,<JRST TTYTRB>
	JRST TPSMSG
	JRST ADDMSG
	JRST TIPGRP
EVECL==.-ENTVEC

; MAIN ROUTINE FOR SNDMSG

SNDMSG:	MOVE P,PDP
	MOVE PTR,[POINT 7,STRING-1,34]
	SETZ FLG,		;CLEAR  FLG
	SETOM SPATCR		; SET TO NO SPECIAL AT CHAR.

; JRST TO HERE FROM TPSMSG (WITH NTLOGF SET AND SPATCR SET UP).
SNDMS1:	PUSHJ P,INIPSI		; INITIALIZE PSI SYSTEM
	PUSHJ P,INITIM		; INITIALIZE TIMER FORK
	PUSHJ P,INITTY		; INITIALIZE TTY MODES
	PUSHJ P,INILH		; INITIALIZE LOCAL HOST STUFF
	SETZM ,FLGMLS		;CLEAR MAILBOX.EXE FLAG
	PUSHJ P,GTUSRT		; GET LIST OF "TO" USERS
	SKIPGE NUSERS		; IF ANY ENTERED, GET "CC" USERS
	PUSHJ P,GTUSRC
	PUSHJ P,GETSBJ		; GET SUBJECT
	PUSHJ P,GETTXT		; GET TEXT OF MESSAGE
	SKIPGE X,NUSERS
	 JRST DUPCHK
SNDULP:	PUSHJ P,GTUSRT		; GET "TO" USERS
	SKIPL NUSERS
	 JRST SNDULP		; IF NONE ENTERED, TRY AGAIN
	PUSHJ P,GTUSRC		; "TO" ENTERED - GET "CC" USERS
DUPCHK:	MOVE X,NUSERS
	MOVE A,[FLAGS,,FLAGS+1]	;ZERO FLAGS
	SETZM FLAGS
	BLT A,FLAGS+777
DUPLUP:	SKIPE HOST(X)		;ONLY CHECK LOCAL ADDRESSES
	 JRST DUPNXT
	MOVX A,RC%EMO		;EXACT MATCH ONLY
	MOVE B,USRTAB(X)
	RCUSR			;GET DIRECTORY NUMBER FOR LOCAL ADR
	 ERJMP DUPNXT
	TXNE A,RC%NOM!RC%AMB	;DID IT MATCH
	JRST DUPNXT		;NO
	HRRZ A,C		;DIRECTORY NUMBER
	IDIVI A,^D36		;SET BIT FLAG CORRESPONDING TO DIR #
	MOVSI C,400000
	MOVN B,B
	ROT C,(B)
	MOVE B,FLAGS(A)
	MOVEI D,USRDUP
	TDOE B,C
	 HRLM D,USRFLG(X)	;FLAG WAS ON -THUS THIS IS A REPEAT
	MOVEM B,FLAGS(A)
DUPNXT:	AOBJN X,DUPLUP
	MOVE X,NUSERS		;SET UP X AGAIN FOR SENDING
	TRZ F,QFILEF		;NO MESSAGES TO FILES QUEUED YET

;WAKEUP ON ALL CHARACTERS
	MOVEI A,100
	RFMOD
	TRO B,17B23
	SFMOD
;Decide whether queue, send, etc.
QSCMD:	MOVE A,DNETTM		;Default is to send, so
	MOVEM A,NETTIM		; initialize net and local wait
	MOVE A,DLOCTM		; times to default values
	MOVEM A,LOCTIM
	HRROI A,[ASCIZ /
Q,S,?,carriage-return: /]
	PSOUT			;Prompt for command
	PUSHJ P,GETCHR		;Get command character
	 JRST KILCMD		;Rubout, kill command
	 JRST SEND		;Carriage return, go to sending
	CAIN A,"?"
	 JRST QSHLP
	CAIN A,"Q"
	 JRST QCMD
	CAIN A,"S"
	 JRST SCMD
	HRROI A,[ASCIZ /Illegal command, type "?" for help./]
	ESOUT			;Illegal command, type error message
	JRST QSCMD		; and try again

KILCMD:	HRROI A,[ASCIZ /XXX/]	;Type XXX and try again
	PSOUT
	JRST QSCMD

QSHLP:	TYPOUT <
	HRROI A,QMSG10
	PSOUT >			;Type help message
	JRST QSCMD		; and get new command

;Subroutine to get command character. Converts to upper case.
;Ignores carriage-return, space, tab.
;Returns +1 if rubout, +2 if linefeed or eol, +3 otherwise
;  with character in 1.
GETCHR:	PBIN			;Get character
	CAIN A,CR
	 JRST GETCHR		;Ignore carriage-return
	CAIN A,CDELLN
	 POPJ P,		;Return +1 if rubout
	CAIN A,LF
	 JRST S1POPJ		;Return +2 if lf or eol
	CAIN A," "
	 JRST GETCHR		;Ignore space
	CAIN A,TAB
	 JRST GETCHR		;Ignore tab
	CAIL A,140
	 SUBI A,40		;Convert lower case to upper
	AOS 0(P)
S1POPJ:	AOS 0(P)
	POPJ P,

QCMD:	HRROI A,[ASCIZ /ueue /]	;Handle Q command
	PSOUT
	SETZ B,			;N not typed
	SETZ C,			;L not typed
QLUP:	PUSHJ P,GETCHR		;Get command char
	 JRST KILCMD		;Rubout, kill command
	 JRST QCR		;Carriage return, finish up
	CAIN A,"N"
	 JRST QN
	CAIN A,"L"
	 JRST QL
	HRROI A,[ASCIZ / ?(N,L,or carriage-return) /]
	PSOUT			;Ignore illegal command
	JRST QLUP
QN:	HRROI A,[ASCIZ /et /]	;N typed
	PSOUT
	SETOB B,NETTIM		;Set net  time to -1 (means queue) and
	JRST QLUP		; remember (in B) that N was typed.
QL:	HRROI A,[ASCIZ /ocal /]	;L typed
	PSOUT
	SETOB C,LOCTIM		;Set local time to -1 (queue) and
	JRST QLUP		; remember (in C) that L was typed
;End of command
QCR:	JUMPN B,SEND		;If either L or N specified, go to
	JUMPN C,SEND		; sending.
	SETOM LOCTIM		;Neither specified - set both
	SETOM NETTIM		; to queue
	JRST SEND		;Then go to sending

SCMD:	HRROI A,[ASCIZ /end /]	;HAndle S command
	PSOUT
	SETO B,			;N not typed
	SETO C,			;L not typed
	SETO D,			;W not typed
SLUP:	PUSHJ P,GETCHR		;Get command char
	 JRST KILCMD		;Rubout, kill command
	 JRST SCR		;Carriage return, finish up
	CAIN A,"N"
	 JRST SN
	CAIN A,"L"
	 JRST SL
	CAIN A,"W"
	 JRST SW
	HRROI A,[ASCIZ / ?(N,L,carriage-return, or W) /]
	PSOUT			;Ignore illegal command
	JRST SLUP
SN:	HRROI A,[ASCIZ /et /]	;N typed
	PSOUT
	MOVE B,DNETTM		;Set net time to default time and
	MOVEM B,NETTIM		; remember in B that this was done.
	JRST SLUP
SL:	HRROI A,[ASCIZ /ocal /]	;L typed
	PSOUT
	MOVE C,DLOCTM		;Set local time to default time and
	MOVEM C,LOCTIM		; remember in C that this was done.
	JRST SLUP
SW:	HRROI A,[ASCIZ /ait time=/] ;W typed
	PSOUT
	PUSH P,B		;Preserve B and C
	PUSH P,C		;(memory of N and L commands)
	MOVEI A,100		;Read base 10 number from tty.
	MOVEI C,^D10
	NIN
	 JRST SWERR		;Error
	JUMPLE B,SWERR		;Must be positive
	MOVEM B,D		;OK, store wait time in D
	BKJFN			;Back up so will process terminator
	 JFCL
SWPOP:	POP P,C			;Restore B and C
	POP P,B
	JRST SLUP
SWERR:	HRROI A,[ASCIZ / ?(must be positive number) /]
	PSOUT			;Error, type msg and ignore
	JRST SWPOP
;End of command
SCR:	JUMPGE B,SCR2		;If either N or L specified, go on
	JUMPGE C,SCR2
	MOVE B,DNETTM		;Neither specified, act as if both N and
	MOVEM B,NETTIM		; L specified
	MOVE C,DLOCTM
	MOVEM C,LOCTIM
SCR2:	JUMPL D,SEND		;If no wait time given, done
	SKIPL B			;If N specifie, store given wait time
	 MOVEM D,NETTIM		; for net time
	SKIPL C			;If L specified, store given wait time
	 MOVEM D,LOCTIM		; for local time
	JRST SEND
; SEND TO ALL USERS

;Set flag telling whether forwarding possible.
SEND:	TRO F,FRWRDF
	MOVE A,FLGMLS
	TLNE A,400000		;MAILBOX.EXE ALREADY THERE?
	JRST SNDLUP		;YEP
	MOVE A,[1B2+1B17]	;NO-See if forwarding program exists
	HRROI B,[ASCIZ /SYS:MAILBOX.EXE/]
	GTJFN
	 TRZA F,FRWRDF		;No forwarding
	RLJFN
	 JFCL

SNDLUP:	MOVE A,USRTAB(X)	;INITIALIZE HOLDU AND HOLDH FOR THIS
	MOVEM A,HOLDU		;ADDRESS - USRTAB(X) AND HOST(X)
	MOVE A,HOST(X)		;MIGHT CHANGE WITH FORWARDING
	MOVEM A,HOLDH
	SETZM REPLY
	MOVEI A,101
	FMSG <
>
	PUSHJ P,OUTUSR
	HLRZ A,USRFLG(X)	;SKIP USER IF DUPLICATE
	CAIN A,USRDUP
	 JRST SNDDUP
	PUSHJ P,MAKHED		; GENERATE HEADING
	SKIPE HOST(X)		; LOCAL?
	 JRST SNDNET		; NO
	PUSHJ P,OPNMSG		; OPEN MAIL.TXT
	 JRST CANT
	 JRST QUEUE
	PUSHJ P,OUTMRK		; OUTPUT DATE AND TIME STAMP
	PUSHJ P,OUTMSG		; PUT OUT MESSAGE
	CLOSF
	 JFCL
	HRROI B,[ASCIZ / -- ok/]
	JRST ENDSND

SNDDUP:	HRROI B,[ASCIZ / --already done/]
	JRST ENDSND

; Send message via network FTP MAIL facility

SNDNET:	SKIPG NETTIM		;IF NETTIM <= 0, JUST QUEUE
	 JRST QUEUE
	TRZ F,NCFRMF
	MOVE A,TIMFRK
	FFORK
	MOVEM P,SAVEP
	MOVEI B,TIMER
	SFORK
	RFORK
	PUSHJ P,DOICP
	 JRST CANT
	 JRST QUEUE
	PUSHJ P,WAITOK
	 JRST QUEUE
REMAIL:	MOVE A,SJFN
	HRROI B,[ASCIZ /MAIL /]
	SETZ C,
	SOUT
	MOVE B,USRTAB(X)
	SOUT
	HRROI B,[ASCIZ /
/]
	SOUT
	MOVEI B,21
	MTOPR
WATMR1:	PUSHJ P,WAITOK
	 JRST WATMRF
	CAMN C,GENDLV
	 JRST [	TRO F,NCFRMF	;SAYS POSSIBLE GENERAL DELIVERY
		JRST FOUR50]
	CAIN C,^D951		;WANTS TO FORWARD?
	JRST MEDOIT		;WE'LL DO IT HERE INSTEAD!!!
	CAME C,GOMAIL
	 JRST WATMR1
WATMRG:	MOVE A,TIMFRK
	FFORK
	MOVEI B,MONITR
	SFORK
	RFORK
	PUSHJ P,OUTMSG
	HRROI B,[ASCIZ /.
/]
	SETZ C,
	SOUT
	MOVEI B,21
	MTOPR
	MOVE A,TIMFRK
	WFORK
	FFORK
	MOVE A,SJFN
	CLOSF
	 JFCL
	MOVE A,RJFN
	 CLOSF
	 JFCL
	HRROI B,[ASCIZ / -- ok/]
	SETZM REPLY
	JRST ENDSND

WATMRF:	CAIN C,^D450		;NO SUCH MAILBOX AT THIS SITE
	JRST [TRZ F,NCFRMF	;NO GEENERAL DELIVRY
		JRST FOUR50]
	CAMN C,NEDLOG
	 JRST MITMUL
FTPERR:	HRLZ D,MNQCOD
	JUMPGE D,CANT
WATMRL:	CAMN C,QCODES(D)
	 JRST QUEUE
	AOBJN D,WATMRL
	JRST CANT

MITMUL:	HRROI B,[ASCIZ /USER NETML
/]
	PUSHJ P,SWTOK		; TRY TO LOGIN
	 JFCL
	CAME C,NEDPAS		; SPECIAL REQUEST FOR PASSWORD
	 JRST CANT		; WELL... WE TRIED
	HRROI B,[ASCIZ /PASS NETML
/]
	PUSHJ P,SWTOK
	 JFCL
	CAME C,LOGOK
	 JRST CANT
	JRST REMAIL

; TRY TO QUEUE THE MESSAGE

QUEUE:	MOVE A,TIMFRK
	FFORK
	PUSHJ P,OPNQUE
	 JRST CANT
	PUSHJ P,OUTMSG
	MOVE A,SJFN
	CLOSF
	 JFCL
	MOVE B,USRTAB(X)	;SET FLAG IF QUEUEING
	ILDB A,B
	CAIN A,FILCHR
	 TRO F,QFILEF
	PUSHJ P,MLFLG
	JRST QUEUE1
	HRROI B,[ASCIZ / -- queued/]
	JRST ENDSND

QUEUE1:	HRROI B,[ASCIZ / -- queued (unable to set flag for immediate processing)/]
	JRST ENDSND

;SET MAILER FLAG
MLFLG:	MOVE A,[400000,,FLAGPG]
	RPACS
	TDNE B,[1B5]		;IF PAGE EXISTS
	TDNE B,[1B10]		;AND NOT PRIVATE
	 SKIPA
	JRST GOTPAG		;IT IS ALREADY MAPPED
	HRROI B,[ASCIZ /<SYSTEM>MAILER.FLAGS.1/]
	MOVSI A,(1B2+1B17)
	GTJFN
	POPJ P,
	PUSH P,A
	MOVEI B,1B19+1B20+1B25
	OPENF
	 JRST [	POP P,A
		RLJFN
		 JFCL
		POPJ P,]
	POP P,A
	HRLZS A
	MOVE B,[400000,,FLAGPG]
	MOVSI C,140000
	PMAP
GOTPAG:	GJINF
	HRRZ C,A		;QUEUE IN LOGIN DIRECTORY
	TRNE FLG,NTLOGF		;IF NOT LOGGED IN,
	HRRZ C,B		; QUEUE IN CONNECTED DIRECTORY
				;NOTE THIS ASSUMES IT IS ON STRUCTURE PS:
	IDIVI C,44
	MOVSI A,400000
	MOVN D,C+1
	ROT A,(D)
	IORM A,FLAGPG*1000(C)
	AOS 0(P)
	POPJ P,

; DONT SEND

DONT:	HRROI B,[ASCIZ / -- didn't/]
	JRST ENDSND

; CAN'T SEND MESSAGE

CANT:	MOVE A,TIMFRK
	FFORK
	TRNE FLG,NTLOGF
	JRST CANT2
	PUSHJ P,OPNUND
	 JRST CANT2
	PUSHJ P,OUTMSG
	MOVE A,SJFN
	CLOSF
	 JFCL
CANT2:	HRROI B,[ASCIZ / -- can't/]
ENDSND:	TRZ F,NCFRMF		;CLEAR GENERAL DELIV. IF ON
	MOVEI A,101
	SETZ C,
	SOUT
	HRROI B,[ASCIZ / --/]
	SETZ C,
	SKIPE REPLY
	SOUT
	HRROI B,REPLY
	SOUT
	MOVE A,[400000,400000]	;DON'T KILL MAILBOX.EXE
	CLZFF
	MOVE A,HOLDU		;RESTORE ORIGINAL CONTENTS INCASE WE 
	MOVEM A,USRTAB(X)	;FORWARDED - THIS KEEPS ALL ADDRESSES
	MOVE A,HOLDH		;CONSISTENT IN ALL MESSAGES EVEN IF MAIL
	MOVEM A,HOST(X)		;DIDN'T ACTUALLY GO THERE.
	AOBJN X,SNDLUP
	KILLML			;WON'T NEED MAILBOX.EXE ANYMORE

;MESSAGE IF ANY MSGS QUEUED TO FILES
	HRROI A,[ASCIZ /
*RUN MAILER TO DELIVER MESSAGES QUEUED FOR * FILES.
*THEY WILL NOT BE DELIVERED AUTOMATICALLY.
/]
	TRNE F,QFILEF
	 PSOUT

IFDEF UTAHSW,<
;KEEPS A COPY OF ALL MESSAGES SENT TO SAVED.MESSAGES IF IT EXISTS
	PUSHJ P,OPNSVD		;OPEN SAVED.MESSAGES
	 JRST ENDS.1		;SAVED.MESSAGES DOES NOT EXIST
	PUSHJ P,MAKHED		;MAKE MESSAGE HEADING ("TO" INSTEAD OF "CC")
	PUSHJ P,OUTMRK		;OUTPUT DATE AND SIZE STAMP
	PUSHJ P,OUTMSG		;OUTPUT THE MESSAGE
	CLOSF			;CLOSE SAVED.MESSAGES
	 JFCL
ENDS.1:
>

	UNMAP
	CLSALL
	HALTF
	JRST SNDMSG
; MAIN GRIPE CODE

GRIPE:	MOVE P,PDP
	MOVE PTR,[POINT 7,STRING-1,34]
	RESET
	SETZ FLG,		;CLEAR  FLG
	SETOM SPATCR		; SET TO NO SPECIAL AT CHAR.
	PUSHJ P,INIPSI
	PUSHJ P,INITTY
GRIPE1:	HRROI A,[ASCIZ /
Griping on subject of /]
	PSOUT
	MOVEI A,[XWD 501000,1
		XWD 100,101
		0

		IFDEF UTAHSW,<POINT 7,[ASCIZ /HELP/]> ;UTAH DIR. FOR
				;GRIPE FILES
		IFNDEF UTAHSW,<POINT 7,[ASCIZ /SYSTEM/]>
		POINT 7,[ASCIZ /GENERAL/]
		POINT 7,[ASCIZ /GRIPES/]
		0
		0
		0
		0]
	SETZ B,
	GTJFN
	 JRST [	HRROI A,[ASCIZ /
No gripe file for that subject, use subsys name or "general"
/]
		PSOUT
		JRST GRIPE1]
	MOVEM A,SJFN
	PUSHJ P,GETTXT
	TRZ F,USEATF		;MAKIHD-DONT INCLUDE SITE IN "FROM"
	PUSHJ P,MAKIHD
	PUSHJ P,MAKEHD
	MOVE A,SJFN
	MOVE B,[7B5+1B22]
	OPENF
	 JRST [	HRROI A,[ASCIZ /
Can't open that file.  Message saved on MAIL.CPY/]
		PSOUT
		CLSALL
		HALTF
		JRST GRIPE]
	PUSHJ P,OUTMRK
	PUSHJ P,OUTMSG
	MOVE A,SJFN
	CLOSF
	 JFCL
	HRROI A,[ASCIZ /
Thank you for your constructive criticism./]
	PSOUT
	CLSALL
	HALTF
	JRST GRIPE

; MAIN CODE FOR GRIPE FOR NON-LOGGED USERS (I.E.TIP USERS)
; SITE NUMBER IN AC1
; USER NAME IN AC10-14 (UP TO 24 CHARS)

TIPGRP:	MOVE P,PDP
	MOVE PTR,[POINT 7,STRING-1,34]
	PUSHJ P,TIPUSE
	SETZM SPATCR
	RESET
	PUSHJ P,INITTY
	SETZM HOSTN		;SET TO NO HOST TABLES
	SETZM HSTNAM		;FOR USE BY MAKIHD IN "FROM.."
	HRROI A,QMSG6
	PSOUT
	SETZ X,
	MOVE B,[POINT 7,[ASCIZ /NCC/]]
	MOVEM B,USRTAB(X)
	MOVE B,[POINT 7,[ASCIZ /BBN/]]
	MOVEM B,HOST(X)
	PUSHJ P,OPNQUE
	JRST [HRROI A,[ASCIZ/
CAN'T GET GRIPE FILE.
PLEASE TRY AGAIN LATER.
/]
		 PSOUT
		 HALTF
		 JRST TIPGRP]
	PUSHJ P,GETSBJ
	PUSHJ P,GETTXT
	TRO F,USEATF		;SET FLAG SO MAKIHD WILL
	PUSHJ P,MAKIHD		;INCLUDE SITE IN "FROM.."
	PUSHJ P,MAKHSB
	PUSHJ P,MAKEHD
	PUSHJ P,OUTMSG
	MOVE A,SJFN
	CLOSF
	JFCL
	PUSHJ P,MLFLG		;SET MAILER FLAGS
	JFCL			;IGNORE FAILURE TO SET FLAGS
	UNMAP
	HRROI A,[ASCIZ /
Thank you for your constructive criticism.
/]
	PSOUT
	CLSALL
	HALTF
	JRST TIPGRP
; DO TTY TROUBLE REPORT

TTYTRB:	MOVE P,PDP
	MOVE PTR,[POINT 7,STRING-1,34]
	RESET
	SETZ FLG,		;CLEAR  FLG
	SETOM SPATCR		; SET TO NO SPECIAL AT CHAR.
	PUSHJ P,INIPSI
	PUSHJ P,INITTY
	SETZ X,
	MOVE B,[POINT 7,TTYMAN]
	MOVEM B,USRTAB(X)
	SETZM HOST(X)
	PUSHJ P,OPNQUE
	 JRST [	HRROI A,[ASCIZ /
TROUBLE FILE NOT AVAILABLE - PLEASE TRY AGAIN LATER/]
		ESOUT
		HALTF
		JRST TTYTRB]

IFDEF UTAHSW,< HRROI A,[ASCIZ /
LOCATION OF TERMINAL & TERMINAL SERIAL # : /]
>

IFNDEF UTAHSW,< HRROI A,[ASCIZ /
LOCATION OF TERMINAL: /]
>

	MOVEM A,PROMPT
	PUSHJ P,GETSB
	HRROI A,[ASCIZ /
DESCRIBE TROUBLE: /]
	MOVEM A,PROMPT
	PUSHJ P,GETTX1
	TRZ F,USEATF		;MAKIHD-DONT INCLUDE SITE IN "FROM"
	PUSHJ P,MAKIHD
	SETZ C,
	HRROI B,[ASCIZ /
LOC'N:/]
	SOUT
	SKIPN B,SUBJCT
	HRROI B,[ASCIZ /NOT STATED/]
	SOUT
	PUSHJ P,MAKEHD
	PUSHJ P,OUTMSG
	MOVE A,SJFN
	CLOSF
	 JFCL
	PUSHJ P,MLFLG
	 JFCL
	UNMAP
	HRROI A,[ASCIZ /
THANK YOU FOR REPORTING YOUR DIFFICULTY.
IT WILL BE INVESTIGATED SHORTLY.
/]
	PSOUT
	HRROI A,[ASCIZ /(Message has been queued for delivery to /]
	PSOUT
	HRROI A,TTYMAN
	PSOUT
	HRROI A,[ASCIZ /)
/]
	PSOUT
	CLSALL
	HALTF
	JRST TTYTRB

; NAME OF TTY REPAIR MAN

IFDEF UTAHSW,<
TTYMAN: ASCIZ /JENSEN/		;UTAH TTY REPAIR MAN
>

IFNDEF UTAHSW,<
TTYMAN:	ASCIZ /PAIGE/
>

; MAIN CODE FOR SNDMSG FOR NON-LOGGED USERS (IE TIP USERS)
; Site number in AC1
; User name in AC10-AC14 (up to 24 chars)

TPSMSG:	MOVE P,PDP
	MOVE PTR,[POINT 7,STRING-1,34]
	PUSHJ P,TIPUSE
	MOVEI A,"%"		;USE % AS SPECIAL AT CHAR
	MOVEM A,SPATCR
	HRROI A,QMSG5
	PSOUT			; GIVE SPECIAL MESSAGE.
	HRROI A,QMSG6
	PSOUT
	JRST SNDMS1		;CONTINUE AS FOR REGULAR ENTRANCE.

TIPUSE:	MOVEM A,SITEN		;SITE ADDR OF USER IN AC 1
	MOVEM PTR,FROMNM	;get user name.
	MOVE A,PTR
	MOVE B,[POINT 7,10]
	SETZ C,
	SOUT
	MOVE PTR,A		;PUT NEW PTR BACK
	IDPB C,PTR		;AND PUT IN ZERO BYTE.
	PUSHJ P,GETSIT		; GET SITE NAME
	MOVEI FLG,NTLOGF	;SET TO "NOT-LOGGED"
	POPJ P,

;GET SITE NAME

GETSIT:	MOVE A,PTR
	MOVEM A,SITE
	MOVE B,SITEN
	MOVEI C,10
	CVHST
	 NOUT			;USE NUMBER IF NAME NOT KNOWN
	 JFCL
	MOVEM A,PTR
	IBP PTR
	POPJ P,
; ADD A MESSAGE TO A GIVEN FILE.
; AC1 - OUTPUT JFN (OF MESSAGE FILE).
; AC2 - B(0)=1 => ADD MESSAGE AT FRONT OF FILE.
;     - B(1)=1 => SUBJECT IN AC7-AC16 (UP TO 39 CHARS)
;     - B(2)=1 => TEXT ON FILE - SEE AC3
;     - B(3)=1 => WAIT IF OUTPUT FILE BUSY
;AC3 - INPUT JFN OF TEXT IF B(2) IN AC2 SET
; ON SUCCESS HALTS WITH JFN IN AC1 (CLOSED BUT NOT RELEASED).
; ON FAILURE, HALTS WITH AC1 NOT CONTAINING JFN.
ADDMSG:	MOVEM SAVACS		;SAVE AC0
	MOVE [XWD 1,SAVACS+1]	;SAVE AC1-AC17
	BLT SAVACS+17
	MOVE P,PDP
	MOVE PTR,[POINT 7,STRING-1,34]
	MOVEM A,SJFN		;SAVE OUTPUT JFN.
	SETZB FLG,F		; Zero all AC flags.
	TLNE B,400000		;SKIP IF NORMAL OUTPUT.
	 TRO FLG,RVRSF		;OUTPUT AT FRONT OF FILE.
	TLNE B,40000
	 TRO FLG,WTBSYF
	TLNE B,200000		;SUBJECT PASSED?
	JRST [TRO FLG,SUBJF	;SET FLAG
		 MOVEM PTR,SUBJCT ;STORE SUBJECT
		 MOVE A,PTR	;COPY IT FROM SAVED AC'S
		 MOVE B,[POINT 7,SAVACS+7]
		 SETZ C,
		 SOUT
		 CAMN PTR,A	;INDICATE NULL SUBJECT
		 SETZM SUBJCT
		 MOVE PTR,A
		 IDPB C,PTR
		 JRST .+1]
	MOVE B,SAVACS+2		;GET PASSED FLAGS
	TLNE B,100000		;TEXT PASSED?
	JRST [	TRO FLG,TEXTF	;SET FLAG
		MOVEM PTR,MSG	;STORE TEXT
		MOVE A,SAVACS+3	;JFN
		MOVE B,[7B5+1B19] ;READ
		OPENF
		 JRST [	SETO A,	;OPENF SHOULDN'T FAIL
			JRST ADDHLT ]
		MOVE B,PTR	;PLACE TO COPY TO
		SETZ C,
		SIN
		MOVE PTR,B
		IDPB C,PTR
		HRLI A,(1B0)	;DON'T RELEASE JFN
		CLOSF		;CLOSE INPUT FILE
		JFCL
		PUSHJ P,GTXTE
		JRST .+1 ]
	SETOM SPATCR		; SET TO NO SPECIAL AT CHAR.
	TRNE FLG,SUBJF
	TRNN FLG,TEXTF
	PUSHJ P,INIPSI
	PUSHJ P,INITTY		;INITIALIZE TTY PARAMS.
	TRNN FLG,SUBJF		;SKIP SUBJECT IF GIVEN ALREADY
	PUSHJ P,GETSBJ		;GET SUBJECT.
	TRNN FLG,TEXTF		;SKIP TEXT IF GIVEN ALREADY
	PUSHJ P,GETTXT		;GET MESSAGE TEXT.
	TRZ F,USEATF		;MAKIHD-DONT INCLUDE SITE IN "FROM"
	PUSHJ P,MAKIHD		;INITIAL PART OF HEADING.
	PUSHJ P,MAKHSB		;SUBJECT.
	PUSHJ P,MAKEHD		;END OF HEADING.
	MOVE A,SJFN
	MOVE B,[7B5+1B22]
	TRNE FLG,RVRSF
	 MOVE B,[7B5+1B19+1B20+1B26] ;R W AND WAIT IF BUSY.
	TRNE FLG,WTBSYF
	 OR B,[1B26]
	OPENF
	 JRST [	SETZ B,
		PUSHJ P,ERRPLY
		HRROI A,REPLY
		PSOUT
		HRROI A,[ASCIZ /
CAN'T OPEN THAT FILE.  MESSAGE SAVED ON MAIL.CPY./]
		PSOUT
		SETO A,		; MARK FAILURE.
		JRST ADDHLT ]
	TRNN FLG,RVRSF
	 JRST ADDMS1		;APPEND MESSAGE.
	MOVEM PTR,ENDPTR	;ADD MESSAGE AT BEGINNING.
	MOVE A,SJFN
	MOVE B,ENDPTR
	MOVNI C,300000
	SIN			;READ WHAT IS THERE ALREADY.
	MOVEM C,OLDCNT		;SAVE COUNT.
	SETZ B,0
	SFPTR			;BACK TO START.
	 JFCL
ADDMS1:	PUSHJ P,OUTMRK		;OUTPUT TIME STAMP.
	PUSHJ P,OUTMSG		;OUTPUT MESSAGE.
	MOVE A,SJFN
	TRNN FLG,RVRSF
	 JRST ADDMS2		;JUST CLOSE IT.
	MOVE B,ENDPTR		;FIRST WRITE OLD CONTENTS.
	MOVNI C,300000
	SUB C,OLDCNT		;GET NEGATIVE BYTE COUNT.
	SOUT
ADDMS2:	HRLI A,(1B0)		; DO NOT RELEASE JFN.
	CLOSF
	 JFCL
	MOVE A,SJFN		; SUCCESS.
ADDHLT:	PUSH P,A
	CLSALL
	POP P,A
	HALTF
	JRST .-1
; USER NAME INSTRUCTIONS

QMSG1:	ASCIZ /
Type user names of the form <user name>@<host name>.  Separate names
with comma, end with carriage return.  Typing just @<host name>
causes that host to apply to subsequent users.  Typing @<null string>
refers to the local host.  Each user's message will indicate to whom
else the message was sent unless a named distribution list is
stated by using <distribution name>:.  E.g. TENEX-users:Tomlinson,... .
If one or more distribution list names are specified, they are used
in place of the user names.  Control-B (STX) may be used to substitute
the contents of a file for typed input.
/
; MESSAGE TYPING INSTRUCTIONS

QMSG2:	ASCIZ /
Your message should be typed in and be terminated with control-Z (SUB).
/

QMSG7:	ASCIZ /
A copy of the text of the message will be saved on the file
MAIL.CPY.nnn;S if you need to send it again.
/
QMSG3:	ASCIZ /
Use the following control characters to edit:
RUBOUT character delete
B (STX) inserts the following file
U (DC1) line delete
R (DC2) retype current line or item
S (DC3) retypes entire text or all items
W (ETB) deletes last word
X (CAN) cancels entire item (start over) - ignored during text input
Z (SUB) terminates input
/

; Subject instructions

QMSG4:	ASCIZ /
The subject should be a one line summary of the message or a null string
ended with carriage return.
/
QMSG5:	ASCIZ /
In the following % may be used instead of @ wherever necessary.
/

QMSG6:	ASCIZ /
^C (Control C) may be used to abort a message.
/

QMSG8:	ASCIZ /
^O (CONTROL O) WILL SUPPRESS TYPEOUT.
/

QMSG9:	ASCIZ \
Choices are:

F-You will be asked to type a file name and to confirm it.  The file
  will be appended to the text you have entered so far.  You then
  continue normal text input.

T-Your text as entered so far will be read into TECO and you can
  proceed to edit it.  You need not give any I/O commands in TECO.
  When you exit TECO (with ";H"), your edited text replaces your
  original text in SNDMSG.  You then continue normal text input.
  The original (unedited) text is saved on MAIL.CPY.nnn;S.
\

QMSG10:	ASCIZ /
The command you give will cause SNDMSG either to try to send the
message immediately or to queue it for later delivery (automatic
delivery by the system MAILER).
Carriage-return terminates the command line.
Rubout aborts the command line.

Basic commands:

 null - i.e. nothing but carriage return - SNDMSG will do whatever
      the default is, currently to send the mail if possible.

 Q -  (queue) - The mail will be queued for all addresses except
      files addressed with "*".

 S -  (send) - The mail will be sent (this is currently the default).

Basic Optional Command Arguments

 S and Q may be followed (on the same line) by:

 N -  (net) - the command applies only to network (non-local) addresses.

 L -  (local) - the command applies only to local addresses.

Other Optional Command Arguments

 S may also be followed (on the same line) by:

 W -  (wait) - to tell SNDMSG how long to wait to be able to send
      the message. You will be asked to enter a (positive) number of
      seconds. SNDMSG will wait that long for: (a) a busy local mailbox
      to become free (default is to not wait at all); (b) a network
      host to give permission to transmit the message (default is
      30 seconds).  Note that if N or L also appears in the S
      command the effect of the W is restricted to net or local mail.
 /
; INTERRUPT STUFF

LEVTAB:	RETPC1
	RETPC1
	RETPC1

CHNTAB:	XWD 1,TIMOUT
	XWD 1,SUPOUT
	XWD 1,MONERR
	REPEAT ^D33,<0>

TIMOUT:	MOVE A,[POINT 7,REPLY]
	HRROI B,[ASCIZ /timed-out/]
	SETZ C,
	SOUT
	MOVE P,[XWD 10000,QUEUE]
	MOVEM P,RETPC1
	MOVE P,SAVEP
	DEBRK

TIMER:	MOVE A,NETTIM
	IMULI A,^D1000
	DISMS
	MOVEI A,777777
	MOVSI B,(1B0)
	IIC
	HALTF

MONITR:	MOVEI P,PDL2-1
	PUSHJ P,WAITOK
	 JRST MONITF
	 CAIE C,^D256
	 JRST MONITR
	HALTF

MONITF:	MOVEI A,777777
	MOVSI B,(1B2)
	IIC
	WAIT

MONERR:	MOVE A,TIMFRK
	FFORK
	MOVEI B,SAVACS
	RFACS
	MOVE C,SAVACS+3
	MOVE P,[XWD 10000,FTPERR]
	MOVEM P,RETPC1
	MOVE P,SAVEP
	DEBRK

;HANDLE ^O INTERRUPT - SUPPRESS TTY OUTPUT
SUPOUT:	PUSH P,A		;SAVE A,B
	PUSH P,B
	MOVEI A,101		;IF OUTPUT BUFFER EMPTY, DO NOTHING
	SOBE
	SKIPA
	JRST SUPDON
	MOVEI A,101		;CLEAR PRIMARY OUTPUT BUFFER
	CFOBF
	MOVEI A,17		;TYPE ^O(EOL)
	PBOUT
	MOVEI A,.CHLFD
	PBOUT
SUPDON:	SKIPN SUPRET		;SPECIAL DEBREAK ADDRESS?
	JRST SUPEND		;NO, JUST DISMISS
	MOVE R,SUPRET		;YES, CLOBBER IT INTO RETURN PC
	MOVEM R,RETPC1
SUPEND:	POP P,B			;RESTORE A,B
	POP P,A
	DEBRK			;DISMISS INTERRUPT
; INITIALIZE PSI SYSTEM

INIPSI:	RESET			; RESET THE WORLD
	MOVEI A,400000		; INITIALIZE INTERRUPT SYSTEM
	MOVE B,[XWD LEVTAB,CHNTAB]
	SIR
	EIR
	MOVSI B,(1B0+1B1+1B2)
	AIC			; TURN ON CHANNELS 0&1&2
	MOVE A,[XWD 17,1]
	TRNN FLG,NTLOGF		;IF LOGGED-IN USER,
	ATI			;ASSIGN ^O TO CHANNEL 1
	SETZM SUPRET
	POPJ P,

; INITIALIZE TIMER FORK

INITIM:	MOVSI A,(1B0+1B1)
	CFORK			; GET A FORK TO DO TIMING
	 HALTF
	MOVEM A,TIMFRK		; REMEMBER FORK HANDLE
	RPCAP			; MAKE IT ABLE TO INTERRUPT ME
	TLO C,(1B9)
	TLO B,(1B9)
	EPCAP
	POPJ P,

; INITIALIZE TTY STUFF

INITTY:	MOVEI A,100		; PRIMARY INPUT
	MOVEM A,INFIL		; IS INITIAL INPUT FILE
	MOVEI A,101		;PRIMARY OUTPU
	MOVE B,[BYTE (2) 1,0,0,1,1,1,1,2,0,3,3,3,3,3,1,1,1,0]
	MOVE C,[BYTE (2) 0,0,1,1,1,0,0,1,1,0,1,1,1,3]
	SFCOC			; NO ECHO ON CONTROL-A,B,H,Q,R,S,W,X ALT
	TRZ F,QUIETF		; TURN ON RESPONSES
	MOVE SF,[XWD -NFILS,FILSTK-1] ; INIT FILE STACK
	POPJ P,

; INITIALIZE LOCAL HOST THINGS

INILH:	MOVE A,[SIXBIT /LHOSTN/]
	SYSGT			; GET LOCAL HOST NUMBER
	JUMPGE B,[SETOM LHOSTN	;NO NET
		POPJ P,]
	MOVEM A,LHOSTN
	MOVE A,PTR
	MOVEM A,LHOST		; GET STRING FOR LOCAL HOST
	MOVE B,LHOSTN		; NUMBER
	MOVEI C,10
	CVHST			; CONVERT TO STRING
	 NOUT			; IF FAILS, USE NUMERIC HOST
	 JFCL
	MOVEM A,PTR		; REST OF STRINGS GO AFTER THIS
	IBP PTR			; SKIP OVER NULL
	MOVEI A,HSTTAB		;INITIAL FREE SPACE POINTER
	MOVEM A,HSTFRE		; ..
	MOVE A,['HOSTN ']
	MOVEI B,HOSTN
	PUSHJ P,SYSGET		;GET THE NUMBERS OF ALL HOSTS
	MOVE A,['HSTNAM']	;AND THE NAMES IN ASCIZ
	MOVEI B,HSTNAM
	PUSHJ P,SYSGET
	POPJ P,
; GET USER LIST

GTUSRT:	MOVSI A,-NDIST
	MOVEM A,XDIST		; POINTER FOR STORING DISTRIBUTION NAMES
	MOVSI X,-NUSRS		; ALLOW ONLY NUSRS USERS
	HRROI A,[ASCIZ /
To (? for help): /]
	MOVEI B,USRTO
	JRST GETUSR

GTUSRC:	HRROI A,[ASCIZ /
cc (? for help): /]
	MOVEI B,USRCC

GETUSR:	MOVEM A,PROMPT
	MOVEM B,USRCAT
	MOVEM X,BX
	MOVE A,XDIST
	MOVEM A,BXDIST
GETUS:	MOVE A,PROMPT
	PSOUT			; PROMPT
	MOVE X,BX
	MOVE A,BXDIST
	MOVEM A,XDIST
	SETZM DEFHST
	SETZM DEFGRP
	TRO F,FULLF		; BREAK ON PUNCT
	TRO F,BLANKF		;IGNORE LEADING AND TRAILING BLANKS
	MOVEM PTR,BPTR
RULUP:	MOVEM PTR,USRTAB(X)	; SAVE BEGINNING OF STRING
	MOVE A,DEFGRP		;GROUP IN RIGHT HALF
	HRL A,USRCAT		; USER CATEGORY IN LEFT HALF
	MOVEM A,USRFLG(X)
	TRZ F,STHSTF
	PUSHJ P,INSTR		; GET USER/HOST NAME
GETUS0:	 JRST [	MOVE PTR,BPTR
		JRST GETUS]
RULUP1:	CAIN A,"?"		; TERMINATOR = ??
	 JRST USRHLP		; YES, PRINT INSTRUCTIONS
	CAIN A,":"		; DISTRIBUTION LIST?
	 JRST USRGRP
	CAIN A,CDELLN		; ABORTED?
RUBOUT:	 JRST [ HRROI A,[ASCIZ /XXX /]
		JRST UFLUSH]	; FLUSH USER
	CAIN A,0
	 JRST [	CAMN EPTR,PTR
	   JRST USRMOR
		MOVEI A,.CHLFD
		JRST .+1 ]
	SKPNAT A		; @ TERMINATOR?
	 JRST [	CAMN EPTR,PTR	;NULL STRING?
		TRO  F,STHSTF	;YES, READ STRING AS PERMANENT HOST
		JRST RUL6 ]	; READ FOREIGN SITE NAME
	CAIE A,.CHLFD
	CAIN A,","
	 JRST [	CAME PTR,EPTR
		 JRST RUL1
		IDPB A,EPTR
		MOVEM EPTR,PTR
		JRST RUL4 ]
	CAIN A,"B"-100		;^B - GET NEW FILE AND CONTINUE
	 JRST [	PUSHJ P,NEWFIL
		JRST USRMOR ]
	CAIN A,FILCHR
	 JRST USRFIL
	CAIE A,33
	JRST UBDTRM
	CAMN PTR,EPTR
	 JRST USRAMB
	SETZ A,			;PREFORM RECOGNITION
	MOVE B,USRTAB(X)	;GET BACK TO BEGINNING OF STRING
	RCUSR
	 ERJMP .+2
	TXNE A,RC%NOM		;NO MATCH
	JRST [SKIPE DEFHST	; IF WE ARE TALKING ABOUT ANOTHER HOST
		JRST USRAMB	; JUST CALL IT AMBIGUOUS
		HRROI A,[ASCIZ / No such local user - Recognition on local users only /]
		JRST BADUS1]	; IF THIS HOST, CALL IT BAD
	TXNE A,RC%AMB		;WAS IT AMBIGUOUS
	JRST USRAMB
	MOVE A,EPTR		; POINTER TO TAIL
	MOVEM B,EPTR		; PASS OVER TAIL
	PUSHJ P,UTAIL		; PRINT TAIL
USRMOR:	PUSHJ P,INSTRC		;GET MORE INPUT
	 JRST GETUS0
	JRST RULUP1

USRAMB:	MOVEI A,7
	PBOUT
	JRST USRMOR

UFLUSH:	PSOUT			;TYPE MSG FROM A
	MOVE PTR,USRTAB(X)	;BACK UP POINTER
	JRST RULUP		;LOOP FOR ANOTHER USER

;TYPE INSTRUCTIONS IN RESPONSE TO "?"
USRHLP:	TYPOUT <
	HRROI A,QMSG1
	PSOUT
	HRROI A,QMSG3
	PSOUT
	HRROI A,QMSG8		;TYPE ^O MESSAGE
	TRNN FLG,NTLOGF		;IF APPROPRIATE
	PSOUT   >
	JRST USRTYP		; AND DO IT AGAIN

USRGRP:	SKIPL B,XDIST
	 JRST [	HRROI A,[ASCIZ / Too many group names /]
		JRST BADUS1 ]
	SETZM DEFGRP
	CAMN PTR,EPTR
	 JRST UGRP2
	MOVE C,USRTAB(X)
	MOVEM C,DIST(B)
	HRLZ C,USRCAT		;USER CATEGORY IN LEFT HALF
	MOVEM C,DSTFLG(B)
	ADD B,[1,,1]
	MOVEM B,XDIST
	HRRZM B,DEFGRP
UGRP2:	IDPB A,EPTR		; KEEP TERMINATOR
	MOVE PTR,EPTR
	JRST RULUP
RUL1:	MOVE B,DEFHST
	MOVEM B,HOST(X)		; REMEMBER DEFAULT
	SKIPE DEFHST
	 JRST RUL63		; SKIP CHECK IF OTHER HOST
	MOVE B,USRTAB(X)
	MOVEM A,SAVTER		; SAVE CHARACTER.
	MOVX A,RC%EMO		;EXACT MATCH ONLY
	RCUSR
	 ERJMP NOLCL
	TXNE A,RC%NOM		;NO MATCH
	JRST NOLCL		;NOT A LOCAL USER
	TXNE A,RC%AMB		;AMBIGUOUS
	JRST [HRROI A,[ASCIZ / Ambiguous local user /]
		JRST BADUS1]
	MOVE A,SAVTER		; RESTORE CHARACTER.
RUL63:	IDPB A,EPTR		; STORE THE TERMINATOR FOR RETYPE
	MOVEM EPTR,PTR		; KEEP THE STRING
	CAIE A,","
	CAIN A,.CHLFD
	SKIPA
UBDTRM:	JRST [	HRROI A,[ASCIZ / Bad terminator /]
		JRST BADUS1 ]
	TRZE F,STHSTF
	JRST [	MOVE B,HOST(X)	;STORE HOST AS DEFAULT
		MOVEM B,DEFHST
		JRST RUL4 ]	;RE-USE SAME SLOT
	AOBJP X,RUL3
RUL4:	CAIN A,","
	JRST RULUP		;COMMAS - CONTINUE GETTING USERS
USREOL:	MOVE A,INFIL		;EOL
	CAIE A,100		;FROM PRIMARY INPUT?
	JRST RULUP		;NO, DON'T TERMINATE USER LIST
	MOVE A,EPTR		;DON'T TERMINATE IF EOL PRECEDED BY COMMA
	BKJFN			;BACK UP
	JFCL
	CAMN A,BPTR		;IF NO PREVIOUS CHARS, EOL TERMINATES
	JRST RUL3
	LDB B,A			;GET PREVIOUS CHAR
	CAIN B,","
	JRST RULUP		;COMMA PRECEDED EOL
RUL3:	HLRE A,X
	ADDI A,NUSRS
	MOVNS A
	HRLZM A,NUSERS
	HLRE A,XDIST
	ADDI A,NDIST
	MOVNS A
	HRLZM A,DISTL
	SETZ C,
	MOVE A,BPTR
DPNULL:	ILDB B,A
	SKPNAT B
	 DPB C,A
	CAIN B,","
	 DPB C,A
	CAIE B,12
	CAIN B,15
	 DPB C,A
	CAIN B,":"
	 DPB C,A
	JUMPN B,DPNULL
	POPJ P,

RUL6:	IDPB A,EPTR		; STORE THE TERMINATOR FOR RETYPE
	MOVEM EPTR,PTR		; KEEP THE STRING
	PUSHJ P,GETHST		; GET HOST NAME
	 JRST GETUS0		; ABORT ALL
	 JRST RUBOUT		; FLUSH WHOLE USER SPEC
	 JRST BADUS1		; FAILURE
	MOVEM B,HOST(X)		; SAVE HOST
	JRST RUL63

GETHST:	PUSHJ P,INSTR		; GET STRING
	 POPJ P,		; GET OUT
	SKIPN A			;REPLACE NULL (EOF)
	 MOVEI A,.CHLFD		; BY EOL
	CAIN A,CDELLN		;LINE DELETE?
	 JRST SKPRET
	CAMN EPTR,PTR
	 JRST [	CAIN A,33
		 JRST AMB33
		SETZ B,		; NULL STRING, USE LOCAL
		JRST SK3RET]
	PUSH P,A		; SAVE TERMINATOR
	MOVE A,PTR		; WHERE TO WRITE RECOGNIZED STRING
	MOVE B,A		; IS ALSO SOURCE
	SETZ C,
	PUSHJ P,HSTSOU		; PERFORM RECOGNITION
	TRNE F,AMBIGF		; AMBIGUOUS?
	 JRST HSTAMB
	TRNN F,MATCHF		; Match found?
	 JRST NOMTCH
GOTHST:	MOVE B,EPTR		; Save where tail starts
	MOVEM A,EPTR		; Update EPTR
	POP P,A			; Get terminator
	CAIE A,33		; ALTMODE?
	 JRST GETHS1
	MOVE A,B		;START OF TAIL
	PUSHJ P,UTAIL		;PRINT TAIL
HSTMOR:	PUSHJ P,INSTRC		;GET MORE INPUT
	JRST GETHST+1
	JRST GETHST+2
GETHS1:	MOVE B,PTR
SK3RET:	AOS 0(P)
SK2RET:	AOS 0(P)
SKPRET:	AOS 0(P)
CPOPJ:	POPJ P,

HSTAMB:	POP P,A			; GET TERMINATOR
	CAIN A,33		; ALTMODE?
AMB33:	 JRST [	MOVEI A,7
		PBOUT		; DING
		JRST HSTMOR ]
	HRROI A,[ASCIZ / Ambiguous host name /]
	JRST SK2RET

NOMTCH:	PUSH P,A		; SAVE POINTER TO END OF HOST NAME
	MOVE A,PTR		; POINTER TO START OF HOST NAME
	MOVEI C,10
	NIN			;TRY INTERPRET NAME AS OCTAL NUMBER
	 JRST HSTBAD		;CAN'T READ AS NUMBER
	LDB C,A			; ALSO BAD IF NUMBER ENDED BY NON-NULL
	 JUMPN C,HSTBAD
	CAILE B,377		;HOST NUMBERS MUST BE LESS THAN 400
	 JRST HSTBAD
	POP P,A			; RESTORE A
	MOVE B,0(P)		;TERMINATING CHARACTER
	CAIE B,33		;IF NOT ALTMODE, NUMBER OK
	 JRST GOTHST
	HRROI A,[ASCIZ /[Can't complete host numbers]/]
	PSOUT
	POP P,A			;POP OFF TERMINATING CHAR
	JRST HSTMOR		;CONTINUE INPUT
HSTBAD:	POP P,A			;RESTORE A
	HRROI A,[ASCIZ / No such host /]
		SUB P,[1,,1]
		JRST SK2RET

BADUSR:	HRROI A,[ASCIZ / /]
BADUS1:	ESOUT
	MOVE A,INFIL
	CAIE A,100
	 JRST [	SETZ C,
		IDPB C,EPTR
		MOVE A,PTR
		PSOUT
		HRROI A,[ASCIZ / -FILE INPUT ABORTED.../]
		PSOUT
		MOVE A,INFIL
		PUSHJ P,ENDFIL
		JRST .+1]
	MOVE PTR,USRTAB(X)
	SETZ C,
	MOVE A,PTR
	IDPB C,A
USRTYP:	MOVE B,PROMPT
	MOVE C,BPTR
	PUSHJ P,RETYPE
	JRST RULUP

;PRINT TAIL ADDED ON BY COMPLETION OF USER OR HOST DUE TO ESC
UTAIL:	CAMN A,EPTR		;A IS TAIL START, EPTR IS END
	HRROI A,[ASCIZ /[Name already complete]/] ;NO TAIL TO TYPE
	PSOUT
	POPJ P,

;HERE IF FIRST CHAR IN USER NAME IS FILCHR - GET A FILE NAME
USRFIL:	TRNE FLG,NTLOGF
	 JRST [HRROI A,[ASCIZ /Non-logged-in users can't send to files/]
		JRST BADUS1]
	IDPB A,EPTR		;SAVE THE FILCHR
	SETZM HOST(X)		;HOST IS ALWAYS LOCAL FOR FILES
	MOVE A,USRFLG(X)	;SET CATEGORY TO FILE
	HRLI A,USRFL
	MOVEM A,USRFLG(X)
	GJINF			;SET UP DEFAULT DIRECTORY TO BE LOGGED-IN
	MOVE B,A		;LOGGED-IN DIR
	HRROI A,LOGDIR		;WHERE TO WRITE DIR NAME
	DIRST			;WRITE IT
	 JRST [	HRROI A,[ASCIZ /Unable to set up default directory/]
		JRST BADUS1 ]
	MOVE A,INFIL		;SET UP I/O JFN FOR GTJFN
	CAIE A,100		;INPUT IS INFIL,
	 SKIPA A,[377777]	;OUTPUT IS 101 IF INFIL=100, NIL OTHERWISE
	MOVEI A,101
	HRL A,INFIL
	MOVEM A,FILJFN+1
	SETZ B,			;NO STRING FOR THIS GTJFN
	MOVEI A,FILJFN		;ARGUMENT BLOCK
	GTJFN
	 JRST [	PUSH P,A	;SAVE ERROR CODE
		MOVE A,INFIL	;GET FILE STATUS OF INPUT
		GTSTS
		POP P,A
		MOVEM B,C	;STATUS NOW IN C
		SETZ B,
		CAIN A,GJFX4	;ILLEGAL CHAR?
		TLNN C,1000	;EOF?
		 SKIPA		;NOT ILL CH OR EOF
		HRROI B,[ASCIZ / Terminating character required after file name, before end of file./]
		PUSHJ P,ERRPLY
		HRROI A,REPLY
		JRST BADUS1 ]
	MOVEM A,USRJFN		;SAVE JFN
;WRITE COMPLETE FILE NAME INCLUDING VERSION INTO STRING AT EPTR
; AND UPDATE EPTR - OMIT DIRECTORY IF DIR=CONNECTED=LOGGED-IN
	SETZ C,			;DEV,DIR,NAME,EXT,VER,PUNCT
	MOVE A,EPTR		;WHERE TO WRITE NAME
	HRRZ B,USRJFN		;JFN OF FILE
	JFNS
	MOVEM A,EPTR		;UPDATE EPTR
	SETZ B,			;END WITH A NULL
	IDPB B,A
	MOVE A,USRJFN
	RLJFN			;RELEASE THE JFN. DON'T NEED IT NOW.
	 JFCL
	MOVE A,INFIL		;READ CHAR THAT TERMINATED FILE NAME
	BKJFN
	 JFCL
	MOVEI A,100		;WAKE UP ON ALL CHARS
	RFMOD
	TRO B,17B23
	SFMOD
	TRZA F,FRSTCH		;HAVEN'T PROCESSED CHAR THAT TERMINATED GTJFN
TRMLUP:	TRO F,FRSTCH
	PUSHJ P,.BIN
	CAIN A,CRTYPE		;^R - RETYPE FILE NAME
	 JRST [	SETZ B,		;NO PROMPT
		MOVE C,PTR	;STRING TO RETYPE
		PUSHJ P,RETYPE
		JRST TRMLUP]	;LOOP FOR REAL TERMINATOR
	CAIN A,"S"-100		;^S - RETYPE ADDRESS LIST
	 JRST [	MOVE B,PROMPT
		MOVE C,BPTR
		PUSHJ P,RETYPE
		JRST TRMLUP]	;LOOP FOR REAL TERMINATOR
	CAIN A,CDELLN		;^Q - DELETE FILE NAME
	 JRST [	HRROI A,[ASCIZ /_
/]
		JRST UFLUSH ]
	CAIN A,"X"-100		;^X - DELETE ADDRESS LIST
	 JRST GETUS0
	CAIN A,CDELLN
	 JRST RUBOUT
	CAIE A," "		;IGNORE SPACES
	CAIN A,CR		;AND CARRIAGE RETURNS
	 JRST TRMLUP
	CAIN A,33		;ALTMODE
	 JRST [	TRNN F,FRSTCH
		 JRST TRMLUP	;IGNORE IF WAS GTJFN TERMINATOR
		MOVEI A,7	;OTHEWISE DING THEN IGNORE
		PBOUT
		JRST TRMLUP ]
	CAIE A,0		;TREAT EOF AND LF AS EOL
	CAIN A,LF
	 MOVEI A,.CHLFD
	JRST RUL63		;OK, CONSIDER CHAR A FIELD TERMINATOR


;FATAL ERROR ROUTINE

FATERR:	MOVEI A,.PRIOU		;GIVE HIM THE MESSAGE
	MOVE B,[400000,,-1]	;THIS FORK LAST ERROR
	SETZ C,
	ERSTR
	JFCL
	JFCL
	HALT
	JRST SNDMSG
; GET SUBJECT LINE

GETSBJ:	HRROI A,[ASCIZ /
Subject: /]
	MOVEM A,PROMPT
GETSB:	MOVE A,PROMPT
	PSOUT
GETSB0:	MOVEM PTR,BPTR
	MOVEM PTR,SUBJCT
	TRO F,FULLF
	TRZ F,BLANKF		;NO SPECIAL TREATMENT OF BLANKS
	PUSHJ P,INSTR
GETSB2:	 JRST [	MOVE PTR,BPTR
		JRST GETSB]
	CAIN A,"?"
	 JRST SBJHLP
	CAIN A,CDELLN
	 JRST [	HRROI A,[ASCIZ /XXX/]
		PSOUT
		JRST GETSB]
	CAIE A,33
	CAIN A,0
	 JRST SBJMOR		;IGNORE NULL & ALTMODE
	CAIN A,"B"-100		;^B - GET NEW FILE AND CONTINUE
	 JRST [	PUSHJ P,NEWFIL
		JRST SBJMOR ]
	CAIE A,.CHLFD
	 JRST SBJSAV
	CAMN PTR,EPTR
	 SETZM SUBJCT		; MARK NULL SUBJECT THIS WAY
	MOVEM EPTR,PTR
	IBP PTR
	POPJ P,

SBJSAV:	IDPB A,EPTR		;SAVE CHAR
SBJMOR:	PUSH P,[GETSB2]		;CONTINUE GATHERING STRING
	JRST INSTRC

SBJHLP:	TYPOUT <
	HRROI A,QMSG4
	PSOUT   >
	JRST GETSB
; GET THE TEXT OF A MESSAGE

GETTXT:	HRROI A,[ASCIZ /
Message (? for help):
/]
	MOVEM A,PROMPT
GETTX1:	MOVE A,PROMPT
	PSOUT
GETTX0:	MOVEM PTR,MSG
	MOVEM PTR,BPTR
	TRZ F,FULLF
	TRZ F,BLANKF		;NO SPECIAL TREATMENT OF BLANKS
	PUSHJ P,INSTR
GETTX:	 JRST GETTXT
	CAIE A,0
	CAIN A,CDELLN
TXTMOR:	 JRST [	PUSH P,[GETTX]
		JRST INSTRC]
	CAIN A,"B"-100
	 JRST TXCTLB
	CAIN A,"?"
	 JRST TXTHLP
	MOVEI A,.CHLFD
	PBOUT
	LDB A,EPTR		; IS THERE A LF
	CAIE A,12		; AT THE END?
	 JRST [	MOVE A,EPTR	; NO
		HRROI B,[ASCIZ /
/]
		SETZ C,
		SOUT		; PUT ONE THERE
		MOVEM A,EPTR
		JRST .+1]
	MOVEM EPTR,PTR
	IBP PTR
	PUSHJ P,MAKCPY
	POPJ P,

;SUBROUTINE TO SAVE TEXT ON MAIL.CPY.N;T
;STORES JFN (UNRELEASED) AT MSGJFN, -1 IF FAILED
MAKCPY:	PUSH P,[1]
GMCLP:	MOVSI A,(1B0!1B1!1B5!1B17)
	HRR A,0(P)
	HRROI B,[ASCIZ /MAIL.CPY;P770000/]
	GTJFN
	 JRST [	AOS A,0(P)
		CAIG A,100
		 JRST GMCLP
		POP P,A
		JRST NOCOPY]
	MOVEM A,0(P)
	MOVE B,[XWD 70000,100000]
	OPENF
	 JRST [	POP P,A
		RLJFN
		 JFCL
		JRST NOCOPY]
	MOVE B,MSG
	SETZ C,
	SOUT
	POP P,A
	MOVEM A,MSGJFN		;SAVE JFN
	TLO A,400000		;DON'T RELEASE JFN WHEN CLOSE
	CLOSF
	 JFCL
	JRST GTXTE
NOCOPY:	HRROI A,[ASCIZ /
Unable to save message on MAIL.CPY -
/]
	PSOUT
	SETOM MSGJFN		;NO MAIL.CPY - JFN=-1
	MOVEI A,101
	HRLOI B,400000
	SETZ C,
	ERSTR
	JFCL
	JFCL
GTXTE:	MOVE A,MSG
	PUSHJ P,CNTMSG		; COUNT LENGTH OF MESSAGE
	MOVEM B,MSGLEN		; SAVE
	POPJ P,

;TYPE INSTRUCTIONS IN RESPONSE TO "?"
TXTHLP:	TYPOUT <
	HRROI A,QMSG2
	PSOUT
	HRROI A,QMSG7
	TRNN FLG,NTLOGF
	PSOUT
	HRROI A,QMSG3
	PSOUT
	HRROI A,QMSG8		;TYPE ^O MESSAGE
	TRNN FLG,NTLOGF		;IF APPROPRIATE
	PSOUT   >
	JRST GETTX1

;HELP MESSAGE FOR ^B CHOICE
TXHLP2:	TYPOUT <
	HRROI A,QMSG9
	PSOUT   >
	JRST CTLBQ

;HANDLE ^B
TXCTLB:	PUSHJ P,PRMTTY
TXNEWF:	JRST [	PUSHJ P,NEWFIL
		JRST TXTMOR  ]
   IFN TECSUB,<
	TRNE FLG,NTLOGF
	 JRST TXNEWF
  >
   IFE TECSUB,<
	JFCL
	 JRST TXNEWF
   >
CTLBQ:	HRROI A,[ASCIZ /
(Insert File or Invoke TECO (F, T, or ?)? /]
	PSOUT
	MOVEI A,100
	RFMOD
	TRO B,17B23
	SFMOD			;WAKE UP ON ALL CHARS
	PBIN
	CAIL A,140		;CONVERT TO UPPER CASE
	 SUBI A,40
	MOVEM A,B
	HRROI A,[ASCIZ /)
/]
	PSOUT
	CAIN B,"?"
	 JRST TXHLP2
	CAIN B,"F"
	 JRST TXNEWF
	CAIE B,"T"
	 JRST TXTMOR

;WRITE TEXT ONTO MAIL.CPY.N;S
	PUSHJ P,MAKCPY
	SKIPGE MSGJFN		;SUCCEEDED?
	 JRST [	HRROI A,[ASCIZ /(? CANNOT INVOKE EDITOR)/]
		PSOUT
		JRST TXTMOR ]
;GET JFN FOR EDITOR (TECO)
	MOVE A,[1B2+1B17]	;OLD FILE
	HRROI B,[ASCIZ /SYS:TECO.EXE/]
	GTJFN
	 JRST [	HRROI A,[ASCIZ /(? UNABLE TO GET SYS:TECO.EXE)/]
		PSOUT
		JRST TXTMOR ]
	MOVEM A,EDJFN		;SAVE JFN
;CREATE FORK FOR EDITOR
	MOVE A,[1B1]		;PASS DOWN CAPABILITIES
	CFORK
	 JRST [	MOVE A,EDJFN
		RLJFN
		 JFCL
		HRROI A,[ASCIZ /(? UNABLE TO CREATE FORK FOR EDITOR)/]
		PSOUT
		JRST TXTMOR]
	MOVEM A,EDFRKH		;SAVE FORK HANDLE
;GET EDITOR INTO FORK
	HRL A,A			;FORK HANDLE
	HRR A,EDJFN		;EDITOR JFN
	GET
;SET UP FOR AND RUN EDITOR
	MOVE A,MSGJFN		;JFN OF TEXT FILE IN AC1
	MOVEM A,SAVACS+1
	MOVE A,EDFRKH		;FORK HANDLE
	MOVEI B,2		;ENTRY 2
	PUSHJ P,RUNFRK		;RUN IT
	 JRST EDBAD		;FAILURE RETURN
;EDITOR RAN OK, NOW GET EDITED TEXT
;RUN SPECIAL EDITOR ENTRY TO RETURN TEXT LOCATION
	MOVE A,EDFRKH
	MOVEI B,3		;ENTRY 3
	PUSHJ P,RUNFRK
	 JRST EDBAD		;CANT FIND OUT WHERE TEXT IS
;AC2 POINTS TO START OF TEXT, AC3 TO END (IN EDITOR ADDRESS SPACE)
;AC1 TELLS WHAT FORM AC2, AC3, TEXT ARE IN
	MOVE A,SAVACS+1		;INTERPRETATION CODE
	CAIN A,1
;AC1=1 - AC2 AND AC3 ARE CHAR ADDRESSES OF BEGINNING AND END OF TEXT
; ALSO, TEXT CONTAINS EOL INSTEAD OF CRLF
	 JRST [	TRO F,EDEOLF	;MUST CONVERT EOL TO CRLF
		JRST EDTXT ]
;AC1=2 - AC2 AND AC3 ARE CHAR ADDRESSES OF BEGINNING AND END OF TEXT
; TEXT CONTAINS CRLF
	CAIN A,2
	 JRST [	TRZ F,EDEOLF	;DON'T CONVERT EOL TO CRLF
		JRST EDTXT ]
	 JRST [	HRROI A,[ASCIZ /(? EDITOR RETURNED INFO IN WRONG FORM)/]
		JRST EDBAD]
EDTXT:	MOVE EPTR,BPTR		;WHERE TO WRITE TEXT
	MOVE B,SAVACS+2		;CHAR ADRR OF 1ST CHAR
	CAML B,SAVACS+3		;ANY CHARS? (START<END)
	 JRST EDTDON		;NO, DONE ALREADY
	IDIVI B,5000		;5000 CHARS/PAGE
	MOVEM B,SAVACS+4	;PAGE # STARTS AT IN EDITOR
	MOVEM C,SAVACS+2	;START CHAR RELATIVE TO START PAGE
	IMULI B,5000
	MOVE C,SAVACS+3		;CHAR ADR PAST LAST CHAR
	SUB C,B
	MOVEM C,SAVACS+3	;END CHAR RELATIVE TO START PAGE
;MAP NEXT PAGE FROM EDITOR
EDTLUP:	MOVE A,SAVACS+4		;PAGE IN EDITOR
	HRL A,EDFRKH		;EDITOR FORK HANDLE
	MOVE B,[400000,,FLAGPG]	;WINDOW PAGE IN SNDMSG
	MOVE C,[1B2]		;READ ONLY
	PMAP			;MAP THE PAGE
; CONSTRUCT START BYTE POINTER IN B
	MOVE C,SAVACS+2		;START CHAR
	IDIVI C,5		;C=WORD#,D=BYTE#
	MOVEI B,FLAGPG*1000	;START OF PAGE
	ADD B,C			;ADD RELATIVE WORD IN PAGE
	MOVEI A,7
	DPB A,[POINT 6,B,11]	;BYTE SIZE=7
	MOVEI A,^D36
	IMULI D,7
	SUB A,D
	DPB A,[POINT 6,B,5]	;POSITION OF BYTE
	MOVE C,SAVACS+3		;END CHAR
	CAILE C,5000		;WITHIN CURRENT PAGE?
	 MOVEI C,5000		;NO, ONLY GO TO END OF PAGE
	SUB C,SAVACS+2		;# OF CHARS TO GET FROM THIS PAGE
	TRNN F,EDEOLF		;IF NEEDN'T SEARCH FOR EOL,
	 MOVN C,C		; USE NEG # OF CHARS
	MOVE A,EPTR		;WHERE TO WRITE STRING
EDTLP2:	MOVEI D,.CHLFD		;TERMINATE ON EOL
	SOUT			;COPY THRU EOL, OR MAX # CHARS
NOTEOL:	JUMPN C,EDTLP2		;IF CHARS REMAIN, COPY MORE
	MOVEM A,EPTR		;USED UP PAGE - SAVE WRITE ADR
;SET UP TO COPY NEXT PAGE
	AOS SAVACS+4		;NEXT PAGE #
	SETZM SAVACS+2		;START CHAR IS BEGINNING OF NEW PAGE
	MOVE C,SAVACS+3		;NEW END CHAR IS 1 PAGE CLOSER THAN WAS
	SUBI C,5000		;5000 CHARS IN A PAGE
	MOVEM C,SAVACS+3
	JUMPG C,EDTLUP		;IF CHARS REMAIN, GO ON TO NEXT PAGE
EDTDON:	MOVE A,EPTR
	SETZ C,			;DONE, PUT NULL AT END
	IDPB C,A
	SETO A,			;REMOVE EDITOR PAGE FROM SNDMSG MAP
	MOVE B,[400000,,FLAGPG]
	PMAP
;CLEAN UP AFTER EDITING AND CONTINUE TEXT INPUT
EDCLEN:	MOVE A,EDFRKH		;KILL EDITOR FORK
	KFORK
	MOVE A,EDJFN
	RLJFN
	 JFCL
	HRROI A,[ASCIZ /(CONTINUE NORMAL TEXT INPUT)/]
	PSOUT
	JRST TXTMOR		;CONTINUE INPUT
;
;SOMETHING FAILED
EDBAD:	PSOUT			;REASON FOR FAILURE IS IN A
	HRROI A,[ASCIZ /(EDITING ABORTED)/]
	PSOUT
	JRST EDCLEN

;SUBROUTINE TO RUN EDITOR FORK -
;ACCEPTS IN 1 - FORK HANDLE
;        IN 2 - RELATIVE ENTRY POINT TO START AT
;RETURNS +1 IF ERROR, ERROR STRING IN 1
;        +2 IF SUCCESS
;CLOBBERS ACS 1,2,3
;SETS FORK ACS FROM SAVACS AND UPDATES THEM ON RETURN
;SAVES AND RESTORES MODE OF PRIM INP AND COC OF PRIM OUT FILES.
RUNFRK:	PUSH P,B		;ENTRY POINT
	PUSH P,A		;FORK HANDLE
	MOVEI A,100		;SAVE MODE OF PRIMARY INPUT
	RFMOD
	MOVEM B,SAVMOD
	MOVEI A,101		;SAVE COC WORDS OF PRIMARY OUTPUT
	RFCOC
	MOVEM B,SAVCOC
	MOVEM C,SAVCOC+1
	POP P,A			;FORK HANDLE
	MOVEI B,SAVACS
	SFACS			;SET FORK ACS FROM SAVACS
	GEVEC			;CHECK IF FORK HAS DESIRED ENTRY
	HLRZ C,B		;LENGTH OF ENT VEC
	POP P,B			;DESIRED ENTRY
	CAML B,C
	 JRST [	HRROI A,[ASCIZ /(? EDITOR LACKS REQUIRED ENTRY POINT)/]
		POPJ P, ]
	SFRKV			;START FORK
	WFORK			;WAIT FOR FORK TO TERMINATE
	PUSH P,A
	MOVEI A,100		;RESTORE MODE OF PRIMARY INPUT
	MOVE B,SAVMOD
	SFMOD
	MOVEI A,101		;RESTORE COC WORDS OF PRIMARY OUTPUT
	MOVE B,SAVCOC
	MOVE C,SAVCOC+1
	SFCOC
	POP P,A
	MOVEI B,SAVACS
	RFACS			;GET FORK ACS
	RFSTS
	HLRZ B,A		;REASON FOR TERMINATION
	CAIE B,2		;VOLUNTARY?
	 JRST [	HRROI A,[ASCIZ /(? EDITOR TERMINATED INVOLUNTARILY)/]
		POPJ P,  ]
	AOS 0(P)		;SKIP RETURN
	POPJ P,
; OPEN MAIL.TXT FILE

OPNMSG:	MOVE D,LOCTIM
	MOVE B,USRTAB(X)	;DOES ADDRESS START WITH FILCHR?
	ILDB A,B
	CAIN A,FILCHR
	 JRST [	MOVE A,[1B2+1B17] ;YES, SPECIAL FILE,
		JRST OPNMS1 ]	;NOT MAIL.TXT
	JUMPL D,OPMSK1		;IF LOCTIM<0, JUST QUEUE
	MOVE A,PTR
	HRROI B,[ASCIZ /PS:</]	;ALL MAIBOXES ARE ON PS:
	SETZ C,
	SOUT
	MOVE B,USRTAB(X)
	SETZ C,
	SOUT
	HRROI B,[ASCIZ />MAIL.TXT.1/]
	SOUT
	MOVE B,PTR
	MOVSI A,101001
OPNMS1:	MOVEM A,SAVACS+1
	MOVEM B,SAVACS+2	;SAVE GTJFN ARGS
OPMLUP:	MOVE A,SAVACS+1		;GET GTJFN ARGS
	MOVE B,SAVACS+2
	GTJFN
	 JRST OPNMER
	MOVEM A,SJFN
	HRLI A,.FBCTL		;CHANGE CONTROL WORD
	MOVX B,FB%DEL!FB%PRM	;CHANGE DELETED AND PERM. BITS
	MOVX C,FB%PRM		;SET DELETED TO ZERO, PERM. TO 1
	CHFDB			;UNDELETE FILE
	ERJMP .+1		;IGNORE ERRORS
OPNMS2:	MOVE A,SJFN
	MOVE B,[7B5+1B22]
	OPENF
	 JRST [	PUSH P,A
		MOVE A,SJFN
		RLJFN
		 JFCL
		POP P,A
		CAIN A,OPNX9
		SOJGE D,[MOVEI A,^D1000
			DISMS
			JRST OPMLUP ]
		JRST OPNMER]
	AOS 0(P)
OPMSK1:	AOS 0(P)
	POPJ P,

;Error replies for OPNMSG
OPNMER:	SETZ B,
	CAIN A,GJFX17
	 HRROI B,[ASCIZ /No such user./]
	CAIN A,GJFX24
	 HRROI B,[ASCIZ /No such mailbox./]
	CAIN A,GJFX35
	 HRROI B,[ASCIZ /Can't access directory now./]
	CAIE A,OPNX23
	CAIN A,OPNX6
	 HRROI B,[ASCIZ /Can't access mailbox now./]
	CAIN A,OPNX9
	 HRROI B,[ASCIZ /Mailbox busy./]
;SKIP TO QUEUE
	CAIE A,OPNX9		;IF FILE BUSY
	CAIN A,OPNX10		;OR NO ROOM
	 JRST OPNMEQ		;Queue - skip return
	MOVE C,USRTAB(X)
	ILDB C,C
	CAIN C,FILCHR		;To file, that's all.
	 JRST ERRPLY
	CAIE A,GJFX35		;ACCESS FAILURES-PLUG IN LOCAL HOST
	CAIN A,OPNX6		;NAME AND TRY OVER NET
	SKIPA
	CAIN A,OPNX23
	JRST [MOVE A,[440700,,STRING] ;LOCAL HOST NAME
		MOVEM A,HOST(X)
		POP P,A		;DON'T NEED THIS STUFF
		JRST SNDNET]
	TRNN F,FRWRDF
	 JRST ERRPLY		;No forwarding
	CAIE A,GJFX17
	CAIN A,GJFX24
	 SKIPA
	JRST ERRPLY		;Forwarding not appropriate.
	CAIN A,GJFX17		;Forwarding appropriate,
	SKIPA
	CAIN A,GJFX24		;SEE IF IN MAILFWDING DATABASE
	JRST [SETZ A,
		TRO A,1
		HRRM A,FLGMLS	;SAYS FROM OPNMER
		JRST NOLCL]
OPNMEQ:	AOS 0(P)		;Skip return
	JRST ERRPLY

;WRITE STRING IN B INTO REPLY.  IF B IS 0,
;WRITE ERROR STRING FOR ERR CODE IN A INTO REPLY
ERRPLY:	JUMPE B,ERRPL2
	HRROI A,REPLY
	SETZ C,
	SOUT
	POPJ P,
ERRPL2:	MOVE B,A		;ERROR CODE
	HRLI B,400000		;THIS FORK
	HRROI A,REPLY		;STRING DESTINATION
	SETZ C,
	ERSTR			;ERROR STRING
	 JFCL			;IGNORE FAILURE
	 JFCL
	IDPB C,A		; END WITH NULL
	POPJ P,

IFDEF UTAHSW,<
;OPEN SAVED.MESSAGES FILE
OPNSVD:	HRROI B,[ASCIZ /SAVED.MESSAGES /]
	MOVSI A,(1B2!1B17)
	GTJFN
	 POPJ P,0
	MOVEM A,SJFN
	MOVE B,[7B5!1B22!1B26]
	OPENF
	 JRST [MOVE A,SJFN	;CAN'T OPEN SAVED.MESSAGES
		RLJFN
		 JFCL
		POPJ P,0]
	AOS 0(P)
	POPJ P,0		;SUCCESSFUL, NORMAL RETURN
>

; OPEN UNDELIVERABLE FILE
OPNUND:	HRROI B,[ASCIZ '/UNDELIVERABLE-MAIL/.']
	JRST OPNQU2

; OPEN QUEUE FILE
OPNQUE:	HRROI B,[ASCIZ /[--UNSENT-MAIL--]./]

OPNQU2:	PUSH P,B
	GJINF			;QUEUE IN LOGIN DIRECTORY
	TRNE FLG,NTLOGF		;IF LOGGED IN, OTHERWISE
	 JRST [DIRST		;IN CONNECTED DIRECTORY
		 JRST [	POP P,B
			 POPJ P,]
		JRST OPNQU3]
	PUSH P,A		;LOGGED IN USER NUMBER
	MOVE A,PTR
	HRROI B,[ASCIZ /PS:</]
	SETZ C,
	SOUT
	POP P,B			;LOGGED IN USER NUMBER
	DIRST
	 JRST [	POP P,B
		 POPJ P,]
	MOVEI C,">"
	IDPB C,A
OPNQU3:	POP P,B
	SETZ C,
	SOUT
	MOVE B,USRTAB(X)
	MOVEI D,"V"-100
OPNQUL:	ILDB C,B
	CAIL C,"A"
	CAILE C,"Z"
	 JRST [	CAIL C,"0"
		CAILE C,"9"
		 IDPB D,A
		JRST .+1]
	IDPB C,A
	JUMPN C,OPNQUL
	MOVEI B,"@"
	DPB B,A
	SKIPE B,HOST(X)
	PUSHJ P,HSTSOU		;COMPLETE HOST NAME THEN SOUT
	HRROI B,[ASCIZ /;P770000/]
	SOUT
	MOVE B,PTR
	MOVSI A,400001
	GTJFN
	 POPJ P,
	MOVEM A,SJFN
	HRLI A,.FBBYV		;SET UP TO SET RENTION COUNT TO 0
	MOVX B,FB%RET
	SETZ C,
	CHFDB
	 ERJMP .+1
	MOVE A,SJFN
	MOVE B,[70000,,100000]
	OPENF
	 JRST [	MOVE A,SJFN
		RLJFN
		 JFCL
		POPJ P,]
	AOS 0(P)
	POPJ P,
; OUTPUT USER NAME AT SITE STRING

OUTUSR:	SETZ C,
	MOVE B,USRTAB(X)
	SOUT
	SKIPN HOST(X)
	 POPJ P,
	HRROI B,[ASCIZ / at /]
	SOUT
	MOVE B,HOST(X)
	PUSHJ P,HSTSOU		;COMPLETE HOST NAME THEN SOUT
	POPJ P,

; DO ICP TO FTP

DOICP:	MOVE A,PTR
	HRROI B,[ASCIZ /NET:0./]
	SETZ C,
	SOUT
	MOVE B,HOST(X)
	PUSHJ P,HSTSOU		;COMPLETE HOST NAME THEN SOUT
	MOVN B,FTPSKT
	MOVEI C,8
	NOUT
	 HALT
	HRROI B,[ASCIZ /;T/]
	SETZ C,
	SOUT
	MOVE B,PTR
	MOVSI A,1
	GTJFN
	 JRST ICPERR		; NO SKIP -- NO SUCH HOST
	AOS 0(P)		; AT LEAST ONE SKIP FROM HERE
	MOVEM A,SJFN
	MOVE B,[XWD 400000,200000]
	OPENF
	 JRST ICPERR
	BIN
	MOVEM B,FSKT
	CLOSF
	 JFCL
	MOVE A,PTR
	HRROI B,[ASCIZ /NET:2./]
	SETZ C,
	SOUT
	MOVE B,HOST(X)
	SOUT
	MOVN B,FSKT
	MOVEI C,10
	NOUT
	 JFCL
	HRROI B,[ASCIZ /;T/]
	SETZ C,
	SOUT
	MOVE B,PTR
	MOVSI A,1
	GTJFN
	 JRST ICPERR
	MOVEM A,SJFN
	MOVE B,PTR
	MOVSI A,1
	GTJFN
	 JRST ICPERR
	MOVEM A,RJFN
	MOVE B,[XWD 103400,200000]
	OPENF
	 JRST ICPERR
	MOVE A,SJFN
	MOVE B,[XWD 102400,100000]
	OPENF
	 JRST ICPERR
	AOS 0(P)
	POPJ P,

;Error replies for DOICP
ICPERR:	SETZ B,
	CAIN A,GJFX19
	 HRROI B,[ASCIZ /No such host./]
	CAIN A,OPNX20
	 HRROI B,[ASCIZ /Host not responding./]
	CAIN A,OPNX21
	 HRROI B,[ASCIZ /Host refusing connection./]
	CAIN A,OPNX9
	 SKIPA
	CAIN A,OPNX10
	 HRROI B,[ASCIZ /Connection table problem./]
	JRST ERRPLY
;HSTSOU - HOST SOUT ROUTINE - COMPLETES HOST NAMES AND DOES SOUT

HSTSOU:	SKIPE HOSTN		;DID THE TABLES READ OK?
	SKIPN HSTNAM		; ..
	JRST SOUTPJ		;NO. JUST SOUT AS IT STANDS
	PUSH P,A		;DESTINATION STRING
	PUSH P,B		;SOURCE STRING TO RECOGNIZE
	PUSH P,C		;COUPLE AC'S FOR TEMPS
	PUSH P,D		; ..
	PUSH P,X		;WILL USE AS COUNTER THRU TABLE
	TRZ F,AMBIGF!MATCHF	;INITIALIZE NOT AMBIGUOUS OR MATCHED
	MOVE X,HOSTN		;POINTER TO HOST NUMBERS AND NAME OFFSET
HSOUL2:	MOVE B,0(X)		;GET A HOST NAME
	ADD B,HSTNAM		;POINT TO TEXT STRING
	HRLI B,440700		;BYTE PTR
	MOVE A,-3(P)		;USER'S NAME
HSOUL1:	ILDB C,A		;CHAR FROM USER
	ILDB D,B		;CHAR FROM TABLE
	CAIG C,172		;USER MAY BE LOWER CASE
	CAIGE C,141
	SKIPA			;NOT
	TRZ C,40		;LOWER. MAKE UPPER.
	CAME C,D		;CHARACTERS MATCH?
	JRST HSOUT1		;NO
	JUMPN C,HSOUL1		;YES. LOOP UNLESS TO END OF STRINGS
HSOUTM:	TRZ F,AMBIGF		; INDICATE SUCCESS FOR INTERESTED CALLER
	TRO F,MATCHF
	MOVE B,0(X)		;EXACT MATCH
	ADD B,HSTNAM		;POINT TO STRING IN TABLE
	HRLI B,440700
	MOVEM B,-3(P)		;PUT IT IN AC B ON STACK
HSOUTR:	POP P,X			;RESTORE ACS
	POP P,D
	POP P,C
	POP P,B
	POP P,A
SOUTPJ:	SOUT
	POPJ P,0

HSOUT1:	JUMPN C,HSOUT2		;IF NOT END OF USER STRING, NO MATCH.
	SKIPL 0(X)		;SERVER BIT ON FOR THIS HOST?
	JRST HSOUT2		;NO. DONT RECOGNIZE IT.
	TROE F,MATCHF		;YES. IT'S A MATCH. FIRST?
	TRO F,AMBIGF		;NO. LOSES. AMBIGUOUS.
	MOVEM X,HSOUTX		;STASH THE INDEX OF THE MATCH
HSOUT2:	AOBJN X,HSOUL2		;MOVE ON TO NEXT HOST NAME
	MOVE B,HSOUTX		;TRIED ALL. POINT TO ANY MATCH
	MOVE B,0(B)
	ADD B,HSTNAM
	HRLI B,440700		;STRING POINTER, MAYBE TO A NAME.
	TRNE F,MATCHF		;A MATCH?
	TRNE F,AMBIGF		;AND NOT AMBIGUOUS?
	SKIPA			;NOT A WIN
	MOVEM B,-3(P)		;WINS. PUT IT ON STACK FOR SOUT
	JRST HSOUTR		;AND RESTORE ACS, SOUT, RETURN.
; SEND A LINE AND WAIT FOR RESPONSE FROM FTP

SWTOK:	MOVE A,SJFN
	SETZ C,
	SOUT
	MOVEI B,21
	MTOPR
	JRST WAITOK

; GET A RESPONSE FROM FTP

WAITOK:	MOVE A,RJFN
	TRZ F,NUMF
	SETZ C,
NINLP:	BIN
	CAIL B,200
	 JRST NINLP
	CAIG B,"9"
	CAIGE B,"0"
	 JRST NINDUN
	TRO F,NUMF
	IMULI C,^D10
	ADDI C,-60(B)
	JRST NINLP

NINDUN:	SKIPA D,[POINT 7,REPLY]
NINDU1:	BIN
	JUMPE B,[GTSTS
		TLNN B,1000
		JRST NINDU1
		MOVE A,[POINT 7,REPLY]
		HRROI B,[ASCIZ/ Net connection closed./]
		SETZ C,
		SOUT
		MOVE C,NETCLS
		POPJ P,   ]
	IDPB B,D
	CAIE B,12
	 JRST NINDU1
	TRNN F,NUMF		; ANY NUMBER INPUT?
	 JRST WAITOK		; NO, GET ANOTHER
	SETZ B,
	IDPB B,D
	CAIL C,^D400
	CAIL C,^D600
	AOS 0(P)
	POPJ P,

; GENERATE FIRST PART OF HEADING

MAKIHD:	MOVE A,PTR
	MOVEM A,HEAD
	HRROI B,[ASCIZ /Date: /]
	SETZ C,
	SOUT
	MOVSI C,(1B5!1B7!1B10!1B12!1B13); IN FORM "15 MAY 1973 1346-EDT"
	SETO B,
	ODTIM
	HRROI B,[ASCIZ /
From: /]
	SETZ C,
	SOUT
	TRNE FLG,NTLOGF		; IS USER LOGGED IN?
	 JRST MAKIH1		;NO, USE FROM NAME.
	PUSH P,A
	GJINF
	MOVE B,A
	POP P,A
	DIRST
	 JFCL
	JRST MAKIH2
MAKIH1:	MOVE B,FROMNM		;USE FROM NAME
	SOUT
MAKIH2:	TRNN F,USEATF		;INCLUDE "AT..."?
	POPJ P,			;NO, JUST RETURN
	HRROI B,[ASCIZ / at /]; SAY WHAT HOST IT'S FROM
	SETZ C,
	SOUT
	MOVE B,LHOST
	TRNE FLG,NTLOGF		;IS USER LOGGED IN?
	 MOVE B,SITE		;NO, USE SITE NAME.
	PUSHJ P,HSTSOU		;COMPLETE HOST NAME THEN SOUT
	POPJ P,
; PUT SUBJECT LINE INTO HEADING

MAKHSB:	SKIPN SUBJCT
	 POPJ P,
	HRROI B,[ASCIZ /
Subject: /]
	SETZ C,
	SOUT
	MOVE B,SUBJCT
	SOUT
	POPJ P,

; MAKE HEADING FOR SNDMSG

MAKHED:	TRZ F,USEATF		;ASSUME NOT USING HOST NAME
	TRNN FLG,NTLOGF		; IF THIS IS A NON-LOGGED USER OR
	SKIPE HOST(X)		; IF THIS IS TO A DIFFERENT HOST
	TRO F,USEATF		;USE HOST NAME
	PUSHJ P,MAKIHD		; GENERATE INITIAL PART OF HEADING
	PUSHJ P,MAKHSB

	HRROI B,[ASCIZ /
To:   /]
	MOVEI C,USRTO
	PUSHJ P,DOCC

	HRROI B,[ASCIZ /
cc:   /]
	MOVEI C,USRCC
	PUSHJ P,DOCC

	PUSHJ P,MAKEHD
	POPJ P,

DOCC:	MOVEM B,PROMPT
	MOVEM C,USRCAT
	SETZ C,
	PUSH P,A
	TRZ F,COMMAF
	SKIPL Y,DISTL
	JRST DOUSRS		;NO GROUPS
	TRZ F,CCUSRF		;FLAG DOING GROUPS
CCLUP1:	HLRZ B,DSTFLG(Y)
	CAMN B,USRCAT		;REJECT IF WRONG TYPE USER
	PUSHJ P,CCADD		;ADD NEXT GROUP TO CC LIST
	AOBJN Y,CCLUP1		;LOOP THRU ALL GROUPS
DOUSRS:	TRO F,CCUSRF		;FLAG DOING USERS
	SKIPL Y,NUSERS
	 JRST DOCEND
CCLUP2:	HRLZ B,USRCAT		;OMIT USERS HAVING GROUPS (RH NE 0)
	CAMN B,USRFLG(Y)	; OR WRONG CATEGORY
	PUSHJ P,CCADD
	AOBJN Y,CCLUP2
DOCEND:	SUB P,[XWD 1,1]
	POPJ P,

CCADD:	PUSH P,A
	HRROI B,[ASCIZ /, /]
	TRNN F,COMMAF
	MOVE B,PROMPT
	SOUT
	TRNN F,CCUSRF
	 JRST [	MOVE B,DIST(Y)
		SOUT
		MOVEI B,":"
		BOUT
		JRST CCCHKE]
	EXCH X,Y
	CAMN X,Y		;IS THIS WHERE ITS GOING?
	JRST [PUSH P,USRTAB(X)	;YES-THIS WILL KEEP ADDRESS
		PUSH P,HOST(X)	;CONSISTENT WITH OTHER MESSAGES
		PUSH P,A
		MOVE A,HOLDU
		MOVEM A,USRTAB(X)
		MOVE A,HOLDH
		MOVEM A,HOST(X)
		POP P,A
		JRST .+1]
	PUSHJ P,OUTUSR
	CAMN X,Y		;RESTORE IT FOR SENDING?
	JRST [POP P,HOST(X)	;YES
		POP P,USRTAB(X)
		JRST .+1]
	EXCH X,Y
CCCHKE:	HRRZ B,A
	SUBI B,@-2(P)
	TROE F,COMMAF
	CAIG B,^D13
	JRST CCEND
  POP P,A
	MOVEI B,","
	BOUT
	TRZ F,COMMAF
	MOVEM A,-1(P)
	JRST CCADD
CCEND:	SUB P,[XWD 1,1]
	POPJ P,
; FINISH UP HEADING

MAKEHD:	HRROI B,[ASCIZ /

/]
	SETZ C,
	SOUT
	MOVEM A,PTR
	IBP PTR
	MOVE A,HEAD
	PUSHJ P,CNTMSG		; GET ITS LENGTH
	MOVEM B,HEDLEN
	POPJ P,

; OUTPUT DATE AND SIZE STAMP

OUTMRK:	MOVE A,SJFN
	SETO B,
	MOVSI C,(1B13)		;TIME ZONE
	ODTIM
	MOVEI B,","
	BOUT
	MOVE B,MSGLEN
	ADD B,HEDLEN
	ADDI B,9
	MOVEI C,12
	NOUT
	 JFCL
	MOVEI B,";"		;ADD BIT FLAGS
	BOUT
	SETZ B,
	MOVE C,[1B2+1B3+^D12B17+^D8]
	NOUT			;BASE 8, 12 COLUMNS, LEADING-0-FILLED
	 JFCL
	MOVEI B,15
	BOUT
	MOVEI B,12
	BOUT
	POPJ P,

; OUTPUT MESSAGE

OUTMSG:	MOVE A,SJFN
	MOVE B,HEAD
	MOVN C,HEDLEN
	SOUT
	MOVE B,MSG
	MOVN C,MSGLEN
	SOUT
	HRROI B,[ASCIZ /-------
/]
	SETZ C,
	SOUT
	POPJ P,

; COUNT LENGTH OF MESSAGE

CNTMSG:	SETZ B,
	ILDB C,A
	JUMPE C,CPOPJ
	AOJA B,.-2
; Collect string
; If fullf = 1, then string is terminated by control-Z
; otherwise it is terminated by any punctuation (@ , eol altmode now)
; Initial ? always returns, rubout always returns

INSTR:	TRZ F,BUFFUL
	MOVE EPTR,PTR
INSTRC:	MOVEI A,100
	RFMOD
	TRZ B,77B23
	TRO B,16B23
	SFMOD
	TRZ F,FRSTCH

RLUP:	PUSHJ P,.BIN
	TRNE FLG,NTLOGF		;IS USER LOGGED IN?
	 JRST [ CAIE A,"C"-100	;NO CHECK FOR ^C
		   JRST .+1	;NONE. GO ON.
		  PBOUT
		  HALTF		;FOUND ONE. EXIT.
		  JRST RLUP	;ON CONT GO ON.
		]
	CAIN A,CDELCH
	 JRST [	CAMN EPTR,PTR
		 JRST DING
		MOVEI A,"\"
		PBOUT
		LDB A,EPTR
		PBOUT
		PUSH P,A
		MOVE A,EPTR
		BKJFN
		 0
		MOVE EPTR,A
		POP P,A
		CAIN A,12
		 JRST .
		JRST RLUP]
	CAIN A,CDELLN
	 JRST [	CAMN EPTR,PTR
		JRST DING
		MOVEI A,"_"
		PBOUT
		MOVEI A,.CHLFD
		PBOUT
		PUSHJ P,BKLIN
		MOVEM A,EPTR
		JRST RLUP]
	CAIN A,"W"-100
	 JRST [	CAMN PTR,EPTR
		 JRST DING
		PUSHJ P,BKWORD
		MOVEI A,"_"
		PBOUT
		JRST RLUP]
	CAIN A,CRTYPE
	 JRST [	PUSHJ P,BKLIN
		MOVEM A,C	;START OF STRING
		SETZ B,		;NO PROMPT
		PUSHJ P,RETYPE
		JRST RLUP]
	CAIN A,"S"-100
	 JRST [	SETZ B,
		PUSH P,EPTR
		IDPB B,EPTR
		POP P,EPTR
		MOVE C,BPTR
		MOVE B,PROMPT
		PUSHJ P,RETYPE
		JRST RLUP]
	TRNE F,BLANKF		;IF FLAG ON,
	 JRST [	CAIN A," "	; SKIP LEADING BLANKS
		CAME PTR,EPTR
		JRST .+1
		JRST RLUP ]
	CAMN PTR,EPTR
	CAIE A,"?"
	CAIN A,CDELLN
	 JRST ENDIN
	CAIE A,0
	CAIN A,"Z"-100
	JRST ENDIN
	CAIN A,"B"-100
	 JRST ENDIN
	TRNE F,FULLF
	 JRST [	CAIN A,15	;FULLF ON
		 JRST RLUP	; IGNORE
		CAIN A,"X"-100
		 JRST [	HRROI A,[ASCIZ /___
/]
			PSOUT
			POPJ P,]
		CAIE A,","
		CAIN A,.CHLFD
		 JRST ENDIN
		CAIE A,33
		CAIN A,":"
		 JRST ENDIN
		CAMN EPTR,PTR	;FILCHR CAUSES RETURN ONLY IF
		CAIE A,FILCHR	; APPEARS AS FIRST CHAR
		SKIPA
		 JRST ENDIN
		SKPNAT A
		 JRST ENDIN
		JRST RLUPS]
	CAIE A,33		;FULLF OFF
	CAIN A,"X"-100		;IGNORE ALTMODE AND ^X
	 JRST RLUP
	TROE F,FRSTCH
	 JRST RLUPS
	PUSH P,A
	MOVEI A,100
	RFMOD
	TRZ B,1B22		;STOP WAKING ON PUNCTUATION
	SFMOD
	POP P,A
RLUPS:	HRRZ B,EPTR
	CAIL B,ESTRING-25
	 JRST [	TROE F,BUFFUL
		 JRST RLUP
		HRROI A,[ASCIZ /
String buffer full.  Finish input soon or you will lose.
/]
		ESOUT
		JRST RLUP]
	CAIL A,140
	CAILE A,177
	 JRST NOTLWR
	TRNE F,RAISEF
	 TRZ A,40
NOTLWR:	IDPB A,EPTR
	PUSH P,EPTR
	SETZ A,
	IDPB A,EPTR
	POP P,EPTR
	JRST RLUP
BKWORD:	MOVE A,EPTR
BKWRL1:	LDB B,A
	PUSHJ P,INVCHK
	 JRST BKWRD1
	CAME A,PTR
	BKJFN
	 JRST BKWRDN
	JRST BKWRL1

BKWRD1:	CAME A,PTR
	BKJFN
	 JRST BKWRDN
	LDB B,A
	PUSHJ P,INVCHK
	 JRST BKWRD1
BKWRDN:	MOVEM A,EPTR
	SETZ B,
	IDPB B,A
	POPJ P,

INVCHK:	CAILE B," "
	CAIL B,177
	AOS 0(P)
	POPJ P,
BKLIN:	MOVE A,EPTR
	SETZ B,
	IDPB B,A
	MOVE A,EPTR
BKLINL:	CAMN A,PTR
	 POPJ P,
	BKJFN
	 0
	LDB B,A
	CAIN B,12
	POPJ P,
	JRST BKLINL

BKBLNK:	PUSH P,A
	MOVE A,EPTR
BKBL1:	CAMN A,PTR
	JRST BKBL2
	LDB B,A
	CAIN B," "
	BKJFN
	JRST BKBL2
	JRST BKBL1
BKBL2:	MOVEM A,EPTR
	POP P,A
	POPJ P,

DING:	MOVEI A,7
	PBOUT
	JRST RLUP

ENDIN:	TRNE F,BLANKF		;IF FLAG ON,
	PUSHJ P,BKBLNK		; BACK UP OVER TRAILING BLANKS
	SETZ B,
	MOVE C,EPTR
	IDPB B,C
	AOS 0(P)
	POPJ P,

;TYPE PROMPT STRING FROM B (NONE IF 0) THEN STRING FROM C -
; STARTS ON NEW LINE - CLOBBERS A
RETYPE:	TYPOUT < MOVEI A,.CHLFD
	PBOUT
	SKIPE A,B		;TYPE PROMPT IF ANY
	PSOUT
	MOVE A,C		;TYPE STRING
	PSOUT  >
	POPJ P,
; BYTE INPUT FROM MULTI-FILES

.BIN:	PUSH P,B
	MOVE A,INFIL
	TRNE F,EOFF
	 JRST [	PUSHJ P,ENDFIL
		POP P,B
		JRST .BIN]
	BIN
	JUMPE B,[GTSTS
		TLNN B,1000
		 JRST .-1
		SETZ B,
		TRO F,EOFF
		JRST .+1 ]
	MOVE A,B
	POP P,B
	POPJ P,

SYSGET:	PUSH P,A		;PRESERVE AC'S
	PUSH P,B
	SETZM 0(B)		;IN CASE FAILS, CLEAR ANSWER.
	SYSGT
	JUMPE B,BAPOPJ		;RETURN IF NO TABLE
	MOVE A,HSTFRE		;POINT TO FREE SPACE
	HLL A,B			;PUT IN COUNT
	MOVEM A,@0(P)		;THATS THE ANSWER
	PUSH P,B		;NOW GET DATA. SAVE POINTER
	HLLZ X,B		;AOBJN COUNTER
SYSGTL:	MOVSI A,(X)		;ENTRY NUMBER IN TABLE
	HRR A,0(P)		;TABLE NUMBER
	GETAB
	  JRST SYSGTF		;FAILED!!
	AOS C,HSTFRE		;MOVE ON DOWN THE FREE SPACE
	CAILE C,HSTTAB+NHSTTB	;OVERFLOW TABLE?
	JRST SYSGTF		;YES.
	MOVEM A,-1(C)		;NO. STORE DATUM
	AOBJN X,SYSGTL		;COUNT THRU TABLE
SYSGTY:	POP P,(P)		;PEEL STACK
BAPOPJ:	POP P,B
	POP P,A
	POPJ P,0

SYSGTF:	SETZM @-1(P)		;FAILURE. CLOBBER ANSWER.
	JRST SYSGTY		;AND RETURN
; POP FILE STACK

ENDFIL:	CLOSF
	 JFCL
	POP SF,INFIL
	CAMN SF,[XWD -NFILS,FILSTK-1]
	 TRZ F,QUIETF
	HRROI A,[ASCIZ /EOF)/]
	TRNN F,QUIETF
	 PSOUT
	TRZ F,EOFF
	POPJ P,

; SET NEW INPUT FILE, PUSH FORMER

NEWFIL:	PUSH SF,INFIL
	TRNE FLG,NTLOGF		;IS USER LOGGED IN?
	 JRST [ HRROI A,[ASCIZ /(File capability not available non-logged-in users.)/]
		  PSOUT
		  JRST NONEWF  ]
	HRROI A,[ASCIZ /(Insert file: /]
	TRNN F,QUIETF
	PSOUT
	PUSHJ P,PRMTTY		; Is INFIL primary input and a TTY?
	SKIPA A,[1B2+3B17]	; No, no confirmation required
	MOVE A,[1B2+1B4+3B17]	; Yes, confirmation required
	MOVEI B,100
	CAME B,INFIL
	 SKIPA B,[377777]
	 MOVEI B,101
	HRL B,INFIL
	GTJFN
	 JRST [	HRROI A,[ASCIZ / ?)/]
		TRNN F,QUIETF
		PSOUT
		JRST NONEWF]
	MOVEM A,INFIL
	MOVE B,[XWD 70000,200000]
	OPENF
	 JRST [	MOVE B,A
		HRLI B,400000
		MOVEI A,101
		SETZ C,
		TRNN F,QUIETF
		ERSTR
		 JFCL
		 JFCL
		MOVE A,INFIL
		RLJFN
		 JFCL
		HRROI A,[ASCIZ / can't open)/]
		TRNN F,QUIETF
		PSOUT
		JRST NONEWF]
	HRROI A,[ASCIZ /.../]
	TRNN F,QUIETF
	PSOUT
	TRO F,QUIETF
	POPJ P,

NONEWF:	POP SF,INFIL
	POPJ P,

;Return +2 if INFIL is primary input and a TTY, +1 otherwise.
; Clobbers A,B,C
PRMTTY:	MOVE A,INFIL
	CAIE A,100
	 POPJ P,
	DVCHR
	LDB A,[POINT 9,B,17]
	CAIN A,12
	 AOS 0(P)
	POPJ P,

NETCLS:	^D453			;IF NET CONN CLOSED, PRETEND CODE WAS THIS
NEDLOG:	^D504			; NEED TO LOG IN
NEDPAS:	^D330			; NEED PASSWORD
LOGOK:	^D230			; SUCCESSFUL LOGIN FOR MULTICS
GENDLV:	^D950
GOMAIL:	^D350
QCODES:	^D401			; CODES IMPLYING QUEUEING
	^D436
	^D452
	^D453
	^D454
MNQCOD:	-5			; NEG OF NUMBER OF REPLY CODES THAT IMPLY QUEUEING
FTPSKT:	3
PDP:	IOWD PDLL,PDL
DNETTM:	^D30			;DEFAULT NET TIME-OUT TIME, SECS
DLOCTM:	0			;DEFAULT LOCAL TIME-OUT TIME, SECS

;ARGUMENTS FOR LONG-FORM GTJFN IN ADDRESS LIST INPUT
FILJFN:	1B2			;OLD VERSION
	0			;I/O JFN filled in later
	0			;normal default device
	POINT 7,LOGDIR		;default directory is logged-in
	POINT 7,[ASCIZ /SAVED/]	;Default file name
	POINT 7,[ASCIZ /MESSAGES/] ;Default extension
	0			;normal default protection
	0			;normal default account
	0			;don't care what JFN
NOLCL:	MOVE A,FLGMLS		;GET MAILBOX.EXE STATUS
	TLNE A,400000
	JRST ALREDY		;WAS ON, FORK IS THERE
	MOVSI A,100001		;WAS OFF, SEE IF MAILBOX.EXE IS AROUND
	HRROI B,[ASCIZ/SYS:MAILBOX.EXE/]
	GTJFN
	JRST NOMLSV+7		;NO
	MOVEM A,FLMLSV		;YES, SAVE JFN
	MOVSI A,(1B1)		;GET A FORK FOR MAILBOX.EXE
	CFORK
	JRST NOMLSV+3		;CAN'T GET FORK
	MOVEM A,FKMLSV		;SAVE FORK HANDLE
	HRL A,FKMLSV		;FORK FOR GET
	HRR A,FLMLSV		;FLE FOR GET
	GET
	HRLZ A,FKMLSV		;LH=FORK,RH=PAGE#0
	MOVE B,[400000,,FWDPAG]	;THIS FORK
	MOVSI C,140000		;READ,WRITE ACCESS
	PMAP
	MOVE A,FLGMLS
	TLO A,400000		;SET MAILBOX.EXE FLAG
	MOVEM A,FLGMLS
ALREDY:	MOVE A,[FWDADR+140,,FWDADR+141]
	SETZM FWDADR+140	;CLEAR BUFFERS
	BLT A,FWDADR+160
	MOVE A,[440700,,FWDADR+140]
	MOVE B,USRTAB(X)
	MOVEI C,^D40
	MOVEI D,0
	SOUT
	MOVE A,FKMLSV		;FORK HANDLE
	MOVEI B,4		;ANY SITE
	MOVEM B,FWDACS+1
	MOVEI B,FWDACS
	SFACS			;SET FORK ACS
	MOVEI B,2
	SFRKV			;START
	WFORK			;WAIT
	RFSTS			;READ FORK STATUS
	HLRZ A,A
	CAIE A,2		;WENT OK ?
	JRST NOMLSV		;NO
	MOVE A,FKMLSV		;YES, GET FORK HANDLE
	MOVEI B,FWDACS
	RFACS			;READ FORK ACS
	MOVE C,FLGMLS
	TRNE C,400001		;FROM FOUR50 OR OPNMER?
	JRST FWDING		;YES
	SKIPG FWDACS+1		;SUCCESS?
	JRST NO10X		;NO
	MOVE EPTR,USRTAB(X)	;YES, RESET POINTER
	SETZ C,			;BYTE COUNTER
	MOVE B,[POINT 7,FWDADR+140]
USRTRN:	ILDB A,B		;TRANSFER REAL USER
	CAIE A,0		;TERMINATING NULL?
	CAIN C,^D40		;END OF FIELD?
	JRST INSERT		;YES
	IDPB A,EPTR
	AOJA C,USRTRN
INSERT:	MOVEI A,100		;INSERT @
	IDPB A,EPTR
	MOVEM EPTR,PTR		;UPDATE PTR
	SETZ C,
	MOVE B,[POINT 7,FWDADR+150]
HSTTRN:	ILDB A,B		;TRANSFER HOST
	CAIE A,0		;TERMINATING NULL?
	CAIN C,^D40		;END OF FIELD?
	JRST FINTRN		;YES, FINISHED TRANSFER
	IDPB A,EPTR
	AOJA C,HSTTRN
FINTRN:	MOVE A,SAVTER		;GET TERMINATOR
	PUSHJ P,GETHST+2	;PTR UPDATED WITHIN PUSHJ-POPJ
	JRST GETUS0
	JRST RUBOUT
	JRST BADUS1
	MOVEM B,HOST(X)		;SAVE HOST
	JRST RUL63
NOMLSV:	UNMAP1
	MOVE A,FKMLSV
	KFORK
	MOVE A,FLMLSV
	HRLI A,(1B0)
	CLOSF
	JFCL
	MOVE A,FLGMLS
	TRNE A,400000		;FROM FOUR50?
	JRST [SETZM FLGMLS	;YES,BUT NO FWDING
		MOVEI C,^D450	;GET FTP CODE
		JRST WATMRF+2	;FAILED-CAN'T FORWARD
		]
	TRNE A,1		;FROM OPNMER?
	JRST [SETZM FLGMLS	;YES, BUT NO FWDING
		HRROI B,[ASCIZ/No such local mailbox, will queue for forwarding/]
		JRST OPNMEQ]
	SETZM ,FLGMLS		;RESET FLGMLS
	HRROI A,[ASCIZ/ Forwarding not available - User must be local /]
	JRST BADUS1
NO10X:	HRROI A,[ASCIZ/ Either no such user or no such mailbox /]
	JRST BADUS1
FOUR50:	SETZ A,
	TRO A,400000
	HRRM A,FLGMLS		;SAYS FROM HERE
	JRST NOLCL
FWDING:	SKIPG FWDACS+1		;SUCCESS?
	JRST [MOVE A,FLGMLS
		TRNE A,1	;FROM OPNMER?
		JRST [HRROI B,[ASCIZ/--Mailbox not local, can't find mailbox location, renamed as undeliverable/]
			MOVE A,[440700,,REPLY]
			SETZ C,
			SOUT
			POP P,A	;DON'T NEED THIS STUFF
			SETZ A,
			HRRM A,FLGMLS ;RESET FWDING PORTION
			JRST CANT]
		SETZ A,
		HRRM A,FLGMLS
		TRNE F,NCFRMF	;GENERAL DELIVERY?
		JRST GENRL2
		MOVEI C,^D450	;NO-RESTORE FTP REPLY CODE
		JRST WATMRF+2]	;WE TRIED
	TRNE F,NCFRMF		;GENERAL DELIVERY?
	JRST [PUSHJ P,WAITOK	;GET ANOTHER RESPONSE
		JRST WATMRF	;SHOULDN'T GET HERE
		CAMN C,GENDLV	;ANOTHER 950?
		JRST .		;GET ANOTHER RESPONSE
		JRST ASK	;SHOULD BE 350
		]
ASK:	MOVE A,TIMFRK		;ANSWER AT YOUR LEISURE
	FFORK
	MOVE A,FLGMLS
	TRNE A,1		;FROM OPNMER?
	JRST [HRROI A,[ASCIZ/-- Mailbox not local, Forwarding to /]
		PSOUT
		MOVE A,[440700,,FWDADR+150]
		PSOUT
		HRROI A,[ASCIZ/.../]
		PSOUT
		POP P,A		;DON'T NEED THIS STUFF
		SETZ A,
		HRRM A,FLGMLS	;RESET FWDING PORTION
		JRST FWDIT+2]	;GET MAILBOX AND SEND OVER NET
	SETZ A,			;NO
	HRRM A,FLGMLS		;RESET FWDING PORTION OF FLAG
	HRROI A,[ASCIZ/ -- Location of /]
	PSOUT
	MOVE A,USRTAB(X)
	PSOUT
	HRROI A,[ASCIZ/'s mailbox not known to /]
	PSOUT
	MOVE A,HOST(X)
	PSOUT
	HRROI A,[ASCIZ/
 However, a user named /]
	PSOUT
	MOVE A,USRTAB(X)
	PSOUT
	HRROI A,[ASCIZ/ has a mailbox at /]
	PSOUT
	MOVE A,[440700,,FWDADR+150]
	PSOUT
IDIOT:	HRROI A,[ASCIZ/
 F,A or ?: /]
	TRNE F,NCFRMF		;GENERAL DELIVERY
	HRROI A,[ASCIZ/
 G,F,A or ?: /]
	PSOUT
	MOVEI A,100
	RFMOD
	TRO B,77B23
	SFMOD
	PBIN
	CAIE A,"F"
	CAIN A,"f"
	JRST FWDIT
	CAIE A,"A"
	CAIN A,"a"
	JRST ABORT
	TRNE F,NCFRMF		;GENERAL DELIVERY?
	JRST [CAIE A,"G"
		CAIN A,"g"
		JRST GENRL
		JRST QUEST
		]
QUEST:	CAIE A,"?"
	JRST [MOVEI A,[BYTE (7) 7,77,0]
		PSOUT
		JRST IDIOT
		]
	TRNE F,NCFRMF		;GENERAL DELIVERY?
	JRST [HRROI A,[ASCIZ/
 G = general delivery to /]
		PSOUT
		MOVEI A,101
		PUSHJ P,OUTUSR
		HRROI A,[ASCIZ/
     An operator will try to deliver the mail/]
		PSOUT
		JRST QUEST+4
		]
	HRROI A,[ASCIZ/
 F = forward to /]
	PSOUT
	MOVE A,[440700,,FWDADR+140]
	PSOUT
	HRROI A,[ASCIZ/ at /]
	PSOUT
	MOVE A,[440700,,FWDADR+150]
	PSOUT
	HRROI A,[ASCIZ/
 A = abort - rename message for /]
	PSOUT
	MOVEI A,101
	PUSHJ P,OUTUSR
	HRROI A,[ASCIZ/ as undeliverable
             and place in /]
	PSOUT
	GJINF
	MOVEI A,101
	DIRST
	JRST [HRROI A,[ASCIZ/CONNECTED DIRECTORY/]
		PSOUT
		JRST .+1]
	HRROI A,[ASCIZ/ at /]
	PSOUT
	HRROI A,STRING		;LOCAL HOST NAME
	PSOUT
	HRROI A,[ASCIZ/
 ? = this explanation/]
	PSOUT
	JRST IDIOT
FWDIT:	HRROI A,[ASCIZ/orwarding.../]
	PSOUT
	MOVE A,[440700,,FWDADR+140]
	MOVEM A,USRTAB(X)	;REPLACE IT
	MOVE A,[440700,,FWDADR+150]
	MOVEM A,HOST(X)
	MOVE A,[400000,,400000]	;KILL CURRENT NET CONNECTION
	CLZFF			;BUT SAVE MAILBOX.EXE
	JRST SNDNET

ABORT:	HRROI A,[ASCIZ/borting.../]
	PSOUT
	TRNE FLG,NTLOGF
	JRST XRENAM
	PUSHJ P,OPNUND
	JRST XRENAM
	PUSHJ P,OUTMSG
	MOVE A,SJFN
	CLOSF
	JFCL
	HRROI B,[ASCIZ/ ok/]
ATELL:	MOVE A,[440700,,REPLY]
	SETZ C,
	SOUT
	MOVEI B,0
	IDPB B,A
	HRROI B,[ASCIZ//]
	JRST ENDSND
XRENAM:	HRROI B,[ASCIZ/ can't rename as undeliverable/]
	JRST ATELL
GENRL:	HRROI A,[ASCIZ/eneral delivery.../]
	PSOUT
	JRST WATMRG		;MAIL IT GENERALLY
GENRL2:	HRROI A,REPLY		;PRINT 950 REPLY
	PSOUT
	PUSHJ P,WAITOK		;GET ANOTHER RESPONSE
	JRST WATMRF		;SHOULDN'T GET HERE
	CAMN C,GENDLV		;ANOTHER 950?
	JRST GENRL2		;PRINT ANOTHER 950 REPLY
JERK:	MOVE A,TIMFRK		;NO-SHOULD BE 350
	FFORK
	SETZM REPLY
	HRROI A,[ASCIZ/ Is general delivery ok for user /]
	psout
	MOVEI A,101
	PUSHJ P,OUTUSR
	HRROI A,[ASCIZ/? /]
	PSOUT
	MOVEI A,100
	RFMOD
	TRO B,77B23
	SFMOD
	PBIN
	CAIE A,"Y"
	CAIN A,"y"
	JRST WATMRG
	CAIE A,"N"
	CAIN A,"n"
	JRST [HRROI A,[ASCIZ/ -- A/]
		PSOUT
		JRST ABORT]
	JRST JERK
;CLOSES CURRENT NET CONNECTION AND SETS  UP PROPER USER AT HOST
;RETURNED BY THE CURRENT FTPSERVER

MEDOIT:	MOVE A,TIMFRK		;STOP TIMER TIL NEXT SENDING
	FFORK
	MOVE A,[440700,,REPLY]
	MOVE B,[440700,,[ASCIZ/ MAIL WILL BE FORWARDED TO /]]
STRCMP:	ILDB D,B
	CAIN D,0		;FINISHED?
	JRST ITSOK		;YES
	ILDB C,A
	CAIL C,"a"
	CAILE C,"z"
	SKIPA
	TRZ C,40		;CONVERT TO UPPER CASE
	CAMN C,D		;SAME?
	JRST STRCMP		;YES
	JRST WATMR1		;NO-SEND TO HOST(X)
ITSOK:	MOVEM A,D		;JUST BEFORE NAME
	MOVE A,SJFN
	HRROI B,[BYTE (7) 3,102,131,105,.CHLFD,0] ;CNTRL-C,B,Y,E
	SETZ C,
	SOUT
	MOVEI B,21
	MTOPR			;DON'T WAIT FOR RESPONSE
	MOVE A,[400000,,400000]	;SAVE MAILBOX.EXE IF THERE
	CLZFF			;KILL NET CONNECTION
	MOVE A,D		;STRING POINTER TO REPLY NAME at HOST
	MOVE C,[440700,,NEWUSR]
	MOVEM C,USRTAB(X)
NXTCHU:	ILDB B,A		;GET USER
	CAIE B,40		;SPACE?
	JRST [IDPB B,C
		JRST NXTCHU]	;NO
	MOVEI B,0		;YES
	IDPB B,C		;INSERT A NULL
	MOVEI C,3		;SKIP 3 MORE CHARACTERS
SKPCH2:	ILDB B,A
	SOJN C,SKPCH2
	MOVE C,[440700,,NEWHST]
	MOVEM C,HOST(X)
NXTCHH:	ILDB B,A		;GET HOST
	CAIE B,15		;CR?
	JRST [IDPB B,C
		JRST NXTCHH]	;NO
	MOVEI B,0		;YES
	IDPB B,C		;INSERT A NULL
	HRROI A,[ASCIZ/ -- Forwarding to /]
	PSOUT
	MOVE A,HOST(X)
	PSOUT
	HRROI A,[ASCIZ/.../]
	PSOUT
	JRST SNDNET		;NOW USE IT TO SEND TO PROPER HOST

;LITERALS XLISTED

	XLIST
	LIT
	LIST
; MASSIVE RE-ORGANIZATION

; VARIABLES

LOC 20000

FLAGPG==./1000
FLAGS:	BLOCK 1000

NETTIM:	BLOCK 1			;TIME-OUT TIME FOR NET MAIL
LOCTIM:	BLOCK 1			;TIME-OUT TIME FOR LOCAL MAIL
PROMPT:	BLOCK 1
SAVACS:	BLOCK 20		;TO SAVE ACCUMULATORS
EDFRKH:	BLOCK 1			;FORK HANDLE FOR EDITOR
SAVMOD:	BLOCK 1			;PRIMARY INPUT JFN MODE
SAVCOC:	BLOCK 2			;PRIMARY OUTPUT COC WORDS
MONITV:	BLOCK 1
PDL2:	BLOCK 4
PDL:	BLOCK PDLL
FILSTK:	BLOCK NFILS
INFIL:	BLOCK 1
MSG:	BLOCK 1
MSGLEN:	BLOCK 1
HEAD:	BLOCK 1
HEDLEN:	BLOCK 1
SUBJCT:	BLOCK 1
DEFHST:	BLOCK 1
DEFGRP:	BLOCK 1
USRCAT:	BLOCK 1
BX:	BLOCK 1
BXDIST:	BLOCK 1
XDIST:	BLOCK 1
DISTL:	BLOCK 1
DIST:	BLOCK NDIST
DSTFLG:	BLOCK NDIST
HOST:	BLOCK NUSRS
USRTAB:	BLOCK NUSRS
USRFLG:	BLOCK NUSRS
FILNAM:	BLOCK NFILS
NUSERS:	BLOCK 1
TIMFRK:	BLOCK 1
SAVEP:	BLOCK 1
SAVEP2:	BLOCK 1
RETPC1:	BLOCK 1
SUPRET:	BLOCK 1
LHOSTN:	BLOCK 1
LHOST:	BLOCK 1
FSKT:	BLOCK 1
RJFN:	BLOCK 1
SJFN:	BLOCK 1
MSGJFN:	BLOCK 1			;JFN OF MAIL.CPY
EDJFN:	BLOCK 1			;JFN FOR EDITOR
USRJFN:	BLOCK 1			;JFN FOR FILES IN ADDRESS LIST
ENDPTR:	BLOCK 1
OLDCNT:	BLOCK 1
SPATCR:	BLOCK 1
LOGDIR:	BLOCK 10		;NAME OF LOGGED IN DIRECTORY
SITEN:	BLOCK 1
SITE:	BLOCK 1
FROMNM:	BLOCK 1
HSTFRE:	BLOCK 1			;SPACE COUNTER INTO HSTTAB
HOSTN:	BLOCK 1			;POINTER TO HOST NUMBERS AND BITS
HSTNAM:	BLOCK 1			;POINTER TO HOST ASCII STRINGS
HSOUTX:	BLOCK 1			;TEMP FOR HSTSOU ROUTINE
REPLY:	BLOCK 100
HSTTAB:	BLOCK NHSTTB		;SPACE FOR HOST NAMES AND NUMBERS
FWDACS:	BLOCK 20		;FOR MAILBOX.EXE ACS
FLMLSV:	BLOCK 1			;MAILBOX.EXE JFN
FKMLSV:	BLOCK 1			;MAILBOX.EXE FORK HANDLE
FLGMLS:	BLOCK 1			;MAILBOX.EXE FLAG
SAVTER:	BLOCK 1			;FOR TERMINATING CHAR IN ADDRESS FIELD
NEWUSR:	BLOCK 10		;WHERE TO PUT USER RETURNED BY FTPSERVER
NEWHST:	BLOCK 10		;WHERE TO PUT HOST RETURNED BY FTPSERVER
HOLDU:	BLOCK 1			;HOLDS ORIGINAL USRTAB(X)CONTENTS
HOLDH:	BLOCK 1			;HOLDS ORIGINAL HOST(X) CONTENTS
STRING:	BLOCK MAXMSG/5
ESTRING:

RELOC

	END <EVECL,,ENTVEC>