Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - sources/smtser.mac
There are no other files named smtser.mac in the archive.
;#6 Fix to make timing fork work again on T20
;#5 Fix to make work on T20 with symbolic STAT calls
;<SOURCES>SMTSER.MAC.123, 23-Jun-83 17:13:08, Edit by ROODE
;#4 temp patch to .CVHST because CVHST is clobbering AC1 on return
;<SOURCES>SMTSER.MAC.122, 22-Jun-83 16:11:06, Edit by ROODE
;bump version num for fix in TCPQIM
;<SOURCES>SMTSER.MAC.121, 20-Jun-83 21:34:36, Edit by ROODE
;uncomment out NOOP command
;<SOURCES>SMTSER.MAC.119,  5-May-83 19:56:05, Edit by ROODE
;make receive stamp terse
;<SOURCES>SMTSER.MAC.118, 26-Apr-83 20:38:09, Edit by ROODE
; modify format of Received stamp to conform to RFC822
; and remove editing of input from JCN's in LINEIN
;<SOURCES>SMTSER.MAC.117, 10-Mar-83 16:13:02, Edit by ROODE
;#2 change from timing fork to IIT call
;#3 Activate inactivity timeout
;<SOURCES>SMTSER.MAC.115,  2-Mar-83 02:06:53, Edit by ROODE
;#1 call tcpiin to initialize multiple tcp recv buffer requests

TITLE SMTSER - SMTP SERVER.  CRJOB STYLE
;STARTED UP BY SMTPSV.SAV SYSTEM JOB

DEFINE REPIZ <ASCIZ>		;use this for reply strings
TCP%JS==400000,,0
TCP%TV==1B11			;#5 TVT Supplied (STAT)
TCP%SY==400,,0			;#5 Symbolic form of STAT
sepjob==1
ifndef sepjob,<sepjob==1>	;1 for job; 0 for fork
TCPOLD==1			;still using TCP-3

opdef	$SOUT [PUSHJ P,TCPOUT]
opdef	$BIN  [PUSHJ P,TCPCHI]

NREVIS==:^D6		;CHANGE WHEN EDITED AT BBN
NLOCAL==:0		;CHANGE WHEN EDITED AT LOCAL SITE
NVERS==:1		;MAJOR REVISION. V2 IS THE CRJOB STYLE.
NPATCH==:0		;PATCH THIS IN PATCHX WHEN BINARY PATCHED
;.DIRECTIVE XSRCVN SRCVNO
IFNDEF SRCVNO,<SRCVNO==^D10000>	; Sigh, some MACROs can't hack above.

SEARCH STENEX,MONSYM

SALL

; Any site-dependent switches should go here.

;AC DEFINITIONS

F=:0		;FLAGS
A=:1		;A-D ARE JSYS ARGS
B=:2
C=:3
D=:4

T1=:5		;TEMPS
T2=:6
P1=:7		;PERMANENT OVER SUBR CALLS
P2=:10
P3=:11

BP=:14		;BYTE POINTER FOR COLLECTING, PARSING STRINGS
X=:15		;MSG POINTER IN MAIL ERRORS

P=:17		;STACK

OPDEF CALL [PUSHJ P,]
OPDEF RET [POPJ P,]
;PARAMETERS


PDLL==40	;LENGTH OF STACK

TIMCHN==^D24	;CHANNEL POKED BY TIMING FORK EVERY NOW AND THEN
CTCCHN==^D25	;CHANNEL FOR CONTROL C
DETCHN==^D26	;CHANNEL FOR NVT HANGUP

LCMDIB==^D512	;WORDS TO HOLD TELNET LINE. MAKE RIDICULOUSLY HUGE
		;BECAUSE OF NLS USERS' INABILITY TO TYPE CARRIAGE RETURN
LREPLY==^D100	;WORDS TO HOLD REPLY. SHOULDN'T NEED NEARLY THIS MUCH
WATTIM==^D600	;SECONDS TO WAIT FOR USER TO TYPE SOMETHING
		;#2 or to better put it, for data to come in

MAXRCP==^D100			;max # recipients
PTHLEN==^D52			;max # words in path

DEFINE CLOSE (FILE)<	MOVEI A,FILE
	PUSHJ P,CLOSER
>
DEFINE CLOSK (FILE)<	MOVEI A,FILE
	PUSHJ P,CLOSEK
>

	LOC 2000		;ORIGIN OF CODE IN LOW SEGMENT
;FLAGS IN AC F

L.SEND==400000		;DISTINGUISH DATA SENDS FROM RECEIVES
L.CMDK==200000		;ERRRPL SETS THIS. CAUSES GETCOM TO HANG UP.
L.LTL==100000		;LINEIN SETS THIS. LINE WAS RIDICULOUSLY LONG.
L.LICV==040000		;SET IN LINEIN WHEN ^V SEEN
;L.ANON==010000		;ANONYMOUS LOGIN
L.DVSC==004000		;FLAG COMMAND INPUT VS DATA
L.MFWD==002000		;MAIL WILL BE FORWARDED, via xmailr
;L.LOGI==001000		;I AM LOGGED IN
L.APPE==000400		;APPEND VERSUS STOR
L.LDSK==000200		;LOCAL FILE IS ON DISK
L.STAT==000100		;STAT VERSUS LIST
;L.NALO==000020		;DON'T AUTO-LOGOUT THIS JOB.
L.RNIL==000010		;RETRIEVE A MEGABIT FROM NIL:
L.PDIR==000004		;PRINT DIRECTORY NAME, IN LIST AND STAT
L.ACTV==000002		;FILE ACTIVITY GOING ON
L.ABOR==000001		;ABORT REQUEST RECEIVED DURING FILE ACTIVITY

R.RLPT==1		;ON IF RECEIVING FOR SPOOLED LPT
R.TYPX==2		;ON WHEN RETR OR STOR IS PAGED FILE TYPE (XTP)
R.T1==4			;TEMPS USED IN DIRECTORY LISTING ROUTINE
R.T2==10		; ..
R.NLST==20		;DISTINGUISH LIST FROM NLST
R.XRCP==40		;5 XRCP VS MAIL
	SUBTTL GO--START UP
;START ADDRESS OF THE TOP LEVEL OF FTP SERVICE

GO:	MOVEI A,100
	MOVEM A,INPUT
	MOVEI A,101
	MOVEM A,OUTPUT
	SETZM $JCN
	MOVE A,['SMTSER']	;SET NAME TO THIS FOR ACCOUNTING
	SETNM


	GJINF			;SEE WHAT MY CONDITION IS
	MOVEM A,GJINF1		;AND SAVE FOR LATER
	MOVEM B,GJINF2
	MOVEM C,GJINF3
	MOVEM D,GJINF4

	MOVEI A,0
	GTHST
	 MOVE 4,[120,,111]
	MOVEM 4,LHOSTN
;	MOVE 1,[102]
;	MOVEM 1,FHSTN

	MOVE A,GJINF4		;line number
;	CAIL A,50		;bad if less than 50
;	 CAIL A,70		;or ge 70
;	  jrst NOTVT
	TLO A,(TCP%TV)		;#101
	MOVE B,[-5,,7]		;#101
	MOVE C,[-5,,stablk] 	;#101 To STABLK
	SKIPN TENEX		;#5 Use symbolic stuff on T20
	 JRST [	TLO A,(TCP%SY)
		MOVE B,[-1,,[ASCII /TFH/]]
		MOVE C,[-1,,STABLK]
		JRST .+1]
	STAT
	  JRST NOTVT
	MOVE 1,STABLK		;foreign host number
	MOVEM 1,FHSTN
	JRST GOX
NOTVT:	MOVE 1,LHOSTN
	MOVEM FHSTN
	JRST GOX

; JCN passed from superior

OFF3:	TLO A,(TCP%JS)		;is a JCN
	MOVEM A,$JCN
	MOVE B,[-5,,7]		;#101
	MOVE C,[-5,,stablk] 	;#101 To STABLK
	SKIPN TENEX		;#5 Use symbolic stuff on T20
	 JRST [	TLO A,(TCP%SY)
		MOVE B,[-1,,[ASCII /TFH/]]
		MOVE C,[-1,,STABLK]
		JRST .+1]
	STAT
	 SETZM STABLK
	MOVE 1,STABLK		;foreign host number
	MOVEM 1,FHSTN
	
;#1	SETZM TCPICT		;#1 added to tcpiin
	CALL TCPOI

	JRST GOX


GOX:
	MOVE P,PDP		;SET UP A STACK
	skipe $jcn		;#1 skip if input not from jcn
	 call tcpiin		;#1 queue up for all buffers

	MOVEI F,0		;INITIALIZE ALL FLAGS TO ZERO
	PUSHJ P,DRSET		;reset conditions
	SETZM TENEX		;assume TOPS20
	MOVE A,['PTYPAR']
	SYSGT
	SKIPL B
	 SETOM TENEX		;non neg means no such table
INIT1:	MOVEI A,400000		;GET CAPABILITIES
	RPCAP			;SO CAN ENABLE CONTROL C,
	IOR C,B			;AND DELIVER MAIL
	EPCAP			; ..
	PUSHJ P,TIMEOK		;SET UP INITIAL TIME BEFORE PSI IS ON
	SETOM TFORKX		;NO TIMING FORK YET
	SKIPE $JCN
	 JRST INIT1A
	MOVEI A,100		;SET THE WAKEUP SET FOR THE NVT
	MOVEI B,0		;SET FOR NO PADDING
	STTYP			; ..
	RFMOD			;SEE WHAT IT IS
	TRZ B,1B22!1B23!1B30!1B31 ;FORGET THE PRINTING CHARACTERS
				; MAKE LOWER CASE COME IN AND OUT OK
	TRO B,1B21!1B20		;TURN ON ALL CONTROL CHAR WAKEUPS
	TLO B,(1B1!1B2!1B3)	;ALLOW LOWER CASE, TABS, FF'S
	TLZ B,177		;MAKE LINE WIDTH BE INFINITE
	SFMOD			;PUT THE REST BACK
	STPAR			; ..
	HRLOI A,(1B4+0B5+1B0+1B1)
	MOVEI B,-1		;REFUSE AND BREAK LINKS
	TLINK			; ..
	  PUSHJ P,BOMB
	SKIPN TENEX		;skip if Tenex
	 JRST INIT1A		;tops20
	MOVE A,GJINF4		;TERMINAL NUMBER
	TRO A,400000		;DESIGNATOR
	HRLI A,(1B0)		;CLEAR ADVICE
	ADVIZ			; ..
	  PUSHJ P,BOMB
INIT1A:
;FALL THRU
;FALLS THRU INTO HERE
INIT2:
	SETZM PRVKWD		;NO PREVIOUS KEYWORD YET,
	SETZM KEYWRD		; AND NO CURRENT ONE EITHER.
	SETOM LGOCNT		;INIT LOGOUT FORCER COUNTER
	SETOM LCLJFN		;CLEAR JFN'S USED LATER
;	SETOM DATJFN		; ..
	SETOM LOGJFN		; ..
;	SETZB A,SYSDNM		;SEE WHAT SYSTEM'S DIR NUM IS
;	HRROI B,[ASCIZ /SYSTEM/]
;	STDIR
;	  JFCL
;	  MOVEI A,1
;	HRRM A,SYSDNM		;STORE IT
	MOVEI A,.GTHNS		;7 Get local host name and number
	HRROI B,LHSTNM		;7
	SETO C,			;7 -1 means local site
	GTHST			;7
	 JRST HANGUP		;7 Foo, couldn't get it?!?

WHTNVT:
REPEAT 0,<
;	MOVEI A,.GTNNI		;#7 Get info about our NVT terminal..
;	MOVE B,GJINF4		;#7  (the input side)
;	MOVEI C,NCPBLK		;#7 
;	MOVSI D,-20		;#7  enuf room for things we need
;	GTNCP			;#7 
;	 JRST [	MOVE A,LHOSTN		;#7 must not be an NVT??
;		MOVEM A,FHSTN		;#7 assume local host,
;		SETOM FORNS		;#7  and hope we don't need
;		SETOM NETLSK		;#7  socket numbers!
;		JRST .+1]		;#7 
>;REPEAT 0


PSIINI:	MOVSI A,^D3		;ASSIGN ^C INTERRUPT
	SKIPE DBUGSW		;OR ^E IF DEBUGGING
	MOVSI A,^D5
	HRRI A,CTCCHN		;TO THIS CHANNEL
;	ATI
	MOVSI A,^D30		;NVT DETACHING PSI CODE
	HRRI A,DETCHN		;TO THIS CHANNEL
	ATI
	MOVEI A,400000		;SET UP PSI SYSTEM
	MOVE B,[LEVTAB,,CHNTAB]	; ..
	SIR
	MOVE B,ONCHNS		;TURN ON THESE CHANNELS
	AIC
	MOVEI A,400000		;NOW TURN THE SYSTEM ON
	EIR

;#6 repeat 0,<		;#2
MAKTFK:	SKIPE TENEX	;#6
	 JRST MAKTF2	;#6

	MOVSI A,(1B0!1B1)	;CREATE A FORK FOR TIMING
	CFORK			; ..
	  JRST FULL		;IF TOO FULL, QUIT.
	HRRZM A,TFORKX		;SAVE THE FORK INDEX
	MOVEI B,TFRKSA		;WHERE IT STARTS
	SFORK			;START IT. IT WILL GIVE ME TIME CHECKS
	JRST MAKTF3	;#6
;#6 >; end repeat 0		;#2

MAKTF2:		;#6
	HRRZI A,400000		;#2 fork self
	MOVEI B,1B<TIMCHN>	;#2 timchn
	MOVEI C,2*^D60000	;#2 two minute interval
	IIT			;#2 initiate future interrupt
MAKTF3:		;#6
;FALL THRU

	SUBTTL SIGNON--GREETING MESSAGE
;FALLS IN FROM ABOVE

SIGNON:	MOVEI A,101
	SETZ C,
	HRROI B,[REPIZ /220 /]	;REQUIRED HELLO MESSAGE
	$SOUT
	HRROI B,LHSTNM		;SITE NAME
	$SOUT
	HRROI B,[ASCIZ / SMTP Service /]
	$SOUT
	HRROI A,TMPBUF		;VERSION NUMBERS
	MOVEI C,12		;DECIMAL FIELDS
	MOVEI B,NVERS
	NOUT
	  JFCL
	MOVEI B,"."
	IDPB B,A
	MOVEI B,NREVIS
	NOUT
	  JFCL
	MOVEI B,"."
	IDPB B,A
	MOVEI B,NLOCAL
	NOUT
	  JFCL
	MOVEI B,"."
	SKIPE PATCHX
	IDPB B,A
	SKIPE B,PATCHX
	NOUT
	  JFCL
	SETZ C,
	HRROI B,[ASCIZ / ready at /]
	SOUT
	SETO B,0		;CURRENT TIME STAMP
	MOVSI C,200221		;FORMAT OF TIME
	ODTIM
	SETZ C,
	MOVEI A,101
	HRROI B,TMPBUF
	$SOUT
	PUSHJ P,PCRLF		;END OF LINE
	JRST GETCOM		;GO READ FIRST COMMAND
NOLINE:	SKIPE $JCN
	 JRST NOLIN2
	GJINF			;SEE IF I GOT DETACHED
	JUMPL D,HANGUP		;IF SO, HANG UP AND LOG OUT
NOLIN2:	HRROI B,MSG500		;NO, MUST BE SUPER LONG LINE
	JRST RPCRLP		;GIVE FAILURE MSG AND READ AGAIN
MSG500:	REPIZ /500 Last line was not comprehensible./

SYNERR:	JSP B,RPCRLP		;SYNTACTICAL ERROR IN COMMAND
	REPIZ /500 Syntax error at start of last command line./
SYNER2:	JSP B,RPCRLP
	REPIZ /501 Syntax error - Character after command verb is bad./
ARGSYN:	PUSHJ P,ADDREP		;HERE TO COMPLAIN OF ARGUMENT SYNTAX
	REPIZ /501 Syntax error in argument of /
	MOVE C,KEYWRD		;NAME OF COMMAND
ARGSYL:	MOVEI B,0		;PRINT COMMAND
	LSHC B,6		;GET A SIXBIT CHARACTER
	ADDI B,40		;CONVERT TO ASCII FROM SIXBIT
	IDPB B,A		;PUT IN REPLY BUFFER
	JUMPN C,ARGSYL		;OUTPUT WHOLE WORD
	MOVEM A,REPLYP		;CURRENT POINTER FOR REPLY
	JSP B,RPCRLP		;CLOSE OFF MSG
	ASCIZ / command./

FULL:	HRROI B,[ASCIZ /401 Service full, please try later. Goodbye./]
	JRST ERRRPL		;CAUSE HANGUP AFTER SENDING THIS

ABORPC:	MOVE P,PDP		;RESTORE STACK LEVEL
	HRROI B,[ASCIZ /? Unknown error interrupt
/]
	SKIPE CTCFLG		;WAS IT A ^C?
	HRROI B,[ASCIZ /Interrupt by user
/]
	SKIPE IOXFLG		;I/O ERROR?
	HRROI B,[ASCIZ +System I/O Error
+]
	PUSH P,B
	HRROI B,[ASCIZ /456 /]
	MOVEI A,101
	SETZ C,
	$SOUT
	POP P,B
	$SOUT	
	SKIPE $JCN
	 CALL TCPOFL
	JRST GETCOM		;GET ANOTHER COMMAND

BOMB:	MOVE A,REPLYP
	HRROI B,[ASCIZ /435 Fatal system error at /]
	MOVEI C,0
	SOUT
	HRRZ B,0(P)
	MOVEI C,10
	NOUT
	  JFCL
	MOVEM A,REPLYP
	JSP B,ERRRPL
	ASCIZ /. Please report it. Logging out./

	SUBTTL GETCOM--COMMAND LINE
;HERE TO GET A COMMAND LINE. FIRST SEE IF SYSTEM STILL UP

GETCOM:	MOVE A,[440700,,REPLYM]	;INITIALIZE POINTER TO REPLY
	MOVEM A,REPLYP		;FOR OTHER ROUTINES TO APPEND TO
	MOVE P,PDP		;RESTORE STACK LEVEL, JUST IN CASE.
	PUSHJ P,TIMEOK		;MARK THAT TIMEOUT HASN'T HAPPENED
	TLNE F,L.CMDK		;ASKED TO KILL JOB BEFORE CMD READING?
	JRST HANGUP		;YES, DO SO.
	MOVE A,['ENTFLG']	;SEE IF SYSTEM STILL OPEN
	SYSGT
	JUMPE B,GETCM1		;IF NO SUCH TABLE,
	JUMPN A,GETCM1		;OR ENTFLG IS NON-ZERO, GO TO IT
SHUTDN:	HRROI B,[ASCIZ /436 Service shutting down; goodbye./]
	JRST ERRRPL		;HANG UP ON HIM
GETCM1:	PUSHJ P,LINEIN		;COLLECT A COMMAND LINE FROM TTY
	  JRST NOLINE		;EOF OR SUPER-LONG LINE
	MOVE A,['ENTFLG']	;FLAG WENT OF DURING TYPEIN WAIT, MAYBE
	SYSGT
	JUMPE B,GETCM2		;CONTINUE IF NO FLAG AVAIL
	JUMPN A,GETCM2		;OR FLAG STILL OK
	JRST SHUTDN		;NO GOOD. HANG UP.
GETCM2:	SKIPN CMDIB		;BLANK LINE?
	JRST BLANK		;YES.
	MOVE BP,[440700,,CMDIB]	;INITIALIZE SAVED BYTE POINTER
GETCM3:	MOVEM BP,SBP		; ..
	ILDB C,BP		;SKIP LEADING SPACES AND TABS
	CAIE C,40		;SST ROUTINE FAILS AT START OF LINE
	CAIN C,11		;SO DO IT THIS WAY
	JRST GETCM3		;THAT WAS A SPACE. SKIP IT.
;	CAIN C,";"		;LET'S ALLOW COMMENTS
;	JRST CMNTOK		; ..
	PUSHJ P,SIN6BT		;COLLECT A SIXBIT WORD
	  JRST SYNERR		;DIDN'T START WITH A GOOD CHARACTER
	LDB C,SBP		;GET THE BREAK CHARACTER
	PUSHJ P,SST		;AND THEN STEP PAST ANY SPACES OR TABS
	JUMPE A,SYNERR		;BAD IF FIRST CHAR ON LINE NOT ALPHANUM.
	CAIE C,40		;SPACING CHARACTER AFTER VERB?
	CAIN C,11		; ..
	JRST PARS02		;YES
	JUMPN C,SYNER2		;JUMP UNLESS END OF LINE
;FALL THRU
;FALLS THRU FROM ABOVE
PARS02:	SKIPE C,KEYWRD		;ANY PREVIOUS KEYWORD?
	MOVEM C,PRVKWD		;YES, SAVE IT.
	MOVEM A,KEYWRD		;SAVE THE SIXBIT KEYWORD
	MOVSI C,-NKEYS		;SEE IF WE CAN FIND THE KEYWORD
	CAMN A,KEYS6B(C)	;THIS ONE?
	JRST KEYFND		;YES
	AOBJN C,.-2		;NO, LOOK THRU LIST
NOTKEY:	MOVE A,REPLYP		;NOT THERE. COMPLAIN
	HRROI B,[ASCIZ /500 I never heard of the /]
	MOVEI C,0
	SOUT
	MOVE C,KEYWRD
NOTKY1:	MOVEI B,0
	LSHC B,6		;CONVERT NAME FROM SIXBIT
	ADDI B,40		; ..
	IDPB B,A		;STORE IN REPLY
	JUMPN C,NOTKY1		;LOOP FOR ALL CHARACTERS
	MOVEM A,REPLYP		;STORE POINTER SO FAR
	HRROI B,[ASCIZ / command. Try HELP./]
	JRST RPCRLP		;FINISH THE LINE

KEYFND:	HRRZ B,KEYADR(C)	;DISPATCH TO ROUTINE
;	SKIPGE KEYADR(C)	;NEED TO BE LOGGED IN?
;	TLNE F,L.LOGI		;YES. AM I?
;	SKIPA			;LOGGED IN, OR DON'T NEED TO BE
;	JRST LGNPLS		;NO GOOD. COMPLAIN.
	PUSHJ P,0(B)		;CALL IT
	  JRST RPCRLP
	JRST RPCRLP


	SUBTTL OUTPUT TO USER
ERRRPL:	TLO F,L.CMDK		;FLAG THIS WAS A FATAL ERROR
RPCRLP:	MOVE A,REPLYP		;APPEND MSG IN B TO REPLY
	MOVEI C,0		;IT'S ASCIZ
	HRLI B,440700		;STRING POINTER (ALLOWS JSP B,RPCRLP)
	SOUT
	HRROI B,CRLFM		;APPEND CRLF
	SOUT
	ADD A,[070000,,0]	;backup so no extra null !!!
	HRROI B,REPLYM		;NOW SEND IT DOWN TELNET LINE
	MOVEI A,101
	$SOUT
	SKIPE $JCN
	 CALL TCPOFL
	JRST GETCOM		;AND GET ANOTHER COMMAND

ADDREP:	HRRO B,0(P)		;STRING PTR TO TEXT
	MOVE A,REPLYP		;ADD TEXT AFTER PUSHJ TO REPLY BUFFER
	MOVEI C,0		;ASCIZ FORM
	SOUT
	MOVEM A,REPLYP		;UPDATE REPLY POINTER
	HRRM B,0(P)		;POINTER TO WORD WITH NULL
	AOS 0(P)		;ONE MORE IS WHERE TO RETURN TO
	POPJ P,0		;RETURN THERE.

CRLFRP:	JSP B,RPCRLP		;JUST EOL, NO MORE TEXT
	0			;NO TEXT.

	SUBTTL MISC ROUTINES
DRSET:	MOVEI A,1		;initial state of 1
	MOVEM A,STATE
	SETZM NRCPTS
	POPJ P,

;.CVHST - translate host number into name

.CVHST:	MOVEI C,10		; 
	CALL [	PUSH P,A	;#4 temp patch due to CVHST bug
		CVHST
		 CAIA
		  AOS -1(P)
		POP P,A
		RET]
;	CVHST			; Translate number into name
	 NOUT			;  error, show (octal) number instead
	  JFCL			; 
	POPJ P,			; 


;CPYSTR - move ASCIZ string in core

cpystr:	push	p,c		;1 save registers
	push	p,d		;1
	hrli	b,(point 7)	;1 make byte pointer of source
				;1  note--we assume A is good byte pointer
cpyst0:	ildb	c,b		;1 get byte
	idpb	c,a		;1 store character
	jumpn	c,cpyst0	;1 loop until done
	add	a,[7b5]		;1 back up 7 bit byte pointer one byte
	pop	p,d		;1 restore registers
	pop	p,c		;1
	popj	p,		;1  and return

	SUBTTL MAIN COMMAND TABLE

;COMMAND MACROS
;C.LGN==1B18	;NEED TO LOG IN TO USE THIS COMMAND

DEFINE KEYMAC <		;KEYWORDS
M1 (HELP,0)
M1 (HELO,0)
M1 (RCPT,0)
M1 (DATA,0)
M1 (RSET,0)
M1 (QUIT,0)
M1 (MAIL,0)			;change code for this
M1 (NOOP,0)

;M1 (MLFL,0)
;M1 (XSEN,0)
;M1 (XSEM,0)
;M1 (XRCP,0)		;5 
;M1 (XRSQ,0)		;5 
;;M1 (BYE,0)
;M1 (ABOR,0)
;;M1 (NOOP,0)
;;M1 (DEBUG,0)
;;M1 (CRASH,0)
;;M1 (BOMB,0)
;M1 (BYTE,0)
;M1 (TYPE,0)
;M1 (STRU,0)
;M1 (MODE,0)
;M1 (ALLO,0)
>

DEFINE M1(A,B)<	SIXBIT +A+>

KEYS6B:	KEYMAC
NKEYS==.-KEYS6B	;LENGTH OF TABLE

DEFINE M1(A,B)<	XWD B,Z'A>

;THE DISPATCH TABLE
KEYADR:	KEYMAC
	SUBTTL ARGUMENT UTILITY ROUTINES


;MACRO FOR DEFINING TABLES FOR ARGS TO TYPE, MODE, STRU COMMANDS
;FIRST TEXT ARG MUST BE THE DEFAULT. ITS VALUE IS 0

DEFINE KM(A,B)<
ZZ==0
IRP B,<
	XWD [SIXBIT /B/],A'$'B
A'.'B==ZZ
ZZ==ZZ+1
>;END IRP
>;END DEFINE


repeat 0,<
ARGUNK:	PUSHJ P,ADDREP		;AN ARGUMENT THAT ISN'T EVEN IN TABLE
	ASCIZ /501 I never heard of /
	MOVE C,KEYWRD
	PUSHJ P,ADD6BC		;PUT COMMAND NAME IN
	PUSHJ P,ADDREP
	ASCIZ / with argument /
	JRST ARGUN1


ADD6BC:	MOVE A,REPLYP		;ADD SIXBIT WORD IN C TO REPLY
ADD6BL:	MOVEI B,0
	LSHC B,6		;SHIFT IN A CHARACTER
	ADDI B,40		;SIXBIT TO ASCII
	IDPB B,A		;INTO MSG
	JUMPN C,ADD6BL		;LOOP IF MORE LETTERS
	MOVEM A,REPLYP		;END OF REPLY SO FAR
	IDPB C,A		;C IS NOW CLEAR. APPEND NULL.
	POPJ P,0		;RETURN FROM ADD6BC
>;repeat 0

GETARG:	PUSHJ P,SIN6BT		;GET A WORD
	  POPJ P,0		;SYNTAX ERROR
	AOS 0(P)		;OK, SKIP AT LEAST ONE
	MOVEM A,ARGWRD		;SAVE FOR ERROR MSGS, REPLIES
	MOVEI B,0		;INDEX INTO TABLE
GETAR2:
;	HLLZ C,0(P1)		;GET UP TO 3 CHARACTERS
	HLRZ C,(P1)
	MOVE C,(C)
	CAMN A,C		;SAME AS SUPPLIED ARG?
	JRST GETAR1		;YES.
	ADDI B,1		;NO, NEXT INDEX
	AOBJN P1,GETAR2		;LOOP LOOKING FOR IT
	POPJ P,0		;NOT IN TABLE

GETAR1:	JRST CPOPJ1		;SUCCESS. FOUND THE WORD.


	SUBTTL MISC Commands
ZNOOP:	JSP B,RPCRLP
	REPIZ /250 No-operation OK./

ZQUIT:	PUSHJ P,ADDREP
	 REPIZ /221 /
	HRROI B,LHSTNM
	SETZ C,
	SOUT
	MOVEM A,REPLYP
	JSP B,ERRRPL		;SEND THIS MESSAGE, THEN HANG UP.
	 ASCIZ /.ARPA SMTP says Goodbye./

ZBYE:	haltf

ZHELP:	JSP B,RPCRLP
	ASCIZ /250- The following commands are supported:
250 HELO MAIL RCPT DATA RSET NOOP QUIT and HELP./

BLANK:	JRST GETCOM
;	JSP B,RPCRLP		;BLANK LINE
;	ASCIZ /200 Blank line ignored./

;CMNTOK:	JSP B,RPCRLP		;LINE STARTED WITH SEMICOLON
;	ASCIZ /200 Comment OK./

ZHELO:	PUSHJ P,ADDREP
	REPIZ /250 /
	HRROI B,LHSTNM
	SETZ C,
	SOUT
	MOVEM A,REPLYP
	JRST CRLFRP

ZRSET:	PUSHJ P,DRSET
	JSP B,RPCRLP
	ASCIZ /250 Reset!/


NOTIMP:	PUSHJ P,ADDREP
	REPIZ /502 The /
	MOVE C,KEYWRD		;PUT VERB INTO MESSAGE
NOTIM1:	MOVEI B,0
	LSHC B,6
	ADDI B,40
	IDPB B,A
	JUMPN C,NOTIM1
	MOVEM A,REPLYP
	HRROI B,[ASCIZ / command is not yet implemented./]
	POPJ P,0


	SUBTTL MAINTAINER Commands
ZCRASH:	JRST 4,.		;TEST COMMAND FOR FATAL ERRORS

ZBOMB:	PUSHJ P,BOMB		;ANOTHER ONE

ZDEBUG:	MOVEI A,400000		;SEE IF I AM A WHEEL
	RPCAP
	TRNN B,600000		; ..
	JRST NOTIMP		;NO. PRETEND NOT IMPLEMENTED
DEBUG1:	SKIPE 770000		;YES. IS DDT THERE?
	JRST DEBUG0		;YES, GO TO IT.
	MOVSI A,1		;NO, GET IT
	HRROI B,[ASCIZ /<SUBSYS>UDDT.SAV/]
	GTJFN
	  JRST NOTIMP
	HRLI A,400000		;INTO THIS FORK
	GET
	MOVE A,116		;JOBSYM
	MOVEM A,@770001		;TO $I-1
DEBUG0:	MOVSI A,400000		;NOW PUT ON COPY/WRITE BIT IN ACCESS
	HRRI A,400		;SO DDT CAN DO BREAKPOINTS
DEBUGL:	RPACS			;SEE IF PAGE THERE
	TLNN B,(1B5)		; ..
	JRST DEBUGN		;NO
	TLNE B,(1B10)		;IF SHARED, PUT ON CW
	SKIPA B,[1B2!1B3!1B4]	;NO, PRIVATE. R,W,E
	MOVSI B,(1B2!1B4!1B9)	;YES, MAKE IT R,E,CW
	SPACS			; ..
DEBUGN:	ADDI A,1		;NEXT PAGE
	HRRI B,(A)
	CAIGE B,700		;CONTINUE UP TO DDT
	JRST DEBUGL		; ..
	PUSHJ P,770000		;CALL DDT
	JSP B,RPCRLP
	REPIZ /250 End of debug./

	SUBTTL HANGUP a connection
TCPEOF:	SKIPGE A,LCLJFN
	 JRST HANGUP
	MOVE A,LCLJFN		;CLOSE OUT THE TEMP FILE.
	HRLI A,400000
	CLOSF
	  JFCL
	HRRZ A,LCLJFN
;later	DELF

HANGUP:	SKIPE $JCN
	 JRST HNGJCN
;	 GJINF			;GET LATEST TTY NUMBER
	DTACH			;GET OFF THE TTY
repeat 0,<
	JUMPL D,NORELD		;NOT IF DETACHED
	MOVEI A,400000(D)	;THE LINE NUMBER TO A TTY DEV DESIGNATOR
	ASND			;ASSIGN IT
	  JRST NORELD		;CAN'T?
	MOVEI A,400000(D)	;AGAIN
	RELD			;CAUSE THE NVT TO CLS
	  JFCL
>
NORELD:

	SETO A,0		;NOW LOG OUT
	PUSHJ P,LOGOUT		;LOGOUT OR HALTF IF DEBUGGING
	WAIT			;SHOULDN'T GET HERE...
	JRST GO

HNGJCN:	haltf



LOGOUT:	SETO A,0		;LOGOUT ME
	SKIPN DBUGSW
	LGOUT
	  JFCL
	SKIPE DBUGSW
	HALTF
	POPJ P,0

FORCLO:	HRROI B,[REPIZ /421 Inactivity timeout.  Aborting.
/]
	MOVEI A,101
	SETZ C,
	$SOUT
	SKIPE $JCN
	 CALL TCPOFL
	JRST HANGUP

	SUBTTL MORE MISC routines


;#6 repeat 0,<		;#2
TFRKSA:	MOVEI A,^D60000
	DISMS
	MOVEI A,-1		;MY SUPERIOR
	MOVEI B,1B<TIMCHN>	;CHANNEL TO POKE HIM ON
	IIC			;DO SO
	JRST TFRKSA		;AND RETURN
;#6 >;end repeat 0		;#2

PCRLF:	PUSH P,A
	PUSH P,B
	PUSH P,C
	HRROI B,CRLFM
	MOVEI A,101
	SETZ C,
	$SOUT
	SKIPE $JCN
	 CALL TCPOFL
	POP P,C
	POP P,B
	POP P,A
	POPJ P,0

SDUMPA:	MOVEI A,101
	MOVEI C,0
	$SOUT
	SKIPE $JCN
	 CALL TCPOFL
	POPJ P,0

CRLFM:	BYTE (7)15,12,0

CLOSER:	SKIPGE 0(A)		;ANYTHING THERE?
	POPJ P,0		;NO SUCH JFN. RETURN.
	PUSH P,A		;YES. SAVE A COUPLE AC'S
	PUSH P,B
	HRRZ A,0(A)		;GET JFN ITSELF
	GTSTS
	JUMPGE B,[RLJFN		;NOT OPEN. JUST RELEASE IT
		    CLOSF	; ..
		  JRST CLOSR1]
	CLOSF
	  JFCL
CLOSR1:	POP P,B			;RESTORE AC'S
	POP P,A
	SETOM 0(A)		;AND FLAG JFN GONE
	POPJ P,0

CLOSEK:	SKIPGE 0(A)		;CLOSE, KEEPING JFN. FILE THERE?
	POPJ P,0		;NO.
	PUSH P,A		;YES, SAVE ADDR WHERE JFN IS
	MOVE A,(A)		;GET THE JFN
	HRLI A,(1B0)		;FLAG TO KEEP THE JFN
	CLOSF			;CLOSE IT
	  JFCL
	POP P,A			;RESTORE POINTER
	POPJ P,0		;RETURN

FRMHST:	HRROI B,[ASCIZ / from host /]
	MOVEI C,0		;IDENTIFY THE HOST
	SOUT
HSTOUT:	MOVE B,FHSTN		;#7 FOREIGN SITE NUMBER
	PUSHJ P,.CVHST		;#7 Output host name/number
	POPJ P,0

CLRPSW:	PUSH P,A		;BE TRANSPARENT
	SETZM $PASS		;CLEAR SECRET INFO
	MOVE A,[$PASS,,$PASS+1]	;IN ALL PASSWORD AREAS
	BLT A,$PASS+7
	SETZM ANOPSW
	MOVE A,[ANOPSW,,ANOPSW+1]
	BLT A,ANOPSW+7
	SETZM CMDIB
	MOVE A,[CMDIB,,CMDIB+1]
	BLT A,CMDIB+20
	JRST APOPJ

	SUBTTL LINEIN --LINE COLLECTOR

;THE LINE COLLECTOR. PERFORMS CHARACTER AND WORD AND LINE EDITING.
;READS A LINE INTO CMDIN BUFFER, TERMINATED BY NULL, CRLF STRIPPED OFF.

LINEIN:	PUSH P,P1
	PUSH P,P2
	PUSH P,P3
LINICQ:				;REENTER HERE ON LINE DELETE
	TLZ F,L.LTL!L.LICV	;CLEAR THIS ROUTINE'S FLAGS
	MOVEI P1,<5*LCMDIB>-3	;MAXIMUM LINE LENGTH TO READ
	MOVE P2,LINEIP		;INITIAL BYTE POINTER TO BUFFER
	SETZM CMDIB		;CLEAR THE BUFFER, TO BE NEAT
	MOVE A,[CMDIB,,CMDIB+1]	; ..
	BLT A,CMDIB+LCMDIB-1	; ..
LININL:	PUSHJ P,TELBIN		;BIN FROM NVT
	  JRST P3POPJ		;NON-SKIP IF TTY GETS EOF
	TLZE F,L.LICV		;CONTROL V SEEN?
	JRST LININ2		;YES. STORE CHARACTER EXACTLY
	CAIN B,12		;IS IT A LINEFEED?
	JRST LINEOL		;YES. QUIT.
	CAIE B,0		;NULL OR CARRET?
	CAIN B,15		; ..
	JRST LININL		;YES, IGNORE COMPLETELY
	SKIPE $JCN		;skip if input not from JCN
	 JRST LININ2		;no editing
	CAIE B,177		;RUBOUT, OR
	 CAIN B,"A"&37		;EDITING. CONTROL A?
	  JRST LINICA		;YES
	CAIN B,"W"&37		;CONTROL W?
	 JRST LINICW		;YES
	CAIE B,"X"&37		;CONTROL X?
	 CAIN B,"U"&37		;CONTROL U?
	  JRST LINICQ		;YES.
	CAIN B,"V"&37		;SUPER-QUOTE?
	TLO F,L.LICV		;FLAG CONTROL V SEEN, THEN STORE IT
LININ2:	IDPB B,P2		;STORE THIS CHARACTER
	SOJG P1,LININL		;ACCUMULATE LINE
	TLO F,L.LTL		;LINE TOO LONG
P3POPJ:	POP P,P3		;NON-SKIP RETURN
	POP P,P2
	POP P,P1
	POPJ P,0

LINEOL:	MOVEI B,0		;NORMAL END OF LINE. TERMINATE WITH EOL
	IDPB B,P2		;TERMINATE THE STRING
	AOS -3(P)		;SKIP RETURN
	JRST P3POPJ		; ..

LINEIP:	010700,,CMDIB-1		;INITIAL POINTER TO BUFFER
;EDITING ROUTINES FOR LINEIN

LINICA:	CAMN P2,LINEIP		;ALREADY AT START OF LINE?
	JRST LININL		;YES, IGNORE THIS ^A
	MOVEI B,0		;CLOBBER THE CURRENT CHARACTER
	DPB B,P2		; ..
	ADD P2,[070000,,0]	;BACK UP THE POINTER
	SKIPGE P2		;IF OFF END OF WORD,
	SUB P2,[430000,,1]	;PREVIOUS WORD.
	AOJA P1,LININL		;UN-COUNT THE DELETED CHARACTER

LINICW:	LDB B,P2		;GET CURRENT CHARACTER
	PUSHJ P,ALNUMQ		;SKIP IF ALPHANUMERIC
	 JRST LINCW1		;NO, A BREAK CHAR.
LINCW2:	MOVEI B,0		;THIS IS ALPHANUMERIC. CLOBBER IT.
	DPB B,P2		; ..
	ADDI P1,1		;UN-COUNT IT.
	ADD P2,[070000,,0]	;BACK UP POINTER
	SKIPGE P2
	SUB P2,[430000,,1]	; ..
	CAMN P2,LINEIP		;BACK TO START OF BUFFER?
	JRST LININL		;YES. DONE DELETING
	LDB B,P2		;NO, SEE IF THIS IS STILL IN THE WORD.
	PUSHJ P,ALNUMQ		;SKIP IF ALPHANUMERIC
	 JRST LININL		;BREAK. DONE.
	JRST LINCW2		;STILL IN WORD. GO DELETE IT.

LINCW1:	MOVEI B,0		;CURRENT CHAR IS A BREAK. GET BACK TO
	DPB B,P2		;WORD BEFORE BREAK(S), THEN DELETE IT.
	ADDI P1,1		;DELETE BREAK CHARACTER
	ADD P2,[070000,,0]
	SKIPGE P2
	SUB P2,[430000,,1]
	CAMN P2,LINEIP		;BACK TO START OF BUFFER?
	JRST LININL		;YES. QUIT.
	LDB B,P2		;SEE IF MULTI-BREAKS AFTER LAST WORD
	PUSHJ P,ALNUMQ		;ALPHANUMERIC?
	 JRST LINCW1		;NO, MORE BREAKS. DELETE THIS ONE TOO
	JRST LINCW2		;INTO THE WORD. DELETE THE WORD.
ALNUMQ:	CAIL B,"A"+40		;LOWER CASE?
	CAILE B,"Z"+40		; ..
	SKIPA			;NO.
	JRST CPOPJ1		;YES. SKIP RETURN.
	CAIL B,"A"		;UPPER CASE?
	CAILE B,"Z"		; ..
	SKIPA			;NO
	JRST CPOPJ1		;YES. SKIP RETURN
	CAIL B,"0"		;DIGIT?
	CAILE B,"9"		; ..
	SKIPA			;NO
	JRST CPOPJ1		;YES. SKIP RETURN.
	CAIN B,"-"		;HYPHEN?
	JRST CPOPJ1		;YES. SKIP RETURN
	POPJ P,0		;SOMETHING ELSE. NON-SKIP.

SIN6BT:	PUSH P,B		;ANSWER TO A, PRESERVE B AND C
	PUSH P,C		; ..
	MOVE BP,SBP		;CURRENT BYTE POINTER
	MOVEI A,0		;CLEAR THE ANSWER
	MOVE C,[440600,,A]	;START POINTER TO ANSWER
SIN6BL:	ILDB B,BP		;GET A CHARACTER
	PUSHJ P,ALNUMQ		;A-Z, 0-9, OR HYPHEN?
	  JRST SIN6B1		;NO, BREAK CHARACTER
	CAIL B,100		;YES. LETTER?
	TRZ B,40		;YES, MAKE SURE UPPER CASE.
	SUBI B,40		;YES. CONVERT TO SIXBIT
	TLNE C,770000		;ROOM FOR ANOTHER CHARACTER?
	IDPB B,C		;YES, STORE IN KEYWORD
	JRST SIN6BL		;ON TO THE BREAK
SIN6B1:	MOVEM BP,SBP		;UPDATE STORED BYTE POINTER
	POP P,C			;RESTORE AC'S
	POP P,B			; ..
	SKIPE A			;SKIP RETURN UNLESS NO WORD
	AOS 0(P)
	POPJ P,0
TELBIN:	MOVEI A,100		;BIN FROM PRIMARY INPUT
	$BIN			;CHARACTER TO AC B
	JUMPE B,TELBI0		;NULL? DISCARD IF SO.
	TLNE F,L.DVSC
	 JRST TELBY2		;data--no exclusion of special chars
	CAIN B,12		;linefeed?
	 JRST CPOPJ1
	CAIGE B,360		;IAC ETC?
	 CAIGE B,37		;CONTROL CHARACTER?
	 JRST TELBIN 
TELBY2:	CAIN B,37		;TTY EOL?
	MOVEI B,12		;YES, MAKE LINEFEED
CPOPJ1:	AOS 0(P)		;NO, OK. SKIP RETURN.
CPOPJ:	POPJ P,0

TELBI0:	SKIPE $JCN
	 JRST TELBIN		;not possible w/JCN

	MOVEI A,100		;SEE IF EOF
	GTSTS
	TLNN B,1000
	JRST TELBIN		;NO, DISCARD THE NULL.
	POPJ P,0		;YES. GIVE NON-SKIP RETURN. BUT
				;PROBABLY DETACH WILL CAUSE PSI ANYHOW

TIMEOK:	PUSH P,A		;UPDATE TIME TILL HANGUP FORCED
	PUSH P,B		;SAVE AC'S
	TIME			;GET SYSTEM UPTIME
	IMULI B,WATTIM		;THIS MANY SECONDS TO WAIT
	ADD A,B			;WAIT UNTIL TIME EQUALS THIS
	MOVEM A,KTIMET		;THEN FORCE A LOGOUT.
BAPOPJ:	POP P,B
APOPJ:	POP P,A
	POPJ P,0

SST:	PUSH P,A		;SKIP SPACES AND/OR TABS AT CURRENT SBP
	TLZ F,L.LICV		;FLAG FIRST CHARACTER
SSTL:	LDB A,SBP		;GET THE CURRENT CHARACTER
	CAIE A,40		;IS IT A SPACE OR TAB?
	CAIN A,11		; ..
	TLOA F,L.LICV		;YES. FLAG MOVING UP AT LEAST ONE CHAR.
	JRST SST01		;NO. QUIT HERE
	IBP SBP			;IT'S A SPACE/TAB. MOVE PAST IT
	JRST SSTL		;AND GO CHECK THE NEXT ONE.
SST01:	MOVSI A,070000		;BACK UP SO ILDB GETS THE NON-SPACE
	TLZN F,L.LICV		;UNLESS DIDN'T MOVE FORWARD AT ALL.
	JRST SST3		;IN WHICH CASE LEAVE IT HERE.
	ADD A,SBP		; ..
	SKIPGE A
	SUB A,[430000,,1]
	MOVEM A,SBP
SST3:	JRST APOPJ

	SUBTTL PSI HANDLERS
TIMINT:	MOVEM 17,PI2AC+17	;STASH THE AC'S
	MOVEI 17,PI2AC		; ..
	BLT 17,PI2AC+16
	MOVE P,L2PDP		;AND SET UP A STACK
	TIME
	CAMG A,KTIMET		;TIME TO QUIT?
	JRST TREARM		;#2 NO.
	AOS A,LGOCNT		;COUNT THE FORCE-LEVEL COUNTER
	CAIL A,2		;PANIC?
	JRST HANGUP		;YES. GET OUT
	CAIL A,1		;STILL NOT SEEN AT PROCESS LEVEL. FIRST?
	JRST TIMIN1		;NO, GO CAUSE DEBRK TO FORCE OFF
;yes, so do a warning?
TREARM:	SKIPN TENEX		;#6
	 JRST L2DBRK		;#6
	HRRZI A,400000		;#2 fork self
	MOVEI B,1B<TIMCHN>	;#2 timchn
	MOVEI C,2*^D60000	;#2 two minute interval
	IIT			;#2 initiate future interrupt
L2DBRK:	MOVSI 17,PI2AC		;RESTORE AC'S
	BLT 17,17		; ..
	DEBRK			;AND RETURN FROM LEV 2 PSI

TIMIN1:	MOVEI A,FORCLO		;FORCED LOGOUT
	HRLI A,(1B5)		;USER MODE
	MOVEM A,RETPC2		;BREAKING OUT OF PRESENT WORK
	SKIPE TENEX		;#6
	 JRST TREARM		;#2 re-arm and debrk

L1DBRK:	MOVSI 17,PI1AC		;RESTORE LEV 1 AC'S
	BLT 17,17		; ..
	DEBRK			;AND RETURN FROM LEV 1 PSI

DETINT:	MOVEM 17,PI2AC+17	;STASH AC'S
	MOVEI 17,PI2AC		;JUST FOR SYMMETRY
	BLT 17,PI2AC+16
	MOVE P,L2PDP		;SET UP STACK
	RESET			;KILL EVERYTHING. (SHOULD DELETE FILE?)
	JRST HANGUP		;AND GO HANG UP NVT

CTCINT:	MOVEM 17,PI2AC+17	;STASH THE AC'S
	MOVEI 17,PI2AC		; ..
	BLT 17,PI2AC+16
	MOVE P,L2PDP		;AND SET UP A STACK
	SETOM CTCFLG
ABODBK:	MOVEI A,ABORPC
	HRLI A,(1B5)		;FORCE IT TO BREAK OUT AT THIS PC
	MOVEM A,RETPC2
	JRST L2DBRK

IOXINT:	MOVEM 17,PI2AC+17	;STASH THE AC'S
	MOVEI 17,PI2AC		; ..
	BLT 17,PI2AC+16
	MOVE P,L2PDP		;AND SET UP A STACK
	SETOM IOXFLG		;FLAG THE I/O ERROR
	JRST ABODBK		;ABORT TO ABORPC ON DEBREAK
	JRST L2DBRK
;THE FATAL (LEV 1) ONES

INSINT:	MOVEM 17,PI1AC+17	;STASH THE AC'S
	MOVEI 17,PI1AC
	BLT 17,PI1AC+16
	MOVE P,L1PDP		;SET UP A STACK
	JSP B,L1INTS
	ASCIZ /Illegal Instruction trap/

MEMINT:	MOVEM 17,PI1AC+17	;STASH THE AC'S
	MOVEI 17,PI1AC
	BLT 17,PI1AC+16
	MOVE P,L1PDP		;SET UP A STACK
	JSP B,L1INTS
	ASCIZ /Illegal memory reference trap/

PDLINT:	MOVEM 17,PI1AC+17	;STASH THE AC'S
	MOVEI 17,PI1AC
	BLT 17,PI1AC+16
	MOVE P,L1PDP		;SET UP A STACK
	JSP B,L1INTS
	ASCIZ /Pushdown stack overflow trap/

FULINT:	MOVEM 17,PI1AC+17	;STASH THE AC'S
	MOVEI 17,PI1AC
	BLT 17,PI1AC+16
	MOVE P,L1PDP		;SET UP A STACK
	JSP B,L1INTS
	ASCIZ /Disk or Drum overflow/
L1INTS:	HRROI A,[REPIZ /421 /]
	PSOUT
	HRROI A,(B)
	PSOUT			;SPECIFIC FAILURE MESSAGE
	HRROI A,[ASCIZ / at /]
	PSOUT
	MOVEI A,101		;TYPE THE PC
	HRRZ B,RETPC1
	MOVEI C,10
	NOUT
	  JFCL
	HRROI A,[ASCIZ /. Goodbye.
/]
	PSOUT
	JRST HANGUP


	SUBTTL MAIL Command
ZMAIL:	MOVE A,STATE		;ensure correct command sequencing
	CAIE A,1
	 JRST OOORD
;parse argument "FROM:"
	MOVEI P1,MAITAB		;TABLE OF KNOWN ARGS
	HRLI P1,-1		;NUMBER OF THEM
	PUSHJ P,GETARG		;LOOK FOR ARG IN TABLE
	  JRST MAISYN		;SYNTAX ERROR
	  JRST MAISYN		;ARGUMENT NOT IN TABLE
	HRRZ C,MAITAB(B)	;DISPATCH FOR THIS ARG
	JRST 0(C)		;GO TO IT (M$FROM)

MAITAB:	KM (M,<FROM>)

OOORD:	JSP B,RPCRLP
	REPIZ /503 Bad sequence of commands--command disgarded./
MAISYN:	JSP B,RPCRLP
	REPIZ /501 Syntax error.  Must use "MAIL FROM:"./
MAISY2:	JSP B,RPCRLP
	REPIZ /501 Syntax error.  Must delimit start of path with "<"./
MAISY3:	JSP B,RPCRLP
	REPIZ /501 Syntax error.  Must delimit end of path with ">"./
MAISY4:	JSP B,RPCRLP
	REPIZ /501 Path too long./

M$FROM:	LDB A,SBP		;GET THE CURRENT CHARACTER
	CAIE A,":"		;IS IT A colon?
	 JRST MAISYN		;syntax error then
	ILDB A,SBP		;GET THE CURRENT CHARACTER
	CAIE A,"<"		;IS IT A left angle bracket?
	 JRST MAISY2		;syntax error
	SETZM RVPATH		;SEE IF ARG WINS. CLEAR rev. path
	MOVE A,[POINT 7,RVPATH]
	MOVE B,SBP
	MOVEI C,<5*PTHLEN>	;max chars
MAIL1:	ILDB D,B		;get char
	CAIN D,">"
	 JRST MAIL2		;terminator found
	CAIN D,0
	 JRST MAISY3		;line ran out before ">"
	IDPB D,A
	SOJG C,MAIL1		;loop til term. or count
	 JRST MAISY4		;path too long
MAIL2:	SETZ D,
	IDPB D,A		;replace with a null
	MOVEI A,2		;move on to state of 2
	MOVEM A,STATE
	JSP B,RPCRLP
	REPIZ /250 Proceed with recipients./

	SUBTTL RCPT Command
ZRCPT:	MOVE A,STATE		;ensure correct command sequencing
	CAIE A,2
	 CAIN A,3
	  CAIA			;state o.k.
	JRST OOORD
;parse argument "TO:"
	MOVEI P1,RCPTAB		;TABLE OF KNOWN ARGS
	HRLI P1,-1		;NUMBER OF THEM
	PUSHJ P,GETARG		;LOOK FOR ARG IN TABLE
	  JRST RCPSYN		;SYNTAX ERROR
	  JRST RCPSYN		;ARGUMENT NOT IN TABLE
	HRRZ C,RCPTAB(B)	;DISPATCH FOR THIS ARG
	JRST 0(C)		;GO TO IT (M$FROM)

RCPTAB:	KM (R,<TO>)

RCPSYN:	JSP B,RPCRLP
	REPIZ /501 Syntax error.  Must use "RCPT TO:"./
EXMXRC:	JSP B,RPCRLP
	REPIZ /552 Too many recipients./
RCPSY1:	JSP B,RPCRLP
	REPIZ /553 Not accepted.  Forwarding unsupported./
RCPSY5:	JSP B,RPCRLP
	REPIZ /501 Path empty./


R$TO:	LDB A,SBP		;GET THE CURRENT CHARACTER
	CAIE A,":"		;IS IT A colon?
	 JRST RCPSYN		;syntax error then
	ILDB A,SBP		;GET THE CURRENT CHARACTER
	CAIE A,"<"		;IS IT A left angle bracket?
	 JRST MAISY2		;syntax error
	MOVE P1,NRCPTS		;number of recpients already
	CAIL P1,MAXRCP
	 JRST EXMXRC		;over limit
	IMULI P1,PTHLEN		;offset into RCPBUF
	SETZM RCPBUF(P1)	;SEE IF ARG WINS. CLEAR recp. path
	MOVSI A,(POINT 7,)	;form pointer
	HRRI A,RCPBUF(P1)	;to correct entry
	MOVE B,SBP
	MOVEI C,<5*PTHLEN>	;max chars
RCPT1:	ILDB D,B		;get char
	CAIN D,">"
	 JRST RCPT2		;terminator found
	CAIN D,0
	 JRST MAISY3		;line ran out before ">"
	CAIE D,":"		;colon?
	CAIN D,","		;comma?
	 JRST RCPSY1		;forwarding not impl.
	IDPB D,A
	SOJG C,RCPT1		;loop til term. or count
	 JRST MAISY4		;path too long
RCPT2:	SETZ D,
	IDPB D,A		;replace with a null
	SKIPN RCPBUF(P1)	;THERE WAS A path, WASNT THERE?
	 JRST RCPSY5
	MOVEI A,3		;move on to state of 3
	MOVEM A,STATE
	AOS NRCPTS
	JSP B,RPCRLP
	REPIZ /250 Accepted./

	SUBTTL ZDATA Command
;some time flush bit R.XRCP which means "am processing
;an XRCP command in MAIL code

ZDATA:	MOVE A,STATE		;ensure correct command sequencing
	CAIE A,3
	 JRST OOORD		;command out of sequence

	HRROI A,GTJSTR		;BUILD A NAME FOR TEMP FILE FOR MAIL.
	HRROI B,[ASCIZ /<MAIL>--MAIL--./]
	MOVEI C,0
	SOUT
	HRRZ B,GJINF3		;JOB NUMBER
	MOVEI C,12		;DECIMAL
	NOUT			;INTO FILENAME
	  JRST MLX10		;IMPOSSIBLE FAILURE
	MOVEI B,"-"
	BOUT
	MOVE D,A		;SAVE A
	HRROI A,-5		;whole job
	RUNTM			;runtime
	MOVE B,A		;into B
	MOVE A,D		;restore pointer
	MOVEI C,10		;octal
	NOUT
	  JRST MLX10		;supposedly impossible
	HRROI B,[ASCIZ /;T;P770000/]	;AND MAKE JOB DEPENDENT.
	MOVEI C,0
	SOUT
MAIL01:	MOVSI A,411001		;GTJFN SHORT, STRING, OUT, TEMP, IG DEL.
	HRROI B,GTJSTR		; ..
	GTJFN
	  JRST MAILX9		;CAN'T?
	MOVEM A,LCLJFN		;STORE JFN
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
	MOVE B,[070000,,100000]	;OPEN TO WRITE.
	OPENF
	  JRST MAILX9		;CAN'T?
	MOVEI C,0
repeat 0,<
	HRROI B,[ASCIZ /Return-path: </]
	SOUT
	HRROI B,RVPATH
	SOUT
>;repeat 0
;	HRROI B,[ASCIZ />
	HRROI B,[ASCIZ /Received:  from /]
	SOUT
	MOVE B,FHSTN		;NOW PUT A TIME-STAMP ON. FIRST, HOST.
	PUSHJ P,.CVHST		;Output host name/number
	HRROI B,[ASCIZ / by /]
	MOVEI C,0
	SOUT
	HRROI B,LHSTNM
	SOUT
	HRROI B,[ASCIZ \ via DDN;  \]
	SOUT
	MOVSI C,(1B7+1B13)
	SETO B,
	ODTIM
	HRROI B,CRLFM		;AND END LINE
	MOVEI C,0
	SOUT
	HRROI B,[REPIZ /354 Type mail, ended by a line with only a dot.
/]
	PUSHJ P,SDUMPA		;SEND MSG AND DUMP BUFFER
	TLO F,L.DVSC		;indicate not reading commands
MAILL1:	PUSHJ P,LINEIN		;NOW READ TELNET LINES.
	  JRST [TLNE F,L.LTL
		JRST MAILX6
		JRST MAILX8 ]	;EOF ON TELNET. ABORT.
MAIL1A:
;;;	MOVEI A,101
;;;	CFOBF

	MOVE A,CMDIB		;SEE IF LINE WAS JUST A DOT
	CAMN A,[ASCII /./]	; ..
	JRST MAIL02		;YES. DEFINES END.
	MOVE A,LCLJFN
	MOVE B,[POINT 7,CMDIB]	;pointer to line
	ILDB C,B		;leading char
	CAIE C,"."		;strip leading period
	 HRROI B,CMDIB		;PUT THE LINE IN THE TEMP FILE
	MOVEI C,0
	SOUT
	HRROI B,CRLFM		;AND A CR LF WHICH WAS STRIPPED
	SOUT
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
	JRST MAILL1		;LOOP TILL DOT OR EOF
; Comes here when text all written to temp file.

MAIL02:	TLZ F,L.DVSC		;indicate now reading commands
	HRRZ A,LCLJFN		;get jfn
	RFPTR			;CHECK SIZE OF THE MAIL
	  JRST MAILX9		;CAN'T FAIL
;	ASH B,3			;EIGHT BITS PER
;	ADDM B,TRBITS
;	ASH B,-3
	CAIL B,^D125000		;DON'T ALLOW SUPER-HUGE FILES.
	 JRST [ CLOSF		;close the file and fail
		JFCL
		JRST MAILX5]
	HRLI A,(1B0)		;MAIL FILE. CLOSE THE WRITE.
	CLOSF			;BUT KEEP THE JFN
	  JFCL
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
	HRRZ A,LCLJFN
	MOVE B,[070000,,200000]	; ..
	OPENF
	  JRST MAILX9		;CAN'T

;;;;loop here per recipient
	MOVE P1,NRCPTS		;number of recipients to do
DODATA:
	TLZ F,L.MFWD		;ASSUME NOT FORWARDING
	PUSHJ P,RCPRQ		;parse recipient
	MOVEI A,3		;xlate name to number
	HRROI B,XMHOST		;parsed host
	GTHST
	 JRST MLFWQ		;dump on xmailr
	CAME C,LHOSTN		;local?
	 JRST MLFWQ		;no
;- APPENDS MAIL TO MESSAGE.TXT;1 FOR LOCAL USER
;;	CLOSE LCLJFN		;5   "

	HRROI A,GTJSTR		;NOW MAKE THE DESTINATION NAME
	MOVEI B,"<"		;STICK IN USER NAME
	BOUT
	HRROI B,XMADDR		;NAME FROM COMMAND
	MOVEI C,0
	SOUT			; ..
	HRROI B,[ASCIZ />MESSAGE.TXT;1/]
	MOVEI C,0
	SOUT
;FALL THRU
;FALLS THRU
	MOVSI A,501001		;SEE IF MAILBOX EXISTS
	HRROI B,GTJSTR
	GTJFN
	  JRST MLFWQ		;IT DOESN'T. SEE IF FORWARDING EXISTS.
	MOVE B,[XWD 1,1]	;MAKE SURE ALLEGED MAILBOX IS
	MOVEI C,C		; PERMANENT. IF NOT, PRETEND
	GTFDB			; IT DOESN'T EXIST
	TLNN C,(1B1)
	JRST [	RLJFN
		  JFCL
		JRST MLFWQ]
	RLJFN			;RELEASE MAILBOX JFN
	  JFCL
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
	MOVEI A,0
	HRROI B,XMADDR		;OK, GET DIRECTORY NUMBER
	STDIR			;SEE IF HE EXISTS
	  JRST MLX10		;NO
	  JRST MLX10		; ..
	HRRZM A,MLUSR		;SAVE THE DIRECTORY NUMBER
	MOVEI A,(A)		;JUST THE NUMBER
repeat 0,<
	CAMN A,SYSDNM		;SYSTEM DIRECTORY?
	 JRST MAILX4		;YES. REFUSE IT.
>;repeat 0

repeat 0,<
;set string to be message file
	HRROI A,GTJSTR		;NOW MAKE THE DESTINATION NAME
	MOVEI B,"<"		;STICK IN USER NAME
	BOUT
	HRRZ B,MLUSR		;HIS DIRECTORY NUMBER
	DIRST
	  JRST MLX10		;SHOULDNT FAIL
	HRROI B,[ASCIZ />MESSAGE.TXT;1/]
	MOVEI C,0
	SOUT
>;repeat 0
;FALLS THRU
;FALLEN INTO FROM ABOVE
	MOVEI X,5		;TIMES TO TRY IF BUSY
	JRST MAIL2B
MAIL2A:	MOVEI A,^D2000
	DISMS
MAIL2B:	HRROI B,GTJSTR		;NOW GET A JFN FOR MAILBOX
	MOVSI A,501001
	TLNE F,L.MFWD		;FORWARDING?
	TLZ A,101000		;YES. ALLOW NEW FILE
MAIL2C:	GTJFN
	  JRST MLFWQ		;attempt to queue
	PUSH P,A		;KEEP ON STACK
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
	MOVE B,[070000,,020000]	;APPEND TO IT.
	OPENF
	  JRST [POP P,A		;CAN'T
		RLJFN
		  JFCL
		SOJG X,MAIL2A
		 JRST MLFWQ]	;try and queue
	MOVE A,LCLJFN		;GET # OF CHARS IN TEMP FILE
	SIZEF
	  JRST [POP P,A
		CLOSF
		  JFCL
		JRST MLX10]
	MOVEM B,T1		;SAVE # CHARS IN T1
	TLNN F,L.MFWD		;FORWARDING?
	 JRST MAIL3A		;no
	 	MOVE A,(P)	; Get back the jfn we need
		HRROI B,[ASCIZ /NET-MAIL-FROM-HOST:/]
		SETZ C,
		SOUT
		PUSHJ P,HSTOUT
		HRROI B,CRLFM
		SETZ C,
		SOUT
		MOVEI B,14	; Yes, start with formfeed
		BOUT
		HRROI B,XMHOST	; Insert host name
		SOUT
		HRROI B,CRLFM	; Delimit host name from address with CRLF
		SOUT
		HRROI B,XMADDR	; Insert address
		SOUT
		HRROI B,CRLFM	; End of this address
		SOUT
		MOVEI B,14	; Final formfeed
		BOUT
		HRROI B,CRLFM	; Empty host name, to say message starts here
		SOUT
		JRST MAIL3B

MAIL3A:
	MOVE A,0(P)		;MESSAGE FILE
	SETO B,0		;PUT STANDARD MSG FILE FORMAT ON.
	MOVSI C,(1B13)		;FIRST, DATE AND TIME WITH TIME ZONE.
	ODTIM
	MOVEI B,","		;THEN COMMA
	BOUT
	MOVE B,T1		;SIZE OF TEXT
	MOVEI C,12		;DECIMAL RADIX
	NOUT
	  MOVE A,0(P)
	MOVEI B,";"		;NOW BIT FLAG FIELD
	BOUT
	SETZ B,			;IS NORMALLY 0.
	MOVE C,[1B2+1B3+^D12B17+^D8] ;12 OCTAL DIGITS, LEADING 0'S.
	NOUT
	  MOVE A,0(P)
	HRROI B,CRLFM
	MOVEI C,0
	SOUT			;AND CR, LF ON END OF LINE
;FALL THRU
MAIL3B:
;actually do the output to the file here
	MOVE A,LCLJFN

;	MOVE B,T1		;COUNT 8-BIT CHARS, THOUGH INCLUDES
;	IMULI B,10		; SMALL ERROR OF LOCAL HEADER
;	ADDM B,IBITCT
;	ADDM B,TRBITS
MLLUP1:	PUSHJ P,TIMEOK		;LOOP TO COPY FROM TEMP TO MSG FILE
	SKIPG C,T1		;# OF CHARS LEFT TO COPY
	JRST MAIL03		;NO MORE
	CAILE C,5000		;IF > 1 PAGE, JUST DO PAGE
	MOVEI C,5000
	SUB T1,C		;ADJUST # REMAINING CHARS
	MOVE A,LCLJFN		;SET UP TO READ FROM TEMP FILE
	HRROI B,WINDOW		; INTO WINDOW
	PUSH P,C		;SAVE # CHARS TO READ
	MOVNS C			;MAKE COUNT NEGATIVE
MLLUP2:	SIN			;READ
	POP P,C			;# OF CHARS READ
	MOVNS C			;WRITE THEM TO MSG FILE
	HRROI B,WINDOW
	MOVE A,0(P)
	SOUT
	JRST MLLUP1		;LOOP FOR MORE

MAIL03:	POP P,A
	CLOSF
	  JFCL
;	PUSHJ P,MLSTAT		;RECORD MAIL STATISTICS
;	TLO F,L.NALO		;NO AUTOLOGOUT, NOW. MAY BE MAILER.
	HRRZ A,LCLJFN
	SETZ B,
	SFPTR
	 JRST MAILX9

	SOJG P1,DODATA		;loop to next recipient
	PUSHJ P,DRSET		;set state down, clear recipient number
	HRROI X,MAILM2		;MAIL DONE.
	JRST MAIL05
MAILM2:	ASCIZ /250 Mail queued successfully./
	SUBTTL MAIL QUEUEING
RCPRQ:
	TLNE F,L.MFWD	;FORWARDING?
	JRST MLX10
	MOVEI A,-1(P1)		;to current recipient
	IMULI A,PTHLEN
	ADDI A,RCPBUF
	HRLI A,(POINT 7,)	;form pointer
	PUSH P,A		;preserve pointer
	SETZ D,			; No pointer yet
RCPRQ0:	ILDB C,A		; Get byte of address
	CAIE C,"%"		; Alternative delimiter?
	 CAIN C,"@"		; Seen a host delimiter?
	  MOVE D,A		; Yes, remember it
	JUMPN C,RCPRQ0		; Charge on until end of string
	JUMPN D,RCPR00		; If a hostname pointer found, use it
	SKIPA D,[POINT 7,LHSTNM]; Otherwise use local host name
RCPR00:	 DPB C,D		; Patch last @ to nul to terminate user string
	POP P,A			;retrieve pointer
	MOVE B,[POINT 7,XMADDR]
RCPR01:	ILDB C,A
	IDPB C,B
	JUMPN C,RCPR01
	SKIPA B,[POINT 7,XMHOST] ; Now copy host name
RCPR04:	 MOVE D,[POINT 7,LHSTNM]
RCPR03:	ILDB C,D
	JUMPE C,RCPR04		; Null host name?  Default to local if so
	CAIE C,11		; Ignore leading whitespace (tab, space)
	 CAIN C," "
	  JRST RCPR03
	IDPB C,B
RCPR02:	ILDB C,D
	CAIN C,"."		;beginning of domain?
	 PUSHJ P,DODOMA		;yes, process
	IDPB C,B
	JUMPN C,RCPR02		; Loop until done
	POPJ P,

DODOMA:	MOVEI A,5		;limit 5 chars
	PUSH P,B		;preserve place in dest.
	PUSH P,D		;preserve place in source
	MOVE B,[POINT 7,T1]	;temp dest.
DODOM1:	ILDB C,D
	TRZ C,40		;upper case
	IDPB C,B
	SKIPE C			;end of host terminates
	SOJG A,DODOM1		;loop til exhaust count
	SETZ C,			;assume can leave off .ARPA
	CAME T1,[ASCIZ/ARPA/]	;ARPA?
	 MOVEI C,"."		;no--continue, copy domain w/host
	POP P,D
	POP P,B
	POPJ P,



MLFWQ:
	HRROI A,GTJSTR
	CALL BLDQNM		; Build a queued mail file name
	TLO F,L.MFWD
	PUSHJ P,TIMEOK		; Update kill time
	MOVEI X,1		;only try once if forwarding
	JRST MAIL2B

; Build a unique queued mail file name.  Destination pointer to name in A.
; Generated name is of the form:
;	<MAIL>[--INCOMING-NETMAIL--].Jjj-ddddddtttttt;-1;P770000
BLDQNM:	HRROI B,[ASCIZ/<MAIL>[--INCOMING-NETMAIL--].J/]
	SETZ C,
	SOUT
	HRRZ B,GJINF3		; Insert job number for unique name
	MOVEI C,^D10
	NOUT
	 NOP
	MOVEI B,"-"		; Hyphen delimiter
	IDPB B,A
	PUSH P,A		; Save string pointer
	GTAD			; Get system date/time
	MOVE B,A		; Now output it in octal
	POP P,A
	MOVEI C,^D8
	NOUT
	 NOP
	HRROI B,[ASCIZ/;-1;P770000/]
	SETZ C,
	SOUT
	RET

MAILX4:	JSP	X,MAIL05
MAILM4:	REPIZ /550 No such mailbox at this site./
MAILX5:	JSP	X,MAIL05
MAILM5:	REPIZ /552 Message exceeds 125,000 byte limit./
MAILX6:	JSP	X,MAIL05
MAILM6:	REPIZ /500 Line too long./


MAILX8:

;	JSP	X,MAIL05
;MAILM8:	REPIZ /453 Net connection closed./

MAILX9:
MLX10:;here when a problem arises likely to be queued netmail file

	JSP	X,MAIL05
MLM10:	REPIZ /451 Impossible error while queuing./

MAIL05:
	SKIPGE A,LCLJFN
	 JRST MAIL5Z
	MOVE A,LCLJFN		;CLOSE OUT THE TEMP FILE.
	HRLI A,400000
	CLOSF
	  JFCL
	HRRZ A,LCLJFN
	DELF
	  JFCL
	CLOSE LCLJFN		;5 Moved here so XRCP can avoid.
MAIL5Z:
MAIL04:	HRROI B,(X)		;REPLY TO CORRECT AC
	JRST RPCRLP		;BACK TO TOP LEVEL
	SUBTTL MAIL STATISTICS
repeat 0,<
;RECORD MAIL STATISTICS IF APPROPRIATE

MLSTAT:	RET			; [SRI] we don't want the mail stats.
	SKIPE DBUGSW		;RETURN IF DEBUGGING
	  POPJ P,0
	MOVEI A,0		;SEE IF MAIL2 DIRECTORY EXISTS
	HRROI B,[ASCIZ /MAIL2/]
	STDIR			; ..
	 JFCL
	 TDZA A,A
	SETO A,0		;IT DOES
	PUSH P,A		;REMEMBER IT
	SETO B,			;CALCULATE VERSION NUMBER FOR
	MOVSI D,(1B0+1B2+0B17)	; STATISTICS FILE BASED ON GMT DATE
	ODCNV
	MOVE A,C		;SAVE DAY OF WEEK IN RH, AND
	HRL A,D			;GMT SECONDS SINCE MIDNIGHT IN LH
	MOVEM A,MLTIMT		; IN A TIME TEMP CELL
	HRRZ A,B		;MONTH
	AOS A
	IMULI A,^D100
	HLRZ B,B		;YEAR
	IDIVI B,^D100
	ADD A,C			;VERSION=MMYY
	TLO A,(1B17)		;SHORT FORM GTJFN
	HRROI B,[ASCIZ /<SYSTEM>MAIL.BLOG/]
	SKIPGE 0(P)		;DOES MAIL2 EXIST?
	HRROI B,[ASCIZ /<MAIL2>MAIL.BLOG/]	;YES. USE IT
	POP P,(P)		;DISCARD THAT FLAG
	GTJFN
	  POPJ P,0		;CAN'T, GIVE UP
	MOVEM A,LOGJFN		;SAVE JFN
	MOVE B,[1B19+1B20+1B25]	;READ,WRITE,THAWED
	OPENF
	  JRST MLSTA2		;CAN'T, GIVE UP
	HRL A,LOGJFN		;MAP PAGE 1 OF STATISTICS FILE
	HRRI A,1
	MOVE B,[400000,,<WINDOW/1000>]
	MOVSI C,140000		;READ/WRITE
	PMAP
	MOVE A,FHSTN		;INCREMENT # OF MSGS RECEIVED
	AOS WINDOW(A)		;FROM THIS HOST
	SETO A,			;UNMAP PAGE
	PMAP
	HRL A,LOGJFN		;MAP PAGE 3 OF FILE
	HRRI A,3
	PMAP
	MOVE A,LCLJFN		;GET # OF CHARS IN MESSAGE
	SIZEF			;=LENGTH OF LOCAL FILE
	  SETZ B,		;SHOULDN'T FAIL
	PUSH P,B		;SAVE THE SIZE
	MOVE A,FHSTN		;ADD TO # OF CHARS RECEIVED
	ADDM B,WINDOW(A)	;FROM THIS HOST
	SETO A,			;UNMAP PAGE
	MOVE B,[400000,,<WINDOW/1000>]
	PMAP
;FALL THRU
;FALLS THRU
	HRL A,LOGJFN		;MAP PAGE 4 OF FILE
	HRRI A,4
	MOVSI C,140000		;READ/WRITE
	PMAP
	MOVE C,MLUSR		;NUMBER OF USER RECEIVING MAIL
	IDIVI C,^D36		;CALCULATE WORD AND BIT
	MOVSI A,400000		; CORRESPONDING TO USER #
	MOVNS D
	ROT A,(D)
	IORM A,WINDOW+200(C)	;TURN ON BIT FOR THAT USER
	SETO A,			;UNMAP PAGE
	PMAP
	MOVS A,LOGJFN		;NOW THE TIME-HISTOGRAM PAGES
	HRRI A,10		;PAGE 10 IS CHARS BY TIME OF DAY
	MOVE B,[400000,,<WINDOW/1000>]
	MOVSI C,140000		;READ AND WRITE ACCESS
	PMAP
	HLRZ A,MLTIMT		;GET THE TIME WITHIN DAY
	IDIVI A,^D<60*30>	;THE HALF-HOUR WITHIN THE DAY
	HRRZ D,MLTIMT		;THE DAY IN THE WEEK (MONDAY = 0)
	IMULI D,^D48		;SKIP N DAYS OF HALF-HOURS
	ADD D,A			;AND ADD IN TODAY'S HALF-HOURS
	POP P,A			;GET BACK LENGTH OF MSG
	ADDM A,WINDOW(D)	;RECORD IT
	MOVS A,LOGJFN		;NOW COUNT MSGS BY TIME OF DAY
	HRRI A,7		;IN THIS PAGE
	MOVE B,[400000,,<WINDOW/1000>]
	MOVSI C,140000		;READ AND WRITE ACCESS
	PMAP
	AOS WINDOW(D)		;COUNT A MSG
	MOVEI A,400000		;NOW GET RUN TIME OF THIS FORK
	RUNTM
	SUB A,IFRKTM		;SINCE STARTED
	SUB A,MALCPU		;LESS ANY POSSIBLE PREVIOUS MSG
	ADDM A,MALCPU		;UPDATE FOR THIS MSG
	ADDM A,WINDOW+777	;COUNT IT IN TOTAL, LAST WD THIS PG
	SETO A,			;UNMAP PAGE
	MOVE B,[400000,,<WINDOW/1000>]
	PMAP
MLSTA2:	CLOSE LOGJFN		;CLOSE STATISTICS FILE
	POPJ P,0
>;repeat 0

	SUBTTL XSEN Command handling
ZXSEM:	; For time being, XSEM = XSEN.
ZXSEN:
	; Get argument (name to send to) and check it.
	PUSHJ P,SST		; Push SBP to start of name.
	SETZ A,			; Using exact match,
	MOVE B,SBP		; look at argument
	STDIR			; to see what directory # is if any.
	 JRST MAILX4		; Foo, no such luser.
	 JRST MAILX4		; shouldn't happen, not using partial match.
	JUMPL A,MAILX4		; Also jump if directory is files-only.
	MOVEI A,(A)		; 10X dir numbers are 18-bit.
	MOVEM A,MLUSR		; Aha, save dir number!

	; See if online now
	PUSHJ P,ONLINE		; Scan tables etc.
	JUMPE A,XSENX7		; If not online, jump...

	; Online, collect message text into buffer
	HRROI B,[ASCIZ /350 User online, send message ended by a line with only a "."
/]
	PUSHJ P,SDUMPA		; Invite data over
	PUSHJ P,MSGBEG		; Set up buffer for reception
	PUSHJ P,MSGCOL		; Yum yum
	 JRST MAILX5		; Ugh, message too long... ran out of room.
	
	; Text collection done, first try to stuff into SENDS.TXT file
	; safely out of way, but don't barf if can't.
	SETZM MLERRC		; Clear error indicator
	MOVE A,SBP		; Get BP to name, which coincidentally is
	PUSHJ P,WRTSND		; name of dir to write msg into!
	 MOVEM A,MLERRC		; If hit error, save code.

	; OK, now again check for online TTY numbers just before sending.
	MOVE A,MLUSR
	PUSHJ P,ONLINE		; Return list of TTY's in A.
	JUMPE A,XSENX7		; Fooey, must have gotten wise to us.
	MOVE D,A

	; Send message to TTYs if possible.
	SETZ T1,		; clear cnt of wins
XSEN4:	MOVEI A,.TTDES
	ADD A,(D)		; Get terminal designator
	PUSHJ P,TIMEOK
	DOBE			; Wait until can get at him. (may bomb...)
;	 ERJMP XSEN5		; Hmm, something wrong? ignore it.
	HRROI B,MSGBUF		; Can send, get pointer to message
	MOVEI C,$MBFLN
	SUB C,MSGCNT		; and cnt of chars in it
	SOUT			; and send it!
	AOS T1			; Bump count of times sent.
XSEN5:	AOBJN D,XSEN4
	JUMPLE T1,XSENX9	; Jump if didn't send to any.

	; Successfully sent message, one last check...
	SKIPE A,MLERRC		; was there an error in writing SENDS.TXT?
	 CAIE A,OPNX9		; and was it "invalid simult access"?
	  JRST XSEN9		; If not or no error, return straightaway.

	; Hmm, try a little harder to get SENDS.TXT written.
	MOVEI X,5	; # times to try
XSEN7:	MOVE A,SBP	; Luser name.
	PUSHJ P,WRTSND	; Try again.
	 JRST [	CAIE A,OPNX9
		 JRST .+1	; Leave loop if strange error,
		SOJLE X,.+1	; or if tried enough times.
		MOVEI A,^D2000	; Wait 2 sec each time
		DISMS
		JRST XSEN7]

	; Return reply indicating success.
XSEN9:	JSP B,RPCRLP
	ASCIZ /256 Message sent successfully./

XSENX7:	JSP B,RPCRLP
	ASCIZ /453 User not online now./
XSENX8:	JSP B,RPCRLP
	ASCIZ /453 User is refusing./
XSENX9:	JSP B,RPCRLP
	ASCIZ /453 Message not sent - user now gone or refusing./
; Auxiliaries for XSEN - online checks, defs etc.

	; These defs are used by XSEN, copied from 20X version.
.PRIIN==:100		; Primary input JFN
.TTDES==:400000		; Universal terminal code
TT%ALK==:1B26		; Allow-links bit in mode word
GS%EOF==:1B8		; At EOF on read
GJ%SHT==:1B17		; Short form GTJFN
OF%APP==:1B22		; Append mode in OPENF


	; ONLINE - takes dir # in A, returns in A an AOBJN
	; pointer to list of TTY's logged in under that directory.
ONLINE:	MOVE D,A		; Get # out of way
	SKIPN C,DIRTBN		; Get JOBDIR table number, if have it
	 JRST [	MOVE A,[SIXBIT /JOBDIR/]	; and ask system if don't.
		SYSGT
		JUMPE B,HANGUP	; Impossible error?
		MOVEM B,DIRTBN	; Save table number and count
		MOVE C,B
		JRST .+1]

	; Now start searching JOBDIR table
	SETZM ONLNPT		; Clear ptr to TTY's found.
	HLLZS C			; Fix up AOBJN thru jobdir table.
ONLIN4:	MOVE A,DIRTBN		; Get JOBDIR table #
	HRLI A,(C)		; Set up <index>,,<tbl #>
	GETAB			; Get the entry = <conn dir #>,,<log dir #>
	 JRST [	SETZ C,		; If failed,
		JRST ONLIN8]	;   exit loop.
	CAIE D,(A)		; Compare dir num in RH with target.
	 JRST ONLIN8		; Nope, try next.
	SKIPN A,TTYTBN		; Get # for JOBTTY table if have it,
	 JRST [	MOVE A,[SIXBIT /JOBTTY/]	; and get from system if not.
		SYSGT
		JUMPE B,HANGUP
		MOVEM B,TTYTBN
		MOVE A,B
		JRST .+1]
	HRL A,C			; Stick job index in LH, have table # in RH
	GETAB			; Get table entry.
	 JRST ONLIN8		; If error, pretend no TTY there.
	JUMPL A,ONLIN8		; Jump if job detached.
	HLRZS A
	SKIPN B,ONLNPT		; Get aobjn ptr to TTY table
	 JRST [	MOVEI B,ONLNTB	; If first time, must fix it up.
		MOVEM B,ONLNPT
		JRST ONLIN6]
	CAME A,(B)
	 AOBJN B,.-1
	JUMPL B,ONLIN8		; Jump if TTY already in table.
ONLIN6:	MOVEM A,(B)		; Not found in table, store in 1st free slot
	MOVSI A,-1
	ADDM A,ONLNPT		; Add one to AOBJN count.
	CAIL B,ONLNTB+$OLNTL	; If stuck this one into last slot,
	 JRST ONLIN9		; time to return.

ONLIN8:	AOBJN C,ONLIN4		; search all of jobdir table.

ONLIN9:	SKIPL A,ONLNPT		; Return AOBJN pointer
	 SETZ A,		; Or zero.
	POPJ P,

	; TTYACP - Takes AOBJN ptr to TTY list (as returned by ONLINE) in A,
	;	skips if at least one is accepting links.  Fails if none
	;	are accepting links.  Doesn't clobber A.
TTYACP:	PUSH P,A
	MOVE D,A
TTYAC4:	MOVEI A,.TTDES
	ADD A,(D)	; Get JFN for terminal descriptor
	RFMOD		; Get mode word for terminal
	TRNE B,TT%ALK	; Allowing links?
	 AOSA -1(P)	; Yes, skip out and do a skip return.
	AOBJN D,TTYAC4	; Hmm, if not check all TTY's on list.
	POP P,A
	POPJ P,

	; MSGBEG - Set up initial string in message buffer.

MSGBEG:	MOVE A,[440700,,MSGBUF]
	HRROI B,[ASCIZ /TTY message from net site /]
	SETZ C,
	SOUT
	PUSHJ P,HSTOUT
	SETZ C,
	HRROI B,[ASCIZ /:
/]
	SOUT
	MOVEM A,MSGBPT		; Store updated BP into buffer.
	HRROI B,MSGBUF
	PUSHJ P,PTRDIF		; Get BP pointer difference into C
	SUBI C,$MBFLN		; Get -# chars left in buffer
	MOVMM C,MSGCNT		; Store # chars left as count.
	MOVEI A,1
	MOVEM A,MSGLNS		; Start count of # lines.
	POPJ P,


	; MSGCOL - Collect message text over command connections.
	; Gobbles into core until usual "." line seen.

MSGCL3:	AOS MSGLNS	; Increment line cnt
	PUSHJ P,TIMEOK	; Bletcherous crock
MSGCOL:	PUSHJ P,GETLIN
	 POPJ P,	; If ran out of room, nonskip return.
	CAIE C,3	; "." check requires line length 3 exactly
	 JRST MSGCL3	; Nope, get another line.
	ILDB D,B	; Get single char of line
	CAIE D,"."	; check
	 JRST MSGCL3	; Nope, keep going...
	ADDM C,MSGCNT	; Aha, found end!  Take last line off count.
	MOVEM B,MSGBPT	; and move bp back.
	AOS (P)		; and skip for win return.
	POPJ P,

	; GETLIN - gobbles line from primary input into MSGBUF, updating
	; MSGCNT and MSGBPT.  Returns count of chars in line (including
	; terminating CRLF or EOL) in C, byte pointer to beginning of line in B.
	; Normally skips; will fail if buffer overflows.
GETLIN:	MOVEI A,.PRIIN
	MOVE C,MSGCNT		; Get count and bp for hacking
	MOVE BP,MSGBPT
GETLN2:	PUSHJ P,GETCH
	IDPB B,BP
	SOJLE C,GETLN7	; Jump if no more room for chars.
	CAIE B,37	; EOL? (on 20X, this would be 15 for CR)
	 JRST GETLN2	; Nope, keep going.
;	PUSHJ P,GETCH	; Hmm, must test next char.
;	JUMPE B,GETLN2	; If null, wanted bare CR.  OK, it's inserted.
;	CAIE B,12	; Linefeed? (should be!)
;	 JRST [	BKJFN	; Nope, must treat like EOL but mustn't lose character.
;		 JFCL	; Just have to hope it wins.
;		JRST GETLN4]
	MOVEI B,15	; 10X only - substitute CRLF
	DPB B,BP	; Replace 37 by 15
	MOVEI B,12	; and insert a LF - end of 10X grossness.

	IDPB B,BP
	SOJLE C,GETLN7
GETLN4:	EXCH C,MSGCNT		; Store count, get old
	SUB C,MSGCNT		; Find # chars in this line.
	EXCH BP,MSGBPT
	MOVE B,BP		; Return BP in B to beg of line.
	AOS (P)
	POPJ P,
GETLN7:	MOVEM BP,MSGBPT		; Buffer overflowed...
	SETZM MSGCNT
	POPJ P,
	
	; Get single char from current source for GETLIN.
GETCH:	BIN
	CAIE B,0	; If null, skip and see if EOF.
	 POPJ P,
	GTSTS		; If null, see if EOF.
	TLNE B,(GS%EOF)
	 JRST HANGUP	; Ugh, die.
	SETZ B,		; no, actual null.
	POPJ P,

	; PTRDIF - Takes BPs in A and B, leaves difference (# chars)
	; in C.  Think of it as A-B => C
	; Won't work for indexed/indirected bp's.
PTRDIF:	PUSH P,A
	PUSH P,B
	TLNE A,7077	; Assume LH -1 if any of these bits set.
	 HRLI A,440700
	TLNE B,7077	; Ditto.
	 HRLI B,440700
	MULI B,5	; Get stuffs
	ADD C,PTRD7P(B)	; and work magic to get canonical pointer
	MULI A,5
	ADD B,PTRD7P(A)	; Ditto for other bp.
	SUBM B,C	; Put A-B in C.
	POP P,B
	POP P,A
	POPJ P,

	133500,,0	; to handle -5 produced by 440700
	BLOCK 4		; never ref'd
PTRD7P:	-54300,,5	; Magic numbers...
	-104300,,4
	-134300,,3
	-164300,,2
	-214300,,1
	; WRTSND - write out message buffer.  A holds BP to directory name.
	;	Skips if successful.  Error return gives err code in A.
	;	maybe later make more general.

WRTSND:	MOVE D,A
	HRROI A,GTJSTR	; Cons up filename into this string
	MOVEI B,"<"
	BOUT
	MOVE B,D
	SETZ C,
	SOUT
	HRROI B,[ASCIZ />SENDS.TXT;0;T/]
	SOUT
	SETZ B,		; Make sure it's ASCIZ.
	BOUT

	; Have filename to hunt for (or create), get JFN etc.
	MOVSI A,(GJ%SHT)	; Short form is all.
	HRROI B,GTJSTR
	GTJFN
	 POPJ P,		; Failed?? non-skip return, err code in A.
	MOVE D,A		; Save JFN
	MOVE B,[7B5+OF%APP]	; Open for appending
	OPENF
	 JRST [	EXCH A,D	; Failed... perhaps simultaneous access.
		RLJFN		; for now, just return.
		 JFCL
		MOVE A,D	; return err code.
		POPJ P,]

	; Hurray, have it open - kick message out.
	MOVEI A,(D)
	HRROI B,MSGBUF		; Get pointer to message
	MOVEI C,$MBFLN
	SUB C,MSGCNT		; and cnt of chars in it
	SOUT			; and send it!
	CLOSF			; Close file (LH = 0)
	 JFCL
	AOS (P)		; Win return.
	POPJ P,

	SUBTTL Numeric Input
;NUMERIC INPUT ROUTINE. DECIMAL UNLESS PRECEDED BY "O" OR "X".

DECIN1:	ILDB C,BP		;SKIP SEPARATOR FIRST
DECIN:	MOVEI A,0		;COLLECT NUMBER HERE
	PUSH P,BP		;SAVE ORIGINAL BYTE POINTER
DECINL:	CAIL C,"0"		;DECIMAL DIGIT?
	CAILE C,"9"		; ..
	JRST DECINX		;NO.
	IMULI A,12		;YES, ACCUMULATE NUMBER
	ADDI A,-"0"(C)		; ..
	ILDB C,BP		;ON TO NEXT CHARACTER
	JRST DECINL		;SEE IF BREAK OR DIGIT
DECINX:	CAMN BP,0(P)		;HAS ANY DIGIT BEEN SEEN?
	JRST RADIXQ		;NO, MAYBE IT'S A LEADING X OR O
	AOS -1(P)		;SAW A DIGIT. SKIP RETURN
	POP P,0(P)		;DISCARD ORIGINAL POINTER
	POPJ P,0		;AND SKIP RETURN

RADIXQ:	CAIE C,"O"		;OCTAL PREFIX?
	CAIN C,"O"+40		;OR LOWER CASE "O"
	JRST OCTIN		;YES. GO READ IT
	CAIE C,"X"		;HEX INPUT?
	CAIN C,"X"+40		; ..
	JRST HEXIN		;YES. GO COLLECT HEX NUMBER
	POP P,(P)		;NO GOOD. DISCARD POINTER ON STACK
	POPJ P,0		;AND GIVE NON-SKIP RETURN

OCTIN:	ILDB C,0(P)		;UPDATE START OF NUMBER, SKIP THE "O"
	MOVE BP,0(P)		; ..
OCTINL:	CAIL C,"0"		;OCTAL DIGIT?
	CAILE C,"7"		; ..
	JRST RADIXX		;NO. QUIT.
	LSH A,3			;YES. ACCUMULATE NUMBER
	ADDI A,-"0"(C)		; ..
	ILDB C,BP		;GET NEXT CHARACTER
	JRST OCTINL		;SEE IF END OF NUMBER
HEXIN:	ILDB C,0(P)		;SKIP THE "X". UPDATE START OF NUMBER
	MOVE BP,0(P)		; ..
HEXINL:	CAIL C,"A"+40		;LOWER CASE LETTER?
	CAILE C,"Z"+40		; ..
	SKIPA			;NO
	TRZ C,40		;YES. MAKE UPPER CASE
	CAIL C,"A"		;NOW, IS IT A HEX DIGIT-LETTER?
	CAILE C,"F"		; ..
	SKIPA			;NO
	SUBI C,"A"-"9"-1	;YES. SQUUNCH DOWN TO DIGITS
	CAIL C,"0"		;DIGIT (INCLUDING A-F)?
	CAILE C,"0"+17		; ..
	JRST RADIXX		;NO
	LSH A,4			;YES. ACCUMULATE NUMBER
	ADDI A,-"0"(C)		; ..
	ILDB C,BP		;ON TO NEXT CHARACTER
	JRST HEXINL		;CONTINUE TILL BREAK CHARACTER

RADIXX:	CAME BP,0(P)		;ANY DIGITS SEEN AT ALL?
	AOS -1(P)		;YES. SKIP RETURN
	POP P,(P)		;DISCARD STARTING BYTE POINTER
	POPJ P,0		; ..


	SUBTTL CONSTANTS
DEFINE M1 (A,B) <
IFNDEF Z'A, <Z'A==NOTIMP>
>
KEYMAC

PDP:	IOWD PDLL,PDL		;STACK POINTER
L1PDP:	IOWD PDLL,L1PDL		;LEV 1 PSI STACK
L2PDP:	IOWD PDLL,L2PDL		;LEV 2 PSI STACK
DBUGSW:	0			;NONZERO FOR DEBUGGING
ONCHNS:	770507,,507777		;CHANNELS ON IN PSI SYSTEM
LEVTAB:	RETPC1			;RETURN PC'S
	RETPC2
	RETPC3
CHNTAB:	REPEAT ^D9,<0>		;FIRST TERM PSI GROUP, OV'S
	1,,PDLINT		;PDLOV
	0			;EOF
	2,,IOXINT		;IO DATA ERROR
	REPEAT 2,<0>		;12,13 UNDEF FILE INT'S
	0			;14 TIME OF DAY
	1,,INSINT		;15 ILLEG INSTRUCTION INT
	REPEAT 3,<1,,MEMINT>	;16-18 MEMORY ILLEGAL REF'S
	0			;FORK TERM
	1,,FULINT		;20 MACHINE SIZE EXCEEDED
	REPEAT 3,<0>		;TRAP TO USER, NEW PAGE, NOT USED
	2,,TIMINT		;24 TIMING FORK INT
	2,,CTCINT		;25 CONTROL C (OR E IN DEBUG)
	2,,DETINT		;26 DETACH INTERRUPT
	REPEAT ^D9,<0>		;UNUSED
IFN <.-44-CHNTAB>,<PRINTX ;CHNTAB NOT 36 LONG>

PATCHX:	NPATCH			;INCREMENT THIS IF BINARY PATCHED

PAT:
PATCH:	BLOCK 200		;FOR PATCHING THE BINARY


;END OF ALL CODE. NOW THE LITERALS.

XLIST ;LIT STATEMENT
LIT
LIST

CODTOP:	;THIS IS THE END OF THIS MODULE EXCEPT FOR PRIVATE PAGES

LOC <<.+777>&777000>	;PAGE BOUNDARY FOR PRIVATE AREAS

	SUBTTL VARIABLES
VARADR==.			;FOR PMAPPING SPACE AWAY

;VARIABLES

RETPC1:	BLOCK 1			;RETURN PC'S FOR PSI SYSTEM
RETPC2:	BLOCK 1
RETPC3:	BLOCK 1			; ..
GJINF1:	BLOCK 1			;RESULTS OF GJINF AT START AND LOGIN
GJINF2:	BLOCK 1
GJINF3:	BLOCK 1
GJINF4:	BLOCK 1
KEYWRD:	BLOCK 1			;THE SIXBIT COMMAND VERB
ARGWRD:	BLOCK 1			;THE SIXBIT ARG FOR SOME COMMANDS
PRVKWD:	BLOCK 1			;PREVIOUS KEYWRD, FOR SEQUENCE-
				; DEPENDANT COMMANDS RNTO, PASS
PI1AC:	BLOCK 20		;STORAGE FOR LEV 1 AC'S
PI2AC:	BLOCK 20		;STORAGE FOR LEV 2 AC'S
PDL:	BLOCK PDLL		;SPACE FOR STACK
L1PDL:	BLOCK PDLL		;ANOTHER ON LEV 1 PSI
L2PDL:	BLOCK PDLL		;AND ANOTHER ON LEV 2

LHSTNM:	BLOCK 20		;LOCAL HOST NAME IN ASCIZ
$USER:	BLOCK 11		;USER NAME TEXT STRING
$PASS:	BLOCK 11		;PASSWORD TEXT STRING
$ACCT:	BLOCK 12		;ACCOUNT WORD OR STRING
ANOPSW:	BLOCK 10		;WHERE TO STORE ANONYMOUS'S PASSWORD 
				; FROM SYSTEM TEXT FILE
PRGJFN:	BLOCK 1			;JFN FROM RMAP OF THIS PROGRAM
TFORKX:	BLOCK 1			;FORK HANDLE OF TIMING FORK
KTIMET:	BLOCK 1			;TIME WHEN JOB WILL BE KILLED BY
				; TIME OF DAY INTERRUPT
IOXFLG:	BLOCK 1			;FLAG SET BY IO ERR PSI
CTCFLG:	BLOCK 1			;FLAG SET BY ^C PSI
LGOCNT:	BLOCK 1			;COUNTER TO FORCE LOGOUT ON TIME.
CMDIB:	BLOCK LCMDIB		;THE TELNET LINE COLLECTED FROM NET
SBP:	BLOCK 1			;BYTE POINTER AS COMMAND IS SCANNED
REPLYM:	BLOCK LREPLY		;AND ANSWER BEING BUILT FOR REPLY
REPLYP:	BLOCK 1			;POINTER TO REPLY BEING BUILT
;SYSDNM:	BLOCK 1			;NUMBER OF SYSTEM
LCLJFN:	BLOCK 1			;JFN OF LOCAL MAIL FILE, TEMP FILES
IBITCT:	BLOCK 1			;BIT COUNT FOR LOGGING
TSBITS:	BLOCK 1			;BITS SENT IN A RETR
	; XMAILR storage
XMADDR:	BLOCK 10		; Save of mail destination address
XMHOST:	BLOCK 20		; Save of mail destination host

XRCPSC:	BLOCK 1			;5 XRCP scheme in use. 0 none, -1 T, +1 R.
XRCPTX:	BLOCK 1			;5 XRCP Saved-text flag. 0 none, -1 collecting,
				;5 +1 saved (LCLJFN points to temp file)

NCPBLK:	BLOCK 20		;#7 GTNCP info block
;      =NCPBLK+.NCIDX		;#7  NCP connection index
; FHSTN= NCPBLK+.NCFHS		;#7  foreign host
; NETLSK=NCPBLK+.NCLSK		;#7  local socket
; FORNS= NCPBLK+.NCFSK		;#7  foreign socket
;      =NCPBLK+.NCFSM		;#7  state of connection
;      =NCPBLK+.NCLNK		;#7  link
;      =NCPBLK+.NCNVT		;#7  NVT, or -1 if none
;      =NCPBLK+.NCSIZ		;#7  byte size of connection
;      =NCPBLK+.NCMSG		;#7  msg allocation
;      =NCPBLK+.NCBAL		;#7  bit allocation
;      =NCPBLK+.NCDAL		;#7  desired allocation
;      =NCPBLK+.NCBTC		;#7  bits transferred
;      =NCPBLK+.NCBPB		;#7  bytes per buffer
;      =NCPBLK+.NCCLK		;#7  time-out countdown
;      =NCPBLK+.NCSTS		;#7  connection status
	; Some stuff for XSEN and friends
DIRTBN:	BLOCK 1		; -len,,num of JOBDIR table
TTYTBN:	BLOCK 1		; -len,,num of JOBTTY table
TBLBUF:	BLOCK ^D100	; For system JOBDIR table
ONLNPT:	BLOCK 1		; AOBJN ptr into ONLNTB table of TTYs
$OLNTL==10		; Max # of TTYs that XSEN can send to (arbitrary)
ONLNTB:	BLOCK $OLNTL	; Table of TTYs specific user is logged in on.
MSGBPT:	BLOCK 1		; Byte pointer into MSGBUF
MSGLNS:	BLOCK 1		; # lines of text in MSGBUF
MSGCNT:	BLOCK 1		; # chars left in MSGBUF
MLERRC:	BLOCK 1		; Error code returned by WRTSND, else zero.

USERST:	BLOCK 20		;NAME STRING OF DIRECTORY FROM CWD
;MLUNST:	BLOCK 20		;NAME OF UNKNOWN MAIL ADDRESSEE
ACTACS:	BLOCK 20		;AC STORAGE FOR FORWARDER FORK
STRTMP:	BLOCK 40		;ANOTHER STRING STORAGE SPACE
DATJFN:	BLOCK 1			;DATA CONN JFN IF MLFL

STABLK:	BLOCK 5			;block for stat jsys

;7 FHSTN:	BLOCK 1			;NUMBER OF FOREIGN HOST
;7 FORNS:	BLOCK 1			;EVEN NUMBERED FOREIGN NVT SOCKET
MYDATS:	BLOCK 1			;CVSKT OF MY DATA CONNECTION
GTJSTR:	BLOCK 40		;SPACE TO BUILD A FILENAME STRING
IFRKTM:	BLOCK 1			;TIME METER FOR LOGGING
LOGJFN:	BLOCK 1			;JFN OF LOG FILE FOR PMAPPING MAIL STAT
LSTJFN:	BLOCK 1			;JFN WHERE LIST OR STAT GOES.
MALCPU:	BLOCK 1			;MORE METERING
;MLFWST:	BLOCK 30		;NAME FOR FORWARDING
LPTSTR:	BLOCK 30		;ARG OF XLPTF COMMAND
MLTIMT:	BLOCK 1			;TEMP FOR GMT TIME COMPUTATION
MLUSR:	BLOCK 1			;DIRECTORY NUMBER OF MAIL RECIPIENT
;7 NBUFN:	BLOCK 1			;GETAB INDEXES FOR NET TABLES
;7 NSTSN:	BLOCK 1			; ..
;7 NETAWD:	BLOCK 1			;TABLE ENTRIES FOR THE NVT
;7 NETLSK:	BLOCK 1			; ..
;7 NETSKX:	BLOCK 1			;INDEX INTO NET TABLES FOR THE NVT
TRBITS:	BLOCK 1			;BITS RECEIVED IN MAIL
LWORDS:	BLOCK 1			;FILE LENGTH IN WORDS
FDBBLK:	BLOCK 30		;AREA TO HOLD AN FDB
FDBBKE=.-1			;END FOR BLT TO CLEAR
JBLOCK:	BLOCK 11		;ARG BLOCK FOR LONG GJTFN
EJBLOK==.-1
JFNTXS:	BLOCK 60		;TEXT STRING FROM JFNS
EJFNTX==.-1
TYXSCT:	BLOCK 1			;SEQUENCE COUNTER FOR TYPE XTP
;DO NOT SEPARATE THE NEXT FEW. THEY ARE THE "TYPE XTP" HEADER
TYXHED:	BLOCK 0			;TAG THE HEADER AREA
CHKSUM:	BLOCK 1			;CHECKSUM OF THE DATA CHUNK
SEQNO:	BLOCK 1			;SEQUENCE NUMBER OF THE CHUNK
TYXNDW:	BLOCK 1			;NUMBER OF DATA WORDS GOES HERE
PAGNO:	BLOCK 1			;PAGE NUMBER IN DISK FILE
ACCESS:	BLOCK 1			;RPACS ARG FOR DISK FILE
RECTYP:	BLOCK 1			;TYPE OF NET CHUNK
TYXHDN==6			;LENGTH OF THIS HEADER
;END OF UNSEPARABLE STUFF
FHSTN:	BLOCK 1			; Foreign (User) Host
LHOSTN:	BLOCK 1			; Local (Server) Host (as User addressed us)
FORNS:	BLOCK 1			; Foreign (User) Port
$JCN:	BLOCK 1			;passed JCN
TMPBUF:	BLOCK 20		;for nouts

INPUT:	BLOCK 1
OUTPUT:	BLOCK 1
TENEX:	BLOCK 1			;nonzero for tenex
STATE:	BLOCK 1			;command state
RVPATH: BLOCK PTHLEN		;Reverse path
NRCPTS: BLOCK 1			;current number of recipients
RCPBUF: BLOCK PTHLEN*MAXRCP

ENTVEC:	GO	
	GO
	OFF3
	BLOCK 1
;NOW THE VARIABLE STORAGE:
VAR

;END OF EVERYTHING

VARTOP:

LOC <<.+777>&777000>

WINDOW:	BLOCK 1000
WINDW2:	BLOCK 1000		;TWO PAGES FOR MAPPING FILES
BLTADR:	BLOCK 1000		;PAGE FOR MAPPING MAILBOX FORWARDER
WINDPN==WINDOW/1000
WND2PN==WINDW2/1000
BLTPAG==BLTADR/1000

MSGBUF:	BLOCK 2000		; Room for collecting message text.
$MBFLN==2000*5			; Max # chars of room in MSGBUF.

IFN .&777,<PRINTX STORAGE NOT ON PAGE BOUNDARIES!!!>


	EXP 123			;CONVINCE LOADER TO PUT SYMBOLS ABOVE HERE