Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE UTLIO	(	 ! Module to do Bucket I/O
	 IDENT = '01-01'
	 ) =

BEGIN

! COPYRIGHT (C) 1980
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A SINGLE
! COMPUTER SYSTEM AND MAY BE COPIED ONLY 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 EXCEPT FOR
! USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE TERMS. TITLE
! TO AND OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
!

!++					
! FACILITY:	RMSUTL
!
! ABSTRACT:
!
!	THIS MODULE DOES ALL THE BKT I/O FOR RMSUTL.
!	IT ALSO DOES INTRA-BKT PROCESSING UPON ID'S & ENTRY NUMBERS.
!	THE BK$ ROUTINES INSURE THE TOP-LEVEL CODE DOESNT KNOW ABOUT BD'S.
!	ALL THAT IS REQUIRED IS CALLING BK$PUT DURING C.CLOSE.
!	OF COURSE, YOU MAY CALL BK$PUT IF YOU WANT TO WRITE A BKT.

! AUTHOR:	A. UDDIN		CREATION DATE: 08-14-80
!

! COMMON RETURNS:
!
!	-1 IF OPERATION ABORTED (MSG ALWAYS OUTPUT)
!	0 IF OPERATION FAILED (EG. ENTRY # TO BK$ENT TOO LARGE)
!	ON SUCCESS, BKT NUMBER OR BKT ADDRESS USUALLY

! TABLE OF CONTENTS:
!
!******************* EDIT HISTORY ************************
!****************** Start RMS-10 V1.1 *********************
!********************* TOPS-10 ONLY ***********************
!
!PRODUCT	MODULE	 SPR
! EDIT	 EDIT	 QAR		DESCRIPTION
!======	======	=====		===========
!
! 100	  1	Dev		Make declarations for TX$APP and TX$TOUT
!				be EXTERNAL ROUTINE so RMS will compile 
!				under BLISS V4 (RMT, 10/22/85).

FORWARD ROUTINE

	BK$ADB,
	BK$DATA,
	BK$DOWN,
	BK$ENT,
	BK$GET,
	BK$ID,
	BK$IDB,
	BK$NEXT,
	BK$PUT : NOVALUE,
	BK$PROL,
	BK$ROOT,
	BK$UP,
	BK$DENT,
	BD$GET,
	BD$PUT: NOVALUE;


!
! REQUIRE FILES:
! 

REQUIRE
	'SYS:RMSINT';

LIBRARY
	'RMSLIB';

! MODULE-LEVEL DATA
!

OWN	ARGLST:	FORMATS [5];
OWN	CURRBD:	FORMATS [BDSIZE];	! MASTER BUCKET DESCRIPTOR
OWN	P_IN_FILE;			! # OF PG IN FILE, FOR BD$GET CONSIS CHK
OWN	RDDESC: FORMATS [RDSIZE];	! REC DESC BLK FOR $UTLINT CALLS
OWN	TEMPBD:	FORMATS [BDSIZE];	! USE THIS BD IF WISH NOT TO CLOB CURRBD


! MACROS:
!


! EQUATED SYMBOLS:
!

LITERAL
	RFMFIX = FB$FIX,		!SO SIZEOF--- RMS MACROS WORK
	SIDHSZ = SIDRHDRSIZE,		!JUST FOR CONVEN
	ONE = 1;

GLOBAL LITERAL BBM_ERR = 0;
GLOBAL LITERAL BBM_INFO = 1;
GLOBAL LITERAL BBM_NONE = 2;

! EXTERNAL REFERENCES:
!

!	Error Messages UTL--- Defined in UTLTOP.
!	TXTOUT MACRO AUTO GENS EXTERNAL REF

EXTERNAL BTY_CLOB,BTY_IDX,BTY_PRIM,BTY_SEC;
				!BKT TYPES
EXTERNAL ROUTINE
	TX$APP : macrosub,
	TX$TOUT : macrosub;
EXTERNAL
	BUF$K1,			! BUFFER FOR KEY
	CU$ENT,			! LAST ENTRY RET BY BK$ENT OR BK$ID
	CU$TYPE,		! TYPE OF LAST BKT GOTTEN BY BK$GC
	FST: POINTER,		! file status table
	BUGERR,			! CHKS FOR RMS BUG ERR & EXITS IF ONE
	INTERR,			! GLOBAL UNWIND LOC FOR INTERNAL ERRS
	PATH: POINTER,		! POINTER TO PATH ARRAY
	KSIZW,			! # OF WDS IN KEY VAL
	KDB: POINTER;		! KEY DESCRIPTOR BLOCK

GLOBAL ROUTINE BK$ADB (AREA_NO) =	! Get area descriptor for area number

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine returns address of the area descriptor corresponding
!	to the given area number.

! FORMAL PARAMETERS:
!
!	The area number

!
! IMPLICIT INPUTS:
!
!	<list of inputs from global or own storage>
!

! IMPLICIT OUTPUTS:
!
!	None

! RETURNS:
!
!	Addr. of ADB

! SIDE EFFECTS:
!
!	The Prolog page will be read in.
!--


BEGIN
	LOCAL	PROLOG:	POINTER;

	PROLOG = $CALL (BK$PROL);		! GET PTR TO PROLOG
	IF .PROLOG LEQ 0 THEN RETURN -1;	!TRANSIT RET FAILURE

	IF .AREA_NO GEQ .PROLOG [FPTAREAS]
	THEN RETURN 0;				!AREA-NO OUT OF RANGE

	PROLOG = .PROLOG + FPTSIZE + 1;		!POINTER TO FIRST ADB
	PROLOG = .PROLOG + (.AREA_NO * AREADESCSIZE);
						!CALC ADDR OF DESIRED ADB
	RETURN .PROLOG;

END;						! end of routine BK$ADB

GLOBAL ROUTINE BK$CHK (BKT_NO) =

! BK$CHK - CHK VALIDIFY OF BKT BUT DO NOT OVWRITE CURR BKT
! ARGUMENTS:
!	BKT_NO = P# OF BKT TO CHK
! RETURNS:
!	-1 IF UNEXP ERR OR BKT CLOBBED
!	1 IF P# OF BKT OK

BEGIN
	CLEAR (TEMPBD, BDSIZE);		!INSURE CLEAN SLATE
	IF $CALL (BD$GET, .BKT_NO, 1, 0, TEMPBD, BBM_ERR) GEQ 0
	THEN BEGIN			!SUCCESS
		$CALL (BD$PUT, TEMPBD, 0);
		RETURN 1;		!TELL USER AFTER CLEANING UP
	END
	ELSE RETURN -1;			!FAILURE
END;

GLOBAL ROUTINE BK$DATA (BKTNO) =	! Get the leftmost data bkt.

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine returns the bucket address and the bucket
!	number of the 'leftmost' data bucket under the current
!	bucket.

! FORMAL PARAMETERS:
!
!	BKTNO		PAGE OF BKT TO BEGIN SCAN AT

! RETURNS:
!
!	BUCKET # FND

BEGIN
	LOCAL
		P_IN_BKT,
		NEXTBD:	FORMATS [BDSIZE],
		BKTPTR:	POINTER;

	P_IN_BKT = .KDB[KDBIBKZ];	! BKT SIZE OF INDEX PAGE FOR CURR KRF

	%([ Get the bucket. There should'nt be any errors. If there ])%
	%([ are,  they should be reported back as system errors.      ])%

	IF $CALL (BD$GET ,.BKTNO, .P_IN_BKT, 0, CURRBD, BBM_ERR) LEQ 0
	THEN RETURN -1;


	BKTPTR = .CURRBD [BKDBKTADR];	! GET ADR OF BKT IN CORE

	IF .BKTPTR [BHBTYPE] ISNT BTYPEINDEX
	THEN
		BEGIN
		TXTOUT (UTLDBC);		!DATA BKT ALREADY CURRENT
		RETURN .BKTNO;			!JUST SHIP BACK ORIG VALUE
	END;


	%([ We now go down the tree till we locate ])%
	%([ the Data bucket.				 ])%

	DO BEGIN
		RDDESC [RDRECPTR] = .BKTPTR + BHHDRSIZE;
						!ADDR OF FIRST REC.

		BLD_ARG_LST (ARGLST, U$GTBKTPTR, RDDESC, CURRBD, NEXTBD);
		$UTLINT (ARGLST,BUGERR);
		IF .ARGLST[0,WRD] EQL FALSE
		THEN BEGIN			!TROUBLE GOING DOWN A LEVEL
			$CALL (M$ERMS, ARGLST, UPLIT(%ASCIZ'?UTLUIO unable to do I/O'));
			RETURN -1;
		END;

		BKTPTR = .NEXTBD [BKDBKTADR];	! GET ADR OF BKT
		$CALL (BD$PUT, CURRBD, FALSE);	! RELEASE THE BKT WE ARE DONE WITH
		MOVEBKTDESC (NEXTBD, CURRBD);	!MAKE THE NEW BKD CURRENT

	END UNTIL .BKTPTR [BHLEVEL] IS DATALEVEL;

	RETURN .CURRBD [BKDBKTNO];		! RETURN BKT NO. VIA REF. ARG

END;						! end of routine BK$DATA

GLOBAL ROUTINE BK$DENT (BKPAGE, BKTADR, RECPTR) =

! BK$DENT - EXPUNGES ANY TYPE OF ENTRY FROM A BKT
! ARGUMENTS:
!	BKPAGE = FILE PAGE OF ENTRY'S BKT
!	BKTADR = ADDR OF BUFFER THAT CONTAINS THE BKT
!	RECPTR = ADDR IN BUFFER OF THE ENTRY TO BE EXPUNGED
! NOTES:
!	IF ENTRY IS UDR, THEN ITS RRV (IF ONE) IS EXPUNGED, & WRITTEN TOO
!	HOWEVER IT IS CALLER'S RESPONS TO WRITE OUT PAGE OF DEL ENT
! CONSIS CHKS MADE:
!	EXPUNGE PRIM DATA ENTRY ONLY IF DEL OR RRV BIT ON
!	EXP INDEX ENTRY ONLY IF IT DOESNT PT AT VALID BKT
!	EXP SIDR ONLY IF RFA ARRAY EMPTY

! IMPLICIT INPUTS:
!	FAB
!	CURRENT KDB

BEGIN

	LABEL IDXLEN;
	LOCAL
		I,
		INUSE,
		PTR : POINTER,
		TEMP,
		RSIZW;
	MAP
		RECPTR:	POINTER,
		BKTADR:	POINTER;

	IF .BKTADR [BHBTYPE] IS BTYPEINDEX	!IS IT INDEX ENTRY?
	THEN	BEGIN				!YES, SET SIZ & CHK IF OK TO DEL
IDXLEN:		BEGIN
		RSIZW = .KDB [KDBKSZW] + 1;	!SIZE OF INDEX ENTRY
		IF .RECPTR[IRBUCKET] GTR .P_IN_FILE
		THEN LEAVE IDXLEN;		!OK TO DEL
		CLEAR (TEMPBD, BDSIZE);		!START WITH NULL BKT DESC
		TEMP = $CALL (BD$GET, .RECPTR[IRBUCKET], 1,0, TEMPBD, BBM_NONE);
						! GET THIS BKT
		IF .TEMP LSS 0			!DID CALL AT LEAST SUCC?
		THEN RETURN -1;			!NO, DONT PLAY WITH FIRE

		PTR = .TEMPBD [BKDBKTADR];	!GET PTR TO IT
		INUSE = .PTR[BHNEXTBYTE];	!GET WDS IN USE
		$CALL (BD$PUT, TEMPBD, 0);	!FREE IT
		IF .TEMP EQL 1 AND .INUSE NEQ BHHDRSIZE
		THEN BEGIN			!OOPS, VALID NON-EMPTY PAGE
			TXTOUT (UTLVEX);	!VALID ENTRY MAY NOT BE EXPUNGED
			RETURN -1;
		END;
	END;					!END IDXLEN BLOCK
	END
	ELSE BEGIN				!DATA ENTRY
	    RSIZW = SIZEOFANYRECORD (RECPTR);	!SIZE OF ARB DATA ENTRY
	    IF .KDB[KDBREF] EQL 0		!IS IT PRIM-DATA BKT?
	    THEN BEGIN				!YES
		IF RRVFLAG(RECPTR) EQL 0 AND DELETEFLAG(RECPTR) EQL 0
		THEN BEGIN			!UNDELETED REC ENTRY
			TXTOUT (UTLVEX);	!VALID ENTRY MAY NOT BE EXPUNGED
			RETURN -1;
		END;
		IF RRVFLAG(RECPTR) EQL 0	!IS IT REC ENTRY?
		THEN IF MAKERFA(.BKPAGE,.RECPTR[DRRECORDID]) NEQ .RECPTR[DRRRVADDRESS]
		THEN BEGIN			!YES, & THERE IS AN RRV FOR IT
			RDDESC[RDRECPTR] = 0;	!START AT TOP OF PAGE
			RDDESC[RDRFA] = .RECPTR[DRRRVADDRESS];
						! AND FIND THIS REC
			BLD_ARG_LST (ARGLST, U$FBYRFA, RDDESC, TEMPBD);
			$UTLINT(ARGLST,BUGERR);	!FIND RRV
			IF .ARGLST NEQ 0	!DID IT SUCCEED?
			THEN BEGIN		!YES
				$CALL (BK$DENT, .TEMPBD[BKDBKTNO], .TEMPBD[BKDBKTADR], .RDDESC[RDRECPTR]);
						!DELETE THE RRV
				SETUPD(TEMPBD);	!INDIC RRV PAGE MODIF
				$CALL (BD$PUT, TEMPBD, 0);
						!RELEASE RRV'S BKT
			END;			!END, DEL RRV
		END;				!END, REC ENTRY WITH RRV
	    END					!END, PRIM-DATA PAGE
	    ELSE INCR I FROM SIDHSZ+.KDB[KDBKSZW] TO .RECPTR[SIDRRECSIZE]+SIDHSZ-1
	    DO BEGIN				!SIDR PAGE
		IF .RECPTR [.I,WRD] NEQ 0	!NON-NULL SIDR
		THEN BEGIN			!YES, CANT DEL IT
			TXTOUT (UTLVEX);	!VALID ENTRY MAY NOT BE EXPUNGED
			RETURN -1;
		END;	
	    END;				!IF EXIT LOOP, RFA ARRAY EMPTY
	END;					!END, IS DATA PAGE

	TEMP = (.BKTADR + .BKTADR [BHNEXTBYTE]) - (.RECPTR + .RSIZW);
						!# OF WRDS TO MOVE
	MOVEWORDS (.RECPTR+.RSIZW, .RECPTR, .TEMP);	!MOVE REST OF BKT UP
	DEC ( BKTADR [BHNEXTBYTE], .RSIZW);	!FIX BKT HDR TOO

	RETURN 1;
END;						%( OF BK$DENT )%

GLOBAL ROUTINE BK$DOWN (BKTNO, ENTRY_NO) =	!Get the bkt pointed to by ENTRY_NO

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine returns the address and entry number of the bucket down
!	the tree which is pointed to by ENTRY_NO in the current bkt.

! FORMAL PARAMETERS:
!
!	ENTRY_NO	Entry no in current bkt which points to the
!			required bkt.

! RETURNS:
!
!	BKT # LOCATED

BEGIN
	LOCAL
		P_IN_BKT,
		MOVINGPTR: POINTER,
		BKTPTR:	POINTER;


	P_IN_BKT = .KDB[KDBIBKZ];	!GET INDEX BKT SIZE FOR CURR KRF

	! BRING STARTING BKT IN

	IF $CALL (BD$GET, .BKTNO, .P_IN_BKT, 0, CURRBD, BBM_ERR) LEQ 0
	THEN RETURN -1;				! INDICATE OPR ABORTED


	BKTPTR = .CURRBD [BKDBKTADR];	! ADDR IN CORE OF CURR BKT

	IF .BKTPTR [BHBTYPE] ISNT BTYPEINDEX	!START BKT INDEX BKT?
	THEN	BEGIN
		TXTOUT (UTLDBC);
		RETURN .BKTNO;			!JUST SHIP ORIG VAL BACK
	END;

	MOVINGPTR = .BKTPTR + BHHDRSIZE;	! ADDR OF FIRST RECORD

	%([	POSITION TO ENTRY_NO IN BUCKET	])%
	%([	CHECK IF IT IS INSIDE THE BKT.	])%

	MOVINGPTR = .MOVINGPTR + (.ENTRY_NO-1) * (.KDB [KDBKSZW] + 1);
	IF .MOVINGPTR GEQ .BKTPTR [BHNEXTBYTE]+.BKTPTR
	THEN BEGIN
		TXTOUT (UTLSEN);		!ENT FOR DOWN NON-EX
		RETURN -1;			! CURRENT BKT NOT INDEX
	END;

	RETURN .MOVINGPTR[IRBUCKET];		!PICK UP BKT NO FROM ENTRY

END;						! end of routine BK$DOWN

GLOBAL ROUTINE BK$ENT (ENTRY_NO) =	! Return addr of ENTRY_NO in current bkt

! FUNCTIONAL DESCRIPTION:
!
!	This routine returns the addr of ENTRY_NO in the
!	current bkt. The current bkt can be either an index
!	bucket or a data bkt.

! FORMAL PARAMETERS:
!
!	ENTRY_NO


! IMPLICIT INPUTS:
!
!	CURRBD, KDB

! RETURNS:
!
!	False IF BAD ENTRY NUMBER
!	Addr. of Entry in Bucket.

BEGIN
	LOCAL
		BKTTYPE,
		MOVINGPTR: POINTER,
		BKTPTR:	POINTER;


	IF .CURRBD [BKDBKTSIZE] EQL 0
	THEN BEGIN
		TXTOUT (UTLIUE);	!NO CURR BKT
		RETURN -1;
	END;

	BKTPTR = .CURRBD [BKDBKTADR];	! ADDR OF BKT IN CORE
	BKTTYPE = .BKTPTR [BHBTYPE];	! GET BKT TYPE

	MOVINGPTR = .BKTPTR + BHHDRSIZE;	! POS TO 1ST ENTRY
	
	%([ SCAN THE BKT. TIL THE REQUESTED ENTRY IS REACHED. ])%

	INCR J FROM 1 TO .ENTRY_NO -1
	DO BEGIN
		IF .MOVINGPTR GEQ .BKTPTR [BHNEXTBYTE]+.BKTPTR
		THEN RETURN FALSE;		!FAIL IF END OF DATA

		MOVINGPTR = .MOVINGPTR + (IF .BKTTYPE IS BTYPEINDEX 
					 THEN
						.KDB [KDBKSZW] + 1
					  ELSE
						SIZEOFANYRECORD (MOVINGPTR));
	END;

	CU$ENT = .ENTRY_NO;		!RET ENTRY # FOUND

	IF .MOVINGPTR GEQ .BKTPTR [BHNEXTBYTE]+.BKTPTR
	THEN RETURN FALSE		!FAIL IF END OF DATA
	ELSE RETURN .MOVINGPTR;		! RETURN ENTRY ADDR.
END;					! end of routine BK$ENT

GLOBAL ROUTINE BK$GET (BKT_NO) = RETURN $CALL (BK$GC, .BKT_NO, BBM_INFO);
GLOBAL ROUTINE BK$GOK (BKT_NO) = RETURN $CALL (BK$GC, .BKT_NO, BBM_ERR);
GLOBAL ROUTINE BK$GQI (BKT_NO) = RETURN $CALL (BK$GC, .BKT_NO, BBM_NONE);

GLOBAL ROUTINE BK$GC (BKT_NO, RETOPT) =

! FUNCTIONAL DESCRIPTION:
!
!	This routine maps in the requested bkt and returns
!	its address.
	
! FORMAL PARAMETERS:
!
!	BKT_NO		BUCKET NUMBER TO MAP
!	RETOPT		IF BBM_INFO, THEN RETS SUCC FOR CLOB BKT
!			IF BBM_ERR, THEN RETS FAILURE FOR CLOB BKT

! IMPLICIT OUTPUTS:
!
!	CU$TYPE IS SET

! RETURNS:
!
!	ADDRESS OF BKT LOCATED

BEGIN
	EXTERNAL UTLFLG,UT_DBAD;
	LOCAL
		GETCASE,
		BKTPTR: POINTER;

	IF CHKFLAG(UTLFLG,UT_DBAD) NEQ 0
	THEN BEGIN
		TXTOUT (UTLEPC);		!DATA ENVIR NOT ESTAB
		RETURN -1;
	END;

	%([ GET REQUESTED BUCKET. ASSUME ITS SIZE TO BE 1.
		IF BKT SIZE GTR 1, BD$GET REREADS CORRECT SIZE AUTOMAT ])%

	GETCASE = $CALL (BD$GET, .BKT_NO, 1, 0, CURRBD, .RETOPT);

	IF .GETCASE LSS 0 THEN RETURN -1;	!COULDNT GET IT, MSG ALR OUTPUT

	BKTPTR = .CURRBD [BKDBKTADR];		!MAKE BKT ACCESSIBLE
	CU$TYPE = $CALL (BK$TYPE, .BKTPTR, .GETCASE);
						!DET TYPE OF BKT
	RETURN .BKTPTR;				!RET BKT'S ADDR
END;						! end of routine BK$GET

GLOBAL ROUTINE BK$ID (ID) =

! FUNCTIONAL DESCRIPTION:
!
!	This routine returns the addr. of bucket entry whose ID
!	matches the given ID.

! FORMAL PARAMETERS:
!	ID	Record ID

! IMPLICIT INPUTS:
!	CURRENT BKT DESC
!
! IMPLICIT OUTPUTS:
!	CU$ENT SET TO ENTRY # OF FND ID
!
! RETURNS:
!	0 IF LOOP TERMINATED WITHOUT SUCCESS
!	Address of FOUND Entry

BEGIN
	LOCAL
		BKTTYPE,
		MOVINGPTR: POINTER,
		BKTPTR:	POINTER;

	IF .CURRBD [BKDBKTSIZE] EQL 0
	THEN BEGIN
		TXTOUT (UTLIUE);	!NO CURR BKT
		RETURN -1;
	END;

	BKTPTR = .CURRBD [BKDBKTADR];	! ADDR OF BKT IN CORE
	IF .BKTPTR [BHLEVEL] GTR DATALEVEL
	THEN				! BKT IS NOT DATA BKT
		BEGIN
		TXTOUT ( UTLBND);
		RETURN -1;
	END;

	MOVINGPTR = .BKTPTR + BHHDRSIZE;	! POSN PAST HEADER
	CU$ENT = 1;				!START WITH 1ST ENTRY
	
	%([ SCAN THE BKT. TIL THE ENTRY WITH REQUESTED ID IS REACHED. ])%

	WHILE .MOVINGPTR LSS .BKTPTR [BHNEXTBYTE]+.BKTPTR
	DO
		BEGIN
		IF .MOVINGPTR [DRRECORDID] EQL .ID
		THEN RETURN .MOVINGPTR;		!SUCCESS

		MOVINGPTR = .MOVINGPTR + SIZEOFANYRECORD (MOVINGPTR);
		CU$ENT = .CU$ENT + 1;		!SET CTR TO NEXT 1
	END;

	RETURN FALSE;
END;						! end of routine BK$ID

GLOBAL ROUTINE BK$IDB (KRF) =

! FUNCTIONAL DESCRIPTION:
!
!	Returns ADDR OF Index Descriptor block for SPECIFIED KRF

! FORMAL PARAMETERS:
!
!	KRF	Target index no. (key of ref.)

! IMPLICIT OUTPUTS:
!
!	CURRBD SETUP

! RETURNS:
!
!	0 (BAD KRF)
!	Addr. of DESIRED IDB

BEGIN
	LOCAL IDBADR;
	LOCAL T1;				!SAVE CURR KREF

	T1 = .KDB[KDBREF];			!RESET AT END OF CALL
	IF NOT $CALL (M$KDB,.KRF)		!SET ENVIR
	THEN RETURN FALSE;			!UNLESS BAD KRF

	$CALL (BD$PUT, CURRBD, 0);		!CLEAR OLD STUFF

	BLD_ARG_LST (ARGLST, U$GETIDB, CURRBD);
	$UTLINT (ARGLST,BUGERR);
	IF .ARGLST [0,WRD] IS FALSE
	THEN	BEGIN
		$CALL (M$ERMS, ARGLST, UPLIT(%ASCIZ'?UTLUIO unable to do I/O'));
		RETURN -1;
	END;
	IDBADR = .ARGLST [0, WRD];		! RETURN IDB ADDR.

	$CALL (M$KDB, .T1);			!RESTORE ORIG KDB INFO
	RETURN .IDBADR;				!DONE
END;						! end of routine BK$IDB

GLOBAL ROUTINE BK$NEXT (BKTNO) =	!Get the Next bkt at the same lvl.

! FUNCTIONAL DESCRIPTION:
!
!	This routine traverses the index structure in the horizontal
!	direction. It gets the bkt at the same level of the tree with
!	the next higher group of keys.

! FORMAL PARAMETERS:
!
!	BKTNO		bucket no. whose NEXT bkt is desired

! RETURNS:
!
!	BKT # FND

! SIDE EFFECTS:
!
!	DISPLAYS INFO MSG IF STARTING BKT IS RIGHTMOST

BEGIN
	LOCAL
		BKTPTR: POINTER;

	! ONLY NEED BKT HDR, SO CAN READ 1 PAGE REGARDLESS OF BKT SIZE

	IF $CALL (BD$GET, .BKTNO, 1, 0,  CURRBD, BBM_INFO) LSS 0
	THEN RETURN -1;

	BKTPTR = .CURRBD[BKDBKTADR];		!GET PTR TO IT
	IF CHKFLAG (BKTPTR [BHFLAGS],BHFLGEND) ISON
	THEN TXTOUT (UTLNBL);			! THERE IS NO NEXT BKT

	BKTPTR = .CURRBD[BKDBKTADR];		!GET PTR TO IT (rpt cause bliss bug)
	RETURN .BKTPTR[BHNEXTBKT];		!RET NEXT PTR
END;						! end of routine BK$NEXT

GLOBAL ROUTINE BK$PUT (FLAG) : NOVALUE =	!Routine to release a bkt.

! FUNCTIONAL DESCRIPTION:
!
!	This routine always releases the bucket that is
!	described by CURRBD. MAY BE CALLED WHEN NO BKT CURRENT.

! FORMAL PARAMETERS:
!
!	FLAG	Update flag

! IMPLICIT INPUTS:
!
!	CURRBD
!

BEGIN

	$CALL (BD$PUT, CURRBD, .FLAG);
	RETURN;

END;					! end of routine bk$put

GLOBAL ROUTINE BK$PROL  =	!Returns the address of Prolog bucket

! FUNCTIONAL DESCRIPTION:
!
!	This routine returns the address of the BUcket contaning
!	the file prolog. It does it in an inelegant manner:
!	It calls on RMS to read the IDB for the key of ref. in
!	the current KDB. The bucket descriptor that is returned
!	is the bkt desc of the prolog page.

! IMPLICIT INPUTS:
!
!	KDB

! IMPLICIT OUTPUTS:
!
!	CURRBD is set up.

! RETURNS:
!
!	ADDR OF PROLOG IF IT COULD BE OBTAINED
!

BEGIN
	LOCAL PT1 : POINTER;
	LOCAL T1;

	%([	READ the IDB.		])%

	T1 = $CALL (BK$IDB, 0);		!TAKE ADVAN THAT 1ST IDB ON 1ST FILE PG
	IF .T1 LEQ 0 THEN RETURN .T1;	! TRANSIT RET FAILURE

	PT1 = .CURRBD[BKDBKTADR];	!GET ADDR OF BEGINNING OF PROLOG
	P_IN_FILE = .PT1[FPTNXTBKT];	!SET TO CURR VALUE, KEEP IT UP TO DATE

	RETURN .PT1;			! RETURN ADDR OF PROLOG BKT

END;					! end of routine BK$PROL

GLOBAL ROUTINE BK$ROOT (KRF) =	!Maps the Root bkt and returns its no.

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine maps the root bkt for the given key-of-ref.

! FORMAL PARAMETERS:
!
!	KRF	Key of reference

! RETURNS:
!
!	0, IMPLYING EMPTY INDEX
!	Bucket number OF DESIRED ROOT BKT

BEGIN
	LOCAL T1;

	IF NOT $CALL (M$KDB,.KRF)		!SET ENVIR FOR SPEC KEY
	THEN BEGIN
		TXTOUT (UTLFNI);		!BAD KRF
		RETURN -1;
	END;

	$CALL (BD$PUT, CURRBD, 0);		!CLEAR OLD STUFF
	BLD_ARG_LST (ARGLST, U$GETROOT, RDDESC, CURRBD);
	$UTLINT (ARGLST,BUGERR);			!HAVE RMS MAP ROOT
	IF .ARGLST [0,WRD] IS FALSE
	THEN
		BEGIN
		T1 = .$FIELD(STS,ARGLST);	!GET STATUS RET BY GETROOT
		IF .T1 EQL ER$RNF OR .T1 EQL ER$EOF THEN RETURN FALSE;
						! INDEX EMPTY
		$CALL (M$ERMS, ARGLST, UPLIT(%ASCIZ'?UTLUIO unable to do I/O'));
		RETURN -1;
	END;
	
	RETURN .CURRBD [BKDBKTNO];
END;					! end of routine BK$ROOT

GLOBAL ROUTINE BK$TYPE (BKTPTR, GETCASE) =

! FUNCTIONAL DESCRIPTION:
!	CALCULATES BKT TYPE OF GIVEN BKT
! ARGUMENTS:
!	BKTPTR = PTR TO BKT TO BE TYPED
!	GETCASE = 1 UNLESS BKT CLOBBED
! RETURNS:
!	BKT TYPE

BEGIN
	MAP BKTPTR : POINTER;

	IF .GETCASE NEQ 1			!CLOBBERED BKT?
	THEN RETURN  BTY_CLOB; 			!YES, CALL WAS _NONE OR _INFO

	IF .BKTPTR[BHLEVEL] NEQ 0		!INDEX BKT?
	THEN RETURN BTY_IDX;			!YES

	IF .KDB[KDBREF] EQL 0			!NO, IS IT UDR?
	THEN RETURN BTY_PRIM			!YES
	ELSE RETURN BTY_SEC;			!NO, 2NDARY DATA BKT

END;						! OF BK$TYPE

GLOBAL ROUTINE BK$UP( BKTNO )  =

! FUNCTIONAL DESCRIPTION:
!	THIS ROUTINE RETURNS THE BUCKET NUMBER OF THE PREVIOUS BUCKET,
!	I.E., THE BUCKET WHICH POINTS TO THE CURRENT BUCKET.
! FORMAL PARAMETERS:
!	BKTNO.	BUCKET NO. WHOSE PREVIOUS BKT IS DESIRED
! RETURNS:
!	FND BKT #
!	0 IF ALREADY AT ROOT

BEGIN
	LOCAL
		LEVEL,
		BKTPTR:	POINTER;

	! GET BKT, ABORT IF ERRS OR IF CLOB

	IF $CALL (BD$GET, .BKTNO, 1, 0, TEMPBD, BBM_ERR) LEQ 0
	THEN RETURN -1;			! COULDNT GET BKT

	BKTPTR = .TEMPBD [BKDBKTADR];	! ADDR OF BKT
	LEVEL = .BKTPTR [ BHLEVEL ];	! SAVE CURRENT LEVEL
	IF CHKFLAG (BKTPTR [BHFLAGS], BHFLGROOT) ISON 
	THEN RETURN 0;			!ALREADY AT ROOT

	RDDESC[RDUSERPTR] = $CALL (M$KLOC, BUF$K1, .BKTPTR+BHHDRSIZE, $CALL(BK$TYPE,.BKTPTR,1));
					!GET (COMBINING IF NECES) 1ST KEY IN BKT

	%([ Set up to actually call the FOLLOWPATH fucntion in RMS ])%

	RDDESC [RDUSERSIZE] = .KDB [KDBKSZ];		!LEN OF KEY TO FIND

	$CALL (BD$PUT, TEMPBD, 0);		!CLEAR OLD STUFF

	BLD_ARG_LST (ARGLST, U$FOLOPATH, RDDESC, TEMPBD);
	$UTLINT (ARGLST,BUGERR);
	IF .ARGLST [0,WRD] IS FALSE
	THEN	BEGIN				!KEY FROM FILE, SO MUST FIND IT
		TXTOUT (UTLAFF);		!COULDNT FIND 1ST KEY ON PAGE
		RETURN -1;
	END;
	$CALL (BD$PUT, TEMPBD, 0);		!CLEAR THIS TOO

	%([ MAKE SURE MASTER BKT NO. AND THE ONE IN THE PATH ARRAY, ])%
	%([ CORRESPONDING TO THE CURRENT LEVEL,  MATCH  ])%

	IF .PATH [.LEVEL, PATHBKT] IS .BKTNO
	THEN	RETURN .PATH[.LEVEL+1,PATHBKT]	! GET PREV BKT NUMBER
	ELSE	BEGIN
		TXTOUT (UTLAFF);		!KEY NOT FND
		RETURN -1;
	END;

END;						! end of routine BK$UP

GLOBAL ROUTINE BD$GET (BKTNO, PAGCNT, LOCKFLG, BD, RETOPT)  =	!CALL ON THE RMS 'GETBKT' FUNC

! FUNCTIONAL DESCRIPTION:
!	SETS UP BKT DESC TO DESIRED BKT, READING IT IN IF NECESSARY
!
! FORMAL PARAMETERS:
!	BKTNO = 1ST PAGE IN FILE OF DESIRED BKT
!	PAGCNT = # OF P TO READ
!	LOCKFLG (ALWAYS 0)
!	BD = PTR TO BKT DESC THAT RMS FILLS IN
!	RETOPT = VALUE TO CTL BAD BKT HDR RETURN ACTION
!
! RETURNS NORMALLY:
!	1 WITH BD SETUP & BKT READ IN
!	-1 IF ANY ERROR MSG OUTPUT
! RETURNS FOR CLOBBERED BKT:
!	-1 & MSG FOR BBM_ERR
!	0 FOR BBM_INFO
!	MSG-PTR FOR BBM_NONE
!
! NOTES:
!	BD$GET HAS A PROBLEM IN THAT RMS BUCKETS CAN BE DIFFERENT SIZE
!	FOR DIFFERENT AREAS. TO LOCALIZE THE IMPACT OF THIS, IT PUTS
!	AND REGETS THE BKT IF THE BKT SIZE PASSED BY CALLER IS WRONG.
!	IT USES THE CURR KDB PLUS BKT TYPE TO DETERMINE ACTU BKT SIZE.
!	IF THE PARTIAL-GET IS THE ONLY CURRENT ACCESSOR OF THE BKT,
!	TWIDDLE RMS'S BUFFER DESC FOR THE BKT TO INSURE IT MAPS WHOLE BKT.

BEGIN
	LOCAL BKTSIZ;			!ACTU # OF P IN BKT
	LOCAL BKTPTR:POINTER;
	LOCAL BBM;
	MAP BD:POINTER;

	$CALL (BD$PUT, .BD, 0);		!CLEAR OLD STUFF

	IF .P_IN_FILE LEQ .BKTNO	!REF PAST EOF?
	THEN BEGIN			!MAYBE, CHK IF FILE EXTENDED
		IF $CALL (BK$PROL) EQL -1	!GET PROLOG TO RESET P_IN_FILE
		THEN RETURN -1;	!OOPS (MSG ALR OUTPUT)
		IF .P_IN_FILE LEQ .BKTNO
		THEN BEGIN		!"STILL" PAST EOF, GIVE ERROR
			TXTOUT(UTLPPE,.BKTNO);
					!PAGE PAST EOF
			RETURN -1;
		END;
	END;

	BLD_ARG_LST (ARGLST, U$GETBKT, .BKTNO, .PAGCNT, .LOCKFLG, .BD);
	$UTLINT (ARGLST,BUGERR);
	IF .ARGLST[0,WRD] EQL FALSE
	THEN BEGIN			!OOPS
	    $CALL (M$ERMS, ARGLST, UPLIT(%ASCIZ'?UTLUIO unable to do I/O'));
	    RETURN -1;
	END;

	BKTPTR = .BD [BKDBKTADR];		! ADDR OF BKT IN CORE

	!MAKE CONSIS CHKS:
	! INDEX MUST HAVE NON-0 LEVEL
	! DATA MUST HAVE 0 LEVEL
	! NEXTBYTE MUST BE GTR 2 AND LE BKT SIZE
	! AREA # MUST AGREE WITH KDB

	BBM = 0;				!SET TO DEFINED VAL
	IF .BKTPTR[BHBTYPE] EQL BTYPEDATA
	THEN	IF .BKTPTR[BHLEVEL] EQL 0	!DOES LEVEL AGREE WITH TYPE?
		THEN BEGIN			!YES, SET DATA BKT SIZE
			BKTSIZ = .KDB[KDBDBKZ];	! FROM KDB
			IF .KDB[KDBDAN] NEQ .BKTPTR[BHTHISAREA]
			THEN BBM = UPLIT (%ASCIZ 'area number');
		END
		ELSE BBM = UPLIT (%ASCIZ 'type/level');
						!BAD INFO IN BKT HDR
	IF .BKTPTR[BHBTYPE] EQL BTYPEINDEX
	THEN	IF .BKTPTR[BHLEVEL] NEQ 0	!DOES LEV AGREE FOR IDX BKT?
		THEN BEGIN			!YES, SET DATA BKT SIZE
			BKTSIZ = .KDB[KDBIBKZ];	! FROM KDB
			IF .KDB[KDBIAN] NEQ .BKTPTR[BHTHISAREA]
			THEN BBM = UPLIT (%ASCIZ 'area number');
		END
		ELSE BBM = UPLIT (%ASCIZ 'type/level');

	IF .BKTPTR[BHBTYPE] GTR 1		!TYPE OUT OF RANGE?
	THEN BBM = UPLIT (%ASCIZ 'type');	!YES

	IF .BKTPTR[BHNEXTBYTE] LSS BHHDRSIZE	!1ST FREE TOO SMALL?
			OR
	 .BKTPTR[BHNEXTBYTE] GTR (.BKTSIZ^P2W)	! OR TOO LARGE?
	THEN BBM=UPLIT(%ASCIZ 'words-in-use');	!YES TO EITHER

	IF .BBM NEQ 0				!BAD BKT MSG SET UP?
	THEN BEGIN
		IF .RETOPT EQL BBM_NONE		!LET CALLER PUT MSG?
		THEN RETURN .BBM;		!YES, RET PTR TO BAD INFO
		IF .RETOPT EQL BBM_ERR		!TREAT AS BARF CONDIT?
		THEN BEGIN			!YES, PUT ERR MSG
			$CALL (BD$PUT, .BD, 0);	!CLEAN UP AFT ABORT
			TXTOUT (UTLPNE, .BKTNO, .BBM, .KDB[KDBREF]);
			RETURN -1;
		END;
		IF .RETOPT EQL BBM_INFO		!TREAT AS INFO COND?
		THEN BEGIN			!YES, DISP/CH B H
			TXTOUT (UTLPNI, .BKTNO, .BBM, .KDB[KDBREF]);
			RETURN 0;		!DONT TRUST REST OF BKT
		END;
	END;

	! GET WHOLE BKT NOW IF PARTIAL BKT SIZE WAS SPEC

	IF .PAGCNT NEQ .BKTSIZ			!DID THE KLUDGE LUCK OUT?
	THEN BEGIN				!NO, GET RIGHT SIZE
		LOCAL BFD:POINTER;		!PTR TO BKT'S BUFF DESC
		$CALL (BD$PUT, .BD, 0);		!RELEASE PARTIAL BKT
		BFD = .BD[BKDBFDADR];		!GET PTR TO BUFF DESC
		IF .BFD[BFDUSECOUNT] EQL 0	!WAS EARLIER GETBKT ONLY USER?
		THEN BFD[BFDBKTSIZ] = 0;	!YES, MAKE RMS THINK BUFF EMPTY

		BLD_ARG_LST (ARGLST, U$GETBKT, .BKTNO, .BKTSIZ, .LOCKFLG, .BD);
		$UTLINT (ARGLST,BUGERR);
		IF .ARGLST[0,WRD] EQL FALSE
		THEN BEGIN			!OOPS
		    $CALL (M$ERMS, ARGLST, UPLIT(%ASCIZ'?UTLUIO unable to do I/O'));
		    RETURN -1;
		END;
	END;

	RETURN 1;				! SUCCESS
END;						! end of routine BD$GET

GLOBAL ROUTINE BD$PUT (BD, UPDATEFLAG) : NOVALUE = !CALL THE RMS 'PUTBKT' FUNC

! FUNCTIONAL DESCRIPTION:
!
!	RELEASE THE SPEC BKT, OUTPUTTING IF UPDATEFLAG SET
!
! FORMAL PARAMETERS:
!
!	BD = PTR TO BKT DESC TO RELEASE
!	UPDFLAG = TRUE IF BKT SHOULD BE WRITTEN
!

BEGIN
	MAP	BD : POINTER;

	IF NULLBD(BD) THEN RETURN;	!BKT DESC EMPTY

	BLD_ARG_LST (ARGLST, U$PUTBKT, .UPDATEFLAG, .BD);
	$UTLINT (ARGLST,INTERR);	! NO ERRORS EXPECTED

	SETNULLBD(BD);			!INSURE NOT "PUT" TILL AGAIN OCC
	RETURN;
END;					! end of routine PUTBKT

END
ELUDOM