Trailing-Edge
-
PDP-10 Archives
-
704rmsf2
-
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 + 0^18 + 22; !EDIT DATE: 23-MAR-79
%([
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 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.
***** 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
%([ 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