Google
 

Trailing-Edge - PDP-10 Archives - tops20_v7_0_tcpip_distribution_tape - tcpip-sources/ftp4.mac
There are 2 other files named ftp4.mac in the archive. Click here to see a list.
	SUBTTL	Subroutine DMPREG

; B/	Address of message
; C/	xx,,PC
; D/	Address of saved ACs
;	CALL DMPREG	Dump registers on .PRIOU
;Ret+1:	Always, Need CRLF to end last line

DMPREG:	HRROI A,[ASCIZS (456,421,<->)]
	TXNE F,F.STAT
	  PSOUT			; TELNET prefix if on TELNET connection
	ERJMP .+1

	HRROI A,(B)		; Make pointer to message
	PSOUT			; Specific failure message
	ERJMP .+1

	HRROI A,[ASCIZ / at /]
	PSOUT
	ERJMP .+1

	MOVX A,<.PRIOU>		; Type the PC
	HRRZ B,C		; PC
	MOVX C,<OCTRAD>
	NOUT
	  ERJMP .+1

	MOVX B,<" ">
	BOUT
	ERJMP .+1

	MOVX B,<.FHSLF,,-1>	; Current error, this fork
	SETZ C,			; No limit on message
	ERSTR			; Print the error
	  JFCL
	  JFCL
	HRROI A,[ASCIZ /.
/]
	PSOUT
	ERJMP .+1

	HRROI A,[ASCIZS (456,421,<-AC00: >)]
	CALL N4AC
	HRROI A,[ASCIZS (456,421,<-AC04: >)]
	CALL N4AC
	HRROI A,[ASCIZS (456,421,<-AC10: >)]
	CALL N4AC
	HRROI A,[ASCIZS (456,421,<-AC14: >)]
	CALL N4AC

	HRROI A,[ASCIZS (456,421,< Please report it. Thank you. >)]
	TXNN F,F.STAT		; If User Program
	  HRLI A,(POINT 7,0,27)	; Omit reply code
	PSOUT
	RET
	SUBTTL	Subroutine used by DMPREG

; Routine to print next four registers, A/ title, D/ pointer to values

N4AC:	TXNN F,F.STAT		; If User Program
	  HRLI A,(POINT 7,0,27)	; Omit reply code
	PSOUT			; Output TELNET header & title
	ERJMP .+1

	MOVX A,<.PRIOU>
	MOVX C,<NO%MAG+NO%LFL+FLD(^D14,NO%COL)+OCTRAD>
	HRLI D,-4		; Do 4 more registers
N4ACL:	MOVE B,(D)		; Get register
	NOUT			; Its value
	  MOVX C,<NO%MAG+NO%LFL+FLD(^D14,NO%COL)+OCTRAD>
	AOBJN D,N4ACL		; Back for another

	HRROI A,CRLFM
	PSOUT
	ERJMP .+1
	RET
	SUBTTL	Subroutine HMSMS

; Output title H:M:S.MSC

; A/	Output designator
; B/	Pointer to title
; D/	Time, msec
;	CALL HMSMS

HMSMS:	SETZ C,
	SOUT

	MOVE C,D
	IDIV C,[^D<60*60*1000>]
	MOVE B,C
	MOVX C,<DECRAD>
	NOUT
	  JFCL

	MOVX B,<":">
	BOUT

	MOVE C,D
	IDIVI C,<^D<60*1000>>
	MOVE B,C
	MOVX C,<DECRAD>
	NOUT
	  JFCL

	MOVX B,<":">
	BOUT

	MOVE C,D
	IDIVI C,<^D<1000>>
	MOVE B,C
	MOVX C,<DECRAD>
	NOUT
	  JFCL

	MOVX B,<".">
	BOUT

	MOVE B,C
	MOVX C,<NO%LFL!NO%ZRO!FLD(3,NO%COL)!DECRAD>
	NOUT
	  JFCL
	RET
	SUBTTL	Subroutine LCLSTS

; F.STAT	Set to insert Reply Codes (i.e. is Server Program)
; A/	Destination pointer
;	CALL LCLSTS

LCLSTS:	SETZ C,			; Build long string at A/
	PUSH P,C		; For NOUT of byte size string

	HRROI B,VERSTR		; Identify ourselves
	CALL BCRLF

	HRROI B,[ASCIZ /The current data transfer parameters are:/]
	CALL BCRLF

	HRROI B,[ASCIZ /    MODE /]
	SKIPGE C,$MODE
	  SETZ C,
	HLRO D,MODTAB+1(C)
	CALL BCCRLF

	HRROI B,[ASCIZ /    STRU /]
	SKIPGE C,$STRU
	  SETZ C,
	HLRO D,STRTAB+1(C)
	CALL BCCRLF

	HRROI B,[ASCIZ /    TYPE /]
	SKIPGE C,$TYPE
	  SETZ C,
	HLRO D,TYPTAB+1(C)

IFN TCPP,<
	CAIN C,TYPE.A
	  JRST [SKIPGE B,$FORM
		  SETZ B,
		HLRO D,FRMTAB+1(B)
		HRROI B,[ASCIZ /    TYPE A /]
		JRST .+1]

	CAIN C,TYPE.L		; Logical byte?
	  JRST [PUSH P,A
		HRROI A,-1(P)	; Byte size into stack
		SETZM (A)	; Clear for digits
		SKIPGE B,$BYTE
		  MOVX B,<^D8>
		MOVX C,<DECRAD>
		NOUT
		  CALL BOMB
		HRROI D,-1(P)	; Location of digits
		HRROI B,[ASCIZ /    TYPE L /]
		POP P,A
		JRST .+1]
> ; End of IFN TCPP
	CALL BCCRLF

	HRROI B,[ASCIZ /NORETAIN generations /]	;#4 
	SKIPE RETVER		;#4 
	 HRROI B,[ASCIZ /RETAIN generations /]	;#4 
	TXNN F,F.STAT		;#4 SERVER?
	 CALL BCRLF		;#4 NO

	TXNN F,F.STAT		; Server?
	 TXNE F,F.TOPN		; Connection open now?
	  JRST LCLST6		; Yes
	HRROI B,[ASCIZ / There is no connection currently open./]
	CALL BCRLF
	JRST LCLSTX		; Done

LCLST6:
	PUSH P,A		; Save destination pointer

	SETZM STRTMP
	MOVX B,<STRTMP,,STRTMP+1>
	BLT B,STRTMP+20

	MOVX A,<.GTHNS>		; Try for string
	HRROI B,STRTMP		; User temp string
	MOVE C,FHSTN
	MOVX D,<POINT 8,FHSTN,3> ; Point before first byte
	GTHST			; Try for name
	  CALL HST4DB		; If error, print decimal #s

	POP P,A

	HRROI B,[ASCIZ /A connection is open to host /]
	HRROI D,STRTMP
	CALL BCCRLF

	SETZ B,			; Assume User
	HRROI D,[ASCIZ /The data connection is CLOSED./]
	SKIPLE DATCON
	  HRROI D,[ASCIZ /The data connection is OPEN./]

	TXNE F,F.STAT		; Server?
	  HRROI B,[ASCIZS (<100 >,<211 >,<>)] ; Prefix if on TELNET connection
	SKIPN B
	  EXCH B,D
	CALL BDCRLF
LCLSTX:	POP P,(P)		; Drop temp string
	RET
	SUBTTL	Subroutines HST4DA/B

; Routine to print TELNET header and string pointed to be B and D

BCRLF:	SETZ D,			; Just string in B
BCCRLF:	PUSH P,B		; String in B & possibly D
	HRROI B,[ASCIZS (<100 >,<211->)] ; Prefix if on TELNET connection
	SETZ C,
	TXNE F,F.STAT		; LIST or STAT?
	  SOUT			; STAT.
	POP P,B

; Routine to print strings pointed to by B and, if non-zero, D

BDCRLF:	SETZ C,			; Print string in B
	SOUT
	HRROI B,(D)		; Possible second string
	SKIPE D			; Don't bother if nothing
	  SOUT
	HRROI B,CRLFM		; End the line
	SOUT
	RET

;	MOVX D,<POINT 8,32-bit-address,3> ; Point before first byte
;	CALL HST4DA if A/ has destination designator
; or	CALL HST4DB if B/ has destination designator
;Ret+1:	Always, #.#.#.#

HST4DB:	MOVE A,B		; Build address here
HST4DA:	MOVX C,<DECRAD>		; Type as four decimal bytes
	JRST HST4DM		; Skip over dot

HST4DL:	MOVX B,<".">
	BOUT
HST4DM:	ILDB B,D		; Get next byte
	NOUT
	  JFCL
	TLNE D,770000		; Bit position zero?
	  JRST HST4DL		; No, have another byte
	MOVX B,<C.NUL>
	BOUT
	RET
	SUBTTL	Subroutines - CLOSER, CLOSEK, CLOSED

; Note: LH of A may contain flags to be passed to "CLOSF"

;	MOVEI A,jfn-variable
;	CALL CLOSER		Close File & Release JFN

CLOSER:	SKIPG 0(A)		; Anything there?
	  RET			; No such JFN. Return.
	PUSH P,A		; Yes. Save a couple AC's
	PUSH P,B
	HRRZ A,0(A)		; Get JFN itself
	GTSTS
	JUMPL B,CLOSR1
	RLJFN			; Not open. Just release JFN
	  JFCL
	JRST CLOSR2

CLOSR1:	CLOSF			; Open, close & release JFN
	  JFCL
CLOSR2:	POP P,B			; Restore AC's
	POP P,A
	SETOM 0(A)		; And flag JFN gone
	RET



;	MOVEI A,jfn-variable
;	CALL CLOSEK		Close File but Keep JFN

CLOSEK:	SKIPG (A)		; Close, keeping JFN. File there?
	  RET			; No.
	PUSH P,A		; Yes, save addr where JFN is
	HRRZ A,(A)		; Get the JFN
	TXO A,CO%NRJ		; Flag to keep the JFN
	CLOSF			; Close it
	  JFCL
	POP P,A			; Restore pointer
	RET			; Return


;	MOVEI A,jfn-variable - DATCON
;	CALL CLOSED		Close data connection

CLOSED:	SKIPG (A)		; Data connection there?
	  RET			; No.
	PUSH P,A		; Yes, save addr (& flags) where JFN is
	HRRZ A,(A)		; Get the JFN (& flags)
	$CLOSF			; Close it
	  JFCL
	POP P,A			; Restore pointer
	SETOM 0(A)		; Data connection gone
	RET			; Return

LLITS:	XLIST			; Low-seg lits for DMPREG
	LIT
	LIST
	SUBTTL Subroutine UPDFIL

.ORG ;BACK TO HIGH SEGMENT


; Update file's attributes, assumes everything is setup


UPDFIL:	SKIPLE LCLJFN		; Have a local file?
	 SKIPN $FILST		; And information about it?
	  JRST UPDFI8		; No, Error??

	CLOSK (LCLJFN)		; Make sure closed

REPEAT 0,<			; This is already done in DRCXFD

	SKIPE TENEX		; TENEX has no SFUST
	  JRST UPDFI8		  and different dates. Unsupported.

	SETO B,			; Whole word for time 

	HRLI A,<.FBCRV>
	SKIPLE C,FILTCR
	  CHFDB
	  ERJMP .+1

	HRLI A,<.FBWRT>
	SKIPLE C,FILTWR
	  CHFDB
	  ERJMP .+1

	HRLI A,<.FBREF>
	SKIPLE C,FILTRD
	  CHFDB
	  ERJMP .+1

	HRLI A,<.SFAUT>
	HRROI B,FILUCR
	SKIPE FILUCR		; Make sure have a name
	 SFUST			; to set
	  ERJMP .+1

	HRLI A,<.SFLWR>
	HRROI B,FILUWR
	SKIPE FILUWR		; Make sure have a name
	 SFUST			; to set
	  ERJMP .+1

> ; End repeat 0

UPDFI8:
	RET
	SUBTTL	Data Transfer Routine, Common to FTP User & Server

;	F.SEND, $MODE3, $STRU3, $TYPE3, $BYTE3
;	DATCON, LCLJFN open
;	CALL XFRDAT
;	X/	address of comletion/error message [226,250,451]

XFRDAT:	TXZ F,F.ERR!F.FDB!F.TYPX!F.NUL!F.DSK!F.IMG ; Clear flags

	MOVE A,$MODE3		; Get current parameters
	MOVE B,$STRU3
	MOVE C,$TYPE3
	MOVE D,$BYTE3

	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
	   TXZ F,F.CLSD		; Doesn't have to

	  CAIE B,STRU.P
> ; End of IFN TCPP
IFE TCPP,<CAIE C,TYPE.X>	; See if PAGED
	   TXZA F,F.TYPX	; Not PAGED xfer
	    TXO F,F.TYPX	; PAGED xfer
IFE TCPF,<			; See if NCP CHANNEL stuff needed
	CAIN C,TYPE.I		; IMAGE type?
	 CAIN D,^D36		; And not words?
	  TXZA F,F.IMG		; No. Ok as is
	   TXO F,F.IMG		; Flag CHANNEL processing
	TXNE F,F.TYPX		; But not if paged
	  TXZ F,F.IMG		; Cannot get here - paged is 36 bits
> ; End of IFE TCPF
	SETZM TYXSCT		; Start sequence numbers at 1
	SETZM NBYTES		; # bytes processed

	HRRZ A,LCLJFN		; See what the local device is
	DVCHR
	LOAD A,DV$TYP		; Get dev type field
	CAIN A,.DVDSK		; Local file DSK:?
	  TXO F,F.DSK		; Yes
	CAIN A,.DVNUL		; NUL: file?
	  TXO F,F.NUL		; Yes

	TXNN F,F.SEND		; Send or receive?
	  JRST DRECV		; Go to DRECV
; Fall into DSEND
	SUBTTL	Send Process, decide which case

; Four cases: Paged from Disk, from Disk, from NUL:, Other

DSEND:	TXNE F,F.NUL		; NUL: file?
	  JRST DSENUL		; Yes.
	TXNN F,F.DSK		; Local file DSK:?
	  JRST DSEBY1		; No, byte by byte

	CALL GETFDB		; Set up the FDB copy of local file
	  JRST DSEEFD		; Illegal instruction interrupt

	TXNE F,F.TYPX		; PAGED (DSK:) transfer?
	  JRST DSEDXT		; Yes.
	JRST DSEDSK		; No.



	SUBTTL	Send Byte by Byte, neither DSK: nor NUL:

DSEBY1:	HRRZ A,LCLJFN		; Get some input
	BIN
	JUMPN B,DSEBY3		; Got a byte

	GTSTS			; Zero byte or EOF/error?
	TXC B,GS%OPN+GS%RDF
	TXNE B,GS%OPN+GS%RDF+GS%EOF
	  JRST DSENDX		; EOF/error

	MOVX B,<0>		; Zero data byte
DSEBY3:
	MOVE A,DATCON		; Write it out
	$BOUT
	ERJMP DSEEWR

	AOS NBYTES		; Count data bytes

	CALL TIMEOK		; Wasteful, every byte, but...
	JRST DSEBY1
	SUBTTL	Send from NUL: (a million bits)

DSENUL:	SETZM FDBBLK		; Zero FDB block
	MOVX A,<FDBBLK,,FDBBLK+1>
	BLT A,FDBBKE

	MOVX A,<400100,,0>	; Make up a phony FDB for the NUL file
	HRR A,LFDB		; System dependent FDB length	
	MOVEM A,FDBBLK+.FBHDR
	MOVX A,<FB%TMP>		; Call it a temp file
	MOVEM A,FDBBLK+.FBCTL
	MOVX A,<FLD(NUMVAL,NMFLG)+770000> ; Make a protection
	MOVEM A,FDBBLK+.FBPRT

	MOVE P2,$BYTE3		; Byte size in B6-B11
	STOR P2,FB$BSZ		; Into FDB
	MOVX BP,<POINT 0,WINDOW> ; Now build byte pointer
	STOR P2,PT$BSZ,+BP

	MOVX P1,<^D36>		; Bits per word
	IDIVI P1,(P2)		; Bytes per word
	MOVE D,P1		; Save for IDPB count
	LSHC P1,<^D<-36+9>>	; Bytes per page in P2

	MOVX T1,<^D1000000>	; A million bits
	IDIV T1,$BYTE3		; Is this many bytes
	SKIPE T2		; Partial word?
	  ADDI T1,1		; Yes, round up
	MOVE P1,T1		; Number of bytes
	MOVEM P1,FDBBLK+.FBSIZ	; Save length for EOF

; D/  # bytes per word
; BP/ Points to data in WINDOW
; P1/ # bytes left to send
; P2/ # bytes per page

	SETO A,			; Free up the window page
	MOVX B,<.FHSLF,,<WINDOW/1000>>
	SETZ C,			; No count
	PMAP

	MOVE A,BP		; Fill two words
DSENU2:	SETZ B,			; with alternating
	IDPB B,A		; zero and one
	SETO B,			; bytes
	IDPB B,A
	SOJG D,DSENU2

	MOVX A,<WINDOW,,WINDOW+2>
	BLT A,WINDOW+777	; Whole page of them

	MOVX A,<PGT$SP>		; Page type
	MOVEM A,RECTYP
	SETOM PAGNO
	SETZM ACCESS

; BP/ POINT $BYTE3,WINDOW, P1 is # bytes left to send, P2 is bytes per page

DSENUP:	MOVE T2,P1		; Number of bytes left in megabit
	CAILE P1,(P2)		; This page make a million?
	  MOVEI T2,(P2)		; No, send a whole page
	SUB P1,T2		; Bytes remaining after this page

	MOVEM T2,TYXNPW		; # Bytes in a page to be sent
	ADDM T2,NBYTES
	AOS A,PAGNO		; Next page
	MOVEM A,PAGENO
	
IFN TCPP,<TXNE F,F.TYPX		; If paged mode,
	    JRST DSENUX>	; Go send header

	MOVN C,T2		; Negative byte count
	MOVE B,BP		; Starting pointer
	MOVE A,DATCON		; Send connection
	$SOUT			; Send this bunch
	ERJMP DSEEWR
	JUMPN C,DSEEWR
	SKIPA
DSENUX:	  CALL DSEXHD		; Send PAGED header & data in window
	JUMPG P1,DSENUP		; If more to go, send more.
				; No more if fall thru. Close file.
	TXNE F,F.TYPX		; Paged type?
	  CALL DSEXFD		; Yes, send FDB & EOF
	JRST DSENDX		; End of the NUL: file
	SUBTTL	Send from disk, not paged

; Bytes of size specified in FDB are packed into $BYTE3 bits for sending
;		$BYTE3	$LBYTE3==OPENF	File
; ASCII		8	7	7	(7)	transform 7 into 8
; IMAGE		36	36	36	x	IMAGE 36 overrides x
; LOCAL n	n	n	n	x	transform x into n
;
; Find # words in file assuming no holes (Hole is a page of zeros)


DSEDSK:	LOAD D,FB$BSZ		; File byte size (writer's)
	SKIPG D 		; In case bad
	  MOVX D,<^D36>		; Assume words

	SKIPG P1,FDBBLK+.FBSIZ	; Bytes in file (in writer's size)
	  MOVX P1,<1B1>		; If not specified, assume infinite

	HRRZ A,LCLJFN		; File
	RFBSZ			; Get bytesize in which file is now open
	  JFCL			; Error return.	Should not happen
	ANDI B,77		; In case junk
	MOVE C,B		; Copy
;=	MOVE C,$LBYT3

	MOVX BP,<POINT 0,WINDOW> ; Make pointer to window page
	STOR C,PT$BSZ,+BP	; Insert byte size

;#3 convert # of bytes written to # of bytes in mode currently open
	PUSH P,C		;#3 SAVE BYTE SIZE
	PUSH P,D		;#3 USED ELSEWHERE?
	MOVE C,D		;#3 
	CAMGE B,C		;#3 OPEN LESS THAN WRITE ?
	 JRST  [IDIVI C,(B)	;#3 YES
		IMULI P1,(C)	;#3 NUMBER OF BYTES IN CURRENT SIZE
		JRST DSEDS1]
DSEDS1:	POP P,D			;#3 RESTORE
	POP P,C			;#3 RESTORE BYTE SIZE

	MOVX A,<^D36>		; Find conversion to local bytes per word
	IDIVI A,(C)		; as OPENFed
	LSH A,^D9		; Bytes per page
	MOVEM A,P2

; Look for holes in file, if hole, set byte count to + infinity

	SETOM PAGNO		; Scan to see if any holes
DSEDSH:	AOS A,PAGNO		; A page to check
	HRL A,LCLJFN		; In this file
	RPACS			; See if its there
	TXNE B,PA%PEX		; Exist?
	  JRST DSEDSH		; Yes. Look onward.
	FFUFP			; See if any pages are used beyond here.
	 SKIPA			; No. Simple sequential file.
	  MOVX P1,<1B1>		; Yes. Make length be infinite
	SUBTTL	Send DSK: file, page by page

; BP/ POINT $BYTE3,WINDOW, P1 is # bytes left to send, P2 is bytes per page

	SETOM PAGENO		; Starts at page zero-1
DSEDSP:	JUMPLE P1,DSENDX	; Leave if all bytes sent
	AOS A,PAGENO		; Next page #
	HRL A,LCLJFN		; In local file
	RPACS			; Page access bits
	TXNE B,PA%PEX		; Page exist?
	  JRST DSEDSQ		; Yes. Send it.
	FFUFP			; See if any more pages beyond.
	  JRST DSENDX		; No. End of file.
	SETO A,			; Yes. Pretend this hole was a page of 0.
DSEDSQ:
	MOVX B,<.FHSLF,,<WINDOW/1000>>
	MOVX C,<PA%RD>		; Map in the page
	PMAP

	MOVE C,P1		; Bytes left to send
	CAMLE C,P2		; If more than a page
	  MOVE C,P2		; Just a page now
	ADDM C,NBYTES		; Count bytes sent
	MOVNS C			; - Number of words for SOUT
	ADDM C,P1		; Bytes remaining after this page

	MOVE B,BP		; Pointer for SOUT

IFE TCPP,<	; NCP is dependent on channel byte size (8, 32, or 36 only)
	TXNE F,F.IMG
	  CALL UNPK98		; Have to shuffle bits
> ; End of IFE TCPP		; New B/ POINT $BYTE3,WINDW2, C/ -count

	HRRZ A,DATCON		; Send the data
	$SOUT
	ERJMP DSEEWR
	JUMPN C,DSEEWR

	CALL TIMEOK		; Update timer
	JRST DSEDSP		; Back for next page
	SUBTTL	Send from DSK:, PAGED type/structure

DSEDXT:	SETOM PAGENO		; Set window page number to zero-1
DSEDX1:	AOS A,PAGENO		; Next page to consider
DSEDX2:	HRRZM A,PAGNO		; Store file page number for net
	HRL A,LCLJFN		; Page pointer
	RPACS			; Find the access for the page
	MOVEM B,ACCESS		; Save bits for net

	TXNN B,PA%PEX		; Does page exist?
	  JRST DSEDX3		; No. Go see if any more.

	MOVX B,<.FHSLF,,<WINDOW/1000>>
	MOVX C,<PM%RD>		; Map it in for reading
	PMAP

	MOVX A,<PGT$SP>		; Simple page (TOPS20)
	SKIPE TENEX
	  MOVX A,<PGT$AP>		; Access controlled page (TENEX)
	MOVEM A,RECTYP		; This is a data record

	MOVX A,<1000>		; Length is one page of 36-bit bytes

; Kludge compression

	SKIPN WINDOW-1(A)	; Or less
	  SOJG A,.-1		; Drop trailing zeros
	CAIGE A,2		; Make sure at least some data
	  MOVX A,<2>		; So loops work

	MOVEM A,TYXNDW		; Store in header
	ADDM A,NBYTES		; And count in transfer length

	CALL DSEXHD		; Send this page

	CALL TIMEOK		; Update timeout timer
	JRST DSEDX1		; On to next page

; Missing page

DSEDX3:	FFUFP			; Are there any more pages?
	  JRST DSEDX4		; No.
	HRRZM A,PAGENO		; Yes, save the page number found
	JRST DSEDX2		; Go send it.

DSEDX4:	CALL DSEXFD		; Last page handled. Send FDB

; Send reached end of file

DSENDX:	MOVX B,<.MOSND>		; Send partial buffer
	MOVE A,DATCON		; May omit PUSH if going to close
;#3 always push, the current vax code can't handle data and FIN in same packet
;#3	TXNN F,F.CLSD		; Going to close?
	 $MTOPR			; No, PUSH data out
	  ERJMP DSEEMT
	JRST XFRDAX		; Done, all ok
	SUBTTL	Subroutine DSEXFD - Send PAGED descriptor block

DSEXFD:	SETZM ACCESS		; Send FDB & EOF for PAGED DSK: file
	SETZM PAGNO		; Clear access and page number
	MOVX A,<PGT$DP>		; Descriptor page
	MOVEM A,RECTYP		; To header

	SETO A,			; Release window
	MOVX B,<.FHSLF,,<WINDOW/1000>>
	SETZ C,			; Just one page
	PMAP

	MOVX A,<FDBBLK,,WINDOW>	; Put the FDB in it
	MOVE C,FDBBLK		; Actual length
	ANDI C,77		; Remove other info
	BLT A,WINDOW-1(C)

	HRROI A,WINDOW(C)	; Pointer to free word
	SETZ C,
	MOVX D,<-FDTXSN,,FDTXST> ; Locations of times & user names

DSEXFL:	HRRO B,(D)		; String
	SOUT			; After FDB
	IDPB C,A		; End string with a NUL
	HRROI A,1(A)		; Next free word
	AOBJN D,DSEXFL		; Back for next

	HRRZI C,-WINDOW(A)	; Words used
	MOVEM C,TYXNDW		; To header for net

IFN TCPP,<			; TCPP has LAST-PAGE after DESCRIPTOR-PAGE
	CALL DSEXHD		; Send descriptor page
	TXO F,F.FDB		; FDB sent

	MOVX A,<PGT$LP>		; Last page
	MOVEM A,RECTYP
	SETZM TYXNDW		; No data
> ; End of IFN TCPP		; Fall into DSEXHD to send LAST-PAGE
	SUBTTL	Subroutine DSEXHD - Send PAGED header & data blocks

; Send PAGED header and data (if any)
;	CALL DSEXHD	Send header & TYXNDW words from page in window

DSEXHD:	AOS A,TYXSCT		; Count the net seq number

IFE TCPP,<
	MOVEM A,SEQNO		; Put it in net header area
	SETZM CHKSUM		; Initialize checksum
	CALL PGCKSM		; Checksum header and page
	SETCAM A,CHKSUM 	; 1's comp to CHKSUM, will add to 0.
> ; End of IFE TCPP

	MOVE C,RECTYP		; Get page type
	MOVE B,PGLEN(C)		; Get corresponding header length
IFN TCPP,<MOVEM B,TYXNPW>	; Into header

	MOVE A,DATCON
IFE TCPP,<$BOUT			; Now. Send this stuff.
	    ERJMP DSEEWR>

	MOVN C,B		; Now that many words of hdr
	MOVX B,<POINT ^D36,TYXHED> ; Point to the data
	$SOUT			; Send the header
	ERJMP DSEEWR
	JUMPN C,DSEEWR

	MOVN C,TYXNDW		; And the data area, this long.
	MOVX B,<POINT ^D36,WINDOW>
	SKIPE C			; Omit if none
	 $SOUT
	  ERJMP DSEEWR
	JUMPN C,DSEEWR

	RET
	SUBTTL	Receive direction after JFN's are both open. Swallow the data


DRECV:	SETO A, 		; Get the window page free
	MOVX B,<.FHSLF,,<WINDOW/1000>>
	SETZ C,			; Just one page
	PMAP


DRCVL1:	TXNE F,F.TYPX		; Paged transfer?
	  JRST DRCX		; Yes.

	MOVE A,$BYTE3		; Byte size sent

IFE TCPP,<
	MOVNI C,1000		; Assume 1000 36-bit bytes
	TXNE F,F.IMG		; NCP CHANNEL processing?
	  MOVNI C,1100		; Yes, if 32 bit bytes 9/8 more
	CAIG A,^D8		; If 8-bit bytes,
	  IMULI C,4		; 4 times as many
> ; End of IFE TCPP

IFN TCPP,<
	MOVX B,<^D36>		; Bits per word
	IDIVI B,(A)		; Bytes per word
	IMULI B,1000		; Page's worth of bytes
	MOVNS C,B		; Negative for SIN
> ; End of IFN TCPP

	MOVX B,<POINT 0,WINDOW>	; Build byte pointer to WINDOW
	STOR A,PT$BSZ,+B

	PUSH P,B		; Save starting byte ptr
	PUSH P,C		; And count
	HRRZ A,DATCON		; Connection from net
	$SIN
	ERJMP DRCERE
	POP P,D 		; Starting count
	POP P,B 		; And pointer
	SUB C,D			; Actual count read by SIN

DRCOUT:	JUMPE C,DRCEOF		; If no bytes then EOF
	ADDM C,NBYTES		; Bytes transferred so far

	MOVNS C 		; Negative for SOUT
IFE TCPP,<
	TXNE F,F.IMG		; NCP CHANNEL processing needed?
	  CALL PACK89		; Yes. Call CHANNEL converter
> ; End of IFE TCPP
	HRRZ A,LCLJFN		; Where to put the data
	TXNN F,F.NUL		; Don't waste time on NUL:
	 SOUT
	  ERJMP DRCERE

DRCEFQ:		; PAGED enters here

	MOVE A,DATCON		; See if have gotten to EOF yet
	$GTSTS
	TXNE B,GS%OPN+GS%RDF	; Still happy?
	 TXNE B,GS%ERR
	  JRST DRCERD		; No.
	TXNE B,GS%EOF		; End of file?
	  JRST DRCEOF		; Yes
	JRST DRCVL1
	SUBTTL	Receive PAGED transfer.

DRCX:	SETO A,			; Throw away any junk in window page
	MOVX B,<.FHSLF,,<WINDOW/1000>>
	SETZ C,			; Just one page
	PMAP

	SKIP WINDOW		; Touch it to get a blank page

	MOVE A,DATCON		; Now get the header length
	$BIN
	ERJMP DRCERE
	JUMPN B,DRCXB		; Got a non-zero header lmngth

; Following should be NCP only, TCPP should be JRST DRCETD

	$GTSTS			; Should be EOF and "last" page
	TXNE B,GS%OPN+GS%RDF
	 TXNE B,GS%ERR
	  JRST DRCERD		; Error - not open, not read, error
	TXNN B,GS%EOF		; EOF?
	  JRST DRCETD		; No. Should not have a zero byte here.

	MOVE C,RECTYP		; EOF. Was last record the "last" page?
	CAME C,[PGT$LP]
	  JRST DRCELP		; No. Error.
	TXNN F,F.FDB		; Get FDB?
	  JRST DRCENF		; No. Error.
	JRST XFRDAX		; Good. Finish up.

DRCXB:	MOVEM B,TYXHDR		; Store in scratch area
	CAIL B,LTYXMN		; Range check it
	 CAIL B,NTXHDR		; Will it fit in this buffer?
	  JRST DRCEHL		; No good. Format error

	MOVN C,B		; Ok, read the header
IFN TCPP,<ADDI C,1>		; Count included count word
	MOVX B,<POINT ^D36,TYXHDR+1>
	$SIN
	ERJMP DRCERE
	JUMPN C,DRCEHR		; If didn't get it all, format error

IFE TCPP,<MOVX C,<TYXHDR+1,,TYXHED>> ; Copy it to real area known length
IFN TCPP,<MOVX C,<TYXHDR,,TYXHED>> ; Copy it to real area known length
	BLT C,TYXHED+TYXHDN-1

	MOVE C,TYXNDW		; Get the data length out of the header
	CAIL C,0		; Make sure it's reasonable
	 CAILE C,1000		; Up to a page
	  JRST DRCEDL		; Format error

	MOVX B,<POINT ^D36,WINDOW> ; Ok, read it into the window
	MOVNS C			; This many words, negative.
	SKIPE C 		; Allow for empty body
	 $SIN
	  ERJMP DRCERE
	JUMPN C,DRCEDR		; Make sure got it all

	AOS C,TYXSCT		; Check the sequence number

IFE TCPP,<
	CAME C,SEQNO		; Does it match sender's?
	  JRST DRCESQ		; No
	CALL PGCKSS		; Checksum the net header and data
	JUMPN A,DRCECK		; Checksum error!
> ; End of IFE TCPP

	MOVE A,RECTYP		; Get data record type
	TXNE F,F.DSK		; To disk?
	  JRST DRCXDS		; Yes.

; PAGED type/structure NOT to DSK:

	CAME A,[PGT$SP]		; Simple page or
	 CAMN A,[PGT$AP]	; Access controlled page?
	  SKIPA			; Yes
	   JRST DRCEFQ		; No, ignore non-data info

	MOVE C,TYXNDW		; Yes. Output the data to local file.
	MOVX B,<POINT ^D36,WINDOW> ; Set AC's like non-paged code.
	JRST DRCOUT		; And rejoin that code.




; PAGED type/structure header & data to DSK:

DRCXDS:	CAME A,[PGT$SP]		; Simple page or
	 CAMN A,[PGT$AP]	; Access controlled page?
	  JRST DRCXDA		; Yes, process data
IFN TCPP,<CAMN A,[PGT$LP]	; Last page?
	    JRST XFRDAX>	; Yes, done all ok
	CAMN A,[PGT$DP]		; Descriptor page?
	  JRST DRCXFD		; Yes
	JRST DRCEFQ		; No, ignore others for growth
	SUBTTL	PAGED data page to DSK: file
				; Put the data in the window into the file
DRCXDA:	MOVX A,<.FHSLF,,<WINDOW/1000>>
	HRRZ B,PAGNO		; Here in the file
	MOVEM B,PAGENO
	HRL B,LCLJFN
	MOVX C,<PM%WR>		; Write access
	PMAP			; In it goes

IFN TCPP,<
	MOVE A,RECTYP		; Get page type
	CAME A,[PGT$AP]		; Access controlled page
	  JRST DRCXD2		; No
	MOVE A,TYXNPW		; Header length
	CAML A,PGLEN+PGT$AP	; Correct length to contain ACCESS?
> ; End of IFN TCPP
	 SKIPN TENEX		; Invalid under TOPS-20
	  JRST DRCXD2		; Omit ACCESS processing

	MOVE A,B		; Now set the file access
	MOVE B,ACCESS
	SPACS
	ERJMP DRCESP
DRCXD2:
	SETO A,0		; And release window (to the file)
	MOVX B,<.FHSLF,,<WINDOW/1000>>
	SETZ C,			; Just one page
	PMAP

	MOVE A,TYXNDW		; Count the transferred bytes
	ADDM A,NBYTES
	JRST DRCEFQ		; See if any more.



	SUBTTL	Process recieved PAGED descriptor page

; Check for reasonable FDB length

DRCXFD:	MOVE A,WINDOW		; Length of FDB
	ANDI A,77
	CAIL A,MINFDB		; Look like an FDB?
	 CAILE A,MAXFDB+10
	  JRST DRCEFL		; No, say format error

; Get extra ASCIZ information after FDB into individual strings

	MOVE B,TYXNDW		; Information words there
	HRROI B,WINDOW(B)	; Pointer beyond end (negative)
	PUSH P,B

	HRROI A,WINDOW(A)	; String pointer from window
	SETZ C,
	MOVX D,<-FDTXSN,,FDTXST>

DRCXFI:	HRRO B,(D)		; String
	SIN			; Get it
	IDPB C,B		; End string with a NUL
	HRROI A,1(A)		; Beginning of next string
	CAMLE A,(P)		; Anythingthere?
	  SETZB D,@(D)		; No, stop
	AOBJN D,DRCXFI		; Back for next
	POP P,(P)		; Discard end address

; Convert date & time strings to internal format (TOPS20 & TENEX differ)

	MOVX D,<-FDTXTN,,FDTXT>
DRCXFJ:	HRRO A,(D)		; String pointer
	SETZ B,			; Any format
	IDTIM
	  TLO B,-1		; No time on error
	HLRZ A,(D)		; FDB offset to corresponding time
	MOVE C,B		; Keep FDB value if equivalent to string
	SUB C,WINDOW(A)		; See if close to FDB value
	MOVMS C			; If magnitude of difference is bigger
	CAILE C,4		;  than a few ticks,
	MOVEM B,WINDOW(A)	; Use time from string
	AOBJN D,DRCXFJ

; Update FDB information

	MOVX D,<-FDBTXN,,0> 	; Update the FDB
	MOVX C,<-FDBTMN,,0>	; Last are times
	PUSH P,C
DRCXFN:	MOVE A,LCLJFN		; Make pointer to FDB word
	HRL A,FDTXT1(D) 	; This word of FDB
	MOVE B,FDTXT2(D)	; This mask to change
	MOVE C,FDTXT1(D)	; From this word of net FDB
	MOVE C,WINDOW(C)
	CAML D,(P)		; A time?
	 SKIPL C		; Yes, valid?
	  CHFDB			; No. Put in the data
CHFDPC:	ERJMP .+1 ;DRCECF
	AOBJN D,DRCXFN		; Loop for changeable words of FDB
	POP P,(P)
REPEAT 0,<
	SKIPN F$KPGN		; Able to retain generation number?
	  JRST DRCXFP		; No

; If original file had a higher generation number, rename it

	HRRZ A,LCLJFN		; Get current
	MOVX B,<1,,.FBGEN>	; Generation number
	MOVEI C,D		; FDB word into D
	GTFDB
	  ERJMP DRCXFP		; Forget it

	HLRZS D			; Extract current #
	HLRZ C,WINDOW+.FBGEN	; Extract original #
	CAMG C,D		; Original greater?
	  JRST DRCXFP		; No, leave it as is

	MOVE D,C		; Save new number
	HRROI A,STRTMP		; Get current name
	HRRZ B,LCLJFN		; Without extension
	MOVX C,<..DEVA!..DIRA!..NAMA!..TYPA!JS%PAF>
	JFNS
	ERJMP DRCXFP		; Forget it
	SETZ C,
	IDPB C,A

	HRRZ A,D		; New generation #
	TXO A,<GJ%NEW!GJ%SHT>
	HRROI B,STRTMP		; Get another JFN
	GTJFN
	  ERJMP	DRCXFP		; Forget it
	HRRZ B,A		; New JFN

	HRRZ A,LCLJFN		; First close current file
	TXO A,CO%NRJ		; Keeping JFN
	CLOSF
	  ERJMP DRCXFO		; Loose, go cleanup

	HRRZS A			; Get rid of flags
	RNAMF			; Rename file to higher generation
	  ERJMP DRCXFO		; Loose, go cleanup
	MOVEM B,LCLJFN		; New local JFN, old released
	JRST DRCXFP		; All ok

DRCXFO:	MOVE A,B		; New JFN
	RLJFN			; Forget it
	  ERJMP .+1
DRCXFP:
> ; End of REPEAT 0

; Set original writer/creator name, if possible

	SKIPE TENEX
	  JRST DRCXFT		; TENEX
				; TOPS20
	MOVX D,<-FDTXUN,,FDTXUS>
DRCXFR:	HRRZ A,LCLJFN		; File
	HLL A,(D)		; Function
	HRRZ B,(D)		; Build pointer to string
	HRLI B,440700		; ..
	ILDB C,B		; See if it's null
	JUMPE C,DRCXF1		; If null, don't set it
	HRLI B,440700		; Rebuild string pointer
	SFUST
	ERJMP .+1		; Probably not enabled
DRCXF1:	AOBJN D,DRCXFR
	JRST DRCXFU

DRCXFT:	SETZ A,			; Literal string
	HRROI B,FDBUS0		; String DIRST
   SKIPA
	STDIR
	  ERJMP .+2
	  ERJMP .+1
	JFCL
DRCXFU:
	JRST DRCEFQ		; Should be EOF now if NCP.

FDTXT1:	EXP .FBCTL		; Can change these words
	EXP .FBBYV
	EXP .FBSIZ
	EXP .FBUSW
..Z=.
	EXP .FBCRV
	EXP .FBWRT
	EXP .FBREF
FDBTMN==.-..Z			; Number of times
FDBTXN==.-FDTXT1

FDTXT2:	EXP FB%TMP+1000000	; Temp and (TENEX) ephemeral bits
	EXP FB%BSZ		; Byte size
	EXP -1			; EOF
	EXP -1			; User settable word

	EXP -1			; Time this version created
	EXP -1			; Time this version last modified
	EXP -1			; Time last referenced

FDTXST:	EXP FDBTM1,FDBTM2,FDBTM3,FDBUS0,FDBUS1
FDTXSN=.-FDTXST
	SUBTTL	Data transfer Error Messages

DRCECF:	JSP X,XFRERR
	ASCIZS (452,451,< ? Unable to update local file descriptor.>)
DRCEDL:	JSP X,XFRERR
	ASCIZS (452,451,< ? Invalid PAGED data block length.>)
DRCEDR:	JSP X,XFRERR
	ASCIZS (452,451,< ? Premature EOF from network during PAGED data read.>)
DRCEFL:	JSP X,XFRERR
	ASCIZS (452,451,< ? Invalid PAGED FDB length.>)
DRCEHL:	JSP X,XFRERR
	ASCIZS (452,451,< ? Invalid PAGED header length.>)
DRCEHR:	JSP X,XFRERR
	ASCIZS (452,451,< ? Premature EOF from network during PAGED header read.>)
DRCELP:	JSP X,XFRERR
	ASCIZS (452,451,< ? Last block of PAGED transfer missing.>)
DRCENF:	JSP X,XFRERR
	ASCIZS (452,451,< ? No descriptor (FDB) information received.>)
DRCERD:	JSP X,XFRERR
	ASCIZS (452,451,< ? Error on network data connection.>)
DRCERE:	JSP X,XFRERR
	ASCIZS (452,451,< ? Read error on network data connection.>)
DRCESP:	JSP X,XFRERR
	ASCIZS (452,451,< ? Error setting local file page access.>)
DRCETD:	JSP X,XFRERR
	ASCIZS (452,451,< ? PAGED header length was zero.>)

IFE TCPP,<
DRCECK:	JSP X,XFRERR
	ASCIZS (452,451,< ? Software-detected checksum error from network during paged transfer.>)
DRCESQ:	JSP X,XFRERR
	ASCIZS (452,451,< ? Sequence error from net during paged transfer.>)
> ; End of IFE TCPP

DSEEFD:	JSP X,XFRERR
	ASCIZS (452,451,< ? Internal Error - Cannot access local file's FDB.>)
DSEEMT:	JSP X,XFRERR
	ASCIZS (452,451,< ? Internal Error - MTOPR failed.>)
DSEEWR:	JSP X,XFRERR
	ASCIZS (452,451,< ? Unexpected close of data connection.>)

MSG226:	ASCIZS (252,226,< Transfer completed.>) ; Ok & Connection closed
MSG250:	ASCIZS (252,250,< Transfer completed.>) ; Ok & connection open


; X/ Address of reply message

XFRERR:	TXO F,F.ERR		; Forces close of connection
	SUBTTL	Data Transfer Exit

DRCEOF:				; Received end of file

IFE TCPP,<TXNE F,F.DSK		; On disk and
	   TXNN F,F.IMG		; CHANNEL processing?
	    JRST DRCEF2		; No. Skip this.
	TXZ F,F.IMG		; Beware loop if CHFDB fails

	CLOSK (LCLJFN)		; Yes. Diddle up the EOF pointer

	MOVX B,<FB%BSZ>		; Byte size field
	MOVX C,<FLD(1,FB%BSZ)>	; One bit bytes
	HRRZ A,LCLJFN
	HRLI A,.FBBYV		; This word in FDB
	CHFDB			; Change it
	ERJMP DRCECF

	SETO B,
	MOVE C,NBYTES		; Number of bytes transferred
	IMUL C,$BYTE3		; Times byte size gives bits
	HRLI A,.FBSIZ		; This word
	CHFDB			; Store in FDB
	ERJMP DRCECF
DRCEF2:
> ; End of IFE TCPP

XFRDAX:	SETO A,			; Unmap the window pages
	MOVX B,<.FHSLF,,<WINDOW/1000>>
	SETZ C,			; No count
	PMAP
	ADDI B,1
	PMAP
	HRRI B,<WINDW2/1000>
	PMAP
	ADDI B,1
	PMAP

	TXNN F,F.ERR		; Have an error message?
	  HRROI X,MSG250	; No, Ok & leaving open
	TXNN F,F.CLSD!F.ERR	; Have to close (or error)?
	  JRST XFRDAZ		; No, all done

	CLOSD (DATCON,CO%WCL)	; Wait for other end to see close
	TXNN F,F.ERR		; Have an error message?
	  HRROI X,MSG226	; No, Ok & closed

XFRDAZ:	HRRZM X,$REPLM		; Local reply message address for superior
	RET			; Return from XFRDAT
	SUBTTL	Subroutine GETFDB

;	CALL GETFDB	Copies Disk FDB into FDBBLK
;Ret+1:	  Illegal instruction interupt
;Ret+2:	Ok

GETFDB:	SETZM FDBBLK		; Clear it in case not DSK: or NUL:
	MOVX A,<FDBBLK,,FDBBLK+1>
	BLT A,FDBBKE

	HRRZ A,LCLJFN		; Local file
	HRLZ B,LFDB		; System dependent FDB length
	MOVEI C,FDBBLK		; Store it here
	TXNN F,F.DSK		; If not disk,
	  JRST GETFDX		; Ok return
	GTFDB			; Get the info
	  ERJMP GETFDY

	MOVE A,FDBBLK		; Size of FDB
	ANDI A,777
	PUSH P,A		; For testing

	MOVX D,<-FDTXTN,,FDTXT>
	MOVX C,<OT%4YR!OT%TMZ!OT%SCL>
GETFD1:	HRRO A,(D)		; String pointer
	HLRZ B,(D)		; FDB offset
	CAMLE B,(P)		; In FDB?
	  JRST GETFD2		; No
	MOVE B,FDBBLK(B)	; Get time
	ODTIM
	ERJMP .+1
	AOBJN D,GETFD1
GETFD2:
	SKIPE TENEX
	  JRST GETFD5		; TENEX
				; TOPS20
	MOVX D,<-FDTXUN,,FDTXUG>
GETFD3:	HRRZ A,LCLJFN		; File
	HLL A,(D)		; Function
	HRRO B,(D)		; String pointer
	GFUST
	AOBJN D,GETFD3
	JRST GETFD6

GETFD5:	HRROI A,FDBUS0		; String pointer
	HLRZ B,FDBBLK(D)	; Directory number
	DIRST
	ERJMP .+1
GETFD6:
	POP P,(P)		; Drop FDB length
GETFDX:	AOS (P)			; Skip return
GETFDY:	RET

FDTXT:	XWD .FBCRV,FDBTM1	; Times  FDB offset,,String variable
	XWD .FBWRT,FDBTM2
	XWD .FBREF,FDBTM3
FDTXTN==.-FDTXT

FDTXUG:	XWD .GFAUT,FDBUS0	; User name  Function code,,String variable
	XWD .GFLWR,FDBUS1
FDTXUN==.-FDTXUG

FDTXUS:	XWD .SFAUT,FDBUS0	; User name  Function code,,String variable
	XWD .SFLWR,FDBUS1

	SUBTTL	NCP Subroutine PGCKSS

IFE TCPP,<
; Checksum routine for paged transfer type. Two entries, depending
; on whether the header is the preassembled length or
; the length that actually came from net.
;	CALL PGCKSS	Compute Checksum
; OR
;	CALL PGCKSM	Compute Checksum

PGCKSS:	MOVN B,TYXHDR		; Length from net
	HRLZ B,B		; Make AOBJN pointer
	HRRI B,TYXHDR+1 	; First word of hdr after its length
	JRST PGCKS1		; Join sender routine

PGCKSM:	MOVX B,<-TYXHDN,,0> 	; Length of header to be sent
	HRRI B,TYXHED		; And where it is.
PGCKS1:	SETZ A,			; Start with a sum of 0
	JCRY0 .+1		; Clear carry 0 flag
PGCKL1:	ADD A,0(B)		; Sum the data
	JCRY0 [AOJA A,.+1]	; End-around carry
	AOBJN B,PGCKL1		; Get the whole header
	MOVN B,TYXNDW		; Now the data area, this length
	HRLZS B 		; Make AOBJN counter
	JCRY0 .+1
PGCKL2:	ADD A,WINDOW(B) 	; Add a data word
	JCRY0 [AOJA A,.+1]	; Catch end-around carry
	AOBJN B,PGCKL2		; All the data
	AOSE A			; Make -0 into +0
	  SOS A			; Wasn't -0, correct and return
	RET

> ; End of IFE TCPP
	SUBTTL	NCP routine to shuffle bits to send CHANNEL in non-36 bit bytes

IFE TCPF,<

UNPK98:	PUSH P,C		; Negative SOUT byte count

	MOVX A,<-1000,,0>	; Process a page of words
	MOVX B,<-10,,0>		; State counter
	MOVX C,<-2000,,WINDW2-1> ; Pointer for 8/32 bit data

UNPK9L:	MOVE T1,WINDOW(A)	; A word of bits
	AOBJN C,.+1		; Count dest ptr
	TRNN B,-1		; Every eight states,
	  AOBJN C,.+1		; Have to count another
	LSHC T1,@IMISHT(B)	; Break into leftover in T1, new wd in T2
	DPB T1,IMIPT1(B)	; Store enough bits in first word
	MOVEM T2,0(C)		; And move word into second. Not yet full.
	AOBJN B,.+2		; Step the state counter
	  MOVX B,<-10,,0>	; Restart it
	AOBJN A,UNPK9L		; Loop for whole page

	POP P,C			; Negative 36-bit byte count
	MOVNS C
	IMULI C,^D9		; Convert to bytes (*9/8)
	ASH C,-3		; This many if 32 bit
	MOVE A,$BYTE3		; Is it eight bit?
	CAIG A,^D8		; (If not, must be 32)
	  ASH C,2 		; Yes. This many bytes to go out
	MOVNS C			; Make it negative again

	MOVX B,<POINT 0,WINDW2>
	STOR A,PT$BSZ,+B	; Byte size for SOUT pointer

	RET			; Back to send it
	SUBTTL	NCP subroutine to shuffle bits from 8/32 bit wds to 36 bit wds

PACK89:	TXNN F,F.DSK		; It is on disk isn't it?
	 RET			; No. Don't process it.

	SETZM WINDW2		; Yes. Clear the window page
	MOVX A,<WINDW2,,WINDW2+1>
	BLT A,WINDW2+777

	MOVX A,<-1100,,0>	; Number of 32 bit words in window
	MOVX B,<-10,,0>		; State counter
	MOVX C,<-1000,,WINDW2>	; Where 36 bit words go.

PACK8L:	AOBJP A,.+2		; Count thru input
	  MOVE T2,WINDOW(A)	; Get two 32 bit words
	MOVE T1,WINDOW-1(A)
	LSH T1,-4		; Butt the two 32 bit groups together
	LSHC T1,@IMOSHT(B)	; Shift to get the correct 36 bits
	MOVEM T1,0(C)		; Store output word
	AOBJN C,.+1		; Count output
	AOBJN B,PACK8N		; Need to reset state counter?
	  MOVX B,<-10,,0>	; Yes.
	  AOBJN A,.+1		; And step an extra word.
PACK8N:	JUMPL A,PACK8L		; Loop if more to do

	MOVX B,<POINT 36,WINDW>]
	MOVNI C,1000		; Packed 36-bit bytes
	RET
	SUBTTL	Tables for in and out CHANNEL processors

IMISHT:	REPEAT 10,<	XWD 0,-4*<.-IMISHT+1>>

IMIPT1:	REPEAT 10,<	POINT ^D<32-<4*<.-IMIPT1>>>,-1(C),31>

IMOSHT:	REPEAT 10,<	EXP <.-IMOSHT+1>*4>

> ; End of IFE TCPF



DLITS:;	LIT
	XLIST
	LIT
	LIST

HSTOP==.-1

.ORG ;BACK TO LOW SEGMENT
	SUBTTL	Interrupt Tables

LEVTAB:	EXP RETPC1,RETPC2,RETPC3

IFDEF USER,<				; User Program
CHNTAB:	0			; 0
	0			; 1
	0			; 2
	0			; 3
	0			; 4
	0			; 5
	0			; 6  Arithmetic Overflowl/nodiv
	0			; 7  Floating Point overflow/FXU
	0			; 8
	0			; 9  PDLOV
	0			; 10 EOF
	0			; 11 IO Data Error
	0			; 12 Quota Exceeded
	0			; 13
	0			; 14 Time of Day
	1,,INSINT		; 15 Illeg Instruction Int
	0			; 16 Illeg Memory Read
	0			; 17 Illeg Memory Write
	0			; 18 Illeg Memory Execute
	0			; 19 Fork Term
	0			; 20 Machine size exceeded (Disk/Drum??)
	0			; 21 Trap to User
	0			; 22 New Page
	0			; 23
IFN TCPF,<NTICHN==-1
	0>
IFE TCPF,<NTICHN==.-CHNTAB	; 24
	3,,NTIINT>
CGICHN==.-CHNTAB		; 25
	3,,CGINT		; Bell typed
COICHN==.-CHNTAB		; 26
	3,,COINT		; Control-O interrupt
IFE TCPP,<ABBCHN==-1>		; 27
IFN TCPP,<ABBCHN==.-CHNTAB	; IIC from TELNET to top
	3,,ABBINT>
ABOCHN==.-CHNTAB		; 28
	3,,ABOINT		; IIC from TELNET to top
CTTCHN==.-CHNTAB		; 29
	3,,CTTINT
	0			; 30
	0			; 31
	0			; 32
	0			; 33
	0			; 34
	0			; 35
IFN <.-44-CHNTAB>,<PRINTX ; CHNTAB not 36 long>

CHNMSK:	<1B<NTICHN>!1B<ABBCHN>!1B<ABOCHN>!1B<CGICHN>!1B<COICHN>!1B<CTTCHN>!1B<.ICILI>>
> ; End of IFDEF USER
	SUBTTL	Interrupt Tables

IFDEF SERVER,<				; Server program
CHNTAB:	0			; 0
	0			; 1
	0			; 2
	0			; 3
	0			; 4
	0			; 5
	0			; 6  Arithmetic Overflowl/nodiv
	0			; 7  Floating Point overflow/FXU
	0			; 8
	1,,PDLINT		; 9  PDLOV
	0			; 10 EOF
	2,,IOXINT		; 11 IO Data Error
	2,,QTAINT		; 12 Quota Exceeded
	0			; 13
	0			; 14 Time of Day
	1,,INSINT		; 15 Illeg Instruction Int
	1,,MEMINT		; 16 Illeg Memory Read
	1,,MEMINT		; 17 Illeg Memory Write
	1,,MEMINT		; 18 Illeg Memory Execute
	0			; 19 Fork Term
	1,,FULINT		; 20 Machine size exceeded (Disk/Drum??)
	0			; 21 Trap to User
	0			; 22 New Page
	0			; 23
TIMCHN==.-CHNTAB	; Channel poked by timing fork every now and then
	2,,TIMINT		; 24 Timing Fork Int
CTCCHN==.-CHNTAB	; Channel for Control-C
	2,,CTCINT		; 25 Control-C (or E in debug)
DETCHN==.-CHNTAB	; Channel for NVT hangup
	2,,DETINT		; 26 Detach Interrupt
CTTCHN==.-CHNTAB	; Channel for Control-T
	2,,CTTINT		; 27 Control-T
	0			; 28
	0			; 29
	0			; 30
	0			; 31
	0			; 32
	0			; 33
	0			; 34
	0			; 35
IFN <.-44-CHNTAB>,<PRINTX ; CHNTAB not 36 long>

ONCHNS:	1B<.ICPOV>!1B<.ICDAE>!1B<.ICILI>!1B<.ICIRD>!1B<.ICIWR>!1B18!1B<.ICMSE>!1B<TIMCHN>!1B<CTCCHN>!1B<DETCHN>!1B<CTTCHN>

FAIJFN:	BLOCK 1
	SUBTTL Constants

DEFINE CC (A,B) <
IFNDEF Z'A, <Z'A==NOTIMP>
>

	COMS


	PARMAC


IFN IPCLOG,<
INFMSG:	1,,.IPCIW		; .IPCI0 message to info
	0			; .IPCI1 no copy
	ASCIZ /[SYSTEM]FTSCTT/	; .IPCI2 get a PID for this name
ENDMSG==.
>

> ; End of IFDEF SERVER
	SUBTTL	Constants

GPDP:	IOWD PDLL,GPDL		; Global (top-level) stack
PDP:	IOWD PDLL,PDL

L1PDP:	IOWD PDLL,L1PDL		; Lev 1 PSI stack
L2PDP:	IOWD PDLL,L2PDL		; Lev 2 PSI stack
L3PDP:	IOWD PDLL,L3PDL		; Lev 3 PSI stack

CMDIP0:	POINT 7,CMDIB-1,34	;  Initial pointer to command buffer
WRDBP0:POINT 7,WORDBF-1,34	;u Initial pointer to word buffer

IFDEF SERVER,<
IFE TCPF,<FTPDAT: 2>		;s Local socket for data connection
IFN TCPF,<FTPDAT: ^D<21-1>>	;s Local port for data connection
> ; End of IFDEF SERVER

IFDEF USER,<
FTPSKT:	FTPICS			;u Protocol ICP socket #
IFE TCPF,<
DATSKT:	FTPDSK			;u Data socket for FTP version
> ; End of IFE TCPF
USRSKT:	USRSKN			;u User socket number U before job #

PMASK:	ASCII /
Your Password/
	BYTE (7) 15,43,43,43,43	;u
	ASCII /##########/
	BYTE (7) 15,115,115,115,115
	ASCII /MMMMMMMMMM/
	BYTE (7) 15,44,44,44,44
	ASCII /$$$$$$$$$$/
	BYTE (7) 15,15
PMASK2:	BYTE (7) 15,"T","h","a","n"
	ASCIZ /k-you.....
/
> ; End of IFDEF USER

T20PAR:	EXP	 0,T20FDB,T20CDL,T20CD2,T20WDL,T20WD2,T20LDL,T20LD2,T20EOL
TNXPAR:	EXP	-1,TNXFDB,TNXCDL,TNXCD2,TNXWDL,TNXWD2,TNXLDL,TNXLD2,TNXEOL

PATCHX=VERSIO			; Update version number if patched
PAT:
PATCH:	BLOCK 400		; For patching the binary
DBUGSW:	0			; Nonzero for debugging

; End of all code. Now the literals.

LITS:	XLIST ; LIT Statement
	LIT
	LIST

LSTOP==.

FREPAG==100			;u Page of free storage
	SUBTTL	Global Variables

	LOC 200000
GSBAS:
FREE:	BLOCK 1			;u Pointer to (end of) free core

GPDL:	BLOCK PDLL		;  Stack for top fork


; NB: order must match T20PAR & TNXPAR
TENEX:	BLOCK 1			; Non-zero if running on a TENEX system
LFDB:	BLOCK 1			; Length of disk FDB
EDIT0:
CDELCH:	BLOCK 1			; System-dependent character delete character
CDE2CH:	BLOCK 1
CDELWD:	BLOCK 1			; System-dependent word delete character
CDE2WD:	BLOCK 1
CDELLN:	BLOCK 1			; System-dependent line delete character
CDE2LN:	BLOCK 1
NEDITS==.-EDIT0
EOL:	BLOCK 1			; System-dependent end of input line character
; NB: order must match T20PAR & TNXPAR

VERSTR:	BLOCK 20		; ASCII version number

				;s Results of GJINF at start and LOGIN
GJINF1:	BLOCK 1			;s User ID # (TENEX 18-bit Dir # or
				;  TOPS20 36-bit User #)
GJINF2:	BLOCK 1			;s Connected directory #
GJINF3:	BLOCK 1			;s Job #
GJINF4:	BLOCK 1			;s -1 or attached TTY #

SYSDNM:	BLOCK 1			;s Dir number of SYSTEM
ANOUNO:	BLOCK 1			;s User number of ANONYMOUS or 0
ANNJFN:	BLOCK 1			;s JFN of ANONYMOUS.USERFILE while open
ANOPSW:	BLOCK 10		;s Where to store ANONYMOUS's password 
ANOPSE==.			;  from system text file

USERNM:	BLOCK 1			;s TENEX: Directory Number (STDIR($USER))
; or				;s TOPS20: User Number (RCUSR($USER))



DIRJFN:				;u Directory JFN in MULTIPLE GET
LSTJFN:	BLOCK 1			;s JFN where LIST or STAT goes.
LCLJFN:	BLOCK 1			;  JFN of local mail file, temp files
LCLGEN:	BLOCK 1			;u Local generation #
PRGJFN:	BLOCK 1			;s JFN from RMAP of this program
TJFN:	BLOCK 1			;u JFN of temporary file
$PATH1:	BLOCK 1		;-1	;s JFN for Rename From
$PATH2:	BLOCK 1		;-1	;s JFN for Rename To

$PTHS1:	BLOCK 40		;s String space for old name in RNFR


F$SEND:	BLOCK 1			;uCD 0 for rcv data from net, else send.
F$FLST:	BLOCK 1			; CR File status is being requested
F$KPGN:	BLOCK 1			; CD May rename local file to keep gen #
F$DOPN:	BLOCK 1			;uCD Flag to assure data conn opened
F$DTRQ:	BLOCK 1			;uC  Data transfer about to be requested
F$DTIP:	BLOCK 1			; C  Data transfer in prog (250, no 252)
F$WORK:	BLOCK 1			;uCD TIMEOK increments, CWFORK test/clears
F$DTDR:	BLOCK 1			;uCR Data trans done reply (252-4) came in.
F$STAR:	BLOCK 1			;uC  Flag top level is at left margin TYI
F$TCLS:	BLOCK 1			;u   Close foreign connection if non-0
F$VBOS:	BLOCK 1			;uCR -1 => VERBOSE typeout;  0 => brief

CGCOUNT:BLOCK 1			;u   -1 if no Control-G, counts upward

$FILST:	BLOCK 200		; CR  File status from STAT 213 reply
EFILST==.-1			;     Global for TELNET receiver to top fork

$REPLM:	BLOCK 1			; CD  Local data trans reply message address
	SUBTTL Network Information

HOSTNN:	BLOCK 1			;u Pointer to host number table
HOSTN:	BLOCK 1			;u Ptr to table of
				;  <Host #s and bits,,Ptr to ASCIZ>
HSTNAM:	BLOCK 1			;u ASCIZ pointed to from HOSTN table
; Tables above are in the FREE area

HOSTNP:	BLOCK 1			;  -# host names,,0 (from GTHST)
LHOSTN:	BLOCK 1			;  Local host # (32-bit Internet fmt)
LHSTYP:	BLOCK 1			;u Local host system type (in HS%STY field)
LHSTNM:	BLOCK 20		;  Local host name in ASCIZ
;NETLSK:BLOCK 1			;  Local Socket
MYDATS:	BLOCK 1			;s CVSKT of my data connection

FHSTN:	BLOCK 1			;  Foreign host # (32-bit Internet fmt)
FHSTYP:	BLOCK 1			;u Foreign host system type (in HS%STY field)
FTNXX:	BLOCK 1			;u Foreign host TENEX/-1, TOPS20/1, other/0
HOSTX:	BLOCK 1			;u Index into HOSTN for that host
FHSTNM:	BLOCK 10		;s Foreign host name in ASCIZ
FORNS:	BLOCK 1			;s Even numbered foreign NVT socket


REPEAT 0,<
NETSKX:	BLOCK 1			;s Index into net tables for the NVT
NBUFN:	BLOCK 1			;s GETAB 'NETBUF' -n,,tab #
NSTSN:	BLOCK 1			;s GETAB 'NETSTS' -n,,tab #
NETAWD:	BLOCK 1			;s  NVT GETAB 'NETAWD'
PRIVF:	BLOCK 1			;u Private socket flag
> ; End of REPEAT 0
	SUBTTL	Data Transfer Parameter Blocks

; Define transfer parameter blocks.  The User has three copies:  first
; is what has most recently been specified by the user,  second is the
; values to be used for the next data transfer (either user values
; or values appropriate for an internal operation (e.g. getting a
; directory listing),  third is the values most recently sent to the
; server (eliminates unnecessary commands to the server which
; remembers the parameters which are in effect.  The Server has a
; single copy, but defines dummy second and third copies on top of
; the first (allows code to be shared between User & Server programs).


; Note: User requires that $HOST be immediately followed by $SOCK
; (PORT command processing).


DEFINE XFRPAR (L,N<HOST,SOCK,MODE,STRU,TYPE,BYTE,FORM>)<ZZ==.
IRP N,<$'N'L=ZZ
	ZZ==ZZ+1> ; End of IRP N
> ; End of DEFINE XFRPAR


PARAMS:	XFRPAR			;  The data transmission parameters
EPARAMS==ZZ-1			;  End of first copy
NPARS==ZZ-PARAMS		;  Number of parameters in block

IFDEF USER,<LOC ZZ>		;  Second copy may overlay first

PARAM2:	XFRPAR 2		;  Copy during actual transfer
EPAR2==ZZ-1

IFDEF USER,<LOC ZZ>		;  Third copy may overlay first

PARAM3:	XFRPAR 3		;  Last ones sent out
;EPAR3==ZZ-1

	LOC ZZ			;  One copy occupies space


$LTYPE:	BLOCK 1			;  Local packing
$LBYTE:	BLOCK 1			;  Local byte size
$FILLB:	BLOCK 1			;  Local filler byte



IBITCT:	BLOCK 1			;  Bit count for logging: MAIL/RETR/STOR/APPE
TSBITS:	BLOCK 1			;  Bits sent by RETR (cumulative, never used)

NBYTES:	BLOCK 1			;  Bytes moved by last file transfer command
PAGENO:	BLOCK 1			;  Page # to map in DSK file (global for ^T)
TYXSCT:	BLOCK 1			;  Sequence number for paged mode
	SUBTTL Paged Mode Header

IFE TCPP,<	; Do NOT separate the next few. They are the "TYPE XTP" header
TYXHED:	BLOCK 0			;  Tag the header area
CHKSUM:	BLOCK 1			;  Checksum of the data chunk
SEQNO:	BLOCK 1			;  Sequence number of the chunk
TYXNDW:	BLOCK 1			;  Number of data words goes here
PAGNO:	BLOCK 1			;  Page number in disk file
ACCESS:	BLOCK 1			;  RPACS arg for disk file
RECTYP:	BLOCK 1			;  Type of net chunk
	PGT$LP==:-3		;  Last page
	PGT$SP==:0		;  Simple data page
	PGT$DP==:-3		;  Descriptor page
	PGT$AP==:0		;  Access controlled page
TYXHDN==.-TYXHED		;  Length of this header
; End of unseparable stuff

PSTOP==.			;  Following are constants, not variables
	LOC LSTOP		;  So back to low segement
	EXP TYXHDN,0,0		;  Header length of PGT$LP==PGT$DP, (unused)
PGLEN:	EXP TYXHDN		;  PGT$SP == PGT$AP
LTYXMN==6			;  Minimum header length
LSTOP==.
	LOC PSTOP		;  Back to process-private area
> ; End of IFE TCPP


IFN TCPP,<	; Do NOT separate the next few. They are the "STRU P" header
TYXHED:	BLOCK 0			;  Tag the header area
TYXNPW:	BLOCK 1			;  Header length (4 or 5)
PAGNO:	BLOCK 1			;  Page number in disk file
TYXNDW:	BLOCK 1			;  Number of data words goes here
RECTYP:	BLOCK 1			;  Page type
	PGT$LP==:0		;  Last page
	PGT$SP==:1		;  Simple data page
	PGT$DP==:2		;  Descriptor page
	PGT$AP==:3		;  Access controlled page
ACCESS:	BLOCK 1 ;(OPTIONAL)	;  RPACS arg for disk file
TYXHDN==.-TYXHED		;  Length of this header
; End of unseparable stuff

PSTOP==.			;  Following are constants, not variables
	LOC LSTOP		;  So back to low segement
PGLEN:	EXP 4,4,4,5		;  Header lengths for PGT$LP, $SP, $DP, $AP
LTYXMN==4			;  Minimum header length
LSTOP==.
	LOC PSTOP		;  Back to process-private area
> ; End of IFN TCPP

NTXHDR==40			;u Length to allow on reading net
TYXHDR:	BLOCK NTXHDR		;u Make longer in case it grows
	SUBTTL	TELNET & Data Connection Control & Data Blocks

IFN TCPF,<			;  Only one TCP connection to send+receive
PRT227:	BLOCK 1			;u Port # from PORT reply (host in SOC255)

RCON:			; TCP File block including CDB + Buffer headers
SCON:	BLOCK <T.SIZE>		;  TELNET file block including CDB
	BLOCK 2*T.NDBF*.TCPBS	;  TELNET buffer headers
TELRBF:	BLOCK <T.BFSZ*T.NDBF>	;  TELNET receive data buffers
TELSBF:	BLOCK <T.BFSZ*T.NDBF>	;  TELNET send data buffers

			; TCP File block including CDB + Buffer headers
DATCON: BLOCK T.SIZE		;  Data connection file block including CDB
	BLOCK 2*T.NDBF*.TCPBS	;  Data connection buffer headers
DATBUF:	BLOCK <2*T.BFSZ*T.NDBF> ;  Data connection data buffers

JFNTXS:	BLOCK 60		;  Text string from JFNS (used by simulation)
EJFNTX==.-1
> ; End of IFN TCPF


IFE TCPF,<
FORNS:	BLOCK 1			;  Foreign socket sent on ICP ("S")
SOCRFC:	BLOCK 1			;  Socket requesting data RFC
SOC255:	BLOCK 1			;  Socket server claimed he would use
IJFN:	BLOCK 1			;  ICP JFN
SCON:	BLOCK 1			;  TELNET send con
RCON:	BLOCK 1			;  TELNET receive con
DATCON:	BLOCK 1			;  Data network socket con
				;  Data conn JFN if MLFL
NCPBLK: BLOCK 20		;  Connection data block
> ; End of IFE TCPF


GSTOP==.
	SUBTTL	Process-Private Variable Storage

	LOC 300000
PSBAS:	BLOCK 1

NTIIA:	BLOCK 1			;u Save AC A here in NTIINT

RETPC1:	BLOCK 1			;  Return PC's for PSI system
PI1AC:	BLOCK 20		;  Storage for Lev 1 AC's
L1PDL:	BLOCK PDLL		;  Another on Lev 1 PSI

RETPC2:	BLOCK 1
PI2AC:	BLOCK 20		;  Storage for Lev 2 AC's
L2PDL:	BLOCK PDLL		;  And another on Lev 2

RETPC3:	BLOCK 1			;  ..
PI3AC:	BLOCK 20
PI3PDL:
L3PDL:	BLOCK PDLL

PDL:	BLOCK PDLL		;  Stack for a fork

; Top fork

IRFMOD:	BLOCK 1			;u What RFMOD got after RESET at go
ICOCB:	BLOCK 1			;u Initial FCOC
ICOCC:	BLOCK 1
FCOCB:	BLOCK 1			;u Initial FCOC, adjusted
FCOCC:	BLOCK 1

RESTRT:	BLOCK 1			;s Flag that we've run before

CPUTIM:	BLOCK 1			;u Timing cells
DAYTIM:	BLOCK 1			;u ..
IFRKTM:	BLOCK 1			;s Time meter for logging
KTIMET:	BLOCK 1			;s Time when job will be killed by
				;  time of day interrupt
IOXFLG:	BLOCK 1			;s Flag set by IO err PSI
CTCFLG:	BLOCK 1			;s Flag set by ^C PSI
LGOCNT:	BLOCK 1			;s Counter to force logout on time.

DFORKH:	BLOCK 1			;u Fork handle of data copier
RFORKH:	BLOCK 1			;u Fork handle of TELNET receiver
SFORKH:	BLOCK 1			;u Fork handle of TELNET sender
;THISFK:BLOCK 1			;u This fork's handle
TFORKX:	BLOCK 1			;s Fork handle of timing fork

IFN IPCLOG,<
IPCDAT:	BLOCK 100		;s Data area for msgs to/from IPCF
PIDARG:	BLOCK 10		;s Arg block for IPCF calls
CTLPID:	BLOCK 1			;s PID of FTSCTL
MYPID:	BLOCK 1			;s PID of FTPSRV
>
	SUBTTL Command Parsing

PRVKWD:	BLOCK 2			;s Previous keywrd, for sequence-
				;  dependant commands RNTO, PASS
KEYWRD:	BLOCK 2			;s The command verb
ARGWRD:	BLOCK 2			;s The arg for some commands
CARG1:	BLOCK 1			;s First argument to command
CARG2:	BLOCK 1			;s Second argument to command

$ACCES:	BLOCK 3			;s Argument block for ACCES JSYS

USRFCT:	BLOCK 1			;s Bad user names counter
$USER:	BLOCK 11		;s User name text string

PASFCT:	BLOCK 1			;s Password failure counter
$PASS:	BLOCK 11		;s Password text string

$ACCT:	BLOCK 12		;s Account word or string

$CWD:	BLOCK 1		; 0	;s Dir Num of CWD command

TEMSTR:	BLOCK 50		;#5 MORE RANDOM STRING SPACE
STRTMP:	BLOCK 100		;  A random string space
ESTRTM==.-1

ERRSTR:	BLOCK 30		;s Error string
LPTSTR:	BLOCK 30		;s Arg of XLPTF command
RCDSTR:	BLOCK 12		;s Space to build up a dir name
USERST:	BLOCK 20		;s Name string of directory from CWD

WORDXP:	BLOCK 1			;u Argument to GETWRD. -N,,Table of ASCIZ
RECX:	BLOCK 1			;u Index when found by RECOG, or -1 if none

BREAKC:	BLOCK 1			;u Character after word
LASTCC:	BLOCK 1			;u Last char read by GCH.

WORDBP:	BLOCK 1			;u Pointer into word string storage
WORDBF:	BLOCK 40		;u Word storage
EWORDB==.-1

GCHSAV:	BLOCK 1			;u Saved char (ESC) to read at GCH, or 0

TSINIX:	BLOCK 1			;u Initial count for TSIN routine
WRDBPS:	BLOCK 1			;  Beginning of current word/string
CMDIC:	BLOCK 1			;u Input line count, >=0
CMDIP:	BLOCK 1			;u Input line pointer, POINT 7,LINBF
CMDIS:	BLOCK 1			;u Input line space, free <= 5*NLINBF
RDTTYC:	BLOCK 1			;u Control-R text address for RDTTY


SBP:	BLOCK 1			;s Byte pointer as command is scanned
CMDIB:	BLOCK LCMDIB		;  The TELNET line collected from net


REPLYP:	BLOCK 1			;s Pointer to reply being built
REPLYM:	BLOCK LREPLY		;s And answer being built for reply

USERBF:	BLOCK 20		;u User name
EUSRBF==.-1

PASSBF:	BLOCK 20		;u Password
EPASBF==.-1

ACCTBF:	BLOCK 20		;u Account
EACTBF==.-1

PREFIX:	BLOCK 1			;u Flag there is a prefix
SUFFIX:	BLOCK 1			;u Flag there is a suffix
PREFXB:	BLOCK 40		;u String storage for prefix and suffix
SUFFXB:	BLOCK 40

FRNPTH:	BLOCK 40		;u Foreign pathname
EFRNPT==.-1

FRNPT2:	BLOCK 40		;u Second foreign path (RENAME)
EFRNP2==.-1
	SUBTTL	Variables Used by XGTJFN to Parse Filespecs

; PARSE block
JBLOCK:				;s  Arg block for long GJTFN
GTJBLK:	BLOCK 20;1+.GJJFN+.GJRTY-.GJJFN ; Long GTJFN control block
EJBLOK==.-1
GTJBKE==.-1			;  Last word in block

FJFNS:	BLOCK 1			;  Fields specified flag word

LGJDEV==10
GTJDEV:	BLOCK LGJDEV		;  Device string
LGJDIR==20
GTJDIR:	BLOCK LGJDIR		;  Directory string
LGJNAM==10
GTJNAM:	BLOCK LGJNAM		;  Name string
GTJEXT:	BLOCK 10		;  Type string
GTJGEN:	BLOCK 1			;  Pointer to position of generation #
LGJPRO==10
GTJPRO:	BLOCK LGJPRO		;  Protection string
LGJACT==10
GTJACT:	BLOCK LGJACT		;  Account string

FILTMP:	BLOCK 1			;  -1 if ;T, 0 otherwise
FILSIZ:	BLOCK 1			;  File size
FILTCR:	BLOCK 1			;  Time file created
FILTWR:	BLOCK 1			;  Time file last written
FILTRD:	BLOCK 1			;  Time file last referenced
LFLUCR==10
FILUCR:	BLOCK LFLUCR		;  User name of creator
LFLUWR==10
FILUWR:	BLOCK LFLUWR		;  User name of last writer
GTJEND:	BLOCK 1			;  (Unused)
; End of PARSE block


GTJLCL:	BLOCK GTJEND+1-GTJBLK	;  PARSE block for local filespec


GTJSTR:	BLOCK 60		;  Space to build a filename string

; .GE. MAX(TENEX=25,101B=30,TOPS-20=.FBLEN)
FDBBLK:	BLOCK 50		;  Area to hold an FDB
FDBTM1:	BLOCK 10		;  Times
FDBTM2:	BLOCK 10
FDBTM3:	BLOCK 10
FDBUS0:	BLOCK 10		;  User names
FDBUS1:	BLOCK 10
FDBBKE==.-1			;  End for BLT to clear

STATMP:	BLOCK 2			;u Values returned by STAT JSYS
RETVER: Z			;#4 FLAG WORD FOR VERSION NUMBER
	SUBTTL	Mail Information & TELNET Receiver & Pages for PMAPs

MLDIR:	BLOCK 1			;s Directory number of mail recipient
MLUSR:	BLOCK 1			;s User number of mail recipient
MLUNWD=20			;s Note only first 10 go to forwarder
MLUNST:	BLOCK MLUNWD+1		;s Name of unknown mail addressee
ACTACS:	BLOCK 20		;s AC storage for forwarder fork
MLFWST:	BLOCK 30		;s Name for forwarding
LOGJFN:	BLOCK 1			;s JFN of log file for pmapping mail stat
MALCPU:	BLOCK 1			;s More metering
MLTIMT:	BLOCK 1			;s Temp for GMT time computation
TRBITS:	BLOCK 1			;s Bits recv'd in mail (cumulative, never used)

REPEAT 0,<
ONLNPT:	BLOCK 1			;  AOBJN ptr into ONLNTB
$OLNTL==10			;  Max # TTY's can XSEN to
ONLNTB:	BLOCK $OLNTL		;  Table of TTY's user is logged onto
MSGBPT:	BLOCK 1			;  Byte ptr into buffer
MSGLNS:	BLOCK 1			;  # lines in XSEN buffer
MLERRC:	BLOCK 1			;  Error code returned by WRTSND
MSGCNT:	BLOCK 1			;  # chars left in buffer
> ; End of REPEAT 0


; User TELENT receiver fork

RCVLIN:	BLOCK 100		;u Space for the incoming TELNET line
ERCVLN==.-1			;u End of same
RCVLST:	BLOCK 101		;u Last TELNET line received
TNRSSS:	BLOCK 1			;u TELNET state
REPCOD:	BLOCK 1			;u Reply code as a number
REPIDX:	BLOCK 1			;u And index into reply tables

	LOC <<<.+777>/1000>*1000>

TPAG:	BLOCK 2000		;  Catches GTJFN echos (-FTP-ECHO.TMP)
WINDOW:	BLOCK 2000		;  File window.
WINDW2:	BLOCK 2000		;  Pages for expanding 32/36 images
BLTADR:	BLOCK 1000		;s Page for mapping mailbox forwarder
BLTPAG==BLTADR/1000		;s Becomes page 0 of MAILBOX.EXE/SAV
		; 140-147 ASCIZ Name (In/Out), 150-157 ASCIZ Host (Out)
;MSGBUF:BLOCK 2000		;  Room for collecting message txt
;$MBFLN==2000*5			;  # Chars to fit in buffer

IFN .&777,<PRINTX Storage not on page boundaries!!!>

PSTOP==.
	'END'			;  Convince loader to put symbols above here

	LOC LSTOP
	LIT		; Shouldn't be any
LSTOP==.

	END GO