Trailing-Edge
-
PDP-10 Archives
-
LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86
-
tools/recog3/oldlookup.b32
There are 2 other files named oldlookup.b32 in the archive. Click here to see a list.
MODULE LIB$LOOKUP_KEYWORD ( ! Keyword lookup routine
IDENT = '2-001' ! File: HLPLOOKUP.B32
) =
BEGIN
!
!****************************************************************************
!* *
!* COPYRIGHT (c) 1978, 1980, 1982 BY *
!* DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. *
!* 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 WHICH IS NOT SUPPLIED BY DIGITAL. *
!* *
!* *
!****************************************************************************
!
!++
! FACILITY: General Utility Procedure library
!
! ABSTRACT:
!
! This routine attempts to match a caller-specified character
! string with a table of keywords built by the caller.
! Various utilities are also provided to let a user dynamically
! allocate keyword tables and entries.
!
! ENVIRONMENT: User mode, AST re-entrant. Non-shared library
!
! AUTHOR: Ward Clark, CREATION DATE: 10 January 1978
!
! MODIFIED BY:
!
! Stanley Rabinowitz - 8-MAY-82
!
! 2-001 - Changed name to LIB$LOOKUP_KEYWORD. Added new routines
! LIB$KEYWORD_TABLE_ADD, LIB$KEYWORD_TABLE_DELETE,
! LIB$ALLOCATE_KEYWORD_TABLE, LIB$DEALLOCATE_KEYWORD_TABLE.
! Allow new format table as well as old format table.
!
! Jonathan M. Taylor - 5-Mar-78
!
! 0-2 - Fixed call to LIB$SCOPY_R_DX after changing parameter
! order. JMT 5-Mar-78
! 0-03 - Change to STARLET library. DGP 20-Apr-78
! 0-04 - Change REQUIRE files for VAX system build. DGP 28-Apr-78
! 0-05 - Change STARLET to RTLSTARLE to avoid conflicts. DGP 1-May-78
! 0-06 - Addressing mode general for LIB$SCOPY. TNH 17-June-78
! 0-08 - Change file name to LIBLOOKUP.B32. JBS 14-NOV-78
! 1-001 - Update version number. JBS 16-NOV-78
! 1-002 - Remove REQUIRE of LIBMAC. Only LIBLOOKUP is using it so
! put its text directly in this file. JBS 11-DEC-78
! 1-003 - Add REQUIRE of LIBMSG to define error symbols. JBS 11-DEC-78
! 1-004 - Change LIB$S to STR$. JBS 23-MAY-1979
! 1-005 - Change call to STR$COPY. JBS 16-JUL-1979
! 1-006 - Declare message symbols as externals, add OUTLEN, and do some
! minor cleanups to the text. JBS 18-SEP-1979
! 1-007 - Remove $LIB_KEY_TABLE, moved to RTLMACB32.REQ.
! JBS 19-DEC-1979
! 1-008 - Use handler to translate signals. RW 22-Jan-1980
! 1-009 - Fix bug where STR$COPY_R was being called with length passed
! by value rather than by reference. SBL 11-Mar-1980
! 1-010 - Enhance to recognize additional classes of string descriptors
! by invoking LIB$ANALYZE_SDESC_R3 to extract length and
! address of 1st data byte from descriptor.
! Change call to STR$COPY_R to LIB$SCOPY_R_DX.
! This eliminates the need to establish a handler and the need
! to convert STR$ statuses to LIB$ statuses.
! RKR 28-MAY-1981.
! 1-011 - Add special-case code to process string descriptors that
! "read" like fixed string descriptors. RKR 7-OCT-1981.
! 1-012 - Redirect jsb's from LIB$ANALYZE_SDESC_R3 to
! LIB$ANALYZE_SDESC_R2. Use LIB$SCOPY_R_DX6 to do copying.
! RKR 18-NOV-1981.
!--
!<BLF/PAGE>
!
! SWITCHES:
!
SWITCHES ADDRESSING_MODE
(EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE);
!
! LINKAGES
!
REQUIRE 'RTLIN:STRLNK'; ! Linkage for LIB$ANALYZE_SDESC_R2
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
LIB$LOOKUP_KEYWORD, ! Keyword table scanning routine
LIB$ALLOCATE_KEYWORD_TABLE, ! Allocates a new table
LIB$DEALLOCATE_KEYWORD_TABLE, ! Deallocates it
LIB$SCAN_KEYWORD_TABLE, ! Scans a keyword table
LIB$KEYWORD_TABLE_ADD, ! Adds a new entry to a keyword table
LIB$KEYWORD_TABLE_DELETE; ! Deletes an entry
!
! INCLUDE FILES:
!
LIBRARY 'RTLSTARLE'; ! VAX/VMS Literals
LIBRARY 'HELPUSER'; ! Recognition package literals
REQUIRE 'RTLIN:RTLPSECT'; ! Define DECLARE_PSECTS macro
!
! MACROS:
!
! None
!
!
! EQUATED SYMBOLS:
!
! None
!
! PSECT DECLARATIONS:
!
DECLARE_PSECTS (LIB); ! This module belongs to the LIB facility
!
! OWN STORAGE:
!
! None
!
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
LIB$ANALYZE_SDESC_R2 : LIB$ANALYZE_SDESC_JSB_LINK, ! Extract length
! and address of
! 1st data byte
! from descriptor
LIB$ANALYZE_SDESC, ! TEMP
LIB$SCOPY_R_DX6 : STRING_JSB ; ! Copy a by-reference string to a
! descriptor of any type.
!+
! The following are the conditions returned by this module
!-
EXTERNAL LITERAL
LIB$_STRTRU, ! String truncated
LIB$_AMBKEY, ! Multiple keyword match found
LIB$_UNRKEY, ! No keyword match found
LIB$_INVARG, ! Invalid argument(s)
HLP$_FULL, ! Keyword table is full
HLP$_REPLACED; ! Keyword successfully replaced
GLOBAL ROUTINE LIB$LOOKUP_KEYWORD ( ! Keyword table scanning routine
STRNG_DESC_ADDR, ! Search string
KEY_TABLE_ADDR, ! Keyword table
KEY_VALUE_ADDR, ! Keyword value deposit area
FULL_DESC_ADDR, ! Full keyword deposit area
OUTLEN ! Number of bytes stored
! in FULL_DESC_ADDR
) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This keyword lookup routine scans a table of keywords (see
! below), attempting to find a keyword which matches a caller-
! specified keyword or keyword abbreviation.
!
!
! When a keyword match is found, the following information is
! optionally returned to the caller:
!
! * longword value associated with the matched keyword
! (KEY_VALUE_ADDR)
! * full keyword string (any descriptor type)
! (FULL_DESC_ADDR)
!
! If an exact keyword match is found (i.e., the caller's search
! string is an unabbreviated keyword), no further processing is
! performed and a normal completion code is returned to the
! caller. Otherwise, after a match has been found, the rest of
! the keyword table is scanned. If an additional match is found,
! a "not enough characters" completion code is returned to the
! caller.
!
! The keyword table, which the caller creates for this routine
! has two possible formats. The old format is provided for
! compatibility purposes. The new format is more general.
!
! OLD FORMAT:
!
! longword vector
! +---------------------------+
! | vector size - 1 | (note that high-order bit is 0)
! +---------------------------+
! | address of keyword string |-------+
! | - - - - - - - - - - - - - | |
! | associated keyword value | V
! +---------------------------+ +---+------------------+
! | . | | | keyword string |
! | . | +---+------------------+
! | . | counted ASCII string
! | |
! | |
! | |
! | |
! +---------------------------+
!
! where the "counted ASCII string" starts with a byte which is
! the unsigned count of the number of ASCII characters which
! follow.
!
! NEW FORMAT:
!
! longword vector
! +---------------------------+
! |1| flags | max entries |
! +---------------------------+
! | | cur entries |
! +---------------------------+
! | address of keyword string |------------------------------+
! | - - - - - - - - - - - - - | |
! | associated keyword value | V
! +---------------------------+ +------------------------+
! | . | | descriptor for keyword |
! | . | +------------------------+
! | . |
! | |
! | |
! | |
! | |
! +---------------------------+
!
! The number of entries (max or cur)
! refers to the number of longword pairs that follow.
!
! FORMAL PARAMETERS:
!
! STRNG_DESC_ADDR.rt.dx - Address of search string descriptor
! KEY_TABLE_ADDR.rlu.ra - Address of keyword table
! [KEY_VALUE_ADDR.wlu.r] - Address of keyword value deposit area
! (optional)
! [FULL_DESC_ADDR.wt.dx] - Address of full keyword deposit area
! (optional)
! [OUTLEN.ww.r] - Number of bytes stored in FULL_DESC_ADDR
! (optional)
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! COMPLETION CODES:
!
! SS$_NORMAL = Unique keyword match found
! LIB$_FATERRLIB = Fatal error in library
! LIB$_INVSTRDES = Invalid string descriptor
! LIB$_INVSIRMEM = Insufficient Virtual memory
! LIB$_STRTRU = String is truncated
! LIB$_AMBKEY = Multiple keyword match found
! (i.e., not enough characters specified)
! LIB$_UNRKEY = No keyword match found
! LIB$_INVARG = Invalid arguments, not enough arguments,
! bad keyword table
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN
BUILTIN
ACTUALCOUNT, ! Actual parameter count
NULLPARAMETER; ! Test for presence of parameter
MAP
STRNG_DESC_ADDR : REF BLOCK [, BYTE], ! caller's search string
FULL_DESC_ADDR : REF BLOCK [, BYTE], ! returned full key
OUTLEN : REF VECTOR [1, WORD, UNSIGNED]; ! Number of bytes
! stored in
! FULL_DESC_ADDR
BIND ! Redefine some routine arguments:
KEY_TABLE = .KEY_TABLE_ADDR : VECTOR, ! Caller's keyword table
KEYTAB = .KEY_TABLE_ADDR : VECTOR[,WORD], ! Same, but as word vector
KEY_VALUE = .KEY_VALUE_ADDR; ! Caller's keyword
! value deposit area
LOCAL
NEW_STRUC, ! TRUE if this is a new-style keyword table
ENTRIES, ! Number of entries in table
MATCH, ! Index of item that matched
KEY_VECT, ! Address of beginning of vectors in table
STRING_LEN : WORD, ! Length of search string
STRING_ADDR, ! Address of search string
MATCH_ADDR, ! Address of item that matched
MATCH_LEN : WORD, ! Length of item that matched
RET_STATUS, ! Temporary status
RETURN_CODE; ! Routine return code
!+
! Verify that the caller provided a proper argument list.
!-
IF (ACTUALCOUNT () LSSU 2) ! If less that 2 arguments were provided,
THEN
RETURN (LIB$_INVARG); ! return an error code to the caller.
!+
! Prepare to scan the caller's keyword table.
!-
RETURN_CODE = LIB$_UNRKEY; ! Initially assume no keyword match
! exists.
!+
! Extract length and address of 1st data byte of search string.
! If error results from attempt to extract, return that error.
!-
IF .STRNG_DESC_ADDR [DSC$B_CLASS] GTRU DSC$K_CLASS_D
THEN ! Use generalized extract
BEGIN
RET_STATUS = LIB$ANALYZE_SDESC_R2 ( .STRNG_DESC_ADDR ;
STRING_LEN, STRING_ADDR ) ;
IF NOT .RET_STATUS THEN RETURN (.RET_STATUS) ;
END
ELSE ! Fetch length and address directly
BEGIN
STRING_LEN = .STRNG_DESC_ADDR [DSC$W_LENGTH] ;
STRING_ADDR = .STRNG_DESC_ADDR [DSC$A_POINTER] ;
END;
!+
! Set NEW flag to TRUE if this is a new style keyword table.
!-
NEW_STRUC=.KEY_TABLE<31,1>;
!+
! Find out how many entries there are and where the entries (vectors)
! begin.
!-
IF .NEW_STRUC
THEN
BEGIN
ENTRIES=.KEYTAB[2];
KEY_VECT=KEY_TABLE[2]
END
ELSE
BEGIN
ENTRIES=.KEY_TABLE/2;
KEY_VECT=KEY_TABLE[1]
END;
!+
! Scan the keyword table for a match with the caller's string.
!-
INCR INDEX FROM 0 TO .ENTRIES-1 DO ! Loop until the end of
! the keyword table.
BEGIN
BIND VECT = .KEY_VECT : VECTOR,
ENTRY = VECT[.INDEX*2]: VECTOR[2];
LOCAL ENTRY_ADDR, ! Address of current entry
ENTRY_LEN : WORD; ! Length of current entry
!+
! Get the length and address of the current keyword.
!-
IF .NEW_STRUC
THEN
BEGIN
RET_STATUS = LIB$ANALYZE_SDESC(.ENTRY[0],ENTRY_LEN,ENTRY_ADDR);
IF NOT .RET_STATUS THEN RETURN .RET_STATUS
END
ELSE
BEGIN
BIND CS = .ENTRY[0] : VECTOR[,BYTE];
ENTRY_LEN=.CS[0];
ENTRY_ADDR=CS[1]
END;
!+
! First make sure that the caller's string is not longer than
! the current keyword.
!-
IF (.STRING_LEN LEQU .ENTRY_LEN)
THEN
!+
! If the caller's string matches the current keyword begin
! additional checking.
!-
IF CH$EQL(.STRING_LEN, .STRING_ADDR,
.STRING_LEN, .ENTRY_ADDR)
THEN
BEGIN
!+
! If the caller's search string is the same length as
! the keyword it matches
!-
IF (.STRING_LEN EQLU
.ENTRY_LEN)
THEN
BEGIN ! special exact-match processing.
MATCH = .INDEX;
MATCH_ADDR = .ENTRY_ADDR; ! Save the current keyword
MATCH_LEN = .ENTRY_LEN; ! table entry address and length.
RETURN_CODE = SS$_NORMAL; ! indicate a keyword
! match was found,
EXITLOOP; ! and bypass further key
! word table scanning.
END; ! special exact-match processing
!+
! If a match has not already been found,
!-
IF (.RETURN_CODE EQL LIB$_UNRKEY)
THEN
BEGIN
MATCH = .INDEX;
MATCH_ADDR = .ENTRY_ADDR; ! Save the current entry
MATCH_LEN = .ENTRY_LEN; ! length and address
RETURN_CODE = SS$_NORMAL; ! and indicate a match
! has been found.
END
ELSE ! Otherwise, indicate that a multiple
! keyword match has been found
BEGIN
RETURN_CODE = LIB$_AMBKEY; ! (i.e., no enough
! characters provided)
EXITLOOP; ! and exit the keyword
! scanning loop.
END;
END; ! End of keyword match processing.
END; ! End of the keyword table searching loop.
!+
! If a keyword match was found, return the keyword information to the
! caller.
!-
IF (.RETURN_CODE NEQ LIB$_UNRKEY) ! Make sure a keyword match was found.
THEN
BEGIN ! match was found code
BIND VECT = .KEY_VECT : VECTOR,
ENTRY = VECT[.MATCH*2]: VECTOR[2];
!+
! If the caller provided a parameter to receive the key value,
! return it to him.
!-
IF ( NOT NULLPARAMETER (3)) THEN
KEY_VALUE = .ENTRY[1];
!+
! If the caller has provided a descriptor to receive the matched
! key, return it to him.
!-
IF ( NOT NULLPARAMETER (4))
THEN
BEGIN ! returning optional arguments
RET_STATUS = LIB$SCOPY_R_DX6 (
.MATCH_LEN,
.MATCH_ADDR,
.FULL_DESC_ADDR ) ;
!+
! If the copy failed, record the status
!-
IF NOT .RET_STATUS THEN RETURN_CODE = .RET_STATUS ;
!+
! If the caller is using fixed length strings, he may want
! to know how many characters we actually stored, not
! counting trailing pads.
! There is no need to check status on call to
! LIB$ANALYZE_SDESC_R2.
! If the descriptor was bad, it would have gotten caught
! during the copy operation above.
!-
IF ( NOT NULLPARAMETER (5))
THEN
BEGIN ! returning length
LOCAL
FULL_LEN, ! **** Shouldn't this be a WORD? - STAN -
FULL_ADDR;
IF .FULL_DESC_ADDR [DSC$B_CLASS] GTRU DSC$K_CLASS_D
THEN ! Use general length extraction
BEGIN
LIB$ANALYZE_SDESC_R2 ( .FULL_DESC_ADDR ;
FULL_LEN, FULL_ADDR ) ;
END
ELSE ! Fetch length directly
FULL_LEN = .FULL_DESC_ADDR [DSC$W_LENGTH ] ;
OUTLEN [0] = MIN (.MATCH_LEN,.FULL_LEN);
END; ! returning length
END; ! returning optional arguments
END; ! match as found code
!+
! Return the current keyword match return code to the caller.
!-
RETURN (.RETURN_CODE); ! Return the current match code to the
! caller.
END; ! End of LIB$LOOKUP_KEYWORD routine
GLOBAL ROUTINE LIB$ALLOCATE_KEYWORD_TABLE(P_HANDLE,P_SIZE) =
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
!
! Allocates a keyword table from virtual memory.
!
! FORMAL PARAMETERS:
!
! P_HANDLE Address of longword to receive back
! address of allocated keyword table
!
! P_SIZE Address of a longword containing
! the maximum number of entries
! that this keyword table may hold.
! If this argument is omitted, or
! if it is 0, or if it's value is 0,
! then a keyword table capable of
! holding 64 entries is allocated.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! SS$_NORMAL Procedure successfully completed.
!
! LIB$_INVARG No arguments were specified or
! a table containing more than 32767
! entries was requested.
!
! LIB$_INSVIRMEM Insufficient virtual memory to allocate
! this keyword table.
!
! SIDE EFFECTS:
!
! NONE
!
!--
LOCAL
ENTRIES, ! Maximum number of entries
BYTE_SIZE, ! Number of bytes to be allocated
STATUS;
BIND
HANDLE = .P_HANDLE; ! Receives address of table allocated
EXTERNAL ROUTINE
LIB$GET_VM; ! Get virtual memory
BUILTIN
ACTUALCOUNT, ! Actual parameter count
NULLPARAMETER; ! Test for presence of parameter
IF ACTUALCOUNT() LSSU 1 ! If less that 1 argument was provided,
THEN RETURN LIB$_INVARG; ! return an error code to the caller.
!+
! The number of bytes of virtual memory depends on the maximum number
! of entries that the table can hold.
! There are two longwords (8 bytes) for each entry,
! plus two overhead longwords at the beginning of the structure.
!-
IF NULLPARAMETER(2)
THEN ENTRIES=64
ELSE BEGIN
BIND SIZE = .P_SIZE;
IF SIZE EQL 0 OR .SIZE EQL 0
THEN ENTRIES=64
ELSE ENTRIES=.SIZE
END;
!+
! It is an error if the number of entries requested is
! more than 32767.
!-
IF .ENTRIES GTRU 32767
THEN RETURN LIB$_INVARG;
!+
! Convert number of entries to size of table in bytes.
!-
BYTE_SIZE=.ENTRIES*8+8;
STATUS=LIB$GET_VM(BYTE_SIZE,HANDLE); ! Allocate the virtual memory
IF NOT .STATUS THEN RETURN .STATUS; ! Return error if had problems
!+
! Initialize the table.
!-
BEGIN
BIND KEYTAB = .HANDLE : VECTOR[4,WORD],
FLAGS = KEYTAB[1] : BITVECTOR[16];
KEYTAB[0]=.ENTRIES; ! Set max number of entries
KEYTAB[1]=0; ! Clear all flags
FLAGS[15]=1; ! Set new structure bit
KEYTAB[2]=0; ! No entries yet.
KEYTAB[3]=0; ! Unused (must be 0 for now)
END;
RETURN SS$_NORMAL
END;
GLOBAL ROUTINE LIB$DEALLOCATE_KEYWORD_TABLE(P_HANDLE) =
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
!
! Deallocated a keyword table that had
! previously been allocated by LIB$ALLOCATE_KEYWORD_TABLE.
!
! FORMAL PARAMETERS:
!
! P_HANDLE address of keyword table
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! SS$_NORMAL procedure successfully completed
!
! LIB$_BADBLOADR Address of keyword table was bad.
! See fuller description of this error
! in writeup of LIB$FREE_VM.
!
! LIB$_INVARG No arguments were specified.
!
! SIDE EFFECTS:
!
! NONE
!
!--
LOCAL
BYTE_SIZE, ! Number of bytes to be allocated
STATUS;
BIND
HANDLE = .P_HANDLE, ! Contains address of table allocated
KEYTAB = .HANDLE : VECTOR[4,WORD];
EXTERNAL ROUTINE
LIB$FREE_VM; ! Free virtual memory
BUILTIN
ACTUALCOUNT; ! Actual parameter count
IF ACTUALCOUNT() LSSU 1 ! If less that 1 argument was provided,
THEN RETURN LIB$_INVARG; ! return an error code to the caller.
!+
! Convert the maximum number of entries to size of table in bytes.
!-
BYTE_SIZE=.KEYTAB[0]*8+8;
STATUS=LIB$FREE_VM(BYTE_SIZE,HANDLE); ! Deallocate the virtual memory
IF NOT .STATUS THEN RETURN .STATUS; ! Return error if had problems
RETURN SS$_NORMAL
END;
GLOBAL ROUTINE LIB$SCAN_KEYWORD_TABLE(P_HANDLE,P_NAME_DESC,P_RTN,P_CTX) =
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
!
! Calls an action routine for each keyword in a keyword table
! that has a given initial string.
!
! FORMAL PARAMETERS:
!
! P_HANDLE Address of unsigned longword containing
! the address of the keyword table.
!
! P_NAME_DESC Address of a string descriptor for the initial
! part of the string that must match. If this is
! 0 or a pointer to the null string, then
! all keywords in the table match.
!
! P_RTN Address of user's action routine to be called.
!
! P_CTX Address of longword contianing context value
! to be passed to user's action routine.
! The action routine is called with three arguments:
!
! 1. address of descriptor for keyword
! 2. address of KIT table corresponding
! to this keyword entry
! 3. address of context longword
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! SS$_NORMAL Service successfully completed.
! A new keyword has been entered into the table.
!
! LIB$_INVARG Fewer than 3 arguments were specified.
!
! SIDE EFFECTS:
!
! NONE
!
!--
LOCAL
FAKE_KIT : $KIT_DECL, ! Internal keyword table used for old-style
! structures.
NEW_STRUC, ! 1 if this is a new-style table
BASE, ! Address of start of longword pairs
NUMBER_OF_ITEMS, ! Number of pairs of longwords
NAME_LEN : WORD,
NAME_ADR,
STATUS;
BIND ROUTINE
RTN = .P_RTN;
BIND
HANDLE = .P_HANDLE,
KEYTAB = .HANDLE : VECTOR;
BUILTIN
ACTUALCOUNT; ! Actual parameter count
EXTERNAL ROUTINE
LIB$ANALYZE_SDESC;
IF ACTUALCOUNT() LSSU 3 ! If less that 3 arguments were provided,
THEN RETURN LIB$_INVARG; ! return an error code to the caller.
STATUS=LIB$ANALYZE_SDESC(.P_NAME_DESC,NAME_LEN,NAME_ADR);
IF NOT .STATUS THEN RETURN .STATUS;
!+
! Set flag NEW_STRUC if this is a new-style keyword table.
!-
NEW_STRUC=.KEYTAB<31,1>;
IF .NEW_STRUC
THEN BEGIN
BIND KW = .HANDLE : VECTOR[,WORD];
NUMBER_OF_ITEMS=.KW[2];
BASE = KEYTAB[2]
END
ELSE BEGIN
NUMBER_OF_ITEMS=.KEYTAB[0]/2;
BASE = KEYTAB[1];
END;
!**** Must remove the *4 when symbol gets real size in bytes.
IF NOT .NEW_STRUC
THEN CH$FILL(0,KIT$K_BLN*4,FAKE_KIT);
!+
! Now go scan through the table.
!-
INCR I FROM 0 TO .NUMBER_OF_ITEMS-1 DO
BEGIN
BIND PAIR_LIST = .BASE : VECTOR,
PAIR = PAIR_LIST[2*.I] : VECTOR;
LOCAL STR_ADR,
STR_LEN : WORD;
!+
! Get the length and the address of the string
! in the kwyword table.
!-
IF .NEW_STRUC
THEN BEGIN
STATUS=LIB$ANALYZE_SDESC(.PAIR[0],STR_LEN,STR_ADR);
IF NOT .STATUS THEN RETURN .STATUS
END
ELSE BEGIN
BIND CS = .PAIR[0] : VECTOR[,BYTE];
STR_LEN=.CS[0];
STR_ADR= CS+1
END;
!+
! If the keyword is too short, then this ain't it.
! Otherwise, compare the keywords.
!-
IF .STR_LEN GEQU .NAME_LEN AND
CH$EQL(.NAME_LEN,.NAME_ADR,.NAME_LEN,.STR_ADR)
THEN BEGIN
IF .NEW_STRUC
THEN BEGIN
BIND KIT=.PAIR[1] : $KIT_DECL;
!+
! Don't compare entry with NOT bit on
! if entered with null null name.
!-
IF .NAME_LEN EQL 0 AND
KIT NEQ 0 AND
.KIT[KIT$V_NOT]
THEN STATUS=1
ELSE STATUS=RTN(.PAIR[0],.PAIR[1],.P_CTX)
END
ELSE BEGIN
LOCAL D : VECTOR[2];
D[0]=.STR_LEN;
D[1]=.STR_ADR;
FAKE_KIT[KIT$L_VAL]=.PAIR[1];
STATUS=RTN(D,FAKE_KIT,.P_CTX)
END;
!+
! We abort the process if the user's routine
! ever returns a FALSE value.
!-
IF NOT .STATUS THEN RETURN .STATUS
END
END;
RETURN SS$_NORMAL
END;
GLOBAL ROUTINE LIB$KEYWORD_TABLE_ADD(P_HANDLE,P_NAME_DESC,P_KIT) =
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
!
! Adds a new entry to a (new-style) keyword table.
!
! FORMAL PARAMETERS:
!
! P_HANDLE Address of unsigned longword containing
! the address of the keyword table.
!
! P_NAME_DESC Address of a string descriptor for the
! keyword to be added to the table.
!
! P_KIT Address of the KIT to be associated with this keyword.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! SS$_NORMAL Service successfully completed.
! A new keyword has been entered into the table.
!
! LIB$_INVARG Fewer than 3 arguments were specified.
!
! HLP$_REPLACED Service successfully completed. The keyword
! was already in the table, and it's associated value
! has been replaced by the new value specified.
!
! HLP$_FULL table full
!
! SIDE EFFECTS:
!
! NONE
!
!--
LOCAL
INDEX,
STATUS;
EXTERNAL LITERAL
HLP$_REPLACED, ! keyword item successfully replaced
HLP$_FULL; ! table was full
BIND
HANDLE = .P_HANDLE, ! Contains address of table allocated
KEYTAB = .HANDLE : VECTOR[4,WORD],
NAME_DESC = .P_NAME_DESC : BLOCK[,BYTE],
KEYVECTOR = .HANDLE : VECTOR,
KIT = .P_KIT;
BUILTIN
ACTUALCOUNT; ! Actual parameter count
IF ACTUALCOUNT() LSSU 3 ! If less that 3 arguments were provided,
THEN RETURN LIB$_INVARG; ! return an error code to the caller.
!+
! See if the entry is already in the table, and if not,
! find the spot where it should go.
!-
INCR I FROM 1 TO .KEYTAB[2] DO
BEGIN
BIND KW = .KEYVECTOR[.I*2] : BLOCK[,BYTE],
KV = KEYVECTOR[.I*2+1];
LOCAL STATE : SIGNED;
!+
! Compare this entry against the user's keyword.
!-
STATE=CH$COMPARE(.NAME_DESC[DSC$W_LENGTH],.NAME_DESC[DSC$A_POINTER],
.KW[DSC$W_LENGTH],.KW[DSC$A_POINTER]);
!+
! If we're not there yet, keep on searching.
! If it's an exact match, just change the value.
! If we're past where it should go, then insert a new entry.
!-
IF .STATE EQL 0
THEN BEGIN
KV=KIT;
RETURN HLP$_REPLACED
END;
IF .STATE EQL -1
THEN BEGIN
!+
! If the table is full, return an error status to the user.
!-
IF .KEYTAB[0] EQL .KEYTAB[2]
THEN RETURN HLP$_FULL;
!+
! Insert us here, moving everyone else down.
!-
KEYTAB[2]=.KEYTAB[2]+1;
CH$MOVE((.KEYTAB[2]-.I)*8,
KEYVECTOR[.I*2],KEYVECTOR[.I*2+2]);
KEYVECTOR[.I*2]=NAME_DESC;
KEYVECTOR[.I*2+1]=KIT;
RETURN SS$_NORMAL
END;
END;
!+
! It wasn't found, so it must go at the end of the table.
!-
!+
! If the table is full, return an error status to the user.
!-
IF .KEYTAB[0] EQL .KEYTAB[2]
THEN RETURN HLP$_FULL;
!+
! Insert us at the end.
!-
KEYTAB[2]=.KEYTAB[2]+1;
KEYVECTOR[.KEYTAB[2]*2]=NAME_DESC;
KEYVECTOR[.KEYTAB[2]*2+1]=KIT;
RETURN SS$_NORMAL
END;
GLOBAL ROUTINE LIB$KEYWORD_TABLE_DELETE(P_HANDLE,P_NAME_DESC) =
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
!
! Removes (deletes) an entry from a (new-style) keyword table.
!
! FORMAL PARAMETERS:
!
! P_HANDLE Address of unsigned longword containing
! the address of the keyword table.
!
! P_NAME_DESC Address of a string descriptor for the
! keyword to be removed from the table.
! An exact match must be found.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! SS$_NORMAL Service successfully completed.
! A new keyword has been entered into the table.
!
! LIB$_INVARG Fewer than 2 arguments were specified.
!
! LIB$_UNRKEY Unrecognized keyword.
!
! SIDE EFFECTS:
!
! NONE
!
!--
LOCAL
INDEX,
STATUS;
BIND
HANDLE = .P_HANDLE, ! Contains address of table allocated
KEYTAB = .HANDLE : VECTOR[4,WORD],
NAME_DESC = .P_NAME_DESC : BLOCK[,BYTE],
KEYVECTOR = .HANDLE : VECTOR;
BUILTIN
ACTUALCOUNT; ! Actual parameter count
IF ACTUALCOUNT() LSSU 2 ! If less that 2 arguments were provided,
THEN RETURN LIB$_INVARG; ! return an error code to the caller.
!+
! Scan the keyword table, looking for this entry.
!-
INCR I FROM 1 TO .KEYTAB[2] DO
BEGIN
BIND KW = .KEYVECTOR[.I*2] : BLOCK[,BYTE],
KV = KEYVECTOR[.I*2+1];
LOCAL STATE : SIGNED;
!+
! Compare this entry against the user's keyword.
!-
STATE=CH$COMPARE(.NAME_DESC[DSC$W_LENGTH],.NAME_DESC[DSC$A_POINTER],
.KW[DSC$W_LENGTH],.KW[DSC$A_POINTER]);
!+
! If we're not there yet, keep on searching.
! If it's an exact match, then we delete this entry.
! If we're past where it should go, then return the
! fact that the keyword was unrecognized.
!-
IF .STATE EQL 0
THEN BEGIN
!+
! Remove this entry by moving everyone else down.
!-
CH$MOVE((.KEYTAB[2]-.I)*8,KEYVECTOR[.I*2+2],KEYVECTOR[.I*2]);
!+
! Decrement the count of entries by 1.
!-
KEYTAB[2]=.KEYTAB[2]-1;
RETURN SS$_NORMAL
END;
IF .STATE EQL -1
THEN RETURN LIB$_UNRKEY;
END;
RETURN LIB$_UNRKEY;
END;
END ! End of LIB$LOOKUP_KEYWORD module
ELUDOM