Google
 

Trailing-Edge - PDP-10 Archives - BB-H138B-BM - language-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	Irwin L. Goverman - Larry Samberg/MLB/DC/PW/AWC	12-Sep-79

;
;
;                         COPYRIGHT (c) 1978,1979
;                    DIGITAL EQUIPMENT CORPORATION
;
;     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

	FILEDT==47			;EDIT LEVEL


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

COMMENT \

Edit	  GCO	   Explanation
----    -------	-------------------------------------------------

0001		Create GLXFIL module
0002		Make positioning code much smarter
0003		Add FI.SIZ to the F%INFO routine to get file size
0004		Optimize the Line Sequence Number checking code
0005		Add the F%FCHN routine find first free channel 
0006	G005	On -10 reset the byte count after file-update
		(F%CHKP) else blocks of output get lost.
0007	G003	On -10 if an FD is given to one of the open routines
		with null device field, default it to 'DSK'.
0010	G018	Add F%INFO function 'FI.CHN' which returns I/O channel
		number on the -10 and JFN on the -20.
0011	G028	Make F%CHKP  smarter so that checkpoints will only be
		done if there was any file activity
0012	G030	Fix DMPBUF, F%REL and F%CHKP to not dump out buffer
		if going to checkpoint or close since on the -10 the
		monitor will dump the buffer
0013	G047	Fix DMPBUF to clear the buffer after each output on the
		-20 in DMPB.1
0014	G048	Make F%DREL and F%DEL Expunge file on -20
		Allow Output to NUL: on the -20.
0015	G050	Make F%CHKP on the -20 Update Byte size of File and Count
0016		Fix OPNCOM to do range check on FD length word
		and return ERIFS$ if not valid

0017		Rewrite F%OBUF so that it always uses ILDB/IDPB logic.
		Move the code for QUOTA EXCEEDED to DMPBUF.


0021		Remove PJUMPx macros

0022		Superseded by edit 24

0023		Change SAVE macro to $SAVE.

0024		Significant re-work and cleanup of GLXFIL.

0025		Make IFNs start at 1 rather than 0

0026		Fix a bug in the F%POS routine which caused 'holey'
		files.

0027		Fix a number of bugs and make line-sequence numbered file
		processing faster.

0030

0031		Make checkpoint code work on the -10.
		On -20 clear residue of output buffer.

0032		-10, Don't try to release channel if FILOP. to OPEN
		fails.  Assume that OPEN failing doesn't assign a chan.

0033		-10, During positioning which requires moving to a new buffer,
		after USETIng to EOF, clear EOF so the INs to flush buffers win

xxxx		Get rid of FB$POS, and FB$IBD.  Clean up checkpoint
		state of the world

0034		Fix bug in OPNERR on -10.  Call RELFB to give
		back the IFNTAB slot if the FILOP. OPEN fails

0035		-10, in LDLEB, if PPN is zero, don't make a path block
		even if the FB contains an (assumedly blank) one

0036		CHANGED F%REN SO THAT IF THE SECOND IFN GET FAILS
		THE FIRST ONE IS RELEASED.

0037		Fix the writing of nulls to not write any if on a full
		word boundary at the end.

0040		Fix F%REW & F%POS so that we dont loop forever positioning
		null files.
		Add FDE error from F%REW & F%POS.

41		Fix CHKIFN so that it correctly checks IFNTAB for the
		IFN which is passed.(Fixes Illegal IFN Stopcode for valid IFN's)

42		Change F%DREL so that it lites the Priv bit in the FILOP.
		Also make it exit through INTREL on an error.

43		Fix F%CHKP to return 0 if no inputs have been done 
		against IFN when F%CHKP is called.

44		Fix F%REN to release its IFN if things look bad

45		Fix F%DEL to do F%OOPN instead of IOPN

46		Fix F%DEL to do F%AOPN instead of F%OOPN
		Change F%DREL (TOPS20) to check for write access instead
		of directory access.
47		Fix INTREL code for -20 to do a RLJFN if the CLOSF fails on
		a file that we have a JFN but have not opened
		Also add GETERR routine to get the last error on -20 before
		trying to MAP it

\
	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

	;TEMPORARY ASSIGNMENT TILL GLXFIL CHANGE MADE TO USE THIS GLXFIL

	SYSPRM	SZ.BUF,200,1000		;SIZE OF BUFFER AREA
	SYSPRM	SZ.OBF,200,1000		;MAXIMUM WORDS XFERRED ON F%?BUF CALL


	$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
	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	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,.FOPPN+1		;FILOP. UUO BLOCK
	FB	LEB,.RBTIM+1		;LOOKUP/ENTER UUO BLOCK
	FB	PTH,10			;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
>  ;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:	MOVEI	S1,SZ.IFN		;CLEAR THE IFN
	MOVEI	S2,IFNTAB		;TABLE FOR RE-USE
	PUSHJ	P,.ZCHNK		;ZERO IT OUT.
	$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<
	MOVX	S1,<44B5+OF%RD>		;36 BIT READ FUNCTION
	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<
	MOVX	S1,<^D36B5+OF%WR>	;36 BIT WRITE IS THE FUNCTION
	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,.CKACN		;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<
	MOVX	P1,<^D36B5+OF%WR+OF%RD>	;36 BIT UPDATE MODE IS THE FUNCTION
					; USE UPDATE INSTEAD OF APPEND SO THAT
					; WE CAN MAP FULL PAGES
	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,.CKACN		;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
	$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

TOPS10<
	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
	$RETT				;AND RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20<
	MOVEI	S1,FBM$IN		;GET INPUT FUNCTION
	MOVEM	S1,FB$MOD(FB)		;AND STORE FOR A SHORT TIME
	MOVE	S1,FB$IFN(FB)		;PUT IFN IN S1
	MOVE	S2,FB$WRD(FB)		;GET NUMBER OF WORDS IN FILE
	IMUL	S2,FB$BPW(FB)		;GET NUMBER OF LAST BYTE
	SUBI	S2,1			;AND BACK UP BY ONE
	$CALL	F%POS			;POSITION TO BEFORE LAST BYTE IN FILE
	JUMPF	[$STOP(CPE,Can't position to EOF)]
	MOVE	S1,FB$IFN(FB)		;GET THE IFN
	$CALL	F%IBYT			;GET THE LAST BYTE
	JUMPF	[$STOP(CRL,Can't read last byte of file)]
	MOVEI	S1,FBM$AP		;GET APPEND MODE BACK
	MOVEM	S1,FB$MOD(FB)		;STORE IT
	MOVE	S1,FB$WRD(FB)		;GET NUMBER OF WORDS IN FILE
	IDIVI	S1,SZ.BUF		;DIVIDE BY WORDS/BUFFER
	MOVNS	S2			;-VE WORDS IN LAST BUFFER
	ADDI	S2,SZ.BUF		;WORDS REMAINING IN LAST BUFFER
	IMUL	S2,FB$BPW(FB)		;BYTES REMAINING IN LAST BUFFER
	MOVEM	S2,FB$BIB(FB)		;STORE IT
	MOVE	S1,FB$IFN(FB)		;PUT THE IFN IN S1
	$RETT				;AND RETURN
>  ;END TOPS20 CONDITIONAL
	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:	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
	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
	CAXE	S1,.TYDSK		;IS IT A DISK?
	JRST	[ MOVX	S1,ERFND$	;NO, RETURN A 'FILE NOT ON DISK'
		  PJRST	RETERR ]	;
	MOVEI	S2,FB$RFD+.FDPPN-2(FB)	;LOCATION TO START PATH BLOCK AT
	HRLI	S2,FDXSIZ-.FDEXT+2	;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
	MOVEI	S2,<1000/203>		;GET NUMBER OF BUFFERS
	MOVEM	S2,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
	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,.FOPPN+1		;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
	JUMPL	T1,OPNERR		;IF ERROR OCCURRED, COMPLAIN
	LOAD	S1,FB$FUB+.FOFNC(FB),FO.CHN	;GET THE CHANNEL NUMBER
	MOVEM	S1,FB$CHN(FB)		;AND SAVE IT AWAY
	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
	HRROI	S2,FB$FD+.FDSTG(FB)	;POINT TO THE FILE
	GTJFN				;FIND IT
	  JRST	OPNERR			;LOSE
	MOVEM	S1,FB$JFN(FB)		;SAVE THE JFN
	DVCHR				;LOOK UP THE DEVICE'S CHARACTERISTICS
	LOAD	S1,S2,DV%TYP		;ISOLATE THE TYPE CODE
	CAXN	S1,.DVDSK		;MAKE SURE ITS A DISK
	JRST	OPNC.1			;DISK..O.K..CONTINUE
	CAXE	S1,.DVNUL		;ALSO CHECK FOR NUL:
	JRST	[ MOVX	S1,ERFND$	;LOAD 'DEVICE IS NOT THE DISK'
		  PJRST RETERR ]	;CLEAN UP AND RETURN
OPNC.1:	MOVE	S1,FB$JFN(FB)		;RESTORE JFN
	CAILE	T4,FOB.CD		;IS THIS FOR SOMEONE?
	SKIPN	T2,FOB.CD(T3)		;IF NOT THERE OR ZERO,
	JRST	OPNC.2			;SKIP THE ACCESS CHECK
	MOVEM	T2,FB$CHK+.CKACD(FB)	;STORE THE CONNECTED 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
	  $STOP(FOF,File operation failed unexpectedly)
	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?
	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
	MOVEI	S1,^D36			;GET A FULL WORD BYTE
	LOAD	S2,FB$FDB+.FBBYV(FB),FB%BSZ ;GET THE SIZE FILE WAS WRITTEN IN
	IDIV	S1,S2			;GET BYTES PER WORD
	MOVE	S2,FB$FDB+.FBSIZ(FB)	;GET HIGHEST BYTE ADDR IN FILE
	IDIV	S2,S1			;GET BYTES IN FILE
	SKIPE	T1			;ANY RESIDUE?
	ADDI	S2,1			;YES, ADD ONE TO WORD COUNT
	MOVEM	S2,FB$WRD(FB)		;STORE WORDS IN FILE
	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,.RBTIM		;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
	LOAD	S2,.FDEXT(S1)		;GET THE EXTENSION
	MOVEM	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
	$RETT				;THEN RETURN

> ;END OF TOPS10 CONDITIONAL
	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$RFD+.FDPPN-2(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+1		;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	FB$RFD+.FDPAT(S1)	;IS THIS PART OF PATH SPECIFIED?
	INCR	FB$RFD+.FDLEN(FB),FD.LEN;YES, INCREMENT LENGTH OF FD
	AOBJN	S1,SETF.1		;REPEAT FOR ALL PARTS
	$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/ 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
	MOVEI	P1,^D36			;ALWAYS USE 36. BIT BYTE SIZE
	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
TOPS20<
	PUSHJ	P,INTREL		;RELEASE THE IFN
>;END TOPS20
TOPS10<
	PUSHJ	P,RELFB			;GIVE BACK THE IFN
>;END TOPS10
	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
	$RETE(FDE)			;NO, RETURN DATA ERROR
>  ;END TOPS10

TOPS20<
	$CALL	.SAVET			;SAVE T1 THRU T4
	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	MOVE	S2,FB$BUF(FB)		;GET BUFFER ADDRESS
	HRLI	S2,(POINT ^D36,0)	;MAKE A BYTE POINTER
	MOVEM	S2,FB$BRH+.BFPTR(FB)	;SAVE THE BYTE POINTER
	MOVNI	T1,SZ.BUF		;NUMBER OF WORDS TO READ
	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:	ADDI	T1,SZ.BUF		;ADD NUMBER OF WORDS REQUESTED
	MOVEM	T1,FB$BRH+.BFCNT(FB)	;STORE NUMBER OF WORDS READ
	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 to a
;	particular byte within the file.
;
;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
	SKIPN	T1,FB$WRD(FB)		;GET WORDS IN FILE
	JRST	[PUSHJ P,POSEOF		;NULL FILE,,POSITION TO EOF
		 $RETT  ]		;AND RETURN
	IMUL	T1,FB$BPW(FB)		;CONVERT TO BYTES
	CAMLE	S2,T1			;POSITIONING WITHIN FILE?
	$RETE(IFP)			;NO, LOSE

	MOVE	T1,FB$BPW(FB)		;GET BYTES PER WORD
	IMULI	T1,SZ.BUF		;GET BYTES PER BUFFER
	MOVE	T2,S2			;COPY THE BYTE NUMBER OVER
	IDIV	T2,T1			;T2=BUFFER NUMBER
					;T3=BYTE WITHIN BUFFER
	SKIPN	FB$EOF(FB)		;ARE WE AT EOF?
	CAME	T2,FB$BFN(FB)		;YES, IS BYTE IN CURRENT BUFFER?
	JRST	POS.4			;WE HAVE TO DO SOME WORK
	PUSHJ	P,SETBFD		;SETUP POINTERS FOR THIS BUFFER

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	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

POS.3:	SOJL	T4,.RETT		;MORE ODD BYTES?
	IBP	FB$BBP(FB)		;YES, BUMP THE POINTER
	JRST	POS.3			;AND LOOP

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

POS.4:
	SETOM	FB$BIB(FB)		;FORCE A READ
	MOVEM	T2,FB$BFN(FB)		;SAVE FOR POSBUF
	SOS	FB$BFN(FB)		;BUT DECREMENT FOR LATER INCREMENT


TOPS10<
	HRL	S1,FB$CHN(FB)		;GET CHANNEL NUMBER
	HRRI	S1,.FOUSI		;USETI CODE
	SETO	S2,			;POSITION TO EOF
	MOVE	T1,[2,,S1]		;FILOP ARG POINTER
	FILOP.	T1,			;POSITION TO EOF
	  JFCL				;IGNORE THE ERROR (ALWAYS HAPPENS)
	MOVE	S2,T1			;COPY STATUS BITS
	TXZ	S2,IO.EOF		;CLEAR EOF
	HRRI	S1,.FOSET		;DO A SETST ON THE SAME CHANNEL
	MOVE	T1,[2,,S1]		;AIM AT ARG LIST
	FILOP.	T1,			;CLEAR EOF, SO INPUT WINS
	 $RETE	(FDE)			;CAN'T CLEAR EOF, TELL USER
;NOW, LOOP AROUND DOING INPUTS UNTIL THE MONITOR HAS TO READ US A NEW BUFFER
POS.5:	HRRI	S1,.FOINP		;INPUT FUNCTION ON SAME CHANNEL
	MOVE	S2,[1,,S1]		;FILOP ARG POINTER
	FILOP.	S2,			;START FLUSHING UNTIL EOF
	  SKIPA				;EOF FINALLY?
	JRST	POS.5			;NO, LOOP
	TXZN	S2,IO.EOF		;END OF FILE?
	 $RETE	(FDE)			;NO, FILE DATA ERROR
	HRRI	S1,.FOSET		;SETSTS FUNCTION FOR THIS CHANNEL
	MOVE	T1,[2,,S1]		;SETUP FOR FILOP.
	FILOP.	T1,			;RESET THE I/O STATUS
	 $RETE	(FDE)			;CAN'T CLEAR EOF, NEXT IN WOULD LOSE
	MOVEI	S2,1(T2)		;NOW, GET BLOCK TO POSITION TO
					;(ADD 1 TO CONVERT FROM OUR 0 BASE
					; CONVENTION TO USETI 1 BASE)

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	HRRI	S1,.FOUSI		;USETI FUNCTION ON THIS CHANNEL
	MOVE	T1,[2,,S1]		;ARG POINTER
	FILOP.	T1,			;SET THE BLOCK NUMBER
	 $RETE	(FDE)			;CAN'T, TELL USER
>  ;END TOPS10 

TOPS20<
	MOVE	S2,T2			;GET BUFFER NUMBER
	IMULI	S2,SZ.BUF		;CONVERT TO WORD NUMBER
	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	SFPTR				;SET FILE POINTER
	  PUSHJ	P,S..FOF		;LOSE BIG!!!
>  ;END TOPS20
	PUSHJ	P,GETBUF		;READ THAT NEXT BUFFER
	SKIPT				;GETBUF WINS !!!
	CAXE	S1,ERFDE$		;NOPE,,IS IT FILE DATA ERROR ???
	SKIPA				;NO,,MAY BE OK
	$RET				;YES,,RETURN FILE DATA ERROR
	SETZM	FB$EOF(FB)		;CLEAR EOF FLAG
	MOVE	S2,T4			;RESET DESIRED  POSITION
	JRST	POS.2			;GO BACK AND POSITION IN THIS BUFFER


POSEOF:	SETOM	FB$BIB(FB)		;MAKE SURE WE ALWAYS GET HERE
	SETOM	FB$EOF(FB)		;DITTO
	$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
	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 CHENNEL NUMBER
	HRRI	S1,.FOOUT		;GET OUTPUT FUNCTION
	MOVE	S2,[1,,S1]		;SETUP ARG POINTER
	FILOP.	S2,			;OUTPUT A BLOCK
	  $RETE(FDE)			;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$BUF(FB)		;GET ADDRESS OF BUFFER
	HRLI	S1,(POINT ^D36,0)	;MAKE A BYTE POINTER
	MOVEM	S1,FB$BRH+.BFPTR(FB)	;SAVE BUFFER BYTE POINTER
	MOVEI	S1,SZ.BUF		;LOAD BUFFER SIZE
	MOVEM	S1,FB$BRH+.BFCNT(FB)	;AND STORE IT
>  ;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,NXTBYT		;GET NEXT BYTE NUMBER
	MOVE	P1,S1			;SAVE IT
	PUSHJ	P,CHKOS			;CHECKPOINT THE OUTPUT
	JUMPF	.RETF			;FAILED?
	MOVE	S1,P1			;GET THE BYTE NUMBER BACK
	$RETT				;AND RETURN

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
	IMUL	S2,FB$BPW(FB)		;CONVERT TO BYTES
	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.
	  $RETE(FDE)			;FILE DATA ERROR?
	HRRZ	S1,FB$BRH+.BFADR(FB)	;GET IN THE NEW BUFFER ADDRESS
	ADD	P1,S1			;ADD IT IN
	MOVEM	P1,FB$BBP(FB)		;AND STORE IT AWAY
	$RETT				;AND 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
	PUSHJ	P,WRTBUF		;WRITE THE BUFFER
	JUMPF	GETERR			;FILE DATA ERROR?
	HRLZ	S1,FB$JFN(FB)		;GET THE JFN
	MOVE	S2,FB$BFN(FB)		;GET THE BUFFER NUMBER
	ADDI	S2,1			;GET EVERYTHING TILL THIS ONE
	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
	MOVEI	S2,44			;GET THE BYTE SIZE
	STORE	S2,T1,FB%BSZ		;STORE IN T1
	MOVX	S2,FB%BSZ		;PUT MASK IN S2
	CHFDB				;CHANGE THE FILE LENGTH
	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	S1,FB$JFN(FB)		;GET THE JFN
	MOVE	S2,FB$BFN(FB)		;GET THE BUFFER NUMBER
	IMULI	S2,SZ.BUF		;GET WORD COUNT
	JUMPL	S2,.RETT		;RETURN IF THIS IS THE DUMMY OUTPUT
	SFPTR				;ELSE, SET FILE POINTER
	ERJMP	[$STOP (CSF,Couldn't set file pointer)]
	SKIPN	FB$BIB(FB)		;AT END OF BUFFER
	JRST	WRTB.2			;YES..NO PADDING NEEDED
	MOVE	S1,FB$BBP(FB)		;GET THE BUFFER BYTE POINTER
	SETZ	S2,			;LOAD A NULL
	LOAD	T1,S1,BP.POS		;GET THE POSITION FIELD
	LOAD	T2,S1,BP.SIZ		;GET THE SIZE FIELD
WRTB.1:	CAMGE	T1,T2			;IS POS .LT. SIZE
	JRST	WRTB.2			;YES, WORD IS FULL
	IDPB	S2,S1			;NO, DEPOSIT A NULL
	SUB	T1,T2			;POS GETS POS-SIZE
	JRST	WRTB.1			;AND LOOP

WRTB.2:	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	MOVE	S2,FB$BUF(FB)		;GET ADDRESS OF BUFFER
	HRLI	S2,(POINT ^D36,0)	;MAKE A BYTE POINTER
	SKIPGE	T1,FB$BIB(FB)		;GET NUMBER OF BYTES LEFT IN THE BUFFER
	SETZB	T1,FB$BIB(FB)		;-1 IS ACTUALLY 0
	IDIV	T1,FB$BPW(FB)		;GET NUMBER OF FULL WORDS LEFT
	SUBI	T1,SZ.BUF		;GET NEGATIVE NUMBER OF WORDS TO XFER
	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
	MOVE	S2,FB$BYT(FB)		;GET BYTESIZE
	DPB	S2,[POINT 6,S1,11]	;MAKE THE CORRECT BYTE POINTER
	MOVEM	S1,FB$BBP(FB)		;STORE THE BUFFER BYTE POINTER
	MOVE	S1,FB$BRH+.BFCNT(FB)	;GET WORD COUNT AGAIN
	IMUL	S1,FB$BPW(FB)		;CONVERT TO BYTES
	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/	ADDRESS OF FRB (FILE RENAME BLOCK)
;
;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
	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,.IOIMG		;IMAGE MODE FOR IO
	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:	MOVE	T2,.FDSTR(S1)		;GET SOURCE STRUCTURE
	MOVE	S2,FRB.DF(T1)		;GET FD FOR DESTINATION
	CAME	T2,.FDSTR(S2)		;ARE THEY THE SAME STRUCTURE?
	JRST	REN.22			;NO, GET RID OF THE IFN, TELL CALLER
	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
	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


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

	HRLZ	S1,T4			;GET CHANNEL NR. TO USE
	IOR	S1,[FO.PRV+.FORNM]	;PRIVELEGES+ RENAME FUNCTION
	MOVEM	S1,FB$FUB+.FOFNC(T3)	;STORE INTO FUNCTION WORD
	HRLI	S1,.FOPPN+1		;SET LENGTH OF BLOCK
	HRRI	S1,FB$FUB(T3)		;AND ITS ADDRESS
	FILOP.	S1,			;DO THE RENAME
	  JRST	REN.3			;FAILED...
REN.2:	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

REN.22:	MOVE	S1,FB$IFN(T3)		;GET THE FIRST IFN
	$CALL	F%REL			;GIVE IT BACK
	$RETE(FDS)			;AND COMPLAIN
> ;END OF TOPS10 CONDITIONAL
TOPS20<
F%REN:	PUSHJ	P,.SAVET		;GET SOME WORK SPACE
	CAIG	S1,FRB.DF		;REQUIRE AT LEAST SOURCE AND DEST.
	$STOP(RTS,Rename block too small)
	MOVE	T4,FRB.DF(S2)		;REMEMBER THE DESTINATION
	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
	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(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
	  PUSHJ	P,S..FOF		;STOP "FILE OPERATION FAILED..."
	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.4			;RETURN ERROR
	MOVE	S1,FB$JFN(T4)		;GET DESTINATION JFN
	RLJFN				;AND RELEASE IT NOW
	  ERJMP	REN.4			;IF IT FAILS, COMPLAIN
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
> ;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
	$CALL	.SAVE1			;SAVE P1
	HRL	S1,FB$CHN(FB)		;GET CHANNEL NUMBER
	HRRI	S1,.FOCLS		;GET CLOSE FUNCTION
	MOVX	S2,CL.RST		;GET CLOSE BITS
	MOVE	P1,[2,,S1]		;GET FILOP. ARG POINTER
	FILOP.	P1,			;AND RESET THE CHANNEL
	  JFCL				;IGNORE ERROR ON RESET
	JRST	INTREL			;AND RELEASE THE CHANNEL

F%REL:	PUSHJ	P,CHKIFN		;CHECK THE IFN
	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
	  $RETE(FDE)			;LOSE
	JRST	RELFB			;GET RID OF MEMORY AND RETURN
>  ;END TOPS10


TOPS20<
F%REL:	PUSHJ	P,CHKIFN		;VALIDATE THE IFN ETC.
INTREL:	MOVE	S1,FB$IFN(FB)		;PUT THE IFN IN S1
	$CALL	F%CHKP			;AND CHECKPOINT THE FILE
	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	CLOSF				;GET RID OF IT
	   JRST	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
	   JRST	.+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	.+1			;IGNORE THE ERROR
	JRST	RELFB			;AND 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,.FOPPN+1		;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(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
	  PUSHJ	P,S..FOF		;ALL LEGAL ERRORS ALREADY SCREENED
	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,<MOVE S1,FINF+.RBTIM(FB)>,<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>
  XX.SIZ==<  PUSHJ P,[EXP <MOVE S1,FB$WRD(FB)>,<IMUL S1,FB$BPW(FB)>,<POPJ P,>]>
  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
	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
	$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%,	ERIFS$
	XWD	ERPRT%,	ERPRT$
	XWD	ERFBM%,	ERPRT$
	XWD	ERAEF%,	ERFAE$
	XWD	ERDNA%,	ERDNA$
	XWD	ERNSD%,	ERNSD$
	XWD	ERNRM%,	ERQEF$
	XWD	ERWLK%,	ERPRT$
	XWD	ERNET%,	ERSLE$
	XWD	ERSNF%,	ERFNF$
	XWD	ERLVL%,	ERFNF$

	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	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)
FIL%L:	END
	$RETE(USE)			;IF EXHAUSTED, RETURN 'UNEXPECTED ERROR'

MAPE.2:	HRRZ	S1,ERRTAB(S2)		;PICK UP THE SYSTEMIZED ERROR CODE
	MOVEM	S1,.LGERR##		;SAVE THE ERROR CODE 
	MOVEI	S2,.			;ALSO OUR CURRENT LOCATION
	MOVEM	S2,.LGEPC##		;FOR LATER EXAMINATION
	$RETF				;THEN TAKE A FAILURE RETURN




TOPS20 <
ERR20:	MOVX	S1,.FHSLF		;GET OUR HANDLE
	GETER				;GET THE ERROR WHICH DID US IN