Google
 

Trailing-Edge - PDP-10 Archives - BB-D480G-SB_FORTRAN10_V11.0_short - forrms.mac
There are 7 other files named forrms.mac in the archive. Click here to see a list.
	SEARCH	MTHPRM,FORPRM
	TV	FORRMS	RMS INTERFACE, 11(5023)

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;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.

;++
; FACILITY:	FORTRAN/RMS Interface
;
; ABSTRACT:
;
;	Contains all routines which perform RMS I/O.  Any code which
;	must SEARCH RMSINT/RMSINJ must be in this module.
;
; ENVIRONMENT:	FORTRAN Runtime System
;
; AUTHOR: Tom Speer 
;
; CREATION DATE: 1-Dec-83
;
; MODIFIED BY:

COMMENT \

***** Begin Revision History *****

4065	JLC	6-Dec-83
	Added some new entries for the skeleton.

4066	JLC	11-Jan-84
	More new entries for the skeleton.

4072	JLC	24-Jan-84
	Begin coding.

4102	JLC	17-Feb-84
	Remove a global which was removed from FOROPN.

4122	JLC	2-May-84
	Add some more globals.

4131	JLC	12-Jun-84
	Add non-skip memory full return to %GTBLK call.

***** Begin Version 11 *****

5000	TGS	1-Jul-85
	Implement RMS OPEN.

5001	TGS	1-Aug-85
	Implement RMS INQUIRE.

5002	TGS	1-Sep-85
	Implement RMS CLOSE.

5003	TGS	24-Oct-85
	Implement RMS READ.

5004	TGS	10-Nov-85
	Implement RMS WRITE.

5007	TGS	4-Jan-86
	RMS error-handling.

5013	TGS	28-May-86
	RMS file-positioning.

5014	MRB	6-JUN-86
	Implement RMS UNLOCK statement. Routines %RMCUL, %RMUNL, FREE$

5016	MRB	16-Jun-86
	Implement MAXREC keyword in open statements.

5023	TGS	18-Nov-86
	Pre-diagnose ER$REX errors to avoid various network problems.
	
***** End Revision History *****

\
	SUBTTL	INTERN-EXTERN DECLARATIONS

;
;	Conditional compilation Macros
;
;If FTEXT is zero, the processor does not support extended addressing
;RMS invocations.  Such machines not only do not need the code in
;FORRMS, they can't compile it, since the .REQUIRE files
;for RMS are not on their system. 

IF10,<	IFNDEF	FTEXT,<FTEXT==0>		;Default on -10
> ;End IF20
IF20,<	IFNDEF	FTEXT,<FTEXT==-1>		;Default on -20
> ;End IF20

;Tell which version we are assembling

IF1,<
	IFN FTEXT,<PRINTX	[Extended version]>
	IFE FTEXT,<PRINTX	[Non-Extended version]>
>

	DEFINE	IFRMS	<IFN FTEXT>		;RMS can be invoked
	DEFINE	IFNRMS	<IFE FTEXT>		;RMS cannot be invoked


;%IF20 conditionals are like IF20 ones, except that if FTEXT=0 (non-
; RMS environment) nothing within a %IF20 assembles at all.
; The RMSENT macro defines ENTRY points as POPJ's for a non-RMS
; environment--just enough defined so FOROTS can be compiled without error.

	DEFINE	%IF20, <
		IFRMS>	;End %IF20

	DEFINE RMSENT (NAM),<
	ENTRY	NAM				;;ENTRY on -10/-20
	IF20,< 					;;If -20
	IFE FTEXT <				;;and not RMS-able
	IRP <NAM>,<NAM': POPJ P,>		;;Dummy entries
		  > ;End IFE
	     > ;End IF20
			    > ;End RMSENT

%IF20,<

	SEARCH	RMSINJ

	.REQUIRE SYS:RMSZER
	.REQUIRE SYS:RTLZNM
	.REQUIRE SYS:ZERBOO
	.REQUIRE SYS:DYNBOO

> ;End %IF20


	SEGMENT CODE


IF20,<
	INTERN	%ERMIN							;[5007]
	ENTRY	FNDRMS							;[5000]

	RMSENT	<%IRMS,%ORMS,%UORMS,%RMOPN,%RMLKP,%RMRFS>		;[5000]
	RMSENT	<%RMGXF,%RMOSW,%RMISW,%RSISW,%RMCLS,%RMREW,%RMBSR>	;[5000]
	RMSENT	<%RMEND,%RMSIN,%RMSOU,%RMRDW,%CHKBD>			;[5000]
	RMSENT	<%RMREN,%RMDSP,%RMEFN,%RMCSY>				;[5002]
	RMSENT	<%RMERR,%RMECL>						;[5007]
	RMSENT	<%RMCRW>						;[5004]
	RMSENT	<%RMCDL,%RMDEL>						;[5013]
	RMSENT	<%RMCUL,%RMUNL>						;[5014]

> ;End IF20

	ENTRY	%RMCKF							;[5000]
	RMSENT	<%RMDAB,%RMASV,%RMKOP,%RMDKB,%RMDFA>			;[5000]
	RMSENT	<%RMFND>						;[5004]
	RMSENT	<%RMECK>						;[5007]
	RMSENT	<%RSOSW>						;[5000]

	EXTERN	%POPJ,%POPJ1

IF20,<
;EXTERNS IN FORERR:

	EXTERN	%RMPDP,ERRPTR,OCTTYP,ASCTYP,%ERNM2,%ERNM3		;[5007]
	EXTERN	INICHR,%RMEPT,FOREC2,EMSGT0,%ERPTR,ERRCNT		;[5007]
	EXTERN	LERRBF							;[5007]
	EXTERN	%ERIOS							;[5014]

;EXTERNS IN FORIO:
	EXTERN	%CUNIT							;[5000]
	EXTERN	SETPTR,%OCLR,RECLEN,PAGNUM				;[5003]
	EXTERN	A.REC,A.KVL,A.KRL,A.KID,D.KEY,EXPIRB,GETIRB		;[5003]
	EXTERN	GETORB,ORINI,BYTUSD,%SETAV,A.FMT			;[5004]
	EXTERN	%CUNIT,%BAKEF						;[5013]
	EXTERN	A.IOS							;[5014]

;EXTERNS IN FORMEM:
	EXTERN	%GTBLK,%FREBLK,%GTPGS,%FREPGS				;[5000]
	EXTERN	%GTSPC							;[5003]
	EXTERN	%MVBLK							;[5004]

;EXTERNS IN FOROPN:
	EXTERN	O.KEY,%TXTBF,TXTBF2,OPNSWT,KEYVAL,FNDSWT		;[5000]
	EXTERN	%ARGNM,SWRECT,FNSPNT,FNSCLR,%GNPNT,FNOJFN		;[5000]
	EXTERN	ASCFNS,RELJFN,%DOJFNS,RANALC,CHKBSZ,BSTAB		;[5000]
	EXTERN	%RSEOF,FDB,OPCNF					;[5000]
	EXTERN	UNKXST							;[5001]
	EXTERN	DSKREN,%RNAMD,%OLDDB,CLSDDB,SWDISC,JFNBLK		;[5002]
	EXTERN	ILLOUT,%SOCNT,%SETIN					;[5004]
	EXTERN	%SETOUT,%SETIN						;[5013]

;EXTERNS IN FOROTS:
	EXTERN	%FSECT,%ABFLG						;[5007]
	EXTERN	%DDBTAB,%UDBAD						;[5013]

;EXTERNS IN FORXIT:
	EXTERN	ABORT.							;[5000]



> ;End IF20


	SUBTTL	%RMKOP	-	Setup a FAB/XAB chain 


;***************************************************************************
;*                                                                         *
;*                      ENTRIES CALLED FROM FOROPN                         *
;*                                                                         *
;***************************************************************************

;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine allocates a FAB/XAB chain and fills in the XAB(s)
;	with KEY specifier data.  It is called from OPEN keyword processing
;	and from DIAKEY when parsing a /KEY: in DIALOG mode. Deallocates
;	any FAB/RAB/XAB which already exists for this (D), then allocates
;	a new FAB/XAB chain.
;
;	O.KEY points to an argument list of the form:
;
;
;                -N,,0                   ;N is KSPLEN*number_keys
;        xM:     IFIW    TP%INT,[LB]     ;primary key first char
;                IFIW    TP%INT,[UB]     ;primary key last char
;                IFIW    type,0          ;type is TP%INT or TP%CHR
;                .....
;                IFIW    TP%INT,[LB]     ;last key first char
;                IFIW    TP%INT,[UB]     ;last key last char
;                IFIW    type,0          ;type is integer or character
;
;	If the arglist has been constructed in DIALOG, LB and UB values
;	are immediate and the left half of each entry except for data
;	type is zero.
;
;	P1 is the secondary arglist pointer
;	P2 is an AOBJN index: -Number_of_specifiers,,key_of_reference
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMKOP
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	O.KEY	-	Address of secondary argument list
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FAB(D)		-	Address of FAB
;	XAB(D)		-	Address of XAB
;		POS	-	Starting byte position of key
;		SIZ	-	Size of key
;		DTP	-	Key's datatype
;		REF	-	Key-of-reference number
;		NXT	-	Pointer to next XAB in chain
;	STGFLG(D)	-	-1 if XAB chain has CHARACTER DTP
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4,P1,P2
;	Deallocates any prexisting FAB/RAB/XAB on entry
;
;--
;[5000] New


IF10,<
%RMKOP:	$SNH				;Should not get here on -10
> ;End IF10

%IF20,<
MAXCHR==^D255				;CHARACTER keys must be equal to/less
					;than this length
INTLEN==4				;INTEGER keys must be 4 bytes long

%RMKOP:	PUSHJ	P,%RMDAB		;Deallocate any arg blocks
	PUSHJ	P,RMFAB			;Allocate a FAB
	MOVEM	T1,FAB(D)		;Save its address

	SETZM	STGFLG(D)		;Clear CHARACTER-in-XAB flag
	SETZM	PXBADR			;Initialize previous XAB address
	MOVE	P1,O.KEY		;Get address of secondary arglist
	XMOVEI	P1,@P1			; alone

;Initialize AOBJN pointer with -number_of_specifiers,,key_of_reference#

	HLRE	T1,-1(P1)		;Get argument count
	IDIVI	T1,KSPLEN		;Get number of specifiers
	MOVSI	P2,(T1)			;-key_num,,key_ref

;TOP OF KEY_SPECIFIER LOOP

KEYLP:	PUSHJ	P,RMXAB			;Allocate a XAB
	MOVE	T4,T1			;Copy current XAB address
	SKIPN	PXBADR			;Prime key XAB (no previous)?
	 MOVEM	T4,XAB(D)		;Yes, save start of chain

;Get Lower Bound argument and store 

	MOVE	T2,LBO(P1)		;Get LB argument
	TLNE	T2,-1			;Immediate?
	 MOVE	T2,(T2)			;No
	MOVEM	T2,SAVLB		;Save
	PUSHJ	P,%CHKBD		;Check validity
	 JRST	KERR			;Bad
	SUBI	T2,1			;LB-1: 0 is starting byte
	$STORE	T2,POS,<(T4)>		;Store starting byte

;Get Upper Bound argument

	MOVE	T2,UBO(P1)
	TLNE	T2,-1			;Immediate?
	 MOVE	T2,(T2)			;No
	MOVEM	T2,SAVUB		;Save
	PUSHJ	P,%CHKBD		;Check bound validity
	 JRST	KERR			;Bad
	SUBI	T2,1			;Adjust for zero start
	$FETCH	T1,POS,<(T4)>		;Get lower bound again
	CAMGE	T2,T1			;UB greater than/equal to start?
	 JRST	KERR			;No, bad argument

;Calculate key size as UB-LB+1 and store

	MOVE	T1,SAVLB		;Get user's lower bound
	MOVE	T2,SAVUB		;and upper
	SUBI	T2,-1(T1)		;UB-LB+1
	$STORE	T2,SIZ,<(T4)>		;Store in current XAB

;Get key data type

	MOVX	T2,XB$STG		;Default to string (CHARACTER)
	LDB	T1,[POINTR (DTO(P1),ARGTYP)] ;Get type
	CAIN	T1,TP%INT		;INTEGER?
	 MOVX	T2,XB$IN4		;Yes
	$STORE	T2,DTP,<(T4)>		;Store in current XAB

	$FETCH	T1,SIZ,<(T4)>		;Get key size
	CAIE	T2,XB$STG		;CHARACTER?
	 JRST	NOTCHR			;No
	SETOM	STGFLG(D)		;Yes,flag it.
	CAILE	T1,MAXCHR		;Bigger than RMS max?
	 JRST	KERR			;Yes, error
	JRST	STFLG			;No, go setup key attributes

NOTCHR: CAIE	T2,XB$IN4		;INTEGER?
	 $SNH				;No, bad arglist
	CAIE	T1,INTLEN		;Yes. Is length = 4?
	 JRST	KERR			;No. bad key value
	$STORE	T1,SIZ,<(T4)>

;Set default DUP/CHG attributes

STFLG:	MOVX	T1,XB$CHG!XB$DUP	;Default allows DUP/CHG for non-prime
	SKIPN	PXBADR			;Prime XAB (no previous)?
	 SETZ	T1,			;Yes, no DUP/CHG
	$STORE	T1,FLG,<(T4)>		;Store in current XAB

;Store the key-of-reference from AOBJN RH

	HRRZ	T1,P2
	$STORE	T1,REF,<(T4)>

;If not the first XAB allocated, establish a backward link and fill in
; X$NXT of the previous XAB.

	SKIPE	T1,PXBADR		;Was there a previous XAB?
	 $STORE	T4,NXT,<(T1)>		;Yes, store the link
	MOVEM	T4,PXBADR		;Store current XAB address in previous

;BOTTOM OF KEY_SPECIFIER LOOP

	ADDI	P1,KSPLEN		;Move arg pntr to next section
	AOBJN	P2,KEYLP		;Increment key_num, key_ref and loop

;Here after all arglist processing. Link in either FAB F$XAB or (if there
; is one) CONFIG XAB X$NXT with start of chain.

	PUSHJ	P,LNKXAB		;Link to FAB or CONFIG
	POPJ	P,			;Return

;Here on argument-invalid errors in the arglist. Since we may have allocated
; a XAB but not yet fully linked it in the chain, we must complete the link
; so everything gets properly deallocated.

KERR:	SKIPE	T1,PXBADR		;Was there a previous XAB?
	 $STORE	T4,NXT,<(T1)>		;Yes, link current to it
	PUSHJ	P,LNKXAB		;Link FAB or CONFIG
	PUSHJ	P,%RMDAB		;Deallocate everything
	PUSHJ	P,%RMDKB		; including the arglist
	MOVE	T1,KEYVAL		;Get keyword value
	MOVEI	T2,OPNSWT		;Find ASCII name for keyword
	PUSHJ	P,FNDSWT
	MOVEM	T1,%ARGNM		;Save for error
	$DCALL	IAV			;"?Ilegal value for /KEY:"


	SEGMENT	DATA

SAVLB:	BLOCK	1			;SAVE LOWER BOUND
SAVUB:	BLOCK	1			;SAVE UPPER BOUND

	SEGMENT	CODE

> ; End %IF20

	SUBTTL	%RMECK	-	Cleanup after failing FOROPN OPEN
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called after a failing FOROPN open-by-device call to DOOPEN.
;	If the file is an RMS file, performs a dummy $CLOSE to release
;	any network link.  If TOPS-10 or non-RMS, a no-op.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMECK
;	<Return here; always requests DIALOG>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)		-		Address of FAB
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T4.
;	If file is RMS, $CLOSEs FAB.
;--
;[5007] New

IF10,<
%RMECK:	POPJ	P,			;No RMS errors on TOPS10
> ;End IF10

%IF20,<
%RMECK:	SKIPN	FAB(D)			;RMS involved?
	 POPJ	P,			;No, just return
	PJRST	RLSLNK			;Yes, go do it

> ;End %IF20

	SUBTTL	LNKXAB	-	Link XAB(D)
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called on completion of Key XAB processing to link FAB FB$XAB to the
;	start of the Key chain XABs. If there is a CONFIG XAB, link its NXT
;	field instead.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,LNKXAB
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)	-	Address of FAB
;	XAB(D)	-	Address of XAB
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FAB F$XAB	-	Set to start of key chain if file is local
;	CONFIG X$NXT	-	Set to start of key chain if file is remote
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T3.
;
;--
;[5000] New

%IF20,<
LNKXAB:	MOVE	T1,FAB(D)		;Get FAB's address
	MOVE	T3,XAB(D)		;Get key chain start
	$FETCH	T2,XAB,<(T1)>		;Get FAB's link field
	JUMPN	T2,LNKCFG		;Non-zero if a CONFIG
	$STORE	T3,XAB,<(T1)>		;store start in FAB FB$XAB
	POPJ	P,			;Return

LNKCFG:	$STORE	T3,NXT,<(T2)>		;link start to CONFIG X$NXT
	POPJ	P,			;Return

> ; End %IF20
	SUBTTL	%CHKBD	-	Check KEY= bound validity
;++
; FUNCTIONAL DESCRIPTION:
;
;	Checks that a LB or UB KEY= value is valid.  LB/UB values
;	must be .GE. zero and must not be more than 17 bits.
;	(Actually the maximum RMS record size for indexed
;	records on TOPS20 results in LB/UB ceilings considerably less than 
;	17 bits; this routine checks only that a well-formed XAB chain can
;	be handed to RMS).
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%CHKBD
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	T2	-	Value to be checked
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	T2	-	Orginal value returned
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T2.
;
;--
;[5000] New

%IF20,<
%CHKBD:	JUMPLE	T2,%POPJ		;.LE. zero
	TLNN	T2,-1			;Overflow on left?
	TRNE	T2,(1B0)		;or on right?
	 POPJ	P,			;Yes, error return
	JRST	%POPJ1			;OK return

> ; End %IF20
	SUBTTL	%RMCKF	-	Check for conflicting RMS OPEN keywords
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called from FOROPN CKCONF to check for conflicting OPEN RMS 
;	keywords.  If a conflict is found, an ICA message is issued via
;	a call to OPCNF.
;
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMCKF
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	ACC(D)		-		ACCESS=
;	ORGAN(D)	-		ORGANIZATION=
;	O.KEY		-		KEY= in OPEN
;	RECTP(D)	-		RECORDTYPE=
;	RSIZE(D)	-		RECL=
;	SHARE(D)	-		SHARED
;	RO(D)		-		READONLY
;	STAT(D)		-		STATUS=
;
;	ORKYTB		-		Table by ORGANIZATION of legal/illegal
;					 KEY= values
;	ORACTB		-		Table by ORGANIZATION of illegal
;					 /ACCESS codes
;	ORRTTB		-		Table by ORGANIZATION of illegal
;					 /RECORDTYPE codes
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	If both /SHARED and /READONLY are specified, SHARE(D) and RO(D)
;	are cleared.
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T4.
;
;--
;[5000] New

IFNRMS,<					;TOPS-10 and KS build
%RMCKF:	JRST	%POPJ1
> ;End IFNRMS

%IF20,<
%RMCKF:	SETZM	IMPORG			;Clear local flag (implied ORG=)
	LOAD	T2,ACC(D)		;Get /ACCESS
	LOAD	T1,ORGAN(D)		;Get /ORGANIZATION
	CAIN	T1,OR.IDX		;If INDEXED
	 MOVX	T2,AC.KEY		;then ACCESS is KEYED
	MOVX	T3,OR.IDX		;Assume keyed
	CAIE	T2,AC.KEY		;If ACCESS='KEYED'
	SKIPE	O.KEY			;or KEY= given
	 MOVEM	T3,IMPORG		;Flag an implied ORG=INDEXED
	SKIPN	IMPORG			;If some ORG was given or implied
	CAIE	T1,OR.UNK
	 JRST	ORKY			;Have to check further

;Here for non-RMS or RSF file

	LOAD	T1,SHARE(D)		;SHARED?
	JUMPE	T1,%POPJ1		;No, all done
	PUSHJ	P,SHARO			;Check vs READONLY
	PJRST	%POPJ1			;and return

;Check /ORGANIZATION vs /KEY (if given)

ORKY:	SKIPE	O.KEY			;KEY= given?
	SKIPL	ORKYTB(T1)		;Yes. Allowed with ORG given?
	 JRST	ORAC			;Yes, OK

	SETZ	T2,			;/KEY has no value (sort of)
	MOVEI	T3,OK.ORG
	MOVEI	T4,OK.KEY
	CALL	OPCNF			;Report error

;Check /ORGANIZATION vs /ACCESS (if given)

ORAC:	SKIPN	T1,IMPORG		;Get implied ORG if any
	 LOAD	T1,ORGAN(D)		;None, use actual
	LOAD	T2,ACC(D)		;Get /ACCESS
	JUMPE	T2,NEWKEY		;None, no check
	MOVE	T3,ORACTB(T1)		;Get ACCESS/ORG entry for this ORG
	PUSHJ	P,CKFSRH		;See if this ACCESS is allowed
	 JRST	NEWKEY			;Yes, OK!

	SKIPE	O.KEY			;No. Did we use implied ORG?
	 JRST	ORAC2			;Yes, different error message

	MOVEI	T3,OK.ORG
	MOVEI	T4,OK.ACC
	PUSHJ	P,OPCNF
	JRST	NEWKEY

ORAC2:	MOVE	T1,T2			;ACCESS in T1
	SETZ	T2,			;/KEY has no value
	MOVEI	T3,OK.ACC
	MOVEI	T4,OK.KEY
	PUSHJ	P,OPCNF

;Check for STATUS='NEW' and /KEY. 

NEWKEY:	LOAD	T1,STAT(D)		;Get /STATUS
	CAIN	T1,ST.SCR		;If SCRATCH
	 MOVX	T1,ST.NEW		;it's really NEW
	CAIE	T1,ST.NEW		;NEW?
	 JRST	ORRT			;No, no further check
	SKIPE	O.KEY			;KEY= given?
	 JRST	NEWFIX			;Yes, no conflict
	SKIPN	T1,IMPORG		;Get implied or actual ORG
	 LOAD	T1,ORGAN(D)
	CAIN	T1,OR.IDX		;INDEXED?
	 PUSHJ	P,[$DCALL KER]		;?KEY= required

;Check STATUS='NEW' and RECL=.  New relative and indexed files
;default to RECORDTYPE='FIXED'.
;In this case, if no RECORDTYPE= has been specified, insist on a RECL=.
;STATUS='UNKNOWN', which may create a new file, is checked for missing
;required RECL=  at OPEN time.

;We only come here if STATUS='NEW' or 'SCRATCH'.

NEWFIX:	SKIPN	T1,IMPORG		;Get implied or actual ORG
	 LOAD	T1,ORGAN(D)
	LOAD	T2,RSIZE(D)		;Get /RECORDSIZE
	JUMPN	T2,ORRT			;Got one, no conflict
	LOAD	T2,RECTP(D)		;Get /RECORDTYPE
	JUMPN	T2,ORRT			;Got one, no conflict

;Here if STATUS='NEW' and no RECL= and no RECORDTYPE was given.

	CAIE	T1,OR.REL		;RELATIVE?
	CAIN	T1,OR.IDX		;or INDEXED?
	 PUSHJ	P,[$DCALL DFR]		;?Default /RECORDT:FIXED requires /RECL

;Check /ORGANIZATION vs RECORDTYPE

ORRT:	LOAD	T2,RECTP(D)		;Get /RECORDTYPE
	JUMPE	T2,SHAC			;None

	LOAD	T1,RSIZE(D)		;Get /RECORDSIZE
	JUMPN	T1,ORRTA		;Got one, good
	CAIN	T2,RT.FIX		;FIXED?
	 PUSHJ	P,[$DCALL FRR]		;Yes, requires a size
ORRTA:	SKIPN	T1,IMPORG		;Get implied or actual ORG
	 LOAD	T1,ORGAN(D)
	MOVE	T3,ORRTTB(T1)		;Get ORG/RECT table entry for this ORG
	PUSHJ	P,CKFSRH		;See if legal
	 JRST	SHAC			;OK!

	SKIPE	IMPORG			;Implied used?
	 JRST	ORRT2			;Yes, different error message
	MOVEI	T3,OK.ORG
	MOVEI	T4,OK.RTP
	PUSHJ	P,OPCNF
	JRST	SHAC

ORRT2:	MOVEI	T3,OK.ACC		;Assume /ACCESS conflict
	LOAD	T1,ACC(D)		;Get /ACCESS
	SKIPN	T1			;If none,
	 MOVEI	T3,OK.KEY		;must be KEY=
	MOVEI	T4,OK.RTP
	PUSHJ	P,OPCNF

;Check /SHARED and /ACCESS

SHAC:	LOAD	T1,SHARE(D)		;Get SHARED bit
	JUMPE	T1,%POPJ		;none given, all done

	LOAD	T2,ACC(D)		;Get /ACCESS
	MOVE	T3,T2			;Copy it
	JUMPE	T2,SHARO		;None given

	CAIN	T2,AC.RIN		;If it's RANDIN
	 MOVX	T2,AC.SIN		;treat like SEQIN for a moment
	CAIE	T2,AC.SIN		;Some read-onlyness?
	 JRST	SHARO			;No
	MOVE	T2,T3			;Retrieve the actual

;/SHARED was specified with an /ACCESS implying read-only.

	SETZ	T1,			;SHARE has no value
	MOVEI	T3,OK.SHR
	MOVEI	T4,OK.ACC
	PUSHJ	P,OPCNF			;Issue error
					;All done

;Check /SHARED vs /READONLY.  If both are given, clear both before
;issuing an error.  We don't get here unless /SHARED was specified.

SHARO:	LOAD	T1,RO(D)		;Get /READONLY
	JUMPE	T1,%POPJ		;None, no conflict

;Here when both were given

	SETZB	T1,T2
	STORE	T1,RO(D)		;Clear both
	STORE	T1,SHARE(D)
	MOVEI	T3,OK.SHR
	MOVEI	T4,OK.RO
	PJRST	OPCNF

;Table for legal KEY= by organization (0 is legal, -1 illegal)
ORKYTB:	0				;NONE
	-1				;SEQUENTIAL
	-1				;RELATIVE
	0				;INDEXED


	SEGMENT	DATA

IMPORG:	BLOCK	1			;Implied ORG=INDEXED

	SEGMENT	CODE

> ;End %IF20
	SUBTTL	CKFSRH	-	Search a conflict table
;++
; FUNCTIONAL DESCRIPTION:
;
;	Searches a table whose AOBJN pointer is in AC3 for a match against
;	the value in AC2.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,CKFSRH
;	<Return here if no match found>
;	<Return here if match found>
;
; INPUT PARAMETERS:
;
;	T3	-		AOBJN pointer to table
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T2-T4.
;
;--
;[5000] New

%IF20,<
CKFSRH:	MOVE	T4,(T3)			;Get table entry
	CAIN	T2,(T4)			;Match our value?
	 JRST	%POPJ1			;Yes, take +2 (error) return
	AOBJN	T3,CKFSRH		;Keep looking
	 POPJ	P,			;No, match is good


	DEFINE	TAB (ARGS) <
	.ARGN.==0
	IRP ARGS,<.ARGN.=.ARGN.+1>
	XWD	-.ARGN.,[IRP ARGS,<ARGS>]
 			   > ;End TAB

;Table for illegal ACCESS types by ORGANIZATION. A -1 allows any ACCESS
; code.  If RMS ever supports direct access to fixed-length sequential
; files, delete AC.RIN and AC.RIO from SEQUENTIAL.

ORACTB:	TAB	<-1>			;NONE
	TAB	<AC.KEY,AC.RIN,AC.RIO>	;SEQUENTIAL
	TAB	<AC.KEY,AC.APP>		;RELATIVE
	TAB	<AC.APP>		;INDEXED

;Table for illegal RECORDTYPES by ORGANIZATION. A -1 allows any RECORDTYPE.
;Note that any is allowed for SEQUENTIAL, even though RECORDTYPE=STREAM
;is disallowed for TOPS20 RMS files.  Since we don't know the operating
;system for a remote file yet, anything goes until the RMS OPEN, when
;a further check is made.

ORRTTB:	TAB	<-1>			;NONE
	TAB	<-1>			;SEQUENTIAL
	TAB	<RT.UND,RT.SCR,RT.SLF>	;RELATIVE
	TAB	<RT.UND,RT.SCR,RT.SLF>	;INDEXED

	PURGE	.ARGN.

> ;End %IF20
	SUBTTL	%RMDFA	-	Default RMS ACCESS
;++
; FUNCTIONAL DESCRIPTION:
;
;	Performs post-OPEN-arg defaulting for /ACCESS to RMS files.  If
;	ORGANIZATION='INDEXED' has been specified or implied, sets /ACCESS
;	to 'KEYED'. 
;
;	Called from FOROPN DFACC.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMDFA
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	ACC(D)		-		ACCESS=
;	ORGAN(D)	-		ORGANIZATION=
;	O.KEY		-		KEY= arglist
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	ACC(D)		-		ACCESS=
;	ORGAN(D)	-		ORGANIZATION=
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

IF10,<
%RMDFA:	POPJ	P,			;No RMS on TOPS10
> ;End IF10

%IF20,<
%RMDFA:	LOAD	T2,ORGAN(D)	;Get /ORGANIZATION
	CAIE	T2,OR.SEQ	;If given as SEQUENTIAL
	CAIN	T2,OR.REL	;or RELATIVE, 
	 POPJ	P,		;nothing to do
	MOVEI	T1,AC.KEY	;Assume ACCESS='KEYED'
	SKIPN	O.KEY		;Was KEY= given?
	CAIN	T2,OR.IDX	;or ORG='INDEXED'?
	 STORE	T1,ACC(D)	;Yes. Default to keyed-access
	LOAD	T2,ACC(D)	;Get access
	CAIE	T2,AC.KEY	;'KEYED'?
	 POPJ	P,

;Here for ACCESS='KEYED'. Set ORGANIZATION='INDEXED'.

	MOVEI	T1,OR.IDX	;Yes, /ORGANIZATION is 'INDEXED'
	STORE	T1,ORGAN(D)
	POPJ	P,		;Return

> ;End %IF20
	SUBTTL	%RMOPN	-	Open an RMS-accessed file
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine opens files with INDX(D) device types of DI.RSF
;	(remote stream) or DI.RMS (RMS).  It allocates a FAB/CONFIG XAB
;	if one does not already exist, sets FAB fields according to
;	OPEN specifiers, allocates a RAB and sets its fields, $OPENs
;	or $CREATEs the file, and $CONNECTs the RAB to the FAB. 
;
;	If a USEROPEN user routine has been specified, calls this routine
;	instead of performing the $OPEN/$CREATE/$CONNECT.
;
;	If cacheing is enabled, allocates a cache.
;
;	Updates the DDB on a successful open.
;
;	RSF files can cause the following to happen after a successful OPEN:
;
;	  o Bucket 0, the FDB page, is read in and EOFN calculated.
;	  o If random-access, a page table is setup.
;	  o If ACCESS='APPEND', the last page of the file is mapped.
;
; CALLING SEQUENCE:
;
;	Called only from FOROPN DOOPEN via OPNTAB.
;	Returns +1 on error to enter DIALOG
;	Returns +2 on success.
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)		-		Address of FAB
;	SAIDX(D)	-		STATUS/ACCESS index
;	ORGAN(D)	-		ORGANIZATION
;	ORGTAB		-		Table of RMS organization bits
;	INDX(D)		-		Device index (file type)
;	SPAN(D)		-		Non-zero if NOSPANBLOCKS
;	SHAR(D)		-		SHARED
;	RO(D)		-		READONLY
;	MAXREC(D)	-		MAXREC=
;	BUFCT(D)	-		BUFFERCOUNT (file window
;					 pages for RSF files; multi-
;					 buffercount for RMS files)
;	UOPN(D)		-		Address of USEROPEN routine
;	UBSIZ(D)	-		User-specified bytesize
;	O.KEY		-		KEY= arg pointer
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	Updates the following DDB fields before a successful return:
;
;	RSIZE(D)	-	Record size in bytes (formatted) or words
;	BSIZ(D)		-	File bytesize
;	IJFN(D)		-	-1 
;	WTAB(D)		-	-1 for RMS relative random-access files,
;				  a page table for random-access RSF files,
;				  else zero.
;	EOFN(D)		-	Set to infinity
;	IMGFLG(D)	-	Set for RSF files residing on VAX systems.
;	DDB filespec fields  -  Updated with expanded filespec
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T4.
;	Invokes RMS.
;	Will establish a network link on successful open of a remote file.
;	May call user's USEROPEN routine if present.
;	May allocate a cache.
;	May set WTAB(D) and allocate a page table
;	May cause temporary  allocation of 1 page for FDB bucket for
;	 RSF files
;	May cause BUFCT-pages mapped to EOF for RSF files opened
;	 ACCESS='APPEND'
;
;--
;[5000] New

IF10,<
%RMOPN:	$SNH				;Should NOT get here on TOPS-10
> ;End IF10

%IF20,<
LWSIZ==9
PSIZ==1000				;Words/page

FB$ALL==FB$GET!FB$PUT!FB$DEL!FB$UPD!FB$TRN ;Full access

%RMOPN:	SKIPN	T1,FAB(D)		;Already have a FAB?
	 PUSHJ	P,RMFAB			;No, allocate one
	MOVEM	T1,FAB(D)		;Save its address
	MOVE	T1,[POINT 7,%TXTBF]	;Setup to get DDB filespec
	PUSHJ	P,%RMFNS		;Get it
	MOVE	T4,FAB(D)		;Get FAB address again
	$STORE	T1,FNA,<(T4)>		;Set filespec in FNA

;Initialize NAM block, also scratch argument blocks, and point FAB NAM
; to the NAM block.

	PUSHJ	P,ABINI			;Initialize some argument blocks
	XMOVEI	T1,NAMBLK		;Point to NAM blk
	$STORE	T1,NAM,<(T4)>

;Setup FAC field according to STATUS/ACCESS value. 

SETFAC:	LOAD	T1,SAIDX(D)		;Get STATUS/ACCESS
	MOVE	T1,FACTAB(T1)		;Get corresponding RMS bits
	LOAD	T2,RO(D)		;Get READONLY bit
	SKIPE	T2			;Set?
	 MOVX	T1,FB$GET		;Yes, set read access only
	$STORE	T1,FAC,<(T4)>		;in FAC of FAB

;Setup ORG field from ORGANIZATION specified. If no ORGANIZATION was
; specified (RSF file or implicit VAX sequential file), ORGAN(D) is zero
; and we default to OR.SEQ.

SETORG:	LOAD	T1,ORGAN(D)		;Get ORGANIZATION
	HLRZ	T1,ORGTAB(T1)		;Get org bits
	$STORE	T1,ORG,<(T4)>

;If SHARED was specified, set the SHR field to full write sharing, else to
; FB$GET, the RMS default.

SETSHR:	MOVX	T2,FB$GET		;Assume no SHARE
	LOAD	T1,SHARE(D)		;Get SHARE bit
	SKIPE	T1			;Any specified?
	 MOVX	T2,FB$GET!FB$PUT!FB$DEL!FB$UPD ;Yes, allow lots
	$STORE	T2,SHR,<(T4)>		;Set in SHR

;Setup MRN field from the MAXREC keyword. If none given, MRN=0 and
; RMS does not check for maximum record number.

	MOVE	T2,MAXREC(D)		;[5016] Get MAXREC
	$STORE	T2,MRN,<(T4)>		;[5016] Store into MRS

;Set RAT to NOSPANBLOCKS or zero.

	LOAD	T1,INDX(D)		;Get file type
	CAIE	T1,DI.RMS		;RMS?
	 JRST	SETTYP			;No, ignore NOSPANBLOCKS

	SETZ	T2,			;Assume none
	LOAD	T1,SPAN(D)		;Get "SPAN" bit
	SKIPE	T1			;Set?
	 MOVX	T2,FB$BLK		;Yes
	$STORE	T2,RAT,<(T4)>		;Store or clear
	SETZ	T2,			;Clear any TYP link
	$STORE	T2,TYP,<(T4)>
	JRST	SETRAB			;Go setup RAB

;For RSF files, point to the TYP block for block-mode I/O.

SETTYP: XMOVEI	T2,TYPBLK		;Yes
	$STORE	T2,TYP,<(T4)>		;Set it, or clear it

;Here after FAB fields are all set. Allocate a RAB and set it up.

SETRAB:	SKIPE	T1,RAB(D)		;Get a fresh RAB
	 PUSHJ	P,%FREBLK
	PUSHJ	P,RMRAB			;Declare a RAB
	MOVEM	T1,RAB(D)		;Save its address
	MOVE	T4,T1			;Copy it
	MOVE	T1,FAB(D)		;Get FAB address
	$STORE	T1,FAB,<(T4)>		;Link RAB to it

;Here to set RAC (record access) field. For now, just set to RB$SEQ. RMS 
; relative file direct READ/WRITEs will set RAC to RB$KEY, as will all indexed
; WRITEs. Indexed READs will set to either SEQ or KEY.

SETRAC:	MOVX	T2,RB$SEQ		;Default to sequential
	$STORE	T2,RAC,<(T4)>

;Here when FAB and RAB are all set. If there is a USEROPEN routine, call
; it to $OPEN and $CONNECT the file; otherwise we do.

	PUSHJ	P,FIXUP			;Do last minute fixup
	 POPJ	P,			;Can't, enter DIALOG

;*NOTE: After FIXUP has been called for remote files, a network link
;is now established and open.  Any $DCALL during OPEN processing from
;now on must ensure that the remote link is relinquished.  This is
;accomplished by the +1 return out of %RMOPN caused by a $DCALL, which
;returns to DOOPEN and calls %RMECK to perform a dummy $CLOSE on
;the FAB.

	PUSHJ	P,APPCHK		;Set ROP for ACCESS=APPEND
	SKIPN	T1,UOPN(D)		;Anything to call?
	 JRST	NOUOPN			;No

	PUSHJ	P,CALUOP		;Yes, call it
	 POPJ	P,			;Failed, enter DIALOG
	JRST	RMORET			;Succeeded, go finish up

;Here with no USEROPEN. OPEN/CREATE the file by STATUS/ACCESS index.
; This resolves to 4 courses of action:
;
;	1) $OPEN the file; if this fails, $CREATE it.
;	2) $CREATE the file; if this fails, $OPEN it.
;	3) $OPEN the file; if this fails, abort.
;	4) $CREATE the file (with a new generation if necessary); if
;	   this fails, abort.
;

NOUOPN:	LOAD	T1,SAIDX(D)		;Get STATUS/ACCESS index
	PUSHJ	P,RMOTB(T1)		;Open the file
	 POPJ	P,			;Can't, take error return

	PUSHJ	P,FABSTV		;Update STV

;Here when the OPEN has succeeded. Check return values, $CONNECT RAB to
; FAB if no USEROPEN, update the DDB, and return.


;Check returned ORG value against what user specified.

RMORET:	LOAD	T1,ORGAN(D)		;Get user's value
	HLRZ	T1,ORGTAB(T1)		;Get corresponding RMS bits
	MOVE	T4,FAB(D)		;Get FAB address
	$FETCH	T2,ORG,<(T4)>		;Get actual
	CAMN	T1,T2			;Same?
	 JRST	UPDDDB			;Yes

	XMOVEI	T1,[ASCIZ /ORGANIZATION/] ;No
	$DCALL	ATC			;?File's ORGANIZATION conflicts
					; with OPEN statement or default


;Check return BSZ (byte-size). If user specified one, and it conflicts
; with the actual returned size (TOPS files only), complain. If the
; user specified a size and the file is non-TOPS, BYTESIZE must equal 8;
; if no size was specified for a non-TOPS file, set it to 8.

UPDDDB:	MOVEI	T1,^D8			;Assume non-TOPS
	PUSHJ	P,NTTOPS		;Alien environment?
	 $FETCH	T1,BSZ,<(T4)>		;No. Get RMS's size
	LOAD	T2,UBSIZ(D)		;Get user-specified size
	JUMPE	T2,RESBSZ		;None given, use returned
	LOAD	T3,INDX(D)		;Get file type
	CAIN	T3,DI.RSF		;RSF?
	 JRST	UPDDB2			;Yes, check later from FDB
	CAIE	T1,(T2)			;Same?
	 $ECALL	BSC			;No. Give conflict warning

RESBSZ:	STORE	T1,BSIZ(D)		;Store returned size
	PUSHJ	P,CHKBSZ		;Update BPW, etc.

UPDDB2:	PUSHJ	P,CHKRET		;Check other returned RMS values
	 POPJ	P,			;Some conflict, enter DIALOG


;Here to connect RAB to FAB if no USEROPEN.

CONRAB:	SKIPE	UOPN(D)			;Any USEROPEN
	 JRST	SWTB			;Yes, already $CONNECT'd, presumably

	PUSHJ	P,CONN$			;Do $CONNECT
	 JRST	RMOER3			;Error

SWTB:	PUSHJ	P,SETWTB		;Setup WTAB, WSIZE, RSF EOF
	SETZM	O.KEY			;Clear any KEY= pntr
	JRST	%POPJ1			;Done with OPEN

RMOTB:	JRST	OPCRE			;UNKNOWN, READ
	JRST	CRERX			;UNKNOWN, WRITE
	JRST	CREOP			;UNKNOWN, READ, WRITE
	JRST	OPCRE			;UNKNOWN, APPEND
	JRST	OPERX			;OLD, READ
	JRST	OPERX			;OLD, WRITE
	JRST	OPERX			;OLD, READ, WRITE
	JRST	OPERX			;OLD, APPEND
	JRST	CRERN			;NEW, WRITE
	JRST	CRERX			;NEW, SCRATCH

FACTAB:	FB$GET				;UNKNOWN, READ
	FB$ALL				;UNKNOWN, WRITE
	FB$ALL				;UNKNOWN, READ, WRITE
	FB$ALL				;UNKNOWN, APPEND
	FB$GET				;OLD, READ
	FB$ALL				;OLD, WRITE
	FB$ALL				;OLD, READ, WRITE
	FB$ALL				;OLD, APPEND 
	FB$ALL				;NEW, WRITE
	FB$ALL				;SCRATCH, WRITE

ORGTAB:	FB$SEQ,,OR.UNK			;NONE
	FB$SEQ,,OR.SEQ			;SEQUENTIAL
	FB$REL,,OR.REL			;RELATIVE
	FB$IDX,,OR.IDX			;INDEXED

;Table for mapping returned RMS record-format values to FOROTS recordtypes
; for RMS files. RH -1 means "this RMS value not supported by FOROTS for RMS
; files"--the only ones currently being STREAM  and LSA records in RMS
; sequential files.

RTTAB:	FB$STM,,-1			;(RT.UNS) NONE
	FB$STM,,-1			;(RT.UND) UNDEFINED 
	FB$FIX,,RT.FIX			;(RT.FIX) FIXED
	FB$VAR,,RT.DEL			;(RT.DEL) VARIABLE
	FB$STM,,-1			;(RT.SEG) SEGMENTED
	FB$LSA,,-1			;LINE-SEQUENCED 
	-1				;Table end

;Special table for VAX RMS recordformats. Allows almost all RFMs for RMS
; files
VRTTAB:	FB$STM,,RT.UND
	FB$STM,,RT.UND
	FB$FIX,,RT.FIX
	FB$VAR,,RT.DEL
	FB$STM,,RT.UND
	FB$LSA,,-1
	-1


;$OPEN the file. This failing, $CREATE it. That failing, abort. 

OPCRE:	PUSHJ	P,OPEN$			;Do $OPEN
	 JRST	OPCREX			;Error
	JRST	%POPJ1			;Return

;Here after a failing OPEN to $CREATE.

OPCREX:	CAIE	T2,ER$FNF		;Was error "File not found"?
	 JRST	RMOER3			;No, this is bad

	PUSHJ	P,DFRFMN		;Default RFM for new RMS files
	 POPJ	P,			;Some conflict, enter DIALOG

	MOVX	T1,FB$ALL		;Reset to full access
	MOVE	T4,FAB(D)		;Get FAB address
	$STORE	T1,FAC,<(T4)>		;Store

	PUSHJ	P,CREA$			;Do $CREATE
	 JRST	RMOERR			;Error
	JRST	%POPJ1			;OK

;$CREATE the file. This failing, $OPEN it. That failing, abort.

CREOP:	LOAD	T1,OSTYPE(D)		;Get OS type
	CAIN	T1,XA$VMS		;VMS?
	 JRST	OPCRE			;Yes, must do it backwards
	PUSHJ	P,DFRFMN		;Default RFM for new RMS files
	 POPJ	P,			;Some conflict, enter DIALOG

	PUSHJ	P,CREA$			;Do $CREATE
	 JRST	CREOPX			;Error
	JRST	%POPJ1

;Here when the $CREATE failed. If the error is ER$FEX (file already
; exists), we try to $OPEN it.

CREOPX:	CAIE	T2,ER$FEX		;Was error "File already exists"?
	 JRST	RMOER3			;No, this is bad

OPERX:	PUSHJ	P,OPEN$			;Do $OPEN
	 JRST	RMOERR			;Error
	JRST	%POPJ1			;OK

;Here to $CREATE a new file. Set FAB(D) FOP to FB$SUP to supercede an
; existing file. If an explicit generation was given for STATUS='NEW',
; leave SUP off so the $CREATE will fail if the file exists.

CRERN:	HRROI	T1,GEN(D)		;STATUS='NEW'. Look at generation
	MOVX	T3,^D10
	NIN%				;See if explicit gen given
	 ERJMP	CRERX			;Assume none
	JUMPLE	T2,CRERX		;0 or neg means no explicit
	SETZ	T2,			;Gen given, setup to turn off SUP
	TRNA				;Skip SUP
CRERX:	MOVX	T2,FB$SUP		;Get supercede bits
	MOVE	T4,FAB(D)		;Get FAB address
	$STORE	T2,FOP,<(T4)>		;Set SUP
	PUSHJ	P,DFRFMN		;Default RFM for new RMS files
	 POPJ	P,			;Some conflict, enter DIALOG

	PUSHJ	P,CREA$			;Do $CREATE
	 JRST	RMOERR			;Error
	$FETCH	T1,FOP,<(T4)>		;Turn SUP off
	TXZ	T1,FB$SUP		;Thusly
	$STORE	T1,FOP,<(T4)>		;reset it
	JRST	%POPJ1			;Success return

;Here on $OPEN/$CREATE errors.

RMOERR:	CAIE	T2,ER$REF		;Indexed Key XAB skew?
	 JRST	RMOER3			;No, something fatal

	PUSHJ	P,OPEN$			;Do $OPEN
	 JRST	RMOER3			;Error
	JRST	%POPJ1			;OK

RMOER3:	SETZ	T2,			;Setup to clear FOP
	$STORE	T2,FOP,<(T1)>		;Turn off any FOP bits
	PUSHJ	P,RMDUXB		;Deallocate any XAB chain
	$DCALL	OPN			;Complain

> ; End %IF20
	SUBTTL	FIXUP	-	Do last minute pre-$OPEN settings
;++
; FUNCTIONAL DESCRIPTION:
;
;	This jacket routine calls last-minute fixup routines to set
;	various FAB parameters and check for inconsistencies which
;	can only be detected when the target operating system is known.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,FIXUP
;	<Error return; go release any remote link>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--
;[5000] New

%IF20,<
FIXUP:	PUSHJ	P,GETOST		;Determine OS type, last minute fixup
	 POPJ	P,			;Can't, take error return
	PUSHJ	P,SETBSZ		;Set/default bytesize
	 POPJ	P,			;Some conflict, take error return
	PUSHJ	P,SETRFM		;Set/default RECORDTYPE
	 POPJ	P,			;Some conflict, take error return
	PJRST	%POPJ1			;OK, take success return

> ; End %IF20
	SUBTTL	GETOST	-	Determine OS type
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine is called just prior to any $OPEN or $CREATE (including
;	USEROPEN functions) to do a $PARSE with OFP (output file parse) set
;	to determine the operating system for remote files. It is a no-op
;	for local files. If the remote system is VAX, change INDX(D) to
;	DI.RMS (since all VAX files are RMS files) and back out of any RSF
;	setup (TYP block links, UDF RFM, etc.) which may already have been
;	done on the assumption that the file is RSF.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,GETOST
;	<Return here for error>
;	<Return here on success>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	NODNAM(D)	-	Node name
;	INDX(D)		-	Device index
;	FAB(D)		-	Address of FAB
;	FORM(D)		-	FORM=
;	ORGAN(D)	-	ORGANIZATION
;	CC(U)		-	CARRIAGECONTROL
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	INDX(D)		-	Reset to DI.RMS for VAX, DI.RSF is
;				TOPS and RECORDTYPE=STREAM, STREAM_CR/LF
;	FAB(D)	FOP	-	Set to OFP before the $PARSE.
;		ORG	-	Defaulted to SEQUENTIAL
;		RAT	-	Set to FB$FTN for VAX CC=FORTRAN
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T4.
;
;--

;[5000] New

%IF20,<
GETOST:	SKIPN	NODNAM(D)		;Is file remote?
	 JRST	%POPJ1			;No, just return

	PUSHJ	P,OFPARS		;Do an OFP $PARSE
	 JRST	RMOERR			;Error

	PUSHJ	P,FETOST		;Get OS type in OSTYPE(D)
	PUSHJ	P,VALOST		;Do we support it?
	 JRST	UNSOP			;No, abort

	CAIE	T2,XA$VMS		;Is it VMS?
	 JRST	%POPJ1			;No, all done

;Here for remote access to VMS. Reset the INDX(D) to DI.RMS, default
; organization to SEQ and check SHR defaulting

	MOVEI	T1,DI.RMS		;Yes. Get code for RMS filetype
	STORE	T1,INDX(D)		;It's now an RMS file

	SETZ	T1,			;Break any TYP link
	$STORE	T1,TYP,<(T4)>

	LOAD	T1,ORGAN(D)		;Get ORGANIZATION
	JUMPN	T1,VAXSHR		;Got one

	MOVX	T1,FB$SEQ		;If none, default to SEQ
	$STORE	T1,ORG,<(T4)>		;Set it
	MOVEI	T1,OR.SEQ		;also tell FOROTS
	STORE	T1,ORGAN(D)

;If the file is sequential and we want PUT access to it, change the
; default SHR from GET to NIL, since this is the way VAX defaults for
; these files.

VAXSHR:	$FETCH	T1,ORG,<(T4)>		;Get ORG value
	CAIE	T1,FB$SEQ		;SEQUENTIAL?
	 JRST	%POPJ1			;No, all done
	$FETCH	T2,FAC,<(T4)>		;Get FAC
	MOVX	T1,FB$NIL		;Assume PUT is on
	TXNE	T2,FB$PUT		;Was it?
	 $STORE	T1,SHR,<(T4)>		;Yes, SHR=NIL
	JRST	%POPJ1			;Done

UNSOP:	MOVEI	T1,NODNAM(D)
	$DCALL	URS			;?Unsupported remote system

> ; End %IF20
	SUBTTL	OFPARS	-	Do an OFP $PARSE
;++
; FUNCTIONAL DESCRIPTION:
;
;	OFP $PARSE to exchange configuration messages.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,OFPARS
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)		-		Address of FAB
;		FOP			OFP set, cleared on success
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T2,T4.
;
;--
;[5000] New

%IF20,<
OFPARS:	MOVE	T4,FAB(D)		;Yes. Get FAB address
	$FETCH	T2,FOP,<(T4)>		;Turn on OFP bit
	TXO	T2,FB$OFP
	$STORE	T2,FOP,<(T4)>		; in FOP

	PUSHJ	P,PARS$			;Do $PARSE
	 JFCL				;Ignore errors for a moment

	$FETCH	T2,FOP,<(T4)>		;Turn off OFP for later OPEN
	TXZ	T2,FB$OFP
	$STORE	T2,FOP,<(T4)>		;Reset it
	PUSHJ	P,RLFJFN		;If RMS gave us a JFN, toss it
	LOAD	T2,STS(D)		;Get $PARSE status
	CAIGE	T2,ER$MIN		;Error?
	 JRST	%POPJ1			;OK return
	POPJ	P,			;Error return

> ;End %IF20

	SUBTTL	RLFJFN	-	Toss an RMS-returned JFN
;++
; FUNCTIONAL DESCRIPTION:
;
;	If the FAB's JFN field is non-zero after an RMS $PARSE or
;	other service call, toss the JFN and zero the field
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RLFJFN
;	<Return here>
;
; INPUT PARAMETERS:
;
;	T4			-		Address of FAB
;
; IMPLICIT INPUTS:
;
;	FAB(D)	JFN		-		FAB returned JFN field
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FAB(D)	JFN		-		Zeroed
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;
;--
;[5000] New

%IF20,<
RLFJFN:	$FETCH	T1,JFN,<(T4)>			;Get JFN, 
	JUMPE	T1,%POPJ			;if any
	RLJFN%					;Release it
	 ERJMP	.+1				;We tried
	SETZ	T1,
	$STORE	T1,JFN,<(T4)>			;Clear the field
	POPJ	P,				;Return

> ;End %IF20
	SUBTTL	VALOST	-	Validate a remote operating system
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called with the returned OS type code from the CONFIG XAB in T2.
;	Returns +1 if the remote system is not supported for Fortran I/O,
;	else +2.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,VALOST
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	T2		-		OS code from CONFIG XAB
;
; IMPLICIT INPUTS:
;
;	OSTAB		-		Table of supported remote systems
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T3.
;
;--
;[5000] New

%IF20,<
VALOST:	MOVEI	T1,OSTAB		;Point at table of supported OS's.
VALOOP:	MOVE	T3,(T1)			;Get an entry
	JUMPE	T3,%POPJ		;End of table and no match
	CAME	T2,T3			;Found it?
	 AOJA	T1,VALOOP		;No, keep looking
	JRST	%POPJ1			;Yes, return +1

;Table of remote operating systems supported by Fortran

OSTAB:	XA$T20				;TOPS20
	XA$VMS				;VAX
	0				;Table end

> ; End %IF20
	SUBTTL	SETBSZ	-	Set/default Bytesize
;++
; FUNCTIONAL DESCRIPTION:
;
;	If a BYTESIZE= was specified, set the FAB to it and calculate bytes/
;	word.  If none, default TOPS files by MODE and set non-TOPS files
;	to 8.  Produce an error for non-TOPS files with BYTESIZE not
;	equal to 8.  Produce an error for TOPS indexed files with KEY= 
;	datatype of CHARACTER if BYTESIZE is not equal to 7.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,SETBSZ
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)		-		Address of FAB
;	UBSIZ(D)	-		BYTESIZE=
;	MODE(D)		-		MODE=
;	STGFLG(D)	-		Non-zero if KEY= contains datatype
;					 CHARACTER
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FAB(D)	BSZ	-		Bytesize
;	BSIZ(D)		-		File bytesize
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4
;
;--
;[5000] New

%IF20,<
SETBSZ:	LOAD	T1,UBSIZ(D)		;Did user specify a size?
	STORE	T1,BSIZ(D)		;(set it in any case)
	JUMPN	T1,CHKBPW		;Yes, check for non-TOPS size

	PUSHJ	P,NTTOPS		;No. TOPS file?
	 JRST	TOPBSZ			;Yes, default by MODE

	MOVEI	T1,^D8			;Non-TOPS. Default to 8
	STORE	T1,BSIZ(D)
	JRST	SETBPW			; and go set it up

TOPBSZ:	LOAD	T1,MODE(D)		;Set by mode
	LOAD	T2,INDX(D)		;If RMS file
	CAIN	T2,DI.RMS
	 MOVX	T1,MD.ASC		;It's really ascii
	MOVE	T2,BSTAB(T1)		;Get local byte size by mode
	STORE	T2,BSIZ(D)		;Save
	JRST	SETBPW			;Go set it up

CHKBPW:	PUSHJ	P,NTTOPS		;Non-TOPS file?
	 JRST	STGCHK			;TOPS, check for STG datatype

	LOAD	T1,BSIZ(D)		;Non-TOPS, better be 8
	CAIE	T1,^D8
	 $DCALL	BME			;?Bytesize must be eight

SETBPW:	PUSHJ	P,CHKBSZ		;Go setup BPW, etc
	LOAD	T2,BSIZ(D)		;Get size again
	MOVE	T4,FAB(D)		;Get FAB address again
	$STORE	T2,BSZ,<(T4)>		;Store it for RMS
	JRST	%POPJ1			;Take success return

STGCHK:	SKIPN	STGFLG(D)		;XABs have STG datatype?
	 JRST	SETBPW			;No, OK

	LOAD	T1,BSIZ(D)		;Yes, bytesize must be 7
	CAIE	T1,7
	 $DCALL	KDB			;"?Key datatype conflicts with BSZ"
	JRST	SETBPW

> ; End %IF20
	SUBTTL	SETRFM	-	Set/default RECORDTYPE/RFM
;++
; FUNCTIONAL DESCRIPTION:
;
;	Setup RFM for all RSF files and for RMS files for which a user
;	RECORDTYPE= value exists.  Set MRS appropriately for file-type.
;
;	RSF files always set RFM to UDF (and FAC to BRO) for block-mode
;	I/O.
;
;	MRS is set to either the user's RECL or, if no 	RECL, to a
;	slightly bogus value of one.  MRS must be non-zero
;	for RSF files, since if zero RMS will ignore the specified 
;	bytesize and create a 7-bit file,
;
;	RMS files are equally tortuous, in order to conform to the
;	VMS RECORDTYPE defaulting scheme.  MRS is set according to the
;	user's RECL: if the file contains fixed-length records, RECL
;	specifies the size of each record; if variable, it specifies
;	the maximum record length; if absent, RMS does not check for
;	maximum record length.  If a RECORDTYPE= exists, we set RFM
;	to it now; if it is absent, this routine leaves RFM untouched
;	and the RFM is set just before the actual OPEN depending on
;	whether the file exists or not.  If it exists, the file's
;	permanent RFM is used; if a new file, we then default as follows
;	(mostly VAX compatibly):
;
;	ORGANIZATION=RELATIVE or INDEXED:		RFM=FIXED
;	All other RMS files:				RFM=VARIABLE
;
;	Note that RMS-20 does not support random-access to fixed-length
;	sequential files.
;
;	This routine checks that a specified RECORDTYPE is legal for
;	the file type in question.

; CALLING SEQUENCE:
;
;	PUSHJ	P,SETRFM
;	<Error return>
;	<Sucess return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)		-	Address of FAB
;	INDX(D)		-	Device index
;	RECTP(D)	-	RECORDTYPE
;	ORGAN(D)	-	ORGANIZATION
;	RSIZ(D)		-	RECORDSIZE
;	FORM(D)		-	FORM=
;	RTTAB		-	Table of supported TOPS RMS recordtypes
;	VRTTAB		-	Table of supported VMS RMS recordtypes
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FAB(D) RFM	-	Set to FB$UDF for all RSF files.
;	       FAC	-	Set to BRO for RSF
;	       MRS	-	Set to maximum recordsize in bytes
;	       MBF	-	Set to user's BUFFERCOUNT for RMS files
;	MRSIZE(D)	-	Set to user's MRS
;	FRSIZB(D)	-	Set to user's MRS
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T4.
;
;--

;[5000] New

%IF20,<
SETRFM:	MOVE	T4,FAB(D)		;Get FAB address
	LOAD	T1,INDX(D)		;Get file type
	CAIE	T1,DI.RSF		;RSF?
	 JRST	RMSRFM			;No, set RMS RFM

	LOAD	T1,RECTP(D)		;Get user's RECTP
	JUMPE	T1,RSFUDF		;None
	CAIE	T1,RT.UND		;If given, must be stream
	 JRST	UNSRFM			;It isn't, go complain

;Here for RSF files

RSFUDF:	MOVX	T1,FB$UDF		;Set to UDF
	$STORE	T1,RFM,<(T4)>
	$FETCH	T1,FAC,<(T4)>		;Set BRO in the FAC
	TXO	T1,FB$BRO
	$STORE	T1,FAC,<(T4)>

	LOAD	T1,RSIZE(D)		;Get RECORDSIZE=
	JUMPN	T1,SETMRS		;Got one

	MOVEI	T1,1			;No, fake an MRS
	$STORE	T1,MRS,<(T4)>
	JRST	%POPJ1			;And take success return

RMSRFM:	LOAD	T1,RECTP(D)		;Get RECORDTYPE
	JUMPE	T1,SETMRS		;None, set MRS
	MOVEI	T2,RTTAB		;Point at TOPS table
	MOVE	T3,OSTYPE(D)		;But check if VMS system
	CAIN	T3,XA$VMS		;VMS?
	 MOVEI	T2,VRTTAB		;Yes, use non-restrictive table
	ADDI	T2,(T1)			;Point at correct entry
	HRRE	T3,(T2)			;Get value
	JUMPL	T3,UNSRFM		;Not supported
	HLRZ	T2,(T2)			;OK, get RMS equivalent
	$STORE	T2,RFM,<(T4)>		;Set RFM

	PUSHJ	P,RMSCC			;Go check CC for RMS files

SETMRS:	LOAD	T1,RSIZE(D)		;Get RECORDSIZE
	LOAD	T2,FORM(D)		;Get FORM=
	CAIE	T2,FM.FORM		;FORMATTED?
	 IMUL	T1,BPW(D)		;No, convert to bytes
	$STORE	T1,MRS,<(T4)>		;Set as MRS
	JRST	%POPJ1			;Take success return

> ; End %IF20
	SUBTTL	RMSCC	-	Check CARRIAGECONTROL for RMS files
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called only for RMS files.  Checks/defaults CC as follows:
;
;	If CC=TRANSLATED, reset it to FORTRAN.  TRANSLATED makes no sense
;	for RMS files, and VMS can't stand embedded carriagecontrol from
;	a TOPS.
;
;	Since VMS will convert CC=FORTRAN for RECORDTYPE=STREAM files
;	to "implied carriage control" from a remote system, reset
;	to VARIABLE if non-TOPS.
;
;	If CC=FORTRAN (the default for non-STREAM RMS files), set the
;	RAT FTN bit if the remote system is non-TOPS.  For VMS and others,
;	FTN CC is a record attribute, not a file attribute.  RAT FB$FTN
;	should never be set for a TOPS RMS file, since the RMSFAL will
;	then do its best to convert the RMS file into a STREAM file.
;	
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RMSCC
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	CC(U)		-		CARRIAGECONTROL
;	FAB(D)		-		Address of FAB
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	CC(U)		-		Reset to FORTRAN if TRANSLATED
;	FAB(D)	RAT	-		Set to FB$FTN is system is non-
;					TOPS and CC=FORTRAN
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;
;--
;[5000] New

%IF20,<
RMSCC:	LOAD	T1,CC(U)		;Get CARRIAGECONTROL
	CAIN	T1,CC.TRN		;TRANSLATED?
	 MOVX	T1,CC.FOR		;Yes, reset to CC=FORTRAN
	STORE	T1,CC(U)

	CAIN	T1,CC.FOR		;If not CC=FORTRAN
	PUSHJ	P,NTTOPS		; or system is TOPS
	 POPJ	P,			; then all done

;System is remote non-TOPS and CC=FORTRAN.  The attribute will not be
;honored by most remote systems, so change the RECORDTYPE to VARIABLE.

	MOVE	T4,FAB(D)		;Get FAB address
	$FETCH	T1,RAT,<(T4)>		;Get RAT bits
	TXO	T1,FB$FTN		;Turn on FTN
	$STORE	T1,RAT,<(T4)>		;Put back
	LOAD	T1,RECTP(D)		;Get RECORDTYPE
	CAIN	T1,RT.UNS		;None given, or
	 MOVX	T1,RT.UND		;STREAM?
	CAIE	T1,RT.UND
	 POPJ	P,			;No
	MOVX	T2,FB$VAR		;Yes, switch to VARIABLE
	$STORE	T2,RFM,<(T4)>		; for both RMS
	MOVX	T2,RT.DEL
	STORE	T2,RECTP(D)		; and FOROTS
	POPJ	P,

> ;End %IF20
	SUBTTL	DFRFMN	-	Default RMS RFM for new files
;++
; FUNCTIONAL DESCRIPTION:
;
;	A no-op for RSF files and for RMS files for which a RECORDTYPE
;	has been specified.  This routine defaults the RFM just before
;	a $CREATE to FIXED for relative or indexed files and for direct-
;	access sequential files, and to VARIABLE for all other RMS files.
;
;	For STATUS='UNKNOWN' indexed files, check whether a KEY= has
;	been specified when $CREATEing a new file.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,DFRFMN
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)		-		FAB address
;	INDX(D)		-		File type
;	RECTP(D)	-		RECORDTYPE=
;	ORGAN(D)	-		ORGANIZATION=
;	ACC(D)		-		ACCESS=
;	RSIZE(D)	-		RECORDSIZE=
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FAB(D)	RFM	-		Default RFM
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--
;[5000] New

%IF20,<
DFRFMN:	LOAD	T1,INDX(D)		;Get file type
	CAIE	T1,DI.RMS		;RMS file?
	 JRST	%POPJ1			;No, a no-op

	LOAD	T1,ORGAN(D)		;Get ORGANIZATION
	LOAD	T2,RSIZE(D)		;Get RECL
	JUMPN	T2,DFRFM1		;Got one
	CAIE	T1,OR.REL		;RELATIVE?
	CAIN	T1,OR.IDX		;or INDEXED?
	 $DCALL	RIR			;Yes, must have RECL=

DFRFM1:	CAIE	T1,OR.IDX		;INDEXED?
	 JRST	DFRFM2			;No

	LOAD	T1,SAIDX(D)		;Get STATUS/ACCESS index
	CAIN	T1,SA.URW		;UNKNOWN R/W (random)?
	 JRST	DFRFM2			;Yes, don't require XABs
	SKIPN	XAB(D)			;KEY= given for new file?
	 JRST	NPKERR			;No, give ER$NPK

DFRFM2:	LOAD	T2,RECTP(D)		;Yes, get RECORDTYPE
	JUMPN	T2,%POPJ1		;Got one, RFM already set

;Here to figure out appropriate RFM default based on file and access

	CAIE	T1,OR.REL		;RELATIVE?
	CAIN	T1,OR.IDX		;or INDEXED?
	 JRST	FIXRFM			;Yes, default to FIXED

;The following check is unnecessary until RMS implements direct-access
; to fixed-length sequential files.

	LOAD	T1,ACC(D)		;It's SEQUENTIAL, get access
	CAIE	T1,AC.RIO		;DIRECT?
	CAIN	T1,AC.RIN
	 JRST	FIXRFM			;Yes, default is FIXED
	SKIPA	T2,[FB$VAR]
FIXRFM:	MOVX	T2,FB$FIX
	MOVE	T4,FAB(D)		;Get FAB address
	$STORE	T2,RFM,<(T4)>		;Set in FAB
	LOAD	T1,RSIZE(D)		;Get RECL
	JUMPN	T1,%POPJ1		;Got one
	CAIN	T2,FB$FIX		;Did we default to FIXED?
	 $DCALL	DFR			;?Default /RECT:FIXED requires /RECL

	JRST	%POPJ1			;Return

NPKERR:	MOVE	T1,FAB(D)
	MOVX	T2,ER$NPK		;We fake an NPK error
	SETZ	T3,
	PUSHJ	P,MAKSTS
	JRST	RMOER3			;Go fail

> ; End %IF20
	SUBTTL	APPCHK	-	Set ROP for ACCESS='APPEND'
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine sets ROP to EOF for RMS files for which ACCESS=
;	'APPEND'. It is a no-op for RSF files, as block-mode does not
;	provide for EOF positioning on an OPEN. Append RSF files have their
;	last page mapped in after the OPEN.  
;
;	Also sets MBF (multibuffercount) from UBUFCT(D), the user's
;	BUFFERCOUNT, else defaults to RMS's MBF.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,APPCHK
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	INDX(D)		-		Device type
;	ACC(D)		-		ACCESS=
;	RAB(D)		-		Address of RAB
;	UBUFCT(D)	-		User's BUFFERCOUNT
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	ACC(D)		-		Set to AC.SOU if ACCESS='APPEND'
;	RAB(D)	ROP	-		Set to RB$EOF for append-access RMS
;					 files
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T4.
;
;--
;[5000] New

%IF20,<
APPCHK:	LOAD	T1,INDX(D)		;Get file type
	CAIN	T1,DI.RSF		;RSF?
	 POPJ	P,			;Yes, just return

	MOVE	T4,RAB(D)		;Get RAB address
	LOAD	T1,UBUFCT(D)		;Get user's BUFFERCOUNT
	$STORE	T1,MBF,<(T4)>
	LOAD	T1,ACC(D)		;Get ACCESS
	CAIE	T1,AC.APP		;'APPEND'?
	 POPJ	P,			;No, don't reset anything

	MOVEI	T1,AC.SOU		;Yes, set SEQUENTIAL
	STORE	T1,ACC(D)
	PUSHJ	P,EOFON			;Turn on EOF
	POPJ	P,

> ; End %IF20
	SUBTTL	CHKRET	-	Check post-OPEN values and update DDB
;++
; FUNCTIONAL DESCRIPTION:
;
;	This jacket routine calls routines to check that RMS-returned
;	file attributes match those specified in the user's OPEN statement.
;
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,CHKRET
;	<Error return; DIALOG will be entered>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--
;[5000] New

%IF20,<
CHKRET:	PUSHJ	P,RETRCT		;Update returned RFM/RECTP value
	 POPJ	P,			;Conflict, error return
	PUSHJ	P,RETMRS		;Check returned MRS value
	 POPJ	P,			;Conflict, error return
	PUSHJ	P,SETIMF		;Set IMGFLG by file type
	PUSHJ	P,SETCSH		;Setup a cache for RMS sequentials
	JRST	%POPJ1			;Success return

> ; End %IF20
	SUBTTL	RETRCT	-	Update RECTP(D) from returned RFM
;++
; FUNCTIONAL DESCRIPTION:
;
;	Setup RECTP from FAB RFM for RMS files only. The return RFM for RSF
;	files must be one of FB$STM, FB$UDF, or FB$LSA; any other value 
;	probably means the file is actually an RMS file.
;
;	Table RTTAB maps returned RFM values into RECTP(D) values for non-
;	VMS RMS files; -1 RH means this returned RFM value is not supported
;	by FOROTS for RMS files. VMS RMS files (i.e. all VMS files) use
;	a non-restrictive VRTTAB table, since VMS Sequential files can have
;	recordtype STM.  (Non-sequential STM types are trapped before
;	the OPEN).
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RETRCT
;	<Error return; DIALOG>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	INDX(D)		-	Device index
;	FAB(D) RFM	-	Returned record format value
;	OSTYPE(D)	-	OS type
;	RECTP(D)	-	RECORDTYPE
;	RTTAB		-	RFM-to-RECTP table for non-VMS RMS files
;	VRTTAB		-	     "         "    "  VMS files
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RECTP(D)	-	DDB RECORDTYPE value
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T4.
;
;--

;[5000] New

%IF20,<
RETRCT:	MOVE	T4,FAB(D)		;Get FAB address
	LOAD	T2,INDX(D)		;Get file type
	$FETCH	T1,RFM,<(T4)>		;Get RMS return value
	CAIE	T2,DI.RMS		;RMS?
	 JRST	RSFRFM			;No, check RSF RFM

	MOVEI	T2,RTTAB		;Point at normal table
	MOVE	T3,OSTYPE(D)		;But check if VMS system
	CAIN	T3,XA$VMS		;VMS?
	 MOVEI	T2,VRTTAB		;Yes, use non-restrictive table
	PUSHJ	P,RTMAP			;Try to match it
	 JRST	UNSRFM			;Not found or unsupported

	LOAD	T2,RECTP(D)		;Get user's RECORDTYPE=
	JUMPE	T2,RSTRCT		;None, use returned
	CAMN	T3,T2			;Does user agree with RMS?
	 JRST	RSTRCT			;Yes, go store

	XMOVEI	T1,[ASCIZ /RECORDTYPE/]
	$DCALL	ATC			;?File's RECORDTYPE conflicts with
					; OPEN statement or default

RSTRCT:	STORE	T3,RECTP(D)		;Store
	JRST	%POPJ1			; and take success return

;Here for recordtypes returned for RSF files.

RSFRFM:	CAIE	T1,FB$UDF		;RMS-UDF?
	CAIN	T1,FB$STM		;or STREAM?
	 JRST	%POPJ1			;Yes, OK
	CAIN	T1,FB$LSA		;or LSA?
	 JRST	%POPJ1			;Yes, OK

	CAIE	T1,FB$VAR		;VARIABLE?
	CAIN	T1,FB$FIX		;or FIXED?
	 $DCALL	RMS

UNSRFM:	LOAD	T1,RECTP(D)		;Get user's RECORDTYPE
	CAIN	T1,RT.UNS		;If none given, it's STREAM
	 MOVX	T1,RT.UND
	MOVEI	T2,SWRECT		;Get address of switch table
	PUSHJ	P,FNDSWT		;Get switch string
	MOVEM	T1,%ARGNM
	$DCALL	URT			;?Recordtype x not supported for
					; this file type

> ; End %IF20

	SUBTTL	RTMAP	-	Map an RFM to a RECORDTYPE
;++
; FUNCTIONAL DESCRIPTION:
;
;	Converts an RFM value to a corresponding RECORDTYPE value.  The
;	address of a table is passed as an argument.  The table determines
;	whether a particular RFM value is supported for not.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RTMAP
;	<Return here if RFM not matched, or RFM is unsupported>
;	<Return here if matched; RECORDTYPE value in T3>
;
; INPUT PARAMETERS:
;
;	T1	-	RFM value to match
;	T2	-	Address of RFM/RECORDTYPE table
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	T3	-	RECORDTYPE value which matches the RFM.  If no
;			match, or unsupported RFM, T3 is indeterminate.
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--
;[5000] New

%IF20,<
RTMAP:	HLRE	T3,(T2)			;Get an RMS value
	JUMPL	T3,%POPJ		;End of table and no match
	CAIE	T1,(T3)			;Match?
	 AOJA	T2,RTMAP		;No, keep looking
	HRRE	T3,(T2)			;Yes, get FOROTS value
	JUMPL	T3,%POPJ		;Unsupported RMS value
	JRST	%POPJ1			;Found and supported

> ;End %IF20
	SUBTTL	RETMRS	-	Check returned MRS value
;++
; FUNCTIONAL DESCRIPTION:
;
;	Set RSIZE(D) to the returned MRS value (recordsize
;	in bytes or words) if the user's size agrees with RMS. If
;	the user specified no size, use MRS. 
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RETMRS
;	<Error return; DIALOG>
;	<Succes return>
;
; INPUT PARAMETERS:U;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)	MRS	-	Returned MRS value
;		RFM	-	Returned RFM
;	INDX(D)		-	Device type
;	FORM(D)		-	FORM=
;	BPW(D)		-	Bytes/word
;	RSIZE(D)	-	RECL=
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RSIZE(D)	-	Set to MRS if returned and user size
;				was specified and RFM=FIXED.
;	MRSIZE(D)	-	Set to MRS for I/O buffer size
;	FRSIZB(D)	-	Set to user's MRS
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T4.
;
;--

;[5000] New

%IF20,<
RETMRS:	LOAD	T1,INDX(D)		;Get file type
	CAIN	T1,DI.RSF		;RSF?
	 JRST	%POPJ1			;Yes, don't bother checking it

	MOVE	T4,FAB(D)		;Get FAB address
	$FETCH	T1,MRS,<(T4)>		;Get max rec size
	STORE	T1,MRSIZE(D)		;Save as MRS buffer size
	$FETCH	T2,RFM,<(T4)>		;Get RMS recordformat
	CAIE	T2,FB$VAR		;Set buffersize if fixed
	 STORE	T1,FRSIZB(D)
	LOAD	T3,ORGAN(D)		;or if INDEXED
	CAIN	T3,OR.IDX
	 STORE	T1,FRSIZB(D)
	JUMPE	T1,MRSCMP		;None, see if user specified one

;T1 has MRS

	CAIE	T2,FB$FIX		;RECORDTYPE FIXED?
	CAIN	T3,OR.REL		;or ORGANIZATION RELATIVE?
	 TRNA				;Yes, recalculate RSIZE
	JRST	%POPJ1			;No, MRS is just a maximum

	LOAD	T2,FORM(D)		;Get FORM
	CAIN	T2,FM.FORM		;FORMATTED?
	 JRST	MRSCMP			;Yes, already in bytes

	ADD	T1,BPW(D)		;Round up to words
	SUBI	T1,1
	IDIV	T1,BPW(D)		;Get words
MRSCMP:	LOAD	T2,RSIZE(D)		;Get user's RECORDSIZE
	JUMPE	T2,UPDMRS		;None, use returned
	CAMN	T1,T2			;Same?
	 JRST	UPDMRS			;Yes

	XMOVEI	T1,[ASCIZ /RECORDSIZE/]
	$DCALL	ATC			;File attribute conflict error

UPDMRS:	MOVEM	T1,RSIZE(D)		;Set the MRS
	JRST	%POPJ1			; and return success

> ; End %IF20
	SUBTTL	SETIMF	-	Set IMGFLG(D) by file type
;++
; FUNCTIONAL DESCRIPTION:
;
;	Set IMGFLG(D) for all RMS files to prevent processing of LSCWs.
;	Also set for RSF files for which MODE='IMAGE'.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,SETIMF
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	INDX(D)		-	Device index
;	MODE(D)		-	MODE
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	IMGFLG(D)	-	Set for RMS files and image-mode RSF.
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;
;--

;[5000] New

%IF20,<
SETIMF:	LOAD	T1,INDX(D)
	CAIE	T1,DI.RMS		;RMS file?
	 JRST	IMFRSF			;No
	SETOM	IMGFLG(D)		;Yes, set flag
	POPJ	P,			;and return

IMFRSF:	SETZM	IMGFLG(D)		;Clear flag
	LOAD	T1,MODE(D)		;Get Fortran data mode
	CAIN	T1,MD.IMG		;Image?
	 SETOM	IMGFLG(D)		;Yes. Set flag
	POPJ	P,

> ; End %IF20
	SUBTTL	SETCSH	-	Setup a cache for RMS sequential access files
;++
; FUNCTIONAL DESCRIPTION:
;
;	For RMS sequential files, if CACHSZ .NEQ. 0, allocate a cache.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,SETCSH
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	INDX(D)		-	Device index
;	ORGAN(D)	-	Organization
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	CACHE(D)	-	Address of cache (CASHSZ words)
;	CACHPT(D)	-	Pointer into cache initialized
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
SETCSH:	LOAD	T1,INDX(D)		;Get file type
	CAIE	T1,DI.RMS		;If RSF,
	 POPJ	P,			;nothing to do

	MOVEI	T1,CACHSZ		;Get CACHSZ in words
	JUMPE	T1,%POPJ		;None, we're done

	LOAD	T2,ORGAN(D)		;Get organization
	CAIE	T2,OR.SEQ		;Cache only RMS sequential
	 POPJ	P,

	PUSHJ	P,%GTBLK		;Allocate a cache
	 $ACALL	MFU			;Can't
	MOVEM	T1,CACHE(D)		;Save cache address
	MOVEM	T1,CACHPT(D)		;Initialize pointer
	POPJ	P,			;Return

> ; End %IF20
	SUBTTL	SETWTB	-	Setup WTAB
;++
; FUNCTIONAL DESCRIPTION:
;
;	Sets WTAB to minus one for random-access RMS relative files.
;	Sets WTAB to a page table for random-access RSF files.
;	Sets WTAB to zero for other RMS and RSF files.
;
;	Sets WSIZ for all files, WADR and BUFADR for sequential files.
;
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,SETWTB
;	<Return here; errors go to ABORT>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	ACC(D)		-	ACCESS
;	INDX(D)		-	Device index
;	ORGAN(D)	-	ORGANIZATION
;	BUFCT(D)	-	BUFFERCOUNT
;	BPW(D)		-	Bytes-per-word
;	WPTR(D)		-	Page address of buffer pages
;	EOFN(D)		-	EOF byte number
;
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	WTAB(D)		-	-1 for RMS-relative direct access files
;				 Page table pointer for random-access RSF
;				 files
;	WPTR(D)		-	Core page address of buffer pages
;	WSIZ(D)		-	Window size in bytes
;	WADR(D)		-	Address of window
;	BUFADR(D)	-	Synonym for WADR.
;	EOFN(D)		-	Set to infinity for RMS files, to
;				 EOF byte # for RSF files.
;	
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;	Reads in the FDB "page" for all RSF file.
;	Allocates a page table for random-access RSF files.
;	
;
;--
;[5000] New

%IF20,<
SETWTB:	SETZM	WTAB(D)			;Clear WTAB
	LOAD	T1,ACC(D)		;Get ACCESS
	CAIE	T1,AC.RIO		;ACCESS='DIRECT'?
	CAIN	T1,AC.RIN
	 SETOM	WTAB(D)			;Yes, flag WTAB
	LOAD	T1,INDX(D)		;Get file type
	CAIN	T1,DI.RSF		;RSF?
	 JRST	SETRSF			;Yes, setup for RSF input

	HRLOI	T1,377777		;RMS EOFN's are infinite
	MOVEM	T1,EOFN(D)
	POPJ	P,

SETRSF:	PUSHJ	P,RSGFDB		;Setup RSF's EOF, FDB, etc.
	LOAD	T1,BUFCT(D)		;Get Buffercount
	PUSHJ	P,%GTPGS		;Get buffer pages
	 $ACALL	MFU			;Can't, memory full
	MOVEM	T1,WPTR(D)		;Save page address

	SKIPGE	WTAB(D)			;ACCESS='DIRECT'?
	 PJRST	RANALC			;Yes, setup WTAB with page table

	MOVE	T1,WPTR(D)		;Get page address
	LSH	T1,LWSIZ		;Get core address
	HRRZM	T1,WADR(D)		;Save address
	HRRZM	T1,BUFADR(D)		;here too

	LOAD	T1,BUFCT(D)		;Get buffercount again
	LSH	T1,LWSIZ		;Get # words
	IMUL	T1,BPW(D)		;Get # bytes in it
	MOVEM	T1,WSIZ(D)		;Save window size

	LOAD	T1,ACC(D)		;Get access type
	CAIE	T1,AC.APP		;Append?
	 POPJ	P,			;No, all done

	MOVEI	T1,AC.SOU		;Yes, set SEQUENTIAL
	STORE	T1,ACC(D)
	MOVE	T2,EOFN(D)		;Get # bytes in file
	MOVEM	T2,BYTN(D)		;Save as byte number also
	PUSHJ	P,RMAPW			;Map in EOF page
	PJRST	SETPTR			;Setup pointers, return

> ; End %IF20
	SUBTTL	RSGFDB	-	Get FDB, set EOFN for RSF files
;++
; FUNCTIONAL DESCRIPTION:
;
;	Obtains FDB data for an RSF file, storing in FDB for updating
;	EOFN(D).
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RSGFDB
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FDB		-	FDB block
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Reads an FDB page over the network (!).
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
RSGFDB:	PUSHJ	P,RSRFDB		;Get the FDB page
	 $ACALL	OPN			;Can't, abort

	MOVSI	T1,(T1)			;Get source to BLT for EOFSET
	MOVEI	T2,FDB			;Get destination
	HRRI	T1,(T2)
	ADDI	T2,.FBSIZ
	BLT	T1,(T2)			;BLT upto .FBSIZ

	PUSHJ	P,FTMPPG		;Free the FDB page
	PJRST	%RSEOF			;Go set EOFN, etc.


> ; End %IF20
	SUBTTL	RSRFDB	-	Get FDB page for an RSF file
;++
; FUNCTIONAL DESCRIPTION:
;
;	Reads "bucket 0" from an RSF file, returning a page containing the
;	file's FDB. 
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RSRFDB
;	<Error return, page deallocated>
;	<Success return, page address in T1>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)		-	Address of RAB
;
; OUTPUT PARAMETERS:
;
;	T1		-	Address of FDB data
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	USZ	-	Set to words/page
;		UBF	-	Set to address of core page
;		BKT	-	Set to "bucket 0" for file
;		RAC	-	Set to RB$BLK for block mode
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4.
;	Calls %GTBLK for one page of memory.
;
;--
;[5000] New

%IF20,<
RSRFDB:	MOVEI	T1,PSIZ			;Get one page for FDB bucket
	PUSHJ	P,%GTBLK		;Get it, zeroed
	 $ACALL	MFU			;Can't
	MOVEM	T1,T2			;Copy for GETBKT

	SETZ	T1,			;Read bucket 0
	PUSHJ	P,GETBKT		;$READ it
	 PJRST	FTMPPG			;Can't, deallocate and return+1

	$FETCH	T1,UBF,<(T4)>		;Get page address
	MOVEM	T1,T3			;Copy
	ADDI	T1,.FBLEN		;Setup to clear rest of page
	SETZM	(T1)
	HRL	T2,T1
	HRRI	T2,1(T1)		;start,,start+1
	BLT	T2,PSIZ-1(T3)
	MOVE	T1,T3			;Return start address
	JRST	%POPJ1			;Take success return


> ; End %IF20
	SUBTTL	FTMPPG	-	Free a temporary page
;++
; FUNCTIONAL DESCRIPTION:
;
;	Calls %FREBLK to return the page to which the "bucket 0" FDB
;	has been written.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,FTMPPG
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)	UBF		-	Address of page
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4.
;
;--
;[5000] New

%IF20,<
FTMPPG:	MOVE	T4,RAB(D)		;Get RAB address
	$FETCH	T1,UBF,<(T4)>		;Get page core address
	PUSHJ	P,%FREBLK		;Free the page
	POPJ	P,

> ; End %IF20
	SUBTTL	RSWFDB	-	Write FDB page for an RSF file
;++
; FUNCTIONAL DESCRIPTION:
;
;	Writes "bucket 0" or FDB page for an RSF file. The address of the
;	page to write is in T1.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RSWFDB
;	<Error return; page is deallocated>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	T1			-	Address of page to write
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	UBF		-	Set to address of page to write
;		RSZ		-	Set to page size in bytes
;		BKT		-	Set to "bucket 0"
;		RAC		-	Set to RB$BLK
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4.
;
;--
;[5000] New

%IF20,<
RSWFDB:	MOVE	T4,RAB(D)		;Get RAB address
	MOVEM	T1,T2			;Copy our buffer address
	SETZ	T1,			;BKT 0 for FDB

	PUSHJ	P,PUTBKT		;$WRITE it
	 PJRST	FTMPPG			;Can't, deallocate, error ret
	JRST	%POPJ1			;Success

> ; End %IF20
	SUBTTL	CALUOP	-	Call a user USEROPEN routine
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called with the address of the USEROPEN routine in UOPN(D). Calls
;	the USEROPEN routine:
;
;		XMOVEI	16,arglist
;		PUSHJ	17,useropen
;
;	Passes an argument list of the following form:
;
;		-3,,0
;		IFIW TP%INT,,address of unit
;		IFIW TP%LBL,,address of FAB
;		IFIW TP%LBL,,address of RAB
;
;	The user's routine returns AC0 non-zero on failure, zero on
;	success.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,CALUOP
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	T1	-	Contents of UOPN(D)
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
UOUNT==0				;Unit arg offset
UOFAB==1				;FAB address offset
UORAB==2				;RAB address offset
UOARNM==3				;Number of USEROPEN args

CALUOP:	XMOVEI	T1,@T1			;Get address to call
	SKIPN	(T1)			;destination valid?
	 $ACALL	MEU			;?Missing EXTERNAL
	MOVEM	T1,USRADR		;Save it
	MOVE	T1,FAB(D)
	PUSHJ	P,RETSUC		;Assume success
	MOVE	T1,RAB(D)
	PUSHJ	P,RETSUC

	PUSH	P,L			;Save L
	XMOVEI	L,UOPARG		;Point to arglist
	HRLI	T1,(IFIW TP%INT,) 	;Setup unit # 
	HRRI	T1,%CUNIT
	MOVEM	T1,UOUNT(L)		;Save as unit argument

	HRLI	T1,(IFIW TP%LBL,)	;Setup FAB address
	HRR	T1,FAB(D)
	MOVEM	T1,UOFAB(L)		;Save as FAB arg

	HRLI	T1,(IFIW TP%LBL,)	;Setup RAB address
	HRR	T1,RAB(D)
	MOVEM	T1,UORAB(L)		;Save as RAB arg

	PUSHJ	P,@USRADR		;Call USEROPEN
	POP	P,L			;Restore L

	JUMPE	T0,%POPJ1		;User says it succeeded

;Since the user says the routine failed, we will believe him/her.  The 2
; pathological cases are:
;
;	1) AC0 .EQ.0 but the routine actually failed to $OPEN and $CONNECT.
;	   This will result in unpredictable failures on subsequent I/O.
;	2) AC0 .NEQ.0 but the routine actually succeeded.  This will result
;	   in an unpredictable FOROTS "error".

	PUSHJ	P,RABSTV		;Update RAB status first
	CAIGE	T2,ER$MIN		;Error in RAB?
	 PUSHJ	P,FABSTV		;No, must be in FAB

	$DCALL	UOF			;USEROPEN failed


;Argument list passed to USEROPEN routine

	SEGMENT	DATA

	-UOARNM,,0
UOPARG:	BLOCK	UOARNM
USRADR:	BLOCK	1			;Address of USEROPEN routine


	SEGMENT	CODE

> ; End %IF20
	SUBTTL	NTTOPS	-	Determine if remote operating-system is TOPS
;++
; FUNCTIONAL DESCRIPTION:
;
;	Checks the OSTYPE(D) to determine whether the remote system is
;	TOPS.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,NTTOPS
;	<Return here if TOPS>		;TOPS is an error condition!
;	<Return here if not TOPS>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	NODNAM(D)	-	Node name
;	OSTYPE(D)	-	OS code from CONFIG XAB
;
; OUTPUT PARAMETERS:
;
;	T2		-	OSTYPE(D)
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T2.
;
;--
;[5000] New

%IF20,<
NTTOPS:	SKIPN	NODNAM(D)		;Remote file?
	 POPJ	P,			;No, must be TOPS

	MOVE	T2,OSTYPE(D)		;Get OS code
	CAIE	T2,XA$T20		;TOPS20?
	CAIN	T2,XA$T10		;or TOPS10?
	 POPJ	P,			;Yes, return+1
	JRST	%POPJ1			;No, return+2

> ; End %IF20
	SUBTTL	%RMLKP	-	Lookup an RMS file
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does a $PARSE/$SEARCH lookup on the DDB file to determine whether
;	the file exists, using a scratch FAB and %TXTBF to receive the FNA
;	string; or, if entry RMLKD is called, uses the FAB pointed to 
;	by FAB(D).
;
;	Calls %RMFNS to pull together a filespec string from its DDB
;	fields.
;
;	For remote files:
;	If the lookup succeeds, the expanded filespec string, including
;	attributes, if any, is stored in EXFBUF so a later %GTFNS call
;	will not have to re-lookup the file. 
;
;	For all files:
;	IJFN is set to -1 if the lookup succeeds.
;
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMLKP
;	<Return here if file not found>
;	<Return here if file exists>
;
; INPUT PARAMETERS:
;
;	None
;
;
; IMPLICIT INPUTS:
;
;	NODNAM(D)		-	Node name
;	DDB filespec fields
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	%TXTBF		-	Recieves DDB filespec string
;	EXFBUF		-	Resultant expanded filespec, or 0
;				if lookup failed
;	IJFN(D)		-	Set to -1 if lookup succeeds
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Invokes RMS.
;	Uses T1,T2,T4.
;
;--
;[5001] New

IF10,<
%RMLKP:	$SNH				;Should NOT get here on TOPS-10
> ;End IF10

%IF20,<
%RMLKP:	XMOVEI	T4,SCRFAB		;Enter here to use SCRFAB
	MOVEM	T4,LKPFAB		;Save as local FAB address
	SETOM	RLSFLG			;Flag "release link" on exit
	JRST	RMLKC			;and join common code

RMLKD:	MOVE	T4,FAB(D)		;Enter here for FAB(D)
	MOVEM	T4,LKPFAB		;We'll use this FAB
	SETZM	RLSFLG			;Flag "don't release link" on exit

RMLKC:	PUSHJ	P,ABINI			;Re-init NAM,SCRFAB, TYP

	MOVE	T1,[POINT 7,EXFBUF]	;Destination for FNA string
	MOVEM	T1,DESPTR		;Save also for resultant string

	PUSHJ	P,%RMFNS		;Get DDB filespec string

	MOVE	T4,LKPFAB
	$STORE	T1,FNA,<(T4)>		;Save address

	XMOVEI	T1,NAMBLK		;Get NAMBLK's address
	$STORE	T1,NAM,<(T4)>		;Link to FAB

	$PARSE	@LKPFAB,LKPERR		;Lookup the file

	$SEARCH	@LKPFAB,LKPERR		;Get resultant filespec

	MOVE	T1,LKPFAB		;Get FAB's address
	PUSHJ	P,FABST2		;Update FAB STV
	SETOM	IJFN(D)			;Flags files exists
	MOVE	T4,LKPFAB		;Get FAB address
	SKIPE	RLSFLG			;Release link?
	 PUSHJ	P,RLSLNX		;Yes
	PUSHJ	P,DRJOFF		;Turn DRJ off
	PUSHJ	P,RLFJFN		;Toss any RMS-returned JFN

;Save the resultant expanded filespec, with attributes.

	SETZM	CVFLAG			;Don't ^V anything
	PUSHJ	P,RETRSA		;
	JRST	%POPJ1			;OK, return +2

LKPERR:	CAIE	T2,ER$FLK		;File locked for some reason?
	 JRST	LKPFNF			;No, not found or ambiguous

;Here for a "File is locked" $SEARCH failure.  This is sufficient evidence
;that the file exists, so we clear the error and return to  $SEARCH+1.
;Note that even though it failed, $SEARCH has updated the NAM block.

	SKIPE	T1,FAB(D)		;If a real FAB,
	PUSHJ	P,RETSUC		; clear the error
	$RETURN				;Return from LKPERR error call

LKPFNF:	POP	P,%RMPDP		;Save error return
	SETZM	IJFN(D)			;File doesn't exist
	SETZM	EXFBUF			;No resultant string
	SETZM	EXFATT			;and no attributes
	PUSHJ	P,FABST2		;Update FAB STV

;Flag an ambiguous state if we never got conclusive evidence...

	CAIE	T2,ER$FNF		;File not found?
	 SETOM	UNKXST			;No, can't determine existence
	SKIPE	RLSFLG			;Release link?
	 PJRST	RLSLNX			;Yes, return +1
	PUSHJ	P,DRJOFF		;Turn DRJ OFF!
	POPJ	P,

	SEGMENT	DATA

LKPFAB:	BLOCK	1			;Address of lookup FAB
RLSFLG:	BLOCK	1			;Non-zero if link to be released

	SEGMENT	CODE

> ; End %IF20
	SUBTTL	RETRSA	-	Store resultant filespec
;++
; FUNCTIONAL DESCRIPTION:
;
;	Saves the resultant filespec string from the NAM block after
;	a $PARSE/$SEARCH sequence.  The string is stored where DESPTR
;	points.  Attributes, if any, are included. EXFATT will contain
;	a byte pointer to the beginning of the attributes portion.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RETRSA
;	<Return here>	
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	DESPTR		-	Byte pointer to destination
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	Filespec is written to destination.
;	EXFATT is updated with a byte pointer to the attributes string,
;	which may be zero.
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5001] New

%IF20,<
RETRSA:	MOVE	T1,DESPTR		;Get pointer 
	MOVEM	T1,FNSPNT		;Point FNSCLR at it
	PUSHJ	P,FNSCLR		;Clear it first
	MOVE	T1,DESPTR
	PUSHJ	P,CVTFNS		;Convert string
	MOVNI	T2,1			;Back up over the null
	IBP	T2,T1
	MOVEM	T2,FNSPNT		;Store
	MOVEM	T2,EXFATT		;Save attributes pntr, too
	PJRST	GUSPWA			;Add attributes and return

> ;End %IF20

	SUBTTL	DRJON	-	Set DRJ for remote files
;++
; FUNCTIONAL DESCRIPTION:
;
;	Sets the DRJ bit for remote files so a $CLOSE will not release
;	the network link, or the JFN.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,DRJON
;	<Return here>
;
; INPUT PARAMETERS:
;
;	T4		-		Address of FAB
;
; IMPLICIT INPUTS:
;
;	NODNAM(D)	-		Nodename
;	FAB(D)		-		FAB address
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FAB(D)	FOP	-		FB$DRJ set if remote
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;
;--
;[5002] New

%IF20,<
DRJON:	$FETCH	T1,FOP,<(T4)>		;Get FOP bits
	TXO	T1,FB$DRJ		;Set DRJ
	$STORE	T1,FOP,<(T4)>		;Bits back
	POPJ	P,			;Return

> ;End %IF20
	SUBTTL	DRJOFF	-	Turn off DRJ
;++
; FUNCTIONAL DESCRIPTION:
;
;	Turn off DRJ in the FAB
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,DRJOFF
;	<Return here>
;
; INPUT PARAMETERS:
;
;	T4		-		Address of FAB
;
; IMPLICIT INPUTS:
;
;	NODNAM(D)		-	Nodename
;	FAB(D)	FOP		-	FB$DRJ
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FAB(D)	FOP		-	DRJ turned off
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;
;--
;[5002] New

%IF20,<
DRJOFF:	$FETCH	T1,FOP,<(T4)>		;Get FOP bits
	TXZ	T1,FB$DRJ		;Turn off DRJ
	$STORE	T1,FOP,<(T4)>		;Reset FOP
	POPJ	P,

> ;End %IF20
	SUBTTL	LOCON	-	Turn on Locate Mode
;++
; FUNCTIONAL DESCRIPTION:
;
;	Sets the Locate Mode bit in the RAB
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,LOCON
;	<Return here>
;
; INPUT PARAMETERS:
;
;	T4			-		Address of RAB
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	ROP		-		RB$LOC
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;
;--
;[5004] New

%IF20,<
LOCON:	$FETCH	T1,ROP,<(T4)>		;Get ROP bits
	TXO	T1,RB$LOC		;Turn Locate on
	$STORE	T1,ROP,<(T4)>		;Reset
	POPJ	P,

> ;End %IF20
	SUBTTL	LOCOFF	-	Turn off Locate Mode
;++
; FUNCTIONAL DESCRIPTION:
;
;	Turns off the Locate Mode bit in the FAB
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,LOCOFF
;	<Return here>
;
; INPUT PARAMETERS:
;
;	T4			-		Address of RAB
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	ROP		-		RB$LOC off
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;
;--
;[5004] New

%IF20,<
LOCOFF:	$FETCH	T1,ROP,<(T4)>		;Get ROP bits
	TXZ	T1,RB$LOC		;Turn off Locate
	$STORE	T1,ROP,<(T4)>
	POPJ	P,

> ;End %IF20
	SUBTTL	EOFON	-	Turn on RB$EOF in RAB(D)
;++
; FUNCTIONAL DESCRIPTION:
;
;	Sets EOF option bit in the RAB.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,EOFON
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)		-		Address of RAB
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	ROP	-		RB$EOF
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T4.
;
;--
;[5000] New

%IF20,<
EOFON:	MOVE	T4,RAB(D)		;Get RAB address
	$FETCH	T1,ROP,<(T4)>		;Get existing ROP bits
	TXO	T1,RB$EOF		;Turn on EOF
	$STORE	T1,ROP,<(T4)>		;Set
	POPJ	P,

> ;End %IF20
	SUBTTL	EOFOFF	-	Turn off RB$EOF in RAB(D)
;++
; FUNCTIONAL DESCRIPTION:
;
;	Clears EOF bit in ROP of RAB(D).
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,EOFOFF
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)		-		Address of RAB
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	ROP	-		RB$EOF cleared
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T4.
;
;--
;[5000] New

%IF20,<
EOFOFF:	$FETCH	T1,ROP,<(T4)>		;Turn off EOF
	TXZ	T1,RB$EOF
	$STORE	T1,ROP,<(T4)>
	POPJ	P,

> ;End %IF20

	SUBTTL	%RMFNS	-	Return DDB filespec
;++
; FUNCTIONAL DESCRIPTION:
;
;	Returns the DDB filespec as a string in the buffer pointed to by
;	T1.
;
;	The filestring is of the form:
;
;          {node::}dev:<dir>file.typ.gen{;Attributes:}
;
;	On return T1 contains the address of the string.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMFNS
;	<Return here>
;
; INPUT PARAMETERS:
;
;	T1	-	Byte pointer to destination buffer where
;			filespec is to be written
;
; IMPLICIT INPUTS:
;
;	DDB filespec fields
;
; OUTPUT PARAMETERS:
;
;	T1	-	Address of destination buffer
;
; IMPLICIT OUTPUTS:
;
;	Writes the filespec to the destination buffer
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;
;--
;[5000] New

%IF20,<
%RMFNS:	MOVEM	T1,SAVPTR		;Save destination pointer
	MOVEM	T1,FNSPNT		; also for FNOJFN
	PUSHJ	P,FNOJFN		;Output up to generation
	MOVE	T1,GEN(D)		;Get generation
	CAME	T1,[ASCIZ/0/]		;Is it zero?
	 JRST	GUSER			;No
	MOVE	T1,%GNPNT		;Yes, don't output a generation
	MOVEM	T1,FNSPNT		;Back up pointer

GUSER:	PUSHJ	P,GUSPWA		;Get USERID, PASSWORD, ACCOUNT,PROT
	HRRZ	T1,SAVPTR		;Restore original address
	POPJ	P,			;Return

	SEGMENT	DATA

SAVPTR:	BLOCK	1			;Pointer storage
DESPTR:	BLOCK	1

	SEGMENT	CODE

> ; End %IF20
	SUBTTL	GUSPWA	-	Assemble file attributes
;++
; FUNCTIONAL DESCRIPTION:
;
;	Writes USERID, PASSWORD, ACCOUNT, and PROTECTION attributes from
;	the DDB to the destination string.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,GUSPWA
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FNSPNT		-	Byte pointer to destination where string is
;				to be written
;	USERID(D)	-	DDB USERID field
;	PASWRD(D)	-	PASSWORD
;	ACCNT(D)	-	ACCOUNT
;	PROT(D)		-	PROTECTION
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FNSPNT		-	Pointer is updated
;
;	Writes DDB fields to the destination.
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
GUSPWA:	SKIPN	USERID(D)		;Any USERID?
	 JRST	GPASS			;No, check password

	MOVEI	T1,[ASCIZ/;USER:/]	;Prefix
	PUSHJ	P,ASCFNS		;Output it
	XMOVEI	T1,USERID(D)		;Data
	PUSHJ	P,ASCFNS		;Output it

GPASS:	SKIPN	PASWRD(D)		;Any PASSWORD?
	 JRST	GACC			;No, check account

	MOVEI	T1,[ASCIZ/;PASS:/]	;Prefix
	PUSHJ	P,ASCFNS		;Output it
	XMOVEI	T1,PASWRD(D)		;Data
	PUSHJ	P,ASCFNS		;Output it

GACC:	SKIPN	ACCNT(D)		;Any ACCOUNT?
	 JRST	GPRO			;No, check protection

	MOVEI	T1,[ASCIZ/;A:/]		;Prefix
	PUSHJ	P,ASCFNS		;Output it
	XMOVEI	T1,ACCNT(D)		;Data
	PUSHJ	P,ASCFNS		;Output it

GPRO:	SKIPN	PROT(D)			;Any PROTECTION?
	 JRST	RMFNZ			;No, finish up

	MOVEI	T1,[ASCIZ/;P:/]		;Prefix
	PUSHJ	P,ASCFNS		;Output it
	XMOVEI	T1,PROT(D)		;Data
	PUSHJ	P,ASCFNS

RMFNZ:	SETZ	T2,
	IDPB	T2,FNSPNT		;End with null
	POPJ	P,			;Return

> ; End %IF20

	SUBTTL	%RMEFN	-	Return filespec for error messages
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called from FOROPN ERFTAB to return a filespec for use in
;	error messages--i.e. don't promiscuously return Decnet access
;	attributes as part of the filespec.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMEFN
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FNSPNT		-	Byte pntr to where filespec is to be written
;	NODNAM(D)	-	Node name
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FNSPNT		-	Byte pntr updated
;	SAVPTR		-	Original FNSPNT saved
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T3.
;
;--
;[5000] New

%IF20,<
%RMEFN:	MOVE	T1,FNSPNT	;Get and save destination
	MOVEM	T1,SAVPTR
	PUSHJ	P,FNOJFN	;Output up to generation
	SKIPE	NODNAM(D)	;Remote file?
	 POPJ	P,		;Yes, now have full expanded spec

	MOVE	T2,SAVPTR	;Local file, treat like non-RMS disk
	MOVX	T1,GJ%SHT+GJ%OFG+GJ%FLG ;Get parse-only JFN
	GTJFN%
	 ERJMP	FNOJFN		;Couldn't, at least output DDB fields

	MOVE	T2,T1		;Copy JFN
	MOVE	T1,SAVPTR	;Restore pointer
	SETZ	T3,		;No defaults
	JFNS%			;Get disk-like spec
	 JSHALT

	MOVEM	T1,FNSPNT	;Update pointer
	MOVE	T1,T2		;Now release the JFN
	RLJFN%
	 JSHALT			;Shouldn't fail

	POPJ	P,		;Return

> ; End %IF20
	SUBTTL	%RMGXF	-	Return expanded filestring
;++
; FUNCTIONAL DESCRIPTION:
;
;	Returns an expanded TOPS20-style filestring in the buffer
;	pointed to by global FNSPNT.  Called from FOROPN %GTFNS
;	with destination buffer cleared and pointer in FNSPNT.
;
;	The destination buffer must not be either the RSA or ESA
;	buffers pointed to by the NAM block.
;
;	The filespec is obtained in one of two ways, depending on the
;	setting of IJFN(D) and the status (open/not open) of the file:
;
;	IJFN(D) is -1:	If the file is not open, but a previous call
;			to %RMLKP has returned a resultant string, use
;			that.  If the file is open already, just return
;			the DDB filespec.
;
;	IJFN(D) is  0:	A deferred-open file. Just return the DDB filespec.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMGXF
;	<Return here>
;
; INPUT PARAMETERS:
;
;	FNSPNT	-	Byte pointer to buffer where expanded filespec
;			is to be written
;
; IMPLICIT INPUTS:
;
;	IJFN(D)	-	-1 if the file is currently open or a successful
;			%RMLKP lookup call has established that it exists.
;	FLAGS(D) -	Flags
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	DESPTR		-	Saved destination pointer
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

IF10,<
%RMGXF:	$SNH				;Should NOT get here on TOPS-10
> ;End IF10

%IF20,<
%RMGXF:	MOVE	T1,FNSPNT		;Get destination pointer
	SKIPN	T2,IJFN(D)		;Any JFN status?
	 JRST	%RMFNS			;No, just get DDB string

	CAME	T2,[-1]			;If not 0, must be -1!
	 $SNH				;Bad

	MOVE	T2,FLAGS(D)		;Get flags
	TXNE	T2,D%IN+D%OUT		;Is file actually open?
	 JRST	%RMFNS			;Yes, just return DDB string

;Here when the file is not open, or IJFN says we don't know whether the
;file exists or not.  If a previous call to %RMLKP has succeeded, IJFN
;will be -1 and EXFBUF will contain the resultant expanded filespec.  If
;EXFBUF for some reason hasn't been updated, we have to do a full lookup!

	MOVEM	T1,DESPTR		;Save destination pointer
	SETZM	CVFLAG			;Don't ^V anything
	SKIPE	EXFBUF			;Do we have a resultant spec?
	 PJRST	RETRSA			;Yes, return it

	PUSHJ	P,%RMLKP		;No. Must do a lookup/expansion
	 $SNH				;?File not found
	PJRST	RETRSA			;OK, return string

> ; End %IF20

	SUBTTL	%RMRFS	-	Return filespec to DDB variables
;++
; FUNCTIONAL DESCRIPTION:
;
;	Returns filespec fields to the DDB. Obtains a parse-only JFN
;	on the filespec string pointed to by RSA of the NAMBLK, then
;	calls %DOJFNS to update the DDB. The parse-only JFN is discarded
;	on return.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMRFS
;	<Return here>
;
; INPUT PARAMETERS:
;
;	NAMBLK		-	NAM filespec pointers
;	 N$RSA		-	 Pointer to expanded filespec
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	NODNAM(D)	-	Nodename
;	DEV(D)		-	Device
;	DIR(D)		-	Directory
;	FILNAM(D)	-	Name
;	EXT(D)		-	Extension
;	GEN(D)		-	Generation
;	PASWRD(D)	-	Password
;	ACCNT(D)	-	Account
;	USERID(D)	-	Userid
;	IJFN(D)		-	Set, then set to -1 on return to
;				indicate DDB contains expanded RMS filespec.
;
;	FNSPNT		-	Destination byte pointer
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
%RMRFS:	MOVE	T1,[POINT 7,%TXTBF]	;Setup destination pntr
	MOVEM	T1,DESPTR		;Save

	SETOM	CVFLAG			;Turn on ^V'ing
	PUSHJ	P,RETRSA		;Copy string

	MOVE	T2,DESPTR		;Get string pointer
	MOVX	T1,GJ%SHT+GJ%OFG+GJ%FLG	;Get parse-only JFN
	GTJFN%
	 JSHALT				;Should not fail

	MOVEM	T1,IJFN(D)		;Setup for JFNS call
	PUSHJ	P,%DOJFNS		;Update DDB
	PUSHJ	P,RELJFN		;Release JFN
	SETOM	IJFN(D)			;Flag file exists
	POPJ	P,			;Return

> ; End %IF20
	SUBTTL	%RMISW/%RSISW -	Switch an RMS/RSF file from output to input
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called only for sequential RMS and RSF files. Switches to input
;	by setting ICNT(D) to zero, so subsequent READ will return EOF.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMISW	;Called only from FOROPN ISWTAB
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	ICNT(D)		-	Current free byte count, cleared.
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	For RSF files, writes the current window.
;	Uses T1.
;
;--
;[5003] New

%IF20,<
%RSISW:	PUSHJ	P,%OCLR			;Clear unused bytes in last word
	PUSHJ	P,RSFOCP		;Output current output window

%RMISW:	SETZM	ICNT(D)			;Tell IN. we're at EOF!
	POPJ	P,
> ; End %IF20

	SUBTTL	%RMOSW	-	Switch an RMS file to output
;++
; FUNCTIONAL DESCRIPTION:
;
;	Switch an RMS  file from input to output, truncating
;	if necessary.  The routine determines whether we are already at
;	EOF (thus allowing a bypass of the truncate operation) by performing
;	a preliminary $FIND on the next record.  If this gets an EOF, and
;	the file is already open for write access, we can leave.  If we
;	don't have write access, or are not at EOF, close the file, reopen
;	it for exclusive access, position to the RFA from the $FIND, and
;	truncate.
;
;	A switch to output is not cheap for a remote file!
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMOSW		;Called from FOROPN OSWTCH
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	ORGAN(D)		-	ORGANIZATION
;	RAB(D)			-	RAB address
;	FAB(D)			-	FAB address
;		RFA		-	RFA from last read/write
;	FLAGS(D)		-	DDB flags
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	RAC		-	RB$RFA for $TRUNCATE
;	FAB(D)	FOP		-	FB$DRJ
;		SHR		-	FB$NIL
;		FAC		-	FB$GET!FB$PUT!FB$TRN
;	FLAGS(D)		-	D%WRT if not already set
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T4.
;	May close, reopen, and truncate the file.
;
;--
;[5004] New

%IF20,<
%RMOSW:	SETZM	EOFFLG			;Clear extremely local "at EOF" flag
	SETZM	IDXREL			;Clear "IDX/relative file" flag
	SETZM	ICNT(D)			;Clear input pointers, we need
	SETZM	IPTR(D)			; an output buffer

	LOAD	T1,ORGAN(D)		;See if the filetype allows truncating
	CAIE	T1,OR.REL		;If relative,
	 CAIN	T1,OR.IDX		;or indexed
	  SETOM	IDXREL			;Flag it

	SKIPN	IDXREL			;Indexed or Relative file?
	 JRST	OSWSEQ			;No, go truncate, maybe
	MOVE	T1,FLAGS(D)		;IDX/REL. Get DDB flags
	TXNE	T1,D%WRT		;Already have WRITE access?
	 POPJ	P,			;Yes, nothing to do
	JRST	OSWCLS			;No, have to close/open

OSWSEQ:	MOVE	T4,RAB(D)		;Get RAB address
	MOVX	T1,RB$SEQ		;Set for sequential access
	$STORE	T1,RAC,<(T4)>

	PUSHJ	P,FIND$			;Do $FIND
	 JFCL				;Ignore error for a moment
	PUSHJ	P,RABSTV
	$FETCH	T1,RFA,<(T4)>		;Get the RFA
	MOVEM	T1,OSWRFA		;Save

	CAIGE	T2,ER$MIN		;Error?
	 JRST	OSWCLS			;No, go close file
	CAIE	T2,ER$EOF		;Yes. Was it EOF?
	 JRST	OSWERR			;No, something bad

;We were already at EOF.  If we already have WRITE access to the file, there's
; nothing left to do.
	
	SETOM	EOFFLG			;Flag "at EOF".
	MOVE	T1,RAB(D)
	PUSHJ	P,RETSUC		;Clear error
	MOVE	T1,FLAGS(D)		;Get DDB flags
	TXNE	T1,D%WRT		;WRITE access?
	 POPJ	P,			;Yes, all done

OSWCLS:	MOVX	T1,D%WRT		;We have WRITE access now
	IORM	T1,FLAGS(D)
	MOVE	T4,RAB(D)
	PUSHJ	P,DRJON			;Keep link

	PUSHJ	P,CLOS$			;Do $CLOSE
	 JRST	OSWERR			;Error

	PUSHJ	P,DRJOFF		;Turn DRJ off!
	MOVX	T1,FB$NIL		;Get exclusive access to file
	SKIPE	IDXREL			;unless IDX/relative file
	 $FETCH	T1,SHR,<(T4)>		;Don't change share access
	$STORE	T1,SHR,<(T4)>
	MOVX	T1,FB$ALL		;Get write access
	$STORE	T1,FAC,<(T4)>

	SETZ	T1,
	$STORE	T1,FOP,<(T4)>		;Clear FOP bits

	MOVE	T4,FAB(D)		;Get FAB address again
	MOVE	T1,[POINT 7,%TXTBF]	;Setup to get DDB filespec
	PUSHJ	P,%RMFNS		;Get it
	$STORE	T1,FNA,<(T4)>		;Set filespec in FNA

	PUSHJ	P,OPEN$			;Do $OPEN
	 JRST	OSWERR			;Error

	MOVE	T4,RAB(D)		;Get RAB address
	SKIPN	IDXREL			;If indexed or relative
	SKIPN	EOFFLG			;or we were not at EOF, normal connect
	 JRST	RMOSCN

	PUSHJ	P,EOFON			;Turn on EOF

RMOSCN:	SETZ	T1,			;Clear RAC
	$STORE	T1,RAC,<(T4)>
	$STORE	T1,KBF,<(T4)>		;Any key buffer
	$STORE	T1,KSZ,<(T4)>		;and size

	PUSHJ	P,CONN$			;Do $CONNECT
	 JRST	OSWERR			;Error

	PUSHJ	P,EOFOFF		;Turn off EOF

;Here for the full $TRUNCATE, unless already at EOF.

	MOVX	T1,RB$RFA		;Get RFA access
	$STORE	T1,RAC,<(T4)>

	SKIPN	IDXREL			;Relative?
	SKIPE	EOFFLG			;At EOF?
	 JRST	RMOSRT			;Yes, don't truncate

	MOVE	T1,OSWRFA		;Get our RFA
	$STORE	T1,RFA,<(T4)>

	PUSHJ	P,FIND$			;Do $FIND
	 JRST	OSWERR			;Error

	PUSHJ	P,TRUN$			;Do $TRUNCATE
	 JRST	OSWERR			;Error

	MOVX	T1,D%MOD		;Set file-is-modified
	IORM	T1,FLAGS(D)

RMOSRT:	SKIPN	IDXREL			;IDX/REL?
	 POPJ	P,			;No, all done
	SKIPN	T1,RFA(D)		;Any last record to reposition to?
	 POPJ	P,			;No, done
	$STORE	T1,RFA,<(T4)>		;Yes, set RFA
	PUSHJ	P,FIND$			;Re-position to it
	 TRNA
	POPJ	P,

;Here for fatal %RMOSW errors.

OSWERR:	PUSHJ	P,EOFOFF		;Turn off EOF
	PUSHJ	P,DRJOFF		;and DRJ
	 $ACALL	IOE			;Bad error

	SEGMENT	DATA

OSWRFA:	BLOCK	1			;RFA for $TRUNCATE
IDXREL:	BLOCK	1			;Indexed/Relative file flag

	SEGMENT	CODE

> ; End %IF20

	SUBTTL	%RSOSW	-	Switch an RSF file to output
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called from OSWTCH via DSKOSW via CLSOUT.  Switches an RSF file from
;	input to output.  EOFN(D) has been setup previously to point at
;	the highest file byte number so far read from the file.  File
;	truncation occurs at EOFN.
;
;	A switch to output is not cheap for remote files!
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RSOSW		;Called from FOROPN CLSOUT
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	EOFN(D)			-		New highest file byte #
;	BPW(D)			-		Bytes/word
;	FLAGS(D)		-		DDB flags
;	FAB(D)			-		FAB address
;	RAB(D)			-		RAB address
;	IPTR(D)			-		Input pointer
;	WSIZ(D)			-		Window size
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FAB(D)	FAC		-		Reset to write access
;		SHR		-		To NIL for truncation
;	RAB(D)	BKT		-		To desired page number
;	BYTN(D)			-		To next-window-byte
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4.
;
;--
;[5004] New

IF10,<
%RSOSW:	$SNH				;Should NOT get here on TOPS-10
> ;End IF10

%IF20,<
%RSOSW:	MOVE	T3,EOFN(D)		;Get highest file byte
	MOVE	T1,BPW(D)		;Get bytes/word
	LSH	T1,LWSIZ		;Get bytes/page
	ADDI	T3,-1(T1)		;and pages written
	IDIVI	T3,(T1)			;rounded

;T3 has file page # of EOF byte.
;Try to read the next file page to see if we are already at EOF

	ADDI	T3,1			;Bump page #
	MOVEM	T3,SAVPAG		;Save
	MOVEM	T3,T1			;Copy

	SETZM	EOFFLG			;Clear "At EOF" flag
	PUSHJ	P,LOCBKT		;Locate page
	 TRNA				;Error, investigate
	JRST	ROSCLS			;No error, go close file

	CAIE	T2,ER$EOF		;Was it EOF?
	 CAIN	T2,ER$RNF		;or page not found?
	  TRNA				;Yes, OK
	JRST	ROSWER			;No, something bad

;Already at EOF.  If we already have WRITE access to the file, there's
;nothing left to do!

	SETOM	EOFFLG			;Flag we are at EOF
	MOVE	T1,RAB(D)
	PUSHJ	P,RETSUC		;EOF! Clear error
	MOVE	T1,FLAGS(D)		;Get DDB flags
	TXNE	T1,D%WRT		;WRITE access?
	 PJRST	%SOCNT			;All done! Set output count

;Here when not at EOF, or need write access.  A full OPEN/CLOSE/TRUNCATE
; is required.

ROSCLS:	MOVX	T1,D%WRT		;We have WRITE access now
	IORM	T1,FLAGS(D)

	MOVE	T4,FAB(D)		;Get FAB address
	PUSHJ	P,DRJON			;Set DRJ, keep net link

	PUSHJ	P,CLOS$			;Do $CLOSE
	 JRST	ROSWER			;Error
	PUSHJ	P,DRJOFF		;Turn DRJ OFF!

	MOVX	T1,FB$ALL		;Get full write access
	$STORE	T1,FAC,<(T4)>
	MOVX	T1,FB$NIL		;Exclusive
	$STORE	T1,SHR,<(T4)>

	MOVE	T1,[POINT 7,%TXTBF]	;Setup to get DDB filespec
	PUSHJ	P,%RMFNS		;Get it
	$STORE	T1,FNA,<(T4)>		;Set filespec in FNA

	PUSHJ	P,OPEN$			;Do $OPEN
	 JRST	ROSWER			;Error

	PUSHJ	P,CONN$			;Do $CONNECT
	 JRST	ROSWER			;Error


;Here for $TRUNCATE.  The BKT we just read is the page after our EOF byte.
; Truncate from that page to the end...unless we were already at EOF.

	SKIPE	EOFFLG			;At EOF?
	 PJRST	%SOCNT			;Yes, no need for $TRUNCATE

	MOVE	T1,SAVPAG		;Get page # back
	$STORE	T1,BKT,<(T4)>		;Set it

	PUSHJ	P,TRUN$			;Do $TRUNCATE
	 JRST	ROSWER			;Error

	MOVX	T1,D%MOD		;Set file-is-modified
	IORM	T1,FLAGS(D)

;File is shorter, b'gad.  Remap our file window

	HRRZ	T1,IPTR(D)		;Get address of data
	JUMPE	T1,%POPJ		;If no data, leave
	MOVN	T1,WSIZ(D)		;Set to map new window
	ADDM	T1,BYTN(D)
	PUSHJ	P,RMAPW			;Map the pages
	MOVE	T1,WSIZ(D)		;Set next window byte number
	ADDM	T1,BYTN(D)
	PJRST	%SOCNT			;Go update count, return

;Here on fatal errors

ROSWER:	PUSHJ	P,DRJOFF		;Turn DRJ OFF!
	$ACALL	IOE

	SEGMENT	DATA

SAVPAG:	BLOCK	1			;Save file page #
EOFFLG:	BLOCK	1			;"At EOF" flag

	SEGMENT	CODE

> ;End %IF20
	SUBTTL	GETBKT	-	$READ a remote page
;++
; FUNCTIONAL DESCRIPTION:
;
;	$READs a bucket (page) whose page number is in T1 to the buffer
;	whose address is in T2.  Updates RAB STS/STV.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,GETBKT
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	T1		-		File page number to read
;	T2		-		Destination address for page
;
; IMPLICIT INPUTS:
;
;	RAB(D)		-		Address of RAB
;
; OUTPUT PARAMETERS:
;
;	Returns STS value in T2.
;	Returns address of RAB in T4.
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	BKT	-		Set to page #
;		UBF	-		Set to destination address
;		USZ	-		Set to page size (words)
;		RAC	-		Set to BLK
;		RFA	-		Cleared
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4
;
;--
;[5004] New

%IF20,<
GETBKT:	MOVE	T4,RAB(D)		;Get RAB address
	$STORE	T1,BKT,<(T4)>		;Set page number to read
	$STORE	T2,UBF,<(T4)>		;Set destination

	MOVEI	T1,PSIZ			;Set size to one page
	$STORE	T1,USZ,<(T4)>

	$FETCH	T1,RAC,<(T4)>		;Turn on BLK mode
	TXO	T1,RB$BLK
	$STORE	T1,RAC,<(T4)>

	SETZ	T1,			;Clear RFA
	$STORE	T1,RFA,<(T4)>

	PUSHJ	P,READ$			;Do $READ
	 PJRST	LOCOFF			;Turn off Locate Mode if on, error ret
	PUSHJ	P,LOCOFF		;Turn off Locate Mode
	JRST	%POPJ1

> ;End %IF20
	SUBTTL	LOCBKT	-	GETBKT in Locate mode
;++
; FUNCTIONAL DESCRIPTION:
;
;	Calls GETBKT with Locate Mode set.  A temporary destination
;	buffer (required by RMS, but unused!) is allocated and
;	deallocated.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,LOCBKT
;	<Error return; buffer deallocated>
;	<Success return; buffer deallocated>
;
; INPUT PARAMETERS:
;
;	T1		-	BKT (page) to locate
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	Returns STS value in T2.
;	Returns address of RAB in T4.
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--

;[5004] New

%IF20,<
LOCBKT:	MOVEM	T1,SAVBKT		;Save target bucket #
	MOVEI	T1,PSIZ			;Get temp buffer
	PUSHJ	P,%GTBLK
	 $ACALL	MFU			;Can't
	MOVEM	T1,T2			;Copy for GETBKT

	MOVE	T4,RAB(D)		;Get RAB address
	PUSHJ	P,LOCON			;Turn on Locate Mode

	MOVE	T1,SAVBKT		;Get BKT #, T2 has destination adr
	PUSHJ	P,GETBKT		;$READ it
	 JFCL				;Ignore error for a moment
	PUSH	P,T2			;Save STS code
	PUSHJ	P,FTMPPG		;Deallocate temp buffer
	POP	P,T2			;Retrieve T2
	CAIL	T2,ER$MIN		;Error?
	 POPJ	P,			;Yes, take error return
	PJRST	%POPJ1			;Take success return

	SEGMENT	DATA

SAVBKT:	BLOCK	1			;Save BKT #

	SEGMENT	CODE

> ;End %IF20
	SUBTTL	PUTBKT	-	$WRITE a file page
;++
; FUNCTIONAL DESCRIPTION:
;
;	$WRITEs the bucket (page) whose number is in T1, and whose core
;	address is in T2.  Updates RAB STS/STV.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,PUTBKT
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	T1			-	File page # to write
;	T2			-	Core buffer address
;
; IMPLICIT INPUTS:
;
;	RAB(D)			-	Address of RAB
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	BKT		-	Page #
;		RBF		-	Buffer address
;		RSZ		-	Buffer size in bytes
;		RFA		-	Cleared
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4.
;
;--
;[5004] New

%IF20,<
PUTBKT:	MOVE	T4,RAB(D)		;Get RAB address
	$STORE	T1,BKT,<(T4)>		;Set BKT #
	$STORE	T2,RBF,<(T4)>		;Set buffer address

	MOVEI	T1,PSIZ			;Get page size in words
	IMUL	T1,BPW(D)		;Convert to bytes
	$STORE	T1,RSZ,<(T4)>		;Store in RAB

	SETZ	T1,
	$STORE	T1,RFA,<(T4)>		;No RFA

	$FETCH	T1,RAC,<(T4)>		;Get current access bits
	TXO	T1,RB$BLK		;Turn on block mode
	$STORE	T1,RAC,<(T4)>

	PUSHJ	P,WRIT$			;Do $WRITE
	 POPJ	P,			;Error
	JRST	%POPJ1			;Success

> ;End %IF20
	SUBTTL	%RMCSY	-	Maybe OPEN on a CLOSE/EXIT
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called from FOROPN CLSITY processing for deferred-open files
;	which have not yet been opened.  This routine performs a lookup
;	on the file. If it exists, it returns +2; if not, +1 for a full
;	OPEN.  %RMCSY is called instead of %RMLKP so we can avoid 
;	requesting and relinquishing a network link.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMCSY
;	<Return here if file does not exist>
;	<Return here if the file exists>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)		-		Address of FAB
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FAB(D)		-		Address of allocated FAB
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	May invoke RMS.
;	May initialize a FAB
;	Uses T1,T4.
;
;--
;[5002] New

%IF20,<
%RMCSY:	SKIPN	T1,FAB(D)		;Already have a FAB?
	 PUSHJ	P,RMFAB			;No, allocate one
	MOVEM	T1,FAB(D)		;Save its address
	MOVEM	T1,T4			;Copy it
	PUSHJ	P,RMLKD			;Lookup the file, keep net link
	 PJRST	FETOST			;Not there, return for full OPEN
	PUSHJ	P,DRJOFF
	PUSHJ	P,RLSLNK		;There, release link
	JRST	%POPJ1			;Return +2

> ;End %IF20
	SUBTTL	FETOST	-	Fetch the OS type into OSTYPE(D)
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called after a $PARSE has updated the CONFIG XAB with the remote
;	OS type.  Stores the OS code in OSTYPE(D)
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,FETOST
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	XA$OST from the CONFIG XAB
;
; OUTPUT PARAMETERS:
;
;	T2		-		OS type code
;
; IMPLICIT OUTPUTS:
;
;	OSTYPE(D)
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	T2,T4.
;
;--
;[5000] New

%IF20,<
FETOST:	MOVE	T4,FAB(D)		;Get FAB
	$FETCH	T2,XAB,<(T4)>		;Get XAB link
	JUMPE	T2,%POPJ		;None, return
	$FETCH	T2,OST,<(T2)>		;Get OS type
	STORE	T2,OSTYPE(D)		;Save
	POPJ	P,

> ;End %IF20

	SUBTTL	%RMCLS	-	Close an RMS-opened file
;++
; FUNCTIONAL DESCRIPTION:
;
;	Closes RMS and RSF files. For RSF files, writes modified pages
;	before closing the file.
;
; CALLING SEQUENCE:
;
;	Called only from FOROPN CLSITA via CLSTAB
;	Returns +1 on a successful CLOSE, otherwise enters dialog mode.
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)	-	Address of FAB
;	INDX(D) -	Device type
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	OJFN/IJFN	-	Cleared on success
;	I/O flags	-	D%IN+D%OUT+D%WRT+D%MOD cleared on success
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4.
;	On $CLOSE errors, deallocates any XAB chain.
;
;--
;[5002] New

IF10,<
%RMCLS:	$SNH				;Should NOT get here on TOPS-10
> ;End IF10

%IF20,<
%RMCLS:	MOVE	T4,FAB(D)		;Get FAB address
	PUSHJ	P,DRJOFF		;Make sure DRJ is OFF!
	$FETCH	T1,IFI,<(T4)>		;Is file open now?
	JUMPE	T1,%POPJ		;No, don't close it

	LOAD	T1,INDX(D)		;Get file type
	CAIN	T1,DI.RSF		;RSF?
	 PUSHJ	P,RMCPG			;Yes, write modified buffers

	MOVE	T1,[POINT 7,%TXTBF]
	PUSHJ	P,%RMFNS		;Get address of filespec
	MOVE	T4,FAB(D)
	$STORE	T1,FNA,<(T4)>		;Set in FAB

	PUSHJ	P,CLOS$			;Do $CLOSE
	 JRST	RMCLER			;Error

	SETZM	IJFN(D)			;Clear the JFN
	SETZM	OJFN(D)
	MOVX	T1,D%IN+D%OUT+D%WRT+D%MOD ;Turn off the I/O bits
	ANDCAM	T1,FLAGS(D)
	POPJ	P,			;Return

;Here on $CLOSE errors.

RMCLER:	PUSHJ	P,RMDUXB		;Deallocate any XAB chain
	LOAD	T2,STS(D)		;Get error status
	CAIE	T2,ER$DCF
	CAIN	T2,ER$DPE		;Ignore protocol errors, the file
	 POPJ	P,			; is really closed
	$ACALL	CLS			;?Close failed

> ; End %IF20
	SUBTTL	RMCPG	-	Write modified RSF pages
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called when closing RSF files to write modified pages for
;	random-access files, or the last buffer for sequential file,
;	free the buffer for sequential files, and deallocate the page
;	table and the page flag table. Deallocation is accomplished 
;	through calls to %FREPGS and %FREBLK.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RMCPG
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	WPTR(D)		-	Address of file pages
;	WTAB(D)		-	Address of in-core page table
;	WADR(D)		-	Offset into WTAB for random-access files
;	BUFCT(D)	-	Number of pages
;	PFTAB(D)	-	Page flag table
;	FLAGS(D)	-	DDB flags
;	CC(U)		-	CARRIAGECONTROL
;	BSIZ(D)		-	Bytesize
;	EOFN(D)		-	EOF byte #
;	BPW(D)		-	Bytes/word
;	DMODE(D)	-	Data mode
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	WPTR,WADR	-	Cleared
;	FDB file page	-	FB%FOR set if file is CC=FORTRAN
;				FB%BSZ set to BSIZ(D)
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4,P1.
;
;--
;[5002] New

%IF20,<
RMCPG:	SKIPN	WPTR(D)			;Anything to write?
	 POPJ	P,			;No

	SKIPN	WTAB(D)			;Sequential-access?
	 JRST	CLSSEQ			;Yes, free buffer

	SETZM	WADR(D)			;Random, point to table start
	LOAD	P1,BUFCT(D)		;Get # pages

RMPLP:	PUSHJ	P,RMWPG			;Write if modified
	AOS	WADR(D)			;Point to next page
	SOJG	P1,RMPLP		;Do all pages
	JRST	FREBFS			;Deallocate tables, etc.

;Here for a sequential close to write last buffers.

CLSSEQ:	MOVE	T1,FLAGS(D)		;Sequential. Get flags
	TXNN	T1,D%OUT		;Last I/O output?
	 JRST	FREBFS			;No, go free up memory

	PUSHJ	P,%OCLR			;Yes, clear unused chars of last word
	PUSHJ	P,RSFOCP		;Output last buffer

;Here for both sequential and random close to deallocate pages, tables, etc.,
; and to update the FDB if necessary.

FREBFS:	MOVE	T1,WPTR(D)		;Get page pointer
	LOAD	T2,BUFCT(D)		; and number of pages
	PUSHJ	P,%FREPGS		;Free them
	SETZM	WPTR(D)			;Clear window addresses
	SETZM	WADR(D)
	SKIPE	T1,WTAB(D)		;If there is a page table
	 PUSHJ	P,%FREBLK		;Free that
	SKIPE	T1,PFTAB(D)		;And any flag table
	 PUSHJ	P,%FREBLK

	MOVE	T1,FLAGS(D)		;Get flags
	TXNN	T1,D%MOD		;Was file modified?
	 POPJ	P,			;No, we're done

;File was modified, so get the FDB page and update it.

	PUSHJ	P,RSRFDB		;Get FDB page for file
	 $ACALL	CLS			;?Can't: Close failed

	MOVEM	T1,FDBADR		;Save address
	MOVEM	T1,T4

	LOAD	T1,CC(U)		;Get CARRIAGECONTROL
	CAIE	T1,CC.FOR		;CC=FORTRAN?
	 JRST	FBBSZ			;No, don't set bit

;T4 has the base address of the FDB block in dynamic memory

	MOVE	T1,.FBCTL(T4)		;Get .FBCTL word of FDB
	TXO	T1,FB%FOR		;Set Fortran bit
	MOVEM	T1,.FBCTL(T4)		;Restore to FDB

FBBSZ:	MOVE	T1,.FBBYV(T4)		;Get .FBBYV word of FDB
	MOVX	T2,FB%BSZ		;Get field mask
	TDZ	T1,T2			;Clear byte size field
	LOAD	T2,BSIZ(D)		;Get byte size we've been using
	LSH	T2,^D24			;Shift into position
	TDO	T1,T2			;Set size

	MOVX	T2,FB%MOD		;Get field mask
	TDZ	T1,T2			;Clear data mode field
	LOAD	T2,DMODE(D)		;Get data mode
	MOVSI	T2,(T2)			;Shift into position
	TDO	T1,T2			;Set it
	MOVEM	T1,.FBBYV(T4)		;Return to FDB

	MOVE	T1,EOFN(D)		;Get file size in bytes
	LOAD	T2,BSIZ(D)		;Get bytesize
	CAIE	T2,^D36			;36 bits?
	 JRST	FBSIZ			;No, use EOFN as is

	ADD	T1,BPW(D)		;Yes, round up
	SUBI	T1,1
	IDIV	T1,BPW(D)		;Get words

FBSIZ:	MOVE	T2,.FBSIZ(T4)		;Get file size word
	SETZ	T2,			;Clear it
	TDO	T2,T1
	MOVEM	T2,.FBSIZ(T4)

	MOVE	T1,FDBADR		;Get FDB address
	PUSHJ	P,RSWFDB		;Write the FDB page
	 $ACALL	CLS			;?Can't: Close failed

	PJRST	FTMPPG			;Free the page, and return

	
	SEGMENT	DATA

FDBADR:	BLOCK	1			;Address of page containing FDB

	SEGMENT	CODE

> ; End %IF20
	SUBTTL	RMWPG	-	Write modified random-access pages
;++
; FUNCTIONAL DESCRIPTION:
;
;	Writes one page from the page table if modified.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RMWPG
;	<Return here>
;
; INPUT PARAMETERS:
;
;	P1		-	File page number to check/write
;
; IMPLICIT INPUTS:
;
;	RAB(D)		-	Address of RAB
;	WADR(D)		-	Offset into WTAB of least used page
;	WPTR(D)		-	Core page address of file pages
;	WTAB(D)		-	Address of in-core page table
;	PFTAB(D)	-	Address of page flag table (-1=modified)
;	BPW(D)		-	Bytes/word
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	BKT	-	Set to file page # +1
;		UBF	-	Set to address of in-core page
;		RSZ	-	Set to bytes/in-core page
;		RAC	-	Set to RB$BLK for block-mode
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4.
;
;--
;[5003] New

%IF20,<
RMWPG:	MOVE	T1,WADR(D)		;Get page table offset
	ADD	T1,PFTAB(D)		;Point to the page flag table
	SKIPL	(T1)			;Modified?
	 POPJ	P,			;No, just return

	SETZM	(T1)			;Flag unmodified

	MOVE	T1,WADR(D)		;Get page table offset to this page
	ADD	T1,WTAB(D)		;Point into table
	MOVE	T1,(T1)			;Get page number
	ADDI	T1,1			;+1 for bucket

	MOVE	T2,WADR(D)		;Get offset again for process page
	ADD	T2,WPTR(D)		;Get process page number
	LSH	T2,LWSIZ		;Make into address

	PUSHJ	P,PUTBKT		;$WRITE it
	 $ACALL	IOE			;Can't
	POPJ	P,			;OK, return


> ; End %IF20
	SUBTTL	%RMREN	-	Rename a remote file via RMS
;++
; FUNCTIONAL DESCRIPTION:
;
;	Renames a file via RMS and returns the expanded filespec
;	from the rename DDB to the old DDB. $RENAME requires 2 FABs,
;	which are allocated and deallocated.
;
;	If the file is local, this routine transfers control to FOROPN's
;	DSKREN for a standard rename operation, bypassing RMS.  This is
;	necessary (not simply more efficient) because RMS-accessed files
;	never perform a GTJFN% and thus locally will never properly interpret
;	logical names in the filespec. 
;
;	If a local filespec is being renamed to a remote spec, produce
;	an ER$RTN (Two different nodes) error.  The reverse (remote to
;	local spec) is permitted, since the rename JFNBLK defaults node
;	and access data to those specified in the original filespec.
;
; CALLING SEQUENCE:
;
;	Called only from FOROPN CHKREN via RENTAB.
;	Returns +2 on success, else $DCALLs to DIALOG.
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	NODNAM(D)	-	Node name
;	GEN(D)		-	Generation number.  If zero, a -1 is used
;				 in the rename spec to produce the next
;				 higher generation
;	%RNAMD		-	Rename DDB
;	%OLDDB		-	Old DDB
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	Old DDBs filespec fields are updated with the expanded rename
;	filespec.
;
;	FAB1/FAB2	-	Address of rename FABs
;	STS(D)		-	Set to ER$RTN if a local spec is being
;				 renamed to a remote spec.
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T4.
;	Allocates 2 temporary FABs, which are deallocated.
;
;--
;[5002] New

%IF20,<
%RMREN:	MOVE	T1,%OLDDB		;See if either DDB had a node
	MOVE	T2,%RNAMD
	SKIPE	NODNAM(T1)		;Is file remote?
	 JRST	RMRENR			;Yes

	SKIPN	NODNAM(T2)		;This one, too?
	 JRST	DSKREN			;No, do it the simple way

	MOVEI	T3,ER$RTN		;?Two different remote nodes
	STORE	T3,STS(T1)		;Put error where FORERR will find it
	STORE	T3,STS(T2)	
	$DCALL	RNM

RMRENR:	PUSHJ	P,RMFAB			;Get a FAB for old filespec
	MOVEM	T1,FAB1			;Save

	MOVE	T1,[POINT 7,%TXTBF] 	;Get filespec string
	PUSHJ	P,%RMFNS
	MOVE	T4,FAB1
	$STORE	T1,FNA,<(T4)>		;Store filespec address

	MOVE	D,%RNAMD		;Point at %RNAMD
	PUSHJ	P,RMFAB			;Get FAB for rename filespec
	MOVEM	T1,FAB2			;Save

	MOVEM	T1,T4			;Copy
	PUSHJ	P,ABINI			;Initialize some arg blocks

	XMOVEI	T1,NAMBLK		;Point at NAMBLK
	$STORE	T1,NAM,<(T4)>

	MOVE	T1,GEN(D)		;Get generation
	MOVEM	T1,SAVGEN		;Save it
	SKIPE	T1			;0?
	 CAMN	T1,[ASCIZ/0/]		;or 0?
	  MOVE	T1,[ASCIZ/-1/]		;Yes, set to -1
	MOVEM	T1,GEN(D)

	MOVE	T1,[POINT 7,TXTBF2]	;Get new filespec address
	PUSHJ	P,%RMFNS
	MOVE	T4,FAB2
	$STORE	T1,FNA,<(T4)>		;Store filespec address

	MOVE	T1,SAVGEN		;Restore generation
	MOVEM	T1,GEN(D)

	$RENAME	@FAB1,ERCRET,@FAB2

;If success, return the expanded RENAME filespec to the old DDB and return.
;If failure, report error.  In any case deallocate the temp FABs and update
;STS/STV
	
	MOVE	T1,FAB1			;Get FAB with status codes
	MOVE	D,%RNAMD		;Put them in rename DDB
	PUSHJ	P,FABST2		;Update STS/STV

	MOVE	D,%OLDDB		;And also in the %OLDDB
	PUSHJ	P,FABST2

	PUSHJ	P,DEAFAB		;Deallocate temporary FABs

	LOAD	T2,STS(D)		;Get status
	CAIL	T2,ER$MIN		;Error?
	 $DCALL	RNM			;Yes, report, take error return
	PUSHJ	P,%RMRFS		;No. Return filespec to DDB
	JRST	%POPJ1			;Return +2 for success


DEAFAB:	SKIPE	T1,FAB1			;Deallocate temp FABs
	 PUSHJ	P,%FREBLK
	SKIPE	T1,FAB2
	 PUSHJ	P,%FREBLK
	SETZM	FAB1			;Say they're gone
	SETZM	FAB2
	POPJ	P,

	SEGMENT	DATA

FAB1:	BLOCK	1			;Address of original FAB
FAB2:	BLOCK	1			;Address of rename FAB
SAVGEN:	BLOCK	1			;Saved GEN(D)

	SEGMENT	CODE

> ; End %IF20
	SUBTTL	%RMDSP	-	Dispose of a file via RMS
;++
; FUNCTIONAL DESCRIPTION:
;
;	Disposes of an RMS-opened file during CLOSE processing. For
;	non-queued functions, SAVE and KEEP are no-ops; EXPUNGE is
;	the equivalent of DELETE. Queued functions PUNCH and PLOT
;	are errors; PRINT/LIST and SUBMIT for RMS files are legal
;	only for VAX systems.
;
; CALLING SEQUENCE:
;
;	Called only from FOROPN CLSITA via DPTAB. Returns +2 on 
;	success, +1 to enter DIALOG.
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	CLSDDB		-	DDB to use during DISPOSE
;	%OLDDB		-	Original DDB (has OSTYPE)
;	ODISP(D)	-	Orthogonal DISPOSE value
;	OSTAT(D)	-	Orthogonal STATUS value
;	INDX(D)		-	Device index
;	STS(D)		-	RMS status code
;	OSTYPE(D)	-	Operating system type
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	DISP(D)		-	Zeroed on error to force a recalculation
;				 of the dispose index after DIALOG.
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T4,D.
;	May allocate and deallocate a FAB.
;
;--
;[5002] New

%IF20,<
%RMDSP:	MOVE	T2,CLSDDB		;Get CLOSE DDB
	LOAD	T1,ODISP(T2)		;Get orthogonal DISPOSE vale
	JUMPN	T1,RMQUE		;Non-zero means queued

;Here when the DISPOSE request is not a queued function (DELETE,
; EXPUNGE,SAVE)

	LOAD	T1,OSTAT(T2)		;Get orthogonal STATUS value
	PUSHJ	P,RMNSTA(T1)		;Go do it
	 POPJ	P,			;Can't, error return
	JRST	%POPJ1			;Did it

RMNSTA:	JRST	%POPJ1			;UNKNOWN (same as SAVE)
	JRST	%POPJ1			;SAVE
	JRST	RMERA			;DELETE
	JRST	RMEXP			;EXPUNGE (same as DELETE)

RMEXP:
RMERA:	PUSHJ	P,RMFAB			;Get a new FAB
	MOVEM	T1,FAB1			;Save its address

	MOVE	T1,[POINT 7,%TXTBF]
	PUSHJ	P,%RMFNS		;Get filespec string (fom old D)
	MOVE	T4,FAB1			;Get FAB address
	$STORE	T1,FNA,<(T4)>		;Store string address

	$ERASE	<(T4)>,ERCRET

	MOVE	T1,T4			;Point at this FAB
	PUSHJ	P,FABST2		;Update STS/STV in FAB(old D)

	PUSHJ	P,DEAFAB		;Deallocate temp FAB

	LOAD	T2,STS(D)		;Get status
	CAIL	T2,ER$MIN		;Error?
	 $DCALL	DEL			;Yes, report error
	JRST	%POPJ1			;No. Success return

;Here for queue function requests. T1 contains the DISPOSE value from ODISP

RMQUE:	MOVEM	T1,SODISP		;Save T1
	MOVE	T2,CLSDDB		;Get DDB
	LOAD	T1,INDX(T2)		;Get device type
	CAIE	T1,DI.RMS		;RMS file
	 JRST	RMQUED			;No. Go do what we can

;PRINT or SUBMIT for remote RMS files is meaningful only if the remote
; system is a VAX (which can handle queued RMS files).

	MOVE	T2,%OLDDB		;Get old DDB
	MOVE	T2,OSTYPE(T2)		;Get OS type
	CAIE	T2,XA$VMS		;VMS system?
	 JRST	UDOERR			;No, can't print/submit

RMQUED:	MOVE	T1,SODISP		;Get saved dispose value
	PUSHJ	P,RMQTB(T1)		;Go do it
	 POPJ	P,			;Can't, error return
	JRST	%POPJ1			;Did it

RMQTB:	JRST	%POPJ1			;NOTHING
	JRST	RMPRIN			;PRINT
	JRST	UDOERR			;PUNCH:?Unsupported dispose option
	JRST	RMSUB			;SUBMIT
	JRST	UDOERR			;PLOT:?Unsupported dispose option


RMSUB:	MOVX	T1,FB$SCF		;Get SUBMIT bit
	MOVEM	T1,SODISP		;Save
	JRST	RMQDEL			;Go do it

RMPRIN:	MOVX	T1,FB$SPL		;Get PRINT bit
	MOVEM	T1,SODISP

RMQDEL:	MOVE	T2,SODISP		;Get whichever
	LOAD	T1,OSTAT(D)		;Get orthogonal STATUS value
	CAIE	T1,OS.DEL		;If DELETE
	CAIN	T1,OS.EXP		;or EXPUNGE
	 TXO	T2,FB$DLT		;turn on DELETE bit
	MOVEM	T2,SODISP

	PUSHJ	P,RMFAB			;Get a FAB
	MOVEM	T1,FAB1			;Save its address

	MOVE	T1,[POINT 7,%TXTBF]
	PUSHJ	P,%RMFNS		;Get filespec string
	MOVE	T4,FAB1			;Get FAB address
	$STORE	T1,FNA,<(T4)>

	MOVE	T1,SODISP		;Get correct bits
	$STORE	T1,FOP,<(T4)>		;Set

	$OPEN	<(T4)>			;OPEN the file again, ignoring errors,
					; since a $CLOSE will clean up the 
					; network link, if any.
	$CLOSE	<(T4)>,ERCRET		;CLOSE with DISPOSE option

	MOVE	T1,T4			;Point at status FAB
	PUSHJ	P,FABST2		;Update STS/STV in FAB(old D)

	PUSHJ	P,DEAFAB		;Deallocate temp FAB

	LOAD	T2,STS(D)		;Get status
	CAIL	T2,ER$MIN		;Was there an error
	 POPJ	P,			;Yes
	JRST	%POPJ1			;Did it

UDOERR:	MOVE	T1,SODISP		;Get DISPOSE value
	MOVE	T1,DSPNAM(T1)		;Get string address
	$DCALL	UDO

DSPNAM:	0				;NOTHING
	[ASCIZ \PRINT/LIST\]
	[ASCIZ \PUNCH\]
	[ASCIZ \SUBMIT\]
	[ASCIZ \PLOT\]

	SEGMENT	DATA

SODISP:	BLOCK	1			;Save DISPOSE value

	SEGMENT	CODE

> ; End %IF20
	SUBTTL	%IRMS	-	Read next RMS record
;***************************************************************************
;*                                                                         *
;*                      ENTRIES CALLED FROM FORIO                          *
;*                                                                         *
;***************************************************************************

;++
; FUNCTIONAL DESCRIPTION:
;
;	Reads an RMS record and sets up I/O pointers to it. Called for
;	all RMS files (RSF files call %RMSIN/%RMRDW). 
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%IRMS
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	ORGAN(D)		-	File organization code
;	RAB(D)			-	RAB address
;	IRBUF(D)		-	Input record buffer pntr
;	IRBLN(D)		-	Buffer length (bytes)
;	RECTP(D)		-	RECORDTYPE=
;	FORM(D)			-	FORM=
;	BPW(D)			-	Bytes/word
;	WTAB(D)			-	Random-access
;	A.KVL			-	Keyed read value
;	A.KRL			-	Keyed read relational value
;	A.KID			-	Keyed read index id
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RFA(D)			-	Current record's RFA
;	RAB(D)	UBF		-	Buffer address
;		USZ		-	Buffer size (words)
;		RAC		-	Record access mode (SEQ, KEY)
;		KBF		-	Set to REC=
;		KSZ		-	Set to key size for indexed
;	FLAGS(D)		-	Set if EOF
;	BUFADR(D)		-	Reset if buffer expanded
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T0,T1,T3,T4.
;
;--
;[5003] New

%IF20,<
%IRMS:	PUSHJ	P,GETINB		;Get input buffer if needed

	LOAD	T1,ORGAN(D)		;Get ORGANIZATION
	MOVE	T4,RAB(D)		;Setup RAB address
	PUSHJ	P,ISORGT(T1)		;Do setup by organization

	PUSHJ	P,IRGET			;Do record input

	SKIPE	T1,KBFADR		;Temp KBF buffer?
	 PUSHJ	P,%FREBLK		;Yes, toss it
	SETZM	KBFADR
	PJRST	RMSWPT			;Setup for I/O from window


IRGET:	PUSHJ	P,GET$			;Do $GET
	 JRST	IRMERR			;Error

	$FETCH	T1,RSZ,<(T4)>
	MOVEM	T1,IRLEN(D)		;Save # bytes actually read
	MOVEM	T1,IRCNT(D)
	ADD	T1,BPW(D)		;Round up to words
	SUBI	T1,1
	IDIV	T1,BPW(D)
	MOVEM	T1,RECLEN		;Store as local record length
	$FETCH	T1,RFA,<(T4)>		;Get returned RFA
	STORE	T1,RFA(D)		;Save
	MOVE	T1,CREC(D)		;Get record number for CACHIT
	PJRST	CACHIT			;Go cache, maybe, and return

;Here on $GET errors. If the error is ER$EOF, flag D%END and zero IRCNT.
; If the error is ER$RNF (record not found), we have tried to read a deleted
; record or a record not yet written. If ORG=REL and access is random, return
; RNR ("?record not written") error. 
;
; If the error is ER$RTB (record too big), expand the
; record buffer, set access to RFA, re-$GET the record and return.
; All other errors abort.

IRMERR:	CAIN	T2,ER$EOF		;EOF?
	 JRST	IRMEOF			;Yes, handle it
	CAIN	T2,ER$RNF		;Record not found?
	 JRST	IRMRNF			;Yes, check it out
	CAIN	T2,ER$RTB		;Record too big?
	 JRST	IRMRTB			;Yes.

;Here on fatal $GET errors.

	PUSHJ	P,IRMSTS		;Go update STS/STV
	$ACALL	IOE

IRMEOF:	MOVX	T0,D%END
	IORM	T0,FLAGS(D)		;Set EOF seen
	SETZM	IRCNT(D)		;We read zero characters
	PUSHJ	P,RABSTV
	POPJ	P,

IRMRNF:	LOAD	T1,ORGAN(D)		;Get ORG=
	CAIN	T1,OR.REL		;Relative?
	SKIPGE	WTAB(D)			;or random-access?
	 JRST	RETRNR			;Yes, "Record not written"

	MOVE	T1,RAB(D)		;No
	PUSHJ	P,RETSUC		;Clear "error"
	SETZM	IRLEN(D)		;Return a null record
	SETZM	IRCNT(D)
	POPJ	P,

RETRNR:	PUSHJ	P,IRMSTS		;Go update STS/STV
	LOAD	T1,ORGAN(D)		;Get ORGANIZATION
	CAIN	T1,OR.IDX		;INDEXED?
	 $ACALL	IOE			;Yes, "?Record not found"
	$ACALL	RNR			;Issue error

;?Record too big for buffer.  STV contains the actual size of the
;record, so use that as minimum expansion size.

IRMRTB:	$FETCH	T3,STV,<(T1)>
	PUSHJ	P,EXPIRB		;Expand the buffer
	PUSHJ	P,IRBWIN		;Disguise it as a window
	PUSHJ	P,UBFUSZ		;Setup UBF,USZ

	MOVX	T1,RB$RFA
	$STORE	T1,RAC,<(T4)>		;Set RFA access
	MOVE	T1,RAB(D)
	PUSHJ	P,RETSUC
	JRST	IRGET			;And go try again

;Here for fatal errors. Update STS/STV, deallocate KBF if present

IRMSTS:	PUSHJ	P,RABSTV
	SKIPE	T1,KBFADR
	 PUSHJ	P,%FREBLK
	SETZM	KBFADR
	POPJ	P,

;Here for ORGANIZATION=SEQUENTIAL
ISSEQ:	MOVEI	T1,[ASCIZ /SEQUENTIAL/]
	SKIPE	A.KVL			;Trying keyed read for OR.SEQ?
	 $ACALL	KRI			;?Keyed read illegal

	MOVX	T1,RB$SEQ		;No. Assume sequential access

;NOTE: the following 2 lines can be uncommented whenever RMS decides
; to fix random $GETs to fixed-length sequential files...

;	SKIPE	WTAB(D)			;Random?
;	 MOVX	T1,RB$KEY		;Yes, set it

	$STORE	T1,RAC,<(T4)>		;Set it in RAB

	XMOVEI	T1,@A.REC		;Get REC= (or 0 for seq-access)
	$STORE	T1,KBF,<(T4)>

	POPJ	P,

;Here for ORGANIZATION=RELATIVE. For random-access set RAC=KEY, where KBF
; points to the record number from a REC=. For sequential access set RAC=SEQ;
; the VAX-compatible RMS behavior now will be to silently skip sequential
; requests to read a deleted or empty record and return the next existing
; record (or EOF).  This also means that RELATIVE files cannot be BACKSPACEd,
; since the actual file current record # is unavailable to FOROTS.

ISREL:	MOVEI	T1,[ASCIZ /RELATIVE/]
	SKIPE	A.KVL			;Trying keyed read for OR.REL?
	 $ACALL	KRI			;?Keyed read illegal

	MOVX	T1,RB$KEY		;No. Assume random-access
	SKIPN	WTAB(D)			;Random?
	 MOVX	T1,RB$SEQ		;No, sequential
	$STORE	T1,RAC,<(T4)>		;Set it in RAB

	XMOVEI	T1,@A.REC		;Get REC= (or 0 for seq-access)
	$STORE	T1,KBF,<(T4)>
	JUMPE	T1,%POPJ		;If seq access, done
	MOVE	T1,(T1)			;For random, update current rec
	MOVEM	T1,CREC(D)
	POPJ	P,

;Here for ORGANIZATION=INDEXED.
; If user's KEYxx keyed read data exists in A.KVL, we setup for a keyed
; read: RAC=KEY; KBF=A.KVL; KRF=keyid (index number); KSZ=A.KVL size in
; bytes for CHARACTER, else zero; ROP=Key relational data. If A.KVL is zero,
; this is a sequential read: RAC=SEQ, KBF/KSZ/ROP=0.

ISIDX:	SKIPE	A.KVL			;Keyed read?
	 JRST	ISKIDX			;Yes

	MOVX	T1,RB$SEQ		;No, sequential
	$STORE	T1,RAC,<(T4)>		;RAC=SEQ
	SETZ	T1,			;Clear any KSZ/KBF pntrs
	$STORE	T1,KBF,<(T4)>
	$STORE	T1,KSZ,<(T4)>
	POPJ	P,

;Here for keyed read

ISKIDX:	MOVX	T1,RB$KEY		;RAC=KEY
	$STORE	T1,RAC,<(T4)>

	SKIPN	T1,A.KID		;KEYID specified?
	 JRST	ISKKVL			;No, use last READ's, or primary

	MOVE	T1,@T1			;Yes, get key-of-reference
	$STORE	T1,KRF,<(T4)>		;Store

ISKKVL:	MOVE	T1,A.KVL		;Get key data pntr
	XMOVEI	T1,@T1			;Get address of KVL data
	LDB	T2,[POINTR (A.KVL,ARGTYP)] ;Get type data type
	MOVEI	T3,4			;Assume 4 for INTEGER length
	CAIE	T2,TP%CHR		;CHARACTER?
	 JRST	ISKSTO			;Integer, got the address

	DMOVE	T0,@A.KVL		;Yes, get descriptor and length
	ADD	T1,BPW(D)		;In words, plus spare byte(s)
	IDIV	T1,BPW(D)
	PUSHJ	P,%GTBLK		;Get tmp key buffer
	 $ACALL	MFU			;Can't
	MOVEM	T1,KBFADR		;Save address
	SUBI	T1,1			;Correct it
	HXL	T1,BYTPT(D)		;Make byte pntr to buffer
	DMOVE	T2,@A.KVL		;Get pntr/count back
	PUSHJ	P,MOVSTR		;Move data to destination
	MOVE	T4,RAB(D)		;Get RAB address
	MOVE	T1,KBFADR		;Get KBF address
	DMOVE	T2,@A.KVL		;Get length back

ISKSTO:	$STORE	T1,KBF,<(T4)>		;Set KBF
	$STORE	T3,KSZ,<(T4)>		;Set length

;Here to set key relational (KGE/KGT) value.  A.KVL is cleared here,
;so a subsequent %IRMS call in the same READ statement will get the
;next sequential record in the current index.

ISKROP:	$FETCH	T1,ROP,<(T4)>		;First turn off existing relationals
	TXZ	T1,RB$KGE!RB$KGT
	MOVE	T2,@A.KRL		;Get user's new value
	TDO	T1,KRLTAB(T2)		;Set RMS bits
	$STORE	T1,ROP,<(T4)>
	SETZM	A.KVL
	POPJ	P,

	SEGMENT	DATA

KBFADR:	BLOCK	1			;Address of KBF data

	SEGMENT	CODE

KRLTAB:	0				;(0) KEY=
	0				;(1) KEYEQ=
	RB$KGE				;(2) KEYGE=
	RB$KGT				;(3) KEYGT=

ISORGT:	JRST	ISSEQ			;NONE
	JRST	ISSEQ			;SEQUENTIAL
	JRST	ISREL			;RELATIVE
	JRST	ISIDX			;INDEXED

> ; End %IF20
	SUBTTL	GETINB	-	Get input buffer, setup RAB
;++
; FUNCTIONAL DESCRIPTION:
;
;	Gets an input buffer if not already allocated, sets up window
;	pointers to it, and sets up RAB UBF and USZ.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,GETINB
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)		-		Address of RAB
;	BUFADR(D)	-		Address of buffer
;	IRBLN(D)	-		Buffer length (bytes)
;	IRBUF(D)	-		Non-zero if already a buffer
;	BPW(D)		-		Bytes/word
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	UBF	-		Buffer address
;		USZ	-		Length in words
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T4
;
;--
;[5003] New
%IF20,<
GETINB:	SKIPN	IRBUF(D)		;Have buffer already?
	 PUSHJ	P,GETIRB		;No, get one
	PUSHJ	P,IRBWIN		;Make it look like a wondow

UBFUSZ:	MOVE	T4,RAB(D)		;Get RAB address
	MOVE	T1,BUFADR(D)		;Get buffer address
	$STORE	T1,UBF,<(T4)>		;Store

	MOVE	T1,IRBLN(D)		;Get buffer size in bytes
	ADD	T1,BPW(D)		;Round up to words
	SUBI	T1,1
	IDIV	T1,BPW(D)		;Get it in words
	$STORE	T1,USZ,<(T4)>		;Store
	POPJ	P,

> ;End %IF20
	SUBTTL	IRBWIN	-	Make a buffer look like a window
;++
; FUNCTIONAL DESCRIPTION:
;
;	Sets up pointers to a record buffer returned by GETIRB so it
;	looks like a window.
;
; CALLING SEQUENCE:
;
;	None
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	IRBUF(D)		-	Buffer pointer
;	IRBLN(D)		-	Buffer size
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	WADR(D)			-	Updated with IRBUF-1
;	BUFADR(D)		-	    "     "    "
;	WPTR(D)			-	Buffer page number
;	WSIZ(D)			-	Size in bytes
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;
;--
;[5003] New

%IF20,<
IRBWIN:	MOVE	T1,IRBUF(D)		;Get pntr-1 to it
	MOVEI	T1,1(1)			;Correct it
	HRRZM	T1,WADR(D)		;Save address
	HRRZM	T1,BUFADR(D)		;Here too
	LSH	T1,-LWSIZ		;Make it a page number
	MOVEM	T1,WPTR(D)		;Save

	MOVE	T1,IRBLN(D)		;Get buffer size 
	MOVEM	T1,WSIZ(D)		;Save as window size in bytes
	POPJ	P,

> ; End %IF20
	SUBTTL	%UORMS	-	Setup output buffer for unformatted WRITE
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called for unformatted RMS writes to setup an output record
;	buffer and make it look like a "window."  If the buffer already
;	exists, checks whether it should be expanded for variable-length
;	output.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%UORMS
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	ORBUF(D)	-		Address of record buffer, if any.
;	RECTP(D)	-		RECORDTYPE=
;	FORM(D)		-		FORM=
;	BPW(D)		-		Bytes/word
;	BYTPT(D)	-		Byte pointer
;	BUFADR(D)	-		Buffer address
;	RSIZE(D)	-		User-specified RECL
;	ORBLN(D)	-		Buffer size in bytes
;	ORBUF(D)	-		Buffer pointer
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	PAGNUM		-		Cleared
;	BYTUSD		-		Bytes used in expanded buffer
;	EOFN(D)		-		Infinity
;	ORBUF(D)	-		BP to beginning of record buffer
;	ORBEG(D)	-		"   "     "     "    "      "
;	ORBLN(D)	-		Buffer length, bytes
;	WADR(D)		-		Set to buffer address
;	BUFADR(D)	-		Set to buffer address
;	WPTR(D)		-		Page number of buffer
;	WSIZ(D)		-		Window size in bytes
;	ICNT(D)		-		Record byte count
;	IPTR(D)		-		Current record pntr
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--
;[5004] New

%IF20,<
%UORMS:	SKIPE	ORBUF(D)		;Any buffer yet?
	 JRST	CHKEXP			;Yes, maybe expand it

	PUSHJ	P,GETORB		;No. Get a buffer
	SETZB	T1,T2
	DMOVEM	T1,PAGNUM		;No used byte count for new buffer

GOTORB:	PUSHJ	P,ORBWIN		;Make it look like a "window"

;Clear new  buffer
	
	MOVE	T3,ORBLN(D)		;Get length
	ADD	T3,BPW(D)		;Round up to words
	SUBI	T3,1
	IDIV	T3,BPW(D)		;Get # words

	MOVE	T1,BUFADR(D)		;Get start address to clear
	
	SETZM	(T1)
	CAIN	T3,1			;One-word buffer?
	 JRST	UORRET			;Yes
	MOVSI	T2,(T1)
	HRRI	T2,1(T1)		;start,,start+1
	ADDI	T1,(T3)			;Make the BLT limit+1
	BLT	T2,-1(T1)

UORRET:	HRLOI	T1,377777		;Reset RMS's EOFN to infinite
	MOVEM	T1,EOFN(D)
	POPJ	P,

CHKEXP:	SKIPE	ORLEN(D)		;Any record length yet?
	SKIPE	RSIZE(D)		;Yes. Fixed recordsize specified?
	 JRST	GOTORB			;Yes, no need to expand, or new buffer
	HRRZ	T1,IPTR(D)		;Any data?
	JUMPE	T1,GOTORB		;No, don't expand
	MOVE	T1,ICNT(D)		;Get words in window
	IDIV	T1,BPW(D)
	JUMPG	T1,GOTORB		;Room left

;Here to expand the "window"

	HRRZ	T1,ORBUF(D)		;Get old buffer address
	ADDI	T1,1			;Corrected
	MOVE	T2,ORBLN(D)		;Get old length in bytes
	MOVEM	T2,BYTUSD		;Save as bytes used
	MOVEM	T3,ORLEN(D)		;Set current length
	IDIV	T2,BPW(D)		;in words
	MOVEM	T2,T3			;Copy
	LSH	T3,1			;Double it for new length
	PUSHJ	P,%MVBLK		;Move to bigger buffer
	 $ACALL	RTL			;Can't
	SUBI	T1,1			;Point to previous word
	HXL	T1,BYTPT(D)		;Make byte pntr to beg of new
	MOVEM	T1,ORBUF(D)		;Store new address
	MOVEM	T1,ORBEG(D)
	IMUL	T3,BPW(D)		;Get new length in bytes
	MOVEM	T3,ORBLN(D)		;Store
	PUSHJ	P,ORBWIN
	JRST	UORRET

ORBWIN:	MOVE	T1,ORBUF(D)		;Get pntr-1 to it
	MOVEI	T1,1(1)			;Correct it
	HRRZM	T1,WADR(D)		;Save address
	HRRZM	T1,BUFADR(D)		;Here too
	LSH	T1,-LWSIZ		;Make it a page number
	MOVEM	T1,WPTR(D)		;Save
	MOVE	T2,ORBLN(D)		;Get buffer size 
	MOVEM	T2,WSIZ(D)		;Save as window size in bytes
	SUB	T2,BYTUSD		;Get bytes available
	MOVEM	T2,ORLEN(D)		;Set record length 

	MOVE	T3,ORBUF(D)		;Get pntr again
	MOVE	T1,BYTUSD		;Get bytes used within "page"
	ADJBP	T1,T3			;Update pntr
	DMOVEM	T1,IPTR(D)		;Save pntr/count
	POPJ	P,


> ; End %IF20

	SUBTTL	%ORMS	-	Write a record with RMS
;++
; FUNCTIONAL DESCRIPTION:
;
;	Writes an RMS record.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%ORMS
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)		-		Address of FAB
;		ORG	-		ORGANIZATION
;	RAB(D)		-		Address of RAB
;	ORGAN(D)	-		ORGANIZATION
;	ORBEG(D)	-		BP to beginning of record buffer
;	ORLEN(D)	-		Formatted actual record length
;	ORSIZ(D)	-		Unformatted buffer length
;	RECTP(D)	-		RECORDTYPE
;	ORBLN(D)	-		Record buffer length, bytes
;	A.REC		-		Address of record number
;	CREC(D)		-		Current record #
;	FLAGS(D)	-		DDB flags
;	RFA(D)		-		RFA
;	WTAB(D)		-		Non-zero if random-access
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	RAC	-		Record access (FB$SEQ, FB$KEY)
;		RBF	-		Record buffer address
;		RSZ	-		Record size, bytes
;		KBF	-		Address of key data
;	RFA(D)		-		RFA from successful output
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T0-T2,T4.
;
;--

;[5004] New

%IF20,<
%ORMS:	MOVE	T4,RAB(D)		;Get RAB address
	MOVE	T1,ORBEG(D)		;Get buffer address
	MOVEI	T1,1(T1)		;Adjust it
	$STORE	T1,RBF,<(T4)>		;Store

;If records are fixed-length, set RSZ to the buffer size, else set to
; the actual record-length in bytes (formatted), or the unformatted buffer
; size in bytes. Indexed files always set to MRSIZE.

	SKIPN	T1,ORLEN(D)		;Assume not fixed, use formt'ed len
	 MOVE	T1,ORSIZ(D)		;or unformatted buffer length
	LOAD	T2,RECTP(D)		;Get RECORDTYPE
	CAIN	T2,RT.FIX		;FIXED?
	 MOVE	T1,ORBLN(D)		;Yes, use fixed buffer length
	LOAD	T2,ORGAN(D)		;Get ORGANIZATION
	CAIN	T2,OR.IDX		;INDEXED?
	 MOVE	T1,MRSIZE(D)		;Yes, use MRS
	$STORE	T1,RSZ,<(T4)>		;Store as RSZ

	XMOVEI	T1,@A.REC		;Get address of recnum (or 0)
	SKIPN	T1			;If none, use CREC
	 XMOVEI	T1,CREC(D)
	$STORE	T1,KBF,<(T4)>

	LOAD	T1,ORGAN(D)		;Get organization
	MOVE	T2,OSORGT(T1)		;Set RAC by org
	$STORE	T2,RAC,<(T4)>

	MOVE	T0,FLAGS(D)		;Get flags
	TXNE	T0,D%RWI		;Is this a REWRITE?
	 JRST	DOUPD			;Yes, do an $UPDATE instead

;Ugly workaround for relative files.  Do a pre-$PUT $FIND on the
;record to see if we will get ER$REX on the $PUT, which must be
;avoided for remote files since it may hang the CONTINUE(abort)
;sequence.

	CAIN	T1,OR.REL		;ORG=REL?
	 JRST	REXFND			;Yes, do pre-$FIND

DOPUT:	PUSHJ	P,PUT$			;Do $PUT
	 $ACALL	IOE

ORMOK:	$FETCH	T1,RFA,<(T4)>		;Get the RFA
	MOVEM	T1,RFA(D)		;Save it
	MOVE	T1,CREC(D)		;Get record number for CACHIT
	PUSHJ	P,CACHIT		;Cache if necessary
	PUSHJ	P,ORINI			;Re-init the buffer
	SKIPN	WTAB(D)			;Random access?
	 POPJ	P,			;No, all done

	LOAD	T1,ORGAN(D)		;Get ORGANIZATION
	CAIN	T1,OR.REL		;RELATIVE?
	SKIPN	A.FMT			;Yes. Formatted output?
	 POPJ	P,			;No, we're done

;Special case for formatted random relative output.  Since slash format
;or indefinte repeat may cause more than one record to be written per
;IOLST. call, we must forget about the user-specified record # in A.REC
;and instead use CREC the next time around (ugh), since otherwise
;the same record will get written again with the new data.

	SKIPN	T1,A.REC		;Get address of recnum
	 XMOVEI	T1,CREC(D)		;or CREC if none
	MOVE	T1,@T1			;Get the number
	MOVEM	T1,CREC(D)		;Set it as current
	SETZM	A.REC			;Clear A.REC pntr
	POPJ	P,

;Here for REWRITE (update an indexed/relative file record), or for
;random-access relative files that tried to $PUT a record to an 
;already-existing record cell.  Indexed records, and fixed-length
;relative records, cannot change record size on an $UPDATE
;(fixed-length records will have been truncated/padded by FOROTS).
;Variable records for which an MRS RECL has been specified
;will get an error if their updated length exceeds MRS.
;
;Indexed $UPDATEs may get errors if the primary key changes or a key
;value is duplicated where these are not allowed in the XAB chain.

DOUPD:	MOVX	T0,D%RWI		;Turn off REWRITE flag
	ANDCAM	T0,FLAGS(D)

	PUSHJ	P,UPDA$			;Do $UPDATE
	 $ACALL	IOE
	JRST	ORMOK			;Update RFA/STV, return


;Here to check if the $PUT will ER$REX for relative files.
;Sequential-access relative files fail with ER$REX;
;random-access relative files do an $UPDATE.

REXMM==50133				;[5023] MAC/MICcode for REX STV
REXFND:	PUSHJ	P,FIND$			;[5023] Find the target record
	 JRST	DOPUT			;[5023] Presumably not there (good)
	SKIPE	WTAB(D)			;[5023] Random access?
	 JRST	RELUPD			;[5023] Yes, do an $UPDATE
	MOVX	T2,ER$REX		;[5023] No. Make ER$REX error
	SETZ	T3,			;[5023] Assume local
	SKIPE	NODNAM(D)		;[5023] If remote
	 MOVEI	T3,REXMM		;[5023]  also return STV
	PUSHJ	P,MAKSTS		;[5023] Fake REX
	$ACALL	IOE


RELUPD:	MOVE	T1,ORBEG(D)		;[5023] Get buffer address
	MOVEI	T1,1(T1)		;[5023] Adjust it
	$STORE	T1,RBF,<(T4)>		;[5023] Store
	JRST	DOUPD			;go do $UPDATE
	

OSORGT:	RB$SEQ				;NONE
	RB$SEQ				;SEQUENTIAL
	RB$KEY				;RELATIVE
	RB$KEY				;INDEXED

> ;End %IF20
	SUBTTL	%RMFND	-	FIND a direct-access relative record
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called from FIND processing in FORIO for files with INDX(D) DI.RMS.
;	This routine checks that the file is an RMS relative file opened
;	for direct access.  If not, it aborts.  If so, it establishes
;	the current record as specified in the user's REC=.  No data is
;	transferred.  An attempt to find a non-existent or deleted
;	record will (VAX compatibly) produce an error.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMFND
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	ORGAN(D)		-	ORGANIZATION
;	WTAB(D)			-	-1 if random-access
;	RAB(D)			-	RAB address
;	A.REC			-	User's REC=
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RFA(D)			-	Set to new current record
;	RAB(D)	RAC		-	RB$KEY
;	RAB(D)	RBF		-	Address of record number
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T4.
;
;--
;[5004]

IF10,<
%RMFND:	$SNH				;Should NOT get here from TOPS-10
> ;End IF10

%IF20,<
%RMFND:	LOAD	T1,ORGAN(D)		;Get ORGANIZATION
	SKIPE	WTAB(D)			;Access must be direct
	CAIE	T1,OR.REL		;ORG must be RELATIVE
	 $ACALL	CDR			;Can't do direct I/O to seq file

	MOVE	T4,RAB(D)		;Get RAB address
	XMOVEI	T1,@A.REC		;Get REC=
	$STORE	T1,KBF,<(T4)>		;Tell RMS about it

	MOVX	T1,RB$KEY		;Setup for keyed access
	$STORE	T1,RAC,<(T4)>

	PUSHJ	P,FIND$			;Do $FIND
	 $ACALL	IOE			;Error

	$FETCH	T1,RFA,<(T4)>		;Get RFA
	MOVEM	T1,RFA(D)		;Update
	PJRST	%SETAV			;Return

> ;End %IF20
	SUBTTL	%RMCRW	-	Check if a REWRITE is legal
;++
; FUNCTIONAL DESCRIPTION:
;
;	Checks that the execution of a REWRITE statement is legal for
;	the specified unit/file.  The file must be an RMS indexed or
;	relative file not opened READONLY.
;	
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMCRW
;	<Return here; errors to %ABORT>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	INDX(D)		-		File type
;	ORGAN(D)	-		ORGANIZATION
;	RO(D)		-		READONLY
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	If the requested REWRITE is illegal, enters error handler.
;	Uses T1.
;
;--
;[5004] New

%IF20,<
%RMCRW:	LOAD	T1,ORGAN(D)		;Screen by ORGANIZATION
	SKIPE	T1			;If none (non-RMS),
	CAIN	T1,OR.SEQ		;or SEQUENTIAL,
	 $ACALL	SIF			;then illegal statement

	SKIPE	A.REC			;Illegal if record number given
	 $ACALL	CDR			;Report random I/O to seq file

	LOAD	T1,RO(D)		;Get READONLY-ness
	JUMPN	T1,ILLOUT		;READONLY, complain
	POPJ	P,			;No, ok

> ;End %IF20
	SUBTTL	%RMREW	-	Rewind an RMS file
;++
; FUNCTIONAL DESCRIPTION:
;
;	Rewinds a sequentially-accessed RMS file.  An error is issued
;	if the file is open for direct access.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMREW
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	ORGAN(D)		-	ORGANIZATION
;	WTAB(D)			-	Non-zero if access direct
;	RAB(D)			-	Address of RAB
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5004] New

%IF20,<
%RMREW:	LOAD	T2,ORGAN(D)	;Get ORGANIZATION
	CAIE	T2,OR.IDX	;Complain if INDEXED, or
	SKIPE	WTAB(D)		;random-access
	 $ACALL	SIF		;?Statement illegal

	MOVX	T1,D%END	;Get Flags
	ANDCAB	T1,FLAGS(D)	;Set no EOF
	PUSHJ	P,%SETIN	;Get file open for input

	PUSHJ	P,REWI$		;Rewind file
	 $ACALL	IOE		;Error

	SETZM	CREC(D)		;Clear RECORD NUMBER
	SETZM	IPTR(D)		;Pretend no I/O done
	SETZM	ICNT(D)		;No bytes in buffer
	SETZM	BYTN(D)		;Set current byte number to 0
	POPJ	P,		;Return


> ; End %IF20

	SUBTTL	%RMBSR	-	BACKSPACE RMS sequential file
;++
; FUNCTIONAL DESCRIPTION:
;
;	Backspace an RMS sequential file.  If RFA cacheing is enabled,
;	the cache is searched for the target RFA which matches the target
;	record number.  If not found, or cacheing has been disabled 
;	(FORPRM parameter CASHSZ is zero), the file is rewound and n-1
;	records are read ($FIND) to position to the target record.
;
;	BACKSPACE is legal only for RMS sequential files not opened
;	ACCESS='APPEND'
;.
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMBSR
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	ORGAN(D)		-		ORGANIZATION
;	RAB(D)			-		Address of RAB
;		ROP		-		RB$EOF
;	CREC(D)			-		Current record #
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	CREC(D)			-		Decremented
;	RAB(D)	RAC		-		RB$KEY
;	RFA(D)			-		Updated during REWIND
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T4.  
;	May rewind file and read n-1 records.
;
;--
;[5013] New

%IF20,<
%RMBSR:	LOAD	T1,ORGAN(D)		;Get ORGANIZATION
	JRST	BAKTAB(T1)		;Screen by organization

;Ensure that only ORG=SEQ RMS files can be BACKSPACEd.

BAKTAB:	$SNH				;UNKNOWN (should not get here!)
	JRST	BAKSEQ			;SEQUENTIAL
	$ACALL	SIF			;RELATIVE (illegal)
	$ACALL	SIF			;INDEXED (illegal)

BAKSEQ:	MOVE	T4,RAB(D)		;Get RAB address
	$FETCH	T1,ROP,<(T4)>		;Get ROP bits
	TXNE	T1,RB$EOF		;/APPEND?
	 $ACALL	SIF			;Yes, can't backspace
	PUSHJ	P,%SETIN		;Switch to input
	SKIPG	CREC(D)			;At beginning of file?
	 POPJ	P,			;Yes, can't backspace more

	SOS	T1,CREC(D)		;Decrement CREC
	MOVE	T0,FLAGS(D)		;Get DDB flags
	TXNE	T0,D%END		;At EOF?
	 JRST	%BAKEF			;Yes, just clear D%END

;Here for a cache search to see if the requested record number's RFA
; is cached.  If so, $FIND it and return.  If not, rewind and read n-1.

	JUMPG	T1,BSRGET		;If not at rec#1, must backspace

;Here if at first record.  Must REWIND so next read gets same record.

	PUSHJ	P,REWI$			;Do rewind
	 $ACALL	IOE			;Error
	POPJ	P,			;Done

BSRGET:	MOVEM	T1,TRGREC		;Save target rec#

;Get an input buffer if needed

	PUSHJ	P,GETINB

;Search the cache for the RFA corresponding to our target record #.  If
; cacheing has been disabled, must rewind and read n-1.

	PUSHJ	P,CSHFND		;Search the cache
	 JRST	GOTRFA			;Found it

;Here when not cached, or no cache.  Do a rewind.

	PUSHJ	P,REWI$			;Rewind file
	 $ACALL	IOE

	SETZM	LOCREC			;Clear local counter
	MOVX	T1,RB$SEQ		;Set sequential access
	$STORE	T1,RAC,<(T4)>

;Read n-1 records to position the file to the target record.

BSRLP:	PUSHJ	P,FIND$			;$FIND a record
	 $ACALL	IOE

	$FETCH	T1,RFA,<(T4)>		;Get RFA
	STORE	T1,RFA(D)		;Save for CACHIT

	AOS	T1,LOCREC		;Bump counter
	PUSHJ	P,CACHIT		;Update cache
		
	SOSLE	TRGREC			;Reached target # yet?
	 JRST	BSRLP			;No, keep going

	JRST	BSRCRP			;Yes, establish as current record

;Here when we have the target RFA from the cache

GOTRFA:	$STORE	T1,RFA,<(T4)>		;Store target RFA
BSRCRP:	MOVX	T1,RB$RFA		;Set RFA access
	$STORE	T1,RAC,<(T4)>

	PUSHJ	P,GET$			;Establish as current
	 $ACALL	IOE

	MOVX	T1,RB$SEQ		;Reset to SEQ
	$STORE	T1,RAC,<(T4)>

	POPJ	P,

	SEGMENT	DATA

TRGREC:	BLOCK	1			;Target record number
LOCREC:	BLOCK	1			;Local record counter

	SEGMENT	CODE

> ;End %IF20
	SUBTTL	CSHFND	-	Search the cache for a record number
;++
; FUNCTIONAL DESCRIPTION:
;
;	Searches the record/RFA cache for the requested record number and
;	returns the matching RFA if found.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,CSHFND
;	<Return here if rec# found>
;	<Return here if not found>
;
; INPUT PARAMETERS:
;
;	TRGREC		-		Target record number
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	T1		-		RFA if found
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--
;[5013] New

%IF20,<
CSHFND:	SKIPN	T2,CACHE(D)		;Cacheing enabled?
	 JRST	%POPJ1			;No, return +2
	MOVEI	T3,CACHSZ
	ADD	T3,T2			;Get cache_end+1

CSHLP:	CAML	T2,T3			;Beyond limit?
	 JRST	%POPJ1			;Yes, not found
	MOVE	T0,(T2)			;Get a record# from cache
	JUMPE	T0,%POPJ1		;If entry is null, entry not found
	CAMN	T0,TRGREC		;Our target #?
	 JRST	CSHGOT			;Yes
	ADDI	T2,2			;No, bump pointer to next entry
	JRST	CSHLP			;Keep going

CSHGOT:	MOVE	T1,1(T2)		;Get associated RFA
	POPJ	P,			;Return

> ;End %IF20
	SUBTTL	%RMASV	-	Handle RMS ASSOCIATEVARIABLE
;++
; FUNCTIONAL DESCRIPTION:
;
;	Updates the ASSOCIATEVARIABLE for RMS files.  It is ignored for
;	RMS files unless ORGANIZATION='RELATIVE' or ACCESS='DIRECT'.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMASV
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	ORGAN(D)		-	ORGANIZATION
;	ACC(D)			-	ACCESS
;	CREC(D)			-	Current record
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	AVAR(D)			-	ASSOCIATEVARIABLE
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	T1,T2.
;
;--
;[5003] New

IF10,<					;No-op on TOPS10
%RMASV:	POPJ	P,
> ;End IF10

%IF20,<
%RMASV:	LOAD	T1,ORGAN(D)		;Get ORGANIZATION=
	CAIE	T1,OR.REL		;RELATIVE?
	 POPJ	P,			;No, ignore assocvar

	LOAD	T1,ACC(D)		;Get ACCESS=
	CAIE	T1,AC.RIO		;ACCESS='DIRECT'?
	CAIN	T1,AC.RIN
	 TRNA				;Yes, set the AV
	POPJ	P,			;No, ignore AV

	MOVE	T2,AVAR(D)		;Get ASSOCVAR
	MOVE	T1,CREC(D)		;Get CREC
	ADDI	T1,1			;Increment
	MOVEM	T1,(T2)			;Store
	POPJ	P,

> ; End %IF20

	SUBTTL	%RMCDL	-	Check if DELETE is legal
;++
; FUNCTIONAL DESCRIPTION:
;
;	Checks whether a DELETE statement is legal for the requested
;	file type.  The file must be an RMS relative or indexed file
;	for which a DDB has been established.
;
;	If a DELETE statement is the first I/O statement for a deferred-
;	open unit, a new file will be created for output, and the DELETE
;	will fail with a "?No current record" error.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMCDL
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	%CUNIT		-		Current unit #
;	DDBAD(U)	-		DDB address
;	%DDBTAB(U)	-		UDBs
;	RO(D)		-		READONLY
;	ORGAN(D)	-		ORGANIZATION
;	A.REC		-		Record number
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	%UDBAD		-		Flagged as I/O in progress
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;	$ACALLs if DELETE is illegal for file.
;
;--
;[5013] New

%IF20,<
%RMCDL:	MOVE	T1,%CUNIT		;Get unit number
	SKIPN	U,%DDBTA(T1)		;Get UDB addr
	 $ACALL	SIF			;None. No implicit OPEN/DELETE
	MOVEM	U,%UDBAD		;We have started an I/O statement
	MOVE	D,DDBAD(U)		;Get DDB addr

	LOAD	T1,RO(D)		;Get READONLY-ness
	JUMPN	T1,ILLOUT		;Can't if readonly

	LOAD	T1,ORGAN(D)		;Get ORGANIZATION
	JRST	DELTAB(T1)		;Screen by organization

DELTAB:	$ACALL	SIF			;UNKNOWN (non-RMS)
	$ACALL	SIF			;SEQUENTIAL (illegal)
	JRST	RELDEL			;RELATIVE
	JRST	IDXDEL			;INDEXED

;Here for RELATIVE deletes.  If direct-access, a REC= is required. If
;seq access, a REC= is forbidden.

RELDEL:	SKIPN	WTAB(D)			;Random I/O?
	 JRST	RELDSQ			;No, must not have REC=.
	SKIPN	A.REC			;Yes. Must have REC=
	 $ACALL	CDS
	POPJ	P,

RELDSQ:	SKIPE	A.REC			;Must not have REC=
	 $ACALL	CDR
	POPJ	P,

;Here for INDEXED deletes.  REC= forbidden.

IDXDEL:	SKIPE	A.REC			;Make sure there's no record #
	 $ACALL	IRN
	POPJ	P,
	 
> ;End %IF20
	SUBTTL	%RMDEL	-	DELETE an RMS record
;++
; FUNCTIONAL DESCRIPTION:
;
;	DELETEs a record from an RMS relative or indexed file.  If no REC=
;	has been specified, this is a current-record delete: the last record
;	successfully located by a READ or FIND is deleted (relative and indexed
;	files).  If a REC= is supplied (relative files only), the specified
;	record is deleted.
;
;	After a direct access delete, the ASSOCIATEVARIABLE is set to the
;	next record.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMDEL
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)			-		Address of RAB
;	A.REC			-		Record number
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	RAC		-		RB$KEY for direct delete
;		KBF		-		Record number
;	CREC(D)			-		Record number
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T4.
;
;--
;[5013] New

%IF20,<
%RMDEL:	MOVE	T4,RAB(D)		;Get RAB address
	SETZ	T1,			;Clear RAC
	$STORE	T1,RAC,<(T4)>

	XMOVEI	T1,@A.REC		;Get REC= (or 0)
	$STORE	T1,KBF,<(T4)>
	JUMPE	T1,DELREC		;If no REC, delete current rec

	SKIPG	T1,@T1			;Direct delete. Legal record number?
	 $ACALL	IRN			;No
	MOVEM	T1,CREC(D)		;Store as current record

	MOVX	T1,RB$KEY		;Set keyed access for REC= delete
	$STORE	T1,RAC,<(T4)>

	PUSHJ	P,FIND$			;Do $FIND to establish current rec
	 $ACALL	IOE			;Error

DELREC:	PUSHJ	P,DELE$			;Do the delete
	 $ACALL	IOE			;Error
	PJRST	%SETAV			;Done

> ;End %IF20

	SUBTTL	%RMCUL	-	Check if UNLOCK is legal
;++
; FUNCTIONAL DESCRIPTION:
;
;	Checks whether an UNLOCK statement is legal for the requested
;	file type.  The file must be an RMS relative or indexed file
;	for which a DDB has been established.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMCUL
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	%CUNIT		-		Current unit #
;	DDBAD(U)	-		DDB address
;	%DDBTAB(U)	-		UDBs
;	ORGAN(D)	-		ORGANIZATION
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	%UDBAD		-		Flagged as I/O in progress
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;	$ACALLs if UNLOCK is illegal for file.
;
;--
;[5014] New

%IF20,<
%RMCUL:	MOVE	T1,%CUNIT		;Get unit number
	SKIPN	U,%DDBTA(T1)		;Get UDB addr
	 $ACALL	SIF			;None. No implicit OPEN/DELETE
	MOVEM	U,%UDBAD		;We have started an I/O statement
	MOVE	D,DDBAD(U)		;Get DDB addr

	LOAD	T1,ORGAN(D)		;Get ORGANIZATION
	JRST	UNLTAB(T1)

UNLTAB:	$ACALL	SIF			;UNKNOWN (illegal)
	$ACALL	SIF			;SEQUENTIAL (illegal)
	JRST	%POPJ			;RELATIVE
	JRST	%POPJ			;INDEXED

> ; End %IF20

	SUBTTL	%RMUNL	-	UNLOCK an RMS record
;++
; FUNCTIONAL DESCRIPTION:
;
;	UNLOCKS a record in an RMS file. The unlock statement uses 
;	the $FREE RMS service call. If a "no record is locked" error
;	occurs it is ignored.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMUNL
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	%ERIOS		-		2nd error number
;	A.IOS		-		IOSTAT variable address
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2
;
;--
;[5014] New

%IF20,<
%RMUNL:	PUSHJ	P,FREE$		;Call the $Free service to unlock rec
	 CAIN	T2,ER$RNL	;Ignore "Record not locked" errors
	SKIPA			;Good return
	 $ACALL	IOE		;Error

	MOVE	T1,%ERIOS	;Get 2nd error number or zero
	SKIPE	T2,A.IOS	;Iostat variable to define?
	 MOVEM	T1,@T2		;Yes. Define IT

	SETZM	%UDBAD		;Now no I/O in progress
	 POPJ	P,		;Return

> ;End %IF20

	SUBTTL	%RMEND	-	ENDFILE for RMS files
;++
; FUNCTIONAL DESCRIPTION:
;
;	Perform ENDFILE processing for RMS sequential files:  get the file
;	open for output (thus truncating it), then get it open for input
;	positioned at EOF.  This statement is trapped as illegal for
;	RMS relative and indexed files.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMEND
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	ORGAN(D)		-		ORGANIZATION
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FLAGS(D)		-		D%END
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;	$ACALLs if ORGANIZATION=RELATIVE or INDEXED.
;
;--
;[5013] New

IF10,<
%RMEND:	$SNH				;Should not get here on TOPS-10
> ;End IF10

%IF20,<
%RMEND:	LOAD	T2,ORGAN(D)		;Get file type
	CAIE	T2,OR.SEQ		;Must be sequential
	 $ACALL	SIF

	PUSHJ	P,%SETOUT		;Set to output
	PUSHJ	P,%SETIN		;Then to input
	MOVX	T1,D%END		;at EOF
	IORM	T1,FLAGS(D)
	POPJ	P,

> ; End %IF20

	SUBTTL	%RMSIN	-	Read a sequential RSF page
;++
; FUNCTIONAL DESCRIPTION:
;
;	Reads a page from a remote stream file accessed sequentially,
;	and updates window pointers via FORIO routine SETPTR.
;
;	Entry RMSMPW is called from %RMOPN to map in the last
;	page of an RSF file opened ACCESS='APPEND'.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMSIN
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	BYTN(D)		-	Desired file byte #
;	EOFN(D)		-	EOF byte #
;	RAB(D)		-	Address of RAB
;	BPW(D)		-	Bytes/word as a function of BYTESIZE and/or
;				returned file bytesize
;	WADR(D)		-	Address of process page to map to
;	BUFCT(D)	-	Window page count
;	WPTR(D)		-	Page number
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RAB(D) BKT	-	Set to page # +1 of file to map
;	       RAC	-	Set to RB$BLK for block-mode I/O
;	       USZ	-	Set to PSIZ (^D512)
;	       UBF	-	Set to WADR(D)
;	ICNT(D)		-	Set to count of free bytes in buffer
;	FLAGS(D)	-	D%END set if EOF
;	PAGNUM		-	Double word containing the page #, bytes used
;				in page
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4.
;
;--
;[5003] New

%IF20,<
%RMSIN:	MOVE	T2,BYTN(D)		;Get target byte number
	CAMGE	T2,EOFN(D)		;At or past EOF?
	 JRST	RMSMPW			;No

	MOVX	T1,D%END		;Yes. Get EOF
	IORM	T1,FLAGS(D)		;Set it
	POPJ	P,			;Return

RMSMPW:	PUSHJ	P,RMAPW			;Map some pages in
	PUSHJ	P,SETPTR		;Setup pointer/count
	MOVE	T2,BYTN(D)		;Get byte # of next window
	CAMG	T2,EOFN(D)		;Past EOF?
	 POPJ	P,			;No, all done
	SUB	T2,EOFN(D)		;Get the difference
	MOVNI	T2,(T2)			;Make negative
	ADDM	T2,ICNT(D)		;Decrement count
	POPJ	P,

;Here to read an n-page window.  

RMAPW:	MOVE	T4,RAB(D)		;Get RAB address
	MOVE	T2,BYTN(D)		;Get target byte # 
	MOVE	T1,BPW(D)		;Calculate page #, get bytes/word
	LSH	T1,LWSIZ		;# bytes/page
	IDIV	T2,T1			;Get file page #
	DMOVEM	T2,PAGNUM		;Save for SETPTR

	ADDI	T2,1			;Bump page # for RMS
	MOVEM	T2,T1			;Copy

;Loop to read in n pages

	LOAD	T3,BUFCT(D)		;Get buffer count
	MOVNI	T3,(T3)			;Negative
	MOVSI	T3,(T3)			;In left half
	HRR	T3,WPTR(D)		;Get page # of bottom page

RMSINL:	MOVEI	T2,(T3)			;Get core addr
	LSH	T2,LWSIZ

	PUSHJ	P,GETBKT		;$READ it
	 JRST	SINERR			;Error

	$FETCH	T1,BKT,<(T4)>		;Increment file page to get
	ADDI	T1,1
	AOBJN	T3,RMSINL		;Back for more

	POPJ	P,			;Done

SINERR:	MOVE	T1,RAB(D)		;Get RAB address in T1
	CAIE	T2,ER$EOF		;EOF error?
	 CAIN	T2,ER$RNF		;or non-existent page?
	  PJRST	RETSUC			;Yes, not really an error, return
	$ACALL	IOE			;No, something bad

> ; End %IF20

	SUBTTL	%RMRDW	-	Read a random RSF page
;++
; FUNCTIONAL DESCRIPTION:
;
;	Maps in a page from a randomly-accessed RSF file, writing any
;	modified pages first.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMRDW
;	<Return here>
;
; INPUT PARAMETERS:
;
;	P1		-	File page # to map
;
; IMPLICIT INPUTS:
;
;	RAB(D)		-	Address of RAB
;	WADR(D)		-	Offset into WTAB of least used page
;	WPTR(D)		-	Core page address of file pages
;	WTAB(D)		-	Page table
;
; OUTPUT PARAMETERS:
;
;	T1		-	Page table pointer
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	UBF	-	Set to destination page address
;		BKT	-	Set to file page # +1
;		USZ	-	Set to page length
;		RAC	-	Set to RB$BLK for block-mode I/O
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4.
;
;--
;[5003] New

%IF20,<
%RMRDW:	PUSHJ	P,RMWPG			;Write any pages which are modified

	MOVE	T4,RAB(D)		;Get RAB address
	MOVE	T2,WADR(D)		;Get page table offset
	ADD	T2,WPTR(D)		;Get core page number
	LSH	T2,LWSIZ		;Convert to address

	SETZM	(T2)			;Clear destination page
	MOVSI	T1,(T2)
	HRRI	T1,1(T2)		;start,,start+1
	BLT	T1,PSIZ-1(T2)		;Clear page

	MOVEI	T1,1(P1)		;Get file page # +1

	PUSHJ	P,GETBKT		;$READ it
	 JRST	RDWERR			;Some error, investigate

RDWRET:	MOVE	T1,WADR(D)		;OK. Get page table offset again
	ADD	T1,WTAB(D)		;Point into page table
	MOVEM	P1,(T1)			;Store new file page number
	POPJ	P,

RDWERR:	CAIE	T2,ER$EOF		;Non-existent page?
	 CAIN	T2,ER$RNF
	  TRNA				;Yes, not really an error
	$ACALL	IOE			;No, some other error
	MOVE	T1,RAB(D)
	PUSHJ	P,RETSUC		;Clear the "error"
	JRST	RDWRET

> ; End %IF20
	SUBTTL	RMSWPT	-	Setup pointers to a file window
;++
; FUNCTIONAL DESCRIPTION:
;
;	Calls SETPTR to update pointers to the window/buffer we
;	just read.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RMSWPT
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	IRBEG(D)	-	Record buffer pointer
;	BYTN(D)		-	Current byte number in file
;	EOFN(D)		-	Number of bytes in file
;	FLAGS(D)	-	DDB flags
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	IRPTR(D)	-	Receives IRBEG
;	IPTR(D)		-	Receives IRBEG
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T2.
;
;--
;[5003] New

%IF20,<
RMSWPT:	PUSHJ	P,SETPTR		;Setup pointers to window
	MOVE	T1,IRBEG(D)		;Get record buffer ptr
	MOVEM	T1,IRPTR(D)		;Initialize it
	MOVEM	T1,IPTR(D)
	SKIPE	IRCNT(D)		;Any characters in record?
	 POPJ	P,			;Yes, we're done

	MOVE	T0,FLAGS(D)		;Get flags
	TXNE	T0,D%END		;Zero chars; EOF also?
	 $ACALL	EOF			;Yes

	POPJ	P,

> ; End %IF20
	SUBTTL	CACHIT	-	Cache record number and RFA
;++
; FUNCTIONAL DESCRIPTION:
;
;	If CACHSZ is non-zero, a cache has been setup at OPEN time for
;	sequential and sequentially-accessed RMS relative files. CACHE(D)
;	points to the start the cache, CACHPT(D) to the next free cache
;	entry. 
;
;	The cache is a block of CACHSZ words (CACHSR records * 2) of the
;	form:
;
;	            !=====================================!
;	CACHE(D) => !     Record number from CREC(D)      !
;		    !-------------------------------------!
;		    !       RFA from $GET or $PUT         !
;		    !-------------------------------------!
;		    !                                     !
;
;	When CACHPT(D) points off the end of the cache, it is reset to
;	the beginning.
;	
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,CACHIT
;	<Return here>
;
; INPUT PARAMETERS:
;
;	T1		-		Record number to cache
;
; IMPLICIT INPUTS:
;
;	RFA(D)		-		RFA from last $GET or $PUT
;	CREC(D)		-		Current record number
;	CACHE(D)	-		Address of cache
;	CACHPT(D)	-		Free entry pointer
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	CACHPT(D)	-		Updated to point to next free
;					cache location
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T3.
;
;--
;[5003] New

%IF20,<
CACHIT:	SKIPN	CACHE(D)		;Are we cacheing?
	 POPJ	P,			;No

	MOVE	T2,CACHPT(D)		;Get address of free cache location
	MOVEM	T1,(T2)			;Save record # in cache
	ADDI	T2,1			;Bump pointer

	MOVE	T1,RFA(D)		;Get RFA of record
	MOVEM	T1,(T2)			;Save in cache
	ADDI	T2,1			;Bump pointer

	MOVE	T1,CACHE(D)		;Get cache start address
	MOVEI	T3,CACHSZ		;Get cache size
	ADD	T3,T1			;Get last word+1
	CAIL	T2,(T3)			;At or beyond the end?
	 MOVE	T2,T1			;Yes, reset pntr to start
	MOVEM	T2,CACHPT(D)		;Save pointer
	POPJ	P,			;Return

> ; End %IF20
	SUBTTL	%RMSOU	- Map or write an RSF buffer
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called from FORIO OSTAB for RSF files when ICNT(D) is zero
;	to write out the current output window.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMSOU
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	BYTN(D)		-	Requested file byte number
;	BPW(D)		-	Bytes/word
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	PAGNUM		-	Double word containing the page #, bytes used
;				in page
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T3.
;
;--
;[5004] New

%IF20,<
%RMSOU:	PUSHJ	P,RSFOCP		;Output current window
	SETZB	T2,T3			;Say we have a new window
	DMOVEM	T2,PAGNUM

	PJRST	SETPTR			;Setup new pointers

> ;End %IF20

	SUBTTL	RSFOCP	-	Output current RSF output window
;++
; FUNCTIONAL DESCRIPTION:
;
;	Writes out the current window to the file, up to and including
;	the window page containing the highest byte written so far to
;	the file.
;
;	Assuming a default 4 page window:
;
;     WADR=Core address of                   IPTR=Byte pntr to last
;     1st window page                        byte written +1
;      \/                                     \/
;	=============================================================
;       |/////////////:://////////////::///         ::              |
;	|/////////////:://////////////::///         ::              |
;	|/////////////:://////////////::///////     ::              |
;	=============================================================
;      /\                                     /\
;      WPTR=1st window page #                EOFN=Highest file byte # written
;
;
;	The calculation of how many window pages to write is as follows:
;
;	1) Using EOFN, calculate the highest file page number to write
;
;			EOFN + ((bytes/page) - 1)
;	LSTFPG =	-------------------------
;		      		(bytes/page)
;
;	2) Calculate the number of pages used in the window:
;
;			(IPTR<rh> - WADR +1) + (PSIZ-1)
;	WINPGS =	------------------------------
;				     PSIZ
;
;	3) The first file "bucket" to write is thus LSTFG-WINPGS+1.
;

; CALLING SEQUENCE:
;
;	PUSHJ	P,RSFOCP
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	IPTR(D)		-		Byte pntr to last written byte in
;					 window
;	WADR(D)		-		Core address of base window page
;	WPTR(D)		-		Page number of base window page
;	EOFN(D)		-		Highest byte written to file
;	BPW(D)		-		Byes/word
;	RAB(D)		-		Address of RAB
;
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RAB(D)	BKT	-		Set to file page(s) to write
;		RAC	-		RB$BLK for block mode I/O
;		USZ	-		PSIZ
;		RBF	-		Set to core page(s) to write
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T4.
;
;--
;[5004] New

%IF20,<
RSFOCP:	HRRZ	T1,IPTR(D)		;Get address of data
	JUMPE	T1,%POPJ		;Leave if none
	SUB	T1,WADR(D)		;Get # words to write -1
	AOJE	T1,%POPJ		;If none to write, leave

;Determine how many pages we have written to the file

	MOVE	T3,EOFN(D)		;Get highest file byte
	MOVE	T1,BPW(D)		;Get bytes/word
	LSH	T1,LWSIZ		;Get bytes/page
	ADDI	T3,-1(T1)		;and pages written
	IDIVI	T3,(T1)			;rounded

;and the number of pages we have to write

	HRRZ	T1,IPTR(D)		;Get current point
	SUB	T1,WADR(D)		;Get total window words used-1
	ADDI	T1,1
	ADDI	T1,PSIZ-1		;Convert to pages
	IDIVI	T1,PSIZ
	MOVNM	T1,WINPGS		;Save negative page count

;Now get the first file page "bucket" to set

	SUBI	T3,-1(T1)		;Bucket# = page#+1
	MOVEM	T3,T1			;Copy

;Setup AOBJN pointer for -# pages to write,,first window page

	HRLE	T3,WINPGS		;Get neg count in left
	HRR	T3,WPTR(D)		;page # of bottom page in right

	MOVE	T4,RAB(D)		;Get RAB address

;Top of loop

RMSOUL:	MOVEI	T2,(T3)			;Get core addr
	LSH	T2,LWSIZ
	$STORE	T2,RBF,<(T4)>		;Store as buffer address

	PUSHJ	P,PUTBKT		;$WRITE it
	 $ACALL	IOE			;Can't

;Bump bucket number

	$FETCH	T1,BKT,<(T4)>		;Increment file page to get
	ADDI	T1,1

	AOBJN	T3,RMSOUL		;Back for more

	POPJ	P,

	SEGMENT	DATA

WINPGS:	BLOCK	1			;Number of window pages to write

	SEGMENT	CODE

> ; End %IF20

	SUBTTL	%RMERR	-	Handle RMS service errors

;***************************************************************************
;*                                                                         *
;*                       ENTRIES CALLED FROM FORERR                        *
;*                                                                         *
;***************************************************************************

;++
; FUNCTIONAL DESCRIPTION:
;
;	Called for RMS errors with $J in the error.  Translates the STS
;	status code into a string by searching a subset table of all
;	RMS STS error codes/strings.  If a match is found, the error
;	message is constructed and pointed to by global %RMEPT.  If
;	no match is found, a string consisting of the STS and STV values
;	alone is constructed.  If the STS code indicates a $SNH (should
;	not happen) internal FOROTS error, this routine never returns
;	but converts the $DCALL/$ACALL error which called it into an
;	OTS error ending at %HALT.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMERR
;	<Return here>
;
; INPUT PARAMETERS:
;
;	P2	-	Error argument block pointer
;
; IMPLICIT INPUTS:
;
;	STS(D)	-	RMS status code
;	STV(D)	-	RMS status value
;	STSTAB	-	Table of matchable error strings in the following
;			format:
;
;	[Address of error string],,<STS-ER$MIN>
;
;			If the error is a $SNH, flag FL%SNH is set in the
;			table entry, RH.
;
;	%RMPDP	-	Address+1 of ERCAL call after the RMS $xxxx error
;			 (used for $SNHs only)
;	%FSECT	-	FOROTS' section number
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	ERRPTR			-	Error message pointer.
;	DESPTR			-	Saved original pointer
;	SAVPTR			-	Local save for STS string address
;	%ERNM2			-	Second error number (STS)
;	%ERNM3			-	Third error number (STV)
;	INICHR			-	1st error character (to @ for $SNH)
;	%RMEPT			-	Pntr to RMS error message text
;
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2,T4.
;
;--
;[5007] New

%IF20,<
FL%SNH==400000				;Table $SNH flag

%RMERR:	LOAD	T1,STV(D)		;Get and save 3rd error number:STV
	MOVEM	T1,%ERNM3

	LOAD	T1,STS(D)		;Get and save 2nd error number:STS
	MOVEM	T1,%ERNM2

	SUBI	T1,ER$MIN		;Strip error offset
	MOVEM	T1,T3			;STS to match in AC3

	MOVE	T1,[POINT 7,TXTBF2]	;Destination for error string
	EXCH	T1,ERRPTR
	MOVEM	T1,DESPTR		;Save original error pntr
	MOVEI	T1,5*LERRBF-1		;Set count
	MOVEM	T1,ERRCNT

	SETZ	T2,
RMERSL:	SETZ	T4,			;Clear local $SNH flag
	MOVE	T1,STSTAB(T2)		;Get table entry
	JUMPE	T1,NOSTS		;End of table with no match
	HRRZ	T1,T1			;Get STS code alone
	TXZE	T1,FL%SNH		;$SNH error?
	 SETOM	T4			;Yes, flag it
	CAIE	T1,(T3)			;Same as our target STS?
	 AOJA	T2,RMERSL		;No, keep looking

;Here with an STS-matched string from the table.  If not a $SNH error
; also, return this string.

	HLRZ	T1,STSTAB(T2)		;Yes, get string address
	MOVEM	T1,SAVPTR		;Save
	JUMPE	T4,RTSTR		;If not also a $SNH, go return it

;Here with a $SNH-flagged error.  If caused by a USEROPEN routine, it's not
; really a $SNH.

	MOVE	T1,%FLGS(P2)		;Get error flags
	TXNE	T1,I%UOF		;USEROPEN error?
	 JRST	RTSTR			;Yes, not *our* $SNH

;Here with a $SNH.  Modify the error string we will return.

	MOVEI	T1,[ASCIZ /Internal FOROTS error at /] ;source
	PUSHJ	P,ASCTYP		;Move string to buffer

	MOVE	T1,%RMPDP		;Get PDP of error.
	SUBI	T1,1			;Get addr of call
	SKIPN	%FSECT			;Non-zero section?
	 MOVEI	T1,(T1)			;No. Exclude flags
	PUSHJ	P,OCTTYP		;Type it in octal

	SETZM	%RMPDP			;Clear $SNH PDP

	MOVEI	T1,[ASCIZ /, /]
	PUSHJ	P,ASCTYP

RTSTR:	MOVE	T1,SAVPTR		;Get STS string address
	PUSHJ	P,ASCTYP		;Ouput it

	MOVEI	T1,[ASCIZ /, /]
	PUSHJ	P,ASCTYP

NOSTS:	MOVEI	T1,[ASCIZ /STS:/]	;Output STS code
	PUSHJ	P,ASCTYP

	LOAD	T1,STS(D)
	PUSHJ	P,OCTTYP

	MOVEI	T1,[ASCIZ /, STV:/]	;And STV
	PUSHJ	P,ASCTYP

	LOAD	T1,STV(D)
	PUSHJ	P,OCTTYP

	SETZ	T1,
	IDPB	T1,ERRPTR

	MOVE	T1,DESPTR		;Restore original error pntr
	MOVEM	T1,ERRPTR
	MOVEI	T1,TXTBF2		;Save pntr to message for $J code
	MOVEM	T1,%RMEPT		;Save error address
	SKIPE	%RMPDP			;$SNH?
	 POPJ	P,			;No, done

;Here for $SNH errors, which never return to DIALOG or take an ERR=.

	MOVE	P2,%ERPTR		;Point to error block
	PUSHJ	P,EMSGT0		;Get error message text

	MOVEI	T1,"@"			;Convert 1st character to SNH
	MOVEM	T1,INICHR

	PJRST	FOREC2			;Go output and die

> ; End %IF20

	SUBTTL	%RMECL	-	Cleanup after an RMS error
;++
; FUNCTIONAL DESCRIPTION:
;
;	If the error was ER$RTN (RENAME to two different nodes), the user
;	tried to:
;
;	a) Rename a local OPEN filespec to a remote CLOSE filespec.
;	b) Rename a remote file to another node.
;
;	In these cases the "remoteness" of the file [NODNAM(D), USERID(D)
;	PASWRD(D)] is zeroed, since in re-entering DIALOG after such an
;	error there is no way for the user to remove a file's "nodeness".
;	This is done now, rather than at the point of error, since FORERR
;	must have the node information available to output as part of the
;	error text.
;
;	In all cases of an RMS error, STS(D) and STV(D) are zeroed here,
;	so that a subsequent DIALOG entry which itself gets an error
;	(quite possibly unrelated to any RMS file) does not re-call the
;	RMS error handler.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMECL
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	STS(D)		-	RMS completion status code
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	STS(D)		-	Zeroed
;	STV(D)		-	Zeroed
;
; The following are cleared on ER$RTN
;
;	NODNAM(D)	-	Node name
;	PASWRD(D)	-	Password
;	USERID(D)	-	User ID
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;
;--
;[5007] New

%IF20,<
%RMECL:	LOAD	T1,STS(D)		;Get STS
	CAIE	T1,ER$RTN		;Two different nodes error?
	 JRST	ZERSV			;No

	SETZM	NODNAM(D)		;Yes, forget about file's remoteness
	SETZM	JFNBLK+.GJNOD		; in the JFN block
	SETZM	PASWRD(D)		; and the DDB
	SETZM	USERID(D)
	SETZM	JFNBLK+.GJATR

ZERSV:	SETZ	T1,			;Clear both STS and STV
	STORE	T1,STS(D)
	STORE	T1,STV(D)
	POPJ	P,

> ;End %IF20

	SUBTTL	STS Error Table

%IF20,<

	DEFINE	USER (STS,STRING) <	;;For RMS errors
	.COD.==<STS-ER$MIN>
	XWD	[ASCIZ @STRING@],.COD.
	PURGE	.COD.,STS
> ;End USER

	DEFINE	SNH (STS,STRING) <   ;;RMS which $SNH
	.COD.==<STS-ER$MIN>+FL%SNH
	XWD	[ASCIZ @STRING@],.COD.
	PURGE	.COD.,STS
> ;End SNH

	DEFINE	IGNORE (STS,STRING) <	;;For ignored RMS error strings
REPEAT 0,<
		USER (STS,STRING)

> ;End REPEAT 0
> ;End IGNORE

STSTAB:
	IGNORE	ER$AID,<Bad AID value>
	IGNORE	ER$ALQ,<Allocation quantity incorrect>
	IGNORE	ER$ANI,<Not ANSI 'D' format>
	IGNORE	ER$BKS,<Bad bucket size>
	IGNORE	ER$BKZ,<'BKZ' field invalid in XAB>
	SNH	ER$BLN,<Bad block length>
	SNH	ER$BSZ,<Bad byte size>
	USER	ER$BUG,<Internal bug found in RMS-20>
	USER	ER$CCF,<Cannot $CLOSE file>
	USER	ER$CCR,<Cannot $CONNECT RAB>
	USER	ER$CDR,<Cannot $DISCONNECT RAB>
	USER	ER$CEF,<Cannot $ERASE file>
	USER	ER$CGJ,<Cannot get JFN for file>
	USER	ER$CHG,<Key value cannot change>
	SNH	ER$COD,<Bad COD value in XAB>
	USER	ER$COF,<Cannot open file>
	USER	ER$CUR,<No current record>
	IGNORE	ER$DAN,<Bad data-area number>
	USER	ER$DEL,<Record has been deleted>
	USER	ER$DEV,<Illegal device>
	IGNORE	ER$DFL,<Bad data-fill percentage value>
	USER	ER$DLK,<Deadlock condition detected>
	USER	ER$DME,<Dynamic memory exhausted>
	SNH	ER$DTP,<Bad data-type in XAB>
	USER	ER$DUP,<Duplicate key exists>
	IGNORE	ER$EDQ,<Unexpected ENQUE/DEQUE error>
	USER	ER$EOF,<End of file>
	SNH	ER$FAB,<Block is not a valid FAB>
	SNH	ER$FAC,<Bad file access value>
	USER	ER$FEX,<File already exists>
	SNH	ER$FLG,<Bad XAB flag combination>
	USER	ER$FLK,<File already locked by someone else>
	SNH	ER$FNA,<Bad FNA value>
	IGNORE	ER$FNC,<File not closed>
	USER	ER$FNF,<File not found>
	SNH	ER$FOP,<Bad file options>
	IGNORE	ER$FSZ,<Invalid header size for VFC-file>
	IGNORE	ER$FUL,<File full>
	IGNORE	ER$IAL,<Invalid argument list>
	IGNORE	ER$IAN,<Bad index-area number>
	SNH	ER$IBC,<Illegal block mode connection>
	SNH	ER$IBO,<Illegal block mode operation>
	SNH	ER$IBS,<Illegal block mode sharing>
	SNH	ER$IFI,<Bad IFI value>
	IGNORE	ER$IFL,<Bad index fill percentage>
	IGNORE	ER$IMX,<Illegal multiple XABs>
	SNH	ER$IOP,<Invalid operation attempted>
	IGNORE	ER$IRC,<Illegal record encountered>
	SNH	ER$ISI,<Bad ISI value>
	SNH	ER$JFN,<Bad JFN value>
	USER	ER$KBF,<Bad KBF value>
	USER	ER$KEY,<Bad record key>
	USER	ER$KRF,<Bad key of reference value>
	USER	ER$KSZ,<Bad key size>
	IGNORE	ER$LSN,<Bad line-sequence number>
	USER	ER$MRN,<Bad MRN value>
	USER	ER$MRS,<Bad MRS value>
	USER	ER$NEF,<Not positioned at EOF>
	IGNORE	ER$NLG,<Log file not active>
	USER	ER$NPK,<Indexed file - no primary key defined>
	SNH	ER$NXT,<Invalid 'NXT' field in a XAB>
	SNH	ER$ORD,<XABs are not in correct order>
	SNH	ER$ORG,<Bad file organization value>
	USER	ER$PEF,<Cannot position to end-of-file>
	IGNORE	ER$PLG,<Error detected in file's prologue>
	SNH	ER$POS,<Bad key position value>
	USER	ER$PRV,<Privilege violation>
	IGNORE	ER$QPE,<Quiet point enabled>
	SNH	ER$RAB,<Block is not a valid RAB>
	SNH	ER$RAC,<Bad record access value>
	SNH	ER$RAT,<Bad record attributes>
	SNH	ER$RBF,<Invalid record buffer address>
	USER	ER$REF,<Bad key reference (REF) value>
	IGNORE	ER$RER,<File processor read error>
	USER	ER$REX,<Record already exists>
	SNH	ER$RFA,<Bad RFA value>
	IGNORE	ER$RFM,<Bad record format>
	USER	ER$RLK,<Record already locked by someone else>
	USER	ER$RNF,<Record not found>
	IGNORE	ER$RNL,<Record not locked>
	SNH	ER$ROP,<Bad record options>
	IGNORE	ER$RRV,<Invalid RRV record found>
	IGNORE	ER$RSA,<Record stream active>
	IGNORE	ER$RSD,<Record size discrepancy>
	USER	ER$RSZ,<Bad record size value>
	SNH	ER$RTB,<Record too big>
	IGNORE	ER$SEQ,<Key value not in sequential order>
	USER	ER$SIZ,<'SIZ' field in XAB invalid>
	IGNORE	ER$TRE,<Index tree error detected>
	USER	ER$TRU,<Cannot truncate this file>
	SNH	ER$UBF,<Bad buffer address>
	IGNORE	ER$UDF,<File is in undefined state>
	IGNORE	ER$VER,<Error in version number>
	IGNORE	ER$WER,<File processor write error>
	SNH	ER$XAB,<Not a valid XAB>
	USER	ER$XCL,<File must be open in exclusive access>
	USER	ER$FSI,<File spec has invalid format>
	USER	ER$DPE,<DAP protocol error>
	USER	ER$SUP,<Unsupported operation>
	USER	ER$DCF,<DAP connection failure>
	USER	ER$EXT,<File extend error>
	SNH	ER$NAM,<Invalid NAM block>
	IGNORE	ER$NMF,<No more files>
	USER	ER$RTD,<RENAME -- two different devices>
	USER	ER$RTN,<RENAME -- two different nodes>
	USER	ER$DCB,<DECNET connection broken>
	USER	ER$IAC,<Invalid access information>
	SNH	ER$TYP,<Invalid TYP block>
	IGNORE	ER$CLA,<Invalid file data class>

	Z				;END OF TABLE

	PURGE	FL%SNH

> ; End %IF20
	SUBTTL	FNDRMS	-	See if RMS is around
;***************************************************************************
;*                                                                         *
;*                       MISCELLANEOUS ROUTINES                            *
;*                                                                         *
;***************************************************************************

;++
; FUNCTIONAL DESCRIPTION:
;
;	Does a GTJFN% on SYS:RTL.EXE and XRMS.EXE to see if they are around
;	for dynamic-library invocation.  If so, just return (or if we
;	have already been called).  If not, go to DIALOG.
;
;	Called from FOROPN DFDEV1 after the device index is established
;	as either DI.RMS or DI.RSF.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,FNDRMS
;	<Error return; enter DIALOG>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RMSJFN		-	If non-zero on entry, we've already been called
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	RMSJFN		-	Holds a released JFN
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--
;[5000] New

IF20,<
FNDRMS:	SKIPE	RMSJFN			;Already done this before?
	 JRST	%POPJ1			;Yes, just return

	MOVX	T1,GJ%SHT+GJ%OLD+GJ%PHY	;No, check for the RTL
	HRROI	T2,[ASCIZ /SYS:RTL.EXE/]
	GTJFN%
	 ERJMP	NORMS			;Go fail

	RLJFN%				;Release JFN
	 ERJMP	.+1

	MOVX	T1,GJ%SHT+GJ%OLD+GJ%PHY	;Check for XRMS.EXE
	HRROI	T2,[ASCIZ /SYS:XRMS.EXE/]
	GTJFN%
	 ERJMP	NORMS			;Go fail

	MOVEM	T1,RMSJFN		;Save JFN as flag
	RLJFN%
	 ERJMP	.+1

	MOVEI	T1,FTEXT		;Get global compilation switch
	JUMPN	T1,%POPJ1

;RMS is on SYS: but FOROTS was compiled on a non-extended machine.

	HRROI	T1,[ASCIZ/
?RMS can only be called on a processor which supports extended addressing.
 This build of FOROTS was compiled on a non-extended machine./]
	PSOUT%
	SETZM	RMSJFN
	HALTF%
	JRST	.-1

;Here when XRMS.EXE/RTL.EXE are not on SYS:.  Issue error, enter DIALOG.

NORMS:	$DCALL	RNA

	SEGMENT	DATA

RMSJFN:	BLOCK	1

	SEGMENT	CODE

> ;End IF20

	SUBTTL	RMFAB	-	Allocate  FAB/CONFIG blocks
;++
; FUNCTIONAL DESCRIPTION:
;
;	Allocates and initializes a FAB block and returns its address
;	in T1.  If the file is remote (i.e. a nodename was included in
;	the filespec), allocate a CONFIG XAB as well and point FAB FB$XAB
;	at it.  Allocates via a call to global routine %GTBLK. 
;
;	FAB format:
;
;		    !=====================================!
;		    !       BID        !       BLN        !
;		    !-------------------------------------!
;		    !       STS        !       STV        !
;		    !-------------------------------------!
;		    !                 CTX                 !
;		    !-------------------------------------!
;		    !       IFI        !       JFN        !
;		    !-------------------------------------!
;		    !       FAC        !       SHR        !
;		    !-------------------------------------!
;		    !       FOP        !ORG! BSZ !  BLS   !
;		    !-------------------------------------!
;		    !                 FNA                 !
;		    !-------------------------------------!
;		    !       RAT        !       MRS        !
;		    !-------------------------------------!
;		    !                 MRN                 !
;		    !-------------------------------------!
;		    !       <UNUSED>        !  BKS  ! RFM !
;		    !-------------------------------------!
;		    !       LOG        !       XAB        !
;		    !-------------------------------------!
;		    !       DEV        !       SDC        !
;		    !-------------------------------------!
;		    !              <UNUSED>               !
;		    !-------------------------------------!
;		    !              <UNUSED>               !
;		    !-------------------------------------!
;		    !              <UNUSED>               !
;		    !-------------------------------------!
;		    !              <UNUSED>               !
;		    !=====================================!
;
;	Local non-indexed RMS files will  be allocated a FAB only,
;	whose XAB field will be zero. Local indexed RMS files will have
;	a FAB whose XAB field points to the first key XAB of any chain.
;
;	Remote non-indexed files (including RSF) will be chained as
;	follows to a CONFIG XAB:
;
;			--------------------
;	FAB:		|                  |
;			-------.....---------
;	    	  F$XAB:|address of CONFIG |
;			--------------------
;
;		       	--------------------
;	CONFIG:		|                  |
;			-------.....--------
;	          X$NXT:|        0         |
;			--------------------
;
;	Remote indexed files' X$NXT in their CONFIG XABs will point
;	to the start of the key XAB chain, if any.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RMFAB
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	NODNAM(D)	-	Nodename string from OPEN
;
; OUTPUT PARAMETERS:
;
;	T1		-	Address of allocated FAB
;
; IMPLICIT OUTPUTS:
;
;	FABLNK		-	Link address
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
RMFAB:	SKIPN	T2,NODNAM(D)		;Nodename specified?
	 JRST	ALFAB			;No, allocate FAB only

	MOVX	T1,XA$SXC		;Yes. Get length of CONFIG XAB
	PUSHJ	P,%GTBLK		;Get a block
	 $ACALL	MFU			;Can't

	MOVE	T2,T1			;T1 off'd by XAB$B
	XAB$B	CFG,<(T2)>		;Declare it
	XAB$E				;End declaration

ALFAB:	MOVEM	T2,FABLNK		;Save link address (or zero)

	MOVX	T1,FA$LNG		;Get FAB length block
	PUSHJ	P,%GTBLK
	 $ACALL	MFU			;Can't

	MOVE	T2,T1			;T1 off'd by FAB$B

	FAB$B	<(T2)>			;Declare it
	FAB$E				;End declaration

	MOVE	T1,FABLNK		;Restore link address
	$STORE	T1,XAB,<(T2)>
	MOVE	T1,T2			;Return address of FAB
	POPJ	P,			;Return

> ; End %IF20
	SUBTTL	RMRAB	-	Allocate a RAB
;++
; FUNCTIONAL DESCRIPTION:
;
;	Allocates a RAB and returns its address in T1. Allocates via a call
;	to global routine %GTBLK.
;
;	RAB format:
;
;		    !-------------------------------------!
;		    !       BID        !       BLN        !
;		    !-------------------------------------!
;		    !       STS        !       STV        !
;		    !-------------------------------------!
;		    !                 CTX                 !
;		    !-------------------------------------!
;		    !       ISI        !       FAB        !
;		    !-------------------------------------!
;		    !  RAC   !   MBF   !       ROP        !
;		    !-------------------------------------!
;		    !                 UBF                 !
;		    !-------------------------------------!
;		    !                 RBF                 !
;		    !-------------------------------------!
;		    !       RSZ        !       USZ        !
;		    !-------------------------------------!
;		    !                 RFA                 !
;		    !-------------------------------------!
;		    !  KRF   !   KSZ   !       LSN        !
;		    !-------------------------------------!
;		    !                 KBF                 !
;		    !-------------------------------------!
;		    !                 BKT                 !
;		    !-------------------------------------!
;		    !  PAD   !          <UNUSED>          !
;		    !-------------------------------------!
;		    !              <UNUSED>               !
;		    !-------------------------------------!
;		    !              <UNUSED>               !
;		    !-------------------------------------!
;		    !              <UNUSED>               !
;		    !-------------------------------------!
;
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RMRAB
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	T1	-	Address of allocated RAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
RMRAB:	MOVX	T1,RA$LNG		;Get RAB length
	PUSHJ	P,%GTBLK		;Get it
	 $ACALL	MFU			;Can't

	MOVE	T2,T1			;T1 off'd by RAB$B

	RAB$B	<(T2)>			;Declare it
	RAB$E				;End declaration

	MOVE	T1,T2			;Return address in T1
	POPJ	P,			;Return

> ; End %IF20
	SUBTTL	RMXAB	-	Allocate a KEY XAB
;++
; FUNCTIONAL DESCRIPTION:
;
;	Allocates a key XAB and returns its address in T1. Allocates via
;	a call to global routine %GTBLK.
;
;	Key XAB format:
;
;		    !=====================================!
;		    !       BID        !       BLN        !
;		    !-------------------------------------!
;		    !  <UNUSED>  ! COD !       NXT        !
;		    !-------------------------------------!
;		    ! <UNUSED>  ! DTP  !       FLG        !
;		    !-------------------------------------!
;		    !  IAN   !   DAN   !  LAN   !   REF   !
;		    !-------------------------------------!
;		    !       IFL        !       DFL        !
;		    !-------------------------------------!
;		    !                 KNM                 !
;		    !-------------------------------------!
;		    !             <RESERVED>              !
;		    !-------------------------------------!
;		    !             <RESERVED>              !
;		    !-------------------------------------!
;		    !              <UNUSED>               !
;		    !-------------------------------------!
;		    !              <UNUSED>               !
;		    !-------------------------------------!
;		    !              <UNUSED>               !
;		    !-------------------------------------!
;		    !       POS0       !       SIZ0       !
;		    !-------------------------------------!
;		    !       POS1       !       SIZ1       !
;		    !-------------------------------------!
;		    !       POS2       !       SIZ2       !
;		    !-------------------------------------!
;		    !       POS3       !       SIZ3       !
;		    !-------------------------------------!
;		    !       POS4       !       SIZ4       !
;		    !-------------------------------------!
;		    !       POS5       !       SIZ5       !
;		    !-------------------------------------!
;		    !       POS6       !       SIZ6       !
;		    !-------------------------------------!
;		    !       POS7       !       SIZ7       !
;		    !=====================================!
;
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RMXAB
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	T1	-	Address of allocated XAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
RMXAB:	MOVX	T1,XA$SXK		;Length of key XAB
	PUSHJ	P,%GTBLK		;Ask for it
	 $ACALL	MFU			;Can't get it

	MOVE	T2,T1			;T1 off'd by XAB$B

	XAB$B	KEY,<(T2)>		;Declare a KEY XAB
	XAB$E

	MOVE	T1,T2			;Return address in T1
	POPJ	P,			;Return

> ;End %IF20

	SUBTTL	%RMDAB	-	Deallocate FAB, RAB, XAB(s), cache
;++
; FUNCTIONAL DESCRIPTION:
;
;	Deallocates FAB(D), RAB(D) and any XAB(D) chain.  Deallocates via
;	calls to global routine %FREBLK. If CACHE(D) is non-zero,
;	deallocates the cache.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMDAB
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)		-	Address of FAB
;	RAB(D)		-	Address of RAB
;	XAB(D)		-	Address of start of XAB chain
;	CACHE(D)	-	Address of cache
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	Zeros FAB, RAB and XAB(D); CACHE(D), CACHPT(D)
;	FABLNK		-	Link address
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

IF10,<					;No-op on TOPS10
%RMDAB:	POPJ	P,
> ;End IF10

%IF20,<
%RMDAB:	SKIPE	%ABFLG			;Are we aborting?
	 POPJ	P,			;Yes, don't deallocate anything
	MOVE	T1,XAB(D)		;Get Key XAB start if any
	MOVEM	T1,FABLNK		;Save

	SKIPN	FAB(D)			;Any FAB?
	 JRST	DXAB			;No, check XAB

	MOVE	T1,FAB(D)		;Get FAB address
	$FETCH	T2,XAB,<(T1)>		;Get XAB link from FAB
	MOVEM	T2,FABLNK		;Save it (maybe CFG start)

	PUSHJ	P,%FREBLK		;Deallocate the FAB
	SETZM	FAB(D)			;Clear DDB

DXAB:	SKIPN	T1,FABLNK		;Was there a XAB link?
	 JRST	DRAB			;No, go check RAB

	PUSHJ	P,RMDXB			;Deallocate the chain
	SETZM	XAB(D)			;Clear DDB

DRAB:	SKIPN	T1,RAB(D)		;Any RAB?
	 JRST	DCACH			;No, check cache

	PUSHJ	P,%FREBLK		;Yes. Get rid of it
	SETZM	RAB(D)			;Clear DDB

DCACH:	SKIPN	T1,CACHE(D)		;Any cache setup?
	 JRST	DABEND			;No, clear buffer pointer

	PUSHJ	P,%FREBLK		;Yes, it's gone
	SETZM	CACHE(D)		; with all its pointers
	SETZM	CACHPT(D)

DABEND:	SETZM	BUFADR(D)		;Clear any buffer pointer
	POPJ	P,

> ; End %IF20
	SUBTTL	%RMDKB	-	Deallocate DIALOG /KEY arglist
;++
; FUNCTIONAL DESCRIPTION:
;
;	Deallocates a secondary arglist created by parsing /KEY in DIALOG.
;	Deallocates via a call to global routine %FREBLK.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,%RMDKB
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	D.KEY	-	Address of secondary arglist. Its count word is in
;			address-1
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	D.KEY	-	Address of secondary arglist is zeroed
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;
;--
;[5000] New

IF10,<
%RMDKB:	POPJ	P,			;No-op on TOPS10
> ;End IF10

%IF20,<
%RMDKB:	SKIPN	T1,D.KEY		;Anything to deallocate?
	 POPJ	P,			;No, just return

	SUBI	T1,1			;Get count word address
	PUSHJ	P,%FREBLK		;Deallocate the arglist
	SETZM	D.KEY			;It's gone
	POPJ	P,			;Return

> ; End %IF20
	SUBTTL	RMDXB	-	Deallocate a XAB chain
;++
; FUNCTIONAL DESCRIPTION:
;
;	Deallocates a XAB chain the first link of which is pointed to by
;	T1. Deallocates via calls to global routine %FREBLK.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RMDXB
;	<Return here>
;
; INPUT PARAMETERS:
;
;	T1	-	Address of first XAB to deallocate
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
RMDXB:	JUMPE	T1,%POPJ		;Zero NXT terminates loop
	$FETCH	T2,NXT,<(T1)>		;Get this XAB's NXT field
	PUSH	P,T2			;Save
	PUSHJ	P,%FREBLK		;Deallocate this XAB
	POP	P,T1			;Make next XAB the current one
	JRST	RMDXB			; and continue


	SEGMENT	DATA

PXBADR:	BLOCK	1			;Address of previous XAB
FABLNK:	BLOCK	1			;FAB XAB link

	SEGMENT	CODE

> ; End %IF20
	SUBTTL	RMDUXB	-	Deallocate and unlink a XAB chain
;++
; FUNCTIONAL DESCRIPTION:
;
;	Deallocates the XAB chain the first link of which is pointed
;	to by XAB(D). Then clears the link from FAB(D) F$XAB if there is
;	no CONFIG XAB, or from CONFIG F$NXT if there is one. Clears
;	XAB(D) on return.  Calls RMDXB to deallocate, ULKXAB to unlink.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RMDUXB
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	XAB(D)		-	 Address of key XAB chain start
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	XAB(D)		-	Zeroed
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1.
;
;--

;[5000] New

%IF20,<
RMDUXB:	SKIPN	T1,XAB(D)		;Any chain to worry about?
	 POPJ	P,			;No, just return

	PUSHJ	P,RMDXB			;Yes, deallocate it
	PJRST	ULKXAB			;Unlink and return

> ; End %IF20
	SUBTTL	ULKXAB	-	Unlink FAB or CONFIG from XAB chain
;++
; FUNCTIONAL DESCRIPTION:
;
;	Unlinks a key XAB chain from either F$XAB of FAB(D) or F$NXT
;	of the CONFIG XAB, if there is one.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,ULKXAB
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)		-	Address of FAB
;	XAB(D)		-	Address of 1st key XAB
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	FAB(D) F$XAB	-	Zeroed if no CONFIG XAB
;	CONFIG F$NXT	-	Zeroed if a CONFIG exists
;	XAB(D)		-	Zeroed

; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--

;[5000] New

%IF20,<
ULKXAB:	SKIPN	XAB(D)			;Any XAB chain
	 POPJ	P,			;No, nothing to do

	MOVE	T1,FAB(D)		;Get FAB address
	$FETCH	T2,XAB,<(T1)>		;Get its link address
	JUMPE	T2,%POPJ		;None, just return

	CAME	T2,XAB(D)		;FAB point to key chain start?
	 JRST	ULKCFG			;No, there's a CONFIG XAB

	SETZ	T2,			;Yes, clear FAB F$XAB
	$STORE	T2,XAB,<(T1)>
	JRST	ZERXAB			;and go clear XAB(D)

ULKCFG:	SETZ	T1,			;Clear CONFIG's F$NXT 
	$STORE	T1,NXT,<(T2)>

ZERXAB:	SETZM	XAB(D)
	POPJ	P,

> ; End %IF20
	SUBTTL	FABSTV	-	Update STV(D) and STS(D) from FAB/RAB
;++
; FUNCTIONAL DESCRIPTION:
;
;	Called after every RMS service call to update the status return
;	values from FAB(D).  RMS service calls which update the RAB's
;	STV should call RABSTV.
;
;	Entry FABST2 is used when the caller passes the address of a
;	different FAB in T1 (e.g. a scratch FAB).
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,FABSTV
;	<Return here>
;
; INPUT PARAMETERS:
;
;	T1	-	Address of FAB (entry FABST2 only)
;
; IMPLICIT INPUTS:
;
;	FAB(D) STV	-	STV value returned to FAB/RAB
;	FAB(D) STS	-	STS value returned to FAB/RAB
;
; OUTPUT PARAMETERS:
;
;	T2		-	STS value
;
; IMPLICIT OUTPUTS:
;
;	STV(D)		-	STV from FAB/RAB
;	STS(D)		-	STS from FAB/RAB
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
FABSTV:	SKIPA	T1,FAB(D)		;Get FAB address
RABSTV:	MOVE	T1,RAB(D)		;or RAB
FABST2:	$FETCH	T2,STV,<(T1)>		;Get STV value
	STORE	T2,STV(D)		;Save

	$FETCH	T2,STS,<(T1)>		;Get STS value
	STORE	T2,STS(D)		;Save

	CAIGE	T2,SU$SUC		;Real error or real success?
	 $SNH				;No, real bad
	POPJ	P,			;Yes, return STS

> ; End %IF20
	SUBTTL	RLSLNK	-	Release a logical link
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does a $CLOSE to release any logical link allocated to the FAB.
;	$CLOSE errors are ignored.  Called only for fatal OPEN errors.
;
;	Entry RLSLNX $CLOSEs the SCRFAB.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,RLSLNK
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;	Closes the file if open on the FAB.
;
;--
;[5000] New

%IF20,<
RLSLNX:	SKIPA	T1,[SCRFAB]		;Get scratch FAB address
RLSLNK:	MOVE	T1,FAB(D)		;Get FAB address
	$CLOSE	<(T1)>			;Yes. Release link, ignore errors.
	POPJ	P,

> ; End %IF20
	SUBTTL	CVTFNS	-	Convert NAMBLK filespec to TOPS20
;++
; FUNCTIONAL DESCRIPTION:
;
;	Using the expanded filespec string pointed to by RSA of the
;	NAMBLK, copies and converts the string to the destination pointed
;	to by T1. Conversion affects only the nodename field, which is
;	translated from:
;
;		node"userid password account"::
;
;	to:
;
;		node::
;
;	If CVFLAG is non-zero, each byte in the directory field (except
;	for open/close delimiters) is ^V-quoted in the copy.
;
;	The opening delimiter of the generation field is always returned
;	as a "."
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,CVTFNS
;	<Return here>
;
; INPUT PARAMETERS:
;
;	T1	-	Byte pointer to destination where converted string
;			is to be written
;
; IMPLICIT INPUTS:
;
;	NAMBLK	-	NAM block pointers 
;	CVFLAG	-	Non-zero if ^V'ing is to be performed on the
;			directory field.
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	CVFLAG	-	Cleared
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T4.
;
;--
;[5000] New

%IF20,<
CVTFNS:	PUSHJ	P,MOVNOD		;Copy/convert node

	$FETCH	T2,DVA,NAMBLK		;Get Device pntr
	$FETCH	T3,DVL,NAMBLK		;and length
	PUSHJ	P,MOVSTR

	$FETCH	T2,DRA,NAMBLK		;Directory
	$FETCH	T3,DRL,NAMBLK
	MOVEI	T4,MOVSTR		;Assume no ^V'ing
	SKIPE	CVFLAG			;^V this field?
	 MOVEI	T4,CTVDIR		;Yes, use different routine
	PUSHJ	P,(T4)

	$FETCH	T2,NMA,NAMBLK		;Name
	$FETCH	T3,NML,NAMBLK
	PUSHJ	P,MOVSTR

	$FETCH	T2,TPA,NAMBLK		;Extention
	$FETCH	T3,TPL,NAMBLK
	PUSHJ	P,MOVSTR

	$FETCH	T2,VRA,NAMBLK		;Generation
	$FETCH	T3,VRL,NAMBLK
	ILDB	T4,T2			;Make sure delimiter is TOPS20
	SUBI	T3,1			;Correct the count
	MOVEI	T4,"."
	IDPB	T4,T1
	PUSHJ	P,MOVSTR

	SETZ	T4,
	IDPB	T4,T1			;End with null
	SETZM	CVFLAG			;Clear ^V flag
	POPJ	P,			;Return


	SEGMENT	DATA

CVFLAG:	BLOCK	1			;-1 if ^V'ing is being done

	SEGMENT	CODE

> ; End %IF20
	SUBTTL	MOVNOD	-	Move a node name from the NAM block
;++
; FUNCTIONAL DESCRIPTION:
;
;	Moves a nodename of NAM block form (node"userid password account"::)
;	to the destination in the form "node::".
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,MOVNOD
;	<Return here>
;
; INPUT PARAMETERS:
;
;	T1	-		Destination byte pointer
;
; IMPLICIT INPUTS:
;
;	NAMBLK		-	NAM block field pointers
;	 NDA/NDL	-	Nodename character descriptor
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T4.
;
;--
;[5000] New

%IF20,<
MOVNOD:	$FETCH	T2,NDA,NAMBLK		;Get pointer to node string
	$FETCH	T3,NDL,NAMBLK		;Get total length

NODLP:	JUMPE	T3,%POPJ		;Count exhausted
	ILDB	T4,T2			;Get a byte
	CAIE	T4,""""			;Look for quotes
	CAIN	T4,":"			; or colon delimiter
	 JRST	GOTNOD			;Got it

	IDPB	T4,T1			;Store character
	SOJA	T3,NODLP		;Keep going

GOTNOD:	MOVEI	T3,":"			;"node::"
	IDPB	T3,T1
	IDPB	T3,T1
	POPJ	P,			;Return

> ; End %IF20
	SUBTTL	CTVDIR	-	Control-V a directory field
;++
; FUNCTIONAL DESCRIPTION:
;
;	Copies the NAM block directory field to the destination, preceding
;	each directory field character with a ^V.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,CTVDIR
;	<Return here>
;
; INPUT PARAMETERS:
;
;	T1	-	Destination byte pointer
;	T2	-	Source pointer
;	T3	-	Field length in bytes
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T0-T4.
;
;--
;[5000] New

%IF20,<
CTVDIR:	JUMPE	T3,%POPJ		;No length
	SUBI	T3,2			;Subtract open/close widgets
	JUMPLE	T3,%POPJ		;Bad length! Just ignore
	ILDB	T4,T2			;Get opening delimiter
	IDPB	T4,T1			;Store without ^V
	MOVEI	T0,""			;Get a Control-V

CDIRLP:	ILDB	T4,T2			;Get source byte
	IDPB	T0,T1			;^V this byte
	IDPB	T4,T1			;Write the byte
	SOJG	T3,CDIRLP		;Loop for count

	ILDB	T4,T2			;Get closing delimiter
	IDPB	T4,T1			;Store without ^V
	POPJ	P,			;Return

> ; End %IF20
	SUBTTL	ABINI	-	Initialize some srgument blocks
;++
; FUNCTIONAL DESCRIPTION:
;
;	Initializes the NAM block, a scratch FAB, and a TYP block.
;	All are cleared before initialization.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,ABINI
;	<Return here>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	NAMBLK RSA	-	Set to address of RSA buffer
;	NAMBLK RSS	-	Set to length of RSA buffer
;	NAMBLK ESA	-	Set to address of ESA buffer
;	NAMBLK ESS	-	Set to length of ESA buffer
;
;	TYPBLK CLA	-	Set to type IMAGE.
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
ABINI:	NAM$Z	NAMBLK			;Clear NAM block

	NAM$B	NAMBLK			;Reinit
	NAM$E

	XMOVEI	T1,NAMBLK
	MOVE	T2,[POINT 7,RSABUF]	;Setup RSA pointer in NAM
	$STORE	T2,RSA,<(T1)>

	MOVEI	T2,RSALC		;Byte-length
	$STORE	T2,RSS,<(T1)>

	MOVE	T2,[POINT 7,ESABUF]	;Setup ESA pointer
	$STORE	T2,ESA,<(T1)>

	MOVEI	T2,ESALC
	$STORE	T2,ESS,<(T1)>

	FAB$Z	SCRFAB			;Re-init the SCRFAB

	FAB$B	SCRFAB
	FAB$E

	TYP$Z	TYPBLK			;Re-init the TYP block

	TYP$B	TYPBLK
	T$CLA	TY$IMA			;Class is image, image is class
	TYP$E

	POPJ	P,

> ; End %IF20
	SUBTTL	MOVSTR	-	Move string
;++
; FUNCTIONAL DESCRIPTION:
;
;	Moves an ASCII string from source to destination. Returns on
;	a null byte or when the count is exhausted, whichever occurs
;	first.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,MOVSTR
;	<Return here>
;
; INPUT PARAMETERS:
;
;	T1	-	Destination byte pointer
;	T2	-	Source byte pointer
;	T3	-	Number of bytes to transfer
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T4.
;
;--
;[5000] New

%IF20,<
MOVSTR:	JUMPLE	T3,%POPJ		;Return on count exhausted
	ILDB	T4,T2			;Get a source byte
	JUMPE	T4,%POPJ		;Quit on null
	IDPB	T4,T1			;Write to destination
	SOJA	T3,MOVSTR		;loop

> ; End %IF20
	SUBTTL	OPEN$	Do $OPEN
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $OPEN and updates FAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,OPEN$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)			-		Address of FAB
;
; OUTPUT PARAMETERS:
;
;	T2			-		STS code from $OPEN
;	T4			-		Address of FAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T0-T2,T4.
;
;--
;[5000] New

%IF20,<
OPEN$:	$OPEN	@FAB(D)
RMSFRT:	PUSHJ	P,FABSTV		;Update STS/STV
	MOVE	T0,(P)			;Get return address off stack
	MOVEM	T0,%RMPDP		;Save
	MOVE	T4,FAB(D)		;Return FAB address
	CAIL	T2,ER$MIN		;Error?
	 POPJ	P,			;Yes, return +1
	JRST	%POPJ1

ERCRET:	MOVE	T0,(P)			;Get return address off stack
	MOVEM	T0,%RMPDP		;Save error return
	$RETURN				;Return to after $call

RETSUC:	MOVX	T2,SU$SUC		;Clear the error
	SETZ	T3,
MAKSTS:	$STORE	T2,STS,<(T1)>
	$STORE	T3,STV,<(T1)>
	PJRST	FABST2

> ;End %IF20
	SUBTTL	CREA$	-	Do $CREATE
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $CREATE and updates FAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,CREA$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)			-		Address of FAB
;
; OUTPUT PARAMETERS:
;
;	T2			-		STS code from $CREATE
;	T4			-		Address of FAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
CREA$:	$CREATE	@FAB(D)
	JRST	RMSFRT

> ;End %IF20
	SUBTTL	CLOS$	-	Do $CLOSE
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $CLOSE and updates FAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,CLOS$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)			-		Address of FAB
;
; OUTPUT PARAMETERS:
;
;	T2			-		STS code from $CLOSE
;	T4			-		Address of FAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
CLOS$:	$CLOSE	@FAB(D)
	JRST	RMSFRT

> ;End %IF20
	SUBTTL	PARS$	-	Do $PARSE
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $PARSE and updates FAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,PARS$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FAB(D)			-		Address of FAB
;
; OUTPUT PARAMETERS:
;
;	T2			-		STS code from $PARSE
;	T4			-		Address of FAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
PARS$:	$PARSE	@FAB(D)
	JRST	RMSFRT

> ;End %IF20
	SUBTTL	GET$	-	Do $GET
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $GET and updates RAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,GET$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)			-		Address of RAB
;
; OUTPUT PARAMETERS:
;
;	T2			-		STS code from $GET
;	T4			-		Address of RAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T0-T2,T4.
;
;--
;[5000] New

%IF20,<
GET$:	$GET	@RAB(D)
RMSRRT:	MOVE	T0,(P)			;Get return address off stack
	MOVEM	T0,%RMPDP
	PUSHJ	P,RABSTV
	MOVE	T4,RAB(D)		;Return RAB address
	CAIL	T2,ER$MIN		;Error?
	 POPJ	P,			;Yes
	JRST	%POPJ1

> ;End %IF20
	SUBTTL	CONN$	-	Do $CONNECT
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $CONNECT and updates RAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,CONN$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)			-		Address of RAB
;
; OUTPUT PARAMETERS:
;
;	T2			-		STS code from $CONNECT
;	T4			-		Address of RAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
CONN$:	$CONNECT @RAB(D)
	JRST	RMSRRT

> ;End %IF20

	SUBTTL	DISC$	-	Do $DISCONNECT
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $DISCONNECT and updates RAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,DISC$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)
;
; OUTPUT PARAMETERS:
;
;	T2			-		STS code from $DISCONNECT
;	T4			-		Address of RAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--
;[5004] New

%IF20,<
DISC$:	$DISCONNECT @RAB(D)
	PJRST	RMSRRT

> ;End %IF20
	SUBTTL	REWI$	-	Do $DISCONNECT/$CONNECT
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $DISCONNECT/$CONNECT sequence to rewind a file to its
;	starting position.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,REWI$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--
;[5013] New

%IF20,<
REWI$:	PUSHJ	P,DISC$
	 POPJ	P,			;Error
	PUSHJ	P,CONN$
	 POPJ	P,			;Error
	JRST	%POPJ1			;Success

> ;End %IF20
	SUBTTL	READ$	-	Do $READ
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $READ and updates RAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,READ$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)			-		Address of RAB
;
; OUTPUT PARAMETERS:
;
;	T2			-		STS code from $READ
;	T4			-		Address of RAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
READ$:	$READ	@RAB(D)
	JRST	RMSRRT
> ;End %IF20
	SUBTTL	PUT$	-	Do $PUT
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $PUT and updates RAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,PUT$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)			-		Address of RAB
;
; OUTPUT PARAMETERS:
;
;	T2			-		STS code from $PUT
;	T4			-		Address of RAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
PUT$:	$PUT	@RAB(D)
	JRST	RMSRRT
> ;End %IF20
	SUBTTL	WRIT$	-	Do $WRITE
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $WRITE and updates RAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,WRIT$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)			-		Address of RAB
;
; OUTPUT PARAMETERS:
;
;	T2			-		STS code from $WRITE
;	T4			-		Address of RAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
WRIT$:	$WRITE	@RAB(D)
	JRST	RMSRRT

> ;End %IF20
	SUBTTL	TRUN$	-	Do $TRUNCATE
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $TRUNCATE and updates RAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,TRUN$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)			-		Address of RAB
;
; OUTPUT PARAMETERS:
;
;	T2			-		STS code from $TRUNCATE
;	T4			-		Address of RAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
TRUN$:	$TRUNCATE @RAB(D)
	JRST	RMSRRT

> ;End %IF20
	SUBTTL	FIND$	-	Do $FIND
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $FIND and updates RAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,FIND$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)			-		Address of RAB
;
; OUTPUT PARAMETERS:
;
;	T2			-		STS code from $FIND
;	T4			-		Address of RAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
FIND$:	$FIND	@RAB(D)
	JRST	RMSRRT

> ;End %IF20
	SUBTTL	UPDA$	-	Do $UPDATE
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $UPDATE and updates RAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,UPDA$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)			-		Address of RAB
;
; OUTPUT PARAMETERS:
;
;	T2			-		STS code from $UPDATE
;	T4			-		Address of RAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2.
;
;--
;[5000] New

%IF20,<
UPDA$:	$UPDATE	@RAB(D)
	JRST	RMSRRT

> ;End %IF20
	SUBTTL	DELE$	-	Do $DELETE
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $DELETE and updates RAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,DELE$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)		-		Address of RAB
;
; OUTPUT PARAMETERS:
;
;	T2		-		STS code from $DELETE
;	T4		-		Address of RAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2
;
;--
;[5013] New

%IF20,<
DELE$:	$DELETE @RAB(D)
	JRST	RMSRRT

> ;End %IF20
	SUBTTL	FREE$	-	Do $FREE
;++
; FUNCTIONAL DESCRIPTION:
;
;	Does $FREE and updates RAB's STS/STV
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,FREE$
;	<Error return>
;	<Success return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	RAB(D)		-		Address of RAB
;
; OUTPUT PARAMETERS:
;
;	T2		-		STS code from $FREE
;	T4		-		Address of RAB
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1,T2
;
;--
;[5014] New

%IF20,<
FREE$:	$FREE	@RAB(D)
	JRST	RMSRRT

> ;End %IF20

;***************************************************************************
;*                                                                         *
;*                      STATIC RMS ARGUMENT BLOCKS                         *
;*                                                                         *
;***************************************************************************

;Scratch FAB for LOOKUPs:


IF20,<
IFNRMS,<ER$MIN==300000>
%ERMIN:	ER$MIN				;RMS error base

> ;End IF20

%IF20,<

	SEGMENT	DATA

SCRFAB:	BLOCK	FA$LNG
NAMBLK:	BLOCK	NA$LNG
TYPBLK:	BLOCK	TY$LNG

RSALW==LTEXTW				;RSA length is %TXTBF's length
RSALC==LTEXTC				;and in characters
ESALC==RSALC				;ESA ditto

RSABUF:	BLOCK	LTEXTW			;RSA buffer
ESABUF:	BLOCK	LTEXTW			;ESA buffer
EXFATT:	BLOCK	1			;Pointer to attributes portion
EXFBUF:	BLOCK	LTEXTW			;Resultant string saved here
	SEGMENT	CODE

;PURGE as many RMS-generated symbols as we can

	DEFINE	RMSPRG (PFX,FLDS) <
	IF2,<
	IRP PFX,<
	  IRP FLDS,< IFDEF PFX'$$'FLDS,<PURGE PFX'$$'FLDS>
		     IFDEF $$'PFX'FLDS,<PURGE $$'PFX'FLDS>
		     IFDEF C$$'FLDS,<PURGE C$$'FLDS>
		   > ;End IRP FLDS
		> ;;End IRP PFX

	PURGE FAB$B,FAB$E,RAB$B,RAB$E,XAB$B,XAB$E,NAM$B,NAM$E,TYP$B,TYP$E
	PURGE T$$OF,T$$PS,T$$SZ,$$ADDR,$$NEWVAL,$$SET,$$CURR,$$MAPADD
	PURGE SF$$CT,SF$$RT,SN$$CT,SN$$RT,SR$$RT,ST$$CT,STO$$C,SX$$CT
	PURGE SX$$RT

	    > ;End IF2

> ;End RMSPRG

	RMSPRG (<F,R,X,N,T>,<AID,ALQ,BID,BKS,BKT,BKZ,BLN,BLS,BSZ,CDT,
		CHA,COD,CTX,DAN,DEV,DFL,DRA,DTP,DVA,DVL,EDT,EDT,ELS,
		ESA,ESL,ESS,FAB,FAC,FLG,FNA,FNB,FOP,FSZ,IAN,IFI,IFL,
		ISI,JFN,JNL,KBF,KNM,KRF,KSZ,LAN,LSN,MBF,MRN,MRS,NAM,
		NDA,NDL,NMA,NML,NOA,NOK,NOP,NXT,ORG,PAD,PS0,PS1,PS2,
		PS3,PS4,PS5,PS6,PS7,RAC,RAT,RBF,RDT,REF,RFA,RFM,RLF,
		ROP,RS1,RS2,RS6,RS7,RS8,RS9,RSA,RSL,RSS,RSZ,RX0,RX1,
		RX2,RX3,RX4,RX5,SDC,SHR,STS,STV,SZ0,SZ1,SZ2,SZ3,SZ4,
		SZ5,SZ6,SZ7,TPA,TPL,TYP,UBF,USZ,VRA,VRL,WCC,XAB>)

> ;End %IF20


	END