Google
 

Trailing-Edge - PDP-10 Archives - BB-BT99S-BB_1990 - 10,7/galaxy/glxlib/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/LWS/CTK 10-May-84

;
;
;        COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982,
;			 1983,1984,1985,1986,1987,1990
;                    DIGITAL EQUIPMENT CORPORATION
;			 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  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.

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

	FILEDT==122			;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.

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

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

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

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

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

0046		Fix F%DEL to do F%AOPN instead of F%OOPN
		Change F%DREL (TOPS20) to check for write access instead
		of directory access.
0047		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

0050		Change SETFD to correctly remember the actual path found
		in lookup enter block to cure problems caused when F%DRREL
		was called for a file that lived in an SFD

0051		Change OPNC.2 (TOPS10) so that if the FILOP. fails, we save the
		extended channel number away before going off to OPNERR.
		Change OPNERR to delete the TOPS10/TOPS20 conditionals and
		always call INTREL to release either the channel or JFN.
		Change INTREL (TOPS10) so that if an error occurs, we release
		the file data base (Call RELFB)
0052		Removed phantom reference to T4 in F%REN and changed
		RELFB to watch for -1 in FB$CHN which indicates the
		file was never opened.
0053		Moved REN.2 label up 2 instructions so that if the rename fails,
		the channel is closed (if it was open'd)
0054		SPR 20-14563 F%POS loops if positioning to last byte of last
		page of a file. If doing so, return EOF.
0055		Zero out entire $DATA space instead of only IFN table.
0056		Allow output to spooled devices, they're really disks.
0057		Repair edit 54 to allow rewinds for short files again.
0060		If the CHKAC fails on TOPS20, return 'protection failure'
		instead of stopcoding.
0061		Fix F%REL to check FB$CHN(FB). Right now we are only checking
		FB$CHN.
0062		Delete CSF stopcode in WRTBUF and just .RETF (SPR 20-14724)
0063		Expand file and I/O error codes and messages for TOPS-10.
0064		Fix stevens QAR. Add DEVSIZ to get disk buffer length.
0065		Change F%INFO to return the correct creation time by adding
		routine FTINFO
0066	3/7/81	End TOPS-10 conditional at the end of routine FTINFO
0067		Fix for SPR 20-14773 & 20-14728 F%AOPN & WRTBUF
0070	3/30/81	Fix QAR-05695; F%CHKP lost data
0071	4/3/81	Add part of missing HOSS edit (SPR #20-14262) to allow
		in-your-behalf renames and deletes work correctly.
0072		Map a couple more LOOKUP/ENTER/RENAME error codes.
0073		Add support for FB.PHY to allow physical-only OPENs.
0074	5/4/81	Add FRB.FL flag word to F%REN arg block
0075		Add a field in the FOBs for protection codes. Add support
		for physical-only on RENAMEs.
0076		Add a file attribute block. Remove protection crock created
		by edit 75 since protections will be handled in the attribute
		block.
0077		Use .FOMAX instead of .FOPPN+1. Increase the size of the
		L/E/R block to .RBMAX words to accomodate account strings.
		Don't use .PTMAX+1 as the length of path block. .PTMAX
		insures a zero word at the end of the block.
0100		Lots of little things. Under TOPS-10 conditionals, add a
		missing POPJ P,. Under TOPS-20 conditionals, clean up access
		checking/connected directory stuff and CHGFDB code. Don't
		checkpoint a file at INTREL, we might not have a valid IFN
		JFN.
0101		Remove file attribute block definitions. They exist in GLXMAC.

0102	1427	Remove bogus defs of SZ.BUF and SZ.OBF


;**;Begin Galaxy 4.1 code maintenance

0103		Fix illegal memory reference problem when using
		F%xOPN routines.
		SPR 10-33434,10-34187	25-SEP-83/CTK

104		Make F%IBYT handle page marks in LSN file correctly.
		7-Nov-83 /LWS

105		In OPNCOM the FILOP. uuo returns a 0 in the path
		block when the structure is NUL. This caused the SETFD
		routine to create FD blocks with 0 as the structure
		name. The final result was BATCON passing QUASAR
		bad information, leading to QUASAR CRL then RRF
		stopcodes.
		1-Mar-84/CTK	SPR 10-34431

106		The F%REN routine always resets the file IO
		mode to zero/ASCII mode. This causes problems
		for /DISP:RENAME on plotter files because the
		file IO mode is used by SPROUT to control
		the plotter.
		15-Mar-84/CTK	SPR 10-34531

107		Add code and revamp the F%REN routine so we
		do the FILOP RENAME correctly. Edit 106
		introduced a DATE-75 bug.
		17-Apr-84	SPR 10-34531

110		Fix problem with F%REN found by the VEREDT tool.
		We could not rename from an SFD to an SFD and
		release channels after use.
		10-May-84/CTK	SPR 10-34690

111		Pick up the pieces from edit 110, the channel
		release code was dropped on the floor.
		19-Oct-84/CTK	GCO 10199

112	10144	Add support for setting the new RDH fields in the
		exteneded LOOKUP/ENTER block.
		 5-Feb-85/DPM

113	10201	Finish GCO 10144. Return RDH fields via F%INFO.
		26-Apr-85 /NT

114	?	Fix GCOs 10144 & 10201.  Do the right things with arg blocks.
		29-Aug-85 /RCB

116	10462	Change $STOP to STOPCD.
		14-Nov-86 /BAH

117	10494	Fix F%DREL so that it will use a real RENAME block instead
		of a single (maybe) zeroed AC when deleting files.
		17-Feb-87 /JJF

120	10651	Relax restriction where device must be spooled or a disk.
		TTYs and MTAs are most common devices (others haven't
		been tested). If device is a TTY and byte-size is 7 or 8,
		I/O mode is .IOASC or .IOAS8 respectively, not .IOIMG.

121	10674	Add missing file attributes, and the ability to set them
		from the IFN of another file.

122	10677	Fix SETFD to always return the correct FD length.  Use
		FILOP. UUO returned filespec block to return accurate
		filespec parts.

\ ; 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	IFF,1			;ATTRIBUTE FROM IFN ARGUMENT FLAG
	FB	ATT,1			;ATTRIBUTE TYPE
	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	FIL,.FOFMX		;RETURNED FILESPEC 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
>  ;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	TYP,1			;DEVICE TYPE
	FB	FLG,1			;FLAG WORD
	  FB.BNW==1B35			;MODE USES BYTES THAT ARE NOT WORD SIZE

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

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

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


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

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

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


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

TOPS10<
	MOVX	S1,<FO.PRV+.FORED>	;READ FUNCTION TO FILOP.
	MOVEM	S1,O$FUNC		;STORE AS FUNCTION
> ;END OF TOPS10 CONDITIONAL
TOPS20<
	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	[STOPCD	(CPE,HALT,,<Can't position to EOF>)]
	MOVE	S1,FB$IFN(FB)		;GET THE IFN
	$CALL	F%IBYT			;GET THE LAST BYTE
	JUMPF	[STOPCD	(CRL,HALT,,<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
	SKIPN	S2			;[67] IS BUFFER ACTUALLY FULL ???
	MOVX	S2,SZ.BUF		;[67] YES,,INDICATE SO
	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
	STOPCD	(OTS,HALT,,<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
	STOPCD	(IBS,HALT,,<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<	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
	TXNE	S2,TY.SPL		;SPOOLED DEVICE?
	MOVX	S1,.TYDSK		;YES, TREAT AS DISK
	MOVEM	S1,FB$TYP(FB)		;SAVE DEVICE TYPE
	CAXE	S1,.TYTTY		;TTY?
	JRST	OPNC.Y			;NOT A TTY
	CAIL	T3,^D7			;TTY
	CAILE	T3,^D8			;7 OR 8 BIT BYTES?
	JRST	OPNC.Y			;NO
	SETO	S1,			;SET "BYTE NOT WORD" BIT
	STORE	S1,FB$FLG(FB),FB.BNW
	SUBI	T3,7			;YES, GET MODE
	SKIPA	S2,[EXP .IOASC		;ASCII
		    EXP .IOAS8](T3)	;8-BIT ASCII
OPNC.Y:	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
	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:	MOVEI	S1,FB$FIL(FB)		;POINT TO RETURNED FILESPEC BLOCK
	HRLI	S1,.FOFMX		;GET ITS LENGTH
	MOVEM	S1,FB$FUB+.FOFSP(FB)	;SAVE FOR MONITOR

;**;[105]ADD 2 LINES AT OPNC.2:+0L	1-MAR-84/CTK
	MOVE	S1,FB$FUB+.FODEV(FB)	;[105]GET DEVICE, SETUP FILOP. 0 RETURN
	MOVEM	S1,FB$PTH+.PTFCN(FB)	;[105]STORE STRUCTURE NAME
	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
	HRROI	S2,FB$FD+.FDSTG(FB)	;POINT TO THE FILE
	GTJFN				;FIND IT
	  JRST	OPNERR			;LOSE
	MOVEM	S1,FB$JFN(FB)		;SAVE THE JFN
	SETZ	T2,			;ASSUME NO CONNECTED DIRECTORY
	CAILE	T4,FOB.CD		;IS THIS FOR SOMEONE?
	MOVE	T2,FOB.CD(T3)		;GET CD IF IT'S THERE
	MOVEM	T2,FB$CHK+.CKACD(FB)	;STORE THE CONNECTED DIRECTORY
	JUMPE	T2,OPNC.2		;SKIP ACCESS CHECK IF NO DIRECTORY
	MOVE	T2,O$PROT		;GET PROTECTION TO CHECK FOR
	MOVEM	T2,FB$CHK+.CKAAC(FB)	;AND PUT WHERE IT WILL GET CHECKED
	LOAD	T2,FOB.US(T3)		;GET USER ID
	MOVEM	T2,FB$CHK+.CKALD(FB)	;STORE IT
	MOVEM	S1,FB$CHK+.CKAUD(FB)	;STORE JFN TO CHECK AGAINST
	MOVEI	S2,FB$CHK(FB)		;ADDRESS OF BLOCK
	MOVX	S1,CK%JFN+.CKAUD+1	;LENGTH + CHECKING JFN
	CHKAC				;CHECK IT
	 SETZM	S1			;RETURN PROTECTION FAILURE
	JUMPE	S1,[ MOVX  S1,ERPRT$	;GET A PROTECTION FAILURE
		     PJRST  RETERR ]	;AND GO FROM THERE
OPNC.2:	MOVE	S1,FB$JFN(FB)		;RESTORE JFN
	MOVE	S2,O$FUNC		;GET FILE OPEN FUNCTION
	OPENF				;OPEN THE FILE
	  JRST	OPNERR			;LOSE?
	DVCHR				;LOOK UP THE DEVICE'S CHARACTERISTICS
	LOAD	S1,S2,DV%TYP		;ISOLATE THE TYPE CODE
	CAXE	S1,.DVNUL		;IF IT THE NULL DEVICE ???
	CAXN	S1,.DVDSK		;OR A DISK ???
	JRST	OPNC.1			;YES TO EITHER,,CONTINUE
	MOVX	S1,ERFND$		;LOAD 'DEVICE IS NOT THE DISK'
	PJRST	RETERR			;CLEAN UP AND RETURN THE ERROR

OPNC.1:	SKIPE	FB$PTR(FB)		;ATTRIBUTE BLOCK EXIST?
	PUSHJ	P,ATTRIB		;LOAD FILE ATTRIBUTES
	MOVE	S1,FB$JFN(FB)		;Get JFN back
	MOVX	S2,<.FBLEN,,.FBHDR>	;GET FILE DESCRIPTOR BLOCK
	MOVEI	T1,FB$FDB(FB)		;AND STORE INTO OUR FB
	GTFDB				;
	  ERJMP	.+1			;IGNORE ERRORS FOR NOW
	PUSHJ	P,SETFD			;SET UP THE ACTUAL FILE DESCRIPTION
	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,.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
	LOAD	S2,.FDEXT(S1)		;GET THE EXTENSION
;**;[107]CHANGE 1 LINE AT LDLEB:+6L	10-APR-84/CTK
	HLLM	S2,FB$LEB+.RBEXT(FB)	;[107]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
	$SAVE	<FB,P4>			;NEED TO MANGLE FILE BLOCKS
	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	S2,.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:	IFIW	ATRPRO		;(01) PROTECTION CODE
	IFIW	ATRACT		;(02) ACCOUNT STRING
	IFIW	ATRSPL		;(03) SPOOLED FILE NAME
	IFIW	ATRCRY		;(04) ENCRYPTION CODE
	IFIW	ATRDTY		;(05) DATA TYPE
	IFIW	ATRDTO		;(06) DATA "OTS" TYPE
	IFIW	ATRDCC		;(07) DATA CARRIAGE CONTROL
	IFIW	ATRBSZ		;(10) LOCAL DATA BYTE SIZE
	IFIW	ATRFSZ		;(11) PHYSICAL DATA FRAME SIZE
	IFIW	ATRHSZ		;(12) FIXED-HEADER SIZE (VARIABLE-LEN RECORDS)
	IFIW	ATRRFM		;(13) RECORD FORMAT
	IFIW	ATRRFO		;(14) RECORD FORMAT ORGANIZATION
	IFIW	ATRRSZ		;(15) RECORD SIZE
	IFIW	ATRBLS		;(16) BLOCK SIZE (BYTES)
	IFIW	ATRFFB		;(17) FIRST FREE BYTE WITHIN LAST BLOCK
	IFIW	ATRACW		;(20) APPLICATION-SPECIFIC FIELD
	IFIW	ATRRMS		;(21) RMS-10 FORMATTED FILE
	IFIW	ATRMCY		;(22) MACY11 FORMATTED FILE
	IFIW	ATRCTG		;(23) CONTIGUOUS ALLOCATION
	IFIW	ATRNSB		;(24) RECORDS DO NO SPAN PHYSICAL BLOCKS
	IFIW	ATRCRE		;(25) CREATION DATE,,TIME
	IFIW	ATRACD		;(26) ACCESS DATE
	IFIW	ATRMOD		;(27) I/O MODE OF FILE
	IFIW	ATRVER		;(30) FILE VERSION WORD
	IFIW	ATRUSW		;(31) USER-SETTABLE WORD
	IFIW	ATRMTA		;(32) TAPE LABEL
	IFIW	ATRSTS		;(33) FILE STATUS BITS
	IFIW	ATRIDT		;(34) BACKUP INCREMENTAL DATE/TIME
	IFIW	ATRPCA		;(35) PRIVILEGED CUSTOMER-SETTABLE WORD
	IFIW	ATRTIM		;(36) PHYSICAL CREATION DATE/TIME
	IFIW	ATRLAD		;(37) LAST ACCOUNTING DATE
	IFIW	ATREXP		;(40) EXPIRATION DATE (UDT)
	IFIW	ATRAUT		;(41) FILE AUTHOR
; 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$IFF(FB)		;FROM AN IFN?
	JRST	ATRAC4			;NOPE
	PUSHJ	P,GETVAL		;GET THE ADDRESS
	  $RETIF			;PROPAGATE FAILURE
	MOVSS	S1			;MAKE BLT SOURCE
	JRST	ATRAC5			;GO JOIN INDIRECTED CASE
ATRAC4:	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
ATRAC5:	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


ATRCRY:	SKIPA	S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.CRY] ;ENCRYPTION CODE
ATRDTY:	MOVE	S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.DTY] ;DATA TYPE
	PJRST	RDHCOM			;ENTER COMMON CODE

ATRDTO:	SKIPA	S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.DTO] ;DATA "OTS" TYPE
ATRDCC:	MOVE	S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.DCC] ;DATA CARRIAGE CONTROL
	PJRST	RDHCOM			;ENTER COMMON CODE

ATRBSZ:	SKIPA	S2,[STORE S1,FB$LEB+.RBBSZ(FB),RB.BSZ] ;LOCAL DATA BYTE SIZE
ATRFSZ:	MOVE	S2,[STORE S1,FB$LEB+.RBBSZ(FB),RB.FSZ] ;PHYSICAL FRAME SIZE
	PJRST	RDHCOM			;ENTER COMMON CODE

ATRHSZ:	SKIPA	S2,[STORE S1,FB$LEB+.RBBSZ(FB),RB.HSZ] ;FIXED-HEADER SIZE
ATRRFM:	MOVE	S2,[STORE S1,FB$LEB+.RBBSZ(FB),RB.RFM] ;RECORD FORMAT
	PJRST	RDHCOM			;ENTER COMMON CODE

ATRRFO:	MOVE	S2,[STORE S1,FB$LEB+.RBBSZ(FB),RB.RFO] ;REC FORMAT ORGANIZATION
	PJRST	RDHCOM			;ENTER COMMON CODE

ATRRSZ:	SKIPA	S2,[STORE S1,FB$LEB+.RBRSZ(FB),RB.RSZ] ;RECORD SIZE (BYTES)
ATRBLS:	MOVE	S2,[STORE S1,FB$LEB+.RBRSZ(FB),RB.BLS] ;BLOCK SIZE (BYTES)
	PJRST	RDHCOM			;ENTER COMMON CODE

ATRFFB:	SKIPA	S2,[STORE S1,FB$LEB+.RBFFB(FB),RB.FFB] ;FIRST FREE BYTE
ATRACW:	MOVE	S2,[STORE S1,FB$LEB+.RBFFB(FB),RB.ACW] ;APPLICATION FIELD
	PJRST	RDHCOM			;ENTER COMMON CODE

ATRRMS:	SKIPA	S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.RMS]  ;RMS-10 FORMATTED FILE
ATRMCY:	MOVE	S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.MCY]  ;MACY11 FORMATTED FILE
	PJRST	RDHCOM			;ENTER COMMON CODE

ATRCTG:	SKIPA	S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.CTG]  ;CONTIGUOUS ALLOCATION
ATRNSB:	MOVE	S2,[STORE S1,FB$LEB+.RBTYP(FB),RB.NSB]  ;/NOSPAN PHY BLOCKS
	PJRST	RDHCOM			;ENTER COMMON CODE


; Common code to set the RDH fields in the extended LOOKUP/ENTER block
RDHCOM:	CAIE	S1,1			;1 WORD
	$RETF				;BAD ARGUMENT
	PUSHJ	P,GETVAL		;FETCH THE VALUE TO STORE
	$RETIF				;BETTER WORK
TOPS10<
	XCT	S2			;STORE FIELD IN L/E BLOCK
	MOVX	S2,RB.DEC		;BIT TO SET
	IORM	S2,FB$LEB+.RBTYP(FB)	;MAKE NEW FIELD VALID
> ;END TOPS-10 CONDITIONAL
	$RETT				;RETURN

ATRCRE:	CAIE	S1,1			;MUST HAVE CORRECT LENGTH
	 $RETE	(FAI)
	PUSHJ	P,GETVAL		;GET THE WORD
	  $RETIF			;END OF LIST
	PUSHJ	P,CNTDT##		;CONVERT UDT TO OLD-STYLE DATE/TIME
	DPB	S2,[POINTR FB$LEB+.RBPRV(FB),RB.CRD] ;STORE LOW PORTION OF DATE
	LSH	S2,-^D12		;ISOLATE HIGH BITS
	DPB	S2,[POINTR FB$LEB+.RBEXT(FB),RB.CRX] ;STORE HIGH PORTION
	ADDI	S1,1			;ACCOUNT FOR POSSIBLE ROUNDING ERRORS
	IDIVI	S1,^D60000		;MAKE INTO MINUTES SINCE MIDNIGHT
	DPB	S2,[POINTR FB$LEB+.RBPRV(FB),RB.CRT] ;STORE CREATION TIME
	$RETT				;DONE

ATRACD:	SKIPA	S2,[POINTR FB$LEB+.RBEXT(FB),RB.ACD]	;ACCESS DATE
ATRMOD:	MOVE	S2,[POINTR FB$LEB+.RBPRV(FB),RB.MOD]	;I/O MODE
	PJRST	ATRCOM			;COMMON CODE FOR 1-WORD VALUES

ATRVER:	SKIPA	S2,[POINT 36,FB$LEB+.RBVER(FB),35]	;VERSION
ATRUSW:	MOVE	S2,[POINT 36,FB$LEB+.RBNCA(FB),35]	;USER-SETTABLE WORD
	PJRST	ATRCOM			;COMMON CODE FOR 1-WORD VALUES

ATRMTA:	SKIPA	S2,[POINT 36,FB$LEB+.RBMTA(FB),35]	;TAPE LABEL
ATRSTS:	MOVE	S2,[POINT 36,FB$LEB+.RBSTS(FB),35]	;STATUS BITS
	PJRST	ATRCOM			;COMMON CODE FOR 1-WORD VALUES

ATRIDT:	SKIPA	S2,[POINT 36,FB$LEB+.RBIDT(FB),35]	;BACKUP DATE/TIME
ATRPCA:	MOVE	S2,[POINT 36,FB$LEB+.RBPCA(FB),35]	;PRIV'ED USW
	PJRST	ATRCOM			;COMMON CODE FOR 1-WORD VALUES

ATRTIM:	SKIPA	S2,[POINT 36,FB$LEB+.RBTIM(FB),35]	;PHYSICAL CREATION UDT
ATRLAD:	MOVE	S2,[POINT 36,FB$LEB+.RBLAD(FB),35]	;LAST ACCOUNTING DATE
	PJRST	ATRCOM			;COMMON CODE FOR 1-WORD VALUES

ATREXP:	SKIPA	S2,[POINT 36,FB$LEB+.RBDED(FB),35]	;EXPIRATION DATE
ATRAUT:	MOVE	S2,[POINT 36,FB$LEB+.RBAUT(FB),35]	;AUTHOR PPN
ATRCOM:	CAIE	S1,1			;BETTER BE A ONE-WORD VALUE HERE
	$RETE	(FAI)
	PUSHJ	P,GETVAL		;READ THE WORD
	$RETIF				;END OF LIST?
	DPB	S1,S2			;STUFF INTO THE RIB
	$RETT				;WIN
	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:	MOVSI	S1,FB$FIL(FB)		;POINT TO RETURNED FILESPEC BLOCK
	HRRI	S1,FB$RFD(FB)		;AND TO DESTINATION
	BLT	S1,FB$RFD+FDXSIZ-1(FB)	;COPY (SMASHES LENGTH WORD)
	MOVEI	S1,FB$RFD+.FDSTR(FB)	;POINT TO START OF REAL DATA
	HRLI	S1,-FDXSIZ		;MAKE AN AOBJN POINTER
	SKIPE	(S1)			;END?
	AOBJN	S1,.-1			;KEEP SEARCHING
	HRRZS	S1			;ISOLATE END ADDR
	SUBI	S1,FB$RFD(FB)		;GET OFFSET
	CAIGE	S1,FDMSIZ		;SMALLER THAN MINIMUM?
	MOVEI	S1,FDMSIZ		;ROUND UP
	STORE	S1,FB$RFD+.FDLEN(FB),FD.LEN ;SET BLOCK LENGTH
	$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
	PUSHJ	P,INTREL		;RELEASE THE IFN
	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
	JUMPN	S2,IBYT.A		;NON-NULL -- NO CHECK OF DEV TYPE
	MOVE	S1,FB$TYP(FB)		;GET DEVICE TYPE
	CAIE	S1,.TYTTY		;TTY?
	JRST	IBYT.A			;NO
	MOVE	S1,FB$BYT(FB)		;YES, GET BYTE SIZE
	CAIE	S1,^D7			;SOME TYPE OF ASCII?
	CAIN	S1,^D8
	JRST	[SETZM	FB$BIB(FB)
		 JRST	IBYT.1]
IBYT.A:	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

;**;[104] Redo code from IBYT.4 to end of F%IBYT. 3-Nov-83 /LWS
;[104] Here to handle LSN strangeness.

IBYT.4:	$SAVE	<T1>			;[104] SAVE T1
	MOVE	S1,FB$BBP(FB)		;GET THE BUFFER BYTE POINTER
	IBP	S1			;NORMALIZE IT
	MOVE	T1,(S1)			;[104] GET THE WORD
	TRNN	T1,1			;[104] 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
	PUSHJ	P,IBYT.8		;[104] GO ADJUST BYTE COUNT AND POINTER
	CAME	T1,[EXP <<"     ">_1>!1];[104] BEGINNING OF LSN PAGE MARK?
	JRST	IBYT.7			;[104] NO,,MUST JUST BE LINE NUMBER
IBYT.5:	SOSGE	FB$BIB(FB)		;[104] COULD BE,,BUFFER HAVE ANY MORE?
	JRST	IBYT.6			;[104] NO,,GO GET ANOTHER BUFFER

	MOVE	S1,FB$BBP(FB)		;[104] GET BYTE POINTER
	IBP	S1			;[104] NORMALIZE IT
	MOVE	T1,(S1)			;[104] GET WHOLE WORD
	CAME	T1,[BYTE (7) .CHCRT,.CHFFD,0,0,0] ;[104] SECOND WORD OF PAGE MARK?
	 JRST	IBYT.2			;[104] NO,,GIVE THE GUY THE NEXT BYTE
	PUSHJ	P,IBYT.8		;[104] YES,,GO ADJUST BYTE COUNT AND POINTER
	JRST	IBYT.1			;[104] GO GET THE NEXT BYTE

IBYT.6:	PUSHJ	P,GETBUF		;[104] GET NEXT BUFFER
	JUMPF	.RETF			;[104] RETURN IF NO MORE
	JRST	IBYT.5			;[104] GO BACK AND GET NEXT BYTE

IBYT.7:	SETZM	FB$LSN(FB)		;[104] 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
	CAIN	S2,.CHTAB		;[104] WAS IT REALLY A TAB?
	JRST	IBYT.1			;[104] YES,,GET NEXT BYTE
	$RETT				;[104] NO,,DON'T KEEP IT FROM CALLER

IBYT.8:	AOS	FB$BBP(FB)		;[104] INCREMENT BYTE-POINT BY ONE WORD
	MOVNI	S1,5-1			;[104] ACCOUNT FOR BYTES BYPASSED BY AOS
					;[104] FB$BIB WAS SOSGE'D ABOVE
	ADDM	S1,FB$BIB(FB)		;[104] DECREMENT BYTES-IN-BUFFER
					;[104] EVEN IF FB$BIB GOES NEGATIVE HERE
					;[104] THE NEXT SOSGE IN IBYT WILL CATCH IT
	POPJ	P,			;[104] RETURN
	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?
	STOPCD	(CTL,HALT,,<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$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
	MOVE	S1,FB$TYP(FB)		;MAKE SURE A DISK
	CAXE	S1,.TYDSK
	JRST	[MOVX	S1,ERFND$	;NO, RETURN A 'FILE NOT ON DISK'
		 PJRST	RETERR ]
	$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
	CAMN	S2,T1			;POSITIONING TO EOF ???
	JRST	[PUSHJ P,POSEOF		;YES, POSITION THERE
		 $RETT  ]		;AND RETURN
	CAML	S2,T1			;POSITIONING WITHIN FILE ???
	$RETE(IFP)			;NO,,RETURN AN ERROR

	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
	  PJRST	MAPIOE			;CAN'T CLEAR EOF, MAP I/O ERROR
;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?
	  PJRST	MAPIOE			;MAP I/O ERROR
	HRRI	S1,.FOSET		;SETSTS FUNCTION FOR THIS CHANNEL
	MOVE	T1,[2,,S1]		;SETUP FOR FILOP.
	FILOP.	T1,			;RESET THE I/O STATUS
	  PJRST	MAPIOE			;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
	  PJRST	MAPIOE			;MAP I/O ERROR
>  ;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
	STOPCD	(FOF,HALT,,<File operation failed unexpectedly>)
>  ;END TOPS20
	PUSHJ	P,GETBUF		;READ THAT NEXT BUFFER
	JUMPT	POS.6			;ANY ERRORS ?
	CAXE	S1,EREOF$		;WAS IT END OF FILE ?
	$RET				;NO - JUST PROPAGATE ERROR BACK
POS.6:	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:	MOVX	TF,FB.BNW		;GET "BYTE NOT WORD" BIT
	MOVE	S1,FB$BIB(FB)		;GET BYTES REMAINING IN BUFFER
	TDNN	TF,FB$FLG(FB)		;36-BIT BYTES?
	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
	TDNE	TF,FB$FLG(FB)		;36-BIT BYTES?
	IDIV	S1,FB$BPW(FB)		;GET WORDS REMAINING
	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$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$TYP(FB)		;GET DEVICE TYPE
	CAXE	S1,.TYDSK		;DISK?
	JRST	[MOVX	S1,ERFND$	;NO, RETURN A 'FILE NOT ON DISK'
		 PJRST	RETERR ]
	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.
	  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
	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
	IDIVI	T1,PAGSIZ		;GET NUMBER OF PAGES
	SKIPE	T2			;ANY LEFT OVER WORDS?
	ADDI	T1,1			;YES - ROUND UP
	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!FB%PGC	;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	.RETF			;CAN'T,,RETURN AN I/O ERROR
	SKIPG	FB$BIB(FB)		;[67] 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(BYTE) COUNT AGAIN
	MOVX	S2,FB.BNW		;GET "BYTE NOT WORD" BIT
	TDNN	S2,FB$FLG(FB)		;36-BIT BYTES (IMAGE MODE)?
	IMUL	S1,FB$BPW(FB)		;YES, 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:
;**;[107]ADD AND REVAMP CODE AT F%REN:+0L	12-APR-84/CTK
	$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
	STOPCD	(RTS,HALT,,<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
	SKIPN	S2,.FDSTR(S1)		;GET STRUCTURE THAT FILE IS ON
	MOVSI	S2,'DSK'
	PUSH	P,S2			;SAVE DEVICE
	DEVTYP	S2,			;SEE IF ITS A DISK TYPE DEVICE
	  MOVX	S2,.TYDSK		;IF IT FAILS, DONT KICK OUT YET
	LOAD	TF,S2,TY.DEV		;GET DEVICE TYPE ONLY
	CAIE	TF,.TYDSK		;DISK?
	JRST	[ POP	P,(P)		;SYNCH STACK
		  MOVX	S1,ERFND$	;NO, RETURN A 'FILE NOT ON DISK'
		  PJRST	RETERR ]	;
	POP	P,FB$FUB+.FODEV(T3)	;PUT DEVICE IN 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
;**;[110]DELETE 2 LINES AT REN.1:+3L	10-MAY-84/CTK
	PUSHJ	P,LDLEB			;LOAD THE LOOKUP/ENTER BLOCK FROM FD
	PUSHJ	P,ALCIFN		;ALLOCATE ANOTHER IFN
	JUMPF	REN.5			;[107]PASS ERROR, RELEASING FIRST IFN

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

;**;[110]ADD 1 LINES AT REN.1:+7	10-MAY-84/CTK
	MOVE	S2,FB$LEB+.RBPPN(T3)	;[110]SAVE THE PATH POINTER
	MOVE	S1,[FO.ASC+FO.PRV+.FORED] ;[107]PRIV'S, CHANNEL, READ-IN
	MOVEM	S1,FB$FUB+.FOFNC(T3)	;[107]STORE INTO FUNCTION WORD
	HRLI	S1,.FOMAX		;[107]SET LENGTH OF BLOCK
	HRRI	S1,FB$FUB(T3)		;[107]AND ITS ADDRESS
	FILOP.	S1,			;[107]DO THE LOOKUP
	  JRST	REN.4			;[107]PASS ERROR, RELEASING FIRST IFN
;**;[110]ADD 7 LINES AT REN.1:+15	10-MAY-84/CTK
	MOVEM	S2,FB$LEB+.RBPPN(T3)	;[110]RESTORE THE PATH POINTER
	LOAD	S1,FB$FUB+.FOFNC(T3),FO.CHN	;[110]GET THE CHANNEL
	HRL	S2,S1			;[110]LOAD THE CHANNEL NUMBER
	HRRI	S2,.FOREL		;[110]GET RELEASE FUNCTION
	MOVE	S1,[1,,S2]		;[110]GET ARG POINTER
	FILOP.	S1,			;[110]RELEASE THE CHANNEL
	  JFCL				;[110]CAN'T CARE ABOUT ERRORS
	HRLI	S1,FB$LEB(T3)		;[107]POINT TO THE LOOKUP/ENTER BLOCK
	HRRI	S1,FB$LEB(FB)		;[107]POINT TO THE RENAME BLOCK
	MOVEI	S2,FB$LEB+.RBMAX-1(FB)	;[107]LET'S GET THE ENDING ADDRESS
	BLT	S1,(S2)			;[107]NOW FILL IN THE RENAME BLOCK
;**;[111]ADD 4 LINES AT REN.1:+24	19-OCT-84/CTK
	EXCH	T3,FB			;[111]LET'S RESET UP THE LOOK UP BLOCK
	MOVE	S1,FRB.SF(T1)		;[111]TO HANDLE RENAMES FROM SFDS
	PUSHJ	P,LDLEB			;[111]LOAD THE LOOK/ENTER AREA
	EXCH	T3,FB			;[111]AND RESTORE THE AC'S
	JUMPE	P1,REN.2		;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.2:	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
	MOVE	S1,[FO.ASC+FO.PRV+.FORNM] ;[107]PRIV'S, CHANNEL, 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.4			;FAILED...
REN.3:	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.4:	PUSH	P,S1			;SAVE ERROR CODE
	PUSHJ	P,REN.3			;RELEASE THE IFNS
	POP	P,S1			;RESTORE ERROR CODE
	PJRST	MAPERR			;RETURN, AFTER MAPPING ERROR

REN.5:	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.
	STOPCD	(RTS,HALT,,<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.4			;RETURN ERROR
	EXCH	FB,T4			;SWAP CUZ EVERYONE BELEIVES IN 'FB'
	PUSHJ	P,ATTRIB		;PROCESS ATTRIBUTE BLOCK
	EXCH	T4,FB			;RESET THINGS
	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
	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.
	MOVE	S1,FB$IFN(FB)		;PUT THE IFN IN S1
	$CALL	F%CHKP			;AND CHECKPOINT THE FILE
INTREL:	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
	MOVE	S1,FB$TYP(FB)		;GET DEVICE TYPE
	CAXE	S1,.TYDSK		;DISK?
	JRST	[MOVX	S1,ERFND$	;NO, RETURN A 'FILE NOT ON DISK'
		 PJRST	RETERR ]
	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
	PUSHJ	P,.SAVET		;SAVE T1-T4, BECAUSE WE'RE
	SETZB	T1,T2			; GOING TO ZERO ALL OF THEM
	SETZB	T3,T4			;  TO PROVIDE A ZEROED RENAME BLOCK
	MOVEI	S1,T1			;GET THE BLOCK'S ADDRESS
	HRLM	S1,FB$FUB+.FOLEB(FB)	;...AND PUT IT IN THE FILOP. BLOCK
	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
	STOPCD	(UFI,HALT,,<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>
  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)>
  SYSPRM XX.ACT,<MOVEI S1,FINF+.RBACT(FB)>,<>	;ACCOUNT STRING
  SYSPRM XX.CRY,<$CALL FIATRB>,<>	;ENCRYPTION CODE
  SYSPRM XX.DTY,<$CALL FIATRB>,<>	;DATA TYPE
  SYSPRM XX.DTO,<$CALL FIATRB>,<>	;DATA "OTS" TYPE
  SYSPRM XX.DCC,<$CALL FIATRB>,<>	;DATA CARRIAGE CONTROL
  SYSPRM XX.BSZ,<$CALL FIATRB>,<>	;LOCAL DATA BYTE SIZE
  SYSPRM XX.FSZ,<$CALL FIATRB>,<>	;PHYSICAL DATA FRAME SIZE
  SYSPRM XX.HSZ,<$CALL FIATRB>,<>	;FIXED-HEADER SIZE
  SYSPRM XX.RFM,<$CALL FIATRB>,<>	;RECORD FORMAT
  SYSPRM XX.RFO,<$CALL FIATRB>,<>	;RECORD FORMAT ORGANIZATION
  SYSPRM XX.RSZ,<$CALL FIATRB>,<>	;RECORD SIZE
  SYSPRM XX.BLS,<$CALL FIATRB>,<>	;BLOCK SIZE (BYTES)
  SYSPRM XX.FFB,<$CALL FIATRB>,<>	;FIRST FREE BYTE WITHIN LAST BLOCK
  SYSPRM XX.ACW,<$CALL FIATRB>,<>	;APPLICATION-SPECIFIC FIELD
  SYSPRM XX.RMS,<$CALL FIATRB>,<>	;RMS-10 FORMATTED FILE
  SYSPRM XX.MCY,<$CALL FIATRB>,<>	;MACY11 FORMATTED FILE
  SYSPRM XX.CTG,<$CALL FIATRB>,<>	;CONTIGUOUS ALLOCATION
  SYSPRM XX.NSB,<$CALL FIATRB>,<>	;RECORDS DON'T SPAN PHYSICAL BLOCKS
  SYSPRM XX.ACD,<LDB S1,[POINTR FINF+.RBEXT(FB),RB.ACD]>,<> ;ACCESS DATE
  SYSPRM XX.MTA,<MOVE S1,FINF+.RBMTA(FB)>,<> ;TAPE LABEL
  SYSPRM XX.STS,<MOVE S1,FINF+.RBSTS(FB)>,<> ;FILE STATUS BITS
  SYSPRM XX.IDT,<MOVE S1,FINF+.RBIDT(FB)>,<> ;BACKUP INCREMENTAL DATE/TIME
  SYSPRM XX.PCA,<MOVE S1,FINF+.RBPCA(FB)>,<> ;PRIVILEGED CUSTOMER WORD
  SYSPRM XX.TIM,<MOVE S1,FINF+.RBTIM(FB)>,<> ;PHYSICAL CREATION DATE/TIME
  SYSPRM XX.LAD,<MOVE S1,FINF+.RBLAD(FB)>,<> ;LAST ACCOUNTING DATE
  SYSPRM XX.EXP,<MOVE S1,FINF+.RBDED(FB)>,<> ;EXPIRATION DATE

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

FITAB:	CFI
	LEN.FI==.-FITAB

RDHTAB:					;FILE ATTRIBUTE RIB WORDS
TOPS10 <
	LOAD	S1,FB$LEB+.RBTYP(FB),RB.CRY ;ENCRYPTION CODE
	LOAD	S1,FB$LEB+.RBTYP(FB),RB.DTY ;DATA TYPE
	LOAD	S1,FB$LEB+.RBTYP(FB),RB.DTO ;DATA "OTS" TYPE
	LOAD	S1,FB$LEB+.RBTYP(FB),RB.DCC ;DATA CARRIAGE CONTROL
	LOAD	S1,FB$LEB+.RBBSZ(FB),RB.BSZ ;LOCAL DATA BYTE SIZE
	LOAD	S1,FB$LEB+.RBBSZ(FB),RB.FSZ ;PHYSICAL FRAME SIZE
	LOAD	S1,FB$LEB+.RBBSZ(FB),RB.HSZ ;FIXED-HEADER SIZE
	LOAD	S1,FB$LEB+.RBBSZ(FB),RB.RFM ;RECORD FORMAT
	LOAD	S1,FB$LEB+.RBBSZ(FB),RB.RFO ;REC FORMAT ORGANIZATION
	LOAD	S1,FB$LEB+.RBRSZ(FB),RB.RSZ ;RECORD SIZE (BYTES)
	LOAD	S1,FB$LEB+.RBRSZ(FB),RB.BLS ;BLOCK SIZE (BYTES)
	LOAD	S1,FB$LEB+.RBFFB(FB),RB.FFB ;FIRST FREE BYTE
	LOAD	S1,FB$LEB+.RBFFB(FB),RB.ACW ;APPLICATION FIELD
	LOAD	S1,FB$LEB+.RBTYP(FB),RB.RMS ;RMS-10 FORMATTED FILE
	LOAD	S1,FB$LEB+.RBTYP(FB),RB.MCY ;MACY11 FORMATTED FILE
	LOAD	S1,FB$LEB+.RBTYP(FB),RB.CTG ;CONTIGUOUS ALLOCATION
	LOAD	S1,FB$LEB+.RBTYP(FB),RB.NSB ;/NOSPAN PHY BLOCKS
RD.LEN==.-RDHTAB

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

FIATRB:	LOAD	S1,FB$LEB+.RBTYP(FB),RB.DEC ;Get the attributes valid bit
	JUMPE	S1,.RETF		;If not valid, return error now
	XCT	RDHTAB-FI.CRY(S2)	;Get value user requested from the rib
	$RETT
> ; 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
	STOPCD	(FIT,HALT,,<FD location requested with illegal type>)
	MOVE	S1,FB			;GET BASE ADDRESS OF FILE BLOCK
	ADD	S1,[EXP FB$RFD,FB$FD]+1(S2) ;POINT TO REQUESTED FD
	$RETT				;RETURN, S1 HAS FD LOCATION




SUBTTL F%FCHN - Find first free channel

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

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

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

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

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


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


SUBTTL RELFB  - Release a File Block

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

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


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

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

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

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

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

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

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

	ERRLEN==.-ERRTAB
>  ;END TOPS10 CONDITIONAL

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

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


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


	SUBTTL	CHKIFN - Check user calls and set IFN context

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


CHKIFN:	EXCH	FB,0(P)			;SAVE CONTENTS OF FB, GET RETURN PC
	PUSH	P,[EXP RSTIFN]		;PLACE TO RESTORE THE REGS FROM
	PUSH	P,FB			;SAVE RETURN PC
	CAILE	S1,0			;IT MUST BE GREATER THAN 0
	CAILE	S1,SZ.IFN		;AND LESS THAN MAX
	SKIPA				;LOSE!!!
	SKIPN	FB,IFNTAB(S1)		;IS IFN ALLOCATED
	STOPCD	(IFN,HALT,,<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:	STOPCD	(IFM,HALT,,<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
	SETZM	FB$IFF(FB)		;ASSUME NOT FROM ANOTHER IFN
	MOVE	S1,@FB$PTR(FB)		;GET VALUE
	TXNE	S1,FI.IMM		;IMMEDIATE ARGUMENT?
	SETOM	FB$IMM(FB)		;YES
	TXNE	S1,FI.IFN		;FROM ANOTHER IFN?
	SETOM	FB$IFF(FB)		;YES
	HRRZM	S1,FB$ATT(FB)		;SAVE ATTRIBUTE TYPE FOR GETVAL W/IFN
	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
	SKIPN	FB$IFF(FB)		;IF NOT VIA AN IFN,
	$RETT				;RETURN THE INFORMATION
	CAMN	S1,FB$IFN(FB)		;BETTER BE A DIFFERENT FILE
	$RETE	(FAI)			;CALL IT INCONSISTENT IF NOT
	$SAVE	<S2>			;IT IS VIA AN IFN, SAVE VOLATILE AC
	MOVE	S2,FB$ATT(FB)		;GET THE INCOMING ATTRIBUTE TYPE
	MOVE	S2,ATINFT-1(S2)		;CONVERT TO F%INFO FI.??? CODE
	PJRST	F%INFO			;GET THE VALUE FROM THE IFN AND RETURN

ATINFT:	EXP	FI.PRT			;(01) PROTECTION CODE
	EXP	FI.ACT			;(02) ACCOUNT STRING
	EXP	FI.SPL			;(03) SPOOLED FILE NAME
	EXP	FI.CRY			;(04) ENCRYPTION CODE
	EXP	FI.DTY			;(05) DATA TYPE
	EXP	FI.DTO			;(06) DATA "OTS" TYPE
	EXP	FI.DCC			;(07) DATA CARRIAGE CONTROL
	EXP	FI.BSZ			;(10) LOCAL DATA BYTE SIZE
	EXP	FI.FSZ			;(11) PHYSICAL DATA FRAME SIZE
	EXP	FI.HSZ			;(12) FIXED-HEADER SIZE
	EXP	FI.RFM			;(13) RECORD FORMAT
	EXP	FI.RFO			;(14) RECORD FORMAT ORGANIZATION
	EXP	FI.RSZ			;(15) RECORD SIZE
	EXP	FI.BLS			;(16) BLOCK SIZE (BYTES)
	EXP	FI.FFB			;(17) FIRST FREE BYTE WITHIN LAST BLOCK
	EXP	FI.ACW			;(20) APPLICATION-SPECIFIC FIELD
	EXP	FI.RMS			;(21) RMS-10 FORMATTED FILE
	EXP	FI.MCY			;(22) MACY11 FORMATTED FILE
	EXP	FI.CTG			;(23) CONTIGUOUS ALLOCATION
	EXP	FI.NSB			;(24) RECORDS DO NO SPAN PHYSICAL BLOCKS
	EXP	FI.CRE			;(25) CREATION DATE,,TIME
	EXP	FI.ACD			;(26) ACCESS DATE
	EXP	FI.MOD			;(27) I/O MODE OF FILE
	EXP	FI.GEN			;(30) FILE VERSION WORD
	EXP	FI.USW			;(31) USER-SETTABLE WORD
	EXP	FI.MTA			;(32) TAPE LABEL
	EXP	FI.STS			;(33) FILE STATUS BITS
	EXP	FI.IDT			;(34) BACKUP INCREMENTAL DATE/TIME
	EXP	FI.PCA			;(35) PRIVILEGED CUSTOMER-SETTABLE WORD
	EXP	FI.TIM			;(36) PHYSICAL CREATION DATE/TIME
	EXP	FI.LAD			;(37) LAST ACCOUNTING DATE
	EXP	FI.EXP			;(40) EXPIRATION DATE (UDT)
	EXP	FI.AUT			;(41) FILE AUTHOR
FIL%L:	END