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

MODULE LIB$LOOKUP_KEYWORD (		! Keyword lookup routine

	IDENT = '2-002'		! 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.
!
! 2-002 - Allow bit 30 in the first longword of a keyword table to mean
!	  (if on) that the keyword table is new-style in the
!	  sense that it uses descriptors, but old-style in the
!	  sense that there is no KIT.  The second longword of each
!	  longword pair is the "value" of that keyword.
!
!	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.REQ';		! 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.REQ';	! 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 containing 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
!
!			Note that a fake KIT will be created if the
!			keyword table is old style or the first
!			longword has bit 30 set.
!
! 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
	KIT_FLAG,			! 1 if KIT is missing from new structure
	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>;
KIT_FLAG=.KEYTAB<30,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)
OR (.NEW_STRUC AND .KIT_FLAG)
  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 AND NOT .KIT_FLAG
		  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