Google
 

Trailing-Edge - PDP-10 Archives - bb-ev83b-bm - tcpip-sources/ftp2s.mac
There are 2 other files named ftp2s.mac in the archive. Click here to see a list.

	MOVX A,<HSBAS/1000>	; Remove access to high segment
	PUSH P,A		; Where the file activity code is
GOSPLP:	MOVX A,<.FHSLF,,0>	; Page in this fork
	HRR A,0(P)		; Here in the address space
	RPACS			; See if the page exists
	TXNN B,PA%PEX
	  JRST GONXTP		; No such page. See if any more.
	MOVX B,1B8		; Access to none, but trap if referenced
	SPACS
GONXTP:	AOS B,0(P)		; On to next page
	CAIGE B,700		; Up to DDT?
	  JRST GOSPLP		; No, discard another one
	POP P,(P)		; Discard page number

	SUBTTL	Re-Initialization

GOBAK:	SETZ F,			; Clear flags
	MOVX A,^D1000		; Sleep a sec
	DISMS

	MOVE A,PREPLY		; Initialize pointer
	MOVEM A,REPLYP		; and store

	GJINF			; See what my condition is & save
	MOVEM A,GJINF1		; 0 since not logged in (or User #)
	MOVEM B,GJINF2		; Connected directory #
	MOVEM C,GJINF3		; Job #
	MOVEM D,GJINF4		; -1 or attached terminal #

	SKIPN A			; Am I logged in already?
	 TXZA F,F.LOGI		; No.
	  TXO F,F.LOGI		; Yes.

	JUMPGE D,INIT1		; Jump if I'm attached.


IFN TCPF,<
	JRST HANGUP
> ; End of IFN TCPF

IFE TCPF,<
	SETO A,			; Not attached, log out if not logged in
	SKIPN GJINF1		; Logged in directory?
	  CALL LOGOUT		; None. Kill off job
	    JFCL
	MOVX A,.PRIOU		; Point to the controlling TTY
	DOBE			; This will hang until attached
	JRST GOBAK		; Go try again.
> ; End of IFE TCPF
	SUBTTL	Re-Initialization, cont.

INIT1:	TXO F,F.TOPN		; TELNET connection is open

	TXNE F,F.LOGI		; If logged in,
	  CALL GETHI		; Map the high seg back in, unwritable.

	MOVX A,.FHSLF		; Get capabilities
	SETOB B,C		; So can enable Control C,
	EPCAP			; And deliver mail
	CALL TIMEOK		; Set up initial time before PSI is on
	SETOM TFORKX		; No timing fork yet
	MOVX A,.PRIIN		; Set the wakeup set for the NVT
	MOVX B,.TTIDL		; Ideal terminal - set for no padding
	SKIPE TENEX		; Except on TENEX, which has no .TTIDL,
	MOVX B,.TTNVT		; Use next best thing, and hope no TELNET
				;  handling gets in the way
	STTYP

	RFMOD			; See what it is
	TXZ B,TT%WKP+TT%WKA+TT%UOC+TT%LIC ; Forget the printing characters
				; Make lower case come in and out ok
	TXO B,TT%WKF+TT%WKN	; Turn on all control char wakeups
	TXO B,TT%MFF+TT%TAB+TT%LCA ; Allow lower case, TABs, FF's
	TXZ B,TT%WID+TT%OSP	; Make line width be infinite & half duplex
	SFMOD			; Put the rest back
	STPAR

	MOVX A,<TL%SAB+<0*TL%ABS>+TL%CRO+TL%COR+<0,,-1>>
	MOVEI B,-1		; Refuse and break links
	TLINK
	  CALL BOMB

	SKIPN TENEX		; TOPS-20 lacks ADVIZ
	  JRST INIT1A
				; For TENEX
	MOVE A,GJINF4		; Terminal number
	TXO A,.TTDES		; Designator
	HRLI A,(1B0)		; Clear advice
	JSYS 315 		; ADVIZ
	  CALL BOMB
	JRST INIT1B		; Skip a little TOPS-20 stuff
	SUBTTL	Re-Initialization, cont.
INIT1A:

IFN REL4,<MOVX A,.PRIOU		; For this terminal
	MOVX B,.MOSNT		; We don't want
	MOVX C,.MOSMN		; System messages
	MTOPR
>	; End Release 4 conditional

INIT1B:	MOVX A,.PRIIN		; Set Ctrl chr echoing to all self
	MOVX B,<BYTE (2)2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2>
	MOVE C,B
	SFCOC

	SETZM $STRU
	SETZM $MODE		; For file connection and so on
	SETZM $TYPE		; Initialize all params to default
	MOVX A,^D8		; Default byte size
	MOVEM A,$BYTE

	SETZM $FORM
	SETZM $LTYPE
	MOVX A,^D7
	MOVEM A,$LBYTE
	MOVX A,FILTAB+0
	MOVEM A,$FILLB


	SETOM $PATH1
	SETOM $PATH2
	SETOM $SOCK
	SETOM $HOST
;INIT2:
	SETZM USRFCT		; No bad user names yet
	SETZM PASFCT		; No password failures yet.
	SETZM USERNM		; User ID has not been declared yet
				; ID is	TENEX Directory #
				;  or	TOPS-20 User #
	SETZM $CWD		; No CWD argument yet
	SETOM $ACCES+2		; Always connecting this job
	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 DATCON
	SUBTTL	Once-only Initialization

	SKIPE RESTRT		; Are we restarting? (Came through HANGUP)
	  JRST INIT6		; Yes, skip this next

	SETZM ANOUNO		; No ANONYMOUS User ID
	HRROI B,TXX.AN		; ANONYMOUS
	CALL USRCHK		; Check if ANONYMOUS is a user
	  JFCL
	  SETZ B,		; None if error
	MOVEM B,ANOUNO		; Yes, save the User ID

	SETZM SYSDNM		; See what SYSTEM's User Num is
	HRROI B,TXX.SY		; SYSTEM
	CALL DIRCHK		; See if SYSTEM has a directory
	  CALL BOMB		; What??
	MOVEM B,SYSDNM		; Store it
	SUBTTL	Once-only Initialization, cont.
INIT6:
IFE TCPF,<			; Do the following only if not TCP version
REPEAT 0,<
	MOVE A,T1		; Get the NVT range
	HRLI A,1
	GETAB
	  JRST HANGUP		; Gotta have that too
	HLRE B,A		; Minus number of NVT's
	HRRZ A,A		; First NVT
	MOVMS B			; Compute last NVT
>
	MOVX A,.GTNSZ		; Get NCP connection sizes
	GTNCP
	  JRST HANGUP		; ??
	HLRE B,C		; Extended +# NVTs
	HRRZ A,C		; # First NVT

	ADDI B,-1(A)		; # Last NVT

	MOVE C,GJINF4		; TTY I am on
	CAML C,A		; Am I on an NVT?
	CAMLE C,B
	  JRST NOTNVT		; No.

; Find out the data about this NVT

;WHTNVT:
REPEAT 0,<	; Long way (need on TENEX?)
	MOVX A,<'NETSTS'>	; Ok, find out who has called in.
	SYSGT			; Which requires scanning some tables.
	MOVEM B,NSTSN		; Save the pointer
	MOVX A,<'NETBUF'>	; Another one
	SYSGT
	MOVEM B,NBUFN
	HLLZ X,B		; Loop thru tables
INITL3:	MOVSI A,(X)		; Table index
	HRR A,NSTSN		; Get connection state
	GETAB
	  JRST HANGUP		; Can't fail
	ROT A,4			; Connection state
	ANDI A,17		; Four bit state
	CAIE A,7		; Is it OPENed?
	  JRST INITX3		; No
	MOVSI A,(X)		; Yes. See if connected to this TTY
	HRR A,NBUFN
	GETAB
	  JRST HANGUP		; Can't fail
	CAMN A,GJINF4		; This TTY?
	  JRST FNDNVT		; Found the NVT
INITX3:	AOBJN X,INITL3		; Keep looking
	JRST HANGUP		; Not found!
	SUBTTL	Once-only Initialization, cont.

FNDNVT:	HRRZM X,NETSKX		; Save the index
	MOVX A,<'NETLSK'>	; Get the data about this NVT's connections
	SYSGT
	MOVE A,B
	HRL A,X
	GETAB
	  0
	TRZ A,1			; Save the even numbered socket
	MOVEM A,NETLSK		; Local socket number
	MOVX A,<'NETFSK'>	; Now get the foreign socket
	SYSGT
	MOVE A,B		; Same code...
	HRL A,X
	GETAB
	  0
	TRZ A,1			; Even one of pair
	MOVEM A,FORNS		; Foreign socket
	MOVX A,<'NETAWD'>	; Host is in this table
	SYSGT
	MOVE A,B
	HRL A,X
	GETAB
	  0
	MOVEM A,NETAWD		; Save it
	HLRZ A,A		; Get host
	ANDI A,777
	MOVEM A,FHSTN
>
	MOVX A,.GTNNI		; Get data about this NVT
	MOVE B,GJINF4		; TTY #
	XMOVEI C,NCPBLK		; 30 bit address
	MOVX D,<-20,,0>		; Want 20 words from 0
	GTNCP
	  JRST HANGUP
	MOVE A,.NCLSK+NCPBLK	; Local socket #
	TRZ A,1			; Save the even numbered socket
	MOVEM A,NETLSK		; Local socket number
	MOVE A,.NCFSK+NCPBLK	; Foreign socket #
	TRZ A,1			; Even one of pair
	MOVEM A,FORNS		; Foreign socket
	MOVE A,.NCFHS+NCPBLK	; Foreign host
	MOVEM A,FHSTN

	JRST PSIINI

NOTNVT:	MOVE A,LHOSTN		; Assume local host if not an NVT
	MOVEM A,FHSTN
	SETOM NETLSK		; Hope I don't need socket numbers
	SETOM FORNS
	JRST PSIINI		; Go set up PSI system
> ; End of IFE TCPF conditional
	SUBTTL	Initialize PSI system & create & start timing fork

PSIINI:	MOVX A,<.TICCC,,CTCCHN>	; Assign ^C interrupt
	SKIPE DBUGSW		; or ^E if debugging
	  MOVX A,<.TICCE,,CTCCHN> ; To this channel
	ATI
	MOVX A,<.TICRF,,DETCHN>	; NVT detaching (^D30, Carrier Off)
	ATI			; To this channel
	MOVX A,<.TICCT,,CTTCHN>	; And Control-T
	ATI

	MOVX A,.FHSLF		; Set up PSI system
	MOVX B,<LEVTAB,,CHNTAB>
	SIR
	MOVE B,ONCHNS		; Turn on these channels
	AIC
	MOVX A,.FHSLF		; Now turn the system on
	EIR

;MAKTFK:
	MOVX A,.FHINF		; Kill all inferiors
	KFORK
	SETOM TFORKX		; No timing fork

	MOVX A,CR%MAP!CR%CAP	; Create a fork for timing

	CFORK			; Create it
	  JRST FULL		; If system can't make it
REPEAT 0,<ERJMP FULL ;TOPS-20 use ERJUMP to avoid ITRAPs>

	HRRZM A,TFORKX		; Save the fork index
	RPCAP			; Make sure it can poke me
	TXO B,SC%SUP
	TXO C,SC%SUP
	EPCAP
	MOVEI B,TFRKSA		; Where it starts
	SFORK			; Start it. It will give me time checks
;FALL THRU
	SUBTTL	IPCF Logging Facility

;FALLS IN FROM ABOVE
IFN IPCLOG,<
GETPID:	MOVX A,IP%CPD		; Get a PID for self
	MOVEM A,PIDARG+.IPCFL
GPIDL:	SETZM PIDARG+.ICPFS	; No PID of sender yet
GPID2:	SETZM PIDARG+.ICPFR	; Receiver is 0, ie <SYSTEM>INFO
	MOVX A,<ENDMSG-INFMSG,,INFMSG>
	MOVEM A,PIDARG+.ICPFP	; The data of the message to INFO

	MOVX A,4		; Count
	MOVEI B,PIDARG		; Descriptor
	MSEND			; Get PID of FTSCTL
	 JRST [ MOVX A,^D1000
		DISMS
		JRST GPIDL]
	MOVX B,IP%CPD		; Don't create another
	ANDCAM B,PIDARG+.ICPFL
	MOVE A,PIDARG+.ICPFS	; Stash my new PID
	MOVEM A,MYPID
GETAGN:	SETZM PIDARG+ICPFL	; No flags
	SETZM PIDARG+.ICPFS	; No particular sender
	MOVE A,MYPID		; I am receiver
	MOVEM A,PIDARG+.ICPFR
	MOVX A,<10,,IPCDAT>	; Receive this much data
	MOVEM A,PIDARG+.ICPFP

	MOVX A,4		; Length of descriptor
	MOVEI B,PIDARG		; Addr of descriptor
	MRECV
	  JFCL
	MOVE A,PIDARG+.ICPFL	; Get flags
	ANDI A,7B32
	CAIE A,1B32		; Sent by monitor? <SYSTEM>ICPF .ICPCC
	CAIN A,2B32		; Sent by INFO? <SYSTEM>INFO .ICPCF
	SKIPA			; Yes.
	  JRST GETAGN		; No, not interested.
	MOVE A,PIDARG+.ICPFL
	TRNE A,7 ;IP%CFM	; Was the packet undeliverable?
	  JRST GPID2		; Yes.
	TRNE A,77B29 ;IP%CFE	; Trouble?
	  JRST GETAGN		; Yes.
	MOVE A,IPCDAT+.ICPI1	; Get FTSCTL's PID
	MOVEM A,CTLPID		; Save it.
>

	HRROI A,[ASCIZS (300,220,< >)]
	PSOUT
	MOVX A,.PRIOU		; Output greeting
	HRROI B,VERSTR
	SETZ C,
	SOUT

	HRROI A,[ASCIZ / at /]
	PSOUT
	MOVX A,.PRIOU
	SETO B,0		; Current time stamp
	MOVX C,<OT%DAY+<0*OT%FDY>+OT%NSC+OT%TMZ+OT%SCL>
	ODTIM			; Format of time

	HRROI A,CRLFM
	PSOUT
	JRST GETCOM		; Go read first command
	SUBTTL	Error Replys - NOLINE, SYNERR, ARGSYN, FULL


;	JRST NOLINE	NVT/TVT Detached, thus no reply possible

NOLINE:	GJINF			; See if I got detached
	JUMPL D,HANGUP		; If so, hang up and logout
	JSP B,RPCRLP		; Must be super long line
	ASCIZS (500,500,< Last line was not comprehensible.>)




;	JRST SYNERR	Bad Initial Character in Command Line

SYNERR:	JSP B,RPCRLP		; Syntactical error in command
	ASCIZS (501,500,< Syntax error at start of last command line.>)




;	JRST SYNERR	Bad Character after Verb

SYNER2:	JSP B,RPCRLP
	ASCIZS (501,500,< Syntax error - Character after command verb is bad.>)




;	JRST ARGSYN	Bad Argument Syntax

ARGSYN:	CALL BEGREP		; Here to complain of argument syntax
	ASCIZS (502,501,< Syntax error in argument of >)
	CALL ADDKEY		; Append 6-bit keywrd
	JSP B,RPCRLP		; Close off msg
	ASCIZ / command./
	SUBTTL	Error Replys - BOMB, NVTNLI, FULL

;	CALL BOMB	Fatal Error, return gives PC
;NEVER RETURNS		May be called BEFORE initialized

BOMB:	MOVEM 16,PI3AC+16	; Save ACs
	MOVX 16,<0,,PI3AC>
	BLT 16,PI3AC+15

	POP P,C			; Return
	MOVEI C,-1(C)		; Address w/o flags

	MOVEM P,PI3AC+17

	HRROI B,[ASCIZS (435,421,< Fatal system error at >)]
	MOVEI D,PI3AC
	CALL DMPREG

	HRROI A,[ASCIZ / Goodbye./]
	PSOUT
	JRST HANGUP



;	JRST NVTNLI	Don't allow Network logins

NVTNLI:	JSP B,ERRRPL		; Don't allow the LOGIN - due to TMON
	ASCIZS (453,421,< Network logins not allowed at this time. Please try later.>)



;	JRST FULL	System is Full

FULL:	JSP B,ERRRPL		; Cause hangup after sending this
	ASCIZS (401,421,< Service full, please try later. Goodbye.>)
	SUBTTL	Reply Subroutines - BEG/ADDREP, ADDARG, ADDKEY, SYNER2

;	CALL ADDREP or BEGREP	Add to or begin a new reply message
;	ASCIZ /.../
;	<RETURN HERE>

BEGREP:	SKIPA A,PREPLY		; Begin a new reply
ADDREP:	  MOVE A,REPLYP		; Add text after call to reply buffer
	HRRO B,0(P)		; String ptr to text
	SETZ C,			; 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
	RET			; Return there.




;	CALL ADDARG (ARGWRD)	CALL ADDKEY (KEYWRD)
;LEAVES		A/ Pointing to end of text (after NULL)
;UPDATES	REPLYP (Before NULL)
;PRESERVES	B
;KILLS		C

ADDARG:	HRROI C,ARGWRD		; Append ARGWRD to reply REPLYP
	SKIPA
ADDKEY:	  HRROI C,KEYWRD	; Append KEYWRD to reply REPLYP
	PUSH P,B		; Save
	MOVE A,REPLYP		; Add sixbit word in C to reply
	MOVE B,C
	SETZ C,
	SOUT
	MOVEM A,REPLYP		; End of reply so far
	IDPB C,A		; Append NULL.
	POP P,B			; Restore
	RET
	SUBTTL	Error Message Completion

;	JRST NOTIMP	Unimplemented Command

NOTIMP:	CALL BEGREP
	ASCIZS (506,502,< The >)
	CALL ADDKEY		; Append verb to message
	JSP B,RPCRLP
	ASCIZ / command is not yet implemented./

PCRLF:	HRROI A,CRLFM
	PSOUT
	RET

CRLFM:	BYTE (7)C.CR,C.LF,C.NUL

PREPLY:	POINT 7,REPLYM




;	MOVX B,[ASCIZ /.../]
;	JRST ERRRPL/RPCRLP
; OR
;	JSP B,ERRRPL/RPCRLP
;	ASCIZ /.../

NURPLY:	MOVE A,PREPLY		; Start over
	JRST RPCRLP+1	; ******
ERRRPL:	  TXO F,F.CMDK		; Flag this was a fatal error
RPCRLP:	  MOVE A,REPLYP		; Append msg in B to reply
	SETZ C,			; It's ASCIZ
	HRLI B,(POINT 7,0)	; String pointer (allows JSP B,RPCRLP)
	SOUT
	HRROI B,CRLFM		; Append CRLF
	SOUT
	HRROI A,REPLYM		; Now send it down TELNET line
	PSOUT
;	JRST GETCOM		; And get another command
;FALL INTO GETCOM
	SUBTTL	Get Next Command

; Here to get a command line. First see if system still up

GETCOM:	MOVE A,PREPLY		; Initialize pointer to reply
	MOVEM A,REPLYP		; For other routines to append to
	MOVE P,GPDP		; Restore stack level, just in case.
	CALL TIMEOK		; Mark that timeout hasn't happened

	TXNE F,F.CMDK		; Asked to kill job before cmd reading?
	  JRST HANGUP		; Yes, do so.
	MOVX 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:	JSP B,ERRRPL		; Hang up on him
	ASCIZS (436,421,< Service shutting down. Goodbye.>)
;CWL spontaneous response violates protocol??

GETCM1:
	CALL LINEIN		; Collect a command line from TTY
	  JRST NOLINE		; EOF or super-long line

	MOVX A,<'ENTFLG'>	; Flag went off 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 [JSP B,RPCRLP	; Blank line
		ASCIZ /200 Blank line ignored./]

	MOVX BP,<POINT 7,CMDIB>	; Initialize saved byte pointer
GETCM3:	MOVEM BP,SBP
	ILDB C,BP		; Skip leading spaces and tabs
	CAIE C,C.SPACE		; SST routine fails at start of line
	CAIN C,C.TAB		; So do it this way
	  JRST GETCM3		; That was a space. Skip it.

	HRROI B,[ASCIZ /200 Comment OK./]
	CAIN C,C.COMNT		; Let's allow comments
	  JRST RPCRLP		; Line started with semicolon
; Fall thru
	SUBTTL	Get Next Command, cont.

; Falls thru from above
		
	CALL GETWRD		; Collect a word
	  JRST SYNERR		; Didn't start with a good character

	LDB C,SBP		; Get the break character
	CALL SST		; Step over spaces or tabs
	JUMPE A,SYNERR		; Bad if first char on line not alphanum.

	CAIE C,C.SPACE		; Spacing character after verb?
	CAIN C,C.TAB
	  SKIPA			; Yes
	JUMPN C,SYNER2		; Jump unless end of line

	SKIPE C,KEYWRD		; Any previous keyword?
	  MOVEM C,PRVKWD	; Yes, save it.
	MOVEM A,KEYWRD		; Save the sixbit keyword

	MOVX C,<-NCOMS,,COMAND+1> ; See if we can find the keyword
	HLRZ D,(C)
	CAMN A,(D)		; This one?
	  JRST KEYFND		; Yes
	AOBJN C,.-3		; No, look thru list
NOTKEY:	CALL BEGREP
	ASCIZ /500 I never heard of the /
	CALL ADDKEY		; Append keyword
	SETZM KEYWRD		; So don't move garbage into PRVKWD
	JSP B,RPCRLP		; Finish the line
	ASCIZ / command. Try HELP./

KEYFND:	HRRZ B,(C)		; Dispatch to routine
	TRNE B,400000		; Need to be logged in? (highseg routine)
	 TXNE F,F.LOGI		; Yes. Am I?
	  SKIPA			; Logged in, or don't need to be
	   JRST [JSP B,RPCRLP	; No good. Complain.
		 ASCIZS (451,530,< Please log in first, with USER, PASS and ACCT.>)]
	CALL 0(B)		; Call it (must set B to message)
	  JRST RPCRLP
	JRST RPCRLP
	SUBTTL	Command Definitions

C.LGN==1B18	; Need to log in to use this command  NB: LH sign bit

DEFINE COMS <		; Keywords
CC (USER,0)
CC (PASS,0)
CC (ACCT,0)
CC (HELP,0)
CC (MAIL,0)
CC (MLFL,0)
CC (ABOR,0)
CC (NOOP,0)
IFE TCPP,<
 CC (BYE,0)
 CC (BYTE,0)
 CC (SOCK,C.LGN)
 CC (XSEN,0)
 CC (XSEM,0)
 CC (XCWD,C.LGN)
 >
IFN TCPP,<
 CC (QUIT,0)
 CC (SITE,0)
 CC (REIN,0)
 CC (MSND,0)
 CC (MSOM,0)
 CC (MSAM,0)
 CC (MRCP,0)
 CC (PORT,C.LGN)
 CC (PASV,C.LGN)
 CC (SMNT,C.LGN)
 >
CC (TYPE,0)
CC (STRU,0)
CC (MODE,0)
CC (RETR,C.LGN)
CC (STOR,C.LGN)
CC (APPE,C.LGN)
CC (RNFR,C.LGN)
CC (RNTO,C.LGN)
CC (DELE,C.LGN)
CC (LIST,C.LGN)
CC (NLST,C.LGN)
CC (ALLO,C.LGN)
CC (REST,C.LGN)
IFE TCPP,<CC (STAT,C.LGN)>
IFN TCPP,<CC (STAT,0)>		; Allow STAT<RETURN>
CC (CWD,C.LGN)
; FOLLOWING ARE NOT PART OF FORMAL SYNTAX BUT ARE ACCEPTED
CC (NOP,0)
CC (DEBUG,C.LGN)
CC (CRASH,0)
CC (BOMB,0)
>
	SUBTTL	Command Symbol & Dispatch Table

DEFINE CC(A,B)<	XWD [ASCIZ \A\],Z'A
IFE B,<.IF Z'A,RELOCATABLE,<PRINTX ? Move Z'A to low segment>>
IFN B,<.IF Z'A,ABSOLUTE,<PRINTX ? Move Z'A to high segment>>
> ; End of DEFINE CC

COMAND:	XWD NCOMS,NCOMS		; Maybe COMND...
	COMS
NCOMS==.-COMAND-1		; Length of table
	SUBTTL	Subroutines - LINEIN - Get Next Input Line

; The line collector. Performs character and word and line editting.
; Reads a line into CMDIN buffer, terminated by NULL, CRLF stripped off.
;	CALL LINEIN
;Ret+1:	  Blank
;Ret+2: Have line

LINEIN:	PUSH P,P1
	PUSH P,P2
	PUSH P,P3
				; Reenter here on line delete
LINICU:	TXZ F,F.LTL!F.QUOC	; Clear this routine's flags
	MOVX 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
	MOVX A,<CMDIB,,CMDIB+1>
	BLT A,CMDIB+LCMDIB-1

LININL:	CALL TELBIN		; BIN from NVT
	  JRST LININX		; Non-skip if TTY gets EOF
	TXZE F,F.QUOC		; C.QUOTE (^V) seen?
	  JRST LININ2		; Yes. Store character EXACTLY
	CAIN B,C.LF		; Is it a linefeed?
	  JRST LINEOL		; Yes. Quit.
	TXNE F,F.INML		; In MAIL (so no editing)?
	  JRST LININ2		; Yes, store code
	CAIE B,C.NUL		; NUL or CR?
	 CAIN B,C.CR
	  JRST LININL		; Yes, ignore completely

	CAIE B,C.BS		; Editting. Backspace?
	 CAMN B,CDELCH		; Editting character delete?
	  JRST LINICH		; Yes
	CAMN B,CDELWD		; Editting word delete?
	  JRST LINICW		; Yes
	CAMN B,CDELLN		; Editting line delete?
	  JRST LINICU		; Yes.

	CAIN B,C.QUOTE		; Super-Quote?
	  TXO F,F.QUOC		; Flag Control-V seen, then store it
LININ2:	IDPB B,P2		; Store this character
	SOJG P1,LININL		; Accumulate line
	TXO F,F.LTL		; Line too long
LININX:	POP P,P3		; Non-skip return
	POP P,P2
	POP P,P1
	RET

LINEOL:	SETZ B,			; Normal end of line. Terminate with EOL
	IDPB B,P2		; Terminate the string
	AOS -3(P)		; Skip return
	JRST LININX
LINEIP:	010700,,CMDIB-1		; Initial pointer to buffer
	SUBTTL	Subroutines - LINEIN - Editing Routines LINICH, LINICW

LINICH:	CAMN P2,LINEIP		; Already at start of line?
	  JRST LININL		; Yes, ignore this ^A
	MOVX B,C.NUL		; 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
	CALL ALNUMQ		; Skip if alphanumeric
	  JRST LINCW1		; No, a break char.
LINCW2:	MOVX B,C.NUL		; 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.
	CALL ALNUMQ		; Skip if alphanumeric
	  JRST LININL		; Break. Done.
	JRST LINCW2		; Still in word. Go delete it.

LINCW1:	MOVX B,C.NUL		; 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
	CALL ALNUMQ		; Alphanumeric?
	  JRST LINCW1		; No, more breaks. Delete this one too
	JRST LINCW2		; Into the word. Delete the word.
	SUBTTL	Subroutines - ALNUMQ

;	B/ CHARACTER
;	CALL ALNUMQ	; Alphanumeric?
;	  RET+1		; Break
;	RET+2		; Alphanumeric or -
;PRESERVES ALL

ALNUMQ:	CAIL B,"a"		; Lower case?
	CAILE B,"z"
	SKIPA			; No.
	  JRST ALNUMS		; Yes. Skip return.
	CAIL B,"A"		; Upper case?
	CAILE B,"Z"
	SKIPA			; No
	  JRST ALNUMS		; Yes. Skip return
	CAIL B,"0"		; Digit?
	CAILE B,"9"
	SKIPA			; No
	  JRST ALNUMS		; Yes. Skip return.
	CAIN B,"-"		; Hyphen?
ALNUMS:	  AOS 0(P)		; Yes. Skip return
	RET			; Something else. Non-skip.
	SUBTTL	Subroutine - GETWRD

;	SBP/ Points to input
;	CALL GETWRD	Get word
;	  RET+1		; No word before break
;	RET+2		; ASCIZ word in a
;Saves all but A, BP	SBP updated to point to break

GETWRD:	PUSH P,B		; Answer to A, preserve B and C
	PUSH P,C

	MOVE BP,SBP		; Current byte pointer
	SETZ A,			; Clear the answer
	MOVX C,<POINT 7,A>	; Start pointer to answer

GETWRL:	ILDB B,BP		; Get a character
	CALL ALNUMQ		; A-Z, 0-9, or Hyphen?
	  JRST GETWR1		; No, break character

	CAIL B,"a"		; If lower case
	 CAILE B,"z"
	  SKIPA
	   TRZ B,40		; Make upper

	TLNE C,760000		; Room for another character?
	  IDPB B,C		; Yes, store in keyword
	JRST GETWRL		; On to the break

GETWR1:	MOVEM BP,SBP		; Update stored byte pointer (points to break)

	POP P,C			; Restore AC's
	POP P,B
	SKIPE A			; Skip return unless no word
	  AOS 0(P)		; Skip return
	RET
	SUBTTL	Subroutines - SIN6BT
REPEAT 0,<
;	SBP/ POINTS TO INPUT
;	CALL SIN6BT	Get sixbit word
;	  RET+1		; No word before break
;	RET+2		; Sixbit word in a
;Saves all but A, BP	SBP updated to point to break

SIN6BT:	PUSH P,B		; Answer to A, preserve B and C
	PUSH P,C
	MOVE BP,SBP		; Current byte pointer
	SETZ A,			; Clear the answer
	MOVX C,<POINT 6,A>	; Start pointer to answer
SIN6BL:	ILDB B,BP		; Get a character
	CALL 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 (points to break)
	POP P,C			; Restore AC's
	POP P,B
	SKIPE A			; Skip return unless no word
	  AOS 0(P)		; Skip return
	RET
> ; End of REPEAT 0


	SUBTTL	Subroutines - SST

;	SBP point to next input character
;	CALL SST	Skip over tabs and spaces
;PRESERVES ALL

SST:	PUSH P,A		; Skip spaces and/or tabs at current SBP
	TXZ F,F.QUOC		; Flag first character
SSTL:	LDB A,SBP		; Get the current character
	CAIE A,C.SPACE		; Is it a space or tab?
	CAIN A,C.TAB
	  TXOA F,F.QUOC		; 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:	TXZN F,F.QUOC		; Unless didn't move forward at all.
	  JRST SST3		; In which case leave it here.
	MOVX A,<070000,,0>	; Back up so ILDB gets the non-space
	ADD A,SBP
	SKIPGE A
	  SUB A,[430000,,1]
	MOVEM A,SBP
SST3:	JRST APOPJ
	SUBTTL	Subroutines - TELBIN

;	CALL TELBIN	Get Input Character
;	  RET+1		; EOF
;	RET+2		; Character in B

TELBIN:	MOVX A,.PRIIN		; BIN from primary input
	BIN			; Character to AC B
	JUMPE B,[MOVX A,.PRIIN
		 GTSTS		; See if EOF or NULL
		 TXNN B,GS%EOF
		  JRST TELBIN	; Discard the NULL.
		 RET]		; EOF. Give non-skip return. But
				; Detach will probably cause PSI anyhow
; Cannot do this if looking for escapes, etc
; 	TRZ B,200		; Clear bit 200

	CAIN B,C.CR		; CR's?
	  JRST TELBIN		; Wait for LF
	CAIN B,TNXEOL		; TENEX EOL? (Not occur in TCPP)
	  MOVX B,C.LF		; Become linefeeds

CPOPJ1:	AOS 0(P)		; Ok. Skip return.
	RET
	SUBTTL	Subroutines - FORCLO, HANGUP, LOGOUT

;	JRST FORCLO	On timeout interrupt/abort
;CWL does this "extra" message violate protocol

FORCLO:	HRROI A,[ASCIZS (434,421,< Autologout; Time exceeded without login.
>)]
	PSOUT
;	JRST HANGUP


;	JRST HANGUP	Close TELNET connection & logout
;			may be called BEFORE initialized

HALTGO:				; (Compatability)
HANGUP:	CLOSD DATCON		; Make sure data connection is closed

	GJINF			; Get latest TTY number
	JUMPL D,NOCLSD		; If already detached
	MOVX A,.PRIOU		; Wait for end of output
	DOBE
	SKIPN DBUGSW		; Don't close TTY if debuging
	  CALL CLSTTY		; Close the terminal
NOCLSD:
; ;;;	CALL DELTMP		; Flush and delete temp file if exists

IFE TCPP,<TXNE F,F.LOGI>	; Not if not logged in
	  CALL LOGOUT		; LOGOUT or HALTF if debugging

	MOVE P,GPDP		; Restore stack level, just in case.
	MOVX A,.FHSLF		; For this fork
	CIS			; And clear pending ones
	CALL TIMEOK		; Reset clock
	SETOM RESTRT		; Mark ourselves as RESTARTING
	SETO A,			; Make us as clean as possible
	CLOSF			; by closing
	  SETO A,
	RLJFN			; and releasing
	  JFCL			; all JFNS
	JRST GOBAK		; And return to start

;	CALL LOGOUT	LOGOUT (no return) unless debuging (halt & return)

LOGOUT:	SETO A,			; Logout me
	SKIPN DBUGSW		;  But not if debuging
	 LGOUT
	  ERJMP [HALTF]		;#2 die on failure
	SKIPE DBUGSW
	  HALTF			; Halt if debuging
	RET
	SUBTTL	Subroutines - CLSTTY

; Try to detach TTY and close the connection so system logout message
; isn't sent to server -- its not part of the protocol.

;	CALL CLSTTY	Close/Detach TTY

CLSTTY:	DTACH			; Get off the TTY
	SKIPN TENEX		; Different on TOPS20
	  JRST CLSTTX
; TENEX
	MOVEI A,.TTDES(D)	; TENEX - line # to a TTY dev designator
	ASND			; Assign it
	  RET
	MOVEI A,.TTDES(D)	; Again
	RELD			; Cause the NVT to close
	  JFCL
	RET

; TOPS20
CLSTTX:	HRROI A,GTJSTR		; TOPS-20
	HRROI B,[ASCIZ /TTY/]
	SETZ C,
	SOUT			; Build TTY name
	MOVEI B,(D)
	MOVX C,OCTRAD		; Octal TTY #
	NOUT
	  JFCL
	HRROI B,[ASCIZ /:/]
	SETZ C,
	SOUT
	MOVX A,GJ%SHT		; Now get JFN for it
	HRROI B,GTJSTR		; Point to string
	GTJFN
	  RET
	PUSH P,A		; Save JFN for later
	MOVX A,.FHSLF		; Adjust caps
	RPCAP
	PUSH P,C		; Save these to restore
	PUSH P,B
	TRZ C,-1		; Ask for everything
	EPCAP
	MOVE A,-2(P)		; Now open TTY
	MOVX B,<FLD(7,OF%BSZ)+OF%WR>
	OPENF
	  JFCL
	MOVX A,.FHSLF
	POP P,B			; Capabilities to be restored
	POP P,C
	EPCAP
	POP P,A			; JFN to be closed & released
	CLOSF			; This to close net conn.
	  JFCL			; Shouldnt fail
	RET
	SUBTTL	Subroutines - FRMHST

;	CALL FRMHST	APPEND " from host x" to string in A/
; KILLS	B, C

	REPEAT 0,<
FRMHST:	PUSH P,A
	HRROI B,[ASCIZ / from host /]
	SETZ C,			; Identify the host
	SOUT
	MOVE B,A
	MOVE C,FHSTN		; Foreign site number
	MOVX A,.GTHNS
	GTHST
	  JRST [MOVE A,(P)	; Get a back
		MOVE B,FHSTN
		MOVX C,OCTRAD	; Octal number
		NOUT
		  JFCL
		JRST .+1]
	POP P,A			; Clean a off stack
	RET
>
REPEAT 0,<
IFN TCPF,<	MOVE B,FHSTN
		LSHC B,-6
		LSH B,-12
		LSHC B,6
		ANDI B,377>
IFE TCPF,<	HRRZ B,FHSTN>	; Foreign site number
	MOVX C,OCTRAD		; In octal if no name
	CVHST			; Name, if any
	  NOUT			; No, number.
	    JFCL
> ; End of REPEAT 0
	SUBTTL	Subroutines - DECIN (OCTIN)

; Numeric input routine. Decimal unless preceded by "O" or "X".
;	BP/ Points to separator before input
;	CALL DECIN
; Ret+1	  Bad input
; Ret+2	A/ number
;Kills C;  Saves B,D;  BP/ points to break

DECIN:	ILDB C,BP		; Skip separator first
	SETZ A,			; Collect number here
	PUSH P,BP		; Save original byte POINTER
DECINL:	CAIL C,"0"		; Decimal digit?
	CAILE C,"9"
	  JRST DECINX		; No.
	IMULI A,DECRAD		; Yes, accumulate number
	ADDI A,-"0"(C)
	ILDB C,BP		; On to next character
	JRST DECINL		; See if break or digit

DECINX:	CAME BP,0(P)		; Has any digit been seen?
	  JRST RADIXY		; Yes, skip return
	CAIE C,"O"		; Octal prefix?
	CAIN C,"o"		; Or lower case "O"
	  JRST OCTIN		; Yes. Go read it
	CAIE C,"X"		; Hex input?
	CAIN C,"x"
	  JRST HEXIN		; Yes. Go collect hex number
	JRST RADIXZ		; No good. Discard pointer on stack
				; 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
	SUBTTL	Subroutines - DECIN (HEXIN)

HEXIN:	ILDB C,0(P)		; Skip the "X". Update start of number
	MOVE BP,0(P)
HEXINL:	CAIL C,"a"		; Lower case letter?
	CAILE C,"z"
	SKIPA			; No
	  TRZ C,"a"-"A"		; 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?
RADIXY:	AOS -1(P)		; Yes. Skip return
RADIXZ:	POP P,(P)		; Discard starting byte pointer
	RET
	SUBTTL	Subroutines - DIRCHK

; Dirchk checks a directory name
; B/	A pointer to the name (W/ or W/o PS:<...>)
;	CALL DIRCHK
; Ret+1	  If fails
; Ret+2	Recognized, directory number in B

DIRCHK:	PUSH P,A		; Save some AC's
	PUSH P,B
	PUSH P,C
	SKIPN TENEX
	  JRST DIRCK1
	SETZ A,			; TENEX
	STDIR
	  JRST DIRCK6
	  JRST DIRCK6
	HRRZ C,A		; Hw directory number
	JRST DIRCK4
DIRCK1:	MOVX A,RC%EMO		; TOPS-20 exact match only
	RCDIR			; Try to recognize
	  ERJMP DIRCK2		; If fail
	TXNN A,RC%NOM!RC%EMO	; Check if good
	  JRST DIRCK4		; Yes
DIRCK2:	HRROI A,RCDSTR		; Where to build string
	HRROI B,[ASCIZ /PS:</]	; Start of string
	SETZ C,
	SOUT
	MOVE B,-1(P)		; Pointer
	SOUT
	HRROI B,[ASCIZ />/]
	SOUT			; And finish with new string
	MOVX A,RC%EMO
	HRROI B,RCDSTR
	RCDIR			; And try again with new string
	  ERJMP DIRCK6		; Still bad
	TXNE A,RC%NOM!RC%AMB	; Exists?
	  JRST DIRCK6		; No
DIRCK4:	MOVE B,C		; Yes, number into B
	AOS -3(P)		; Skip return
DIRCK6:	POP P,C			; Restore C
	POP P,(P)		; Discard pointer
	POP P,A
	RET			; And return
	SUBTTL	Subroutines - USRCHK - Validate User Name String
; USRCHK Checks a user name string
;	B/	a pointer to the name
;	CALL USRCHK
;	  RET+1		If fails
;	  RET+2		FILES-ONLY
;	RET+3		Recognized, User ID # is in B

;User ID number is	TOPS-20 User Number (36-bit)
;			TENEX Directory Number (18 bit)

USRCHK:	PUSH P,A		; Save some AC's
	PUSH P,B
	PUSH P,C

	SKIPN TENEX
	  JRST USRCK1		; TOPS-20
				; TENEX
	SETZ A,			; Positive number for exact match
	STDIR			; Check name pointed to by B
	  JRST USRCK6		; No match
	  JRST USRCK6		; Ambiguous
	HRRZ B,A		; TENEX directory number
	TXNE A,1B0		; FILES-ONLY?
	  JRST USRCK4		; Yes, lose (but return number)
	JRST USRCK2		; No, ok

USRCK1:	MOVX A,RC%EMO		; Exact match only
	RCUSR			; Try to recognize
	ERJMP USRCK6		; Fail
	MOVE B,C		; Possible user # to B
	TXNN A,RC%NOM!RC%AMB	; Exists?
	  JRST USRCK2		; Yes
				; No, or FILES-ONLY
	EXCH B,-1(P)		; Restore pointer & save user #
	CALL DIRCHK		; Special test for FILES-ONLY
	  JRST USRCK6		; Not even FILES-ONLY
	MOVE B,-1(P)		; Get back user #
	JRST USRCK4		; Ok means FILES-ONLY

USRCK2:	AOS -3(P)		; Ok ret+3
USRCK4:	AOS -3(P)		; FILES-ONLY ret+2
USRCK6:	POP P,C			; Restore C
	POP P,(P)		; Drop B
	POP P,A
	RET			; And return
	SUBTTL	Subroutines - SNDCTL
IFN IPCLOG,<			; Don't use this feature yet
SNDCTL:	PUSH P,A
	PUSH P,B
	PUSH P,C
	SETZM PIDARG+.ICPFL	; Send data to FTSCTL
	MOVX C,3		; Try three times
SNDCT1:	MOVE A,MYPID
	MOVEM A,PIDARG+.IPCFS
	MOVE A,CTLPID
	MOVEM A,PIDARG+.IPCFR
	MOVX A,<20,,IPCDAT>	; Should put correct length on
	MOVEM A,PIDARG+.IPCFP

	MOVX A,4		; Length of descriptor
	MOVEI B,PIDARG		; Addr of descriptor
	MSEND
	  JRST [MOVX A,^D1000
		DISMS
		SOJGE C,SNDCT1
		JRST .+1]
	POP P,C
	POP P,B
	POP P,A
	RET
>
	SUBTTL	Subroutines - TIMEOK

;	CALL TIMEOK	; Still ok, set timer fork for WATTIM from now

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
	RET



	SUBTTL	Forks - TFORKX/TFRKSA - Timing Fork

; Timing fork to wake us up each minute

TFRKSA:	MOVX A,^D60000
	DISMS
	MOVEI A,.FHSUP		; My superior
	MOVX B,<1B<TIMCHN>>	; Channel to poke him on
	IIC			; Do so
	JRST TFRKSA		; And return
	SUBTTL	PSI Handlers - Level 1 (Fatal) - INSINT, MEMINT, PDLINT, FULINT

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
	ASCIZS (,,<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
	ASCIZS (,,<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
	ASCIZS (,,<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
	ASCIZS (,,<Disk or Drum overflow>)


; Output registers and error message, if possible

L1INTS:	MOVE C,RETPC1		; PC
	MOVEI D,PI1AC		; Pointer to registers
	CALL DMPREG		; Tell the bad news
	HRROI A,[ASCIZ / Goodbye.
/]
	PSOUT
	ERJMP .+1
	JRST HANGUP

REPEAT 0,<
L1DBRK:	MOVX 17,<PI1AC,,0>	; Restore lev 1 AC's
	BLT 17,17
	DEBRK			; and return from lev 1 PSI
>
	SUBTTL	PSI Handlers - Level 2 (Non-Fatal) - TIMINT, DETINT

; Timeout

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 L2DBRK		; No.
	TXNN F,F.ANON		; Yes. ANONYMOUS user?
	 TXNN F,F.LOGI!F.NALO	; Or not logged in at all?
	  SKIPA			; Yes. Autologout him.
	   JRST L2DBRK		; Real logged in user. Let it sit idle.
	AOS A,LGOCNT		; Count the force-level counter
	CAIL A,2		; Panic?
	  JRST HANGUP		; Yes. Get out
	MOVX B,<PC%USR+FORCLO>	; Assume forced logout
	CAIL A,1		; Still not seen at process level. First?
	  MOVEM B,RETPC2	; Break out of present work & force off 
L2DBRK:	MOVX 17,<PI2AC,,0>	; Restore AC's
	BLT 17,17
	DEBRK			; And return from lev 2 PSI
	 ERJMP DBKFA1


; NVT Detached; No reply possible

DETINT:	MOVEM 17,PI2AC+17	; Stash AC's
	MOVEI 17,PI2AC		; Just for symmetry
	BLT 17,PI2AC+16
	MOVE P,L2PDP		; Set up stack
	MOVX A,<PC%USR+HANGUP>	; They went away, go hangup
	MOVEM A,RETPC2		; Save for return
	DEBRK			; And return
	 ERJMP DBKFAL		; #2 go detach and logout
	JRST DBKFAL		; Just in case
	SUBTTL	PSI Handlers - Level 2 (Non-Fatal) - CTCINT, IOXINT, QTAINT

; ^C (^E if debug)

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:	MOVX A,<PC%USR+ABORPC>	; Force it to break out at this PC
	MOVEM A,RETPC2
	JRST L2DBRK



;  IO Error

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



; Quota Exceeded

QTAINT:	MOVE P,GPDP		; Restore stack level, just in case.
	HRROI X,[ASCIZS (456,552,< Exceeded working quota>)]
	MOVX A,<PC%USR+DATABE>	; Debreak out to close conn etc.
	MOVEM A,RETPC2
	DEBRK
	 ERJMP DBKFA3
	SUBTTL	PSI Handlers - Level 2 (Non-Fatal) - Control-T

CTTINT:	MOVEM 17,PI2AC+17	; Save registers
	MOVX 17,<0,,PI2AC>	; Here
	BLT 17,PI2AC+16

	MOVX A,.PRIOU
	DOBE

	HRROI A,[ASCIZS (100,111,< Awaiting data transfer command.
>)]
	SKIPN F$DTRQ		; Transfer requested or
	 SKIPE F$DTIP		; In progress
	  SKIPA			; Yes, report state
	   JRST CTINT7		; No, simple reply

	HRROI A,[ASCIZS (100,111,< Data transfer in progress, >)]
	PSOUT
	MOVX A,.PRIOU
	MOVE B,NBYTES
	MOVX C,DECRAD
	NOUT
	  JFCL
	HRROI A,[ASCIZ /. bytes sent/]
	SKIPN F$SEND		; Which direction
	  HRROI A,[ASCIZ /. bytes received/]
	PSOUT

	TXNN F,F.TYPX
	  JRST CTINT4
	HRROI A,[ASCIZ / (page /]
	PSOUT
	MOVX A,.PRIOU
	MOVE B,PAGENO
	NOUT
	  JFCL
	HRROI A,[ASCIZ /)/]
	PSOUT
CTINT4:
	HRRZ B,LCLJFN
	JUMPE B,CTINT6
	HRROI A,[ASCIZ / from /]
	SKIPN F$SEND		; Which direction
	  HRROI A,[ASCIZ / for /]
	PSOUT
	MOVX A,.PRIOU
	MOVX C,<..DEVD+..DIRD+..NAMA+..TYPA+..GENA+JS%PAF>
	JFNS
CTINT6:	HRROI A,[ASCIZ /.
/]
CTINT7:	PSOUT

	JRST L2DBRK		; All done
	SUBTTL	Command Execution Routines - USER

ZUSER:	GJINF			; See if logged in already
	JUMPN A,[JSP B,RPCRLP	; If so, complain
		 ASCIZS (504,503,< You are already logged in.>)]
	TXZ F,F.ANON		; Make sure not ANONYMOUS
	SETZM $ACCT		; Clear any account junk
	CALL SST		; Skip leading spaces
	MOVX A,<POINT 7,$USER>	; User name string storage
	MOVEI C,^D39		; Maximum length
USER01:	ILDB B,SBP		; Get a character
	IDPB B,A		; Store in string
	JUMPE B,USER02		; Quit on null
	SOJG C,USER01		; Loop for whole name
USERNG:	SETZM USERNM		; Too long. No User ID.
	AOS A,USRFCT		; Count bad user names
	CAIL A,5		; Allow him a few, then force him out
	  JRST USER03		; Too many
	CALL ADDREP		; Tell him user doesn't exist
	ASCIZS (431,530,< No such user as >)
	HRROI B,$USER
	SOUT
	MOVEM A,REPLYP
	JSP B,RPCRLP		; Return error msg
	ASCIZ /./

USER03:	JSP B,ERRRPL		; Hang up with following msg
	ASCIZS (430,421,< Too many login failures. Goodbye.>)

USER02:	MOVX B,<POINT 7,$USER>	; Name string
	CALL USRCHK		; Check if valid user
	  JRST USERNG		;  Failed
	  JRST [AOS A,USRFCT	; Cannot login to a FILES-ONLY Directory
		CAIL A,5	; Count failures, allow a few
		  JRST USER03	; Too many. Hang him up.
		JSP B,RPCRLP	; Tell him that's FILES-ONLY
		ASCIZS (431,530,< You can't log in under that directory name.>)]
	MOVEM B,USERNM		; Ok, save User ID #
	CAME B,ANOUNO		; ANONYMOUS?
	  JRST USER04		; No. Skip over ANONYMOUS
	SUBTTL	Anonymous User

; Anonymous User - Get ANONYMOUS' password from system file

	SETZM ANOPSW		; Collect ANONYMOUS password
	MOVX A,GJ%OLD+GJ%SHT	; From system file
	HRROI B,T20.AU		;TOPS-20
	SKIPE TENEX		;ANONYMOUS.USERFILE
	  HRROI B,TNX.AU	;TENEX
	GTJFN
	  JRST USRAN1		; File not there - don't allow logins
	MOVEM A,ANNJFN		; Stash JFN here
	MOVX B,<FLD(7,OF%BSZ)+OF%RD> ; Read ASCII from first line
	OPENF			; Open file
	  JRST USRAN2		; Can't?
	MOVX D,<POINT 7,ANOPSW>	; Store text here
	MOVX C,^D39		; Max length in case file bad
USRAN4:	BIN			; Get a character of password
	IDPB B,D		; Store in string
	SOJLE C,USRAN2		; Too long
	CAIL B,C.SPACE		; Valid character?
	  JRST USRAN4		; Yes, get next
	MOVX B,C.NUL		; Terminate with NULL
	DPB B,D			; Over invalid byte
	TXO F,F.ANON		; ANONYMOUS is the user name
USRAN2:	CLOSR ANNJFN		; Finished with file
USRAN1:	TXNE F,F.ANON		; Get password ok?
	  JRST USER04		; Yes
	SETZM USERNM		; Invalid user (ANONYMOUS)
	AOS A,USRFCT
	CAIL A,5		; Count failures, allow a few
	  JRST USER03		; Too many. Hang up.
	JSP B,RPCRLP
	ASCIZS (431,530,< ANONYMOUS logins are not allowed.>)
USER04:				; Continue...

; IFN REL4,<
	SKIPN TENEX		; No GDACC in TOPS-20
	  JRST USER06		; Have one in TENEX
;>	;END RELEASE 4 CONDITIONAL

	MOVX A,<POINT 7,$ACCT+1> ; Back here from ANONYMOUS
	MOVE B,USERNM		; See if user has a default account
	JSYS 331		; TENEX GDACC
	  JRST USER06		; No.
	MOVEM A,$ACCT		; Yes. Store it for LOGIN JSYS
USER06:
	HRROI B,[ASCIZS (330,331,< ANONYMOUS user ok, send real ident as password.>)]
	TXNE F,F.ANON		; ANONYMOUS or real user?
	  JRST RPCRLP		; ANONYMOUS. Ask for name (specal msg)
	JSP B,RPCRLP		; Real. Ask for password
	ASCIZS (330,331,< User name ok. Password, please.>)
	SUBTTL	Command Execution Routines - PASS

ZPASS:	SETZM $PASS		; Make sure no junk left around
	SKIPN USERNM		; Has a user been seen?
	  JRST PASS06		; No.
	CALL SST		; Skip leading (unquoted) spaces
	MOVX A,<POINT 7,$PASS>	; Password string storage
	MOVX C,^D39		; Maximum length
PASS01:	ILDB B,SBP		; Get a character
	CAIN B,C.QUOTE		; Quote character?
	  JRST [ILDB B,SBP	; Quoted character. Copy it.
		JRST PASS03]	; Without crunching lower case to upper
	CAIL B,"a"		; Not quoted, make LC be UC
	CAILE B,"z"
	SKIPA			; Not lower case
	  SUBI B,"a"-"A"	; Make lower be upper
PASS03:	IDPB B,A		; Store the character
	JUMPE B,PASS04		; Jump at end.
	SOJG C,PASS01		; Space counter
PASSNG:	SETZM $PASS		; Clear. Flags that no good pswd yet.
	AOS A,PASFCT		; Count bad passwords
	HRROI B,[ASCIZS (430,421,< Password wrong again. Goodbye.>)]
	CAIL A,5		; Allow a few, then force off
	  JRST ERRRPL		; Hang up on him
	JSP B,RPCRLP		; Bad, but not too many times yet
	ASCIZS (431,530,< Password incorrect.>)


PASS04:	TXNE F,F.LOGI		; Am I already logged in?
	  JRST PASCWD		; Yes, maybe for CWD

IFN REL4,<SKIPN TENEX
	    JRST PASS4A		; If TOPS-20
> ; End of Release 4 conditional
				; TENEX
	HRRZ A,USERNM		; Check the password. User ID
	TXO A,1B0		; Check, don't connect
	HRROI B,$PASS		; The supplied password
IFN ANOP,<			; Do not demand user give password
	TXNE F,F.ANON		; ANONYMOUS?
	  HRRI B,ANOPSW		; Yes, different password.
 >
	TXNE F,F.ANON		; If trying ANONYMOUS,
	 SKIPE $PASS		; Phony password must be non-null.
	  CNDIR			; Check it
	   JRST PASSNG		; Fail. Count it, reply, maybe hangup.
PASS4A:
	SUBTTL	Command Execution Routines - PASS, cont.

IFN REL4,<SKIPE TENEX		; If REL4 try without an account
>
	   SKIPE $ACCT		; Any default account?
	    JRST PASS10		; Yes. Go do the login.
PASSAC:	JSP B,RPCRLP		; No. ask for the account.
	ASCIZS (331,332,< Password OK, Account please.>)

PASS06:	JSP B,RPCRLP		; Pass w/o user
	ASCIZS (431,503,< User name before password, please.>)
	SUBTTL	Command Execution Routines - PASS/ACCT - Try to login

;Back here from ACCT command, too, if not yet logged in.

PASS10:	MOVX A,.SFNVT		; Are logins on NVT's allowed?
	TMON
	JUMPE B,NVTNLI		; If not, don't allow FTP service either
	MOVE A,USERNM		; User ID
	JUMPE A,PASS06		; If no user name yet, don't login.


	SKIPE TENEX		; Not supported on TOPS-20
	  HRLI A,(1B16)		; TENEX bit to suppress login date update
	MOVX B,<POINT 7,$PASS>	; Password
	MOVE C,$ACCT		; And account
IFN ANOP,<			; Do not demand user give password
	TXNE F,F.ANON		; ANONYMOUS?
	  HRRI B,ANOPSW		; Yes. Here's its password.
 >

	LOGIN			; Failed? Strange. Report it.
	  SKIPA			; Lose
	    JRST PASS12		; Ok, continue

	SKIPN $ACCT		; See if defaulting
	  JRST [CAIN A,LGINX1	; Invalid account?
		 JRST PASSAC	; Yes
		CAIN A,602111	; VACCX0 - invalid account
		  JRST PASSAC
		CAIN A, 602112	; VACCX1 - string too long
		  JRST PASSAC
		CAIN A,602126	; VACCX2 - account expired
		  JRST PASSAC
		JRST .+1]	; Go give ERRSTR message
	CALL CLRPSW		; No, clear secret info
	PUSH P,A
	CALL ADDREP		; Build a reply
	ASCIZS (431,530,< Login failed unexpectedly, >)
	POP P,B
	HRLI B,.FHSLF		; Error in this fork
	ERSTR			; String for the error
	  JFCL
	  SKIPA
	MOVEM A,REPLYP		; End of string
	JSP B,RPCRLP		; Carriage return and reply
	ASCIZ /./
	SUBTTL	Command Execution Routines - PASS/ACCT - Logged in

PASS12:	TXO F,F.LOGI		; Flag that I am logged in.
	CALL CLRPSW		; Clear secret info

IFN ENABL,<
	MOVX A,.FHSLF		; Enable caps
 	SETOB B,C
	EPCAP
> ; End of ENABL

	GJINF			; Update job info
	MOVEM A,GJINF1
	MOVEM B,GJINF2
	MOVEM C,GJINF3
	MOVEM D,GJINF4

	MOVE A,REPLYP		; Compose a pretty login message
	HRROI B,[ASCIZ /230 User /]
	SETZ C,
	SOUT
	MOVE B,USERNM		; Convert User ID to name string
	DIRST
	ERJMP .+1		; Can't fail
	HRROI B,[ASCIZ / logged in at /]
	SETZ C,
	SOUT
	SETO B,
	MOVX C,<OT%DAY+<0*OT%FDY>+OT%NSC+OT%TMZ+OT%SCL>
	ODTIM			; Format of date/time
	HRROI B,[ASCIZ /, job /]
	SETZ C,
	SOUT
	HRRZ B,GJINF3		; Job number
	MOVX C,DECRAD
	NOUT
	  JFCL
	HRROI B,[ASCIZ /. /]
	SETZ C,
	SOUT
	MOVEM A,REPLYP		; Message pointer so far.

	HRROI B,CRLFM		; End of line
	SOUT
	SUBTTL	Command Execution Routines - Logged in, Get high segment

IFN IPCLOG,<
	HRROI A,IPCDAT		; And tell controller
	HRROI B,[ASCIZ /FTP Server: /]
	SETZ C,
	SOUT
	MOVE B,PREPLY		; Get initial pointer
	IBP B
	IBP B
	IBP B			; After the 230
	SOUT
	CALL SNDCTL
>

; Here to get in the file activity portion now that program is 
; safely logged in. Note that this greatly reduces security errors.

	GJINF			; Find out from system whether I am 
	SKIPN A			; really logged in.
	  CALL BOMB		; Not logged in! Quit and hang up.
	CALL GETHI		; Map the high segment back to life
	JSP B,RPCRLP		; All set, give greeting
	0
	SUBTTL	Subroutines - GETHI, CLRPSW

;	CALL GETHI	Map High Segment back in (Only if logged in)

GETHI:	MOVX A,<HSBAS/1000>	; First page of critical code
	PUSH P,A		; Current page number to stack
GETLP:	MOVX A,<.FHSLF,,0>	; In this fork,
	HRR A,0(P)		; At this page,
	RPACS			; See if page is there
	TXNN B,PA%PEX
	  JRST GETLPN		; No, so can't make it accessible
	MOVX B,PA%RD+PA%EX	; Set access to read execute (no write)
	SPACS
GETLPN:	AOS A,0(P)		; Look at next page
	CAIGE A,700		; Unless up to DDT area
	  JRST GETLP
	POP P,A			; Discard page number
	RET			; End of GETHI



;	CALL CLRPSW	Clear Passwords
;SAVES	ALL

CLRPSW:	PUSH P,A		; Be transparent
	SETZM $PASS		; Clear secret info
	MOVX A,<$PASS,,$PASS+1>	; In all password areas
	BLT A,$PASS+7
	SETZM ANOPSW
	MOVX A,<ANOPSW,,ANOPSW+1>
	BLT A,ANOPSW+7
	SETZM CMDIB
	MOVX A,<CMDIB,,CMDIB+1>
	BLT A,CMDIB+20
	JRST APOPJ
	SUBTTL	Command Execution Routines - ACCT

ZACCT:	CALL SST
	MOVE A,SBP		; Pick up account characters here
	MOVX B,<POINT 7,$ACCT+1>; Store string here
	MOVX D,^D39		; Max length of string
	SETZ T1,		; Accumulate number here
	TXZ F,F.NUMA		; So far, it may be a number
	SETZM $ACCT+1		; Clear so can tell if null argument
ACCT01:	ILDB C,A		; Get a character of the account
	JUMPE C,ACCT02		; End of argument
	CAIL C,"a"		; Lower case?
	CAILE C,"z"
	SKIPA			; No
	  SUBI C,"a"-"A"	; Yes, make upper.

	SKIPN TENEX		; Test system
	  JRST ACCTNN		; If TOPS-20 only string accounts
	CAIL C,"0"		; Decimal digit?
	CAILE C,"9"
	  JRST ACCTNN		; Not numeric
	IMULI T1,12		; Accumulate number
	ADDI T1,-"0"(C)
	SKIPA
ACCTNN:	  TXO F,F.NUMA		; Not numeric
	IDPB C,B		; Add to text string
	SOJG D,ACCT01		; Loop if still space.
ACCTNG:	JSP B,RPCRLP		; String too long or otherwise bad
	ASCIZS (431,530,< Account not valid.>)

ACCT02:; MOVX C,C.NUL		; (It had to be to get here)
	IDPB C,B		; Terminate string
	SKIPN $ACCT+1		; Was string non-null?
	  JRST ACCTNG		; No. Empty string is no good
	TXNE F,F.NUMA		; Numeric?
	  JRST ACCT03		; No, alphabetic.
	TXNE T1,NMFLG		; 33 bit value or less?
	  JRST ACCTNG		; No. Bad.
	TXOA T1,<FLD(NUMVAL,NMFLG)> ; Ok.
ACCT03:	  MOVX T1,<POINT 7,$ACCT+1> ; Here for string account
	MOVEM T1,$ACCT		; This is the designator

	SKIPN A,USERNM		; Do we know who we are?
	  GJINF			; Get who we are
	MOVEM A,USERNM		; Save User ID
	MOVE B,$ACCT		; Get pointer or number
	SKIPN TENEX		; Different on TOPS20
	  JRST ACCT3A
	JSYS 330		; TENEX VACCT, is it ok?
	  JRST ACCTNG		; No
IFN REL4,<SKIPA>		; Skip TOPS-20 stuff
ACCT3A:
	SUBTTL	Command Execution Routines - ACCT, cont.

IFN REL4,<VACCT			; JSYS 566, TOPS-20 is it ok?
	   ERJMP ACCTNG		; Bad
> ; 101B doesn't validate accounts

	TXNN F,F.LOGI		; Am I logged in already?
	  JRST PASS10		; No, go do LOGIN.
	MOVE A,$ACCT		; Yes, change to this account
	MOVX B,0		; No flags
	CACCT			; Do the change
	  JRST ACCTNG		; This should not fail
	JSP B,RPCRLP		; Ok, account has been changed.
	ASCIZ /230 Account OK./
	SUBTTL	Command Execution Routines - TYPE

ZTYPE:	CALL BEGREP		; Start building ok reply
	ASCIZ /200 Type /
	MOVX P1,<-NTYPES,,TYPTAB+1> ; # & Table of known types
	CALL GETARG		; Look for arg in table
	  JRST ARGSYN		; Has to be one
	  JRST ARGUNK		; Arg was there but not known
	MOVEM B,CARG1		; Save argument so far
	CALL 0(C)		; Go to it
LCMRET:	JSP B,RPCRLP		; Finish msg and return
	ASCIZ / ok./

IFN TCPP,<
TYPTAB:	KM(TYPE,<A,E,I,L>,ARGNIM)

FILTAB:	40			; ASCII <SPACE>
	100			; EBCDIC <SPACE>
	0			; NULL
	0			; NULL

TYPE$L:	CALL ADDREP
	ASCIZ / bytesize /
	MOVE BP,SBP		; For DECIN
	LDB B,BP		; Get break
	CAIE B,C.SPACE		; Must have space
	  JRST [JSP B,NURPLY	; Need byte size
		ASCIZ /501 TYPE L must specify byte size./]

IFN TCPF,<	; Support byte sizes 1-36
	CALL DECIN		; Get logical byte size
	  JRST [JSP B,NURPLY	; Something wrong
		ASCIZ /504 Error in TYPE L logical byte size parameter./]

	HRROI B,[ASCIZ /504 TYPE L only implemented for logical byte sizes 1 to 36./]
	CAIL A,^D1		; Min
	 CAILE A,^D36		; Max
	  JRST NURPLY		; Out of range

	MOVE B,A		; Byte size
	MOVE A,REPLYP		; Where to put it
	MOVX C,DECRAD		; In decimal
	NOUT			; For the user
	  JFCL
	MOVEM A,REPLYP		; Updated pointer
	MOVE A,B		; Byte size for following
	CALLRET TY$LN		; Ok

> ; End of IFN TCPF
	SUBTTL	Command Execution Routines - TYPE, cont.

IFE TCPF,<	; Only support byte sizes 8, 32, 36
	MOVX P1,<-NBYTSZ,,BSZTAB>
	CALL GETARG		; Get byte size
	  JRST ARGSYN		; Has to be one
	  JRST ARGUNK		; Which is implemented
	MOVE A,BYTESZ(B)	; Get byte size
	MOVEM A,$BYTE		; Set it
	MOVEM A,$LBYTE
	HRRZ C,BSZTAB(B)
	JRST (C)		; Call routine

BSZTAB:	KM(BS,<8,32,36>)
NBYTSZ==.-BSZTAB
BYTESZ:	DEC 8,32,36

> ; End of IFE TCPF
	SUBTTL	Command Execution Routines - TYPE, cont.

TYPE$A:	LDB B,SBP		; Get break
	JUMPE B,TY$DEF		;  EOL means default (0)
	CALL ADDREP
	ASCIZ / /
	CALL SST		; Skip break, spaces, tabs
	MOVX P1,<-NFORMS,,FRMTAB+1>
	CALL GETARG		; Get format arg
	  JRST ARGSYN		; Has to be one
	  JRST ARGUNK		; Has to be implemented
	JRST (C)		; Call routine

FRMTAB:	KM(FORM,<N,T,C>,ARGNIM)



TY$DEF:	SETZB T2,CARG1
FORM$N:	MOVEM B,$FORM		; Save format
	MOVX A,0		; Local packed words
	MOVEM A,$LTYPE
	MOVX A,7		; Local ASCII size
	MOVEM A,$LBYTE
	MOVX A,^D8		; ASCII is 8-bit bytes
	JRST TCMRET

IFE TCPF,<	; Only support byte sizes 8, 32, 36
BS$8:	SKIPA A,[^D8]
BS$32:	  MOVX A,^D32
	SKIPA
BS$36:
> ; End of IFE TCPF

TYPE$I:	  MOVX A,^D36
TY$LN:	MOVEM A,$LBYTE		; A/ byte, CARG1/ type
TCMRET:	MOVEM A,$BYTE
				; CARG1/ type
	MOVE B,CARG1		; Get type argument
	MOVE T1,FILTAB(B)	; Fill character
	MOVEM T1,$FILLB		; For this type
> ; End of IFN TCPP

IFE TCPP,<
TYPTAB:	KM(TYPE,<A,E,I,L,P,XTP>)
NTYPES==.-TYPTAB

TYPE$A: TYPE$I: TYPE$L: TYPE$XTP:
	MOVE B,CARG1		; Get type argument
> ; End of IDE TCPP

	MOVEM B,$TYPE		; Save the index into table
	RET
	SUBTTL	Subroutines - ARGUNK, ARGNIM, GETARG

;	JRST ARGUNK	Unknown Letter Argument

ARGUNK:	CALL BEGREP		; An argument that isn't even in table
	ASCIZS (501,504,< I never heard of >)
	CALL ADDKEY		; Put command name in
	CALL ADDREP
	ASCIZ / with argument /
	JRST ARGUN1


;	JRST ARGNIM	Unimplemented Letter Argument

ARGNIM:	CALL BEGREP		; An arg in the table but unimplemented
	ASCIZS (506,504,< >)
	CALL ADDKEY
	CALL ADDREP
	ASCIZ / is not implemented for argument /

ARGUN1:	CALL ADDARG		; Add ARGWRD
	JSP B,RPCRLP
	ASCIZ /./


; SBP/	Points to next input
;	MOVX P1,<-TABLE LENGTH,,TABLE ADDRESS>
;	CALL GETARG
; Ret+1	  Syntax Error
; Ret+2	  Not in table
; Ret+3	Found in table: Index in B, arg added to REPLYM, SBP updated

GETARG:	CALL GETWRD		; Get a word
	  RET ;+1		; Syntax error
	AOS 0(P)		; Ok, skip at least one
	MOVEM A,ARGWRD		; Save for error msgs, replies
	SETZ B,			; Index into table
GETAR2:	HLRZ C,(P1)		; Get address of ASCIZ keyword
	CAMN A,(C)		; (First 5 char) same as typein?
	  JRST GETAR4		; Yes, found the word
				; Go append to reply & skip return
	ADDI B,1		; No, next index
	AOBJN P1,GETAR2		; Loop looking for it
	RET ;+2			; Not in table

GETAR4:	PUSH P,C		; Save all
	PUSH P,B
	PUSH P,A
	CALL ADDARG		; Append keyletter to reply
	POP P,A
	POP P,B
	POP P,C
	HRRZ C,(P1)		; Dispatch address
	AOS (P)
	RET;+3
	SUBTTL	Command Execution Routines - MODE

ZMODE:	CALL BEGREP		; Start building ok reply
	ASCIZ /200 Mode /
	MOVX P1,<-NMODES,,MODTAB+1> ; # & Table of known MODEs
	CALL GETARG		; Look for arg in table
	  JRST ARGSYN		; Syntax error
	  JRST ARGUNK		; Argument not in table
	CALL 0(C)		; Go to it
	JRST LCMRET		; Common return for good letter commands

MODTAB:
IFE TCPP,<KM(MODE,<S,B,T,H>,ARGNIM) >
IFN TCPP,<KM(MODE,<S,B,C>,ARGNIM)   >


MD$DEF:	SETZ B,
MODE$S:	MOVEM B,$MODE		; Save the index into table
	RET
	SUBTTL	Command Execution Routines - BYTE

; Note BYTE is not a TCPP Command
IFE TCPP,<
ZBYTE:	CALL SST		; Get byte size argument
	MOVE BP,SBP
	CALL DECIN		; Collect a number
	  JRST ARGSYN		; Not a number
	CAIE A,^D8		; Eight bits?
	 CAIN A,^D36		; 36 bits?
	  JRST BYTEOK		; Yes
	CAIE A,^D32		; 32 bits?
	  JRST BYTEX1		; No
BYTEOK:	LDB B,BP		; Get terminator
	JUMPN B,BYTEX1		; Should be eol
	MOVEM A,$BYTE		; Store the value
	JSP B,RPCRLP		; Ok
	ASCIZ /200 Byte size accepted./

BYTEX1:	JSP B,RPCRLP
	ASCIZS (506,504,< Byte size must be 8, 32, or 36.>)
 >
	SUBTTL	Command Execution Routines - STRU

ZSTRU:	CALL BEGREP		; Build a success reply
	ASCIZ /200 Structure /
	MOVX P1,<-NSTRUS,,STRTAB+1> ; # & Args to structure
	CALL GETARG		; Look for arg in table
	  JRST ARGSYN		; Syntax error
	  JRST ARGUNK		; Not in table
	CALL 0(C)		; Go to it.
	JRST LCMRET		; Finish it up

STRTAB:
IFE TCPP,<KM(STRU,<F,R>,ARGNIM)   >
IFN TCPP,<KM(STRU,<F,R,P>,ARGNIM) >


ST$DEF:	SETZ B,
;STRU$R:	; Record length??
STRU$P:
STRU$F:	MOVEM B,$STRU		; Store the arg
	RET
	SUBTTL	Command Execution Routines - ABOR (^C or IO Error)

;	DEBRK to ABORPC		On ^C or IO Error

ABORPC:	MOVE P,GPDP		; Restore stack level, just in case.
	HRROI A,[ASCIZS (456,500,< ? Unknown error interrupt.
>)]
	SKIPE CTCFLG		; Was it a ^C?
	  HRROI A,[ASCIZS (456,552,< Interrupt by user.
>)]
	SETZM CTCFLG

	SKIPE IOXFLG		; I/O error?
	  HRROI A,[ASCIZS (456,552,< System I/O Error.
>)]
	SETZM IOXFLG

	PSOUT			; Report error, fake ABOR


; ABORt command

ZABOR:	SKIPE F$DTIP		; File activity?
	  JRST DOABOR		; Yes. Abort it
				; No
IFN TCPP,<
	SKIPLE DATCON		; Data connection open?
	 SKIPN DATCON+T.JCN
	  JRST ZABOR5		; No
	JSP B,RPCRLP		; Yes, report it
	ASCIZS (<202 ABOR request ignored.>,<225 No file transfer in progress, Data connection OPEN.>)
ZABOR5:
> ; End of IFN TCPP


	JSP B,RPCRLP		; Report data connection closed
	ASCIZS (<202 ABOR request ignored.>,<226 No file transfer in progress, Data connection CLOSED. >)

; Abort data transfer

DOABOR:	CLOSD DATCON		; Close the data connection
	SETZM F$DTIP		; Data transfer no longer in progress

	JSP B,RPCRLP		; Back to top.
	ASCIZS (<200>,<226>,< File transfer aborted, Data connection CLOSED.>)
	SUBTTL	Command Execution Routines - BOMB, BYE/QUIT, CRASH, HELP, NOOP

ZBOMB:	CALL BOMB		; Another one


ZBYE:
ZQUIT:	JSP B,ERRRPL		; Send this message, then hang up.
	ASCIZS (<231 BYE>,<221 QUIT>,< command received. Goodbye.>)


ZCRASH:	JRST 4,.		; Test command for fatal errors


ZNOP:
ZNOOP:	JSP B,RPCRLP
	ASCIZS (200,200,< No-operation OK.>)



ZSITE:	JSP B,RPCRLP
	ASCIZS (100,214,< Use SMNT <structure-name> to use unregulated structures.>)
	SUBTTL	Command Execution Routines - HELP

;CWL ARG & MORE INFO

ZHELP:
 IFE TCPP,<
	JSP B,RPCRLP
	ASCIZS (100,,< The following commands are allowed before logging in:
100 USER, PASS, ACCT, NOP, NOOP, HELP, MAIL, MLFL, BYE,
100 BYTE (8 only), TYPE (A only), MODE (S only), and STRU (F only).
100 After logging in, the following are allowed:
100 BYTE (8, 32 and 36 only), SOCK, TYPE (A,I,L,XTP only),
100 RETR, STOR, APPE, RNFR, RNTO, DELE, LIST, NLST,
100 STAT (for directory listing), CWD and XCWD.
200 End of help text.>)
 >

 IFN TCPP,<
	HRROI B,HMSNL		; Pre-login message
	TXNE F,F.LOGI
	  HRROI B,HMSLI		; Post-login message
	JRST RPCRLP

HMSNL:	ASCIZ /214-The following commands are allowed before logging in:
214-  USER, PASS, ACCT, HELP, MAIL, MLFL, QUIT,
214-  SITE, TYPE A, MODE S, STRU F, and NOOP.
214-After logging in, the following are also allowed:
214-  TYPE I, TYPE L 1 to 36, STRU P,
214-  RETR, STOR, APPE, RNFR, RNTO, SMNT, CWD,
214-  DELE, LIST, NLST, STAT, PASV, and PORT.
214 End of help text./

HMSLI:	ASCIZ /214-The following commands are allowed:
214-  PASS, ACCT, HELP, QUIT, NOOP,
214-  SITE, TYPE I, TYPE L 1 to 36, STRU P,
214-  RETR, STOR, APPE, RNFR, RNTO, SMNT, CWD,
214-  DELE, LIST, NLST, STAT, PASV, and PORT.
214 End of help text./
 >
	SUBTTL	Command Execution Routines - MAIL/MLFL

; MAIL Command - Appends mail to local user's mailbox
; and MLFL Command, same but data on data conn instead of TELNET.

ZMAIL:	TXZA F,F.MLFL		; Flag MAIL, not MLFL
ZMLFL:	  TXO F,F.MLFL		; Flag MLFL, not MAIL

	TXNE F,F.LOGI		; Don't accept mail if logged in.
	 SKIPE DBUGSW		; If debug ok to be logged in
	  TRNA
	   JRST [JSP B,RPCRLP
		ASCIZS (<504>,<530>,< Mail only accepted if you do NOT log in first.>)]

	CALL SST		; Skip over to name

; XSEM joins here	;CWL WHAT ABOUT F.LOGI & F.MLFL
;MAILJ:
	TXZ F,<F.MFWD+F.NXM>	; Assume not forwarding

	CALL DELTMP		; Flush temp file if exists
	CLOSR LCLJFN		; In case aborted out of MAIL

	SETOM LCLJFN		; No temp file
	SETZM F$KPGN
	SETZM IBITCT		; No bits read yet
	SETZM MLDIR		; No directory # yet
	SETZM MLUSR		; No user # yet
	SETZM MLUNST		; No user name yet

	MOVE B,SBP
	MOVX C,5*MLUNWD
	SETZ D,
	HRROI A,MLUNST
	SOUT

	MOVX B,C.NUL
	IDPB B,A		; Terminate string

	SKIPN MLUNST		; There was a name, wasn't there?
;CWL BETTER MESSAGE HERE?
	  JRST MAILX4		; No. A losing command
	SUBTTL	Command Execution Routines - MAIL/MLFL, cont.

	HRROI A,GTJSTR		; Now make the destination name
	HRROI B,T20.DV		; TOPS-20 structure name
	SKIPE TENEX		; Add structure name
	  HRROI B,TNX.DV	; TENEX structure name
	SETZ C,
	SOUT

	MOVEI B,"<"		; Stick in user name
	BOUT

	HRROI B,MLUNST		; Name from command
	SOUT

	MOVEI B,">"		; End user name
	BOUT

	HRROI B,T20.MB		; TOPS-20
	SKIPE TENEX		; Mailbox file name
	  HRROI B,TNX.MB	; TENEX
	SOUT

	PUSH P,A		; BBN save ptr for account
	MOVX A,<GJ%DEL+GJ%SHT>	; TOPS-20
	SKIPE TENEX
	  MOVX A,<GJ%OLD+GJ%DEL+GJ%SHT> ; See if TENEX mailbox exists

	HRROI B,GTJSTR
	GTJFN			; First try with user's default account
IFE MLACTF,<
	  JRST MLFWQ		; It doesn't. See if forwarding exists.
 >
IFN MLACTF,<
	  JRST [POP P,A		; Restore string for account
		HRROI B,TXX.AC	; Mail default account string
		SOUT
		MOVX A,<GJ%DEL+GJ%SHT>	; TOPS-20
		SKIPE TENEX
		  MOVX A,<GJ%OLD+GJ%DEL+GJ%SHT> ; See if TENEX mailbox exists

		HRROI B,GTJSTR	; Point to new string
		GTJFN		; Second, try with mail account string
		  JRST MLFWQ	; Both lose, see if forwarding exists.
		TXO F,F.NXM ;****; Mark user account as "nonexistant" (funny)
		JRST .+2]   ;****; Join below after pop
 >
	POP P,(P)		; Flush string
	SUBTTL	Command Execution Routines - MAIL/MLFL, cont.

	MOVX B,<1,,.FBCTL>	; Make sure alleged mailbox is
	MOVEI C,C		; permanent. If not, pretend
	GTFDB			; it doesn't exist
	TXNN C,FB%PRM
	  JRST [RLJFN		; If not permanent
		  JFCL
		JRST MLFWQ]	; Forward it
	RLJFN			; Release mailbox JFN
	  JFCL

	CALL TIMEOK		; Update kill time

; Note: Mailboxes can exist in directories which are NOT users

	HRROI B,MLUNST		; Ok, get directory number
	CALL DIRCHK		; See if such a directory
	  JRST MAILX4		; No such directory
; CWL	CANE B,	ANONYMOUS DIR #	; Refuse mail to ANONYMOUS?
	 CAMN B,SYSDNM		; System directory?
;CWL BETTER MESSAGE?
	  JRST MAILX4		; Yes. Refuse it.
	MOVEM B,MLDIR		; Save directory #
;	MOVEM B,MLUSR		; Also default user # (if TENEX)

	HRROI B,MLUNST		; Mailbox name
	CALL USRCHK		; See if also a user
	  JFCL			; No, USER # is really DIR #
	  MOVE B,MLDIR		; FILES-ONLY (ok here)
	MOVEM B,MLUSR		; Real user
	SUBTTL	Command Execution Routines - MAIL/MLFL, cont.

MAIL0A:	HRROI A,GTJSTR		; Build a name for temp file for mail.
	HRROI B,T20.DV		; TOPS-20
	SKIPE TENEX		; Structure name
	  HRROI B,TNX.DV	; TENEX
	SETZ C,
	SOUT

	HRROI B,TXX.MT		; Mail temp file name
	SOUT

	HRRZ B,GJINF3		; Job number
	MOVX C,DECRAD		; Decimal
	NOUT			; Into filename
	  JSP E,MAILX9		; Impossible failure

  REPEAT 0,<
	MOVEI B,"-"		; Separator
	BOUT
	PUSH P,A		; Save pointer
	GTAD			; Get a number
	MOVE B,A		; Store it
	POP P,A			; Restore
	NOUT			; And make file name unique
	 JSP E,MAILX9		; Can't fail
  >

	HRROI B,[ASCIZ /;P770000/]; And make job dependent.
	SETZ C,
	SOUT

IFN MLACTF,<
	HRROI B,TXX.AC		; Mail account
	SOUT
> ; End of IFN MLACTF

	MOVX B,C.NUL		; Make sure terminator
	BOUT

;MAIL01:
	MOVX A,<GJ%FOU+GJ%TMP+GJ%DEL+GJ%SHT>
	HRROI B,GTJSTR		; GTJFN short, string, out, temp, ig del.
	GTJFN
	  JSP E,MAILX9		; Can't?
	MOVEM A,LCLJFN		; Store JFN

	CALL TIMEOK		; Update kill time

	MOVX B,<FLD(7,OF%BSZ)+OF%WR> ; Open to write.
	OPENF
	  JSP E,MAILX9		; Can't?
	SUBTTL	Command Execution Routines - MAIL/MLFL, cont.

;MAIL HEADER:
;	Mail-From: foreign host
;	Recieved-Date: dd-mon-yy hhmm-tmz
;USER SHOULD START WITH Date:, From:, Subject: AND To:

	HRROI B,[ASCIZ /Mail-From: /] ; Write mail header info
	SETZ C,
	SOUT

	MOVE B,A		; Tmp file JFN
	MOVX A,.GTHNS
	MOVE C,FHSTN
	GTHST
	  JRST [MOVE A,LCLJFN
		HRROI B,[ASCIZ /Site /]
		SETZ C,
		SOUT
		MOVX D,<POINT 8,FHSTN,3>
		CALL HST4DA	; #.#.#.# to A/
		JRST .+1]
;MAIL1B:

	MOVE A,LCLJFN
	HRROI B,[ASCIZ/
Received-Date: /]
	SETZ C,
	SOUT

	MOVX C,<OT%NSC+OT%NCO+OT%TMZ+OT%SCL>
	SETO B,
	ODTIM

	HRROI B,CRLFM		; End line
	SETZ C,
	SOUT

	TXNE F,F.MLFL		; Mail file?
	  JRST MLFL01		; Yes. Different data capture mechanism
	SUBTTL	Command Execution Routines - MAIL from TELNET connection

	MOVX A,.PRIOU
	HRROI B,[ASCIZS (<350 >,<354->,<Type mail, ended by a line with only a "."
>,<>,<354 Begin with Date:, From:, Subject: and To:
>)]
	SETZ C,
	SOUT			; Send msg and dump buffer

MAILL1:	TXO F,F.INML		; Flag no editing
	CALL LINEIN		; Now read TELNET lines.
	  JRST [TXZ F,F.INML	; Clear flag
		TXNE F,F.LTL
		  JRST [JSP X,MAIL05 ;MAILX6:
			ASCIZ /451 Line too long./]
		JRST [JSP X,MAIL05 ;MAILX8: EOF ON TELNET. ABORT.
			ASCIZS (453,426,< Net connection closed.>)]
		]
	TXZ F,F.INML
;MAIL1A:

	MOVE A,CMDIB		; See if line was just a dot
	CAMN A,[ASCII /./]
	  JRST MAIL02		; Yes. Defines end.

	MOVE A,LCLJFN
	HRROI B,CMDIB		; Put the line in the temp file
	SETZ C,
	SOUT

	HRROI B,CRLFM		; And a CR LF which was stripped
	SOUT

	CALL TIMEOK		; Update kill time
	JRST MAILL1		; Loop till dot or EOF
	SUBTTL	Command Execution Routines - MAIL from data connection

MLFL01:	CALL OPN8NC		; Get a data connection
	  JRST [JSP B,RPCRLP	; MLFLXP: Fail because parameters no good
		ASCIZS (454,501,< Mail file must be 8-bit, Ascii type, Stream mode, File structure.>)]
	  JRST [CLOSD DATCON	; MFPDX1:
		CLOSR LCLJFN
		CALL DELTMP
		JSP B,RPCRLP
		ASCIZS (454,425,< Unable to establish data connection.>)]

	MOVX A,.PRIOU
	HRROI B,[ASCIZS (250,150,< Begin mail file transfer.
>)]
	SETZ C,
	SOUT			; Send msg and dump buffer

MLFLL1:	MOVE A,DATCON		; Get the mail
	$BIN
	JUMPN B,MLFLN		; EOF or NULL?

	$GTSTS			; Yes. See which.
	TXNE B,GS%EOF
	  JRST [CLOSD DATCON	; MLFLEF:
		JRST MAIL02]	; Now copy to real mailbox.
	JRST MLFLL1		; NULL. Throw it away.

MLFLN:	CAILE B,177		; And throw away TELNET controls
	  JRST MLFLL1

	MOVE A,LCLJFN		; Ok, a real char. Put in file
	BOUT

	CALL TIMEOK		; Update timeout
	JRST MLFLL1		; Onward.


;MLFLEX:	CLOSD DATCON		; Close JFN
;	JRST MAIL05		; And release files
	SUBTTL	Command Execution Routines - MAIL from local temp file

; All mail in temp file

MAIL02:	MOVX A,CO%NRJ		; Keep JFN
	HRR A,LCLJFN		; For temp file
	CLOSF			; But keep the JFN
	  JFCL

	CALL TIMEOK		; Update kill time

	HRRZ A,LCLJFN		; Re-open for reading
	MOVX B,<FLD(7,OF%BSZ)+OF%RD> ; Reopen for reading
	OPENF
	  JSP E,MAILX9		; Can't

	SIZEF			; Check size of the mail
	  JSP E,MAILX9		; Can't fail

	ASH B,3			; Eight bits per
	ADDM B,TRBITS
	ASH B,-3
	CAIL B,10000		; Don't allow super-huge files.
	  JRST [JSP X,MAIL05	; MAILX5: Bad.
		ASCIZ /451 Message too long./]

	TXNE F,F.MFWD		; Forwarding?
	  JRST [HRROI A,GTJSTR	; Yes. Copy file name to fwd thru
		HRROI B,MLFWST
		SETZ C,
		SOUT

		MOVX B,C.NUL
		BOUT		; Terminate with null
		JRST MAIL2A]
	HRROI A,GTJSTR		; Now make the destination name
;	HRROI B,T20.DV		; TOPS-20
;	SKIPE TENEX		; Structure name
;	  HRROI B,TNX.DV	; TENEX
;	SETZ C,
;	SOUT
	MOVEI B,"<"		; Stick in user name
IFN REL4,<SKIPE TENEX>		; If on TENEX, make into a directory
	  BOUT

	MOVE B,MLDIR		; His directory number
	DIRST			; TENEX "NAME"; TOPS-20 "PS:<NAME>"
	  JSP E,MAILX9		; Shouldnt fail

	MOVEI B,">"
IFN REL4,<SKIPE TENEX>		; If TENEX, stick in an anglebracket
	  BOUT

	HRROI B,T20.MB		; TOPS-20
	SKIPE TENEX		; Mail box file name
	  HRROI B,TNX.MB	; TENEX
	SETZ C,
	SOUT

	HRROI B,TXX.AC		; Default account string
	TXZE F,F.NXM		; Was mailbox "nonexistant"?
	  SOUT			; Yes, tack on an account

	MOVX B,C.NUL		; Make sure NUL terminator
	BOUT

; Falls thru
; Fallen into from above
; Try to open mailbox or "[--UNSENT-MAIL--].user@host"
;CWL FLAG FOR QUEUED VS DELIVERED FOR REPLY MESSAGE?

MAIL2A:	MOVX X,5		; Times to try if busy
MAIL2B:	HRROI B,GTJSTR		; Now get a JFN for mailbox
	MOVX A,GJ%DEL!GJ%SHT	; TOPS-20
	SKIPE TENEX
	  MOVX A,GJ%OLD!GJ%DEL!GJ%SHT ; TENEX
	TXNE F,F.MFWD		; Forwarding?
	  MOVX A,GJ%FOU!GJ%NEW!GJ%SHT ; New file only then
;MAIL2C:

	GTJFN
	  JSP E,MAILX9		; No such file
;	  JRST MAILX4		; No such file
	PUSH P,A		; Keep on stack

	HRLI A,.FBCTL		; Make sure it's undeleted
	MOVX B,FB%DEL
	MOVX C,<0*FB%DEL>	; Not deleted bit
	CHFDB

	CALL TIMEOK		; Update kill time

	HRRZ A,0(P)		; Restore JFN
	MOVX B,<FLD(7,OF%BSZ)+OF%APP> ; Append to it.
	OPENF
	  JRST [		; Open failure
	    MOVEM A,B		; Save error code for diagnosis

	    POP P,A		; First release JFN
	    RLJFN
	      JFCL

	    SOJLE X,[		; If giving up, diagnose failure
		CAIE B,OPNX1	; File is already open
		CAIN B,OPNX9	; Invalid simultaneous access
				; If can forward, to MAIL2A above
		  JRST [MOVE A,FHSTN	; Don't queue if from same host
					;CWL WHY NOT??
			TXNN F,F.MFWD	; Only possible if to real mailbox
			CAMN A,LHOSTN	; To avoid circular sending
			  JRST [JSP X,MAIL05
				ASCIZS (453,450,< Mailbox busy.>)]
			HRROI A,GTJSTR	; Ok to queue. Make file name
	SUBTTL	Command Execution Routines - MAIL from local temp file, cont.

			HRROI B,T20.UM	; TOPS-20
			SKIPE TENEX	; [--UNSENT-MAIL--].
			  HRROI B,TNX.UM ; TENEX
			SETZ C,
			SOUT

			HRROI B,MLUNST	; User
			SOUT

			HRROI B,TXX.MA	; @
			SETZ C,
			SOUT		; No host (local)

			HRROI B,T20.NV	; TOPS-20
			SKIPE TENEX	; ./;-1
			  HRROI B,TNX.NV ; TENEX
			SOUT

			HRROI B,TXX.AC	; Optional mail account
			SOUT

			MOVX B,C.NUL
			BOUT

			TXO F,F.MFWD	; Now forwarding
			JRST MAIL2A]

		CAIN B,OPNX6	; Append access required
		  JRST [JSP X,MAIL05
			ASCIZS (450,550,< Append access to mailbox not allowed.>)]
		CAIN B,OPNX10	; Entire file structure full
		  JRST [JSP X,MAIL05
			ASCIZS (453,452,< Disk full.>)]
		CAIN B,OPNX16	; File has bad index block
		  JRST [JSP X,MAIL05
			ASCIZS (453,550,< Mailbox damaged.>)]
		JRST [JSP X,MAIL05
			ASCIZS (453,550,< Unexpected failure to open mailbox.>)]
		]

	    MOVX A,^D2000	; Wait & try again
	    DISMS
	    JRST MAIL2B]
	SUBTTL	Command Execution Routines - MAIL from local temp file, cont.

	MOVE A,LCLJFN		; Get # of chars in temp file
	SIZEF
	  JRST [POP P,A
		CLOSF
		  JFCL
		JSP E,MAILX9]
	MOVEM B,T1		; Save # chars in T1

	TXNE F,F.MFWD		; Forwarding?
	  JRST MAILL2		; Yes. Don't put header on.

	MOVE A,0(P)		; Message file

	SETO B,			; Put standard msg file format on.
	MOVX C,OT%TMZ		; First, date and time with time zone.
	ODTIM

	MOVX B,","		; Then comma
	BOUT

	MOVE B,T1		; Size of text
	MOVX C,DECRAD		; Decimal radix
	NOUT
	  MOVE A,0(P)		; If error, JFN back to A

	MOVX B,";"		; Now bit flag field ;#6 remove space
	BOUT

	SETZ B,			; Is normally 0.
	MOVE C,FORNS		; If foreign ICP socket
REPEAT 0,<			; 3/81 conflicts with HERMES
	CAIL C,MLSKT		; Is authenticated mail socket
	CAILE C,MLSKT+5		; In this group of 6
	  SKIPA			; No good.
	    TXO B,1B7		; Ok, flag verified in B7
  >
	MOVX C,<NO%LFL+NO%ZRO+FLD(^D12,NO%COL)+FLD(OCTRAD,NO%RDX)>
	NOUT			; 12 octal digits, leading 0'S.
	  MOVE A,0(P)		; If error, JFN back to A

	HRROI B,CRLFM
	SETZ C,
	SOUT			; And CR, LF on end of line

; Fall thru

; MAIL BOX(forward) JFN on stack

MAILL2:	MOVE A,LCLJFN		; Temp file JFN pointer back at start
	SETZ B,
	SFPTR
	  JFCL

	MOVE B,T1		; Count 8-bit chars, though includes
	IMULI B,10		; Small error of local header
	ADDM B,IBITCT
	ADDM B,TRBITS

MLLUP1:	CALL 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 next page
	  MOVX 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 or

REPEAT 0,<
	MOVX D,C.FF		; Stop on formfeed (to convert it)
MLLUP2:
  >

	SIN			; Read

REPEAT 0,<
	LDB T2,B		; If last char FF, replace by LF
	CAIN T2,C.FF
	  MOVX T2,C.LF
	DPB T2,B
	JUMPN C,MLLUP2		; Finish SIN if incomplete
  >

	POP P,C			; # of chars read
	MOVNS C			; Write them to msg file
	HRROI B,WINDOW
	MOVE A,0(P)		; Mail file JFN
	SOUT

	JRST MLLUP1		; Loop for more
; Mail in mailbox or unsent mailbox

MAIL03:
IFN REL4,<SKIPE TENEX
	   JRST MAIL3A		; Don't do this if on TENEX

	HRROI B,FHSTNM		; Foreign host name
	MOVE C,FHSTN		; Foreign host number
	MOVX A,.GTHNS		; Get string from number
	GTHST
	  SETZM FHSTNM		; If fail, no name

	HRROI B,FHSTNM
	MOVE A,(P)		; Get file JFN 
	HRLI A,.SFLWR		; Last writer string
	SFUST			; Set it
	  ERJMP .+1		; If fails
> ; End of Release 4 conditional
MAIL3A:

	POP P,A			; Close & delete temp file
	CLOSF
	  JFCL

	JFCL
; 	CALL MLSTAT		; Record mail statistics

	TXO F,F.NALO		; No autologout, now. May be MAILER.
	HRROI X,MAILM2		; Mail done.
	TXNE F,F.MLFL		; Or was it MLFL
	  HRROI X,MAILM3	; Yes.
	JRST MAIL05

MAILM3:	ASCIZS (252,226,< Mail completed successfully.>) ; For MLFL

MAILM2:	ASCIZS (256,250,< Mail completed successfully.>) ; For MAIL
	SUBTTL	Subroutines - MLSTAT

;	CALL MLSTAT	Record mail statistics if appropriate
;			in PS:<MAIL2>,PS:<SYSTEM> MAIL.BLOG

;	Page 1,2,3	Word(FHSTN) is # messages recieved
;	Page 4,5,6	Word(Local DIR #) is # messages for directory
;	Page 7		Word(1/2 hrs since midnight) is # messages
;			Word(777) is CPU time used
;	Page 10		Word(1/2 hrs since midnight) is # characters


MLSTAT:	SKIPE DBUGSW		; Return if debugging
	  RET
	SKIPLE A,FHSTN		; Cannot use internet ID
	CAIL A,<^D3*512>	; 3 512. word pages
	  RET

	HRROI A,GTJSTR
	HRROI B,T20.DV		; TOPS-20
	SKIPE TENEX		; Structure
	  HRROI B,TNX.DV	; TENEX
	SETZ C,
	SOUT
	MOVEI B,"<"
	BOUT

	HRROI B,TXX.M2		; See if MAIL2 directory exists
	CALL DIRCHK
	  SKIPA B,[TXX.SY]	; No, use SYSTEM
	 MOVE B,[TXX.M2]	; Yes, use MAIL2
	HRRO B,B		; Build pointer

;	SETZ C,
	SOUT
	MOVEI B,">"
	BOUT
	HRROI B,TXX.ML		; Mail log file name
	SOUT

	SETO B,			; Calculate version number for
	MOVX D,<IC%DSA+<0*IC%ADS>+IC%UTZ+FLD(0,IC%TMZ)>
	ODCNV			; Statistics file based on GMT date
	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
	SUBTTL	Subroutines - MLSTAT, cont.

	TXO A,GJ%SHT		; Shortc form GTJFN
	HRROI B,GTJSTR		; File name for mail log file
	GTJFN
	  RET			; Can't, give up
	MOVEM A,LOGJFN		; Save JFN

	MOVX B,<OF%RD+OF%WR+OF%THW> ; Read,Write,Thawed
	OPENF
	  JRST MLSTA2		; Can't, give up

	HRL A,LOGJFN		; Map page 1 of statistics file
	HRRI A,1
	MOVX B,<.FHSLF,,<WINDOW/1000>>
	MOVX C,<PM%RD+PM%WR>	;Read/Write
	PMAP
	MOVE A,FHSTN		; Increment # of msgs received
	ANDI A,1777		; Beware internet, etc address
	AOS WINDOW(A)		; From this host
	SETO A,			; Unmap page
	SETZ C,			; No count
	PMAP

	HRL A,LOGJFN		; Map page 3 of file
	HRRI A,3
	MOVX C,<PM%RD+PM%WR>	;Read/Write
	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
	ANDI A,1777		; Beware internet, etc address
	ADDM B,WINDOW(A)	; From this host
	SETO A,			; Unmap page
	MOVX B,<.FHSLF,,<WINDOW/1000>>
	SETZ C,			; No count
	PMAP

	HRL A,LOGJFN		; Map page 4 of file
	HRRI A,4
	MOVX C,<PM%RD+PM%WR>	;Read/Write
	PMAP
	HRRZ C,MLDIR		; Directory number of user receiving mail
	IDIVI C,^D36		; Calculate word and bit
	MOVX A,1B0		; Corresponding to user #
	MOVNS D
	ROT A,(D)
	IORM A,WINDOW+200(C)	; Turn on bit for that user
	SETO A,			; Unmap page
	SETZ C,			; No count
	PMAP
	SUBTTL	Subroutines - MLSTAT, cont.

	HRL A,LOGJFN		; Now the time-histogram pages
	HRRI A,10		; Page 10 is chars by time of day
	MOVX C,<PM%RD+PM%WR>	; 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
	SETO A,			; Unmap page
	MOVX B,<.FHSLF,,<WINDOW/1000>>
	SETZ C,			; No count
	PMAP

	HRL A,LOGJFN		; Now count msgs by time of day
	HRRI A,7		; In this page
	MOVX C,<PM%RD+PM%WR>	; Read and write access
	PMAP
	AOS WINDOW(D)		; Count a msg

	MOVX A,.FHSLF		; Now get run time of this fork
	RUNTM
;CWL NOT INITIALIZED??
	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
	MOVX B,<.FHSLF,,<WINDOW/1000>>
	SETZ C,			; No count
	PMAP

MLSTA2:	CLOSR LOGJFN		; Close statistics file
	RET
	SUBTTL	Forward Mail

; If mailbox is busy or cannot be opened, forward mail

MLFWQ:	MOVX A,<GJ%OLD+GJ%SHT>	; Get JFN of forwarder
	HRROI B,T20.MF		; TOPS-20
	SKIPE TENEX		; Mailbox program
	  HRROI B,TNX.MF	; TENEX

	GTJFN
	  JRST MFWDX1		; Not there. ;CWL BETTER MESSAGE?
				; No forwarder instead of no mailbox?
	PUSH P,A		; Save JFN
	CALL TIMEOK		; Update kill time

	MOVX A,CR%CAP		; Create an inferior fork
	CFORK
	  JRST [MOVX A,^D2000	; Failed get fork, wait 2 sec & try again
		DISMS

		MOVX A,CR%CAP
		CFORK
		 SKIPA		; Failed again
		  JRST .+1	; Got fork, go back

		POP P,A		; No fork. Release MAILBOX.EXE JFN
		RLJFN
		  JFCL

		JSP X,MAIL05	; MAILX3:
		ASCIZS (453,451,< No forks available; Please try later.>)]

	PUSH P,A		; Save fork handle
;STACKED FORK HANDLE & JFN
	HRL A,0(P)		; Get prog into fork
	HRR A,-1(P)		; JFN
	GET
				; Access page of program
	HRLZ A,0(P)		; Page 0 of inferior
	MOVX B,<.FHSLF,,BLTPAG>	; Mapped from this fork
	MOVX C,<PM%RD+PM%WR>	; Rd, Wrt access
	PMAP
				; Pass arguments to it
	MOVX T1,<-10,,0>	; Copy name (10 is pgm paramater)
	 MOVE A,MLUNST(T1)	; Commanded addressee
	 MOVEM A,BLTADR+140(T1)	; To inferior
	 AOBJN T1,.-2

	MOVE A,0(P)		; Fork handle again
	MOVEI B,[1]-1		; Set AC1 to 1 for local site
	SFACS

	CALL TIMEOK		; Update kill time

	MOVX B,2		; Entry vector offset for running as fork
	SFRKV			; Start up inferior
	WFORK
	CALL TIMEOK		; Update kill time

	RFSTS			; See if it finished ok
	HLRZ A,A
	CAIE A,.RFHLT		; HALTF?
	  JRST MFWDX3		; No

	MOVE A,0(P)		; Handle again
	MOVX B,ACTACS		; Account fork AC blk is free here
	RFACS			; Get answer
	SKIPG ACTACS+1		; Success answer?
	  JRST MFWDX3		; No

	MOVX A,<POINT 7,LHSTNM>	; Prevent loops.
	MOVX B,<POINT 7,BLTADR+150> ; By checking for local host
	MOVX C,50
MLFWQ2:	ILDB T1,A		; Check user's host name from program
	ILDB T2,B
	CAME T1,T2
	  JRST MLFWQ3		; User not at this host; punt
	JUMPE T1,MLFWQ1		; If matched thru end, check name

	SOJG C,MLFWQ2		; Look til end or mismatch
	JRST MFWDX3		; Wierd failure.


MLFWQ1:	MOVX A,<POINT 7,MLUNST>	; See if user name matches too
	MOVX B,<POINT 7,BLTADR+140>
	MOVX C,50
MLFWQ4:	ILDB T1,A
	ILDB T2,B
	CAME T1,T2
	  JRST MLFWQ3		; Bad user name
	JUMPE T1,MFWDX3

	SOJG C,MLFWQ4
	JRST MFWDX3
MLFWQ3:	HRROI A,MLFWST		; Copy over for a new file
	HRROI B,T20.UM		; TOPS-20
	SKIPE TENEX		; Unsent mail file name
	  HRROI B,TNX.UM	; TENEX
	SETZ C,			; Mailer standard name
	SOUT
	HRROI B,BLTADR+140
	SOUT
	HRROI B,TXX.MA		; Separate NAME@HOST
	SOUT
	HRROI B,BLTADR+150
	SOUT
	HRROI B,T20.NV		; TOPS-20
	SKIPE TENEX		; New version of file
	  HRROI B,TNX.NV	; TENEX
	SOUT
	HRROI B,TXX.AC		; Account
	SOUT
	MOVX B,C.NUL
	BOUT

	HRROI A,STRTMP		; Build reply
	HRROI B,[ASCIZS (951,151,< Mail will be forwarded to >)]
	SOUT			; Tell user
	HRROI B,BLTADR+140
	SOUT			; Give addressee
	HRROI B,[ASCIZ / at /]
	SOUT
	HRROI B,BLTADR+150
	SOUT
	HRROI B,CRLFM		; End of line
	SOUT
	MOVX B,C.NUL		; Be safe
	BOUT

	MOVX A,.PRIOU		; Now send it all
	HRROI B,STRTMP
	SOUT

	TXO F,F.MFWD		; Flag for later processing
	POP P,A			; Fork handle of forwarder
	KFORK
	MOVE A,0(P)		; And MAILBOX.EXE JFN
	HRLI A,(CO%NRJ)		; Why keep if RLJFN??
	CLOSF
	  JFCL
	POP P,A
	RLJFN
	  JFCL
	CALL TIMEOK		; Update kill time
	JRST MAIL0A		; Now get the mail

MFWDX3:	POP P,A			; Fork
	KFORK

	MOVE A,0(P)
	HRLI A,(CO%NRJ)		; Why keep if RLJFN??
	CLOSF
	  JFCL

	POP P,A			; JFN for MAILBOX.EXE
	RLJFN
	  JFCL

MFWDX1:	JRST MAILX4


REPEAT 0,<			; This would create a mailbox if
				; data base said there should be one
MLFWMX:	HRROI B,GTJSTR		; Mailbox string
	MOVX A,GJ%SHT		; Short ( so be sure to create)
	GTJFN
	  JRST MAILX4		; Can't, give up

	MOVX B,OF%RD!OF%WR	; Open it up ;CWL PROTECTION?
	OPENF
	  JRST MAILX4		; Failed

	HRLI A,.FBCTL		; Ctl word
	MOVX B,FB%PRM+FB%DEL	; Change deleted, permenant bits
	MOVX C,FB%PRM		; To be off & on respectivly
	CHFDB			; Set them

	HRRZS A
	CLOSF			; Close the file
	  JFCL

	JRST MAIL01		; And go get mail
>	; END REPEAT 0

MAILX4:	JSP	X,MAIL05
	ASCIZS (450,504,< No such mailbox at this site.>)

MAILX9:	HRROI A,ERRSTR
	HRROI B,[ASCIZS (455,451,< >)]
	SETZ C,
	SOUT

	HRLOI B,.FHSLF
	ERSTR
	  SETZM ERRSTR		; If no msg, zero first byte
	  SETZM ERRSTR

	HRROI B,[ASCIZ /, PC=/]
	SOUT

	HRRZ B,E		; Get PC
	MOVX C,OCTRAD		; Octal
	NOUT
	  JFCL

	HRROI X,ERRSTR
;	JRST MAIL05		; Fall into MAIL05


;	HRROI X,[ASCIZ /.../]	JSP X,MAIL05
;	JRST MAIL05		ASCIZ /.../

MAIL05:	CALL DELTMP		; Flush temp file if exists
	CLOSR LCLJFN
	CLOSD DATCON
	HRROI B,(X)		; Reply to correct AC
	JRST RPCRLP		; Back to top level

; CLOSE AND DELETE LCLJFN

DELTMP:	SKIPG A,LCLJFN		; Get out the temp file.
	  RET			; No file
	HRLI A,(CO%NRJ)		; Keep JFN for expunge
	CLOSF
	  JFCL
	MOVX A,DF%EXP		; Expunge it too
	HRR A,LCLJFN		; Get JFN
IFN REL4,<SKIPE TENEX>		; On TENEX don't set bit
	   HRRZS A		; So clear left half
	DELF
	  JFCL
	RET

;MAILM9:ASCIZS (453,451,< Scratch file failure.>)
	SUBTTL	Subroutines - OPN8NC

;Subr used by MLFL (and FORMERLY XLPTF) to open ascii data connection.
;	CALL OPN8NC	Open 8-bit ASCII data connection
;Ret+1:	  Bad parameters
;Ret+2:	  Open failure
;REt+3:	Opened ok

OPN8NC:	SKIPG $STRU		; Arguments for simple ASCII xfer?
	 SKIPLE $MODE
	  RET			; Params bad
	SKIPN A,$BYTE		; Byte size 8?
	  MOVX A,^D8		; Or unspecified?
	SKIPG $TYPE		; And ASCII type?
	 CAIE A,^D8
	  RET			; No.
	AOS 0(P)		; At least one skip after here

IFN TCPF,<			; TCP version of open
	MOVEI A,T.CDB+DATCON	; Connection descriptor block
	MOVE B,FTPDAT		; Local data port number
	MOVEM B,.TCPLP(A)
	MOVE C,LHOSTN		; Must use address by which we
	MOVEM C,.TCPLH(A)	; were initially contacted
	MOVE B,FHSTN
	MOVEM B,.TCPFH(A)
	MOVE B,FORNS
	MOVEM B,.TCPFP(A)

	MOVEI A,DATCON		; File block
	MOVX B,<-T.NDBF,,DATBUF>; Number and location of data buffers
	MOVX C,<TCP%WT!TCP%FS!T.BFSZ> ; Size of buffers
	$GTJFN			; W/ initiate connection & wait
	  RET			; Failed
	MOVEM A,DATCON		; "JFN"

	MOVEI A,DATCON		; File block
	MOVX B,<FLD(^D8,OF%BSZ)> ; 8-bit connection
	TXNE F,F.SEND		; Send or receive?
	 TXOA B,OF%WR		; Send
	  TXO B,OF%RD		; Receive
	$OPENF
	  RET			; Failed
> ; End of IFN TCPF conditional

IFE TCPF,<			; Version for NCP
	HRROI A,GTJSTR		; Build name for data connection
	HRROI B,[ASCIZ /NET:2./]
	SETZ C,
	SOUT
	MOVE B,FHSTN		; Foreign host number
	MOVX C,OCTRAD		; Octal
	NOUT
	  JFCL
	MOVX B,"-"
	BOUT
	MOVE B,FORNS		; Foreign socket of TELNET conn
	TRO B,1			; His socket is a sender
	ADDI B,2		; And two above the TELNET
	NOUT
	  JFCL
	HRROI B,[ASCIZ /;T/]	; Mine is job relative
	SOUT
	MOVX B,C.NUL
	BOUT

	MOVX A,GJ%SHT		; Now get a JFN
	HRROI B,GTJSTR		; For this connection
	GTJFN
	  RET			; Can't?
	MOVEM A,DATCON		; Ok

	MOVE B,GJINF3		; My job number
	ADDI B,^D100000		; Construct socket number
	LSH B,^D15
	ADDI B,2

	HRROI A,[ASCIZ /255 SOCK /]	; Socket reply
	PSOUT
	MOVX A,.PRIOU
	MOVX C,DECRAD		; Tell him in net virtual radix (10.)
	NOUT
	  JFCL
	HRROI A,CRLFM		; End line
	PSOUT

	MOVE A,DATCON		; Now try to open the connection
	MOVX B,<FLD(8,OF%BSZ)+FLD(^D20,OF%MOD)+OF%RD>
	OPENF			; Type of connection to open
	  RET			; Can't?
> ; End of IFE TCPF conditional

	AOS 0(P)		; Ok, skip return
	RET
	SUBTTL	Command Execution Routines - XSEM, XSEN
	REPEAT 0,<		; How get here??
;XSEN COMMAND HANDLING

ZXSEM:	TXOA F,F.XSEM		; Flag if its an XSEM
ZXSEN:	TXZ F,F.XSEM		; Its an XSEN
	TXNE F,F.LOGI		; Don't accept mail if logged in.
	 SKIPE DBUGSW		; If debug ok to be logged in
	  TRNA
	   JRST ORDERX

			;Get argument (name to send to) and check it
	PUSHJ P,SST		; Push SBP to start of name
	SKIPN TENEX
	 JRST XSEN0
	MOVEI A,1		; Exact match
	MOVE B,SBP		; Check it out
	STDIR
	JRST MAILX4		; No such user
	JRST MAILX4		; Ambiguous, just as bad
	HRRZM A,MLUSR		; He exists! Save number
	JRST XSEN1
XSEN0:	MOVSI A,(RC%EMO)
	MOVE B,SBP
	RCUSR				; Check him/her/it out
	TLNE A,(RC%NOM!RC%AMB)		; Non-exist or ambiguus?
	 JRST MAILX4			; Yes, bad.
	MOVEM C,MLUSR			; Save user number

; But is he online?
XSEN1:	PUSHJ P,ONLINE			; Check it out
	 JUMPE A,XSENX7			; If not online jump...
	PUSHJ P,TTYACP			; Online, see if accepting links
	 JRST XSENX8

; Online, collect message
	HRROI B,[ASCIZ /350 User online, send message ended by a line with only a "."
/]
	PUSHJ P,SDUMPA			; Invite data
	PUSHJ P,MSGBEG			; Set up buffer
	PUSHJ P,MSGCOL			; And get message
	 JRST MAILX5			; Oops, message to long
; Text collection done, try to put stuff into SENDS.TXT
; but dont die if can't
	SETZM MLERRC			; Clear error indicator
	MOVE A,SBP			; Get BP to name, happens to be dirctory
	PUSHJ P,WRTSND
	 MOVEM A,MLERRC			; If error save code

; Check online TTY#'s again just before sending
	PUSHJ P,ONLINE			; List of TTY's in A
	JUMPE A,XSENX7			; Oops he sneaked off
	MOVEI D,ONLNTB
	HLL D,A

; Now send message
	SETZ T1,			; Clr cnt of wins
XSEN4:	MOVEI A,400000
	ADD A,(D)			; Get terminal designator
	RFMOD				; Get mode word
	TRNN B,1000			; Links allowed?
	 JRST XSEN5			; Nope, must be refusing
	PUSHJ P,TIMEOK
	DOBE				; Wait until we can send to him
	SKIPN TENEX			; Don't bother with next on TOPS-20
	 JRST XSEND0
	RFCOC				; Get control output word
	MOVEM B,.TEMP1#			; Save first word and
	MOVEM C,.TEMP#			; Save 2nd word of it
	TLO B,14			; Set bing ^G
	TRO C,1400			; Set to indicate EOL's
	SFCOC
XSEND0:	MOVE T2,[POINT 7,MSGBUF]	; Can send, get pointer to buffer
	MOVEI C,$MBFLN
	SUB C,MSGCNT			; And number ofal CHARACTERS
XSEND:	ILDB B,T2			; Get a char
	BOUT				; Sendl IT
	SOJG C,XSEND			; If more go back
	SKIPN TENEX			; Again skip stuff if TOPS-20
	 JRST XSEND2
	RFCOC
	MOVE B,.TEMP1			; Restore old control chr words
	MOVE C,.TEMP
	SFCOC
XSEND2:	AOS T1				; Add to times sent
XSEN5:	AOBJN D,XSEN4
	JUMPLE T1,XSENX9		; Jump if didn't send any

; Message sent succesfully, one last check
	SKIPE A,MLERRC			; Error in writing SENDS.TXT?
	CAIE A,600130			; Was it because file busy?
	 JRST XSEN9			; If not or no error return now
; Try a little more to write to SENDS.TXT
	MOVEI X,5			; Number of times to try
XSEN7:	MOVE A,SBP			; Luser name
	PUSHJ P,WRTSND			; Try again
	 JRST [	CAIE A,600130
		JRST .+1		; Leave loop if strange error
		SOJLE X,.+1		; Or if tryed enough
		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:	HRROI B,[ASCIZ /User not online./]
	JRST XSENXR
XSENX8:	HRROI B,[ASCIZ /User refusing links./]
	JRST XSENXR
XSENX9:	JSP B,RPCRLP
	ASCIZ /453 Message not sent-- user went away./

XSENXR:	TXNE F,F.XSEM			; Try to mail it?
	 JRST XSENXM			; Yes
	PUSH P,B			; No save ptr to string
	HRROI B,[ASCIZ /453 /]		; Send error prefix
	PUSHJ P,SDUMPA
	POP P,B
	JRST RPCRLP			; Send string and back to command level

; Here to fake MAIL for XSEM

XSENXM:	PUSH P,B			; Save string
	HRROI B,[ASCIZ/009 /]		; Prefix with info code
	PUSHJ P,SDUMPA
	POP P,B				; Then reason for mailing
	PUSHJ P,SDUMPA
	HRROI B,[ASCIZ /  Will mail message.
/]
	PUSHJ P,SDUMPA			; End with above
	TXZ F,F.MLFL			; Tell mail it's coming over TELNET
	JRST MAILJ			; And join mail code



; Random auxiliaries for XSEN
	;ONLINE - takes dir # in MLUSR, returns in A an AOBJN
	;pointer to list of TTY's logged in under that directory
ONLINE:	SETZM ONLNPT			; Clear ptr to TTY's found
	SKIPE TENEX			; Use different routine if TENEX
	 JRST ONLIN3
	MOVSI D,-^D200			; Setup pointer for jobs to look at
ONLIN0:	MOVEI A,(D)			; Job number
	MOVE B,[-2,,T1]			; Where to stick
	MOVEI C,.JITNO			; Start with TTY#
	GETJI
	 ERJMP ONLIN2			; No job there
	CAME T2,MLUSR			; Same guy?
	 JRST ONLIN2			; Nope
	JUMPL T1,ONLIN2			; Detached..
	SKIPN B,ONLNPT			; Get AOBJN ptr to TTY table
	 JRST [MOVEI B,ONLNTB		; If first time must fix up
	       MOVEM B,ONLNPT
	       JRST ONLIN1]
	CAME T1,(B)
	AOBJN B,.-1
	JUMPL B,ONLIN2			; Jump if TTY already in table
ONLIN1:	MOVEM T1,(B)			; Not in table, store
	MOVSI A,-1
	ADDM A,ONLNPT			; Add to AOBJN count
	CAIL B,ONLNTB+$OLNTL		; If stuck this in lat slot
	 JRST ONLIN6			; Time to return
ONLIN2:	AOBJN D,ONLIN0			; Search all jobs
	JRST ONLIN6			; And return

; Here is TENEX stuff
ONLIN3:	MOVE 1,[SIXBIT /JOBDIR/]	; Job table
	SYSGT				; Get number, size
	HLLZ D,B			; AOBJN pointer to job number
	HRRZ T1,B			; Table number
ONLIN4:	HRL A,D				; Index
	HRR A,T1			; Table number
	GETAB
	 JFCL
	HRRZ A,A
	CAMN A,MLUSR			; Same guy?
	 PUSHJ P,GTTTY			; Yes, get his TTY#
	AOBJN D,ONLIN4			; Go back for more
ONLIN6:	SKIPL A,ONLNPT			; Return AOBJN ptr
	 SETZ A,			; Or zero
	POPJ P,

GTTTY:	SKIPN B,ONLNPT			; If first time init things
	 JRST [	MOVE A,[SIXBIT /JOBTTY/]
		SYSGT
		HRRZM B,TABNM1#		; Save table number
		MOVEI B,ONLNTB
		MOVEM B,ONLNPT
		JRST GTTTY2]
GTTTY2:	HRL A,D
	HRR A,TABNM1
	GETAB
	 JFCL
	HLRE A,A
	JUMPL A,GTTTY6			; If detached return
	MOVEM A,(B)			; Store TTY in table
	MOVSI A,-1
	ADDI A,1
	ADDM A,ONLNPT			; Add to AOBJN count
GTTTY6:	POPJ P,				; Go back for more jobs

	;TTYACP - Takes AOBJN ptr to TTY list 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,400000
	ADD A,(D)			; Get terminal descriptor
	RFMOD				; Get mode word
	TRNE B,1000			; See if accepting
	 AOSA -1(P)			; Yes, skip out and do a skip return
	AOBJN D,TTYAC4			; If not check some more
	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
	CALL HSTOUT
	SETZ C,
	HRROI B,[ASCIZ /
/]
	SOUT				;  Output a CRLF
	MOVEM A,MSGBPT			; Store updated BP into buffer
	HRROI B,MSGBUF
	CALL PTRDIF			; Get BP pointer difference into C
	SUBI C,$MBFLN			; Get -# chars left as count
	MOVMM C,MSGCNT			; Store # of chars left as count.
	MOVEI A,1
	MOVEM A,MSGLNS			; Start count of number of lines
	RET

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

MSGCL0:	AOS MSGLNS			; Increment line cnt
	CALL TIMEOK
MSGCOL:	CALL GETLIN
	 RET				; If ran out of room non-skip return
	CAIE C,2			; "." check requires line length 2 exactly
	 JRST MSGCL0			; Nope, get another line
	ILDB D,B			; Get single char
	CAIE D,"."			; Check
	 JRST MSGCL0			; Nope, keep going
	ADDM C,MSGCNT			; End! Take last line off count
	AOS MSGCNT			; Plus extra LF
	MOVEM B,MSGBPT			; And move BP back
	AOS (P)				; And skip for win return
	RET

	;GETLIN - gobbles line from primary input into MSGBUF, updating
	;MSGCNT and MSGBPT. Returns count of characters in line
	;(including terminating CRLF) in C, turns CRLF's into EOL's
	;if on TENEX, byte pointer to beginnning of line in B
	;normally skips; will fail if buffer overflows
GETLIN:	MOVE C,MSGCNT			; Get count and BP for hacking
	MOVE BP,MSGBPT
GETLN2:	CALL TELBIN
	 JRST HANGUP			; He went away
	IDPB B,BP
	SOJLE C,GETLN7			; Jump if no more room
	CAIE B,12			; If end of line
	JRST GETLN2			; Nope, keep going
GETLN4:	EXCH C,MSGCNT			; Store count, get old
	SUB C,MSGCNT			; Find number of chars in line
	MOVEI B,15			; Get CR
	DPB B,BP			; Overwrite LF
	MOVEI B,12			; LF
	IDPB B,BP			; And stick it on
	SOS MSGCNT			; Subtract extra character
	EXCH BP,MSGBPT
	MOVE B,BP			; Return BP in B to BOL
	AOS (P)
	RET
GETLN7:	MOVEM BP,MSGBPT			; Buffer overflowed
	SETZM MSGCNT
	RET


	;PTRDIF - Takes BP's in A and B, Leaves difference (# chars)
	;in C. think of as A-B replaces C
	;wont work for indexed/indirect pointers
PTRDIF:	PUSH P,A
	PUSH P,B
	TLNE A,7077
	 HRLI A,440700
	TLNE B,7077
	 HRLI B,440700
	MULI B,5
	ADD C,PTRD7P(B)
	MULI A,5
	ADD B,PTRD7P(A)
	SUBM B,C
	POP P,B
	POP P,A
	RET
	133500,,0
	BLOCK 4
PTRD7P:	-54300,,5
	-104300,,4
	-134300,,3
	-164300,,2
	-214300,,1

	;WRTSND - write out message buffer. A hold BP to directory name
	;skips if succesfull. Error return gives err code in A
WRTSND:	MOVE D,A
	HRROI A,GTJSTR			; Cons up filename into this string
	HRROI B,[ASCIZ /</]
	SKIPN TENEX
	 HRROI B,[ASCIZ /PS:</]
	SETZ C,
	SOUT
	MOVE B,D
	SOUT
	HRROI B,[ASCIZ />SENDS.TXT;0;T/]
	SKIPN TENEX
	 HRROI B,[ASCIZ />SENDS.TXT.0;T/]
	SOUT
	SETZ B,
	BOUT

;;; Have file name to find (or create), get JFN
	MOVX A,GJ%SHT
	HRROI B,GTJSTR
	GTJFN
	 RET
	MOVE D,A			; Save JFN
	MOVX B,7B5+OF%APP		; Open for append
	OPENF
	 JRST [	EXCH A,D		; Failed.. perhaps simultaneous access
		RLJFN
	 	 JFCL			; For now just return
		MOVE A,D		; Return err code
		RET]

;;; Hey ! Got it open
	MOVEI A,(D)
	HRROI B,MSGBUF
	MOVEI C,$MBFLN
	SUB C,MSGCNT
	SOUT
	CLOSF
	 JFCL
	AOS (P)
	RET				; Skip return

;;; Output hostname to JFN in A
HSTOUT:	MOVE B,A
	MOVEI A,.GTHNS
	MOVE C,FHSTN
	GTHST
	 JFCL
	MOVE A,B
	RET
>
	SUBTTL	Password when logged in may be for CWD

.ORG ;BACK TO HIGH SEGMENT
; Here on PASS Command when already logged in. See if it goes with a CWD.

PASCWD:	MOVE A,PRVKWD		; See what previous command keyword was
	CAME A,['XCWD  ']
	CAMN A,['CWD   ']	; Either form of CWD?
	  SKIPA			; Yes
	    JRST [JSP B,PASCW4	; No. What's with this silly PASS?
		  ASCIZS (504,503,< You are already logged in. I don't know what this password is for.>)]

	GJINF			; It follows CWD. See if already
	CAMN B,$CWD		; Connected to the desired directory.
	  JRST [JSP B,PASCW4	; Yes, ignore password.
		ASCIZ /250 Password not needed for this CWD./]
				; No, go do it.
IFN REL4,<SKIPN TENEX		; TENEX?
	   JRST CWDCHK		; Nope
> ; End of IFN REL4
	HRRZ A,$CWD		; Desired Directory
	MOVX B,<POINT 7,$PASS>	; Password
	CNDIR			; Do the connect
	  JRST PASCW3		; Failed
	JRST CWDOK
CWDCHK:				;TOPS-20
	MOVEI B,$ACCES		; Get address of argument block
	MOVE A,$CWD		; Desired directory
	MOVEM A,.ACDIR(B)	; Put in argument block
	MOVX A,<POINT 7,$PASS>	; Password
	MOVEM A,.ACPSW(B)	; Put in argument block
	SETOM .ACJOB(B)		; This job

	MOVX A,<AC%CON+3>	; Three word argument block
	ACCES			; Connect to directory
	 ERJMP PASCW3		; Failed
CWDOK:
	CALL ADDREP		; CWD command joins here
	ASCIZS (200,250,< Connected to >)
	MOVE B,$CWD		; Plug name into message
	DIRST
	  MOVE A,REPLYP		; Can't fail here, I hope.
	MOVEM A,REPLYP		; Update pointer
	JSP B,PASCW4		; Ok
	ASCIZ /./

PASCW3:	JSP B,PASCW4		; ACCES failed
	ASCIZS (431,530,< CWD-PASS: Directory or Password wrong.>)
PASCW4:	CALL CLRPSW		; Clear secret info (preserve B)
	JRST RPCRLP
	SUBTTL	Post-Login Command Execution Routines - DEBUG

ZDEBUG:	MOVX A,.FHSLF		; See if I am a WHEEL
	RPCAP
	TXNN B,<SC%WHL>		; Was also SC%OPR
	  JRST NOTIMP		; No. Pretend not implemented
DEBUG1:	SKIPE 770000		; Yes. Is DDT there?
	  JRST DEBUG0		; Yes, go to it.
	MOVX A,GJ%SHT+GJ%OLD	; No, get it
	HRROI B,T20.UE		; TOPS-20
	SKIPE TENEX		; UDDT filespec
	  HRROI B,TNX.US	; TENEX
	GTJFN
	  JRST NOTIMP
	HRLI A,.FHSLF		; Into this fork
	GET
	MOVE A,116		; JOBSYM
	MOVEM A,@770001		; to $I-1
DEBUG0:	MOVX A,<.FHSLF,,<HSBAS/1000>> ; Now put on copy/write bit in access
				; So DDT can do breakpoints
DEBUGL:	RPACS			; See if page there
	TXNN B,PA%PEX
	  JRST DEBUGN		; No
	MOVX B,<PA%RD+PA%WR+PA%EX> ; Assume private. R,W,E
	TXNN B,PA%PRV		; If shared, put on CW
	  MOVX B,<PA%RD+PA%EX+PA%CPY> ; Make it R,E,CW
	SPACS
DEBUGN:	ADDI A,1		; Next page
	HRRI B,(A)
	CAIGE B,700		; Continue up to DDT
	  JRST DEBUGL
	CALL 770000		; Call DDT
DRETN:	JSP B,RPCRLP
	ASCIZS (200,200,< End of debug.>)

	SUBTTL	Post-Login Command Execution Routines - ALLOcate

; Allocate command - not really necessary on TOPS20

IFN TCPP,<
ZALLO:	JSP B,RPCRLP
	ASCIZ /202 Allocations are not requred at this site./
> ; End of INF TCPP


	SUBTTL	Post-Login Command Execution Routines - RESTart

;	Restart Command

ZREST:	JSP B,RPCRLP		; Restart command not implemented
	ASCIZS (200,502,< Restart command received but ignored.>)
	SUBTTL	Post-Login Command Execution Routines - SMNT

ZSMNT:	HRROI B,[ASCIZS (200,202,< SMNT is not required at this site>)]
	SKIPE TENEX		; Only TOPS20 needs this
	  JRST RPCRLP

	CALL SST		; Down to the argument

	MOVE B,SBP		; Just collect string
	MOVX A,<POINT 7,$PTHS1>	; Where to stash it
	MOVNI C,<5*40>-2	; Length
	SOUT

	MOVX A,<1,,.MSIMC>	; Imcrement mount count
	MOVEI B,D		; Argument block
	MOVX D,<POINT 7,$PTHS1>	; Structure name
	MSTR
	ERJMP SMNTX0

SMNTX:	JSP B,RPCRLP		; Send this back
	ASCIZS (200,202,< Structure mounted.>)




SMNTX0:	MOVX A,<.FHSLF>		; Get error code
	GETER
	HRRZS B
	CAIN B,MSTX31		; Already mounted?
	  JRST SMNTX		; Yes, don't return error

	CALL ADDREP
	ASCIZS (451,550,< Failed to mount structure: >)

	MOVX B,<.FHSLF,,-1>
	ERSTR
	  JFCL
	  JFCL
	MOVEM A,REPLYP

	JSP B,RPCRLP
	ASCIZ /./
	SUBTTL	Post-Login Command Execution Routines - CWD

ZXCWD:				; Change working directory
ZCWD:	CALL SST		; Down to the argument

	MOVE B,SBP		; Pointer to argument
	CALL DIRCHK		; See if valid directory name
	  JRST XCWD1		; No
	MOVEM B,$CWD		; Save in case password follows

	HRROI A,USERST		; To (garbage) string for user name
	DIRST
	  JRST XCWD1		; Cant fail
	MOVX A,.FHSLF		; Get current caps
	RPCAP
	PUSH P,B		; Save them
	PUSH P,C
	SETO C,			; Enable for the CNDIR
	EPCAP
	MOVE A,$CWD		; See if can do a CNDIR to it
	SETZ B,			; Without a password

	SKIPN TENEX
	  JRST CWD6		; TOPS-20
	CNDIR			; TENEX
	  JRST XCWD2		; No.
	JRST CWD8		; Jump around TOPS-20 stuff
				; TOPS-20
CWD6:	MOVEM A,$ACCES		; Put in arg block
	MOVEM B,$ACCES+1	; Without password
	MOVX A,<AC%CON+3>	; Connect to directory
	MOVEI B,$ACCES		; Get address of block
	ACCES			; Connect
	  ERJMP XCWD2		; No
CWD8:
	POP P,C			; Yes, restore caps
	POP P,B
	MOVX A,.FHSLF
	EPCAP
	JRST CWDOK		; Go send success message
	SUBTTL	Post-Login Command Execution Routines - CWD, cont.

;	Connect W/o password failed, ask for it

XCWD2:	POP P,C			; Acces failed.
	POP P,B
	MOVX A,.FHSLF
	EPCAP
	JSP B,RPCRLP		; Say just prefix accepted.
	ASCIZS (200,331,< Default name accepted. Send password to connect to it.>)


;	Bad Directory Name (TOPS-20 structure ACCESS?)

XCWD1:	JSP B,RPCRLP
	ASCIZS (431,501,< No such directory - CWD.>)
	SUBTTL	Post-Login Command Execution Routines - SOCK/PORT

IFE TCPP,<	; NCP	[HOST,] SOCK
ZSOCK:	SETOM $HOST		; Default host
	CALL DECIN		; Decimal number argument
	  JRST SOCKX1		; Syntax error
	CAIE C,","		; Host number?
	JRST SOCK01		; No.

	TXNE A,<740000,,0>	; Legal host?
	  JRST [JSP B,SOCKXX	; SOCKX2:
		ASCIZS (503,501,< Host number exceeds 32 bits.>)]
	MOVEM A,$HOST		; Yes. Save it.

	CALL DECIN		; And get socket number
	  JRST SOCKX1		; Has to be one. Default not allowed.
SOCK01:	CAIE C,0		; End of line now?
	  JRST SOCKX1		; No. Error.
	TLNE A,740000		; Legal number?
	  JRST [JSP B,SOCKXX	; SOCKX3: Bad socket number (over 2**32)
		ASCIZS (<503 Socket>,<501 Port>,< number out of range.>)]
  > ; End of IFE TCPP


IFN TCPP,<	; TCP	PORT H1,H2,H3,H4,P1,P2
P$SOCK:	POINT 16,$SOCK,15	; Leftmost 16 bits

ZPORT:	MOVSI T2,-6		; 4 bytes of $HOST & 2 of $SOCK
	MOVE T1,[POINT 8,$HOST,3] ; Rightmost 32 bits
	SETZM $HOST
;		Check break characters?
SOCK02:	CALL DECIN		; Get next byte
	  JRST SOCKX1
	SKIPL A
	  CAILE A,377
	    JRST SOCKX1		; Must be 0 to 377
	IDPB A,T1		; Save it
	AOBJN T2,SOCK02		; Get rest

	SKIPG $HOST
	  SETOM $HOST
;		Verify CR/EOL?
	LDB A,P$SOCK		; Get 16 bits
  > ; End of IFN TCPP
	MOVEM A,$SOCK		; Save sock/port #

	CLOSD DATCON		; Make sure data connection is closed

	JSP B,RPCRLP		; And return to command loop

SOCKM1:	ASCIZS (<200 Socket>,<200 Port>,< command accepted.>)
	SUBTTL	Post-Login Command Execution Routines - SOCK/PORT, cont.

SOCKX1:	HRROI B,[ASCIZS (501,501,< Syntax error in >,SOCK,PORT,< command.>)] ; EOL not at right place
; Fall into SOCKXX


;	HRROI B,[ASCIZ /.../]
;	JRST SOCKXX		JSP B,SOCKXX
;				ASCIZ /.../

SOCKXX:	SETOM $SOCK		; Clear to defaults
	SETOM $HOST
	JRST RPCRLP		; Reply



	SUBTTL	Post-Login Command Execution Routines - PASV

;  Choose a port number, enter passive mode & listen for a connection

ZPASV:	CLOSD DATCON		; Make sure connections are closed

	TXO F,F.PASV		; Entering passive mode

	CALL PREDAT		; To listen
	  JRST NURPLY		; B/ has pointer to msg; F.PASV cleared

	CALL PRE255		; Reply with pseudo PORT command.

	JSP B,RPCRLP
	0	;ASCIZ //
	SUBTTL	Post-Login Command Execution Routines - DELE

ZDELE:	HRROI A,JFNTXS		; Copy argument for file name
	MOVE B,SBP
	SETZ C,
	SOUT
	IDPB C,B		; End string

	CALL JBKINI		; Set up for delete file request
				; Set A/JBLOCK, B/SBP
	MOVX C,<GJ%OLD+.GJLEG>	; Old file required
	MOVEM C,.GJGEN(A)
	GTJFN
	  JRST [JSP B,DELXX	; No such file
		ASCIZS (450,550,< DELE: No such>)]
	MOVEM A,LCLJFN
	LDB C,B			; Make sure got to EOL
	JUMPN C,[JSP B,DELXX	;  No. Bad syntax.
		ASCIZS (550,501,< DELE: Bad name syntax (not confirmed) in>)]
	CALL JFNTXT		; Store text string for this filename
	DVCHR			; See what the device is
	LOAD D,DV$TYP		; Get device type
	CAIE D,.DVDSK		; Disk?
	  JRST [JSP B,DELXX	; No. Error.
		ASCIZS (506,504,< DELE: Only implemented for DISK files, not>)]
	HRRZ A,LCLJFN		; JFN
	DELF			; Do the delete
	  JRST [JSP B,DELXX	;  Can't. Assume access rights bad
		ASCIZS (451,550,< DELE: You do not have access rights to delete>)]
	SETOM LCLJFN		; JFN released by DELF JSYS
DELEOK:	MOVEI A,JBLOCK		; Try to get next lowest
	MOVE B,SBP		; Name string
	GTJFN
	  JRST [JSP B,DELXX
		ASCIZS (254,250,< File deleted ok,>)]
				; Message used to be "only copy" but
				; that could be wrong if user typed an
				; explicit version (generation) number
	RLJFN
	  JFCL
	HRROI B,[ASCIZS (254,250,< Lowest generation deleted ok,>)]

DELXX:	CLOSR LCLJFN
	MOVE A,REPLYP
	TLO B,-1
	SETZ C,
	SOUT			; Part of message to reply buffer
	SKIPN JFNTXS		; A file name?
	  JRST DELXX1		; No
	HRROI B,[ASCIZ / file /]
	SOUT
	HRROI B,JFNTXS
	SOUT			; Yes, tack on filename
DELXX1:	MOVEM A,REPLYP
	JSP B,RPCRLP		; Return a message
	ASCIZ /./
	SUBTTL	Post-Login Command Execution Routines - RNFR/RNTO

ZRNFR:	MOVE B,SBP		; Rename from. Just collect string
	MOVX A,<POINT 7,$PTHS1>	; Where to stash it
	MOVNI C,<5*40>-2	; Length
	SOUT
	JSP B,RPCRLP		; Send this back
	ASCIZS (200,350,< Rename-from name stored.>)


ZRNTO:	SKIPN $PTHS1		; Have old name from some previous RNFR?
	  JRST [JSP B,RPCRLP	;  No, error
		ASCIZS (431,503,< Please send old file name (RNFR) before new.>)]
	SETOM $PATH1		; No JFN's here yet
	SETOM $PATH2

	CALL JBKINI		; Set A/JBLOCK, B/SBP
	MOVX C,<GJ%FOU+GJ%NEW>	; Output new file only
	MOVEM C,.GJGEN(A)
	GTJFN			; See if the file is there
	  JRST RNMX1		; Can't get "to" JFN
	MOVEM A,$PATH2

	CALL JBKINI		; Ok. Try the from JFN
				; Set A/JBLOCK, B/SBP
	MOVX C,<GJ%OLD>		; Old file only
	MOVEM C,.GJGEN(A)
	HRROI B,$PTHS1		; Stored from RNFR command
	GTJFN
	  JRST [PUSH P,A	; Save error code
		CALL ADDREP	; Start reply
		ASCIZS (450,550,< Cannot access old-named file: >)
		JRST RNMXE]
	MOVEM A,$PATH1		; Store JFN

	MOVE B,$PATH2		; Ok, get new name
	RNAMF			; Do the rename
	  JRST [PUSH P,A	; Save error code
		CALL ADDREP	; Start reply
		ASCIZS (455,550,< Rename failed: >)
		JRST RNMXE]
	SETOM $PATH1		; Good. This JFN now gone.

	MOVE A,$PATH2
	CALL JFNTXT

	CALL ADDREP		; Build fancy reply
	ASCIZS (253,250,< Old file renamed >)
	HRROI B,JFNTXS		; New file name
	SETZ C,
	SOUT
	JRST RNMXU
	SUBTTL	Post-Login Command Execution Routines - RNFR/RNTO, cont.
; GTJFN of new name failed, error code in A
RNMX1:	PUSH P,A		; Save error code
	CAIE A,GJFX20		; Errors for file exists already
	CAIN A,GJFX27
	  JRST RNMX2
	CALL ADDREP
	ASCIZS (455,450,< Can't get JFN for New file name: >)
	JRST RNMXE

RNMX2:	CALL ADDREP
	ASCIZS (456,503,< "New Name" already exists. Delete it first: >)
	JRST RNMXE

;RNMX2:	PUSH P,A
;	CALL ADDREP
;	ASCIZS (451,550,< No access rights to create new file: >)
;	JRST RNMXE

;RNMX4:	PUSH P,A
;	CALL ADDREP
;	ASCIZS (451,550,< No access rights to delete old filename: >)
;	JRST RNMXE

RNMXE:	POP P,B			; Error code
	HRLI B,.FHSLF
	ERSTR			; Append system error code
	  JFCL
	  JFCL
RNMXU:	MOVEM A,REPLYP		; Save end of message so far
	CLOSR $PATH1		; Clean up JFNs
	CLOSR $PATH2
	JSP B,RPCRLP
	ASCIZ /./
	SUBTTL	Post-Login Command Execution Routines - STAT

; Outer level sets up for TELNET connection, then calls DOLIST

;STAT - TELNET Connection, TYPE A or E
;During file xfer, <CR> - State of transfer
;Between Transfers
;	<CR> - Status including current transfer parameters
;	<DIR> - File names w/o dir, all generations (one line)
;	<FILE> - File info

; 211,212,213,504,530,550


.ORG ;BACK TO LOW SEGMENT

ZSTAT:	TXO F,F.STAT		; Tell DOLIST it's a STAT
	TXZ F,F.NLST		; Similar to LIST

	MOVX A,.PRIOU		; Data goes to primary output
	CALL DOLIST		; Do the work
	JRST GETCOM		; Done.

.ORG ;BACK TO HIGH SEGMENT
	SUBTTL	Post-Login Command Execution Routines - LIST/NLST

; Outer level sets up for data connection, then calls DOLIST

;LIST - Data Connection	<CR> - Connected Directory
;	TYPE A or E	<DIR> - File names w/o dir, all generations (one line)
;			<FILE> - File Info
;NLST - Data Connection	<CR> - Connected Directory
;	TYPE A or E	<DIR> - File names w/ dir, top generation

; 150-226, 504


ZLIST:	TXZA F,F.NLST		; LIST, not NLST
ZNLST:	  TXO F,F.NLST		; NLST, not LIST.

	SKIPGE A,$BYTE
	  MOVX A,^D8
	MOVEM A,$BYTE
	CAIN A,^D8		; Must be 8-bit
	 SKIPLE $TYPE		; ASCII
	  JRST LISTX1		; Lose
	SKIPG $MODE		; Better be an ASCII connection
	 SKIPLE $STRU
	  JRST LISTX1		; Lose

	TXZ F,F.STAT		; Tell DOLIST it's a LIST, not STAT.
	TXO F,F.SEND		; Set up a send connection
	SETOM F$DTIP		; Data transfer in progress
	CALL PREDAT		;  ..
	  JRST RPCRLP		; No good.

	MOVX A,.PRIOU
	HRROI B,[ASCIZS (250,150,< List started.
>)]
	SETZ C,
	SOUT			; Send msg and dump buffer to SJFN

	MOVE A,DATCON		; Where DOLIST should send answers
	CALL DOLIST

	CLOSD DATCON		; Done with the data connection

	SETZM F$DTIP		; Data transfer no longer in progress
	HRROI B,[ASCIZS (252,226,< Transfer completed.>)] ; & data closed
	JRST RPCRLP


LISTX1:	JSP B,RPCRLP
	ASCIZS (506,504,< Parameters for LIST command must be STRU F, MODE S, TYPE A.>)
	SUBTTL	Post-Login Command Execution Routines - RETR

;Retrieve Command. File from server to user

; 150-<226,250,451>, 425, 501, 504, 550


ZRETR:	TXZ F,F.TYPX!F.FDB!F.ERR ; Assume not paged mode, and error
	TXZ F,F.DSK!F.NUL	; Clear a couple flags
	TXO F,F.SEND		; This is a send connection of data
	SKIPG B,$BYTE		; Any declared byte size?
	  MOVX B,^D8		; No. Set it to default eight-bit
	MOVEM B,$BYTE

	SKIPLE $MODE		; See if default stream mode.
	  JRST RETX0		; No.
	MOVE C,$TYPE		; Get type
IFE TCPP,<CAIE C,TYPE.XTP>	; Is it paged?
IFN TCPP,<MOVE D,$STRU		; See if paged structure
	  CAIE D,STRU.P>	; Is it paged?
	    JRST RETR01		; No, will filter later

; Paged Stru/Type
IFN TCPP,<CAIE C,TYPE.I		; Allow TYPE I
	   CAIN C,TYPE.L	; TYPE L 36 and
> ; End of IFN TCPP
	    CAIE B,^D36		; 36 bits and paged?
	     JRST RETX0		; No. Error
	TXO F,F.TYPX		; It is 36-bit paged mode. Remember in flag.
IFN TCPP,<JRST RETR02>		; Already know STRU ok


RETR01:	SKIPLE $STRU		; Structure must be default file
	  JRST RETX0

RETR02:	CALL TIMEOK		; Update timeout
	SETZM TYXSCT		; Clear net sequence count for page mode

	CALL JBKINI		; Initilize GTJFN block
				; Set A/JBLOCK, B/SBP
	MOVX C,GJ%OLD		; Existing file for reading
	MOVEM C,.GJGEN(A)	; No default version
	GTJFN			; Open the local file
	  JRST RETX1
	MOVEM A,LCLJFN		; Save it

	LDB C,B			; Was terminator the end of line?
	JUMPN C,RETX2		; If not, complain

	CALL JFNTXT		; Stash file name in txt storage
	SUBTTL	Post-Login Command Execution Routines - RETR, cont.

	MOVE A,LCLJFN		; Ok. See what type device it is on
	DVCHR
	LOAD D,DV$TYP
	CAIN D,.DVDSK		; Disk?
	  TXO F,F.DSK		; Yes, Local disk file.
	CAIN D,.DVNUL		; Is it the NUL:?
	  TXO F,F.NUL		; Yes, Flag to phony up a NUL:

	HRROI X,[ASCIZS (457,504,< Paged transfer must be on DSK: or NUL:.>)]
	TXNN F,F.TYPX		; Paged mode?
	  JRST RET02B		; No.
	TXNN F,F.NUL!F.DSK	; DSK: or NUL:?
	  JRST DATABE		; RETXPX: No.
RET02B:
	TXNE F,F.NUL		; Nul:?
	  JRST RET02		; Yes, Bypass OPENF


	MOVX A,^D36		; Common byte size
	MOVE P1,$TYPE		; Get type
	CAIE P1,TYPE.I		; Image type?
	 TXNE F,F.TYPX		; Or Paged?
	  JRST RETOPN		; Yes, All set

	MOVX A,^D7
	CAIN P1,TYPE.A		; Ascii?
	  JRST RETOPN		; Yes

	MOVE A,$BYTE		; Get the connection byte size
	CAIN P1,TYPE.L		; Local byte?
	  JRST RETOPN		; Yes

	JRST RETX4		; No. Unknown type. (impossible)
REPEAT 0,<
	MOVE D,$BYTE		; Get the byte size
	CAIE D,^D36		; Only support image 36 bits now.
	 TXNE F,F.DSK		; Except ok on disk ;CWL 8 32
	  SKIPA
	   JRST RETX4		; Say not supported, if not 36-bits.
	HRROI B,SLOWM1		; But give the guy a comment
	MOVX A,.PRIOU
	SETZ C,
	CAIE D,^D36		; That it will be slow if 8 or 32
	  SOUT			; Dump on TELNET send
	MOVX A,^D36
  >
	SUBTTL	Post-Login Command Execution Routines - RETR, cont.

RETOPN:	MOVEM A,$LBYTE		; Local file byte size ($BYTE unless ASCII)
	MOVX B,OF%RD		; Build OPENF parameter
	STOR A,OF$BSZ,+B

RETOPO:	MOVE A,LCLJFN		; Get local JFN back
	PUSH P,B		; Save open flags.
	OPENF
	  JRST [POP P,B
		TXON B,OF%THW	; Try it thawed
		  JRST RETOPO
		JRST RETX5]	; Already did. Fail.
	POP P,B			; Clear stack
RET02:	; Enter here if NUL:
	CALL SETCLSD		; Setup F.CLSD

	SETOM F$DTIP		; Data transfer in progress

	CALL PREDAT		; Set up the data connection
	  JRST RPCRLP		; Can't. Return reason.

	MOVE A,REPLYP		; Send started msg
	HRROI B,[ASCIZS (250,150,< Retrieve of >)]
	SKIPL D,$TYPE		; Or more specific message.
	 CAIN D,TYPE.A		; ASCII type?
	  HRROI B,[ASCIZS (250,150,< ASCII retrieve of >)]
	CAIN D,TYPE.I
	  HRROI B,[ASCIZS (250,150,< IMAGE retrieve of >)]
	TXNE F,F.TYPX
	  HRROI B,[ASCIZS (250,150,< Paged retrieve of >)]
	SETZ C,
	SOUT

	HRRZ B,LCLJFN		; File name
	MOVX C,<..DEVD+..DIRA+..NAMA+..TYPA+..GENA+JS%TMP+JS%PAF> ; Format
	JFNS
	HRROI B,[ASCIZ / started.
/]
	SETZ C,
	SOUT
	HRROI A,REPLYM		; Send it
	PSOUT
	MOVE A,PREPLY		; And prepare for next one
	MOVEM A,REPLYP
	SETZM REPLYM

	CALL XFRDAT		; Transfer file

	CLOSR LCLJFN		; Close these files if open
	SETZM F$DTIP		; Data transfer no longer in progress
	HRROI B,0(X)		; Pointer to reply message
	JRST RPCRLP		; Reply
	SUBTTL	Post-Login Command Execution Routines - APPE/STOR

; Store and Append commands. File from remote to server.
; (111) 150-<226,250,451>, 425, 501, 504, 550

ZAPPE:	TXOA F,F.APPE		; Append. Much like STOR.
ZSTOR:	  TXZ F,F.APPE		; Not append
	TXZ F,F.DSK+F.NUL+F.SEND ; Assume not DSK: or NUL:, not send
	TXZ F,F.RLPT+F.TYPX+F.FDB!F.ERR	; Assume not to spooled LPT,
	SETZM F$KPGN		; not paged mode, and error
	SETZM TYXSCT		; But if it is, start at seq zero
	MOVX B,PGT$AP		; Data page with access control
	MOVEM B,RECTYP		; In case EOF comes in immediately.
	SETZM IBITCT		; Image bit count is 0

	SKIPLE A,$MODE		; Stream mode?
	  JRST STOX0		; No. Unsupported.
	MOVE B,$STRU
	MOVE C,$TYPE		; Get type
	SKIPG D,$BYTE		; Byte still at default?
	  MOVX D,^D10		; Yes. Set to real size
	MOVEM D,$BYTE

IFE TCPP,<CAIE C,TYPE.XTP>	; Is it paged?
IFN TCPP,<CAIE B,STRU.P>	; Is it paged?
	    JRST STO00		; No
; Paged

IFN TCPP,<CAIE C,TYPE.I		; Allow TYPE I or
	   CAIN C,TYPE.L	; TYPE L 36 and
> ; End of IFN TCPP
	    CAIE D,^D36		; Paged and 36 bit bytes?
	     JRST STOX0		; No. Bad.
	TXNE F,F.APPE		; Yes. STOR, I hope.
	  JRST STOX0		; No. Can't append in page mode
	TXO F,F.TYPX		; Ok. Flag page mode
	SETOM F$KPGN		; Allow rename to retain generation #
IFN TCPP,<JRST STO02>		; Already know STRU ok

STO00:	SKIPLE $STRU		; Only file structured so far.
	  JRST STOX0
STO02:	CALL TIMEOK		; Update timeout.
	CALL JBKINI		; Set up the default strings in GTJFN blk
				; Set A/JBLOCK, B/SBP
	MOVX C,GJ%FOU+GJ%FLG	; Output use bit and request flags bit
	TXNE F,F.APPE		; Unless append, whence
	  MOVX C,GJ%FLG		; Use current version if any.
	TXNE F,F.ANON		; If ANONYMOUS, no new files at all.
	  MOVX C,GJ%OLD+GJ%FLG	; So don't default to new version
	MOVEM C,.GJGEN(A)
	GTJFN			; Get it.
	  JRST STOX1		; Can't
	HRRZM A,LCLJFN		; Store the JFN
	TXNN A,GJ%NHV		; Want higher generation #?
	  SETZM F$KPGN		; No, don't rename
	SUBTTL	Post-Login Command Execution Routines - APPE/STOR, cont.

	SKIPE JBLOCK+.GJACT	; Was there an account?
	  JRST STO01		; Yes. Main string pointer not needed.

;CWL WHAT GOES HERE??

STO01:	LDB C,B			; Get the terminator
	JUMPN C,STOX2		; Jump if not EOL
	MOVE A,LCLJFN		; Ok. Name was good.
	CALL JFNTXT		; Store the text string for file name

	MOVE A,LCLJFN
	DVCHR			; See what device it's on.
	LOAD A,DV$TYP		; Get device type
	CAIN A,.DVDSK		; Disk
	  TXO F,F.DSK		; Yes.
	CAIN A,.DVNUL		; NUL device?
	  TXO F,F.NUL		; Yes

	HRROI X,[ASCIZS (457,504,< Paged transfer must be on DSK: or NUL:.>)]
	TXNN F,F.TYPX		; Paged mode?
	  JRST STO02B		; No.
	TXNN F,F.NUL!F.DSK	; Disk or NUL?
	  JRST DATABE		; RETXPX: No.
STO02B:
	CAIE A,.DVLPT		; LPT:?
	  JRST STO03		; No

; Check if spooled line printer??

STOLPT:	TXNE F,F.ANON		; ANONYMOUS login?
	  JRST [JSP X,DATABE	; STOX8: Let's not have ANONYMOUS listings
		ASCIZS (450,504,< Anonymous users may not write on LPT:.>)]

	MOVX A,^D7		; Spooled byte size
	MOVE B,$BYTE		; For now, only allow ASCII 8-bit.
				; This should be fixed, though.
	CAIN B,^D8		; Eight bit conn?
	 SKIPLE P1,$TYPE	; And ASCII?
	  JRST .+2		; No.
	   JRST STOOPN		; Yes.
	JSP X,DATABE		; Error.
	ASCIZS (503,504,< Transfers to LPT: must be ASCII, 8-bit connections.>)
	SUBTTL	Post-Login Command Execution Routines - APPE/STOR, cont.

STO03:	MOVX A,^D36		; Common byte size
	MOVE P1,$TYPE		; Get type
	CAIE P1,TYPE.I		; Image type?
	 TXNE F,F.TYPX		; Or Paged?
	  JRST STOOPN		; Yes, All set

	MOVX A,^D7
	CAIN P1,TYPE.A		; Ascii?
	  JRST STOOPN		; Yes

	MOVE A,$BYTE		; Get the connection byte size
	CAIN P1,TYPE.L		; Local byte?
	  JRST STOOPN		; Yes

	JRST STOX4		; No. Unknown type. (impossible)
REPEAT 0,<
IFE TCPF,<
	HRROI B,SLOWM1		; But complain about it.
	MOVX A,.PRIOU
	SETZ C,
	CAIE D,^D36		; If not 36 bit mode
	  SOUT			; Send down TELNET conn

 > ; End of IFE TCPF
> ; End of REPEAT 0

STOOPN:	MOVEM A,$LBYTE		; Local file byte size ($BYTE unless ASCII)
	MOVX B,OF%WR		; Build OPENF parameter - Writeing
	TXNE F,F.APPE		; or
	  TXO B,OF%APP		; Appending
	STOR A,OF$BSZ,+B

	MOVE A,LCLJFN		; Restore the JFN
	OPENF			; Open according to stuff in B
	  JRST STOX5		; Can't.

	CALL SETCLSD		; Setup F.CLSD

	SETOM F$DTIP		; Data transfer in progress

	CALL PREDAT		; Set up common params,
	  JRST RPCRLP		; No good. Msg in B.
	SUBTTL	Post-Login Command Execution Routines - APPE/STOR, cont.

	MOVE A,REPLYP		; Send started msg
	HRROI B,[ASCIZS (250,150)]
	SKIPL D,$TYPE		; Or more specific message.
	 CAIN D,TYPE.A		; ASCII type?
	  HRROI B,[ASCIZS (250,150,< ASCII>)]
	CAIN D,TYPE.I
	  HRROI B,[ASCIZS (250,150,< IMAGE>)]
	TXNE F,F.TYPX
	  HRROI B,[ASCIZS (250,150,< Paged>)]
	SETZ C,
	SOUT

	HRROI B,[ASCIZ / Store of /]
	TXNE F,F.APPE		; Or append msg
	  HRROI B,[ASCIZ / Append to /]
	SOUT

	HRRZ B,LCLJFN		; File name
	MOVX C,<..DEVD+..DIRA+..NAMA+..TYPA+..GENA+..PROA+..ACTA+JS%TMP+JS%PAF> ; Format
	JFNS
	HRROI B,[ASCIZ / started.
/]
	SETZ C,
	SOUT
	HRROI A,REPLYM		; Send it
	PSOUT
	MOVE A,PREPLY		; And prepare for next one
	MOVEM A,REPLYP
	SETZM REPLYM

	CALL XFRDAT		; Transfer file

	TXNN F,F.ERR 		; Have a local error?
	  JRST STO08		; No, seems ok
	CLOSK (LCLJFN)
	HRRZ A,LCLJFN		; File to be deleted
	TXO A,<DF%EXP>
	DELF			; Delete and expunge file
	  JFCL
	SETOM LCLJFN		; Gone
STO08:
	SKIPA
DATABE:	  TXO F,F.ERR		; Have error (Interrupt break-out address)

IFN TCPP,<TXNN F,F.ERR		; Close if error or
	   TXNE F,F.CLSD	; EOF requires it
	    CAIA		; Have to close
	     JRST STO09>	; Leave open - paged & ok
	CLOSD (DATCON,CO%WCL)	; Wait for other end to see close
STO09:

;DATABT:
	CLOSR LCLJFN		; Close these files if open
	SETZM F$DTIP		; Data transfer no longer in progress
	HRROI B,0(X)		; Pointer to reply message
	JRST RPCRLP		; Reply
	SUBTTL	File Transfer Errors

RETX0:	STOX0:			; Neither LCLJFN nor DATCON
RETX4:	STOX4:			; LCLJFN 
	JSP X,DATABE		; Paged & not 36, unknown type, mode, stru
	ASCIZS (457,504,< Parameter combination illegal or unimplemented.>)

RETX1:				; GTJFN failed
RETX5:	JSP X,ERRMSG		; OPEN filed
	ASCIZS (450,550,< File not accessable. >)

RETX2:	STOX2:			; LCLJFN - bad terminator - Syntax
	JSP X,DATABE
	ASCIZS (550,501,< Bad terminator after file name.>)

RETX3:	STOX3:
	JSP X,DATABE		; Access denied message
	ASCIZS (451,550,< You do not have access for that file operation.>)

STOX1:				; GTJFN failed
STOX5:	JSP X,DATABE		; OPEN failed
	ASCIZS (450,550,< Can't write such a file.>)

STOX6:	JSP X,DATABE		; No account specified
	ASCIZS (433,532,< Account must be supplied to store files. Send ACCT.>)

SLOWM1:	ASCIZS (<050 >,<111->,<Image mode requires 36-bit bytes for efficiency.
>,050,111,< Use TYPE L instead if possible. Proceeding...
>)


ERRMSG:	CALL ERRSUB
	JSP X,DATABE
	0

ERRSUB:	HRROI A,(X)
	PSOUT			; Output message

	MOVX A,.PRIOU		; Output the error message
	MOVX B,<.FHSLF,,-1>	; Last error for this process
	SETZ C,
	ERSTR
	  JFCL
	  JFCL
	RET
	SUBTTL	Subroutines - PREDAT

; Subroutine called by commands which need the data connection.
; Prepares the data socket, sends the 255 socket reply, and
; then opens the connection.
; Skip return if ok, else non-skip with error msg in B.
; Arguments are F.SEND (for direction) and the socket/host/byte params

; Ok or 425


PREDAT:	SKIPGE A,DATCON		; Connection already there?
	  JRST PRED2A		; No.
	$GTSTS			; Yes. Is it the right kind?
	TXNN B,GS%OPN		; Open?
	  JRST PRED2		; No. Flush.

IFN TCPP,<
	JRST PRED2I		; Go set byte size, etc
> ; End of IFN TCPP

IFE TCPP,<
	TXNE F,F.SEND		; Yes. Right direction?
	 TXNN B,GS%WRF		; Sending and open for write?
	  JRST PRED1A		; No
	CALL PRE255		; Yes. Send socket reply,
	JRST PRED3		; And use it again


PRED1A:	TXNN F,F.SEND		; Receiving?
	 TXNN B,GS%RDF		; And open for read?
	  JRST PRED2		; No
	CALL PRE255		; Send socket reply
	JRST PRED3		; And use it
> ; End of IFE TCPP
	SUBTTL	Subroutines - PREDAT, cont.

PRED2:	$CLOSF			; Get rid of old connection
	  JFCL			; If can't, just get another JFN
PRED2A:	SETOM DATCON		; No useful old connection

IFE TCPF,<			;  Version for NCP

;NET:<LOCAL_SOCKET>.<$HOST(FHSTN)>-<$SOCK(FORNS+2 OR 3)>;T

	MOVX A,<POINT 7,GTJSTR>	; Pointer to build a new socket name
	HRROI B,[ASCIZ /NET:/]
	SETZ C,
	SOUT			; Start it.
; 2 is old FTP
	MOVX B,2		; Local socket is 2 or 3, job relative.
	TXNE F,F.SEND		; Write connection?
	  ADDI B,1		; Yes, make it odd
	MOVX C,OCTRAD		; Octal number in NCP
	NOUT
	  CALL BOMB
	MOVX B,"."		; Separate from distant field
	IDPB B,A
	SKIPGE B,$HOST		; Foreign host specified?
	  MOVE B,FHSTN		; No, default is where TELNET is from
	MOVX C,OCTRAD
	NOUT
	  CALL BOMB
	MOVX B,"-"		; Flag for socket
	IDPB B,A
	SKIPGE B,$SOCK		; Foreign socket specified?
	  JRST [MOVE B,FORNS	; No, get TELNET conn socket
		ADDI B,2	; Plus 2 to receive
		TXNN F,F.SEND	; Or is he sending?
		  ADDI B,1	; Yes. Make his odd number
		JRST .+1]
	MOVX C,OCTRAD		; Socket in octal
	NOUT
	  CALL BOMB
	HRROI B,[ASCIZ /;T/]	; Job-local socket
	SETZ C,
	SOUT
	CALL TIMEOK		; Update timer clock
	SUBTTL	Subroutines - PREDAT, cont.

	MOVX A,GJ%SHT		; Now try to get the socket
	HRROI B,GTJSTR
	GTJFN
	  JRST PREDX1		; Can't?
	MOVEM A,DATCON		; Ok, save the JFN
;CWL TENEX?
	CVSKT			; Now get the socket number (absolute)
	  JRST PREDX2		; Can't?
	TXNN F,F.SEND		; Make sure sex bit is right
	 TRZA B,1
	  TRO B,1		; Sending
	MOVEM B,MYDATS		; Save it
	CALL PRE255		; Now send the 255 reply

	CALL TIMEOK		; Update timer
	MOVX B,<FLD(^D20,OF%MOD)+OF%WR> ; Write, buffered send
	TXNN F,F.SEND		; See which way to point it
	  MOVX B,OF%RD		; Read.
	SKIPG A,$BYTE		; Get byte size
	  MOVX A,10		; Default is 8-bit
	STOR A,OF$BSZ,+B
	MOVE A,DATCON		; Now do the connect
	OPENF
	  JRST PREDX2		; Can't
PRED3:	AOS 0(P)		; Success return from PREDAT
	RET


PREDX2:	MOVE A,DATCON		; Couldn't open or CVSKT
;	CLOSF			; Be sure closed
;	 JFCL			; Don't care if fails
	RLJFN			; Free the JFN
	  JFCL
	JRST PREDX1		; Error exit
> ; End of IFE TCPF conditional
	SUBTTL	Subroutines - PREDAT, cont.

IFN TCPF,<			; Opend TCP data connection
	MOVEI A,T.CDB+DATCON	; Connection descriptor block
	MOVE B,GJINF3		; Our job # is
	LSH B,^D8		; High byte of port
	TXNN F,F.PASV		; If PASV
	  SETZ B,		; Otherwise high byte is 0
	ADD B,FTPDAT		; Low byte is Data socket number
	MOVEM B,.TCPLP(A)	; To CDB
	MOVE C,LHOSTN		; Must use address by which we
	MOVEM C,.TCPLH(A)	; were initially contacted

	SKIPGE B,$HOST		; Specific host given?
	  MOVE B,FHSTN		; No, use TELNET host
	SKIPG C,$SOCK		; Specific port specified
	  MOVE C,FORNS		; No, use same as TELNET
	TXNE F,F.PASV		; However if PASV then
	  SETZB B,C		; Wild foreign Host/Port
	MOVEM B,.TCPFH(A)
	MOVEM C,.TCPFP(A)

	MOVEI A,DATCON		; File block
	MOVX B,<-T.NDBF,,DATBUF>
	MOVX C,T.BFSZ
	TXNN F,F.PASV		; If passive, don't wait or force sync
	  TXO C,<TCP%WT!TCP%FS>
	$GTJFN	
	  JRST PREDX1		; Failed
	MOVEM A,DATCON		; Initialized

	TXNE F,F.PASV		; Passive?
	  JRST PRED3		; Passive open - need F.SEND for $OPENF

PRED2I:	SKIPG A,DATCON		; Should contain DATCON here
	  JRST PREDX0		; ??
	SKIPG C,$BYTE
	  MOVX C,^D8
	MOVEM C,$BYTE
	SETZ B,
	STOR C,OF$BSZ,+B	; For open
	TXNE F,F.SEND		; Sending?
	 TXOA B,OF%WR		; Yes
	  TXO B,OF%RD		; No, reading
	$OPENF
	  JRST PREDX0		; Failed
PRED3:	AOS 0(P)		; Success return from PREDAT
	RET
> ; End of IFN TCPF conditional
	SUBTTL	Subroutines - PREDAT, cont.

PREDX0:	CLOSD DATCON
PREDX1:	TXZ F,F.PASV		; Not in PASV mode either
	HRROI A,STRTMP		; Build error msg here
	HRROI B,[ASCIZS (454,425,< Data connection failed: >)]
	SETZ C,
	SOUT
	HRLOI B,.FHSLF
	SETZ C,
	ERSTR
	  JFCL
	  JFCL
	HRROI B,STRTMP		; Point to msg
	RET			; Fail return








	SUBTTL	Subroutines - PRE255

;	CALL PRE255

PRE255:	MOVE A,PREPLY		; Build reply
	HRROI B,[ASCIZS (<255 SOCK >,<227 Entering Passive mode, use PORT >)]
	SETZ C,
	SOUT			; Send server socket reply in specified

	MOVX C,DECRAD		; Network virtual radix


IFE TCPP,<
	MOVE B,MYDATS
	NOUT
	  CALL BOMB
	HRROI B,CRLFM
	SETZ C,
	SOUT
	SETZ B,
	BOUT
	HRROI A,REPLYM		; Output it all at once
	PSOUT
 >
	SUBTTL	Subroutines - PRE255, cont.
IFN TCPP,<
	MOVX D,<POINT 8,LHOSTN,3> ; First 8 bits
	MOVSI T1,-4		;  4 bytes of host

PRE257:	ILDB B,D
	NOUT
	  CALL BOMB
	MOVX B,","
	BOUT

	AOBJN T1,PRE257

	MOVX D,<POINT 8,.TCPLP+T.CDB+DATCON,27> ; Two byte socket #
	LDB B,D
	NOUT
	  CALL BOMB
	MOVX B,","
	BOUT
	ILDB B,D
	NOUT
	  CALL BOMB

	MOVEM A,REPLYP		; For whoever to finish
 >


IFN TCPF,<
;CWL ???
	JRST PRE25X
	MOVEI X,^D120
PRE25L:	MOVEI A,^D1000
	DISMS
	MOVE A,DATCON+T.JCN
;CWL *** TOPS20 & TENEX
;	LOADI B,TSTAT		;  Get TSTAT word
;	HRRO B,B
;	HRROI C,C
;	STAT
;	 JRST PRE25X
;	ANDI C,TRSYN!TSSYN	; Still synchable
;	CAIN C,<FLD(4,TRSYN)+FLD(4,TSSYN)>
;	 SOJG X,PRE25L		; Yes, wait
PRE25X:	> ; End of IFN TCPF conditional

	RET
	SUBTTL	Subroutines - DOLIST

; DOLIST is the guts of LIST, NLST and STAT.

; 211, 212, 213, 504, 530, 550

.ORG ;BACK TO LOW SEGMENT


DOLIST:	MOVEM A,LSTJFN		; Save the destination.

	LDB B,SBP		; First character of argument
	TXNE F,F.STAT		; Jump if not STAT
	 SKIPE B		; Or if STAT with non-null argument
	  JRST DOLI00

; STAT<RETURN>

	HRROI A,$FILST		; Build string here

	CALL LCLSTS		; Append info to string A/

	SOUT
	IDPB C,A		; End string

	MOVE A,LSTJFN		; TELNET or data connection
	HRROI B,$FILST		; Accumulated string
	$SOUT			; Send it

IFE TCPP,<			; NCP ends this way
	HRROI B,[ASCIZ /200 End of status.
/]
	TXNE F,F.STAT		; On TELNET conn?
	  $SOUT			; Yes. Flag end.
> ; End of IFE TCPP

	RET			; Return from DOLIST
	SUBTTL	DOLIST - Return directory/file info

DOLI00:	TXNE F,F.LOGI		; Am I logged in?
	  JRST DOLI01		; Yes, continue in high segment

	JSP B,RPCRLP		; No good. Complain.
	ASCIZS (451,530,< Please log in first, with USER, PASS and ACCT.>)


.ORG ;BACK TO HIGH SEGMENT


DOLI01:	TXZ F,F.PDIR		; Clear flags: omit directory
	TXZ F,F.T1!F.T2		; Not need CR, more than generation changed

	CALL JBKINI		; See if his string makes sense
				; Set A/JBLOCK, B/SBP
	HRROI T1,[ASCIZ /*/]	; Set up for defaults
	MOVEM T1,.GJNAM(A)
	MOVEM T1,.GJEXT(A)	; Name and ext

	MOVX T1,<GJ%OLD+GJ%IFG+.GJDEF>	; Flags for wild, hi gen of old files
	TXNN F,F.NLST		; Unless NLST command,
	  HRRI T1,.GJALL	; "Star" for version default
	MOVEM T1,.GJGEN(A)

	MOVE T1,A		; Save args
	MOVE T2,B
	GTJFN
	  JRST DOLIX1		; No good
	MOVEM A,LCLJFN		; Save it

	TXNN A,GJ%DEV+GJ%UNT+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER ; Any wild cards?
	  JRST DOLINS		; No stars, single file

	TXNE A,GJ%DEV+GJ%UNT+GJ%DIR ; Wild dev or dir?
	  JRST DOLIX3		; Yes. Don't allow whole dumps.

; Stars don't necessairly mean multiple files...

	MOVE A,LCLJFN
	GNJFN			; More than one?
	 TXOA F,F.T1		; No, only one (and lost JFN too)
	  RLJFN			; Get to common state - no JFN
	   JFCL

	MOVE A,T1		; Restore args
	MOVE B,T2
	GTJFN			; Get JFN back
	  JRST DOLIX1		; No good
	MOVEM A,LCLJFN		; Save it

	TXZE F,F.T1		; What was the result?
	  JRST DOLINS		; Only one found
	SUBTTL	Subroutines - DOLIST - Multiple files

	TXNN F,F.NLST		; If LIST command, then
	  TXO F,F.PDIR		; Print directory name first time

DOLIL0:	MOVX A,<POINT 7,STRTMP>	; Build line here
	MOVEM A,T1		; Beginning of string
	MOVEM A,T2		; Current end
	TXZ F,F.T1		; Need prefix (not appending a generation)

DOLIL1:	CALL TIMEOK		; Update time kill.

	MOVE A,T2		; Append to this string
	HRROI B,[ASCIZS (<151 >,<212->)] ; Header for TELNET connection
	SETZ C,
	TXON F,F.T1		; Already started line?
	 TXNN F,F.STAT		; No. Need the header?
	  SKIPA			; Yes, don't need header again
	   SOUT			; New line and need header

	MOVX B,","		; Separating versions only?
	TXNE F,F.T2
	  BOUT			; Yes.

	HRRZ B,LCLJFN		; The file name to be listed

	TXZN F,F.PDIR		; Want directory line?
	  JRST DOLI03		; Not now

; Output a directory name line

	MOVX C,<..DEVA+..DIRA+JS%PAF> ; TOPS-20
	SKIPE TENEX
	  MOVX C,<..DIRA+JS%PAF> ; TENEX only dir name, punctuated
	JFNS			; Append to string

	HRROI B,CRLFM		; Force an end of line here.
	SETZ C,
	SOUT
	MOVEM A,T1		; Beginning of next line
	MOVEM A,T2		; Always have another line following
	TXZ F,F.T1		; And say not started this line
	JRST DOLIL1		; Back for first file name
	SUBTTL	Subroutines - DOLIST - Multiple files, append filespec

DOLI03:	MOVX C,<..NAMA+..TYPA+..GENA+JS%TMP+JS%PAF>
	TXZE F,F.T2		; Just a new version?
	  MOVX C,<..GENA>	; Yes. Just print that.

	TXNE F,F.NLST		; But if NLST, send different format.
	  MOVX C,<..DEVD+..DIRA+..NAMA+..TYPA+..GENA+JS%TMP+JS%PAF>
	JFNS			; Append something.
	MOVEM A,T2		; Save string pointer

	MOVE A,LCLJFN		; Step the handle
	GNJFN
	  JRST DOLILZ		; No more. Go bash "-".

	TXNE F,F.NLST		; NLIST command?
	  JRST DOLIN2		; Yes. Always separate lines.
	TXNN A,GN%DIR+GN%NAM+GN%EXT ; Just version change?
	  JRST DOLI02		; Yes.

	TXNE A,GN%DIR		; New directory?
	  TXO F,F.PDIR		; Yes. Want to mention it.
	SKIPN TENEX
	 TXNN A,GN%STR		; New structure on TOPS-20?
	  SKIPA			; No
	   TXO F,F.PDIR		; Yes. Want to mention it.

DOLIN2:	MOVE A,T2		; String pointer
	HRROI B,CRLFM		; End line.
	SETZ C,
	SOUT
	MOVEM A,T2		; Save pointer again
	IDPB C,A		; End string
	MOVE A,LSTJFN		; Output this file
	HRROI B,STRTMP
	$SOUT
	JRST DOLIL0		; Loop to next line & file.

; Only version changed, pointer is on top of stack

DOLI02:	TXO F,F.T2		; Ext is all that changes
	JRST DOLIL1		; Loop

; End of list, send last line

DOLILZ:	MOVE A,T2
IFN TCPP,<ILDB B,T1		; Skip 3 digits
	ILDB B,T1
	ILDB B,T1
	MOVX B," "
	TXNE F,F.STAT		; Only STAT has header
	  IDPB B,T1		; Whose last line has a space
> ; End of IFN TCPP
	JRST DOLIZ1		; A/ points to end
	SUBTTL	Subroutines - DOLIST - Single file

DOLINS:	MOVX A,<POINT 7,STRTMP>	; Build string here
	HRROI B,[ASCIZS (150,213,< >)]
	SETZ C,
	TXNE F,F.STAT		; Cue needed?
	  SOUT			; Yes

	MOVX C,<..DEVD+..DIRD+..NAMA+..TYPA+..GENA+..PROA+..ACTA+JS%TMP+JS%SIZ+JS%CDR+JS%LWR+JS%LRD+JS%PSD+JS%PAF> ; QFD format
	TXNE F,F.STAT		; But if STAT, give full pathname
	  MOVX C,<..DEVA+..DIRA+..NAMA+..TYPA+..GENA+..PROA+..ACTA+JS%TMP+JS%SIZ+JS%CDR+JS%LWR+JS%LRD+JS%PSD+JS%PAF> ; QFD format
	TXNE F,F.NLST		;  But if NLST, send different format.
	  MOVX C,<..DEVD+..DIRD+..NAMA+..TYPA+..GENA+..PROA+..ACTA+JS%TMP+JS%PAF>	; Bits for format

	HRRZ B,LCLJFN		; Get the file JFN
	JFNS

	TXNN F,F.STAT		; STAT?
	  JRST DOLIZ1		; No

; Return creator/writer names with STAT

	SKIPE TENEX		; TENEX?
	  JRST DOLINX		; Yes

; TOPS20 names via GFUST

	MOVE D,A		; Save pointer to string
	HRRZ A,LCLJFN
	MOVX B,<OF%RD+OF%WR>	; ? Why do we need writing??
 skipa;	OPENF
	  JRST DOLINT
	MOVE A,D
	MOVX B,","		; Append creator & last writer
	BOUT
	MOVE B,A		; String pointer
	HRRZ A,LCLJFN		; File &
	HRLI A,<.GFAUT>		; Function
	GFUST
	ERJMP DOLINT
	MOVE D,B
	MOVE A,B
	MOVX B,","
	BOUT
	MOVE B,A
	HRRZ A,LCLJFN
	HRLI A,<.GFLWR>
	GFUST
	ERJMP DOLINT
	MOVE A,B
	JRST DOLIZ1

DOLINT:	MOVE A,D
	JRST DOLIZ1
; TENEX names via GTFDB/DIRST

DOLINX:	PUSH P,A		; Save pointer

	HRRZ A,LCLJFN
	MOVE B,[1,,.FBUSE]	; LH is writer's number
	MOVEI C,D
	GTFDB

	MOVX A,<.NULIO>
	HLRZ B,D		; User number
	DIRST
	  JRST DOLINZ

	MOVE A,(P)		; String
	MOVX B,","		; Append creator & last writer
	BOUT

	HLRZ B,D		; User number
	DIRST
	  JRST .+1

	MOVX B,","		; Append creator & last writer
	BOUT

	HLRZ B,D		; User number
	DIRST
	  JRST .+1

	MOVEM A,(P)
DOLINZ:	POP P,A

; Common wrapup for last line

DOLIZ1:	HRROI B,CRLFM		; Output EOL
	SETZ C,
	SOUT
	IDPB C,A		; End string

	CLOSR (LCLJFN)		; Release STAT JFN

	MOVE A,LSTJFN		; TELNET or data connection
	HRROI B,STRTMP		; Accumulated string
	$SOUT			; Send it

IFE TCPP,<			; NCP ends this way
	HRROI B,[ASCIZ /200 End of status.
/]
	TXNE F,F.STAT		; On TELNET conn?
	  $SOUT			; Yes. Flag end.
> ; End of IFE TCPP
	RET			; Return from DOLIST
	SUBTTL	Subroutines - DOLIST - Error Exits

; GTJFN error on user argument

DOLIX1:	HRROI B,[ASCIZS (450,550,< >)]	; File status
	HRROI D,[ASCIZ /? Not found.
/]
	JRST DOLIXX


; Star for device or directory is illegal

DOLIX3:	HRROI B,[ASCIZS (451,504,< >)]
	HRROI D,[ASCIZ /? * not allowed for device or directory.
/]

DOLIXX:	HRRZ A,LCLJFN		; Close JFN which has too many stars
	RLJFN
	  JFCL
	SETOM LCLJFN

	MOVE A,LSTJFN
	SETZ C,
	TXNE F,F.STAT		; Header needed on TTY conn?
	  $SOUT			; Yes.

	MOVE B,D
	$SOUT

	RET			; Error return from DOLIST
	SUBTTL	Subroutines - JBKINI, JFNTXT
;	CALL JBKINI	Initialize long-form GTJFN block
;SETS	A/ JBLOCK	Address of long form block for GTJFN
;	B/ C(SBP)	Frequent string to GTJFN

JBKINI:	MOVEI A,JBLOCK		; Address of block
	SETZM (A)		; Set up for long for GTJFN
	MOVX B,<JBLOCK,,JBLOCK+1>
	BLT B,EJBLOK		; Clear it first
	MOVX B,<.NULIO,,.NULIO>	; No TTY I/O
	MOVEM B,.GJSRC(A)
	MOVE B,SBP		; Rest of user's argument
	RET			; Return


;	CALL JFNTXT

JFNTXT:	PUSH P,A		; Preserve AC's
	PUSH P,B
	PUSH P,C
	SETZM JFNTXS		; Clear text storage
	MOVX A,<JFNTXS,,JFNTXS+1>
	BLT A,EJFNTX
	HRRZ B,-2(P)		; The JFN
	HRROI A,JFNTXS		; Store string here
	MOVX C,<..DEVD+..DIRA+..NAMA+..TYPA+..GENA+JS%PAF> ; Bits for format
	JFNS
	POP P,C
	POP P,B
	POP P,A
	RET
	SUBTTL	Subroutine - SETCLSD

;	CALL SETCLSD		; Sets F.CLSD if data connecion has to
;				; be closed to indicate EOF, Else cleared


SETCLS:	TXO F,F.CLSD		; Assume close at EOF (NCP always closes)

IFN TCPP,<			; Have to close data connection for EOF?
	SKIPGE A,$MODE2		; Get current parameters
	  SETZ A,		; Default
	SKIPGE B,$STRU2
	  SETZ B,

	CAIE A,MODE.C		; Modes Compressed or
	 CAIN A,MODE.B		; Blocked
	  TXZ F,F.CLSD		; Don't have to
	CAIN A,MODE.S		; Mode S and
	 CAIE B,STRU.P		; Structure P
	  SKIPA			; No
	   TXZ F,F.CLSD		; Yes, don't have to
> ; End of IFN TCPP
	RET


;	TXNN F,F.CLSD
;	  RET

.ORG ;BACK TO LOW SEGMENT
	SUBTTL	Routine to trap DEBRK failures
;#2 Called with pointer to asciz string, identifying routine, in A
DBKFA1: HRROI D,[ASCIZ / TIMINT or CTTINT
/]
	JRST DBKFAI
DBKFA2:	HRROI D,[ASCIZ / DETINT
/]
	JRST DBKFAI
DBKFA3:	HRROI D,[ASCIZ / QTAINT
/]
	TRN
DBKFAI:
 REPEAT 0,<			;Monitor bug causing need of this
				; is believed gone.
	MOVX A,GJ%SHT
	HRROI B,[ASCIZ /<SYSTEM>FTP-FAIL.LOG/]
	GTJFN
	 ERJMP DBKFAL
	HRRZM A,FAIJFN
	MOVX B,FLD(7,OF%BSZ)!OF%RD!OF%APP
	OPENF
	 ERJMP [HRRZ A,FAIJFN
		RLJFN
		 TRN
		JRST DBKFAL]
	GTAD			;#2 get identifying date
	MOVE B,A
	HRRZ A,FAIJFN
	ODTIM
	MOVE B,D
	SETZ C,
	SOUT
	CLOSF
	 TRN
> ; End repeat 0
DBKFAL:	GJINF			;#2 add detach of controlling terminal
	CALL CLSTTY		;#2 detach it 
	JRST LOGOUT		;#2 and logout

	SUBTTL