Trailing-Edge
-
PDP-10 Archives
-
tops20-v7-ft-dist1-clock
-
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