Trailing-Edge
-
PDP-10 Archives
-
tops10_tools_bb-fp64b-sb
-
10,7/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) 1978 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
!
! 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