godzil/ack
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial revision

Browse Source
This commit is contained in:
bal
1984-11-26 13:43:22 +00:00
parent 5481dd47a9
commit 7b798175ad
36 changed files with 4585 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

88
util/ego/ic/Makefile Normal file
View File

@@ -0,0 +1,88 @@
EMH=../../../h
EML=../../../lib
CFLAGS=
DEBUG=../share
SHARE=../share
MALLOC=
IC=.
OBJECTS=ic.o ic_aux.o ic_lookup.o ic_io.o ic_lib.o
MOBJECTS=ic.m ic_aux.m ic_lookup.m ic_io.m ic_lib.m
SHOBJECTS=$(SHARE)/put.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/debug.o $(SHARE)/files.o $(SHARE)/map.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/aux.o
MSHOBJECTS=$(SHARE)/put.m $(SHARE)/alloc.m $(SHARE)/global.m $(SHARE)/debug.m $(SHARE)/files.m $(SHARE)/map.m $(SHARE)/lset.m $(SHARE)/cset.m
SRC=ic.h ic_aux.h ic_lib.h ic_lookup.h ic_io.h ic.c ic_aux.c ic_lib.c ic_lookup.c ic_io.c
.SUFFIXES: .m
.c.m:
ack -O -L -c.m $(CFLAGS) $<
.c.o:
cc $(CFLAGS) -c $<
all: $(OBJECTS)
ic: \
$(OBJECTS) $(SHOBJECTS)
cc -i -o ic $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a $(MALLOC)
optim: $(MOBJECTS) $(MSHOBJECTS)
ego IC CF $(F) CA $(MOBJECTS) $(MSHOBJECTS)
ack -O -o ic.ego -.c lfile.m $(EML)/em_data.a
lpr:
pr $(SRC) | lpr
dumpflop:
tar -uf /mnt/ego/ic/ic.tarf $(SRC) Makefile
# the next lines are generated automatically
# AUTOAUTOAUTOAUTOAUTOAUTO
ic.o: ../../../h/em_flag.h
ic.o: ../../../h/em_mes.h
ic.o: ../../../h/em_pseu.h
ic.o: ../../../h/em_spec.h
ic.o: ../share/alloc.h
ic.o: ../share/aux.h
ic.o: ../share/debug.h
ic.o: ../share/def.h
ic.o: ../share/files.h
ic.o: ../share/global.h
ic.o: ../share/map.h
ic.o: ../share/put.h
ic.o: ../share/types.h
ic.o: ic.h
ic.o: ic_aux.h
ic.o: ic_io.h
ic.o: ic_lib.h
ic.o: ic_lookup.h
ic_aux.o: ../../../h/em_mnem.h
ic_aux.o: ../../../h/em_pseu.h
ic_aux.o: ../../../h/em_spec.h
ic_aux.o: ../share/alloc.h
ic_aux.o: ../share/aux.h
ic_aux.o: ../share/debug.h
ic_aux.o: ../share/def.h
ic_aux.o: ../share/global.h
ic_aux.o: ../share/types.h
ic_aux.o: ic.h
ic_aux.o: ic_aux.h
ic_aux.o: ic_io.h
ic_aux.o: ic_lookup.h
ic_io.o: ../../../h/em_pseu.h
ic_io.o: ../../../h/em_spec.h
ic_io.o: ../share/alloc.h
ic_io.o: ../share/debug.h
ic_io.o: ../share/types.h
ic_io.o: ic.h
ic_io.o: ic_io.h
ic_io.o: ic_lookup.h
ic_lib.o: ../../../h/em_mes.h
ic_lib.o: ../../../h/em_pseu.h
ic_lib.o: ../../../h/em_spec.h
ic_lib.o: ../share/debug.h
ic_lib.o: ../share/files.h
ic_lib.o: ../share/global.h
ic_lib.o: ../share/types.h
ic_lib.o: ic.h
ic_lib.o: ic_io.h
ic_lib.o: ic_lib.h
ic_lib.o: ic_lookup.h
ic_lookup.o: ../../../h/em_spec.h
ic_lookup.o: ../share/alloc.h
ic_lookup.o: ../share/debug.h
ic_lookup.o: ../share/map.h
ic_lookup.o: ../share/types.h
ic_lookup.o: ic.h
ic_lookup.o: ic_lookup.h

520
util/ego/ic/ic.c Normal file
View File

@@ -0,0 +1,520 @@
/* I N T E R M E D I A T E C O D E
*
* I C . C
*/
#include <stdio.h>
#include "../share/types.h"
#include "../share/debug.h"
#include "../share/def.h"
#include "../share/map.h"
#include "../../../h/em_spec.h"
#include "../../../h/em_pseu.h"
#include "../../../h/em_flag.h"
#include "../../../h/em_mes.h"
#include "ic_lookup.h"
#include "ic.h"
#include "ic_aux.h"
#include "ic_io.h"
#include "ic_lib.h"
#include "../share/alloc.h"
#include "../share/global.h"
#include "../share/files.h"
#include "../share/put.h"
#include "../share/aux.h"
/* Global variables */
dblock_p db;
dblock_p curhol = (dblock_p) 0; /* hol block in current scope */
dblock_p ldblock; /* last dblock */
proc_p lproc; /* last proc */
short tabval; /* used by table1, table2 and table3 */
offset tabval2;
char string[IDL+1];
line_p firstline; /* first line of current procedure */
line_p lastline; /* last line read */
int labelcount; /* # labels in current procedure */
short fragm_type = DUNKNOWN; /* fragm. type: DCON, DROM or DUNKNOWN */
short fragm_nr = 0; /* fragment number */
obj_id lastoid = 0;
proc_id lastpid = 0;
dblock_id lastdid = 0;
lab_id lastlid = 0;
offset mespar = UNKNOWN_SIZE;
/* argumument of ps_par message of current procedure */
extern process_lines();
extern int readline();
extern line_p readoperand();
extern line_p inpseudo();
main(argc,argv)
int argc;
char *argv[];
{
/* The input files must be legal EM Compact
* Assembly Language files, as produced by the EM Peephole
* Optimizer.
* Their file names are passed as arguments.
* The output consists of the files:
* - lfile: the EM code in Intermediate Code format
* - dfile: the data block table file
* - pfile: the proc table file
* - pdump: the names of all procedures
* - ddump: the names of all data blocks
*/
FILE *lfile, *dfile, *pfile, *pdump, *ddump;
lfile = openfile(lname2,"w");
pdump = openfile(argv[1],"w");
ddump = openfile(argv[2],"w");
while (next_file(argc,argv) != NULL) {
/* Read all EM input files, process the code
* and concatenate all output.
*/
process_lines(lfile);
dump_procnames(prochash,NPROCHASH,pdump);
dump_dblocknames(symhash,NSYMHASH,ddump);
/* Save the names of all procedures that were
* first come accross in this file.
*/
cleanprocs(prochash,NPROCHASH,PF_EXTERNAL);
cleandblocks(symhash,NSYMHASH,DF_EXTERNAL);
/* Make all procedure names that were internal
* in this input file invisible.
*/
}
fclose(lfile);
fclose(pdump);
fclose(ddump);
/* remove the remainder of the hashing tables */
cleanprocs(prochash,NPROCHASH,0);
cleandblocks(symhash,NSYMHASH,0);
/* Now write the datablock table and the proctable */
dfile = openfile(dname2,"w");
putdtable(fdblock, dfile);
pfile = openfile(pname2,"w");
putptable(fproc, pfile,FALSE);
}
/* Value returned by readline */
#define NORMAL 0
#define WITH_OPERAND 1
#define EOFILE 2
#define PRO_INSTR 3
#define END_INSTR 4
#define DELETED_INSTR 5
STATIC add_end()
{
/* Add an end-pseudo to the current instruction list */
lastline->l_next = newline(OPNO);
lastline = lastline->l_next;
lastline->l_instr = ps_end;
}
process_lines(fout)
FILE *fout;
{
line_p lnp;
short instr;
bool eof;
/* Read and process the code contained in the current file,
* on a per procedure basis.
* On the fly, fragments are formed. Recall that two
* successive CON pseudos are allocated consecutively
* in a single fragment, unless these CON pseudos are
* separated in the assembly language program by one
* of: ROM, BSS, HOL and END (and of course EndOfFile).
* The same is true for ROM pseudos.
* We keep track of a fragment type (DROM after a ROM
* pseudo, DCON after a CON and DUNKNOWN after a HOL,
* BSS, END or EndOfFile) and a fragment number (which
* is incremented every time we enter a new fragment).
* Every data block is assigned such a number
* when we come accross its defining occurrence.
*/
eof = FALSE;
firstline = (line_p) 0;
lastline = (line_p) 0;
while (!eof) {
linecount++; /* for error messages */
switch(readline(&instr, &lnp)) {
/* read one line, see what kind it is */
case WITH_OPERAND:
/* instruction with operand, e.g. LOL 10 */
lnp = readoperand(instr);
lnp->l_instr = instr;
/* Fall through! */
case NORMAL:
VL(lnp);
if (lastline != (line_p) 0) {
lastline->l_next = lnp;
}
lastline = lnp;
break;
case EOFILE:
eof = TRUE;
fragm_type = DUNKNOWN;
if (firstline != (line_p) 0) {
add_end();
putlines(firstline,fout);
firstline = (line_p) 0;
}
break;
case PRO_INSTR:
VL(lnp);
labelcount = 0;
if (firstline != lnp) {
/* If PRO is not the first
* instruction:
*/
add_end();
putlines(firstline,fout);
firstline = lnp;
}
lastline = lnp;
break;
case END_INSTR:
curproc->p_nrformals = mespar;
mespar = UNKNOWN_SIZE;
assert(lastline != (line_p) 0);
lastline->l_next = lnp;
putlines(firstline,fout);
/* write and delete code */
firstline = (line_p) 0;
lastline = (line_p) 0;
cleaninstrlabs();
/* scope of instruction labels ends here,
* so forget about them.
*/
fragm_type = DUNKNOWN;
break;
case DELETED_INSTR:
/* EXP, INA etc. are deleted */
break;
default:
error("illegal readline");
}
}
}
int readline(instr_out, lnp_out)
short *instr_out;
line_p *lnp_out;
{
register line_p lnp;
short n;
/* Read one line. If it is a normal EM instruction without
* operand, we can allocate a line struct for it here.
* If so, return a pointer to it via lnp_out, else just
* return the instruction code via instr_out.
*/
VA((short *) instr_out);
VA((short *) lnp_out);
switch(table1()) {
/* table1 sets string, tabval or tabval2 and
* returns an indication of what was read.
*/
case ATEOF:
return EOFILE;
case INST:
*instr_out = tabval; /* instruction code */
return WITH_OPERAND;
case DLBX:
/* data label defining occurrence, precedes
* a data block.
*/
db = block_of_lab(string);
/* global variable, used by inpseudo */
lnp = newline(OPSHORT);
SHORT(lnp) = (short) db->d_id;
lnp->l_instr = ps_sym;
*lnp_out = lnp;
if (firstline == (line_p) 0) {
firstline = lnp;
/* only a pseudo (e.g. PRO) or data label
* can be the first instruction.
*/
}
return NORMAL;
case ILBX:
/* instruction label defining occurrence */
labelcount++;
lnp = newline(OPINSTRLAB);
lnp->l_instr = op_lab;
INSTRLAB(lnp) = instr_lab(tabval);
*lnp_out = lnp;
return NORMAL;
case PSEU:
n = tabval;
lnp = inpseudo(n); /* read a pseudo */
if (lnp == (line_p) 0) return DELETED_INSTR;
*lnp_out = lnp;
lnp->l_instr = n;
if (firstline == (line_p) 0) {
firstline = lnp;
/* only a pseudo (e.g. PRO) or data label
* can be the first instruction.
*/
}
if (n == ps_end) return END_INSTR;
if (n == ps_pro) return PRO_INSTR;
return NORMAL;
}
/* NOTREACHED */
}
line_p readoperand(instr)
short instr;
{
/* Read the operand of the given instruction.
* Create a line struct and return a pointer to it.
*/
register line_p lnp;
short flag;
VI(instr);
flag = em_flag[ instr - sp_fmnem] & EM_PAR;
if (flag == PAR_NO) {
return (newline(OPNO));
}
switch(table2()) {
case sp_cend:
return(newline(OPNO));
case CSTX1:
/* constant */
/* If the instruction has the address
* of an external variable as argument,
* the constant must be regarded as an
* offset in the current hol block,
* so an object must be created.
* Similarly, the instruction may have
* an instruction label as argument.
*/
switch(flag) {
case PAR_G:
lnp = newline(OPOBJECT);
OBJ(lnp) =
object((char *) 0,(offset) tabval,
opr_size(instr));
break;
case PAR_B:
lnp = newline(OPINSTRLAB);
INSTRLAB(lnp) = instr_lab(tabval);
break;
default:
lnp = newline(OPSHORT);
SHORT(lnp) = tabval;
break;
}
break;
#ifdef LONGOFF
case CSTX2:
/* double constant */
lnp = newline(OPOFFSET);
OFFSET(lnp) = tabval2;
break;
#endif
case ILBX:
/* applied occurrence instruction label */
lnp = newline(OPINSTRLAB);
INSTRLAB(lnp) = instr_lab(tabval);
break;
case DLBX:
/* applied occurrence data label */
lnp = newline(OPOBJECT);
OBJ(lnp) = object(string, (offset) 0,
opr_size(instr) );
break;
case VALX1:
lnp = newline(OPOBJECT);
OBJ(lnp) = object(string, (offset) tabval,
opr_size(instr) );
break;
#ifdef LONGOFF
case VALX2:
lnp = newline(OPOBJECT);
OBJ(lnp) = object(string,tabval2,
opr_size(instr) );
break;
#endif
case sp_pnam:
lnp = newline(OPPROC);
PROC(lnp) = proclookup(string,OCCURRING);
VP(PROC(lnp));
break;
default:
assert(FALSE);
}
return lnp;
}
line_p inpseudo(n)
short n;
{
int m;
line_p lnp;
byte pseu;
short nlast;
/* Read the (remainder of) a pseudo instruction, the instruction
* code of which is n. The END pseudo may be deleted (return 0).
* The pseudos INA, EXA, INP and EXP (visibility pseudos) must
* also be deleted, although the effects they have on the
* visibility of global names and procedure names must first
* be recorded in the datablock or procedure table.
*/
switch(n) {
case ps_hol:
case ps_bss:
case ps_rom:
case ps_con:
if (lastline == (line_p) 0 || !is_datalabel(lastline)) {
if (n == ps_hol) {
/* A HOL need not be preceded
* by a label.
*/
curhol = db = block_of_lab((char *) 0);
} else {
assert(lastline != (line_p) 0);
nlast = INSTR(lastline);
if (n == nlast &&
(n == ps_rom || n == ps_con)) {
/* Two successive roms/cons are
* combined into one data block
* if the second is not preceded by
* a data label.
*/
lnp = arglist(0);
pseu = (byte) (n == ps_rom?DROM:DCON);
combine(db,lastline,lnp,pseu);
oldline(lnp);
return (line_p) 0;
} else {
error("datablock without label");
}
}
}
VD(db);
m = (n == ps_hol || n == ps_bss ? 3 : 0);
lnp = arglist(m);
/* Read the arguments, 3 for hol or bss and a list
* of undetermined length for rom and con.
*/
dblockdef(db,n,lnp);
/* Fill in d_pseudo, d_size and d_values fields of db */
if (fragm_type != db->d_pseudo & BMASK) {
/* Keep track of fragment numbers,
* enter a new fragment.
*/
fragm_nr++;
switch(db->d_pseudo) {
case DCON:
case DROM:
fragm_type = db->d_pseudo;
break;
default:
fragm_type = DUNKNOWN;
break;
}
}
db->d_fragmnr = fragm_nr;
return lnp;
case ps_ina:
getsym(DEFINING);
/* Read and lookup a symbol. As this must be
* the first occurrence of the symbol and we
* say it's a defining occurrence, getsym will
* automatically make it internal (according to
* the EM visibility rules).
* The result (a dblock pointer) is voided.
*/
return (line_p) 0;
case ps_inp:
getproc(DEFINING); /* same idea */
return (line_p) 0;
case ps_exa:
getsym(OCCURRING);
return (line_p) 0;
case ps_exp:
getproc(OCCURRING);
return (line_p) 0;
case ps_pro:
curproc = getproc(DEFINING);
/* This is a real defining occurrence of a proc */
curproc->p_localbytes = get_off();
curproc->p_flags1 |= PF_BODYSEEN;
/* Record the fact that we came accross
* the body of this procedure.
*/
lnp = newline(OPPROC);
PROC(lnp) = curproc;
lnp->l_instr = (byte) ps_pro;
return lnp;
case ps_end:
curproc->p_nrlabels = labelcount;
lnp = newline(OPNO);
get_off();
/* Void # localbytes, which we already know
* from the PRO instruction.
*/
return lnp;
case ps_mes:
lnp = arglist(0);
switch((int) aoff(ARG(lnp),0)) {
case ms_err:
error("ms_err encountered");
case ms_opt:
error("ms_opt encountered");
case ms_emx:
ws = aoff(ARG(lnp),1);
ps = aoff(ARG(lnp),2);
break;
case ms_ext:
/* this message was already processed
* by the lib package
*/
case ms_src:
/* Don't bother about linecounts */
oldline(lnp);
return (line_p) 0;
case ms_par:
mespar = aoff(ARG(lnp),1);
/* #bytes of parameters of current proc */
break;
}
return lnp;
default:
assert(FALSE);
}
/* NOTREACHED */
}

42
util/ego/ic/ic.h Normal file
View File

@@ -0,0 +1,42 @@
/* I N T E R M E D I A T E C O D E
*
* G L O B A L C O N S T A N T S & V A R I A B L E S
*/
/* macros used by ic_lib.c and ic_io.c: */
#define ARCHIVE 0
#define NO_ARCHIVE 1
/*
* The next constants are close to sp_cend for fast switches
*/
#define INST 256 /* instruction: number in tabval */
#define PSEU 257 /* pseudo: number in tabval */
#define ILBX 258 /* label: number in tabval */
#define DLBX 259 /* symbol: name in string[] */
#define CSTX1 260 /* short constant: stored in tabval */
#define CSTX2 261 /* offset: value in tabval2 */
#define VALX1 262 /* symbol+short: in string[] and tabval */
#define VALX2 263 /* symbol+offset: in string[] and tabval2 */
#define ATEOF 264 /* bumped into end of file */
/* Global variables */
extern dblock_p db;
extern dblock_p curhol; /* hol block in current scope */
extern dblock_p ldblock; /* last dblock processed so far */
extern proc_p lproc; /* last proc processed so far */
extern short tabval; /* used by table1, table2 and table3 */
extern offset tabval2;
extern char string[];
extern line_p lastline; /* last line read */
extern int labelcount; /* # labels in current procedure */
extern obj_id lastoid; /* last object identifier used */
extern proc_id lastpid; /* last proc identifier used */
extern lab_id lastlid; /* last label identifier used */
extern dblock_id lastdid; /* last dblock identifier used */
extern byte em_flag[];

459
util/ego/ic/ic_aux.c Normal file
View File

@@ -0,0 +1,459 @@
/* I N T E R M E D I A T E C O D E
*
* I C _ A U X . C
*/
#include "../share/types.h"
#include "../share/global.h"
#include "../share/debug.h"
#include "../share/def.h"
#include "../share/aux.h"
#include "../../../h/em_pseu.h"
#include "../../../h/em_spec.h"
#include "../../../h/em_mnem.h"
#include "ic.h"
#include "ic_io.h"
#include "ic_lookup.h"
#include "../share/alloc.h"
#include "ic_aux.h"
/* opr_size */
offset opr_size(instr)
short instr;
{
switch(instr) {
case op_loe:
case op_ste:
case op_ine:
case op_dee:
case op_zre:
return (offset) ws;
case op_lde:
case op_sde:
return (offset) 2*ws;
case op_lae:
case op_fil:
return (offset) UNKNOWN_SIZE;
default:
error("illegal operand of opr_size: %d", instr);
}
/* NOTREACHED */
}
/* dblockdef */
STATIC offset argsize(arg)
arg_p arg;
{
/* Compute the size (in bytes) that the given initializer
* will occupy.
*/
offset s;
argb_p argb;
switch(arg->a_type) {
case ARGOFF:
/* See if value fits in a short */
if ((short) arg->a_a.a_offset == arg->a_a.a_offset) {
return ws;
} else {
return 2*ws;
}
case ARGINSTRLAB:
case ARGOBJECT:
case ARGPROC:
return ps; /* pointer size */
case ARGSTRING:
/* strings are partitioned into pieces */
s = 0;
for (argb = &arg->a_a.a_string; argb != (argb_p) 0;
argb = argb->ab_next) {
s += argb->ab_index;
}
return s;
case ARGICN:
case ARGUCN:
case ARGFCN:
return arg->a_a.a_con.ac_length;
default:
assert(FALSE);
}
/* NOTREACHED */
}
STATIC offset blocksize(pseudo,args)
byte pseudo;
arg_p args;
{
/* Determine the number of bytes of a datablock */
arg_p arg;
offset sum;
switch(pseudo) {
case DHOL:
case DBSS:
if (args->a_type != ARGOFF) {
error("offset expected");
}
return args->a_a.a_offset;
case DCON:
case DROM:
sum = 0;
for (arg = args; arg != (arg_p) 0; arg = arg->a_next) {
/* Add the sizes of all initializers */
sum += argsize(arg);
}
return sum;
default:
assert(FALSE);
}
/* NOTREACHED */
}
STATIC arg_p copy_arg(arg)
arg_p arg;
{
/* Copy one argument */
arg_p new;
assert(arg->a_type == ARGOFF);
new = newarg(ARGOFF);
new->a_a.a_offset = arg->a_a.a_offset;
return new;
}
STATIC arg_p copy_rom(args)
arg_p args;
{
/* Make a copy of the values of a rom,
* provided that the rom contains only integer values,
*/
arg_p arg, arg2, argh;
for (arg = args; arg != (arg_p) 0; arg = arg->a_next) {
if (arg->a_type != ARGOFF) {
return (arg_p) 0;
}
}
/* Now make the copy */
arg2 = argh = copy_arg(args);
for (arg = args->a_next; arg != (arg_p) 0; arg = arg->a_next) {
arg2->a_next = copy_arg(arg);
arg2 = arg2->a_next;
}
return argh;
}
dblockdef(db,n,lnp)
dblock_p db;
int n;
line_p lnp;
{
/* Process a data block defining occurrence */
byte m;
switch(n) {
case ps_hol:
m = DHOL;
break;
case ps_bss:
m = DBSS;
break;
case ps_con:
m = DCON;
break;
case ps_rom:
m = DROM;
break;
default:
assert(FALSE);
}
db->d_pseudo = m;
db->d_size = blocksize(m, ARG(lnp));
if (m == DROM) {
/* We keep the values of a rom block in the data block
* table if the values consist of integers only.
*/
db->d_values = copy_rom(ARG(lnp));
}
}
/* combine */
combine(db,l1,l2,pseu)
dblock_p db;
line_p l1,l2;
byte pseu;
{
/* Combine two successive ROMs/CONs (without a data label
* in between into a single ROM. E.g.:
* xyz
* rom 3,6,9,12
* rom 7,0,2
* is changed into:
* xyz
* rom 3,6,9,12,7,0,2
*/
arg_p v;
db->d_size += blocksize(pseu,ARG(l2));
/* db is the data block that was already assigned to the
* first rom/con. The second one is not assigned a new
* data block of course, as the two are combined into
* one instruction.
*/
if (pseu == DROM && db->d_values != (arg_p) 0) {
/* The values contained in a ROM are only copied
* to the data block if they may be useful to us
* (e.g. they certainly may not be strings). In our
* case it means that both ROMs must have useful
* arguments.
*/
for (v = db->d_values; v->a_next != (arg_p) 0; v = v->a_next);
/* The first rom contained useful arguments. v now points to
* its last argument. Append the arguments of the second
* rom to this list. If the second rom has arguments that are
* not useful, throw away the entire list (we want to copy
* everything or nothing).
*/
if ((v->a_next = copy_rom(ARG(l2))) == (arg_p) 0) {
oldargs(db->d_values);
db->d_values = (arg_p) 0;
}
}
for (v = ARG(l1); v->a_next != (arg_p) 0; v = v->a_next);
/* combine the arguments of both instructions. */
v->a_next = ARG(l2);
ARG(l2) = (arg_p) 0;
}
/* arglist */
STATIC arg_string(length,abp)
offset length;
register argb_p abp;
{
while (length--) {
if (abp->ab_index == NARGBYTES)
abp = abp->ab_next = newargb();
abp->ab_contents[abp->ab_index++] = readchar();
}
}
line_p arglist(n)
int n;
{
line_p lnp;
register arg_p ap,*app;
bool moretocome;
offset length;
/*
* creates an arglist with n elements
* if n == 0 the arglist is variable and terminated by sp_cend
*/
lnp = newline(OPLIST);
app = &ARG(lnp);
moretocome = TRUE;
do {
switch(table2()) {
default:
error("unknown byte in arglist");
case CSTX1:
tabval2 = (offset) tabval;
case CSTX2:
*app = ap = newarg(ARGOFF);
ap->a_a.a_offset = tabval2;
app = &ap->a_next;
break;
case ILBX:
*app = ap = newarg(ARGINSTRLAB);
ap->a_a.a_instrlab = instr_lab((short) tabval);
app = &ap->a_next;
break;
case DLBX:
*app = ap = newarg(ARGOBJECT);
ap->a_a.a_obj = object(string,(offset) 0, (offset) 0);
/* The size of the object is unknown */
app = &ap->a_next;
break;
case sp_pnam:
*app = ap = newarg(ARGPROC);
ap->a_a.a_proc = proclookup(string,OCCURRING);
app = &ap->a_next;
break;
case VALX1:
tabval2 = (offset) tabval;
case VALX2:
*app = ap = newarg(ARGOBJECT);
ap->a_a.a_obj = object(string, tabval2, (offset) 0);
app = &ap->a_next;
break;
case sp_scon:
*app = ap = newarg(ARGSTRING);
length = get_off();
arg_string(length,&ap->a_a.a_string);
app = &ap->a_next;
break;
case sp_icon:
*app = ap = newarg(ARGICN);
goto casecon;
case sp_ucon:
*app = ap = newarg(ARGUCN);
goto casecon;
case sp_fcon:
*app = ap = newarg(ARGFCN);
casecon:
length = get_int();
ap->a_a.a_con.ac_length = (short) length;
arg_string(get_off(),&ap->a_a.a_con.ac_con);
app = &ap->a_next;
break;
case sp_cend:
moretocome = FALSE;
}
if (n && (--n) == 0)
moretocome = FALSE;
} while (moretocome);
return(lnp);
}
/* is_datalabel */
bool is_datalabel(l)
line_p l;
{
VL(l);
return (l->l_instr == (byte) ps_sym);
}
/* block_of_lab */
dblock_p block_of_lab(ident)
char *ident;
{
dblock_p dbl;
/* Find the datablock with the given name.
* Used for defining occurrences.
*/
dbl = symlookup(ident,DEFINING);
VD(dbl);
if (dbl->d_pseudo != DUNKNOWN) {
error("identifier redeclared");
}
return dbl;
}
/* object */
STATIC obj_p make_object(dbl,off,size)
dblock_p dbl;
offset off;
offset size;
{
/* Allocate an obj struct with the given attributes
* (if it did not exist already).
* Return a pointer to the found or newly created object struct.
*/
obj_p obj, prev, new;
/* See if the object was already present in the object list
* of the given datablock. If it is not yet present, find
* the right place to insert the new object. Note that
* the objects are sorted by offset.
*/
prev = (obj_p) 0;
for (obj = dbl->d_objlist; obj != (obj_p) 0; obj = obj->o_next) {
if (obj->o_off >= off) {
break;
}
prev = obj;
}
/* Note that the data block may contain several objects
* with the required offset; we also want the size to
* be the right one.
*/
while (obj != (obj_p) 0 && obj->o_off == off) {
if (obj->o_size == UNKNOWN_SIZE) {
obj->o_size = size;
return obj;
} else {
if (size == UNKNOWN_SIZE || obj->o_size == size) {
return obj;
/* This is the right one */
} else {
prev = obj;
obj = obj->o_next;
}
}
}
/* Allocate a new object */
new = newobject();
new->o_id = ++lastoid; /* create a unique object id */
new->o_off = off;
new->o_size = size;
new->o_dblock = dbl;
/* Insert the new object */
if (prev == (obj_p) 0) {
dbl->d_objlist = new;
} else {
prev->o_next = new;
}
new->o_next = obj;
return new;
}
obj_p object(ident,off,size)
char *ident;
offset off;
offset size;
{
dblock_p dbl;
/* Create an object struct (if it did not yet exist)
* for the object with the given size and offset
* within the datablock of the given name.
*/
dbl = (ident == (char *) 0 ? curhol : symlookup(ident, OCCURRING));
VD(dbl);
return(make_object(dbl,off,size));
}

39
util/ego/ic/ic_aux.h Normal file
View File

@@ -0,0 +1,39 @@
/* I N T E R M E D I A T E C O D E
*
* A U X I L I A R Y R O U T I N E S
*/
extern offset opr_size(); /* ( short instr )
* size of operand of given instruction.
* The operand is an object , so the
* instruction can be loe, zre etc..
*/
extern dblockdef(); /* (dblock_p db, int n, line_p lnp)
* Fill in d_pseudo, d_size and
* d_values fields of db.
*/
extern combine(); /* (dblock_p db;line_p l1,l2;byte pseu)
* Combine two successive ROMs or CONs
* (with no data label in between)
* into one ROM or CON.
*/
extern line_p arglist(); /* ( int m)
* Read a list of m arguments. If m
* is 0, then the list is of
* undetermined length; it is
* then terminated by a cend symbol.
*/
extern bool is_datalabel(); /* ( line_p l)
* TRUE if l is a data label defining
* occurrence (i.e. its l_instr
* field is ps_sym).
*/
extern dblock_p block_of_lab(); /* (char *ident)
* Find the datablock with
* the given name.
*/
extern obj_p object(); /* (char *ident,offset off,short size)
* Create an object struct.
*/

204
util/ego/ic/ic_io.c Normal file
View File

@@ -0,0 +1,204 @@
/* I N T E R M E D I A T E C O D E
*
* I C _ I O . C
*/
#include <stdio.h>
#include "../share/types.h"
#include "../share/debug.h"
#include "../../../h/em_pseu.h"
#include "../../../h/em_spec.h"
#include "../../../h/arch.h"
#include "ic.h"
#include "ic_lookup.h"
#include "../share/alloc.h"
#include "ic_io.h"
STATIC short libstate;
STATIC long bytecnt;
STATIC FILE *infile; /* The current EM input file */
STATIC int readbyte()
{
if (libstate == ARCHIVE && bytecnt-- == 0L) {
/* If we're reading from an archive file, we'll
* have to count the number of characters read,
* to know where the current module ends.
*/
return EOF;
}
return getc(infile);
}
short readshort() {
register int l_byte, h_byte;
l_byte = readbyte();
h_byte = readbyte();
if ( h_byte>=128 ) h_byte -= 256 ;
return l_byte | (h_byte*256) ;
}
#ifdef LONGOFF
offset readoffset() {
register long l;
register int h_byte;
l = readbyte();
l |= ((unsigned) readbyte())*256 ;
l |= readbyte()*256L*256L ;
h_byte = readbyte() ;
if ( h_byte>=128 ) h_byte -= 256 ;
return l | (h_byte*256L*256*256L) ;
}
#endif
short get_int() {
switch(table2()) {
default: error("int expected");
case CSTX1:
return(tabval);
}
}
char readchar()
{
return(readbyte());
}
offset get_off() {
switch (table2()) {
default: error("offset expected");
case CSTX1:
return((offset) tabval);
#ifdef LONGOFF
case CSTX2:
return(tabval2);
#endif
}
}
STATIC make_string(n) int n; {
register char *s;
extern char *sprintf();
s=sprintf(string,".%u",n);
assert(s == string);
}
STATIC inident() {
register n;
register char *p = string;
register c;
n = get_int();
while (n--) {
c = readbyte();
if (p<&string[IDL])
*p++ = c;
}
*p++ = 0;
}
int table3(n) int n; {
switch (n) {
case sp_ilb1: tabval = readbyte(); return(ILBX);
case sp_ilb2: tabval = readshort(); return(ILBX);
case sp_dlb1: make_string(readbyte()); return(DLBX);
case sp_dlb2: make_string(readshort()); return(DLBX);
case sp_dnam: inident(); return(DLBX);
case sp_pnam: inident(); return(n);
case sp_cst2: tabval = readshort(); return(CSTX1);
#ifdef LONGOFF
case sp_cst4: tabval2 = readoffset(); return(CSTX2);
#endif
case sp_doff: if (table2()!=DLBX) error("symbol expected");
switch(table2()) {
default: error("offset expected");
case CSTX1: return(VALX1);
#ifdef LONGOFF
case CSTX2: return(VALX2);
#endif
}
default: return(n);
}
}
int table1() {
register n;
n = readbyte();
if (n == EOF)
return(ATEOF);
if ((n <= sp_lmnem) && (n >= sp_fmnem)) {
tabval = n;
return(INST);
}
if ((n <= sp_lpseu) && (n >= sp_fpseu)) {
tabval = n;
return(PSEU);
}
if ((n < sp_filb0 + sp_nilb0) && (n >= sp_filb0)) {
tabval = n - sp_filb0;
return(ILBX);
}
return(table3(n));
}
int table2() {
register n;
n = readbyte();
if ((n < sp_fcst0 + sp_ncst0) && (n >= sp_fcst0)) {
tabval = n - sp_zcst0;
return(CSTX1);
}
return(table3(n));
}
file_init(f,state,length)
FILE *f;
short state;
long length;
{
short n;
infile = f;
libstate = state;
bytecnt = length;
linecount = 0;
n = readshort();
if (n != (short) sp_magic) {
error("wrong magic number: %d", n);
}
}
arch_init(arch)
FILE *arch;
{
short n;
infile = arch;
n = readshort();
if (n != ARMAG) {
error("wrong archive magic number: %d",n);
}
}

34
util/ego/ic/ic_io.h Normal file
View File

@@ -0,0 +1,34 @@
/* I N T E R M E D I A T E C O D E
*
* L O W L E V E L I / O R O U T I N E S
*/
extern int table1(); /* ( )
* Read an instruction from the
* Compact Assembly Language input
* file (in 'neutral state').
*/
extern int table2(); /* ( )
* Read an instruction argument.
*/
extern int table3(); /* ( int )
* Read 'Common Table' item.
*/
extern short get_int(); /* ( ) */
extern offset get_off(); /* ( ) */
extern char readchar(); /* ( ) */
extern file_init(); /* (FILE *f, short state, long length)
* Input file initialization. All
* following read operations will read
* from the given file f. Also checks
* the magic number and sets global
* variable 'linecount' to 0.
* If the state is ARCHIVE, length
* specifies the length of the module.
*/
extern arch_init(); /* (FILE *arch)
* Same as file_init,but opens an
* archive file. So it checks the
* magic number for archives.
*/

274
util/ego/ic/ic_lib.c Normal file
View File

@@ -0,0 +1,274 @@
/* I N T E R M E D I A T E C O D E
*
* I C _ L I B . C
*/
#include <stdio.h>
#include "../share/types.h"
#include "../share/debug.h"
#include "../../../h/em_spec.h"
#include "../../../h/em_pseu.h"
#include "../../../h/em_mes.h"
#include "../../../h/arch.h"
#include "ic_lookup.h"
#include "ic.h"
#include "ic_io.h"
#include "../share/global.h"
#include "../share/files.h"
#include "ic_lib.h"
STATIC skip_string(n)
offset n;
{
/* Read a string of length n and void it */
while (n--) {
readchar();
}
}
STATIC skip_arguments()
{
/* Skip the arguments of a MES pseudo. The argument
* list is terminated by a sp_cend byte.
*/
for (;;) {
switch(table2()) {
case sp_scon:
get_off(); /* void */
/* fall through !!! */
case sp_icon:
case sp_ucon:
case sp_fcon:
get_int(); /* void */
skip_string(get_off());
break;
case sp_cend:
return;
default:
break;
}
}
}
STATIC bool proc_wanted(name)
char *name;
{
/* See if 'name' is the name of an external procedure
* that has been used before, but for which no body
* has been given so far.
*/
proc_p p;
if (( p = proclookup(name,IMPORTING)) != (proc_p) 0 &&
!(p->p_flags1 & PF_BODYSEEN)) {
return TRUE;
} else {
return FALSE;
}
}
STATIC bool data_wanted(name)
char *name;
{
/* See if 'name' is the name of an externally visible
* data block that has been used before, but for which
* no defining occurrence has been given yet.
*/
dblock_p db;
if ((db = symlookup(name,IMPORTING)) != (dblock_p) 0 &&
db->d_pseudo == DUNKNOWN) {
return TRUE;
} else {
return FALSE;
}
}
STATIC bool wanted_names()
{
/* Read the names of procedures and data labels,
* appearing in a 'MES ms_ext' pseudo. Those are
* the names of entities that are imported by
* a library module.
* If any of them is wanted, return TRUE.
* A name is wanted if it is the name of a procedure
* or data block for which applied occurrences but
* no defining occurrence has been met.
*/
for (;;) {
switch(table2()) {
case DLBX:
if (data_wanted(string)) {
return TRUE;
}
/* A data entity with the name
* string is available.
*/
break;
case sp_pnam:
if (proc_wanted(string)) {
return TRUE;
}
break;
case sp_cend:
return FALSE;
default:
error("wrong argument of MES %d", ms_ext);
}
}
}
STATIC FILE *curfile = NULL;
STATIC bool useful()
{
/* Determine if any entity imported by the current
* compact EM assembly file (which will usually be
* part of an archive file) is useful to us.
* The file must contain (before any other non-MES line)
* a 'MES ms_ext' pseudo that has as arguments the names
* of the entities imported.
*/
for (;;) {
if (table1() != PSEU || tabval != ps_mes) {
error("cannot find MES %d in library file",ms_ext);
}
if (table2() != CSTX1) {
error("message number expected");
}
if (tabval == ms_ext) {
/* This is the one we searched */
return wanted_names();
/* Read the names of the imported entities
* and check if any of them is wanted.
*/
} else {
skip_arguments(); /* skip remainder of this MES */
}
}
}
STATIC bool is_archive(name)
char *name;
{
/* See if 'name' is the name of an archive file, i.e. it
* should end on ".a" and should at least be three characters
* long (i.e. the name ".a" is not accepted as an archive name!).
*/
register char *p;
for (p = name; *p; p++);
return (p > name+2) && (*--p == 'a') && (*--p == '.');
}
STATIC struct ar_hdr hdr;
STATIC bool read_hdr()
{
/* Read the header of an archive module */
fread(&hdr, sizeof(hdr), 1, curfile);
return !feof(curfile);
}
STATIC int argcnt = ARGSTART - 1;
STATIC short arstate = NO_ARCHIVE;
FILE *next_file(argc,argv)
int argc;
char *argv[];
{
/* See if there are more EM input files. The file names
* are given via argv. If a file is an archive file
* it is supposed to be a library of EM compact assembly
* files. A module (file) contained in this archive file
* is only used if it imports at least one procedure or
* datalabel for which we have not yet seen a defining
* occurrence, although we have seen a used occurrence.
*/
long ptr;
for (;;) {
/* This loop is only exited via a return */
if (arstate == ARCHIVE) {
/* We were reading an archive file */
if (ftell(curfile) & 1) {
/* modules in an archive file always
* begin on a word boundary, i.e. at
* an even address.
*/
fseek(curfile,1L,1);
}
if (read_hdr()) { /* read header of next module */
ptr = ftell(curfile); /* file position */
file_init(curfile,ARCHIVE,hdr.ar_size);
/* tell i/o package that we're reading
* an archive module of given length.
*/
if (useful()) {
/* re-initialize file, because 'useful'
* has read some bytes too.
*/
fseek(curfile,ptr,0); /* start module */
file_init(curfile,ARCHIVE,hdr.ar_size);
return curfile;
} else {
/* skip this module */
fseek(curfile,
ptr+hdr.ar_size,0);
}
} else {
/* done with this archive */
arstate = NO_ARCHIVE;
}
} else {
/* open next file, close old */
if (curfile != NULL) {
fclose(curfile);
}
argcnt++;
if (argcnt >= argc) {
/* done with all arguments */
return NULL;
}
filename = argv[argcnt];
if ((curfile = fopen(filename,"r")) == NULL) {
error("cannot open %s",filename);
}
if (is_archive(filename)) {
/* ends on '.a' */
arstate = ARCHIVE;
arch_init(curfile); /* read magic ar number */
} else {
file_init(curfile,NO_ARCHIVE,0L);
return curfile;
}
}
}
}

14
util/ego/ic/ic_lib.h Normal file
View File

@@ -0,0 +1,14 @@
/* I N T E R M E D I A T E C O D E
*
* L I B R A R Y M A N A G E R
*/
extern FILE *next_file(); /* (int argc, char *argv[])
* See if there are any more EM input files.
* 'argv' contains the names of the files
* that are passed as arguments to ic.
* If an argument is a library (archive
* file) only those modules that are useful
* are used.
*/

405
util/ego/ic/ic_lookup.c Normal file
View File

@@ -0,0 +1,405 @@
/* I N T E R M E D I A T E C O D E
*
* I C _ L O O K U P . C
*/
#include <stdio.h>
#include "../share/types.h"
#include "../share/debug.h"
#include "../share/map.h"
#include "../../../h/em_spec.h"
#include "ic.h"
#include "ic_lookup.h"
#include "../share/alloc.h"
sym_p symhash[NSYMHASH];
prc_p prochash[NPROCHASH];
num_p numhash[NNUMHASH];
/* instr_lab */
lab_id instr_lab(number)
short number;
{
register num_p *npp, np;
/* In EM assembly language, a label is an unsigned number,
* e.g. 120 in 'BRA *120'. In IC the labels of a procedure
* are represented by consecutive integer numbers, called
* lab_id. The mapping takes place here.
*/
npp = &numhash[number%NNUMHASH];
while (*npp != (num_p) 0) {
if ((*npp)->n_number == number) {
return(*npp)->n_labid;
} else {
npp = &(*npp)->n_next;
}
}
/* The label was not found in the hashtable, so
* create a new entry for it.
*/
*npp = np = newnum();
np->n_number = number;
np->n_labid = ++lastlid;
/* Assign a new label identifier to the num struct.
* lastlid is reset to 0 at the beginning of
* every new EM procedure (by cleaninstrlabs).
*/
return (np->n_labid);
}
/* symlookup */
STATIC unsigned hash(string) char *string; {
register char *p;
register unsigned i,sum;
for (sum=i=0,p=string;*p;i += 3)
sum ^= (*p++)<<(i&07);
return(sum);
}
dblock_p symlookup(name, status)
char *name;
int status;
{
/* Look up the name of a data block. The name can appear
* in either a defining or applied occurrence (status is
* DEFINING, OCCURRING resp.), or in a MES ms_ext instruction
* as the name of a data block imported by a library module
* (status is IMPORTING). Things get complicated,
* because a HOL pseudo need not be preceded by a
* data label, i.e. a hol block need not have a name.
*/
register sym_p *spp, sp;
register dblock_p dp;
if (name == (char *) 0) {
assert(status == DEFINING);
dp = newdblock();
} else {
spp = &symhash[hash(name)%NSYMHASH];
while (*spp != (sym_p) 0) {
/* Every hashtable entry points to a list
* of synonyms (i.e. names with the same
* hash values). Try to find 'name' in its
* list.
*/
if (strncmp((*spp)->sy_name, name, IDL) == 0) {
/* found */
return ((*spp)->sy_dblock);
} else {
spp = &(*spp)->sy_next;
}
}
/* The name is not found, so create a new entry for it.
* However, if the status is IMPORTING, we just return 0,
* indicating that we don't need this name.
*/
if (status == IMPORTING) return (dblock_p) 0;
*spp = sp = newsym();
strncpy(sp->sy_name, name, IDL);
dp = sp->sy_dblock = newdblock();
}
if (fdblock == (dblock_p) 0) {
fdblock = dp;
/* first data block */
} else {
ldblock->d_next = dp; /* link to last dblock */
}
ldblock = dp;
dp->d_pseudo = DUNKNOWN; /* clear all fields */
dp->d_id = ++lastdid;
dp->d_size = 0;
dp->d_objlist = (obj_p) 0;
dp->d_values = (arg_p) 0;
dp->d_next = (dblock_p) 0;
dp->d_flags1 = 0;
dp->d_flags2 = 0;
if (status == OCCURRING) {
/* This is the first occurrence of the identifier,
* so if it is a used occurrence make the
* identifier externally visible, else make it
* internal.
*/
dp->d_flags1 |= DF_EXTERNAL;
}
return dp;
}
/* getsym */
dblock_p getsym(status)
int status;
{
if (table2() != DLBX) {
error("symbol expected");
}
return(symlookup(string,status));
}
/* getproc */
proc_p getproc(status)
int status;
{
if (table2() != sp_pnam) {
error("proc name expected");
}
return(proclookup(string,status));
}
/* proclookup */
proc_p proclookup(name, status)
char *name;
int status;
{
register prc_p *ppp, pp;
register proc_p dp;
ppp = &prochash[hash(name)%NPROCHASH];
while (*ppp != (prc_p) 0) {
/* Every hashtable entry points to a list
* of synonyms (i.e. names with the same
* hash values). Try to find 'name' in its
* list.
*/
if (strncmp((*ppp)->pr_name, name, IDL) == 0) {
/* found */
return ((*ppp)->pr_proc);
} else {
ppp = &(*ppp)->pr_next;
}
}
/* The name is not found, so create a new entry for it,
* unless the status is IMPORTING, in which case we
* return 0, indicating we don't want this proc.
*/
if (status == IMPORTING) return (proc_p) 0;
*ppp = pp = newprc();
strncpy(pp->pr_name, name, IDL);
dp = pp->pr_proc = newproc();
if (fproc == (proc_p) 0) {
fproc = dp; /* first proc */
} else {
lproc->p_next = dp;
}
lproc = dp;
dp->p_id = ++lastpid; /* create a unique proc_id */
dp->p_next = (proc_p) 0;
dp->p_flags1 = 0;
dp->p_flags2 = 0;
if (status == OCCURRING) {
/* This is the first occurrence of the identifier,
* so if it is a used occurrence the make the
* identifier externally visible, else make it
* internal.
*/
dp->p_flags1 |= PF_EXTERNAL;
}
return dp;
}
/* cleaninstrlabs */
cleaninstrlabs()
{
register num_p *npp, np, next;
for (npp = numhash; npp < &numhash[NNUMHASH]; npp++) {
for (np = *npp; np != (num_p) 0; np = next) {
next = np->n_next;
oldnum(np);
}
*npp = (num_p) 0;
}
/* Reset last label id (used by instr_lab). */
lastlid = (lab_id) 0;
}
/* dump_procnames */
dump_procnames(hash,n,f)
prc_p hash[];
int n;
FILE *f;
{
/* Save the names of the EM procedures in file f.
* Note that the Optimizer Intermediate Code does not
* use identifiers but proc_ids, object_ids etc.
* The names, however, can be used after optimization
* is completed, to reconstruct Compact Assembly Language.
* The output consists of tuples (proc_id, name).
* This routine is called once for every input file.
* To prevent names of external procedures being written
* more than once, the PF_WRITTEN flag is used.
*/
register prc_p *pp, ph;
proc_p p;
char str[IDL+1];
register int i;
#define PF_WRITTEN 01
for (pp = &hash[0]; pp < &hash[n]; pp++) {
/* Traverse the entire hash table */
for (ph = *pp; ph != (prc_p) 0; ph = ph->pr_next) {
/* Traverse the list of synonyms */
p = ph->pr_proc;
if ((p->p_flags2 & PF_WRITTEN) == 0) {
/* not been written yet */
for(i = 0; i < IDL; i++) {
str[i] = ph->pr_name[i];
}
str[IDL] = '\0';
fprintf(f,"%d %s\n",p->p_id, str);
p->p_flags2 |= PF_WRITTEN;
}
}
}
}
/* cleanprocs */
cleanprocs(hash,n,mask)
prc_p hash[];
int n,mask;
{
/* After an EM input file has been processed, the names
* of those procedures that are internal (i.e. not visible
* outside the file they are defined in) must be removed
* from the procedure hash table. This is accomplished
* by removing the 'prc struct' from its synonym list.
* After the final input file has been processed, all
* remaining prc structs are also removed.
*/
register prc_p *pp, ph, x, next;
for (pp = &hash[0]; pp < &hash[n]; pp++) {
/* Traverse the hash table */
x = (prc_p) 0;
for (ph = *pp; ph != (prc_p) 0; ph = next) {
/* Traverse the synonym list.
* x points to the prc struct just before ph,
* or is 0 if ph is the first struct of
* the list.
*/
next = ph->pr_next;
if ((ph->pr_proc->p_flags1 & mask) == 0) {
if (x == (prc_p) 0) {
*pp = next;
} else {
x->pr_next = next;
}
oldprc(ph); /* delete the struct */
} else {
x = ph;
}
}
}
}
/* dump_dblocknames */
dump_dblocknames(hash,n,f)
sym_p hash[];
int n;
FILE *f;
{
/* Save the names of the EM data blocks in file f.
* The output consists of tuples (dblock_id, name).
* This routine is called once for every input file.
*/
register sym_p *sp, sh;
dblock_p d;
char str[IDL+1];
register int i;
#define DF_WRITTEN 01
for (sp = &hash[0]; sp < &hash[n]; sp++) {
/* Traverse the entire hash table */
for (sh = *sp; sh != (sym_p) 0; sh = sh->sy_next) {
/* Traverse the list of synonyms */
d = sh->sy_dblock;
if ((d->d_flags2 & DF_WRITTEN) == 0) {
/* not been written yet */
for (i = 0; i < IDL; i++) {
str[i] = sh->sy_name[i];
str[IDL] = '\0';
}
fprintf(f,"%d %s\n",d->d_id, str);
d->d_flags2 |= DF_WRITTEN;
}
}
}
}
/* cleandblocks */
cleandblocks(hash,n,mask)
sym_p hash[];
int n,mask;
{
/* After an EM input file has been processed, the names
* of those data blocks that are internal must be removed.
*/
register sym_p *sp, sh, x, next;
for (sp = &hash[0]; sp < &hash[n]; sp++) {
x = (sym_p) 0;
for (sh = *sp; sh != (sym_p) 0; sh = next) {
next = sh->sy_next;
if ((sh->sy_dblock->d_flags1 & mask) == 0) {
if (x == (sym_p) 0) {
*sp = next;
} else {
x->sy_next = next;
}
oldsym(sh); /* delete the struct */
} else {
x = sh;
}
}
}
}

71
util/ego/ic/ic_lookup.h Normal file
View File

@@ -0,0 +1,71 @@
/* I N T E R M E D I A T E C O D E
*
* L O O K - U P R O U T I N E S
*/
/* During Intermediate Code generation data label names ('symbols'),
* procedure names and instruction labels (numbers) are translated
* to resp. a data block pointer, a proc pointer and a label identifier.
* We use three hash tables for this purpose (symhash, prochash, numhash).
* Every name/number is hashed to an index in a specific table. A table
* entry contains a list of structs (sym, prc, num), each one representing
* a 'synonym'. (Synonyms are names/numbers having the same hash value).
*/
/* status passed as argument to look_up routines:
* resp. used occurrence, defining occurrence, occurrence in
* a MES ms_ext pseudo.
*/
#define OCCURRING 0
#define DEFINING 1
#define IMPORTING 2
#define NSYMHASH 127
#define NPROCHASH 127
#define NNUMHASH 37
extern sym_p symhash[];
extern prc_p prochash[];
extern num_p numhash[];
extern lab_id instr_lab(); /* ( short number)
* Maps EM labels to sequential
* integers.
*/
extern dblock_p symlookup(); /* (char *ident, int status)
* Look up the data block with
* the given name.
*/
extern dblock_p getsym(); /* ( int status)
* Read and look up a symbol.
* If this is the first occurrence
* of it, then make it external
* (if status=OCCURRING) or
* internal (if DEFINING).
*/
extern proc_p getproc(); /* (int status)
* Same as getsym, but for procedure
* names.
*/
extern proc_p proclookup(); /* ( char *ident, int status)
* Find (in the hashtable) the
* procedure with the given name.
*/
extern cleaninstrlabs(); /* ( )
* Forget about all instruction labels.
*/
extern dump_procnames(); /* (prc_p hash[], int n, FILE *f)
* Save the names of the procedures
* in file f; hash is the hashtable
* used and n is its length.
*/
extern cleanprocs(); /* (prc_p hash[], int n,mask)
* Make the names of all procedures
* for which p_flags1&mask = 0 invisible
*/
extern cleandblocks(); /* (sym_p hash[], int n)
* Make the names of all data blocks
* for which d_flags1&mask = 0 invisible
*/