Google
 

Trailing-Edge - PDP-10 Archives - BB-JF18A-BM - sources/rms/rmsdsi.b36
There are 6 other files named rmsdsi.b36 in the archive. Click here to see a list.
%TITLE 'DSI -- initialize data structures'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE dsi (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:
!
!	DSI contains routines which initialize internal
!	data structures within RMS-20.
!
! ENVIRONMENT:	User mode, interrupts deferred until JSYS return.
!
! AUTHOR: Ron Lusk , CREATION DATE: 18-Mar-83
!
! REVISION HISTORY:
! RMS EDIT
!	Ron Lusk, 9-May-83 : VERSION 2
! 404	-   SETFST - No locking if FB$SMU is set (DSI edit 401)
!     
! 411	-   FENDOFKEY - Handle variable-byte-size records.
!
! 427   -   SETKDB - Do not touch KSD's
!
!	Andrew Nourse, 14-Jan-1985 : VERSION 3
! 504   -   Image mode
! 550	-   If an FFF file class if found (file class < 0), then
!	    use the non-RMS file organization FST$K_NON. (RL)
!--

!
! TABLE OF CONTENTS
!
!
!	SETFST	    -	Set up a File Status Table
!	SETRST	    -	Set up a Record Satus Table
!	READADB	    -	Read in the Area Descriptor Block
!	SETKDB	    -	Set up a Key Descriptor Block
!	FENDOFKEY   -	Compute the End-of-Key byte
!			number for SETKDB
!	UNDOKDBS    -	Flush a partially processed
!			KDB list
!
!
! INCLUDE FILES:
!

REQUIRE 'rmsreq';

!
! MACROS:
!
!   None.
!
! EQUATED SYMBOLS:
!

GLOBAL BIND
    dsiv = 2^24 + 0^18 + 401;			! Module version number

MAP
    dvflgs : monword;

!
! OWN STORAGE:
!
!   None.
!
! EXTERNAL REFERENCES:
!
!   None.
!
%SBTTL 'SETFST - initialize File Status Table'

GLOBAL ROUTINE setfst =

!++
! FUNCTIONAL DESCRIPTION:
!
!	SETFST initializes the contents of the File Status
!	Table.  It is called only from the $OPEN and $CREATE
!	processors when a file is initially opened for
!	processing.  It takes all relevant values from the
!	user's File Access Block (FAB) and moves them into
!	the FST.  Note that the FAB must contain all the
!	important information at this time...the File
!	Prologue is not read at all.
!
!	Note:  In order to make selection statements based
!	on file organization work more easily (as in
!	"CASE .fileorg ..."), this routine will set up a
!	special code if the file contains stream or LSA
!	format records.  If so, the file organization field
!	(FSTORG) will be set to ORGASC instead of the
!	sequential organization given by the user.
!	Therefore, after this routine exits, the original
!	file organization given by the user is lost.  A
!	quick check is made by this routine to make sure
!	that the user's file organization value is not
!	ORGASC already.
!
!	Note further that the block of storage which is
!	allocated for the FST is cleared by GMEM.  Thus,
!	there are several source statements in this routine
!	which clear certain fields and are commented out.
!	They are included only to make it clear which fields
!	are being manipulated.
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	FAB	-   FAB must point to the user's File Access
!		    Block.  Data from the FAB is copied to
!		    the FST.
!	FST	-   assumes that the FST has been allocated
!		    and that the length of the FST is
!		    already in the BLOCKLENGTH field of the
!		    FST.
!	FPT	-   the File Prologue must be mapped and
!		    pointed to by FPT.
!
! COMPLETION CODES:
!
!	TRUE	-   FST initialized
!	FALSE	-   Error
!		    Invalid file organization specified
!
! SIDE EFFECTS:
!
!	If there are no errors, then the FST will be
!	    initialized.
!	If the file organization specified in the user's FAB
!	    is invalid, USRSTS is set to ER$ORG, and the FST
!	    is deallocated.
!
!--

    BEGIN

    REGISTER
	flags;

    TRACE ('SETFST');
!+
!   Check the file organization value to make
!   sure it is in the proper range.  If it is,
!   then set up the FST properly; if not, give
!   an error return.
!-

    CASE .Fab [Fab$v_Org] FROM Fab$k_Seq TO Fab$k_Idx OF		  !m504
	SET

	[OUTRANGE] : 				! Illegal organization
!+
!   The user gave us a bad file
!   organization, so give him an error.
!-
	    returnstatus( Rms$_Org );

	[Fab$k_Seq] :
!+
!   Non-RMS files have a
!   special internal "file organization",
!   ORGASC (0), so set it up that way.
!-
	    BEGIN

	    IF .fst [fst$h_file_class] lss 0	! FFF file?		!A550
	    then				! 			!A550
		fst [fst$h_org] = fst$k_non	! Non-RMS organization	!A550
	    else
		begin
		Fst [Fst$h_Org] =		!m504
		  ( CASE .fab [Fab$v_Rfm]	! 
		    FROM  Fab$k_Var TO Fab$k_Rfm_Max OF
		    SET
		    [Fab$k_Stm,     ! Stream format
		     Fab$k_Lsa,	! LSA format
		     Fab$k_Udf]:    !
			Fst$k_Non;     ! Non-RMS organization
		    [INRANGE]:
			Fst$k_Seq;	! Normal sequential org.
		    [OUTRANGE]:
			ReturnStatus( Rms$_Rfm );
		    TES );
		    end;
	    END;

	[INRANGE] :
	    !
	    !   No special handling for REL, IDX
	    !
	    Fst [Fst$h_Org] = .Fab [Fab$v_Org];
	TES;

!+
!   Fill in all fields in the FST.
!-
    fst [blocktype] = fstcode;			! Type of block
    fst [blocklength] = fstsize;		! And size [this is redundant;
    						!   the length is set in
    						!   RMSOPN]
    fst [blink] = .fst;				! Link this FST to itself
    fst [flink] = .fst;				!   and again...
    fst [fstjfn] = .userjfn;			! Save JFN
!+
!   We must now determine if we are going to lock this file
!   during its access.  This locking will be done only if there
!   is a writer of the file, and the file is not open for
!   exclusive access; locking is disabled when FB$SMU is set
!   in the FAC field, allowing LIBOL to handle locking itself.
!-
    flags = 0;					! Assume no locking

    IF rmsfile
    THEN

	IF ((.fab [fabfac, 0] AND fb$smu) EQL 0) AND 	! RMS locking	!M404
	    (((.fab [fabshr, 0] AND axwrt) NEQ 0) OR 	! If others will write
	    ((.fab [fabfac, 0] AND axwrt) NEQ 0))	! Or we will write
	THEN
	    flags = flglocking;			! We will lock each record

    						! Unless...

    IF .fab [fabshr, 0] NEQ axnil		! Nil sharing anyway?
    THEN
	fst [fstflags] = .flags;		! Sharing, so set locking

!+
!   We must now get some fields from the file prologue.
!   However, if the file is null (i.e., an empty ASCII file),
!   then we cannot even touch the page or we will get a read
!   trap.
!-

    IF rmsfile
    THEN
	BEGIN
!+
!   We must now set the LOBYTE field to be the start of the data
!   space of the file.  This information is necessary in order
!   to set the file EOF pointer on a $CLOSE, and to check a
!   user's RFA to make sure it is within the data space of the
!   file.
!-
	fst [fstlobyte] = 			! Start of records
	.fpt [blocklength] + endblocksize;
	END;

!   fst [fsthybyte] = 0;			! Clear these fields...
!   fst [fstflags] = 0;				! Store flags
    fst [fstfac] = .fab [fabfac, 0];
    fst [fstshr] = .fab [fabshr, 0];
!+
!   If the user specified NIL in the FAC field,
!   then we allow him to read and do no locking.
!-

    IF (.fab [fabfac, 0] EQL axnil) OR 		! NIL access	    !M404
	(.fab [fabfac, 0] EQL fb$smu)		! NIL with SMU set  !A404
    THEN
	fst [fstfac] = axget;			! Transparent read

    fst [fstrat] = .fab [fabrat, 0];
    fst [fstmrs] = .fab [fabmrs, 0];		! Maximum record size
    fst [fstmrn] = .fab [fabmrn, 0];		! Maximum record number
    fst [fstbsz] = .fab [fabbsz, 0];		! Byte size
    fst [fstrfm] = .fab [fabrfm, 0];		! Record format
    fst [fstfop] = .fab [fabfop, 0];		! File processing options
    fst [fstdevtype] = .dvflgs [dv_typ];	! Store device class
!+
!   We must now set up the KBFSIZE field, which represents the
!   size (in words) of a buffer which must be allocated on the
!   $CONNECT to hold the current key value (indexed files only).
!   However, the KDB information has not been set up yet, so we
!   will not fill in this field.  SETKDB will compute the value
!   and store it in the FST.
!-
!+
!   Fill in minimum number of buffers;
!   RMS requires at least this many.
!-
    fst [fstminbuf] = (				! Base count on organization
    CASE fileorg FROM orgasc TO orgidx OF
	SET
	[orgasc] : minbufasc;			! ASCII
	[orgseq] : minbufseq;			! RMS sequential
	[orgrel] : minbufrel;			! Relative
	[orgidx] : minbufidx			! Indexed
	TES);
!+
!   Fill in number of buffers to allocate.
!   (RMS should run "better" with more buffers.)
!   (Note that this field is the default number of
!   buffers.  The user may override by specifying
!   MBF in the RAB.)
!
!   Note that the number of buffers used for an indexed file is
!   a constant plus the maximum number of levels in any of the
!   indexes within the file.  This value is not known until we
!   process the File Prologue completely and set up the KDBs.
!   Therefore, we will not add in the MAXLEVEL value until later
!   when we set up all the KDBs.
!-
    fst [fstnumbuf] = (				!
    CASE fileorg FROM orgasc TO orgidx OF
	SET
	[orgasc] : numbufasc;			! ASCII
	[orgseq] : numbufseq;			! RMS Sequential
	[orgrel] : numbufrel;			! Relative
	[orgidx] : numbufidx;			! Indexed (increment later
						!   by number of levels in
						!   the file).
	TES);
!+
!   Fill in buffer size.
!
!   Note that this field will be filled with the
!   value 1 for now.  If this is an indexed file,
!   then the actual buffer size will be set later
!   when the Index Descriptors are read in.
!-
    fst [fstbufsiz] = defbufsiz;
    RETURN true
    END;					! End of SETFST
%SBTTL 'SETRST - initialize Record Status Table'

GLOBAL ROUTINE setrst =

!++
! FUNCTIONAL DESCRIPTION:
!
!	SETRST initializes the contents of the Record Status
!	Table.  This routine is called only from the
!	$CONNECT processor.  [It may, at some time in the
!	future, be called by a $REWIND processor.] It sets
!	up all the values in the Record Status Table,
!	including the Next-Record-Pointer.
!
!	Again, as in SETFST, the block allocated for the RST
!	is cleared by GMEM; some expressions which would
!	normally zero fields are therefore commented out,
!	although they are left for documentation.
!
!	Unlike SETFST (which expects to find an allocated
!	File Status Table waiting for it where FST is
!	pointing), SETRST itself will call GMEM to allocate
!	the core for the Record Status Table.  This is
!	because the actual amount allocated for the table
!	depends on the number of buffers allocated to the
!	record stream (see the opening code below).
!
! FORMAL PARAMETERS
!
!	None.
!
! IMPLICIT INPUTS
!
!	FST	-   the File Status Table is referenced to
!		    determine the number of buffers needed
!		    and the file organization.
!	RAB	-   the user's Record Access Block is read
!		    for buffer count and initial key of
!		    reference.
!	KDBs	-   The KDBs are checked to ensure that a
!		    valid key of reference has been chosen.
!
!
! COMPLETION CODES:
!
!	TRUE	-   Success
!	FALSE	-   Dynamic memory exhausted, or
!		    Bad key of reference
!		    (Error code in USRSTS.)
!
! SIDE EFFECTS:
!
!	FST [FSTSEQBKT] is set to -1 for ASCII files.
!
!	Core is allocated for the RST.
!
!	Core is allocated for the Key buffer.
!
!	Core is allocated for the file buffers.
!
!--

    BEGIN

    REGISTER
	tempac;					! Temporary AC

    LOCAL
	bytesword,
	keybuffsize,				! Size of the key buffer
	bufferpage,				! Page # of first buffer page
	totalpages,				! Number of buffer pages
	wordcount,
	bfdptr : REF BLOCK,			! Current buffer descriptor
	numbuf,					! Number of buffers to allocate
	enufbuf,				! Minimum buffers to allocate
	bufsiz,					! Pages per buffer
	eofbyte,				! Byte number of the EOF
	actrstsize,				! Actual size of this RST
	keyofref,				! Key of reference
	temp;

!
!   The meaning of the following comment is unclear, but
!   it is left for future generations to ponder.
!				- RL, March '83
!
!?! When not all buffers can be allocated
!
    TRACE ('SETRST');
    !
    !   Compute number buffers, size of buffer, etc.
    !
    enufbuf = .fst [fstminbuf];			! Minimum we must allocate
    bufsiz = .fst [fstbufsiz];			! Pages per buffer

    IF (numbuf = .rab [rabmbf, 0]) EQL 0	! Did user specify a count?
    THEN
	numbuf = .fst [fstnumbuf]		! No -- use default
    ELSE
	numbuf = MAX (.numbuf, .enufbuf);	! Yes -- but use

    						!   at least ENUFBUF
!+
!   The actual size of the RST is the size
!   of the basic structure itself plus
!   twice the number of buffers, for the
!   vector of buffer descriptors and the
!   vector of Least Recently Used values.
!-
    actrstsize = rstsize + 2*.numbuf;		! Compute actual RST size
!+
!   Allocate core for the RST.
!-

    IF (rst = gmem (.actrstsize)) EQL false	! Get core
    THEN
	returnstatus (er$dme);

!+
!   For indexed files, RABKRF must refer to an
!   existing key of reference.
!-

    IF idxfile
    THEN
	BEGIN
	rst [rstnrpref] = (keyofref = .rab [rabkrf, 0]);	! Fetch it
!+
!   Does a KDB exist for this key number?
!-

	IF getkdb (.keyofref) EQL false		! Locate KDB
	THEN
	    BEGIN
	    pmem (.actrstsize, rst);		! Free the memory
	    returnstatus (er$krf)		! Bad KRF
	    END;

	END;

    !
    !   Set up initial values.
    !
    rst [rstbfdcount] = .numbuf;		! Number of buffers
    rst [blocktype] = rstcode;			! Block-type code
    rst [blocklength] = .actrstsize;		! Length of an RST
    rst [rstfst] = .fst;			! Store address of FST
!	RST [ RSTRSZ ] = 0;			! These are commented out
!	RST [ RSTRSZW ] = 0;			!   as noted above
!	RST [ RSTDATARFA ] = 0;			!   in the routine
!	RST [ RSTFLAGS ] = 0;			!   description.
!	RST [ RSTLASTOPER ] = 0;		! Ditto
!	RST [ RSTBYTECOUNT ] = 0;		! Ditto
!+
!   For indexed files, we must now allocate a buffer to hold the
!   current key.  This buffer must be as large as the largest
!   key string defined for the file.  The size of this largest
!   key is kept in the FST.
!-
    keybuffsize = .fst [fstkbfsize];		! Get the size

    IF .keybuffsize NEQ 0
    THEN
	BEGIN
	lookat ('	KEY-BUFF-SIZE :', keybuffsize);
!+
!   If we can't get enough core for the keybuffer,
!   flush the RST and return ER$DME.
!-

	IF (rst [rstkeybuff] = gmem (.keybuffsize)) EQL false
	THEN
	    BEGIN
	    pmem (.actrstsize, 			! Size of RST
		rst);				! Location of RST
	    returnstatus (er$dme)
	    END

	END;

!++
!   Allocate buffers
!--

!+
!   Perform this loop until we either get a contiguous
!   buffer which is big enough, or we get below the
!   ENUFBUF value.
!-

    DO
	BEGIN
	!
	!   Try to get the buffer pages.
	!
	totalpages = .numbuf*.bufsiz;
!+
!   If we can't get enough, then release
!   the RST and the key buffer.
!-

	IF (bufferpage = gpage (.totalpages)) EQL false AND 	!
	    (numbuf = .numbuf - 1) LSS .enufbuf
	THEN
	    BEGIN
	    temp = .rst [rstkeybuff];		! Address of key buffer

	    IF .keybuffsize NEQ 0
	    THEN 				! Release key buffer
		pmem (.keybuffsize, 		! Size
		    temp);			! Location

	    pmem (.actrstsize, 			! RST size
		rst);				! Location of RST
	    returnstatus (er$dme)
	    END;

	tempac = .bufferpage
	END
    UNTIL .tempac NEQ false;			! END OF LOOP

!+
!   We now have allocated a big chunk of contiguous buffers.  We
!   must set up the buffer descriptors in the RST so we can use
!   the buffers in single units if we want to.
!-
    bfdptr = bfdoffset;
    rst [rstbfdcount] = .numbuf;		! Set buffer count

    INCR j FROM 1 TO .numbuf DO
	BEGIN
	bfdptr [bfdbpage] = .bufferpage;	! First page of buffer
	bfdptr = .bfdptr + 1;
	bufferpage = .bufferpage + .bufsiz;
	END;

!+
!   Setup buffer pointer for ASCII files.
!-

    IF asciifile                        ! ANY NON-RMS FILE
    THEN
	BEGIN
	!
	!   Form a pointer to the current
	!   bucket descriptor.
	!
	cbd = .rst + rstcbdoffset;		! Point to CBD in RST
!	bfdptr = bfdoffset;			! Form ptr to buf desc
	bfdptr = rst [rstbfd];			! Point to BFD vector
	fst [fstseqbkt] = -1;			! Force positioning on
						!   1st I/O operation
	currentfilepage = -1;			! Indicate no page mapped
	curentbufferadr = 			! Get pointer to buffer
	.bfdptr [bfdbpage]^p2w;
	cbd [bkdbfdadr] = .bfdptr;		! Set current BFD
	cbd [bkdbktsize] = asciibktsize;	! Set bucket size
	END;

!<BLF/PAGE>
!++
!	We are now ready to position the file.
!	There are several distinct cases which must be considered:
!
!	    Organization, access		Technique
!		=========			===
!
!	    Sequential, no appending		NRP = 1st byte after prologue
!
!	    Sequential, appending		NRP = EOF byte
!
!	    Relative, no appending		NRP = 1 (1st record)
!
!	    Relative, appending			<><> ILLEGAL <><>
!
!		Indexed				Undefined ( 0 )
!
!	    Stream, no appending		POSASCFILE (0)
!
!	    Stream, appending			POSASCFILE (EOF byte)
!
!--

!+
!   Determine the EOF byte number.
!-

    IF dasd AND (fileorg NEQ orgrel)		! Disk and not relative file?
    THEN
	eofbyte = sizefile (.fst [fstjfn])	! Yes -- return size of file
    ELSE
	eofbyte = -1;				! Not disk or relative file,

    						!   so no EOF
!+
!   If the file is zero-length, or we are
!   appending (and if this isn't a TTY:),
!   then we are at EOF.
!-

    IF (.eofbyte EQL 0 OR appendoption NEQ 0) AND 	!
	( NOT tty)				! Can't do it to TTY:
    THEN
	setflag (rst [rstflags], flgeof);	! Set EOF flag

    CASE fileorg FROM orgasc TO orgidx OF
	SET

	[orgasc] :
	    BEGIN				! ASCII

	    IF dasd
	    THEN
		BEGIN
!+
!   If RB$EOF is on, we will set the pointer to
!   the EOF.  Otherwise, we must set it to the
!   start of the file since another $CONNECT may
!   have been done to the file.
!-

		IF appendoption EQL 0 THEN eofbyte = 0;

		!
		!   Set pointer to start of file.
		!
		posascfil (.fst [fstjfn], 	! JFN
		    .eofbyte);			! Byte
		END;

	    END;

	[orgseq] :
	    BEGIN				! Sequential

	    IF (appendoption NEQ 0) AND 	! Appending and
		(.eofbyte NEQ 0)		!   non-zero file?
	    THEN
		rst [rstnrp] = .eofbyte		! Yes - point at EOF
	    ELSE
		rst [rstnrp] = .fst [fstlobyte];	! No - look at first

	    					!   byte after prologue
	    END;

	[orgrel] :
	    !
	    !	No choice for relative files
	    !
	    rst [rstnrp] = 1;			! Relative file

	[orgidx] :
	    !
	    !	Undefined for indexed files
	    !
	    rst [rstnrp] = 0;
	TES;

    !
    !	Finally, link the RST to the owning FST
    !
    link (rst, fst);
    RETURN true
    END;					! End of SETRST
%SBTTL 'READADB - read Area Descriptor Block'

GLOBAL ROUTINE readadb (prologptr : REF BLOCK) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	READADB reads in the Area Descriptor Block which is
!	stored in the initial prologue of an indexed file.
!	This routine must simply acquire core for the ADB
!	and transfer it into the new buffer.
!
!	This routine presupposes that all Area Descriptors
!	are contained within page 0 of the file.
!
! FORMAL PARAMETERS
!
!	PROLOGPTR   -	pointer to start of File Prologue
!
! IMPLICIT INPUTS
!
!	?
!
! COMPLETION CODES:
!
!	TRUE	-   OK
!	FALSE	-   Couldn't get core for the ADB
!		    File problem: No ADB
!
! SIDE EFFECTS:
!
!	On return, the location of the in-core
!	Area Descriptor Block will be stored in
!	the global variable ADB.
!
!--

    BEGIN

    REGISTER
	adbptr : REF BLOCK;			! Temporary ADB pointer

    LOCAL
	adblength;				! Length of the ADB

    TRACE ('READADB');
!+
!   First, we must find the location of the Area
!   Descriptors in the Prologue of the file.  This is
!   done by skipping over the initial file block because
!   the Area Descriptors are always the second block in
!   the File Prologue.
!-
    adbptr = 					! Skip over file block
    .prologptr [blocklength] + .prologptr;

    IF .adbptr [blocktype] NEQ adbcode
    THEN
	BEGIN					! We have a screwed-up
						!   File Prologue
	fileproblem (fe$noa);
	RETURN false
	END;

    adblength = .adbptr [blocklength];		! Fill in the length of
    						!   this block
!+
!   We must now allocate some free core for this block.
!-

    IF (adb = gmem (.adblength)) EQL false	! Get core
    THEN
	returnstatus (er$dme);

!+
!   Move the entire ADB into our free core chunk.
!-
    movewords (.adbptr, 			! From
	.adb, 					! To
	.adblength);				! Size
    RETURN true
    END;					! End of READADB
%SBTTL 'SETKDB - create KDB chain'

GLOBAL ROUTINE setkdb (prologptr : REF BLOCK) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	SETKDB reads in the chain of Index Descriptor Blocks
!	(IDBs) from the data file and creates the internal
!	chain of Key Descriptor Blocks (KDBs).  Each KDB is
!	composed of only a summary of the contents of the
!	IDB; only that information which will be needed
!	internally to process a key.  Each KDB is linked to
!	the next in a continuous linear series with a null
!	pointer in the last KDB.
!
!	There are also a few miscellaneous fields which must
!	be set up or altered in the FST by this routine.
!	For example, FSTNUMBUF is altered by adding the
!	number of levels in the deepest index in the file.
!	Also, the FSTKBFSIZE field is set up here to be able
!	to hold the largest key in the file.
!
! FORMAL PARAMETERS
!
!	PROLOGPTR   -	pointer to start of File Prologue
!
! IMPLICIT INPUTS
!
!	?
!
! COMPLETION CODES:
!
!	TRUE	-   OK
!	FALSE	-   Error (code in USRSTS)
!		    No more core
!		    Index bucket size not big enough
!		    No index descriptor in file (FE$NOI)
!
! SIDE EFFECTS:
!
!	FST fields are updated as noted above.
!
!--

    BEGIN

    LOCAL
	lastkdb : REF BLOCK,			! Last KDB we have created
	lastidb,				! Last IDB we have processed
	multipageflag,				! True if multi-page Prologue
	windowpage,				! Page into which we have
						!   mapped Prologue
	filepagenumber,				! Current page of PROLOGUE
	keybytesize,				! Bytesize for this key
	nextkdb,				! Next KDB in our chain
	maxlevels,				! Maximum number of levels
						!   for all indexes
	temp,					! Temporary local[??!!]
	totalsize,				! Total bytes in key string
	keybuffsize,				! Largest key buffer required
	biggestbkz,				! Biggest bucket size
	idbfileaddress,				! Address of IDB in the file
	endofkeybyte,				! Highest byte number
						!   of key string
	adbptr : REF BLOCK,			! Area descriptors
	areanumber,				! Area number for this index
	bucketsize,				! Bucket size for this index
	keysegptr : REF BLOCK,			! Key segment descriptors
	thiskdb : REF BLOCK,			! Current KDB
	idbptr : REF BLOCK,			! Current IDB
	xabptr : REF BLOCK;			! XAB portion of the IDB

    EXTERNAL
	dtptable : BLOCK;			! Key datatype table

    REGISTER
	bltac,
	tempac : BLOCK [1],
	tempac2;

    TRACE ('SETKDB');
    !
    !   We must now clear the pointer the list of KDBs.
    !
    fst [fstkdb] = 0;
    !
    !   Initialize some variables.
    !
    maxlevels = 1;				! Assume at least 1 level
    biggestbkz = 0;				! Largest bucket size
    filepagenumber = 0;
    windowpage = .prologptr^w2p;		! Find where our buffer is
    !
    !   Clear the largest key buffer value.
    !
    keybuffsize = 0;
    !
    !   We must find the first IDB in the File Prologue.
    !
    adbptr = .prologptr [fptadb] + .prologptr;	! Get Area Descriptor
    idbptr = .prologptr [fptidb] + .prologptr;	! ...and Index Descriptor
!+
!   Do a consistency check to see if this is an IDB.
!-

    IF .idbptr [blocktype] NEQ idbcode
    THEN
	BEGIN
	fileproblem (fe$noi);			! No index descriptor
	usrret ()
	END;

    idbfileaddress = 				! Form page 0 address
    (0^p2w) + (.idbptr AND ofsetmask);
    lastidb = (lastkdb = 0);			! Clear KDB address
!+
!   This is the main loop.  We will fetch each
!   IDB in the File Prologue area and create an
!   internal KDB for it.  If at any time our
!   free core runs out, we must unwind all this.
!-
    multipageflag = false;

    WHILE .idbfileaddress NEQ 0 DO
	BEGIN
!+
!   Get some core for a KDB.
!-

	IF (thiskdb = gmem (kdbsize)) EQL false
	THEN 					! We must unwind all KDBs
	    BEGIN
	    undokdbs ();

	    IF .multipageflag THEN ppage (.windowpage, 1, true);

	    returnstatus (er$dme)
	    END;

!+
!   We now are ready to set up the contents of
!   the KDB.  Note that this code could be
!   speeded up a little if certain fields which
!   are in both the IDB and KDB were BLTed
!   instead of moved one at a time.
!-
!+
!   Set up pointer to the XAB portion of the block.
!-
	xabptr = .idbptr + idbxaboffset;	! Make a pointer to
						!   the XAB portion
						!   of the IDB
!+
!   Set up header.
!-
	thiskdb [blockheader] = kdbcode^blktypelsh + kdbsize;
!+
!   Move common fields.
!-
	thiskdb [kdbroot] = .idbptr [idbroot];
	thiskdb [kdbnxt] = 0;			! Clear next pointer
!+
!   Update the maximum number of levels.
!-

	IF .idbptr [idblevels] GTR .maxlevels	!
	THEN
	    maxlevels = .idbptr [idblevels];	!

!+
!   Set up the pointer to the disk address of the IDB.
!-
	thiskdb [kdbidbaddr] = .idbfileaddress;
	!
	!   fill in the datatype of this key, and find
	!   the bytesize which is associated with
	!   that datatype.
	!
	thiskdb [kdbdtp] = .xabptr [xabdtp, 0];	! Get datatype
	keybytesize = .dtptable [.xabptr [xabdtp, 0], dtpbytesize];
	thiskdb [kdbkbsz] = .keybytesize;
	!
	!   Fetch the number of levels in the index.
	!
	thiskdb [kdblevels] = .idbptr [idblevels];
	!
	!   We will now fill in the fields from the
	!   XAB which is embedded within the IDB.
	!
	thiskdb [kdbref] = .xabptr [xabref, 0];
	!
	!   Move the XAB flags to the IDB, and
	!   clear the unused ones.
	!
	temp = .xabptr [xabflg, 0] AND allxabflags;

	IF .thiskdb [kdbroot] EQL 0		!
	THEN
	    setflag (temp, flgnoindex);

	thiskdb [kdbflags] = .temp;		! Store flags
	thiskdb [kdbdtp] = .xabptr [xabdtp, 0];
	!
	!   We will now set up the information about
	!   areas.  We will need to set up the area
	!   number and bucket size of both data and
	!   index buckets, and set up the word
	!   offset into a bucket which represents
	!   the IFL/DFL offset value.
	!
	tempac = .xabptr [xabian, 0];		! Get index area number
	thiskdb [kdbian] = .tempac;		! Store it
	bltac = (				! Set up AC for BLT
	thiskdb [kdbibkz] = 			!  and the bucketsize
	.adbptr [(.tempac*areadescsize) + 1, adbbkz]);	!
	!   If this bucket size is the largest one we have so far,
	!   remember how big it is (for future buffer allocation).
	!
	biggestbkz = MAX (.bltac, .biggestbkz);
	tempac2 = .bltac^b2w;			! Get maximum offset value
!+
!   Set up the index fill limit,
!   if user specified one.
!-

	IF .xabptr [xabifl, 0] GEQ (.tempac2/2)	! Must be 50 percent
	THEN
	    tempac2 = .xabptr [xabifl, 0];

	thiskdb [kdbifloffset] = .tempac2;
!+
!   Now do the data area.
!-
	tempac = .xabptr [xabdan, 0];		! Get data area number
	thiskdb [kdbdan] = .tempac;		! Store it
	bltac = (				!
	thiskdb [kdbdbkz] = 			!
	.adbptr [(.tempac*areadescsize) + 1, adbbkz]);
!+
!   Save the biggest bucketsize.
!-
	biggestbkz = MAX (.bltac, .biggestbkz);
	tempac2 = .bltac^b2w;			! Get maximum offset value

	IF .xabptr [xabdfl, 0] GEQ (.tempac2^divideby2lsh)	!
	THEN
	    tempac2 = .xabptr [xabdfl, 0];

	thiskdb [kdbdfloffset] = .tempac2;
!+
!   Now, set up key position and size.
!-
	movewords (.xabptr + xabksdoffset, 	! From
	    .thiskdb + kdbksdoffset, 		! To
	    maxkeysegs);			! Size
!+
!   We must now compute the total size of the key string (in
!   words).  This value is needed when we allocate key
!   buffers, and when we need to pass over an index record
!   which contains the key string.  We compute this value by
!   summing up the total size of the entire key (from each
!   key segment) and then using the bytesize of the key
!   data-type.
!   If the data is not byte-oriented (and therefore not segmented)
!   we can skip all that, since the size is fixed anyway.
!-

        keysegptr = .xabptr + xabksdoffset;     ! Point to first key segment


        CASE .xabptr [xabdtp,0] FROM 0 to maxdtp OF
             SET
             [dtpstg, dtpsix, dtpebc, dtpas8, dtppac]: ! Byte data
                 BEGIN
                 totalsize = 0;			     ! Initialize counter

                 INCR j FROM 0 TO maxkeysegs - 1     ! Loop over all segments
                 DO
                     BEGIN
                     totalsize = .totalsize + .keysegptr [.j, keysiz]
                     END;
                 END;
             [dtpin4, dtpun4, dtpfl1]:  ! Word data
                      totalsize = 1;                                    !M427
                      
             [dtpin8, dtpfl2, dtpgfl]:  ! Doubleword data
                      totalsize = 2;                                    !M427 
             TES;
!+
!   TOTALSIZE now contains the total number
!   of bytes in the key string.  We must now
!   compute the number of full words this
!   string will occupy.
!-
	lookat ('	TOTALSIZE: ', totalsize);
	thiskdb [kdbksz] = .totalsize;
	tempac = (thiskdb [kdbkszw] = sizeinwords (.totalsize, .keybytesize));

	IF .thiskdb [kdbkszw] GTR .keybuffsize
	THEN 					!
	!
	!	We need a bigger buffer to hold this key
	!
	    keybuffsize = .thiskdb [kdbkszw];

!+
!   We must now insure that the user's index
!   fill offset is large enough to allow a
!   minimum of three index records to be
!   manipulated in the same index bucket.
!   This restriction greatly simplifies the
!   algorithms for splitting the index
!   buckets, so the check should be done
!   here.
!-

	IF (temp = ((.tempac + irhdrsize)*3) + bhhdrsize) GTR 	!
	    .thiskdb [kdbifloffset]
	THEN 					!
	!
	!	Reset the IFL value to be higher
	!
	    thiskdb [kdbifloffset] = .temp;

!++
!		Now, compute the size of the record header.
!		There are three cases which must be considered:
!
!		   Type			Header size
!		   ====			===========
!
!		   Secondary			2
!
!		   Primary,variable		3
!
!		   Primary,fixed		2
!--

!+
!   Assume secondary keys.
!-
	tempac = sidrhdrsize;			! Size of a SIDR record

	IF .thiskdb [kdbref] EQL refprimary
	THEN 					! We have a primary data record
	    BEGIN

	    IF .fpt [fptrfm] EQL rfmfix
	    THEN 				! Fixed-length record
		tempac = fixhdrsize
	    ELSE 				! Variable-length record
		tempac = varhdrsize		! Use different header size
	    END;

	!
	!   Now, store this value in the KDB.
	!
	thiskdb [kdbhsz] = .tempac;
!+
!   We must now compute the minimum size
!   that the record must be in order to
!   fully include this key within the
!   record.  This computation is currently
!   trivial [!] due to the method of addressing
!   keys and the mapping of data-types onto
!   key byte sizes.  Once we have computed
!   this value, then later when a record is
!   inserted into the file and the record
!   size is less than this value, we won't
!   have to insert the record into the index
!   associated with this key string.
!-
	thiskdb [kdbminrsz] = fendofkey (.keybytesize, .keysegptr);
!+
!   We have now created the current KDB.  We must link
!   it into our chain of existing KDBs.
!-

	IF .lastkdb EQL 0			! Is there a "last KDB"?
	THEN
	    fst [fstkdb] = .thiskdb		! No - this is first
	ELSE
	    lastkdb [kdbnxt] = .thiskdb;	! Yes - add to chain

	lastkdb = .thiskdb;			! Update current pointer
	!
	!   Get the address of the next IDB in the file.
	!
	idbfileaddress = .idbptr [idbnxt];	! Bump next IDB pointer
!+
!   Does it span page boundaries?
!-

	IF (.idbfileaddress^w2p) NEQ .filepagenumber
	THEN
	    BEGIN

	    IF .multipageflag EQL false
	    THEN 				! Allocate a new page
		BEGIN
		multipageflag = true;

		IF (windowpage = gpage (1)) EQL false
		THEN
		    BEGIN
		    undokdbs ();
		    returnstatus (er$dme);
		    END

		END;

	    filepagenumber = .idbfileaddress^w2p;
!+
!   Map the File Prologue page in.
!-
	    pagin (.fst [fstjfn], 		! JFN
		.filepagenumber, 		! From
		.windowpage, 			! To
		axupd, 				! Access
		1);				! Count
	    END;

	idbptr = (.windowpage^p2w) OR 		! Use core page #
	(.idbfileaddress AND ofsetmask);	! And file offset
	lookat ('	NEXT IDB-PTR: ', idbptr);
	lookat ('	IDB-FILE-ADDRESS: ', idbfileaddress);
	!
	!   Print out what we've done.
	!

%IF dbug
%THEN
	begindebug (dbblocks)			!
	bugout(%STRING ('*Dump of KDB *: ', %CHAR (13), %CHAR (10)));
	dumpkdb (.thiskdb);
	enddebug;
%FI

	END;

!+
!   Store the key buffer size in the File Status Table.
!   Note that the value which is stored is twice that of
!   of the actual size of the key.  This is because the
!   top of the buffer is used for the actual current key
!   and the bottom half of the buffer is used for
!   temporary storage of the key in the last-record when a
!   bucket splits.
!-
    fst [fstkbfsize] = 2*.keybuffsize;
    !
    !   Set the number of pages in each
    !   file buffer into the FST.
    !
    fst [fstbufsiz] = .biggestbkz;
    !
    !   Add the # of levels into the number of buffers
    !   which this file needs to process correctly.
    !
    fst [fstnumbuf] = .fst [fstnumbuf] + .maxlevels;
!+
!   Release any extra pages we may have gotten.
!-

    IF .multipageflag				!
    THEN
	ppage (.windowpage, 1, true);

    RETURN true
    END;					! End of SETKDB
GLOBAL ROUTINE fendofkey (keybytesize, ksdptr : REF BLOCK) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	FENDOFKEY computes the byte number of the data
!	record which constitutes the last byte in the
!	specified key.  This value is necessary so we will
!	know whether we need to enter a particular record
!	into the index of the particular key.  This
!	computation is somewhat involved, so it is included
!	as a separate routine.
!
! FORMAL PARAMETERS
!
!	KEYBYTESIZE -	bytesize of this key
!	KSDPTR	    -	pointer to the first Key Segment
!			Descriptor in the XAB
!
! ROUTINE VALUE:
!
!	Byte number of last byte in key (expressed in
!	terms of the record's bytesize).
!
!--

    BEGIN                               !R411 Re-write this routine for
                                        !     mixed byte sizes

    LOCAL
	answer,					! Highest byte so far
        end_of_segment,                 	! Rec byte # for End of segment
	keybytesperword,			! Bytes of the key in each word
	recbytesperword,			! Bytes of record in each word
	recordbytesize,				! Byte size of the data record
        keyend,                         	! End of key in key-size bytes
	fullkeywords,				! Words occupied by key
	keybits;				! Bits occupied by key

    TRACE ('FENDOFKEY');
    !
    !   Initialize the final result to zero.
    !
    answer = 0;

    !+
    !   Do this loop, once for each key segment.
    !-
    INCR j FROM 0 TO maxkeysegs - 1 DO
	BEGIN
        !+
        !  Find the position of the end of the key
        !   (in key-byte-size bytes)
        !-
        keyend =  .ksdptr [.j, keypos] + .ksdptr [.j, keysiz];

        !+
        ! Find how many of each kind of bytes fit in a word
        !-
	recordbytesize = .fst [fstbsz];		! Get record byte size
	keybytesperword = %BPUNIT/.keybytesize;	! Key bytes in 1 word    !M411
	recbytesperword = %BPUNIT/.recordbytesize; ! Record bytes / word !M411

	!+
	!   Compute the number of full words to end of the key,
	!   and the bit offset in the word.
        !-
        fullkeywords = .keyend / .keybytesperword;                        !M411
        keybits = (.keyend MOD .keybytesperword) * .keybytesize;          !M411

	!
	!   Let's see some of this stuff.
	!
	lookat ('	KEYBYTESPERWORD:', keybytesperword);
	lookat ('	KEY ENDS AFTER WORD:', fullkeywords);
	lookat ('	KEY-BITS:', keybits);

	!+
	!   Compute minimum record size for this key.
        !   (in record-byte-size bytes)
	!-

	end_of_segment = (.fullkeywords*.recbytesperword)		  !M411
	                 +((.keybits+.recordbytesize-1)/.recordbytesize); !M411
        ! Convert number of full words into record bytes,
        ! and convert number of extra bits into record bytes
        ! The total is the number of record bytes we need to fit this segment

        !+
        !   Check if this key segment is "greater" than the highest one.
        !-
	IF .end_of_segment GTR .answer THEN answer = .end_of_segment

	END;

    lookat ('	Final result from FENDOFKEY: ', answer);
    RETURN .answer
    END;					! End of FENDOFKEY
GLOBAL ROUTINE undokdbs : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	UNDOKDBS gives back all KDB free memory if we
!	couldn't process the File Prologue correctly.
!
! FORMAL PARAMETERS
!
!	None.
!
! IMPLICIT INPUTS
!
!	FST [FSTKDB] - pointer to KDB chain.
!
! ROUTINE VALUE:
!
!	None.
!
! SIDE EFFECTS:
!
!	The free memory for the KDBs is freed.
!
!--

    BEGIN

    LOCAL
	thiskdb : REF BLOCK,
	nextkdb : REF BLOCK;

    TRACE ('UNDOKDBS');
    thiskdb = .fst [fstkdb];

    WHILE .thiskdb NEQ 0 DO
	BEGIN
	nextkdb = .thiskdb [kdbnxt];		! Save address of next KDB
	pmem (kdbsize, thiskdb);		! Release memory
	thiskdb = .nextkdb			! Advance our pointer
	END;

    RETURN
    END;					! End of UNDOKDBS

END						! End of Module DSI

ELUDOM