mirror of
https://github.com/PDP-10/stacken.git
synced 2026-04-19 00:27:51 +00:00
793 lines
14 KiB
Plaintext
793 lines
14 KiB
Plaintext
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
|