Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/rmsmsc.b36
There are 6 other files named rmsmsc.b36 in the archive. Click here to see a list.
%TITLE 'M I S C E L   -- special-purpose routines'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE miscel (IDENT = '3.0'
		) =
BEGIN

GLOBAL BIND
    miscv = 3^24 + 0^18 + 642;			! Edit date: 27-Jun-86

!+
!
!
!
!	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1977, 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.
!
!
!
!    AUTHOR:	S. BLOUNT /EGM/RL
!    FUNCTION:	THIS MODULE CONTAINS SEVERAL MISCELLANEOUS
!    ROUTINES, EACH OF WHICH IS SMALL AND VERY
!    SPECIAL-PURPOSE.
!
!
!    **********	TABLE OF CONTENTS	**************
!
!
!
!
!    ROUTINE			FUNCTION
!    =======			========
!
!    GETKDB			FIND THE KEY DESCRIPTOR FOR A KEY OF REFERENCE
!
!    MOVEKEY			MOVE A USER KEY STRING TO A BUFFER
!
!    CKEYKK			COMPARE TWO NON-SEGMENTED KEY STRINGS
!
!    CKEYKU			COMPARE KEY STRING TO SEGMENTED DATA RECORD
!
!    CKEYUU			COMPARE TWO SEGMENTED KEY STRINGS (DATA RECORDS)
!
!    SETNRP			SET UP THE NRP FOR INDEXED FILES
!
!
!
!
!
!    REVISION HISTORY:
!
!    PRODUCT	  SPR
!    EDIT	  QAR		DESCRIPTION
!    ======	====== 		===============================================
!
!	1       XXXXX		(JK 20-AUG-76) ADD 'FBYRFA' ROUTINE.
!
!    	2	XXXXX		(JK 3-SEP-76)
!                       	FBYRFA' SHOULD TELL 'GETBKT' TO LOCK BKT
!
!	3	XXXXX		(JK 3-SEP-76)  'FBYRFA' MOVED TO RMSUD2.
!	4	XXXXX           (SB 31-JAN-77)
!                       	GETKDB DOESNT CHECK FOR BAD KRF (FOR DISPLAY)
!	5	XXXXX           (SB 3-MAY-77)  MOVE SIDRELEMENT FROM RD TO RST
!
!	6	XXXXX           (SB 21-JUN-77)
!                       	SPEED UP SETNRP BY USING REGISTER RST PTR
!
!	7	XXXXX		(SB 21-JUN-77)
!                       	SET SIDR-ELEMENT IN RST ON EACH CALL TO SETNRP
!
!	13      XXXXX		NO SYMPTOMS OBSERVED, BUT THE KEY VALUES IN THE
!    				VARIOUS INDEX ARRAYS HAVE EXTRA BITS IN THEM.
!    				THIS IS STACK CONTENTS DEPENDENT, WHICH MEANS
!    				THAT SLIGHT ALTERATIONS TO USER PROGRAMS COULD
!    				PRODUCE FILES WHICH ARE FUNCTIONALLY EQUIVALENT
!    				BUT 'BIT-WISE' DIFFERENT. AVOID THIS BY
!    				CLEARING OUT THE DESTINATION KEY BUFFER BEFORE
!    				COPYING THE KEY.
!
!    ***** START VERSION 2 DEVELOPMENT *****
!
!
!	301	XXXXX		SUPPORT EXTENDED ADDRESSING.
!
!	400	xxxxx		Clean up BLISS code (RL,22-Apr-83)
!
!	407	xxxxx		Fix key comparison routines for
!				nonzero sections.
!
!       411                     Non-display keys.
!
!	413	xxxxx		(RL,23-Jun-83) Zero local storage
!				for byte pointers in CKEYUU.
!
!	464?	xxxxx		(RL,7-Dec-84) Make CKEY.. routines
!				work across sections so that
!				RMSLOD can use them from different
!				sections.
!
!    ***** START VERSION 3 DEVELOPMENT *****
!
!	642	xxxxx		(TGS, 27-Jun-86) Extended addressing
!				bug in MOVEKEY, was randomly XBLTing
!				user section memory before copy the
!				user's key.
!--

!
! Include Files
!

REQUIRE 'RMSREQ';

!
! Equated Symbols
!

LITERAL
    packed_digit_size = 4,			! Size of a packed-decimal digit  !A411
    register_pair = %O'13';			! Use AC13 and AC14 for double precision   !A411

!
! Builtin Declarations
!

BUILTIN
    CMPF,					!A411
    CMPD,					!A411
    CMPG,					!A411
    scann;					!A411
%SBTTL 'GETKDB - locate KDB in chain'

GLOBAL ROUTINE getkdb (keyofreference) =
! GETKDB
! ======
! ROUTINE TO LOCATE A SPECIFIC KEY DESCRIPTOR BLOCK IN THE KDB CHAIN.
!	THIS ROUTINE IS CALLED WITH A KEY-OF-REFERENCE VALUEAND IT
!	RETURNS THE LOCATION OF THAT KDB.
! INPUT:
!	KEY-OF-REFERENCE VALUE
! OUTPUT:
!	FALSE:		KDB NOT FOUND
!	NOT FALSE:	KDB ADDRESS (NOT PUT INTO GLOBAL "KDB")
! ROUTINES CALLED:
!	CRASH
    BEGIN

    REGISTER
	kdbaddress : REF BLOCK,
	counter;				! TEMP COUNTER OF KDB'S

    TRACE ('GETKDB');

    !+
    !    GET KDB ADDRESS
    !-

    kdbaddress = .fst [fstkdb];			! GET KDB FOR PRIMARY KEY
    counter = 0;				! CLEAR COUNTER VALUE

    UNTIL .counter EQL .keyofreference DO
	BEGIN

	IF (kdbaddress = .kdbaddress [kdbnxt]) EQL 0 THEN RETURN false;	! CHECK FOR END OF CHAIN

	counter = .counter + 1;			! Bump the count
	END;

    !+
    !    WE HAVE FOUND THE CORRECT KDB HERE
    !-

    IF .keyofreference NEQ .kdbaddress [kdbref] THEN rmsbug (msgkdb);

    lookat ('	KDB FOUND AT: ', kdbaddress);
    RETURN .kdbaddress
    END;
%SBTTL 'MOVEKEY - move user key'

GLOBAL ROUTINE movekey (recptr, buffptr) : NOVALUE =
! MOVEKEY
! =======
! ROUTINE TO MOVE A NON-CONTIGUOUS USER KEY STRING TO
!	A CONTIGUOUS  KEY BUFFER
! INPUT:
!	RECPTR		ADDRESS OF USER DATA RECORD
!
!	BUFFPTR		ADDRESS OF THE KEY BUFFER
! OUTPUT:
!	<NO STATUS RETURNED>
! ROUTINES CALLED:
!	<NONE>
    BEGIN

    MAP
	recptr : REF BLOCK;

    LOCAL
	keydescptr : REF BLOCK;			! KEY DESCRIPTOR PTR

    TRACE ('MOVEKEY');
    keydescptr = .kdb + kdbksdoffset;		! FORM PTR TO KEY SEG DESC

    !+
    !  Move the key. Do differently depending on whether data is:
    !      Byte-oriented (and segmented, maybe)
    !      Word-oriented (never segmented)
    !      Doubleword-oriented (never segmented)
    !-

    CASE .kdb [kdbdtp] FROM 0 TO maxdtp OF
	SET

	[dtpin4, dtpun4, dtpfl1] : 		! Single-word keys
	    .buffptr = .recptr [.keydescptr [0, keypos], wrd];

	[dtpfl2, dtpgfl, dtpin8] : 		! Double-word keys
	    BEGIN

	    REGISTER
		t1 = 5,
		t2 = 6;

	    dmove (t1, recptr [.keydescptr [0, keypos], wrd]);
	    t2 = .t2;				! Tell compiler to leave t2 alone
	    dmovem (t1, .buffptr);
	    END;

	[dtpstg, dtpsix, dtpebc, dtpas8, dtppac] : 	! Byte-oriented keys
	    BEGIN

	    LOCAL
		temp1,				! Temporaries for moving key
		temp2,				! ...
		byteptrlefthalf,		! Used to form a byte pointer
		startofrecrdptr,		! Source record pointer
		destptr,			! Destination buffer pointer
		fullkeysize;			! Size of entire key

	    REGISTER
		sidxac = 4,			! Source indexed pointer
		didxac = 5,			! Destination indexed pointer
		tempac;				! Random register

	    !
	    !    Get a byte pointer to the start of the user record
	    !
	    startofrecrdptr = .recptr ;
	    destptr = .buffptr;
	    !
	    !    Compute a left half using the key byte size.
	    !
	    byteptrlefthalf = (.kdb [kdbkbsz]^6) + nullbp;	! Make LH

	    !+
	    !	If the record pointer is a local section
	    !	address, than just create a regular byte
	    !	pointer. Else, create an indexed byte ptr.
	    !-

	    IF .startofrecrdptr<lh> EQL 0
	    THEN
		startofrecrdptr<lh> = .byteptrlefthalf
	    ELSE
		BEGIN
		sidxac = .startofrecrdptr;
		startofrecrdptr<lh> = .byteptrlefthalf + 4;	! 4 = SIDXAC
		startofrecrdptr<rh> = 0
		END;

	    !+
	    !	Set up the buffer pointer likewise
	    !-

	    IF .destptr<lh> EQL 0
	    THEN
		destptr<lh> = .byteptrlefthalf
	    ELSE
		BEGIN
		didxac = .destptr;
		destptr<lh> = .byteptrlefthalf + 5;	! 5 = DIDXAC
		destptr<rh> = 0
		END;

	    !
	    !   Clear the destination key area before the copy
	    !
	    IF .rmssec NEQ 0                                              !m572
	    THEN
               BEGIN
               IF .buffptr<lh> EQL 0                                      !a642
               THEN  buffptr = .buffptr OR .rmssec;                       !a642
	       xclear (.buffptr, .kdb [kdbkszw]);
               END
	    ELSE
		clear (.buffptr, .kdb [kdbkszw]);
	    !
	    !   Get the size of this key string
	    !
	    fullkeysize = .kdb [kdbksz];

	    !+
	    !	Do this loop once for each key segment
	    !-

	    INCR j FROM 0 TO maxkeysegs - 1 DO
		BEGIN

		!+
		!   If we have moved entire key ... Exit
		!-

		IF .fullkeysize EQL 0 THEN RETURN true;

		!
		!   Get the starting position of this key
		!
		tempac = .keydescptr [.j, keypos];	! Get key position
		!
		!   Form a byte pointer to this key segment
		!
		adjbp (tempac, startofrecrdptr);
		temp2 = .tempac;
		!
		!   Get the size of this segment
		!
		temp1 = .keydescptr [.j, keysiz];
		fullkeysize = .fullkeysize - .temp1;
		!
		!   Move this key segment
		!
		!   Note: MOVSLJ could be used, but it would be difficult
		!   because both byte pointers must be GLOBAL.
		!
		sidxac = .sidxac;		! Force reference so BLISS
		didxac = .didxac;		!   doesn't smash these.

		WHILE ((temp1 = .temp1 - 1) GEQ 0) DO
		    BEGIN
		    ildb (tempac, temp2);
		    idpb (tempac, destptr);
		    END;

		END;

	    RETURN;
	    END;				! String data types
	TES;

    END;					! MOVEKEY
%SBTTL 'CKEYKK - compare two non-segmented keys'

GLOBAL ROUTINE ckeykk (recdesc : REF BLOCK, target_key_ptr : REF BLOCK) =

!++
! CKEYKK
! ======
!       Routine to compare two non-segmented keys.  These may be
!       ASCII, SIXBIT, EBCDIC, PACKED, INTEGER, FLOATING,
!       DOUBLE_FLOATING, G_FLOATING, or DOUBLE_INTEGER
!	This routine is used to compare two contiguous key strings.
!	For example, a user search key string and an index record
!	key string can be compared. However, user data records
!	cannot be compared with this routine because the keys
!	are (or may be) segmented.
!
! INPUT:
!	RECDESC		    Record Descriptor
!		USERPTR		Address of Search Key String
!		USERSIZE	Size of Search Key String
!	TARGET_KEY_PTR        Address of Target Key String
!
! OUTPUT STATUS:
!
!	TRUE:	Search terminated normally (search key leq target key)
!		RDFLGLSS may be set in the record descriptor
!	FALSE:	Search Key GTR Target Key
!
! ROUTINES CALLED:
!	<NONE>
!
!--

    BEGIN

    LOCAL
	comp_value,				! +1 (S gtr T), 0, -1 (S lss T)
	searchsize,				! Length of key
	search_ptr : $byte_pointer,		! Pointer to record
	target_ptr : $byte_pointer,		! Pointer to target
	tmp_source : $byte_pointer,		! Temporary copies
	tmp_target : $byte_pointer;		! ...

    TRACE ('CKEYKK');

    !+
    !    CHECK INPUT VALUES
    !-

    checkinput (target_key_ptr, GTR, 0);
    !
    !    Clear the LSS flag bit
    !
    clrflag (recdesc [rdstatus], rdflglss);

    !+
    !	Account for single section use, etc.
    !-

    IF .(recdesc [rduserptr])<18, 18> EQL 0	! Local address?
    THEN
	recdesc [rduserptr] = .rmssec OR .recdesc [rduserptr];	! Globalize it

    IF .target_key_ptr<18, 18> EQL 0		! Local also?
    THEN
	target_key_ptr = .rmssec OR .target_key_ptr;	! Fix it up, too

    !+
    !	Set up byte pointers if needed for this datatype.
    !-

    CASE .kdb [kdbdtp] FROM 0 TO maxdtp OF
	SET

	[dtpstg, dtpebc, dtpsix, dtpas8, dtppac] : 	! Byte data
	    BEGIN
	    !
	    !	Set up the byte pointers to the records being compared.
	    !
	    search_ptr = target_ptr = 0;	! Zero pointers first
	    search_ptr [ptr$v_byte_position] = 	! First char of source
	    target_ptr [ptr$v_byte_position] = 36;	!   and target
	    search_ptr [ptr$v_global_flag] = 0;	! Local byte pointer
	    search_ptr [ptr$v_byte_size] = 	! Same bytesize for both
	    target_ptr [ptr$v_byte_size] = .kdb [kdbkbsz];	! ...

	    !+
	    !	Set up the 2-word pointers from the
	    !	arguments passed to us.
	    !-

	    IF .rmssec NEQ 0			! Nonzero section?
	    THEN
		BEGIN				! Set up global pointers
		search_ptr [ptr$v_global_flag] = 1;	! Source pointer
		search_ptr [ptr$a_global_address] = .recdesc [rduserptr];
		target_ptr [ptr$v_global_flag] = 1;	! Target pointer
		target_ptr [ptr$a_global_address] = .target_key_ptr;
		END
	    ELSE
		BEGIN				! Set up local pointers
		search_ptr [ptr$v_global_flag] = 0;	! Source pointer
		search_ptr [ptr$a_local_address] = .recdesc [rduserptr];
		target_ptr [ptr$v_global_flag] = 0;	! Target pointer
		target_ptr [ptr$a_local_address] = .target_key_ptr;
		END;

	    END;

	[INRANGE] :
	;
	TES;

    !+
    !   The following case statement compares the
    !   search and target keys in a way appropriate
    !   to their datatype.  The result of the
    !   comparison is stored in COMP_VALUE.
    !-

    comp_value = 1;				! Assume search GTR target

    CASE .kdb [kdbdtp] FROM 0 TO maxdtp OF
	SET

	[dtpstg, dtpebc, dtpsix, dtpas8] : 	! Character data
	    BEGIN
	    !
	    !   Size for compare is size of Search String
	    !
	    searchsize = .recdesc [rdusersize];

	    !+
	    !   Compare the two key strings.
	    !   If false, the search key was GTR
	    !   than the target key.
	    !-

	    IF cstringle_ea (search_ptr, 	! Search key
		    target_ptr, 		! Target key
		    searchsize, 		! Length
		    searchsize)			! Length
	    THEN
		BEGIN

		!+
		!   Search key is either LSS or EQL target key,
		!	so compare terminating characters.
		!-

		IF (scann (search_ptr) LSS scann (target_ptr))	!
		THEN
		    comp_value = -1		! Search LSS target
		ELSE
		    comp_value = 0;		! Search EQL target

		END;

	    END;				! STRING DATA

	[dtppac] :
	    BEGIN

	    LOCAL
		tmp_result,			! Temp to Result of this block
		searchlast,			! last byte of search string
		targetlast,			! last byte of target string
		searchsign,			! sign of search string
		targetsign;			! sign of target string

	    !
	    !   Size for string compare instruction is
	    !   size of search string - 1 because the
	    !   sign is embedded in the last byte,
	    !   and both + and - have several representations
	    !
	    searchsize = .recdesc [rdusersize] - 1;

	    !+
	    !   Compare the two key strings
	    !   If false, the search key was
	    !   probably GTR than the target key
	    !-

	    IF cstringle_ea (search_ptr, 	! Search key
		    target_ptr, 		! Target key
		    searchsize, 		! Length
		    searchsize) EQL false	! Length
	    THEN
		tmp_result = 1			!
	    ELSE

		IF scann (search_ptr) EQL scann (target_ptr)	!
		THEN
		    tmp_result = 0		!
		ELSE
		    tmp_result = -1;		!

	    !+
	    !    Check last byte of each string for last digit and sign
	    !-

	    searchlast = CH$RCHAR_A (search_ptr);
	    targetlast = CH$RCHAR_A (target_ptr);
	    searchsign = (CASE (.searchlast AND %X'F')	!
	    FROM %X'A' TO %X'F' OF 		!
		SET
		[%X'F', %X'A', %X'C', %X'E'] : 1;
		[%X'B', %X'D'] : -1;
		[OUTRANGE] : 0;
		TES);
	    !
	    !   Fetch sign of target
	    !
	    targetsign = (CASE (.targetlast AND %X'F')	!
	    FROM %X'A' TO %X'F' OF 		!
		SET
		[%X'F', %X'A', %X'C', %X'E'] : 1;
		[%X'B', %X'D'] : -1;
		[OUTRANGE] : 0;
		TES);

	    IF (.tmp_result EQL 0)		! Strings are the same so far
	    THEN 				! we must check the last digit
		BEGIN				! to see if they are the same

		LOCAL
		    diff;

		diff = (.searchlast^-packed_digit_size) - 	!
		(.targetlast^-packed_digit_size);

		IF .diff GTR 0
		THEN
		    tmp_result = 1
		ELSE

		    IF .diff LSS 0 THEN tmp_result = -1;

		END;

	    !+
	    ! Now make sure the signs were the same
	    !-

	    IF .searchsign NEQ .targetsign	!
	    THEN
		tmp_result = .searchsign;	! Signs were different

	    !
	    !   Return the value of this comparison
	    !
	    comp_value = .tmp_result*.searchsign;	! result of all this
	    END;				! PACKED DECIMAL DATA

	[dtpin4] :
	    BEGIN

	    BIND
		search_val = .recdesc [rduserptr],	! Search key
		target_val = .target_key_ptr;	! Target key

	    IF .search_val LSS .target_val	! Well?
	    THEN
		comp_value = -1			! Search LSS target
	    ELSE

		IF .search_val EQL .target_val	! Check again
		THEN
		    comp_value = 0;		! Search EQL target

	    END;

	[dtpun4] : 				! Unsigned Integer data
	    BEGIN

	    BIND
		search_val = .recdesc [rduserptr],	! Search key
		target_val = .target_key_ptr;	! Target key

	    IF .search_val LSSU .target_val	! Well?
	    THEN
		comp_value = -1			! Search LSS target
	    ELSE

		IF .search_val EQLU .target_val	! Check again
		THEN
		    comp_value = 0;		! Search EQL target

	    END;

	[dtpfl1] : 				! Single Floating data
	    comp_value = CMPF (.recdesc [rduserptr], .target_key_ptr);

	[dtpfl2] : 				! Double-Floating data
	    comp_value = CMPD (.recdesc [rduserptr], .target_key_ptr);

	[dtpgfl] : 				! G-Floating data
	    comp_value = CMPG (.recdesc [rduserptr], .target_key_ptr);

	[dtpin8] : 				! Two-word integer
	    BEGIN

	    REGISTER
		R1 = register_pair,
		R2 = register_pair + 1;

	    dmove (R1, .recdesc [rduserptr]);	! Get what we're searching for
	    dsub (R1, .target_key_ptr);		! Subtract target
	    R2 = .R2;				! Tell Compiler r2 was used

	    IF (.R1 LEQ 0)			! Well?
	    THEN

		IF (.R1 LSS 0)
		THEN
		    comp_value = -1		! search < target
		ELSE

		    IF (.R2 EQL 0)		! first words same; second too?
		    THEN
			comp_value = 0;		! search = target

	    END;
	TES;

    SELECT .comp_value OF
	SET

	[1] :
	    RETURN false;			! search string > target

	[0] :
	    RETURN true;			! search string = target

	[-1] :
	    BEGIN
	    setlssflag (recdesc);		! search string < target
	    RETURN true;
	    END;
	TES;

    RETURN true;
    END;					! End CKEYKK
%SBTTL 'CKEYKU - compare keystring w/ UDR'

GLOBAL ROUTINE ckeyku (recdesc : REF BLOCK, dataptr : REF BLOCK) =
    ! CKEYKU
    ! ======
    ! ROUTINE TO COMPARE KEY STRING TO A USER DATA RECORD (SEGMENTED)
    ! INPUT:
    !	RECDESC		RECORD DESCRIPTOR PACKET
    !		USERPTR		ADDRESS OF SEARCH KEY STRING
    !		USERSIZE	SIZE OF SEARCH KEY STRING
    !
    !	DATAPTR		ADDRESS OF USER DATA RECORD
    ! OUTPUT:
    !	TRUE:	SEARCH KEY .LEQ. TARGET KEY
    !		FLGLSS MAY BE SET IN THE STATUS WORD
    !	FALSE:	SEARCH KEY .GTR. TARGET KEY
    ! ROUTINES CALLED:
    !	<NONE>
    BEGIN

    LOCAL
	searchkeyptr : REF BLOCK,		! Ptr to Search Key
	startofrecptr : REF BLOCK,		! Ptr to Start of Data Record
	ksdptr : REF BLOCK,			! Ptr to Key Segment Desc
	searchp,				! Current Search Pointer
	datap : REF VECTOR,			! Current Data pointer
	keysizetouse,				! Size for comparison
	searchsize;				! SIZE OF K(S)

    LOCAL
	comp_value,				! Comparison result
	search_ptr : $byte_pointer,		! Pointer to record
	target_ptr : $byte_pointer,		! Pointer to target
	tmp_search : $byte_pointer,		! Temporary copies
	tmp_target : $byte_pointer;		! ...

    TRACE ('CKEYKU');
    !
    !    Clear the LSS flag to start
    !
    clrflag (recdesc [rdstatus], rdflglss);	! CLEAR STATUS

    !+
    !	Make local addresses into globals, by making
    !	the (hopefully) valid assumption that any
    !	local address is to refer to RMS's section,
    !	whether or not we are in section 0.
    !-

    IF .(recdesc [rduserptr])<18, 18> EQL 0	! Local address?
    THEN
	recdesc [rduserptr] = .rmssec OR .recdesc [rduserptr];	! Globalize it

    IF .dataptr<18, 18> EQL 0			! Local also?
    THEN
	dataptr = .rmssec OR .dataptr;		! Fix it up, too

    !
    !	Set up the pointer to the key segments
    !
    ksdptr = .kdb + kdbksdoffset;		! Pointer to key seg descriptor

    !+
    !	Set up byte pointers if needed for this datatype.
    !-

    CASE .kdb [kdbdtp] FROM 0 TO maxdtp OF
	SET

	[dtpstg, dtpebc, dtpsix, dtpas8, dtppac] : 	! Byte data
	    BEGIN
	    searchsize = .recdesc [rdusersize];	! Get key size
	    !
	    !	Set up the byte pointers to the records being compared.
	    !
	    search_ptr = target_ptr = 0;	! Zero pointers first
	    search_ptr [ptr$v_byte_position] = 	! First char of search
	    target_ptr [ptr$v_byte_position] = 36;	!   and target
	    search_ptr [ptr$v_global_flag] = 0;	! Local byte pointer
	    search_ptr [ptr$v_byte_size] = 	! Same bytesize for both
	    target_ptr [ptr$v_byte_size] = .kdb [kdbkbsz];	! ...

	    !+
	    !	Set up the 2-word pointers from the
	    !	arguments passed to us.
	    !-

	    IF .rmssec NEQ 0			! Nonzero section?
	    THEN
		BEGIN				! Set up global pointers
		search_ptr [ptr$v_global_flag] = 1;	! Search pointer
		search_ptr [ptr$a_global_address] = .recdesc [rduserptr];
		target_ptr [ptr$v_global_flag] = 1;	! Target pointer
		target_ptr [ptr$a_global_address] = .dataptr;
		END
	    ELSE
		BEGIN				! Set up local pointers
		search_ptr [ptr$v_global_flag] = 0;	! Search pointer
		search_ptr [ptr$a_local_address] = .recdesc [rduserptr];
		target_ptr [ptr$v_global_flag] = 0;	! Target pointer
		target_ptr [ptr$a_local_address] = .dataptr;
		END;

	    END;

	[INRANGE] :
	;
	TES;

    !+
    !   The following case statement compares the
    !   search and target keys in a way appropriate
    !   to their datatype.  The result of the
    !   comparison is stored in COMP_VALUE.
    !-

    comp_value = 1;				! Assume search GTR target

    CASE .kdb [kdbdtp] FROM 0 TO maxdtp OF
	SET

	[dtpstg, dtpebc, dtpsix, dtpas8] : 	! SOME KIND OF STRING DATA
	    BEGIN

	    !+
	    !    Do this loop once for each key segment
	    !-

	    INCR j FROM 0 TO maxkeysegs - 1 DO
		BEGIN
		!
		!    Form a byte pointer to this key byte
		!
		$copy_byte_pointer (target_ptr, tmp_target);	!
		$adjbp_ea (.ksdptr [.j, keypos], tmp_target);
		!
		!    Use smaller of the size of this key segment
		!    and the rest of the search key.
		!
		keysizetouse = .ksdptr [.j, keysiz];

		IF .searchsize LSS .keysizetouse	! Adjust compare size
		THEN
		    keysizetouse = .searchsize;

		!+
		!    Compare the strings
		!-

		IF cstringle_ea (search_ptr, 	! K(S)
			tmp_target, 		! Target
			keysizetouse, 		! Size
			keysizetouse) EQL false	! Same size
		THEN
		    BEGIN
		    comp_value = 1;		! Need to set it here
		    EXITLOOP;			! Search GTR target
		    END;

		!+
		!   Check if K(S) was LSS user data record key
		!	by checking the terminating byte.
		!-

		IF scann (search_ptr) LSS scann (tmp_target)	!
		THEN
		    BEGIN
		    comp_value = -1;
		    EXITLOOP;
		    END;

		!+
		!    Decrement size of search key
		!-

		searchsize = .searchsize - .keysizetouse;

		IF .searchsize EQL 0		! Compared entire key?
		THEN
		    BEGIN
		    comp_value = 0;
		    EXITLOOP;			! Yes. win.
		    END;

%IF dbug
%THEN

		IF .searchsize LSS 0 THEN rmsbug (msgksz);

%FI

		comp_value = 0;			! Equal keys (just in case)
		END;

	    END;				! String compare

	[dtppac] :
	    BEGIN

	    LOCAL
		tmp_result,			! Temp to Result of this block
		searchlast,			! last byte of search string
		targetlast,			! last byte of target string
		searchsign,			! sign of search string
		targetsign;			! sign of target string

	    !
	    !   Size for string compare instruction is
	    !   size of search string - 1 because the
	    !   sign is embedded in the last byte,
	    !   and both + and - have several representations
	    !
	    searchsize = .recdesc [rdusersize] - 1;
	    !
	    !    Form a byte pointer to this key byte
	    !
	    $copy_byte_pointer (target_ptr, tmp_target);	!
	    $adjbp_ea (.ksdptr [0, keypos], tmp_target);

	    !+
	    !   Compare the two key strings
	    !   If false, the search key was
	    !   probably GTR than the target key
	    !-

	    IF cstringle_ea (search_ptr, 	! Search key
		    tmp_target, 		! Target key
		    searchsize, 		! Length
		    searchsize) EQL false	! Length
	    THEN
		tmp_result = 1			!
	    ELSE

		IF scann (search_ptr) EQL scann (tmp_target)	!
		THEN
		    tmp_result = 0		!
		ELSE
		    tmp_result = -1;		!

	    !+
	    !    Check last byte of each string for last digit and sign
	    !-

	    searchlast = CH$RCHAR_A (search_ptr);
	    targetlast = CH$RCHAR_A (tmp_target);
	    searchsign = (CASE (.searchlast AND %X'F')	!
	    FROM %X'A' TO %X'F' OF 		!
		SET
		[%X'F', %X'A', %X'C', %X'E'] : 1;
		[%X'B', %X'D'] : -1;
		[OUTRANGE] : 0;
		TES);
	    !
	    !   Fetch sign of target
	    !
	    targetsign = (CASE (.targetlast AND %X'F')	!
	    FROM %X'A' TO %X'F' OF 		!
		SET
		[%X'F', %X'A', %X'C', %X'E'] : 1;
		[%X'B', %X'D'] : -1;
		[OUTRANGE] : 0;
		TES);

	    IF (.tmp_result EQL 0)		! Strings are the same so far
	    THEN 				! we must check the last digit
		BEGIN				! to see if they are the same

		LOCAL
		    diff;

		diff = (.searchlast^-packed_digit_size) - 	!
		(.targetlast^-packed_digit_size);

		IF .diff GTR 0
		THEN
		    tmp_result = 1
		ELSE

		    IF .diff LSS 0 THEN tmp_result = -1;

		END;

	    !+
	    ! Now make sure the signs were the same
	    !-

	    IF .searchsign NEQ .targetsign	!
	    THEN
		tmp_result = .searchsign;	! Signs were different

	    !
	    !   Return the value of this comparison
	    !
	    comp_value = .tmp_result*.searchsign;	! result of all this
	    END;				! PACKED DECIMAL DATA

	[dtpin4] :
	    BEGIN

	    BIND
		search_val = .recdesc [rduserptr],	! Search key
		target_val = .dataptr + .ksdptr [0, keypos];	! Target key

	    IF .search_val LSS .target_val	! Well?
	    THEN
		comp_value = -1			! Search LSS target
	    ELSE

		IF .search_val EQL .target_val	! Check again
		THEN
		    comp_value = 0;		! Search EQL target

	    END;

	[dtpun4] : 				! Unsigned Integer data
	    BEGIN

	    BIND
		search_val = .recdesc [rduserptr],	! Search key
		target_val = .dataptr + .ksdptr [0, keypos];	! Target key

	    IF .search_val LSSU .target_val	! Well?
	    THEN
		comp_value = -1			! Search LSS target
	    ELSE

		IF .search_val EQLU .target_val	! Check again
		THEN
		    comp_value = 0;		! Search EQL target

	    END;

	[dtpfl1] : 				! Single Floating data
	    comp_value = CMPF (.recdesc [rduserptr], 	!
		.dataptr + .ksdptr [0, keypos]);

	[dtpfl2] : 				! Double-Floating data
	    comp_value = CMPD (.recdesc [rduserptr], 	!
		.dataptr + .ksdptr [0, keypos]);

	[dtpgfl] : 				! G-Floating data
	    comp_value = CMPG (.recdesc [rduserptr], 	!
		.dataptr + .ksdptr [0, keypos]);

	[dtpin8] : 				! Two-word integer
	    BEGIN

	    REGISTER
		R1 = register_pair,
		R2 = register_pair + 1;

	    dmove (R1, .recdesc [rduserptr]);	! Get what we're searching for
	    dsub (R1, .dataptr + .ksdptr [0, keypos]);	! Subtract target
	    R2 = .R2;				! Tell Compiler r2 was used

	    IF (.R1 LEQ 0)			! Well?
	    THEN

		IF (.R1 LSS 0)
		THEN
		    comp_value = -1		! search < target
		ELSE

		    IF (.R2 EQL 0)		! first words same; second too?
		    THEN
			comp_value = 0;		! search = target

	    END;
	TES;

    !+
    ! Now we use our tri-state value to return the value our caller wants,
    ! and set the less-than flag if appropriate.
    !-

    SELECT .comp_value OF
	SET

	[1] :
	    RETURN false;			! search string > target

	[0] : 					! Search = Target
	    RETURN true;

	[-1] : 					! Search < Target
	    BEGIN
	    setlssflag (recdesc);		! Use flag to show LSS
	    RETURN true;
	    END;
	TES;

    RETURN true;
    END;					! End CKEYKU
%SBTTL 'CKEYUU - compare two UDRs'

GLOBAL ROUTINE ckeyuu (recdesc, targetptr) =
    ! CKEYUU
    ! ======
    ! ROUTINE TO COMPARE TWO SEGMENTED KEY STRINGS.
    !	THIS ROUTINE ACCEPTS THE ADDRESSES OF TWO KEY STRINGS
    !	WHICH ARE SEGMENTED ( I.E., EXIST WITHIN A DATA RECORD ).
    !	IT WILL COMPARE THESE TWO STRINGS TO DETERMINE WHICH ONE
    !	IS "GREATER" THAN THE OTHER. CURRENTLY, THIS ROUTINE IS
    !	USED ONLY WHEN AN $UPDATE IS DONE TO AN INDEXED FILE
    !	AND THE NEW KEY STRINGS MUST BE COMPARED WITH THE OLD
    !	VALUES OF EACH KEY.
    ! INPUT:
    !	RECDESC		RECORD DESCRIPTOR PACKET
    !		USERPTR		ADDRESS OF SOURCE DATA RECORD
    !		USERSIZE	<IGNORED>
    !
    !	TARGETPTR	ADDRESS OF TARGET DATA RECORD
    ! OUTPUT:
    !	TRUE:	SOURCE KEY STRING WAS .LEQ. TARGET KEY STRING
    !		FLGLSS WILL BE SET IF SOURCE .LSS. TARGET
    !
    !	FALSE:	SOURCE KEY STRING WAS .GTR. TARGET KEY STRING
    ! ROUTINES CALLED:
    !	<NONE>
    ! NOTES:
    !
    !	1.	THE SIZE OF THE KEY STRINGS CONTAINED IN THE
    !		DATA RECORD IS NOT USED BY THIS ROUTINE. THIS
    !		MEANS THAT IF THE DATA RECORD IS NOT LONG ENOUGH
    !		TO COMPLETELY CONTAIN A PARTICULAR KEY STRING,
    !		THIS ROUTINE SHOULD NOT BE CALLED.
    BEGIN

    MAP
	recdesc : REF BLOCK,
	targetptr : REF BLOCK;

    LOCAL
	comp_value,				! Result of key comparisons
	ksdptr : REF BLOCK,			! PTR TO KEY SEGMENT DESCRIPTRS
	searchkeysize,				! SIZE OF ENTIRE KEY STRING
	search_ptr : $byte_pointer,		! Pointer to record	!A407
	target_ptr : $byte_pointer,		! Pointer to target	!A407
	tmp_search : $byte_pointer,		! Temporary copies	!A407
	tmp_target : $byte_pointer,		! ...			!A407
	segsize;				! Size of this segment  !A411

    TRACE ('CKEYUU');
    !
    !    Clear the LSS flag to start
    !
    clrflag (recdesc [rdstatus], rdflglss);	! CLEAR STATUS

    !+
    !	Make local addresses into globals, by making
    !	the (hopefully) valid assumption that any
    !	local address is to refer to RMS's section,
    !	whether or not we are in section 0.
    !-

    IF .(recdesc [rduserptr])<18, 18> EQL 0	! Local address?
    THEN
	recdesc [rduserptr] = .rmssec OR .recdesc [rduserptr];	! Globalize it

    IF .targetptr<18, 18> EQL 0			! Local also?
    THEN
	targetptr = .rmssec OR .targetptr;	! Fix it up, too

    !
    !	Set up pointer to key segments
    !
    ksdptr = .kdb + kdbksdoffset;		! Pointer to key seg descriptor

    !+
    !	Set up byte pointers if needed for this datatype.
    !-

    CASE .kdb [kdbdtp] FROM 0 TO maxdtp OF
	SET

	[dtpstg, dtpebc, dtpsix, dtpas8, dtppac] : 	! Byte data
	    BEGIN
	    !
	    !	Fetch the full size of the entire key string
	    !
	    searchkeysize = .kdb [kdbksz];
	    !
	    !	Set up the byte pointers to the records being compared.
	    !
	    search_ptr = target_ptr = 0;	! Zero pointers first
	    search_ptr [ptr$v_byte_position] = 	! First char of search
	    target_ptr [ptr$v_byte_position] = 36;	!   and target
	    search_ptr [ptr$v_global_flag] = 0;	! Local byte pointer
	    search_ptr [ptr$v_byte_size] = 	! Same bytesize for both
	    target_ptr [ptr$v_byte_size] = .kdb [kdbkbsz];	! ...

	    !+
	    !	Set up the 2-word pointers from the
	    !	arguments passed to us.
	    !-

	    IF .rmssec NEQ 0			! Nonzero section?
	    THEN
		BEGIN				! Set up global pointers
		search_ptr [ptr$v_global_flag] = 1;	! Search pointer
		search_ptr [ptr$a_global_address] = .recdesc [rduserptr];
		target_ptr [ptr$v_global_flag] = 1;	! Target pointer
		target_ptr [ptr$a_global_address] = .targetptr;
		END
	    ELSE
		BEGIN				! Set up local pointers
		search_ptr [ptr$v_global_flag] = 0;	! Search pointer
		search_ptr [ptr$a_local_address] = .recdesc [rduserptr];
		target_ptr [ptr$v_global_flag] = 0;	! Target pointer
		target_ptr [ptr$a_local_address] = .targetptr;
		END;

	    END;

	[INRANGE] :
	;
	TES;

    !+
    !   The following case statement compares the
    !   search and target keys in a way appropriate
    !   to their datatype.  The result of the
    !   comparison is stored in COMP_VALUE.
    !-

    comp_value = 1;				! Assume search GTR target

    CASE .kdb [kdbdtp] FROM 0 TO maxdtp OF
	SET

	[dtpstg, dtpebc, dtpsix, dtpas8] : 	! SOME KIND OF STRING DATA
	    BEGIN

	    !+
	    !    Do this loop once for each key segment
	    !-

	    INCR j FROM 0 TO maxkeysegs - 1 DO
		BEGIN

		!+
		!    If we have scanned entire key, we can exit
		!-

		IF .searchkeysize EQL 0
		THEN
		    BEGIN
		    comp_value = 0;
		    EXITLOOP;
		    END;

		!+
		!    If this segment is null, don't bother with it
		!-

		IF (segsize = .ksdptr [.j, keysiz]) NEQ 0
		THEN
		    BEGIN			! We can compare it
		    !
		    !    Decrement the amount left to process
		    !
		    searchkeysize = .searchkeysize - .segsize;

%IF dbug
%THEN

		    IF .searchkeysize LSS 0 THEN rmsbug (msgksz);

%FI

		    !
		    !	Make temporary byte pointers
		    !
		    $copy_byte_pointer (search_ptr, tmp_search);	! !A407
		    $copy_byte_pointer (target_ptr, tmp_target);	! !A407

		    !+
		    !    Get the position of this segment
		    !-

		    BEGIN

		    LOCAL
			keypsn;

		    keypsn = .ksdptr [.j, keypos];	!M411
		    $adjbp_ea (.keypsn, tmp_search);	! Adjust 2-word
		    $adjbp_ea (.keypsn, tmp_target);	! byte pointers
		    END;

		    !+
		    !   We now have two byte ptrs to the two records.
		    !   We can compare this key segment.
		    !
		    !   If the CSTRINGLE macro returns false,
		    !   then the search key segment was greater
		    !   than the target key segment.  We can
		    !   leave, letting COMP_VALUE default to 1.
		    !   If the macro does not return false, then
		    !   we have to decide whether the keys are
		    !   equal or the search key is less than the
		    !   target key.
		    !-

		    IF cstringle_ea (tmp_search, 	! Search	!M407
			    tmp_target, 	! Target	!M407
			    segsize, 		! Size		!M411
			    segsize) EQL false	! Size		!M411
		    THEN
			BEGIN
			comp_value = 1;		! Search key GTR target key
			EXITLOOP;		! Leave loop
			END;

		    !+
		    !    However, the search key segment may have been
		    !    LSS target key segment.  So, we must
		    !    compare the last two characters processed by
		    !    this instruction to see if they are equal.
		    !-

		    IF scann (tmp_search) LSS 	! Last char of search
			scann (tmp_target)	! Last char of target
		    THEN
			BEGIN
			comp_value = -1;
			EXITLOOP;
			END;

		    !+
		    !    At this point, the key segments were equal,
		    !    or the size was zero. In either case, we can
		    !    go back for the next key segment.
		    !-

		    END;			! of IF keysiz NEQ 0

		!
		!    The search key was identical to the target key
		!
		comp_value = 0;			! Return 0: they were equal
		END;				! End of segment loop

	    END;				! End String data types

	[dtppac] :
	    BEGIN

	    LOCAL
		tmp_result,			! Temp to Result of this block
		searchlast,			! last byte of search string
		targetlast,			! last byte of target string
		searchsign,			! sign of search string
		targetsign;			! sign of target string

	    !
	    !   Size for string compare instruction is
	    !   size of search string - 1 because the
	    !   sign is embedded in the last byte,
	    !   and both + and - have several representations
	    !
	    searchkeysize = .recdesc [rdusersize] - 1;
	    !
	    !	Make temporary byte pointers
	    !
	    $copy_byte_pointer (search_ptr, tmp_search);	! !A407
	    $copy_byte_pointer (target_ptr, tmp_target);	! !A407

	    !+
	    !    Get the position of this segment
	    !-

	    BEGIN

	    LOCAL
		keypsn;

	    keypsn = .ksdptr [0, keypos];	!M411
	    $adjbp_ea (.keypsn, tmp_search);	! Adjust 2-word
	    $adjbp_ea (.keypsn, tmp_target);	! byte pointers
	    END;

	    !+
	    !   Compare the two key strings
	    !   If false, the search key was
	    !   probably GTR than the target key
	    !-

	    IF cstringle_ea (tmp_search, 	! Search key
		    tmp_target, 		! Target key
		    searchkeysize, 		! Length
		    searchkeysize) EQL false	! Length
	    THEN
		tmp_result = 1			!
	    ELSE

		IF scann (tmp_search) EQL scann (tmp_target)	!
		THEN
		    tmp_result = 0		!
		ELSE
		    tmp_result = -1;		!

	    !+
	    !    Check last byte of each string for last digit and sign
	    !-

	    searchlast = CH$RCHAR_A (tmp_search);
	    targetlast = CH$RCHAR_A (tmp_target);
	    searchsign = (CASE (.searchlast AND %X'F')	!
	    FROM %X'A' TO %X'F' OF 		!
		SET
		[%X'F', %X'A', %X'C', %X'E'] : 1;
		[%X'B', %X'D'] : -1;
		[OUTRANGE] : 0;
		TES);
	    !
	    !   Fetch sign of target
	    !
	    targetsign = (CASE (.targetlast AND %X'F')	!
	    FROM %X'A' TO %X'F' OF 		!
		SET
		[%X'F', %X'A', %X'C', %X'E'] : 1;
		[%X'B', %X'D'] : -1;
		[OUTRANGE] : 0;
		TES);

	    IF (.tmp_result EQL 0)		! Strings are the same so far
	    THEN 				! we must check the last digit
		BEGIN				! to see if they are the same

		LOCAL
		    diff;

		diff = (.searchlast^-packed_digit_size) - 	!
		(.targetlast^-packed_digit_size);

		IF .diff GTR 0
		THEN
		    tmp_result = 1
		ELSE

		    IF .diff LSS 0 THEN tmp_result = -1;

		END;

	    !+
	    ! Now make sure the signs were the same
	    !-

	    IF .searchsign NEQ .targetsign	!
	    THEN
		tmp_result = .searchsign;	! Signs were different

	    !
	    !   Return the value of this comparison
	    !
	    comp_value = .tmp_result*.searchsign;	! result of all this
	    END;				! PACKED DECIMAL DATA

	[dtpin4] :
	    BEGIN

	    BIND
		search_val = .recdesc [rduserptr] + 	! Search key
		    .ksdptr [0, keypos],	!
		target_val = .targetptr + .ksdptr [0, keypos];	! Target key

	    IF .search_val LSS .target_val	! Well?
	    THEN
		comp_value = -1			! Search LSS target
	    ELSE

		IF .search_val EQL .target_val	! Check again
		THEN
		    comp_value = 0;		! Search EQL target

	    END;

	[dtpun4] : 				! Unsigned Integer data
	    BEGIN

	    BIND
		search_val = .recdesc [rduserptr] + .ksdptr [0, keypos],	! Search key
		target_val = .targetptr + .ksdptr [0, keypos];	! Target key

	    IF .search_val LSSU .target_val	! Well?
	    THEN
		comp_value = -1			! Search LSS target
	    ELSE

		IF .search_val EQLU .target_val	! Check again
		THEN
		    comp_value = 0;		! Search EQL target

	    END;

	[dtpfl1] : 				! Single Floating data
	    comp_value = CMPF (.recdesc [rduserptr] + .ksdptr [0, keypos], 	!
		.targetptr + .ksdptr [0, keypos]);

	[dtpfl2] : 				! Double-Floating data
	    comp_value = CMPD (.recdesc [rduserptr] + .ksdptr [0, keypos], 	!
		.targetptr + .ksdptr [0, keypos]);

	[dtpgfl] : 				! G-Floating data
	    comp_value = CMPG (.recdesc [rduserptr] + .ksdptr [0, keypos], 	!
		.targetptr + .ksdptr [0, keypos]);

	[dtpin8] : 				! Two-word integer
	    BEGIN

	    REGISTER
		R1 = register_pair,
		R2 = register_pair + 1;

	    dmove (R1, 				! Get what we're searching for
		.recdesc [rduserptr] + .ksdptr [0, keypos]);
	    dsub (R1, .targetptr + .ksdptr [0, keypos]);	! Subtract target
	    R2 = .R2;				! Tell Compiler r2 was used

	    IF (.R1 LEQ 0)			! Well?
	    THEN

		IF (.R1 LSS 0)
		THEN
		    comp_value = -1		! search < target
		ELSE

		    IF (.R2 EQL 0)		! first words same; second too?
		    THEN
			comp_value = 0;		! search = target

	    END;
	TES;

    !+
    ! Now we use our tri-state value to return the value our caller wants,
    ! and set the less-than flag if appropriate.
    !-

    SELECT .comp_value OF
	SET

	[1] :
	    RETURN false;			! search string > target

	[0] :
	    RETURN true;			! search string = target

	[-1] :
	    BEGIN
	    setlssflag (recdesc);		! search string < target
	    RETURN true;			!
	    END;
	TES;

    RETURN true;
    END;					! End CKEYUU
%SBTTL 'SETNRP - set next-record-pointer'

GLOBAL ROUTINE setnrp (recdesc, databd) : NOVALUE =
! SETNRP
! ======
! ROUTINE TO SET UP THE NEXT-RECORD-POINTER CONTEXT FOR
!	INDEXED FILES IN THE RST. THIS ROUTINE IS CALLED
!	WHENEVER THE NRP MIGHT HAVE TO BE CHANGED (E.G., $GET,
!	$FIND, $PUT SEQ, ETC. ).
! INPUT:
!	RECDESC		RECORD DESCRIPTOR PACKET
!		RFA		RFA OF DATA RECORD
!				(EITHER UDR OR SIDR)
!		RRV		RFA OF RRV RECORD
!		RECPTR		ADDRESS OF DATA RECORD IN BUFFER
!		SIDRELEMENT	OFFSET INTO CURRENT POINTER ARRAY
!
!	DATABD		BUCKET DESCRIPTOR OF DATA BUCKET
! OUTPUT:
!	<NO STATUS RETURNED>
    BEGIN

    MAP
	recdesc : REF BLOCK,
	databd : REF BLOCK;

    REGISTER
	keysizeinwords,
	rstptr : REF BLOCK,			! FOR SPEED
	acptr : REF BLOCK;			! TEMP PTR

    LOCAL
	recordptr : REF BLOCK,			! PTR TO CURRENT RECORD
	keybuffptr : REF BLOCK;			! PTR TO KEY BUFFER

    TRACE ('SETNRP');

    !+
    !    GET A POINTER TO THE ACTUAL PRIMARY DATA RECORD
    !-

    recordptr = .recdesc [rdrecptr];		! GET PTR TO RECORD
    rstptr = .rst;				! GET RST ADDRESS
    rstptr [rstrpref] = .kdb [kdbref];		! SET UP KRF OF RP
!+
!    SET UP THE INTERNAL REPRESENTATION OF THE CURRENT RECORD.
!    NOTE THAT THIS REPRESENTATIN IS DIFFERENT FROM THE
!    EXTERNAL (USER'S RFA) FORMAT. THIS IS BECAUSE THE USER
!    MUST HAVE A PERMANENT HANDLE ON THE RECORD...THUS THE
!    RRV FORMAT. HOWEVER, SINCE THE RECORD CANT MOVE WHILE
!    IT IS OUR CURRENT RECORD, WE CAN REPRESENT IT INTERNALLY
!    BY ITS RFA FORMAT.
!-
    rstptr [rstdatarfa] = makerfa (.databd [bkdbktno], .recordptr [drrecordid]);
!+
!    SET UP THE OFFSET INTO THE CURRENT POINTER ARRAY OF
!    THE CURRENT RECORD (FOR PRIMARY KEYS, THIS OPERATION
!    IS UNIMPORTANT)
!-
    rstptr [rstrpsidr] = .recdesc [rdsidrelement];	![%44]SET TENTATIVE SIDR ELEM
!+
!    IF THIS IS A $FIND RANDOM, THEN WE DONT NEED TO SET
!    UP THE NRP DATA -- UNLESS ROPNRP SET.
!-

    IF (currentjsys EQL c$find) AND ( NOT seqadr) AND (chkflag (rab [rabrop, 0], ropnrp) EQL 0) THEN RETURN;

    !+
    !    WE CAN NOW SET UP THE NEXT RECORD POINTER DATA
    !-

    !+
    !    SET UP THESE VALUES
    !-

    rstptr [rstnrp] = .recdesc [rdrfa];
    rstptr [rstnrprrv] = .recdesc [rdrrv];
!+
!    MOVE THE KEY STRING INTO THE RST KEY BUFFER.
!    NOTE THAT THE KEY OF THE CURRENT DATA RECORD IS
!    MOVED INTO THE BUFFER WITH THE FULL KEY-STRING SIZE,
!    NOT THE SIZE GIVEN BY THE USER (MAY HAVE BEEN A
!    GENERIC SELECTION )
!-
!+
!    WE MUST BUMP THE POINTER TO THE DATA (ALWAYS A PRIMARY DATA RECOR)
!    BUT THEN MOVE THE KEY (COULD BE SECONDARY)
!    INTO THE KEY BUFFER. SO, WE WILL NEED A TEMP
!    POINTER TO THE PRIMARY KDB
!-
    acptr = .fst [fstkdb];			! PRIMARY KDB
    recordptr = .recordptr + .acptr [kdbhsz];	! SKIP PRIMARY HEADER
    keybuffptr = .rstptr [rstkeybuff];		! ADDRESS TO MOVE IT
    movekey (.recordptr, 			! From record
	.keybuffptr);				! To buffer

    !+
    !    SAVE THE KEY OF REFERENCE OF THE NRP
    !-

    rstptr [rstnrpref] = .kdb [kdbref];
    rstptr [rstsidrelement] = .recdesc [rdsidrelement];	![%44]NOT $FIND RANDOM, SO SET ACTU SIDR ELEM
    RETURN
    END;					! End SETNRP

END

ELUDOM