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