Google
 

Trailing-Edge - PDP-10 Archives - BB-BT99S-BB_1990 - 10,7/rms10/rmssrc/rmsopn.b36
There are 11 other files named rmsopn.b36 in the archive. Click here to see a list.
MODULE OPENER =

BEGIN

GLOBAL BIND	OPENV = 1^24 + 1^18 + 27;	!EDIT DATE: 11-JAN-89

%([

FUNCTION:	THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
		THE $OPEN AND $CREATE MACROS IN RMS-20.
AUTHOR:	S. BLOUNT

THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1977, 1979, 1989 BY DIGITAL EQUIPMENT CORPORATION



**********	TABLE OF CONTENTS	**************




	ROUTINE			FUNCTION
	=======			========

	$OPEN			PROCESSOR FOR THE $OPEN MACRO

	$CREATE			PROCESSOR FOR THE $CREAT MACRO

	OFILE			GET A JFN AND OPEN THE FILE

	DOOPEN			PERFORM SECOND PORTION OF FILE OPEN




REVISION HISTORY:

EDIT		DATE		PURPOSE
====		====		=======

1		7-16		/SB CHANGE CALL TO READADB
2		7-21		/SB ADD SHORT BIT TO GTJFN CALL
3		30-SEP-76	/SB ASSUME SETKDB SETS ERROR CODE
4		29-OCT-76	/SB DELETE CHECKING
5		1-NO-76		/SB RE-ARRANGE AND ADD OPEN IF BIT
6		16-NOV-76	/SB TAKE OUT NO JFN RULE FOR $CREATE
7		22-NOV-76	/SB ADD ERROR MAPPING LOGIC
8		16-DEC-76	/SB SET "NEWFILE" FLAG IN CREATE
9		6-JAN-77	/SB OPEN ASCII FILES IN 7-BIT MODE SO
				    THE EOF POINTER IS SET UP RIGHT.
10		7-JAN-77	/SB DONT LOCK FILE IS EXCLUSIVE ACCESS
11		31-JAN-77	/SB TAKE CALL TO DISPFILE OUT OF IDX CONDITIONALS
12		31-JAN-77	/SB ADD OPFDUD BIT TO OPEN (FOR ALL FILES)
13		23-FEB-77	/SB DONT GENERATE BYTE PTR IN GTFDB
14		2-MAR-77	/SB REMOVE LOCK-MODE FIELD ACCESS
15		4-MAR-77	/SB SET WRITE ACCESS IF FILE NON-EX
16		29-MAR-77	/SB SET BYTE SIZE IN FDB FOR $CREATE
17		7-APR-77	/SB TAKE OUT HYBYTE STORE
18		3-MAY-77	/SB SAVE ADB ADDRESS IN FST

*************************************************
*						*
*		NEW REVISION HISTORY		*
*						*
*************************************************

PRODUCT	MODULE	 SPR
 EDIT	 EDIT	 QAR		DESCRIPTION
======	======	=====		===========

17	19	XXXXX	SET THE FDB BYTE SIZE OF STREAM FILES TO 7 BITS
			SO THE CHFDB THAT UPDATES THE END OF FILE PTR.
			WILL NOT MULTIPLY THE BYTE COUNT (CORE BYTE
			SIZE = 7)  BY THE NUMBER OF 7 BIT BYTES PER
			36 BIT WORD (DEFAULT FDB BYTE SIZE = 36).

21	20	XXXXX	FOR STREAM FILES, UPDATE THE FDB ONLY FOR DISK FILES.
			REFER TO PRODUCT EDIT 17.

****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************

PRODUCT	MODULE	 SPR
 EDIT	 EDIT	 QAR		DESCRIPTION
======	======	=====		===========

 100	  21	Dev		Make declarations for routine names
				be EXTERNAL ROUTINE so RMS will compile 
				under BLISS V4 (RMT, 10/22/85).

 106      22	Dev		Do not trash other bits in the RIB status
				word when setting RP$RMS. (RMT, 12/2/85)

 114	  23	Dev		(WXD, 4/2/86) RIBSTS revisited.

 120	  24	10-35646	(12/5/86 asp) in OFILE set correct size of
				RENBLK and FILOP arg cnt.

 121      25	10-35025	(4/13/87 asp) in OFILE release channel if
				open fails.

 122      26    10-35723        (8/11/87 asp) in OFILE (again) do lookup to
                                get rib status before open to avoid wipe of
                                Always Backup.

 126	  27	20-20998A	(1/11/89 smw) Check FAB bucket size less than 8.

	***** END OF REVISION HISTORY *****




])%

	%([ EXTERNAL DECLARATIONS ])%


EXTERNAL ROUTINE
    CHECKXAB,	! SCAN THE USER'S XAB CHAIN
    CRASH,
    DISPFILE,	! DISPLAY THE FILE ATTRIBUTES
!    DUMP,
    FILEQ,			
    GPAGE,
    IDXFILEPROLOG,	! CREATE AN INDEXED FILE PROLOGUE
    READADB,	! READ THE AREA DESCRIPTORS
    PPAGE,
    PLOGPAGE,
    FERROR,
    GMEM,
    SETKDB,			! SET UP THE KEY DESCRIPTORS
    SETFST,
    SETPLOG;

EXTERNAL
    FDBWORD1;	! FIRST WORD OF FILE FDB

    
	%([ ERROR MESSAGES USED WITHIN THIS MODULE ])%

EXTERNAL
    MSGFAILURE;		! ROUTINE FAILED WHICH SHOULDN'T HAVE



FORWARD ROUTINE		OFILE;			! THESE ARE FORWARD DECLARATIONS


REQUIRE 'RMSREQ';
REQUIRE 'RMSOSD';

MACRO	OPENEXIT =				!SUCCESSFULLY EXIT TO USER
	BEGIN
		OAFLAGS = ZERO;			!THIS INDICS SUCCESS
		USEREXIT			!JUMP TO USER
	END %;

EXTDECLARATIONS;
SUBDECLARATIONS;

	%([ EXTERNAL MAPPINGS ])%

	MAP
	    FDBWORD1:	FORMAT;	! FIRST WORD OF FDB


	%([ ERROR MAPPING TABLES DEFINED IN THIS MODULE ])%

	%([ GTJFN/OPENF AND FILOP. ERROR MAPPING TABLE ])%

	GLOBAL BIND OPNERRTAB = UPLIT(

	%IF TOPS10 %THEN
		OSERRMAP (ER$FSI, ER$FSI),	!DUMMY CASE, SEE PAR10FS
		OSERRMAP (ER$FNF, ERFNF_, ERIPP_, ERDNA_, ERNSD_, ERSNF_),
		OSERRMAP (ER$FEX, ERAEF_),
		OSERRMAP (ER$PRV, ERPRT_),
		OSERRMAP (ER$DEV, ERWLK_),
		OSERRMAP (ER$FLK, ERFBM_, ERENQ_),
						!START OF DELETE CODES
		OSERRMAP (ER$FNC, ERFBM_),	!CANT DELETE FILE BEING UPD
	%FI
	%IF TOPS20 %THEN
		OSERRMAP (ER$FSI, GJFX4, GJFX5, GJFX6, GJFX7, GJFX8, GJFX9,
			GJFX10, GJFX11, GJFX12, GJFX13, GJFX14, GJFX31,
			GJFX33, GJFX34, GJFX43),
		OSERRMAP (ER$FNF, GJFX16, GJFX17, GJFX18, GJFX19, GJFX20,
			GJFX24, GJFX28, GJFX32, OPNX2),
		OSERRMAP ( ER$FEX, GJFX27 ),	! FILE ALREADY EXISTS
		OSERRMAP (ER$PRV, GJFX35, GJFX44, OPNX3, OPNX4, OPNX5, OPNX6,
			OPNX15),
		OSERRMAP ( ER$DEV, GJFX38 ),	! BAD DEVICE
		OSERRMAP ( ER$FLK, OPNX9 ),	! FILE LOCKED
	%FI
	OSERRMEND ;				! END OF TABLE




! $OPEN
! ====

! THIS ROUTINE PROCESSES THE $OPEN MACRO.
!	IT IS CALLED DIRECTLY FROM THE RMS-20 VERB DISPATCHER.
!	THIS ROUTINE UPON COMPLETION WILL EXIT DIRECTLY BACK TO
!	THE RMS-20 EXIT PROCESSING ROUTINE.

! FORMAT OF $OPEN MACRO:
!
!		$OPEN 		<FAB-ADDRESS> [,<ERROR-ADDRESS>]
!
! FAB FIELDS USED AS INPUT TO $OPEN:
!
!	BLS		BLOCK SIZE FOR FILE
!	FAC		FILE ACCESS VALUE
!	FOP		FILE OPTIONS
!	FNA		FILE NAME ADDRESS
!	JFN		JFN OF FILE
!	LOG		ADDRESS OF LOG CONTROL BLOCK
!	SHR		FILE SHARING VALUE
!
! FAB FIELDS RETURNED TO USER:
!
!	DEV		DEVICE CHARACTERISTICS
!	IFI		INTERNAL FILE IDENTIFIER
!	JFN		JFN OF FILE
!	ORG		FILE ORGANIZATION
!	RAT		RECORD ATTRIBUTES
!	RFM		RECORD FORMAT
!	STS		COMPLETION STATUS CODE
!	STV		ADDITIONAL STATUS INFORMATION
!


! INPUT:
!	BLOCK		ADDRESS OF USER FILE BLOCK
!	ERRORRETURN	ADDRESS OF USER ERROR PROCESSING ROUTINE

! OUTPUT:
!	<NO STATUS CODE RETURNED>
!
!

%([	******** FLOW OF $OPEN ROUTINE ********	

	1.	OPEN THE FILE
	4.	LOCK THE FILE
	5.	PROCESS FILE PROLOGUE 
	6.	UPDATE FIELDS IN USER FAB
	7.	CREATE THE FILE STATUS BLOCK
	8.	CHECK FOR ALL ERRORS IN $OPEN REQUEST

	****************************************


])%

GLOBAL ROUTINE %NAME('$OPEN') ( BLOCK, ERRORRETURN ) =
BEGIN
	ARGUMENT (BLOCK,BASEADD);			! ARG IS USER FAB
	ARGUMENT (ERRORRETURN,BASEADD);			! ADDRESS OF USER ERROR ROUTINE

	RMSENTRY ('$OPEN');

	%([ FETCH THE USER'S FAB AND ERROR ADDRESS ])%

	FAB = .BLOCK;					! GET ADDRESS OF FAB
	ERRADR = .ERRORRETURN;	! AND USER ERROR ADDRESS
	ERRORBLOCK ( FAB );				! ALL ERRORS GO TO THE FAB

	%([ MAKE SURE THIS IS A FAB ])%

	IF .FAB [ BLOCKTYPE ] ISNT FABCODE THEN USERERROR ( ER$FAB );
	IF .FAB [ BLOCKLENGTH ] LSS V1FABSIZE THEN USERERROR ( ER$BLN );


	%([ OPEN THE FILE ])%

	%IF TOPS10
	%THEN
		IF $CALL(OFILE,0) ISNT TRUE		!ARG IGNORED ON 10
		THEN  RMSBUG ( MSGFAILURE );		! TRY TO OPEN THE FILE
	%FI
	%IF TOPS20
	%THEN
		IF CALLOFILE ( PCI ( GJ_OLD ) ) ISNT TRUE
		THEN  RMSBUG ( MSGFAILURE );		! TRY TO OPEN THE FILE
	%FI

	%([ REMEMBER THAT WE NEED TO CLOSE THE FILE ])%

	OAFLAGS = ABRCLOSE;

	%([ WE MUST MAKE SURE THE FILE EXISTS. THIS CHECK MUST
	   BE MADE BECAUSE IF THE USER GAVE US A JFN, WE HAVE
	   NO WAY OF CHECKING IF IT IS ASSOCIATED WITH AN
	   EXISTING FILE WITHOUT READING THE FDB (WHICH WE
	   DID IN OFILE. ])%

	IF ( CHKFLAG ( FDBWORD1, FDBNXF ) ISON )
	THEN	%(FILE DOES NOT EXIST)%
		$EXIT (OABORT,%(ERROR)%	PCI ( ER$FNF ) );

	%([ PERFORM THE REST OF THE $OPEN MACRO PROCESSING ])%

	CALLDOOPEN;

	OPENEXIT						! RETURN TO USER

END; %( OF $OPEN PROCESSOR )%


! $CREATE
! ======

! PROCESSOR FOR $CREATE MACRO.
! THIS ROUTINE WILL CREATE A NEW FILE FOR USE BY RMS-20.
!	AN OPTION (FB$CIF) IS ALSO SUPPORTED WHICH WILL
!	$OPEN THE FILE IF IT ALREADY EXISTS.
!
! FORMAT OF $CREATE MACRO:
!
!		$CREATE		<FAB-ADDRESS> [,<ERROR-ADDRESS>]
!
! FAB FIELDS USED AS INPUT TO $CREATE:
!
!		BLS		BLOCK SIZE FOR FILE
!		BKS		BUCKET SIZE FOR FILE
!		FAC		FILE ACCESS VALUE
!		FOP		FILE OPTIONS
!		FNA		FILE NAME ADDRESS
!		MRN		MAXIMUM RECORD NUMBER
!		MRS		MAXIMUM RECORD SIZE
!		ORG		FILE ORGANIZATION
!		RAT		RECORD ATTRIBUTES
!		RFM		RECORD FORMAT
!		XAB		ADDRESS OF XAB CHAIN
!
! FAB FIELDS RETURNED TO USER:
!
!		BLS		BLOCK SIZE OF FILE
!		DEV		DEVICE CHARACTERISTICS
!		IFI		INTERNAL FILE IDENTIFIER
!		JFN		JFN OF FILE
!		STS		COMPLETION STATUS CODE
!		STV		ADDITIONAL STATUS INFORMATION

! INPUT:
!	ADDRESS OF USER FAB
!	ADDRESS OF USER ERROR ROUTINE

! OUTPUT:
!	<STATUS FIELD>


GLOBAL ROUTINE %NAME('$CREATE') ( BLOCK, ERRORRETURN ) =
BEGIN

	ARGUMENT	(BLOCK,BASEADD);
	ARGUMENT	(ERRORRETURN,BASEADD);

EXTERNAL ROUTINE
    DOOPEN;

REGS;

LOCAL
    TEMP,
    DISKFLAG,				! FLAG IF DEVICE IS A DISK
    GTJFNBITS;				! BITS FOR GTJFN JSYS

MAP
    TEMP:	FORMAT;

	RMSENTRY ('$CREATE');
	FAB = .BLOCK;					! GET ADDRESS OF FAB
	 ERRADR = .ERRORRETURN;	! AND USER ERROR ADDRESS
	ERRORBLOCK ( FAB );				! SEND ALL ERRORS TO FAB

	%([ CHECK  BLOCK-TYPE CODE OF FAB ])%

	IF .FAB [ BLOCKTYPE ] ISNT FABCODE THEN USERERROR ( ER$FAB );
	IF .FAB [ BLOCKLENGTH ] LSS V1FABSIZE THEN USERERROR ( ER$BLN );

	IF CHKFLAG (FAB[FABFAC], AXWRT) IS OFF THEN USERERROR (ER$FAC);
					!MUST DO OUTPUT TO CREATE A FILE


	%IF TOPS10
	%THEN

	IF CALLOFILE ( 0 ) ISNT TRUE			!DUMMY ARG ON 10 CALL
	THEN RMSBUG ( MSGFAILURE );			! SHOULDN'T FAIL

	%([ FOR CONVENIENCE, DETERMINE IF DEVICE IS A DISK ])%

	DISKFLAG = FALSE;				! ASSUME NOT
	IF .DVFLGS [ DEVTYPE ] IS DVDSK
	THEN
		DISKFLAG = 1;				! YES, IT IS

	%([ SET THE FLAG WHICH INDICATES THE FILE IS OPEN AND MUST BE CLOSED ])%

	OAFLAGS = ABRCLOSE;

	! FOPCIF SUPPORTED ON 10 BY DIRECTLY CHECKING CONTENTS OF FILE

	IF ( CHKFLAG ( FDBWORD1, FDBNXF ) IS OFF ) 	!IS NON-EX BIT ON?
	THEN	IF .DISKFLAG ISNT FALSE
		THEN	BEGIN				!FILE EXISTS
			IF (CHKFLAG (FAB[FABFOP],FOPCIF) ISON)	!ALLOWED?
			THEN	BEGIN			!YES
				CALLDOOPEN;		! PROCEED AS IF $OPEN
				OPENEXIT		! RETURN IF SUCCESSFUL
			END	 %(OF IF WE SHOULD PROCEED AS $OPEN)%
			ELSE	%(THE FILE EXISTS...USER ERROR)%
				$EXIT (OABORT,	%(ERROR)%	PCI ( ER$FEX ) )
		END;	%(OF IF THE FILE EXISTS)%

	%([ RESET FILE CLASS FIELD IN THE FDB ])%

	IF ( .FAB [ FABRFM ] ISNT RFMSTM )
			AND
	  ( .FAB [ FABRFM ] ISNT RFMLSA )
	THEN	BEGIN %( TO RESET FDB)%
		IF .DISKFLAG IS FALSE
		THEN
			USERERROR ( ER$DEV );			! RMS FILES MUST BE ON DISK
		%([ NO FDB CONCEPT ON 10 ])%

		%([ NOW GET A FREE PAGE FOR THE FILE PROLOGUE ])%

		IF ( PLOGPAGE = CALLGPAGE ( PCI ( 1 ) ) ) IS FALSE
			THEN $EXIT (OABORT, PCI ( ER$DME )  );

		%([ SET UP A TEMPORARY POINTER TO THIS PAGE, AND
		   MAP IN PAGE 0 FROM THE FILE TO CREATE THE PROLOGUE ])%

		FPT = .PLOGPAGE ^ P2W;				! SET POINTER

		$CALL	(PAGIN,
				%(JFN)%		.USERJFN,
				%(PAGE)%	0,
				%(INTO)%	.PLOGPAGE,
				%(ACCESS)%	AXUPD,
				%(COUNT)%	1);

	%([ SET UP THE FILE PROLOGUE ])%

		CALLSETPLOG;				! SET UP THE FILE PROLOGUE
		SETFLAG ( OAFLAGS, ABRPLOGPAGE );	! REMEMBER THIS WAS DONE
	END	 %( OF IF NOT ASCII FILE )%
	ELSE	IF .FAB[FABORG] NEQ ORGSEQ
		THEN $EXIT (OABORT, PCI(ER$RFM));	!STM/LSA REQUIRES SEQ FILE

	%FI	!IF TOPS10

	%IF TOPS20
	%THEN

	%([ DETERMINE THE BITS FOR THE GTJFN JSYS ])%

	GTJFNBITS = GJ_NEW;				! DEFAULT IS: ERR IF OLD FILE
	IF CHKFLAG ( FAB [ FABFOP ], FOPCIF ) ISON
	THEN	GTJFNBITS = ZERO			! JUST OPEN IF EXISTS
	ELSE	IF CHKFLAG (FAB [FABFOP], FOPSUP) ISON
		THEN	GTJFNBITS = GJ_FOU;		! SUPERSEDE IF FILE EXISTS

	%([ OPEN THE FILE ])%

	IF 	CALLOFILE ( LCI ( GTJFNBITS ) ) ISNT TRUE
	THEN RMSBUG ( MSGFAILURE );			! SHOULDN'T FAIL

	%([ FOR CONVENIENCE, DETERMINE IF DEVICE IS A DISK ])%

	DISKFLAG = FALSE;				! ASSUME NOT
	IF .DVFLGS [ DEVTYPE ] IS DVDSK
	THEN
		DISKFLAG = 1;				! YES, IT IS

	%([ SET THE FLAG WHICH INDICATES THE FILE IS OPEN AND MUST BE CLOSED ])%

	OAFLAGS = ABRCLOSE;

	%([ AT THIS POINT, WE MUST CHECK TO SEE IF THE FILE
	   EXISTS AND IF THE USER SPECIFIED THE "CREATE IF"
	   FILE OPTION. IF SO, WE MUST CONTINUE AS IF THIS WERE
	   A REGULAR $OPEN MACRO. HOWEVER, FOR NON-DISK DEVICES,
	   THE $CREATE WILL ALWAYS FORM A NEW FILE.  ])%

	IF ( CHKFLAG ( FDBWORD1, FDBNXF ) IS OFF ) 
	THEN IF .DISKFLAG ISNT FALSE
		THEN	%(THE FILE EXISTS)%
		BEGIN

		%([ DOES HE WANT TO OPEN THE FILE IF IT EXISTS? ])%

		IF  ( CHKFLAG ( FAB [ FABFOP ], FOPCIF ) ISON )
		THEN	%(DO THE $OPEN)%
			BEGIN
			CALLDOOPEN;				! PROCEED AS IF $OPEN
			OPENEXIT				! RETURN IF SUCCESSFUL
			END %(OF IF WE SHOULD PROCEED AS $OPEN)%
		ELSE	%(THE FILE EXISTS...USER ERROR)%

			$EXIT (OABORT,	%(ERROR)%	PCI ( ER$FEX ) )

		END;	%(OF IF THE FILE EXISTS)%


	%([ RESET FILE CLASS FIELD IN THE FDB ])%

	IF ( .FAB [ FABRFM ] ISNT RFMSTM )
			AND
	  ( .FAB [ FABRFM ] ISNT RFMLSA )
	THEN
		BEGIN %( TO RESET FDB)%
		TEMP [ FDBCLS ] = CLSRMS;				! CLASS = RMSFILE

		%([ MAKE SURE THAT THIS IS A DISK. OTHERWISE, ITS AN ERROR ])%

		IF .DISKFLAG IS FALSE
		THEN
			USERERROR ( ER$DEV );			! RMS FILES MUST BE ON DISK


		%([ CHANGE THE FDB FILE CLASS FIELD TO BE AN RMS-20 FILE ])%

		AC1 = .USERJFN OR FDBCTL^18;	!JFN & WORD TO CHANGE
		AC2 = FDBCLSMASK;		!BITS TO CHANGE IN SPEC WORD
		AC3 = .TEMP;			!NEW VALS FOR THOSE BITS
		DO_JSYS (CHFDB);

		%([ NOW, SET THE BYTE SIZE IN THE FDB TO BE 36. THIS
		   IS NOT REQUIRED FOR THE MONITOR BUT IS A GOOD
		   THING TO DO AT THIS POINT. ])%

		AC1 = .USERJFN OR FDBBYV^18;	!JFN & WORD TO CHANGE
		AC2 = FDBBSZMASK;		!BITS TO CHANGE IN SPEC WORD
		AC3 = RMSBYTESIZE^FDBBSZLSH;	!NEW VALS FOR THOSE BITS
		DO_JSYS (CHFDB);

		%([ NOW GET A FREE PAGE FOR THE FILE PROLOGUE ])%

		IF ( PLOGPAGE = CALLGPAGE ( PCI ( 1 ) ) ) IS FALSE
			THEN $EXIT (OABORT, PCI ( ER$DME )  );

		%([ SET UP A TEMPORARY POINTER TO THIS PAGE, AND
		   MAP IN PAGE 0 FROM THE FILE TO CREATE THE PROLOGUE ])%

		FPT = .PLOGPAGE ^ P2W;				! SET POINTER

		$CALL	(PAGIN,
				%(JFN)%		.USERJFN,
				%(PAGE)%	0,
				%(INTO)%	.PLOGPAGE,
				%(ACCESS)%	AXUPD,
				%(COUNT)%	1);

	%([ SET UP THE FILE PROLOGUE ])%

		CALLSETPLOG;					! SET UP THE FILE PROLOGUE
		SETFLAG ( OAFLAGS, ABRPLOGPAGE );		! REMEMBER THIS WAS DONE
		END %( OF IF NOT ASCII FILE )%

	ELSE
%([17])%	BEGIN %(TO RESET THE BYTE SIZE FOR LSA AND STREAM FILES)%
		IF .FAB[FABORG] NEQ ORGSEQ
		THEN $EXIT (OABORT, PCI(ER$RFM));	!STM/LSA REQUIRES SEQ FILE
		IF .FAB [ FABRFM ] IS RFMLSA 
		THEN	BEGIN
			AC1 = .USERJFN;			! GET JFN
			AC2 = RMSBYTESIZE;
			DO_JSYS ( SFBSZ );
		END
%([17])%	ELSE	%( MUST BE STREAM FILE )%
%([21])%		IF .DISKFLAG ISNT FALSE
%([21])%		THEN	BEGIN	%( ONLY IF FILE IS ON DISK )%
			AC1 = .USERJFN OR FDBBYV^18;	!JFN & WORD TO CHANGE
			AC2 = FDBBSZMASK;		!BITS TO CHANGE IN SPEC WORD
			AC3 = ASCIIBYTESIZE^FDBBSZLSH;	!NEW VALS FOR THOSE BITS
			DO_JSYS (CHFDB);
%([21])%		END
%([17])%	END; %( OF LSA OR STREAM FILE )%


	%FI	!IF TOPS20


	%([	SET UP THE FILE-STATUS TABLE	])%

	IF CALLSETFST IS FALSE 
	THEN	$EXIT(OABORT, GCI(USRSTS));
	SETFLAG (OAFLAGS,ABRFST);			! REMEMBER THIS

	SIZEOFFILE = .FST [FSTLOBYTE];			! INIT TO SIZE OF PROL

	%([ INDICATE THAT THIS IS A NEW FILE AND WE ARE NOT LOCKING ])%

	FST [ FSTFLAGS ] = ( .FST [ FSTFLAGS ] OR FLGNEWFILE ) AND ( NOT FLGLOCKING );


	%([ CHECK FOR ERRORS ])%

	IF CALLFERROR IS FALSE THEN $EXIT (OABORT, GCI ( USRSTS )  );


	%([ FOR INDEXED FILES, WE MUST NOW CREATE THE REST OF THE FILE PROLOGUE ])%

	%IF INDX %THEN

	IF IDXFILE
	THEN

		BEGIN

		%([ 126 Check the bucket size for the default area ])%

		IF .FAB[FABBKS] GTR MAXBKZ			!126 in FAB
			THEN $EXIT(OABORT, PCI(ER$BKS));	!126

		%([ CHECK THE USER'S XAB CHAIN FOR ERRORS ])%

		IF CALLCHECKXAB IS FALSE THEN $EXIT (OABORT, GCI ( USRSTS ) );

		%([ IF THEY WERE OK, WE CAN SET UP THE REST OF
		   THE FILE PROLOGUE. ])%

		IF CALIDXFILPROLOG IS FALSE THEN $EXIT(OABORT, PCI(ER$DME));
	
		%([ WE HAVE NOW CREATED THE PROLOGUE. HOWEVER, WE
		   MUST READ THE PROLOGUE BACK IN AND SET UP THE
		   SPECIAL INTERNAL DATA STRUCTURES ( KEY BLOCKS ) ])%

		IF CALLREADADB ( GPT ( FPT ) ) IS FALSE 
		THEN
			$EXIT (OABORT, GCI ( USRSTS ) );

		%([ REMEMBER THAT WE HAVE READ THE ADB ])%

 		FST [ FSTADB ] = .ADB;			! SAVE ADDRESS IN FST
		SETFLAG ( OAFLAGS, ABRADB );

		%([ CREATE THE KEY DESCRIPTOR BLOCKS ])%

		IF CALLSETKDB ( GPT ( FPT ) ) IS FALSE
		THEN
			$EXIT (OABORT, GCI ( USRSTS ) )
		END; %(OF IF IDXFILE)%
	%FI


	%([ WE CAN NOW FLUSH THE FREE PAGE THAT WE USED TO CREATE
	   THE FILE PROLOGUE ( IF THIS IS AN RMS-20 FILE ) ])%

	IF RMSFILE
	THEN
		BEGIN
		RTRACE (%STRING('	FLUSHING PROLOG PAGE...',%CHAR(13),%CHAR(10)));
		$CALL (PAGOUT, .USERJFN, 0, .PLOGPAGE, 1);	!WRITE IT OUT
		CALLPPAGE (	%(PAGE #)%	GCI ( PLOGPAGE ),
				%(COUNT)%		PCI ( 1 ),		! COUNT
				%(KILL IT)%	PCI ( TRUE ) )		! DESTROY PAGE
		END; %( OF IF RMSFILE )%


	%([ RETURN FILE-ID ])%

	FAB [ FABIFI ] = .FST;					! RETURN FST ADDRESS AS IFI

	FAB [ FABJFN ] = .USERJFN;				! SET IT IN FAB

	OPENEXIT						! RETURN TO USER

END; %( OF CREAT )%



! OFILE
! =====

! THIS ROUTINE DOES THE ACTUAL OPENF OPERATION FOR THE
!	$OPEN MACRO. IT IS CALLED ONLY FROM "OPEN" AND "CREATE".
!	IT ALSO PERFORMS SOME MINIMAL CHECK TO MAKE SURE
!	THAT THE DEVICE IS A PROPER ONE FOR THE FILE.
!	THESE CHECKS ARE PERFORMED HERE ONLY BECAUSE THERE
!	ARE CERTAIN ERRORS WHICH WILL PREVENT THE FILE FROM
!	BEING OPENED SUCCESSFULLY, SO IT IS BETTER IF WE
!	CAN GIVE THE USER AN INTELLIGENT ERROR MESSAGE,
!	INSTEAD OF ONE FROM THE MONITOR.


! INPUT:
!	GTJFNBITS =	BITS FOR GTJFN JSYS

! OUTPUT:
!	<STATUS=TRUE ALWAYS>
!


GLOBAL ROUTINE OFILE ( GTJFNBITS ) =
BEGIN
	ARGUMENT (GTJFNBITS,VALUE);			! BITS TO USE IN GTJFN JSYS

REGS;

LOCAL
    TEMP,
    MASK,			! MASK BITS FOR DEV FIELD
    OPENBSZ,			! BYTE SIZE TO USE FOR THE OPENF
    OPENBITS,			! TEMP TO SETUP OPENF BITS
%IF TOPS10 %THEN
    FILBLKPTR,
    FOPARG: VECTOR[$FOPPN],	!ALLOC FILOP ARG BLK
    FILBLK: VECTOR[$RBELB],	!LOOKUP BLK
    LUKBLK: VECTOR[$RBELB],   !SIZE IS $RBSTS + 1
    PATHBLK: VECTOR[14],	!FOR SFD'S IN FILE SPEC
    DELBLK: VECTOR[$RBSIZ],	!FOR DELETING FILE DURING CREATE
    RENBLK: VECTOR[$RBSIZ],	!FOR DELETING FILE
%FI
    FILEDESC;


%IF TOPS10 %THEN
MAP FILBLKPTR:	POINTER;
%FI

	TRACE ( 'OFILE' );

	! RELEASE 1 SUPPORTS A NEW MODE: "TRANSPARENT" READ.
	! THIS IS DESIGNATED BY FABFAC=0 AND FABSHR IGNORED, AND MEANS
	! ALLOW READ NO MATTER WHAT.

	IF .FAB [FABFAC] EQL AXNIL		!TRANS READ? THEN
	THEN .FAB [FABSHR] = AXNIL;		!SHARING IRRELEV

	%([ IF HE DIDN'T GIVE US A JFN, THEN WE MUST GET ONE ])%


	%([	ALLOCATE SOME CORE FOR FST TO SET UP 3 FIELDS	])%


	IF (FST = CALLGMEM(PCI(FSTSIZE))) IS FALSE
	THEN
		RETURNSTATUS(ER$DME);

	%IF TOPS10 %THEN
	IF .FAB [FABSHR] NEQ 0			!S-U NOT SUPPORTED ON 10
	THEN USERERROR (ER$FAC);		!TELL USER

	FOPARG[$FOBRH] = 0;			!NO BUFFERS (ALWAYS DUMP MODE)
	FOPARG[$FONBF] = 0;			!DITTO
	CLEAR (FILBLK[$RBCNT],$RBELB);		!ZERO FILBLK

	IF ( USERJFN = .FAB [ FABJFN ] ) IS ZERO  
	THEN	BEGIN
		AC2 = .FAB[FABFNA];			! GET JFN/STRING POINTER

		%([ IF THE ADDRESS OF THE FILE-NAME IS ZERO IN THE
		   LEFT HALF, MAKE IT INTO AN ASCII BYTE POINTER. ])%

		IF .AC2<LH> IS ZERO			!IF WHOLE WORD PTR
		THEN	AC2 = POINT (.AC2, 36, 7 );	! MAP TO ASCII PTR

		AC1 = $CALLM(PAR10FS, .AC2, FOPARG, FILBLK, PATHBLK);
		IF .AC1 NEQ TRUE			!PARSE FILE SPEC SUCCESSFULLY?
		THEN USERERROR(ER$FSI);

	END %( OF IF .FAB [ FABJFN ] IS ZERO )%

	ELSE	BEGIN %(HE IS GIVING US HIS OWN JFN...CHECK IT OUT)%
		ERROR (ER$JFN);			!NOT SUPPORTED ON 10
	END; %(OF ELSE...)%

	%([ WE MUST NOW DETERMINE THE DEVICE CHARACTERISTICS OF THIS FILE ])%

	DVFLGS = $CALL (DEVCHAR, .FOPARG[$FODEV]);	!GET DEVICE FLAGS (20 FORMAT)


	MASK = ZERO;				! CLEAR DEVICE FLAG
	IF ( ( .FAB [ FABFAC ] AND AXGET ) NEQ 0 )
	THEN MASK = DVIN;			! DEVICE CAN DO INPUT

IF .DVFLGS [ DEVTYPE ] IS DVTTY 
THEN BEGIN				!DEVICE IS TTY
	IF .FAB[FABFAC] NEQ AXPUT	!ONLY PUTS ALLOWED TO TTY
	THEN USERERROR ( ER$DEV );
	FDBWORD1 = ZERO;		!SET ENVIR FOR $OPEN/DOOPEN
END
ELSE BEGIN				!NOT TTY
	FOPARG[$FOIOS] = $IODMP;	!SET DISK DATA MODE
	IF ( ( .FAB [ FABFAC ] AND AXWRT ) ISNT ZERO )
	THEN BEGIN				! AN OUTPUT MODE?
		MASK = .MASK OR DVOUT;		! MUST BE OUTPUT DEVICE
		IF .FAB [ FABSHR ] ISNT AXNIL
		THEN	Openbits = $FOMAU	!SIMUL UPD
		ELSE	OPENBITS = $FOSAU;	! EXCL UPD
	END
	ELSE OPENBITS = $FORED;		!READ ACCESS

	IF ( .DVFLGS AND .MASK ) ISNT .MASK	!DEVICE CAPAB OK?
			OR
	  ( .DVFLGS [ DEVTYPE ] ) IS DVMTA %(MTA)%
	THEN					!NO, CANT DO OPERATION
		 USERERROR ( ER$DEV );

	IF CURRENTJSYS IS C$CREATE
	THEN BEGIN			!MANUALLY SUPERSEDE FILE IF REQ
		IF CHKFLAG(FAB [FABFOP], FOPSUP) ISON
		THEN	BEGIN
			FOPARG[$FOFNC] =  FO$PRV OR FO$ASC OR $FODLT;
					!BY DELETING EXIST FILE
			FOPARG[$FOLEB] = RENBLK^18 OR DELBLK;
					! SUBSID BLKS FOR DELETE
			MOVEWORDS (FILBLK, DELBLK, $RBSIZ);
						!MOVE TO TEMP SPOT
			DELBLK[$RBCNT] = RB$DSL OR ($RBSIZ-1);
			RENBLK = 0;	!TELL MONITOR TO "ZERO" FILE
			AC1 = $FOPPN^18 OR FOPARG;
			IF NOT UUO (1, FILOP$(AC1))
			THEN	IF .AC1 ISNT ERFNF_ 
				THEN
					MAPSYSTEMCODE(%(DEFA)% ER$CEF, %(TAB)%  OPNERRTAB);
			FOPARG[$FOLEB] = FILBLK; !RESET NORM VAL
		END;
	END;

	%([ TRY TO OPEN THE FILE ])%

	IF CURRENTJSYS IS C$CREATE
	THEN FILBLK[$RBCNT] = RB$DSL OR $RBSTS	!SET CNT AND NO LIB
	ELSE 
        FILBLK[$RBCNT] = RB$AUL OR $RBSTS;	!SET CNT & UPD IN LIB OK

! 8/11/86 asp - Add code to do lookup to get rib status to avoid wiping ABU
	FOPARG[$FOFNC] = FO$PRV OR FO$ASC OR $FORED; !DO LOOKUP 4 OLD RIBSTS
	FOPARG[$FOLEB] = LUKBLK;
	MOVEWORDS(FILBLK,LUKBLK,$RBSTS+1);   !COPY OVER FILBLK
	AC1 = $FOPAT^18 OR FOPARG;		!ARG BLK PTR
 	UUO ( 1, FILOP$(AC1) );                 !IF FAIL, ERR CODE IN AC1
	TEMP = .FOPARG<18,9>;   	! get channel
	TEMP = (.TEMP^18 OR $FOREL);	! channel and function
	AC1 = 1^18 OR TEMP;             ! ARG BLK PTR
	UUO( 1, FILOP$(AC1) );		! DROP IT LIKE A BAD HABIT
        FILBLK[$RBSTS] = .LUKBLK[$RBSTS];     ! SAVE RIB STATUS

	TEMP = ( .FILBLK[$RBSTS] OR RP$RMS );
	FILBLK[$RBSTS] = .TEMP;		!INDIC RMS FILE
	FOPARG[$FOLEB] = FILBLK;		!CLEAR RENAME BLK
	FOPARG[$FOFNC] = FO$PRV OR FO$ASC OR .OPENBITS;

	AC1 = $FOPPN^18 OR FOPARG;		!ARG BLK PTR
	IF NOT UUO ( 1, FILOP$(AC1) )		!IF FAIL, ERR CODE IN AC1
	THEN
! 4/13/87 asp - add code to release channel
		BEGIN
		MASK = .AC1;	! SAVE ERR STS FOR MAPSYSTEMCODE, GROSS
		TEMP = .FOPARG<18,8>;	! get channel
		TEMP = (.TEMP^18 OR $FOREL);	! channel and function
		AC1 = 1^18 OR TEMP;	! ARG BLK PTR
		UUO( 1, FILOP$(AC1) );		! DROP IT LIKE A BAD HABIT
		AC1 = .MASK;	! RESTORE ERR STS
		MAPSYSTEMCODE ( %(DEFAU)% ER$COF,%(TAB)%   OPNERRTAB );
		END;

	OAFLAGS = ABRCLOSE;			! REMEMBER TO CLOSE FILE ON ERRS



%([**	SAVE SOME IMPORTANT VALUES FROM THE EXTENDED LOOKUP BLOCK   **])%


	FILBLKPTR = FILBLK;			! SET UP ADDRESS
	DATELASTACC = .FILBLKPTR [$RBEXT,0,15];
	CREATIME = (.FILBLKPTR [ $RBEXT,15,3 ]) OR (.FILBLKPTR [ $RBPRV,0,12 ]);
	SIZEOFFILE = .FILBLKPTR [ $RBSIZ,WRD ];

	%([**	END OF SAVE	**])%

	USERJFN = .FOPARG<18,8>;		!PICKUP JFN ASSIGNED
	FDBWORD1 = ZERO;			! START CLEAR
	IF .FILBLK [$RBSIZ] EQL 0		!NO GOOD WAY TO TELL IF FILE CRE
	THEN SETFLAG (FDBWORD1,FDBNXF);		!SO, EQUATE 0 LEN FILE TO CREATE
						!MAKES RESTRICTION: CANT $OPEN 0 ELN FILE
						!MUST $CREATE WITH FB$CIF SET
END;						!NOT TTY

	%FI	!END IF TOPS10

%IF TOPS20 %THEN

	IF ( USERJFN = .FAB [ FABJFN ] ) IS ZERO  
	THEN
		BEGIN

		AC2 = .FAB[FABFNA];		! GET JFN/STRING POINTER

		%([ IF THE ADDRESS OF THE FILE-NAME IS ZERO IN THE
		   LEFT HALF, MAKE IT INTO AN ASCII BYTE POINTER. ])%

		IF .AC2<LH> IS ZERO			!IF WHOLE WORD PTR
		THEN	AC2 = POINT (.AC2, 36, 7 );	! MAP TO ASCII PTR
		AC1 =(.GTJFNBITS OR GJ_SHT );		! GET THOSE JFN BITS
		JSYS_FAIL ( GTJFN ) 	%([ TRY TO GET A JFN ])%
		THEN					!JSYS FAILED
			MAPSYSTEMCODE ( %(DFAU)% ER$CGJ, %(TAB)%  OPNERRTAB );

		USERJFN  = .AC1;				! SAVE JFN IN GLOBAL LOCATION
	END %( OF IF .FAB [ FABJFN ] IS ZERO )%

	ELSE	BEGIN		 %(MUST BE OK JFN NOT YET ASSOC WITH OPEN FILE)%
		AC1 = .USERJFN;		!GET STATUS FROM MON TO FIND OUT
		AC2 = ZERO;
		DO_JSYS ( GTSTS);
		IF ( .AC2 AND GS_NAM ) IS OFF  OR  (.AC2 AND GS_OPN) ISNT OFF
		THEN ERROR ( ER$JFN );
	END; %(OF ELSE...)%


	OAFLAGS = ABRCLOSE;		! REMEMBER TO CLOSE FILE ON ERRORS

	%([ WE MUST NOW DETERMINE THE DEVICE CHARACTERISTICS OF THIS FILE ])%

	DVFLGS = $CALL (DEVCHAR, .USERJFN);	!GET DEVICE FLAGS (20 FORMAT)

	%([ AT THIS POINT, WE MUST READ THE FDB OF THIS FILE
	   IN ORDER TO DETERMINE WHAT "CLASS" THE FILE BELONGS
	   TO ( I.E., IT IS EITHER A RMS-FILE OR AN ASCII-FILE ).
	   HOWEVER, FOR NON-DISK FILES, THIS WILL OBVIOUSLY NOT WORK,
	   SO WE WILL CLEAR THE LOCAL VARIABLE "FDBWORD1" FIRST,
	   TO MAKE SURE THAT THE CHECK BELOW RESULTS IN THIS FILE
	   BEING CLASSIFIED AS AN ASCII FILE	])%

	FDBWORD1 = ZERO;					! CLEAR FOR NON-DISK
	IF .DVFLGS [ DEVTYPE ] IS DVDSK %(DISK)%
	THEN	BEGIN
		AC1 = .USERJFN;			!FILE TO CHK
		AC2 = 1^18 OR FDBCTL;		!# OF WORDS & STARTING PT
		AC3 = ADDR(FDBWORD1);		!ADDR OF BLK TO STORE DATA AT
		DO_JSYS (GTFDB)
	END;

	%([ WE NOW MUST DETERMINE IF THIS IS AN RMS-20 FILE.
	   IF SO, WE CAN OPEN IT IN 36-BIT MODE. IF NOT (I.E.,
	   IT'S A STREAM OR LSA FILE, THEN WE MUST OPEN IT IN
	   7-BIT MODE SO THE MONITOR EOF POINTER DOESN'T GET
	   ROUNDED UP TO THE NEAREST FULL WORD. ])%

	OPENBSZ = RMSBYTESIZE;			! ASSUME RMS FILE
	IF .FDBWORD1 [ FDBCLS ] ISNT CLSRMS
	THEN	%(USE 7-BIT MODE)%
		OPENBSZ = ASCIIBYTESIZE;

	%([ SET UP THE REGISTERS FOR THE OPENF JSYS ])%


	%([ NOW, SET EACH BIT IN AC2 TO INDICATE ACCESS ])%

	MASK = ZERO;				! CLEAR DEVICE FLAG
	IF ( ( .FAB [ FABFAC ] AND AXGET ) NEQ 0 )
	THEN MASK = DVIN;			! DEVICE CAN DO INPUT


	%([ SET UP THE FILE BYTE SIZE, AND SET THE READ AND
	   "DON'T UPDATE TO DISK" BITS. ])%
	%([ ***NOTE THAT SEQUENTIAL/RELATIVE FILES WILL
	   NOT BE UPDATED TO DISK AUTOMATICALY BY RMS*** ])%

	Openbits = (.OPENBSZ ^ OPFBSZLSH ) + OF_RD + OF_DUD + OF_THW;
							! AVOID FUNNY MONITOR RULES BY ALW OPENING THAWED

	IF ( ( .FAB [ FABFAC ] AND AXWRT ) ISNT ZERO )	! IF AN OUTPUT MODE
	THEN	BEGIN
		MASK = .MASK OR DVOUT;			! MUST BE OUTPUT DEVICE
		SETFLAG ( Openbits, OF_WR )		! SET WRITE BIT IF WE WILL WRITE FILE
	END;

	%([ CHECK FOR SOME QUICK DEVICE ERRORS ])%

	IF ( .DVFLGS AND .MASK ) ISNT .MASK		! CANT DO OPERATION
			OR
	    ( .DVFLGS [ DEVTYPE ] ) IS DVMTA %(MTA)%
	THEN USERERROR ( ER$DEV );

	AC2 = .OPENBITS;
	AC1 = .USERJFN;
	JSYS_FAIL ( OPENF )				!OPEN FILE
	THEN	MAPSYSTEMCODE ( %(DEFAU)% ER$COF,%(TAB)%   OPNERRTAB );

%FI	!END IF TOPS20
	%([ NOW, WE MUST SET THE DEVICE CHARAC FLAGS IN THE USER'S FAB ])%

	MASK = ZERO;						! COLLECT BITS HERE
	IF ( ( .DVFLGS AND DVDIR ) ISON ) THEN MASK = DEVMDI;	! DIRECTORY DEVICE
	TEMP = .DVFLGS [ DEVTYPE ];				! GET DEVICE CLASS
	IF .TEMP IS DVMTA THEN SETFLAG ( MASK, DEVSQD );	! SEQUENTIAL DEVICE
	IF .TEMP IS DVTTY THEN SETFLAG ( MASK, DEVTRM );	! TERMINAL
	IF ( .TEMP GEQ DVLPT )
		AND
	   ( .TEMP LEQ DVTTY )					! LPT,CDR, OR TTY
	THEN
		BEGIN
		SETFLAG ( MASK, DEVREC );			! RECORD DEVICE
		IF .TEMP ISNT DVCDR THEN SETFLAG ( MASK, DEVCCL )
		END; %( OF IF TEMP GEQ DVLPT...)%

	FAB [ FABDEV ] = .MASK;					! RETURN FLAGS TO USER

	GOODRETURN						! RETURN OK

END; %( OF OFILE )%



! DOOPEN
! ======

! ROUTINE TO COMPLETE THE OPENING OF A FILE FOR RMS-20.
!	THIS ROUTINE DOES NOT ACQUIRE A JFN OR OPEN THE
!	FILE. HOWEVER, IT PERFORMS ALL OTHER FUNCTIONS
!	NECESSARY TO SET UP A FILE FOR LATER PROCESSING.
!
!	THIS ROUTINE IS CALLED ONLY ON A $OPEN MACRO OR
!	A $CREATE MACRO WHEN THE "CREATE IF" BIT IS SET
!	IN THE FILE OPTIONS (FOP) FIELD AND THE FILE DOES
!	NOT EXIST.
!
!	THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE:
!
!		1.	LOCK THE FILE
!		2.	MAP IN PAGE ZERO OF THE FILE (DISK ONLY)
!		3.	RMS FILES: READ THE PROLOGUE
!			NON RMS-FILES: DETERMINE IF ASCII OR LSA
!		4.	UPDATE THE USER'S FAB
!		5.	SET UP THE FST
!		6.	CHECK FOR ERRORS IN USER CALL
!		7.	FOR INDEXED FILES, PROCESS REST OF PROLOGUE

! INPUT:
!	<NONE>

! OUTPUT:
!	<NO STATUS RETURNED>

! ROUTINES CALLED:
!	FILEQ
!	OABORT
!	SETFST
!	PPAGE
!	GPAGE

GLOBAL ROUTINE DOOPEN: NOVALUE  =
BEGIN

REGS;

LOCAL
    DSTATUS,		! TO HOLD 'DISPFILE' STATUS
    TEMP,
    FIRSTWORD,
    FILEHEADER;
MAP
    TEMP:	POINTER;
MAP
    FIRSTWORD:	FORMAT;

	TRACE ('DOOPEN');

	%([ WE MUST NOW KEEP TRACK OF WHAT OPERATIONS HAVE BEEN
	   PERFORMED DURING THE OPEN PROCESSING, SO THAT IF A PROBLEM OCCURS LATER,
	   WE CAN UN-WIND EASILY. THIS IS DONE BY SETTING A BIT IN
	   "OAFLAGS" FOR EACH OPERATION WHICH WE MIGHT NEED
	   TO UNDO LATER.  FOR STARTERS, NOTE THAT THE
	   FILE IS OPEN AND MUST BE CLOSED ON AN ERROR: ])%

	OAFLAGS = ABRCLOSE;

	! LOCKING POSSIB APPLIC IF DISK FILE...
	! LOCKING APPLIES UNLESS TRANS READ

	%IF TOPS20 %THEN			!FOR V1 AT LEAST, NO LOCKS ON 10
	IF ( .DVFLGS [ DEVTYPE ] IS DVDSK  ) AND .FAB [ FABFAC ] ISNT AXNIL
	THEN BEGIN
		TEMP = ENQBLK;			! ASSUME WE WILL BLOCK
		IF ( .FAB [ FABFOP ] AND FOPWAT ) IS OFF
		THEN TEMP = ENQAA;		! NOPE, ALLOC ONLY IF AVAIL.
		$CALLOS (ER$FLK, (CALLFILEQ ( PCI (ENQCALL) , LCI (TEMP) )) );

		%([ INDICATE THAT WE HAVE LOCKED THE FILE FOR UN-WINDING ])%
		SETFLAG ( OAFLAGS, ABRUNLOCK )
	END;
	%FI					!END TOPS20 LOCKS

	%([ PROCESS PROLOGUE: ])%

	%([ WE MUST NOW READ THE FIRST WORD OF THE FILE IN
	   ORDER TO MAKE SURE THAT IT IS A PROPER RMS-20 FILE,
	   OR TO DETERMINE WHETHER THIS IS AN ASCII OR A SEQUENCED
	   FILE.  HOWEVER, FOR CARRIAGE-CONTROL DEVICES, WE DONT
	   WANT TO DO THIS. THEREFORE WE MUST
	   FIRST CLEAR THE LOCAL VARIABLE TO MAKE SURE THAT THIS
	   FILE IS TREATED AS AN ASCII FILE ( I.E. BIT 35 WILL BE OFF ) ])%


	FIRSTWORD = ZERO;						! FOR C-C DEVICES

	%([ IS THIS A DISK? ])%

	IF .DVFLGS [ DEVTYPE ] IS DVDSK %(DISK)% 
	THEN
		BEGIN %(TO READ 1ST WORD TO DETERMINE FILE-TYPE)%

		%([ GET A FREE PAGE FROM THE FREE STORAGE MANAGER ])%

		IF ( PLOGPAGE = CALLGPAGE ( PCI ( 1 ) ) ) IS FALSE
		THEN 
			$EXIT (OABORT, PCI ( ER$DME ) );

		%([ INDICATE TO THE ABORT ROUTINE THAT WE HAVE THIS PAGE ])%

		SETFLAG ( OAFLAGS, ABRPLOGPAGE );

		%([ IF THE FILE IS NULL (I.E., PAGE 0 DOESN'T EXIST),
		   THEN THE NEXT INSTRUCTION WILL GENERATE AN
		   ILLEGAL READ ERROR. THUS, WE MUST MAKE SURE THE
		   PAGE EXISTS BEFORE WE TRY TO READ IT. ])%

		IF $CALL (PAGEXIST, .USERJFN, ZERO) 
		THEN BEGIN				!PAGE 0 EXISTS
			$CALL	(PAGIN,			!MAP PROLOG IN
				%(JFN)%		.USERJFN,
				%(PAGE)%	0,
				%(INTO)%	.PLOGPAGE,
				%(ACCESS)%	AXGET,
				%(COUNT)%	1 );

			FPT = .PLOGPAGE ^ P2W;		!SET UP PTR TO PROLOG
			FIRSTWORD = .FPT [ WHOLEWORD ];	!GET 1ST WD OF FIL
		END;

	END; %(OF IF .DVFLGS [ DEVTYPE ] IS DVDSK)%

	%([ FOR RMS-10, JUST CHECK HEADER WORD DIRECTLY ])%

	%([ WE MUST DETERMINE IF THIS FILE IS ONE WHICH WAS
	   CREATED BY RMS-20.  THIS IS INDICATED BY THE
	   "FILE CLASS" FIELD IN THE FDB. IF THIS IS AN
	   RMS-20 FILE, THEN WE MUST READ IN THE FILE
	   DESCRIPTIVE INFORMATION CONTAINED IN THE FILE
	   PROLOGUE AND USE IT TO DETERMINE IF THE USER
	   HAS MADE ANY ERRORS, AND MOVE SOME OF ITS
	   CONTENTS INTO THE USER'S FAB. ])%


	IF .FIRSTWORD [ BLOCKTYPE ] IS FPBLOCK
	THEN	%(COPY PROLOGUE DATA TO FAB)%

		BEGIN

		%([ MAKE SURE THIS IS A DISK FILE ])%

		IF .DVFLGS [ DEVTYPE ] ISNT DVDSK
		THEN %(AN RMS FILE MUST EXIST ON DISK)%
			$EXIT (OABORT, PCI ( ER$DEV ) );

		%([ NOW, UPDATE THE USER PARAMETER SECTION  OF THE FAB ])%
		FAB [ FABORG ] = .FPT [ FPTORG ];		! FILE ORGANIZATION
		FAB [ FABRAT ] = .FPT [ FPTRAT ];		! FILE ATTRIBUTES
		FAB [ FABMRS ] = .FPT [ FPTMRS ];		! MAX RECORD NUMBER
		FAB [ FABMRN ] = .FPT [ FPTMRN ];		! MAX FILE SIZE
		FAB [ FABBSZ ] = .FPT [ FPTBSZ ];		! BYTE SIZE
		FAB [ FABBKS ] = .FPT [ FPTBKS ];		! BUCKET SIZE
		FAB [ FABRFM ] = .FPT [ FPTRFM ];		! RECORD FORMAT
	END %( OF IF CLASS = RMS )%
	ELSE
		BEGIN %( TO CLEAR FAB PARAMETERS FOR ASCII FILES )%
		RTRACE (%STRING('	CLEARING FAB FOR ASCII...',%CHAR(13),%CHAR(10)));
		IF .FIRSTWORD [ BLOCKTYPE ]  IS FPBLOCK THEN
			BEGIN
			FILEPROBLEM ( FE$BFC );			! BAD FILE CLASS
			USEREXIT
			END;

		%([ IS THIS AN LSA FILE? ])%

		IF ( .FIRSTWORD AND BITN ( 35 ) ) ISON
		THEN
			TEMP = RFMLSA				! SEQUENCED IF BIT 35
		ELSE
			TEMP = RFMSTM;				! ASCII STREAM FILE

		%([ FOR LSA FILES, WE MUST CHANGE THE FILE BYTE SIZE
		   BACK TO 36, SINCE WE NEED TO READ IT IN BINARY MODE ])%

	%IF TOPS20 %THEN
		IF ( FAB [ FABRFM ] = .TEMP ) IS RFMLSA
		THEN %( WE NEED TO DO SOME SPECIAL STUFF )%
			BEGIN
			AC1 = .USERJFN;
			AC2 = RMSBYTESIZE;
			DO_JSYS ( SFBSZ);
		END; %( OF ELSE BIT 35 IS ON )%
	%FI

		FAB [ FABORG ] = ORGSEQ;			! SET ASCII FILE ORGANIZATION
		FAB [ FABMRS ] = ZERO;				! CLEAR SOME UNNEEDED LOCATIONS
		FAB [ FABMRN ] = ZERO;
		FAB [ FABRAT ] = ZERO;
		FAB [ FABBSZ ] = ASCIIBYTESIZE			! RESET IF ASCII
		END; %( OF ELSE CLAUSE FOR STREAM FILES )%



	%([ SET UP THE FILE-STATUS TABLE ])%

	IF CALLSETFST IS FALSE THEN				! INITIALIZE A FILE-STATUS TABLE
		$EXIT (OABORT, GCI ( USRSTS ) );

	%([ SET THE FLAG THAT WE HAVE GOTTEN CORE FOR THE FST ])%

	SETFLAG ( OAFLAGS, ABRFST );

	%([ SET THE FLAG WHICH INDICATES THAT THE FILE IS LOCKED ])%
	IF CHKFLAG ( OAFLAGS, ABRUNLOCK ) ISON
	THEN
		SETFLAG ( FST [ FSTFLAGS ], FLGFLOCKED );

	%(( CHECK FOR ALL ERRORS IN OPEN/CREATE REQUEST ))%

	IF 	CALLFERROR IS FALSE
	THEN $EXIT (OABORT, GCI ( USRSTS ) );

	%([ DISPLAY THE FILE CHARACTERISTICS IF THE USER HAS
	   GIVEN US AN XAB CHAIN TO FILL IN ])%


	%([ IF THIS IS AN INDEXED FILE, WE MUST PROCESS THE
	   REST OF THE FILE PROLOGUE. WE DID NOT PERFORM THE
	   FUNCTION EARLIER IN THE OPEN PROCESSING BECAUSE THERE
	   WAS NO INFORMATION THAT WE NEEDED, AND FLUSHING THE
	   INTERNAL BLOCKS, ETC. IS A PAINFUL OPERATION. THUS,
	   WE ONLY PROCESS THE REST OF THE PROLOGUE ONLY AFTER
	   WE HAVE PERFORMED ALL NORMAL CHECKING OPERATIONS
	   ON THE FILE. ])%

	%IF INDX %THEN

	IF IDXFILE
	THEN %(PROCESS THE REST OF THE FILE PROLOGUE)%

		BEGIN

		%([ FIRST, READ IN THE AREA DESCRIPTOR BLOCK ])%
		IF CALLREADADB ( GPT ( FPT ) ) IS FALSE
		THEN
			$EXIT (OABORT, GCI ( USRSTS ) );

		%([ REMEMBER THAT WE HAVE PROCESSED THE ADB ])%

 		FST [ FSTADB ] = .ADB;			! SAVE ADDRESS IN FST
		SETFLAG ( OAFLAGS, ABRADB );


		%([ NEXT, SET UP ALL KEY DESCRIPTORS AND LINK THEM TO THE FST ])%

		IF CALLSETKDB ( GPT ( FPT ) ) IS FALSE
		THEN
			$EXIT (OABORT, GCI ( USRSTS ) );

		END; %(OF IF IDXFILE)%

	%FI

	%([ IF THE USER HAS GIVEN US AN XAB CHAIN, WE
	   FILL IT IN FOR HIM. ])%

	IF .FAB [ FABXAB ] ISNT ZERO
	THEN
		BEGIN
		IF (DSTATUS = CALLDISPFILE) ISNT TRUE
		THEN
			BEGIN
			USRSTS = .DSTATUS;	! SAVE RESULT
			$EXIT (OABORT, GCI ( USRSTS ) );
			END %(OF IF ERROR ON DISPFILE)%
		END; %(OF IF FABXAB ISNT ZERO)%

	%([ IF THIS IS A DISK FILE, WE MUST GIVE BACK THE
	   FREE PAGE WHICH WE GOT EARLIER TO READ IN THE
	   FILE PROLOGUE ])%

	IF DASD
	THEN
		CALLPPAGE (	%(PAGE #)%	GCI ( PLOGPAGE ),
				%(COUNT)%		PCI ( 1 ),
				%(DESTROY)%	PCI ( TRUE ) );	! MUST UN-MAP PAGE

	%([ FINALLY, RETURN THE FILE-ID OF THIS FILE TO THE USER'S FAB ])%
	FAB [ FABIFI ] = .FST;					! RETURN FILE-ID
	FAB [ FABJFN ] = .USERJFN;				! SET IT IN FAB
	RETURN

END; %(OF DOOPEN)%

END
ELUDOM