Google
 

Trailing-Edge - PDP-10 Archives - BB-P363B-SM_1985 - mcb/mcbda/mdastb.bli
There is 1 other file named mdastb.bli in the archive. Click here to see a list.
MODULE MDASTB (					!Symbol table file management.
		IDENT = '003010',
		LANGUAGE (BLISS16, BLISS36)
		) =
BEGIN
!
!
!
!                    COPYRIGHT (c) 1980, 1981, 1982
!                    DIGITAL EQUIPMENT CORPORATION
!                        Maynard, Massachusetts
!
!     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: MDASTB
!
! ABSTRACT:
!
!
! THIS MODULE COORDINATES ACCESS TO SYMBOL TABLE FILES
!
!
! ENVIRONMENT: ANY
!
! AUTHOR: ALAN D. PECKHAM, CREATION DATE: 25-AUG-78
!
! MODIFIED BY:
!
!	Alan D. Peckham, : VERSION 3
! 01	- Update for MCB V3.0
!--

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    GETREC,					!Get a word from the symbol table file.
    ADD_SYMBOL,					!Insert a new symbol in a given table.
    ADD_TABLE,					!Insert a new symbol table.
    DEL_SYMBOLS : NOVALUE,			!Remove symbols from a table entry.
    STBLST,					!Update symbol values in list.
    STBFIL,					!Allow access to symbol table.
    STBOPN,					!Initialize the symbol tables.
    STBSYM;					!Return the value of a symbol.

!
! INCLUDE FILES
!

LIBRARY 'MDACOM';				!MDA common definitions.

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!

LITERAL
    NEW_RECORD = 0,				!Get a word from the next record.
    CURRENT_RECORD = 1,				!Get a word from the current record.
    OBJ_LOW = 1,				!Lowest object record type.
    OBJ_GSD = 1,				!Global Symbol Dictionary.
    OBJ_END_GSD = 2,				!End of GSD records.
    OBJ_TXT = 3,				!TeXT information.
    OBJ_RLD = 4,				!ReLocation Dictionary.
    OBJ_ISD = 5,				!Internal Symbol Dictionary.
    OBJ_END_MOD = 6,				!End of module.
    OBJ_HIGH = 6,				!Highest object record type.
    GSD_LOW = 0,				!Lowest GSD record type.
    GSD_MOD = 0,				!Module name.
    GSD_CSECT = 1,				!Control section name.
    GSD_INTERNAL = 2,				!Internal symbol name.
    GSD_TRANSFER = 3,				!Transfer address.
    GSD_GLOBAL = 4,				!Global symbol name.
    GSD_PSECT = 5,				!Program section name.
    GSD_VERSION = 6,				!Program version identification.
    GSD_ARRAY = 7,				!Mapped array declaration.
    GSD_HIGH = 7;				!Highest GSD record type.

$FIELD
    S_FIELDS =
	SET
	S_BEG = [$SUB_BLOCK ()],
	S_LINK = [$ADDRESS],
	S_VALUE = [$SHORT_INTEGER],
	S_NAME = [$SUB_BLOCK ()],
	S_NAME_0 = [$SHORT_INTEGER],
	S_NAME_1 = [$SHORT_INTEGER]
	TES;

LITERAL
    S_HIGH = MDA_MAX_SYMBOLS - 1,
    S_LENGTH = $FIELD_SET_SIZE,
    S_LOW = 0;

$FIELD
    T_FIELDS =
	SET
	T_BEG = [$SUB_BLOCK ()],
	T_LINK = [$ADDRESS],
	T_SYMBOLS = [$ADDRESS],
	T_NAME_PTR = [$POINTER],
	T_WANTED = [$BIT],
	T_DEFINED = [$BIT]
	TES;

LITERAL
    T_HIGH = MDA_MAX_TABLES - 1,
    T_LENGTH = $FIELD_SET_SIZE,
    T_LOW = 0;

!
! OWN STORAGE:
!

OWN
    RECORD_COUNT,
    STBBLK,				!Symbol table file control block.
    SYMBOLS : BLOCKVECTOR [MDA_MAX_SYMBOLS, S_LENGTH] FIELD (S_FIELDS),
    SYMBOL_FREE : REF BLOCK [S_LENGTH] FIELD (S_FIELDS),
    SYMBOL_TABLES,
    TABLES : BLOCKVECTOR [MDA_MAX_TABLES, T_LENGTH] FIELD (T_FIELDS),
    TABLE_FREE : REF BLOCK [T_LENGTH] FIELD (T_FIELDS),
    TABLE_NAMES : CH$SEQUENCE (MDA_MAX_TABLES*7);

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    ASSOCIATE,					!Associate file with control block.
    CLOSE,					!Close a file.
    FILNM : NOVALUE,				!Convert file name to ASCII.
    GETFIL,					!Get a word from the file.
    OPEN;					!Open a file.
GLOBAL ROUTINE STBOPN (STB_FILBLK) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    LOCAL
	NAME_PTR;

    STBBLK = .STB_FILBLK;
    NAME_PTR = CH$PTR (TABLE_NAMES);

    DECRA TBL_PTR FROM TABLES [T_HIGH, T_BEG] TO TABLES [T_LOW, T_BEG] BY T_LENGTH DO
	BEGIN

	MAP
	    TBL_PTR : REF BLOCK [T_LENGTH] FIELD (T_FIELDS);

	TBL_PTR [T_LINK] = .TBL_PTR + T_LENGTH;
	TBL_PTR [T_SYMBOLS] = 0;
	TBL_PTR [T_NAME_PTR] = .NAME_PTR;
	TBL_PTR [T_WANTED] = FALSE;
	TBL_PTR [T_DEFINED] = FALSE;
	NAME_PTR = CH$PLUS (.NAME_PTR, 7);
	END;

    TABLES [T_HIGH, T_LINK] = 0;
    TABLE_FREE = TABLES [T_LOW, T_BEG];

    DECRA SYM_PTR FROM SYMBOLS [S_HIGH, S_BEG] TO SYMBOLS [S_LOW, S_BEG] BY S_LENGTH DO
	BEGIN

	MAP
	    SYM_PTR : REF BLOCK [T_LENGTH] FIELD (T_FIELDS);

	SYM_PTR [T_LINK] = .SYM_PTR + S_LENGTH;
	END;

    SYMBOL_FREE = SYMBOLS [S_LOW, S_BEG];
    SYMBOLS [S_HIGH, S_LINK] = 0;
    SYMBOL_TABLES = 0;
    TRUE
    END;					!OF STBOPN
GLOBAL ROUTINE STBLST (LIST_ADR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    LOCAL
	DEFINITION,
	LIST : REF VECTOR;

    LIST = .LIST_ADR;

    WHILE .LIST [0] NEQ 0 DO
	BEGIN

	IF DEFINED (DEFINITION = STBSYM (LIST [0])) THEN LIST [2] = .DEFINITION;

	LIST = LIST [4]
	END;

    .LIST_ADR
    END;					!OF STBLST
GLOBAL ROUTINE STBFIL (FILE_NAME_LIST) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    LOCAL
	FIL_LEN,
	FIL_PTR,
	WANTED_TBL : REF BLOCK [T_LENGTH] FIELD (T_FIELDS),
	TBL_PTR : REF BLOCK [T_LENGTH] FIELD (T_FIELDS);	!Symbol table pointer.

    BIND
	FILE_LIST = (.FILE_NAME_LIST - %UPVAL) : VECTOR;

    SYMBOL_TABLES = 0;

    !+
    ! Reset table request flags.
    !-

    INCRA TBL_PTR FROM TABLES [T_LOW, T_BEG] TO TABLES [T_HIGH, T_BEG] BY T_LENGTH DO
	BEGIN

	MAP
	    TBL_PTR : REF BLOCK [T_LENGTH] FIELD (T_FIELDS);

	TBL_PTR [T_WANTED] = FALSE;
	END;

    !+
    ! Add requested tables to the list and mark them as wanted.
    !-

    INCR FIL_INDEX FROM 1 TO .FILE_LIST [0] DO
	BEGIN

	LABEL
	    CHECKLOOP;

CHECKLOOP :
	BEGIN
	FIL_PTR = .FILE_LIST [.FIL_INDEX];
	FIL_LEN = CH$LEN (.FIL_PTR);
	WANTED_TBL = 0;

	INCRA TBL_PTR FROM TABLES [T_LOW, T_BEG] TO TABLES [T_HIGH, T_BEG] BY T_LENGTH DO
	    BEGIN

	    MAP
		TBL_PTR : REF BLOCK [T_LENGTH] FIELD (T_FIELDS);

	    IF .TBL_PTR [T_DEFINED]
	    THEN
		BEGIN

		IF CH$EQL (.FIL_LEN, .FIL_PTR, 7, .TBL_PTR [T_NAME_PTR], 0)
		THEN
		    LEAVE CHECKLOOP WITH WANTED_TBL = .TBL_PTR;

		IF NOT .TBL_PTR [T_WANTED] THEN WANTED_TBL = .TBL_PTR;

		END;

	    END;

	IF .TABLE_FREE NEQ 0
	THEN
	    BEGIN
	    WANTED_TBL = .TABLE_FREE;
	    TABLE_FREE = .WANTED_TBL [T_LINK];
	    END;

	IF .WANTED_TBL EQL 0
	THEN
	    RETURN
		BEGIN
		TYPLN (1, CH$ASCIZ (FATAL, 'NO ROOM FOR SYMBOL FILE "%#A.STB"'), .FIL_LEN, .FIL_PTR);
		FALSE
		END;

	CH$COPY (.FIL_LEN, .FIL_PTR, 0, 7, .WANTED_TBL [T_NAME_PTR]);
	DEL_SYMBOLS (.WANTED_TBL);
	WANTED_TBL [T_DEFINED] = FALSE;
	END;
	WANTED_TBL [T_WANTED] = TRUE;
	WANTED_TBL [T_LINK] = .SYMBOL_TABLES;
	SYMBOL_TABLES = .WANTED_TBL;
	END;

    !+
    ! Now define the symbols of any table that isn't currently loaded.
    !-

    INCRA TBL_PTR FROM TABLES [T_LOW, T_BEG] TO TABLES [T_HIGH, T_BEG] BY T_LENGTH DO
	BEGIN

	MAP
	    TBL_PTR : REF BLOCK [T_LENGTH] FIELD (T_FIELDS);

	IF .TBL_PTR [T_WANTED] AND NOT .TBL_PTR [T_DEFINED]
	THEN

	    IF NOT ADD_TABLE (.TBL_PTR)
	    THEN
		BEGIN
		DEL_SYMBOLS (.TBL_PTR);
		RETURN FALSE
		END
	    ELSE
		TBL_PTR [T_DEFINED] = TRUE;

	END;

    TRUE
    END;					!OF STBFIL
GLOBAL ROUTINE STBSYM (SYM_NAME_ADR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	SYM_NAME = (.SYM_NAME_ADR) : VECTOR [2];

    LOCAL
	SYM_PTR : REF BLOCK [S_LENGTH] FIELD (S_FIELDS),
	TBL_PTR : REF BLOCK [T_LENGTH] FIELD (T_FIELDS);

    IF (TBL_PTR = .SYMBOL_TABLES) NEQ 0
    THEN

	DO
	    BEGIN

	    IF (SYM_PTR = .TBL_PTR [T_SYMBOLS]) NEQ 0
	    THEN

		DO

		    IF (.SYM_NAME [0] EQL .SYM_PTR [S_NAME_0] AND .SYM_NAME [1] EQL .SYM_PTR [S_NAME_1])
		    THEN
			RETURN .SYM_PTR [S_VALUE]

		UNTIL ((SYM_PTR = .SYM_PTR [S_LINK]) EQL 0);

	    END
	UNTIL ((TBL_PTR = .TBL_PTR [T_LINK]) EQL 0);

    UNDEFINED
    END;					!OF STBSYM
ROUTINE ADD_TABLE (TBL_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	TBL_PTR : REF BLOCK [T_LENGTH] FIELD (T_FIELDS);

    LOCAL
	NAME : VECTOR [2],
	TYPE,
	VALUE,
	RECORD_TYPE;

    IF NOT ASSOCIATE (.STBBLK, .TBL_PTR [T_NAME_PTR], CH$ASCIZ ('STB'))
    THEN
	RETURN
	    BEGIN
	    TYPLN (1, CH$ASCIZ (WARNING, 'CANNOT FIND SYMBOL TABLE FILE "%#A.STB"'),
		CH$LEN (.TBL_PTR [T_NAME_PTR]), .TBL_PTR [T_NAME_PTR]);
	    FALSE
	    END;

    IF NOT OPEN (.STBBLK, F_READ, F_BINARY)
    THEN
	RETURN
	    BEGIN
	    TYPLN (1, CH$ASCIZ (WARNING, 'CANNOT OPEN SYMBOL TABLE FILE "%@"'), FILNM, .STBBLK);
	    FALSE
	    END;

    RECORD_COUNT = 0;

    DO
	(CASE (RECORD_TYPE = GETREC (NEW_RECORD)) FROM OBJ_LOW TO OBJ_HIGH OF
	    SET
	    [OBJ_GSD] : 			!GSD entry
		UNTIL .RECORD_COUNT EQL 0 DO
		    BEGIN
		    NAME [0] = GETREC (CURRENT_RECORD);
		    NAME [1] = GETREC (CURRENT_RECORD);
		    TYPE = GETREC (CURRENT_RECORD);
		    VALUE = GETREC (CURRENT_RECORD);

		    CASE .TYPE<8, 8> FROM GSD_LOW TO GSD_HIGH OF
			SET

			[GSD_GLOBAL] :

			    IF NOT .TYPE<2, 1>
			    THEN

				IF NOT ADD_SYMBOL (.TBL_PTR, NAME, .VALUE)
				THEN
				    RETURN
					BEGIN
					TYPLN (1, CH$ASCIZ (FATAL, 'THE REST OF "%@" IS LOST'), FILNM, .STBBLK)
					;
					CLOSE (.STBBLK);
					FALSE
					END;

			[INRANGE, OUTRANGE] :
			    0;			!
			TES

		    END;
	    [OBJ_END_GSD] : RECORD_TYPE = OBJ_END_MOD;	!Stop module processing.
	    [INRANGE] : 0;			!Ignore the record.
	    [OUTRANGE] : RETURN
		    BEGIN
		    TYPLN (1, CH$ASCIZ (FATAL, 'BADLY FORMATTED SYMBOL TABLE FILE "%@"'), FILNM, .STBBLK);
		    CLOSE (.STBBLK);
		    FALSE
		    END;
	    TES)
    UNTIL .RECORD_TYPE EQL OBJ_END_MOD;

    CLOSE (.STBBLK);
    TRUE
    END;					!OF ADD_TABLE
ROUTINE DEL_SYMBOLS (TBL_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	TBL_PTR : REF BLOCK [T_LENGTH] FIELD (T_FIELDS);

    LOCAL
	PTR : REF BLOCK [S_LENGTH] FIELD (S_FIELDS);

    UNTIL (PTR = .TBL_PTR [T_SYMBOLS]) EQL 0 DO
	BEGIN
	TBL_PTR [T_SYMBOLS] = .PTR [S_LINK];
	PTR [S_LINK] = .SYMBOL_FREE;
	SYMBOL_FREE = .PTR;
	END;

    END;					!OF DEL_SYMBOLS
ROUTINE ADD_SYMBOL (TBL_PTR, SYM_NAME_ADR, SYM_VALUE) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	TBL_PTR : REF BLOCK [T_LENGTH] FIELD (T_FIELDS);

    BIND
	SYM_NAME = (.SYM_NAME_ADR) : VECTOR [2];

    LOCAL
	SYM_PTR : REF BLOCK [S_LENGTH] FIELD (S_FIELDS);

    DO

	IF (SYM_PTR = .SYMBOL_FREE) NEQ 0
	THEN
	    BEGIN
	    SYMBOL_FREE = .SYM_PTR [S_LINK];
	    SYM_PTR [S_LINK] = .TBL_PTR [T_SYMBOLS];
	    TBL_PTR [T_SYMBOLS] = .SYM_PTR;
	    SYM_PTR [S_NAME_0] = .SYM_NAME [0];
	    SYM_PTR [S_NAME_1] = .SYM_NAME [1];
	    SYM_PTR [S_VALUE] = .SYM_VALUE;
	    RETURN TRUE;
	    END

    WHILE
	BEGIN

	LOCAL
	    TBL_PTR : REF BLOCK [T_LENGTH] FIELD (T_FIELDS);

	DECRA TBL_PTR FROM TABLES [T_HIGH, T_BEG] TO TABLES [T_LOW, T_BEG] BY T_LENGTH DO
	    BEGIN

	    MAP
		TBL_PTR : REF BLOCK [T_LENGTH] FIELD (T_FIELDS);

	    IF .TBL_PTR [T_DEFINED] AND NOT .TBL_PTR [T_WANTED]
	    THEN
		BEGIN
		DEL_SYMBOLS (.TBL_PTR);
		TBL_PTR [T_DEFINED] = FALSE;
		EXITLOOP TRUE
		END
	    ELSE
		FALSE

	    END

	END;

    TYPLN (1, CH$ASCIZ (FATAL, 'SYMBOL TABLE OVERFLOW (%2R = %P)'), .SYM_NAME [0], .SYM_NAME [1], .SYM_VALUE);
    FALSE
    END;					!OF ADD_SYMBOL
ROUTINE GETREC (IOTYPE) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    OWN
	WORD_VALUE;

    BIND
	WORD_PTR = CH$PTR (WORD_VALUE,, 16);

    CASE .IOTYPE FROM 0 TO 1 OF
	SET

	[NEW_RECORD] :
	    BEGIN

	    WHILE .RECORD_COUNT NEQ 0 DO
		BEGIN
		GETFIL (.STBBLK, WORD_PTR, 1);
		RECORD_COUNT = .RECORD_COUNT - 1
		END;

	    DO
		GETFIL (.STBBLK, WORD_PTR, 1)
	    UNTIL (RECORD_COUNT = CH$RCHAR (WORD_PTR)/2 - 1) GEQ 0;

	    GETFIL (.STBBLK, WORD_PTR, 1);
	    CH$RCHAR (WORD_PTR)
	    END;

	[CURRENT_RECORD] :

	    IF .RECORD_COUNT EQL 0
	    THEN
		UNDEFINED
	    ELSE
		BEGIN
		RECORD_COUNT = .RECORD_COUNT - 1;
		GETFIL (.STBBLK, WORD_PTR, 1);
		CH$RCHAR (WORD_PTR)
		END;

	TES

    END;					!OF GETREC
END

ELUDOM