;<PUP>PUPFTP.MAC;30    26-SEP-82 15:24:36    EDIT BY TAFT
; Change DIR to ENUM.
; Note: still using old protocol for Store and Enumerate --
; should change this someday.
;<PUP>PUPFTP.MAC;29    26-APR-81 14:55:35    EDIT BY TAFT
; Send Creation-Date property during Store.
;<PUP>PUPFTP.MAC;28    16-JAN-81 11:12:21    EDIT BY TAFT
; Strip trailing "." in Name-body if local filename has blank extension
;<PUP>PUPFTP.MAC;27    24-OCT-80 09:59:05    EDIT BY TAFT
; Permit storing a 36-bit file with any byte size, but
; give a warning message.
;<PUP>PUPFTP.MAC;26     4-NOV-79 12:35:06    EDIT BY TAFT
; Revise MAXTAB
; Set file creation date from incoming property list during Retrieve
;<PUP>PUPFTP.MAC;25     2-SEP-79 16:00:11    EDIT BY TAFT
;<PUP>PUPFTP.MAC;24    28-AUG-77 17:39:38    EDIT BY TAFT
; Fix "Rename" to send default directory in both property lists
;<PUP>PUPFTP.MAC;23    24-JUL-77 16:52:33    EDIT BY TAFT
; Repair buggy NOUT in List command
;<PUP>PUPFTP.MAC;22     3-JUN-77 11:23:07    EDIT BY TAFT
; Add "List" and "Rename" commands
;<PUP>PUPFTP.MAC;19     2-JUN-77 19:16:37    EDIT BY TAFT
; Split out some subroutines into separate module PFUUTL.MAC
;<PUP>PUPFTP.MAC;18    12-APR-77 10:39:42    EDIT BY TAFT
; Move VERTXT here
; Add "Exec" and "Halt" commands
;<PUP>PUPFTP.MAC;17     2-APR-77 16:49:49    EDIT BY TAFT
; Add dummy routines for mail-related properties
;<PUP>PUPFTP.MAC;16    19-MAR-77 20:04:57    EDIT BY TAFT
; Add "Delete" command
; Add "Preserve Version"
; Add "No" prefix for "Debug" and "Preserve"
; Straighten out who clobbers what property lists.
;<PUP>PUPFTP.MAC;14    19-MAR-77 13:46:36    EDIT BY TAFT
; Fix crash caused by typing in ";?"
;<PUP>PUPFTP.MAC;13    18-MAR-77 18:09:13    EDIT BY TAFT
; Add REFILL procedure for property list parser
;<PUP>PUPFTP.MAC;12    18-MAR-77 17:18:12    EDIT BY TAFT
; Just send EOC when SCNPRP fails since SCNPRP now generates the
; appropriate "No" response internally.
;<PUP>PUPFTP.MAC;11    15-MAR-77 19:25:28    EDIT BY TAFT
; Change "Selective" to "Automatic", add "List" and "Version".
; "Quit" now closes connection.
; Call "Login" command automatically in appropriate places.
; Default user name in "Login".
; Add Tenex-paged type
; Add kludge to make Tenex-paged the default when connect to Maxc
;<PUP>PUPFTP.MAC;8    10-MAR-77 14:37:48    EDIT BY TAFT
; Break out major pieces of the program:
; PUPDEF.MAC -- definitions shared by PUPFTP and PUPSRV
; PFUDEF.MAC -- definitions specific to PUPFTP
; PFUCMD.MAC -- keyboard command interpreter
; PFUPRP.MAC -- property list parser
; PUPXFR.MAC -- data transfer routines, shared with PUPSRV
; PUPUUO.MAC -- UUO handler, shared with PUPSRV
; What remain are the top-level command handlers and various
; subroutines.
;<PUP>PUPFTP.MAC;5     8-APR-76 01:53:54    EDIT BY TAFT
; Make "Debug" toggle the debug flag on and off
; Add command for setting eol convention
; Add common procedure GNTPAR for generating type, byte size, eol
; convention properties
;<PUP>PUPFTP.MAC;3    25-MAR-76 22:38:34    EDIT BY TAFT
; Add "Close" command (equivalent to "Disconnect")
;<PUP>PUPFTP.MAC;2    25-MAR-76 00:56:33    EDIT BY TAFT
; Send Type and Byte-Size in "Retrieve" property list if we have them
; Properly handle error returns from INKEY

; Copyright 1979 by Xerox Corporation

	TITLE PUPFTP -- PUP FTP USER PROGRAM
	SUBTTL E. A. Taft / January, 1976

	SEARCH PUPDEF,PFUDEF,STENEX
	USEVAR FTPVAR,FTPPVR


VERTXT:	ASCIZ /1.14 26-Sep-82/


; Assemble Mark names and flags

DEFINE XN(SYM,TYPE,NAME,FLAGS) <
REPEAT TYPE-<.-MRKNAM>,<0>
	FLAGS + [ASCIZ /NAME/]
>
DEFINE XS(SYM,TYPE,NAME,FLAGS) <
REPEAT TYPE-<.-MRKNAM>,<0>
	1B0+FLAGS + [ASCIZ /NAME/]
>

MRKNAM::MARKS


; Assemble command dispatch tables

DEFINE X(NAME,HELP,FLAGS) <
	[ASCIZ /NAME/] ,, C.'NAME
>

CMDDSP:	COMMANDS

NCMDS==.-CMDDSP		; Length of main command table

AUTDSP:	AUTCMDS

NAUTCM==.-AUTDSP	; Length of "Automatic" command table

NODSP:	NOCMDS

NNOCMD==.-NODSP		; Length of "No" command table


; Assemble flags and help table

DEFINE X(NAME,HELP,FLAGS) <
	<FLAGS> + [ASCIZ /HELP/]
>

CMDHLP:	COMMANDS

; -----------------------------------------------------------------
;	Main loop and user command handling
; -----------------------------------------------------------------

; Start of program

PUPFTP::RESET
	MOVE P,[IOWD STKLEN,STACK]  ; Setup stack
	SETZ F,			; Clear flags

	MOVSI D,-<ELSLOC-ILSLOC>/1000  ; Set count of storage pages
	SETO A,			; Delete page
	MOVSI B,400000		; This fork
	HRRI B,ILSLOC/1000(D)	; Unmap and delete storage page
	PMAP
	AOBJN D,.-2

	MOVEI A,400000		; Get capabilities
	RPCAP
	TRNE C,1B18+1B19	; Wheel or operator?
	 TLO F,(ENABLF)		; Yes, remember so

	GJINF
	HRRZ B,A		; Login directory number
	HRROI A,USRNAM		; Generate default user name
	DIRST
	 PUSHJ P,SCREWUP

	PUSHJ P,INIPSI		; Initialize psi system

	MOVEI A,100		; Get terminator of command used
	BKJFN			;  to start subsystem
	 JRST COMLP
	PBIN
	CAIE A," "		; Space?
	 JRST COMLP		; No, prompt for first command
	PUSHJ P,INIEDT##	; Yes, omit prompt, init editor
	PUSHJ P,C.OPE0		; Fake "Open" command

; Main command loop
COMLP:	PUSHJ P,CRIF##		; Go to left margin
	PUSHJ P,INIEDT##	; Initialize command editor
	PROMPT <*>		; Print prompt
	HRRI F,0		; Clear temporary flags

	MOVE A,[-NCMDS,,CMDDSP]	; Setup ptr to dispatch table
	PUSHJ P,INKEY##		; Input and lookup command keyword
	 JRST COMLP2		; None found or other error

; Found command.  Check flags before dispatching
	MOVE P1,0(A)		; Get dispatch word
	MOVE C,CMDHLP-CMDDSP(A)	; Get flags and help string

	TLNE C,(SPCREQ)		; Space required after command?
	TLNE D,(C.SPAC)		; Yes, was there one?
	 CAIA			; Yes or not needed
	 JRST COMLP3		; No and needed, give error

	TLNE C,(CONREQ)		; Required to have connection open?
	TLNE F,(CONOPF)		; Yes, is it?
	 CAIA			; No or not needed
	 JRST [	ERROR <%/Please "Open" a connection first>
		JRST COMLP]

	TLNN C,(PRECNF)		; Confirm command before dispatch?
	 JRST .+3		; No
	PUSHJ P,CONFRM##	; Yes, await confirming EOL
	 JRST COMLP		; Not confirmed

	PUSHJ P,0(P1)		; Dispatch to command handler
	 CAI			; Some handlers return +2
	JRST COMLP		; Back to top

; Here if command not found or other error
COMLP2:	TLNE D,(C.CDEL)		; Command delete?
	 JRST COMLP		; Yes, just give another prompt
	SKIPE WRDLEN##		; Null word input?
	 JRST COMLP4		; No
	TLNE D,(C.CEOL)		; Yes, followed by eol?
	 JRST COMLP		; Yes, just prompt for more input
	LDB A,CMDBYT##		; No, get terminator
	CAIN A,";"		; Start of comment?
	 JRST [	MOVSI B,(C.ALPH+C.NUM+C.PUNC+C.SPAC+C.CTRL)  ; Yes
		HRROI A,[ASCIZ /Comment/]
		PUSHJ P,INWORD## ; Input and discard rest of line
		 JRST COMLP	; Line delete
		JRST COMLP]	; Normal (must be eol), done
COMLP3:	ERROR < ? >		; Not legal syntax, complain
	JRST COMLP		; Prompt for more input

; Finally, try to parse first word as a host name
COMLP4:	TLNE F,(CONOPF)		; Is there already a connection?
	 JRST COMLP3		; Yes, don't try to parse host name
	PUSHJ P,[		; Get stack level right
		MOVEM P,WRDPDP## ; Fake up INWORD state to look
		MOVEI C,C.OPE1	;  like it was called from C.OPEN
		MOVEM C,WRDXIT##
		MOVSI C,(C.ALPH+C.NUM+C.HSTC)
		MOVEM C,WRDATR##
		LDB A,CMDBYT##	; Recover terminator
		TLNN D,(C.HSTC)	; Was it punct legal inside name?
		 JRST C.OPE2	; No, enter "Open" code
		IBP CMDBYT##	; Yes, include char in word
		AOS WRDLEN##
		JRST APWORD##]	; Get more input from user
	JRST COMLP		; When done, resume main loop

; Here for command error if delete not typed
DELERR:	TLNE D,(C.CDEL)
	 POPJ P,

; Here for garden-variety command errors from routines called
; from the main loop
CERR:	ERROR < ? >,1



; "Help" -- print out more detailed help message

C.HELP:	PUSHJ P,CRIF##		; Go to left margin
	MOVSI A,-NCMDS		; Init table counter
C.HEL1:	HLRO B,CMDDSP(A)	; Get command name
	HRRO C,CMDHLP(A)	; Get help text
	TYPE < %2S %3S%/>	; Print both
	AOBJN A,C.HEL1		; Repeat for all commands
	TYPE < host-name%/ ; comment%/>; Additional info
	POPJ P,


; "Quit"

C.QUIT:	TLNE F,(CONOPF)		; Connection open?
	 PUSHJ P,C.DIS1		; Yes, close it


; "Halt"

C.HALT:	HALTF			; Exit PUPFTP
	POPJ P,			; Back to command loop if resumed


; "Debug" -- turn on verbose printouts and other information

C.DEBU:	NOISE <printout enabled>
	PUSHJ P,CONFRM##	; Request confirmation
	 POPJ P,		; Forget it
	TRNE F,NOPREF		; Ok, prefixed by "No"?
	 TLZA F,(DEBUGF)	; Yes, turn debugging off
	 TLO F,(DEBUGF)		; No, turn it on
	POPJ P,


; "Version"

C.VERS:	PUSHJ P,CRIF##
	HRROI A,VERTXT
	TYPE < Tenex Pup FTP User %1S>
	POPJ P,

; "Exec"

C.EXEC:	MOVSI A,(1B2+1B17)	; Old file
	HRROI B,[ASCIZ /<SYSTEM>EXEC.SAV/]
	GTJFN
	 ERROR <Exec not available: %1J>,1
	MOVE B,A		; Save jfn
	MOVSI A,(1B1)		; Transmit capabilities
	CFORK
	 JRST [	ERROR <%1J>
		MOVE A,B
		RLJFN
		 PUSHJ P,SCREWUP
		POPJ P,]
	MOVSI A,(A)		; Get fork,,jfn
	HRRI A,(B)
	GET			; Get file into fork
	HLRZ A,A		; Fork handle
	SETZ B,			; Entry point 0
	SFRKV			; Start fork
	WFORK			; Wait for it to terminate
	KFORK			; Kill it
	POPJ P,


; "No" prefix for other commands

C.NO:	MOVE A,[-NNOCMD,,NODSP]	; Setup ptr to dispatch table
	PUSHJ P,INKEY##		; Input following keyword
	 JRST DELERR		; Line delete or error
	TRO F,NOPREF		; Ok, set "No" prefix flag
	MOVE D,0(A)		; Get dispatch
	JRST 0(D)		; Enter regular command handler


; Unimplemented commands
UNIMP:	ERROR <%/Not implemented yet>,1

; "Disconnect"

C.CLOS:	NOISE <current connection>
	JRST .+2
C.DISC:	NOISE <from remote host>
	PUSHJ P,CONFRM##	; Confirm command
	 POPJ P,		; Not confirmed
	JRST C.DIS1

; Here from most other places when "End" encountered
DISCON:	TYPE <Connection terminated by server%/>
	JRST C.DIS1		; Go disconnect

; Here to handle EOC syncronization error
UNSEOC:	TYPE <Unsynchronized EOC -- aborting connection%/>
	HRRZ A,CONJFN		; Abort the connection
	MOVEI B,25
	SETZ C,
	HRROI D,[ASCIZ /FTP sequence error/]
	MTOPR

C.DIS1:	HRRZ A,CONJFN		; Get output JFN
	CLOSF			; Close connection
	 JRST [	TYPE <Timeout during disconnect sequence%/>
		HRRZ A,CONJFN	; Failed, probably timeout
		SETZ B,		; Clear error flags
		SDSTS
		CLOSF		; Try again
		 PUSHJ P,SCREWUP
		JRST .+1]
	HLRZ A,CONJFN		; Now close input JFN
	CLOSF
	 PUSHJ P,SCREWUP	; Can't fail
	SETZM CONJFN		; Forget JFNs
	TLZ F,(CONOPF)		; Say no connection open
	POPJ P,


; "Preserve"
; At present only "Preserve Version (numbers)" is implemented

C.PRES:	HRROI A,[[ASCIZ /VERSION/],,0]
	PUSHJ P,INKEY##		; Input following keyword
	 JRST DELERR		; Line delete or error
	NOISE <numbers>
	PUSHJ P,CONFRM##	; Input confirmation
	 POPJ P,		; Forget it
	TRNE F,NOPREF		; Ok, have "No" prefix?
	 TLZA F,(PREVRF)	; Yes, turn off preserving versions
	 TLO F,(PREVRF)		; No, turn it on
	POPJ P,

; "Byte" -- supply byte size for unknown cases

C.BYTE:	NOISE <size is>
	HRROI A,[ASCIZ /Decimal number 0-36/]
	MOVSI B,(C.NUM)		; Allow numbers only
	PUSHJ P,INWORD##	; Input a word
	 POPJ P,		; Line delete
	MOVE A,WRDBYT##		; Get string ptr to word
	MOVEI C,↑D10		; Decimal radix
	NIN			; Convert to number
	 JRST CERR
	CAIL B,0		; Ensure in range
	CAILE B,↑D36
	 JRST CERR
	HRLM B,0(P)		; Ok, save it
	PUSHJ P,CONFRM##	; Confirm command
	 POPJ P,		; Line delete
	HLRZ B,0(P)		; Ok, recover byte size
	MOVEM B,DEFPRP+P.BYTE	; Set default byte size
	POPJ P,


; "Type" -- supply type for unknown cases

C.TYPE:	MOVE A,[-4,,TYPDSP]	; Set ptr to keyword table
	PUSHJ P,INKEY##		; Input following keyword
	 JRST DELERR		; Line delete or error
	HRRZ A,0(A)		; Got it, get type code
	HRLM A,0(P)		; Save it
	PUSHJ P,CONFRM##	; Confirm command
	 POPJ P,		; Line delete
	HLRZ A,0(P)		; Ok, recover type code
	MOVEM A,DEFPRP+P.TYPE	; Set default type
	POPJ P,

TYPDSP:	[ASCIZ /BINARY/],,2
	[ASCIZ /PAGED/],,3
	[ASCIZ /TEXT/],,1
	[ASCIZ /UNSPECIFIED/],,0


; "EOL" -- supply end of line convention for unknown cases

C.EOL:	NOISE <convention>
	MOVE A,[-3,,EOLDSP]	; Set ptr to keyword table
	PUSHJ P,INKEY##		; Input following keyword
	 JRST DELERR		; Line delete or error
	HRRZ A,0(A)		; Got it, get eol code
	HRLM A,0(P)		; Save it
	PUSHJ P,CONFRM##	; Confirm command
	 POPJ P,		; Line delete
	HLRZ A,0(P)		; Ok, recover eol code
	MOVEM A,DEFPRP+P.EOLC	; Set default eol convention
	POPJ P,

EOLDSP:	[ASCIZ /CR/],,0
	[ASCIZ /CRLF/],,1
	[ASCIZ /TRANSPARENT/],,2

; "Open" -- initiate connection to foreign port

C.OPEN:	TLNE F,(CONOPF)		; Is there already a connection?
	 ERROR <There is already an open connection>,1
	NOISE <connection to>
C.OPE0:	HRROI A,[ASCIZ /Remote host name/]
	MOVSI B,(C.ALPH+C.NUM+C.HSTC) ; Terminate on non-alphanumerics
	PUSHJ P,INWORD##	; Input a word
C.OPE1:	 POPJ P,		; Line delete
	JUMPE C,CERR		; Fail if no input
C.OPE2:	TLNN D,(C.SPAC+C.CEOL+C.ESC+C.HSTP)  ; Good terminator?
	 JRST CERR		; No, reject
	HRLM A,0(P)		; Save terminator
	SETZ A,
	TLNE D,(C.SPAC+C.CEOL+C.ESC)  ; Terminated by space or EOL?
	 DPB A,CMDBYT##		; Yes, replace terminator with null
	MOVE A,WRDBYT##		; Get string ptr to start of word
	MOVE B,[1B0+100B17+TEMP]  ; Buffer net addresses here
	TRNE F,ESCAPF		; Terminated by Escape?
	 TLO B,(1B1)		; Yes, permit recognition
	PUPNM			; Attempt to parse as net address
	 JRST [	CAIN A,PUPNX2	; Failed, ambiguous?
		 JRST [	ERROR <>; Yes, ring bell to say want more
			JRST APWORD##]  ; Resume input
		CAIE A,PUPNX1	; Name not found?
		TLNE D,(C.SPAC+C.CEOL+C.ESC)  ; Completed input?
		 JRST CERR	; Yes, treat as command error
		IBP CMDBYT##	; No, include terminator in word
		AOS WRDLEN##	; Include in count
		JRST APWORD##]	; Resume INWORD for more input
	TRNN F,ESCAPF		; Were we recognizing?
	 JRST C.OPE4		; No
	PUSHJ P,BAKBYT##	; Yes, make string ptr to tail
	TYPE <%1S>		; Print tail if any
C.OPE3:	ILDB A,CMDBYT##		; Look for new end
	JUMPE A,APWORD##	; Resume INWORD when get there
	AOS WRDLEN##		; Count extra characters
	JRST C.OPE3

C.OPE4:	HLRZ A,0(P)		; Recover terminator
	DPB A,CMDBYT##		; Put it back on end of input
	TLNE D,(C.PUNC)		; Punctuation?
	 JRST [	IBP CMDBYT##	; Yes, advance past it
		AOS WRDLEN##	; Include in count
		JRST APWORD##]	; Resume INWORD for more input
	MOVE A,TEMP		; Got space or EOL, get net/host
	TLNE A,-1		; Ensure we have sufficient input
	TRNN A,-1
	 ERROR <Incomplete host specification>,1
	HRROI A,HSTNAM		; Ok, build string for GTJFN
	PUSHJ P,CPYWRD##	; Foreign port name
	SKIPN TEMP+1		; Foreign socket specified?
	 WRITE <+FTP>		; No, append to specification
	PUSHJ P,CONFRM##	; Confirm command
	 POPJ P,		; Line delete

	PUSHJ P,OPNCON		; Open the connection
	 POPJ P,		; Failed (message already typed)

; "Open" (cont'd)

; Now do version handshake
	HRROI A,VERTXT		; Ok, set ptr to version text
	FTPM(VERS,FTPVER,<Maxc Pup FTP user %1S>,,EOC)  ; Send it
C.OPE5:	PUSHJ P,GETRSP##	; Get response
	 JRST DISCON		; End
	 JRST UNSEOC		; EOC
	CAIE A,MKVERS		; Correct response?
	 JRST [	HRRO C,MRKNAM(A)  ; No, give error
		TYPE <Improper response "[%3S] %4S" to version query%/>
		JRST C.OPE5]	; Try again
	TYPE( < %4S%/)		; Ok, print server herald
	CAIE B,FTPVER		; Correct protocol version?
	 JRST [	ERROR <Server protocol incompatible -- aborting%/>
		JRST C.DIS1]	; Go disconnect
	PUSHJ P,FLSEOC##	; All ok, scan past EOC
	 JRST DISCON		; End

; Check for foreign host being a Maxc, and if so set the
; default transfer type to "Paged".
	HRRZ A,CONJFN
	MOVE C,[1,,D]		; Get net,,host into D
	GDSTS
	MOVSI A,-NMAXTB		; Search table of Maxc addresses
	CAMN D,MAXTAB(A)
	 JRST [	MOVEI A,3	; Found, set default type
		MOVEM A,DEFPRP+P.TYPE
		TYPE < Type defaulted to "Paged"%/>
		JRST C.OPE6]
	AOBJN A,.-2
	HRRZ A,DEFPRP+P.TYPE	; Not found, check current type
	CAIN A,3		; Tenex paged?
	 SETZM DEFPRP+P.TYPE	; Yes, reset default to unspecified
C.OPE6:	POPJ P,			; Done

; Table of Maxc net,,host addresses
MAXTAB:	3 ,, 200	; All the addresses of Maxc1
	4 ,, 40
	3 ,, 5		; Maxc2
	4 ,, 240
NMAXTB==.-MAXTAB

; Open Pup connection port
; Assumes foreign port specification in HSTNAM
; Returns +1:  Failed, message already printed
;	+2:  Succeeded, nothing printed
;	     input,,output JFNs in CONJFN
; Clobbers A-D

OPNCON:	HRROI A,TEMP		; Build complete name here
	HRROI B,HSTNAM		; Foreign port spec
	WRITE <PUP:!J.%2S>	; Build the string
	MOVSI A,(1B2+1B17)	; Short form, name from string
	HRROI B,TEMP
	GTJFN			; Get a JFN for the port
	 ERROR <Connect failure: %1J>,1  ; Shouldn't ever fail
	HRLZM A,CONJFN		; Ok, save input JFN
	MOVE B,[8B5+8B17+1B19]	; Bytesize 8, 30-second timeout
	OPENF			; Initiate rendezvous
	 JRST OPNCO4		; Failed

; Now make name string and open same port for output
	CVSKT			; Get local port address
	 PUSHJ P,SCREWUP
	HRROI A,TEMP		; Where to build name
	WRITE <PUP:%3O!A.>	; Start it off
	PUSH P,A
	HLRZ A,CONJFN
	MOVE C,[2,,C]		; Get foreign port address
	GDSTS
	HLRZ B,C		; Separate net and host
	HRRZS C
	POP P,A
	WRITE <%2O#%3O#%4O>	; Append foreign port to string
	MOVSI A,(1B2+1B17)	; Short form, name from string
	HRROI B,TEMP
	GTJFN			; Get a JFN for the port
	 JRST OPNCO6		; Failed (unlikely)
	HRRM A,CONJFN		; Ok, save output JFN
	MOVE B,[8B5+1B20]	; Bytesize 8, open for output
	OPENF
	 JRST OPNCO5		; Failed (unlikely)
	TLO F,(CONOPF)		; Succeeded, remember open
	JRST SKPRET##		; Return +2

; Failure from first OPENF
OPNCO4:	HRLM A,0(P)		; Save error code
	HLRZ A,CONJFN		; Recover JFN
	RLJFN			; Release it
	 PUSHJ P,SCREWUP
	SETZM CONJFN		; Insurance...
	HLRZ A,0(P)		; Recover error code
	CAIN A,OPNX20		; Check for special cases
	 ERROR <Connection attempt timed out>,1
	CAIN A,OPNX21
	 ERROR <Connection attempt rejected by remote host>,1
	ERROR <Connection failure: %1J>,1  ; Catchall

; Failure from second OPENF
OPNCO5:	HRLM A,0(P)		; Save error code
	HRRZ A,CONJFN		; Release the output JFN
	RLJFN
	 PUSHJ P,SCREWUP
	HLRZ A,0(P)		; Recover error code

; Failure from second GTJFN
OPNCO6:	ERROR <Connection failure: %1J>
	HLRZ A,CONJFN		; Get input JFN
	MOVEI B,25		; Abort function
	SETZ C,			; No code assigned
	HRROI D,[ASCIZ /Connection attempt aborted/]  ; Abort text
	MTOPR			; Abort the connection
	CLOSF			; Close the port
	 PUSHJ P,SCREWUP	; Can't fail after abort done
	SETZM CONJFN		; Forget connection JFNs
	POPJ P,			; Take fail return

; "Login"
; Also called as a subroutine from PROCNO.
; Returns +2 upon successful completion.

C.LOGI::SETZM TEMP		; Clear temp page
	MOVE A,[TEMP,,TEMP+1]
	BLT A,TEMP+3*<USRSTL/5+1>-1
	TLNN D,(C.SPAC+C.CEOL)	; Terminated by space or EOL?
	 JRST CERR		; No, complain
	TLNE D,(C.CEOL)		; EOL?
	 TRO F,ESCAPF		; Yes, pretend Escape was hit
	NOISE <user>
	HRROI A,[ASCIZ /Remote user name/]
	MOVSI B,(C.ALPH+C.NUM+C.PUNC)  ; Alphanumerics & punct.
	PUSHJ P,INWORD##	; Input a word
	 POPJ P,		; Line delete
	JUMPE C,[TLNN D,(C.ESC)	; Null input ended by escape?
		 JRST CERR	; No, error
		PUSHJ P,BAKBYT##  ; Yes, back up over the escape
		HRROI A,USRNAM	; Supply default user name
		PROMPT <%1S >
		JRST C.LOG1]
	PUSHJ P,ESPACE##	; Print space for escape
	TLNN D,(C.SPAC+C.CEOL+C.ESC)  ; Error if not space or EOL
	 JRST CERR
	CAILE C,USRSTL		; Make sure not too long
	 ERROR <%/Word too long>,1
C.LOG1:	HRROI A,TEMP		; Where to buffer user name
	PUSHJ P,CPYWRD##	; Copy the word that was input
	TLNE D,(C.CEOL)		; End of command?
	 JRST C.LOG5		; Yes
	PUSHJ P,NOECHO##	; No, turn off echoing for next
	NOISE <password>
	HRROI A,[ASCIZ /Password/]
	MOVSI B,(C.ALPH+C.NUM+C.PUNC)
	PUSHJ P,INWORD##	; Input the password
	 POPJ P,		; Line delete
	TRNN F,ESCAPF		; Unless Escape hit
	 PRINT 0(A)		;  print the terminator
	PUSHJ P,ESPACE##	; Print space for Escape
	PUSHJ P,OKECHO##	; Echoing back on
	TLNN D,(C.SPAC+C.CEOL+C.ESC)  ; Error if not space or EOL
	 JRST CERR
	CAILE C,USRSTL		; Make sure not too long
	 ERROR <%/Word too long>,1
	HRROI A,TEMP+<USRSTL/5+1>  ; Where to buffer user password
	PUSHJ P,CPYWRD##	; Copy the word that was input
	LDB A,CMDBYT##		; Get terminating character
	MOVE B,WRDBYT##		; Flush password from command
	MOVEM B,CMDBYT##	;  string (so ↑R won't type it)
	IDPB A,CMDBYT##		; Append password terminator
	TLNE D,(C.CEOL)		; End of command?
	 JRST C.LOG5		; Yes
	NOISE <account>
	HRROI A,[ASCIZ /Account/]
	MOVSI B,(C.ALPH+C.NUM+C.PUNC)
	PUSHJ P,INWORD##	; Input the account
	 POPJ P,		; Line delete
	PUSHJ P,ESPACE##	; Print space for Escape
	CAILE C,USRSTL		; Make sure not too long
	 ERROR <%/Word too long>,1
	HRROI A,TEMP+2*<USRSTL/5+1>  ; Where to buffer user account
	PUSHJ P,CPYWRD##	; Copy the word that was input

C.LOG5:	PUSHJ P,CONFRM##	; Await confirming EOL
	 POPJ P,		; Line delete
	MOVE A,[TEMP,,USRNAM]	; Ok, remember all parameters
	BLT A,USRNAM+3*<USRSTL/5+1>-1
	JRST SKPRET##		; Done, signal success

; "Connect"

C.CONN:	SETZM TEMP		; Clear temp page
	MOVE A,[TEMP,,TEMP+1]
	BLT A,TEMP+2*<USRSTL/5+1>-1
	NOISE <to directory>
	HRROI A,[ASCIZ /Remote directory name/]
	MOVSI B,(C.ALPH+C.NUM+C.PUNC)  ; Alphanumerics & punct.
	PUSHJ P,INWORD##	; Input a word
	 POPJ P,		; Line delete
	PUSHJ P,ESPACE##	; Print space for Escape
	TLNN D,(C.SPAC+C.CEOL+C.ESC)  ; Error if not space or EOL
	 JRST CERR
	TLNE D,(C.CEOL)		; Null input followed by EOL?
	 JUMPE C,C.CON2		; Yes, zap connect parameters
	CAILE C,USRSTL		; Make sure not too long
	 ERROR <%/Word too long>,1
	HRROI A,TEMP		; Where to buffer connect name
	PUSHJ P,CPYWRD##	; Copy the word that was input
	TLNE D,(C.CEOL)		; End of command?
	 JRST C.CON2		; Yes
	PUSHJ P,NOECHO##	; No, turn off echoing for next
	NOISE <password>
	HRROI A,[ASCIZ /Password/]
	MOVSI B,(C.ALPH+C.NUM+C.PUNC)
	PUSHJ P,INWORD##	; Input the password
	 POPJ P,		; Line delete
	TRNN F,ESCAPF		; Unless Escape hit
	 PRINT 0(A)		;  print the terminator
	PUSHJ P,ESPACE##	; Print space for Escape
	PUSHJ P,OKECHO##	; Echoing back on
	TLNN D,(C.SPAC+C.CEOL+C.ESC)  ; Error if not space or EOL
	 JRST CERR
	CAILE C,USRSTL		; Make sure not too long
	 ERROR <%/Word too long>,1
	HRROI A,TEMP+<USRSTL/5+1>  ; Where to buffer password
	PUSHJ P,CPYWRD##	; Copy the word that was input
	LDB A,CMDBYT##		; Get terminating character
	MOVE B,WRDBYT##		; Flush password from command
	MOVEM B,CMDBYT##	;  string (so ↑R won't type it)
	IDPB A,CMDBYT##		; Append password terminator
C.CON2:	PUSHJ P,CONFRM##	; Await confirming EOL
	 POPJ P,		; Line delete
	MOVE A,[TEMP,,CONNAM]	; Ok, remember all parameters
	BLT A,CONNAM+2*<USRSTL/5+1>-1
	POPJ P,			; Done


; "Directory" -- supply default directory

C.DIRE:	SETZM TEMP		; Zero to detect null case
	HRROI A,[ASCIZ /Default remote directory name/]
	MOVSI B,(C.ALPH+C.NUM+C.PUNC)  ; Alphanumerics & punct.
	PUSHJ P,INWORD##	; Input a word
	 POPJ P,		; Line delete
	PUSHJ P,ESPACE##	; Print space for Escape
	TLNN D,(C.SPAC+C.CEOL+C.ESC)  ; Error if not space or EOL
	 JRST CERR
	CAILE C,USRSTL		; Make sure not too long
	 ERROR <%/Word too long>,1
	HRROI A,TEMP		; Where to buffer directory name
	PUSHJ P,CPYWRD##	; Copy the word that was input
	PUSHJ P,CONFRM##	; Await confirming EOL
	 POPJ P,		; Line delete
	MOVE A,[TEMP,,DEFPRP+P.DIRE]  ; Ok, copy default directory
	BLT A,DEFPRP+P.DIRE+USRSTL/5
	POPJ P,


; "Automatic" -- special kind of Retrieve, Store, or Delete

C.AUTO:	MOVE A,[-NAUTCM,,AUTDSP]  ; Setup ptr to dispatch table
	PUSHJ P,INKEY##		; Input following keyword
	 JRST DELERR		; Line delete or error
	TRO F,AUTOF		; Ok, set Automatic flag
	MOVE D,0(A)		; Get dispatch
	JRST 0(D)		; Enter regular command handler


; "Retrieve"
; Also get here on "Automatic Retrieve" with AUTOF on in F

C.RETR:
C.GET:	NOISE <remote file>
	HRROI A,[ASCIZ /Remote filename/]
	MOVSI B,(C.ALPH+C.NUM+C.PUNC+C.SPAC)  ; All printable chars
	PUSHJ P,INWORD##	; Input a word
	 POPJ P,		; Line delete
	TRNE F,ESCAPF		; Ended with Escape?
	 JRST [	ERROR <>	; Yes, can't recognize here
		JRST APWORD##]	; So just ask for more input
	TLNN D,(C.CEOL)		; Ended with eol?
	 JRST CERR		; No, give error
	JUMPE C,CERR		; Also bad if no input
	MOVE A,[DEFPRP,,FILPRP]	; Ok, init file property list
	BLT A,FILPRP+PLSIZE-1
	HRROI A,FILPRP+P.SFIL	; Where to put server filename
	PUSHJ P,CPYWRD##	; Do it

; Generate "Retrieve" command to server
C.RET1:	HRROI A,NETBUF		; Buffer property list here
	HRROI B,FILPRP+P.SFIL	; String ptr to server filename
	WRITE <(Server-Filename %2S)>; Generate property
	MOVEI B,FILPRP		; Default property list
	PUSHJ P,GNTPAR##	; Generate transfer parameters
	PUSHJ P,SNDLGN##	; Send login/connect parameters
	HRROI A,NETBUF		; Where property list is
	FTPM(RETR,,<(%1S)>,,EOC)  ; Send command and property list

; Wait for response
C.RET2:	PUSHJ P,GETRSP##	; Get response
	 JRST DISCON		; End
	 JRST [	TYPE <No files retrieved>
		POPJ P,]
	CAIN A,MKNO		; See if "No"
	 JRST [	ERROR( < %4S%/)	; Report failure to user
		HRLM B,0(P)	; Save "No" code
		PUSHJ P,FLSEOC##  ; Scan past EOC
		 JRST DISCON	; End
		HLRZ B,0(P)	; Recover "No" code
		PUSHJ P,PROCNO##  ; Process "No" code
		 POPJ P,	; Not recoverable, exit
		JRST C.RET1]	; Recoverable, retry
	CAIE A,MKPLST		; Here-is-property-list response?
	 JRST [	HRRO C,MRKNAM(A)  ; No, give error
		TYPE <Improper response "[%3S] %4S" to Retrieve request%/>
		JRST C.RET2]	; Try again
	JRST C.RET4		; Ok, go process

; "Retrieve" (cont'd)

; Loop here after each retrieval
C.RET3:	PUSHJ P,GETRSP##	; Get next command from server
	 JRST DISCON		; End
	 POPJ P,		; EOC, retrieve finished
	CAIE A,MKPLST		; Here-is-property-list response?
	 JRST [	HRRO C,MRKNAM(A)  ; No, give error
		TYPE <Improper response "[%3S] %4S" to Retrieve request%/>
		JRST C.RET3]	; Try again

; Interpret property list, check filename and properties
C.RET4:	MOVE A,[DEFPRP,,FILPRP]	; Copy default property list
	BLT A,FILPRP+PLSIZE-1
	HRROI A,NETBUF		; Where text is
	MOVEI B,FILPRP		; Where to put decoded properties
	PUSHJ P,SCNPRP##	; Interpret property list
	 JRST [	TYPE <Bad property list, one file bypassed%/>
		PUSHJ P,FLSEOC##  ; Scan past EOC
		 JRST DISCON	; End
		FTPM(EOC)	; Return control to server for next file
		JRST C.RET3]	; On to next
	PUSHJ P,FLSEOC##	; Scan past EOC
	 JRST DISCON		; End
	MOVEI A,FILPRP		; Construct Server-Filename if
	PUSHJ P,FIXNAM##	;  there isn't one already
	HRROI A,FILPRP+P.SFIL	; Make string ptr to filename
	MOVE B,FILPRP+P.TYPE	; Make sure type specified,
	CAIN B,2		; and also bytesize if binary
	 SKIPE FILPRP+P.BYTE
	 SKIPN FILPRP+P.TYPE
	  JRST [TYPE <Type/Byte-Size missing, file %1S bypassed%/>
		FTPM(NO,105,<Type/Byte-Size missing>,,EOC)
		JRST C.RET3]

; If "Automatic Retrieve", try to create a local filename using
; just the Name-Body property
	SKIPE FILPRP+P.SFIL	; Name supplied as property?
	TRNN F,AUTOF		; Automatic retrieve?
	 JRST C.RET6		; No, go ask
	TYPE <%1S (to local file) >; Type server filename for user
C.RET5:	MOVSI A,(1B0+1B17)	; No, name from string, short form
	TLNE F,(PREVRF)		; Want to preserve versions?
	 HRR A,FILPRP+P.VERS	; Yes, set default version
	HRROI B,FILPRP+P.NAMB	; String in Name-Body property
	GTJFN			; Get JFN for local output file
	 JRST [	HRROI B,FILPRP+P.NAMB  ; Failed, print string as is
		ERROR <%2S%/ %1J%/>
		JRST C.RET6]	; Go ask user for name
	HRRZM A,DSTJFN		; Ok, store file JFN
	TYPE <%1F%/>		; Type the filename
	JRST C.RET7		; Go try to open it

; "Retrieve" (cont'd)

; If not "Automatic Retrieve" or default filename didn't work,
; get local filename from user
C.RET6:	PUSHJ P,INIEDT##	; Initialize editor
	HRROI A,FILPRP+P.SFIL	; Get server filename string
	PROMPT <%1S (to local file) >; Prompt user
	TRO F,NEOLEF		; Say don't echo eols
	HRROI A,[ASCIZ /
Carriage Return to transfer to default local file,
Delete to bypass transfer of file,
or enter desired local filename/]
	MOVSI B,(C.ALPH+C.NUM)	; Terminate on non-alphanumerics
	PUSHJ P,INWORD##	; Input first field of reply
	 JRST [	SKIPE WRDLEN##	; Line delete, any previous input?
		 JRST C.RET6	; Yes, give user another try
		FTPM(NO,105,<Bypass this file>,,EOC) ; No, bypass
		JRST C.RET3]	; On to next file
	TRZ F,NEOLEF		; Normal echoing again
	TLNE D,(C.CEOL+C.ESC)	; Ended by eol or escape?
	 JUMPE C,C.RET5		; Yes, default if no word input
	MOVSI A,(1B0+1B3)	; Output use, "new version" etc.
	PUSHJ P,GETJFN##	; Do GTJFN and capture terminator
	 JRST [	TLNN D,(C.CDEL)	; Failed, command delete?
		 ERROR < ? >	; No, give brief error message
		JRST C.RET6]	; Try again
	HRRZM A,DSTJFN##	; Ok, store file JFN
	MOVEI A," "		; Pretend terminator was space
	DPB A,CMDBYT##
	PUSHJ P,CONFRM##	; Confirm command
	 JRST [	HRRZ A,DSTJFN##	; Line delete, release JFN
		RLJFN
		 PUSHJ P,SCREWUP
		JRST C.RET6]	; Request input again

; Now we have JFN for the local file.
; Open it and tell server to send file
C.RET7:	HRRZ A,DSTJFN##		; Get the JFN
	PUSHJ P,CHKDSK##	; Check for device disk
	HRRZ B,FILPRP+P.TYPE	; Dispatch on type
	JRST @[	SCREWUP		; Unspecified
		RTYTXT		; Text
		RTYBIN		; Binary
		RTYPAG](B)	; Paged

RTYPAG:	TRNN F,DSKDVF		; Paged, device disk?
	 JRST [	ERROR <"Type Paged" illegal for non-disk files>
		HRRZ A,DSTJFN##	; Release the JFN
		RLJFN
		 PUSHJ P,SCREWUP
		JRST C.RET6]	; Ask for a new filename
	MOVEI B,↑D36		; Byte size is 36
	JRST .+3

RTYBIN:	SKIPA B,FILPRP+P.BYTE	; Binary, use specified byte size
RTYTXT:	 MOVEI B,7		; Text, use byte size 7
	HRRZM B,FILPRP+P.BYTE	; Save byte size for transfer code
	ROT B,-6		; Position for OPENF
	HRRI B,1B20		; Open for output
	OPENF
	 JRST [	PUSHJ P,ROPNER##  ; Failed, print message
		HRRZ A,DSTJFN##	; Release the JFN
		RLJFN
		 PUSHJ P,SCREWUP
		JRST C.RET6]	; Ask for a new filename
	FTPM(YES,0,<File open, ready for data>,,EOC) ; Tell server

; Set file creation date to value given in property list, if present
	SKIPE C,FILPRP+P.CDAT	; Present in property list?
	TRNN F,DSKDVF		; Output file on disk?
	 JRST C.RET8		; No
	HRRZ A,DSTJFN##		; Yes, set creation date
	HRLI A,13
	SETO B,
	CHFDB

; "Retrieve" (cont'd)

; Await server's Here-is-File command and file data
C.RET8:	PUSHJ P,GETRSP##	; Get command from server
	 JRST RETEND		; End received
	 JRST RETEOC		; Unsynchronized EOC
	CAIN A,MKNO		; "No", i.e. abort?
	 JRST RETABT		; Go handle
	CAIE A,MKFILE		; "Here-is-File"?
	 JRST [	HRRO C,MRKNAM(A)  ; No, make ptr to command name
		TYPE <Improper response "[%3S] %4S" during Retrieve%/>
		JRST C.RET8]	; Ignore, look for another
	HLRZ A,CONJFN		; Set source JFN
	MOVEM A,SRCJFN##
	MOVEI A,FILPRP		; File property list
	PUSHJ P,RECDAT##	; Do the retrieval
	 JRST [	HRRZ A,DSTJFN##	; Failed, give local message
		TYPE <Data error during retrieve of %1F, aborted%/>
		PUSHJ P,GYESNO##  ; Flush rest of file, get command
		 JRST RETEND	; End
		 JRST RETEOC	; EOC
		 CAI		; Yes
		PUSHJ P,KILFIL##  ; No, flush local file
		JRST C.RET3]	; On to next file
	PUSHJ P,GYESNO##	; Retrieve finished, get terminator
	 JRST RETEND		; End
	 JRST RETEOC		; Unsynchronized EOC
	 CAIA			; Yes
	 JRST RETABT		; No, i.e. abort
	HRRZ A,DSTJFN		; Yes, transfer completed
	CLOSF			; Close local file
	 TYPE <Unlikely local CLOSF error: %1J%/>
	JRST C.RET3		; On to next file if any

; Here for errors during the actual retrieval
RETEND:	PUSHJ P,KILFIL##	; End received
	JRST DISCON

RETEOC:	PUSHJ P,KILFIL##	; Unsynchronized EOC
	JRST UNSEOC

RETABT:	HRRZ A,DSTJFN##
	TYPE <Retrieve of %1F aborted by server%/>
	PUSHJ P,KILFIL##	; Flush local file if possible
	JRST C.RET3		; On to next

; "Store"
; Also get here on "Automatic Store" with AUTOF on in F

C.STOR:
C.SEND:	NOISE <local file>
C.STO1:	HRROI A,[ASCIZ /Local filename/]
	MOVSI B,(C.ALPH+C.NUM)	; Terminate on non-alphanumerics
	PUSHJ P,INWORD##	; Input a word
	 POPJ P,		; Line delete
	MOVSI A,(1B2+1B11)	; Old file, "*" ok
	PUSHJ P,GETJFN##	; Do GTJFN, capture terminator
	 JRST [	TLNE D,(C.CDEL)	; Failed, command delete?
		 POPJ P,	; Yes, stop here
		ERROR < ? >	; No, give brief error message
		MOVE A,WRDBYT##	; Flush word that was input
		MOVEM A,CMDBYT##
		JRST C.STO1]	; Try again
	MOVEM A,SRCJFN##	; Ok, save JFN
	TLNE D,(C.CEOL)		; Terminated with EOL?
	 JRST C.STO2		; Yes, no confirmation needed
	PROMPT < [Confirm] >
	PUSHJ P,CONFRM##	; Input confirmation
	 JRST [	HRRZ A,SRCJFN##	; Command delete
		RLJFN
		 PUSHJ P,SCREWUP
		POPJ P,]

; Loop here for each local file designated by JFN
C.STO2:	MOVE A,[DEFPRP,,FILPRP]	; Copy default property list
	BLT A,FILPRP+PLSIZE-1
	HRRZ A,SRCJFN##		; Get local JFN
	PUSHJ P,CHKDSK##	; Set DSKDVF appropriately

; If "Automatic Store", create a remote filename using
; just the local name and extension
	TRNN F,AUTOF		; Automatic store?
	 JRST C.STO5		; No, go ask for foreign filename
	TYPE <%1F (to remote file) >; Type filename
C.STO3:	HRRZ B,SRCJFN##		; No, get source JFN
	MOVE C,[1B8+1B11+1B35]	; Name and ext with punctuation
	PUSHJ P,DOJFNS##	; Convert to string, quote if req'd
	PUSH P,B		; See if string ends in "."
GFNPR4:	ILDB C,B
	CAIN C,"."
	 JRST [	MOVE C,B
		ILDB C,C
		JUMPN C,GFNPR4
		DPB C,B		; Yes, strip trailing "."
		JRST .+2]
	JUMPN C,GFNPR4
	MOVE B,0(P)
	HRROI A,FILPRP+P.NAMB	; Set Name-Body property
	WRITE <%2S>
	POP P,B
	TYPE <%2S>		; Type foreign name for user
	TLNE F,(PREVRF)		; Preserving versions?
	TRNN F,DSKDVF		; Yes, is local file on disk?
	 JRST C.STO4		; No, can't do version stuff
	HRRZ A,SRCJFN##		; Yes, get version number from FDB
	MOVE B,[1,,7]
	MOVEI C,C		; Put it here
	GTFDB
	HLRZS C			; Put in RH
	MOVEM C,FILPRP+P.VERS	; Put in property list
	TYPE <;%3D>

C.STO4:	PRINT EOL
	JRST C.STO6		; Go begin store

; "Store" (cont'd)

; If not "Automatic Store", get remote filename from user
C.STO5:	PUSHJ P,INIEDT##	; Initialize editor
	HRRZ A,SRCJFN##		; Get local JFN
	PROMPT <%1F (to remote file) >; Prompt user
	TRO F,NEOLEF		; Say don't echo eols
	HRROI A,[ASCIZ /
Carriage Return to transfer to default remote file,
Delete to bypass transfer of file,
or enter desired remote filename/]
	MOVSI B,(C.ALPH+C.NUM+C.PUNC+C.SPAC)  ; All printable chars
	PUSHJ P,INWORD##	; Input remote filename
	 JRST [	SKIPE WRDLEN##	; Line delete, any input?
		 JRST C.STO5	; Yes, give user another try
		JRST C.STO9]	; No, skip over this file
	TLNE D,(C.CEOL+C.ESC)	; Terminated by eol or escape?
	 JUMPE C,C.STO3		; Yes, default if no word input
	TRNE F,ESCAPF		; Escape terminated?
	 JRST [	ERROR <>	; Yes, can't recognize here
		JRST APWORD##]	; So just ask for more input
	TLNN D,(C.CEOL)		; Ended by EOL?
	 JRST [	ERROR < ?%/>	; No, bad char or something
		JRST C.STO5]	; Try again
	PRINT EOL		; Print the EOL that was suppressed
	HRROI A,FILPRP+P.SFIL	; Copy to Server-Filename property
	PUSHJ P,CPYWRD##

; Here when ready to initiate Store
C.STO6:	HRRZ A,SRCJFN##		; Get local JFN
	PUSHJ P,CKSPAR		; Check parameters
	 JRST C.STO9		; Can't store this file
	PUSHJ P,OPNSTO		; Open local file
	 JRST C.STO9		; Failed, bypass file

; Loop back here to retry after recoverable "No" responses
C.STO7:	HRROI A,NETBUF		; Where to buffer property list
	HRROI B,FILPRP+P.SFIL	; Make ptr to Server-Filename
	SKIPE FILPRP+P.SFIL	; Was that specified?
	 WRITE <(Server-Filename %2S)>; Yes, send property
	HRROI B,FILPRP+P.NAMB	; Make ptr to Name-Body
	SKIPE FILPRP+P.NAMB	; Was that specified?
	 WRITE <(Name-Body %2S)>; Yes, send property
	SKIPE B,FILPRP+P.VERS	; Is there a version?
	 WRITE <(Version %2D)>	; Yes, send it
	SKIPE B,FILPRP+P.CDAT	; Have creation date property?
	 WRITE <(Creation-Date %2Z)>; Yes, send it
	MOVEI B,FILPRP		; File property list
	PUSHJ P,GNTPAR##	; Generate transfer parameters
	PUSHJ P,SNDLGN##	; Append Login/Connect properties
	HRROI A,NETBUF		; Where the property list is
	FTPM(STOR,,<(%1S)>,,EOC)  ; Send off command and properties

; "Store" (cont'd)

; Await server's "Yes" or "No" reply, and do transfer if Yes
	PUSHJ P,GYESNO##	; Get reply
	 JRST STOEND		; End received
	 JRST STOEOC		; Unsynchronized EOC
	 CAIA			; Yes
	 JRST [	PUSHJ P,PROCNO##  ; No, process "No" code
		 CAIA		; Not recoverable
		 JRST [	PUSHJ P,FLSEOC##  ; Recoverable, try again
			 JRST DISCON
			JRST C.STO7]
		JUMPE B,STOABT	; No, check error code
		CAIL B,20	; Username or password problem?
		CAILE B,24
		 CAIG B,3	; Or other global problem?
		  HRRZS SRCJFN##  ; Yes, disable indexing of JFN
		JRST STOABT]	;  so we stop with this file
	PUSHJ P,FLSEOC##	; Normal, flush following EOC
	 JRST STOEND		; End
	MOVEI A,MKFILE		; Insert "Here-Is-File" mark
	SETZ B,
	PUSHJ P,BEGCMD##
	HRRZ A,CONJFN		; Set destination JFN
	MOVEM A,DSTJFN##
	MOVEI A,FILPRP		; Property list
	PUSHJ P,SNDDAT##	; Do the actual store
	 JRST [	HRRZ A,SRCJFN##	; Failed, give local message
		TYPE <Data error in local file %1F, aborted%/>
		FTPM(NO,103,<File data error>,,EOC) ; Tell server
		PUSHJ P,GYESNO##  ; Await response
		 JRST STOEND	; End
		 JRST STOEOC	; EOC
		 CAI		; Yes (shouldn't happen)
		JRST STOABT]	; Go close file, on to next file
	FTPM(YES,0,<Transfer completed>,,EOC)  ; Done, tell server
	HRRZ A,SRCJFN##		; Close local file
	HRLI A,400000		; But don't release
	CLOSF
	 TYPE <Unlikely local CLOSF error: %1J%/>
	PUSHJ P,GYESNO##	; Get server's response
	 JRST DISCON		; End
	 JRST UNSEOC		; EOC
	 CAI			; Yes (i.e. successful)
	PUSHJ P,FLSEOC##	; No (message already typed)
	 JRST DISCON

; Here to advance to next file designated by local JFN
C.STO9:	MOVE A,SRCJFN##		; Get JFN with flags
	GNJFN			; Step to next file
	 POPJ P,		; No more (JFN released).  Done.
	JRST C.STO2		; More, go process

; Here for errors during the actual store
STOEND:	HRRZ A,SRCJFN##		; End received, close local file
	CLOSF			;  and release JFN
	 CAI
	JRST DISCON		; Handle disconnect

STOEOC:	HRRZ A,SRCJFN##		; Unsynchronized EOC
	CLOSF			; Close and release JFN
	 CAI
	JRST UNSEOC		; Go abort connection

STOABT:	HRRZ A,SRCJFN##		; Here if server said "No"
	HRLI A,400000		; Close file, don't release JFN
	CLOSF
	 CAI
	PUSHJ P,FLSEOC##	; Flush server's EOC
	 JRST DISCON		; End
	JRST C.STO9		; On to next file

; "Store" subroutines ...

; Check and/or default parameters for "Store" command
;	A/ JFN for file being stored
; Assumes transfer parameters are in FILPRP
; Returns +1:  Error, message already typed
;	+2:  Ok, type and byte size filled in appropriately
; Clobbers B-D

CKSPAR:	SETZ B,			; Assume don't know byte size
	TRNN F,DSKDVF		; Local file on disk?
	 JRST CKSPA2		; No
	MOVE B,[1,,11]		; Yes, read byte size from FDB
	MOVEI C,C		; Put it here
	GTFDB
	LDB B,[POINT 6,C,11]	; Extract byte size
CKSPA2:	HRRZ C,FILPRP+P.TYPE	; Get specified transfer type
	HRRZ D,FILPRP+P.BYTE	; Get specified byte size
	JRST @[	STYUNS		; Dispatch on type:  Unspecified
		STYTXT		; Text
		STYBIN		; Binary
		STYPAG](C)	; Paged

; Here for type unspecified
STYUNS:	SKIPN D,B		; File byte size known?
	 ERROR <Type specification required to store %1F>,1
	MOVEI C,2		; Assume binary
	CAIN B,7		; 7-bit file?
	 MOVEI C,1		; Yes, assume text
	JRST CKSPA4		; Go set parameters

; Here for type Text
STYTXT:	SKIPE D,B		; File byte size known?
	CAIN D,↑D36		; Yes, 36 bit words?
	 MOVEI D,7		; Not known or 36, assume 7 bit
	CAIE D,7		; Legal byte size?
	CAIN D,8
	 JRST CKSPA4		; Yes
	ERROR <Type Text inconsistent with byte size %4D of file %1F>,1

; Here for type Binary
STYBIN:	JUMPN D,.+3		; Transfer byte size specified?
	SKIPN D,B		; No, substitute file byte size
	 ERROR <Byte size specification required to store %1F>,1
	JUMPE B,CKSPA4		; Ok if file byte size unknown
	CAMN B,D		; Both known, make sure consistent
	 JRST CKSPA4		; Ok
	CAIE B,↑D36		; No, but permit anyway for 36-bit file
	 ERROR <Parameters inconsistent with byte size %4D of file %1F>,1
	TYPE <Storing %2D-bit file %1F with byte size %4D.
This may be incorrect -- beware!%/>
	JRST CKSPA4

; Here for type Tenex-Paged
STYPAG:	TRNN F,DSKDVF		; Is local file on disk?
	 ERROR <"Type Paged" illegal for non-disk files>,1
	MOVEI D,↑D36		; Set local byte size to 36

; All cases converge here
; C/ Transfer type, D/ Transfer byte size
CKSPA4:	MOVEM C,FILPRP+P.TYPE	; Store type and byte size
	MOVEM D,FILPRP+P.BYTE
	MOVE B,[1,,13]		; Get file creation date
	MOVEI C,FILPRP+P.CDAT
	TRNE F,DSKDVF
	 GTFDB
	JRST SKPRET##		; Return +2

; "Store" subroutines ...

; Open file for store
; Assumes file JFN is in SRCJFN
; and that transfer parameters are in FILPRP
; Returns +1:  Failed, error message already generated
;	+2:  Succeeded, file open
; Clobbers A-D

OPNSTO:	TRNN F,DSKDVF		; Is file on disk?
	 JRST OPNST1		; No, bypass extension check
	HRROI A,TEMP		; Yes, buffer file extension here
	SETZM TEMP
	HRRZ B,SRCJFN##
	MOVSI C,(1B11)		; Get extension only
	JFNS
	MOVEI B,1B19+1B25	; Assume want to open thawed
	MOVE A,TEMP		; Get the extension
	CAME A,[ASCII /SAV/]	; Leave thawed if .SAV
OPNST1:	MOVEI B,1B19		; Open in frozen mode
	MOVE A,FILPRP+P.BYTE	; Get transfer byte size
	DPB A,[POINT 6,B,5]	; Put in position
	HRRZ A,SRCJFN##		; Setup JFN
	OPENF			; Attempt to open
	 JRST [	TRC B,1B25	; Failed, try flipping thawed bit
		HRRZ A,SRCJFN##
		OPENF
		 JRST SOPNER##  ; Failed again, give error
		JRST .+1]	; Succeeded, continue
	JRST SKPRET##		; Return +2

; "Delete"
; Also get here on "Automatic Delete" with AUTOF on in F

C.DELE:	NOISE <remote file>
	HRROI A,[ASCIZ /Remote filename/]
	MOVSI B,(C.ALPH+C.NUM+C.PUNC+C.SPAC)  ; All printable chars
	PUSHJ P,INWORD##	; Input a word
	 POPJ P,		; Line delete
	TRNE F,ESCAPF		; Ended with Escape?
	 JRST [	ERROR <>	; Yes, can't recognize here
		JRST APWORD##]	; So just ask for more input
	TLNN D,(C.CEOL)		; Ended with eol?
	 JRST CERR		; No, give error
	JUMPE C,CERR		; Also bad if no input
	MOVE A,[DEFPRP,,FILPRP]	; Ok, init file property list
	BLT A,FILPRP+PLSIZE-1
	HRROI A,FILPRP+P.SFIL	; Where to put server filename
	PUSHJ P,CPYWRD##	; Do it

; Generate "Delete" command to server
C.DEL1:	HRROI A,NETBUF		; Buffer property list here
	HRROI B,FILPRP+P.SFIL	; String ptr to server filename
	WRITE <(Server-Filename %2S)>; Generate property
	PUSHJ P,SNDLGN##	; Send login/connect parameters
	HRROI A,NETBUF		; Where property list is
	FTPM(DELE,,<(%1S)>,,EOC)  ; Send command and property list

; Wait for response
C.DEL2:	PUSHJ P,GETRSP##	; Get response
	 JRST DISCON		; End
	 JRST [	TYPE <No files deleted>
		POPJ P,]
	CAIN A,MKNO		; See if "No"
	 JRST [	ERROR( < %4S%/)	; Report failure to user
		HRLM B,0(P)	; Save "No" code
		PUSHJ P,FLSEOC##  ; Scan past EOC
		 JRST DISCON	; End
		HLRZ B,0(P)	; Recover "No" code
		PUSHJ P,PROCNO##  ; Process "No" code
		 POPJ P,	; Not recoverable, exit
		JRST C.DEL1]	; Recoverable, retry
	CAIE A,MKPLST		; Here-is-property-list response?
	 JRST [	HRRO C,MRKNAM(A)  ; No, give error
		TYPE <Improper response "[%3S] %4S" to Delete request%/>
		JRST C.DEL2]	; Try again
	JRST C.DEL4		; Ok, go process

; "Delete" (cont'd)

; Loop here after each file deleted
C.DEL3:	PUSHJ P,GETRSP##	; Get next command from server
	 JRST DISCON		; End
	 POPJ P,		; EOC, delete finished
	CAIE A,MKPLST		; Here-is-property-list response?
	 JRST [	HRRO C,MRKNAM(A)  ; No, give error
		TYPE <Improper response "[%3S] %4S" to Delete request%/>
		JRST C.DEL3]	; Try again

; Interpret property list, check filename and properties
C.DEL4:	MOVE A,[DEFPRP,,FILPRP]	; Copy default property list
	BLT A,FILPRP+PLSIZE-1
	HRROI A,NETBUF		; Where text is
	MOVEI B,FILPRP		; Where to put decoded properties
	PUSHJ P,SCNPRP##	; Interpret property list
	 JRST [	TYPE <Bad property list, one file bypassed%/>
		PUSHJ P,FLSEOC##  ; Scan past EOC
		 JRST DISCON	; End
		FTPM(EOC)	; Return control to server for next file
		JRST C.DEL3]	; On to next
	PUSHJ P,FLSEOC##	; Scan past EOC
	 JRST DISCON		; End
	MOVEI A,FILPRP		; Construct Server-Filename if
	PUSHJ P,FIXNAM##	;  there isn't one already

; If not "Automatic Delete", request confirmation from user
	PUSHJ P,INIEDT##	; Initialize editor
	HRROI A,FILPRP+P.SFIL	; Get server filename string
	PROMPT <Delete %1S>
	TRNE F,AUTOF		; Automatic delete?
	 JRST [	PRINT EOL	; Yes, charge ahead
		JRST C.DEL7]
	PROMPT < [Confirm] >
	PUSHJ P,CONFRM##	; Confirm command
	 JRST [	FTPM(NO,105,<Bypass this file>,,EOC)
		JRST C.DEL3]	; On to next file

; Tell server to delete file
C.DEL7:	FTPM(YES,0,<Delete it!>,,EOC)
	PUSHJ P,GYESNO##	; Get response from server
	 JRST DISCON		; End received
	 JRST UNSEOC		; Unsynchronized EOC
	 JRST C.DEL3		; Yes, finished
	 JRST C.DEL3		; No (message already printed)

; "Rename"

C.RENA:	NOISE <remote file>
	HRROI A,[ASCIZ /Existing remote filename/]
	MOVSI B,(C.ALPH+C.NUM+C.PUNC)  ; All printable chars
	PUSHJ P,INWORD##	; Input a word
	 POPJ P,		; Line delete
	TLNN D,(C.CEOL+C.SPAC+C.ESC)  ; Proper terminator?
	 JRST CERR		; No, complain
	JUMPE C,CERR		; Null input not allowed
	TLNE D,(C.CEOL)		; Terminated by EOL?
	 TRO F,ESCAPF		; Yes, pretend escape hit
	HRROI A,FILPRP+P.SFIL	; Where to put old server filename
	PUSHJ P,CPYWRD##	; Do it

	NOISE <to be>
	HRROI A,[ASCIZ /New remote filename/]
	MOVSI B,(C.ALPH+C.NUM+C.PUNC)  ; All printable chars
	PUSHJ P,INWORD##	; Input a word
	 POPJ P,		; Line delete
	TRNE F,ESCAPF		; Ended with escape?
	 JRST [	ERROR <>	; Yes, can't recognize here
		JRST APWORD##]	; So just ask for more input
	TLNN D,(C.CEOL)		; Proper terminator?
	 JRST CERR		; No, complain
	JUMPE C,CERR		; Null input not allowed
	HRROI A,FILBUF		; Where to put new server filename
	PUSHJ P,CPYWRD##	; Do it

; Generate "Rename" command to server
C.REN1:	HRROI A,NETBUF		; Buffer property list here
	HRROI B,FILPRP+P.SFIL	; String ptr to old name
	WRITE <(Server-Filename %2S)>; Generate property
	PUSHJ P,SNDLGN		; Send login/connect parameters
	WRITE <)(>		; End first property list, start second
	HRROI B,DEFPRP+P.DIRE
	SKIPE 0(B)		; Is there a default directory
	 WRITE <(Directory %2S)>
	HRROI A,NETBUF		; Result string
	HRROI B,FILBUF		; New server filename
	FTPM(RENA,,<(%1S(Server-Filename %2S))>,,EOC)  ; Send it

; Wait for response
	PUSHJ P,GYESNO##
	 JRST DISCON		; End
	 JRST UNSEOC		; Unsynchronized EOC
	 JRST [	PUSHJ P,FLSEOC##  ; "Yes", flush EOC
		 JRST DISCON
		POPJ P,]	; Done
	HRLM B,0(P)		; "No", save code
	PUSHJ P,FLSEOC##	; Flush EOC
	 JRST DISCON
	HLRZ B,0(P)		; Recover "No" code
	PUSHJ P,PROCNO##	; Process "No" code
	 POPJ P,		; Not recoverable, exit
	JRST C.REN1		; Recoverable, retry

; "List"

C.LIST:	PUSHJ P,SAVE1##
	SETZ P1,		; Reset list format flags
	NOISE <remote file designator>
	HRROI A,[ASCIZ /Remote file designator/]
	MOVSI B,(C.ALPH+C.NUM+C.PUNC+C.SPAC)  ; All printable chars
	PUSHJ P,INWORD##	; Input a word
	 POPJ P,		; Line delete
	TRNE F,ESCAPF		; Ended with Escape?
	 JRST [	ERROR <>	; Yes, can't recognize here
		JRST APWORD##]	; So just ask for more input
	TLNN D,(C.CEOL)		; Ended with eol?
	 JRST CERR		; No, give error
	JUMPE C,CERR		; Also bad if no input
	MOVE A,CMDBYT		; Get command byte pointer
	BKJFN			; Back it up
	 PUSHJ P,SCREWUP
	LDB D,A			; Get char before terminator
	CAIN D,","		; Comma?
	 MOVEM A,CMDBYT		; Yes, store backed up pointer
	HRROI A,FILPRP+P.SFIL	; Where to put server filename
	PUSHJ P,CPYWRD##	; Do it
	CAIE D,","		; Subcommands follow?
	 JRST C.LIS1		; No

; Loop to gather subcommands
C.LIS0:	PUSHJ P,CRIF##
	PUSHJ P,INIEDT##	; Reinitialize editor
	PROMPT <**>
	MOVE A,LSTSUB		; List subcommand dispatch table
	PUSHJ P,INKEY##		; Input keyword
	 JRST [	TLNE D,(C.CDEL)	; Command delete?
		 POPJ P,	; Yes, exit
		MOVE C,WRDLEN##	; Null input?
		TLNE D,(C.CEOL)	; Terminated by eol
		 JUMPE C,C.LIS1	; Yes, end of subcommands
		ERROR < ?>
		JRST C.LIS0]
	HRRZ A,0(A)		; Get list format flags for keyword
	IORI P1,(A)		; Set them
	JRST C.LIS0		; Back for more subcommands

; Generate "List" command to server
C.LIS1:	HRROI A,NETBUF		; Buffer property list here
	HRROI B,FILPRP+P.SFIL	; String ptr to server filename
	WRITE <(Server-Filename %2S)>; Generate property
	PUSHJ P,SNDLGN##	; Send login/connect parameters
	HRROI A,NETBUF		; Where property list is
	FTPM(ENUM,,<(%1S)>,,EOC) ; Send command and property list

; "List" (cont'd)

; Wait for response
C.LIS2:	PUSHJ P,GETRSP##
	 JRST DISCON		; End
	 POPJ P,		; EOC, done
	CAIN A,MKNO		; See if "No"
	 JRST [	ERROR( < %4S%/)	; Report failure to user
		HRLM B,0(P)	; Save "No" code
		PUSHJ P,FLSEOC##  ; Scan past EOC
		 JRST DISCON	; End
		HLRZ B,0(P)	; Recover "No" code
		PUSHJ P,PROCNO	; Process "No" code
		 POPJ P,	; Not recoverable, exit
		JRST C.LIS1]	; Recoverable, retry
	CAIE A,MKPLST		; Here-is-property-list response?
	 JRST [	HRRO C,MRKNAM(A)  ; No, give error
		TYPE <Improper response "[%3S] %4S" to List request%/>
		JRST C.LIS2]	; Try again

; Parse property list
	SETZM FILPRP		; Zero it out
	MOVE A,[FILPRP,,FILPRP+1]
	BLT A,FILPRP+PLSIZE-1
	HRROI A,NETBUF		; Where text is
	MOVEI B,FILPRP		; Where to put decoded properties
	PUSHJ P,SCNPRP##	; Interpret property list
	 JRST [	TYPE <Bad property list, one file bypassed%/>
		JRST C.LIS2]

; Print header if necessary
	TLON P1,(1B0)		; Already printed?
	TRNN P1,-1		; Or printing only name?
	 JRST C.LIS3		; Yes
	TYPE <%/                        >
	TRNE P1,LSTYPE		; Printing type?
	 TYPE < Type >
	TRNE P1,LSSIZE		; Printing size?
	 TYPE <  Size>
	SETZ A,			; For dates, assume no times
	TRNE P1,LSTIME		; List times?
	 HRROI A,[ASCIZ /      /]  ; Yes, extra space
	TRNE P1,LSCDAT		; Printing creation date?
	 TYPE <  Creation%1S>
	TRNE P1,LSWDAT		; Printing write date?
	 TYPE <  Write   %1S>
	TRNE P1,LSRDAT		; Printing read date?
	 TYPE <  Read    %1S>
	TRNE P1,LSAUTH		; Print author?
	 TYPE < Author>
	TYPE <%/%/>

; "List" (cont'd)
; Now print listing for this file
C.LIS3:	MOVEI A,101
	HRROI B,FILPRP+P.SFIL	; Server filename
	MOVEI C,↑D1000		; Get Tenex to count the bytes
	SETZ D,
	SOUT
	TRNN P1,-1		; Anything else to print?
	 JRST C.LIS8		; No
	SUBI C,↑D<1000-25>	; Reserve 25 chars for name
	PRINT " "		; Print spaces up to position 25
	SOJG C,.-1

	TRNN P1,LSTYPE		; List file type?
	 JRST C.LIS4		; No
	HRRZ A,FILPRP+P.TYPE	; Yes, get file type
	HRRZ B,FILPRP+P.BYTE	; Byte size
	XCT [	TYPE < ?    >	; Unspecified
		TYPE < Text >	; Text
		TYPE < B(%2D)>	; Binary
		TYPE < Paged>	; Paged (huh?)
	    ](A)
	CAIN A,2		; Binary?
	CAIL B,↑D10		; Byte size less than 10?
	 CAIA
	 PRINT " "		; Yes, another space

C.LIS4:	TRNN P1,LSSIZE		; List file size?
	 JRST C.LIS5		; No
	MOVEI A,101
	MOVE B,FILPRP+P.SIZE	; Get file size
	MOVE C,[1B2+1B4+6B17+↑D10]  ; Leading blanks, width 6
	NOUT
	 CAI			; Ok if number overflows

C.LIS5:	MOVE B,FILPRP+P.CDAT
	TRNE P1,LSCDAT		; List creation date?
	 PUSHJ P,PRDATE		; Yes, do so
	MOVE B,FILPRP+P.WDAT
	TRNE P1,LSWDAT		; List write date?
	 PUSHJ P,PRDATE		; Yes, do so
	MOVE B,FILPRP+P.RDAT
	TRNE P1,LSRDAT		; List read date?
	 PUSHJ P,PRDATE		; Yes, do so
	HRROI A,FILPRP+P.AUTH
	TRNE P1,LSAUTH		; List author?
	 TYPE < %1S>

; End of listing for this file
C.LIS8:	PRINT EOL
	JRST C.LIS2		; Back for next

; Print date in correct format for "List" command
;	B/ Tenex-format date and time
;	P1/ List format flags
; Returns +1 always
; Clobbers A-C

PRDATE:	PRINT " "
	JUMPE B,[TYPE <   ---   >; Handling for unspecified date
		TRNE P1,LSTIME
		 TYPE <      >
		POPJ P,]
	MOVEI A,101
	MOVSI C,(1B9)		; Normally omit time
	TRNE P1,LSTIME		; Want to include time?
	 TLC C,(1B9+1B10)	; Yes, but omit seconds
	ODTIM			; Do it
	POPJ P,


; "List" subcommand definitions and keyword table

LSTYPE==1B18	; List type and byte size
LSSIZE==1B19	; List size
LSCDAT==1B20	; List creation date
LSWDAT==1B21	; List write date
LSRDAT==1B22	; List read date
LSTIME==1B23	; List times as well as dates
LSAUTH==1B24	; List author

DEFINE X(KEY,FLAGS) <[ASCIZ /KEY/],,FLAGS>

LSUBTB:	X AUTHOR,LSAUTH
	X CREATION,LSCDAT
	X EVERYTHING,-1
	X READ,LSRDAT
	X SIZE,LSSIZE
	X TIMES,LSTIME
	X TYPE,LSTYPE
	X VERBOSE,LSTYPE+LSWDAT+LSRDAT+LSAUTH
	X WRITE,LSWDAT

LSTSUB:	LSUBTB-.,,LSUBTB	; Table pointer

; Initialize PSI system
; Returns +1
; Clobbers A, B

INIPSI:	MOVEI A,400000		; Initialize psi system
	MOVE B,[LEVTAB,,CHNTAB]
	SIR
	EIR
	MOVE B,[ACTCHN]		; Activate channels
	AIC
	POPJ P,


; PSI channel definitions

DEFINE PSI(CH,LEV,DISP) <
	ACTCHN==ACTCHN!1B<CH>
RELOC CHNTAB+↑D<CH>
	LEV ,, DISP
>

	ACTCHN==0

CHNTAB:	PSI(9,1,PDLOVF)		; Pushdown overflow
	PSI(11,1,DATERR)	; Data error
	PSI(15,1,ILLINS)	; Illegal instruction
	PSI(16,1,ILLRED)	; Illegal read
	PSI(17,1,ILLWRT)	; Illegal write
	PSI(18,1,ILLXCT)	; Illegal execute
	PSI(20,1,ILLSIZ)	; Machine size exceeded



RELOC CHNTAB+↑D36

LEVTAB:	CH1PC		; Level 1 - fatal errors
	CH2PC		; Level 2 - not used
	CH3PC		; Level 3 - normal wakeups, eof, etc.

; Interrupt routines

; Fatal errors

PDLOVF:	JSP B,CRASHX
	ASCIZ /Pushdown overflow/

DATERX:	JSP B,CRASHX
	ASCIZ /IO data error/

ILLINS:	JSP B,CRASHX
	ASCIZ /Illegal instruction/

ILLRED:	JSP B,CRASHX
	ASCIZ /Illegal read/

ILLWRT:	JSP B,CRASHX
	ASCIZ /Illegal write/

ILLXCT:	JSP B,CRASHX
	ASCIZ /Illegal execute/

ILLSIZ:	JSP B,CRASHX
	ASCIZ /Machine size exceeded/

; Common code for fatal error interrupts
CRASHX:	PUSH P,CH1PC		; Put trap pc on stack
	TLOA B,-1		; Make call pc into string ptr


; UUO handlers and FORMAT escape sequences not defined in PUPFTP
%ULOG:: %UELOG:: %LETC:: %LETP::

; Routine to call if an impossible error occurs
; Does not return

SCREWUP::HRROI B,[ASCIZ /An impossible error has occurred/]
	HRRZ A,0(P)		; Get return pc
	SUBI A,1		; Backup to call
	ERROR <%2S at %1O>
	HALTF

; Handling for data error
DATERR:	PUSH P,A		; Save an ac
	SKIPL A,SRCDSP		; Check for error dispatches
	SKIPGE A,DSTDSP
	 TRNN A,-1		; Both specified and armed?
	  JRST DATERX		; No, treat as fatal error
	HRRZM A,CH1PC		; Armed, clobber interrupt pc
	SETZM SRCDSP		; Disarm errors
	SETZM DSTDSP
	POP P,A
	MOVE P,ERRPDP		; Go to correct stack level
	DEBRK			; Break to error dispatch

; Storage assignments

LS CH1PC		; PSI return locations
LS CH2PC
LS CH3PC

LS STACK,STKLEN		; Local stack
LSP TEMP,1		; One page for general scratch use

LS CONJFN		; Network input,,output JFNs

LSP NETBUF,1		; Network I/O buffer
LSP FILBUF,1		; Local file buffer

LS ERRPDP		; Stack pointer to restore on data error
LS SRCDSP		; Source file data error dispatch
LS DSTDSP		; Destination file data error dispatch

LS HSTNAM,20		; Remote port name (from Host command)

LS DEFPRP,PLSIZE	; Default property list
LS FILPRP,PLSIZE	; File property list (Store/Retrieve)

; *** Do not change the order of the following ***
LS USRNAM,USRSTL/5+1	; User-Name string
LS USRPSW,USRSTL/5+1	; User-Password string
LS USRACT,USRSTL/5+1	; User-Account string
LS CONNAM,USRSTL/5+1	; Connect-Name string
LS CONPSW,USRSTL/5+1	; Connect-Password string
; ***


	END PUPFTP