Google
 

Trailing-Edge - PDP-10 Archives - BB-H138E-BM - galaxy-sources/glxfil.mac
There are 40 other files named glxfil.mac in the archive. Click here to see a list.
	TITLE	GLXFIL  --  File I/O Interface for GALAXY Programs
	SUBTTL	Preliminaries

;
;
;	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
;	1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1985
;
;     THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;     AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
;     AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS
;     SOFTWARE  OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
;     OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  NO  TITLE  TO
;     AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;     THE INFORMATION  IN  THIS  SOFTWARE  IS  SUBJECT  TO  CHANGE
;     WITHOUT  NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;     BY DIGITAL EQUIPMENT CORPORATION.
;
;     DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
;     OF  ITS  SOFTWARE  ON  EQUIPMENT  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.

	SEARCH	GLXMAC			;SEARCH SUBSYSTEMS SYMBOLS
	PROLOG(GLXFIL,FIL)		;GENERATE PROLOG CODE

	FILMAN==:106			;Maintenance edit number
	FILDEV==:122			;Development edit number
	VERSIN (FIL)			;Generate edit number


;THE PURPOSE OF THIS MODULE IS TO PROVIDE AN OPERATING SYSTEM INDEPENDENT
;	INPUT FILE INTERFACE TO GALAXY PROGRAMS (OR ANY OTHER PROGRAM WHICH
;	WANTS TO USE IT).
	SUBTTL	Table of Contents


;		Table of Contents for GLXFIL
;
;
;			   Section			      Page
;   1. Preliminaries. . . . . . . . . . . . . . . . . . . . .    1
;   2. Table Of Contents. . . . . . . . . . . . . . . . . . .    2
;   3. Revision History . . . . . . . . . . . . . . . . . . .    3
;   4. Global Routines. . . . . . . . . . . . . . . . . . . .    4
;   5. Local AC definitions . . . . . . . . . . . . . . . . .    5
;   6. Module Storage . . . . . . . . . . . . . . . . . . . .    5
;   7. FB     - File Block Definitions. . . . . . . . . . . .    6
;   8. F%INIT - Initialize the world. . . . . . . . . . . . .    8
;   9. F%IOPN - Open an input file. . . . . . . . . . . . . .    9
;  10. F%OOPN - Open an output file . . . . . . . . . . . . .   10
;  11. F%AOPN - Open an output file in append mode. . . . . .   11
;  12. OPNCOM - Common file open routine. . . . . . . . . . .   13
;  13. LDLEB  - Load a LOOKUP/ENTER block from an FD. . . . .   16
;  14. File attribute processing
;       14.1.   Main loop and dispatch table. . . . . . . . .   17
;  15. SETFD  - Set up a real description of opened file. . .   19
;  16. SETFOB - Build an internal FOB . . . . . . . . . . . .   20
;  17. OPNERR - Handle a system error from F%IOPN . . . . . .   21
;  18. F%IBYT  -  Read one byte from file . . . . . . . . . .   22
;  19. F%IBUF  -  Read a buffer of data from file . . . . . .   23
;  20. GETBUF  -  Read one input buffer from the operating system   24
;  21. F%POS  -  Position an input file . . . . . . . . . . .   25
;  22. F%REW  -  Rewind an input file . . . . . . . . . . . .   25
;  23. F%OBYT  -  Write one byte into file. . . . . . . . . .   29
;  24. F%OBUF  -  Write a buffer full of data to a file . . .   30
;  25. PUTBUF  -  Give one output buffer to the operating system  32
;  26. F%CHKP  -  Checkpoint a file . . . . . . . . . . . . .   33
;  27. WRTBUF  -  TOPS20 Subroutine to SOUT the current buffer  35
;  28. SETBFD
;       28.1.   Setup Buffer Data . . . . . . . . . . . . . .   35
;  29. F%REN  - Rename a file . . . . . . . . . . . . . . . .   36
;  30. F%REL  - Release a file. . . . . . . . . . . . . . . .   39
;  31. F%DREL - Delete a file and release it. . . . . . . . .   40
;  32. F%DEL  - Delete an unopened file . . . . . . . . . . .   41
;  33. F%INFO - Return system information about a file. . . .   42
;  34. F%FD   - Return a pointer to the FD on an opened IFN .   43
;  35. F%FCHN - Find first free channel . . . . . . . . . . .   43
;  36. ALCIFN - Allocate an Internal File Number. . . . . . .   44
;  37. RELFB  - Release a File Block. . . . . . . . . . . . .   44
;  38. GETERR . . . . . . . . . . . . . . . . . . . . . . . .   45
;  39. MAPERR - Map an operating system error . . . . . . . .   46
;  40. MAPIOE - Map an I/O error. . . . . . . . . . . . . . .   48
;  41. CHKIFN - Check user calls and set IFN context. . . . .   49
	SUBTTL Revision History

COMMENT \

*****  Release 4.2 -- begin maintenance edits  *****

104	4.2.1495
	Don't set pages in FDB when checkpointing.

105	4.2.1579	29-May-84
	In OPNERR check for JFN and if found, release it.

106	4.2.1601	14-Jan-85
	In F%OOPN and F%AOPN change protection check to .CKAWR from .CKACN.

*****  Release 5.0 -- begin development edits  *****

120	5.1002		28-Dec-82
	Move to new development area.  Clean up edit organization.  Update TOC.

121	5.1199		6-Feb-85
	If a RENAME fails, delete the created file.

122	5.1200		6-Feb-85
	Set bit IB.NAC to zero so as not to restrict access to JFNs.

123	5.1216		13-May-85
	Fix multiple bugs involving APPEND mode files.  In particular,
	Update F%CHKP, NXTBYT, etc. to use the TOPS-20 byte count for
	EOF.  In F%xOPN, use the user-specified byte size when opening
	files.  In F%AOPN, use OF%APP mode OPENF so appends get done
	right.  This ends up fixing CRL stop codes, hung programs that
	can't find the EOF for an append, and in general, trashed files.

\   ;End of revision history
	SUBTTL	Global Routines

	ENTRY	F%INIT			;INITIALIZE THE MODULE
	ENTRY	F%IOPN			;OPEN A FILE FOR INPUT
	ENTRY	F%AOPN			;OPEN A FILE FOR APPENDED OUTPUT
	ENTRY	F%OOPN			;OPEN A FILE FOR OUTPUT
	ENTRY	F%IBYT			;READ  AN INPUT BYTE
	ENTRY	F%OBYT			;WRITE AN OUTPUT BYTE
	ENTRY	F%IBUF			;READ AN INPUT BUFFER
	ENTRY	F%OBUF			;WRITE AN OUTPUT BUFFER
	ENTRY	F%REL			;RELEASE A FILE
	ENTRY	F%DREL			;DELETE AND RELEASE A FILE
	ENTRY	F%RREL			;RESET (ABORT) I/O AND RELEASE A FILE
	ENTRY	F%REW			;REWIND A FILE
	ENTRY	F%POS			;POSITION A FILE
	ENTRY	F%CHKP			;CHECKPOINT A FILE, RETURN POSITION
	ENTRY	F%INFO			;RETURN SYSTEM INFORMATION ON FILE
	ENTRY	F%FD			;RETURN POINTER TO AN IFN'S FD
	ENTRY	F%REN			;RENAME AN FILE
	ENTRY	F%DEL			;DELETE A FILE
	ENTRY	F%FCHN			;FIND FIRST FREE CHANNEL
;	ENTRY	F%NXT			;(FUTURE) GET NEXT FILE IN SPECIFICATION
	SUBTTL Local AC definitions

	FB==15				;ALWAYS ADDRESS OF CURRENT FILE BLOCK

SUBTTL	Module Storage

	$DATA	FILBEG,0		;START OF ZEROABLE $DATA FOR GLXFIL
	$DATA	IFNTAB,SZ.IFN+1		;ADDRESS OF FILE DATA PAGE FOR
					; EACH IFN


; DATA BLOCK FOR COMMON FILE OPEN ROUTINE

	$DATA	O$MODE			;MODE FILE IS TO BE OPENED IN
	$DATA	O$FUNC			;FILOP. OR OPENF BITS TO USE
	$DATA	O$PROT			;PROTECTION FOR IN BEHALF
	$DATA	O$GJFN			;GTJFN BITS TO USE

	$DATA	DMPFLG			;FLAG TO DUMP THE BUFFER
	$DATA	F$FOB,FOB.SZ		;FOR FOR INTERNAL USE
	$DATA	FILEND,0		;END OF ZEROABLE $DATA FOR GLXFIL
	SUBTTL	FB     - File Block Definitions

	FB%%%==0			;INITIAL OFFSET

DEFINE	FB(A1,A2),<
	FB$'A1==FB%%%
	FB%%%==FB%%%+A2
	IFG <FB%%%-1000>,<PRINTX FB TOO LARGE>
>  ;END DEFINE FB

;The following entries in the FB are invariant for a given file opening.

	FB	BEG,0			;BEGINNING OF PAGE
	FB	IFN,1			;THE IFN
	FB	BYT,1			;BYTE SIZE
	FB	WRD,1			;NUMBER OF WORDS IN FILE
	FB	BPW,1			;NO. OF BYTES/WORD
	FB	MOD,1			;OPEN MODE
	  FBM$IN==1			;  INPUT
	  FBM$OU==2			;  OUTPUT
	  FBM$AP==3			;  APPEND
	  FBM$UP==4			;  UPDATE
	FB	CNT,1			;ATTRIBUTE ARGUMENT COUNT
	FB	PTR,1			;ATTRIBUTE ARGUMENT POINTER
	FB	IMM,1			;ATTRIBUTE ARGUMENT FLAG
	FB	BUF,1			;ADDRESS OF BUFFER PAGE
	FB	FD,FDXSIZ		;FD GIVEN ON OPEN CALL,MAY BE WILDCARDED
	FB	RFD,FDXSIZ		;ACTUAL DESCRIPTION OF CURRENT FILE ON THIS IFN

TOPS10<
	FB	FUB,.FOMAX		;FILOP. UUO BLOCK
	FB	LEB,.RBMAX		;LOOKUP/ENTER UUO BLOCK
	FB	PTH,.PTMAX		;PATH BLOCK
	FB	CHN,1			;CHANNEL NUMBER FOR THIS FILE
>  ;END TOPS10 CONDITIONAL


TOPS20<
	FB	FDB,.FBLEN		;BLOCK FOR THE FDB
	FB	CHK,.CKAUD+1		;BLOCK FOR CHKAC JSYS
	FB	JFN,1			;THE JFN
	FB	ACT,10			;USED FOR ACCOUNT STRING STORAGE
	FB	VBP,1			;Virgin Byte Pointer (initial)
>  ;END TOPS20 CONDITIONAL
;The following variables define the current buffer state

	FB	BIB,1			;Bytes In Buffer
					; ON INPUT, THIS IS THE NUMBER OF DATA
					; BYTES REMAINING IN THE CURRENT BUFFER.
					; ON OUTPUT, THIS IS THE NUMBER OF BYTES
					; WHICH MAY BE DEPOSITED INTO THE BUFFER
					; BEFORE IT MUST BE DUMPED.

	FB	BBP,1			;Buffer Byte Pointer
					; ON INPUT, THIS POINTS TO THE LAST
					; BYTE READ FROM THE BUFFER AND ON
					; OUTPUT IT POINTS TO THE LAST BYTE
					; DEPOSITED.  IT IS NORMALLY INCREMENTED
					; BEFORE USING.

	FB	BFN,1			;BuFfer Number
					; THIS IS THE NUMBER (RELATIVE TO THE
					; DISK FILE) OF THE CURRENT BUFFER (I.E.
					; THE ONE DEFINED BY FB$BRH)

	FB	EOF,1			;SET IF EOF SEEN ON INPUT

	FB	LSN,1			;Line Sequence Numbers
					; CONTAINS 0 IF LSN PROCESSING WAS NOT
					; REQUESTED.  IF LSN PROCESSING WAS
					; REQUESTED, THIS IS SET TO 1 DURING
					; FILE-OPEN ROUTINE.  FIRST INPUT WILL
					; SET TO -1 OR 0 DEPENDING ON WHETHER
					; OR NOT FILE HAS LSNS.

	FB	FNC,1			;File Needs Checkpointing
					; THE IS AN OUTPUT ONLY FLAG WHICH IS
					; -1 IF ANY OUTPUT HAS BEEN DONE SINCE
					; THE LAST CHECKPOINT.  IF 0 WHEN F%CHKP
					; IS CALLED, NOTHING IS UPDATED TO DISK.
					; THIS ALLOWS A PROGRAM TO CHECKPOINT AN
					; OUTPUT FILE ON A TIME BASIS (E.G.) AND
					; NOT INCUR THE EXPENSE OF I/O IF NO
					; OUTPUT CALLS HAVE BEEN MADE SINCE LAST
					; CHECKPOINT.

	FB	BRH,3			;BUFFER RING HEADER

TOPS20<
;	.BFADR==0			;BUFFER ADDRESS
	.BFPTR==1			;BUFFER BYTE POINTER
	.BFCNT==2			;BUFFER BYTE COUNT
					; DUE TO AN OUTPUT CHECKPOINT
>  ;END TOPS20

	FB$END==FB%%%			;END OF FILE BLOCK
	SUBTTL	F%INIT - Initialize the world

;F%INIT IS CALLED TO INITIALIZE THE GLXFIL MODULE.  IT MUST
;	BE CALLED BEFORE ANY OTHER ROUTINE IN GLXFIL IS CALLED.

; CALL IS:	NO ARGUMENTS
;
; RETURN:	ALWAYS TRUE


F%INIT:	MOVE	S1,[FILBEG,,FILBEG+1]	;BLT PTR TO ZEROABLE $DATA SPACE
	SETZM	FILBEG			;DO THE FIRST LOCATION
	BLT	S1,FILEND-1		;AND BLT THE REST TO ZERO
	$RETT				;RETURN.
	SUBTTL	F%IOPN - Open an input file

;CALL:		S1/	LENGTH OF FILE OPEN BLOCK (FOB)
;		S2/	ADDRESS OF FOB (DESCRIBED IN GLXMAC)
;			FOB.FD (WORD 0)	:	ADDRESS OF FD
;			FOB.CW (WORD 1)	:	CONTROL INFORMATION
;			FOB.US (WORD 2)	:	USER ID FOR IN BEHALF
;			FOB.CD (WORD 3)	:	CONNECTED DIRECTORY (TOPS-20)
;
;TRUE RETURN:	S1/ CONTAINS INTERNAL FILE NUMBER (IFN)
;
;FALSE RETURN:	S1/ CONTAINS ERROR CODE

;POSSIBLE ERRORS:
;	ERSLE$  ERIFS$	ERFNF$	ERPRT$	ERDNA$	ERUSE$


F%IOPN:	PUSH	P,S1			;SAVE FOB SIZE
	MOVX	S1,FBM$IN		;FILE WILL BE READ
	MOVEM	S1,O$MODE		;SO SET THAT UP NOW

TOPS10<
	MOVX	S1,<FO.PRV+.FORED>	;READ FUNCTION TO FILOP.
	MOVEM	S1,O$FUNC		;STORE AS FUNCTION
> ;END OF TOPS10 CONDITIONAL
TOPS20<
	LOAD	S1,FOB.CW(S2),FB.BSZ	;Get user-specified byte size
	LSH	S1,^D30			;Stuff into byte size field
	IORX	S1,OF%RD		;Open for read
	MOVEM	S1,O$FUNC		;IS FUNCTION FOR OPENF
	MOVX	S1,GJ%SHT+GJ%OLD	;AND SHORT GTJFN, OLD FILE
	MOVEM	S1,O$GJFN		;IS FUNCTION FOR GTJFN
	MOVX	S1,.CKARD		;WANT TO KNOW IF WE CAN READ FILE
	MOVEM	S1,O$PROT		;IF CHKAC IS DONE
>  ;END OF TOPS20 CONDITIONAL
	POP	P,S1			;RESTORE LENGTH OF FOB
	PJRST	OPNCOM			;PERFORM THE OPEN
	SUBTTL	F%OOPN - Open an output file

;CALL:		S1/	LENGTH OF FILE OPEN BLOCK (FOB)
;		S2/	ADDRESS OF FOB (DESCRIBED IN GLXMAC)
;			FOB.FD (WORD 0)	:	ADDRESS OF FD
;			FOB.CW (WORD 1)	:	CONTROL WORD
;			FOB.US (WORD 2)	:	USER ID FOR IN BEHALF
;			FOB.CD (WORD 3)	:	CONNECTED DIRECTORY (TOPS-20)
;
;TRUE RETURN:	S1/ CONTAINS INTERNAL FILE NUMBER (IFN)
;
;FALSE RETURN:	S1/ CONTAINS ERROR CODE

;POSSIBLE ERRORS:
;	ERSLE$	ERIFS$	ERPRT$	ERDNA$	ERUSE$


F%OOPN:	PUSH	P,S1			;SAVE LENGTH OF THE FOB
	MOVX	S1,FBM$OU		;THE FILE IS BEING WRITTEN
	MOVEM	S1,O$MODE		;

TOPS10<
	LOAD	S1,FOB.CW(S2),FB.NFO	;GET NEW FILE ONLY FLAG
	SKIPE	S1			;IF ITS SET,
	SKIPA	S1,[EXP FO.PRV+.FOCRE]	;SET FOR FILE CREATION
	MOVX	S1,<FO.PRV+.FOWRT>	;ELSE, GET PRIVELEGED WRITE FUNCTION
	MOVEM	S1,O$FUNC		;STORE AS OPEN FUNCTION CODE
> ;END OF TOPS10 CONDITIONAL

TOPS20<
	LOAD	S1,FOB.CW(S2),FB.BSZ	;Get user-specified byte size
	LSH	S1,^D30			;Stuff into byte size field
	IORX	S1,OF%WR		;Open for write
	MOVEM	S1,O$FUNC		;FOR THE OPENF
	LOAD	S1,FOB.CW(S2),FB.NFO	;GET THE NEW FILE ONLY BIT
	SKIPE	S1			;IF ITS SET
	SKIPA	S1,[EXP GJ%SHT+GJ%NEW] 	;FORCE A NEW FILE
	MOVX	S1,GJ%SHT+GJ%FOU	;OTHERWISE, JUST NEW GENERATION , SHORT GTJFN
	MOVEM	S1,O$GJFN		;IS GTJFN FUNCTION
	MOVX	S1,.CKAWR		;THE PROTECTION TO CHECK FOR
	MOVEM	S1,O$PROT		;CONNECT TO DIRECTORY ACCESS
> ; END OF TOPS20 CONDITIONAL

	POP	P,S1			;RESTORE LENGTH OF FOB
	PJRST	OPNCOM			;DO COMMON OPENING
	SUBTTL	F%AOPN - Open an output file in append mode

; OPEN FILE FOR OUTPUT, APPENDING IF FILE ALREADY EXISTS

;CALL:		S1/	LENGTH OF FILE OPEN BLOCK (FOB)
;		S2/	ADDRESS OF FOB (SEE DESCRIPTION IN GLXMAC)
;
;TRUE RETURN:	S1/ CONTAINS INTERNAL FILE NUMBER (IFN)
;
;FALSE RETURN:	S1/ CONTAINS ERROR CODE

; POSSIBLE ERRORS:	ERSLE$  ERIFS$  ERPRT$  ERDNA$  ERUSE$

F%AOPN:	PUSHJ	P,.SAVE1		;SAVE A PERM AC
	MOVE	P1,0(S2)		;GET THE FD ADDRESS.
	MOVE	P1,.FDFIL(P1)		;GET THE STRUCTURE NAME.

TOPS10<
	CAMN	P1,[SIXBIT/NUL/]	;IS IT NULL ???
> ;END OF TOPS10 CONDITIONAL

TOPS20<
	AND	P1,[-1,,777400]		;GET JUST THE BITS WE WANT.
	CAMN	P1,[ASCIZ/NUL:/]	;IS IT NULL ???
> ;END OF TOPS20 CONDITIONAL

	PJRST	F%OOPN			;YES,,OPEN IT AS OUTPUT.

	MOVX	P1,FBM$AP		;FILE IS WRITTEN, APPEND MODE
	MOVEM	P1,O$MODE		;

TOPS10<
	MOVX	P1,<FO.PRV+.FOAPP>	;GET PRIVELEGED APPEND FUNCTION
	MOVEM	P1,O$FUNC		;STORE AS OPEN FUNCTION CODE
> ;END OF TOPS10 CONDITIONAL

TOPS20<
	LOAD	P1,FOB.CW(S2),FB.BSZ	;Get user-specified byte size
	LSH	P1,^D30			;Stuff into byte size field
	IORX	P1,OF%APP		;Open for append
	MOVEM	P1,O$FUNC		;FOR THE OPENF
	MOVX	P1,GJ%SHT		;USE SHORT GTJFN, AND OLD FILE (IF ANY)
	MOVEM	P1,O$GJFN		;SET GTJFN FUNCTION
	MOVX	P1,.CKAWR		;THE PROTECTION TO CHECK FOR
	MOVEM	P1,O$PROT		;CONNECT TO DIRECTORY ACCESS
> ; END OF TOPS20 CONDITIONAL


			;F%AOPN IS CONTINUED ON NEXT PAGE
			;CONTINUED FROM PREVIOUS PAGE

	PUSHJ	P,OPNCOM		;OPEN UP THE FILE
	JUMPF	.RETF			;PASS ON FAILURE IF IT OCCURRED

TOPS10<
	$SAVE	FB			;SAVE FB
	MOVE	FB,IFNTAB(S1)		;SET FB ADDRESS
	SKIPN	FB$WRD(FB)		;DOES THIS FILE EXIST?
	$RETT				;NO, NO NEED FOR ANYTHING SPECIAL
	PUSHJ	P,SETBFD		;SETUP BBP, BIB
	MOVE	S1,FB$WRD(FB)		;GET THE FILE SIZE
	IDIVI	S1,SZ.BUF		;DIVIDE BY BUFFER SIZE
	MOVEM	S1,FB$BFN(FB)		;SAVE BUFFER NUMBER
	MOVE	S1,FB$IFN(FB)		;GET IFN TO RETURN
>  ;END TOPS10 CONDITIONAL
	$RETT				;AND RETURN
	SUBTTL	OPNCOM - Common file open routine

OPNCOM:	$SAVE	<FB>			;PRESERVE REGS
	$CALL	.SAVET			;SAVE T REGS TOO
	MOVE	T1,S2			;SAVE ADDRESS OF FOB
	MOVE	T4,S1			;AND ITS LENGTH
	CAIGE	T4,FOB.MZ		;CHECK FOR MINIMUM SIZE
	$STOP(OTS,File Open Block is too small)
	LOAD	T2,FOB.FD(T1)		;GET THE FD ADDRESS
	LOAD	T3,FOB.CW(T1),FB.BSZ	;GET THE BYTE SIZE
	CAIL	T3,1			;CHECK BYTE RANGE
	CAILE	T3,^D36			; FROM 1 TO 36
	$STOP(IBS,Illegal byte size given)
	LOAD	S1,(T2),FD.LEN		;GET FD LENGTH
	CAIL	S1,FDMSIZ		;CHECK RANGE
	CAILE	S1,FDXSIZ
	 $RETE	(IFS)			;INVALID FILE SPEC
	PUSHJ	P,ALCIFN		;GET AN IFN
	JUMPF	.RETF			;PASS ON ANY ERROR
	MOVEM	T3,FB$BYT(FB)		;AND SAVE THE BYTE SIZE
	LOAD	S1,FOB.CW(T1),FB.LSN	;SEE IF USER WANTS TO SUPRESS LSNS
	JUMPE	S1,OPNC.0		;IF NOT, SKIP TESTS
	AOS	FB$LSN(FB)		;MARK THAT LSN PROCESSING REQUESTED
	CAIE	T3,7			;MUST BE A SEVEN BIT FILE
	PUSHJ	P,S..IBS		;IF NOT SEVEN-BIT, ITS WRONG
OPNC.0:	CAILE	T4,FOB.AB		;FOB CONTAIN ATTRIBUTE BLOCK WORD?
	SKIPN	S1,FOB.AB(T1)		;YES - GET ATTRIBUTE BLOCK ADDRESS
	JRST	OPNC.X			;THERE ISN'T ONE
	MOVEM	S1,FB$PTR(FB)		;STORE IT
	HRRZ	S1,(S1)			;GET WORD COUNT
	MOVEM	S1,FB$CNT(FB)		;STORE IT
OPNC.X:	MOVEI	S1,^D36			;GET BITS/WORD
	IDIV	S1,FB$BYT(FB)		;DIVIDE BY BITS/BYTE
	MOVEM	S1,FB$BPW(FB)		;STORE BYTES/WORD
	MOVE	S1,O$MODE		;GET REQUESTED ACCESS MODE
	MOVEM	S1,FB$MOD(FB)		;STORE INTO MODE WORD
	MOVEI	S2,FB$FD(FB)		;GET LOCATION TO MOVE FD TO
	LOAD	S1,.FDLEN(T2),FD.LEN	;GET FD'S LENGTH
	ADD	S1,S2			;LAST LOCATION FOR BLT
	HRLI	S2,0(T2)		;STARTING LOCATION OF FD
	BLT	S2,-1(S1)		;STORE TILL LAST WORD
	SETOM	FB$BFN(FB)		;SET CURRENT BUFFER TO -1
	SETZM	FB$BIB(FB)		;NO BYTES IN BUFFER
	SETZM	FB$EOF(FB)		;CLEAR EOF FLAG
	SETZM	FB$FNC(FB)		;FILE DOESN'T NEED CHECKPOINTING


				;FALL THRU TO OPERATING SYSTEM
				; DEPENDENT CODE
TOPS10<	MOVEI	S2,.IOIMG		;LOAD IMAGE MODE
	MOVX	S1,FB.PHY		;GET /PHYSICAL BIT
	TDNE	S1,FOB.CW(T1)		;IS IT SET?
	TXO	S2,UU.PHS		;YES
	MOVEM	S2,FB$FUB+.FOIOS(FB)	;STORE IN FILE BLOCK
	SKIPN	S2,.FDSTR(T2)		;GET THE STRUCTURE
	MOVSI	S2,'DSK'		;USE 'DSK' AS DEFAULT
	MOVEM	S2,FB$FUB+.FODEV(FB)	;STORE IN FILE BLOCK
	DEVTYP	S2,			;SEE IF ITS A DISK TYPE DEVICE
	  MOVX	S2,.TYDSK		;IF IT FAILS, DONT KICK OUT YET
	LOAD	S1,S2,TY.DEV		;GET DEVICE TYPE ONLY
	TXNN	S2,TY.SPL		;Spooled device?
	CAXN	S1,.TYDSK		;IS IT A DISK?
	SKIPA				;Spooled, or disk, OK...
	JRST	[ MOVX	S1,ERFND$	;NO, RETURN A 'FILE NOT ON DISK'
		  PJRST	RETERR ]	;
	MOVEI	S2,FB$PTH(FB)		;LOCATION TO START PATH BLOCK AT
	HRLI	S2,.PTMAX		;SET SIZE UP TOO
	MOVEM	S2,FB$FUB+.FOPAT(FB)	;STORE IT AWAY
	MOVEI	S2,FB$BRH(FB)		;GET ADR OF BUFFER RING HDR
	MOVEM	S2,FB$FUB+.FOBRH(FB)	;AND STORE IT
	MOVE	TF,FB$FUB+.FOIOS(FB)	;GET THE DATA MODE IN TF
	MOVE	S1,FB$FUB+.FODEV(FB)	;GET THE SIXBIT DEVICE IN S1
	MOVEI	S2,TF			;POINT TO THE ARG BLK
	DEVSIZ	S2,			;GET THE DEVICE BUFFER SIZE
	 MOVEI	S2,203			;FAILED,,USE WHAT WE KNOW IS RIGHT
	HRRZS	S2			;GET ONLY BUFFER LENGTH
	MOVX	S1,PAGSIZ		;GET THE TOTAL BUFFER LENGTH
	IDIV	S1,S2			;CALC NUMBER OF BUFFERS THAT WILL FIT
	MOVEM	S1,FB$FUB+.FONBF(FB)	;STORE AS # OF BUFFERS
	MOVE	S2,FB$MOD(FB)		;GET THE MODE WORD
	CAIE	S2,FBM$OU		;IS IT OUTPUT
	CAIN	S2,FBM$AP		; OR APPEND?
	SKIPA				;YES IT IS
	JRST	OPNC.1			;NO, SKIP THIS CODE
	MOVSS	FB$FUB+.FOBRH(FB)	;REVERSE BUFFER HEADER WORD
	MOVSS	FB$FUB+.FONBF(FB)	; AND BUFFER NUMBER WORD
OPNC.1:	MOVEI	S2,FB$LEB(FB)		;GET ADDRESS OF LOOKUP/ENTER BLOCK
	MOVEM	S2,FB$FUB+.FOLEB(FB)	;STORE IT
	MOVE	S1,T2			;GET ADDRESS OF FD BLOCK
	PUSHJ	P,LDLEB			;LOAD THE LOOKUP ENTER BLOCK
	PUSHJ	P,ATTRIB		;SET FILE ATTRIBUTES
	MOVE	S2,O$FUNC		;GET FILOP. FUNCTION WORD
	TXO	S2,FO.ASC		;ASSIGN CHANNEL NUMBER
	MOVEM	S2,FB$FUB+.FOFNC(FB)	;STORE IN FUNCTION WORD
	CAIG	T4,FOB.US		;IS THIS "ON BEHALF"?
	JRST	OPNC.2			;NO
	LOAD	S1,FOB.US(T1)		;GET PPN OF USER
	MOVEM	S1,FB$FUB+.FOPPN(FB)	;AND STORE IT
OPNC.2:	MOVE	T1,FB$BUF(FB)		;GET ADDRESS OF BUFFER
	EXCH	T1,.JBFF##		;TELL MONITOR TO BUILD BUFFERS THERE
	MOVSI	S1,.FOMAX		;GET LEN,,0
	HRRI	S1,FB$FUB(FB)		;GET LEN,,ADDRESS
	FILOP.	S1,			;DO THE FILOP.
	  MOVNS	T1			;FLAG THAT FILOP FAILED
	MOVMM	T1,.JBFF##		;RESTORE FIRST FREE
	LOAD	TF,FB$FUB+.FOFNC(FB),FO.CHN ;GET THE CHANNEL NUMBER
	MOVEM	TF,FB$CHN(FB)		;AND SAVE IT AWAY
	JUMPL	T1,OPNERR		;IF ERROR OCCURRED, COMPLAIN
	PUSHJ	P,SETFD			;SET UP REAL FILE DESCRIPTION
	MOVE	S1,FB$LEB+.RBSIZ(FB)	;GET WORDS IN FILE
	MOVEM	S1,FB$WRD(FB)		;STORE IT
	MOVE	S1,FB$IFN(FB)		;GET THE IFN IN S1
	$RETT				;AND RETURN OUR SUCCESS
>  ;END TOPS10 CONDITIONAL
TOPS20<
	MOVE	T3,T1			;GET LOCATION OF FOB INTO SAFER PLACE
	MOVE	S1,O$GJFN		;GET GTJFN FUNCTION WORD
	MOVX	S2,FB.PHY		;GET /PHYSICAL BIT
	TDNE	S2,FOB.CW(T3)		;IS IT SET?
	TXO	S1,GJ%PHY		;YES
	LOAD	S2,IIB##+IB.FLG,IB.NAC	;Get access bit value
	SKIPE	DEBUGW			;Debugging?
	SETZ	S2,			;Yes, do not restrict
	STORE	S2,S1,GJ%ACC		;Store as value of JFN access
	HRROI	S2,FB$FD+.FDSTG(FB)	;POINT TO THE FILE
	GTJFN				;FIND IT
	  JRST	OPNERR			;LOSE
	MOVEM	S1,FB$JFN(FB)		;SAVE THE JFN
	SETZ	T2,			;ASSUME NO CONNECTED DIRECTORY
	CAILE	T4,FOB.CD		;IS THIS FOR SOMEONE?
	MOVE	T2,FOB.CD(T3)		;GET CD IF IT'S THERE
	MOVEM	T2,FB$CHK+.CKACD(FB)	;STORE THE CONNECTED DIRECTORY
	JUMPE	T2,OPNC.2		;SKIP ACCESS CHECK IF NO DIRECTORY
	MOVE	T2,O$PROT		;GET PROTECTION TO CHECK FOR
	MOVEM	T2,FB$CHK+.CKAAC(FB)	;AND PUT WHERE IT WILL GET CHECKED
	LOAD	T2,FOB.US(T3)		;GET USER ID
	MOVEM	T2,FB$CHK+.CKALD(FB)	;STORE IT
	MOVEM	S1,FB$CHK+.CKAUD(FB)	;STORE JFN TO CHECK AGAINST
	MOVEI	S2,FB$CHK(FB)		;ADDRESS OF BLOCK
	MOVX	S1,CK%JFN+.CKAUD+1	;LENGTH + CHECKING JFN
	CHKAC				;CHECK IT
	 SETZM	S1			;RETURN PROTECTION FAILURE
	JUMPE	S1,[ MOVX  S1,ERPRT$	;GET A PROTECTION FAILURE
		     PJRST  RETERR ]	;AND GO FROM THERE
OPNC.2:	MOVE	S1,FB$JFN(FB)		;RESTORE JFN
	MOVE	S2,O$FUNC		;GET FILE OPEN FUNCTION
	OPENF				;OPEN THE FILE
	  JRST	OPNERR			;LOSE?
	DVCHR				;LOOK UP THE DEVICE'S CHARACTERISTICS
	LOAD	S1,S2,DV%TYP		;ISOLATE THE TYPE CODE
	CAXE	S1,.DVNUL		;IF IT THE NULL DEVICE ???
	CAXN	S1,.DVDSK		;OR A DISK ???
	JRST	OPNC.1			;YES TO EITHER,,CONTINUE
	MOVX	S1,ERFND$		;LOAD 'DEVICE IS NOT THE DISK'
	PJRST	RETERR			;CLEAN UP AND RETURN THE ERROR

OPNC.1:	SKIPE	FB$PTR(FB)		;ATTRIBUTE BLOCK EXIST?
	PUSHJ	P,ATTRIB		;LOAD FILE ATTRIBUTES
	MOVE	S1,FB$JFN(FB)		;Get JFN back
	MOVX	S2,<.FBLEN,,.FBHDR>	;GET FILE DESCRIPTOR BLOCK
	MOVEI	T1,FB$FDB(FB)		;AND STORE INTO OUR FB
	GTFDB				;
	  ERJMP	.+1			;IGNORE ERRORS FOR NOW
	PUSHJ	P,SETFD			;SET UP THE ACTUAL FILE DESCRIPTION
	MOVE	S1,FB$BUF(FB)		;Buffer page address
	HRLI	S1,440000		;Form byte pointer to first byte
	MOVE	S2,FB$BYT(FB)		;Get byte size
	DPB	S2,[POINT 6,S1,11]	;Set byte size field in byte pointer
	MOVEM	S1,FB$VBP(FB)		;Store virgin byte pointer
	SETZM	FB$BIB(FB)		;Mark buffer as empty
	MOVE	S1,FB$VBP(FB)		;Get virgin byte pointer
	MOVEM	S1,FB$BBP(FB)		;set current buffer pointer

OPNC.E:	MOVE	S1,FB$IFN(FB)		;PUT IFN IN S1
	$RETT				;RETURN SUCCESS, IFN IN S1
>  ;END TOPS20 CONDITIONAL
	SUBTTL  LDLEB  - Load a LOOKUP/ENTER block from an FD


; LDLEB IS USED TO LOAD THE LOOKUP/ENTER BLOCK FOR OPEN AND RENAME
; ROUTINES.

; CALL IS:	FB/ ADDRESS OF FB
;		S1/ ADDRESS OF FD
;
; RETURN:	ALWAYS TRUE

TOPS10<
LDLEB:	PUSHJ	P,.SAVE2		;GET SOME SCRATCH SPACE
	MOVEI	S2,.RBMAX		;LENGTH OF LOOKUP
	MOVEM	S2,FB$LEB+.RBCNT(FB)	;STORE IN LOOKUP/ENTER BLOCK
	LOAD	S2,.FDNAM(S1)		;GET FILE NAME
	MOVEM	S2,FB$LEB+.RBNAM(FB)	;STORE IN LOOKUP/ENTER BLOCK
	HLLZ	S2,.FDEXT(S1)		;GET THE EXTENSION
	HLLM	S2,FB$LEB+.RBEXT(FB)	;STORE IT
	MOVE	P1,.FDPPN(S1)		;GET THE PPN
	MOVEM	P1,FB$LEB+.RBPPN(FB)	;STORE INTO LOOKUP/ENTER BLOCK
	LOAD	S2,.FDLEN(S1),FD.LEN	;GET FD LENGTH
	SUBI	S2,.FDPAT		;SUBTRACT OFFSET OF FIRST SFD
	JUMPLE	S2,.RETT		;IF NO SFDS, WE ARE DONE
	JUMPE	P1,.RETT		;IF PPN IS 0, DON'T MAKE A PATH BLOCK
	MOVEM	P1,FB$PTH+.PTPPN(FB)	;STORE PPN IN PATH BLOCK
	MOVEI	P2,FB$PTH(FB)		;AND MAKE THE PPN WORD OF LEB
	MOVEM	P2,FB$LEB+.RBPPN(FB)	;POINT TO THE PATH BLOCK
	MOVE	P1,FB			;GET FB POINTER

LDLE.1:	MOVE	P2,.FDPAT(S1)		;GET AN SFD
	MOVEM	P2,FB$PTH+.PTPPN+1(P1)	;STORE IT
	ADDI	S1,1			;INCREMENT 1ST PTR
	ADDI	P1,1			;INCREMENT 2ND PTR
	SOJG	S2,LDLE.1		;AND GET THEM ALL
	POPJ	P,			;RETURn

> ;END OF TOPS10 CONDITIONAL
SUBTTL	File attribute processing -- Main loop and dispatch table


; Here to process file attributes.
; Call:	MOVE	FB,address of file block
;	PUSHJ	P,ATTRIB
;
; TRUE return:	attributes set.
; FALSE return:	failed for some reason; error code stored.
;
; For TOPS-10 this must be done before any FILOP. UUOs are done
; to that the attributes get put into the LOOKUP/ENTER/RENAME blocks.
;
; For TOPS-20, this routine must be called after any GTJFN/OPENF JSYS are
; done.
;
ATTRIB:	SKIPN	FB$PTR(FB)		;HAVE AN ATTRIBUTE BLOCK?
	$RETT				;NO
	PUSHJ	P,GETBLK		;EAT OVERHEAD WORD
	JUMPT	ATTR.1			;CHECK FOR ERRORS
	$RETE	(FAI)			;FILE ATTRIBUTE BLOCK INCONSISTANCY

ATTR.1:	PUSHJ	P,GETBLK		;GET A BLOCK TYPE
	  JUMPF	.RETT			;RETURN IF ALL DONE
	LOAD	S2,S1,FI.ATR		;GET BLOCK TYPE
	CAIL	S2,1			;RANGE CHECK
	CAILE	.FIMAX			; IT
	  $RETE	(IFA)			;ILLEGAL FILE ATTRIBUTE
	LOAD	S1,S1,FI.LEN		;GET LENGTH
	PUSHJ	P,@ATRTAB-1(S2)		;PROCESS IT
	JUMPT	ATTR.1			;LOOP FOR MORE IF ALL IS OK
	$RETE	(FAI)			;FILE ATTRIBUTE BLOCK INCONSISTANCY


; Attribute dispatch table
; All routines are called with S1:= attribute block word count.
;
ATRTAB:	EXP	ATRPRO			;(01) PROTECTION CODE
	EXP	ATRACT			;(02) ACCOUNT STRING
	EXP	ATRSPL			;(03) SPOOLED FILE NAME
; Protection
;
ATRPRO:	CAIE	S1,1			;1 WORD WE HOPE
	  $RETF				;LOSER
	PUSHJ	P,GETVAL		;GET PROTECTION CODE
	  JUMPF	.RETF			;THERE WASN'T ONE
TOPS10	<STORE	S1,FB$LEB+.RBPRV(FB),RB.PRV> ;STORE IT
TOPS20	<
	MOVE	T1,S1			;GET PROTECTION CODE
	HRLI	S1,.FBPRT		;INDEX INTO FDB TO CHANGE
	HRR	S1,FB$JFN(FB)		;GET THE JFN
	MOVEI	S2,-1			;MASK OF BITS TO CHANGE
	CHFDB				;AND SET IT
	  ERJMP	GETERR			;CAN'T
>
	$RETT				;RETURN


; Account string
;
ATRACT:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	SKIPG	P1,S1			;GET WORD COUNT
	  $RETF				;NEGATIVE OR ZERO LOSES
TOPS10	<MOVEI	P2,FB$LEB+.RBACT(FB)>	;TOPS-10 BASE ADDRESS OF ACCT STRING
TOPS20	<MOVEI	P2,FB$ACT(FB)>		;TOPS-20 BASE ADDRESS OF ACCT STRING
	SKIPN	FB$IMM(FB)		;IMMEDIATE ARGUMENT?
	JRST	ATRAC2			;NOPE
ATRAC1:	PUSHJ	P,GETVAL		;GET A WORD
	  JUMPF	.RETF			;PREMATURE END OF LIST
	MOVEM	S1,(P2)			;PUT A WORD
	ADDI	P2,1			;POINT TO NEXT STORAGE LOCATION
	SOJG	P1,ATRAC1		;LOOP FOR ALL WORDS
	JRST	ATRAC3			;FINISH UP
ATRAC2:	SOSGE	FB$CNT(FB)		;COUNT ARGUMENTS
	  $RETF				;END OF LIST
	HRLZ	S1,@FB$PTR(FB)		;GET ADDRESS OF BLOCK
	HRRI	S1,(P2)			;MAKE A BLT POINTER
	AOS	FB$PTR(FB)		;INCREMENT FOR NEXT TIME
	ADDI	P1,(P2)			;COMPUTE END ADDRESS OF BLT
	BLT	S1,-1(P1)		;COPY BLOCK
ATRAC3:
TOPS20	<
	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	HRROI	S2,FB$ACT(FB)		;POINT TO ACCOUNT STRING
	SACTF				;SET FILE ACCOUNT
	  $RETF				;CAN'T
>
	$RETT				;RETURN


; Spooled file name (TOPS-10 only)
;
ATRSPL:	CAIE	S1,1			;1 WORD
	  $RETF				;BAD ARGUMENT
	PUSHJ	P,GETVAL		;GET SPOOLED FILE NAME
	  JUMPF	.RETF			;END OF LIST
TOPS10	<MOVEM	S1,FB$LEB+.RBSPL(FB)>	;STORE IT
	$RETT				;RETURN
	SUBTTL	SETFD  - Set up a real description of opened file

;SETFD	IS CALLED AFTER A FILE IS OPENED TO STORE A REAL
;	I.E. OBTAINED FROM THE SYSTEM ,  FD

;CALL IS:	FB POINTS TO THE FILE'S FILE BLOCK
;
;RETURN IS:	ALWAYS TRUE


TOPS10<
SETFD:	MOVE	S1,FB$PTH+.PTFCN(FB)	;GET FILE'S DEVICE
	MOVEM	S1,FB$RFD+.FDSTR(FB)	;STORE INTO STRUCTURE LOCATION
	MOVE	S1,FB$LEB+.RBNAM(FB)	;GET FILE'S NAME
	MOVEM	S1,FB$RFD+.FDNAM(FB)	;STORE INTO RFD
	HLLZ	S1,FB$LEB+.RBEXT(FB)	;GET FILE'S EXTENSION
	MOVEM	S1,FB$RFD+.FDEXT(FB)	;STORE IT
	MOVX	S1,.FDPPN		;GET LENGTH OF ALL BUT PATH
	STORE	S1,FB$RFD+.FDLEN(FB),FD.LEN ;STORE IT AWAY
	MOVSI	S1,-<FDXSIZ-.FDPPN-1>	;GET MAXIMUM LENGTH OF PATH
	HRR	S1,FB			;RELOCATE TO THE RFD
SETF.1:	SKIPE	S2,FB$PTH+.PTPPN(S1)	;IS THIS PART OF PATH SPECIFIED?
	INCR	FB$RFD+.FDLEN(FB),FD.LEN;YES, INCREMENT LENGTH OF FD
	MOVEM	S2,FB$RFD+.FDPPN(S1)	;STORE THE ACTUAL PATH
SETF.2:	AOBJN	S1,SETF.1		;REPEAT FOR ALL PARTS
	MOVEI	S1,FB$PTH(FB)		;POINT TO ACTUAL PATH BLOCK
	MOVEM	S1,FB$LEB+.RBPPN(FB)	;SAVE FOR FUTURE REFERENCE
	$RETT				;THEN RETURN TO CALLER
> ;END OF TOPS10 CONDITIONAL

TOPS20<
SETFD:	PUSH	P,T1			;SAVE JSYS REGISTER
	HRROI	S1,FB$RFD+.FDSTG(FB)	;MAKE POINTER TO PLACE TO STORE STRING
	MOVE	S2,FB$JFN(FB)		;GET JFN OF FILE
	MOVX	T1,1B2+1B5+1B8+1B11+1B14+JS%TMP+JS%PAF
	JFNS				;MAKE STRING FROM JFN
	ANDI	S1,-1			;GET ADDRESS LAST USED
	SUBI	S1,FB$RFD-1(FB)		;GET LENGTH OF THE FD
	STORE	S1,FB$RFD+.FDLEN(FB),FD.LEN ;STORE THE LENGTH AWAY
	POP	P,T1			;RESTORE THE REGISTER
	$RETT				;RETURN TO CALLER
> ;END OF TOPS20 CONDITIONAL
	SUBTTL SETFOB - Build an internal FOB

;SETFOB is used to create an internal FOB, which is built from a regular
;FOB with any missing fields defaulted.  It is used by rename and delete
;to create a complete FOB where the user may have supplied only a partial
;one.
;

;CALL IS:	S1/ LENGTH OF INPUT FOB
;		S2/ USER SPECIFIED BYTE SIZE,, ADDRESS OF INPUT FOB 
;TRUE RETURN:	S1/ LENGTH OF INTERNAL FOB
;		S2/ ADDRESS OF INTERNAL FOB
;
; TRUE RETURN IS ALWAYS GIVEN

SETFOB:	PUSHJ	P,.SAVE1		;GET ONE WORK AC
	MOVE	P1,FOB.FD(S2)		;FD ALWAYS GIVEN
	STORE	P1,F$FOB+FOB.FD		;SO USE IT
	HLRZ	P1,S2			;Get the user specified byte size
	SKIPN	P1			;Was one specified?
	MOVEI	P1,^D36			;No, so use 36. bit size
	CAIL	P1,1			;Check for
	CAILE	P1,^D36			;legal byte sizde
	JRST	S..IBS			;Illegal byte size specified.
	STORE	P1,F$FOB+FOB.CW,FB.BSZ	;FOR THE FILE
	CAIG	S1,FOB.US		;IS USER ID GIVEN?
	TDZA	P1,P1			;NO, FILL IT WITH ZERO
	MOVE	P1,FOB.US(S2)		;ELSE USE WHAT IS GIVEN
	STORE	P1,F$FOB+FOB.US		;STORE IT
TOPS20<
	CAIG	S1,FOB.CD		;IS CONNECTED DIRECTORY GIVEN?
> ;END OF TOPS20 CONDITIONAL
	TDZA	P1,P1			;NO, FILL WITH ZERO
	MOVE	P1,FOB.CD(S2)		;ELSE USE WHAT IS GIVEN
	STORE	P1,F$FOB+FOB.CD		;STORE IT
	MOVEI	S1,FOB.SZ		;SIZE OF FOB
	MOVEI	S2,F$FOB		;AND ITS LOCATION
	$RETT				;RETURN WITH POINTERS SET UP
	SUBTTL	OPNERR - Handle a system error from F%IOPN

;OPNERR IS CALLED ON A SYSTEM GENERATED ERROR IN F%IOPN TO CLEAN
;	UP, TRANSLATE THE SYSTEM ERROR CODE INTO A GALAXY ERROR CODE
;	AND RETURN FALSE.
;
;RETERR IS LIKE OPNERR, EXCEPT THAT THE ERROR CODE IS ALREADY A GLXLIB ERROR
; CODE, NOT A SYSTEM ERROR CODE
;
;UPON ENTERING,  S1 CONTAINS THE ERROR CODE
;		 FB CONTAINS THE ADDRESS OF THE WORK PAGE
;		 I  CONTAINS THE IFN

OPNERR:	PUSH	P,S1			;SAVE THE ERROR CODE
	PUSHJ	P,INTREL		;RELEASE THE IFN
	SKIPE	S1,FB$JFN(FB)		;Don't release if there is no JFN
	RLJFN				;Release the JFN
	ERJMP	.+1			;Ignore any errors
NOJFN:	POP	P,S1			;Restore the error code
	PJRST	MAPERR			;MAP THE OPERATING SYSTEM ERROR

;RETERR IS AN IDENTICAL ERROR ROUTINE, EXCEPT THAT THE ERROR CODE IS
; PRE-MAPPED.

RETERR:	PUSH	P,S1			;SAVE THE CODE
	PUSHJ	P,INTREL		;RELEASE THE IFN
	POP	P,S1			;RESTORE THE CODE
	MOVEM	S1,.LGERR##		;SET UP IN CASE OF STOP CODE
	MOVEI	S2,.			;AND SET UP THE PC TOO
	MOVEM	S2,.LGEPC##		;
	$RETF				;FINALLY, TAKE FAILURE RETURN
	SUBTTL	F%IBYT  -  Read one byte from file

;F%IBYT is called for a file open for INPUT or UPDATE to return the next
;	byte from the file.
;
;Call:		S1/  IFN
;
;True Return:	S1/  IFN
;		S2/  Next byte from file
;
;False Return:	S1/  Error code:  EREOF$  ERFDE$

F%IBYT:	PUSHJ	P,CHKIFN		;CHECK THE IFN
	MOVE	S1,FB$MOD(FB)		;GET OPEN MODE
	CAIN	S1,FBM$IN		;IS IT INPUT?
	JRST	IBYT.1			;YES, CONTINUE
	CAIN	S1,FBM$UP		;OR UPDATE?
	HALT .				;NOT IMPLEMENTED YET!
	JRST	ILLMOD			;NO, GIVE A STOPCODE

IBYT.1:	SOSGE	FB$BIB(FB)		;COUNT OFF ONE MORE BYTE
	JRST	IBYT.3			;NO MORE IN BUFFER
	SKIPE	FB$LSN(FB)		;ARE WE TRIMMING LSN'S?
	JRST	IBYT.4			;YES, GO CHECK IT
IBYT.2:	ILDB	S2,FB$BBP(FB)		;NO, JUST GET THE NEXT BYTE
	MOVE	S1,FB$IFN(FB)		;RESTORE IFN
	$RETT				;AND RETURN

IBYT.3:	PUSHJ	P,GETBUF		;GET NEXT BUFFER FULL
	JUMPF	.RETF			;RETURN IF IT FAILED
	JRST	IBYT.1			;ELSE, TRY AGAIN

IBYT.4:	MOVE	S1,FB$BBP(FB)		;GET THE BUFFER BYTE POINTER
	IBP	S1			;NORMALIZE IT
	MOVE	S1,(S1)			;GET THE WORD
	TRNN	S1,1			;IS LSN BIT SET?
	JRST	[SKIPLE FB$LSN(FB)	;SKIP IF NOT VIRGIN FILE
		 SETZM FB$LSN(FB)	;IT IS, THEN THERE ARE NO LSNS IN FILE!
		 JRST IBYT.2]		;GET THE BYTE
	AOS	FB$BBP(FB)		;INCREMENT BYTE-POINT BY ONE WORD
	MOVNI	S1,5-1			;ACCOUNT FOR BYTES BYPASSED BY AOS
					;FB$BIB WAS SOSGE'D ABOVE
	ADDM	S1,FB$BIB(FB)		;DECREMENT BYTES-IN-BUFFER
					;EVEN IF FB$BIB GOES NEGATIVE HERE
					;THE NEXT SOSGE IN IBYT WILL CATCH IT
	SETZM	FB$LSN(FB)		;CLEAR FLAG TO AVOID RECURSION
	PUSHJ	P,IBYT.1		;GET THE TAB FOLLOW LSN
	SETOM	FB$LSN(FB)		;RE-SET THE FLAG
	JUMPF	.RETF			;PASS ON THE ERROR
	JRST	IBYT.1			;ELSE, GET NEXT BYTE
	SUBTTL	F%IBUF  -  Read a buffer of data from file

;F%IBUF is called for a file open for INPUT or UPDATE to return the next
;	'n' bytes of data from the file.
;
;Call:		S1/  IFN
;
;True Return:	S1/  Number of bytes returned
;		S2/  Byte Pointer to first byte (ILDB)
;
;False Return:	S1/  Error Code:  EREOF$  ERFDE$

F%IBUF:	PUSHJ	P,CHKIFN		;CHECK THE IFN
	MOVE	S1,FB$MOD(FB)		;GET I/O MODE
	CAIN	S1,FBM$IN		;IS IT INPUT?
	JRST	IBUF.1			;YES, CONTINUE
	CAIN	S1,FBM$UP		;IS IT UPDATE?
	HALT .				;NOT IMPLEMENTED YET
	JRST	ILLMOD			;INCORRECT MODE

IBUF.1:	SKIPE	FB$LSN(FB)		;WANT TO TRIM LINE NUMBERS?
	$STOP(CTL,Cannot trim LSN in buffered mode)
	SKIPG	S1,FB$BIB(FB)		;GET NUMBER OF BYTES IN BUFFER
	JRST	IBUF.2			;NONE THERE, NEED TO READ ANOTHER
	MOVE	S2,FB$BBP(FB)		;GET THE BYTE POINTER
	SETZM	FB$BIB(FB)		;NO BYTES LEFT IN BUFFER
	$RETT				;RETURN

IBUF.2:	PUSHJ	P,GETBUF		;GET A NEW BUFFER
	JUMPF	.RETF			;PROPAGATE THE ERROR
	JRST	IBUF.1			;AND TRY AGAIN
	SUBTTL	GETBUF  -  Read one input buffer from the operating system

;GETBUF is called by F%IBYT and F%IBUF to read another bufferful of data
;	from the file.  It has no explicit input arguments.  On TRUE return,
;	it has no explicit output arguments but it returns with the FB
;	fully updated.
;
;False return:	S1/  Error code:  EREOF$  ERFDE$


GETBUF:	SKIPE	FB$EOF(FB)		;HAVE WE SEEN EOF?
	JRST	POSEOF			;YES, JUST RETURN EOF

TOPS10<
	HRL	S1,FB$CHN(FB)		;GET THE CHANNEL NUMBER
	HRRI	S1,.FOINP		;LOAD THE INPUT FUNCTION CODE
	MOVE	S2,[1,,S1]		;FILOP ARG POINTER
	FILOP.	S2,			;AND DO THE INPUT
	  SKIPA				;SKIP IF ERROR
	JRST	GETB.2			;ELSE CONTINUE ON
	TXNE	S2,IO.EOF		;IS IT END OF FILE?
	JRST	POSEOF			;YES, HANDLE IT
	PJRST	MAPIOE			;MAP I/O ERROR
>  ;END TOPS10

TOPS20<
	$CALL	.SAVET			;SAVE T1 THRU T4
	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	MOVE	S2,FB$VBP(FB)		;Get virgin byte pointer
	MOVEM	S2,FB$BRH+.BFPTR(FB)	;SAVE THE BYTE POINTER
	MOVEI	T1,SZ.BUF		;Number of words in buffer
	IMUL	T1,FB$BPW(FB)		;Compute bytes in buffer
	MOVEM	T1,FB$BRH+.BFCNT(FB)	;Save the byte count
	MOVNS	T1			;Negate it for SIN
	SIN				;READ THEM
	ERJMP	[GTSTS			;GET FILE STATUS
		 TXNN S2,GS%EOF		;IS IT EOF?
		  PJRST GETERR		;GET ERROR, MAP IT AND RETURN
		 PUSHJ P,POSEOF		;YES, SET EOF
		 JRST GETB.1]		;AND CONTINUE ON
GETB.1:	ADD	T1,FB$BRH+.BFCNT(FB)	;Calculate actual bytes read
	MOVEM	T1,FB$BRH+.BFCNT(FB)	;Save the count
	JUMPE	T1,POSEOF		;GOT EOF!!
>  ;END TOPS20

GETB.2:	AOS	FB$BFN(FB)		;INCREMENT BUFFER NUMBER
	PUSHJ	P,SETBFD		;SETUP BUFFER DATA
	$RETT
	SUBTTL	F%POS  -  Position an input file
	SUBTTL	F%REW  -  Rewind an input file

;F%POS is called for a file open for INPUT to position the file to the end of
;	the buffer containing the byte specified in S2. The pointer FB$BBP(FB)
;	will point to the byte.
;
;F%REW is a special case of F%POS to position to the first byte
;	of the file.
;
;Call:		S1/  IFN  (for F%POS and F%REW)
;		S2/  Byte number (for F%POS only)
;
;True Return:	Nothing returned
;
;False Return:	S1/  Error code:  ERIFP$  ERFDE$

F%REW:	SETZ	S2,			;POSITION TO BYTE 0 FOR REWIND
F%POS:	PUSHJ	P,CHKIFN		;CHECK THE IFN GIVEN
	$CALL	.SAVET			;SAVE T REGS
	MOVE	T4,S2			;SAVE DESIRED BYTE NUMBER
	MOVE	S1,FB$MOD(FB)		;GET I/O MODE
	CAIN	S1,FBM$IN		;IS IT INPUT?
	JRST	POS.1			;YES, ALL IS WELL
	CAIN	S1,FBM$UP		;UPDATE?
	HALT .				;NO IMPLEMENTED
	JRST	ILLMOD			;ELSE, LOSE

POS.1:	CAME	S2,[EXP -1]		;DOES HE WANT EOF?
	JRST	POS.2			;NO, CONTINUE ON
	PUSHJ	P,POSEOF		;SETUP EOF
	$RETT				;AND RETURN

POS.2:	SKIPGE	S2			;RANGE CHECK THE BYTE NUMBER
	$RETE(IFP)			;NEGATIVE BYTES LOSE
	PUSHJ	P,FSIZE			;Get max pointer
	CAMLE	T4,S1			;Ok?
	 $RETE(IFP)			;Illegal File pointer
	MOVE	T1,FB$BPW(FB)		;Get the number of bytes/word
	IMULI	T1,SZ.BUF		;Get the number of bytes/buffer
	MOVE	T2,T4			;Pick up the position	
	IDIV	T2,T1			;T2=number of buffers,T3=byte in buffer
	MOVEM	T2,FB$BFN(FB)		;Update the buffer number
	IMUL	T2,T1			;Number of bytes in previous buffers
	MOVE	S1,FB$JFN(FB)		;Pick up the JFN
	MOVE	S2,T2			;Position to start of current buffer
	SFPTR%				;Do it
	$STOP(FOF,File operation failed unexpectedly)
	MOVE	S1,FB$JFN(FB)		;Get the JFN
	MOVE	S2,FB$VBP(FB)		;Get virgin byte pointer
	MOVEM	S2,FB$BRH+.BFPTR(FB)	;SAVE THE BYTE POINTER
	MOVEI	T1,SZ.BUF		;Number of words in buffer
	IMUL	T1,FB$BPW(FB)		;Compute bytes in buffer
	MOVEM	T1,FB$BRH+.BFCNT(FB)	;Save the byte count
	MOVNS	T1			;Negate it for SIN
	SIN%				;Read them
	ERJMP	[GTSTS			;Get file status
		 TXNN S2,GS%EOF		;Is it EOF?
		  PJRST GETERR		;Get error, map it and return
		 JRST POS.3]		;And continue on
POS.3:	ADD	T1,FB$BRH+.BFCNT(FB)	;Calculate actual bytes read
	MOVEM	T1,FB$BRH+.BFCNT(FB)	;Save the count
	PUSHJ	P,SETBFD		;Set up pointers for this buffer
	MOVNS	T3			;Negate byte count
	ADDM	T3,FB$BIB(FB)		;To decrement buffer count
	MOVNS	T3			;Re-negate
	IDIV	T3,FB$BPW(FB)		;Convert to words
	ADDM	T3,FB$BBP(FB)		;Push up the byte pointer some
	SETZM	FB$EOF(FB)		;Clear EOF flag
POS.4:	SOJL	T4,.RETT		;More odd bytes?
	IBP	FB$BBP(FB)		;Yes, bump the pointer
	JRST	POS.4			;And loop

POSEOF: PUSH	P,T1			;Save T1 for later
	SETOM	FB$BIB(FB)		;MAKE SURE WE ALWAYS GET HERE
	SETOM	FB$EOF(FB)		;DITTO
	MOVE	S1,FB$JFN(FB)		;Point monitor's file pointer to EOF
	SETO	S2,			;...
	SFPTR				;...
	 JFCL				;Ignore errors, this should never fail
	POP	P,T1			;Restore T1
	$RETE(EOF)			;RETURN THE ERROR
	SUBTTL	F%OBYT  -  Write one byte into file

;F%OBYT is called for an open OUTPUT or APPEND file to write one byte.
;
;Call:		S1/  IFN
;		S2/  Byte to write
;
;True Return:	No data returned
;
;False Return:	S1/  Error code:  ERFDE$

F%OBYT:	PUSHJ	P,CHKIFN		;CHECK OUT THE IFN
	SETOM	FB$FNC(FB)		;DO SOMETHING ON NEXT CHECKPOINT CALL
	MOVE	S1,FB$MOD(FB)		;GET THE MODE
	CAIE	S1,FBM$OU		;IF OUTPUT
	CAIN	S1,FBM$AP		;OR APPEND
	JRST	OBYT.1			;CONTINUE ON
	JRST	ILLMOD			;ELSE, LOSE

OBYT.1:	SOSGE	FB$BIB(FB)		;ANY ROOM IN BUFFER?
	JRST	OBYT.2			;NO, DUMP THE BUFFER AND GET NEXT ONE
	IDPB	S2,FB$BBP(FB)		;YES, DEPOSIT THE BYTE
	$RETT				;RETURN TRUE

OBYT.2:	PUSH	P,S2			;SAVE S2
	PUSHJ	P,PUTBUF		;WRITE OUT THE BUFFER
	POP	P,S2			;RESTORE S2
	JUMPF	.RETF			;PROPAGATE AN ERROR
	JRST	OBYT.1			;ELSE, TRY AGAIN
	SUBTTL	F%OBUF  -  Write a buffer full of data to a file

;F%OBUF is called to transfer a buffer full of data to a file which is
;	open for OUTPUT or APPEND.
;
;Call:		S1/  IFN
;		S2/  XWD Number of bytes,Address of buffer
;
;True Return:	No data returned
;
;False Return:	S1/  Error code:  ERFDE$

F%OBUF:	PUSHJ	P,CHKIFN		;CHECK THE IFN OUT
	PUSHJ	P,.SAVE4		;SAVE P1 THRU P4
	SETOM	FB$FNC(FB)		;DO SOMETHING ON NEXT CHECKPOINT CALL
	MOVE	P1,FB$MOD(FB)		;GET THE MODE
	CAIE	P1,FBM$OU		;IF IT IS OUTPUT
	CAIN	P1,FBM$AP		; OR APPEND,
	SKIPA				; THEN WIN
	JRST	ILLMOD			;ELSE LOSE
	HRRZ	P1,S2			;GET ADDRESS IN P1
	HLRZ	P2,S2			;GET COUNT IN P2
	HRLI	P1,(POINT)		;MAKE IT A BYTE POINTER
	MOVE	P3,FB$BYT(FB)		;GET BYTE SIZE
	DPB	P3,[POINT 6,P1,11]	;STORE IT
	MOVE	S1,FB$BIB(FB)		;GET BYTES REMAINING
	IDIV	S1,FB$BPW(FB)		;DIVIDE BY BYTES/WORD
	JUMPE	S2,OBUF.5		;JUMP TO SPECIAL CASE IF WORD-ALIGNED

OBUF.1:	SOJL	P2,.RETT		;RETURN WHEN DONE
	ILDB	P3,P1			;ELSE, GET A BYTE
OBUF.2:	SOSGE	FB$BIB(FB)		;ANY ROOM IN BUFFER?
	JRST	OBUF.3			;NO, GET MORE ROOM
	IDPB	P3,FB$BBP(FB)		;STORE THE BYTE
	JRST	OBUF.1			;AND LOOP

OBUF.3:	PUSHJ	P,PUTBUF		;WRITE OUT THE BUFFER
	JUMPF	.RETF			;PROPAGATE THE FAILURE
	JRST	OBUF.2			;AND TRY AGAIN


					;F%OBUF IS CONTINUED ON THE NEXT PAGE
					;CONTINUED FROM PREVIOUS PAGE

;HERE IF CURRENT BUFFER IS WORD ALIGNED
;P1 CONTAINS BYTE POINTER TO USER'S BUFFER
;P2 CONTAINS BYTE COUNT

OBUF.5:	IDIV	P2,FB$BPW(FB)		;P2 GETS WORD COUNT P3 GET REMAIN BYTES

;NOW LOOP BLT'ING AS MANY OF THE USER'S DATA WORDS AS WILL FIT INTO THE
;	FILE BUFFER EACH TIME THRU.

OBUF.6:	JUMPE	P2,OBUF.8		;DONE IF NOTHING LEFT TO MOVE
	SKIPE	S1,FB$BIB(FB)		;ANY ROOM IN BUFFER?
	JRST	OBUF.7			;YES, CONTINUE ON
	PUSHJ	P,PUTBUF		;NO, DUMP IT OUT
	JUMPF	.RETF			;IF FAILURE, RETURN IT
	MOVE	S1,FB$BIB(FB)		;NOW GET BYTES REMAINING IN BUFFER
OBUF.7:	IDIV	S1,FB$BPW(FB)		;GET WORDS REMAINING IN BUFFER
	CAML	S1,P2			;IS THERE ENOUGH ROOM FOR ALL USER DATA?
	MOVE	S1,P2			;YES, USE DATA COUNT
	SUB	P2,S1			;AND UPDATE FOR NEXT ITERATION
	MOVN	S2,S1			;GET NEGATIVE WORD COUNT
	IMUL	S2,FB$BPW(FB)		;GET NEGATIVE BYTE COUNT
	ADDM	S2,FB$BIB(FB)		;UPDATE BUFFER BYTE COUNT
	MOVE	S2,FB$BBP(FB)		;GET BUFFER BYTE POINTER
	ADDM	S1,FB$BBP(FB)		;UPDATE FOR NEXT ITERATION
	IBP	S2			;NORMALIZE THE BYTE POINTER
	HRL	S2,P1			;MAKE A BLT POINTER
	ADD	P1,S1			;UPDATE SOURCE POINTER
	ADDI	S1,-1(S2)		;GET END OF BLT ADDRESS
	BLT	S2,(S1)			;MOVE SOME DATA
	JRST	OBUF.6			;AND LOOP

OBUF.8:	SOJL	P3,.RETT		;RETURN WHEN NO MORE BYTES
	ILDB	S2,P1			;GET A BYTE
	MOVE	S1,FB$IFN(FB)		;GET THE IFN
	$CALL	F%OBYT			;WRITE THE BYTE
	JRST	OBUF.8			;AND LOOP
	SUBTTL	PUTBUF  -  Give one output buffer to the operating system

;PUTBUF is called from F%OBYT and F%OBUF to write a buffer full of information
;	into the output file.  It has no explicit input arguments.  On True
;	return it has no explicit output arguments but it returns with the FB
;	fully updated.
;
;False return:	S1/  Error code:  ERFDE$


TOPS10<
PUTBUF:	MOVE	S1,FB$BIB(FB)		;GET BYTES REMAINING IN BUFFER
	EXCH	S1,FB$BRH+.BFCNT(FB)	;EXCH WITH ORIGNINAL byte COUNT
	SUB	S1,FB$BRH+.BFCNT(FB)	;GET NUMBER OF byteS WRITTEN
	ADDM	S1,FB$BRH+.BFPTR(FB)	;UPDATE THE BYTE POINTER
	HRL	S1,FB$CHN(FB)		;GET THE CHENNEL NUMBER
	HRRI	S1,.FOOUT		;GET OUTPUT FUNCTION
	MOVE	S2,[1,,S1]		;SETUP ARG POINTER
	FILOP.	S2,			;OUTPUT A BLOCK
	  PJRST	MAPIOE			;MAP I/O ERROR
					;AND FALL INTO PUTB.1
>  ;END TOPS10

TOPS20<
PUTBUF:	PUSHJ	P,WRTBUF		;WRITE OUT THE BUFFER
	JUMPF	GETERR			;RETURN FILE DATA ERROR
	MOVE	S1,FB$VBP(FB)		;Get a virgin byte pointer
	MOVEM	S1,FB$BRH+.BFPTR(FB)	;and save it
	MOVEI	S1,SZ.BUF		;Get the buffer size
	IMUL	S1,FB$BPW(FB)		;Make it into bytes
	MOVEM	S1,FB$BRH+.BFCNT(FB)	;and save the count
>  ;END TOPS20

	PUSHJ	P,SETBFD		;SET BUFFER DATA (BBP, BIB)
	AOS	FB$BFN(FB)		;INCREMENT THE BUFFER NUMBER
	$RETT				;AND RETURN
	SUBTTL	F%CHKP  -  Checkpoint a file

;F%CHKP is called to checkpoint the current file.  If the file is open
;	for INPUT, the number of the next byte to be returned to the
;	user is returned.  If the file is opened for OUTPUT, all internal
;	buffers are written out, and all file pointers are updated to
;	relect the file's existence.  The byte number of the next byte
;	to be written is returned.
;
;Call:		S1/  IFN
;
;True Return:	S1/  Number of next byte
;
;False Return:	S1/  Error code:  ERFDE$   or MAPERR mapping

F%CHKP:	PUSHJ	P,CHKIFN		;CHECK OUT THE IFN
	MOVE	S1,FB$MOD(FB)		;GET THE MODE
	CAIN	S1,FBM$IN		;IS IT INPUT?
	JRST	CHK.I			;YES, GO HANDLE IT
	CAIE	S1,FBM$OU		;IS IT OUTPUT
	CAIN	S1,FBM$AP		;OR APPEND?
	JRST	CHK.O			;YES, GO HANDLE THAT
	CAIN	S1,FBM$UP		;IS IT UPDATE
	HALT .				;YES, NOT IMPLEMENTED YET!
	JRST	ILLMOD			;ELSE, ILLEGAL MODE

CHK.I:	SETO	S1,			;SETUP TO RETURN EOF
	SKIPE	FB$EOF(FB)		;HIT EOF?
	SKIPLE	FB$BIB(FB)		;YES, ANYTHING LEFT IN THE BUFFER?
	JRST	NXTBYT			;GO COMPUTE AND RETURN NEXT BYTE NUMBER
	$RETT				;NO, REALLY EOF

CHK.O:	$CALL	.SAVE1			;SAVE P1
	PUSHJ	P,CHKOS			;CHECKPOINT THE OUTPUT
	JUMPF	.RETF			;FAILED?
	PUSHJ	P,NXTOUT		;GET NEXT BYTE NUMBER
	JUMPF	.RETF			;
	$RETT				;AND RETURN

NXTOUT:	SKIPGE	S1,FB$BFN(FB)		;ANY INPUTS DONE YET?
	JRST	[SETZM	S1		;NO, RETURN BYTE 0
		$RETT]			; AND TRUE!
	MOVE	S1,FB$JFN(FB)		;Get the JFN
	RFPTR%				;Get the next byte number
	ERJMP	.RETF			;Return false if an error
	MOVE	S1,S2			;Place byte number in S1
	$RETT				

NXTBYT:
	SKIPGE	S1,FB$BFN(FB)		;ANY INPUTS DONE YET?
	JRST	[SETZM	S1		;NO, RETURN BYTE 0
		$RETT]			; AND TRUE!
	IMUL	S1,FB$BPW(FB)		;GET NUMBER OF COMPLETE WORDS
	IMULI	S1,SZ.BUF		;GET NUMBER OF COMPLETE BUFFERS
	MOVE	S2,FB$BRH+.BFCNT(FB)	;GET NUMBER OF WORDS ORIGINALLY IN BFR
	SUB	S2,FB$BIB(FB)		;GET REMAININDER OF CURRENT BUFFER
	ADD	S1,S2			;AND WE HAVE THE ANSWER
	$RETT				;SO RETURN
TOPS10<
CHKOS:	SKIPL	FB$FNC(FB)		;SKIP IF FILE NEEDS CHECKPOINTING
	$RETT				;ELSE, JUST RETURN
	SETZM	FB$FNC(FB)		;NO LONGER NEEDS CHECKPOINTING
	$CALL	.SAVE1			;SAVE P1
	MOVE	P1,FB$BBP(FB)		;GET THE BUFFER BYTE POINTER
	HRRZ	S1,FB$BRH+.BFADR(FB)	;GET THE BUFFER ADDRESS
	SUB	P1,S1			;GET OFFSET INTO BUFFER
	MOVE	S1,FB$BIB(FB)		;GET BYTES REMAINING IN BUFFER
	IDIV	S1,FB$BPW(FB)		;GET WORDS REMAINING
	EXCH	S1,FB$BRH+.BFCNT(FB)	;EXCH WITH ORIGNINAL WORD COUNT
	SUB	S1,FB$BRH+.BFCNT(FB)	;GET NUMBER OF WORDS WRITTEN
	ADDM	S1,FB$BRH+.BFPTR(FB)	;UPDATE THE BYTE POINTER
	HRL	S1,FB$CHN(FB)		;GET THE CHANNEL NUMBER
	HRRI	S1,.FOURB		;UPDATE RIB FUNCTION
	MOVE	S2,[1,,S1]		;FILOP ARG POINTER
	FILOP.	S2,			;DO THE FILOP.
	  PJRST	MAPIOE			;MAP I/O ERROR
	MOVE	S1,FB$BIB(FB)		;GET BYTES REMAINING IN BUFFER
	IDIV	S1,FB$BPW(FB)		;GET WORDS REMAINING
	SKIPG	S1			;ANY SPACE LEFT ???
	PJRST	SETBFD			;NO,,RETURN RESETTING BBP AND BIB
	HRRZ	S1,FB$BRH+.BFADR(FB)	;YES,,GET THE CURRENT BUFFER ADDRESS
	ADD	P1,S1			;UPDATE THE BYTE POINTER
	MOVEM	P1,FB$BBP(FB)		;AND SAVE IT
	$RETT				;RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20<
CHKOS:	SKIPL	FB$FNC(FB)		;SKIP IF FILE NEEDS CHECKPOINTING
	$RETT				;ELSE, JUST SKIP IT
	SETZM	FB$FNC(FB)		;DISK IS (WILL BE) UP TO DATE
	$CALL	.SAVET			;SAVE T REGS
	MOVE	S1,FB$BPW(FB)		;Get bytes per word
	IMULI	S1,SZ.BUF		;Calculate bytes per buffer
	SUB	S1,FB$BIB(FB)		;Subtract unused part
	SKIPLE	S1			;Skip if buffer is empty
	JRST [	PUSHJ	P,PUTBUF	;WRITE THE BUFFER
		JUMPF	GETERR		;FILE DATA ERROR?
		JRST	.+1 ]		;Rejoin main code
	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	SIZEF				;Get size of file
	ERJMP	GETERR			;MAP ERROR
	HRLZ	S1,FB$JFN(FB)		;Put JFN in LF, 0 in RH
	MOVE	S2,T1			;Put page count here
	UFPGS				;FORCE IT ALL OUT
	ERJMP	GETERR			;MAP THE ERROR
	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	RFPTR				;READ THE FILE POINTER
	ERJMP	GETERR			;MAP THE ERROR
	MOVE	T1,S2			;SAVE THE SIZE IN T1
	HRRZ	S1,FB$JFN(FB)		;GET THE JFN
	MOVX	S2,.FBSIZ		;GET NUMBER OF WORD TO CHANGE
	STORE	S2,S1,CF%DSP		;STORE IN S1
	TXO	S1,CF%NUD		;DON'T UPDATE THE DISK
	SETOM	S2			;CHANGE ALL BITS
	CHFDB				;CHANGE THE FILE LENGTH
	ERJMP	GETERR			;MAP THE ERROR
	HRRZ	S1,FB$JFN(FB)		;GET THE JFN
	MOVX	S2,.FBBYV		;GET NUMBER OF WORD TO CHANGE
	STORE	S2,S1,CF%DSP		;STORE IN S1
	PUSH	P,S1			;Save this for a bit
	HRRZ	S1,FB$JFN(FB)		;Get the JFN again
	RFBSZ				;Get file's real byte size
	ERJMP [	POP	P,S1		;Restore S1
		JRST	GETERR ]	;and return error
	POP	P,S1			;Restore S1
	SETZ	T1,			;CLEAR T1
	STORE	S2,T1,FB%BSZ		;Put the byte size in the right place
	MOVX	S2,FB%BSZ		;PUT MASK IN S2
	CHFDB				;SET THE BYTE SIZE
	ERJMP	GETERR			;MAP THE ERROR
	$RETT				;AND RETURN
>  ;END TOPS20
	SUBTTL	WRTBUF  -  TOPS20 Subroutine to SOUT the current buffer

TOPS20<
;Call:		FB$BIB setup
;
;True Return:	Buffer SOUTed
;
;False Return:	If file data error

WRTBUF:	$CALL	.SAVET			;SAVE T REGS
	MOVE	S2,FB$BFN(FB)		;GET THE BUFFER NUMBER
	JUMPL	S2,.RETT		;RETURN IF THIS IS THE DUMMY OUTPUT
	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	MOVE	S2,FB$MOD(FB)		;Get the file open mode
	CAIN	S2,FBM$AP		;Is it append?
	JRST	WRTB.2			;Yes, can't SFPTR an appended file
	SETOM	S2			;Set to the end of the file
	SFPTR%				;Do it
	ERJMP	.RETF			;Return I/O error
WRTB.2:	MOVE	S2,FB$VBP(FB)		;Get virgin byte pointer
	MOVNI	T1,SZ.BUF		;Get negative size of buffer in words
	IMUL	T1,FB$BPW(FB)		;Make that into a byte count
	SKIPGE	FB$BIB(FB)		;Check NUMBER OF BYTES LEFT
	SETZM	FB$BIB(FB)		;-1 IS ACTUALLY 0
	ADD	T1,FB$BIB(FB)		;Add in the unused part of the buffer
	SOUT				;AND DO THE OUTPUT
	ERJMP	.RETF			;PROPAGATE FAILURE
	$RETT				;ELSE, RETURN
>  ;END TOPS20


SUBTTL	SETBFD  --  Setup Buffer Data

;SETBFD is called to set the current 'user' buffer parameters (i.e.
;	FB$BIB, FB$BBP) from the 'operating system' values
;	(FB$BRH).  No calling parameters, returns with BIB and BBP, setup.


SETBFD:	MOVE	S1,FB$BRH+.BFPTR(FB)	;GET THE BYTE POINTER
	MOVEM	S1,FB$BBP(FB)		;STORE THE BUFFER BYTE POINTER
	MOVE	S1,FB$BRH+.BFCNT(FB)	;Get byte count again
	MOVEM	S1,FB$BIB(FB)		;SAVE FOR USER
	$RETT				;AND RETURN
	SUBTTL  F%REN  - Rename a file

; CALLS TO F%REN PROVIDE A SOURCE AND DESTINATION NAME.
;	THE SOURCE FILE IS RENAMED TO THE NAME SPECIFIED AS THE
;	DESTINATION FILE.

; CALL:		S1/	LENGTH OF FILE RENAME BLOCK (DESCRIBED IN GLXMAC)
;		S2/	BYTE SIZE(OPTIONAL),,ADDRESS OF FRB (FILE RENAME BLOCK)
;			IF BYTE SIZE NOT SPECIFIED THEN DEFAULTS TO 36.
;
;TRUE RETURN:	IF RENAME OPERATION IS SUCCESSFUL
;
;FALSE RETURN:	S1/ ERROR CODE
;
; POSSIBLE ERRORS:	ERPRT$  ERFNF$  ERFDS$


TOPS10<
F%REN:	$SAVE	FB			;SAVE THE FB ADDRESS RESGISTER
	PUSHJ	P,.SAVET		;GET SOME WORK SPACE
	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	T1,S2			;GET FRB ADDRESS
	MOVE	T2,S1			;AND ITS SIZE INTO PERMANENT PLACES
	CAIG	T2,FRB.DF		;REQUIRE AT LEAST SOURCE AND
	$STOP(RTS,Rename block too small)
	PUSHJ	P,ALCIFN		;ALLOCATE AN IFN
	JUMPF	.RETF			;PROPOGATE ANY ERROR
	MOVE	T3,FB			;AND THE FB ADDRESS
	MOVE	S1,FRB.SF(T1)		;GET FD FOR SOURCE OF RENAME
	MOVX	S2,FR.PHY		;GET PHYSICAL ONLY BIT
	TDNE	S2,FRB.FL(T1)		;IS IT SET?
	SKIPA	S2,[UU.PHS+.IOIMG]	;YES
	MOVEI	S2,.IOIMG		;NO
	MOVEM	S2,FB$FUB+.FOIOS(T3)	;ALTHOUGH NONE WILL BE DONE
	MOVE	S2,.FDSTR(S1)		;GET STRUCTURE THAT FILE IS ON
	MOVEM	S2,FB$FUB+.FODEV(T3)	;STORE INTO FILOP BLOCK
	MOVEI	S2,FB$LEB(T3)		;GET ADDRESS OF LOOKUP/ENTER AREA
	MOVEM	S2,FB$FUB+.FOLEB(T3)	;STORE IT TOO
	CAIG	T2,FRB.US		;IS THIS "IN BEHALF"?
	JRST	REN.1			;NO, NO NEED TO SET IT UP
	MOVE	S2,FRB.US(T1)		;GET USER ID (PPN)
	MOVEM	S2,FB$FUB+.FOPPN(T3)	;STORE IT
REN.1:	CAIG	T2,FRB.AB		;FOB CONTAIN ATTRIBUTE BLOCK POINTER?
	TDZA	P1,P1			;NOPE
	MOVE	P1,FRB.AB(T1)		;GET ATTRIBUTE BLOCK ADDRESS
	MOVE	T2,.FDSTR(S1)		;GET SOURCE STRUCTURE
	MOVE	S2,FRB.DF(T1)		;GET FD FOR DESTINATION
	PUSHJ	P,LDLEB			;LOAD THE LOOKUP/ENTER BLOCK FROM FD
	PUSHJ	P,ALCIFN		;ALLOCATE ANOTHER IFN
	JUMPF	REN.21			;PASS ERROR AFTER RELEASING FIRST IFN

	JUMPE	P1,REN.X		;ANY ATTRIBUTES?
	MOVEM	P1,FB$PTR(FB)		;SET ATTRIBUTE BLOCK ADDR IN NEW FB
	HRRZ	P1,(P1)			;GET WORD COUNT
	MOVEM	P1,FB$CNT(FB)		;SET ATTRIBUTE BLOCK COUNT IN NEW FB

REN.X:	MOVEI	S2,FB$LEB(FB)		;GET ADDRESS OF 2ND LEB
	HRLM	S2,FB$FUB+.FOLEB(T3)	;STORE AS LH OF 1ST .FOLEB POINTER
	MOVE	S1,FRB.DF(T1)		;NOW GET 2ND FD ADDRESS
	PUSHJ	P,LDLEB			;LOAD THE LOOKUP/ENTER AREA
	PUSHJ	P,ATTRIB		;SET FILE ATTRIBUTES

	;F%REN IS CONTINUED ON THE FOLLOWING PAGE
   	;CONTINUED FROM PREVIOUS PAGE

	MOVX	S1,FO.ASC		;ASSIGN CHANNEL NUMBER
	IOR	S1,[FO.PRV+.FORNM]	;PRIVELEGES+ RENAME FUNCTION
	MOVEM	S1,FB$FUB+.FOFNC(T3)	;STORE INTO FUNCTION WORD
	HRLI	S1,.FOMAX		;SET LENGTH OF BLOCK
	HRRI	S1,FB$FUB(T3)		;AND ITS ADDRESS
	FILOP.	S1,			;DO THE RENAME
	  JRST	REN.3			;FAILED...
REN.2:	LOAD	S1,FB$FUB+.FOFNC(T3),FO.CHN ;GET THE CHANNEL
	MOVEM	S1,FB$CHN(T3)		;REMEMBER FOR RELEASE
	MOVE	S1,FB$IFN(T3)		;GET THE FIRST IFN
	$CALL	F%RREL			;AND RELEASE IT
	MOVE	S1,FB$IFN(FB)		;GET THE SECOND IFN
	$CALL	F%RREL			;RELEASE IT
	$RETT				;AND RETURN

REN.3:	PUSH	P,S1			;SAVE ERROR CODE
	PUSHJ	P,REN.2			;RELEASE THE IFNS
	POP	P,S1			;RESTORE ERROR CODE
	PJRST	MAPERR			;RETURN, AFTER MAPPING ERROR

REN.21:	PUSH	P,S1                    ;SAVE ERROR CODE
	MOVE	S1,FB$IFN(T3)           ;GET FIRST IFN
	$CALL	F%REL                   ;AND RELEASE IT
	POP	P,S1                    ;RESTORE ERROR CODE
	$RETF                           ;PROPAGATE ERROR

> ;END OF TOPS10 CONDITIONAL
TOPS20<
F%REN:	PUSHJ	P,.SAVET		;GET SOME WORK SPACE
	PUSHJ	P,.SAVE2		;SAVE P1
	CAIG	S1,FRB.DF		;REQUIRE AT LEAST SOURCE AND DEST.
	$STOP(RTS,Rename block too small)
	CAIGE	S1,FRB.FL		;ANY FLAG WORD ???
	TDZA	T2,T2			;NO, FILL IT WITH ZERO
	LOAD	T2,FRB.FL(S2),FR.NFO	;ELSE PICK UP 'NEW FILE ONLY' BIT
	MOVE	T4,FRB.DF(S2)		;REMEMBER THE DESTINATION

	MOVX	P1,FR.PHY		;GET PHYSICAL ONLY BIT
	TDNN	P1,FRB.FL(S2)		;IS IT SET?
	TDZA	P1,P1			;NOPE
	MOVEI	P1,FB.PHY		;GET FOB BIT
	MOVEM	P1,F$FOB+FOB.CW		;STORE SOMETHING

	PUSHJ	P,SETFOB		;SET UP INTERNAL FOB
	PUSHJ	P,F%IOPN		;OPEN THE FILE FOR INPUT
	JUMPF	.RETF			;IF IT FAILS, GIVE UP NOW
	MOVEM	S1,T1			;REMEMBER SOURCE IFN
	MOVEM	T4,F$FOB+FOB.FD		;REPLACE SOURCE FD WITH DESTINATION FD
	STORE	T2,F$FOB+FOB.CW,FB.NFO	;SET 'NEW FILE ONLY' FLAG
	MOVEI	S1,FOB.SZ		;AND SET UP FOR USE OF THE
	MOVEI	S2,F$FOB		;INTERNAL FOB
	PUSHJ	P,F%OOPN		;MAKE IT OUTPUT SO PROTECTION IS CHECKED
	JUMPF	REN.31			;ON ERROR, RELEASE FIRST IFN AND PROPAGATE
	MOVEM	S1,T2			;REMEMBER DESTINATION IFN
	MOVE	T3,IFNTAB(T1)		;GET FB OF SOURCE
	MOVE	T4,IFNTAB(T2)		;AND OF DESTINATION
	SKIPN	FB$CHK+.CKACD(T3)	;IS THIS IN SOMEONES BEHALF?
	JRST	REN.2			;NO
	MOVX	S1,.CKACN		;YES, SEE IF WE COULD CONNECT
	MOVEM	S1,FB$CHK+.CKAAC(T3)	;BECAUSE WE WILL "DELETE" THE
	MOVX	S1,CK%JFN+.CKAUD+1	;FILE BY RENAMING IT
	MOVEI	S2,FB$CHK(T3)		;AND THATS MORE THAN JUST READING IT
	CHKAC				;ASK MONITOR
	 SETZM	S1			;RETURN PROTECTION FAILURE
	JUMPE	S1,[ MOVX  S1,OPNX3	;RETURN A PROTECTION FAILURE
		     JRST  REN.4 ]	;TO CALLER
REN.2:	MOVE	S1,FB$JFN(T3)		;GET JFN OF SOURCE FILE
	TXO	S1,CO%NRJ		;KEEP THE JFN AFTER CLOSING
	CLOSF				;CLOSE THE FILE
	  ERJMP	REN.4			;RETURN ERROR
	MOVE	S1,FB$JFN(T4)		;GET SOURCE JFN
	TXO	S1,CO%NRJ		;KEEP THE JFN AFTER CLOSING
	CLOSF				;CLOSE DESTINATION TOO
	  ERJMP	REN.4			;MAP ERROR, RETURN
	MOVE	S1,FB$JFN(T3)		;SET SOURCE FOR RENAME
	MOVE	S2,FB$JFN(T4)		;SET DESTINATION TOO
	RNAMF				;RENAME THE FILE
	  ERJMP	REN.5			;RETURN ERROR
	EXCH	FB,T4			;SWAP CUZ EVERYONE BELEIVES IN 'FB'
	PUSHJ	P,ATTRIB		;PROCESS ATTRIBUTE BLOCK
	EXCH	T4,FB			;RESET THINGS
REN.3:	MOVE	S1,T1			;SETUP SOURCE IFN
	$CALL	F%RREL			;AND RELEASE IT
	MOVE	S1,T2			;AND DESTINATION IFN
	$CALL	F%RREL			;AND RELEASE IT
	$RETT				;AND RETURN

REN.31:	PUSH	P,S1                    ;SAVE ERROR CODE
	MOVE	S1,T1                   ;GET SOURCE IFN
	$CALL	F%REL                   ;AND RELEASE IT
	POP	P,S1                    ;RESTORE ERROR CODE
	$RETF                           ;PROPAGATE ERROR

REN.4:	PUSH	P,S1			;SAVE ERROR CODE
	PUSHJ	P,REN.3			;RELEASE ALL IFN'S
	POP	P,S1			;RESTORE ERROR CODE
	PJRST	MAPERR			;RETURN, MAPPING THE ERROR

REN.5:	PUSH	P,S1			;Save the original error
	MOVE	S1,FB$JFN(T4)		;Get destination (created file) JFN
	TXO	S1,DF%NRJ!DF%EXP	;Delete and expunge but keep the JFN
	DELF%				;Get rid of it
	ERJMP	.+1			;Ignore errors
	POP	P,S1			;Get back the original error
	JRST	REN.4			;Resume error handling

> ;END OF TOPS20 CONDITIONAL
	SUBTTL	F%REL  - Release a file

;F%REL CLOSES THE FILE AND RELEASE THE IFN.

;CALL:		S1/  IFN
;
;TRUE RETURN:	IF FILE HAS BEEN CLOSED SUCCESSFULLY.
;	  NOTE: FILE IS RELEASED (I.E. IFN MADE INVALID) EVEN IF AN ERROR IS
;	        RETURNED.
;
;FALSE RETURN:	S1/ERROR CODE
;
; POSSIBLE ERRORS:  ERFDE$

TOPS10<
F%RREL:	PUSHJ	P,CHKIFN		;CHECK THE IFN
	SKIPGE	FB$CHN(FB)		;WAS IT EVER OPENED?
	 PJRST	RELFB			;NO..JUST RELEASE THE FB
	$CALL	.SAVE2			;SAVE P1 - P2
	HRL	P1,FB$CHN(FB)		;GET CHANNEL NUMBER
	HRRI	P1,.FOCLS		;GET CLOSE FUNCTION
	MOVX	P2,CL.RST		;GET CLOSE BITS
	MOVE	S1,[2,,P1]		;GET FILOP. ARG POINTER
	FILOP.	S1,			;AND RESET THE CHANNEL
	  PJRST	DREL.2			;FAILED,,PASS ERROR CODE BACK
	JRST	INTREL			;RELEASE THE CHANNEL

F%REL:	PUSHJ	P,CHKIFN		;CHECK THE IFN
	SKIPGE	FB$CHN(FB)		;WAS FILE EVER OPENED?
	 PJRST	RELFB			;NO..JUST RELEASE THE FB
	MOVE	S1,FB$BIB(FB)		;GET BYTES REMAINING IN BUFFER
	IDIV	S1,FB$BPW(FB)		;GET WORDS REMAINING
	EXCH	S1,FB$BRH+.BFCNT(FB)	;EXCH WITH ORIGNINAL WORD COUNT
	SUB	S1,FB$BRH+.BFCNT(FB)	;GET NUMBER OF WORDS WRITTEN
	ADDM	S1,FB$BRH+.BFPTR(FB)	;UPDATE THE BYTE POINTER

INTREL:	HRL	S1,FB$CHN(FB)		;GET THE CHANNEL
	HRRI	S1,.FOREL		;GET RELEASE FUNCTION
	MOVE	S2,[1,,S1]		;GET ARG POINTER
	FILOP.	S2,			;RELEASE THE CHANNEL
	  SETOM	S1			;SET ERROR INDICATOR
	PUSH	P,S2			;SAVE POSSIBLE I/O ERROR BITS
	PUSHJ	P,RELFB			;IN ANY CASE RELEASE THE FILE DATA BASE
	POP	P,S2			;RESTORE S2
	CAMN	S1,[-1]			;DID AN ERROR OCCUR ???
	  PJRST	MAPIOE			;MAP I/O ERROR
	$RETT				;NO,,JUST RETURN
>  ;END TOPS10


TOPS20<
F%REL:	PUSHJ	P,CHKIFN		;VALIDATE THE IFN ETC.
	SKIPN	FB$JFN(FB)		;See if there's a jfn yet
	JRST	RELFB			;If not, just release the storage
	MOVE	S1,FB$IFN(FB)		;PUT THE IFN IN S1
	$CALL	F%CHKP			;AND CHECKPOINT THE FILE
INTREL:	SKIPN	S1,FB$JFN(FB)		;GET THE JFN
	JRST	RELFB			;If no jfn, just release storage
	CLOSF				;GET RID OF IT
	   ERJMP INTR.1			;PROCESS THE ERROR
	JRST	RELFB			;AND DELETE THE FB
INTR.1:	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	RLJFN				;RELEASE THE JFN
	   ERJMP .+1			;IGNORE THE ERROR
	JRST	RELFB			;AND DELETE THE FB

F%RREL:	PUSHJ	P,CHKIFN		;VALIDATE THE IFN ETC.
	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	TXO	S1,CZ%ABT		;ABORT THE OPERATION
	CLOSF				;CLOSE THE FILE
	ERJMP	.+2			;Maybe never opened ... toss it
	JRST	RELFB			;AND DELETE THE FB
	MOVE	S1,FB$JFN(FB)		;Reload the JFN
	RLJFN%				;And get rid of it
	ERJMP	.+1			;Ignore any errors
	JRST	RELFB			;Delete the FB

>  ;END TOPS20
	SUBTTL	F%DREL - Delete a file and release it

;CALL:		S1/  IFN
;
;TRUE RETURN:	IF DELETION COULD BE ACCOMPLISHED
;
;FALSE RETURN:	S1/ ERROR CODE
;
;POSSIBLE ERRORS:	ERPRT$	ERUSE$

TOPS10<
F%DREL:	PUSHJ	P,CHKIFN		;CHECK FOR LEGAL IFN
	HRL	S1,FB$CHN(FB)		;GET CHANNEL NUMBER
	HRRI	S1,.FOCLS		;GET CLOSE FUNCTION
	MOVE	S2,[1,,S1]		;GET FILOP. ARG POINTER
	FILOP.	S2,			;AND CLOSE THE FILE
	  JFCL				;IGNORE ERROR
	HRLZ	S1,FB$CHN(FB)		;GET CHANNEL NUMBER
	IORX	S1,<FO.PRV+.FODLT>	;LITE PRIV+DELETE FUNCTION
	MOVEM	S1,FB$FUB+.FOFNC(FB)	;SAVE IT IN THE FILOP BLOCK
	SETZM	FB$FUB+.FONBF(FB)	;NO BUFFERS
	SETZM	FB$FUB+.FOBRH(FB)	;NO BUFFER RING HEADER
	MOVSI	S1,.FOMAX		;GET FILOP BLOCK LENGTH
	HRRI	S1,FB$FUB(FB)		;AND ADDRESS
	FILOP.	S1,			;AND DELETE THE FILE
	  JRST	DREL.2			;IT FAILED!
	PJRST	INTREL			;RELEASE IFN AND RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20<
F%DREL:	PUSHJ	P,CHKIFN		;VALIDATE THE IFN
	SKIPN	FB$CHK+.CKACD(FB)	;SHOULD WE CHECK PROTECTION?
	JRST	DREL.1			;NO
	MOVX	S2,.CKAWR		;SEE IF WE COULD WRITE THE FILE
	MOVEM	S2,FB$CHK+.CKAAC(FB)	;SAVE IN CHKAC BLOCK
	MOVEI	S2,FB$CHK(FB)		;ADDRESS OF CHKAC BLOCK
	MOVX	S1,CK%JFN+.CKAUD+1	;LENGTH OF CHKAC BLOCK
	CHKAC				;CHECK THE ACCESS
	 SETZM	S1			;RETURN PROTECTION FAILURE
	JUMPE	S1,[ MOVX S2,OPNX3	;LOAD A PROTECTION FAILURE
		     JRST  DREL.2 ]	;AND CONTINUE
DREL.1:	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	TXO	S1,CO%NRJ		;DONT RELEASE THE JFN
	CLOSF				;CLOSE THE FILE
	  JRST	DREL.2			;ERROR CHECK
	MOVX	S1,DF%EXP		;SET EXPUNGE FILE BIT
	HRR	S1,FB$JFN(FB)		;GET JFN FROM ADDRESS
	DELF				;DELETE THE FILE
	  ERJMP	DREL.2			;FAILED, EXAMINE IT
	PJRST	RELFB			;RELEASE FB BLOCK
> ;END OF TOPS20 CONDITIONAL

DREL.2:	PUSH	P,S1			;SAVE ERROR CODE
	PUSHJ	P,INTREL		;RETURN MEMORY
	POP	P,S1			;GET FAILURE CODE
	PJRST	MAPERR			;RETURN AFTER MAPPING TO GALAXY ERROR
	SUBTTL	F%DEL  - Delete an unopened file

;F%DEL is used to delete a file that has not been opened.
;In actuality, this routine opens the file and then closes it with delete.

;CALL IS:	S1/ Size of the FOB
;		S2/ Address of the FOB (See GLXMAC for FOB description)
;
;TRUE RETURN:	If file deletion has been successful
;
;FALSE RETURN:	S1/ Error code if file can not be deleted.

F%DEL:	PUSHJ	P,SETFOB		;USE INTERNAL FOB TO BUILD DEFAULTS
	PUSHJ	P,F%AOPN		;OPEN THE FILE UP (APPEND MEANS WRITE ACCESS)
	JUMPF	.RETF			;IF IT FAILS, PASS IT ON
	PJRST	F%DREL			;DELETE THE FILE, PASS ON ANY FAILURE
	SUBTTL   F%INFO - Return system information about a file

; F%INFO WILL RETURN INFORMATION FROM EITHER THE FDB OR THE LOOKUP/ENTER BLOCK
;	BASED ON THE CANONICAL FILE INFORMATION TOKEN PASSED AS THE INPUT
;	ARGUMENT.

; CALL:		S1/ IFN
;		S2/ CANONICAL FILE INFORMATION DESCRIPTOR (SEE GLXMAC)
;
; RETURN:	S1/ CONTENTS OF DESIRED WORD


F%INFO:	PUSHJ	P,CHKIFN		;VALIDATE INTERNAL FILE NUMBER
	SKIPL	S2			;INSURE THAT ARGUMENT IS IN RANGE
	CAIL	S2,LEN.FI		;OF AVAILABLE DATA
	$STOP(UFI,Unknown File Information Descriptor)
	XCT	FITAB(S2)		;FETCH THE INFORMATION
	$RETT				;AND TAKE A GOOD RETURN

; MAKE UP THE SYSTEM-DEPENDENT TABLE FOR FETCHING VALUES

	SYSPRM  FINF,FB$LEB,FB$FDB	;BASE OF FILE INFORMATION


  SYSPRM XX.CRE,<$CALL FTINFO>,<MOVE S1,FINF+.FBCRV(FB)>
  SYSPRM XX.GEN,<MOVE S1,FINF+.RBVER(FB)>,<LDB S1,[POINTR(FINF+.FBGEN(FB),FB%GEN)]>
  SYSPRM XX.PRT,<LDB S1,[POINTR(FINF+.RBPRV(FB),RB.PRV)]>,<LDB S1,[POINTR(FINF+.FBPRT(FB),RHMASK)]>
  SYSPRM XX.CLS,<SETZM	S1>,<LDB S1,[POINTR(FINF+.FBCTL(FB),FB%FCF)]>
  SYSPRM XX.AUT,<MOVE S1,FINF+.RBAUT(FB)>,<LDB S1,[POINTR(FINF+.FBUSE(FB),RHMASK)]>
  SYSPRM XX.USW,<MOVE S1,FINF+.RBNCA(FB)>,<MOVE S1,FINF+.FBUSW(FB)>
  SYSPRM XX.SPL,<MOVE S1,FINF+.RBSPL(FB)>,<SETZM S1>
  SYSPRM XX.SIZ,<MOVE S1,FB$WRD(FB)>,<PUSHJ P,FSIZE>
  SYSPRM XX.MOD,<LDB S1,[POINTR(FINF+.RBPRV(FB),RB.MOD)]>,<LDB S1,[POINTR(FINF+.FBBYV(FB),FB%MOD)]>
  SYSPRM XX.CHN,<MOVE S1,FB$CHN(FB)>,<MOVE S1,FB$JFN(FB)>

DEFINE X(A)<
	EXP < XX.'A>
> ;END OF X DEFINITION

FITAB:	CFI
	LEN.FI==.-FITAB

; This code is not immediately obvious.  The problem is that the user
; may have opened the file with a different byte size than that with
; which the file was written.  We can't guarantee perfection, since
; not all byte sizes are integral multiples of each other.  Howeer,
; we get as close as possible, always rounding up so a reader will be
; guaranteed to read everything in the file (although the last byte
; may only be partially significant).  In the comments, (file) refers
; to quantities related to the way the file was written, and (opening)
; refers to the same quantities related to the way the file is opened.
FSIZE:	$CALL	.SAVET			;Save these work registers
	MOVE	S1,FB$JFN(FB)		;Get JFN
	MOVE	S2,[2,,.FBBYV]		;Byte size and count words (FILE)
	MOVEI	T1,T1			;Byte size in T1, count in T2 (FILE)
	GTFDB				;..
	 ERCAL	S..FOF			;unexpected error
	RFBSZ				;Get the byte size (OPENING)
	 ERCAL	S..FOF			;unexpected error
	LDB	T1,[POINT 6,T1,11]	;Get byte size (FILE)
	CAIN	T1,(S2)			;Same byte sizes?
	JRST [	MOVE	S1,T2		;So use the value from the FDB
		$RET ]			;and return to caller
	MOVE	T3,S2			;Save byte size (OPENING)
	MOVEI	S1,^D36			;Get word size
	IDIVI	S1,(T1)			;Compute bytes per word (FILE), truncate
	MOVE	S2,S1			;Move it here
	MOVE	S1,T2			;Get byte count (FILE)
	IDIVI	S1,(S2)			;Compute fullword count (FILE)
	IMULI	S2,(T1)			;Remainder * byte size (FILE) = extra bt
	MOVE	T1,S2			;Preserve for a bit
	MOVEI	T2,^D36			;bits per word
	IDIVI	T2,(T3)			;Bytes per word (OPENING)
	IMULI	S1,(T2)			;Fullwords (FILE) * bytes/word (OPENING)
					; =  bytes (OPENING) to fill fullwords
					; (FILE)
	ADDI	T1,-1(T3)		;Round up
	IDIVI	T1,(T3)			;Extra bits after fullwords (FILE)
					; * bits/byte (OPENING) = bytes (OPEN)
					; required to hold extra bits
	ADDI	S1,(T1)			;the sum is the answer
	$RET


TOPS10<
FTINFO:	LOAD	S2,FINF+.RBPRV(FB),RB.CRD ;Get low order bits of 15 bit
					;  creation date
	LOAD	S1,FINF+.RBEXT(FB),RB.CRX ;Get the higher order 3 bits
	DPB	S1,[POINT 3,S2,23]	;Put date together in S2
	LOAD	S1,FINF+.RBPRV(FB),RB.CRT ;Get minutes since midnight
	IMULI	S1,^D60000		;Make it milliseconds
	$CALL	CNVDT##			;Convert to internal date time
	$RET
> ; END OF TOPS10 CONDITIONAL
	SUBTTL F%FD   - Return a pointer to the FD on an opened IFN

;CALL:		S1/IFN
;		S2/0			;TO OBTAIN ORIGINAL FD, PERHAPS WITH
					;WILDCARDS
;  OR
;		S2/-1			;TO OBTAIN CURRENT FD, I.E. ACTUAL FILE
;					;SPECIFICATION
;
;TRUE RETURN:	S1/LOCATION OF THE FIRST WORD OF THE FD CURRENTLY
;		   ASSOCIATED WITH THE IFN.
;		   TRUE RETURN IS ALWAYS GIVEN
;



F%FD:	PUSHJ	P,CHKIFN		;VALIDATE THE INTERNAL FILE NUMBER
	CAIG	S2,0			;IF 0, WANT MASTER FD
	CAMGE	S2,[EXP -1]		;  IF -1, WANT CURRENT FD
	$STOP(FIT,FD location requested with illegal type)
	MOVE	S1,FB			;GET BASE ADDRESS OF FILE BLOCK
	ADD	S1,[EXP FB$RFD,FB$FD]+1(S2) ;POINT TO REQUESTED FD
	$RETT				;RETURN, S1 HAS FD LOCATION




SUBTTL F%FCHN - Find first free channel

;F%FCHN is used on the TOPS-10 operating system to find the lowest I/O
;	channel that is not in use.  This routine does not allocate the
;	channel and the channel must be OPENed before the next F%FCHN call.

;CALL IS:	No arguments
;
;TRUE RETURN:	S1/ Number of lowest channel not OPENed or INITed
;FALSE RETURN:	All channels are in use

F%FCHN:
TOPS10<
	MOVSI	S1,-20			;20 CHANNELS ARE AVAILABLE (0-17)

FCHN.1:	HRRZ	S2,S1			;GET CHANNEL NUMBER
	DEVCHR	S2,			;DO A DEVICE CHARACTERISTICS CHECK
	SKIPE	S2			;IF ZERO, NOT OPENED YET
	AOBJN	S1,FCHN.1		;LOOP FOR ALL OF THEM
	JUMPGE	S1,[$RETE(SLE)]		;TAKE FALSE RETURN IF ALL TRIED
	ANDI	S1,-1			;GET DOWN TO JUST CHANNEL NUMBER
> ;END OF TOPS10 CONDITIONAL
	$RETT				;AND RETURN
	SUBTTL	ALCIFN - Allocate an Internal File Number

;CALL:		NO ARGUMENTS
;
;TRUE RETURN:	FB/  ADRESS OF THE FILE BLOCK
;
;FALSE RETURN:	S1/ERROR CODE
;


ALCIFN:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVSI	P1,-SZ.IFN		;MAKE AOBJN POINTER FOR LOOP
	HRRI	P1,1			;AND START AT 1
ALCI.1:	SKIPE	IFNTAB(P1)		;CHECK THE TABLE
	AOBJN	P1,ALCI.1		;NOT THIS ENTRY SO, LOOP
	JUMPGE	P1,[ $RETE(SLE) ]	;SYSTEM LIMIT ON FILES EXCEEDED
	MOVEI	S1,FB$END		;GET FB SIZE
	$CALL	M%GMEM			;GET THE MEMORY
	MOVEM	S2,IFNTAB(P1)		;STORE ADDRESS IN TABLE
	MOVE	FB,S2			;SETUP FB REGISTER
	HRRZM	P1,FB$IFN(FB)		;SAVE THE IFN
TOPS10 <
	SETOM	FB$CHN(FB)		;VIRGINIZE CHANNEL NUMBER
> ;End TOPS10
	$CALL	M%GPAG			;GET A BUFFER PAGE
	MOVEM	S1,FB$BUF(FB)		;SAVE THE ADDRESS
	$RETT				;AND TAKE A GOOD RETURN


SUBTTL RELFB  - Release a File Block

;CALL IS:	S1/ Index into IFNTAB to release
;
;TRUE RETURN:	Always

RELFB:	MOVE	S1,FB$BUF(FB)		;GET ADDRESS OF BUFFER PAGE
	$CALL	M%RPAG			;RETURN THE PAGE
	MOVE	S1,FB$IFN(FB)		;GET THE IFN
	SETZM	IFNTAB(S1)		;CLEAR THE IFN TABLE ENTRY
	MOVEI	S1,FB$END		;GET A LENGTH
	MOVE	S2,FB			;AND AN ADDRESS
	$CALL	M%RMEM			;RETURN THE MEMORY
	$RETT				;AND RETURN
	SUBTTL	GETERR	- Get Last -20 error to MAP it
TOPS20 <


	;This routine is either ERJMP'ed or JRST'ed to as a result
	;of a JSYS error involving some file manipulation. The
	;error code for the JSYS error is retrieved from the monitor
	;and saved in case the user does an ^E/[-1]/ or stopcodes.
	;The error code returned to the user is 'File Data Error'

GETERR:	MOVEI	S1,.FHSLF		;USE MY HANDLE
	GETER				;GET THE LAST ERROR CODE
	HRRZ	S1,S2			;GET THE ERROR	AND FALL INTO MAPERR
	JRST	MAPERR			;MAP THE ERROR
>;END TOPS20
	SUBTTL	MAPERR - Map an operating system error

;ROUTINE TO MAP AN OPERATING SYSTEM ERROR INTO A GALAXY ERROR.
;	CALL WITH ERROR CODE IN S1 AND RETURN FALSE WITH GALAXY
;	ERROR CODE IN S1.
;
MAPERR:	PUSHJ	P,.SAVE1		;GET ONE SCRATCH AC
	MOVSI	S2,-ERRLEN		;GET -VE LEN OF TABLE

MAPE.1:	HLRZ	P1,ERRTAB(S2)		;GET A SYSTEM CODE
	CAMN	P1,S1			;IS IT OURS?
	JRST	MAPE.2			;YES, WIN
	AOBJN	S2,MAPE.1		;NO, LOOP

TOPS20 <MOVEM	S1,.LGERR##		;SAVE THE ERROR CODE FOR TOPS20
	MOVEI	S1,ERUSE$		;GET UNEXPECTED ERROR CODE
	$RETF				;RETURN IT TO THE USER
>;END TOPS20

TOPS10 <$RETE(USE)>			;IF EXHAUSTED, RETURN 'UNEXPECTED ERROR'

MAPE.2:	HRRZ	S1,ERRTAB(S2)		;PICK UP THE ERROR CODE
	MOVEM	S1,.LGERR##		;STORE ERROR CODE IN CASE OF STOP
	MOVEI	S2,.			;ALSO OUR CURRENT LOCATION
	MOVEM	S2,.LGEPC##		;FOR LATER EXAMINATION
	$RETF				;THEN TAKE A FAILURE RETURN
TOPS10<
ERRTAB:	XWD	ERFNF%,	ERFNF$
	XWD	ERIPP%,	ERIPP$
	XWD	ERPRT%,	ERPRT$
	XWD	ERFBM%,	ERFBM$
	XWD	ERAEF%,	ERFAE$
	XWD	ERTRN%, ERTRN$
	XWD	ERDNA%,	ERDNA$
	XWD	ERNSD%,	ERNSD$
	XWD	ERNRM%,	ERQEF$
	XWD	ERWLK%,	ERWLK$
	XWD	ERNET%,	ERSLE$
	XWD	ERCSD%, ERCSD$
	XWD	ERDNE%, ERCDD$
	XWD	ERSNF%,	ERSNF$
	XWD	ERSLE%, ERESL$
	XWD	ERLVL%, ERLVL$
	XWD	ERNCE%, ERCCW$
	XWD	ERFCU%, ERFCU$
	XWD	ERENQ%, ERENQ$

	ERRLEN==.-ERRTAB
>  ;END TOPS10 CONDITIONAL

TOPS20<
ERRTAB:	XWD	DESX8,	ERFND$
	XWD	GJFX3,	ERSLE$
	XWD	GJFX4,	ERIFS$
	XWD	GJFX5,	ERIFS$
	XWD	GJFX6,	ERIFS$
	XWD	GJFX7,	ERIFS$
	XWD	GJFX8,	ERIFS$
	XWD	GJFX16,	ERNSD$
	XWD	GJFX17,	ERFNF$
	XWD	GJFX18,	ERFNF$
	XWD	GJFX19,	ERFNF$
	XWD	GJFX20,	ERFNF$
	XWD	GJFX22,	ERSLE$
	XWD	GJFX23,	ERSLE$
	XWD	GJFX24,	ERFNF$
	XWD	GJFX27,	ERFAE$
	XWD	GJFX28,	ERDNA$
	XWD	GJFX29,	ERDNA$
	XWD	GJFX35, ERPRT$
	XWD	OPNX2,	ERFNF$
	XWD	OPNX3,	ERPRT$
	XWD	OPNX4,	ERPRT$
	XWD	OPNX7,	ERDNA$
	XWD	OPNX8,	ERDNA$
	XWD	OPNX10,	ERQEF$
	XWD	OPNX23,	ERQEF$
	XWD	OPNX25,	ERPRT$
	XWD	RNAMX1, ERFDS$
	XWD	RNAMX3,	ERPRT$
	XWD	RNAMX4,	ERQEF$
	XWD	RNAMX8,	ERPRT$
	XWD	IOX11,	ERQEF$

	ERRLEN==.-ERRTAB
>  ;END TOPS20 CONDITIONAL
SUBTTL	MAPIOE - Map an I/O error


; Routine to map I/O error bits into a Galaxy error code
; S2:= I/O status word
;
TOPS10	<				;TOPS-10 ONLY
MAPIOE:	TXNE	S2,IO.IMP		;IMPROPER MODE
	  $RETE	(SWS)			;? Software write-locked file structure
	TXNE	S2,IO.DER		;DISK ERROR
	  $RETE	(DER)			;? Hardware device error
	TXNE	S2,IO.DTE		;HARD DATA/PARITY ERROR
	  $RETE	(DTE)			;? Hard data error
	TXNE	S2,IO.BKT		;BLOCK TOO LARGE/DISK FULL/ENQ
	  $RETE	(BKT)			;? Block too large
	$RETE	(FDE)			;? File data error
>					;END OF TOPS-10 CONDITIONAL
	SUBTTL	CHKIFN - Check user calls and set IFN context

;CHKIFN CHECKS TO SEE IF AN IFN IS OPENED.  CALL WITH IFN IN S1.
; THIS ROUTINE IS ALSO RESPONSIBLE, AS A CO-ROUTINE, FOR SETTING
;	UP THE REGISTERS "FB" AND "I", TO GIVE THE FB ADDRESS AND THE IFN
;	RESPECTIVELY.  THESE REGISTERS ARE RESTORED UPON A "POPJ " RETURN.


CHKIFN:	EXCH	FB,0(P)			;SAVE CONTENTS OF FB, GET RETURN PC
	PUSH	P,[EXP RSTIFN]		;PLACE TO RESTORE THE REGS FROM
	PUSH	P,FB			;SAVE RETURN PC
	CAILE	S1,0			;IT MUST BE GREATER THAN 0
	CAILE	S1,SZ.IFN		;AND LESS THAN MAX
	SKIPA				;LOSE!!!
	SKIPN	FB,IFNTAB(S1)		;IS IFN ALLOCATED
	$STOP(IFN,Illegal IFN provided in call)
	$RETT				;TAKE A GOOD RETURN


; HERE TO RESTORE I AND FB TO THEIR PRE-CALL CONTENTS

RSTIFN:	POP	P,FB			;RESTORE FB
	POPJ	P,			;RETURN


ILLMOD:	$STOP(IFM,Illegal file mode in subroutine call)
; Get a word (block type) from the user's argument list
; Call:	PUSHJ	P,GETBLK
;
; TRUE return:	S1:= word, FI.IMM remembered for later
; FALSE return:	end of list
;
GETBLK:	SOSGE	FB$CNT(FB)		;COUNT ARGUMENTS
	  $RETF				;END OF LIST
	SETZM	FB$IMM(FB)		;ASSUME NOT IMMEDIATE VALUE
	MOVE	S1,@FB$PTR(FB)		;GET VALUE
	TXNE	S1,FI.IMM		;IMMEDIATE ARGUMENT?
	SETOM	FB$IMM(FB)		;YES
	AOS	FB$PTR(FB)		;POINT TO NEXT WORD
	$RETT				;RETURN


; Get a value from the user's argument list
; This routine will either return an immediate value or resolve
; an address based on the setting of the FB$IMM(FB) flag. It is expected
; that GETBLK be called first to set or clear FB$IMM(FB).
;
GETVAL:	SOSGE	FB$CNT(FB)		;COUNT ARGUMENTS
	  $RETF				;END OF LIST
	SKIPE	FB$IMM(FB)		;IMMEDIATE VALUE?
	MOVE	S1,@FB$PTR(FB)		;YES
	SKIPN	FB$IMM(FB)		;CHECK AGAIN
	JRST	[MOVE	S1,@FB$PTR(FB)	;GET ADDRESS
		 MOVE	S1,@S1		;GET A VALUE
		 JRST	.+1]		;ONWARD
	AOS	FB$PTR(FB)		;POINT TO NEXT WORD
	$RETT				;AND RETURN
FIL%L:	END