Google
 

Trailing-Edge - PDP-10 Archives - BB-KL11M-BM_1990 - t20src/tbl.b36
There are 13 other files named tbl.b36 in the archive. Click here to see a list.
MODULE tbluk (  !
                ENTRY(tbl_lookup,
                      tbl_add,
                      tbl_delete)
                ) =
BEGIN
!	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1985, 1989.
!	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.

!++
! FACILITY:     Table Lookup/Add/Delete Routines
!
! ABSTRACT:     These routines emulate the TOPS-20 tbluk jsys for use
!       on not only TOPS-20 but TOPS-10 (and potentially others) as well.
!
! ENVIRONMENT:  TOPS-10, and TOPS-20
!
! AUTHOR: Richard B. Waddington, CREATION DATE: 11-Jan-85
!
! MODIFIED BY:
!
!       , : VERSION
! 01    -
!--
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
        tbl_compare,
        tbl_lookup,
        tbl_add,
        tbl_delete;
!
! INCLUDE FILES:
!
%IF %SWITCHES(TOPS20) %THEN
    LIBRARY 'MONSYM';
    LIBRARY 'MXJLNK';
%FI
LIBRARY 'TBL';
REQUIRE 'BLT';
!
! MACROS:
!
MACRO
     CH$DEFAULT (N, DEFAULT) =
	%IF %NULL (n) %THEN default %ELSE n %fi %;

MACRO
     CH$LEN (PTR, N) =
        BEGIN
        LOCAL
            p;

	IF CH$FAIL(p = CH$FIND_CH (ch$default (N,200), PTR, 0))
        THEN 
            ch$default (N, 200)
        ELSE
            CH$DIFF (.p, PTR)
        END %;
!
! EQUATED SYMBOLS:
!
LITERAL
    true = (1 EQL 1),
    false = (1 EQL 0);

SWITCHES LIST(NOEXPAND);
! The following table is used to convert strings to UPPER CASE.
GLOBAL BIND
    uc_tab = CH$TRANSTABLE(seq(%O'0', %O'140'),
                           seq(%C'A', %C'Z'),
                           seq(%O'173', %O'177'));
SWITCHES LIST(EXPAND);
!
! OWN STORAGE:
!
!
! EXTERNAL REFERENCES:
!
GLOBAL ROUTINE tbl_lookup (tb_,str,indx_) =  !

!++
! FUNCTIONAL DESCRIPTION:
!       This routine emulates the TOPS-20 TBLUK JSYS.
!
! FORMAL PARAMETERS:
!
!       tb:     The address of a TBLUK tbl.
!       str:    A CH$PTR to the string to look up.
!       indx:   The address to return the table index in.  If str
!               uniquely matches, this is the index of str.
!               If str does not match, then this is the index where
!               str would go if it were in the table.
!
! IMPLICIT INPUTS:
!
!       uc_tab is used to convert lowercase to UPPER CASE.
!
! IMPLICIT OUTPUTS:
!
!       NONE
!
! ROUTINE VALUE:
!       0 if no match is found
!       1 if an exact match is found
!       2 if str is an ambiguous abreviation
!       3 if str is an unambiguous abreviation
!
! COMPLETION CODES:
!
!       NONE
!
! SIDE EFFECTS:
!
!       NONE
!
!--

    BEGIN
    BIND
        tb = .tb_: tbl,
        lc_ptr = .str,
        indx = .indx_;

    STACKLOCAL
        str_uc_buffer: VECTOR[ch$allocation(132)];

    BIND
        str_ptr = CH$PTR(str_uc_buffer);

    LOCAL
        str_len,
        key,
        top,
        bottom,
        done,
        norec,
        indx_first;


    IF .tb[TBL_ACTUAL_ENTRIES] LEQ 0
    THEN
        BEGIN
        indx = 1;
        RETURN tbl_nomatch;                       !Table is empty, nomatch...
        END;

    str_len = ch$len(lc_ptr);                     !Get the length and convert
    CH$TRANSLATE(uc_tab,                          ! to UPPER CASE
                .str_len, lc_ptr,
                0,
                .str_len + 1, str_ptr);

    done = false;                                 !Do the binary search
    bottom = 1;
    top = .tb[TBL_ACTUAL_ENTRIES];

    WHILE NOT .done DO
        BEGIN
        BUILTIN LSH;

        IF .top LEQ .bottom
        THEN
            done = true;

        indx = LSH(.top + .bottom, -1);
        CASE tbl_compare(.str_len, str_ptr, tb, .indx)
                        FROM tbl_lessthan TO tbl_greaterthan OF
            SET
            [tbl_lessthan]:     top = .indx - 1;
            [tbl_equalto]:      (done = false; EXITLOOP); !Found a match
            [tbl_greaterthan]:  bottom = indx = .indx + 1;
            TES;
        END;

    IF .indx EQL 0
    THEN
        indx = 1;

    IF .done                            !No match
    THEN
        RETURN tbl_nomatch;

    indx_first = .indx;

    WHILE .indx GTR 1 DO                !Perform linear search back to
                                        ! first possible match
        BEGIN
        IF tbl_compare(.str_len, str_ptr, tb, .indx - 1) EQL tbl_greaterthan
        THEN
            EXITLOOP;

        indx = .indx -1
        END;

    key = key$(tb, .indx, norec);       !Check the no-recognize bit

    IF .norec
    THEN
        RETURN tbl_ambiguous;

                                        !Check for exact match
    IF CH$RCHAR(CH$PLUS(CH$PTR(.key), .str_len)) EQL 0
    THEN
        RETURN tbl_exactmatch;

    IF .indx EQL .indx_first            !Binary search hit first one.
    THEN                                ! See if it's unique...
        IF tbl_compare(.str_len, str_ptr, tb, .indx + 1) NEQ tbl_equalto
        THEN
            RETURN tbl_abreviation;

    RETURN tbl_ambiguous                !Must be ambiguous

    END;                        !End of TBL_LOOKUP

ROUTINE tbl_compare(len,ptr,tb_,i) =
!++
! FUNCTIONAL DESCRIPTION:
!       This routine compares an UPPER CASE string with an entry in a
!       TBLUK table.
!
! FORMAL PARAMETERS:
!
!       len:    The length of the string.
!       ptr:    The pointer to the string.
!       tb:     The address of a TBLUK tbl.
!       str:    The index of the entry to compare with.
!
! IMPLICIT INPUTS:
!
!       uc_tab is used to convert lowercase to UPPER CASE.
!       ptr is assumed to be pointing to an UPPER CASE string.
!
! IMPLICIT OUTPUTS:
!
!       NONE
!
! ROUTINE VALUE:
!      -1 if the string is less than the entry.
!       0 if the string matches.
!       1 if the string is greater than the entry.
!
! COMPLETION CODES:
!
!       NONE
!
! SIDE EFFECTS:
!
!       NONE
!
!--
    BEGIN
    STACKLOCAL
        key_uc_buffer: VECTOR[CH$ALLOCATION(132)];

    BIND
        tb = .tb_: tbl;

    BIND
        key_ptr = CH$PTR(key_uc_buffer);

    CH$TRANSLATE(uc_tab,                        !Convert table key to UC
                .len, CH$PTR(key$(tb, .i)),
                0,
                .len, key_ptr);

    CASE CH$COMPARE(.len, .ptr, .len, key_ptr)  !Compare strings
        FROM -1 TO 1 OF
            SET
            [-1]:   RETURN tbl_lessthan;

            [0]:    RETURN tbl_equalto;

            [1]:    RETURN tbl_greaterthan;
            TES;
    END;                                                !End of tbl_compare
GLOBAL ROUTINE tbl_add (tb_,key_,indx_,data) =        !

!++
! FUNCTIONAL DESCRIPTION:
!       This routine emulates the TOPS-20 TBADD JSYS.
!
! FORMAL PARAMETERS:
!
!       tb:     The address of a TBLUK tbl.
!       key:    The address of an ASCIZ string.
!       indx:   The address to return the new table index to.
!       data:   The value to be stored in the table's data field.
!
! IMPLICIT INPUTS:
!
!       NONE
!
! IMPLICIT OUTPUTS:
!
!       NONE
!
! ROUTINE VALUE:
!       0 if table is full
!       1 if successful
!       2 if entry already exists
! COMPLETION CODES:
!
!       NONE
!
! SIDE EFFECTS:
!
!       NONE
!
!--

    BEGIN
    BIND
        tb = .tb_: tbl,
        key = .key_,
        indx = .indx_;

    IF .tb[TBL_ACTUAL_ENTRIES] EQL .tb[TBL_MAXIMUM_ENTRIES]
    THEN
        RETURN 0;                               !Table is full

    IF tbl_lookup(tb, CH$PTR(key), indx) EQL tbl_exactmatch
    THEN
        RETURN 2;                               !Entry already exists

    DECR i FROM .tb[TBL_ACTUAL_ENTRIES] TO .indx DO
        tb[.i + 1, TBL_WORD] = .TB[.i, TBL_WORD];

    tb[.indx, TBL_KEY] = key;
    tb[.indx, TBL_DATA] = .data;
    tb[TBL_ACTUAL_ENTRIES] = .tb[TBL_ACTUAL_ENTRIES] + 1;
    RETURN 1;
    END;                        !End of tbl_add
GLOBAL ROUTINE tbl_delete (tb_,indx) =        !

!++
! FUNCTIONAL DESCRIPTION:
!       This routine performs a TBDEL JSYS on TOPS-20, and emulates it
!   on TOPS-10.
!
! FORMAL PARAMETERS:
!
!       tb:     The address of a TBLUK tbl.
!       indx:   The index of the table_entry to be deleted.
!
! IMPLICIT INPUTS:
!
!       NONE
!
! IMPLICIT OUTPUTS:
!
!       NONE
!
! ROUTINE VALUE:
!       0 if table is empty
!       1 if element is deleted
!       2 if index is invalid
!
! COMPLETION CODES:
!
!       NONE
!
! SIDE EFFECTS:
!
!       NONE
!
!--

    BEGIN
    BIND
        tb = .tb_: tbl;

    LOCAL
        error,
        bits;           !

    BIND
        del_addr = tb[.indx, TBL_WORD],
        last_addr = tb + .tb[TBL_ACTUAL_ENTRIES];

    IF .tb[TBL_ACTUAL_ENTRIES] EQL 0
    THEN
        RETURN 0;                               !Table is empty

    IF .indx GTR .tb[TBL_ACTUAL_ENTRIES]
    THEN
        RETURN 2;                               !Index is invalid

    $$BLT(((del_addr +1) ^ 18) + del_addr, last_addr);
    last_addr = 0;

    tb[TBL_ACTUAL_ENTRIES] = .tb[TBL_ACTUAL_ENTRIES] - 1;
    RETURN 1;
    END;                        !End of tbl_delete
END                           !End of module tbl
ELUDOM