Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - stanford/ftp/ftputl.mac
There are no other files named ftputl.mac in the archive.
;<FTP>FTPUTL.MAC.73, 17-Mar-85 17:14:19, Edit by LOUGHEED
; SRA's more general version of edit 72
;<FTP>FTPUTL.MAC.72, 16-Mar-85 13:58:21, Edit by LOUGHEED
; From MIT: .SFUST doesn't quote nulls (or "." or "-")
;<FTP>FTPUTL.MAC.71, 20-Aug-84 21:07:24, Edit by KRONJ
; Fix CKSSET for separate remote and local types
;<FTP>FTPUTL.MAC.70, 16-May-84 12:22:15, Edit by KRONJ
; Accept any binary transfer w/transfer byte size 36
;<FTP>FTPUTL.MAC.69,  3-May-84 22:58:12, Edit by KRONJ
; KILFIL calls UNMAP for a better chance of successfully closing
;<FTP>FTPUTL.MAC.68, 26-Apr-84 14:36:03, Edit by KRONJ
; Move OPNSTO here from FTP
;<FTP>FTPUTL.MAC.67, 23-Apr-84 16:50:11, Edit by KRONJ
;<FTP>FTPUTL.MAC.66, 23-Apr-84 15:48:04, Edit by KRONJ
; Account for differences in logical and physical byte sizes when counting
; bytes in file to be sent.
;<FTP>FTPUTL.MAC.64, 31-Mar-84 17:43:41, Edit by LOUGHEED
; CHKPLT/SETPLT in Stanford conditionals

	SEARCH FTPDEF,JOBDAT
	TTITLE (FTPUTL, -- UUOs and other useful routines for FTP and PUPFSV)

	;; Based on the PUPUUO module of UUOs for the PUP FTP programs
	;; by E. Taft, March 1977, Copyright 1979 by Xerox Corporation.
	;;
	;; Copyright (C) 1984 Board of Trustees, Stanford University
	;; The information in this software is subject to change without
	;; notice and should not be construed as a commitment by Stanford
	;; University.  Stanford assumes no responsibility for the use or
	;; reliability of this software.

	EXTERN TEMP,FILJFN,SETWDT,OVRQTA,EDISC,STYBAD,PRMCNF

	LOC .JB41		; The place for UUOs
	CALL DOLUUO		; This is our UUO handler instruction
	RELOC			; Now go back to normal code

; Double skip (+3)!
R2SKIP::AOS (P)			; Set +3 return
	RETSKP			; Do it


; UUO handler.  This must be reentrant to handle the WRITE
; within %LETJ for undefined JSYS errors.
DOLUUO:	PUSH P,A		; Save an AC
	MOVE A,.JBUUO		; Pick up LUUO
	LSH A,-^D27		; Position opcode to RH
	MOVE A,UUODSP-1(A)	; Get location from UUO dispatch table
	EXCH A,0(P)		; Restore AC, put location on stack
	RET			; Fix stack and jump to UUO handler


; UUO dispatch table (driven by definitions in FTPDEF)
; UUO handler routines are responsible for saving their own ac's

UUODSP:	EXPAND(UUOS,<	IF2,<IFNDEF ITEM,<EXTERN ITEM>>
			EXP ITEM>)

; TYPE <string>
; Type given string with formatting actions

LS TYPBUF,200			; Hold 640 chars, plenty for any typeout

%UTYPE:	CALL FORMAT		; Call formatter
	 MOVE A,[POINT 7,TYPBUF] ; Set up byte pointer
	 CALL %UTYP1		; Send off buffered text
	RET   			; Return from UUO

%UTYP1:	SETZ B,			; Prepare to store null
	IDPB B,A		; Append null to buffer
	HRROI A,TYPBUF		; Point to buffered typeout
	PSOUT%			; Send it all off at once
	RET

; ETYPE <string>
; Type given error message with formatting actions
; Optional second argument is instruction to execute

%UETYP:	PUSH P,.JBUUO		; Save instruction in case reentrant UUO
	AOS .JBUUO		; Skip over instruction
	CALL FORMAT		; Call formatter
	 MOVE A,[POINT 7,TYPBUF] ; Set up byte pointer
	 CALL %UETY1		; Send off buffered text
	POP P,.JBUUO		; Now restore instruction
	XCT @.JBUUO		; Execute instruction there
	RET   			; Return from UUO

%UETY1:	SETZ B,			; Prepare to store null
	IDPB B,A		; Append null to buffer
	HRROI A,TYPBUF		; Point to buffered typeout
	ESOUT%			; Send it all off at once
	RET

; WRITE <string>   or   WRITE ac,<string>
; Write given string with formatting actions on arbitrary
;  destination designator given in ac (default ac is A)

%UWRIT:	CALL FORMAT		; Call formatter
	 CALL %UWRI1		; Setup -- get selected designator
	 CALL %UWRI2		; Completion -- update designator
	RET   			; Return from UUO

; Setup routine -- fetch designator from ac specified in UUO
%UWRI1:	LDB A,[POINT 4,.JBUUO,12]	; Get ac field of UUO
	CAIG A,D		; Ac in protected range?
	 ADDI A,-5(P)		; Yes, now on stack
	HRLM A,-5(P)		; Save address for finishing up
	MOVE A,0(A)		; Get designator from specified ac
	RET   

; Completion routine -- store possibly updated designator
%UWRI2:	HLRZ D,-5(P)		; Recover ac field of UUO
	MOVEM A,0(D)		; Store updated designator
	SETZ B,			; Prepare to store null
	TLNE A,-1		; Outputting to string?
	 IDPB B,A		; Yes, append null
	RET   
; Perform output formatting for UUO routines.
; Assumes ASCIZ string pointed to by .JBUUO (effective adr of UUO).
; Performs substitution for escape sequences of the form
;	% <number> <letter>
; where <number> sometimes specifies an ac and <letter> specifies
; the operation (see table LETDSP).

; Call by:
;	CALL FORMAT
;	 Instruction to set up destination designator in A
;	 Instruction to finish up after entire string written
; Returns +3 always
; No ac's clobbered

FORMAT::PUSH P,A		; Save a block of ac's
	PUSH P,B
	PUSH P,C
	PUSH P,D
	XCT @-4(P)		; Execute setup instruction
	MKPTR(A)		; Make sure we have real byte pointer
	HRRZ B,.JBUUO		; Get the effective address
	HRLI B,(POINT 7)	; Make byte ptr
	PUSH P,B		; Put on stack

; Loop here for each character
; A/ destination designator
	TRNA			; Skip over FBOUT
FORMA1:	 CALL FBOUT		; Here to send char before looping
FORMAL:	ILDB B,0(P)		; Get a char from the string
	IFE. B			; If null, finished
	  ADJSP P,-1		; Flush byte pointer
	  AOS D,-4(P)		; Get caller pc, set up triple skip return
	  XCT (D)		; Execute completion instruction
	  POP P,D		; Restore ACs
	  POP P,C
	  POP P,B
	  POP P,A
	  RETSKP		; Return +3
	ENDIF.

; Have next character in the string.  Look at it to see if it's a schema.
	CAIE B,"%"		; Escape?
	 JRST FORMA1		; No, just type normally

; Here when hit escape sequence.  Find number after it.
	SETZ C,			; Init number
	DO.
	  ILDB D,0(P)		; Get next char
	  CAIL D,"0"		; A digit?
	   CAILE D,"7"
	    EXIT.		; No, done
	  LSH C,3		; Yes, multiply number by 8
	  ADDI C,-"0"(D)	; Add value of new digit
	  LOOP.
	ENDDO.

	MOVEI B,-5(P)		; Get loc-1 of ac block on stack
	ADDI B,(C)		; Add ac #
	CAIG C,D		; One of the protected ac's?
	 SKIPA B,0(B)		; Yes, get contents from stack
	  MOVE B,0(C)		; No, get contents directly
	CAIL D,"A"		; Check bounds
	 CAILE D,"Z"
	  IFSKP.
	    CALL @LETDSP-"A"(D)	; Dispatch on command
	    JRST FORMAL		; Loop
	  ENDIF.

	CAIE D,"%"		; %% means just quote %
	IFSKP.
	  MOVEI B,"%"
	  JRST FORMA1
	ENDIF.

	CAIE D,"_"		; %_ means conditional CRLF
	IFSKP.
	  PUSH P,A		; Save output designator
	  MOVEI A,.CTTRM	; Controlling TTY
	  RFPOS%		; Read cursor position
	  POP P,A		; Restore designator
	  TXNE B,.RHALF		; Are we at column 1?
	   JRST SCHCRL		; No, add a CRLF
	  JRST FORMAL		; Back for next char
	ENDIF.

	CAIE D,"/"		; %/ means crlf
BADSCH:	 FATAL <Unexpected schema character>
SCHCRL:	MOVEI B,15
	CALL FBOUT
	MOVEI B,12
	JRST FORMA1		; Go send it off


; Dispatch table for escape sequence function letters
; The routine dispatched to has the calling sequence:
;	A/ Destination designator
;	B/ Contents of ac
;	C/ The ac number itself
; Returns +1
; Must update A appropriately;  may clobber B-D

LETDSP:	BADSCH			; A
	BADSCH			; B
	%LETC			; C - Character in AC
	%LETD			; D - Decimal integer in AC
	BADSCH			; E
	%LETF			; F - Filename for JFN in AC
	BADSCH  		; G
	BADSCH  		; H
	%LETI			; I - Insert character given octal code
	%LETJ			; J - String for JSYS error # in ac
	BADSCH  		; K
	BADSCH  		; L
	BADSCH  		; M
	BADSCH  		; N
	%LETO			; O - Octal integer in ac
	BADSCH			; P
	%LETQ			; Q - like S but quote ) and '
	%LETR			; R - Runtime interval in ac - HH:MM:SS.S
	%LETS			; S - ASCIZ string pointed to by ac
	%LETT			; T - Date and time in ac
	%LETU			; U - User name for directory # in ac
	BADSCH			; V
	BADSCH			; W
	BADSCH			; X
	BADSCH			; Y
	BADSCH			; Z
; Individual functions for escape sequences

; C - Character in AC
%LETC:	JUMPN B,FBOUT		; Send non-null character off
	RET			; Or ignore null

; D - Decimal integer in ac
%LETD:	MOVX C,FLD(^D10,NO%RDX)	; Decimal radix
	NOUT%			; Output number
	 JFATAL
	RET   


; F - Filename for JFN in ac
%LETF:	SKVERB VB.TRS		; Are we in server?
	 TDZA C,C		; No, use standard form
	  MOVX C,JS%SPC		; Yes, use all fields
	JFNS%			; Generate filename string
	RET   


; I - Insert character for given octal code
%LETI:	MOVE B,C		; Get the code
;	CALLRET FBOUT		; Output it


; Internal BOUT% routine
; Same as BOUT% except much faster in string pointer case
; (Does not handle case of lh=-1

FBOUT::	TLNN A,-1		; Outputting to a file?
	 BOUT%			; Yes, do so in normal manner
	TLNE A,-1		; To string?
	 IDPB B,A		; Yes (much faster than BOUT%)
	RET   


; J - String for JSYS error # in ac
%LETJ:	HRLI B,.FHSLF		; This fork
	TDZN C,C		; No string limit.  If no AC given
	 TXO B,.RHALF		; Then use last JSYS error encountered
	ERSTR%			; Convert error # to string
	 JRST %LETJU		; Undefined error number
	 FATAL <JSYS error in ERSTR>
	RET   			; Done

%LETJU:	PUSH P,A		; Save pointer
	MOVEI A,.FHSLF		; On self
	GETER%			; Get error condition
	POP P,A			; Get pointer back
	HRRZS B			; Keep only error number
	WRITE <Undefined error %2O> ; Write this way
	RET

; O - Octal integer in ac
%LETO:	MOVX C,NO%MAG!FLD(10,NO%RDX)
	NOUT%			; Output number
	 JFATAL
	RET   

; Q - string pointed to by AC, with ' and ) appropriately quoted
%LETQ:	MKPTR(B)		; Make sure we have a real byte pointer
	MOVE C,B		; Get string in more convenient place
	DO.
	  ILDB B,C		; Get next char
	  JUMPE B,ENDLP.	; Done if null
	  CAIE B,PQUOTE		; Quote?
	   CAIN B,")"		; or close paren?
	    IFNSK.
	      MOVEI B,PQUOTE	; Yes, get quote
	      CALL FBOUT	; Send it off
	      LDB B,C		; Now get character to send again
	    ENDIF.
	  CALL FBOUT		; Send it off
	  LOOP.			; Back for the next
	ENDDO.
	EXCH B,C		; Clean up
	RET			; All done
; Individual functions for escape sequences (cont'd)

; R - Runtime interval in ac (ms), in form HH:MM:SS.S
%LETR:	ADDI B,^D50		; Round up to nearest 0.1 second
	IDIV B,[^D<60*60*1000>]	; Get hours
	PUSH P,C		; Save remainder
	MOVX C,FLD(^D10,NO%RDX)	; Output hours
	NOUT%
	 JFATAL
	MOVEI B,":"		; Colon
	CALL FBOUT
	POP P,B			; Recover remainder
	IDIVI B,^D<60*1000>	; Get minutes
	IDIVI C,^D1000		; Get seconds
	PUSH P,C		; Save seconds
	MOVX C,NO%LFL!NO%ZRO!FLD(2,NO%COL)!FLD(^D10,NO%RDX)
	NOUT%			; Output minutes
	 JFATAL
	MOVEI B,":"		; Colon
	CALL FBOUT
	POP P,B			; Recover seconds
	NOUT%			; Output them
	 JFATAL
	MOVEI B,"."		; Decimal point
	CALL FBOUT
	MOVE B,D		; Get thousanths
	IDIVI B,^D100		; Convert to tenths
	MOVX C,FLD(^D10,NO%RDX)
	NOUT%			; Output tenths
	 JFATAL
	RET   


; S - String pointed to by ac
%LETS:	SETZ C,			; Terminate by null
	SOUT%			; Append the string
	RET   


; T - Date and time in ac, in standard form DD-MMM-YY HH:MM:SS
%LETT:	TDZN C,C		; Standard format.  If no AC given
	 SETO B,		; Then use current date and time
	ODTIM%			; Output date and time
	RET   


; U - User name for directory # in ac
%LETU:	PUSH P,A		; Save dest
	DIRST%
	IFNJE.
	  POP P,0(P)		; Clean up stack
	  RET   
	ENDIF.
	POP P,A			; Recover dest (DIRST% clobbers A on error)
	JRST %LETO		; Go try as an octal number instead
; Compare strings
;	A/ One string ptr
;	B/ Another string ptr
; Returns +1:  Not equal
;	+2:  Equal
; Clobbers A-C

STRCMP::SAVEAC <C,D>		; Save some registers
	MKPTR (A)		; Make one
	MKPTR (B)		; and the other into real byte pointers.
	DO.
	  ILDB C,A		; Get a char
	  ILDB D,B		; And another
	  CAME C,D		; If different
	   RET			; Then go return that
	  JUMPN C,TOP.		; If non-null, back for more
	ENDDO.
	RETSKP			; and return same
; "Super" SFUST emulation.
; call as for SFUST%, returns +1 always (ignores JSYS errors)
; uses TEMP

.SFUST::SAVEAC <C,D,P1,P2>	; Save some registers
	MOVEM A,TEMP		; Save JFN
	MOVEI A,.CHCNV		; Quote character
	MKPTR (B)		; Make sure we have a real byte pointer
	MOVE D,[POINT 7,TEMP+1]	; A convenient place to write it into
	DO.
	  ILDB C,B
	  CAIE C,.CHCNV		; Quote?
	  IFSKP.
	    ILDB C,B		; Yes, get next character
	    JUMPE C,TOP.	; Refuse to quote a null (doubleplusungood)
	    IDPB A,D		; Drop in the quote
	    IDPB C,D		; Drop in the quoted char
	    LOOP.		; Next char
	  ENDIF.		; Wasn't quoted
	  MOVE P1,C		; Copy the char so we can mung it
	  IDIVI P1,^D32		; P1 := C / 32, P2 := C % 32
	  MOVE P1,[BRINI. USRB0.,USRB1.,USRB2.,USRB3.
		   UNBRK. 0			; Don't quote nulls
		   EXP   W0.,W1.,W2.,W3.	; Expand username break mask
		   PURGE W0.,W1.,W2.,W3.	; Clean up
		  ](P1)		; Get mask word
	  LSH P1,(P2)		; Shift to interesting bit
	  SKIPGE P1		; Is this a legal char for a username?
	   IDPB A,D		; No, quote it
	  IDPB C,D		; Write the byte in any case
	  JUMPN C,TOP.		; Loop if wasn't a null
	ENDDO.
	MOVE A,TEMP		; Get JFN and code back
	HRROI B,TEMP+1		; With string we just consed
	SFUST%			; Set the author string
	 ERNOP
	RET
; Check for device disk
;	A/ JFN for file being retrieved or stored
; Returns +1 always
; Sets F%DSKF flag appropriately
; Clobbers B, C

CHKDSK::PUSH P,A		; Save JFN
	SETO B,			; Don't take it as disk if JSYS fails
	HRRZS A			; Only use left half of JFN
	DVCHR%			; Get device characteristics
	 ERNOP			; ignoring any errors.
	POP P,A			; Restore JFN
	TXNN B,DV%TYP		; Check device type
	 TXOA F,F%DSKF		; Device is a disk
	  TXZ F,F%DSKF		; Device is not a disk
	RET

; Alternate version takes JFN in B, saves A
CHDSKB::PUSH P,A		; Save register
	MOVE A,B		; Copy JFN
	CALL CHKDSK		; Do the check
	MOVE B,A		; Get JFN back
	POP P,A			; Restore saved register
	RET
IFN STANSW,<
; Check if a file is a plot file
; call with A/JFN, B/property list (CHKDSK should already have been called)
; returns +1/always

CHKPLT::TXNN F,F%DSKF		; Disk file?
	 RET			; No, nothing to do
	SAVEAC <A,B,C,D>	; Don't mung registers
	MOVE D,B		; Copy property list pointer
	MOVX B,<1,,.FBCTL>	; Get file class field of FDB.
	MOVEI C,C
	GTFDB%
	 ERNOP
	HLRZS C			; Isolate field.
	ANDI C,17
	CAIN C,.FBPLT		; Plot file?
	 SETOM P.PLOT(D)	; Yes
	RET

; If a plot file, set that in FDB
; same calling conventions as CHKPLT
SETPLT::SKIPE P.PLOT(B)		; Plot file?
	 TXNN F,F%DSKF		; and disk file?
	  RET			; No, nothing to do
	SAVEAC <A,B,C>		; Yes, save some regs
	HRLI A,.FBCTL		; Set file-class field to .FBPLT.
	MOVX B,FB%FCF
	MOVX C,FLD(.FBPLT,FB%FCF)
	CHFDB%
	 ERNOP
	RET
>;IFN STANSW

IFE STANSW,<			; CHKPLT/SETPLT no-ops if not at Stanford
CHKPLT::
SETPLT::RET
>;IFE STANSW
; "Kill" destination file, i.e. delete all its pages and
; try very hard to make it go away (works only for disk).
; Returns +1 always
; Closes and releases JFN
; Clobbers A-D

KILFIL::SKIPN A,FILJFN		; Get destination JFN.
	 RET			; None, just return.
	CALL UNMAP		; Make sure it is not still mapped
	HRLI A,(CZ%ABT)		; Abort the file.
	CLOSF%			; Close it
	IFJER.
	  HRRZ A,FILJFN		; Failed, get JFN
	  RLJFN%		; and try to forget it
	ANNSK.
	  SKTERS VB.TRS		; Unless terser than terse
	   TYPE <%_%% Unlikely local file close error - %J%/>
	ENDIF.
CLRFIL:	SETZM FILJFN		; Don't do it again.
	RET


; Step through a wildcard spec in FILJFN
; returns +1/no more, +2/FILJFN stepped
NXTFIL::SAVEAC <A>		; Don't lose register
	MOVE A,FILJFN		; Get JFN
	GNJFN%			; Step it
	 JRST CLRFIL		; No more, clear file and return +1
	RETSKP			; Got one, return with it
; Storage for file transfers

; Some file transfer routines depends on being able to use the location
; one before FILPAG as scratch (for the page number and access word).
; Do not change the following order!

LSP NETPAG			; Network i/o buffer (shuffle modes only)
LSP FILPAG			; One-page i/o buffer
FPGNUM==<FILPAG/1000>		; Page number

LS FILBSZ			; File byte size
LS FILPTR			; Pointer to buffer for byte-shuffle xfers
LS BCOUNT			; Number of bytes per page
LS NBYTES			; How many bytes we've put total
LS NXTPAG			; Which page to store into (set to -1)
LS NBFPTR			; Pointer into it
LS NETROT			; How many words to rotate in
LS EBITS			; How much to LSH to get first one
LS NETBYT			; Number of bytes left in net buffer
LS FILBYT			; ditto for file buffer (used by PUTPAG)
LS EOFHIT			; No end of file hit yet (for byte i/o)
LS PADCHR			; What byte to use when padding data
LS NETPSV,2			; Net pointer save area
LS NETHDR			; Block header etc storage
; Paged output to a file
; call with FILPAG/data, FILJFN/JFN
; if doing sequential i/o, needs BCOUNT and FILPTR set also
; doesn't mung any registers, returns +1 always
;
; works even for non-disk files by using sequential i/o instead.
; all file output should come through here.

LS FFREEP			; Return value from FFFFP% for OVRQTA loop

PUTPAG::PUSH P,C		; Save this register
	MOVN C,FILBYT		; Get number of bytes back
	SUB C,BCOUNT		; Minus number total to make SOUT counter
	IFL. C			; If we have something there
	  PUSH P,A		; Save some more registers
	  PUSH P,B
	  IFXE. F,F%DSKF	; Non-disk file?
	    MOVE A,FILJFN	; Yes, point to destination file
	    MOVE B,FILPTR	; Get start pointer to file buffer
	    SOUT%		; Send it out
	  ELSE.
	    ADDM C,NBYTES	; Save in negative total bytes mapped out
	    AOS A,NXTPAG	; Get next page to use
	    HRL A,FILJFN	; With JFN for file
	    CALL DOPUTP		; Go send off the page
	  ENDIF.
	  POP P,B		; Restore saved registers
	  POP P,A
	ENDIF.
	POP P,C			; and unconditionally saved register
	JRST SHOXFR		; Show transfer with excls

DOPUTP:	MOVEM A,FFREEP		; Save page and JFN in case we loop
	DO.
	  MOVX A,<.FHSLF,,FPGNUM> ; Get source: own fork, file buffer page
	  MOVE B,FFREEP		; Get JFN and page in B
	  MOVX C,PM%WR		; Writing
	  PMAP%			; Put fork page in file
	  IFJER.
	    MOVEI A,.FHSLF	; On ourself
	    GETER%		; Find last error
	    HRRZS B		; Get the error code
	    CAIE B,IOX11	; Quota exceeded
	     CAIN B,IOX34	; or disk structure completely full?
	      IFSKP.
		CAIE B,PMAPX6	; This kind of quota exceeded?
		 FATAL <Unexpected PMAP output error>
	      ENDIF.
	    CALL OVRQTA		; Over quota, let PUPFTP or PUPFSV handle
	    LOOP.		; If continued, go try again
	  ENDIF.
	ENDDO.
	RET
; Here with the first 25 words of the transfer - the FDB - in FILPAG.
SETFDB::HRRZ A,FILJFN		; With the file
	HRLI A,.FBBYV		; Byte size info
	MOVX B,FB%BSZ		; Changing byte size
	MOVE C,FILPAG+.FBBYV	; With what we got from the net
	CHFDB%			; Do it
	HRLI A,.FBSIZ		; Count of bytes
	SETO B,			; All bits
	MOVE C,FILPAG+.FBSIZ	; With the size from the FDB
	CHFDB%			; Set that too
	SKTERS VB.DEB		; Debugging?
	 DTYPE "<FDB>"		; Yes, add this to go with the excls
	RET

; Here with the page access word at FILPAG - 1 and the page itself at FILPAG
; Access word consists of access bits in left half, page number in right half.
SETPAG::MOVE A,FILPAG-1		; Get access word
	HRL A,FILJFN		; Save JFN in left half
	CALL DOPUTP		; Map the page out to the file
	HLLZ B,FILPAG-1		; Get page access bits back
	HRR A,FILPAG-1		; And page number
	HRL A,FILJFN		; With destination file
	SPACS%			; Set page access bits
	JRST SHOXFR		; Go type !! marks
; Set file's byte size and number of bytes
; returns +2/always by jumping to SHXEND, A-C smashed
; number of bytes should be in NBYTES
; byte size should be in FILBSZ
;
; This routine will only work with disk files,
; but then non-PMAP i/o doesn't need it.
;
; Do not call this for Tenex-Paged transfers.
; The size should be set from the FDB sent at the start
; of the transfer instead.

SFBSZ::	TXNN F,F%DSKF		; Disk file?
	 JRST SHXUMP		; No, all done
	HRRZ A,FILJFN		; Else get output file
	HRLI A,.FBBYV		; Byte size of file
	MOVX B,FB%BSZ		; That's all we want to set
	MOVE C,FILBSZ		; Get remembered byte size
	LSH C,^D35-POS(FB%BSZ)	; Shift into position
	CHFDB%			; Set it
	HRLI A,.FBSIZ		; Number of bytes in file
	SETO B,			; All bits
	MOVN C,NBYTES		; With number of bytes we sent
	CHFDB%			; Set that in the file's FDB
	JRST SHXEND		; Done with the transfer, go finish up
; Paged file input

LS INPPAG

; Set NBYTES to number of bytes in the file
; sets to infinity for non-disk files - they know when to stop by other means

SETBSZ::SAVEAC <A,B,C>		; Get some registers
	IFXE. F,F%DSKF		; Do we have a disk file?
	  MVI. .INFIN,NBYTES	; No, get positive infinity as byte count
	  RET
	ENDIF.
	HRRZ A,FILJFN		; Else with the input file
	MOVX B,<1,,.FBSIZ>	; With byte count word
	MOVEI C,NBYTES		; Into appropriate place
	GTFDB%			; Read FDB word

	;; Now we've got the official count, mung it for our byte size
	MOVX B,<1,,.FBBYV>	; Byte size word
	MOVEI C,B		; Into register B
	GTFDB%			; Read FDB word
	LOAD B,FB%BSZ,B		; Get the byte size bits
	JUMPE B,R		; If zero we've lost so just use what we have
	CAMN B,FILPRP+P.BYTE	; If same as byte size we're using
	 RET			; Then no need for mungage
	CAMG B,FILPRP+P.BYTE	; Is real byte size greater than what we want?
	IFSKP.
	  IDIV B,FILPRP+P.BYTE	; Yes, get quotient
	  IMULM B,NBYTES	; That is how much to increase byte count by
	  RET			; All done
	ENDIF.
	MOVE A,FILPRP+P.BYTE	; Real byte size smaller, get what we want
	IDIV A,B		; Get how much smaller it is
	MOVE B,NBYTES		; Now get number of real bytes
	IDIV B,A		; Turn into number of logical bytes
	SKIPE C			; Any left over?
	 ADDI B,1		; Yes, count as a full one
	MOVEM B,NBYTES		; Save new byte count
	RET

; Read in a page of data
; doesn't need to save any registers
; in fact, SNDPAG depends on A being returned with PMAP pointer.

GETPAG::CALL SETWDT		; Set watchdog timer for loop
	TXNE F,F%DSKF		; Do we have a disk file?
	IFSKP.			; No...
	  HRRZ A,FILJFN		; Get source file JFN
	  MOVE B,FILPTR		; and pointer to file
	  MOVN C,BCOUNT		; maximum permissable bytes
	  SIN%			; Read them in
	   ERCAL RCERR		; Hope error is EOF
	  ADD C,BCOUNT		; Get how many bytes we read
	  JUMPE C,R		; If none, return now
	  CAME C,BCOUNT		; If we got less than a full buffer
	   MOVEM C,NBYTES	; Then remember and don't come back
	ELSE.
	  AOS A,INPPAG		; Disk file, get starting page
	  HRL A,FILJFN		; With source JFN
	  FFUFP%		; Find next used file page
	   RET			; No more, all done
	  HRRZM A,INPPAG	; Got one, save for the next time
	  MOVX B,<.FHSLF,,FPGNUM> ; Into file buffer page
	  MOVX C,OF%RD		; Don't need to write to it
	  PMAP%			; Map file page in
	ENDIF.
	CALL SHOXFR		; Show transfer
	RETSKP


; Unmap FILPAG data buffer to save core and make sure it's clean for next xfer

UNMAP::	SAVEAC <A,B,C>		; Save some registers
	SETO A,			; From nothing
	MOVE B,[.FHSLF,,FPGNUM]	; Into file buffer page
	SETZ C,			; No flags
	PMAP%			; Unmap
	RET
; Type excls to show user something is happening

LS SHXCNT			; Counter for excl output
LS SHXDEF			; How many pages to put between excls
LS SHXINT			; How many we have yet to see

; Routine to initialize counter for user ! typeout
SHXINI::IFTERS VB.NRM		; If being terse
	  SETZM SHXINT		; Clear all the way so can never type out
	  RET
	ENDIF.
	MVI. 1,SHXINT		; Have yet to see none
	IFVERB VB.DEB		; If debugging
	  MVI. 1,SHXCNT		; 1 page between outputs
	  RET			; Nothing now
	ENDIF.
	SKIPG CX,SHXDEF		; Get default interval.  Do we want one?
	 SETZM SHXINT		; No, so don't even print one excl
	MOVEM CX,SHXCNT		; Save as interval for this transfer
				; Drop in to do one now

; Routine to type transfer progress.  ! every 10 pages (or as set by SET HASH)
; Careful with order of SKTERS etc - don't want printout for F%STYO
SHOXFR:	SOSE SHXINT		; See if we want to type now
	 RET			; Either never will or count not exhausted
	TYPE <!>		; Count exhausted, indicate progress
	MV. SHXCNT,SHXINT	; Reinitialize counter
	RET			; All done with show and tell

; Finish off display of transfer with [OK]
; Jump to here to return from RECDAT or SNDDAT
; Entry SHXUMP makes sure page is unmapped for non-disk xfers.
SHXUMP::CALL UNMAP		; Unmap file page to clear it out
SHXEND::SKVERB VB.NRM		; Being terse?
	 RETSKP			; Yes, don't even include [OK]
	SKVERB VB.DEB		; If debugging want to be precise about excls
	 SKIPG SHXINT		; Not debugging, but do we want excls at all?
	  IFSKP. <TYPE <! >>	; Want them, so type a final one
	TYPE <[OK]%/>		; Finish transfer progress display
	RETSKP
; File name manipulation

; Character names
LANGB=="<"
RANGB==">"

; Get Name-Body pointer for local GTJFN, or fake it from Server-Filename
GETNMB::HRROI B,FILPRP+P.NAMB	; Point to name-only part of file name.
	SKIPE FILPRP+P.NAMB	; If non-zero
	 RET			; then all done.
	HRROI B,FILPRP+P.SFIL	; Else point to server-filename
;	CALLRET SKPDIR		; and skip over directory to get filename only.

; Increment a byte pointer until past all directory terminators.

SKPDIR::SAVEAC <A>		; Don't mung caller's register
	STKVAR <DRPREF>		; Get temp prefix pointer
	MKPTR(B)		; Make sure it's a real byte pointer
	MOVEM B,DRPREF		; Save current point for later.
	DO.
	  ILDB A,B		; Get next byte.
	  IFE. A		; If null, done with directory part
	    MOVE B,DRPREF	; Get the byte pointer back
	    RET			; for the return.
	  ENDIF.
	  CAIE A,.CHCNV		; Control V?
	  IFSKP.
	    ILDB A,B		; Yes, get another and ignore it.
	    LOOP.
	  ENDIF.

	  ;; I used to have [ ] in the characters skipped over here.
	  ;; But as far as I can tell only SAIL/TOPS10 uses them as delimiters
	  ;; and that style loses for SKPDIR and are covered separately
	  ;; in the DIRECTORY command anyway...
	  INSET A,<LANGB,RANGB,":","/">,<MOVEM B,DRPREF>
	  LOOP.
	ENDDO.
; Get version of JFN+flags in A, return in B

JFNVRS::MOVX B,.GJNHG		; Assume generation is -1 until shown otherwise
	TXNE A,GJ%VER		; Wildcard generation?
	 MOVX B,.GJALL
	TXNE A,GJ%ULV		; Lowest?
	 MOVNI B,.GJLEG
	TXNE A,GJ%VER!GJ%NHV!GJ%UHV!GJ%ULV ; No generation flags, get from JFN
	 RET			; Wild version, already set up
	SAVEAC <A,C>		; Save some registers
	MOVE B,A		; Move JFN into different register
	HRROI A,TEMP
	MOVX C,FLD(.JSAOF,JS%GEN)
	JFNS%
	HRROI A,TEMP		; From just-created version strin
	MOVEI C,^D10		; in decimal
	NIN%			; read in the number.
	 NOP			; Can't fail
	RET
; Here to set up property lists for new transfer

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

SETPRP::TXZE F,F%PSET		; Property list already set?
	 RET			; Yes, just return
	SAVEAC <A>		; Don't mung register
	MOVE A,[DEFPRP,,FILPRP]	; Get where to copy through to
	BLT A,FILPRP+PLSIZE-1	; Copy whole property list across
	RET
; Open file in FILJFN for store (properties in FILPRP)
; Returns +1:  Failed, error message pointed to in AC1
;	  +2:  Succeeded, file open, JFN in AC1
; Calls OPSERR on failure with A/point to text

DEFINE OPNERR (TEXT) <
	JRST [	HRROI C,TEMP	;; Point to temporary buffer
		WRITE C,<TEXT>	;; Write the message
		HRROI A,TEMP	;; Now point to it again
		RET ]		;; Let main program handle it and return
>

OPNSTO::SAVEAC <B,C,D>		; Save some registers
	CALL CKSPAR		; Check properties for send
	 RET			; Lost
	MOVX B,OF%RD		; Open for read, not thawed.
	MOVE A,FILPRP+P.BYTE	; Get transfer byte size
	STOR A,OF%BSZ,B		; Put in position
	DO.
	  HRRZ A,FILJFN		; Setup JFN
	  OPENF%		; Attempt to open
	   IFSKP. <RETSKP>
	  TXON B,OF%THW		; Turn thaw on. was it already?
	   LOOP.		; No, go back and try this way.
	ENDDO.
	HRRZ D,FILJFN		; Else get file again
	OPNERR <Couldn't open %4F - %J>	; To make error message
; Check and/or default parameters for "Store" command
; Call with FILJFN/ JFN for file being stored, F%DSKF set, properties in FILPRP
; Returns +1:  Hard error, message typed
;	  +2:  Ok, type and byte size filled in appropriately
; Can call STYBAD with A/pointer to failure text

DEFINE CKSBAD(TEXT) <
	JRST [	HRROI A,TEMP	;; Point to a nice buffer
		HRRZ C,FILJFN	;; Get file pointer again
		WRITE <TEXT>	;; Say what was wrong
		JRST STYCHG ]	;; Go ask caller and try again if lucky
>

CKSPAR:	HRRZ A,FILJFN		; Get the file
	SETZ B,			; Assume don't know byte size
	IFXN. F,F%DSKF		; Local file on disk?
	  MOVE B,[1,,.FBCTL]	; Yes, want flag word
	  MOVEI C,C		; Into C
	  GTFDB%
	  TXNE C,FB%NEX		; File exists?
	   OPNERR <File %1F does not exist>
	  TXNE C,FB%DIR		; Directory?
	   OPNERR <%1F is a directory file>
	  MOVE B,[1,,.FBBYV]	; Yes, read byte size from FDB
	  MOVEI C,C		; Put it here
	  GTFDB%
	  LOAD B,FB%BSZ,C	; Extract byte size
	ENDIF.

; Here after trying a change of settings to check again
CKSRTY:	HRRZ C,FILPRP+P.TYPE	; Get specified transfer type
	HRRZ D,FILPRP+P.BYTE	; Get specified byte size
	JRST @[	STYUNS		; Dispatch on type:  Unspecified
		STYTXT		; Text
		STYBIN		; Binary
		STYPAG		; Tenex-Paged
		STYDIR		; Directory???  Shouldn't happen...
		STYPAG		; MEIS-Paged
		STYTXT		; EBCDIC
		STYBIN ](C)	; Image

; Here when we got an error message, call caller routine and retry
STYCHG:	HRROI A,TEMP		; Point to buffer again
	CALL STYBAD		; Call main program handler routine
	 OPNERR <Not confirmed, file bypassed>
	JRST CKSRTY		; Won, go check again
; Type-specific routines for CKSPAR

; Here for type directory
STYDIR:	CKSBAD <Illegal to transfer file %3F with type "Directory">

; Here for type Text
STYTXT:	SKIPE D,B		; File byte size known?
	 CAIN D,^D36		; or 36 bit words?
	  MOVEI D,7		; Not known or 36 bits, use 7 bit
	INSET D,<7,8>,JRST CKSSET ; Legal byte size?
	CKSBAD <Type Text inconsistent with byte size %4D of file %3F>

; Here for type unspecified
STYUNS:	MOVEI C,TT.TXT		; Assume text
	INSET B,<^D36,7>,JRST STYTXT ; If 7 or 36 bit, assume text
	MOVEI C,TT.BIN		; No, this is binary
;	JRST STYBIN		; Go handle as such

; Here for type Binary
STYBIN:	IFE. D			; Transfer byte size specified?
	  SKIPE D,B		; No, substitute file byte size
	   JRST CKSSET		; Got one, now go try it
	  CKSBAD <Byte size specification required to store %3F>
	ENDIF.
	JUMPE B,CKSSET		; If have default but no file size, go ahead
	CAIE B,^D36		; Same if it is 36
	 CAMN B,D		; Both known, make sure consistent
	  JRST CKSSET		; If they are, then done checking
	CAIN D,^D36		; File byte not 36, but transfer is?
	 JRST CKSSET		; Yes, that is Ok too.
	SKTERS VB.TRS		; Unless terser than terse
	 TYPE <Default of %4D inconsistent with byte size %2D of %1F>
	HRROI A,[ASCIZ/Using default anyway [Confirm] /]
	CALL PRMCNF		; Make sure user wants to go through with it
	 JRST STYCHG		; Didn't, ask for a new type
	JRST CKSSET		; and go ahead with the transfer

; Here for type Paged
STYPAG:	TXNN F,F%DSKF		; Is local file on disk?
	 CKSBAD <%1F is not a disk file>
	MOVEI D,^D36		; Set local byte size to 36 (unused)

; All cases converge here
; C/ Transfer type, D/ Transfer byte size
CKSSET:	SKIPE A,FILPRP+P.XTYP	; Remote type unspecified
	 CAMN A,FILPRP+P.TYPE	; Or in step with local?
	  MOVEM C,FILPRP+P.XTYP	; Yes, remain in step
	MOVEM C,FILPRP+P.TYPE	; Store local type in any case
	SKIPE A,FILPRP+P.XBYT	; Remote byte size unspecified
	 CAMN A,FILPRP+P.BYTE	; Or in step with local?
	  MOVEM D,FILPRP+P.XBYT	; Yes, remain in step
	MOVEM D,FILPRP+P.BYTE	; .. local byte size
	RETSKP			; Return +2 for success
; Here with some terrible unrecoverable data error, cause data error PSI

; Here if I/O data error occurs in SIN% from net or file
RCERR::	MOVEI A,.FHSLF		; On self
	GETER%			; Find out what the error was
	HRRZS B			; Keep only error number
	CAIN B,IOX4		; If end of file
	 RET			; Then it's OK
RECNDE::CALL KILFIL		; Try to eliminate the file
	POP P,A			; Get return address
	HRRZS A			; Without flags
	SKTERS VB.TRS		; Unless terser than terse
	 ETYPE <Unexpected I/O data error at %1O - %J%/>
	JRST EDISC		; Flush connection

	END