Trailing-Edge
-
PDP-10 Archives
-
704rmsf2
-
10,7/rms10/rmssrc/rmsdsi.b36
There are 6 other files named rmsdsi.b36 in the archive. Click here to see a list.
MODULE DSI =
BEGIN
GLOBAL BIND DSIV = 1^24 + 0^18 + 22; !EDIT DATE: 5-APR-77
%([
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
THIS MODULE CONTAINS ROUTINES WHICH INITIALIZE INTERNAL DATA
STRUCTURES WITHIN RMS-20.
*** TABLE OF CONTENTS ***
ROUTINE FUNCTION
======= ========
SETFST SET UP A FILE STATUS TABLE
SETRST SET UP A RECORD STATUS 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
REVISION HISTORY:
EDIT DATE WHO PURPOSE
==== ==== === =========
1 7-9 SEB ADD SETKDB,READADB,FENDOFKEY
2 7-14 SEB SET NOINDEX BIT IF ROOT IS 0
3 7-22 SEB CALL GETWINDOW FROM SETRST, NOT GTBYTE
4 9-22 SEB MODIFY FENDOFKEY FOR NEW KEY RULES
5 9-24 SEB ADD NEW idx MACROS
6 9-29 SEB ADD MAXLEVELS CHANGES
7 9-30 SEB MAKE SETKDB CHECK FOR 3 KEYS PERS BKT
8 10-2 SEB CLEAR TEMP IN SETRST SO idx FILE EOF IS SET RIGHT
9 11-7 SEB TAKE OUT CHECK FOR MININDEX RECS IN SETKDB
10 11-NOV SEB MAKE SETRST CHECK BAD KRF FOR idx FILES
11 7-JAN SEB IN SETFST, ACCESS FPT ONLY FOR RMS FILES
12 27-JAN SEB FIX ERROR IN FENDOFKEY IF SIZ=0
13 28-JAN SEB CHANGE MINIMUM VALUE OF "MAXLEVELS" TO 1
14 1-FEB SEB DON'T ALLOW IFL .LSS. 3 INDEX RECORDS (SETKDB)
15 23-FEB SEB MAKE MIN VALUE FOR IFL,DFL TO BE 50 PERCENT
16 25-FEB SEB MAKE BUFFER ALLOCATION CONTIGUOUS IN RST
17 1-MAR SEB MAKE LOCK-MODES INTO A FLAG BIT
18 11-MAR SEB ADD 1 BYTE FOR CHECK-BYTE FOR REL FILES IN SETRST
19 23-MAR SEB UNDO EDIT 18
20 30-MAR SEB REMOVE LINK AND DELINK
21 5-APR SEB TAKE OUT RSTRSZW, RSTEOF IN SETRST
*************************************************
* *
* NEW REVISION HISTORY *
* *
*************************************************
****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************
PRODUCT MODULE SPR
EDIT EDIT QAR DESCRIPTION
====== ====== ===== ===========
100 22 Dev Make declarations for routine names
be EXTERNAL ROUTINE so RMS will compile
under BLISS V4 (RMT, 10/22/85).
***** END OF REVISION HISTORY *****
])%
%([ FORWARD DECLARATIONS ])%
%(< FORWARD DECLARATIONS FOR FENDOFKEY,UNDOKDBS ARE IN ROUTINES>)%
%([ EXTERNAL DECLARATIONS ])%
%( The following external declarations are in the expansion
of the CALL macros. )%
!EXTERNAL
! CRASH,
! DUMP,
! GMEM,
! GPAGE,
! GTBYTE,
! PMEM,
! PPAGE;
%([ ERROR CODES WITHIN THIS MODULE ])%
EXTERNAL
MSGFAILURE; ! A ROUTINE FAILED
REQUIRE 'RMSREQ';
EXTDECLARATIONS;
! SETFST
! ======
! THIS ROUTINE INTIALIZES 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 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 THE FOLLOWING :**
!
! IN ORDER TO MAKE SELECTION STATEMENTS BASED ON FILE
! ORGANIZATION WORK EASIER ( E.G. 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 ISNT ORGASC ALREADY.
!
! INPUT:
! NONE
! OUTPUT:
! TRUE: FST ALLOCATED AND INTIALIZED
! FALSE: ERROR
! NO CORE AVAILABLE
! NULL FILE ORG FIELD VALUE
!
! NOTE 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.
GLOBAL ROUTINE SETFST =
BEGIN
REGISTER
FLAGS;
TRACE ( 'SETFST' );
%([ CHECK THAT THE FILE ORG VALUE ISNT NULL ])%
IF .FAB [ FABORG ] IS ORGASC
THEN
BEGIN
FLAGS= .FST [BLOCKLENGTH];
CALLPMEM (LCI (FLAGS), RGCI (FST) );
RETURNSTATUS ( ER$ORG );
END;
%([ FILL IN ALL FIELDS IN THE FST ])%
FST [ BLOCKTYPE ] = FSTCODE; ! TYPE OF BLOCK
FST [ BLOCKLENGTH ] = FSTSIZE; ! AND SIZE
FST [ BLINK ] = .FST; ! LINK THIS FST TO ITSELF
FST [ FLINK ] = .FST;
FST [ FSTJFN ] = .USERJFN; ! SAVE JFN
FST [ FSTORG ] = .FAB [ FABORG ]; ! FILE ORGANIZATION
%([ SET UP THE FILE ORGANIZATION ( SEE ABOVE ) ])%
IF ( ( .FAB [ FABRFM ] IS RFMSTM ) ! FOR ASCII FILES..
OR
( .FAB [ FABRFM ] IS RFMLSA ) ) ! OR SEQUENCED FILES..
AND
( .FAB [ FABORG ] IS ORGSEQ )
THEN FST [ FSTORG ] = ORGASC; ! PRETEND ITS AN ORGANIZATION
%([ 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. ])%
FLAGS = ZERO; ! ASSUME NO LOCKING
IF RMSFILE
THEN IF ( ( .FAB [ FABSHR ] AND AXWRT ) ISON ) ! IF OTHERS WILL WRITE
OR
( ( .FAB [ FABFAC ] AND AXWRT ) ISON ) ! OR WE WILL WRITE
THEN FLAGS = FLGLOCKING; ! WE WILL LOCK EACH REC
!UNLESS...
IF .FAB [ FABSHR ] ISNT 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 DATE SPACE OF THE FILE ])%
FST [ FSTLOBYTE ] = .FPT [ BLOCKLENGTH ] + ENDBLOCKSIZE! START OF RECORDS
END;
! FST [ FSTHYBYTE ] _ ZERO; ! CLEAR THESE FIELDS...
! FST [ FSTFLAGS ] _ ZERO; ! STORE FLAGS
FST [ FSTFAC ] = .FAB [ FABFAC ];
FST [ FSTSHR ] = .FAB [ FABSHR ];
IF .FAB [FABFAC] EQL AXNIL THEN FST [FSTFAC] = AXGET; ! TRANS READ
FST [ FSTRAT ] = .FAB [ FABRAT ];
FST [ FSTMRS ] = .FAB [ FABMRS ]; ! MAS RECORD SIZE
FST [ FSTMRN ] = .FAB [ FABMRN ]; ! MAX RECORD NUMBER
FST [ FSTBSZ ] = .FAB [ FABBSZ ]; ! BYTE SIZE
FST [ FSTRFM ] = .FAB [ FABRFM ]; ! RECORD FORMAT
FST [ FSTFOP ] = .FAB [ FABFOP ];
FST [ FSTDEVTYPE ] = .DVFLGS [ DEVTYPE ]; ! 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 "MIN. NO. OF BUFFERS" ])%
%([ RMS REQUIRES AT LEAST THIS MANY. ])%
FST [ FSTMINBUF ] = (CASE FILEORG FROM 0 TO 3 OF
SET
[0]: %( ASCII )% MINBUFASC;
[1]: %( SEQ. )% MINBUFSEQ;
[2]: %( REL. )% MINBUFREL;
[3]: %( idx. )% MINBUFIDX
TES);
%([ FILL IN "NO. OF BUFFERS TO ALLOCATE" ])%
%([ (RMS SHOULD RUN "BETTER" WITH MORE BUFFERS) ])%
%([ (NOTE THAT THIS FIELD IS THE DEFAULT NO. OF ])%
%([ BUFFERS. THE USER MAY OVERRIDE BY SPECI- ])%
%([ FYING "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 KDB'S. THEREFORE, WE WILL NOT ADD IN THE
"MAXLEVEL" VALUE UNTIL LATER WHEN WE SET UP ALL THE
KDB'S. ])%
FST [ FSTNUMBUF ] = (CASE FILEORG FROM 0 TO 3 OF
SET
[0]: %( ASCII )% NUMBUFASC;
[1]: %( SEQ. )% NUMBUFSEQ;
[2]: %( REL. )% NUMBUFREL;
[3]: %( idx. )% NUMBUFIDX %( + MAX LEVELS )%
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;
GOODRETURN
END; %( OF SETFST )%
! SETRST
! ======
! ROUTINE TO INITIALIZE THE CONTENTS OF THE RECORD STATUS TABLE.
! THIS ROUTINE IS CALLED ONLY FROM THE $CONNECT
! MACRO PROCESSOR. IT SETS UP ALL THE VALUES
! IN THE RST, INCLUDING THE NEXT-RECORD-POINTER.
! INPUT:
! NONE
! OUTPUT:
! NONE
! GLOBALS USED:
! GPAGE
! GTBYTE
! PPAGE
!
! SEE THE NOTE IN THE HEADING FOR SETFST.
GLOBAL ROUTINE SETRST:NOVALUE =
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: POINTER, ! POINTER TO CURRENT BUFFER DESC.
NUMBUF, ! HOLDS NO. BUFFERS TO ALLOCATE
ENUFBUF, ! HOLDS MIN. NO. BUFFERS TO ALLOCATE
BUFSIZ, ! NO. PAGES IN EACH BUFFER
EOFBYTE, ! BYTE NUMBER OF THE EOF OF FILE
ACTRSTSIZE, ! ACTUAL SIZE OF THIS RST
KEYOFREF, ! KEY OF REFERENCE
TEMP;
! WHEN NOT ALL BUFFERS CAN BE ALLOCATED
EXTERNAL ROUTINE
GETKDB; ! CHECK IF KRF IF VALID
TRACE ( 'SETRST');
%([ COMPUTE NO. BUFFERS, SIZE OF BUFFER, ETC. ])%
ENUFBUF = .FST [ FSTMINBUF ]; ! MIN. NO. BUFFERS WE MUST ALLOCATE
BUFSIZ = .FST [ FSTBUFSIZ ]; ! NO. PAGES IN A BUFFER
IF ( NUMBUF =.RAB [ RABMBF ] ) IS ZERO
THEN NUMBUF = .FST [ FSTNUMBUF ] ! USE DEFAULT IF USER DOESN'T SPECIFY
ELSE
BEGIN %( USER SPECIFIED NO. BUFFERS TO USE )%
IF .NUMBUF LSS .ENUFBUF
THEN NUMBUF = .ENUFBUF ! IF USER'S VALUE TOO SMALL
END;
%([ ALLOCATE CORE FOR RST ])%
ACTRSTSIZE = RSTSIZE + .NUMBUF + .NUMBUF; ! COMPUTE ACTUAL RST SIZ
! 2ND NUMBUF FOR LRU VEC
IF (RST = CALLGMEM( LCI ( ACTRSTSIZE ))) IS FALSE THEN
RETURNSTATUS ( ER$DME );
%([ FOR INDEXED FILES, CHECK THE KRF VALUE. ])%
%IF INDX %THEN
IF IDXFILE
THEN
BEGIN
RST [ RSTNRPREF ] = ( KEYOFREF = .RAB [ RABKRF ] ); ! FETCH IT
%([ CAN WE FIND AN INTERNAL KDB FOR THIS KEY NUMBER? ])%
IF CALLGETKDB ( LCI ( KEYOFREF ) ) IS FALSE THEN !LOCATE KDB
BEGIN
CALLPMEM ( LCI ( ACTRSTSIZE ),
RGCI ( RST ) );
RETURNSTATUS ( ER$KRF ) ! BAD KRF
END
END; %(OF IF INDEXED FILE)%
%FI
%([ SET UP INITIAL VALUES ])%
RST [ RSTBFDCOUNT ] = .NUMBUF; ! NO. OF BUFFERS
RST [ BLOCKTYPE ] = RSTCODE; ! BLOCK-TYPE CODE
RST [ BLOCKLENGTH ] = .ACTRSTSIZE; ! LENGTH OF AN RST
RST [ RSTFST ] = .FST; ! STORE ADDRESS OF FST
! RST [ RSTRSZ ] _ ZERO; ! FOR SAFETY, CLEAR THESE LOCS
! RST [ RSTRSZW ] _ ZERO;
! RST [ RSTDATARFA ] _ ZERO;
! RST [ RSTFLAGS ] _ ZERO; ! CLEAR FLAGS
%([ WE MUST NOW DETERMINE (FOR ASCII FILES) IF WE ARE
POSITIONED AT THE EOF. WE WILL BE AT THE EOF IF THE
FILE IS NULL , OR IF WE ARE USING THE "RB$EOF" OPTION.
THUS, WE MUST CHECK THE FDB EOF BYTE NUMBER, AND OUR
OWN TEMPORARY EOF (HYBYTE) TO DETERMINE WHERE OUR
EOF IS GOING TO BE. ])%
! RST [ RSTLASTOPER ] _ ZERO; ! AND LAST OPERATION
! RST [ RSTBYTECOUNT ] _ ZERO; ! CLEAR PAGE COUNT
%([ 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 ISNT ZERO
THEN
BEGIN
LOOKAT ( ' KEY-BUFF-SIZE :',KEYBUFFSIZE );
IF ( RST [ RSTKEYBUFF ] = CALLGMEM ( LCI ( KEYBUFFSIZE ) ) ) IS FALSE THEN
BEGIN
CALLPMEM ( %(SIZE OF RST)% LCI ( ACTRSTSIZE ),
%(LOC OF RST)% RGCI ( RST ) );
RETURNSTATUS ( ER$DME )
END %(OF CANT GET CORE)%
END; %(OF IF KEYBUFFSIZE ISNT ZERO)%
%([ ALLOCATE BUFFERS ])%
%([ PERFORM THIS LOOP UNTIL WE EITHER GET A CONTIGOUS
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 = CALLGPAGE ( %(SIZE)% LCI ( TOTALPAGES ))) IS FALSE
AND ( NUMBUF = .NUMBUF - 1 ) LSS .ENUFBUF
THEN
BEGIN
TEMP = .RST [ RSTKEYBUFF ]; ! ADDRESS OF KEY BUFFER
IF .KEYBUFFSIZE ISNT ZERO
THEN %(RELEASE KEY BUFFER)%
CALLPMEM ( %(SIZE)% LCI ( KEYBUFFSIZE ),
%(LOC)% RLCI ( TEMP ) );
CALLPMEM ( %(RST SIZE)% LCI ( ACTRSTSIZE ),
%(LOC OF RST)% RGCI ( RST ) );
RETURNSTATUS ( ER$DME )
END;
TEMPAC = .BUFFERPAGE
END
UNTIL .TEMPAC ISNT 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
INC ( BFDPTR, 1 );
INC ( BUFFERPAGE, .BUFSIZ )
END; %(OF SET UP BUFFER DESCRIPTORS)%
%([ SETUP BUFFER POINTER FOR ASCII FILES ])%
IF ASCIIFILE
THEN
BEGIN %( SETUP POINTER FOR ASCII FILES )%
%([ FORM A POINTER TO THE CURRENT BKT DESCRIPTOR ])%
CBD = .RST + RSTCBDOFFSET; ! FORM PTR
BFDPTR = BFDOFFSET; ! FORM PTR TO BUF DESC
FST [FSTSEQBKT] = -1; !FORCE POSITIONING ON 1ST I/O OPER
CURRENTFILEPAGE = -1; !INDIC NO PAGE MAPPED
CURENTBUFFERADR = .BFDPTR [ BFDBPAGE ] ^ P2W; ! GET PTR TO BUFFER
CBD [ BKDBFDADR ] = .BFDPTR; ! SET CURRENT BUFF DESC
CBD [ BKDBKTSIZE ] = ASCIIBKTSIZE; ! SET BUCKET SIZE
END; %( OF SETUP POINTER FOR ASCII FILES )%
%([
WE ARE NOW READY TO POSITION THE FILE.
THERE ARE SEVERAL DISTINCT CASES WHICH MUST BE CONSIDERED:
FILE ORG. TECHNIQUE
========= ===
SEQ, NO APPEND NRP=1ST BYTE AFTER PROLOGUE
SEQ, APPEND NRP=EOF BYTE
REL, NO APPEND NRP=1 ( 1ST RECORD )
REL, APPEND < ILLEGAL >
IDX UNDEFINED ( 0 )
STREAM, NO APPEND POSASCFILE(0)
STREAM, APPEND POSASCFILE (EOF BYTE)
])%
%([ DETERMINE THE EOF BYTE NUMBER ])%
IF DASD AND ( FILEORG NEQ ORGREL )
THEN EOFBYTE = $CALL (SIZEFILE, .FST[FSTJFN])
ELSE EOFBYTE = -1; !FAIL THE IF
%([ SET EOF FLAG ACCORDINGLY ])%
IF ( .EOFBYTE IS ZERO OR APPENDOPTION ISON ) AND ( NOT TTY )
THEN SETFLAG ( RST [ RSTFLAGS ], FLGEOF );
CASE FILEORG FROM 0 TO 3 OF
SET
[0]: BEGIN %(ASC)%
IF DASD
THEN BEGIN
%([ IF RB$EOF IS ON, WE WILL SET THE PTR 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 IS OFF
THEN EOFBYTE = ZERO; %(SET POINTER TO START OF FILE)%
$CALL (POSASCFIL,
%(JFN)% .FST [ FSTJFN ],
%(BYTE)% .EOFBYTE );
END; %(OF IF DASD THEN IF ASCIIFILE)%
END;
[1]: BEGIN %(SEQ)%
IF (APPENDOPTION ISON) AND (.EOFBYTE ISNT ZERO)
THEN RST [RSTNRP] = .EOFBYTE
ELSE RST [RSTNRP] = .FST [ FSTLOBYTE ];
END;
[2]: %(REL)% RST [RSTNRP] = 1;
[3]: %(idx)% RST [RSTNRP] = ZERO;
TES; %( END OF CASE FABORG )%
%([ FINALLY, LINK THE RST TO THE OWNING FST ])%
LINK ( %(THIS RST)% RST, %(ONTO CHAIN)% FST );
GOODRETURN
END; %( OF SETRST )%
! READADB
! =======
! THIS ROUTINE WILL READ IN THE AREA DESCRIPTOR BLOCK
! WHICH IS STORED IN THE INITIAL PROLOGUE AT
! AN INDEXED FILE. THIS ROUTINE MUST SIMPLY
! ACQUIRE CORE FOR THE ADB AND TRANSFER IT INTO THE
! NEW BUFFER.
! INPUT:
! PROLOGPTR POINTER TO START OF FILE PROLOGUE
! OUTPUT:
! TRUE: OK
! FALSE: ERROR
! COULDN'T ACQUIRE CORE
! ON OUTPUT, THE LOCATION OF THE ADB WILL BE STORED
! IN THE GLOBAL VARIABLE "ADB".
! GLOBALS USED:
! ADB
GLOBAL ROUTINE READADB ( PROLOGPTR ) =
BEGIN
%IF INDX %THEN
ARGUMENT (PROLOGPTR,BASEADD); ! ADDRESS OF START OF FILE PROLOGUE
REGISTER
ADBPTR: ; ! TEMP POINTER TO ADB
LOCAL
ADBLENGTH; ! LENGTH OF THE ADB
MAP
PROLOGPTR: POINTER,
ADBPTR: POINTER;
TRACE ('READADB');
%([ *** NOTE ***
THIS ROUTINE PRESUPPOSES THAT ALL AREA DESCRIPTORS
ARE CONTAINED WITHIN PAGE 0 OF THE FILE ])%
%([ 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 = .PROLOGPTR [ BLOCKLENGTH ] + .PROLOGPTR; ! BYPASS FILE BLOCK
IF .ADBPTR [ BLOCKTYPE ] ISNT ADBCODE
THEN %(WE HAVE A SCREWED-UP FILE PROLOGUE)%
BEGIN
FILEPROBLEM ( FE$NOA );
BADRETURN
END; %(OF IF THIS ISNT AN ADB)%
ADBLENGTH = .ADBPTR [ BLOCKLENGTH ]; ! FILL IN THE LENGTH OF THIS BLOCK
%([ WE MUST NOW ALLOCATE SOME FREE CORE FOR THIS BLOCK ])%
IF (ADB = CALLGMEM ( LCI ( ADBLENGTH ))) IS FALSE
THEN
RETURNSTATUS ( ER$DME );
%([ MOVE THE ENTIRE ADB INTO OUR FREE CORE CHUNK ])%
MOVEWORDS ( %(FROM)% .ADBPTR,
%(TO)% .ADB,
%(SIZE)% .ADBLENGTH);
GOODRETURN
%FI
END; %( OF READADB )%
! SETKDB
! =======
! THIS ROUTINE READS IN THE CHAIN OF
! INDEX DESCRIPTOR BLOCKS (IDB) FROM
! THE DATA FILE AND CREATES THE INTERNAL
! CHAIN OF KEY DESCRIPTOR BLOCKS (KDB).
! EACH KDB IS COMPOSED OF ONLY A
! SUMMARY OF THE CONTENTS OF THE IDB;
! ONLY THAT INFO 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.
! INPUT:
! POINTER TO START OF FILE PROLOGUE
! OUTPUT:
! TRUE: OK
! FALSE: ERROR (ERROR CODE IS IN USRSTS)
! NO MORE CORE
! INDEX BUCKET SIZE NOT BIG ENOUGH
! GLOBALS USED:
! GMEM
! PMEM
! DUMP
! PPAGE
! UNDOKDBS
GLOBAL ROUTINE SETKDB ( PROLOGPTR ) =
BEGIN
%IF INDX %THEN
ARGUMENT (PROLOGPTR,BASEADD); ! PTR TO FILE PROLOGUE IN CORE
EXTERNAL ROUTINE
FENDOFKEY, ! FIND THE END OF THE KEY STRING
UNDOKDBS: ; ! FLUSH THE KDB CHAIN
LOCAL
LASTKDB, ! PTR TO THE LAST KDB WE HAVE CREATED
LASTIDB: , ! PTR TO THE 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: , ! SIZE OF THE BYTES FOR THIS KEY
NEXTKDB: , ! PTR TO THE NEXT KDB IN OUR CHAIN
MAXLEVELS: , ! MAX # OF LEVELS FOR ALL INDEXES
TEMP: , ! TEMPORARY LOCAL
TOTALSIZE: , ! TOTAL # OF BYTES IN THE KEY STRING
KEYBUFFSIZE: , ! LARGEST KEY BUFFER REQUIRED (IN FST)
BIGGESTBKZ: , ! BIGGEST BUCKET SIZE FOR FILE BUFFERS
IDBFILEADDRESS: , ! PLACE OF THE IDB IN THE FILE
ENDOFKEYBYTE: , ! HIGHEST BYTE NUMBER OF KEY STRING
ADBPTR: , ! PTR TO AREA DESCRIPTORS
AREANUMBER: , ! AREA NUMBER FOR THIS INDEX
BUCKETSIZE: , ! BUCKET SIZE FOR THIS INDEX
KEYSEGPTR: , ! PTR TO THE KEY SEGMENT DESCRIPTORS
THISKDB: , ! PTR TO THE CURRENT KDB
IDBPTR: , ! TEMP PTR TO THE CURRENT IDB
XABPTR: ; ! PTR TO THE XAB PORTION OF THE IDB
EXTERNAL
DTPTABLE,
DUMPKDB; ! KEY DATA TYPE TABLE
MAP
DTPTABLE: FORMAT;
MAP
LASTKDB: POINTER,
ADBPTR: POINTER,
PROLOGPTR: POINTER,
THISKDB: POINTER,
KEYSEGPTR: POINTER,
IDBPTR: POINTER,
XABPTR: POINTER;
REGISTER
BLTAC,
TEMPAC,
TEMPAC2;
MAP
TEMPAC: FORMAT;
TRACE ( 'SETKDB');
%([ WE MUST NOW CLEAR THE POINTER THE LIST OF KDB'S ])%
FST [ FSTKDB ] = ZERO;
%([ INITIALIZE SOME VARIABLES ])%
MAXLEVELS = 1; ! ASSUME AT LEAST 1 LEVEL
BIGGESTBKZ = ZERO; ! LARGEST BUCKET SIZE
FILEPAGENUMBER = ZERO;
WINDOWPAGE = .PROLOGPTR ^ W2P; ! FIND WHERE OUR BUFFER IS
%([ CLEAR THE LARGEST KEY BUFFER VALUE ])%
KEYBUFFSIZE = ZERO;
%([ WE MUST FIND THE FIRST IDB
IN THE FILE PROLOGUE ])%
ADBPTR = .PROLOGPTR [ FPTADB ] + .PROLOGPTR; ! GET AREA DESC ADDRESS
IDBPTR = .PROLOGPTR [ FPTIDB ] + .PROLOGPTR; ! ...AND INDEX DESCRIPTORS
%([ DO A CONSISTENCY CHECK TO SEE IF THIS IS AN IDB ])%
IF .IDBPTR [ BLOCKTYPE ] ISNT IDBCODE THEN
BEGIN
FILEPROBLEM ( FE$NOI ); ! NO INDEX DESCRIPTOR
USEREXIT
END;
IDBFILEADDRESS = ( ZERO ^ P2W ) + (.IDBPTR AND OFSETMASK ); ! FORM AN ADDRESS
LASTIDB = ( LASTKDB = ZERO ); ! 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 ISNT ZERO
DO
BEGIN
%([ GET SOME CORE FOR A KDB ])%
IF ( THISKDB = CALLGMEM ( PCI ( KDBSIZE )))
IS FALSE
THEN %( WE MUST UNWIND ALL KDB'S )%
BEGIN
CALLUNDOKDBS;
IF .MULTIPAGEFLAG THEN CALLPPAGE ( LCI ( WINDOWPAGE ),PCI ( 1 ), PCI ( TRUE ) );
RETURNSTATUS ( ER$DME )
END; %( OF IF GMEM IS FALSE )%
%([ 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
BLT'ED INSTEAD OF MOVED ONE AT A TIME. ])%
%([ SET UP POINTER TO THE XAB PORTION OF THE BLOCK ])%
XABPTR = .IDBPTR + IDBXABOFFSET; ! MAKE A PTR TO THE XAB PORTION OF THE IDB
%([ SET UP HEADER ])%
THISKDB [ BLOCKHEADER ] = KDBCODE ^ BLKTYPELSH + KDBSIZE;
%([ MOVE COMMON FIELDS ])%
THISKDB [ KDBROOT ] = .IDBPTR [ IDBROOT ];
THISKDB [ KDBNXT ] = ZERO; ! CLEAR NEXT PTR
%([ UPDATE THE MAX 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 DATA-TYPE OF THIS KEY, AND FIND
THE BYTESIZE WHICH IS ASSOCIATED WITH THAT DATA-TYPE ])%
THISKDB [ KDBDTP ] = .XABPTR [ XABDTP ]; ! GET DATA-TYPE
KEYBYTESIZE = .DTPTABLE [ .XABPTR [ XABDTP ], 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 ];
%([ MOVE THE XAB FLAGS TO THE IDB, AND CLEAR THE UNUSED ONES ])%
TEMP = .XABPTR [ XABFLG ] AND ALLXABFLAGS; ! GET XAB FLAGS AND CLEAR REST
IF .THISKDB [ KDBROOT ] IS ZERO THEN SETFLAG ( TEMP, FLGNOINDEX );
THISKDB [ KDBFLAGS ] = .TEMP; ! STORE FLAGS
THISKDB [ KDBDTP ] = .XABPTR [ XABDTP ];
%([ 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 ]; ! GET INDEX AREA NUMBER
THISKDB [ KDBIAN ] = .TEMPAC; ! STORE IT
BLTAC = ( THISKDB [ KDBIBKZ ] = .ADBPTR [ (.TEMPAC * AREADESCSIZE)+1, ADBBKZ ]); ! AND BUCKET SIZE
%([ IF THIS BUCKET SIZE IS THE LARGEST ONE WE HAVE SO FAR,
REMEMBER HOW BIG IT IS (FOR FUTURE BUFFER ALLOCATION) ])%
IF .BLTAC GTR .BIGGESTBKZ THEN BIGGESTBKZ = .BLTAC;
TEMPAC2 = .BLTAC ^ B2W; ! GET MAX OFFSET VALUE
IF .XABPTR [ XABIFL ] GEQ .TEMPAC2 ^DIVIDEBY2LSH ! MUST BE 50 PERCENT
THEN
TEMPAC2 = .XABPTR [ XABIFL ];
THISKDB [ KDBIFLOFFSET ] = .TEMPAC2;
%([ NOW, DO THE DATA AREA ])%
TEMPAC = .XABPTR [ XABDAN ]; ! GET DATA AREA NUMBER
THISKDB [ KDBDAN ] = .TEMPAC; ! STORE IT
BLTAC = ( THISKDB [ KDBDBKZ ] = .ADBPTR [( .TEMPAC * AREADESCSIZE)+1, ADBBKZ ]);
IF .BLTAC GTR .BIGGESTBKZ THEN BIGGESTBKZ = .BLTAC;
TEMPAC2 = .BLTAC ^ B2W; ! GET MAX OFFSET VALUE
IF .XABPTR [ XABDFL ] GEQ ( .TEMPAC2 ^ DIVIDEBY2LSH )
THEN
TEMPAC2 = .XABPTR [ XABDFL ];
THISKDB [ KDBDFLOFFSET ] = .TEMPAC2;
%([ NOW, SET UP KEY POSITION AND SIZE. ])%
MOVEWORDS ( %(FROM)% .XABPTR + XABKSDOFFSET,
%( TO )% .THISKDB + KDBKSDOFFSET,
%( SIZE )% MAXKEYSEGS );
%([ 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 WHIC 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 ])%
KEYSEGPTR = .XABPTR + XABKSDOFFSET; ! BUMP PTR TO KEY SEGMENTS
TOTALSIZE = ZERO; ! INIT COUNTER
INCR J FROM 0 TO MAXKEYSEGS-1 ! LOOP OVER ALL SEGMENTS
DO
BEGIN
TOTALSIZE = .TOTALSIZE + .KEYSEGPTR [ .J, KEYSIZ ]
END; %(OF INCR J LOOP)%
%([ "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 ] IS REFPRIMARY
THEN %(WE HAVE A PRIMARY DATA RECORD)%
BEGIN
IF .FPT [ FPTRFM ] IS RFMFIX
THEN %(THIS IS A FIXED-LENGTH RECORD)%
TEMPAC = FIXHDRSIZE
ELSE %(THIS IS A VARIABLE-LENGTH RECORD)%
TEMPAC = VARHDRSIZE ! USE DIFFERENT HDR SIZE
END; %(OF IF THIS IS A PRIMARY KEY)%
%([ 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 ] = CALLFENDOFKEY ( %(BYTE SIZE)% LCI ( KEYBYTESIZE ),
%(PTR TO KSD)% LPT ( KEYSEGPTR ));
%([ WE HAVE NOW CREATED THE CURRENT KDB.
WE MUST LINK IT INTO OUR CHAIN OF
EXISTING KDB'S ])%
IF .LASTKDB IS ZERO %( THIS IS THE 1ST ONE )%
THEN
FST [ FSTKDB ] = .THISKDB
ELSE
LASTKDB [ KDBNXT ] = .THISKDB;
LASTKDB = .THISKDB; ! UPDATE CURRENT PTR
%([ GET THE ADDRESS OF THE IDB IN THE FILE ])%
IDBFILEADDRESS = .IDBPTR [ IDBNXT ]; ! BUMP NEXT IDB PTR
%([ DOES IT SPAN PAGE BOUNDARIES? ])%
IF ( .IDBFILEADDRESS ^ W2P ) ISNT .FILEPAGENUMBER
THEN
BEGIN
IF .MULTIPAGEFLAG IS FALSE
THEN %(WE NEED TO ALLOCATE A NEW PAGE)%
BEGIN
MULTIPAGEFLAG = TRUE;
IF ( WINDOWPAGE = CALLGPAGE ( PCI ( 1 ) ) ) IS FALSE
THEN
BEGIN
CALLUNDOKDBS;
RETURNSTATUS ( ER$DME );
END
END;
FILEPAGENUMBER = .IDBFILEADDRESS ^ W2P;
%([ MAP THE FILE PROLOGUE PAGE IN ])%
$CALL (PAGIN,
%(JFN)% .FST [FSTJFN],
%(FROM)% .FILEPAGENUMBER,
%(TO)% .WINDOWPAGE,
%(ACCESS)% AXUPD,
%(COUNT)% 1);
END;
IDBPTR = ( .WINDOWPAGE ^ P2W ) %(USE CORE PAGE #)%
OR
( .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
BUGOUT ( %STRING('*DUMP OF KDB *: ',%CHAR(13),%CHAR(10)));
CALLDUMPKDB ( LPT ( THISKDB ) );
ENDDEBUG;
%FI
END; %( OF WHILE .IDBPTR ISNT ZERO )%
%([ 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 TEMP 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 ])%
INC ( FST [ FSTNUMBUF ], .MAXLEVELS );
%([ RELEASE ANY EXTRA PAGES WE MAY HAVE GOTTEN ])%
IF .MULTIPAGEFLAG THEN CALLPPAGE ( LCI ( WINDOWPAGE ),PCI ( 1 ), PCI ( TRUE ) );
GOODRETURN
%FI
END; %( OF SETKDB )%
! FENDOFKEY
! =========
! THIS ROUTINE COMPUTES THE BYTE NUMBER OF THE DATE 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.
! INPUT:
! KEYBYTESIZE BYTE SIZE OF THIS KEY
! KSDPTR => PTR TO THE FIRST KEY SEGMENT DESCRIPTOR IN XAB
! OUTPUT:
! BYTE NUMBER OF LAST BYTE IN KEY (EXPRESSED IN
! TERMS OF THE RECORD'S BYTE SIZE)
! GLOBALS USED
! <NONE>
GLOBAL ROUTINE FENDOFKEY ( KEYBYTESIZE, KSDPTR ) =
BEGIN
ARGUMENT (KEYBYTESIZE,VALUE); ! BYTE SIZE OF KEY
ARGUMENT (KSDPTR,BASEADD); ! PTR TO KEY SEGMENT DESCRIPTORS
MAP
KSDPTR: POINTER;
REGISTER
TEMPAC: FORMAT;
LOCAL
KEYBYTESPERWORD, ! # OF BYTES OF THE KEY IN EACH WORD
ANSWER: , ! USE A LOCAL FOR THE FINAL RESULT
RECBYTESPERWORD: , ! # OF BYTES OF THE RECORD IN EACH WORD
RECORDBYTESIZE: , ! BYTE SIZE OF THE DATA RECORD
SLACKBYTES: , ! # OF BYTES LEFT IN 1ST WORD OF KEY
LEFTOVERBITS: , ! # OF BITS LEFT OVER IN 1ST WORD OF KEY
FULLKEYWORDS: , ! # OF WORDS OCCUPIED BY KEY
KEYBITS: , ! TOTAL # OF BITS OCCUPIED BY KEY
KEYSIZE: , ! SIZE OF THE KEY
KEYSTART: ; ! FIRST BYTE OF THE KEY
TRACE ( 'FENDOFKEY' );
%([ INITIALIZE THE FINAL RESULT TO ZERO ])%
ANSWER = ZERO;
%([ DO THIS LOOP, ONCE FOR EACH KEY SEGMENT ])%
INCR J FROM 0 TO MAXKEYSEGS -1
DO
BEGIN
%([ FIND THE KEY POSITION AND SIZE ])%
%([ ********NOTE********* ])%
%([ THE LARGE CHUNK OF CODE BELOW WAS WRITTEN TO
SUPPORT A COMPLETELY GENERALIZED KEY-SPECIFICATION
MECHANISM. THAT IS, THE BYTE SIZE OF THE RECORD
AND THE KEY SIZE OF THE KEY COULD BE ANYTHING.
SINCE RMS RESTRICTS THE MIXING OF KEYS AND RECORD
TYPES (I.E., RECORD BYTE SIZES), THIS CODE IS
UNNECESSARY BUT IS BEING INCLUDED IN THIS FILE
IN CASE IT IS EVER NEEDED. ])%
%([ JUST FIND THE END OF THIS KEY SEGMENT ])%
TEMPAC = .KSDPTR [ .J, KEYSIZ ]; ! GET SIZE OF THIS SEGMENT
IF .TEMPAC ISNT ZERO
THEN
INC ( TEMPAC, .KSDPTR [ .J, KEYPOS ] );
%([ ***START OF NON-COMPILED CODE *** ])%
! BEFORE USING THIS PORTION OF CODE, REPLACE ALL IDIVI BY REGULAR
! BLISS DIVIDES.
!
! KEYSTART _ .KSDPTR [ .J, KEYPOS ] ; ! STARTING POSITION
! KEYSIZE _ .KSDPTR [ .J, KEYSIZ ]; ! AND SIZE
!
! RECORDBYTESIZE _ .FST [ FSTBSZ ]; ! GET RECORD BYTE SIZE
! KEYBYTESPERWORD _ 36 / .KEYBYTESIZE; ! # OF KEY BYTES IN 1 WORD
! RECBYTESPERWORD _ 36 / .RECORDBYTESIZE; ! SAME FOR RECORD
!
! %[ COMPUTE THE # OF FULL WORDS TO START OF THE KEY ]%
!
! TEMPAC _ .KEYSTART;
! IDIVI ( TEMPAC, .RECBYTESPERWORD ); ! DIVIDE BY RECORD BYTES
! FULLKEYWORDS _ .TEMPAC [ 0, WRD ]; ! START TO COUNT WORDS
!
! KEYBITS _ .TEMPAC [ 1, WRD ] * .RECORDBYTESIZE; ! # OF BITS LEFT OVER IN WORD
!
! %[ LET'S SEE SOME OF THIS STUFF ]%
!
!! LOOKAT ( ' KEYBYTESPERWORD:',KEYBYTESPERWORD);
!! LOOKAT ( ' FULL-KEY-WORDS:',FULLKEYWORDS);
!! LOOKAT ( ' KEY-BITS:',KEYBITS);
!
! %[ DETERMINE HOW MANY KEY BYTES CAN GO IN REST OF THIS WORD ]%
!
! LEFTOVERBITS _ 36 - .KEYBITS;
! SLACKBYTES _ .LEFTOVERBITS / .KEYBYTESIZE; ! # OF BYTES TO GO IN THIS WORD
!
!! LOOKAT ( ' LEFT-OVER-BITS:',LEFTOVERBITS);
!! LOOKAT ( ' SLACKBYTES:',SLACKBYTES);
!
! IF .SLACKBYTES GEQ .KEYSIZE
! THEN %THE KEY WILL FIT ENTIRELY IN THE REST OF THIS WORD%
!
! BEGIN
! RTRACE ( ' KEY WILL FIT IN LAST WORD?M?J');
! KEYBITS _ .KEYBITS + ( .KEYSIZE * .KEYBYTESIZE );
! END %OF IF SLACKBYTES GEQ KEYSIZE%
!
! ELSE %THE KEY EXTENDS INTO THE NEXT WORD%
!
! BEGIN
! KEYSIZE _ .KEYSIZE - .SLACKBYTES; ! SUB # OF BYTES IN THIS WORD
! TEMPAC _ .KEYSIZE; ! FIND # OF WORDS LEFT
! IDIVI ( TEMPAC, .KEYBYTESPERWORD );
! FULLKEYWORDS _ .FULLKEYWORDS + 1 + .TEMPAC [ 0,WRD ] ;
! KEYBITS _ .TEMPAC [ 1, WRD ] * .KEYBYTESIZE
! END; %OF IF KEY EXTENDS INTO NEXT WORD%
!
! %[ LOOK AGAIN ]%
!
!! LOOKAT ( ' FULLKEYWORDS: ',FULLKEYWORDS);
!! LOOKAT ( ' KEYBITS: ',KEYBITS );
!
! %[ COMPUTE MINIMUM RECORD SIZE FOR THIS KEY ]%
!
! TEMPAC _ .KEYBITS;
! IDIVI ( TEMPAC, .RECORDBYTESIZE ); ! # OF BYTE IN DATA RECORD
!
! %[ ROUND THIS VALUE UP ]%
!
! IF .TEMPAC [ 1, WRD ] ISNT ZERO THEN INC ( TEMPAC, 1 );
!
! %[ NOW DO THE FINAL COMPUTATION ]%
!
! TEMPAC _ .TEMPAC + ( .FULLKEYWORDS * .RECBYTESPERWORD );
!
! %[ CHECK IF THIS KEY SEGMENT IS "GREATER" THAN THE HIGHEST ONE ]%
%([ *** END OF NON-COMPILED CODE *** ])%
IF .TEMPAC GTR .ANSWER THEN ANSWER = .TEMPAC
END; %(OF THE HUGE INCR LOOP)%
LOOKAT ( ' FINAL RESULT FROM FENDOFKEY: ', ANSWER );
RETURN .ANSWER
END; %(OF FENDOFKEY)%
! UNDOKDBS
! ========
! ROUTINE TO GIVE BACK ALL KDB FREE MEMORY IF WE COULDN'T
! PROCESS THE FILE PROLOGUE CORRECTLY.
! INPUT:
! <NONE>
! OUTPUT:
! <NO STATUS RETURNED>
GLOBAL ROUTINE UNDOKDBS: NOVALUE =
BEGIN
%IF INDX %THEN
LOCAL
THISKDB: POINTER,
NEXTKDB: POINTER;
TRACE ('UNDOKDBS');
THISKDB = .FST [ FSTKDB ];
WHILE .THISKDB ISNT ZERO
DO
BEGIN
NEXTKDB = .THISKDB [ KDBNXT ]; ! SAVE THE ADDRESS OF THE NEXT ONE
CALLPMEM ( PCI ( KDBSIZE ),
RLCI (THISKDB ));
THISKDB = .NEXTKDB ! ADVANCE OUR POINTER
END; %(OF WHILE THERE ARE MORE KDB'S)%
RETURN
%FI
END; %(OF UNDOKDBS)%
END
ELUDOM