Trailing-Edge
-
PDP-10 Archives
-
BB-JF18A-BM
-
sources/rms/rmsfil.b36
There are 6 other files named rmsfil.b36 in the archive. Click here to see a list.
%TITLE 'F I L E S -- prologue handlers'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE files (IDENT = '2.0'
) =
BEGIN
!
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 1986.
! ALL RIGHTS RESERVED.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
! COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
! THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
! ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
! AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE
! SOFTWARE IS HEREBY TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
! NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
! EQUIPMENT CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
! ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY: RMS
!
! ABSTRACT:
!
! FILES contains all routines which create and
! process the prologue blocks within RMS-20 files.
!
! ENVIRONMENT: User mode
!
! AUTHOR: Ron Lusk , CREATION DATE: 31-Mar-83
!
! MODIFIED BY:
!
! Ron Lusk, 8-Jul-83 : VERSION 2
! 417 - Fix calculation of WINPAGEGLOBAL in DOKEYBLOCKS (and DOAREABLOCKS
! if necessary). The global page number is calculated to be
! sect#,,page# (i.e., 2,,666) rather than 0,,global-page# (0,,2666).
! This is causing the process handle on a PMAP to change from
! .FHSLF (400000) to 400002.
!
!--
!
! TABLE OF CONTENTS
!
!
! SETPLOG - Create a File Prologue Block
! IDXFILEPROLOG - Create the indexed file prologue
! DOAREABLOCKS - Create the area descriptors
! DOKEYBLOCKS - Create the index descriptors
! GETIDB - Locate an Index Descriptor Block
!
! INCLUDE FILES:
!
REQUIRE 'rmsreq';
!
! MACROS:
!
! None.
!
! EQUATED SYMBOLS:
!
! None.
!
! OWN STORAGE:
!
! None.
!
! EXTERNAL REFERENCES:
!
! None.
!
%SBTTL 'SETPLOG - create prologue'
GLOBAL ROUTINE setplog =
!++
! FUNCTIONAL DESCRIPTION:
!
! SETPLOG creates a file prologue in free core when an
! RMS-20 file is initially created. The prologue does
! not include the end-block. The prologue is not
! written out to the file until after the $CREATE is
! determined to have been successful.
!
! The file prologue is always written at the address
! contained in the global variable FPT.
!
! All fields in the File Prologue which are common for
! all file organizations are initialized by this
! routine. Fields which are used only for indexed
! files (area, adboffset, keys, idboffset) are set up
! by the corresponding routine (DOAREABLOCKS or
! DOKEYBLOCKS) when the rest of the prologue
! structures are created. All reserved fields in this
! block are automatically zeroed because the page on
! which this page is being created is a new file page.
!
! FORMAL PARAMETERS
!
! None.
!
! IMPLICIT INPUTS
!
! FPT - address of the file prologue in core
!
! ROUTINE VALUE:
!
! None.
!
! SIDE EFFECTS:
!
! ?
!
!--
BEGIN
LOCAL
temp,
endptr : REF BLOCK;
TRACE ('SETPLOG');
fpt [blocktype] = fpblock; ! Set file code
fpt [blocklength] = fptsize; ! And size
fpt [fptrfm] = .fab [fabrfm, 0]; ! Record format
fpt [fptbsz] = .fab [fabbsz, 0]; ! Byte-size
fpt [fptbks] = .fab [fabbks, 0]; ! Use bucket size in FAB
fpt [fptorg] = .fab [faborg, 0]; ! Organization
fpt [fptrat] = .fab [fabrat, 0]; ! Attributes
fpt [fptmrs] = .fab [fabmrs, 0]; ! Maximum record size
fpt [fptmrn] = .fab [fabmrn, 0]; ! Maximum file size
!+
! Note that the NXTBKT field in the prologue is set by
! DOKEYBLOCKS, when each Index descriptor block is
! initially created.
!
!
! The other fields are already clear because this is a new
! file page.
!
! Set up the end block for Sequential/Relative files.
!-
endptr = .fpt + .fpt [blocklength]; ! Adjust new pointer
endptr [wholeword] = endblock^leftlsh + endblocksize;
RETURN true;
END; ! End of SETPLOG
%SBTTL 'IDXFILEPROLOG -- index prologue routine'
GLOBAL ROUTINE idxfileprolog =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is used to create all blocks within the
! File Prologue which are unique to indexed files.
! This routine creates the following blocks:
! 1) Area Descriptors
! 2) Index Descriptors
!
! FORMAL PARAMETERS
!
! None.
!
! IMPLICIT INPUTS
!
! PLOGPAGE - Number of free page which contains
! the first page of the file prologue.
!
! COMPLETION CODES:
!
! TRUE - Success
! FALSE - Error
! No free pages found for multi-page
! prologue.
!
! SIDE EFFECTS:
!
! ?
!
!--
BEGIN
LOCAL
window_number, ! Page number of file window
file_page_number; ! File Prologue Page
TRACE ('IDXFILEPROLOG');
!+
! Set up the page number of the current prologue.
!-
file_page_number = 0; ! Always start on page 0
window_number = .plogpage; ! Find where Prologue is
!+
! Create the Area Descriptors.
!-
doareablocks (window_number, file_page_number);
!+
! Create all Index Descriptor Blocks.
!-
RETURN dokeyblocks (.window_number, .file_page_number)
END; ! End of IDXFILEPROLOG
%SBTTL 'DOAREABLOCKS - Set up FPT Area Descriptors'
GLOBAL ROUTINE doareablocks ( ! Set up Area Descriptors
p_window_number, ! Prologue's memory page
p_file_page_number ! Prologue's file page (0)
) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! DOAREABLOCKS creates the Area Descriptors in the
! prologue of an indexed file.
!
! FORMAL PARAMETERS
!
! WINDOW_NUMBER - Page where prologue is currently
! mapped
! FILE_PAGE_NUMBER - File page number of the File
! Prologue (always 0).
!
! IMPLICIT INPUTS
!
! ?
!
! ROUTINE VALUE:
!
! None.
!
! SIDE EFFECTS:
!
! ?
!
!--
BEGIN
BIND
window_number = .p_window_number,
file_page_number = .p_file_page_number;
REGISTER
movingptr : REF BLOCK, ! Temporary pointer variable
adbptr : REF BLOCK, ! Area descriptor pointer
areaindex, ! Index for ADB
prologptr : REF BLOCK, ! File Prologue pointer
default_bucket_size, ! Default size of the bucket
areacount; ! Count of area descriptors
LOCAL
xabptr : REF BLOCK; ! Pointer to user XAB
TRACE ('DOAREABLOCKS');
!+
! Set up the pointers.
!-
prologptr = .window_number^p2w; ! Pointer to window
adbptr = .prologptr [blocklength] + .prologptr;
!+
! Create a null header for this block.
!-
adbptr [wholeword] = (adbcode^blktypelsh);
areacount = 1; ! Start off with 1 area
!+
! Create the default area.
!-
default_bucket_size = .fab [fabbks, 0]; ! Get user's bucket size
IF .default_bucket_size EQL 0 ! Did he use default?
THEN
default_bucket_size = defbucketsize; ! Yes - set up default
adbptr [.areacount, adbbkz] = ! Store BKZ in first ADB
.default_bucket_size;
!++
! Note that the Area ID is already 0 so we don't have to
! set it.
!--
!+
! Create an entry for each ADB.
!-
xabptr = .fab [fabxab, 0]; ! Get first XAB
UNTIL .xabptr EQL 0 DO
BEGIN
xabptr = .xabptr OR .blksec; ! Get global address
IF .xabptr [xabcod, 0] EQL codarea ! Do only for
! area allocation XABs
THEN
BEGIN
areaindex = (.areacount*areadescsize) + 1;
areacount = .areacount + 1; ! Bump the number of areas
IF (adbptr [.areaindex, adbbkz] = .xabptr [xabbkz, 0]) EQL 0
THEN ! Use the default bucket size
adbptr [.areaindex, adbbkz] = .default_bucket_size
END;
!+
! Fetch address of next XAB in chain.
!-
xabptr = .xabptr [xabnxt, 0] ! Advance XAB
END;
!+
! Fill in the length of the ADB in the block header.
!-
adbptr [blocklength] = ! Add 1 for header size
(.areacount*areadescsize) + 1;
!+
! Fill in some prologue information about the ADB.
!-
prologptr [fptareas] = .areacount; ! Fill in number of areas
prologptr [fptadb] = .adbptr; ! And address of ADB offset
RETURN ! No status returned
END; ! End of DOAREABLOCKS
%SBTTL 'DOKEYBLOCKS -- Set up IDBs'
GLOBAL ROUTINE dokeyblocks (window_number, file_page_number) =
!++
! FUNCTIONAL DESCRIPTION:
!
! DOKEYBLOCKS creates the index descriptors which ar
! put in the prologue of an indexed file.
!
! Each index descriptor contains all information which
! is required by RMS-20 to process a record according
! to the particular key.
!
! The chain of Index Descriptor Blocks begins
! immediately following the Area Descriptors in the
! File Prologue. Each IDB is linked to the next one.
!
! FORMAL PARAMETERS
!
! WINDOW_NUMBER - process page into which file
! prologue is mapped.
! FILE_PAGE_NUMBER - file page number of prologue
!
! IMPLICIT INPUTS
!
! ?
!
! COMPLETION CODES:
!
! TRUE - OK
! FALSE - Error
! No free pages left for multi-page prologue
!
! SIDE EFFECTS:
!
! ?
!
!--
BEGIN
LOCAL
multipageflag,
xabptr : REF BLOCK,
prologptr : REF BLOCK,
idbptr : REF BLOCK,
winpageglobal, ! Global window page
! (includes section number)
lastidbptr : REF BLOCK,
idbcount,
idblen; ! Number of words in an IDB
TRACE ('DOKEYBLOCKS');
!+
! Assume that this is a one-page prologue.
!-
multipageflag = false;
!+
! Set up some pointers.
!-
prologptr = .window_number^p2w;
winpageglobal = .window_number OR (.rmssec^w2p); ! Global page !M417
idbptr = .prologptr [blocklength] + .prologptr; ! Hop over file data
idblen = .idbptr [blocklength] + .idbptr; ! Hop over area blocks
idbptr = .idblen; ! Otherwise BLISS clobbers it?
lookat (' ADDR OF IDB: ', idbptr);
!+
! Make File Prologue point to IDBs.
!-
prologptr [fptidb] = .idbptr; ! Fill in prologue
idbcount = 0; ! Clear key counter
lastidbptr = 0; ! Show this is first
!+
! We will now scan the XAB chain.
!-
xabptr = .fab [fabxab, 0]; ! Get chain address
UNTIL .xabptr EQL 0 DO ! Scan for key XABs
BEGIN
xabptr = .xabptr OR .blksec; ! Get global pointer
!+
! Check if this is a key XAB.
!-
IF .xabptr [xabcod, 0] EQL codkey ! Key XAB?
THEN
BEGIN
!+
! Create an Index Descriptor Block.
!-
makeidb (.prologptr, ! Pointer to IDB
.idbptr, ! Index descriptor
.xabptr); ! XAB
!+
! Make this IDB point to where the next IDB is likely to go.
!-
idblen = .idbptr [blocklength]; ! Get an IDB's length
idbptr [idbnxt] = ! Build pointer
(.file_page_number^p2w) + ((.idbptr + .idblen) AND ofsetmask);
lastidbptr = .idbptr; ! Save for possible
! alternate IDBNXT
idbptr = .idbptr + .idblen; ! Point at next one
!+
! Is there room for one more IDB on this page? If the end
! of the next possible IDB doesn't fit on this page, then
! we have to map a new page for the prologue.
!-
IF ((.idbptr + .idblen)^w2p) NEQ (.window_number) !
THEN
BEGIN ! Yes, we will overlap
! onto the next page
file_page_number = .file_page_number + 1; ! Bump page
lastidbptr [idbnxt] = .file_page_number^p2w;
!+
! Do we need a new page?
!-
IF .multipageflag EQL false
THEN
BEGIN
multipageflag = true;
rtrace (%STRING ( !
' Allocating extra prologue page...', !
%CHAR (13), %CHAR (10))); !
IF (window_number = gpage (1)) EQL false !
THEN
RETURN false
ELSE
winpageglobal = .window_number OR (.rmssec^w2p);!M417
END
ELSE
pagout ( ! Flush previous page
.fst [fstjfn], ! JFN
.file_page_number - 1, ! To
.winpageglobal, ! From
1); ! Count of pages
!+
! Now, map the next page into our window.
!-
pagin (.fst [fstjfn], ! JFN
.file_page_number, ! From
.winpageglobal, ! To
axupd, ! Access
1); ! Count of pages
idbptr = .window_number^p2w;
END;
idbcount = .idbcount + 1 ! BUMP COUNT
END;
!+
! Fetch the next XAB in the chain.
!-
xabptr = .xabptr [xabnxt, 0] ! Go to next XAB
END;
!+
! Clear the "next" pointer in the last IDB we made.
!-
IF .lastidbptr NEQ 0 THEN lastidbptr [idbnxt] = 0;
!+
! If we allocated an extra page for the prologue, then
! write it out (the first page will be written out later).
!-
IF .multipageflag
THEN
BEGIN
pagout (.fst [fstjfn], ! JFN
.file_page_number, ! To
.winpageglobal, ! From
1); ! Count of pages
ppage (.window_number, 1, true)
END;
!+
! We have now created all Index Descriptor Blocks.
!
! We must now store the key count in the File Prologue.
!-
prologptr [fptkeys] = .idbcount;
lookat ('# OF IDB-S:', idbcount);
!+
! Also, reset the NXTBKT field if we had a
! multi-page prologue.
!-
prologptr [fptnxtbkt] = (.file_page_number + 1);
!+
! Set up file size and adjust the "official" EOF.
!-
fst [fstsof] = .prologptr [fptnxtbkt]^p2w;
adjeof (.fst [fstjfn], .fst [fstsof], false);
RETURN true
END; ! End of DOKEYBLOCKS
%SBTTL 'MAKEIDB - create an index descriptor'
GLOBAL ROUTINE makeidb ( ! Create an IDB
prologptr : REF BLOCK, ! Prologue address
idbptr : REF BLOCK, ! IDB's address
xabptr : REF BLOCK ! Corresponding XAB
) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! MAKEIDB creates a single Index Descriptor Block in
! the prologue of an indexed file. Each descriptor
! completely describes the characteristics of a
! particular record key. Each XAB which is used to
! ceate these descriptors has already been checked for
! errors.
!
! The general structure of an Index Descriptor Block
! is:
!
! Header (1 word)
! Generated information (fixed-length)
! User XAB (variable length)
! Key name (6 words)
!
! The following fields are set up by this routine:
!
! BLOCKTYPE
! BLOCKLENGTH
! LEVELS (assumed to be 0 because this is
! a new page)
! All fields fetched from the XAB
! KEY-NAME
!
! The following fields are *not* set up by this
! routine and are listed with a description of who
! sets them up:
!
! ROOT - when the root is initially
! allocated.
! NXTIDB - when the next IDB is created
! (by DOKEYBLOCKS)
!
!
!
! FORMAL PARAMETERS
!
! PROLOGPTR - start of file prologue
! IDBPTR - place to write IDB
! XABPTR - user XAB
!
! IMPLICIT INPUTS
!
! ?
!
! ROUTINE VALUE:
!
! None.
!
! SIDE EFFECTS:
!
! ?
!
!--
BEGIN
REGISTER
movingptr : REF BLOCK,
sizeofxab,
tempac;
LOCAL
temp;
MAP
tempac : BLOCK [1];
TRACE ('MAKEIDB');
!+
! Set the size of this XAB
!-
sizeofxab = .xabptr [blocklength];
!+
! Fill in header of IDB.
!-
idbptr [blockheader] = !
(idbcode^blktypelsh) + .sizeofxab + idbsize;
!++
! We will now move the entire user's XAB into this block.
! Note that we assume that all fields are initially zero
! (since this is a virgin file page), so we don't have to
! clear any fields.
!--
movingptr = .idbptr + idbxaboffset; ! Point to XAB
!+
! Move the entire XAB into the file IDB.
!-
IF .rmssec NEQ 0
THEN
xcopy (.xabptr, ! From
.movingptr, ! To
.sizeofxab) ! Size
ELSE
movewords (.xabptr, ! From
.movingptr, ! To
.sizeofxab); ! Size
xabptr = .movingptr; ! Reset the pointer to the
! new XAB position
!+
! We have now moved the XAB in. We must check if there is
! a key-name and, if so, move it to this ADB.
!-
IF (tempac = .xabptr [xabknm, 0]) NEQ 0
THEN
BEGIN
!
! Default to section number of the FAB
!
IF .tempac<lh> EQL 0 !
THEN
tempac = .tempac OR .blksec;
IF .rmssec NEQ 0
THEN
xcopy (.tempac, ! From
.movingptr + .sizeofxab, ! To
keynamesize) ! Size
ELSE
movewords (.tempac, ! From
.movingptr + .sizeofxab, ! To
keynamesize) ! Size
END;
!+
! If debugging, dump the IDB.
!-
begindebug (dbblocks) !
bugout(%STRING ('*Dump of IDB *: ', %CHAR (13), %CHAR (10))); !
dumpidb (.idbptr); !
enddebug; !
RETURN
END; ! End of MAKEIDB
%SBTTL 'GETIDB - locate an IDB'
GLOBAL ROUTINE getidb (bktdesc : REF BLOCK) =
!++
! FUNCTIONAL DESCRIPTION:
!
! GETIDB locates an Index Descriptor Block in the file
! prologue of an indexed file. This routine assumes
! that the global KDB is set to point to the current
! Key Descriptor Block. This routine will locate the
! associated index descriptor and return a pointer to
! it. It is the caller's responsibility to flush the
! bucket descriptor which is returned.
!
! Locking is **never** done for the File Prologue.
!
! FORMAL PARAMETERS
!
! BKTDESC - Address of caller's bucket descriptor.
!
! IMPLICIT INPUTS
!
! ?
!
! ROUTINE VALUE:
!
! FALSE - error
! Not False - address in core of index descriptor
!
! SIDE EFFECTS:
!
! ?
!
!--
BEGIN
LOCAL
filebucket : BLOCK [1]; ! Bucket of index descriptor
REGISTER
fileaddress, ! Address of the IDB
idbptr : REF BLOCK;
TRACE ('GETIDB');
!+
! Fetch the address of the index descriptor on disk.
!-
fileaddress = .kdb [kdbidbaddr]; ! Get address
filebucket = (.fileaddress^w2p)^p2b; ! Convert to bucket number
!+
! Get the bucket which contains this IDB.
!-
IF getbkt (.filebucket, ! Bucket number
1, ! Bucket size
false, ! Lock flag
.bktdesc) EQL false ! Bucket descriptor
THEN
RETURN false; ! Return FALSE on error
!+
! Form an in-core pointer to the Index Descriptor.
!-
idbptr = (.bktdesc [bkdbktadr]) OR (.fileaddress AND ofsetmask);
RETURN .idbptr
END; ! End of GETIDB
END ! End of Module FILES
ELUDOM