Google
 

Trailing-Edge - PDP-10 Archives - bb-ev83b-bm_longer - tcpip-sources/ftp2u.mac
There are 2 other files named ftp2u.mac in the archive. Click here to see a list.
; Use GTHST to build HOSTN and HSTNAM tables, add use of HOSTNN
; table (saves a step in HOST00)
	SUBTTL	Initialization

	CALL SETTTY		; Set up params about user console

	MOVX A,<FREPAG*1000>	; Free storage
	MOVEM A,FREE		; Base to pointer

	CALL GETHST		; Initialize host tables

	SETOM DFORKH		; No inferiors yet.
	SETOM RFORKH
	SETOM SFORKH

	SETOM RCON		; No JFNs either
	SETOM SCON
	SETOM DATCON
	SETOM LCLJFN
	SETOM DIRJFN
	SETOM TJFN

	TXZ F,F.TOPN		; No connection now open
	SETZM F$TCLS		; And no request to close it

	SETZM PREFIX		; No partial file names yet
	SETZM SUFFIX

	TXO F,F.NST1		; Fake NOSTATISTICS command
	SETZM F$VBOS		; Fake BRIEF command

	SETZM RETVER		;#4 No RETAIN

	SETOM PARAMS		; Clear all transmission parameters
	MOVE A,[PARAMS,,PARAMS+1]
	BLT A,EPARAM		; To "default - unspecified".

	MOVE A,[PARAMS,,PARAM2] ; And copy them to other two groups
	BLT A,PARAM2+NPARS-1

	MOVE A,[PARAMS,,PARAM3]
	BLT A,PARAM3+NPARS-1

; Touch all global pages so MAKFRK will pass them to inferiors

	MOVEI A,<<GSBAS/1000>*1000> ; Lowest address
	 SKIP (A)		; Touch it to create it
	 ADDI A,1000		; Next page
	 CAIG A,GSTOP		; Have enough?
	  JRST .-3		; Need another

; Initialize interrupts

	MOVX A,<.TICCG,,CGICHN>	; Channel for bell interrupt
	ATI
	MOVX A,<.TICCO,,COICHN>	; And Control-O
	ATI
	MOVX A,<.TICCT,,CTTCHN>	; And Control-T
	ATI
	MOVX A,<.FHSLF>		; Set up PSI for this fork
	MOVX B,<LEVTAB,,CHNTAB>	; Int vectors
	SIR
	EIR
	MOVE B,CHNMSK
	AIC

; Give greeting

	HRROI A,VERSTR
	PSOUT


; Fall into command reader
	SUBTTL	Command Interpreter

CRCOM:	MOVX A,<.PRIOU>		; Try to prevent mixing TTY lines
	DOBE

	RFPOS
	HRRZ B,B		; Get line position
	HRROI A,CRLFM
	SKIPE B			; Jump if at left margin
	  PSOUT			; Carriage return and command input

COMMAN:	MOVE P,GPDP		; Just in case
	TXZ F,F.KJFN		; Clear for all cases except .MGET

	MOVX A,<.PRIOU>		; Try to prevent mixing TTY lines
	DOBE
	MOVX A,<.PRIIN>		; Set wake set for non-alphas
	RFMOD
	TXZ B,TT%WKA
	TXO B,TT%WKF+TT%WKN+TT%WKP	; Wake on controls and punct
	SFMOD

;;;THIS	SHOULD BE PROVOKED BY INT.
;	SKIPE F$TCLS		; Request to close connection?
;	  CALL TCLOS1		; Yes. Do so.

	CALL GCHINI		; Start of line

	MOVE A,CMDIP
	MOVEM A,RDTTYC		; Control-R, if applicable
	HRROI B,[BYTE (7)C.HRLD] ; Prompt character
	CALL UPDCTR

	SETOM F$STAR		; Note am at command input

	MOVE X,COMTBX		; Index to command keywords
	SKIPE DBUGSW
	  HRLI X,<-XCOMS>	; Extra if debugging
	MOVEM X,WORDXP		; To arg cell of GETWRD
	TXNN F,F.TOPN		; Unless a connection is open,
	 TXOA F,F.HCOM		; A host name is ok as command
	  TXZ F,F.HCOM		; Must type CONNECT to kill other connection
	CALL GETWRD		; Get a word (LC = UC)
	  JRST BLANKQ		; May be blank line or not in table

; Keyword or host name valid, dispatch to processing routine

	MOVX A,<.PRIIN>		; Ok, turn control echoing back on
	MOVE B,FCOCB
	MOVE C,FCOCC
	SFCOC
	SUBTTL	Dispatch to processor, Invalid keyword, Comment

	TXZ F,F.NOST		; Assume will want timing statistics
;	SKIPE F$TCLS		; Request to close connection?
;	  CALL TCLOS1		; Yes. Do so.

	SKIPGE C,RECX		; Get the command index
	  JRST ERRCOM		; None
	TXZE F,F.HCM1		; Was command a host name?
	  JRST .HOST1		; Yes. Back door into host routine

	MOVE B,COMTB2+1(C)	; Flags
	TXNN F,F.TOPN		; Connection open?
	 JUMPL B,[CALL TCLOS1	; No, Need one
		HRROI A,[ASCIZ /
? Type a "CONNECT" command first./] ; Make sure disconnected
		JRST ERRMSG]	; Complain
				; Either connected or don't need to be
	HRRZ C,COMTB1+1(C)	; Get routine to handle it
	CALL 0(C)		; Go to it
	  JRST ERRCOM		; Failure.
	NOISE <
>
	JRST COMMAN		; Get next command

; Invalid keyword or host name (msg given) or blank line (no msg given)

BLANKQ:	MOVE A,BREAKC		; What was the break?
	CAIN A,"?"		; Help request?
	  JRST [CALL HLPCOM	; Yes, Do it
		  JFCL
		JRST CRCOM]	; Done
	CAMN A,CDELLN		; Line deleted?
	  JRST XXXCOM		; Yes
	CAIE A,C.LF		; LF or ESC are blanks
	 CAIN A,C.ESC
	  JRST CRCOM		; Treat as blanks
	CAIN A,";"		; Comment?
	  JRST COMMNT		; Yes
	MOVE B,WORDBP		; Partial command word given?
	CAME B,WRDBP0
	 TXNN F,F.HELP		; Yes, given help message?
	  JRST ERRCOM		; No, complain now (or give help)
	JRST CRCOM		; Already complained & given help

; Rest of line is a comment

COMMNT:	MOVX BP,<0>		; Chars to bit bucket
	MOVX X,<777777>		; And its a big bucket
	CALL TSINS		; Read rest of commnt line
	  JRST XXXCOM		; Rubout?
	JRST COMMAN		; Type star.
	SUBTTL	 Line deleted, Unimplemented Commands, Errors

; Line deleted

XXXCOM:	MOVE P,GPDP		; Reset stack
	HRROI A,[ASCIZ / XXX/]
	SKIPE TENEX
	  PSOUT			; TENEX
	JRST CRCOM		; TOPS20


; Unimplemented commands

NOTIMP:	MSG <
Unimplemented Command >
;	MOVE A,WRDBPS		; Beginning of command word
	HRROI A,WORDBF
	PSOUT


; Errors during processing

ERRCOM:	MOVE P,GPDP		; Just in case

	MOVX A,<.PRIIN>		; Back to standard echoing
	MOVE B,FCOCB
	MOVE C,FCOCC
	SFCOC

	MOVE A,LASTCC		; Error or deleted line?
	CAMN A,CDELLN
	  JRST XXXCOM		; Deleted line

	HRROI A,[ASCIZ /
? Error in command./]
	TXON F,F.HELP		; Only give following message on first error
	  HRROI A,[ASCIZ /
? Type "HELP ?<RETURN>" for help./]


; Error in command, A/ pointer to error message

ERRMSG:	PUSH P,A
	MOVX A,<.PRIIN>
	DOBE			; Clear typeahead
	CFIBF
	POP P,A
	PSOUT
	JRST CRCOM		; And try again
	SUBTTL	Subroutines ERRSUB, LF2ESC

; Set	A/ Pointer to (pre) message
;	JRST ERRSYS		; Print message, system error msg
;				  Go for next command
ERRSYS:	CALL ERRSUB
	JRST CRCOM



; Set	A/ Pointer to (pre) message
;	CALL ERRSUB		; Print message, system error msg


ERRSUB:	PUSH P,A
	MOVX A,<.PRIIN>
	DOBE			; Clear typeahead
	CFIBF
	POP P,A
	PSOUT			; Output message

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

	CALLRET PCRLF		; End line & return



; If BREAKC is a LF, change it to a ESC for NOISE

LF2ESC:	MOVE C,BREAKC
	CAIE C,C.LF
	  RET
	MOVX C,C.ESC
	MOVEM C,BREAKC
	RET
	SUBTTL	Subroutine GETNXX

; If foreign end is a TOPS20 or TENEX the local filespec is whatever
; the user specifies with defaults:
;  DEVICE and DIRECTORY	local connected device & directory
;  NAME and TYPE	from foreign file
;  GENERATION #		max(local next higher,gen # of foreign file)
; It's a kludge due to the generation # specification and a couple
; TOPS20 "bugs" and TENEX compatability requirements.
;  1)	GTJFN/GJ%OFG doesn't do ESC default processing as desired
;  2)	GTJFN & JFNS/C=0 returns a device which the user didn't
;	specify if connected to something besides PS:  or  returns
;	generation ".0" when the user didn't specify it
;  3)	TENEX GTJFN lacks .GJRTY  (hense use of temp file)
;  4)	Cannot distinguish defaulted generation # from user specifying
;	a value equal to the default
;  5)	Control-U using .PRIIN,,.PRIOU looses "prompt"
;  6)	GJ%MSG echos text which delete doesn't "see"



; Get a local JFN based on defaults from foreign file whose filespec
; is contained in the string FRNPTH


;FRNPTH/String which is to be used for local defaults
; A/	GTJFN flags,,Address of prompt
;	CALL GETNXX
;Ret+1:	  File not found (by foreign STAT command)
;Ret+2:	  Ok, B/ local filespec, GTJBLK contains parsed FRNPTH
;	  If GTJFN flags were given  A/ Flags & JFN
;Ret+3:	Not TOPS20/TENEX or Error
; Uses	$FILST, GTJLCL, STRTMP


GETNXX:	SKIPN FTNXX		; Foreign end TOPS20/TENEX?
	  JRST RSKP2		; No, cannot get generation # desired

	PUSH P,P3		; Yes, try to keep file attributes
	PUSH P,P2
	PUSH P,P1
	MOVEM A,P1		; Save flags & prompt

	HRROI A,FRNPTH		; Default name
	MOVX B,<.GJDEF>		; Default generation # if none specified
	CALL GTFSTS		; Get attributes from foreign end
	  JRST GETNX1		; File missing
	  JRST GETNX3		; Lose, back to other way ($FILST is 0)
				; Note $FILST is non-zero

	NOISE <
>
	CALL GCHINI		; Clear input buffer

	HRRO B,P1		; Prompt
	CALL UPDCTR

	MOVX P2,<<EFRNP2-FRNPT2>*5-1> ; Initial count
	MOVX P3,<POINT 7,FRNPT2> ; Initial pointer

; Get local filespec

	MOVE X,P2		; Current count and
	MOVE BP,P3		; Pointer

	CALL TSINS		; Get local filespec
	  JRST XXXCOM		; Deleted all

GETNXA:	HLLZ A,P1		; GTJFN flags
	CALL GETNXC		; Get response & edit
	  JRST GETNX3		; Error
	  JRST GETNX2		; Confirmed & Ok

	CALL TSINC		; Back for more editting
	  JRST XXXCOM		; Ugh, Deleted!
	JRST GETNXA


GETNX3:	AOS -3(P)		; RSKP2
GETNX2:	AOS -3(P)		; RSKP
GETNX1:	POP P,P1		; RET
	POP P,P2
	POP P,P3
	RET
	SUBTTL	Subroutine GETNXC

; Parse user's filespec into GTJLCL recording fields and punctuation
; specified.  Build an expanded filespec in STRTMP by filling in *s
; from information in GTJBLK.  If ESC was typed, pass the string and
; ESC with default name.type from GTJBLK to GTJFN, then default an
; unspecified generation number to max(local next highest,GTJBLK);
; then echo the defaulted characters and return (for another round).
; If confirmation is given and GTJFN flags are given, get a local
; JFN for the expanded string and return it; otherwise just return
; the string.

;GTJBLK/GTJFN block for defaults (from foreign STAT)
; A/	GTJFN flags in left half
; X,P2/	Remaining length
;BP,P3/	User typein
;	CALL GETNXC		; Uses	GTJLCL, STRTMP
;Ret+1:	  Error
;Ret+2:	  Ok, Confirmed, B/ Pointer to filespec; if GTJFN flags  A/ JFN
;Ret+3:	Need more user input (confirmation/edit)

GETNXC:	PUSH P,P1
	PUSH P,[0]		; For end pointer
	PUSH P,A		; Save flags

; Parse user typein

	MOVX A,<POINT 7,STRTMP>	; String for expanded user filespec
	MOVE B,P3		; Pointer to user typein
	MOVEI D,GTJBLK		; Has defaults
	MOVEI E,GTJLCL		; Local GTJFN block
	CALL EXPSTR		; Expand stars
	  JRST GETNX0		; Error

; Process break character - ESC, LF, or ding

	MOVE C,BREAKC		; Get user's terminator
	CAIN C,C.ESC		; Terminate with ESC?
	  JRST GETNXL		; Yes, go for defaulted values
	SKIPE STRTMP		; Have something and
	 CAIE C,C.LF		; Confirmed?
	  JRST GETNXZ		; No, Ding

; If GTJFN flags were specified, get the JFN corresponding to STRTMP

	SETO A,			; No JFN
	HLLZ B,(P)		; GTJFN flags
	JUMPE B,GETNXJ		; None

	MOVEI A,GTJLCL		; GTJFN block
	IORM B,.GJGEN(A)
	HRR B,GTJBLK+.GJGEN	;#4 GET FLAGS WORD
	SKIPE RETVER		;#4 RETAIN VERSION?
	 HRRM B,.GJGEN(A)	;#4 YES
	HRROI B,STRTMP		; Expanded filespec
	GTJFN
	  JRST GETNXV		; Lose, ERRMSG, prompt, ding
GETNXJ:

; Return the string and maybe a JFN

	HRROI B,STRTMP		; Expanded filespec
	POP P,(P)		; Drop flags
	POP P,(P)		; Drop temp pointer
	POP P,P1
	JRST RSKP		; Ok



; ESC was typed, see what defaults GTJFN supplies

GETNXL:	MOVE P1,FJFNS-GTJBLK(E)	; Save flags for user-specified
				; fields and punctuation
; A/ string end, C/ break character
	MOVEM A,-1(P)		; Save pointer after user typein

	MOVX D,<GJ%FOU+GJ%FLG+.GJNHG> ; Next higher generation
	SKIPE RETVER		;#4 RETAIN VERSION?
	 HRR D,GTJBLK+.GJGEN	;#4 YES, GET GENERATION
	MOVEI E,GTJLCL		; Local GTJFN block
	CALL GTJFNS		; Get JFN for string
	  JRST GETNXW		; No current file, use foreign
	MOVEM A,LCLJFN		; Save JFN & flags

; Get actual name & type

	MOVX A,<POINT 7,0>
	HRRI A,GTJNAM-GTJBLK(E)	; Pointer for name
	MOVEM A,.GJNAM(E)
	HRRZ B,LCLJFN
	MOVX C,<..NAMA>
	JFNS

	MOVX A,<POINT 7,0>
	HRRI A,GTJEXT-GTJBLK(E)	; Pointer for extension
	MOVEM A,.GJEXT(E)
	MOVX C,<..TYPA>
	JFNS

; Get the (local) default generation #

	HRRZ A,LCLJFN		; See what the generation # is
	MOVX B,<1,,.FBGEN>
	MOVEI C,D
	GTFDB
	ERCAL BOMB
	HLRZS D			; Our next higher
	MOVEM D,LCLGEN		; Save it

	CLOSR (LCLJFN)		; Don't need LCLJFN anymore
; If user specified local generation #, use it

	TXNE P1,JS%GEN		; Local generation # specified?
	  JRST GETNXT		; Yes, use user's value

; User did not specify generation field, find max of local & foreign

	HRRZ B,GTJBLK+.GJGEN	; Foreign generation
	CAMG B,LCLGEN		; Is ours higher?
	  JRST GETNXT		; Yes, it becomes the default

; Foreign is higher, switch to it if same name.type

	SKIPN A,.GJNAM+GTJLCL
	  JRST GETNXP		; Default matches
	MOVE B,.GJNAM+GTJBLK
GETNXN:	ILDB C,A		; Compare names
	ILDB D,B
	CAME C,D
	  JRST GETNXT		; Mis-match, use local next higher
	JUMPN C,GETNXN

	SKIPN A,.GJEXT+GTJLCL
	  JRST GETNXP		; Default matches
	MOVE B,.GJEXT+GTJBLK
GETNXO:	ILDB C,A
	ILDB D,B
	CAME C,D
	  JRST GETNXT		; Mis-match, use local next higher
	JUMPN C,GETNXO
GETNXP:

; Same name.type & foreign is higher, so use it
; Edit defaulted foreign generation number into the tempfile string
; in place of local

	MOVE A,-1(P)		; Get pointer after user typein
	MOVX B,<POINT 7,TPAG>	; Characters due to default
	SETZ C,
	SOUT			; Appended to user typein
	IDPB C,A		; End it

	MOVEI E,GTJLCL
	HRROI A,STRTMP
	CALL XGTJFN		; Parse to locate generation #
	  JRST GETNX0		; Error

	MOVX A,<POINT 7,TPAG>	; Characters due to default
	MOVE B,-1(P)		; End of user typein
	MOVE D,GTJGEN-GTJBLK(E) ; Where gen # punctuation goes (or 0)
GETNXQ:	CAMN B,D		; At correct place?
	  JRST GETNXR		; Yes
	ILDB C,B		; Move to next position
	JUMPE C,GETNXR		; Stop if C.NUL
	ILDB C,A
	JRST GETNXQ		; Back for next character
GETNXR:
	MOVE C,FJFNS-GTJBLK(E)	; Fields & punctuation that was parsed

	MOVX B,<".">
	TXNN C,<FLD(2,JS%NAM)>	; Have . after name?
	  IDPB B,A		; No (??), insert it

	SKIPE TENEX
	  MOVX B,<";">

	TXNN C,<FLD(4,JS%GEN)>	; If need punctuation before gen #
	  IDPB B,A		; Insert it

; This trashes info after generation (prot, acct, temp) ought to fix...

	HRRZ B,.GJGEN+GTJBLK	; Foreign generation
	MOVX C,<DECRAD>
	NOUT
	  JFCL			; ??
	MOVX C,<C.NUL>		; Terminate string
	IDPB C,A
GETNXT:

; Echo what ESC produced to user for confirmation/edit

	SKIPN TPAG		; Get anything?
	  JRST GETNXW		; No, ding
	MOVX B,<POINT 7,TPAG>	; Where GTJFN echoed it
	CALL QTECHK		;#5 HACK TO CHECK FOR QUOTED CHARS
	CALL STRSCT		; Echos to X,BP, CMDBF, TTY
	JRST GETNXY		; Ok ready for edit

; GTJFN failed

GETNXV:	HRROI A,[ASCIZ /
? /]
	CALL ERRSUB
GETNXZ:	MOVE C,BREAKC
	CAIE C,C.LF		; If LF
	  JRST GETNXW
	CALL BKCMD		; Remove break from CMDBF
	MOVE A,RDTTYC		; Reprompt
	PSOUT


; Need confirmation or error, ring bell (nothing was defaulted)

GETNXW:	MOVX A,<C.BELL>
	PBOUT


; Let user edit current filespec

GETNXY:	MOVE A,P2		; Original length
	SUB A,X			; Characters used
	POP P,(P)		; Drop flags
	POP P,(P)		; Drop temp pointer
	POP P,P1		; BP at end
	JRST RSKP2		; Need another round



GETNX0:	POP P,(P)		; Drop flags
	POP P,(P)		; Drop temp pointer
	POP P,P1		; BP at end
	HRROI A,[ASCIZ /
? Cannot parse local filespec./]
	CALL ERRSUB
	RET
	SUBTTL	Subroutine GTJLFS

; Get local filespec from user (with optional default string).
; Allow editting until confirmed and return the JFN.
; GTJBLK has default name & type

; A/	GTJFN long form flags & default generation
; P1/	Adr of def,,Adr of noise
;	CALL GTJLFS		Get local filespec
;Ret+1:				XXXCOM on all deleted
;Ret+2:	A/ Flags & JFN
; Uses	GTJBLK, STRTMP, GTJLCL

GTJLFS:	PUSH P,P3
	PUSH P,P2
	PUSH P,P1

	PUSH P,A		; Save flags

GTJLFR:	MOVX P2,<<ESTRTM-STRTMP>*5-1> ; No confirmation required
	MOVX P3,<POINT 7,STRTMP-1,34> ; Comapred to backedup pointer below
	CALL GETSTR		; Get initial string or default
	  JRST XXXCOM		; All deleted
	PUSH P,C

	HRROI A,STRTMP		; String returned
	MOVEI E,GTJBLK
	CALL XGTJFN		; Extract defaults
	  JRST XXXCOM

	POP P,C
	JUMPE C,GTJLFW		; If default, don't ding

GTJLFT:	CAIE C,C.ESC		; If ESC or
	 CAIN C,<"F"&37>	; If Control-F or
	  JRST GTJLFU
	CAIN C,C.LF		; If LF and
	 SKIPN STRTMP		; Have something
	  JRST GTJLGG		; No, ding
GTJLFU:				; Yes, ask GTJFN what it means

				; C/ has break
	MOVE A,BP		; End of user typein
	MOVE D,(P)		; Flags
	MOVEI E,GTJLCL		; GTJFN block
	CALL GTJFNS		; Ask about it
	  JRST GTJLFZ		; GTJFN failed

	MOVE C,BREAKC		; Get break back
	CAIN C,C.LF		; Confirmed?
	  JRST GTJLFX		; Yes, return flags & JFN

	HRRZS A			; JFN, so far
	RLJFN
	  JFCL
	SKIPN TPAG		; Any more specified?
	  JRST GTJLFV		; No, ding

	MOVX B,<POINT 7,TPAG>	; What was added
	CALL QTECHK		;#5 HACK TO CHECK IT FOR QUOTED CHARS
	CALL STRSCT		; Echo it for verification
	JRST GTJLFW

;#5 HACK TO INSERT ^V WHERE REQUIRED
;CALLED WITH:
;	B/ POINTER TO PIECE OF A FILE NAME
;RETURNS:
;	+1 ALWAYS (DOES NOT DESTROY ANY ACS)
QTECHK:
	PUSH P,A		
	PUSH P,B
	PUSH P,C
	PUSH P,D
	SETZB C,D
	MOVEI D,C.QUOTE		;^V
	MOVE A,B		;SOURCE
	PUSH P,A		;SAVE IT AGAIN
	MOVE B,[POINT 7,TEMSTR]		;TEMPORARY PLACE TO WRITE
	SKIPA
QTENXT:	IDPB C,B		;ADD CHARACTER
	ILDB C,A		;GET NEXT ONE
	CAIN C,C.QUOTE		;A QUOTE?
	 JRST  [IDPB C,B
		ILDB C,A
		CAIN C,0
		 JRST QTERET
		JRST QTENXT]
	CAIN C,0
	 JRST QTERET
	CAIN C,"."
	 JRST QTENXT
	CAIN C,"-"
	 JRST QTENXT
	CAIN C,"$"
	 JRST QTENXT
	CAIN C,"_"
	 JRST QTENXT
	CAIGE C,"A"
	 JRST  [CAIL C,"0"
		 CAILE C,"9"
		  IDPB D,B	;QUOTE IT
		JRST QTENXT]	;LOOK AT NEXT ONE
	CAIG C,"Z"
	 JRST QTENXT
	IDPB D,B
	JRST QTENXT

QTERET:	IDPB C,B
	POP P,A
	HRROI B,TEMSTR
	SETZ C,
	SOUT
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET

; GTJFN failed

GTJLFZ:	MOVE C,BREAKC		; GTJFN failed
	CAIN C,C.ESC		; If ESC,
	  JRST GTJLFV		; Ding

	HRROI A,[ASCIZ /
? /]
	CALL ERRSUB		; Report reason
	MOVE A,RDTTYC		; Echo input
	PSOUT
	MOVE C,BREAKC
	CAIN C,C.LF
GTJLGG:	  CALL BKCMD		; LF out of CMDBF

; Ding and try again

GTJLFV:	MOVX A,<C.BELL>		; Ding
	PBOUT

; Back for more input/edit

GTJLFW:	MOVE A,P2		; Used count
	SUB A,X			; for TSINC
	CALL TSINC		; Continue input
	  JRST XXXCOM		; Deleted

	CAME BP,P3		; All gone?
	  JRST GTJLFT		; No, back for more
	CAIN C,C.ESC
	  JRST GTJLFU		; Go interpret ESC
	MOVX A,C.BELL
	PBOUT
	CAIN C,C.LF
	  CALL BKCMD
	CALL LF2ESC
	JRST GTJLFR

; Finally confirmed

GTJLFX:	AOS -4(P)		; Skip return
	POP P,(P)		; Drop flags
	POP P,P1
	POP P,P2
	POP P,P3
	RET
	SUBTTL	Subroutine GTJFNS

; Place break character at end of filespec in STRTMP and get a JFN
; for the result, using default name.type from GTJBLK.  Retrun the
; JFN and the echos of the defaulted characters.

; A/	Pointer to end of string in STRTMP
; C/	Break character (e.g. ESC)
; D/	Flags & default generation #
; E/	Address of temporary "GTJFN BLOCK" to be used
;	Note: if GTJBLK is specified, there is no default name.type
;	CALL GTJFNS
;Ret+1:	  GTJFN failed
;Ret+2:	Ok, JFN in A


GTJFNS:	IDPB C,A		; Put terminator (ESC) into buffer
	MOVX C,<C.NUL>		; for GTJFN
	IDPB C,A		; Terminate string

	CALL TMPRST		; Reset temp file

	CALL GTJINI		; Clear it GTJFN block

	MOVE A,E		; Local GTJFN block
	MOVEM D,.GJGEN(A)	; Flags & default generation
	HRR C,TJFN		; Echos to file (TENEX lacks .GJRTY)
	HRRM C,.GJSRC(A)
	MOVE C,.GJNAM+GTJBLK	; Default name from foreign
	MOVEM C,.GJNAM(A)
	MOVE C,.GJEXT+GTJBLK	; Default type from foreign
	MOVEM C,.GJEXT(A)

	HRROI B,STRTMP		; Expanded user typein followed by ESC
	GTJFN			; See what we get
	  RET			; Failed
	PUSH P,A		; Save JFN & flags

	HRRZ A,TJFN		; Make sure echos are terminated
	SETZ B,
	BOUT

	POP P,A			; Return JFN & flags
	JRST RSKP
	SUBTTL	Subroutine STRSCT

; Copy strin in B/ to BP, CMDIB, and TTY:, adjusting counts accordingly

; X, BP;  CMDIP, CMDIS
; B/	Pointer to ASCIZ string to be copied
;	CALL STRSCT


STRSCT:	PUSH P,B		; Save string pointer

	MOVX A,<.PRIOU>		; Do TTY: first to get correct count
	MOVE C,X		; Remaining space
	MOVX D,<C.NUL>		; Terminator
	SOUT			; Input string to terminal (outputs C.NUL)
	SUB C,X			; Negative (# defaulted characters+1)
	ADDI C,1		; Don't count C.NUL

	JUMPGE C,STRSCX		; Quit if string was empty

	ADDM C,X		; Update remaining space in BP buffer

; Echo defaulted to command buffer

	PUSH P,C		; Save count

	ADDB C,CMDIS		; Space used
	JUMPLE C,XXXCOM		; Whole buffer filled??

	MOVE A,CMDIP
	MOVE B,-1(P)		; String pointer again
	MOVE C,(P)		; Negative count
	SOUT
	MOVEM A,CMDIP
	IDPB D,A		; Terminate string

	POP P,C			; Negative count

; Copy defaulted characters into local filespec input buffer

	MOVE A,BP		; Where user typed ESC
	MOVE B,(P)		; Pointer to string again
	SOUT
	MOVEM A,BP		; New end
	IDPB D,A		; Terminate string
				; BP at end
STRSCX:	POP P,B
	RET
	SUBTTL	Subroutine GTFSTS

; User has specified a foreign path name in FRNPTH
; If TOPS20/TENEX on both ends, get status of remote file
; including file attributes (also completes filename user typed)

; A/	Pointer to filespec
; B/	Default generation #
;	CALL GTFSTS (FRNPTH->$FILST->GTJBLK)
;Ret+1:	  File not found (by foreign STAT command)
;Ret+2:	  Not TOPS20/TENEX or Error
;Ret+3:	Ok

GTFSTS:	PUSH P,P1
	PUSH P,A		; Pointer to filespec
	MOVE P1,B		; Default generation #

	SETZM $FILST		; Reply will go here
	MOVX A,<$FILST,,$FILST+1>
	BLT A,EFILST

	SKIPE FTNXX		; Is foreign host a TOPS20 or TENEX? and
	 SKIPE TENEX		; We are a TOPS20?
	  JRST GTFSTY		; No, skip this

	MOVE A,(P)		; Pointer to string
	MOVEI E,GTJBLK
	CALL XGTJFN		; Split up name
	  JRST GTFSTY		; Lose

; Build foreign filespec, specifying default generation if user didn't specify

	MOVX A,<POINT 7,STRTMP>	; Build filespec here
	SETZ C,			; For SOUTs

	SKIPE B,.GJDEV(E)	; Device specified?
	  SOUT			; Yes
	MOVX D,<":">
	SKIPE B
	  IDPB D,A

	SKIPN B,.GJDIR(E)	; Directory specified?
	  JRST GTFST2		; No
	MOVEI D,"<"
	IDPB D,A		; Yes
	SOUT
	MOVEI D,">"
	IDPB D,A
GTFST2:
	SKIPE B,.GJNAM(E)	; Name specified
	  SOUT
	MOVX D,<".">
	IDPB D,A
	SKIPE B,.GJEXT(E)	; Entension specified
	  SOUT
	MOVX D,<".">		; Get generation prefix correct
	SKIPGE FTNXX
	  MOVX D,<";">
	IDPB D,A

	HRRE C,P1		; Extended default generation #
	MOVE P1,FJFNS-GTJBLK(E)	; Flags for fields & punctuation from user

	HRRZ B,.GJGEN(E)	; Possible user specified generation
	TXNN P1,<FLD(1,JS%GEN)>	; User specify?
	  MOVE B,C		; No, use caller's default
	MOVX C,<DECRAD>		; Generation is decimal
	NOUT			; Number to string
	  JFCL
	MOVX D,<C.NUL>		; End string
	IDPB D,A

; Send STAT command to other end, wait for reply (213 or 212/530/550/etc)

	SETOM F$FLST		; Tell what is happening

	HRROI A,STRTMP
	HRROI B,[ASCIZ /STAT /]	; Request file info
	CALL TELSND

	MOVX D,<-^D<120*2>,,0>	; Timeout
	SKIPA A,[^D500]		; 1/2 second (skip initial wait)
	 DISMS
	 SKIPE F$FLST		; Reply received?
	  AOBJN D,.-2		; Not yet
	JUMPGE D,GTFSTY		; Give up

	SKIPN $FILST		; File missing?
	  JRST [POP P,(P)	; Drop pointer
		POP P,P1
		MOVX B,<GJFX24>	; File not Found
		CALL SETERR
		HRROI A,[ASCIZ /
? Foreign /]
		CALLRET ERRSUB]	; Message, System error, Ret+1
; If we're a TOPS20 and other end is TENEX, convert ; to .

	SKIPL TENEX		; TENEX parses either
	 SKIPL FTNXX
	  JRST GTFST5
				; Local TOPS20 & foreign TENEX
	MOVX A,<POINT 7,$FILST>
GTFST4:	ILDB B,A
	JUMPE B,GTFST5		; Missing??
	CAIE B,";"		; Find semicolon?
	  JRST GTFST4
	MOVX B,<".">		; Yes, replace with . for TOPS20 GTJFN
	DPB B,A
GTFST5:

; Now parse the reply

	HRROI A,$FILST		; Pointer to foreign filespec
	MOVEI E,GTJBLK
	CALL XGTJFN
	  JRST GTFST7

	MOVE A,BREAKC
	CAIN A,C.ESC		; If user ended with ESC and
	 TXNE P1,<FLD(1,JS%GEN)> ; Didn't specify a generation #
	  JRST GTFST6

	MOVX A,<.PRIOU>
	MOVX B,<".">		; Echo generation #
	SKIPGE FTNXX
	  MOVX B,<";">
	BOUT
	HRRZ B,.GJGEN(E)
	MOVX C,<DECRAD>
	NOUT
	  JFCL
GTFST6:

	AOSA -2(P)		; Ret+3 return, All ok
GTFSTY:	  SETZM $FILST		; Ret+2 return, Flag no foreign info
	AOS -2(P)
	POP P,B			; Pointer
	POP P,P1
	RET			; Error


GTFST7:	HRROI A,[ASCIZ /
? Cannot parse /]
	PSOUT
	POP P,A		; Original string
	PSOUT
	POP P,P1
	HRROI A,[ASCIZ / - /]
	CALLRET ERRSUB
	SUBTTL	Subroutine EXPSTR

; Expand user's filespec by replacing stars with corresponding default

; A/	Destination pointer
; B/	Source pointer
; D/	Parse block containing defaults
; E/	Parse block to be used
;	CALL EXPSTR		; Expand stars from source into dest
;Ret+1:	  Error
;Ret+2:	A/ Updated to end

EXPSTR:	PUSH P,P1
	MOVE P1,D		; Deafults
	PUSH P,A		; Destination

	MOVE A,B		; Source
	CALL XGTJFN		; Parse source filespec
	  JRST EXPSTX

	MOVE A,(P)		; String for expanded user filespec
	SETZM (A)		; Empty
	MOVE D,P1		; Default GTJBLK
	MOVE P1,FJFNS-GTJBLK(E)	; Get fields specified
	MOVX T1,<-4,,.GJDEV>	; DEV, DIR, NAM, TYP, (GEN, PRO, ACT)
	ADDI D,.GJDEV		; Point to DEV
	ADDI E,.GJDEV		; Point to DEV
	TXZ F,F.T1		; First four
	SETZ C,			; For SOUTs
EXPSTL:	TLNN P1,700000		; User specify field or punctuation?
	  JRST EXPSTN		; Nothing specified

	MOVX B,<POINT 7,T2>
	HLLZ T2,GJPCT(T1)	; Pre-punctuation for field
	TLNE P1,400000		; Omit if user didn't specify
	  SOUT

	MOVE B,(E)		; User string pointer
	MOVE T2,(B)		; First word of user string
	CAMN T2,[ASCII /*/]	; Specify just star?
	  MOVE B,(D)		; Yes, replace with default
	TLNE P1,100000		; Omit if user didn't specify
	  SOUT

	MOVX B,<POINT 7,T2>
	HRLZ T2,GJPCT(T1)	; Post-punctuation for field
	TLNE P1,200000		; Omit if user didn't specify
	  SOUT
EXPSTN:
	LSH P1,3		; Next JS% triple
	ADDI D,1
	ADDI E,1
	AOBJN T1,EXPSTL		; Back for next text field
; Finished a few, check if up to generation # or done

	TXOE F,F.T1		; Up to generation?
	  JRST EXPSTV		; No, all done

; GEN is encoded

	TLNN P1,700000	 	; User specify generation field?
	  JRST EXPSTS		; Nothing specified

	MOVX B,<".">
	SKIPE TENEX		; Don't really need this as TENEX
	  MOVX B,<";">		; will parse either (at BBN)
	TLNE P1,400000		; Copy period if user specified it
	  BOUT

	HRRE B,.GJGEN-.GJPRO(E)	; User-specified generation #
	CAME B,[-1,,.GJALL]	; If *, replace with foreign generation #
	 JRST EXPSTQ		; No

	MOVE C,BREAKC
	CAIN C,C.LF		; Confirmed?
	  HRRE B,.GJGEN-.GJPRO(D)
EXPSTQ:

	MOVX C,<DECRAD>
	TLNE P1,100000		; Copy if user specified generation #
	 NOUT
	  JFCL
	SETZ C,			; Restore for SOUTs
EXPSTS:
	LSH P1,3
	HRLI T1,-2		; PRO, ACT
	JRST EXPSTL		; Back for rest of the text fields
EXPSTV:
	SUBI D,.GJACT+1-.GJGEN	; Back to beginning of block
	SUBI E,.GJACT+1-.GJGEN	; Back to beginning of block

	AOS -2(P)		; Skip return

EXPSTX:	POP P,(P)		; Error return
	POP P,P1
	RET
	SUBTTL	Subroutine XGTJFN

; A/ Pointer to DEV:<DIR>NAM.TYP.GEN;P;A;T,siz,Tcr,Twr,Trd,Ucr,Uwr
; E/ Address of PARSE block to be used
;	CALL XGTJFN	(TENEX,FTNXX)
;Ret+1:	  Error
;Ret+2:	Parsed ok, fields split up and PARSE block set accordingly

XGTJFN:	CALL GTJINI		; Zero block

	MOVX B,<JS%PAF>
	PUSH P,B		; No fields yet specified

;	SKIPE FTNXX		; Is foreign host a TOPS20 or TENEX? and
;	 SKIPE TENEX		; We are a TOPS20?
;	  JRST XGTJFX		; No, skip this

	SETOM GTJBLK-GTJBLK(E)	; No generation specified

	TLC A,-1		; Change HRROI type
	TLCN A,-1		; Pointer into one that
	  HRLI A,(POINT 7)	; ILDB can use

; Setup to gather the NAME field

XGTNLP:	SETZM GTJNAM-GTJBLK(E)	; Clear name string
	HRLI B,GTJNAM-GTJBLK(E)	; in case last field was DEV
	HRRI B,GTJNAM-GTJBLK+1(E)
	BLT B,GTJNAM-GTJBLK+LGJNAM-1(E)
	HRRI B,GTJNAM-GTJBLK(E)
	HRLI B,(POINT 7)
	MOVX D,<FLD(1,JS%NAM)>	; Field without punctuation
	TXZA F,F.T1		; No dots seen
XGTCLP:	  SETZ D,		; No field nor punctuation
XGTDLP:				; D/ has flags for field or punctuation
	JSP T2,XGTGCH		; Get a character (to XGTJFV on EOL)
	CAIN C,":"		; End of DEV:?
	  JRST XGTDEV		; Yes
	CAIN C,"<"		; Beginning of directory?
	  JRST XGTDIR		; Yes
	CAIN C,"."		; Have terminating . ?
	  JRST XGTTOG		; Yes
	CAIN C,";"		; Beignning of (TENEX generation or)
	  JRST XGTGOA		; attributes? Yes
	CAIN C,","		; Size, etc?
	  JRST XGTSIZ		; Yes
	IORM D,(P)		; Got at least one character in field
	IDPB C,B		; Save text character
	JRST XGTCLP		; Loop back for next character

; : ends a device name, copy from NAM string to DEV string

XGTDEV:	PUSH P,A		; Save input pointer
	HRROI A,GTJDEV-GTJBLK(E)
	HRROI B,GTJNAM-GTJBLK(E)
	MOVX C,<LGJDEV*5-1>
	MOVX D,<C.NUL>		; Copy through terminator
	SOUT			; Copy from name to dev string
	POP P,A
	MOVX D,<GJFX5>		; Field length
	JUMPLE C,XGTJFY		; Error
	MOVE C,(P)
	TXO C,<FLD(3,JS%DEV)>	; Post-punctuation & specified
	TXZ C,JS%NAM		; It isn't a name
	MOVEM C,(P)
	JRST XGTNLP		; Back for name

; Directory string is surrounded by <...>

XGTDIR:	MOVX D,<GJFX7>		; Directory field in invalid position
	SKIPE GTJNAM-GTJBLK(E)	; Trash before bracket?
	  JRST XGTJFY		; Yes, error
	HRROI B,GTJDIR-GTJBLK(E)
	MOVX C,<LGJDIR*5-1>
	MOVEI D,">"		; Read through terminating bracket
	SIN
	MOVX D,<GJFX5>		; Length exceeds 39
	JUMPLE C,XGTJFY
	SETZ C,			; End directory name
	DPB C,B			; and wipe out copied bracket
	MOVX C,<FLD(7,JS%DIR)>	; Pre-, post-punctuation & specified
	IORM C,(P)
;	MOVX C,<JS%NAM>
;	ANDCAM C,(P)
	JRST XGTNLP		; Back for name

; Period terminates NAM and (TOPS20) EXT

XGTTOG:	TXOE F,F.T1		; First or second?
	  JRST XGTGOA		; Second begins generation #
	MOVX C,<FLD(2,JS%NAM)>	; Post-punctuation
	IORM C,(P)
	HRRI B,GTJEXT-GTJBLK(E)
	HRLI B,(POINT 7)	; Begin extension
	MOVX D,<FLD(1,JS%TYP)>
	JRST XGTDLP		; Any character is in type

; Process generation # (second . or first ;)

XGTGOA:	MOVEM A,GTJGEN-GTJBLK(E) ;Where ./; of generation # should be

	MOVX D,<FLD(4,JS%GEN)>	; Just pre-punctuation
	IORM D,(P)		; Incase XGTGCH exits
	MOVE D,A		; Peek ahead
	JSP T2,XGTGCH
	EXCH D,A		; Old pointer back
	MOVX D,<FLD(4,JS%GEN)>	; Remove pre-punctuation which
	ANDCAM D,(P)		; might be for some other field

 jfcl;	MOVEM A,GTJGEN-GTJBLK(E) ;Where # of generation # should begin

; Look for numeric generation #

XGTGEN:	MOVX D,<FLD(5,JS%GEN)>	; Pre-punctuation & digit/sign
	MOVX C,<DECRAD>		; Get generation #
	NIN
	  JRST XGTGES		; Maybe star
XGTGEX:	MOVEM B,GTJBLK-GTJBLK(E) ; Save generation number
	IORM D,(P)

	LDB C,A			; Break character
	JSP T2,XGTGCI		; Make sure valid
	JRST XGTGEU		; Go check it



XGTGES:	MOVEI T1,XGTCOF		; If *, have to get next punctuation
	MOVX D,<FLD(5,JS%GEN)>	; Pre-punctuation & character
	MOVX B,<.GJALL>
	LDB C,A			; NIN didn't like this
	CAIN C,"*"		; Star?
	  JRST XGTGEV		; Yes

	MOVX D,<FLD(4,JS%GEN)>	; Just pre-punctuation
	MOVX B,<.GJDEF>		; Either .; or ;; for
	CAIE C,";"		; Generation #
	  JRST XGTATT		; May be ;P ;A or ;T
XGTGEU:	MOVEI T1,XGTAOS		; If missing, have next punctuation

XGTGEV:	MOVEM B,GTJBLK-GTJBLK(E) ; Save generation number
	IORM D,(P)		; And flags

	JSP T1,(T1)		; Look for ; or , (may already have it in C)
	MOVX D,<GJFX15>		; Invalid confirmation
	JRST XGTJFY		; Error
	SUBTTL	Process ;P  ;A  ;T fields

XGTATI:	JSP T2,XGTGCH		; Get keyletter after ;
XGTATT:	TRZ C,40		; Upper case (if letter)
	CAIN C,"T"
	  JRST XGTTMP
	CAIN C,"A"
	  JRST XGTACT
	CAIN C,"P"
	  JRST XGTPRO
	MOVX D,<GJFX40>		; Invalid attribute
	JRST XGTJFY		; Error

; ;P
XGTPRO:	HRRI B,GTJPRO-GTJBLK(E)
	HRLI B,(POINT 7)
	MOVX D,<LGJPRO*5-1>
	MOVX C,<FLD(4,JS%PRO)>
	IORM C,(P)
XGTPLP:	JSP T1,XGTCOF		; Get character & return if no ; or ,
	IDPB C,B
	MOVX C,<FLD(5,JS%PRO)>
	IORM C,(P)
	SOJG D,XGTPLP
	MOVX D,<GJFX5>		; Field exceeds 39 characters
	JRST XGTJFY		; error

; ;A
XGTACT:	HRRI B,GTJACT-GTJBLK(E)
	HRLI B,(POINT 7)
	MOVX D,<LGJACT*5-1>	; Terminator may be ; or ,
	MOVX C,<FLD(4,JS%ACT)>
	IORM C,(P)
XGTALP:	JSP T1,XGTCOF		; Get character & return if no ; or ,
	IDPB C,B
	MOVX C,<FLD(5,JS%ACT)>
	IORM C,(P)
	SOJG D,XGTALP
	MOVX D,<GJFX5>		; Field exceeds 39 characters
	JRST XGTJFY

; ;T
XGTTMP:	SETOM FILTMP-GTJBLK(E)	; Remember it
	MOVX C,<JS%TMP>
	IORM C,(P)
	JSP T1,XGTCOF
	MOVX D,<GJFX15>		; Invalid confirmation
	JRST XGTJFY

XGTCOF:	JSP T2,XGTGCH		; Get next character or skip to end
XGTAOS:	CAIN C,";"
	  JRST XGTATI		; Go decide which attribute
	CAIN C,","
	  JRST XGTSIZ		; Go process size, dates, user names
	JRST (T1)		; Return from XGTCOF
	SUBTTL	Process Size, Dates, and User Name fields

XGTSIZ:	MOVX C,<DECRAD>		; Decimal size field
	NIN			; File size
	  SETOB B,C
	MOVEM B,FILSIZ-GTJBLK(E)
	MOVX D,<JS%SIZ>
	SKIPL C
	  IORM D,(P)

	JSP T2,XGTCMA		; Want comma break - Ok, XGTJFV, Error ret
	SETZ B,			; Time created
	MOVX D,<JS%CDR>
	IDTIM
	  SETZB B,D
	MOVEM B,FILTCR-GTJBLK(E)
	IORM D,(P)
	MOVX D,<JS%LWR>

	JSP T2,XGTCMA		; Want comma break - Ok, XGTJFV, Error ret
	SETZ B,			; Time last written
	IDTIM
	  SETZB B,D
	MOVEM B,FILTWR-GTJBLK(E)
	IORM D,(P)

	JSP T2,XGTCMA		; Want comma break - Ok, XGTJFV, Error ret
	SETZ B,			; Time last referenced
	MOVX D,<JS%LRD>
	IDTIM
	  SETZB B,D
	MOVEM B,FILTRD-GTJBLK(E)
	IORM D,(P)

	JSP T2,XGTCMA		; Want comma break - Ok, XGTJFV, Error ret
	HRROI B,FILUCR-GTJBLK(E)
	MOVX C,<LFLUCR*5-1>	; User who created
	MOVX D,<",">
	SIN
	MOVX D,C.NUL		; Comma isn't part of name
	DPB D,B
	MOVX D,<GJFX5>		; Length exceeds 39
 JFCL;	JUMPLE C,XGTJFY

	JSP T2,XGTCMA		; Want comma break - Ok, XGTJFV, Error ret
	HRROI B,FILUWR-GTJBLK(E)
	MOVX C,<LFLUWR*5-1>	; User who last wrote
	MOVX D,<";">		; Allow extra??
	SIN
	MOVX D,C.NUL		; Comma isn't part of name
	DPB D,B
	MOVX D,<GJFX5>		; Length exceeds 39
 JFCL;	JUMPLE C,XGTJFY
	SUBTTL	Fill in GTJBLK Pointers

XGTJFV:				; Done
	MOVE C,(P)		; JFNS argument
	MOVEM C,FJFNS-GTJBLK(E)	; Into data block

; Generation is different

	MOVX D,<GJ%FOU+GJ%FLG+GJ%XTN+.GJDEF>
	TXNN C,<FLD(1,JS%GEN)>	; Was generation specified?
	  MOVEM D,.GJGEN(E)	; No, use default
	HLLM D,.GJGEN(E)	; Set flags

; Do DEV, DIR, NAM, TYP, PRO, ACT

	MOVEM E,(P)		; Save GTJBLK address
	MOVX D,<.GJDEV-.GJACT-1,,.GJDEV>
	ADDI E,.GJDEV
XGTJFW:	MOVE B,GJIMG(D)		; Offset to text
	ADD B,E			; Address of text
	HRLI B,(POINT 7)	; Pointer to text
	SKIPE A,(B)		; Anything specified?
	  MOVEM B,(E)		; Yes, set pointer in GTJBLK
	AOS E
	AOBJN D,XGTJFW
	MOVE E,(P)

XGTJFX:	AOS -1(P)		; All ok return
XGTJFZ:	POP P,(P)		; Error return (drop flags)
	RET

XGTJFY:	MOVE B,D		; Error code
	CALL SETERR		; For this process
	JRST XGTJFZ		; Leave

; Get a character
;	JSP T2,XGTGCH

XGTGCH:	ILDB C,A		; Get next character
XGTGCI:	JUMPE C,XGTJFV		; NUL - Ends everything
	CAIE C,C.CR		; or CR
	 CAIN C,C.LF		; or LF
	  JRST XGTJFV
	JRST (T2)		; Return with character

; Check for comma break
;	JSP T2,XGTCMA

XGTCMA:	LDB C,A			; Actual break
	JUMPE C,XGTJFV		; NUL - Ends everything
	CAIE C,","		; Is it what's wanted?
	  JRST XGTJFY		; Error
	JRST (T2)		; Proceed
	SUBTTL	GTJFN block routines

;  E/	Address of GTJFN block of interest
;	CALL GTJINI

GTJINI:	SETZM GTJBLK-GTJBLK(E)	; Zero GTJFN block
	HRLI B,(E)
	HRRI B,1(E)
	BLT B,GTJEND-GTJBLK(E)	; And string storage

	MOVX B,<.NULIO,,.NULIO>
	MOVEM B,.GJSRC(E)
	MOVX B,<GTJBKE-.GJF2-GTJBLK>	
	MOVEM B,.GJF2(E)

	SETZM FJFNS-GTJBLK(E)	; Nothing seen
	RET

; JFNS argument for correcponding GTJBLK position
JSFLG:	EXP JS%GEN,0,JS%DEV,JS%DIR,JS%NAM,JS%TYP,JS%PRO,JS%ACT,0,0

; GTJBLK text offset for corresponding GTJBLK position

GJIMG:	EXP -1,-1
	EXP GTJDEV-GTJBLK-.GJDEV
	EXP GTJDIR-GTJBLK-.GJDIR
	EXP GTJNAM-GTJBLK-.GJNAM
	EXP GTJEXT-GTJBLK-.GJEXT
	EXP GTJPRO-GTJBLK-.GJPRO
	EXP GTJACT-GTJBLK-.GJACT

GJPCT:	BYTE (7)"."(11)0(7)0(11)0	; Generation in "wrong" place
	EXP 0
	BYTE (7)0(11)0(7)":"(11)0	; HL is pre-field punctuation(s)
	BYTE (7)"<"(11)0(7)">"(11)0	; RH is post-field punctuation
	BYTE (7)0(11)0(7)"."(11)0
	BYTE (7)0(11)0(7)0(11)0

	BYTE (7)";","P"(4)0(7)0(11)0
	BYTE (7)";","A"(4)0(7)0(11)0
	SUBTTL	Subroutines for temp file

;	CALL TMPRST	; Get temp file if necessary & zero it

TMPRST:	PUSH P,C
	PUSH P,B
	PUSH P,A

; If haven't opened temp file, do so now

	SKIPLE TJFN
	  JRST TMPRSZ		; Already open

	MOVX A,<GJ%FOU+GJ%TMP+GJ%DEL+GJ%SHT>
	HRROI B,[ASCIZ /-FTP-ECHO-.TMP;P770000;T/]
	GTJFN
	  JRST TMPRSY
	MOVEM A,TJFN
	HRRZS A

	MOVX B,<FLD(7,OF%BSZ)+OF%RD+OF%WR>
	OPENF
	  CALL TMPLOS

	HRLZ A,TJFN		; From temp file
	HRRI A,0		; Map in first page
	HRLZI B,.FHSLF
	HRRI B,<TPAG/1000>	; To TPAG
	MOVX C,<PM%RD+PM%WR+PM%PLD>
	PMAP
	ERCAL TMPLOS
TMPRSZ:
	SETZM TPAG		; Zero the temp page
	MOVX A,<TPAG,,TPAG+1>
	BLT A,TPAG+777

	HRRZ A,TJFN		; Reset file pointer
	SETZ B,			; to beginning
	SFPTR
	  JFCL

	POP P,A
	POP P,B
	POP P,C
	RET

TMPLOS:	CALL TMPREL		; Clean up
	CALLRET BOMB

TMPRSY:	HRROI A,[ASCIZ /
? Can't open scratch file -FTP-ECHO-.TMP;T
/]
	CALL ERRSUB		; Tell why

; Release the temp file

TMPREL:	SKIPG A,TJFN		; JFN assigned?
	  RET			; No, all done

	MOVX A,<-1>
	MOVX B,<.FHSLF,,<TPAG/1000>>
	MOVX C,<0>		; Unmap the page
	PMAP
	ERJMP .+1

	CLOSK (TJFN)		; Make sure file is closed

	HRRZ A,TJFN
	TXO A,DF%EXP		; So it can be deleted
	DELF
	  JFCL
	SETOM TJFN

	RET
	SUBTTL	Subroutines GETSTR, GETSTF

; Set	P1/ Address of default,,address of noise string
;	P2/ String buffer count + 1B0 if confirmation required
;	P3/ Pointer to string buffer
;	CALL GETSTR		; Gets a string using TSIN
;Ret+1:	  Deleted		; Reject empty strings (ESC, LF)
;Ret+2:	Have a string		; Pre NOISE & on LF
;	C/ Break
;	X & BP set after string
;
; Alternate entry GETSTF for foreign file names, which for ITS
;  sytems means allow space character within the name.

GETSTF:	MOVE A,FHSTYP		; Get string for foreign file name
	CAIN A,.HSITS		; Which for ITS means allow spaces 
	TXZA F,F.SPTC		;  within file names.
GETSTR:	TXO F,F.SPTC		; Space is normally a terminator
	MOVE C,BREAKC		; Get last break
	CAIE C,C.ESC		; Last field end with ESC?
	  JRST GETSTS		; No, skip noise
GETSTN:	HRRO A,P1		; Noise string
GETSTO:	PSOUT			; Print noise
GETSTS:	CALL SBST		; Discard last break, spaces & tabs

	HRRZ X,P2		; Buffer length
	MOVE BP,P3		; Buffer pointer
	SETZM (P3)		; Zero first word
GETSTL:	HRRZ A,P2		; Initial count minus
	SUB A,X			; Remaining is space used
	CALL TSINC
	  RET			; Line delete

	MOVE D,P3		; Initial pointer
	ILDB B,D		; Get anything?
	TXNE P2,<1B0>		; Confirmation not required or
	 CAIN C,C.LF		; Required and have it?
	  JUMPN B,RSKP		; Yes, return if have something

	CAIN C,C.ESC		; ESC typed and
	 TLNN P1,-1		; Have default string?
	  JRST GETSTV		; No
	SKIPE (P3)		; Have something in buffer?
	  JRST GETSTV		; Yes, cannot complete it

	HLRO B,P1		; Default string to
	CALL STRSCT		; BP, CMDIP, TTY:
	MOVX C,C.NUL		; Terminator changed
	TXNN P2,<1B0>		; Confirmation required?
	  JRST RSKP		; No, return with default
	JRST GETSTL		; Yes, back for confirmation

GETSTV:	MOVX A,<C.BELL>		; No, lose
	PBOUT			; Ding

	CAIN C,C.ESC		; ESC?
	  JRST GETSTL		; Yes, try again (ESC not in command buffer)
	CALL BKCMD		; Remove break from command buffer
	CAIE C,C.LF		; LF?
	  CALL PCRLF		; No, Echo CR LF
	JRST GETSTN
	SUBTTL	Subroutine TSIN, TSINS, TSINC

; Read a string up to ESC, SPACE, LF (or, if TSINS, include SPACE)

; Set	X/   Maximum string length
;	BP/  Pointer to string area
;	CALL TSIN (TSINS if SPACE is a data character, not a break)
;Ret+1	  Line too long, Line deleted
;Ret+2	Ok, BREAKC & LASTCC set, X & BP updated (points before C.NUL)

; TSINC continues previous TSIN(S)
; A/	# characters returned by prior call(s)
; X/	String length returned last time
; BP/	Pointer to string buffer returned last time
;	CALL TSINC
;Ret+1	  Line too long, Line deleted
;Ret+2	Ok, BREAKC & LASTCC set, X & BP updated (points before C.NUL)


TSIN:	TXOA F,F.SPTC		; Space is a term char
TSINS:	  TXZ F,F.SPTC		; This entry, its a data character
	MOVE C,CMDIP		; Record start of
	MOVEM C,WRDBPS		; String address
	SETZ A,			; No prior call
TSINC:	MOVEM X,TSINIX		; Save initial count
	ADDM A,TSINIX
	SETZM WORDXP		; Make sure ESC does nothing wierd
	TXZ F,F.QUOC		; Not quoting

TSINL:	CALL GCH		; Get a character
	  JFCL			; Break
	TXZE F,F.QUOC		; Quote char last?
	  JRST TSIN3		; Yes. No checks.
	CAIE C,C.QUOTE		; Quote char?
	  JRST TSIN2		; No

; Read QUOTE character

				;#5 Read it an keep it
	TXO F,F.QUOC		;#5 Yes. Note,
	IDPB C,BP		;#5 Put away the char
	SOJG X,TSINL		;#5 End test
	RET			;#5 Failed length end test

; Non QUOTE, Unquoted character

TSIN2:	TXNE F,F.SPTC		; What is a space?
	 CAIE C,C.SPACE		; Term. And is this a space?
	  SKIPA			; Not a break
	   JRST TSINX		; Break. Do so.

	CAIE C,C.ESC		; Escape?
	 CAIN C,C.LF		; One of the end-of-lines?
	  JRST TSINX		; Control. Break.

; Look for editting characters

	CAMN C,CDELLN		; Delete line?
	  RET			; Yes. Quit non-skip
	CAMN C,CDELCH		; Character delete?
	  JRST TSINA		; Yes. Delete a char.
	CAMN C,CDELWD		; Word delete?
	  JRST TSINDW		; Yes. Delete word.

; Move data character to string (ESC not in command buffer)

TSIN3:	IDPB C,BP		; Put away the char
	SOJG X,TSINL		; End test
	RET			; Failed length end test


; Got a terminator

TSINX:	MOVEM C,LASTCC		; Stash the character
	MOVEM C,BREAKC
	MOVX A,<C.NUL>		; And terminate string with a NULL
	MOVE B,BP
	IDPB A,B
	JRST RSKP		; Good return


; Word delete

TSINDW:	SKIPE TENEX	; cwl?
	  CALL BKCMD		; Remove word delete character

	CAML X,TSINIX		; At beginning?
	  JRST DING		; Yes

TSINWL:	CALL TSINBK		; Back a character

	LDB C,BP		; Last character
	CAMGE X,TSINIX		; At beginning?
	 CALL ALNUM		; Or is it a break?
	  SKIPA			; Yes, stop backing up
	   JRST TSINWL		; No, go delete another character

 JFCL;	CALL PCRLF
	MOVE A,RDTTYC
	HRROI A,[ASCIZ /_
/]
	PSOUT			; Retype
	JRST TSINL		; Right back to top.

; Character delete

TSINA:	CAML X,TSINIX		; X already at max?
	  JRST DING		; Yes
	MOVX A,<"\">		; Prefix deleted char
	PBOUT
	LDB A,BP		; Get the discard character
	TXNN F,F.NOEC		; Unless password,
	  PBOUT			; Type it
	CALL TSINBK		; Back a char
	JRST TSINL		; Get another char


; Line delete

TSINDL:	CAML X,TSINIX		; Back up to beginning of string
	  JRST TSINL		; There
	CALL TSINBK
	JRST TSINDL


; Ring bell

DING:	MOVX A,<C.BELL>		; Ring the bell & read next character
	PBOUT
	JRST TSINL


; Routine to backup input pointer & count

TSINBK:	MOVX C,<C.NUL>		; Increment X & ADJBP BP,-1
	DPB C,BP
	ADD BP,[7B5]
	SKIPGE BP
	  SUB BP,[430000,,1]
	AOS X
	CALLRET BKCMD		; Also backup command buffer
	SUBTTL	Subroutine GETWRD

; Get word routine. Looks up commands and args, collects text.
; Set:	WORDXP/ -N,,Table of <addresses of ASCIZ,,xxx>, or 0 if none
;	CALL GETWRD
;BREAKC/ set to break character
;Ret+1:	  Fail return if RUBOUT typed (no error message given),
;	  if not a unique word and WORDXP was non-0 (error msg given)
;Ret+2:	Good return with RH X/ Offset into word pointers (WORDXP or,
;		if F.HCM1, HOSTN)


;GETWLC:TXZA F,F.LCUC		; Entry for LC left alone
GETWRD:	  TXO F,F.LCUC		; Entry for UC = LC
GETW01:	SETZM WORDBF		; Clear word buffer
	MOVX A,<WORDBF,,WORDBF+1>
	BLT A,EWORDB

	MOVE A,CMDIP		; Current position in input line
	MOVEM A,WRDBPS		; Starts word and is

	MOVE A,WRDBP0		; Initial byte ptr to it
GETW11:	MOVEM A,WORDBP		; Current end
 JFCL;	MOVEM A,CMDIP
	MOVX C,<C.NUL>
	IDPB C,A
	TXZ F,F.HCM1		; This word is not a host name (yet)

; Accumulate word

GETWL1:	CALL GCH		; Get a character
	  JRST GETWBK		; Break char
	SETZM F$STAR		; Not at left margin any more
	TXNN F,F.LCUC		; Convert LC to UC?
	  JRST GETW02		; No
	CAIL C,"a"		; Yes. LC?
	 CAILE C,"z"
	  SKIPA			; No
	   TRZ C,"a"-"A"	; Yes. Make UC
GETW02:	IDPB C,WORDBP		; Add to string storage
	JRST GETWL1		; And read some more


; Terminator was read

GETWBK:	SETZM F$STAR		; Not at left margin now
	MOVEM C,BREAKC		; Save the break
	CAMN C,CDELCH		; Character delete?
	  JRST GTWDCH		; Yes, delete char.
	CAMN C,CDELWDS		; Word delete?
	  JRST GTWDW		; Yes, delete word
	CAMN C,CDELLN		; Line delete?
	  JRST XXXCOM		; Yes, flush command

; If keyword table given, apply recognition

;GETWEW:
;	CALL BKCMD		; Remove break from buffer
	CALL RECOG		; Assume term ok. Recognize the word.
	  RET			; No input before ESC
	  JRST GTWEWD		; No match or not a unique word. Ding.
				; Match or no table
	SETZM WORDXP		; Force next caller to declare his table
	JRST RSKP		; Good. Return it. X/ index of match or 0,
				;  And break char in BREAKC

; No match or not unique

GTWEWD:	MOVE A,BREAKC		; Was recognition requested?
	CAIE A,C.ESC
	  JRST GTWEW1		; No.
	TXNE F,F.AMB		; Ambiguous or unknown?
	  JRST GTWDNG		; Ambig. Ding and read on.
GTWEW1:	HRROI A,[ASCIZ /? Invalid keyword /]	; Unknown. Complain.
	PSOUT
	RET			; Fail return
; Could be JRST GETW01 but for .HOST second entry... fix?


; Word delete

GTWDW:	SKIPE TENEX	; cwl?
	  CALL BKCMD		; Remove word delete character

	MOVE A,WORDBP		; At start of word?
	CAMN A,WRDBP0
	  JRST GTWDNG		; Yes, ding

GTWDWL:	CALL BKWRDP		; Back a character

	LDB C,WORDBP		; Last character
	MOVE A,WORDBP		; At start of word?
	CAME A,WRDBP0
	 CALL ALNUM		; Or is it a break?
	  SKIPA			; Yes, stop backing up
	   JRST GTWDWL		; No, go delete another character

 JFCL;	CALL PCRLF
	MOVE A,RDTTYC
	HRROI A,[ASCIZ /_
/]
	PSOUT			; Retype
	JRST GETWL1		; Right back to top.

; Character delete

GTWDCH:	CALL GTWDC1		; Delete one character
	  JRST GTWDNG		; Back to start, ding
	JRST GETWL1		; Get another character


GTWDC1:	MOVE A,WORDBP		; At start of word?
	CAMN A,WRDBP0
	  RET			; Yes. No more to delete
	AOS (P)			; No, will skip return
	MOVX A,<"\">		; Do some rubbing out
	PBOUT			; Flag deleted char
	LDB A,WORDBP		; Type it out
	PBOUT
	SKIPA TENEX	; cwl?
	  CALL BKCMD
 JFCL;	CALLRET BKWRDP		; Backup word pointer


BKWRDP:	MOVE A,WORDBP		; At start of word?
	CAMN A,WRDBP0
	  RET			; Yes
	MOVX A,<C.NUL>		; Remove it from buffer
	DPB A,WORDBP
	MOVX A,<070000,,0>	; Back up pointer
	ADD A,WORDBP
	SKIPGE A
	  SUB A,[430000,,1]
	MOVEM A,WORDBP		; New pointer
	CALLRET BKCMD		; Backup input buffer too

; Ding the bell - no match or ambiguous

GTWDNG:	MOVX A,<C.BELL>		; Bell
	PBOUT
	JRST GETWL1		; Read more
	SUBTTL	Subroutines OCTIN, DECIN

; Skip spaces & tabs then read an octal number (already past last break)

;	CALL OCTIN
; Get	C/ Break character
;Ret+1:	  No number or line delete
;Ret+2:	A/ Octal number

OCTIN:	TXZ F,F.CHOK		; No ok chars seen
	SETZM WORDXP		; In case of ESC.
	CALL SST		; Skip to non-blank.
	SETZ A,			; Clear answer
OCTINL:	CALL GCH		; Get a character
	  JFCL			; Break
	CAIL C,"0"		; Octal digit?
	 CAILE C,"7"
	  JRST OCTINX		; No
	TXO F,F.CHOK		; Yes. Seen at least one.
	LSH A,3 		; Accumulate octal number
	ADDI A,-"0"(C)
	JRST OCTINL

; Common exit

OCTINX:	MOVEM C,BREAKC		; Save break character
	CAMN C,CDELLN		; Rubout?
	  RET			; Yes. Fail return
	TXZE F,F.CHOK		; Ok char seen?
	  AOS 0(P)		; Yes.
	RET			; Return


; Skip spaces & tabs then read an decimal number (already past last break)

;	CALL DECIN
;Ret+1:	  No number or line delete
;Ret+2:	A/ Decimal number

DECIN:	CALL SST		; Skip spaces & tabs
	SETZM WORDXP		; In case of ESC
	TXZ F,F.CHOK		; No chars seen yet that are digits
	SETZ A,			; Start number at 0
DECINL:	CALL GCH		; Read a char
	  JFCL			; Break
	CAIL C,"0"		; Digit?
	 CAILE C,"9"
	  JRST OCTINX		; No. Same exit as octal.
	TXO F,F.CHOK		; Ok, seen a digit
	IMULI A,DECRAD		; Accumulate decimal number
	ADDI A,-"0"(C)
	JRST DECINL		; Get next digit or break
	SUBTTL	Subroutines KEYLTR


; Set	X/	-N,,Address+1 of table of <[ASCIZ /x/],,routine>
;	CALL KEYLTR	; Only used by: MODE, STRU, TYPE, FORM
;Ret+1:	  Line delete, not in table, not terminated
;Ret+2:	  Found, Terminated by SPACE
;Ret+3:	Found, Terminated by ESC or LF
;	B/ routine
;	D/ index (XXXX.X)



KEYLTR:	CALL SEST		; Skip possible ESC and spaces & tabs
	CALL GCH		; Now read the character
	  JFCL			; Break. Symbol const or not, who cares.
	CAMN C,CDELLN		; Line delete?
	  RET			; Rubout return

	CAIL C,140		; Lower case?
	  TRZ C,40		; Make upper
	SETZ D,			; Index answer to 0
	CAIN C,C.ESC		; Want default?
	  JRST KEYLT0		; Yes

	LSH C,^D<36-7>		; Make ASCIZ
KEYLTL:	HLRZ B,(X)		; Get good answer
	CAMN C,(B)		; Match?
	  JRST KEYLT1		; Yes.
	ADDI D,1		; No. Try next one
	AOBJN X,KEYLTL
	RET			; Not there.

; ESC typed, echo default (first) possibility

KEYLT0:	HLRO A,(X)		; First (default) letter
	PSOUT			; Echo it
	SKIPA			; ESC is EOL

; Match found

KEYLT1:	 CALL GCH		; And an EOL, hopefully.
	  JFCL			; Break. Sym or term
	MOVEM C,BREAKC
	HRRZ B,(X)		; Dispatch address is an answer too

	CAIE C,C.LF		; Terminated by ESC or LF
	 CAIN C,C.ESC
	  JRST RSKP2		; Yes. Double skip

	CAIN C,C.SPACE		; Terminated by SPACE?
	  JRST RSKP		; Yes. Single skip
	RET			; Not properly terminated
	SUBTTL	Subroutines GTFNDF, S(B,E)ST

; Set	B/  Pointer to default name
;	CALL GTFNDF
;Ret+1:	Always, A & B set for GTJFN


GTFNDF:	PBIN
	CAMN A,CDELLN		; Delete line?
	  JRST XXXCOM		; Yes.
	CAIE A,C.ESC		; Default?
	  JRST GTFND2		; No

	MOVE A,B		; Yes, echo it
	PSOUT
	HRROI A,CRLFM		; And end of line
	PSOUT
	MOVX A,<GJ%FOU+GJ%SHT>	; Feed in same string
	JRST GTFND3		; Ok.

GTFND2:	MOVX A,<.PRIIN>		; No. Back up and get JFN
	BKJFN
	  CALL BOMB		; Can't fail?
	MOVX A,<GJ%FOU+GJ%CFM+GJ%FNS+GJ%SHT>
	MOVX B,<.PRIIN,,.PRIOU>
GTFND3:
	RET			; Ready for GJTFN


;	Discard last break unless it was an LF and skip spaces and tabs

;	CALL SST	Discard spaces & tabs
; or	CALL SEST	Discard previous ESC and any spaces & tabs
; or	CALL SBST	Discard previous break and any spaces & tabs
;Ret+1	Always


SEST:	MOVE C,LASTCC		; Check last command char
	CAIN C,C.ESC		; Escape? If so GCH next character
SBST:	 CALL GCH		; Get next character
	  JFCL			; Break or last wasn't an ESC
SST:	MOVE C,LASTCC		; Get the char last typed in
	CAIE C,C.SPACE		; Space?
	 CAIN C,C.TAB		; Tab?
	  JRST SBST		; Yes. Discard
	JUMPE C,SBST		; Also NULLs in initialization.
	MOVEM C,GCHSAV		; No. Save so GCH sees it next.
	RET			; Return
	SUBTTL	Subroutines GCH, ALNUM(Q)

; If WORDXP = 0 [no RECOG], preserves A, B, D

; 	CALL GCH		; Get input character
;Ret+1	  Break character
;Ret+2	Non-break character
; Get	C/ character


GCH:	SKIPE C,GCHSAV		; Any saved character?
	  JRST GCH01		; Yes. Return it.

	CALL TYI		; Get a typed in character
	CAIN C,C.ESC		; Escape?
	  JRST GCHESC		; Yes.

; Note that TYI has purged C.NUL, C.CR, Translated C.FF, EOL, & edit char

	SKIPA			; Return the character
GCH01:	  SETZM GCHSAV		; No longer a saved char
	MOVEM C,LASTCC		; Save character

; Fall into ALNUMQ


; C/	Character
;	CALL ALNUM(Q)
;Ret+1:	  Break
;Ret+2:	0-9,A-Z,a-z (,-,.)


ALNUMQ:	CAIE C,"."
	 CAIN C,"-"
	  JRST RSKP		; Legal punctuation - non-break
ALNUM:	CAIL C,"a"		; Return char, skip unless brk.
	 CAILE C,"z"
	  SKIPA
	   JRST RSKP		; Lower case letter
	CAIL C,"A"
	 CAILE C,"Z"
	  SKIPA
	   JRST RSKP		; Upper case letter
	CAIL C,"0"
	 CAILE C,"9"
	  SKIPA
	   JRST RSKP		; Digit
	RET			; Break character

; Just read an ESC (Not a saved character)

GCHESC:	MOVEM C,GCHSAV		; Return the ESC later
	CALL BKCMD		; Remove from buffer
	SKIPE WORDXP		; If no table, return ESC now
	 CALL RECOG		; See if a word matches
	  JRST GCH		; No input before ESC.  Return ESC
	  JRST GCH02		; No match/ambiguous
				; Match/(no table)

; Copy recognized characters into word buffer and echo to terminal

	MOVE C,WRDBP0		; Start of word typed in
;	MOVE C,WRDBPS		; Start of word typed in
	MOVX B,<"?">		; Make sure B non-zero

	MOVE D,RECX		; The matching index
	ADD D,WORDXP		; Pointer to words
	HLRZ D,(D)		; The text address
	HLL D,[POINT 7,0]	; Start of good word

GCHESL:	ILDB A,D		; Keyword character
	JUMPE A,GCHES2		; Quit at end of ASCIZ keyword
	SKIPE B 		; Run out of typein?
	  ILDB B,C		; No. Get another (matching) user char
	JUMPN B,GCHES1		; If not to end, don't fake typein

	PBOUT			; Output the keyword char
	IDPB A,WORDBP		; And put it in typein buffer
	SOSG CMDIS		; Less free space (CMDIC should be 0)
	  JRST [HRROI A,[ASCIZ /? Command line too long./]
		JRST ERRMSG]
	IDPB A,CMDIP		; Recognized character into typein buffer

GCHES1:	JRST GCHESL		; Loop till end of literal

; Word in buffer, end it with a NUL

GCHES2:	MOVE B,WORDBP
	IDPB A,B		; Put NULL in input word

	MOVX A,<C.SPACE>
	PBOUT
	SOSG CMDIS		; Less free space (CMDIC should be 0)
	  JRST [HRROI A,[ASCIZ /? Command line too long./]
		JRST ERRMSG]
	IDPB A,CMDIP		; Space into typein buffer

	MOVE B,CMDIP
	MOVX A,<C.NUL>
	IDPB A,B
	JRST GCH		; And return the ESC

; Input to ESC doesn't match or is ambiugous, ring bell

GCH02:	MOVX A,<C.BELL>		; Doesn't match. Ding.
	PBOUT
	SETZM GCHSAV		; Don't see the ESC again
	JRST GCH		; And read again


; Initialize get character routine

;	CALL GCHINI		; Initilize line buffer
; Kills	A


GCHINI:	SETZM GCHSAV		; No saved character
	CALL CMDCLR		; Clear line buffer
	RET			; Return
	SUBTTL	Subroutine RECOG

;	WRDBP0 -> Start of word

; Set	WORDBP -> End of word
;	WORDXP/   -N,,Address of table of <Address of ASCIZ,,xxx>, or 0
;	CALL RECOG
; Get	X/	Index of match, or -1 if none
; Kills	A, B, C, D
;Ret+1:	  No input before ESC
;Ret+2:	  No match, or not unique
;Ret+3:	Found match (D=0 means matched thru end of literal), or no table

RECOG:	SKIPN X,WORDXP		; Is there a table to try?
	  JRST RSKP2		; No. Good return then.
	SETOM RECX		; Yes. Clear index to none
;	MOVE A,WRDBPS		; Was there any input?
;	CAMN A,CMDIP
	MOVE A,WRDBP0		; Was there any input?
	CAMN A,WORDBP
	  RET			; No. Non-skip return
	TRZ X,-1		; Clear to a counter in RH
	TXZ F,F.AMB!F.MATC	; Clear match counters
RECGL1:	MOVE A,WRDBP0		; Start of word buffer
;	MOVE A,WRDBPS		; Start of word buffer
	MOVE B,X		; Make a pointer to a test word
	ADD B,WORDXP		; Word address of current test word
	HLRZ B,(B)		; Get LH ASCIZ address
	HLL B,[POINT 7,0]	; And pointer LH
RECGL2:	ILDB C,A		; Char from input
	ILDB D,B		; Char from literal
	CAME C,D		; Match?
	  JRST RECOG1		; No.
	JUMPN C,RECGL2		; Yes. Loop if not end of word

; Exact, full, match

	HRRZM X,RECX		; Matched to end. Save index.
	TXO F,F.MATC		; A match,
	TXZ F,F.AMB		; And exact isn't ambiguous
	JRST RSKP2		; Good return.

; Mismatch

RECOG1:	JUMPN C,RECOG2		; Not a match. Typein done?

; Matched thru end of typein

	HRRZM X,RECX		; Yes. Matched to end of typein.
	TXOE F,F.MATC		; At least one match
	 TXO F,F.AMB		; More than one. May yet be exact match
RECOG2:	  AOBJN X,RECGL1	; Try all test words.

	TXNE F,F.MATC		; A match at all?
	  JRST RECOG3		; Yes. Don't try host names

; No match, try host names if haven't and allowed (F.HCOM)

	MOVE A,HOSTN		; Pointer to host names
	CAME A,WORDXP		; Is that what we searched?
	TXNN F,F.HCOM		; No. Should we?
	  JRST RECOG3		; Don't do host search
	MOVEM A,WORDXP		; Yes. Set to search it.
	HLLZ X,A		; Set up counter
	TXO F,F.HCM1		; Flag have now tried host table.
	JRST RECGL1		; Do so.

; All done, decide which return

RECOG3:	TXNE F,F.MATC		; Good return if non-ambig match
	 TXNE F,F.AMB
	  JRST RSKP		; Not a good answer. One skip.
	MOVE X,RECX		; Get the answer

RSKP2:	AOS 0(P)		; Ok. Double skip return
RSKP:	AOS 0(P)		; Single skip return
	RET
	SUBTTL	Subroutine TYI

; Get next input character

;	CALL TYI
; C/	Character (CR & NULs dropped, end-of-line changed to LF)
;	Preserves A, B, D

TYI:	SKIPN TENEX		; Use RDTTY under TOPS20
	  JRST TYI20

; TENEX input, byte at a time

	SOSG CMDIS		; Space available?
	  JRST XXXCOM		; No
TYINX0:	PUSH P,A		; Wrong AC
	PBIN			; Use PBIN under TENEX
	MOVE C,A		; Where it is to be returned
	POP P,A

	CAIE C,C.NUL		; Flush out NULLs and CR's
	 CAIN C,C.CR
	  JRST TYINX0


; Common return to translate C.FF & EOL,
; map secondary editting characters into primary

TYIX:	CAIE C,C.FF		; For now ^L,EOL is LF
	 CAMN C,EOL		; System-dependent end-of-line
	  MOVX C,<C.LF>		; Replaced by LF

	CAMN C,CDE2CH
	  MOVE C,CDELCH
	CAMN C,CDE2WD
	  MOVE C,CDELWD
	CAMN C,CDE2LN
	  MOVE C,CDELLN

	SKIPE TENEX		; If TENEX, put
	  IDPB C,CMDIP		; Character into input buffer

	RET			; Return character

; TOPS20 input via RDTTY


TYI20:	SOSGE CMDIC		; Have any buffered characters?
	  JRST TYI1		; No, get more
	ILDB C,CMDIP		; Get char, return in C
	CAIE C,C.NUL		; Flush out NULLs and CR's
	 CAIN C,C.CR
	  SKIPA			; Flush
	   JRST TYIX		; Go filter it
	CALL BKCMD
	JRST TYI20		; Get another (CMDIC should be zero)

; Refill buffer

TYI1:	PUSH P,A		; Preserve all
	PUSH P,B

	MOVE A,CMDIP		; Current pointer
	MOVE B,CMDIS		; Current remaining space
	TXO B,RD%BRK+RD%TOP+RD%PUN+RD%CRF+RD%RND
	MOVE C,RDTTYC		; ^R buffer
	RDTTY
	  CALL BOMB

	TXNE B,RD%BFE		; Deleted all?
	  JRST [MOVX A,<.PRIIN>	; Get character causing return
		BKJFN
		 SKIPA B,[CDELLN] ; On error, wipe out everything
		  BIN		; Get character (RUBOUT or ^U)
		MOVE C,B	; TYI returns it here
		POP P,B
		POP P,A
		JRST TYIX]	; Go filter it

	HRRZ B,B		; Get updated space count
	EXCH B,CMDIS		; Save it, get old
	SUB B,CMDIS		; Compute number chars just read
	MOVEM B,CMDIC		; Save it

	POP P,B
	POP P,A			; Restore
	JRST TYI20		; All set
	SUBTTL	Subroutines UPDCTR

; Output string, and insert it into the command buffer

; B/	Pointer to text to be inserted into command buffer
;	CALL UPDCTR
; Kills	A, B


UPDCTR:	PUSH P,D
	PUSH P,C

	PUSH P,B		; Save pointer to text

	MOVX A,<.PRIOU>		; Display it for the user
	MOVE C,CMDIS		; Remaining space
	MOVX D,<C.NUL>		; ASCIZ string terminator
	SOUT			; Output & count characters
	ADDI C,1		; Correct for C.NUL

	MOVE A,CMDIS		; Space before call
	MOVEM C,CMDIS		; Space after string inserted
	SUB C,A			; Space being used

	MOVE A,CMDIP		; Where text gets inserted
	POP P,B			; Pointer to text again
	SOUT			; Text to command buffer
	MOVEM A,CMDIP		; Where to continue
	SETZM CMDIC		; No valid characters after CMDIP

	POP P,C
	POP P,D
	RET
	SUBTTL	Subroutines BKCMD, CMDCLR

; Backup command buffer pointer/count

;	CALL BKCMD


BKCMD:	PUSH P,A

	MOVE A,CMDIP		; Able to backup?
	CAMN A,CMDIP0
	  JRST BKCMDX		; No

	MOVX A,<C.NUL>		; Remove it from buffer
	DPB A,CMDIP

	MOVX A,<070000,,0>	; Back up pointer
	ADD A,CMDIP
	SKIPGE A
	  SUB A,[430000,,1]
	MOVEM A,CMDIP		; New pointer

	AOS CMDIS		; More free space

BKCMDX:	POP P,A
	RET



; Clear line buffer

;	CALL CMDCLR
; Kills	A


CMDCLR:	SETZM CMDIB		; Clear command buffer
	MOVX A,<CMDIB,,CMDIB+1>
	BLT A,CMDIB+LCMDIB-1

	MOVX A,<LCMDIB*5-1>	; Init count of
	MOVEM A,CMDIS		; Reaining buffer space
	SETZM CMDIC		; No characters in buffer
	MOVE A,CMDIP0		; Init ptr
	MOVEM A,CMDIP

	SETZM BREAKC		; No prior characters
	SETZM LASTCC

	RET
	SUBTTL	Interrupts - Control-G and Data Fork Aborts

; Here on PSI cause by TELNET rcv fork requesting abort

ABOINT:	TXO F,F.ABOR		; Abort DATCON (not TELNET)
	TXZA F,F.CGFG
ABBINT:	  TXO F,F.ABOR!F.CGFG	; Abort both TELNET & DATCON
	JRST ABINT1		; Data fork has halted

; Here on BELL typed

CGINT:	TXZ F,F.ABOR
	TXO F,F.CGFG		; Flag which kind of int.

ABINT1:	MOVEM 17,PI3AC+17	; Save registers
	MOVX 17,<0,,PI3AC>	; Here
	BLT 17,PI3AC+16
	MOVX P,<IOWD PDLL,PI3PDL> ; Get a stack

	SETZM F$DOPN		; Remember no longer synced
	SETZM F$DTRQ		; Shouldn't need this ;cwl
	SETZM F$FLST		; In case waiting for STAT reply

	TXNE F,F.ABOR		; Abort TELNET?
	 TXNN F,F.CGFG		; (Both set)
	  JRST ABINT3		; No
	CALL TCLOS1		; Close everything up
	JRST ABINT5		; All done

ABINT3:;TXNN F,F.ABOR!F.CGFG	; Abort data only?
;	  JRST ABINT5		; No

	TXNN F,F.CGFG		; Control-G interrupt?
	  JRST ABINT4		; No, from data fork

; User requesting data abort, tell server to abort
; Try three ways, ABOR, TELNET Control-C, and a couple Control-Cs

	MOVNI C,ABORLN		; Message length
	MOVX B,<POINT 8,ABORTX>	; Pointer to it (8-bit for TELNET)
	SKIPLE A,SCON
	 $SOUT
	  ERJMP ABINT4		; Force it from this end

	MOVE A,SCON
	MOVX B,<.MOSND>
	$MTOPR			; Push it along
	ERJMP DOICPA

	AOSG CGCOUNT		; Or if a second Control-G
	  JRST ABINT9
	SUBTTL	Interrupts - More aborts and Control-O

ABINT4:
IFN TCPP,<SKIPE A,DATCON+T.JCN	; Speed things up
	   ABORT
	    JFCL
	  SETZM DATCON+T.JCN	; Gone
> ; End of IFN TCPP

	CLOSD DATCON		; Close data connection
ABINT5:

	MOVX A,<C.BELL>		; Type a BELL
	PBOUT

	MOVX A,<PC%USR+FWPC+1>	; Break-out address
	HRRZ B,RETPC3		; Get the interrupt PC
	CAIE B,FWPC		; Fork wait?
	 CAIN B,FWPC+1
	  MOVEM A,RETPC3	; Yes. Break it out.

ABINT9:	MOVX 17,<PI3AC+1,,1>	; Restore ACs (except F)
	BLT 17,17
	DEBRK



ABORTX:	BYTE (8)"A","B","O","R"	; Data abort request
	BYTE (8)C.CR,C.LF,C.CC,C.CC
	BYTE (8)TN.IC,TN.CC,C.CR,C.LF
ABORLN==^D12			; Message length



; Here on Control-O

COINT:	MOVEM A,NTIIA		; Clear output buffer int
	MOVX A,<.PRIOU>		; Output primary JFN
	CFOBF
	MOVE A,NTIIA
	DEBRK
	SUBTTL	Interrupts - Control-T

CTTINT:	MOVEM 17,PI3AC+17	; Save registers
	MOVX 17,<0,,PI3AC>	; Here
	BLT 17,PI3AC+16
	MOVE P,[IOWD PDLL,L3PDL] ; Have a stack

	HRROI A,[ASCIZ /
PC = /]
	PSOUT

	MOVX A,<.PRIOU>
	HRRZ B,RETPC3
	MOVX C,<OCTRAD>
	NOUT
	  JFCL

	MOVX A,<.FHJOB>
	RUNTM
	PUSH P,C		; Save connect time

	MOVE D,A		; CPU time used
	MOVX A,<.PRIOU>
	HRROI B,[ASCIZ /, Used /]
	CALL HMSMS		; Hours, minutes, seconds, msec

	POP P,D
	HRROI B,[ASCIZ / in /]
	CALL HMSMS		; Hours, minutes, seconds, msec

	MOVX A,<'SYSTAT'>
	SYSGT
	JUMPLE A,CTINT2		; ??
	HRRZ A,B
	HRLI A,14		; 1-minute load average
	GETAB
	  JRST CTINT2		; ??
	MOVE B,A

	HRROI A,[ASCIZ /, Load /]
	PSOUT

	MOVX A,<.PRIOU>
	MOVX C,<FL%ONE!FL%PNT!FL%RND!FLD(3,FL%FST)!FLD(2,FL%SND)>
	FLOUT
	  JFCL
CTINT2:
	HRROI A,[ASCIZ /
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,[ASCIZ /
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
	ERJMP .+1
CTINT6:	HRROI A,[ASCIZ /.
/]
CTINT7:	PSOUT

	MOVX 17,<PI3AC+1,,1>	; Restore ACs (except F)
	BLT 17,17
	DEBRK
	SUBTTL	Interrupts - ITRAP
; Catch ITRAP's and simulate ERJMP for TENEXes

INSINT:	MOVEM 17,PI1AC+17	; Save registers
	MOVX 17,<0,,PI1AC>	; Here
	BLT 17,PI1AC+16
	MOVE P,[IOWD PDLL,L1PDL] ; Set up a stack

	HRRZ B,RETPC1		; Get the interrupt PC
	HLRZ A,0(B)		; Instr after the bad one
	CAIN A,(<ERJMP 0>)	; An ERJMP?
	JRST IIINT1		; Yes, go do it
	HRROI A,[ASCIZ /
? Illegal instruction trap at /]
	PSOUT
	MOVEI A,.PRIOU		; Report the failure
	MOVEI C,OCTRAD
	NOUT
	 JFCL
	CALL PCRLF
	HALTF			; Let user take a look at it
	JRST GO

IIINT1:	MOVX A,PC%USR
	HRRI A,@0(B)		; Dest of the ERJMP
	MOVEM A,RETPC1		; Go there
	MOVX 17,<PI1AC,,0>	; Restore ACs
	BLT 17,17
	DEBRK
	SUBTTL	Subroutine BOMB, PCRLF

;	CALL BOMB	; Never returns


BOMB:	MOVEM 16,PI2AC+16	; User process doesn't use level 2
	MOVX 16,<0,,PI2AC>
	BLT 16,PI2AC+15		; Save ACs for dump

	HRROI B,[ASCIZ /
? "Impossible Error" in FTP User Process at location /]
	POP P,C			; Error address
	MOVEI C,-1(C)		; Drop flags

	MOVEM P,PI2AC+17	; Stack before CALL BOMB

	MOVEI D,PI2AC		; AC block
	CALL DMPREG		; Dump everything
	CALL PCRLF		; End last line

HALTGO:	HALTF			; Halt and restart
	JRST GO



PCRLF:	HRROI A,CRLFM		; Output end of line
	PSOUT
	RET


CRLFM:	ASCIZ /
/
	SUBTTL	Subroutines SETTTY, GETHST

SETTTY:	MOVX A,<.PRIIN>		; Set up params about user console
	RFMOD			; See what it is
	MOVEM B,IRFMOD		; Store it
	TXNE B,TT%DUM		; Full or Half duplex?
	  TXO F,F.HDX		; Half.
	RFCOC			; See what the echoing is
	MOVEM B,ICOCB		; Save for exit
	MOVEM C,ICOCC
	MOVX D,<-NEDITS-1,,0>	; Count edit characters & ESC
	SKIPA T2,[-C.ESC]	; First character
SETTYL:	  MOVN T2,EDIT0-1(D)	; Next character
	SKIPG T2		; Was negative, skip it
	 CAMG T2,[-40]		; Only control
	  JRST SETTYN		; Skip it
	ASH T2,1		; Two bits per characrer
	MOVX T1,<3B1>
	LSHC T1,(T2)		; Position bits
	TDZ B,T1		; Clear bits in mask
	SKIPN T1		; If bits in T1, T2 has garbage
	  TDZ C,T2
SETTYN:	AOBJN D,SETTYL		; Do all characters
	MOVEM B,FCOCB		; Save them
	MOVEM C,FCOCC
	SFCOC			; And set them in system
	RET

; GETHST
; Build HOSTN, HOSTNN, and HSTNAM tables in FREE space
; HOSTN format - [ASCIZ /host name/],,host status
; HOSTNN contains host numbers
; HSTNAM contains host names (pointed to by HOSTN entry)

GETHST:	MOVE B,HOSTNP		; get neg. # host names,,0
	HRR B,FREE		; table allocated from free space
	MOVEM B,HOSTNN		; save table ptr
	HLRE C,B
	MOVNS C			; get length of table
	ADDM C,FREE		; bump FREE ptr accordingly
	HRR B,FREE		; now allocate HOSTN
	MOVEM B,HOSTN		; save table ptr
	ADDM C,FREE		; bump FREE ptr

	MOVE T2,HOSTNP		; AOBJN ptr (neg. # host names,,0)
	HRRZ P1,HOSTNN		; pointer to host numbers table
	HRRZ P2,HOSTN		; ptr to string ptr/status table
	SETZ E,			; null byte to deposit after strings
	MOVE B,FREE		; allocate host names table
	MOVEM B,HSTNAM		; save table ptr
	MOVX A,.GTHIX		; get name string, host #, status
GETHS1:	HRLI B,(POINT 7,0)	; make byte ptr
	HRLZM B,0(P2)		; save adr in HOSTN table
	HRRZ C,T2		; index
	GTHST			; do it
	 JRST GETHSX		; assume no more
	IDPB E,B		; put ending null
	MOVEM C,0(P1)		; put host number in table
	HRRM D,0(P2)		; put rh status in HOSTN table
	AOS B			; bump byte ptr to next word
	AOS P1			; bump HOSTNN ptr
	AOS P2			; and HOSTN ptr
	AOBJN T2,GETHS1		; and loop (finally)
GETHSX:	HRRZM B,FREE		; save new FREE ptr
	RET			; and done
	SUBTTL	Subroutines TCLOSE, TCLOS1

TCLOSE:	HRROI A,[ASCIZ / (Closing previous connection.) /]
	TXNE F,F.TOPN		; Is TELNET connection open?
	  PSOUT
TCLOS1:

IFN TCPP,<
	CLOSD DATCON		; Close data connection
> ; End of IFN TCPP

	CLOSD RCON		; Close TELNET Receive

	CLOSD SCON		; Close TELNET Send

	SKIPE DBUGSW
	  JRST TCLOS4		; Don't kill forks if debugging

	SKIPLE A,RFORKH		; Kill TELNET receiver fork
	  KFORK
	SETOM RFORKH

	SKIPLE A,DFORKH		; Kill Data fork
	  KFORK
	SETOM DFORKH
TCLOS4:

	TXZ F,F.TOPN		; TELNET connection not open.
	SETZM F$TCLS		; Request for close has been satisfied

	SETOM PARAM3		; Say have sent no params
	MOVE A,[PARAM3,,PARAM3+1]
	BLT A,PARAM3+NPARS-1
	RET
	SUBTTL	Command Definitions

DEFINE COMS <		; Keywords
CC (<CONNECT>,,.HOST,< to <host-name>
        or <decimal-byte>.<decimal-byte>.<decimal-byte>.<decimal-byte>
        or #<octal-number>>)
CC (<LOGIN>,TOPN,.LOGIN,< <username> <password> <optional-account>>)
CC (<ACCOUNT>,TOPN,.ACCT,< <number> or <string>>)
CC (<GET>,TOPN,.GET,< <remote-file> to <local-file>>)
CC (<SEND>,TOPN,.SEND,< <local-file> to <remote-file>>)
CC (<MULTIPLE>,TOPN,.MULT,< GET/SEND <local-file-group>
         Allows "*", TOPS20/TENEX sites only.>)
CC (<APPEND>,TOPN,.APPE,< <local-file> to <remote-file>>)
CC (<RENAME>,TOPN,.RENAM,< <remote-file> to be <new-remote-file>>)
CC (<DELETE>,TOPN,.DELET,< <remote-file>>)
CC (<DIRECTORY>,TOPN,.DIREC,< of <remote-user>>)
CC (<CWD>,TOPN,.CWD,< change working directory to <directory-path>>)
CC (<STATUS>,TOPN,.STATU,< of remote system>)
CC (<MAIL>,TOPN,.MAIL,< <file> to <remote-user>>)
IFE TCPP,<
 CC (<BYE>,,.DISC,< same as DISCONNECT>)
> ; End of IFE TCPP
IFN TCPP,<
 CC (<BYE>,,.BYE,< closes connection>)
> ; End of IFN TCPP
CC (<DISCONNECT>,,.DISC,< from remote host (abort)>)
CC (<EXIT>,,.QUIT,< returns to EXEC, without closing connection>)
CC (<QUIT>,,.QUIT,< returns to EXEC, without closing connection>)
REPEAT 0,<
 CC (<PREFIX>,,.PREFI,< String to put in front of foreign filenames>)
 CC (<SUFFIX>,,.SUFFI,< String to put at end of foreign file names>)
> ; End of REPEAT 0
IFE TCPP,<
 CC (<MODE>,,.MODE,< sets transmission mode>)
 CC (<STRUCTURE>,,.STRU,< sets structure of data>)
 CC (<TYPE>,,.TYPE,< sets data type>)
 CC (<BYTE>,,.BYTE,< size of data connection>)
 CC (<ASCII>,,.ASC,< a shorthand for TYPE A, BYTE 8>)
 CC (<PAGED>,,.PAGED,< a shorthand for TYPE X, BYTE 36 (TENEX sites only)>)
 CC (<TENEX>,,.TENEX,< a shorthand for IMAGE, BYTE 36>)
> ; End of IFE TCPP
IFN TCPP,<
 CC (<MODE>,,.MODE,< sets transmission mode to one of {S}>)
 CC (<STRUCTURE>,,.STRU,< sets structure of data to one of {F, P}>)
 CC (<TYPE>,,.TYPE,< sets data type to one of {A N, I, L n}>)
;CC (<FORMAT>,,.FORM,< of text is one of {N}>)
 CC (<ASCII>,,.ASC,< a shorthand for STRU F, TYPE A>)
 CC (<PAGED>,,.PAGED,< a shorthand for STRU P, TYPE L 36>)
 CC (<TENEX>,,.TENEX,< a shorthand for TYPE I>)
> ; End of IFN TCPP
CC (<IMAGE>,,.IMAGE,< a shorthand for TYPE I>)
CC (<VERBOSE>,,.VERBOS,< typeout mode>)
CC (<BRIEF>,,.BRIEF,< typeout mode>)
CC (<QUOTE>,TOPN,.QUOTE,< <arbitrary-FTP-line>>)
CC (<STATISTICS>,,.STATS,< turns on typeout of timing statistics>)
CC (<NOSTATISTICS>,,.NOSTA,< turns off typeout of timing statistics>)
CC (<RETAIN>,,.RETAI,< turns on retention of generation numbers>) ;#4 
CC (<NORETAIN>,,.NORET,< turns off retention of generation numbers>) ;#4 
CC (<HELP>,,.HELP,< types this information>)

XCOM==.	; End of normal commands

CC (<ECHO>,TOPN,.ECHO,< request server to echo commands >)
CC (<NOECHO>,TOPN,.NECHO,< request server to stop echoing commands >)
> ; End of DEFINE COMS
	SUBTTL	Command Symbol Table

TOPN==1B0	; NB: Sign bit  Must have open TELNET connection for command

IF2,<				; If TAG undefined, define it tobe NOTIMP
DEFINE CC (WORD,FLAG,TAG,HELP)<
ND TAG,NOTIMP> ; End of DEFINE CC
	COMS
> ; End of IF2


DEFINE CC (WORD,FLAG,TAG,HELP)<
	XWD [ASCIZ \WORD\],TAG
> ; End of DEFINE CC


COMTB1:	NCOMS,,XCOMS		; Actual,,Maximum
	COMS
NCOMS==XCOM-COMTB1-1		; Most of the commands
XCOMS==.-COMTB1-1		; All commands for debugging

COMTBX:	-NCOMS,,COMTB1+1	; Pointer to command words


DEFINE CC (WORD,FLAG,TAG,HELP)<
IFB  <FLAG>,<	EXP      [ASCIZ \HELP\]>
IFNB <FLAG>,<	EXP FLAG+[ASCIZ \HELP\]>
> ; End of DEFINE CC


COMTB2:	NCOMS,,XCOMS		; Maintain parallelism
	COMS
	SUBTTL	Command HELP, HELP Commands

.HELP:	MSG < C, E, S or ? >
	MOVX A,<.PRIIN>
	RFMOD
	TXO B,TT%WKF+TT%WKN+TT%WKP+TT%WKA
	SFMOD
	CALL CMDCLR		; Clear line buffer
	CALL TYI		; Get answer
	MOVE A,C		; It came back in C
	CAMN A,CDELLN		; Line deleted?
	  JRST XXXCOM		; Yes
	CAIE A,"C"
	 CAIN A,"c"
	  JRST HLPCOM
	CAIE A,"E"
	 CAIN A,"e"
	  JRST HLPEXM
	CAIE A,"S"
	 CAIN A,"s"
	  JRST HLPSTS
	CAIN A,"?"
	  JRST HLPQM
	JRST ERRCOM




HLPCOM:	MSG <
 Commands are:
>
	MOVX X,<-NCOMS,,0>
	SKIPE DBUGSW
	  MOVX X,<-XCOMS,,0>
HELP01:	HLRO A,COMTB1+1(X)	; Command keyword
	PSOUT
	HRRO A,COMTB2+1(X)	; And help text
	PSOUT
	HRROI A,CRLFM		; EOL
	PSOUT
	AOBJN X,HELP01

	MSG <
Type BELL (^G) to abort a file transfer and return to command level.
Type ^O to clear typeout buffer.
Use  ^V to quote characters in LOGIN.
>
	JRST RSKP
	SUBTTL	Command HELP Status, HELP Example

HLPEXM:	HRROI A,HLPEX1		; Long message
	PSOUT
	JRST RSKP

HLPEX1:	ASCIZ /
@FTP				;call in the subsystem
*BBN				;connect to host BBN
*LOG SMITH SECRET 12345 	;declare name, password, account
				; the password will not be echoed.
*DIR *.MAC
(to local file) TTY:		;get a partial directory listing
*GET PROGRAM.MAC		;must end with carriage return
(to local file) <esc>PROGRAM.MAC  ;escape causes same name to be used
*BYE				;request server to terminate
*QUIT
@

/



HLPQM:	MSG <
Type "C" for a list of commands, "E" for a example of FTP use,
or "S" for current status.
>
	JRST .HELP




HLPSTS:	CALL LCLSTU		; Print local status
	JRST RSKP		; Good return from help command.

LCLSTU:	SETOM PARAM3		; Say have sent no params
	MOVE A,[PARAM3,,PARAM3+1]
	BLT A,PARAM3+NPARS-1

	MOVX A,<.PRIOU>		; Status info to user
	CALLRET LCLSTS
	SUBTTL	ASCII, PAGED, TENEX, IMAGE, BRIEF, VERBOSE, (NO) STATS

.ASC:	MOVX A,<^D8>		; Eight bit bytes
	MOVEM A,$BYTE
	MOVX A,<TYPE.A>		; ASCII type
	MOVEM A,$TYPE
	SETZM $FORM
IFN TCPP,<SETZM $STRU>		; Default (file) structure
	JRST RSKP


.PAGED:	MOVX A,<^D36>		; Set byte size to a word
	MOVEM A,$BYTE
IFN TCPP,<MOVX B,<STRU.P>		; And to PAGED structure
	  MOVEM B,$STRU
	  MOVX A,<TYPE.L>> ; End of IFN TCPP
IFE TCPP,<MOVX A,<TYPE.X>>	; And to PAGED type
	MOVEM A,$TYPE
	JRST RSKP


IFN TCPP,<
.IMAGE:
> ; End of IFN TCPP
.TENEX:	MOVX A,<^D36>		; 36-bit connection
	MOVEM A,$BYTE
IFE TCPP,<
.IMAGE:
> ; End of IFE TCPP
	MOVX A,<TYPE.I>		; Code for IMAGE transmission
	MOVEM A,$TYPE
	JRST RSKP


.BRIEF:	TDZA A,A		; Clear VERBOSE flag
.VERBO:	  SETO A, 		; Set VERBOSE flag
	MOVEM A,F$VBOS
	JRST RSKP


.STATS:	TXZA F,F.NST1		; Statistics typeout allow/suppress
.NOSTA:	  TXO F,F.NST1
	JRST RSKP
	SUBTTL Command MODE

.MODE:	NOISE < (key letter) >
	MOVE X,[-NMODES,,MODTAB+1]
	CALL KEYLTR
	  JRST MODE$		; No match
	  JRST NOTCFM		; Not confirmed (space)
	JRST 0(B)		; Ok


IFE TCPP,<
MODTAB:	KM (MODE,<S,B,T,H>)
> ; End of IFE TCPP


IFN TCPP,<
MODTAB:	KM (MODE,<S,B,C>)
> ; End of IFN TCPP


MODE$S:
	HRRZM D,$MODE
	JRST RSKP


MODE$:	NOISE <
>
	MSG <? Invalid or unimplemented MODE parameter>
	JRST CRCOM


NOTCFM:	MSG <
? Not confirmed>
	JRST CRCOM
	SUBTTL	STRUCTURE

.STRU:	NOISE < (key letter) >
	MOVE X,[-NSTRUS,,STRTAB+1]
	CALL KEYLTR
	  JRST STRU$		; No match
	  JRST NOTCFM		; Not confirmed (space)
	JRST 0(B)		; Ok


IFE TCPP,<
STRTAB:	KM (STRU,<F,R>)
> ; End of IFE TCPP


IFN TCPP,<
STRTAB:	KM (STRU,<F,R,P>)
> ; End of IFN TCPP


IFN TCPP,<
STRU$P:
> ; End of IFN TCPP

STRU$F:	HRRZM D,$STRU
	JRST RSKP


STRU$:	NOISE <
>
	MSG <? Invalid or unimplemented STRUCTURE parameter>
	JRST CRCOM
	SUBTTL	Command TYPE

.TYPE:	NOISE < (key letter) >
	MOVE X,[-NTYPES,,TYPTAB+1]
	CALL KEYLTR
IFE TCPP,<JRST TYPE$		; No match
	  JRST NOTCFM>		; Not confirmed (space)
IFN TCPP,<JRST TYPE$		; No match
	  JFCL			; Accept space as terminator

	MOVX C,<0>		; Default $FORM for TYPE A,E

	MOVE A,BREAKC		; Dispatch on LF
	CAIN A,C.LF
	  JRST 0(B)		; Ok (Default second parameter, if any)
				; Second parameter specified
	CAIE D,TYPE.E		; EBCDIC?
	 CAIN D,TYPE.A		; or ASCII?
	  SKIPA			; No
	   JRST 0(B)		; Ok

	PUSH P,D		; Save which
	CALL .FORM1		; Get print format
	  JRST APOPJ		; Clear stack & error return
	POP P,D			; Restore which
	JRST TYPF$A		; Go set $BYTE
> ; End of IFN TCPP




IFE TCPP,<
TYPTAB:	KM (TYPE,<A,E,I,L,P,X>)
> ; End of IFE TCPP


IFN TCPP,<
TYPTAB:	KM (TYPE,<A,E,I,L>)
> ; End of IFN TCPP

IFN TCPP,<
TYPE$L:	CALL .BYTE		; HAVE to get byte size
	  RET			; Bad byte size
	MOVX D,<TYPE.L>		; Ok, $BYTE set
	JRST TYPS

TYPE$I:	CAIN A,C.SPACE		; Make sure confirmed
	  JRST NOTCFM
	MOVX A,<^D36>		; Image is 36 bits
	MOVEM A,$BYTE
	JRST TYPS

TYPE$A:	MOVEM C,$FORM		; Default print format
TYPF$A:	MOVX C,<^D8>		; Byte size
	MOVEM C,$BYTE
> ; End of IFN TCPP


IFE TCPP,<
TYPE$L:
TYPE$X:
TYPE$I:
TYPE$A:
> ; End of IFE TCPP

TYPS:	HRRZM D,$TYPE		; Set type
	JRST RSKP


TYPE$:	NOISE <
>
	MSG <? Invalid or unimplemented TYPE parameter>
	JRST CRCOM
	SUBTTL	BYTE

.BYTE:	NOISE < (decimal number) >
BYTE00:	CALL SEST		; Get rid of possible ESC
	CALL DECIN		; Read the desired byte size
	  JRST BYTE$$		; Failed

IFE TCPP,<
	CAIE A,^D36		; Scan for legal values
	 CAIN A,^D32
	  JRST BYTE01
	CAIN A,^D8
	  JRST BYTE01		; Legal value
BYTE$:	MSG <
? Must be 36, 32 or 8 bit bytes.>
> ; End of IFE TCPP

IFN TCPP,<
	CAIL A,1		; Check for legal values
	 CAILE A,^D36
	  SKIPA			; Illegal value
	   JRST BYTE01		; Legal value
BYTE$:	MSG <
? Must be 1 to 36 bit bytes.>
> ; End of IFN TCPP

	JRST CRCOM


BYTE$$:	CAIE C,C.ESC		; ESC typed?
	  JRST ERRCOM
	MOVX A,<C.BELL>
	PBOUT
	JRST BYTE00


BYTE01:	MOVEM A,$BYTE		; Store the byte size
	JRST RSKP
	SUBTTL	Command FORM

.FORM:	NOISE < (key letter) >
	JRST .FORM2

.FORM1:	NOISE < (print format key letter) >
.FORM2:	MOVE X,[-NFORMS,,FRMTAB+1]
	CALL KEYLTR
	  JRST FORM$		; No match
	  JRST NOTCFM		; Not confirmed (space)
	JRST 0(B)		; Ok

IFE TCPP,<
FRMTAB:	KM (FORM,<U,P>)
> ; End of IFE TCPP

IFN TCPP,<
FRMTAB:	KM (FORM,<N,T,C>)
FILTAB:	40			; ASCII space
	100			; EBCDIC space
	0			; NULL
	0			; NULL
> ; End of IFN TCPP

IFN TCPP,<
FORM$N:
> ; End of IFN TCPP

IFE TCPP,<
FORM$U:
> ; End of IFE TCPP

	HRRZM D,$FORM
	JRST RSKP

FORM$:	NOISE <
>
	MSG <? Invalid or unimplemented print FORMAT parameter>
	JRST CRCOM
	SUBTTL	Command CONNECT

.HOST:	TXNE F,F.TOPN		; Is TELNET connection open?
	  CALL TCLOSE		; Yes. Close it and any data.
	NOISE < (to host) >

	CALL SEST		; Skip ESC, spaces and tabs, peek ahead

IFN TCPP,<CAIN C,"#"		; Octal guide character?
	   JRST HOST06		; Yes. Read the host number
	  CAIL C,"0"		; First char an decimal digit?
	   CAILE C,"9"
	    SKIPA		; No
	     JRST HOST07	; Yes. Read the host number
> ; End of IFN TCPP

IFE TCPP,<CAIL C,"0"		; First char an octal digit?
	   CAILE C,"7"
	    SKIPA		; No
	     JRST HOST06	; Yes. Read the host number
> ; End of IFE TCPP

	MOVE X,HOSTN		; Pointer to names of hosts
	MOVEM X,WORDXP		; Arg to get word
	CALL GETWRD		; Read a host name
	  JRST ERRCOM		; Bad name
	JRST HOST00		; And go open conn.


; Entry for host name at command level (RECX set to HOSTN index)

.HOST1:	TXNE F,F.TOPN		; TELNET conn open?
	  CALL TCLOSE		; Yes. Close it.
	MOVE X,RECX		; Get the host table index

HOST00:	MOVE A,HOSTN		; Base of table
	ADDI A,0(X)		; Offset found by GETWRD
	MOVEM A,HOSTX		; Save this handy index (unused)
	HRRZ D,0(A)		; Get host status
	ANDI D,HS%STY		; Extract system type
	MOVEM D,FHSTYP		; Host status
	HRRZ A,HOSTNN		; Base of host numbers table
	ADDI A,0(X)		; add offset
	MOVE A,0(A)		; Get host number
; Fall into HOST01
	SUBTTL	Command CONNECT, cont., Open TELNET connection

HOST01:	MOVEM A,FHSTN		; Store it
	SETOM $STRU		; Assume default structure
	SETOM $TYPE		; Assume default type
	CALL DOICP		; Open the TELNET connections
	  JRST ICPERR		; No good

	MSG < Connection opened.
 Assuming >
	MOVE A,FHSTYP		; Host status
	SETZM FTNXX		; Foreign host TENEX (-1), TOPS20 (1), other
	CAIN A,.HS10X	 	; A TENEX?
	  SETOM FTNXX		; Yes
	CAIN A,.HST20		; Same for Tops20's
	  AOS FTNXX		; Yes
	MOVX B,<^D8>		; Start at eight
	SKIPE FTNXX		; For TENEX & TOPS20
	  MOVX B,<^D36>		; Assume 36 bit
	CAIE A,.HSITS	 	; Or a MAC ITS system?
	 CAIN A,.HSDEC	 	; Same for TOPS10 systems
	  MOVX B,<^D36>
	MOVEM B,$BYTE		; Stash the answer

	MOVX C,<TYPE.L>		; And Logical type if 36-bit.
	MOVE D,$STRU		; Current structure
	CAIE A,.HST20		; Tops20 paged
	 CAIN A,.HS10X	 	; Image if 36 unless 10x, then paged.
IFE TCPP,<MOVX C,<TYPE.X>>	; Paged.
IFN TCPP,<MOVX D,<STRU.P>>	; STRU Paged, TYPE L 36

	CAIN B,^D36
	  MOVEM C,$TYPE
IFN TCPP,<
	CAIN B,^D36
	  MOVEM D,$STRU
> ; End of IFN TCPP

	MOVX A,<.PRIOU>		; Declare decision to user to change
	MOVX C,<DECRAD>		; If he doesn't like it.
	NOUT
	  JFCL
	MSG <-bit connections>

	HRROI A,[ASCIZ /, Paged transfers/]
IFE TCPP,<MOVE B,$TYPE		; Declare paged if so
	  CAIN B,TYPE.X> ; End of IFE TCPP
IFN TCPP,<MOVE B,$STRU
	  CAIN B,STRU.P> ; End of IFN TCPP
	    PSOUT
	HRROI A,[ASCIZ /.
/]
	PSOUT
	SUBTTL	Command CONNECT, cont., Create Forks & Start Listener

	SKIPE DBUGSW		; If debugging and
	 SKIPG RFORKH		; Already have a fork
	  SKIPA
	   JRST HOST03		; Don't get another
	CALL MAKFRK		; Create needed inferiors
	  JRST MKFERR		; Can't
	MOVEM X,RFORKH		; One for TELNET receive
HOST03:

	SKIPE DBUGSW		; If debugging and
	 SKIPG DFORKH		; Already have a fork
	  SKIPA
	   JRST HOST04		; Don't get another
	CALL MAKFRK
	  JRST MKFERR
	MOVEM X,DFORKH		; One for data flow.
HOST04:

	MOVE A,RFORKH		; Receiver handle
	MOVEI B,RFRKSA		; And starting address
	SFORK			; Start it.
REPEAT 1,<
 ; The following is a total crock which can't possibly be the right fix
 ; for anything. When the right fix is found for whatever this crock
 ; is getting around, this should be instantly removed.
	SKIPE TENEX		; No batch on TENEX
	JRST HOST4X		; ..
	SETO A,0		; See if this is running under BATCH
	SETZ D,0		; ..
	MOVE B,[-1,,D]
	MOVEI C,.JIBAT
	GETJI			; Am I a batch job?
	 ERJMP HOST4X
	JUMPL D,HOST4X		; Go if not
	MOVEI A,^D5000		; If so, wait 5 seconds
	DISMS			; for some other bug to be hidden
HOST4X:
> ;End total crock
	JRST CRCOM		; Good return



ICPERR:	SETOM FHSTN		; No current foreign host
	JRST CRCOM		; See what to do now.




MKFERR:	HRROI A,[ASCIZ /
? Can't	create forks to handle TELNET connections.
/]
	JRST ERRSYS		; System message might help
	SUBTTL	Command CONNECT, cont., Host specified numerically

; Host address from octal number

HOST06:
IFN TCPP,<CALL GCH		; Get # again
	    JFCL		; Its a break character
	  CALL SBST		; Now discard it & get ready for digit
> ; End of IFN TCPP
	CALL OCTIN		; Read octal number
	  JRST ERRCOM		; (Can't happen)
	SKIPLE A 		; Range check the answer
IFN TCPF,<CAML A,[040000000000]>
IFE TCPF,<CAIL A,400>		; DOES THE 400 DEPEND ON PRIVF? CWL
	    JRST ERRCOM
	JRST HOST09		; Go open connection


; Host address from four decimal bytes

HOST07:	MOVX D,<-4,,0>		; Four bytes
	SETZ B,
HOST08:	CALL DECIN		; Get byte
	  JRST ERRCOM
	CAIL A,0		; Range check
	 CAILE A,^D255
	  JRST ERRCOM
	LSH B,^D8
	ADD B,A
	MOVE A,BREAKC		; If terminated by a period
	CAIN A,"."
	 CALL GCH		; Discard it
	  JFCL
	AOBJN D,HOST08		; Back for rest
	SKIPG A,B		; Where to put it
	  JRST ERRCOM		; Zero is bad
HOST09:
	PUSH P,A		; Save host address
	MOVE C,A
	MOVX A,<.GTHHN>
	GTHST
	 SETZ D,		; No status info
	ANDI D,HS%STY		; Extract system type
	MOVEM D,FHSTYP		; Save status info
	POP P,A			; Restore
	JRST HOST01
	SUBTTL	Commands BYE, DISCONNECT, QUIT, Subroutine SNDBYE

.BYE:				; Synonym for disconnect command 
.DISC:	TXNE F,F.TOPN		; If connection exists
	  CALL SNDBYE		; Request the close
	MOVEI B,^D10		; Wait a little while for it to close
	JRST BYEWQ		; ..
BYEWL:	MOVEI A,^D1000		; Wait one second
	DISMS			; ..
BYEWQ:	SKIPG SCON		; Connection still open?
	SKIPLE DATCON		; ..
	SKIPA			; Yes
	JRST RSKP		; No, so done.
	SOJG B,BYEWL		; Wait up to 10 seconds
	CALL TCLOS1		; Force close if needed
	JRST RSKP		; Return as if OK

SNDBYE:	HRROI A,[0]		; No body of BYE message

IFE TCPP,<
	HRROI B,[ASCIZ /BYE  /]
> ; End of IFE TCPP
IFN TCPP,<
	HRROI B,[ASCIZ /QUIT/]
 > ; End of IFN TCPP

	CALL TELSND		; Output the "BYE" command
	JFCL
;	CALL TCLOS1		; Close the TELNET connection
	RET



.QUIT:	MOVX A,<.PRIOU>		; Restore terminal
	MOVE B,ICOCB
	MOVE C,ICOCC
	SFCOC

	CALL TMPREL		; Release temp file

	HRROI A,[ASCIZ /[The connection is still open.]
/]
	SKIPG SCON		; If a connection is still open, say so
	 SKIPLE DATCON
	  PSOUT

	HALTF			; Pause

	CALL SETTTY		; Setup terminal again

	JRST RSKP		; Continue
	SUBTTL	Commands RETAIN, NORETAIN

.RETAI:	SETOM RETVER		;#4 Do retain generation numbers
	JRST CRCOM		;#4 

.NORET:	SETZM RETVER		;#4 Don't retain generation numbers
	JRST CRCOM		;#4 
	SUBTTL	Commands ECHO, NOECHO, QUOTE, STATUS

.ECHO:	SKIPA B,[TNSDOE]	; Do echo
.NECHO:	  MOVEI B,TNSDNE	; Don't echo
	HRLI B,(POINT 8,0)	; TELNET control characters
	MOVE A,SCON		; TELNET send
	MOVNI C,3		; Length
	$SOUT
	ERJMP ERRCOM

	MOVE A,SCON
	MOVX B,<.MOSND>
	$MTOPR			; Push it along
	ERJMP ERRCOM
	JRST RSKP


.QUOTE:	MOVX X,<<ESTRTM-STRTMP>*5-1>
	MOVE BP,[POINT 7,STRTMP]

	SKIPE DBUGSW		; Debugging?
	  JRST QUOT4		; Yes

	CALL TSINS		; Read a string including spaces
	  JRST XXXCOM		; Quit on RUBOUT

QUOT2:	HRROI B,[0]		; No keyword.
	HRROI A,STRTMP		; Data is what was in user typein
	CALL TELSND		; Send it
	JRST RSKP


QUOT4:	MSG < (ending with ^Z) >
	SETZM STRTMP		; Incase nothing
	MOVX A,<.PRIIN>		; Source
	MOVE B,BP		; Destination
	MOVE C,X		; Maximum count
	MOVX D,<C.TTYE>		; Terminating character
	SIN
				; Ought to check for overflow, etc
	SETZ D,			; End string
	DPB D,B
	JRST QUOT2		; Send it on


.STATU:	NOISE < (of server) >
	CALL LCLSTU		; Print local status
	HRROI B,[ASCIZ /STAT/]
	HRROI A,[0]
	CALL TELSND		; "STAT" with no arg.
	JRST RSKP
	SUBTTL	Command LOGIN

;LOGIN Command. Takes NAME, optional PASSWORD, optional ACCT.

.LOGIN:	SETZM USERBF		; So can tell what was typed in
	SETZM PASSBF
	SETZM ACCTBF

	CALL LF2ESC		; In case break was a LF

	HRRZI P1,[ASCIZ / (user-ident) /]
	MOVX P2,<<EUSRBF-USERBF>*5-1> ; Count
	MOVX P3,<POINT 7,USERBF> ; Pointer
	CALL GETSTR
	  JRST XXXCOM		; Deleted

	MOVE C,BREAKC		; Retrieve break character
	CAIN C,C.LF		; End of line?
	  JRST LOGINX		; Yes.

	MOVX A,<.PRIIN>
	RFMOD			; Kill echoing for password
	TXZ B,TT%ECO+TT%ECM
	SFMOD
	TXO F,F.NOEC		; Flag echoing is off
	MOVE D,B		; Save for TT%DUM check

	HRROI A,STRTMP
	HRROI B,[ASCIZ / (password) /]
	SETZ C,
	SOUT
	MOVE P1,A		; Save pointer (no ESC)

	HRROI B,PMASK		; Password mask
	TXNE D,TT%DUM		; If not full duplex,
	  SOUT			; Append mask string
	IDPB C,A		; End string

	MOVE C,BREAKC
	CAIN C,C.ESC
	  HRROI P1,STRTMP	; ESC begins with noise
	MOVE A,P1		; Initial output

	HRROI P1,STRTMP		; Subsequent output
	MOVX P2,<<EPASBF-PASSBF>*5-1>
	MOVX P3,<POINT 7,PASSBF>
	CALL GETSTO
	 TXOA F,F.AMB		; Borrow flag over echo set
	  TXZ F,F.AMB!F.NOEC

	MOVX A,<.PRIIN>
	RFMOD
	TXO B,TT%ECO		; Echoing back on
	SFMOD

	HRROI A,PMASK2		; And final one
	TXNE B,TT%DUM		; If not full duplex
	  PSOUT

	MOVE A,BREAKC		; Echo the break
	CAIN A,C.LF		; Linefeed?
	  JRST [CALL PCRLF	; Yes, type a CR and LF
		JRST LOGI1Q]
	PBOUT
LOGI1Q:	TXNE F,F.AMB		; Now was a rubout typed during password?
	  JRST XXXCOM		; Yes.

	CAIN C,C.LF		; EOL after password?
	  JRST LOGINX		; Yes, skip account

REPEAT 1,<		; Default account on ESC
	NOISE < (account) >
	MOVX X,<<EACTBF-ACCTBF>*5-1>
	MOVX BP,<POINT 7,ACCTBF>
	CALL SEST		; Discard ESC, spaces & tabs
	CALL TSIN
	  JRST XXXCOM
> ; End of REPEAT 1
REPEAT 0,<		; Force account if started
	HRRZI P1,[ASCIZ / (account) /]
	MOVX P2,<<EACTBF-ACCTBF>*5-1>
	MOVX P3,<POINT 7,ACCTBF>
	CALL GETSTR
	  JRST XXXCOM		; Deleted
> ; End of REPEAT 0
	CALL SST		; Skip SPACEs and TABs
	CAIE C,C.LF		; Should be end of line
	 CAIN C,C.ESC		; or an ESC
	  CAIA			; Ok, try to login
	   JRST ERRCOM		; Not confirmed
LOGINX:

	HRROI A,USERBF		; User name string or 0
	SKIPN (A)
	  JRST LOGINZ		; No user ?? Done
	HRROI B,[ASCIZ /USER /]
	CALL TELSND

	HRROI A,PASSBF		; Password buffer
	SKIPN (A)
	  JRST LOGINZ
	HRROI B,[ASCIZ /PASS /]
	CALL TELSND

	HRROI A,ACCTBF		; Account string
	SKIPN (A)
	  JRST LOGINZ
	HRROI B,[ASCIZ /ACCT /]
	CALL TELSND

LOGINZ:	JRST RSKP
	SUBTTL	Commands ACCOUNT, CWD

.ACCT:	SETZM ACCTBF		; No string

	CALL LF2ESC		; In case break was a LF

	HRRZI P1,[ASCIZ / (number or string) /]
	MOVX P2,<<EACTBF-ACCTBF>*5-1>
	MOVX P3,<POINT 7,ACCTBF>
	CALL GETSTR
	  JRST XXXCOM		; Deleted

	CAIE C,C.LF
	  JRST ERRCOM

	HRROI B,[ASCIZ /ACCT /] ; Send the FTP command
	HRROI A,ACCTBF
	SKIPE (A)		; ??
	  CALL TELSND
	JRST RSKP		; End of account command





.CWD:	CALL LF2ESC		; In case break was a LF

	HRRZI P1,[ASCIZ / (to directory) /]
	MOVX P2,<<ESTRTM-STRTMP>*5-1>
	MOVX P3,<POINT 7,STRTMP>
	CALL GETSTR
	  JRST XXXCOM		; Deleted

	CAIE C,C.LF		; EOL?
	  JRST ERRCOM

	HRROI A,STRTMP		; The argument
	HRROI B,[ASCIZ /CWD /]	; The TELNET command
	CALL TELSND		; Send it
	JRST RSKP		; End of CWD command
	SUBTTL	Commands RENAME

.RENAM:	CALL LF2ESC		; In case break was a LF

	HRRZI P1,[ASCIZ / (existing-file) /]
	MOVX P2,<<EFRNPT-FRNPTH>*5-1>
	MOVX P3,<POINT 7,FRNPTH>

	SKIPN FTNXX		; Other end TOPS20/TENEX
	  TXO P2,<1B0>		; No, require confirmation

	CALL GETSTF		; Get foreign file name
	  JRST XXXCOM		; Deleted

	MOVE A,BREAKC
	CAIE A,C.ESC		; Want verification?
	  JRST RENAM2		; No

	HRRZI A,[ASCIZ / (to be) /] ; Don't get a JFN, prompt
	CALL GETNXX		; Get remote file status
	  JRST CRCOM		; File missing, message given
	  JRST RENAM7		; Ok, confirmed, B/ string
RENAM2:
	NOISE <
>
	HRRZI P1,[ASCIZ / (to be) /]
	MOVX P2,<<EFRNP2-FRNPT2>*5-1>
	MOVX P3,<POINT 7,FRNPT2>

	CALL GCHINI		; Initialize new command line
	HRRO B,P1
	CALL UPDCTR		; Prompt

	TXO P2,<1B0>		; Require confirmation
	CALL GETSTF		; Get foreign file name
	  JRST XXXCOM		; Deleted

	SKIPA
RENAM7:	  MOVE P3,B		; Save new name string pointer

	HRROI B,[ASCIZ /RNFR /] ; First command
	HRROI A,FRNPTH		; Old name
	CALL TELSND

	HRROI B,[ASCIZ /RNTO /]
	MOVE A,P3
	CALL TELSND
	JRST CRCOM
	SUBTTL	Command DELETE

.DELET:	CALL LF2ESC		; In case break was a LF

	HRRZI P1,[ASCIZ / (foreign file) /]
	MOVX P2,<<EFRNPT-FRNPTH>*5-1>
	MOVX P3,<POINT 7,FRNPTH>
	CALL GETSTF		; Get foreign file name
	  JRST XXXCOM		; Deleted

	CAIE C,C.ESC		; User request verification?
	  JRST DELET4		; No

	MOVE A,P3		; String
	MOVX B,<.GJLEG>		; Delete uses oldest generation
	CALL GTFSTS		; Verify foreign file
	  JRST CRCOM		; Foreign file not found
	  JFCL			; Other end not TENEX/TOPS20

DELET4:	NOISE <
>
	MSG <Do you really want to delete >

	HRROI A,FRNPTH
	PSOUT
	MSG <? (Y or N) >
	MOVX A,<.PRIIN>		; Break on all chars
	RFMOD
	TXO B,TT%WKP+TT%WKA
	SFMOD
	CALL TYI
	TRZ C,"y"-"Y"
	CAIE C,"Y"
	  JRST XXXCOM

	HRROI B,[ASCIZ /DELE /]
	HRROI A,FRNPTH
	CALL TELSND
	JRST CRCOM
	SUBTTL	Command DIRECT

.DIREC:	CALL LF2ESC		; In case break was a LF

	SETZM $FILST		; No attributes

; Get confirmed path name for directory

	MOVX P1,<[ASCIZ /*.*/],,[ASCIZ / (of) /]>
	MOVX P2,<<EFRNPT-FRNPTH>*5-1>
	MOVX P3,<POINT 7,FRNPTH>

	TXO P2,<1B0>		; Require confirmation
	CALL GETSTF		; Get foreign file name
	  JRST XXXCOM		; Deleted

	CAIE C,C.LF		; On new line
	  CALL PCRLF		; Will be

; Get local filespec for directory listing

	MOVX P1,<[ASCIZ /TTY:/],,[ASCIZ / (to local-file) /]>

	CALL GCHINI		; Initialize new line
	HRRO B,P1		; Prompt
	CALL UPDCTR

	MOVEI E,GTJBLK		; No default name.type
	CALL GTJINI

	MOVX A,<GJ%FOU>
	CALL GTJLFS		; Get local filespec
	  JRST LOPNX0
	MOVEM A,LCLJFN

	MOVX B,<FLD(7,OF%BSZ)+OF%WR>
	OPENF
	  JRST LOPNX1

; Get the direcotry data

	SETZM F$SEND		; Receive data
	SETZM F$KPGN		; No rename for generation #
	CALL PREASC
	TXO F,F.NOST		; No statistics

	HRROI B,[ASCIZ /LIST /]
	CALL DIREC9		; Rejoin GET command for data xfer
	  JFCL
	CLOSR (LCLJFN)
	JRST RSKP
	SUBTTL	Command GET

.GET:	CALL LF2ESC		; In case break was a LF
	SETZM $FILST		; Assume no attributes

; Get the foreign filespec, if TOPS20/TENEX allow ESC before confirmation

	HRRZI P1,[ASCIZ / (foreign-filename) /]
	MOVX P2,<<EFRNPT-FRNPTH>*5-1>
	MOVX P3,<POINT 7,FRNPTH>

	SKIPN FTNXX		; Other end TOPS20/TENEX
	  TXO P2,<1B0>		; No, require confirmation

	CALL GETSTF		; Get foreign path name
	  JRST XXXCOM		; Deleted

; Get filespec for local copy

	MOVX P1,<FRNPTH,,[ASCIZ / (to local-file) /]>

	MOVX A,<GJ%FOU>
	HRR A,P1		; Prompt
	CALL GETNXX		; Setup for GTJFN if remote is TOPS20/TENEX
	  JRST CRCOM ;LOPNX2	; File missing, message given
	  JRST GET5		; Yes, have a JFN
				; Isn't TOPS20/TENEX or error
	SETZM $FILST		; No attributes
	NOISE <
>
	CALL GCHINI
	HRRO B,P1		; Prompt
	CALL UPDCTR

	MOVX A,<GJ%FOU+.GJNHG>
	CALL GTJLFS		; Get file name or default
	  JRST LOPNX0
GET5:	MOVEM A,LCLJFN		; Save local JFN
	SETZM F$KPGN
 jfcl;	TXNE A,GJ%NHV		; Next higher version allowed?
 jfcl;	  SETOM F$KPGN		; Yes, try to retain generation #

; Get the data and, if TOPS200/TENEX, update file attributes

	CALL GETS1		; Do the work of the GET
	 SKIPA			; Error
	  CALL UPDFIL		; Update file attributes

	CLOSR (LCLJFN)
	JRST RSKP
	SUBTTL	Subroutine GETS1 - Do the work of the GET

;LCLJFN/For data

;	CALL GETS1
;Ret+1:	  Error
;Ret+2:	Ok

GETS1:	HRRZ A,LCLJFN
	MOVX B,<OF%WR>		; Open for writing.

; Decide what local file's byte size should be

	SKIPG D,$BYTE		; Is there a declared byte size?
	  MOVX D,<^D8>		; No. Default is eight
	SKIPG C,$TYPE		; Except if it's ASCII,
	  MOVX D,<^D7>		; Disc file should be ASCII
	CAIN C,TYPE.I		; Image type?
	  MOVX D,<^D36>		; Yes. Make words, will fix below
	STOR D,OF$BSZ,+B	; Put it in right place for OPENF

	OPENF
	  JRST LOPNX3		; Error message & return

; Perform data transfer

	SETZM F$SEND		; Direction flag for data fork
	CALL PREDAT		; Send any mode, type params.
	HRROI B,[ASCIZ /RETR /] ; Protocol retrieval cue

DIREC9:	; .DIREC CALLs here

	HRROI A,FRNPTH		; Name for it
	SETOM F$DTRQ		; Going to request transfer
	CALL TELSND		; Send the command
	CALL CWFORK		; Common fork wait and wrapup

	JRST RSKP		; Return from GET subr
	SUBTTL	Commands MAIL, APPEND, SEND

.MAIL:	TXZ F,F.APPE		; Not append
	TXO F,F.MLFL		; Mail file
	  JRST SND01		; Use common code
.APPE:	TXOA F,F.APPE		; Append, not send command.
.SEND:	  TXZ F,F.APPE		; Send, not append command
	TXZ F,F.MLFL		; Append or send, not mail
SND01:
	CALL LF2ESC		; In case break was a LF

	HRRZI P1,[ASCIZ / (local-file) /] ; No default, prompt

; Get local file

	MOVEI E,GTJBLK		; No default name.type
	CALL GTJINI

	MOVX A,<GJ%OLD+.GJDEF>	; Get the local file name
	CALL GTJLFS
	  JRST LOPNX0		; Bad confirm, probably.
	MOVEM A,LCLJFN		; Store JFN for that file

; Find foreign default

	MOVX C,<..NAMA+..TYPA+JS%PAF> ; If file
	SKIPE RETVER		;#4 RETAIN VERSION?
	 MOVX C,<..NAMA+..TYPA+..GENA+JS%PAF>	;#4 YES
	TXNE F,F.MLFL		; But for mail file,
	  MOVX C,<..NAMA>	; Just file name for user name
	HRROI A,FRNPT2
	HRRZ B,LCLJFN		; Type file name locally
	JFNS

; Find prompt & begin new line

	MOVX P1,<FRNPT2,,[ASCIZ / (to remote-file) /]>
	TXNE F,F.MLFL		; But for mail file,
	  MOVX P1,<FRNPT2,,[ASCIZ / (to remote-user) /]>

	CALL GCHINI		; Begin new line
	HRRO B,P1		; Prompt
	CALL UPDCTR

; Get foreign filespec

	MOVX P2,<<EFRNPT-FRNPTH>*5-1>
	TXO P2,<1B0>		; Require confirmation
	MOVX P3,<POINT 7,FRNPTH> ; Where to save foreign pathname
	CALL GETSTF		; Get foreign name
	  JRST XXXCOM

	JRST SND05		; Go do send
REPEAT 0,<
	SETZM FRNPTH		; Clear whole word so SKIPE works below

	HRROI A,[ASCIZ /   (to remote-file) /]

	SKIPE FTNXX		; Is foreign host a TOPS20 or TENEX? and
	 SKIPE TENEX		; We are a TOPS20?
	  SKIPA			; No, skip this
	   TXNE F,F.MLFL
	    JRST SND03
	PSOUT

	SETZM GTJBLK		; Clear the GTJFN block
	MOVX A,<GTJBLK,,GTJBLK+1>
	BLT A,GTJEND
	MOVX B,<GJ%FOU+GJ%CFM>
	HLLM B,GTJBLK+.GJGEN
	MOVX B,<.PRIIN,,.PRIOU>
	MOVEM B,GTJBLK+.GJSRC

	HRROI A,STRTMP		; Build string for file
	HRRZ B,LCLJFN
	MOVX C,<..DEVA!..DIRA!..NAMA!..TYPA!..GENA!JS%PAF>
	JFNS

	MOVEI A,GTJBLK
	HRROI B,STRTMP		; Get a JFN for it
	GTJFN
	  JRST xxxcom

	HRRZ B,A
	HRROI A,FRNPTH
	MOVX C,<..DEVA!..DIRA!..NAMA!..TYPA!..GENA!JS%PAF>
	JFNS

	MOVE A,B
	RLJFN
	  JFCL
	JRST snd05
SND03:
;zzz
	TXNE F,F.MLFL		; Mail file?
	  HRROI A,[ASCIZ /   (to remote-user) /]
	PSOUT

	CALL SEST
	MOVX X,<<EFRNPT-FRNPTH>*5-1>
	MOVX BP,<POINT 7,FRNPTH> ; Where to save foreign pathname
	SETZM FRNPTH		; Clear whole word so SKIPE works below
	CALL TSIN		; Foreign file name
	  JRST XXXCOM

	CAIN C,C.ESC		; Escape term?
	 SKIPE FRNPTH		; And no other characters?
	  JRST SND05		; No

	MOVX C,<..NAMA+..TYPA+JS%PAF>
	TXNE F,F.MLFL		; But for mail file,
	  MOVX C,<..NAMA>	; Just file name for user name
	HRROI A,FRNPTH
	HRRZ B,LCLJFN		; Type file name locally
	JFNS

	CALL SNDS1		; Call file sender after echoing name
	  JFCL
	JRST SND07		; Wrap up
> ; End of REPEAT 0

SND05:	CALL SNDS2		; Call file sender without echoing name
	  JFCL
SND07:	CLOSR (LCLJFN)
	JRST CRCOM
	SUBTTL	Subroutines SNDS1, SNDS2

;LCLJFN/Local JFN for data

; SNDS1 lists the foreign filespec before initiating the transfer

SNDS1:	HRROI A,FRNPTH		; Type file name locally
	PSOUT
	CALL PCRLF

SNDS2:

; Decide what local bytesize to use

	MOVX B,<OF%RD>		; Read file
	SETO C,			; Try to figure out the right
	MOVE A,$BYTE		; Size for local JFN
	SKIPG $TYPE		; ASCII?
	  MOVX C,<^D7>		; Yes. Local is ASCII too
	SKIPGE C		; Any decision for ASCII?
	  MOVE C,A		; No. Use declared byte size
	SKIPG C 		; If any
	  MOVX C,<^D8>		; No. Use default eight-bit for image
	STOR C,OF$BSZ,+B	; Put in place for OPENF

	TXNE F,F.MLFL		; If mail file, force ASCII read
	  MOVX B,<FLD(7,OF%BSZ)+OF%RD>

	HRRZ A,LCLJFN
	OPENF
	  CALLRET LOPNX3	; Error message & return

; Setup for transfer depending on command MAIL vs STORE/APPEND

	SETOM F$SEND		; Direction flag for data fork
	TXNE F,F.MLFL		; If mail, set ASCII params
	  JRST [CALL PREASC
		HRROI B,[ASCIZ /MLFL /] ; FTP command
		JRST SNDS7]
	CALL PREDAT		; Set up socket 255 mechanism
	HRROI B,[ASCIZ /STOR /] ; Tell foreign guy to store file
	TXNE F,F.APPE		; Or maybe append it,
	  HRROI B,[ASCIZ /APPE /]
SNDS7:

; Transfer the data

	HRROI A,FRNPTH		; Under this name
	SETOM F$DTRQ		; Going to request transfer
	CALL TELSND
	CALL CWFORK		; Fork wait routine
	JRST RSKP		; Successful completion
	SUBTTL	Command MULTIPLE ...

.MULT:	TXZ F,F.APPE!F.HCOM	; Write, don't search host names

	MOVE X,MLTTBX		; Set up to search table
	MOVEM X,WORDXP
	CALL GETWRD		; GET or SEND word
	  RET			; Neither

;CWL ? FOR HELP?

	SKIPGE C,RECX		; Good answer?
	  RET
	HRRZ C,MLTTB1+1(C)	; Get routine address
	CALLRET 0(C)		; Dispatch


DEFINE MULTM <
CC (<GET>,.MGET)
CC (<SEND>,.MSEND)
>

DEFINE CC (WORD,TAG)<
	XWD [ASCIZ \WORD\],TAG
> ; End of DEFINE CC


MLTTB1:	NMCOMS,,NMCOMS
	MULTM
NMCOMS==.-MLTTB1-1


MLTTBX:	XWD -NMCOMS,MLTTB1+1
	SUBTTL	Command MULTIPLE SEND

.MSEND:	CALL LF2ESC		; In case break was a LF
	TXZ F,F.MLFL!F.APPE

	MOVEI E,GTJBLK		; No defaults
	CALL GTJINI

	HRRZI P1,[ASCIZ / (local file group) /]
	MOVX A,<GJ%OLD+GJ%IFG>
	CALL GTJLFS
	  JRST LOPNX0
	MOVEM A,LCLJFN

MSL1:	HRROI A,FRNPTH		; Place to build foreign file name
	HRROI B,PREFXB		; Yes. Point to it
	SETZ C,
	SKIPE PREFIX		; Is there a prefix first?
	  SOUT

	HRRZ B,LCLJFN		; Now put on the name and extension
	MOVX C,<..NAMA+..TYPA+JS%PAF>
	SKIPE RETVER		;#4 RETAIN?
	 MOVX C,<..NAMA+..TYPA+..GENA+JS%PAF>	;#4 YES
	JFNS			; Let system parse file name

	HRROI B,SUFFXB		; Yes. Pointer to it
	SETZ C,
	SKIPE SUFFIX		; Trailer? (ACCT, PPN,...)
	  SOUT

	TXO F,<F.KJFN!F.NOST>	; Keep JFN for stars and prevent verbosity
	CALL SNDS1		; And do the SEND, echoing foreign filespec
	  JFCL			; Error message??

	CLOSK (LCLJFN)		; Close file

	MOVE A,LCLJFN		; Now step to next file
	GNJFN
	 SKIPA			; No more
	  JRST MSL1		; Go send this one

	CALL PCRLF
	CLOSR (LCLJFN)

; CWFORK did this & so did data fork
;	CALL CLSDIF		; Close and release data conn if req'd

	JRST RSKP		; Ok return from .MULT
	SUBTTL	Command MULTIPLE GET

.MGET:	CALL LF2ESC		; In case break was a LF
	SETZM $FILST		; Assume no attributes

	HRRZI P1,[ASCIZ / (remote file group) /]
	MOVX P2,<<EFRNPT-FRNPTH>*5-1>
	MOVX P3,<POINT 7,FRNPTH>
 JFCL;	SKIPN FTNXX
	  TXO P2,<1B0>		; Require confirmation
	CALL GETSTF		; Get foreign path name
	  JRST XXXCOM		; Deleted

 JFCL;	HRROI A,[ASCIZ / (to local-file) /]
 JFCL;	CALL GETNXX		; Setup for GTJFN if remote is TOPS20/TENEX
 JFCL;	  JRST LOPNX2		; Foreign file not found
 JFCL;	  JRST MGET5		; Yes, all set
				; Isn't or error
	CAIE C,C.LF
	  CALL PCRLF

	MOVX A,<GJ%FOU+GJ%TMP+GJ%DEL+GJ%SHT> ; A temp file to hold list.
	HRROI B,[ASCIZ /-FTP-TEMP-.TMP;P770000;T/]
	GTJFN
	  JRST MGX1		; Can't
	MOVEM A,LCLJFN

	MOVX B,<FLD(7,OF%BSZ)+OF%WR> ; Write on it
	OPENF
	  JRST MGX2		; Can't

	SETZM F$SEND		; Declare receive direction
	SETZM F$KPGN		; No rename for generation #
	TXO F,F.KJFN		; Keep the directory file JFN

	CALL PREASC		; Send params for NLST

	TXO F,F.NOST		; Don't type out NLST statistics
	HRROI B,[ASCIZ /NLST /]
	HRROI A,FRNPTH		; Send NLST of the path name
	SETOM F$DTRQ		; Going to request transfer
	CALL TELSND

	CALL CWFORK		; Wait for the file to come in.

	CLOSK (LCLJFN)		; Close directory temp file
	HRRZ A,LCLJFN		; Now re-open the temp for reading
	MOVX B,<FLD(7,OF%BSZ)+OF%RD>
	OPENF
	  JRST MGX2		; Can't
	MOVEM A,DIRJFN		; Hold it
	SETOM LCLJFN
 JFCL;	SETOM F$KPGN		; Allow rename for generation #

MGL1:	HRRZ A,DIRJFN		; Main loop. Get a file name
	HRROI B,FRNPTH		; Where it goes
	MOVX C,<<EFRNPT-FRNPTH>*5-1>
	MOVX D,<C.LF>		; Quit on linefeed
	SIN
	JUMPLE C,MGX3

	MOVX C,<C.NUL>		; Force a NUL at end of name
	IDPB C,B

	GTSTS
	TXNE B,GS%EOF		; Hit EOF yet?
	  JRST MG90		; Yes. Quit

	HRROI A,FRNPTH		; Foreign name
	MOVX B,<.GJDEF>		; Highest generation
	CALL GTFSTS		; Get its info, parse into GTJBLK
	  JRST MGX4		; File is missing??
	  JFCL;name.ext/GTJBLK; Not TOPS20/TENEX, just continue

	MOVX C,C.ESC		; Note $FILST is non-zero
	MOVEM C,BREAKC

	MOVX A,<GJ%FOU>
	MOVX P2,<<EFRNP2-FRNPT2>*5-1>
	HRRZ X,P2
	MOVX P3,<POINT 7,FRNPT2>
	MOVE BP,P3
	SETZM (P3)
; Local name to user
	CALL GETNXC		; Default everything
	  JRST MGX6		; Error
	  JRST MGX5		; ?? We didn't say C.LF

	MOVX A,<GJ%FOU!GJ%SHT>
	HRROI B,FRNPT2
	GTJFN
	  JRST MGX5		; What's wrong??
	MOVEM A,LCLJFN		; Ok

	CALL PCRLF

	CALL GETS1		; Do the work of the GET
	 SKIPA			; Error
	  CALL UPDFIL		; Update file attributes

	CLOSR (LCLJFN)
	TXNE F,F.CGFG		; User type BELL?
	  JRST MG90		; Yes. Quit.
	JRST MGL1		; Loop thru all files in list
	SUBTTL	Command MULTIPLE GET, cont.

MGX6:	HRROI B,FRNPT2		; String GTJFN rejected
	SKIPA
MGX5:	  HRROI B,$FILST	; Foreign filespec that lost

	HRROI A,[ASCIZ /
? Can't	open local file - GTJFN: /]
	PSOUT
	MOVX A,<.PRIOU>
	SETZ C,
	SOUT
	HRROI A,CRLFM
	CALL ERRSUB
	CALL PCRLF
	JRST MGL1		; Try the next one.

MGX4:	SKIPA A,[ASCIZ /
? Foreign file not found: /]
MGX3:	  HRROI A,[ASCIZ /
? Foreign name too long: /]
	HRLI A,-1
	PSOUT
	HRROI A,FRNPTH
	PSOUT
	CALL PCRLF
	JRST MGL1


MGX2:	CLOSR (LCLJFN)		; Errors
MGX1:	HRROI A,[ASCIZ /
? Can't open scratch file -FTP-TEMP-.TMP;T
/]
	CALL ERRSUB		; Tell why


; Reached end

MG90:	SKIPG A,DIRJFN		; Directory file? (Better be)
	  JRST MG91		; No.
	CLOSK (DIRJFN)		; CLOSF the file so in can be deleted
	HRRZ A,DIRJFN		; Now delete and release the JFN
	DELF			; Delete and release JFN
	  JFCL
MG91:	SETOM DIRJFN
	CLOSR (LCLJFN)

; CWFORK did this & so did data fork
;	CALL CLSDIF		; Close and release data conn if req'd

	JRST RSKP		; Return from .MGET
	SUBTTL	Error returns, SETJFS, LF2ESC

; GTJFN failed - .DIREC, .GET, .SEND/.APPE/.MAIL, .MSEND
; There is no LCLJFN, but CLOSR can handle that situation

LOPNX0:	CAIN A,GJFX33		; No file name specified?
	  JRST CRCOM		; Yes, probably line delete, exit quietly

; OPENF failed - .DIREC

LOPNX1:	CALL SETJFS		; Get local name
	CLOSR (LCLJFN)		; Release JFN
	JRST ERRSYS		; Message, System message, next command

; Data transfer failed, returning to command processor with LCLJFN valid
; .MGET

LOPNX2:	CALL SETJFS		; Get local name
	JRST ERRSYS		; Message, System message, next command

; Data transfer failed, returning to command processor with LCLJFN valid
; GETS1, SNDS1, SNDS2

LOPNX3:	CALL SETJFS		; Get local name
	CALLRET ERRSUB		; Message, System message, return

; Build error string

SETJFS:	HRROI A,ERRSTR		; String
	HRROI B,[ASCIZ /
? Can't	open /]
	SETZ C,
	SOUT

	SKIPG B,LCLJFN		; Have a local JFN?
	  JRST SETJFT		; No
	MOVX C,<..DEVD!..DIRD!..NAMA!..TYPA!..GENA!JS%PAF>
	JFNS
	JRST SETJFU
SETJFT:
	HRROI B,[ASCIZ /local file/]
	SOUT
SETJFU:	MOVX B,<".">
	BOUT
	MOVX B,<" ">
	BOUT
	MOVX B,C.NUL
	BOUT
	HRROI A,ERRSTR
	RET
	SUBTTL	Subroutine DOICP - TCP

IFN TCPF,<
; Fill addresses and ports into file block

DOICP:	MOVEI A,.FHSLF		; Clear any "last error"
	MOVEI B,0		; to avoid phony failure reasons
	SETER
	ERJMP .+1
	TXZ F,F.ABOR!F.CGFG	; Clear forced abort flags

	MOVE A,USRSKT		; Disambiguate old and new
	ADDI A,1		;  ports by counting low 8 bits
	DPB A,[POINT 8,USRSKT,35] ; (Leave job number in high 8 bits)
	MOVEI A,T.CDB+SCON	; Connection descriptor block
	MOVE B,USRSKT
	MOVEM B,.TCPLP(A)	; Set local port
	MOVE B,FHSTN
	MOVEM B,.TCPFH(A)	; and foreign host
	MOVE B,FTPSKT
	MOVEM B,.TCPFP(A)	; and foreign standard port

; Funny GTJFN to open the connection

	MOVEI A,SCON		; File block
	MOVX B,<-T.NDBF,,TELRBF>
	MOVX C,<T.BFSZ>
	TXO C,<TCP%FS>		; Force synchronization
	$GTJFN
	  JRST DOICPF		; Failed
	MOVEM A,SCON		; The "JFN" for the connection
	MOVEM A,RCON

; Wait here for synchronization - user may abort it with ^G

	MOVX D,<-CNTMOT,,0>	; Timeout
DOICPW:	MOVX A,<^D1000>		; A second
	DISMS			; Wait here so may be aborted

	TXNE F,F.ABOR!F.CGFG	; Request to abort?
	  JRST DOICPA		; Yes, abort

	MOVEI A,SCON
	CALL CONSYN		; Connecion synced?
	  JRST DOICPA		; Leave if aborted
	  AOBJN D,DOICPW	; Not yet, wait a second
	JUMPGE D,DOICPA		; Give up

	MOVX B,<FLD(8,OF%BSZ)!OF%RD!OF%WR> ; TELNET connection is 8-bit bytes
	SKIPLE A,SCON		; No "JFN" ??
	 $OPENF
	  JRST DOICPF		; Failed
	TXO F,F.TOPN		; Indicate TELNET conn open
	JRST RSKP

; TELNET commands to ECHO & not ECHO

TNSDOE:	BYTE (8)TN.IC,TN.DO,TN.OEC ; IAC-DO-ECHO (For testing)
TNSDNE:	BYTE (8)TN.IC,TN.DN,TN.OEC ; IAC-DONT-ECHO


; Abort TELNET connection on error or request

DOICPA:	MOVX A,<.FHSLF>
	MOVX B,1B<ABBCHN>	; Abort TELNET & data connections
	IIC


; Report connection failure

DOICPF:	CALL PCRLF
	MOVX A,<.PRIOU>		; Output the error message
	MOVX B,<.FHSLF,,-1>	; Last error for this process
	SETZ C,
	ERSTR
	 JFCL
	 SKIPA			; ??
	  RET			; Got a system message
	HRROI A,[ASCIZ /
Can't connect to server for unknown reason/]
	PSOUT
	RET

> ; End of IFN TCPF
	SUBTTL	Subroutine DOICP - NCP
IFE TCPF,<		; Define these only for NCP version

; Finite state machine parameters
; State Codes

;FSDEAD==0
;FSCLZD==1
;FSPNDG==2
;FSLSNG==3
FSRFCR==4
;FSCLW2==5
FSRFCS==6
FSOPND==7
;FSCLSW==10
;FSDATW==11
;FSRFN1==12
;FSCLZW==13
;FSRFN2==14
;FSKILD==15
;FSFREE==16

;OPERATING SYSTEM PARAMS IN HOST TABLE (1.30 OR LATER)

;	SERVER==1B0		;SITE IS A SERVER
;	USER==1B1		;SITE IS A USER
;	NICKNM==1B2		;NAME IS A NICKNAME
;USE .HS10X OPS10X==1B8		;SYSTEM RUNS TENEX
;USE .HSITS OPSITS==2B8		;SYSTEM RUNS I.T.S
;USE .HSDEC OPST10==3B8		;SYSTEM RUNS SOME KIND OF DEC TOPS10 MONITOR
;	OPSTIP==4B8		;SITE IS A TIP
;	OPSMTT==5B8		;SITE IS A MAG-TAPE TIP
;USE .HST20 OPST20==11B8		;SITE IS A TOPS20

;INITIAL CONNECTION PROTOCOL
;CALLED	ONLY FROM HOST CONNECT COMMAND

DOICP:	SETOM IJFN		; These JFNs not yet assigned
	SETOM RCON
	SETOM SCON
	HRROI A,GTJSTR		; Put string for socket in buffer
	HRROI B,[ASCIZ /NET:/]	; Device field is first
	SETZ C, 		; Quit on NULL
	SOUT
	PUSH P,A		; Save location of this number for later
	MOVE B,USRSKT		; Default user socket number
	MOVX C,<NO%LFL+NO%ZRO+FLD(3,NO%COL)+10>	; NOUT as 3-digit octal
	NOUT
	  CALL BOMB
	MOVX B,<".">		; End of local half
	IDPB B,A		; Separator
	MOVE B,FHSTN		; Foreign host number
	MOVX C,<OCTRAD>		; Octal
	NOUT			; To string
	  CALL BOMB
	MOVX B,<"-">		; Separator before socket number
	IDPB B,A		; To string
	PUSH P,A		; Save string address for final socket
	MOVE B,FTPSKT		; Standard FTP ICP socket
; CWL
	SKIPE PRIVF		; If private version
	  ADDI B,400

	MOVX C,<OCTRAD>		; Output in octal
	NOUT			; To string
	  CALL BOMB
	HRROI B,[ASCIZ /;T/]	; Make local socket be relative to job.
	SETZ C,
	SOUT			; By adding ;T to output name
	MOVX A,<GJ%SHT>		; GTJFN short form, string.
	HRROI B,GTJSTR		; Pointer to string
	GTJFN			; Get a JFN
	  JRST ICPFL2		; IMP not connected failure.
	MOVEM A,IJFN		; Save JFN of this connection
	MOVX B,<FLD(40,OF%BSZ)+OF%RD> ; Open the connection to read 32bit num
	CALL .OPENF		; Open using PI and DISMIS for speed
	  JRST ICPFL3		; Can't open connection.
	BIN			; Get the remote host's socket "S"
	MOVEM B,FORNS		; Save foreign S
	SKIPN F$VBOS		; Verbose?
	  JRST DOICP2		; No
	PUSH P,A		; Yes.
	HRROI A,[ASCIZ /(RCVD FOR'N SOCKET # /]
	PSOUT
	PUSH P,B
	PUSH P,C
	MOVX A,<.PRIOU>
	MOVX C,<OCTRAD>
	NOUT
	  JFCL
	POP P,C
	POP P,B
	HRROI A,[ASCIZ /)
/]
	PSOUT
	POP P,A
DOICP2:	CLOSF			; Free the ICP socket.
	  JFCL
	POP P,A 		; Back up to start of 4n socket in string

; ICPA:
	MOVX C,<OCTRAD>		; Octal number for socket
	NOUT			; Put it in the string
	  CALL BOMB
	HRROI B,[ASCIZ /;T/]	; And ;T after new number
	SETZ C,
	SOUT			; Add to string
	POP P,A 		; Retrv pos of lcl socket in JFN str
	MOVE B,USRSKT		; Protocol says previous +2
	ADDI B,2		; Is the place he will connect to
	MOVX C,<NO%LFL+NO%ZRO+FLD(3,NO%COL+10)>	; 3-digit octal number
	NOUT
	  CALL BOMB
	MOVX B,<".">		; Restore terminator clobbered by NOUT
	IDPB B,A		; Now have new name for socket pair.
;ICPB:
	HRROI B,GTJSTR		; Pointer to name string
	MOVX A,<GJ%SHT>		; Set up for GTJFN of this pair
	GTJFN			; Get the send JFN
	  JRST ICPFL4		; Can't
	MOVEM A,SCON		; Save TELNET send JFN
	HRROI B,GTJSTR		; And another pair for receive
	MOVX A,<GJ%SHT>
	GTJFN
	  JRST ICPFL5
	MOVEM A,RCON		; TELNET receive JFN
	MOVE A,SCON		; Now open them
	MOVX B,<FLD(10,OF%BSZ)+FLD(7,OF%MOD)+OF%WR> ; Send, no wait, buffered.
	OPENF
	  JRST ICPFL6
	MOVE A,RCON		; Open receive side
	MOVX B,<FLD(10,OF%BSZ)+OF%RD> ; Eight bit bytes, wait.
	OPENF
	  JRST ICPFL7		; Can't open.
	VMSG <(OPENED RCV SOCKET)
>
	MOVE A,SCON		; See if send side made it yet.
	CALL OPNWAT
	  JRST ICPFL8		; No good on send side.
	VMSG <(OPENED SEND SOCKET)
>
	TXO F,F.TOPN		; TELNET connection is now open.
	JRST RSKP		; Succeeded in ICP'ing


ICPFL4:	JSP X,ICPFX
	ASCIZ /No JFN for TELNET send side/
ICPFL5:	JSP X,ICPFX
	ASCIZ /No JFN for TELNET receive side/
ICPFL6:	JSP X,ICPFX
	ASCIZ /Can't open TELNET send connection/
ICPFL7:	JSP X,ICPFX
	ASCIZ /Can't open TELNET receive connetion/
ICPFL8==ICPFL6
ICPFL2:	JSP X,ICPFX2		; Two deep on stack. Set X to msg
	ASCIZ /IMP is disconnected/
ICPFL3:	MOVEI X,[ASCIZ /host is rejecting/]
	CALL HSTCHK		; Is host up?
	  MOVEI X,[ASCIZ /host is disconnected/] ; No
ICPFX2:	POP P,(P)		; Remove 4n sock byte pointer
; ICPFX1:
	POP P,(P)		; Remove local sock byte ptr
ICPFX:	HRROI A,[ASCIZ /
Can't connect to server because  /]
	PSOUT
	HRROI A,(X)		; Type error message
	PSOUT
	CLOSR IJFN
	CLOSR RCON
	CLOSR SCON
	RET		; Fail return from ICP attempt
	SUBTTL	Subroutine .OPENF

;Called	from DOICP routine only

.OPENF:	PUSH P,A		; JFN to stack
	TXO B,FLD(6,OF%MOD)	; Change net open mode to no wait
	OPENF			; Try opening
	  JRST APOPJ		; Immediate failure. Report it
	JRST OPNWT0		; Go wait for some action

OPNWAT:	PUSH P,A		; Save the JFN to wait for
OPNWT0:	TXZ F,F.NTIC		; Clear wait counter
	MOVX B,<.MOAIN>		; Interrupt MTOPR for net
	MOVSI C,777700+NTICHN	; No PI for INS, INR, NTICHN for FSM
	MTOPR			; Assign the NTICHN int
OPNWTL:	TXZ F,F.NTIC		; Clear counter again
	MOVE A,0(P)		; Get the JFN to wait for
	GDSTS			; Look at FSM
	ROT B,4 		; State code
	ANDI B,17
	CAIN B,FSOPND		; Connection opened?
	  JRST OPNWIN		; Yes. Good.
	CAIE B,FSRFCS		; RFC still outstanding?
	  JRST OPNFL		; No. Must have failed.
	MOVX A,<^D100000>	; Wait a hundred seconds (interrupt out)
	TXON F,F.NTIC		; Set counter up since waiting
OPNWTK:	  DISMS			; Wait a while. Tag for int check.
	JRST OPNWTL		; Wait some more, new state.

OPNWIN:	POP P,A 		; Get back JFN
	MOVX B,<.MOAIN>		; Turn interrupt off for FSM
	SETO C,
	MTOPR
	JRST RSKP		; And skip return from OPNWAT

OPNFL:	POP P,A 		; Get JFN back
	CLOSF			; Close the connection
	  JFCL
	RET			; Return failure from OPNWAT

NTIINT:	MOVEM A,NTIIA		; Save an AC
	TXON F,F.NTIC		; First change of state?
	  DEBRK			; Yes. Wait some more.
	HRRZ A,RETPC3		; No. See if still in the DISMS
	CAIE A,OPNWTK
	CAIN A,OPNWTK+1
	  SKIPA A,[PC%USR+OPNWTL] ; Yes. Break out of it.
	SKIPA A,NTIIA		; No. Get back user AC
	  MOVEM A,RETPC3	; Yes. Change return. Bad AC ok.
	DEBRK
	SUBTTL	Subroutine HSTCHK

;Called	from DOICP routine only

HSTCHK:	PUSH P,A		; Skip if host is up
	PUSH P,B

REPEAT 0,<
	MOVE A,['IMPHRT']	; Table of host bits
	SYSGT
	PUSH P,B		; Save table number
	MOVE A,FHSTN		; Host to check on
	IDIVI A,^D36		; Convert to word and bit number
	HRLM A,0(P)		; Stash word number
	POP P,A 		; XWD WORD,TABLE
	GETAB			; Get the word with host bit in it
	  SETZ A,		; Not there. Assume down (imposs)
	ROT A,(B)		; Select the bit
	SKIPGE A		; Test bit in sign of a for upness
	  AOS -2(P)		; On = Up = Skip return
> ; End of REPEAT 0

	PUSH P,C
	PUSH P,D
	MOVX A,<.GTHHN>
	MOVE C,FHSTN
	GTHST
	  SETZ D,
	MOVEM C,FHSTN
	MOVEM D,FHSTST
	TXNE D,HS%UP		; Host up?
	  AOS -4(P)		; B0 on= Up = Skip return
	POP P,D
	POP P,C
> ; End of IFE TCPF

BAPOPJ:	POP P,B 		; Restore AC's
APOPJ:	POP P,A
	RET
	SUBTTL	Subroutine MAKFRK

;	CALL MAKFRK	Make an inferior.
;Ret+1:	  Failed
;Ret+2:	Success, returns handle in X.

MAKFRK:	MOVX A,<CR%CAP>		; Pass on capabilities
	CFORK			; Make the fork
	  RET 			; Can't
	MOVEM A,X		; Copy for return from this routine
	RPCAP			; Make it legal to PSI the superior
	TXO B,SC%SUP
	TXO C,SC%SUP
	EPCAP

	MOVEI C,0		; Pass 0-GSTOP to inferior
	MOVEI D,GSTOP
	CALL MAP2IN

	MOVEI C,HSBAS		; Pass HSBAS-HSTOP to inferior
	MOVEI D,HSTOP
	CALL MAP2IN

IFN DEBUG,<			; If debugging, DDT too
	MOVE A,[.FHSLF,,770]	; Is DDT present?
	RPACS
	MOVEI C,770000
	MOVEI D,777777
	TXNE B,PA%PEX
	  CALL MAP2IN		; Yes.
> ; End of IFN DEBUG
REPEAT 0,<		; cwl why below?
	MOVNI D,PSTOP-PSBAS	; Length of process private stuff
	LSH D,11		; In pages
	HRRI D,<PSBAS_<-11>>	; Where it starts
MKFKL2:	SETO A,			; Make page go away in inferior
	SETZ C,
	MOVSI B,(X)		; Fork handle
	HRRI B,(D)		; Page number
	PMAP			; All gone
	MOVX B,<.FHSLF,,0>	; Now let go of it in top fork
	HRRI B,(D)
	SETO A,
	SETZ C,			; Just one page
	PMAP
	AOBJN D,MKFKL2		; For all private pages
> ; End of REPEAT 0
	JRST RSKP
	SUBTTL	Subroutines MAP2IN, CLSDIF

;	MOVEI C,first address
;	MOVEI D,last address
;	CALL MAP2IN


MAP2IN:	TRZ C,777		; Beginning of page
	SUB D,C			; Length-1
	MOVNI D,1(D)		; Negative length
	LSH D,^D<18-9>		; AOBJN counter
	LSH C,^D<-9>		; Address to page #
	HRR D,C			; -n,,page #
MAP2IL:	MOVEI A,0(D)		; Pointer to page in top fork
	HRLI A,.FHSLF
	RPACS			; Page exist in superior?
	TXNN B,PA%PEX
	  JRST MAP2IM		; No, don't bother mapping it
	HRLZ B,X		; Inferior handle
	HRR B,A 		; Same page
	MOVX C,<PM%RD+PM%WR+PM%EX> ; All access
	PMAP			; Create the page in inferior
MAP2IM:
	AOBJN D,MAP2IL		; Loop for whole common code
	RET



;	CALL CLSDIF		; Close and release data conn if req'd

CLSDIF:

IFN TCPP,<			; Have to close data connection for EOF?
	TXO F,F.CLSD		; Assume close at EOF (NCP always closes)

	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
	TXNN F,F.CLSD
	  RET
> ; End of IFN TCPP

	CLOSD DATCON		; Required, Close data connection
	RET
	SUBTTL	Subroutines PREASC, PREDAT

; F$SEND & LCLJFN must be set


PREASC:	SETZM $MODE2		; MODE.S
	SETZM $STRU2		; STRU.F
	SETZM $TYPE2		; TYPE.A Entry for ASCII xfer, like LIST
	SETZM $BYTE2		; Set to ^D8 below
	SETZM $FORM2		; FORM.N
	JRST PREDT0

PREDAT:	MOVX A,<PARAMS,,PARAM2> ; Copy permanent params
	BLT A,EPAR2
PREDT0:	TXZ F,F.TYPX		; Clear flags

	SKIPGE A,$MODE2		; Set default to zero
	  SETZB A,$MODE2
	SKIPGE B,$STRU2
	  SETZB B,$STRU2
	SKIPGE C,$TYPE2
	  SETZB C,$TYPE2
	SKIPG D,$BYTE2		; Byte size specified?
	  MOVX D,<^D8>		; No, use default
	MOVEM D,$BYTE2

; Make a few checks before open data connection & start data fork

	TXO F,F.CLSD		; Assume close at EOF (NCP always closes)
IFN TCPP,<			; Have to close data connection for EOF?
	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

; Check if PAGED

IFN TCPP,<CAIE B,STRU.P>	; See if PAGED
IFE TCPP,<CAIE C,TYPE.X>	; See if PAGED
	    JRST PREDT2		; Not PAGED type

	HRROI A,[ASCIZS (<
? Paged	transfer must be 36-bit bytesize.
>,<
? PAGED	transfer must be TYPE L 36.
>,<>)]
	CAIE D,^D36		; Ok, but legal only for 36 bits
	  JRST PREDX2		; No good.
	SKIPN F$SEND		; And on sending, only from DSK
	  JRST PREDT1		; Receiving, ok.

	HRRZ A,LCLJFN		; Send. See if a disk
	DVCHR
	HRROI A,[ASCIZ /
? Paged	SENDs must be from NUL: or DSK: files.
/]
	LOAD C,DV$TYP
	CAIE C,.DVDSK		; Disk?
	 CAIN C,.DVNUL		; Or NUL:?
PREDT1:	  TXOA F,F.TYPX		; Yes (for ^T)
	   JRST PREDX2		; No, complain
PREDT2:

; Send parameters for data transfer, if required

	MOVE B,$MODE2		; And same for MODE ...
	CAMN B,$MODE3		; New mode?
	  JRST PREDT3		; No
	MOVEM B,$MODE3
	HLRO A,MODTAB+1(B)
	HRROI B,[ASCIZ /MODE /]
	CALL TELSND
PREDT3:


	MOVE B,$STRU2		; Structure stated?
	CAMN B,$STRU3		; New structure?
	 JRST PREDT4		; No
	MOVEM B,$STRU3		; Yes. Update and send
	HLRO A,STRTAB+1(B)	; Cue character
	HRROI B,[ASCIZ /STRU /]
	CALL TELSND		; Send parameter
PREDT4:

	MOVE B,$BYTE2		; Byte size specified?
	CAMN B,$BYTE3		; New byte size?
	  JRST PREDT5		; No
	MOVEM B,$BYTE3		; Yes. Update and send
IFN TCPP,<
	MOVE C,$TYPE2		; TYPE L ?
	CAIN C,TYPE.L		; If not, shouldn't need to send size...
	  JRST PREDT6		; TCPP sends byte size as part of TYPE L
> ; End of IFN TCPP

IFE TCPP,<
	HRROI A,STRTMP		; Yes.
	MOVX C,<DECRAD>		; Must convert it to a string for sender
	NOUT
	  CALL BOMB
	HRROI B,[ASCIZ /BYTE /] ; The FTP directive
	HRROI A,STRTMP		; And the value
	CALL TELSND		; Send it out
> ; End of IFE TCPP
PREDT5:


	MOVE B,$TYPE2		; New TYPE ?
	CAMN B,$TYPE3
	  JRST PREDT7		; No
	MOVEM B,$TYPE3		; Need to send it
	HLRO A,TYPTAB+1(B)	; Get the cue character
	HRROI B,[ASCIZ /TYPE /]
IFE TCPP,<
	CAIN A,"X"		; TYPE X?
	  JRST [ HRROI A,[ASCIZ /XTP/]
		 JRST .+1]	; And on to next param.
> ; End of IFE TCPP
IFN TCPP,<
	CAIN A,"L"		; Logical byte?
PREDT6:	  JRST [MOVX A,<TYPE.L>	; In case entered via PREDT6
		MOVEM A,$TYPE3
		MOVE B,$BYTE3	; Yes. (Note $BYTE3 was updated above)
		HRROI A,STRTMP
		MOVX C,<DECRAD>	; Must convert it to a string for sender
		NOUT
		  CALL BOMB
		HRROI B,[ASCIZ /TYPE L /]
		HRROI A,STRTMP
		JRST .+1]
> ; End of IFN TCPP
	CALL TELSND		; Send parameter character
PREDT7:

IFE TCPF,<SETOM SOC255>		; No socket response yet
	SETOM CGCOUNT		; No Control-G requests
IFN TCPF,<
; Establish listening TCP data connection BEFORE TELSND transfer command
	TXZ F,F.ABOR!F.CGFG	; Clear forced abort flags
	SETZM F$DTRQ		; No outstanding request
	SETZM F$DTIP		; No data transfer in progress
	SETZM F$DTDR		; Nor done reply
	SETZM NBYTES		; Number of bytes transferred
	SETZM PAGENO

	SKIPLE DATCON		; Connection already established?
	  JRST PREDT8		; Yes
	SETZM F$DOPN		; No

	MOVEI A,T.CDB+DATCON	; Connection descriptor block
	MOVE B,USRSKT
	MOVEM B,.TCPLP(A)	; Set local port
	MOVE B,FHSTN
	MOVEM B,.TCPFH(A)	; and foreign host
	MOVE B,FTPSKT
	SUBI B,1		; and foreign standard port
	MOVEM B,.TCPFP(A)	; is one less than TELNET port

	MOVEI A,DATCON		; File block
	MOVX B,<-T.NDBF,,DATBUF>
	MOVX C,<T.BFSZ>		; No TCP open flags
	$GTJFN			; Listen but don't wait
	  JRST PREDX1		; Failed
	MOVEM A,DATCON		; The "JFN" for the connection
PREDT8:
> ; End of IFN TCPF
	RET


PREDX1:	CLOSR LCLJFN		; Clean up

	HRROI A,[ASCIZ /
? Can't	open the data connection.
/]
	SETOM F$TCLS		; Request close of TELNET connection
	JRST ERRSYS		; Tell why


PREDX2:	PUSH P,A		; Save message
	CLOSR LCLJFN		; Clean up
	POP P,A
	JRST ERRMSG
	SUBTTL	Subroutine CWFORK

; Common wait for data fork.

CWFORK:
IFE TCPF,<TXZ F,F.ABOR!F.CGFG	; IFN TCPP - PREDAT cleared it
	  SETZM F$DOPN		; Count when data conn is opened
	  SETOM F$DTRQ		; No outstanding request
	  SETZM F$DTIP		; No data transfer in progress
	  SETZM F$DTDR		; Nor done reply
	  SETZM NBYTES		; Number of bytes transferred
	  SETZM PAGENO>
	SETZM F$WORK		; Haven't had a TIMEOK

	SKIPG A,DFORKH		; Get run and console times
	  JRST CWFK4		; ??
	RUNTM			; Before anything starts
	MOVEM A,CPUTIM
	MOVEM C,DAYTIM

	SKIPG A,DFORKH		; Start the data transfer fork
	  JRST CWFK4		; ??
	MOVEI B,DFRKSA		; Where it starts
	SFORK			; Make the data go.
	JUMPLE A,CWFK4		; ??
FWPC==.	; For the int routine to look for WFORK JSYS
	WFORK

	SKIPG A,DFORKH		; Make sure good termination
	  JRST CWFK4		; ??
	RFSTS
	HLRZ A,A		; Should be a .RFHLT for HALTF
	TXNN F,F.ABOR!F.CGFG	; Don't gripe if forced by user or server
	 CAIN A,.RFHLT
	  JRST CWFK5		; Ok

	PUSH P,B		; Stash the PC
	MSG <
? Data fork terminated, PC = >
	MOVX A,<.PRIOU>
	POP P,B
	HRRZS B
	MOVX C,<OCTRAD>
	NOUT
	  JFCL
	CALL PCRLF
CWFK5:
	SUBTTL	Subroutine CWFORK, cont.

	SKIPG A,DFORKH		; Fork handle
	  JRST CWFK4		; ??
	HFORK			; Stop it in case wasn't voluntary

	RUNTM			; Get console and run times
	SUB A,CPUTIM		; Difference in times
	IMULI A,^D1000	 	; Make milliseconds
	PUSH P,B
	IDIVI A,(B)
	POP P,B
	MOVEM A,CPUTIM

	SUB C,DAYTIM
	IMULI C,^D1000
	IDIVI C,(B)
	MOVEM C,DAYTIM

; Wait for completion reply or timeout  30*2 seconds ;cwl

	SKIPN F$DTRQ		; If data transfer (requested or
	 SKIPE F$DTIP		; In progress) and
	  TXNE F,F.ABOR!F.CGFG	; Not aborted since began CWFORK?
	   JRST CWFK2		; No, don't wait
	MOVNI X,^D30		; Yes, wait a little bit
CWFKL1:	TXNN F,F.ABOR!F.CGFG	; Data fork aborted yet? or
	 SKIPE F$DTDR		; Done reply in yet?
	  JRST CWFK2		; Yes.
	MOVX A,<^D2000>	 	; No. Wait for it.
	DISMS
	SETZ A,
	EXCH A,F$WORK		; Making progress?
	JUMPN A,CWFKL1		; Yes, don't count
	AOJL X,CWFKL1		; Check now
CWFK2:
	MOVX A,<.PRIOU>		; Don't foul timing with TTY wait
	DOBE			; So wait first for TTY.

	HRROI A,[ASCIZ /
 No completion reply received.
/]
	SKIPN F$DTDR		; 252-4 received?
	  PSOUT			; No. Say so.

	SKIPA
CWFK4:	  TXO F,F.CGFG		; Enter here if DFORKH disappeared
	HRROI A,[ASCIZ /
 Aborted.
/]
	TXNE F,F.CGFG
	  PSOUT


	HRROI A,[ASCIZ / Data connection was never established.
/]
	SKIPN F$DOPN		; Data ever opened?
	  PSOUT			; No. Say so.

; CWFK1:

;	TXNE F,F.KJFN		; Want to hang on to JFN?
;	  JRST [CLOSK (LCLJFN)	; (MULTIPLE SEND/GET only)
;		JRST CWFK7]	; Yes. Close and keep.

; If receiving and had an error, delete the garbage

	TXNN F,F.KJFN		; Want to hang on to JFN?
	 SKIPE F$SEND		; Receiving?
	  JRST CWFK6		; Yes, skip this
	HRRZ A,$REPLM		; Address of reply message
	CAIE A,MSG226
	 CAIN A,MSG250		; A good transfer from this end?
	  TXNE F,<F.ABOR!F.CGFG> ; and from the other end?
	   SKIPA		; One end or the other failed
	    JRST CWFK6		; Both seem ok

	CLOSK (LCLJFN)
	HRRZ A,LCLJFN		; File to be deleted
	TXO A,<DF%EXP>
	DELF			; Delete and expunge file
	 SKIPA
	  SETOM LCLJFN		; Gone
CWFK6: ; CWFK7:
	CALL CLSDIF		; Close and release data conn if req'd
				; (In case data fork didn't)
; Return statistics if requested

	TXNE F,F.ABOR!F.CGFG!F.NOST!F.NST1 ; See if should give statistics
	  JRST CWNOST		; No stats

	MOVX A,<.PRIOU>		; TTY interference not desired
	DOBE
	CALL PCRLF		; Print summary
	MOVX A,<.PRIOU>		; First, amount of data
	MOVE B,NBYTES
	MOVX C,<DECRAD>
	NOUT
	  JFCL
	MSG <. bytes transferred, run time = >
	MOVX A,<.PRIOU>
	MOVE B,CPUTIM
	MOVX C,<DECRAD>
	NOUT
	  JFCL
	MSG <. MS,
 Elapsed time = >
	MOVX A,<.PRIOU>
	MOVE B,DAYTIM
	MOVX C,<DECRAD>
	NOUT
	  JFCL
	MSG <. MS, Rate = >
	MOVE B,$BYTE2
	IMUL B,NBYTES		; Bits
	IMULI B,^D1000
	IDIV B,DAYTIM		; Baud
	MOVX A,<.PRIOU>
	MOVX C,<DECRAD>
	NOUT
	  JFCL
	MSG <. Baud.
>
CWNOST:	RET
	SUBTTL	Subroutine TELSND

;Set:	A/ the character
;	B/the keyword address
;	CALL TELSP
;OBSOLETE
TELSP:	SETZM STRTMP
	DPB A,[POINT 7,STRTMP,6]
	HRROI A,STRTMP
;	JRST TELSND		; Mostly just use TELSND routine


;Set:	A/ address of second ASCIZ string
;	B/ address of first ASCIZ string
;	CALL TELSND

TELSND:	PUSH P,C
	HLL B,[POINT 7,0]	; First ASCIZ string to send
	HLL A,[POINT 7,0]	; Second ASCIZ string to send
	PUSH P,A		; (Make ILDB pointers)

	MOVE A,SCON
	SETZ C,
	$SOUT
	ERJMP TELSEE
	POP P,B			; Second string
	$SOUT
	ERJMP TELSEE
	HRROI B,CRLFM		; Terminate with CR LF
	$SOUT
	ERJMP TELSEE
	MOVX B,<.MOSND>		; Send accumulated buffer
	$MTOPR
	ERJMP TELSEE
	POP P,C
	RET

TELSEE:	MOVX A,<.FHSLF>
	MOVX B,<1B<ABBCHN>>	; Abort TELNET & data connections
	IIC
	POP P,C
	RET

CLITS:;	LIT
	XLIST
	LIT
	LIST
	SUBTTL	Inferior Fork Routine to Read Server Responses

RFRKSA:	MOVE P,PDP		; Process stack

TNRSOL:	MOVE A,[RCVLIN,,RCVLST]	; Save last reply
	BLT A,RCVLST+ERCVLN-RCVLIN
	SETZM RCVLIN		; Start of line. Clear buffer.
	MOVE A,[RCVLIN,,RCVLIN+1]
	BLT A,ERCVLN
	MOVX X,<<ERCVLN-RCVLIN>*5-1> ; Count line length
	MOVX BP,<POINT 7,RCVLIN> ; Point to start of buffer

	MOVEI A,TNRNRM		; Switch to no-escape-seen
TNRSNS:	MOVEM A,TNRSSS		; Set next state

TNRL01:	MOVE A,RCON		; Get next TELNET character
	$BIN
	ERJMP TNRCTC
	MOVEI D,TNRNRM		; Usual next state
	EXCH D,TNRSSS		; Get current state
	JUMPN B,@D		; Dispatch based on state

	$GTSTS			; End of data or zero byte?
	MOVE C,B		; Current status
	MOVX B,<C.NUL>		; Assume zero byte
	TXC C,<GS%OPN+GS%RDF>	; If not open or not read or
	TXNE C,<GS%OPN+GS%RDF+GS%EOF> ; error
	  JRST TNRCTC		; Then abort both
	JRST @D			; NUL, dispatch based on state


	SUBTTL	Process normal TELNET characters

TNRNRM:	MOVEI A,TNRIAC		; Next state if IAC
	CAIN B,TN.IC		; IAC?
	  JRST TNRSNS		; Yes, go set state & get TELNET code
TNRNR1:
IFE TCPP,<CAIL B,200		; TELNET control character?
	    JRST TNRL01;TELCON>	; Yes. (None yet implemented)

	ANDI B,177
	MOVE A,B
	SKIPGE DBUGSW		; Debugging?
	  PBOUT			; Yes, echo immediately
	CAIE B,C.NUL		; Skip NULs and CRs
	 CAIN B,C.CR
	  JRST TNRL01
	CAIN B,C.LF		; End of line?
	  JRST TNREOL		; Yes.
	IDPB B,BP		; No. Store character in input buffer.
	SOJG X,TNRL01		; Count in case of huge line
TNREOL:
	SUBTTL	Process reply

; End of TELNET line

	MOVX B,<C.NUL>		; Make sure a NUL at end
	IDPB B,BP
	TLNE BP,760000		; Fill word out to end
	  JRST .-2
; Extract reply code

	SETZB A,X		; Clear number and digit counter
	MOVE BP,[POINT 7,RCVLIN]
TNRNL1:	ILDB B,BP		; Get a reply code digit
	CAIL B,"0"		; Decimal digit?
	 CAILE B,"9"
	  JRST TNREON		; No.
	IMULI A,DECRAD		; Yes. Accumulate decimal number
	ADDI A,-"0"(B)
	AOJA X,TNRNL1		; Count digits. Loop.
TNREON:
	MOVE D,B		; Save break character
	SKIPN X 		; Were there any digits in number?
	  SETO A,		; No. Make a phony reply value.
	MOVEM A,REPCOD		; Store reply code
	JUMPL A,TNRFNY		; Don't bother searching table

; Look up reply code in table

	MOVSI X,-NREPS		; Counter for number of known replies
TNRL02:	HRRZ B,REPTB1(X)	; Get a known reply
	CAMN B,REPCOD		; Is that what we got?
	  JRST TNRRF		; Reply found.
	AOBJN X,TNRL02		; No. Loop
TNRFNY:

	MOVX A,<C.SRVH>		; Prefix character
	PBOUT			; Type it
	HRROI A,RCVLIN		; Funny reply. Not found. Type it.
	PSOUT
	HRROI A,[ASCIZ /
/]
	PSOUT
	MOVX A,<C.HRLD>
	SKIPE F$STAR		; In command input?
	  PBOUT			; Yes. Re-cue
	JRST TNRRF2		; To rest of reply handler
	SUBTTL	Found reply code in table, optionally print it

TNRRF:;	MOVEM X,REPIDX		; Save index into tables (unused)

	MOVE B,REPTB1(X)	; Get bits for what to do.
;REPEAT 0,< ; This slows down output a lot. What to do?
	MOVX A,<.PRIOU>		; Try not to mix TTY output lines
	  DOBE
;>
	SKIPN F$VBOS		; All typeout wanted?
	  JRST TNRRF1		; No
	TXZ B,RC.TT		; Yes. Diddle up flags to
	TXO B,RC.TA		; Print whole line
TNRRF1:
	CALL TNRPRT		; Print message if requested

; Dispatch if requested

	HRRZ C,REPTB2(X)	; Dispatch address, if any.
IFN TCPP,<CAIN D,C.SPACE>	; Code terminated by SPACE and
	   TXNN B,RC.DS 	; Want dispatch?
	    SKIPA		; No
	     CALL 0(C)		; Yes.
TNRRF2:

; Check if reply code is in range to abort data connection

IFE TCPP,<
	MOVE A,REPCOD		; Get the reply number
	CAIL A,^D401		; In the range to abort data?
	 CAILE A,^D599
	  JRST TNRSOL		; No.  Go get another line.
	JRST TNRABT		; Yes, abort connections
> ; End of IFE TCPP

IFN TCPP,<
	MOVE C,REPCOD		; Get the reply number

	IDIVI C,DECRAD		; D gets units
	MOVE B,C
	IDIVI B,DECRAD		; C gets tens
	MOVE A,B
	IDIVI A,DECRAD		; B gets hundreds, & A ??

	CAIE B,^D4		; 42X & 45x & 52x & 55x abort data conn
	 CAIN B,^D5
	  SKIPA			; 4xx or 5xx
	   JRST TNRSOL		; Cannot be any

	CAIE C,^D2
	 CAIN C,^D5
	  JRST TNRABT		; Yes, abort connections
	JRST TNRSOL		; No.  Go get another line.
> ; End of IFN TCPP
	SUBTTL	Subroutine to Conditionally Print Reply Message

; B/	RC.CA!RC.CT
;	CALL TNRPRC

TNRPRC:	TXNE B,RC.CT		; Copy conditional flags to permanent
	  TXO B,RC.TT
	TXNE B,RC.CA
	  TXO B,RC.TA


; B/	RC.TA!RC.TT
;	CALL TNRPRT


TNRPRT:	TXNN B,<RC.TA!RC.TT>	; Typeing?
	  RET			; No
	MOVX A,<C.SRVH>		; Herald prefixing server typeout
	PBOUT			; Yes. Prefix character first

IFE TCPP,<MOVX A,<070000,,0>>	; Back up pointer
IFN TCPP,<MOVX A,<0>>
	ADD A,BP		; To just after digits

	TXNE B,RC.TT	 	; Type text?
	  PSOUT			; Yes.

	HRROI A,RCVLIN		; Type whole thing?
	TXNE B,RC.TA
	  PSOUT			; Yes.

	HRROI A,[ASCIZ /
/]
	PSOUT			; Yes. End the line.
	MOVX A,<C.HRLD>
	SKIPE F$STAR		; In command input?
	  PBOUT			; Yes. Re-cue
	RET
	SUBTTL	Abort Connection(s)

; Abort both data and TELNET connections

TNRDIS:	HRROI A,[ASCIZ /
? Fatal error in TELNET receiver fork, aborting connections.
/]
	PSOUT


; Abort both data and TELNET connections

TNRCTC:	HRROI A,[ASCIZ /
-- Connection has terminated --
/]				; EOF or not open or not read
	PSOUT



	MOVX A,<.FHSUP>		; Interrupt superior
	MOVX B,<1B<ABBCHN>>	; Abort TELNET & data connections
	IIC
	HALTF
	JRST .-1



; Abort data connection

TNRABT:	MOVX A,<.FHSUP>		; Interrupt superior
	MOVX B,<1B<ABOCHN>>	; Abort data connection
	IIC

IFN TCPP,<JRST TNRSOL>		; Continue reading

	HALTF
	JRST .-1
	SUBTTL	Handle TELNET IAC character

TNRIAC:	CAIN B,TN.IC		; Double IAC?
	  JRST TNRNR1		; Yes. (Normal state and) handle the character
	MOVE C,B
	SETZ B,			; (For TNRTNC)
	CAIGE C,TN.WL		; WILL(3), WONT(4), DO(5), DONT(6)?
	  JRST TNRTNC		; No, some TELNET command
				; (Normal state and) ignore it
	MOVE A,[TNRWIL
		TNRWNT
		TNRDO
		TNRDNT]-TN.WL(C)
	JRST TNRSNS



TNRWTM:	BYTE (8)TN.IC,TN.WL,TN.OTM ; IAC-WILL-TM


; /B has option code

TNRWIL:	MOVX C,<TN.WL>
	JRST TNRTNC

TNRWNT:	MOVX C,<TN.WN>
	JRST TNRTNC

TNRDO:	CAIN B,TN.OTM		; Timing mark?
	  JRST [MOVE A,SCON	; TELNET send
		MOVX B,<POINT 8,TNRWTM>	; Data
		MOVNI C,3	; Length
		$SOUT
		ERJMP TNRCTC
		MOVE A,SCON
		MOVX B,<.MOSND>
		$MTOPR		; Push it along
		ERJMP TNRCTC
		MOVX B,<TN.OTM>	; Restore option
		JRST .+1]
	MOVX C,<TN.DO>
	JRST TNRTNC

TNRDNT:	MOVX C,<TN.DN>
	JRST TNRTNC

; /C	TELNET Command code
; /B	(Optional) option code

TNRTNB:	SETZ B,
TNRTNC:	SKIPN F$VBOS		; Verbose mode?
	  JRST TNRL01		; No

	MOVX A,<C.SRVH>		; Prefix character
	PBOUT			; Type it
	PUSH P,B		; Save TELNET code
	MOVX B,<TN.IC>
	CALL TNCOD
	PSOUT
	MOVE B,C
	CALL TNCOD
	PSOUT
	POP P,B
	CALL TNOPT
	SKIPE B
	  PSOUT
	HRROI A,[ASCIZ /
/]
	PSOUT
	MOVX A,<C.HRLD>
	SKIPE F$STAR		; In command input?
	  PBOUT			; Yes. Re-cue
	JRST TNRL01
; TELNET Characters and codes

TN.IC==377	; TELNET escape character
TN.DN==376	; TELNET DON't character
TN.DO==375	; TELNET DO character
TN.WN==374	; TELNET WON'T character
TN.WL==373	; TELNET WILL character
TN.SB==372	; TELNET Sub-negotiation begin character
TN.GA==371	; TELNET Go-ahead character
TN.CU==370	; TELNET Control-U character
TN.RO==367	; TELNET Rubout character
TN.CT==366	; TELNET Control-T character
TN.CO==365	; TELNET Control-O character
TN.CC==364	; TELNET Control-C character
TN.BR==363	; TELNET Break character
TN.DM==362	; TELNET Data-mark character
TN.NP==361	; TELNET NOP character
TN.SE==360	; TELNET Sub-negotiation end character


TN.OBN==0	; TELNET Binary option
TN.OEC==1	; TELNET Echo option
TN.ORC==2	; TELNET Reconnect option
TN.OSG==3	; TELNET Suppress Go-ahead option
TN.OMS==4	; TELNET Message-size option
TN.OST==5	; TELNET Status option
TN.OTM==6	; TELNET Timing-mark option
TN.ORE==7	; TELNET RCTE option

; B/	code
;	CALL TNCOD, TNOPT
; A/	Pointer to ASCIZ string data

TNCOD:	HRROI A,[ASCIZ /(?)/]
	CAIL B,TN.SE		; Check range
	 CAILE B,TN.IC
	  RET			; Not a TELNET code
	HRROI A,TN.TAB-TN.SE(B)	; Pointer
	RET

TNOPT:	HRROI A,[ASCIZ /(?)/]
	CAIL B,TN.OBN		; Check range
	 CAILE B,TN.ORE
	  RET			; Not a TELNET code
	LSH B,1			; Two words per
	HRROI A,TNOTAB-TN.OBN(B) ; Pointer
	RET

TN.TAB:
	ASCIZ /(SE)/	; TELNET Sub-negotiation end character
	ASCIZ /(NP)/	; TELNET NOP character
	ASCIZ /(DM)/	; TELNET Data-mark character
	ASCIZ /(BR)/	; TELNET Break character
	ASCIZ /(CC)/	; TELNET Control-C character
	ASCIZ /(CO)/	; TELNET Control-O character
	ASCIZ /(CT)/	; TELNET Control-T character
	ASCIZ /(RO)/	; TELNET Rubout character
	ASCIZ /(CU)/	; TELNET Control-U character
	ASCIZ /(GA)/	; TELNET Go-ahead character
	ASCIZ /(SB)/	; TELNET Sub-negotiation begin character
	ASCIZ /(WL)/	; TELNET WILL character
	ASCIZ /(WN)/	; TELNET WON'T character
	ASCIZ /(DO)/	; TELNET DO character
	ASCIZ /(DN)/	; TELNET DON't character
	ASCIZ /(IC)/	; TELNET escape character

TNOTAB:
	ASCIZ /(OBN)/	; TELNET Binary option
	ASCIZ /(OEC)/	; TELNET Echo option
	ASCIZ /(ORC)/	; TELNET Reconnect option
	ASCIZ /(OSG)/	; TELNET Suppress Go-ahead option
	ASCIZ /(OMS)/	; TELNET Message-size option
	ASCIZ /(OST)/	; TELNET Status option
	ASCIZ /(OTM)/	; TELNET Timing-mark option
	ASCIZ /(ORE)/	; TELNET RCTE option
; Special handling of some replies

REP250:	SETZM F$DTDR		; No data trans done reply
	SETOM F$DTIP		; Data trans in prog, allegedly
	SETZM F$DTRQ		; Request has been acknowledged
	RET			; Return

REP251:	RET			; Restart reply

REP252:	REP253:	REP254:		; These same as above, functionally.
	SETOM F$DTDR		; Done reply came in
	SETZM F$DTIP		; Not in progress
	RET

IFE TCPP,<
REP255:	ADDI BP,1		; Move over five characters, "SOCK "
	SETZ A,			; See if we can read a number
RP255L:	ILDB B,BP		; Character
	CAIL B,"0"		; Digit?
	CAILE B,"9"
	  JRST RP255A		; No.
	IMULI A,DECRAD
	ADDI A,-"0"(B)		; Add in the digit
	JRST RP255L		; Build the number

RP255A:	MOVEM A,SOC255		; Store for receive fork to see.
	RET			; Return to TELNET dispatcher.
> ; End of IFE TCPP
	SUBTTL	Process Reply 212/213/550 (file status) and 227 (PORT)
IFN TCPP,<
TR213:	MOVE D,B		; Save flags
	HRROI A,$FILST		; Global file status string
	MOVE B,BP		; Reply text
	SETZ C,
	SOUT			; Save it
	IDPB C,A		; End the string
	MOVE B,D		; Restore flags for TNRPRC
	SKIPN F$FLST		; Doing invisible STAT on file?
	  CALL TNRPRC		; No, print it too
TR212:	SETZM F$FLST		; Tell top level reply has arrived
	RET

TR550:	SKIPE F$FLST		; Invisible STAT?
	  JRST TR212		; No, no message here
	CALL TNRPRC		; Transfer - Print message
	JRST TNRABT		; and abort it

; Entering Passive Mode.  h1,h2,h3,h4,p1,p2

TR227:	SETZ A,
	PUSH P,A		; For Host
	PUSH P,B		; For Port
	MOVX C,<POINT 8,-1(P),3>; Point to temp for host (rigth justified)
	ADDI BP,1		; Move over five characters, "PORT "
	MOVX D,<-6,,0>		; Six bytes
TR227B:	SETZ A,			; See if we can read a number
TR227D:	ILDB B,BP		; Character
	CAIL B,"0"		; Digit?
	 CAILE B,"9"
	  JRST TR227E		; No.
	IMULI A,DECRAD
	ADDI A,-"0"(B)		; Add in the digit
	JRST TR227D		; Build the number

TR227E:	CAIL A,0		; Range check bytes
	 CAILE A,255
	  JRST TR227J		; Lose
	IDPB A,C		; Stash the byte
	AOBJN D,TR227B		; Get next byte
TR227J:	POP P,B			; Port
	LSH B,^D<16-36>		; Right justify
	POP P,A			; Host (already justified)
	TLNE D,-1		; Right number of bytes?
	  JRST TR227X		; No
	MOVEM B,PRT227		; Store for receive fork to see.
	RET			; Return to TELNET dispatcher.

TR227X:	HRROI A,[ASCIZ /
? Invalid PORT reply received.
/]
	PSOUT
	RET
> ; End of IFN TCPP
	SUBTTL	NCP Responses

IFE TCPP,<			; NCP Responses
DEFINE RESPTB <
	RESPCD (000,RC.TT,TNRDIS)	;GENERAL INFO.
	RESPCD (030,RC.TT,TNRDIS)	;SERVER AVAILABILITY
	RESPCD (050,RC.TT,TNRDIS)	;FTP COMMENT, USER INFO
	RESPCD (100,RC.TT,TNRDIS)	;SYSTEM STATUS REPLY
	RESPCD (150,RC.TT,TNRDIS)	;FILE STATUS REPLY
	RESPCD (151,RC.TT,TNRDIS)	;DIRECTORY LISTING REPLY
	RESPCD (200,,TNRDIS)		;JUST AN OK TO LAST COMMAND
	RESPCD (201,RC.TT,TNRDIS)	;ABORT HAS TERMINATED ACTIVITY
	RESPCD (202,RC.TA,TNRDIS)	;BAD ABORT ( NO ACTIVITY)
	RESPCD (230,RC.TT,TNRDIS)	;LOGIN RECEIVED
	RESPCD (231,RC.TT,TNRDIS)	;LOGGED OUT.
	RESPCD (232,,TNRDIS)		;LOGOUT RECEIVED BUT HOLDING
	RESPCD (250,RC.TD,REP250)	;TRANSFER STARTED
	RESPCD (251,RC.DS,REP251)	;RESTART MARKER
	RESPCD (252,RC.TD,REP252)	;TRANSFER COMPLETED
	RESPCD (253,RC.TD,REP253)	;RENAME COMPLETED
	RESPCD (254,RC.TD,REP254)	;DELETE COMPLETED
	RESPCD (255,RC.DS,REP255)	;SOCKET REPLY
	RESPCD (256,RC.TT,TNRDIS)	;MAIL DONE.
	RESPCD (300,RC.TT,TNRDIS)	;GREETING.
	RESPCD (301,RC.TA,TNRDIS)	;INCOMPLETE COMMAND
	RESPCD (330,,TNRDIS)		;ENTER PASSWORD
	RESPCD (331,,TNRDIS)		;PASS OK, SEND ACCT
	RESPCD (350,RC.TT,TNRDIS)	;SEND MAIL.
	RESPCD (400,RC.TT,TNRDIS)	;NOT IMPL
	RESPCD (401,RC.TA,TNRDIS)	;NO MORE USERS NOW
	RESPCD (430,RC.TA,TNRDIS)	;LOGIN FAILURE
	RESPCD (431,RC.TT,TNRDIS)	;LOGIN FAILURE
	RESPCD (432,RC.TA,TNRDIS)	;USER CANT USE THIS SERVICE
	RESPCD (434,RC.TA,TNRDIS)	;LOGOUT FORCED
	RESPCD (435,RC.TA,TNRDIS)	;LOGOUT FORCED
	RESPCD (436,RC.TA,TNRDIS)	;LOGOUT FORCED
	RESPCD (450,RC.TT,TNRDIS)	;FILE NOT FOUND
	RESPCD (451,RC.TT,TNRDIS)	;ACCESS DENIED
	RESPCD (452,RC.TA,TNRDIS)	;TRANSFER FAILED
	RESPCD (453,RC.TA,TNRDIS)
	RESPCD (454,RC.TA,TNRDIS)	;CAN'T HOOK TO YOUR SOCKET
	RESPCD (500,RC.TT,TNRDIS)	;GIBBERISH RCVD
	RESPCD (501,RC.TT,TNRDIS)
	RESPCD (502,RC.TT,TNRDIS)
	RESPCD (503,RC.TT,TNRDIS)
	RESPCD (504,RC.TT,TNRDIS)
	RESPCD (505,RC.TT,TNRDIS)
	RESPCD (506,RC.TT,TNRDIS)
  > ; End of DEFINE RESPTB
> ; End of IFE TCPP
	SUBTTL	TCP Responses

IFN TCPP,<			; TCP Responses
DEFINE RESPTB <
RESPCD (110,RC.TD,REP251)	; Restart marker reply.
RESPCD (111,RC.TT,TNRDIS);+	; FTP comment, user info
 RESPCD (119,RC.TT,TNRDIS)	; Terminal not available, will try mailbox.
 RESPCD (120,RC.TT,TNRDIS)	; Service ready in nnn minutes
RESPCD (125,RC.TD,REP250)	; Data conn already open; transfer starting
 RESPCD (150,RC.TD,REP250)	; File status okay; about to open data conn
RESPCD (151,RC.TT,TNRDIS)	; User not local; Will forward <user>@<host>.
 RESPCD (152,RC.TT,TNRDIS)	; User Unknown; Mail forwarded by operator.
RESPCD (200,,TNRDIS)		; Command okay
RESPCD (202,RC.TT,TNRDIS)	; Command not implemented, superfluous here
RESPCD (211,RC.TT,TNRDIS)	; System status, or system help reply
RESPCD (212,RC.TD,TR212)	; Directory status
RESPCD (213,RC.DT,TR213)	; File status
RESPCD (214,RC.TT,TNRDIS)	; Help message
 RESPCD (215,RC.TT,TNRDIS)	; <scheme> is the preferred scheme.
RESPCD (220,RC.TT,TNRDIS)	; Service ready for new user
RESPCD (221,RC.TD,TNRCTC)	; Service closing TELNET connection
RESPCD (225,RC.TD,REP252)	; Data conn open; no transfer in progress
RESPCD (226,RC.TD,REP252)	; Closing data conn
RESPCD (227,RC.TD,TR227)	; Entering Passive Mode.  h1,h2,h3,h4,p1,p2
RESPCD (230,RC.TT,TNRDIS)	; User logged in, proceed
RESPCD (250,RC.TD,REP252)	; Requested file action okay, completed.
RESPCD (331,,TNRDIS)	; **	; User name okay, need password
RESPCD (332,RC.TT,TNRDIS)	; Need account for login
RESPCD (350,,TNRDIS)		; Requested file action pending further info
RESPCD (354,RC.TT,TNRDIS)	; Start mail input; end with <CR><LF>.<CR><LF>
RESPCD (421,RC.TD,TNRCTC)	; Service not available, closing TELNET conn
RESPCD (425,RC.TT,TNRDIS)	; Can't open data connection
RESPCD (426,RC.TD,TNRABT)	; Connection closed; transfer aborted.
RESPCD (450,RC.TD,TNRABT)	; File action not taken: file unavailable/busy
RESPCD (451,RC.TD,TNRABT)	; Action aborted: local error in processing
RESPCD (452,RC.TD,TNRABT)	; Action not taken: insufficient space -system
RESPCD (500,RC.TD,TNRABT)	; Syntax error, command unrecognized
RESPCD (501,RC.TD,TNRABT)	; Syntax error in parameters or arguments
RESPCD (502,RC.TD,TNRABT)	; Command not implemented
RESPCD (503,RC.TD,TNRABT)	; Bad sequence of commands
RESPCD (504,RC.TD,TNRABT)	; Command not implemented for that parameter
RESPCD (530,RC.TD,TNRABT)	; Not logged in
RESPCD (532,RC.TD,TNRABT)	; Need account for storing files
RESPCD (550,RC.DT,TR550)	; Action not taken: unavailable/not found/access
RESPCD (551,RC.TD,TNRABT)	; Action aborted: page type unknown
RESPCD (552,RC.TD,TNRABT)	; File action aborted: exceeded allocation
 RESPCD (553,RC.TD,TNRABT)	; Action not taken: file name not allowed
  > ; End of DEFINE RESPTB
> ; End of IFN TCPP
	SUBTTL	Response Receiver Tables

; Bits which drive response receiver

RC.TT==1B0	; Type the text but not the number
RC.TA==1B1	; Type the whole line
RC.DS==1B2	; Dispatch to a handler
RC.CT==1B3	; Type the text but not the number if dispatcher calls
RC.CA==1B4	; Type the whole line if dispatcher calls

RC.TD==RC.TT!RC.DS	; Abbreviations
RC.DT==RC.DS!RC.CT
RC.DA==RC.DS!RC.CA

DEFINE RESPCD (CODE,FLAG,ROUT),<	EXP CODE+FLAG>

RADIX 10
REPTB1:	RESPTB			; Flags and Reply codes
NREPS==.-REPTB1 		; Length of table
RADIX 8

DEFINE RESPCD (CODE,FLAG,ROUT),<	EXP ROUT>

REPTB2:	RESPTB			; Dispatch routine address

RLITS:;	LIT
	XLIST
	LIT
	LIST
	SUBTTL	Data Transfer Fork

; Routine which indicates that data is moving

TIMEOK:	AOS F$WORK		; Still working
	RET


; First get the network data connection,
; then do the file transfer itself.

DFRKSA:	MOVE P,PDP		; Fresh fork, get a stack
	MOVEI A,.FHSLF		; Set up PSI system for this fork
	MOVE B,[LEVTAB,,DCHNTB]	; Different channel table for data fork
	SIR
	MOVE B,ONCHND		; Fewer channels on
	AIC
	MOVEI A,.FHSLF
	EIR			; Turn it on

	SETZ F,			; Clear old flags
	SKIPE F$SEND		; If sending
	  TXO F,F.SEND		; Set local flag


IFE TCPF,<			; Following code is only for NCP version
	SETOM SOC255		; No 255 reply in yet.
	SETOM DATCON		; No data conn yet

	HRROI A,GTJSTR		; First build string for listening skt
	HRROI B,[ASCIZ /NET:/]	; Device field
	SETZ C,
	SOUT
	MOVE B,USRSKT		; Construct socket number to listen on
	ADDI B,4		; FTP says the default is TELNET+2
	TXNE F,F.SEND		; Direction of transfer?
	  ADDI B,1		; Make right sex. Not needed by GTJFN..
	MOVX C,<OCTRAD>		; Octal number
	NOUT
	  JRST NODJFN
	HRROI B,[ASCIZ /.;T/]	; No extension, makes a listener.
	SETZ C,
	SOUT
	MOVX A,<GJ%SHT>		; Short form JFN
	HRROI B,GTJSTR
	GTJFN
	  JRST NODJFN		; Can't get it?
	MOVEM A,DATCON		; Store JFN
; DFRK00:
	MOVE B,$BYTE3		; Get byte size
	LSH B,^D30		; Put it in left 6 bits
	TXO B,<FLD(5,OF%MOD)>	; Buffered send
	TXO B,OF%RD		; Assume listening.
	TXNE F,F.SEND		; Which direction?
	  TXC B,OF%WR+OF%RD	; Sending. Change to write.
	OPENF			; Make it listen
	  JRST NODJF2		; Died already.
	MOVX X,<DWTIME>		; Seconds to wait for action here.
DATW1:	MOVX A,<^D1000>	 	; Wait a second
	DISMS
	MOVE A,DATCON		; See what connection state is
	GDSTS
	HLRZ A,B		; Get state, left 4 bits.
	ANDI A,740000
	CAIN A,(<FSRFCR>B3)	; When connection request comes in,
	  JRST DFRK01		; This is the state it goes to.
	SOJG X,DATW1		; Not yet. Count down timer.  NODJF2:
	CLOSD (DATCON)		; Common error return here
NODJFN:	SETOM SOC255		; No socket number
	MSG <
? Can't	open the data connection.  >
	SETOM F$TCLS		; Request TELNET closedown
	HALTF
	JRST .-1		; End of data fork on disaster.

; More of data fork. Here when RFC received on listening data skt.

DFRK01:	HLRZ A,B		; See if the byte size matches
	ANDI A,77
	CAME A,$BYTE3
	 JRST NODJF4		; Not right byte size
	MOVEM D,SOCRFC		; RFC socket number.  ; Cwl 6 lines
added use GTNCP instead of GTSTS on DATCON
	MOVX A,<.GTNJF>
	MOVE B,DATCON
	MOVEI C,C
	HRROI D,.NCFHS
	GTNCP
	  SETZ C,

	CAME C,FHSTN		; And the foreign host too.
	  JRST NODJF3		; Doesn't match. Flush it.
	MOVE D,SOCRFC		; RFC socket #
	SUBI D,2		; See if socket is the default
	TRZ D,1 		; Ignore sex of socket
	CAMN D,FORNS		; Match?
	  JRST DFRK03		; Yes. Don't wait for 255 reply

DATW2:	SKIPLE SOC255		; Has a 255 socket reply come in?
	  JRST DFRK02		; Yes. Check it out
	MOVX A,<^D1000>	 	; No. Wait another second for it.
	DISMS
	SOJG X,DATW2		; See if it's here now
	MSG < (No socket verification received. Proceeding anyway.)  >
	JRST DFRK03		; Go do the transfer

DFRK02:	MOVE D,SOC255		; Get the 255 reply number
	XOR D,SOCRFC		; Compare with RFC socket
	TRZ D,1 		; Ignoring sex bit
	JUMPE D,DFRK03		; Go transfer if they match
	MSG < Socket verification does not match.  >
	JRST NODJF2		; Quit on this error.

DFRK03:	SKIPN F$VBOS		; Want comments?
	  JRST DFRK3A		; No
	MSG <(Accepting data connection, socket >
	MOVX A,<.PRIOU>
	MOVX C,<OCTRAD>
	MOVE B,SOCRFC
	NOUT
	  JFCL
	HRROI B,[ASCIZ /, host /]
	SETZ C,
	SOUT
	MOVX C,<OCTRAD>
	MOVE B,FHSTN
	CVHST
	  NOUT
	  JFCL
	MSG <.)  >
DFRK3A:	AOS F$DOPN		; Flag opening connection
	MOVE A,DATCON		; Now willing to open the connection.
	MOVX B,<.MOACP>		; Accept the RFC
	MTOPR

	CALL XFRDAT		; Perform data transfer

	HALTF
	JRST .-1

NODJF3:	MSG <Data connection from wrong host.  >
	JRST NODJF2
NODJF4:	MSG <Data connection not right byte size.  >
	JRST NODJF2 > ; End of IFE TCPF
	SUBTTL	Open TCP Data Connection (Its already listening)

IFN TCPF,<SKIPE F$DOPN		; Already checked if synchronized?
	   JRST DFRK01		; Yes

	MOVX D,<-CNTMOT,,0>	; Timeout
DATW1:	MOVX A,<^D1000>		; A second
	DISMS

	MOVEI A,DATCON
	CALL CONSYN		; Connecion synced?
	  JRST NODJFN		; Leave if aborted
	  AOBJN D,DATW1		; Not yet, wait a second
	JUMPGE D,NODJFN		; Give up
DFRK01:
	AOS F$DOPN		; Remember synced

	SETZ B,			; "Open" with current direction/byte size
	MOVE C,$BYTE3
	STOR C,OF$BSZ,+B	; Byte size
	TXNE F,F.SEND		; Sending or receiving?
	 TXOA B,OF%WR		; Sending
	  TXO B,OF%RD		; Receiving
	SKIPLE A,DATCON
	 $OPENF
	  JRST NODJF2		; Failed

	CALL XFRDAT		; Perform data transfer
	HALTF			; Terminate this fork
	JRST .-1		; No way to continue

NODJF2:
NODJFN:	MSG <
? Can't	establish the data connection.
>
	MOVX A,<.FHSUP>		; Interrupt superior
	MOVX B,<1B<ABOCHN>>	; Abort data connection
	IIC
	HALTF			; Terminate this fork
	JRST .-1		; No way to continue

DCHNTB:	REPEAT ^D15,<	EXP 0>	; Channels 0-14 unused
	XWD 1,INSINT		; Chan 15 is illeg inst trap
	REPEAT ^D20,<	EXP 0>	; Channels 16-35 unused

ONCHND:	EXP 1B<.ICILI>		; Take illeg inst traps
	SUBTTL	Subroutine CONSYN

;	MOVEI A,nameCON
;	CALL CONSYN
;Ret+1:	  Error (connection aborted)
;Ret+2:	  Connection not synchronized
;Ret+3:	Connection synchronized

CONSYN:	SKIPN A,T.JCN(A)	; TCP connection id
	  RET			; Leave if aborted
	TXO A,TCP%SY		; Giving names
	MOVX B,<-2,,[ASCII /TRSYN/
		 ASCII /TSSYN/]>
	MOVX C,<-2,,STATMP>	; Temp area
IFN TCPOLD,<CALL KLUDG1>
	STAT
	  RET			; Error - connection gone?
	MOVE B,STATMP		; Receive synchronization state
	MOVE C,STATMP+1		; Send synchronization state
	CAIL B,4		; Going or gone?
	 CAIGE C,4
	  RET			; Yes, give up
	CAIN B,7		; Recv synced? and
	 CAIE C,7		; Send synced?
	  JRST RSKP		; Not yet synced
	JRST RSKP2		; Synced


IFN TCPOLD,<
KLUDG1:	SKIPN TENEX		; TENEX has old code
	  RET			; All set if TOPS20 with new code

	TXZ A,TCP%SY		; Doesn't have symbols
	MOVX B,<-1,,13>		; Status word 	*** may be 12 if TCP monitor
	STAT			;		*** code is old enough
	  JRST KLUDX1
	LDB B,[POINT 3,STATMP,23]
	LDB C,[POINT 3,STATMP,26]
	MOVEM B,STATMP
	MOVEM C,STATMP+1
	AOS (P)
KLUDX1:	AOS (P)			; Skip STAT following CALL
	RET

> ; End of TCPOLD

> ; End of IFN TCPF

	SUBTTL