Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

TITLE	CPAFIL  --  File I/O needed by CMDPAR
SUBTTL	Irwin L. Goverman - Larry Samberg/MLB/DC/PW/AWC	12-Sep-79

;
;
;
;	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1978, 1986.
;	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	CPASYM			;SEARCH SUBSYSTEMS SYMBOLS
	PROLOG(CPAFIL)		;GENERATE PROLOG CODE

SUBTTL Table Of Contents

SUBTTL Revision History

SUBTTL Local AC definitions and Entry Points

	FB==15				;ALWAYS ADDRESS OF CURRENT FILE BLOCK

	ENTRY	F%INIT,F%IOPN,F%IBYT,F%IBUF,F%REL,F%INFO

SUBTTL	Module Storage

$IMPURE

	;TEMPORARY ASSIGNMENT TILL CPAFIL CHANGE MADE TO USE THIS CPAFIL

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


	$DATA	IFNTAB,1+1		;ADDRESS OF FILE DATA PAGE FOR
					; TAKE IFN
	$DATA	TAKBUF,SZ.BUF+3		;TAKE INPUT BUFFER (+3 FOR -10 BH)

; DATA BLOCK FOR COMMON FILE OPEN ROUTINE

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

	$DATA	DMPFLG			;FLAG TO DUMP THE BUFFER
	$DATA	F$FOB,FOB.SZ		;FOR FOR INTERNAL USE

	SUBTTL	FB     - File Block Definitions

	FB%%%==0			;INITIAL OFFSET

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

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

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

TOPS10<
	FB	FUB,.FOPPN+1		;FILOP. UUO BLOCK
	FB	LEB,.RBTIM+1		;LOOKUP/ENTER UUO BLOCK
	FB	PTH,10			;PATH BLOCK
	FB	CHN,1			;CHANNEL NUMBER FOR THIS FILE
>  ;END TOPS10 CONDITIONAL


TOPS20<
	FB	FDB,.FBLEN		;BLOCK FOR THE FDB
	FB	CHK,.CKAUD+1		;BLOCK FOR CHKAC JSYS
	FB	JFN,1			;THE JFN
>  ;END TOPS20 CONDITIONAL

;The following variables define the current buffer state

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

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

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

	FB	EOF,1			;SET IF EOF SEEN ON INPUT

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

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

	FB	BRH,3			;BUFFER RING HEADER

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

	FB$END==FB%%%			;END OF FILE BLOCK

	$DATA	TAK.FB,FB$END		;FB OF TAKE FILE

$PURE

	SUBTTL	F%INIT - Initialize the world

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

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


F%INIT:	MOVEI	S1,SZ.IFN		;CLEAR THE IFN
	MOVEI	S2,IFNTAB		;TABLE FOR RE-USE
	$CALL	.ZCHNK		;ZERO IT OUT.
	$RETT				;RETURN.

	SUBTTL	F%IOPN - Open an input file

;CALL:		S1/	LENGTH OF FILE OPEN BLOCK (FOB) 
;		S2/	ADDRESS OF FOB (DESCRIBED IN CPASYM)
;			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	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
	$CALL	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
	$STOP(IBS,Illegal byte size given)
OPNC.0:	MOVEI	S1,^D36			;GET BITS/WORD
	IDIV	S1,FB$BYT(FB)		;DIVIDE BY BITS/BYTE
	MOVEM	S1,FB$BPW(FB)		;STORE BYTES/WORD
	MOVE	S1,O$MODE		;GET REQUESTED ACCESS MODE
	MOVEM	S1,FB$MOD(FB)		;STORE INTO MODE WORD
	MOVEI	S2,FB$FD(FB)		;GET LOCATION TO MOVE FD TO
	LOAD	S1,.FDLEN(T2),FD.LEN	;GET FD'S LENGTH
	ADD	S1,S2			;LAST LOCATION FOR BLT
	HRLI	S2,0(T2)		;STARTING LOCATION OF FD
	BLT	S2,-1(S1)		;STORE TILL LAST WORD
	SETOM	FB$BFN(FB)		;SET CURRENT BUFFER TO -1
	SETZM	FB$BIB(FB)		;NO BYTES IN BUFFER
	SETZM	FB$EOF(FB)		;CLEAR EOF FLAG
	SETZM	FB$FNC(FB)		;FILE DOESN'T NEED CHECKPOINTING


				;FALL THRU TO OPERATING SYSTEM
				; DEPENDENT CODE

TOPS10<
	MOVEI	S2,.IOIMG		;LOAD IMAGE MODE
	MOVEM	S2,FB$FUB+.FOIOS(FB)	;STORE IN FILE BLOCK
	SKIPN	S2,.FDSTR(T2)		;GET THE STRUCTURE
	MOVSI	S2,'DSK'		;USE 'DSK' AS DEFAULT
	MOVEM	S2,FB$FUB+.FODEV(FB)	;STORE IN FILE BLOCK
	DEVTYP	S2,			;SEE IF ITS A DISK TYPE DEVICE
	  MOVX	S2,.TYDSK		;IF IT FAILS, DONT KICK OUT YET
	LOAD	S1,S2,TY.DEV		;GET DEVICE TYPE ONLY
	CAXE	S1,.TYDSK		;IS IT A DISK?
	JRST	[ MOVX	S1,ERFND$	;NO, RETURN A 'FILE NOT ON DISK'
		  PJRST	RETERR ]	;
	MOVEI	S2,FB$RFD+.FDPPN-2(FB)	;LOCATION TO START PATH BLOCK AT
	HRLI	S2,FDXSIZ-.FDEXT+2	;SET SIZE UP TOO
	MOVEM	S2,FB$FUB+.FOPAT(FB)	;STORE IT AWAY
	MOVEI	S2,FB$BRH(FB)		;GET ADR OF BUFFER RING HDR
	MOVEM	S2,FB$FUB+.FOBRH(FB)	;AND STORE IT
	MOVEI	S2,1			;GET NUMBER OF BUFFERS
	MOVEM	S2,FB$FUB+.FONBF(FB)	;STORE AS # OF BUFFERS
	MOVE	S2,FB$MOD(FB)		;GET THE MODE WORD
	CAIE	S2,FBM$OU		;IS IT OUTPUT
	CAIN	S2,FBM$AP		; OR APPEND?
	SKIPA				;YES IT IS
	JRST	OPNC.1			;NO, SKIP THIS CODE
	MOVSS	FB$FUB+.FOBRH(FB)	;REVERSE BUFFER HEADER WORD
	MOVSS	FB$FUB+.FONBF(FB)	; AND BUFFER NUMBER WORD
OPNC.1:	MOVEI	S2,FB$LEB(FB)		;GET ADDRESS OF LOOKUP/ENTER BLOCK
	MOVEM	S2,FB$FUB+.FOLEB(FB)	;STORE IT
	MOVE	S1,T2			;GET ADDRESS OF FD BLOCK
	$CALL	LDLEB			;LOAD THE LOOKUP ENTER BLOCK
	MOVE	S2,O$FUNC		;GET FILOP. FUNCTION WORD
	TXO	S2,FO.ASC		;ASSIGN CHANNEL NUMBER
	MOVEM	S2,FB$FUB+.FOFNC(FB)	;STORE IN FUNCTION WORD
	CAIG	T4,FOB.US		;IS THIS "ON BEHALF"?
	JRST	OPNC.2			;NO
	LOAD	S1,FOB.US(T1)		;GET PPN OF USER
	MOVEM	S1,FB$FUB+.FOPPN(FB)	;AND STORE IT
OPNC.2:	MOVE	T1,FB$BUF(FB)		;GET ADDRESS OF BUFFER
	EXCH	T1,.JBFF##		;TELL MONITOR TO BUILD BUFFERS THERE
	MOVSI	S1,.FOPPN+1		;GET LEN,,0
	HRRI	S1,FB$FUB(FB)		;GET LEN,,ADDRESS
	FILOP.	S1,			;DO THE FILOP.
	  MOVNS	T1			;FLAG THAT FILOP FAILED
	MOVMM	T1,.JBFF##		;RESTORE FIRST FREE
	JUMPL	T1,OPNERR		;IF ERROR OCCURRED, COMPLAIN
	LOAD	S1,FB$FUB+.FOFNC(FB),FO.CHN	;GET THE CHANNEL NUMBER
	MOVEM	S1,FB$CHN(FB)		;AND SAVE IT AWAY
	$CALL	SETFD			;SET UP REAL FILE DESCRIPTION
	MOVE	S1,FB$LEB+.RBSIZ(FB)	;GET WORDS IN FILE
	MOVEM	S1,FB$WRD(FB)		;STORE IT
	MOVE	S1,FB$IFN(FB)		;GET THE IFN IN S1
	$RETT				;AND RETURN OUR SUCCESS
>  ;END TOPS10 CONDITIONAL

TOPS20<
	MOVE	T3,T1			;GET LOCATION OF FOB INTO SAFER PLACE
	MOVE	S1,O$GJFN		;GET GTJFN FUNCTION WORD
	HRROI	S2,FB$FD+.FDSTG(FB)	;POINT TO THE FILE
	GTJFN%				;FIND IT
	  JRST	OPNERR			;LOSE
	MOVEM	S1,FB$JFN(FB)		;SAVE THE JFN
	DVCHR%				;LOOK UP THE DEVICE'S CHARACTERISTICS
	LOAD	S1,S2,DV%TYP		;ISOLATE THE TYPE CODE
	CAXN	S1,.DVDSK		;MAKE SURE ITS A DISK
	JRST	OPNC.1			;DISK..O.K..CONTINUE
	CAXE	S1,.DVNUL		;ALSO CHECK FOR NUL:
	JRST	[ MOVX	S1,ERFND$	;LOAD 'DEVICE IS NOT THE DISK'
		  PJRST RETERR ]	;CLEAN UP AND RETURN
OPNC.1:	MOVE	S1,FB$JFN(FB)		;RESTORE JFN
	CAILE	T4,FOB.CD		;IS THIS FOR SOMEONE?
	SKIPN	T2,FOB.CD(T3)		;IF NOT THERE OR ZERO,
	JRST	OPNC.2			;SKIP THE ACCESS CHECK
	MOVEM	T2,FB$CHK+.CKACD(FB)	;STORE THE CONNECTED DIRECTORY
	MOVE	T2,O$PROT		;GET PROTECTION TO CHECK FOR
	MOVEM	T2,FB$CHK+.CKAAC(FB)	;AND PUT WHERE IT WILL GET CHECKED
	LOAD	T2,FOB.US(T3)		;GET USER ID
	MOVEM	T2,FB$CHK+.CKALD(FB)	;STORE IT
	MOVEM	S1,FB$CHK+.CKAUD(FB)	;STORE JFN TO CHECK AGAINST
	MOVEI	S2,FB$CHK(FB)		;ADDRESS OF BLOCK
	MOVX	S1,CK%JFN+.CKAUD+1	;LENGTH + CHECKING JFN
	CHKAC%				;CHECK IT
	  $STOP(FOF,File operation failed unexpectedly)
	JUMPE	S1,[ MOVX  S1,ERPRT$	;GET A PROTECTION FAILURE
		     PJRST  RETERR ]	;AND GO FROM THERE
OPNC.2:	MOVE	S1,FB$JFN(FB)		;RESTORE JFN
	MOVE	S2,O$FUNC		;GET FILE OPEN FUNCTION
	OPENF%				;OPEN THE FILE
	  JRST	OPNERR			;LOSE?
	MOVX	S2,<.FBLEN,,.FBHDR>	;GET FILE DESCRIPTOR BLOCK
	MOVEI	T1,FB$FDB(FB)		;AND STORE INTO OUR FB
	GTFDB%				;
	  ERJMP	.+1			;IGNORE ERRORS FOR NOW
	$CALL	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:	$CALL	.SAVE2		;GET SOME SCRATCH SPACE
	MOVEI	S2,.RBTIM		;LENGTH OF LOOKUP
	MOVEM	S2,FB$LEB+.RBCNT(FB)	;STORE IN LOOKUP/ENTER BLOCK
	LOAD	S2,.FDNAM(S1)		;GET FILE NAME
	MOVEM	S2,FB$LEB+.RBNAM(FB)	;STORE IN LOOKUP/ENTER BLOCK
	LOAD	S2,.FDEXT(S1)		;GET THE EXTENSION
	MOVEM	S2,FB$LEB+.RBEXT(FB)	;STORE IT
	MOVE	P1,.FDPPN(S1)		;GET THE PPN
	MOVEM	P1,FB$LEB+.RBPPN(FB)	;STORE INTO LOOKUP/ENTER BLOCK
	LOAD	S2,.FDLEN(S1),FD.LEN	;GET FD LENGTH
	SUBI	S2,.FDPAT		;SUBTRACT OFFSET OF FIRST SFD
	JUMPLE	S2,.RETT		;IF NO SFDS, WE ARE DONE
	JUMPE	P1,.RETT		;IF PPN IS 0, DON'T MAKE A PATH BLOCK
	MOVEM	P1,FB$PTH+.PTPPN(FB)	;STORE PPN IN PATH BLOCK
	MOVEI	P2,FB$PTH(FB)		;AND MAKE THE PPN WORD OF LEB
	MOVEM	P2,FB$LEB+.RBPPN(FB)	;POINT TO THE PATH BLOCK
	MOVE	P1,FB			;GET FB POINTER

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

> ;END OF TOPS10 CONDITIONAL

	SUBTTL	SETFD  - Set up a real description of opened file

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

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


TOPS10<
SETFD:	MOVE	S1,FB$RFD+.FDPPN-2(FB)	;GET FILE'S DEVICE
	MOVEM	S1,FB$RFD+.FDSTR(FB)	;STORE INTO STRUCTURE LOCATION
	MOVE	S1,FB$LEB+.RBNAM(FB)	;GET FILE'S NAME
	MOVEM	S1,FB$RFD+.FDNAM(FB)	;STORE INTO RFD
	HLLZ	S1,FB$LEB+.RBEXT(FB)	;GET FILE'S EXTENSION
	MOVEM	S1,FB$RFD+.FDEXT(FB)	;STORE IT
	MOVX	S1,.FDPPN+1		;GET LENGTH OF ALL BUT PATH
	STORE	S1,FB$RFD+.FDLEN(FB),FD.LEN ;STORE IT AWAY
	MOVSI	S1,-<FDXSIZ-.FDPPN-1>	;GET MAXIMUM LENGTH OF PATH
	HRR	S1,FB			;RELOCATE TO THE RFD
SETF.1:	SKIPE	FB$RFD+.FDPAT(S1)	;IS THIS PART OF PATH SPECIFIED?
	JRST	[MOVEI	T1,FD.LEN	;GET LEN OF FD
		 ADDM	T1,FB$RFD+.FDLEN(FB)	;ADD TO CURR POS
		 JRST	.+1]
	AOBJN	S1,SETF.1		;REPEAT FOR ALL PARTS
	$RETT				;THEN RETURN TO CALLER
> ;END OF TOPS10 CONDITIONAL

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

	SUBTTL	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 CPALIB ERROR
; CODE, NOT A SYSTEM ERROR CODE
;
;UPON ENTERING,  S1 CONTAINS THE ERROR CODE
;		 FB CONTAINS THE ADDRESS OF THE WORK PAGE
;		 I  CONTAINS THE IFN

OPNERR:
	PUSH	P,S1			;SAVE THE ERROR CODE
TOPS20<
	$CALL	INTREL		;RELEASE THE IFN
>;END TOPS20
TOPS10<
	$CALL	RELFB			;GIVE BACK THE IFN
>;END TOPS10
	POP	P,S1			;RESTORE THE ERROR CODE
	PJRST	MAPERR			;MAP THE OPERATING SYSTEM ERROR

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

RETERR:	PUSH	P,S1			;SAVE THE CODE
	$CALL	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:	$CALL	CHKIFN		;CHECK THE IFN
	MOVE	S1,FB$MOD(FB)		;GET OPEN MODE
	CAIN	S1,FBM$IN		;IS IT INPUT?
	JRST	IBYT.1			;YES, CONTINUE
	CAIN	S1,FBM$UP		;OR UPDATE?
	HALT .				;NOT IMPLEMENTED YET!
	JRST	ILLMOD			;NO, GIVE A STOPCODE

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

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

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

	SUBTTL	F%IBUF  -  Read a buffer of data from file

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

F%IBUF:	$CALL	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:	$CALL	GETBUF		;GET A NEW BUFFER
	JUMPF	.RETF			;PROPAGATE THE ERROR
	JRST	IBUF.1			;AND TRY AGAIN

	SUBTTL	GETBUF  -  Read one input buffer from the operating system

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


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

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

TOPS20<
	$CALL	.SAVET			;SAVE T1 THRU T4
	MOVE	S1,FB$JFN(FB)		;GET THE JFN
	MOVE	S2,FB$BUF(FB)		;GET BUFFER ADDRESS
	HRLI	S2,(POINT ^D36,0)	;MAKE A BYTE POINTER
	MOVEM	S2,FB$BRH+.BFPTR(FB)	;SAVE THE BYTE POINTER
	MOVNI	T1,SZ.BUF		;NUMBER OF WORDS TO READ
	SIN%				;READ THEM
	ERJMP	[GTSTS%			;GET FILE STATUS
		 TXNN S2,GS%EOF		;IS IT EOF?
		  PJRST GETERR		;GET ERROR, MAP IT AND RETURN
		 PUSHJ P,POSEOF		;YES, SET EOF
		 JRST GETB.1]		;AND CONTINUE ON
GETB.1:	ADDI	T1,SZ.BUF		;ADD NUMBER OF WORDS REQUESTED
	MOVEM	T1,FB$BRH+.BFCNT(FB)	;STORE NUMBER OF WORDS READ
	JUMPE	T1,POSEOF		;GOT EOF!!
>  ;END TOPS20

GETB.2:	AOS	FB$BFN(FB)		;INCREMENT BUFFER NUMBER
	$CALL	SETBFD		;SETUP BUFFER DATA
	$RETT

SUBTTL	MISCELLANEOUS ROUTINES

POSEOF:	SETOM	FB$BIB(FB)		;MAKE SURE WE ALWAYS GET HERE
	SETOM	FB$EOF(FB)		;DITTO
	$RETE(EOF)			;RETURN THE ERROR

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

SETBFD:	MOVE	S1,FB$BRH+.BFPTR(FB)	;GET THE BYTE POINTER
	MOVE	S2,FB$BYT(FB)		;GET BYTESIZE
	DPB	S2,[POINT 6,S1,11]	;MAKE THE CORRECT BYTE POINTER
	MOVEM	S1,FB$BBP(FB)		;STORE THE BUFFER BYTE POINTER
	MOVE	S1,FB$BRH+.BFCNT(FB)	;GET WORD COUNT AGAIN
	IMUL	S1,FB$BPW(FB)		;CONVERT TO BYTES
	MOVEM	S1,FB$BIB(FB)		;SAVE FOR USER
	$RETT				;AND RETURN

	SUBTTL	F%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%REL:	$CALL	CHKIFN		;CHECK THE IFN
	MOVE	S1,FB$BIB(FB)		;GET BYTES REMAINING IN BUFFER
	IDIV	S1,FB$BPW(FB)		;GET WORDS REMAINING
	EXCH	S1,FB$BRH+.BFCNT(FB)	;EXCH WITH ORIGNINAL WORD COUNT
	SUB	S1,FB$BRH+.BFCNT(FB)	;GET NUMBER OF WORDS WRITTEN
	ADDM	S1,FB$BRH+.BFPTR(FB)	;UPDATE THE BYTE POINTER

INTREL:	HRL	S1,FB$CHN(FB)		;GET THE CHANNEL
	HRRI	S1,.FOREL		;GET RELEASE FUNCTION
	MOVE	S2,[1,,S1]		;GET ARG POINTER
	FILOP.	S2,			;RELEASE THE CHANNEL
	  $RETE(FDE)			;LOSE
	JRST	RELFB			;GET RID OF MEMORY AND RETURN
>  ;END TOPS10


TOPS20<
F%REL:	$CALL	CHKIFN		;VALIDATE THE IFN ETC.
INTREL:	MOVE	S1,FB$IFN(FB)		;PUT THE IFN IN S1
	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

>  ;END TOPS20

	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 CPASYM)
;
; RETURN:	S1/ CONTENTS OF DESIRED WORD


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

; MAKE UP THE SYSTEM-DEPENDENT TABLE FOR FETCHING VALUES

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


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

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

FITAB:	CFI
	LEN.FI==.-FITAB

	SUBTTL	ALCIFN - Allocate an Internal File Number

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


ALCIFN:	$CALL	.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	S2,TAK.FB		;GET TAKE FB
	MOVEM	S2,IFNTAB(P1)		;STORE ADDRESS IN TABLE
	MOVE	FB,S2			;SETUP FB REGISTER
	HRRZM	P1,FB$IFN(FB)		;SAVE THE IFN
	MOVEI	S1,TAKBUF		;BUFFER PAGE ADDR
	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$IFN(FB)		;GET THE IFN
	SETZM	IFNTAB(S1)		;CLEAR THE IFN TABLE ENTRY
	$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:	$CALL	.SAVE1		;GET ONE SCRATCH AC
	MOVSI	S2,-ERRLEN		;GET -VE LEN OF TABLE

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

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

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

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

TOPS10<
ERRTAB:	XWD	ERFNF%,	ERFNF$
	XWD	ERIPP%,	ERIFS$
	XWD	ERPRT%,	ERPRT$
	XWD	ERFBM%,	ERPRT$
	XWD	ERAEF%,	ERFAE$
	XWD	ERDNA%,	ERDNA$
	XWD	ERNSD%,	ERNSD$
	XWD	ERNRM%,	ERQEF$
	XWD	ERWLK%,	ERPRT$
	XWD	ERNET%,	ERSLE$
	XWD	ERSNF%,	ERFNF$
	XWD	ERLVL%,	ERFNF$

	ERRLEN==.-ERRTAB
>  ;END TOPS10 CONDITIONAL

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

	ERRLEN==.-ERRTAB
>  ;END TOPS20 CONDITIONAL

	SUBTTL	CHKIFN - Check user calls and set IFN context

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


CHKIFN:	EXCH	FB,0(P)			;SAVE CONTENTS OF FB, GET RETURN PC
	XMOVEI	T1,RSTIFN		;PLACE TO RESTORE THE REGS FROM
	PUSH	P,T1
	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)

END