Google
 

Trailing-Edge - PDP-10 Archives - cuspbinsrc_2of2_bb-fp63b-sb - 10,7/rms10/rmssrc/rmsget.b36
There are 6 other files named rmsget.b36 in the archive. Click here to see a list.

MODULE GET =

BEGIN

GLOBAL BIND	GETV = 1^24 + 0^18 + 8;		!EDIT DATE: 21-JUN-77

%([

FUNCTION:	THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
		THE $GET MACRO FOR 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
	=======			========

	$GET			DISPATCHER FOR $GET USER MACRO

	DOGETASCII		PERFORM $GET FOR ASCII FILES

	DOGETSEQ		PERFORM $GET FOR SEQUENTIAL FILES

	DOGETREL		PERFORM $GET FOR RELATIVE FILES

	DOGET		PERFORM $GET FOR INDEXED FILES

	GETREC			I/O ROUTINE FOR $GET PROCESSOR

	PADBUFFER		ROUTINE TO PAD USER'S BUFFER FOR RB$PAD

	GET			ROUTINE TO GET A RECORD FROM INDEXED FILE




REVISION HISTORY:

EDIT	DATE		WHO			PURPOSE
====	====		===			==========

1	1-NOV-76	SEB		NO ABORT FOR GTBYTE
2	16-NOV-76	SEB		ADD GETIDX AND FIX LOCATE MODE BUG
3	16-DEC-76	SEB		CHANGE ERPOS TO ERCUR
4	22-DEC-76	SEB		MAKE UPD,DEL,TRU IMPLY FB$GET IN FAC
5	5-APR-77	SEB		MAKE GETREC USE RSZW FOR ALL FILES
6	4-MAY-77	SEB		RELEASE BUCKET FOR IDX FILE IF READ-ONLY
7	21-JUN-77	SEB		FIX GETIDX SO FIND-GET ON
					SEC KEY CLEARS THE RSTNRP FIELD

*************************************************
*						*
*		NEW REVISION HISTORY		*
*						*
*************************************************

****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************

PRODUCT	MODULE	 SPR
 EDIT	 EDIT	 QAR		DESCRIPTION
======	======	=====		===========

 100	  8	Dev		Make declarations for routine names
				be EXTERNAL ROUTINE so RMS will compile 
				under BLISS V4 (RMT, 10/22/85).


	***** END OF REVISION HISTORY *****



])%




	%([ EXTERNAL DECLARATIONS ])%
EXTERNAL ROUTINE
    CRASH,
    DUMP,		! DEBUGGING ROUTINE
    DOEOF,		! PROCESS EOF CONDITION
    GETASCII,
    LOCKIT;
!    MOVESTRING,
!    FNDREL;


%([ EXTERNAL ERROR MESSAGES CONTAINED IN THIS MODULE ])%

EXTERNAL
!    MSGPGONE,		! FILE PAGE MISSING
    MSGBKT,			! CURRENT BUCKET IS NULL
    MSGKDB,			! BAD KDB VALUE
    MSGINPUT,		! BAD INPUT ARGS TO A ROUTINE
!    MSGUNLOCKED,		! RECORD IS UNLOCKED
    MSGFAILURE;		! ROUTINE FAILURE


FORWARD ROUTINE		GETREC;



REQUIRE 'RMSREQ';
EXTDECLARATIONS;



! $GET
! ====

! PROCESSOR FOR $GET MACRO

! INPUT:
!	ADDRESS OF USER RECORD BLOCK (RAB)
!	ADDRESS OF USER ERROR ROUTINE

! OUTPUT:
!	<STATUS FIELD>


! GLOBALS USED:
!	$FIND
!	FINDASCII
!	FINDSEQ
!	FINDREL
!	GETASCII
!	GETREC
!	LOCKIT

! FORMAT OF THE $GET MACRO:
!
!		$GET	<RAB-ADDRESS> [,<ERROR-ADDRESS>]
!
!! RAB FIELDS USED AS INPUT TO $GET:
!
!	ISI		INTERNAL STREAM IDENTIFIER
!	KBF		KEY BUFFER ADDRESS (RELATIVE/INDEXED)
!	KRF		KEY OF REFERENCE (INDEXED)
!	KSZ		SIZE OF KEY IN BUFFER (INDEXED)
!	RAC		RECORD ACCESS
!	RFA		RECORD'S FILE ADDRESS
!	ROP		RECORD OPTIONS
!		RB$LOC		USE LOCATE MODE
!		RB$RAH		READ-AHEAD
!		RB$KGT		KEY IS GREATER THAN (INDEXED)
!		RB$KGE		KEY IS GREATER THAN OR EQUAL TO (INDEXED)
!	UBF		ADDRESS OF USER RECORD BUFFER
!	USZ		SIZE OF USER RECORD BUFFER

! RAB FIELDS WHICH ARE RETURNED BY $GET:
!
!	BKT		RELATIVE RECORD NUMBER OF TARGET RECORD (RELATIVE)
!	LSN		LINE-SEQUENCED NUMBER (ASCII)
!	RBF		ADDRESS OF RECORD TRANSFERED
!	RFA		RECORD'S FILE ADDRESS
!	RSZ		SIZE OF RECORD TRANSFERED
!	STS		STATUS OF OPERATION
!	STV		ADDITIONAL STATUS INFORMATION


GLOBAL ROUTINE %NAME('$GET') ( BLOCK, ERRORRETURN ) =
BEGIN
	ARGUMENT (BLOCK,BASEADD);
	ARGUMENT (ERRORRETURN,BASEADD);

EXTERNAL ROUTINE
    DOGETASCII,	! PROCESSS $GET FOR ASCII FILES
    PADBUFFER,	! PAD THE USER'S BUFFER
    DOGETSEQ,	! PROCESS $GET FOR SEQUENTIAL FILES
    DOGETREL,	! PROCESS $GET FOR RELATIVE FILES
%IF INDX %THEN
    DOGETIDX,	! PROCESS $GET FOR INDEXED FIES
%FI
    RSETUP;

	RMSENTRY ($GET);

	%([ FETCH THE ADDRESS OF THE USER RAB AND ERROR ROUTINE ])%

	RAB = .BLOCK;				! GET RAB ADDRESS
	ERRADR = .ERRORRETURN;	! AND USER ERROR ADDRESS

	%([ PERFORM STANDARD SET-UP AND CHECK FOR READ ACCESS.
	   NOTE THAT IF ANY BIT IN THE FAC FIELD IS SET OTHER THAN
	   FB$PUT, THEN A $GET OPERATION IS LEGAL ])%

	CALLRSETUP (PCI (AXGET+AXUPD+AXDEL+AXTRN));	! SET UP PARAMETERS

	%([ SET UP THE USER'S RBF FIELD ])%

	IF ( RAB [ RABRBF ] = .RAB [ RABUBF ] ) LEQ MINUSERBUFF THEN USERERROR ( ER$UBF );

	%([ DISPATCH TO THE PROPER ROUTINE FOR THIS FILE ORGANIZATION ])%

	CASE FILEORG FROM 0 TO 3 OF
	SET

		[0]:	%(ASCII)%	CALLDOGETASCII;
		[1]:	%(SEQUNTIAL)%	CALLDOGETSEQ;
		[2]:	%(RELATIVE)%	CALLDOGETREL;
		%IF INDX %THEN
		[3]:	%(INDEXED)%	CALLDOGETIDX
		%FI

	TES;	%(END OF CASE FILEORG)%

	%([ PAD THE USER'S BUFFER, IF HE WANTS IT. ])%

	IF ( CHKFLAG ( RAB [ RABROP ], ROPPAD ) ISON )
	THEN
		CALLPADBUFFER;

	%([ INDICATE THAT THIS OPERATION WAS A SUCCESS ])%

	SETSUCCESS;						! THIS WAS DONE CORRECTLY

	%([ EXIT TO THE USER ])%

	USEREXIT

END;	%( OF $GET )%



! DOGETASCII
! ==========

! ROUTINE TO PROCESS THE $GET MACRO FOR ASCII FILES.
!	THIS ROUTINE MUST INSURE THAT THE ASCII FILE
!	IS CORRECTLY POSITIONED TO THE RECORD, AND THEN
!	MUST TRANSFER THE DATA INTO THE USER'S BUFFER.

! INPUT:
!	<NONE>

! OUTPUT:
!	<NO STATUS RETURNED>

! NOTES:
!
!	1.	ON AN ERROR, THIS ROUTINE WILL NOT EXIT TO THE
!		MAIN $GET PROCESSOR, BUT WILL EXIT DIRECTLY TO
!		THE USER.

GLOBAL ROUTINE DOGETASCII: NOVALUE  =
BEGIN

EXTERNAL ROUTINE
    FINDASC,	! LOCATE THE ASCII RECORD
    GETASCII;	! MOVE THE RECORD

	TRACE ('DOGETASCII');

	%([ IF THE LAST OPERATION WAS NOT A $FIND, THEN WE
	   MUST INSURE THAT WE ARE POSITIONED AT THE CORRECT
	   RECORD. IF THE LAST OPERATION WAS A $FIND, THEN WE
	   ARE ALREADY AT THE TARGET RECORD. ])%

	IF .RST [ RSTLASTOPER ] ISNT C$FIND
	THEN	%(LOCATE THE RECORD)%
		CALLFINDASC;

	%([ MOVE THE RECORD AND SET UP THE USER'S RSZ FIELD ])%

	RAB [ RABRSZ ] = CALLGETASCII ( PCI ( TRUE ) );	! MOVE THE DATA

	RETURN 

END; %(OF DOGETASCII)%



! DOGETSEQ
! ========

! ROUTINE TO ACTUALLY PERFORM THE $GET MACRO FOR SEQUENTIAL FILES.
!	THIS ROUTINE MUST LOCATE THE CURRENT RECORD AND THEN
!	TRANSFER ALL ITS DATA INTO THE USER'S BUFFER. IF THE LAST
!	OPERATION WAS A $FIND, THEN WE ARE ALREADY AT THE CURRENT
!	RECORD AND THE DATA CAN BE MOVED IMMEDIATELY. IF THE
!	USER SPECIFIED LOCATE MODE FOR HIS $GET OPERATION, AND IF
!	HE IS ONLY READING THE FILE, THEN WE WILL MERELY
!	RETURN A POINTER TO THE RECORD IN HIS RBF FIELD INSTEAD
!	OF ACTUALLY MOVING THE DATA TO HIS BUFFER.

! INPUT:
!	<NONE>

! OUTPUT:
!	<NO STATUS RETURNED>

! NOTES:
!
!	1.	IF AN ERROR OCCURS, THIS ROUTINE WILL EXIT DIRECTLY
!		TO THE USER.
!
!	2.	IF THE LAST OPERATION WAS A $FIND, THEN IT IS
!		ASSUMED THAT THE NRP IS NOT SET UP AND MUST BE
!		COMPUTED BY THIS ROUTINE.

GLOBAL ROUTINE DOGETSEQ: NOVALUE  =
BEGIN

EXTERNAL ROUTINE
    FINDSEQ,	! LOCATE THE RECORD
    GETREC;		! MOVE THE DATA

LOCAL
    CRP;			! ADDRESS OF CURRENT RECORD

	TRACE ('DOGETSEQ');

	%([ IF THE LAST OPERATION WAS A $FIND, AND THIS IS A
	   $GET SEQUENTIAL, THEN WE ARE ALREADY LOCATED AT
	   THE TARGET RECORD. IF NOT, WE MUST LOCATE IT ])%

	IF	SEQADR			%(SEQUENTIAL ACCESS)%
		AND
		( .RST [ RSTLASTOPER ] IS C$FIND )
	THEN	%(WE ALREADY HAVE A CURRENT RECORD)%

		BEGIN

		%([ FETCH THE CURRENT RECORD AND CHECK IT ])%

		CRP = ( RAB [ RABRFA ] = .RST [ RSTDATARFA ] );
		IF .CRP IS ZERO THEN USERERROR ( ER$CUR );	! NO RP

		%([ COMPUTE THE NRP VALUE BECAUSE THE $FIND OPERATION
		   DID NOT RESET IT ])%

		RST [ RSTNRP ] = 	.CRP		%(CURRENT RECORD)%
					+
					HEADERSIZE	%(SIZE OF HEADER)%
					+
					.RST [ RSTRSZW ]; %(SIZE OF LAST REC)%
		END	%(OF IF LAST OPER WAS A $FIND)%

	ELSE	%(WE MUST FIND THE RECORD)%

		CALLFINDSEQ;

	%([ TRANSFER THE RECORD INTO THE USER'S BUFFER ])%

	RAB [ RABRSZ ] = CALLGETREC;

	RETURN 

END;	%(OF DOGETSEQ)%


! GETREC
! ======

! THIS ROUTINE PERFORMS THE ACTUAL "GET"ING OF A
!	RECORD FROM A SEQUENTIAL OR RELATIVE FILE.
!	ON INPUT, THE FILE PAGE MUST BE CORRECTLY MAPPED
!	AND PAGPTR MUST POINT TO THE FIRST WORD
!	OF THE HEADER.  IF THE FILE IS OPENED
!	IN LOCATE MODE AND THE RECORD DOESN'T SPAN
!	THE PAGE BOUNDARIES, THEN THE RECORD IS NOT
!	MOVED, A POINTER TO IT IS RETURNED.

! INPUT:
!	<NONE>

! OUTPUT:
!	# OF BYTES MOVED

! GLOBALS USED:
!	GTBYTE
!	MOVEREC

! NOTES:
!
!	1. THE FOLLOWING MACROS ARE USED WITHIN THIS ROUTINE. THESE
!		ARE DEFINED IN "BUFFER.REQ":
!
!			CURRENTWINDOW
!			CURRENTFILEPAGE
!
!	2.	ON INPUT TO THIS ROUTINE, THE FOLLOWING FIELDS ARE
!		ASSUMED TO SET UP:
!			RSTRSZ		SIZE IN BYTES OF RECORD
!			RSTRSZW		SIZE IN WORDS OF RECORD

GLOBAL ROUTINE GETREC  =
BEGIN
LOCAL
    RECORDPTR,
    WORDCOUNT,
    BYTECOUNT,
    BYTESIZE,
    BYTESWORD,
    USERPTR,
    CRP,
    BYTEADR,
    USERBUFFSIZE;

REGISTER
    TEMPAC;		! USED FOR TEMP CALCULATIONS

MAP
    RECORDPTR:	FORMAT;


EXTERNAL ROUTINE
    GTBYTE,
    MOVEREC;

	TRACE ('GETREC');

	%([ GET THE POINTER TO THE CURRENT RECORD ])%

	RECORDPTR = .RST [ RSTPAGPTR ];

	%([ GET VARIOUS VALUES ])%

	BYTESIZE = .FST [ FSTBSZ ];		! FILE BYTE SIZE
	BYTECOUNT = .RST [ RSTRSZ ];		! RECORD BYTE COUNT
	WORDCOUNT = .RST [ RSTRSZW ];		! RECORD WORD COUNT

	%([ IF THE USER SPECIFIED THAT HE WANTED LOCATE MODE,
	   AND IF HE IS ONLY READING THE FILE (IF HE IS WRITING
	   IT, LOCATE MODE IS DISABLED), THEN WE MUST CHECK TO
	   SEE IF THE RECORD SPANS PAGE BOUNDARIES. ])%

	IF LOCATEMODE AND INPUTMODE 
	THEN	%( CHECK FOR SPANNING RECORD )%

		BEGIN
		IF ( .RECORDPTR [OFSET]		 %( OFFSET INTO CURRENT PAGE )%
			+ HEADERSIZE		 %( PLUS SIZE OF HEADER )%
			+ .WORDCOUNT )		 %( PLUS RECORD LENGTH )%
			LEQ PAGESIZE %( IS LESS THAN ONE PAGE )%
		THEN %( THE RECORD DOESN'T SPAN PAGES )%
			BEGIN
			RAB [ RABRBF ] = .RECORDPTR + HEADERSIZE;	! CONTRUCT POINTER TO OUR BUFFER
			RETURN .BYTECOUNT;			! RETURN
			END	%( OF IF RECORD DOESN'T SPAN )%
		END;	%( OF IF LOCATEMODE )%




	%([ AT THIS POINT, EITHER WE ARE IN MOVE MODE OR
	THE RECORD SPANS PAGES.  IN EITHER CASE, THE
	RECORD WILL BE MOVED INTO THE USER'S BUFFER ])%

	RECORDPTR = .RECORDPTR + HEADERSIZE;			! COMPUTE START OF DATA

	%([ CHECK IF DATA PORTION OF RECORD BEGINS ON  NEXT PAGE )%

	%([ NOTE THAT THIS NEXT CHECK MAKES NO ASSUMPTION ABOUT
	   THE SIZE OF THE RECORD HEADER. IF THE ASSUMPTION IS
	   MADE THAT THE HEADER IS ALWAYS 1 WORD LONG, THEN THIS
	   CHECK CAN BE MADE SIMPLER AND FASTER ])%

	IF .RECORDPTR [ PAGE ] ISNT .CURRENTWINDOW THEN		! DID WE GO OVER THE FILE PAGE?

		BEGIN
		BYTEADR = ( .CURRENTFILEPAGE + 1 ) ^ P2W;	! FIND BYTE OF NEXT FILE PAGE
		CALLGTBYTE (	 %(RFA ADDR)%	LCI (BYTEADR),
				%(NO ABORT)%	PCI (FALSE));

		RECORDPTR = .RST [ RSTPAGPTR ]			! GET THE UPDATED DATA POINTER

		END;	%( IF RECORD DATA BEGINS ON NEXT PAGE )%



	%([ THE DATA PORTION OF THE RECORD IS NOW
	   IN THE WINDOW AND PAGPTR POINTS TO IT.
	   WE MUST DETERMINE IF THE RECORD IS TOO BIG
	   FOR THE USER'S BUFFER.  ])%

	USERBUFFSIZE = .RAB [ RABUSZ ];
	IF .WORDCOUNT GTR .USERBUFFSIZE
	THEN

		%( RECORD CANT FIT IN BUFFER )%

		BEGIN	%( TO COMPUTE HOW MUCH OF IT WILL FIT )%
		USRSTS = ER$RTB;					! SET "PARTIAL RECORD" CODE
		USRSTV = .BYTECOUNT;				! RETURN SIZE OF RECORD
		BYTECOUNT = (36 / .BYTESIZE ) * .USERBUFFSIZE		! USER-BUFFER
		END;	%( OF CHECKING FOR PARTIAL RECORD )%



	%([ AT THIS POINT, WE HAVE THE FOLLOWING VALUES:
		BYTECOUNT = # OF BYTES TO BE TRANSFERRED
		RECORDPTR = ADDRESS OF 1ST DATA WORD IN RECORD

	WE CAN NOW MOVE THE RECORD INTO USERS BUFFER ])%

	USERPTR = .RAB [ RABUBF ];				! GET ADRESS OF USER BUFFER

	IF CALLMOVEREC (LCI (RECORDPTR),			%( FROM HERE... )%
			LCI (USERPTR),			%( TO HERE )%
			PCI (FALSE),			%( THIS IS A GET )%
			LCI (BYTECOUNT),		%( BYTES TO MOVE )%
			LCI (BYTESIZE))		%( SIZE OF EACH BYTE )%
	IS FALSE THEN RMSBUG ( MSGFAILURE );			! ROUTINE FAILURE

	%([ IF THE FILE IS ONLY BEING READ, THEN WE CAN
	   IMMEDIATELY UNLOCK THE CURRENT RECORD ])%

	IF INPUTMODE
	THEN IF DATALOCKED
		THEN
			UNLOCK ( RST [ RSTDATARFA ] );	! UNLOCK CURRENT RECORD

	%([ RETURN THE SIZE OF THE RECORD MOVED ])%

	RETURN	.BYTECOUNT					! RETURN # OF BYTES MOVED

END;	%( OF GETREC )%



! DOGETREL
! ========

! ROUTINE TO ACTUALLY PERFORM THE $GET MACRO FOR SEQUENTIAL FILES.
!	THIS ROUTINE MUST LOCATE THE CURRENT RECORD AND THEN
!	TRANSFER ALL ITS DATA INTO THE USER'S BUFFER. IF THE LAST
!	OPERATION WAS A $FIND, THEN WE ARE ALREADY AT THE CURRENT
!	RECORD AND THE DATA CAN BE MOVED IMMEDIATELY. IF THE
!	USER SPECIFIED LOCATE MODE FOR HIS $GET OPERATION, AND IF
!	HE IS ONLY READING THE FILE, THEN WE WILL MERELY
!	RETURN A POINTER TO THE RECORD IN HIS RBF FIELD INSTEAD
!	OF ACTUALLY MOVING THE DATA TO HIS BUFFER.

! INPUT:
!	<NONE>

! OUTPUT:
!	<NO STATUS RETURNED>

! NOTES:
!
!	1.	IF AN ERROR OCCURS, THIS ROUTINE WILL EXIT DIRECTLY
!		TO THE USER.
!
!	2.	IF THE LAST OPERATION WAS A $FIND, THEN IT IS
!		ASSUMED THAT THE NRP IS NOT SET UP AND MUST BE
!		COMPUTED BY THIS ROUTINE.

GLOBAL ROUTINE DOGETREL: NOVALUE  =
BEGIN

EXTERNAL ROUTINE
    FINDREL,	! LOCATE THE RECORD
    GETREC;		! MOVE THE DATA

LOCAL
    CRP;			! ADDRESS OF CURRENT RECORD

	TRACE ('DOGETREL');

	%([ IF THE LAST OPERATION WAS A $FIND, AND THIS IS A
	   $GET SEQUENTIAL, THEN WE ARE ALREADY LOCATED AT
	   THE TARGET RECORD. IF NOT, WE MUST LOCATE IT ])%

	IF	SEQADR			%(SEQUENTIAL ACCESS)%
		AND
		( .RST [ RSTLASTOPER ] IS C$FIND )
	THEN	%(WE ALREADY HAVE A CURRENT RECORD)%

		BEGIN

		%([ FETCH THE CURRENT RECORD AND CHECK IT ])%

		CRP = ( RAB [ RABRFA ] = .RST [ RSTDATARFA ] );
		IF .CRP IS ZERO THEN USERERROR ( ER$CUR );	! NO RP

		%([ COMPUTE THE NRP VALUE BECAUSE THE $FIND OPERATION
		   DID NOT RESET IT ])%

		RST [ RSTNRP ] = .CRP + 1			! BUMP RP
		END	%(OF IF LAST OPER WAS A $FIND)%

	ELSE	%(WE MUST FIND THE RECORD)%

		CALLFINDREL;

	%([ TRANSFER THE RECORD INTO THE USER'S BUFFER ])%

	RAB [ RABRSZ ] = CALLGETREC;

	RETURN 

END;	%(OF DOGETREL)%


! DOGETIDX
! ========

! ROUTINE TO PERFORM THE PRIMARY PROCESSING FOR THE $GET MACRO
!	FOR AN INDEXED FILE.  IF THE LAST OPERATION WAS A $FIND,
!	THEN THE CURRENT RECORD (DATARFA) POSITION IS ALREADY
!	SET UP AND WE CAN DIRECTLY ACCESS THE RECORD. IF NOT,
!	WE MUST CALL FINDIDX TO LOCATE THE TARGET RECORD.

! INPUT:
!	<NONE>

! OUTPUT:
!	<NO STATUS RETURNED>

GLOBAL ROUTINE DOGETIDX: NOVALUE  =
 BEGIN

%IF INDX %THEN
 
 LOCAL
    RECDESC:	FORMATS[ RDSIZE ],	! RECORD DESCRIPTOR PACKET
    DATABD:	FORMATS[ BDSIZE ],	! BUCKET DESCRIPTOR
    KEYOFREFERENCE,			! RP KRF
    RECORDPTR:	POINTER,		! PTR TO CURRENT RECORD
    SAVEDKDB;			! SAVE THE ADDRESS OF CURRENT KEY

REGISTER TEMPAC;
 
  EXTERNAL ROUTINE
    FBYRFA,			! LOCATE RECORD BY ITS RFA
    SETNRP,			! SET UP THE NEXT-RECORD-POINTER
    PUTBKT,			! RELEASE THE CURRENT BUCKET
    GETKDB,
    GETIDX,			! READ A RECORD FROM INDEXED FILE
    FINDIDX;		! FIND THE TARGET RECORD
 
 
 	TRACE ('DOGETIDX');
 
 	%([ FOR A $FIND-$GET SEQUENCE, WE MUST LOCATE THE
 	   CURRENT RECORD BY ITS RFA ADDRESS. ])%
 
 	IF SEQADR AND ( .RST [ RSTLASTOPER ] IS C$FIND )
 	THEN	%(WE MUST LOCATE THE RECORD)%
 
 		BEGIN
 
 		%([ WE MUST NOW FETCH THE RP RFA AND STORE IT IN THE REC
 		   DESCRIPTOR. NOTE THAT THIS RFA IS OF THE USER
 		   DATA RECORD. THUS, IF THE $FIND WAS DONE ON A
 		   SECONDARY KEY, WE HAVE NO RFA FOR THE SIDR SO WE
 		   MUST MAKE SURE THAT WE DON'T USE THE UDR RFA AS THE
 		   NRP POINTER BECAUSE THE NRP MIGHT REPRESENT THE SIDR
 		   RFA. ])%
 
		IF (TEMPAC = .RST [ RSTDATARFA ]) IS ZERO	! GET UDR RFA
		THEN USERERROR ( ER$CUR ); 	! NO CURRENT RECORD

 		%([ IF THE FIND WAS BY SECONDARY KEY, DONT USE THIS VALUE ])%

		IF .RST [ RSTRPREF ] ISNT REFPRIMARY THEN TEMPAC = ZERO;
		RECDESC [ RDRFA ] = .TEMPAC;

		%([ NOW, SET UP THE SIDR-ELEMENT OFFSET WHICH WE KEEP
		   IN THE RST. WE WILL NEED IT IN "SETNRP". ])%

		RECDESC [ RDSIDRELEMENT ] = .RST [ RSTRPSIDR ];	![%44] CONV TENTA SIDR ELEM TO ACTUAL 1


 		%([ LOCATE THE CURRENT RECORD ])%
 
		KEYOFREFERENCE = .RST [ RSTRPREF ];		! USE RP KEY-OF-REFERENCE
		IF (KDB = CALLGETKDB ( LCI ( KEYOFREFERENCE ) )) IS FALSE
		THEN RMSBUG ( MSGKDB  );

		FETCHCURRENTBKT ( DATABD );		! GET THE CURRENT BUCKET
		IF NULLBD ( DATABD ) THEN RMSBUG ( MSGBKT );	! CHECK IT OUT

		%([ GET THE POINTER TO THE CURRENT RECORD ])%

		RECORDPTR = ( RECDESC [ RDRECPTR ] = .RST [ RSTPAGPTR ] );
 
 		%([ WE MUST NOW SET UP THE ADDRESS OF THE RRV OF THIS
 		   RECORD, SINCE IT IS NOT KEPT INTERNALLY (ONLY THE
 		   NRP RRV ADDRESS IS MAINTAINED IN THE RST).
 		   TO DO THIS, WE MUST ACTUALLY ACCESS THE RECORD ])%
 
 		RECDESC [ RDRRV ] = .RECORDPTR [ DRRRVADDRESS ]
 		END	%(OF IF LAST OPER WAS A $FIND)%
 
 	ELSE	%(WE MUST LOCATE THE RECORD)%
 
 		CALLFINDIDX (	%(RD)%	LCT ( RECDESC ),
 				%(BKT)%	LCT ( DATABD ) );
 

 	%([ WE HAVE NOW LOCATED THE RECORD. WE MUST MOVE IT INTO
 	   THE USER'S BUFFER, OR SET UP A POINTER TO IT IF LOCATE
 	   MODE IS BEING USED. ])%
 
	SAVEDKDB = .KDB;			! SAVE CURRENT KEY
 	RAB [ RABRSZ ] = CALLGETIDX (	%(RD)%	LCT ( RECDESC ),
 					%(BKT)%	LCT ( DATABD ) );
	KDB = .SAVEDKDB;			! RESTORE CURRENT KEY
 
	%([ SET THE RFA IN THE USER'S FAB ])%

	RAB [ RABRFA ] = .RECDESC [ RDRRV ];

	%([ WE CAN NOW UPDATE THE INTERNAL DATA BASE BY ADJUSTING
	   THE NEXT-RECORD-POINTER (NRP) VALUES.])%

	CALLSETNRP (	%(RECORD DESC)%	LCT ( RECDESC ),
			%(BUCKET)%	LCT ( DATABD ) );

 	%([ IF THE FILE IS READ-ONLY, THEN UNLOCK THE CURRENT BUCKET ])%
 
 	IF INPUTMODE THEN RELEASCURENTBKT;
 
	RETURN 
%FI

 END; %(OF DOGETIDX)%




! PADBUFFER
! =========

! ROUTINE TO PERFORM USER BUFFER PADDING IF THE RB$PAD OPTION
!	IS SPECIFIED ON A $GET. THIS ROUTINE IS CALLED ONLY
!	AFTER THE ENTIRE RECORD (OR AS MUCH OF IT AS WOULD FIT)
!	IS MOVED INTO THE USER'S RECORD BUFFER. THE REST OF THE
!	BUFFER IS THEN PADDED WITH THE CHARACTER SPECIFIED IN
!	THE "PAD" FIELD OF THE RAB.

! INPUT:
!	<NONE>

! OUTPUT:
!	<NO STATUS RETURNED>

! IMPLICIT INPUT FIELDS:
!
!	RAB:	
!		RBF	ADDRESS OF USER RECORD BUFFER
!		UBF	ADDRESS OF USER BUFFER
!		RSZ	SIZE OF USER RECORD
!

! ROUTINES CALLED:
!	<NONE>

! NOTES:
!
!	1.	THIS ROUTINE SHOULD OBVIOUSLY NOT PERFORM ITS
!		FUNCTION IF THE USER IS OPERATING IN LOCATE MODE
!		(AND THE RECORD WAS ACTUALLY "LOCATED" IN THE RMS-20
!		FILE BUFFER). THUS, IF RBF ISNT UBF, THIS ROUTINE WILL
!		IMMEDIATELY EXIT.
!
!	2.	**THIS ROUTINE HAS NOT BEEN OPTIMIZED**
!		TO SPEED IT UP, THE BYTES IN THE CURRENT WORD
!		CAN BE DEPOSITED, THEN EACH SUCCESSIVE WORD CAN
!		BE STORED WITH A FULL WORD OF BYTES UNTIL THE
!		BUFFER IS FULL.

GLOBAL ROUTINE PADBUFFER: NOVALUE  =
BEGIN

REGISTER
    BUFFERBYTEPTR,		! PTR TO USER BUFFER
    AC0 = 0,			! EXTEND AC BLOCK
    AC1 = 1,
    AC2 = 2,
    AC3 = 3,
    AC4 = 4;

LOCAL
    EXTENDBLOCK:	FORMATS[ EXTBLKSIZE ],	! USED FOR OP-CODE OF EXTEND INSTR.
    BYTESLEFT;			! # OF BYTES LEFT IN BUFFER


	TRACE ('PADBUFFER');

	%([ IF THE USER IS IN LOCATE MODE, THEN WE WILL EXIT WITHOUT
	   DOING ANYTHING. WE KNOW THAT HE IS IN LOCATE MODE IF
	   HIS RBF ADDRESS IS NOT THE SAME AS HIS UBF ADDRESS. ])%

	IF ( BUFFERBYTEPTR = .RAB [ RABRBF ] ) ISNT .RAB [ RABUBF ]
	THEN	%(DONT PAD OUR OWN BUFFER)%
		RETURN ;

	%([ COMPUTE THE SIZE OF HIS BUFFER IN BYTES ])%

	BYTESLEFT = 36 / .FST [ FSTBSZ ];	! # OF BYTES PER WORD
	BYTESLEFT = ( .BYTESLEFT * .RAB [ RABUSZ ] ) - .RAB [ RABRSZ ];

	%([ FORM A POINTER TO THE LAST BYTE IN THE BUFFER ])%

	BUFFERBYTEPTR = POINT ( .BUFFERBYTEPTR, 36, .FST [ FSTBSZ ] );

	AC4  = .RAB [ RABRSZ ];	! GET RECORD SIZE
	ADJBP ( AC4, BUFFERBYTEPTR );	! POINTER TO END OF BUFFER

	%([ SET UP EXTEND OP-CODE BLOCK ])%

	EXTENDBLOCK [ 0, WRD ] = MOVSLJ ^ 27;	! MOVE LEFT OP-CODE
	EXTENDBLOCK [ 1, WRD ] = .RAB [ RABPAD ];	! GET PAD CHAR
	EXTENDBLOCK [ 2, WRD ] = ZERO;		! NO FILL

	%([ FILL IN THE AC BLOCK ])%

	AC0 = ZERO;		! NO SOURCE STRING
	AC1 = ZERO;		! NO BYTE POINTER
	AC3 = .BYTESLEFT;	! # OF BYTES IN BUFFER

	%([ NOW, DO THE BUFFER PADDING...NOTE THAT THERE IS
	   CURRENTLY NO CHECK TO SEE IF THIS INSTRUCTION
	   FAILED. HOWEVER, THE IFSKIP MUST PERFORM SOME
	   DUMMY OPERATION OR BLISS WILL OPTIMIZE OUT THE
	   SKIP AND THE STACK WILL NOT BE ADJUSTED PROPERLY. ])%

	IF NOT EXTEND ( AC0, EXTENDBLOCK )
	THEN
		TRUE	
	ELSE
		FALSE;

	RETURN 
END;	%(OF PADBUFFER)%



! GETIDX
! ======

! ROUTINE TO READ A RECORD FROM AN INDEXED FILE.
!	THIS ROUTINE IS CALLED ONLY AFTER THE TARGET
!	RECORD HAS BEEN LOCATED AND ITS ADDRESS HAS BEEN
!	ESTABLISHED. THIS ROUTINE WILL THEN COMPUTE HOW
!	MUCH (IF ANY) OF THE RECORD IS TO BE MOVED, AND
!	WILL MOVE THE RECORD INTO THE USER'S BUFFER.
!
! INPUT:
!	RECDESC		RECORD DESCRIPTOR PACKET
!		RFA		RFA OF CURRENT RECORD
!		RECPTR		ADDRESS (IN BUFFER) OF CURRENT RECORD
!		RRV		RRV ADDRESS OF CURRENT RECORD
!
!	DATABD		BKT DESCRIPTOR OF DATA BUCKET
!
! OUTPUT:
!	VALUE RETURNED = SIZE IN BYTES OF RECORD (ACTUAL BYTES MOVED)



GLOBAL ROUTINE GETIDX ( RECDESC, DATABD ) =
 BEGIN

%IF INDX %THEN

	ARGUMENT	(RECDESC,BASEADD);		! RECORD DESCRTIPTOR
	ARGUMENT	(DATABD,BASEADD);		! BUCKET DESCRIPTOR
 MAP
    RECDESC:	POINTER,
    DATABD:	POINTER;

 REGISTER
    TEMPAC,		! TEMPORARY AC
    BYTESPERWORD,	! # OF BYTES PER WORD FOR THIS FILE
    RECORDPTR:	POINTER;	! PTR TO THE TARGET RECORD

 EXTERNAL ROUTINE
    PUTBKT;			! RELEASE A BUCKET

 LOCAL
    RECORDSIZE,		! SIZE IN BYTES OF THIS RECORD
    WORDSTOMOVE,		! # OF WORDS IN RECORD
    EXTRABYTES,		! # OF LEFT-OVER BYTES
    BUFFERSIZE,		! SIZE OF USER'S BUFFER
    FULLWORDS,		! TOTAL # OF WORDS IN RECORD
    BUFFERPTR:	POINTER;	! PTR TO USER'S BUFFER


	TRACE ('GETIDX');
	CHECKEXACTCOUNT;

	%([ ON ENTRY, WE SHOULD HAVE THE ADDRESS OF THE RECORD
	   IN THE RECORD DESCRIPTOR. LET'S GET IT AND HAVE A LOOK. ])%

	RECORDPTR = .RECDESC [ RDRECPTR ];
	LOOKAT ('	READING REC AT: ', RECORDPTR);

	%([ SET UP THE PRIMARY KDB BECAUSE WE ARE ALWAYS MOVING
	   A PRIMARY USER DATA RECORD ])%

	KDB = .FST [ FSTKDB ];			! GET UDR KDB

	%([ WE CAN NOW GET THE SIZE OF THIS RECORD, IN BYTES ])%

	IF FIXEDLENGTH
	THEN
		RECORDSIZE = .FST [ FSTMRS ]
	ELSE
		RECORDSIZE = .RECORDPTR [ DRRECSIZE ];

	%([ BUMP THE POINTER PAST THE RECORD HEADER ])%

	INC ( RECORDPTR, .KDB [ KDBHSZ ] );

	%([ IF THIS IS LOCATE MODE, AND THE USE IS ONLY READING THE
	   FILE, THEN WE CAN SIMPLY SET UP A POINTER TO THE RECORD
	   IN OUR BUFFER. ])%

	IF LOCATEMODE
	THEN IF INPUTMODE
	THEN	%(WE CAN PASS BACK A POINTER)%

		BEGIN
		RTRACE (%STRING('	LOCATE MODE FOUND...',%CHAR(13),%CHAR(10)));
		RAB [ RABRBF ] = .RECORDPTR;		! STORE RECORD ADDR
		RETURN .RECORDSIZE
		END; %(OF IF LOCATEMODE)%

	%([ EITHER THIS IS MOVE MODE, OR THE USER IS NOT IN
	   READ-ONLY ACCESS. IN EITHER CASE, WE WILL MOVE
	   THE RECORD INTO THE USER'S BUFFER AREA. ])%

	%([ COMPUTE THE SIZE IN WORDS OF THIS RECORD ])%

	BYTESPERWORD = 36 / .FST [ FSTBSZ ];		! # OF BYTES IN EACH WORD
	WORDSTOMOVE = .RECORDSIZE / .BYTESPERWORD;	! # OF FULL WORDS
	EXTRABYTES = .RECORDSIZE - ( .WORDSTOMOVE * .BYTESPERWORD );

	%([ LET'S SEE ALL THIS ])%

	LOOKAT ('	WORDS-TO-MOVE: ', WORDSTOMOVE);
	LOOKAT ('	EXTRA-BYTES: ', EXTRABYTES );

	%([ LET'S FIND OUT IF THE ENTIRE RECORD WILL FIT IN THE BUFFER ])%

	FULLWORDS = .WORDSTOMOVE;

	IF .EXTRABYTES ISNT ZERO
	THEN	%(WE CAN FIT ONE MORE WORD IN)%
		INC ( FULLWORDS, 1 );

	%([ GET THE SIZE OF THE USER'S BUFFER ])%

	BUFFERSIZE = .RAB [ RABUSZ ];
	IF .BUFFERSIZE LSS .FULLWORDS
	THEN	%(THE RECORD WON'T FIT)%

		BEGIN
		RTRACE (%STRING('	RECORD CANT FIT...',%CHAR(13),%CHAR(10)));
		EXTRABYTES = ZERO;			! CHOP OFF EXTRA
		WORDSTOMOVE = .BUFFERSIZE;		! MOVE THIS MUCH
		USRSTS = ER$RTB;				! PARTIAL RECORD
		USRSTV = .RECORDSIZE			! RETURN FULL SIZE
		END; %( OF IF RECORD WOULDNT FIT)%

	%([ FORM A PTR TO THE USER'S BUFFER ])%

	BUFFERPTR = .RAB [ RABUBF ];

	%([ MOVE THE MAIN BODY OF THE RECORD ])%

	IF .WORDSTOMOVE ISNT ZERO
	THEN
		MOVEWORDS (	%(FROM)%	.RECORDPTR,
				%(TO)%	.BUFFERPTR,
				%(SIZE)%	.WORDSTOMOVE );

	%([ BUMP OUR POINTERS AND DECREMENT THE SIZE OF THE BUFFER ])%

	INC ( BUFFERPTR, .WORDSTOMOVE );
	INC ( RECORDPTR, .WORDSTOMOVE );
	DEC ( BUFFERSIZE, .WORDSTOMOVE );

	%([ WE CAN NOW MOVE THE SLACK BYTES ])%

	IF .EXTRABYTES ISNT ZERO
	THEN

		BEGIN

		%([ WE WILL CREATE A BYTE POINTER WHICH HAS A
		   BYTE SIZE OF ( FILE BYTE SIZE * # OF BYTES TO MOVE).
		   THIS AVOIDS THE NECESSITY OF USING A ILDB LOOP
		   TO MOVE A SMALL NUMBER OF BYTES. ])%

		TEMPAC = .FST [ FSTBSZ ] * .EXTRABYTES;		! # OF BITS TO MOVE
		TEMPAC = ( .TEMPAC ^ 6 ) + NULLBP;		! FORM LH OF PTR
		RECORDPTR<LH> = .TEMPAC;
		BUFFERPTR<LH> = .TEMPAC;		! STORE IN POINTERS
		LOOKAT ('	RECORD-PTR: ', RECORDPTR);
		LOOKAT ('	BUFF-PTR: ', BUFFERPTR );

		REPLACEI ( BUFFERPTR, SCANI ( RECORDPTR ))
		END; %(OF IF THERE WERE EXTRA BYTES)%

	%([ COMPUTE THE SIZE OF THE RECORD WE MOVED ])%

	RECORDSIZE = ( .WORDSTOMOVE * .BYTESPERWORD ) + .EXTRABYTES;
	RETURN .RECORDSIZE
%FI

 END; %(OF GETIDX)%

END
ELUDOM