Trailing-Edge
-
PDP-10 Archives
-
BB-JF18A-BM
-
sources/rms/rmsdis.b36
There are 6 other files named rmsdis.b36 in the archive. Click here to see a list.
%TITLE 'D I S P L A Y -- $DISPLAY processor'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE display (IDENT = '3.0(610)'
) =
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:
!
! DISPLAY contains all routines which process
! the $DISPLAY macro in RMS-20.
!
! ENVIRONMENT: User mode, interrupts deferred until JSYS return
!
! AUTHOR: Ron Lusk , CREATION DATE: 17-Mar-83
!
!--
!
! TABLE OF CONTENTS
!
!
! $DISPLAY - processor for $DISPLAY macro
! DISPFILE - routine called by $DISPLAY and $OPEN
!
!
! INCLUDE FILES:
!
REQUIRE 'rmsreq';
!
! MACROS:
!
! None.
!
! EQUATED SYMBOLS:
!
GLOBAL BIND
dsplv = 3^24 + 0^18 + 572; ! Module version
!
! OWN STORAGE:
!
! None.
!
! EXTERNAL REFERENCES:
EXTERNAL ROUTINE
D$Display;
EXTERNAL
OurCfg: $XabCfg_decl;
GLOBAL ROUTINE $display (fabblock, errorroutine) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! $DISPLAY displays the attributes of an indexed file
! by transferring the contents of the File Prologue
! Area and Index Descriptor Blocks into the user's XAB
! chain. This function may also be used to fill in a
! Date XAB or a Summary XAB for any file organization.
!
! Each user XAB is scanned, in turn, and appropriate
! information from the file is loaded into it:
!
! For Area XABs, only the area bucket size is stored
! into the XAB.
! For Key XABs, all key characteristics including the
! key name are moved.
! For Date XABs, the relevant information is acquired
! from the monitor and stored into the user's XAB.
! For Summary XABs, the size of the Area Descriptor
! Block and the number of Key Descriptor Blocks in
! the KDB chain are stored into the XAB.
!
! FORMAL PARAMETERS
!
! FABBLOCK - address of user File Access Block
!
! ERRORRETURN - address of user's error routine
!
! IMPLICIT INPUTS
!
! ?
!
! ROUTINE VALUE:
!
! None.
!
! SIDE EFFECTS:
!
! ?
!
!--
BEGIN
rmsentry ($display);
!
! Fetch the user's FAB and error addresses.
!
fab = .fabblock; ! Get FAB address
erradr = .errorroutine; ! And user error address
fsetup (); ! Set up the rest
!+
! Check out if this is a good file.
!-
IF .fst [blocktype] NEQ fstcode ! Valid FST?
THEN
usererror (er$ifi);
!+
! Check if he has an XAB chain.
!-
IF .fab [fabxab, 0] NEQ 0
THEN
BEGIN
REGISTER
temp;
IF .fst[fst$v_remote] ! Is it remote? !m571
THEN temp = d$display( .fab, .fst )
ELSE temp = dispfile (); ! Display the file
IF .temp NEQ true ! Failure?
THEN
usrsts = .temp ! Return proper code
END;
usrret ();
END; ! End of $DISPLAY
GLOBAL ROUTINE dispfile =
!++
! FUNCTIONAL DESCRIPTION:
!
! DISPFILE actually fills the user's XAB chain with
! the correct file attribute information.
!
! Note that this routine is driven by the contents of
! the user's XAB chain, not the contents of the File
! Prologue. This reasonable because the Prologue will
! always be on page 0, and because it avoids many
! searches of the XAB chain.
!
! Note also that the File Status Table must be set up
! before this routine is called. Thus, any
! modifications to the $OPEN processing should take
! this fact into account.
!
! FORMAL PARAMETERS
!
! None.
!
! IMPLICIT INPUTS
!
! ?
!
! COMPLETION CODES:
!
! TRUE - Success
! ER$DME - Dynamic memory exhausted in
! mapping File Prologue
! ER$XAB - Invalid block in XAB chain
! ER$COD - Invalid XAB code detected
! ER$BLN - Invalid XAB length detected
! ER$ORD - Key XABs out of order
! Area XABs out of order
! ER$IMX - More than one Date XAB
! More than one Summary XAB
! ER$NXT - Bad NXT field in XAB
!
! SIDE EFFECTS:
!
! The RAB STV field will be set to the address of the bad XAB
! if an error is detected.
!
!--
BEGIN
REGISTER
xabptr : REF BLOCK,
idbptr : REF BLOCK,
acptr : REF BLOCK,
temp;
LABEL
loop,
outerloop;
LOCAL
! bucketdesc : VECTOR [bdsize], ! Bucket descriptor
dates_blk : BLOCK [dates_blksiz], ! Block for dates
windowpage, ! Current window page number
winpageglobal, ! Windowpage or .RMSSEC
xabtype, ! Type of this XAB
filepagenumber, ! Page number of currently
! mapped file page
errorcode, ! Storage for error codes
dateflag, ! Flag for Date XAB seen
summaryflag, ! Flag for Summary XAB seen
highestarea, ! Highest area ID seen
highestref, ! Highest key of reference seen
keyref, ! Key of reference
loopstatus,
keypointer,
userkeyptr; !610 User's original keypointer
TRACE ('DISPFILE');
!
! Get the address of the XAB chain.
!
xabptr = .fab [fabxab, 0];
!
! Initialize some more stuff.
!
highestarea = (highestref = -1); ! Set to low number
dateflag = (summaryflag = false); ! Clear these flags
errorcode = true;
filepagenumber = allones; ! This means no page mapped
!+
! Get a free page to use for the prologue.
!
! Note that this operation is superfluous for non-indexed
! files, but it is easier to do it this way than to check
! below if there is a page already allocated.
!-
IF (windowpage = gpage (1)) EQL false THEN RETURN er$dme;
!+
! Do this loop for all XABs.
!-
outerloop :
BEGIN
WHILE .xabptr NEQ 0 DO
BEGIN
xabptr = .xabptr OR .blksec; ! Get global address
!+
! We need two BEGIN-END pairs here so we can exit correctly.
!-
loop :
BEGIN
loopstatus = true; ! Assume no error
IF .xabptr [blocktype] NEQ xabcode ! Is this an XAB?
THEN
loopstatus = er$xab;
IF .xabptr [xabcod, 0] GTR maxcod ! Is this a valid XAB?
THEN
loopstatus = er$cod;
!+
! Did we find an error above?
!-
IF .loopstatus NEQ true THEN LEAVE loop WITH false;
!
! Check the block length of this XAB.
!
xabtype = .xabptr [xabcod, 0]; ! Get type code
temp = (CASE .xabtype FROM xab$k_key TO xb$max OF
SET
[xab$k_key] : xab$k_keylen; ! Key
[xab$k_all] : xab$k_alllen; ! Area
[xab$k_dat] : xab$k_datlen; ! Date
[xab$k_sum] : xab$k_sumlen; ! Summary
[xab$k_cfg] : xab$k_cfglen; ! Configuration
TES);
IF .xabptr [blocklength] NEQ .temp ! Block length OK?
THEN
LEAVE loop WITH (loopstatus = er$bln); ! Bad block length
!+
! Select the proper XAB code.
!-
CASE .xabtype FROM xb$key TO xb$max OF
SET
[xb$key] :
BEGIN ! Key
IF NOT idxfile !
THEN
LEAVE loop WITH (loopstatus = true); !
!
! Find the internal KDB.
!
keyref = .xabptr [xabref, 0];
IF .keyref LEQ .highestref ! Keys out of order?
THEN
LEAVE loop WITH (loopstatus = er$ord);
highestref = .keyref; ! Update new high keys
!+
! We will allow a Key XAB with a key
! of reference greater than the
! highest key number in the file.
!-
IF (kdb = getkdb (.keyref)) EQL false !
THEN
LEAVE loop WITH (loopstatus = true); !
! Bad reference
!+
! Locate the index descriptor for this key.
!-
!+
! Check to see if the IDB is on the page we currently have mapped in.
!-
IF ((temp = (.kdb [kdbidbaddr]^w2p)) NEQ .filepagenumber)
THEN ! We must map in a new page
BEGIN
filepagenumber = .temp;
winpageglobal = .windowpage OR (.rmssec^s2p);
pagin (.fst [fstjfn], ! JFN
.filepagenumber, ! From file
.winpageglobal, ! To memory
axupd, ! Access
1); ! One page
END;
!
! Form a pointer to this IDB.
!
idbptr = ((.windowpage^p2w) + !
(.kdb [kdbidbaddr] AND ofsetmask)); !
! Save the user's key name pointer.
!
keypointer = userkeyptr =.xabptr [xabknm, 0]; !610
!+
! If local section address, get global address.
!-
IF .keypointer<wrd> NEQ 0 !
THEN !
IF .keypointer<lh> EQL 0 !
THEN !
keypointer = .keypointer OR .blksec; !
!+
! Move the XAB stored in the file to the XAB.
!-
IF .rmssec NEQ 0
THEN
xcopy ( ! Move with XBLT
.idbptr + idbxaboffset + xabhdrsize, ! From
.xabptr + xabhdrsize, ! To
keyxabsize - xabhdrsize) ! Size
ELSE
movewords ( ! Normal BLT
.idbptr + idbxaboffset + xabhdrsize, ! From
.xabptr + xabhdrsize, ! To
keyxabsize - xabhdrsize); ! Size
!+ 610
! Replace the keypointer with the user's original ptr and
! Copy the KeyName field
!-
IF (xabptr[xabknm,0] = .userkeyptr) GTR minuserbuff !610
THEN
IF .rmssec NEQ 0
THEN
xcopy ( ! XBLT
.idbptr + idbxaboffset + keyxabsize, ! From
.keypointer, ! To
keynamesize) ! Size
ELSE
movewords ( !
.idbptr + idbxaboffset + keyxabsize, ! From
.keypointer, ! To
keynamesize); ! Size
loopstatus = true
END;
[xb$all] :
BEGIN ! Area
IF NOT idxfile THEN LEAVE loop WITH (loopstatus = true);
!+
! Check to see if the AID value conforms
! to the highest area in the file (we must
! subtract 2 from the blocklength because
! of the header, and because the area
! numbers start at 0).
!-
IF (temp = .xabptr [xabaid, 0]) GTR !
((.adb [adb$h_bln] - 2)/areadescsize) ! Area count
THEN
LEAVE loop WITH (loopstatus = true);
IF .temp LEQ .highestarea !
THEN
LEAVE loop WITH (loopstatus = er$ord);
highestarea = .temp; ! Update new high
xabptr [xabbkz, 0] = .adb[adb$v_bkz, .temp];
loopstatus = true ! Set value
END;
[xb$dat] :
BEGIN ! Date
!+
! Check that only one of these are given.
! Note that this check is really not
! necessary, it is included here for
! compatability with RMS-11.
!-
IF .dateflag NEQ 0 ! Have we seen a DATE XAB?
THEN
LEAVE loop WITH (loopstatus = er$imx);
dateflag = 1; ! Set flag
!+
! Read the file's dates from the monitor.
!-
datofile (.fst [fstjfn], ! JFN
dates_blk, ! Pointer to block
dates_blksiz); ! Size
!+
! Fill in the user's XAB.
!-
xabptr [xabcdt, 0] = .dates_blk [dt_cre, wrd];
xabptr [xabrdt, 0] = .dates_blk [dt_wri, wrd];
xabptr [xabedt, 0] = 0; ! No deletion
loopstatus = true ! Indicate success
END;
[xb$sum] :
BEGIN ! Summary
IF .summaryflag NEQ 0 ! Have we seen a SUMMARY XAB?
THEN
LEAVE loop WITH (loopstatus = er$imx);
summaryflag = 1; ! Set flag
!
! The following line was deleted long ago, yet kept -- RL, Mar-83
! xabptr [xabnor, 0] = 0; ! Record descriptor[?]
temp = 0; ! Assume no areas
IF idxfile ! Do only for index files
THEN
temp = (.adb[adb$h_bln] - 1)/areadescsize;
xabptr [xabnoa, 0] = .temp; ! Store in XAB
temp = 0; ! Init counter
acptr = .fst [fstkdb]; ! Pointer to first KDB
!+
! Loop over all KDBs and count them
! (this means that we don't have to
! scan thru the file IDBs to determine
! the number of keys).
!-
UNTIL .acptr EQL 0 DO
BEGIN
acptr = .acptr [kdbnxt];
temp = .temp + 1; ! Bump KDB counter
END;
xabptr [xabnok, 0] = .temp;
loopstatus = true
END;
[Xab$k_Cfg]:
IF .rmssec NEQ 0
THEN
$rms$xcopy( OurCfg + Xab$k_HdrLen, ! Copy local config
.Xabptr + Xab$k_HdrLen, ! xab , except for
Xab$k_CfgLen - Xab$k_HdrLen ) ! header !m553
ELSE
$move_words( OurCfg + Xab$k_HdrLen, ! Copy local config
.Xabptr + Xab$k_HdrLen, ! xab , except for
Xab$k_CfgLen - Xab$k_HdrLen ); ! header !m572
TES;
END;
!+
! Check to see if the next XAB address is ok.
!-
temp = .xabptr [xabnxt, 0]; ! Get next XAB address
IF (.temp NEQ 0) AND (.temp LEQ minuserbuff) !
THEN
loopstatus = er$nxt; ! Bad next address
!+
! Did we find an error during our XAB scan?
!-
IF .loopstatus NEQ true
THEN
BEGIN
usrstv = .xabptr; ! Remember XAB
LEAVE outerloop WITH (errorcode = .loopstatus)
END;
!
! Go to next XAB.
!
xabptr = .temp
END;
END;
!+
! Flush the free page we got earlier.
!-
ppage (.windowpage, 1, true);
RETURN .errorcode
END; ! End of DISPFILE
END ! End of Module DISPLAY
ELUDOM