Google
 

Trailing-Edge - PDP-10 Archives - RMS-10_T10_704_FT2_880425 - 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