Google
 

Trailing-Edge - PDP-10 Archives - bb-l014z-bm_tops20_v7_0_tsu03_1_of_3 - galsrc/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, 1988.
;	ALL RIGHTS RESERVED.
;
;	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 THAT IS NOT SUPPLIED BY DIGITAL.

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

	FILMAN==:142			;Maintenance edit number
	FILDEV==:141			;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. Revision History . . . . . . . . . . . . . . . . . . .   3
;    2. Global Routines  . . . . . . . . . . . . . . . . . . .   4
;    3. Local AC definitions . . . . . . . . . . . . . . . . .   5
;    4. FB - File Block Definitions  . . . . . . . . . . . . .   6
;    5. F%INIT - Initialize the world  . . . . . . . . . . . .   8
;    6. F%IOPN - Open an input file  . . . . . . . . . . . . .   9
;    7. F%OOPN - Open an output file . . . . . . . . . . . . .  10
;    8. F%AOPN - Open an output file in append mode  . . . . .  11
;    9. OPNCOM - Common file open routine  . . . . . . . . . .  13
;   10. LDLEB - Load a LOOKUP/ENTER block from an FD . . . . .  16
;   11. File attribute processing - Main loop and dispatch tab  17
;   12. SETFD - Set up a real description of opened file . . .  19
;   13. SETFOB - Build an internal FOB . . . . . . . . . . . .  20
;   14. OPNERR - Handle a system error from F%IOPN . . . . . .  21
;   15. F%IBYT - Read one byte from file . . . . . . . . . . .  22
;   16. F%IBUF - Read a buffer of data from file . . . . . . .  23
;   17. GETBUF - Read one input buffer from the operating syst  24
;   18. F%POS - Position an input file . . . . . . . . . . . .  25
;   19. F%OBYT - Write one byte into file  . . . . . . . . . .  26
;   20. F%OBUF - Write a buffer full of data to a file . . . .  27
;   21. PUTBUF - Give one output buffer to the operating syste  29
;   22. F%CHKP - Checkpoint a file . . . . . . . . . . . . . .  30
;   23. WRTBUF - TOPS20 Subroutine to SOUT the current buffer   32
;   24. F%REN - Rename a file  . . . . . . . . . . . . . . . .  33
;   25. F%REL - Release a file . . . . . . . . . . . . . . . .  36
;   26. F%DREL - Delete a file and release it  . . . . . . . .  37
;   27. F%DEL - Delete an unopened file  . . . . . . . . . . .  38
;   28. F%INFO - Return system information about a file  . . .  39
;   29. F%FD - Return a pointer to the FD on an opened IFN . .  40
;   30. ALCIFN - Allocate an Internal File Number  . . . . . .  41
;   31. GETERR - Get Last -20 error to MAP it  . . . . . . . .  42
;   32. MAPERR - Map an operating system error . . . . . . . .  43
;   33. MAPIOE - Map an I/O error  . . . . . . . . . . . . . .  45
;   34. CHKIFN - Check user calls and set IFN context  . . . .  46
	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.

107	4.2.1620	Aug-13-85
	In F%OOPN, allow a file to supersede an existing file

*****  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.

125	Increment maintenance edit level for version 5 of GALAXY.

126	5.1229		30-Dec-85
	In routine F%IOPN, set OF%PLN if LSNs are not suppressed.

127	5.1235		Apr-15-86
	Add ERJMP after OPENF in routine OPNC.2

130	5.1240		Jun-16-86
	In routine F%POS (POS.2), check to see if the caller wants to include
LSN in its calculation to position a byte within a file and set the according
bit (SF%LSN) to the SFPTR JSYS. (only for version 5 of GALAXY)
	******This edit requires MONITOR edit 7321 and MONSYM 7322. *******

*****  Release 6.0 -- begin development edits  *****

140	6.1005		5-Oct-87
	If F%REL encounters an error while closing a file, cause it to return
an error. If the error is due to "file still mapped", then have it return 
error GALAXY error ERFSM$; otherwise, have it return GALAXY error ERUSE$.

141	6.1225		8-Mar-88
	Update copyright notice.

*****  Release 6.0 -- begin maintenance edits  *****

142	6.1266		10-Jul-88
	Add support for TTY: 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

;**;[142]At BRH,3:+7L add 3 lines   JCR 7/10/88
	FB	TYP,1			;[142]FILE TYPE
	  .FBNTY==0			;[142]NON-TTY
	  .FBTTY==1			;[142]TTY
>  ;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
;**;[126]At F%IOPN:+1L add one line 	JYCW	12/30/85
	PUSH	P,S2			;[126]Save FOB address
	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
;**;[126]At F%IOPN:+8L (within TOPS-20 conditional) add 3 lines JYCW 12/30/85
	LOAD	S2,FOB.CW(S2),FB.LSN	;[126]See if user wants to supress lsns
	SKIPN	S2			;[126]If not
	IORX	S1,OF%PLN		;[126] set disable LSN checking
	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
;**;[126]At F%IOPN:+17L add 1 line JYCW 12/30/85
	POP	P,S2			;[126]Restore FOB address
	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
;**;[107]At F%OOPN:10L insert four lines  JCR  8/13/85
	LOAD	S1,FOB.CW(S2),FB.SUP	;[107]Get the supersede bit
	TDZE	S1,S1			;[107]Is it on?
	MOVX	S1,GJ%FOU!GJ%NEW	;[107]Yes, get the bits to turn off
	ANDCAM	S1,O$GJFN		;[107]And turn them off
	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
;**;[127]At OPNC.2:+3L change 1 line  JYCW  4/15/86
	  ERJMP	OPNERR			;[127]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
;**;[142]At OPNC.2:+9L replace 2 lines with 6 lines  JCR  7/10/88
	CAIN	S1,.DVTTY		;[142]IS IT A TTY?
	JRST	OPNC.A			;[142]YES, INDICATE SO IN THE FB
	MOVX	S1,ERFND$		;[142]LOAD 'DEVICE IS NOT THE DISK'
	PJRST	RETERR			;[142]CLEAN UP AND RETURN THE ERROR

OPNC.A:	MOVEI	S1,.FBTTY		;[142]PICK UP THE TTY DEVICE CODE
	MOVEM	S1,FB$TYP(FB)		;[142]PLACE IN THE FB
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
;**;[130]At IBYT.1:+2L Delete two lines JYCW 6/16/86
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

;**;[130]At IBYT.4+0L delete 17 lines (routine IBYT.4)  JYCW  6/16/86
	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$  ERFND$	;[142]

F%REW:	SETZ	S2,			;POSITION TO BYTE 0 FOR REWIND
F%POS:	PUSHJ	P,CHKIFN		;CHECK THE IFN GIVEN
;**;[142]At F%POS:+1L add 3 lines  JCR 7/10/88
	SKIPE	FB$TYP(FB)		;[142]A TTY: FILE?
	JRST	[ MOVEI S1,ERFND$	  ;[142]YES, PICK UP THE ERROR CODE
		  $RETF ]		  ;[142]INDICATE AN ERROR OCCURRED
	$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
;**;[130]At POS.2+12L Add two lines  JYCW  6/16/86
	SKIPE	FB$LSN(FB)		;[130]Want to trim line numbers?
	TXO	S1,SF%LSN		;[130]Yes, set bit to include LSN
	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
;**;[142]At CHKOS:+11L add 2 lines  JCR 7/10/88
	SKIPE	FB$TYP(FB)		;[142]A TTY?
	$RETT				;[142]YES, RETURN NOW
	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:	PUSH	P,S1			;[6000]SAVE THE ERROR CODE
	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	RLJFN				;RELEASE THE JFN
	   ERJMP .+1			;IGNORE THE ERROR
	$CALL	RELFB			;[6000]AND DELETE THE FB
	POP	P,S1			;[6000]RESTORE THE ERROR CODE
	PJRST	MAPERR			;[6000]RETURN ERROR AS GALAXY ERROR
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.
;**;[142]At FSIZE:+0L add 3 lines  JCR 7/10/88
FSIZE:	SKIPE	FB$TYP(FB)		;[142]A TTY: file?
	JRST	[ SETZ 1,		  ;[142]Yes, give it a size of 0
		  $RET ]		  ;[142]And return
	$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	CLSX3,  ERFSM$			;[6000]FILE STILL MAPPED
	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