Trailing-Edge
-
PDP-10 Archives
-
cuspbinsrc_2of2_bb-fp63b-sb
-
10,7/rms10/rmssrc/rmsdis.b36
There are 6 other files named rmsdis.b36 in the archive. Click here to see a list.
MODULE DISPLAY =
BEGIN
GLOBAL BIND DSPLV = 1^24 + 0^18 + 4; !EDIT DATE: 31-JAN-77
%([
FUNCTION: THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
THE $DISPLAY MACRO IN RMS-20.
AUTHOR: S. BLOUNT
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1977, 1979 BY DIGITAL EQUIPMENT CORPORATION
********** TABLE OF CONTENTS **************
ROUTINE FUNCTION
======= ========
$DISPLAY PROCESSOR FOR $DISPLAY MACRO
DISPFILE SUBROUTINE CALLED BY $DISPLAY AND $OPEN
REVISION HISTORY:
EDIT DATE WHO PURPOSE
==== ==== === =======
1 3-SEP-76 SB MAKE LEGAL FOR NON-IDX FILES
2 29-SEP-76 SB ADD AREADESCSIZE CHANGE
3 31-JAN-77 SB COSMETIC CHANGES TO DISPFILE
*************************************************
* *
* NEW REVISION HISTORY *
* *
*************************************************
****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************
PRODUCT MODULE SPR
EDIT EDIT QAR DESCRIPTION
====== ====== ===== ===========
100 4 Dev Make declarations for CRASH, GETKDB, DUMP,
GPAGE, FSETUP, and PPAGE be EXTERNAL ROUTINE
so RMS will compile under BLISS V4
(RMT, 10/22/85).
***** END OF REVISION HISTORY *****
])%
%([ FORWARD DECLARATIONS ])%
FORWARD ROUTINE DISPFILE; ! DISPLAY THE FILE ROUTINE
%([ EXTERNAL DECLARATIONS ])%
EXTERNAL ROUTINE
GETKDB, ! GET A KEY DESCRIPTOR
CRASH, ! FOR DEBUGGING
DUMP, ! FOR DEBUGGING
GPAGE, ! GET A PAGE FOR THE PROLOGUE
FSETUP, ! FILE OPERATION SETUP
PPAGE; ! PUT A FREE PAGE
%([ ERROR MESSAGES REFERENCED IN THIS MODULE ])%
REQUIRE 'RMSREQ';
EXTDECLARATIONS;
! $DISPLAY
! ========
! PROCESSOR FOR $DISPLAY MACRO.
! THIS MACRO DISPLAYS THE ATTRIBUTES OF AN INDEXED FILE
! BY TRANSFERING THE CONTENTS OF THE FILE PROLOGUE AREA
! AND INDEX DESCRIPTOR BLOCKS INTO THE USER'S XAB CHAIN.
! THIS MACRO MAY ALSO BE USED TO FILL IN A DATE XAB FOR
! A NON-INDEXED FILE.
! EACH USER XAB IS SCANNED, IN TURN, AND THE
! APPROPRIATE INFORMATION FROM THE FILE IS LOADED INTO IT.
! FOR AREA XAB'S, ONLY THE AREA BUCKET SIZE IS STORED INTO
! THE XAB. FOR KEY XAB'S, ALL KEY CHARACTERISTICS INCLUDING
! THE KEY NAME ARE MOVED. FOR DATE XAB'S, THE RELEVANT
! INFORMATION IS ACQUIRED FROM THE MONITOR AND STORED
! INTO THE USER'S XAB.
! FORMAT OF $DISPLAY MACRO:
!
! $DISPLAY <FAB-ADDRESS> [,<ERROR-ADDRESS>]
!
! FAB FIELDS USED AS INPUT TO $DISPLAY:
!
! XAB ADDRESS OF XAB CHAIN
!
! FAB FIELDS RETURNED TO USER:
!
! STS COMPLETION STATUS CODE
! <ALL RELEVANT ATTRIBUTE VALUES ARE ALSO PLACED IN THE XAB'S>
! INPUT:
! ADDRESS OF USER FILE ACCESS BLOCK (FAB)
! ERROR RETURN ADDRESS
! OUTPUT:
! <USER STATUS FIELD SET TO ERROR CODE>
! GLOBALS USED:
! <NONE>
! ROUTINES CALLED:
! DISPFILE
! GETIDB
GLOBAL ROUTINE %NAME('$DISPLAY') ( BLOCK, ERRORROUTINE ): NOVALUE =
BEGIN
ARGUMENT (BLOCK,BASEADD); ! FAB ADDRESS
ARGUMENT (ERRORROUTINE,BASEADD); ! USER ERROR ADDRESS
REGISTER TEMP;
RMSENTRY ( $DISPLAY );
%([ FETCH THE USER'S FAB AND ERROR ADDRESSES ])%
FAB = .BLOCK; ! GET FAB ADDRESS
ERRADR = .ERRORROUTINE; ! AND USER ERROR ADDRESS
CALLFSETUP; ! SET UP THE REST
%([ CHECK OUT IF THIS IS A GOOD FILE ])%
IF .FST [ BLOCKTYPE ] ISNT FSTCODE THEN USERERROR ( ER$IFI );
%([ CHECK IF HE HAS AN XAB CHAIN ])%
IF .FAB [ FABXAB ] ISNT ZERO
THEN
BEGIN
TEMP = CALLDISPFILE; ! DISPLAY THE FILE
IF .TEMP ISNT TRUE THEN USRSTS = .TEMP
END; %(OF IF FABXAB ISNT ZERO)%
USEREXIT
END; %(OF $DISPLAY)%
! DISPFILE
! ========
! ROUTINE TO DISPLAY THE ATTRIBUTES OF A FILE.
! THIS ROUTINE 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
! IS REASONABLE BECAUSE THE PROLOGUE WILL ALWAYS BE ON
! PAGE 0, AND BECAUSE IT AVOIDS MANY SEARCHES OF THE XAB
! CHAIN.
! INPUT:
! <NONE>
! OUTPUT:
! TRUE: OK
! NOT TRUE: ERROR CODE RETURNED IN VREG
! ROUTINES CALLED:
! DUMP
! GETIDB
!
! NOTE THAT THE FST MUST BE SET UP BEFORE THIS ROUTINE
! IS CALLED. THUS, ANY MODIFICATIONS TO THE $OPEN PROCESSING
! SHOULD TAKE THIS FACT INTO ACCOUNT.
GLOBAL ROUTINE DISPFILE =
BEGIN
REGISTER
XABPTR: POINTER,
IDBPTR: POINTER,
ACPTR: POINTER,
TEMP;
LABEL LOOP,OUTERLOOP;
LOCAL
BUCKETDESC: VECTOR[ BDSIZE ], ! BUCKET DESCRIPTOR
DATES_BLK: FORMATS[ DATES_BLKSIZ ], ! BLOCK FOR DATES
WINDOWPAGE, ! CURRENT WINDOW PAGE NUMBER
XABTYPE, ! TYPE OF THIS XAB
FILEPAGENUMBER, ! PAGE # OF CURRENTLY MAPPED FILE PAGE
ERRORCODE, ! STORAGE FOR ERROR CODES
DATEFLAG, ! FLAG FOR DATA 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;
TRACE ('DISPFILE');
%([ GET THE ADDRESS OF THE XAB CHAIN ])%
XABPTR = .FAB [ FABXAB ];
%([ 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 = CALLGPAGE ( PCI ( 1 ) )) IS FALSE
THEN
RETURN ER$DME;
%([ DO THIS LOOP FOR ALL XAB'S ])%
OUTERLOOP: BEGIN
WHILE .XABPTR ISNT ZERO
DO
BEGIN
%([ WE NEED TWO BEGIN-END PAIRS HERE SO WE CAN EXIT CORRECTLY ])%
LOOP: BEGIN
LOOPSTATUS = TRUE; ! ASSUME NO ERROR
IF .XABPTR [ BLOCKTYPE ] ISNT XABCODE ! IS THIS AN XAB
THEN LOOPSTATUS = ER$XAB;
IF .XABPTR [ XABCOD ] GTR MAXCOD
THEN LOOPSTATUS = ER$COD; ! IS THIS A VALID XAB
%([ DID WE FIND AN ERROR ABOVE? ])%
IF .LOOPSTATUS ISNT TRUE THEN LEAVE LOOP WITH FALSE;
%([ CHECK THE BLOCK LENGTH OF THIS XAB ])%
XABTYPE = .XABPTR [ XABCOD ]; ! GET TYPE CODE
TEMP = ( CASE .XABTYPE FROM 0 TO 3 OF
SET
[0]: %(KEY)% KEYXABSIZE;
[1]: %(AREA)% AREAXABSIZE;
[2]: %(DATE)% DATEXABSIZE;
[3]: %(SUM)% SUMXABSIZE
TES);
IF .XABPTR [ BLOCKLENGTH ] ISNT .TEMP
THEN
LEAVE LOOP WITH ( LOOPSTATUS = ER$BLN ); ! BAD BLOCK LENGTH
%([ SELECT THE PROPER XAB CODE ])%
CASE .XABTYPE FROM 0 TO 3 OF
SET
[0]: %(KEY)% BEGIN
IF NOT IDXFILE THEN LEAVE LOOP WITH ( LOOPSTATUS = TRUE );
%IF INDX %THEN
%([ FIND THE INTERNAL KDB ])%
KEYREF = .XABPTR [ XABREF ];
IF .KEYREF LEQ .HIGHESTREF THEN LEAVE LOOP WITH ( LOOPSTATUS = ER$ORD );
HIGHESTREF = .KEYREF; ! UPDATE NEW HIGH
%([ WE WILL ALLOW A KEY XAB WITH A REF GTR THAN THE
HIGHEST KEY NUMBER IN THE FILE ])%
IF ( KDB = CALLGETKDB ( LCI ( KEYREF ) ) ) IS FALSE
THEN
LEAVE LOOP WITH ( LOOPSTATUS = TRUE ); ! BAD REF
%([ 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 ) )
ISNT
.FILEPAGENUMBER )
THEN %(WE MUST MAP IN A NEW PAGE)%
BEGIN
FILEPAGENUMBER = .TEMP;
$CALL (PAGIN,
%(JFN)% .FST[FSTJFN],
%(FROM)% .FILEPAGENUMBER,
%(TO)% .WINDOWPAGE,
%(access)% AXUPD,
%(COUNT)% 1);
END; %(OF WE MUST MAP IN NEW PAGE)%
%([ FORM A POINTER TO THIS IDB ])%
IDBPTR = ( ( .WINDOWPAGE ^ P2W ) +
( .KDB [ KDBIDBADDR ] AND OFSETMASK ) );
%([ SAVE THE USER'S KEY NAME POINTER ])%
KEYPOINTER = .XABPTR [ XABKNM ];
%([ MOVE THE XAB STORED IN THE FILE TO THE XAB ])%
MOVEWORDS ( %(FROM)% .IDBPTR+IDBXABOFFSET+XABHDRSIZE,
%(TO)% .XABPTR+XABHDRSIZE,
%(SIZE)% KEYXABSIZE-XABHDRSIZE );
%([ REPLACE THE KEY-NAME POINTER ])%
IF ( XABPTR [ XABKNM ] = .KEYPOINTER )
GTR MINUSERBUFF
THEN
MOVEWORDS ( %(FROM)% .IDBPTR+IDBXABOFFSET+KEYXABSIZE,
%(TO)% .KEYPOINTER,
%(SIZE)% KEYNAMESIZE );
%FI
LOOPSTATUS = TRUE
END; %(OF IF KEY XAB)%
[1]: %(AREA)% BEGIN
IF NOT IDXFILE THEN LEAVE LOOP WITH ( LOOPSTATUS = TRUE );
%IF INDX %THEN
%([ CHECK TO SEE IF THE "AID" VALUE CONFORMS TO
THE HIGHEST AREA IN THE FILE (WE MUST SUBTRACE
2 FROM THE BLOCKLENGTH BECAUSE OF THE HEADER,
AND BECAUSE THE AREA NUMBERS START AT 0) ])%
IF ( TEMP = .XABPTR [ XABAID ] ) GTR
((.ADB [ BLOCKLENGTH ]-2 ) / AREADESCSIZE ) %(# OF AREAS#)% THEN LEAVE LOOP WITH ( LOOPSTATUS = TRUE );
IF .TEMP LEQ .HIGHESTAREA THEN LEAVE LOOP WITH ( LOOPSTATUS = ER$ORD );
HIGHESTAREA = .TEMP; ! UPDATE NEW HIGH
XABPTR [ XABBKZ ] = AREATOBKTSIZE ( .TEMP );
%FI
LOOPSTATUS = TRUE ! SET VALUE
END; %(OF IF THIS IS AN AREA XAB)%
[2]: %(DATE)% BEGIN
%([ 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 ISNT ZERO THEN LEAVE LOOP WITH ( LOOPSTATUS = ER$IMX );
DATEFLAG = 1; ! SET FLAG
%([ READ THE FILE'S DATES FROM THE MONITOR ])%
$CALL (DATOFILE,
%(JFN)% .FST [ FSTJFN ],
%(PTR TO BLOCK)% DATES_BLK,
%(SIZE)% DATES_BLKSIZ );
%([ FILL IN THE USER'S XAB ])%
XABPTR [ XABCDT ] = .DATES_BLK [ DT_CRE, WRD ];
XABPTR [ XABRDT ] = .DATES_BLK [ DT_WRI, WRD ];
XABPTR [ XABEDT ] = ZERO; ! NO DELETION
LOOPSTATUS = TRUE ! INDICATE SUCCESS
END; %(OF DATE XAB)%
[3]: %(SUMRY)% BEGIN
IF .SUMMARYFLAG ISNT ZERO THEN LEAVE LOOP WITH ( LOOPSTATUS = ER$IMX );
SUMMARYFLAG = 1; ! SET FLAG
! XABPTR [ XABNOR ] _ ZERO; ! RECORD DESC
TEMP = ZERO; ! ASSUME NO AREAS
IF IDXFILE ! DO ONLY FOR IDX FILES
THEN TEMP = (.ADB [ BLOCKLENGTH ] -1 )/ AREADESCSIZE;
XABPTR [ XABNOA ] = .TEMP; ! STORE IN XAB
TEMP = ZERO; ! INIT COUNTER
ACPTR = .FST [ FSTKDB ]; ! PTR TO 1ST KDB
%([ LOOP OVER ALL KDB'S AND COUNT THEM (THIS
MEANS THAT WE DON'T HAVE TO SCAN THRU THE
FILE IDB'S TO DETERMINE THE NUMBER OF KEYS) ])%
UNTIL .ACPTR IS ZERO
DO
BEGIN
ACPTR = .ACPTR [ KDBNXT ];
INC ( TEMP, 1 ) ! BUMP CTR
END; %(OF UNTIL ACPTR IS ZERO)%
XABPTR [ XABNOK ] = .TEMP;
LOOPSTATUS = TRUE
END %(OF FILE SUMMARY XAB)%
TES; %(END OF CASE STATEMENT)%
END; %(OF THE INNER LOOP)%
%([ CHECK TO SEE IF THE NEXT XAB ADDRESS IS OK ])%
TEMP = .XABPTR [ XABNXT ]; ! GET NEXT XAB ADDRESS
IF ( .TEMP ISNT ZERO )
AND
( .TEMP LEQ MINUSERBUFF )
THEN LOOPSTATUS = ER$NXT; ! BAD NEXT ADDRESS
%([ DID WE FIND AN ERROR DURING OUR XAB SCAN? ])%
IF .LOOPSTATUS ISNT TRUE
THEN
BEGIN
USRSTV = .XABPTR; ! REMEMBER XAB
LEAVE OUTERLOOP WITH ( ERRORCODE = .LOOPSTATUS )
END;
%([ GO TO NEXT XAB ])%
XABPTR = .TEMP
END; %(OF WHILE LOOP)%
END; %( OF OUTERLOOP )%
%([ FLUSH THE FREE PAGE WE GOT EARLIER ])%
CALLPPAGE ( LCI ( WINDOWPAGE ), PCI ( 1 ), PCI ( TRUE ) );
RETURN .ERRORCODE
END; %(OF DISPFILE)%
END
ELUDOM