mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-24 08:54:17 +00:00
337 lines
9.5 KiB
Plaintext
337 lines
9.5 KiB
Plaintext
$title ('SYMBOL TABLE MODULE')
|
||
symb:
|
||
do;
|
||
|
||
/*
|
||
|
||
modified 3/25/81 R. Silberstein
|
||
modified 3/28/81 R. Silberstein
|
||
modified 3/30/81 R. Silberstein
|
||
modified 4/15/81 R. Silberstein
|
||
modified 4/16/81 R. Silberstein
|
||
modified 4/20/81 R. Silberstein
|
||
modified 6/16/81 R. Silberstein
|
||
modified 7/24/81 R. Silberstein
|
||
|
||
*/
|
||
|
||
/*
|
||
This is the module to perform all symbol table
|
||
handling. There are 2 different kinds of symbols,
|
||
codemacro mnemonics and user defined symbols.
|
||
|
||
The codemacro symbols are entered into the
|
||
symbol table through the hash vector "CODEMACROENTRY",
|
||
whereas the user symbols uses the hash vector
|
||
"SYMBENTRY". Each symbol enters the symbol table through
|
||
hash vector element "i", where i is the hash function of
|
||
the symbol. The function is defined as:
|
||
|
||
H(S) = (C1 + C2 +.... + Ci + ..+ Cn) mod 64
|
||
|
||
where Ci is the ascii code of the i'th symbolcharacter.
|
||
|
||
*/
|
||
|
||
$include (:f1:macro.lit)
|
||
$include (:f1:equals.lit)
|
||
$include (:f1:struc.lit)
|
||
$INCLUDE (:F1:DEV.LIT)
|
||
$include (:f1:mnem.ext)
|
||
$include (:f1:subr1.ext)
|
||
$include (:f1:subr2.ext)
|
||
$include (:f1:files.ext)
|
||
$INCLUDE (:F1:TEXT.EXT)
|
||
$INCLUDE (:F1:IO.EXT)
|
||
DECLARE SYMBOLDEVICE BYTE EXTERNAL;
|
||
$eject
|
||
|
||
/* Global variables: */
|
||
|
||
dcl
|
||
codemacroentry (64) addr /* opcode mnemonic entry */
|
||
data(
|
||
.push,.repz,0,.aaa,0,.movs,.pushf,.MOVSB,
|
||
.adc,.add,.CMPSW,.ja,.dec,.loopne,0,.repnz,
|
||
.jae,.jg,.clc,.iand,.loopz,.aas,.jl,.in,
|
||
.cli,.jo,.inc,.lahf,.icall,.jne,.cwd,.jnbe,
|
||
.cmp,.ior,.callf,.div,.les,0,.sar,.jmp,
|
||
.hlt,.lock,.xchg,.ret,.idiv,.jmpf,.mul,.pop,
|
||
.sti,.inot,.mov,.cmps,.iret,.popf,0,.imul,
|
||
.out,.xlat,.jmps,0,0,0,0,.loope),
|
||
|
||
symbentry (64) addr, /* user symbol entry */
|
||
symbtab(1) byte at (.memory), /* symbol table */
|
||
freept addr public, /* adr. of next free symb. tab byte */
|
||
end$of$symbtab addr PUBLIC, /* last symbol table byte */
|
||
symbolheadlg byte, /* length of head for each symbol */
|
||
attributelg byte, /* length of symbol attributes */
|
||
codemacheadlg byte, /* length of codemacrohead */
|
||
overflowlimit addr, /* used to test overflow */
|
||
col byte; /* current column position */
|
||
|
||
DECLARE
|
||
ALPHAROOT ADDRESS, /* ROOT OF ALPHABETIZED SYMBOL LIST */
|
||
ALPHASYMPTR ADDRESS, /* POINTER TO CURRENT SYMBOL IN ALPHA LIST */
|
||
ALPHASYM BASED ALPHASYMPTR SYMBOLHEAD, /* SYMBOL TEMPLATE */
|
||
SORTSYMPTR ADDRESS, /* POINTER TO SYMBOL BEING INSERTED */
|
||
SORTSYM BASED SORTSYMPTR SYMBOLHEAD; /* SYMBOL TEMPLATE */
|
||
|
||
$eject
|
||
/****************** SUBROUTINES ******************/
|
||
|
||
outbyt: proc (ch); /* print one byte to symbol file */
|
||
dcl ch byte;
|
||
if ch=cr then$do /* update column position */
|
||
col=0;
|
||
else$do
|
||
if ch <> lf then col=col+1;
|
||
end$if;
|
||
call outsymbolbyte(ch);
|
||
end outbyt;
|
||
|
||
hash: proc (lg,pt) byte;
|
||
dcl (lg,i,h) byte,pt addr,asc based pt (1) byte;
|
||
i=0ffh; h=0;
|
||
do while (i:=i+1) < lg;
|
||
h=h+asc(i);
|
||
end$while;
|
||
return h and 3fh;
|
||
end hash;
|
||
|
||
/* search for either a user symbol or a codemacro */
|
||
|
||
search: proc(lg,pt1,pt2,pt3,headlg) byte;
|
||
dcl (lg,headlg) byte,(pt1,pt2,pt3) addr,
|
||
ascii based pt1(1) byte,symbptr based pt2 addr,
|
||
entrytab based pt3 (64) addr,
|
||
currentpt addr,next based currentpt addr,
|
||
symbhead based currentpt symbolhead;
|
||
|
||
currentpt=entrytab(hash(lg,.ascii(0)));
|
||
do while currentpt <> 0;
|
||
if lg = symbhead.slength then$do
|
||
if equal(lg,currentpt+headlg,.ascii(0)) then$do
|
||
symbptr=currentpt+3;
|
||
return true;
|
||
end$if;
|
||
end$if;
|
||
currentpt=next;
|
||
end$while;
|
||
return false;
|
||
end search;
|
||
|
||
/* enter either new symbol or new codemacro */
|
||
new: proc(lg,pt1,pt2,headlg,pt3) byte;
|
||
dcl (lg,headlg) byte,(pt1,pt2,pt3) addr,
|
||
ascii based pt1 (1) byte,entrytab based pt2 (64) addr,
|
||
symptr based pt3 addr,
|
||
current addr,currentcontent based current addr,
|
||
symb based freept symbolhead;
|
||
if freept > overflowlimit - (lg+headlg) then$DO
|
||
CALL OUTTEXT (.SYMBFULLERRTEXT);
|
||
CALL SYSTEM$RESET;
|
||
END$IF;
|
||
current=.entrytab(hash(lg,.ascii(0)));
|
||
SYMB.NEXT = CURRENTCONTENT;
|
||
currentcontent=freept;
|
||
symptr=freept+3;
|
||
symb.slength=lg;
|
||
call copy(lg,.ascii(0),freept+headlg);
|
||
freept=freept+headlg+lg;
|
||
return true;
|
||
end new;
|
||
|
||
newsymbol: proc (lg,asciiptr,returnpt) byte public;
|
||
dcl lg byte,(asciiptr,returnpt) addr;
|
||
return new(lg,asciiptr,.symbentry,symbolheadlg,returnpt);
|
||
end newsymbol;
|
||
|
||
newmacro: proc (lg,asciiptr,codmacdefpt) byte public;
|
||
dcl lg byte,(asciiptr,codmacdefpt,retpt) addr,
|
||
cmaddr based retpt addr;
|
||
if new(lg,asciiptr,.codemacroentry,codemacheadlg,.retpt) then$do
|
||
cmaddr=codmacdefpt;
|
||
return true;
|
||
end$if;
|
||
return false;
|
||
end newmacro;
|
||
|
||
findsymbol: proc(lg,stradr,result) byte public;
|
||
dcl lg byte,(stradr,result) addr;
|
||
return search(lg,stradr,result,.symbentry(0),symbolheadlg);
|
||
end findsymbol;
|
||
|
||
getattributes: proc(symbadr,dest) public;
|
||
dcl (symbadr,dest) addr,symb based symbadr symbolstruc;
|
||
call copy(attributelg,.symb.length,dest);
|
||
end getattributes;
|
||
|
||
enterattributes: proc(symbadr,source) public;
|
||
dcl (symbadr,source) addr,symb based symbadr symbolstruc;
|
||
call copy(attributelg,source,.symb.length);
|
||
end enterattributes;
|
||
|
||
findcodemacro: proc(lg,stradr,result) byte public;
|
||
dcl lg byte,(stradr,result) addr;
|
||
return search(lg,stradr,result,.codemacroentry(0),codemacheadlg);
|
||
end findcodemacro;
|
||
|
||
new$cm$body: PROC (lg,ptr) byte public;
|
||
dcl lg byte,ptr addr;
|
||
if freept > overflowlimit-lg then return false;
|
||
call copy (lg,ptr,freept);
|
||
freept=freept+lg;
|
||
return true;
|
||
end$proc new$cm$body;
|
||
|
||
new$cm$name: PROC (lg,asciiptr,returnptr) byte public;
|
||
dcl lg byte,(asciiptr,returnptr) addr;
|
||
return new(lg,asciiptr,.codemacroentry,5,returnptr);
|
||
end$proc new$cm$name;
|
||
|
||
SORTSYMBOLS: PROCEDURE;
|
||
DECLARE
|
||
CURRENT ADDRESS,
|
||
CURRENTCONTENT BASED CURRENT ADDRESS,
|
||
NEXT ADDRESS,
|
||
I BYTE;
|
||
|
||
ALPHALOCFOUND: PROCEDURE BYTE;
|
||
DECLARE
|
||
SORTNAMEPTR ADDRESS,
|
||
SORTNAME BASED SORTNAMEPTR (1) BYTE,
|
||
ALPHANAMEPTR ADDRESS,
|
||
ALPHANAME BASED ALPHANAMEPTR (1) BYTE,
|
||
I BYTE;
|
||
|
||
SORTNAMEPTR = SORTSYMPTR + SYMBOLHEADLG;
|
||
ALPHANAMEPTR = ALPHASYMPTR + SYMBOLHEADLG;
|
||
DO I = 1 TO SORTSYM.SLENGTH;
|
||
IF I > ALPHASYM.SLENGTH THEN RETURN FALSE;
|
||
IF SORTNAME (I-1) > ALPHANAME (I-1) THEN RETURN FALSE;
|
||
IF SORTNAME (I-1) < ALPHANAME (I-1) THEN RETURN TRUE;
|
||
END;
|
||
RETURN TRUE;
|
||
END ALPHALOCFOUND;
|
||
|
||
FIXCHAIN: PROCEDURE;
|
||
SORTSYM.NEXT = ALPHASYMPTR;
|
||
CURRENTCONTENT = .SORTSYM;
|
||
END FIXCHAIN;
|
||
|
||
INSERTALPHA: PROCEDURE;
|
||
CURRENT, ALPHASYMPTR = .ALPHAROOT;
|
||
DO WHILE (ALPHASYMPTR := ALPHASYM.NEXT) <> 0;
|
||
IF ALPHALOCFOUND THEN$DO
|
||
CALL FIXCHAIN;
|
||
RETURN;
|
||
END$IF;
|
||
CURRENT = ALPHASYMPTR;
|
||
END$WHILE;
|
||
CALL FIXCHAIN;
|
||
END INSERTALPHA;
|
||
|
||
ALPHAROOT = 0;
|
||
DO I = 0 TO LAST (SYMBENTRY);
|
||
SORTSYMPTR = SYMBENTRY (I);
|
||
DO WHILE SORTSYMPTR <> 0;
|
||
NEXT = SORTSYM.NEXT;
|
||
CALL INSERTALPHA;
|
||
SORTSYMPTR = NEXT;
|
||
END$WHILE;
|
||
END;
|
||
END SORTSYMBOLS;
|
||
|
||
outcrlf: proc;
|
||
call outbyt(cr);
|
||
call outbyt(lf);
|
||
end outcrlf;
|
||
|
||
printsymbols: proc(typ); /* print all symbols to file */
|
||
dcl (typ,i) byte;
|
||
|
||
advancetonext: proc; /* advance to next column (16,32,48,64) */
|
||
dcl (x,y) byte;
|
||
x=col/16;
|
||
y=16-(col mod 16);
|
||
if x >= 4 then$do
|
||
call outcrlf;
|
||
else$do
|
||
IF SYMBOL$DEVICE = PRINTER THEN$DO
|
||
DO WHILE (Y := Y - 1) <> 255;
|
||
CALL OUTBYT (SPACE);
|
||
END$WHILE;
|
||
ELSE$DO
|
||
col=col+y;
|
||
call outsymbolbyte(tab);
|
||
if y > 8 then call outsymbolbyte(tab);
|
||
END$IF;
|
||
end$if;
|
||
end advancetonext;
|
||
|
||
OUTBYTES: proc(lg,p);
|
||
dcl lg byte,p addr,asc based p byte;
|
||
DO WHILE (LG := LG - 1) <> 0FFH;
|
||
call outbyt(asc);
|
||
P = P + 1;
|
||
end$while;
|
||
end OUTBYTES;
|
||
|
||
printsymb: proc(p); /* print single symbol */
|
||
dcl p addr,x based p symbolhead,
|
||
a addr,ascii based a (1) byte,help(4) byte;
|
||
a=p+symbolheadlg;
|
||
if X.STYPE=typ then$do
|
||
if col+x.slength+5 > 79 then call outcrlf;
|
||
call hex2out(x.offset,.help(0));
|
||
CALL OUTBYTES (4, .HELP);
|
||
call outbyt(space);
|
||
CALL OUTBYTES (X.SLENGTH, .ASCII);
|
||
call advancetonext;
|
||
end$if;
|
||
end printsymb;
|
||
|
||
/* print symbols main program */
|
||
|
||
col=0;
|
||
CALL OUTBYTES (4, .('0000')); /* print header */
|
||
call outbyt(space);
|
||
if typ=lab then call OUTBYTES(6,.('LABELS'));
|
||
if typ=variable then call OUTBYTES(9,.('VARIABLES'));
|
||
if typ=number then call OUTBYTES(7,.('NUMBERS'));
|
||
call outcrlf;
|
||
ALPHASYMPTR = ALPHAROOT;
|
||
DO WHILE ALPHASYMPTR <> 0;
|
||
CALL PRINTSYMB (ALPHASYMPTR);
|
||
ALPHASYMPTR = ALPHASYM.NEXT;
|
||
END;
|
||
if col <> 0 then call outcrlf;
|
||
|
||
end printsymbols;
|
||
|
||
symbterminate: proc public; /* print symbol table */
|
||
IF SYMBOLDEVICE = NULL THEN RETURN; /* no need to sort, etc. */
|
||
CALL SORTSYMBOLS;
|
||
CALL OUTSYMBOLBYTE (FORMFEED);
|
||
call printsymbols(variable); /* variables */
|
||
CALL OUTCRLF;
|
||
call printsymbols(number); /* numbers */
|
||
CALL OUTCRLF;
|
||
call printsymbols(lab); /* labels */
|
||
end symbterminate;
|
||
|
||
symbinit: proc public;
|
||
dcl i byte;
|
||
dcl symb symbolhead at (.i),codm codemacrohead at (.i);
|
||
end$of$symbtab=(endbuf/256)*256-1;
|
||
freept=.symbtab(0);
|
||
CALL FILL (0, SIZE (SYMBENTRY), .SYMBENTRY);
|
||
symbolheadlg=.symb.baseindex-.symb.next+1;
|
||
attributelg=symbolheadlg-3;
|
||
codemacheadlg=.codm.defptr-.codm.next+2;
|
||
overflowlimit=end$of$symbtab-symbolheadlg;
|
||
end symbinit;
|
||
|
||
end$module symb;
|
||
|