mirror of
https://github.com/PDP-10/PCC20.git
synced 2026-01-13 23:26:39 +00:00
1045 lines
24 KiB
C
1045 lines
24 KiB
C
# include "gt.h"
|
||
|
||
/*
|
||
|
||
GT Compiler
|
||
Section 3: Action Routines
|
||
|
||
*/
|
||
|
||
/* The maximum number of registers is really limited by the number
|
||
of bits in a word on the machine running this program and
|
||
on the machine running the C compiler since the set of all
|
||
registers is represented by the bits in a single word.
|
||
Also, the maximum number of indirect classes is even further
|
||
limited because the set of all memory reference classes, which
|
||
includes indirection via registers, is also represented by the
|
||
bits in a single word. */
|
||
|
||
# define maxregs 16 /* maximum number of registers */
|
||
# define maxtypes 8 /* maximum number of data types */
|
||
# define maxmem 16 /* maximum number of memory refs */
|
||
# define maxnmacs 100 /* maximum number of named macros */
|
||
# define retregsz 18 /* 2 + maxtypes*2 */
|
||
# define namop 0300 /* number of abstract machine operators */
|
||
# define mdfsz 2000 /* size of macro definition list table */
|
||
|
||
# define find_reg fndrg
|
||
# define find_pc fndpc
|
||
# define find_type fndty
|
||
|
||
extern char cstore[], *cscsp;
|
||
extern int lineno, f_out, *get_top();
|
||
|
||
int ntype 0, /* number of data types */
|
||
typname[maxtypes], /* names of data types */
|
||
nmem 0, /* current number of memory refs */
|
||
memname[maxmem], /* names of memory refs */
|
||
nreg 0, /* current number of registers */
|
||
regname[maxregs], /* index to name of register */
|
||
rcname[maxregs], /* index to name of register classes */
|
||
rcp[maxregs], /* descriptions of register classes */
|
||
nrc 0, /* number of register classes */
|
||
pcname[maxtypes], /* index to name of pointer classes */
|
||
npc 0, /* current number of pointer classes */
|
||
pcor[maxtypes], /* pointer class offset range function no. */
|
||
norr 0, /* number of offset range functions emitted */
|
||
trdt[maxtypes], /* registers holding a given type */
|
||
prdt[maxtypes], /* registers holding a given pointer */
|
||
cfp[maxregs], /* descriptions of conflicts */
|
||
nac 0, /* number of alignment classes */
|
||
calign[maxtypes], /* align. factors of align. classes */
|
||
tsize[maxtypes], /* sizes of each type */
|
||
talign[maxtypes], /* align. classes of each type */
|
||
tpoint[maxtypes], /* pointer classes of each type */
|
||
pc_align[maxtypes], /* resolution of pointer class in characters */
|
||
retreg[retregsz], /* the registers in which values
|
||
of a given type are returned
|
||
in a function call - this array is
|
||
indexed by the value returned by a
|
||
routine CTYPE in the code generator */
|
||
cfactor 0, /* current alignment factor */
|
||
save_area_size -1,
|
||
opreg[namop], /* registers for result of op */
|
||
opmem[namop], /* memory refs for result of op */
|
||
oplist[namop], /* used to construct opreg, opmem */
|
||
coplist 0, /* index into oplist */
|
||
amopp[namop], /* indices to lists in amopl */
|
||
c_oploc 0, /* current index in oploc table */
|
||
amopl[500], /* lists of indices to oplocs */
|
||
c_amopl 0, /* current entry in amopl */
|
||
copflag l_unknown, /* current flag */
|
||
allmem -1, /* this name represents all mem_refs */
|
||
mactab[namop], /* names of macro calls */
|
||
macdef[namop], /* index in mdeflist to beginning of macro */
|
||
nnmacs 0, /* current number of named macros */
|
||
nmacname[maxnmacs], /* names of named macros */
|
||
nmacdef[maxnmacs], /* index in mdeflist to beginning of macro */
|
||
mdeflist[mdfsz], /* list of macro definitons, each a list of
|
||
integers:
|
||
|
||
flag(operand 1)
|
||
word(operand 1)
|
||
flag(operand 2)
|
||
word(operand 2)
|
||
flag(result)
|
||
word(result)
|
||
|
||
...
|
||
|
||
-1
|
||
|
||
*/
|
||
cmacro 1, /* current macro number */
|
||
cmdf 0; /* current entry in mdeflist */
|
||
|
||
struct oploc {
|
||
int flag[3], /* flag for opnd 1, opnd 2, result:
|
||
1 - memory ref type
|
||
2 - registers
|
||
3 - result left in opnd 1
|
||
4 - result left in opnd 2
|
||
*/
|
||
word[3], /* word for opnd1, opnd2, result:
|
||
bits represent memory ref
|
||
types or register numbers
|
||
according to the flag
|
||
*/
|
||
clobber;} /* bits indicate registers which
|
||
are clobbered as a result of this
|
||
operation
|
||
*/
|
||
doploc;
|
||
|
||
/**********************************************************************
|
||
|
||
PRCOM - Print Comment
|
||
|
||
**********************************************************************/
|
||
|
||
prcom (name, narray, varray, count)
|
||
int name, narray[], varray[], count;
|
||
|
||
{int i;
|
||
|
||
for (i=0; i<count; ++i)
|
||
{gprint ("/* %s %m\t", name, narray[i]);
|
||
rd_print (varray[i]);
|
||
gprint (" */\n");
|
||
}
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
RD_PRINT - gprint register description as bit string
|
||
|
||
**********************************************************************/
|
||
|
||
rd_print (w) int w;
|
||
|
||
{int i;
|
||
|
||
for (i=0;i<nreg;i++) gprint ("%c", ((w>>i) & 1) + '0');
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
GENERIC TABLE ROUTINES
|
||
|
||
TFIND - find name in table, return -1 if not there
|
||
TENTER - find name in table, enter if not there
|
||
TEFIND - find name in table, emit error message if not there
|
||
|
||
**********************************************************************/
|
||
|
||
int tfind (name, table, size)
|
||
int name, *table, size;
|
||
|
||
{int i;
|
||
|
||
for (i=0;i<size;++i) if (table[i]==name) return (i);
|
||
return (-1);
|
||
}
|
||
|
||
int tenter (name, table, psize, maxsize, errno)
|
||
int name, *table, *psize, maxsize, errno;
|
||
|
||
{int i, size;
|
||
|
||
size = *psize;
|
||
if ((i = tfind (name, table, size)) >= 0) return (i);
|
||
if (size >= maxsize) error (errno, lineno);
|
||
table[size] = name;
|
||
return ((*psize)++);
|
||
}
|
||
|
||
int tefind (name, table, size, errno)
|
||
int name, *table, size, errno;
|
||
|
||
{int i;
|
||
|
||
i = tfind (name, table, size);
|
||
if (i<0) error (errno, lineno, TIDN, name);
|
||
return (i);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
SPECIFIC TABLE ROUTINES
|
||
|
||
**********************************************************************/
|
||
|
||
int typ_find (n) {return (tfind (n, typname, ntype));}
|
||
int typ_enter (n) {return (tenter (n, typname, &ntype, maxtypes, 4019));}
|
||
int find_type (n) {return (tefind (n, typname, ntype, 2028));}
|
||
|
||
int mem_find (n) {return (tfind (n, memname, nmem));}
|
||
int mem_enter (n) {return (tenter (n, memname, &nmem, maxmem, 4020));}
|
||
int find_mem (n) {return (tefind (n, memname, nmem, 2029));}
|
||
|
||
int reg_find (n) {return (tfind (n, regname, nreg));}
|
||
int reg_enter (n) {return (tenter (n, regname, &nreg, maxregs, 4017));}
|
||
int find_reg (n) {return (tefind (n, regname, nreg, 2027));}
|
||
|
||
int rc_find (n) {return (tfind (n, rcname, nrc));}
|
||
int rc_enter (n) {return (tenter (n, rcname, &nrc, maxregs, 4018));}
|
||
|
||
int pc_find (n) {return (tfind (n, pcname, npc));}
|
||
int pc_enter (n) {return (tenter (n, pcname, &npc, maxtypes, 4016));}
|
||
int find_pc (n) {return (tefind (n, pcname, npc, 2026));}
|
||
|
||
/**********************************************************************
|
||
|
||
GETREG - return bit set for register named N
|
||
if undefined, emit message and return empty set
|
||
|
||
**********************************************************************/
|
||
|
||
int getreg (n)
|
||
|
||
{int r;
|
||
|
||
if ((r = find_reg (n)) < 0) return (0);
|
||
return (1 << r);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
GETRC - same as GETREG but N can name register class
|
||
|
||
**********************************************************************/
|
||
|
||
int getrc (n)
|
||
|
||
{int c;
|
||
|
||
if ((c = rc_find (n)) >= 0) return (rcp[c]);
|
||
return (getreg (n));
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
ATNAMES - define names of data types
|
||
|
||
**********************************************************************/
|
||
|
||
atnames (sp) int *sp;
|
||
|
||
{int *ot;
|
||
|
||
ot = get_top (sp);
|
||
if (ntype != 0) error (2002, lineno);
|
||
else while (sp<=ot) typ_enter (*sp++);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
ARNAMES - define names of registers
|
||
|
||
**********************************************************************/
|
||
|
||
arnames (sp) int *sp;
|
||
|
||
{int *ot;
|
||
|
||
ot = get_top (sp);
|
||
if (nreg != 0) error (2003, lineno);
|
||
else while (sp <= ot) reg_enter (*sp++);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
AMNAMES - define names of memory references
|
||
|
||
**********************************************************************/
|
||
|
||
amnames (sp) int *sp;
|
||
|
||
{int *ot;
|
||
|
||
ot = get_top (sp);
|
||
if (nmem != 0) error (2004, lineno);
|
||
else while (sp <= ot) mem_enter (*sp++);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
FS1 - finished with TYPENAMES,REGNAMES, and MEMNAMES statements
|
||
|
||
**********************************************************************/
|
||
|
||
fs1()
|
||
|
||
{int t;
|
||
|
||
if (ntype == 0) error (4013,lineno);
|
||
if (nreg == 0) error (4014,lineno);
|
||
if (nmem == 0) error (4015,lineno);
|
||
|
||
for (t=0; t<ntype; ++t)
|
||
pcname[t]=calign[t]=tsize[t]=talign[t]=tpoint[t]= -1;
|
||
for (t=0; t<namop; ++t) amopp[t] = mactab[t] = -1;
|
||
for (t=0; t<retregsz; ++t) retreg[t] = -1;
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
FS2 - finished with SIZE, ALIGN, CLASS, CONFLICT, POINTER,
|
||
and SAVEAREASIZE statements
|
||
|
||
**********************************************************************/
|
||
|
||
fs2()
|
||
|
||
{int t, i, a, c;
|
||
|
||
if (npc==0) error(4021,lineno);
|
||
for (i=0; i<ntype; ++i)
|
||
if (tsize[i]<0)
|
||
{error(2016,lineno,TIDN,typname[i]);
|
||
tsize[i]=1;
|
||
}
|
||
for (i=0; i<ntype; ++i)
|
||
if (talign[i]<0)
|
||
{error(2023,lineno,TIDN,typname[i]);
|
||
talign[i]=0;}
|
||
prcom ("\t class", rcname, rcp, nrc);
|
||
prcom ("\tconflict", regname, cfp, nreg);
|
||
for (t=0;t<ntype;++t)
|
||
{a=calign[talign[t]];
|
||
for(c=npc-1;c>=0;--c) if ((a%pc_align[c])==0) break;
|
||
if (c<0) error(2022,lineno,TIDN,typname[t]);
|
||
else tpoint[t]=c;
|
||
}
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
ASIZE - define size of basic types
|
||
|
||
SIZE - the size in characters
|
||
SP - a pointer to a list of the types with the given size
|
||
|
||
**********************************************************************/
|
||
|
||
asize (size, sp) int size, *sp;
|
||
|
||
{int *ot, t;
|
||
|
||
ot = get_top (sp);
|
||
while (sp<=ot)
|
||
{if ((t = find_type (*sp++)) >= 0)
|
||
if (tsize[t] >= 0)
|
||
error(2015,lineno,TIDN,typname[t]);
|
||
else tsize[t]=size;
|
||
}
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
AALIGN - define alignment class
|
||
|
||
factor - alignment factor
|
||
sp - pointer to list of types in this alignment class
|
||
|
||
**********************************************************************/
|
||
|
||
aalign (factor, sp) int factor, *sp;
|
||
|
||
{int *ot, t;
|
||
|
||
ot = get_top (sp);
|
||
if (factor <= cfactor)
|
||
{error (2009, lineno);
|
||
return;
|
||
}
|
||
cfactor = calign[nac] = factor;
|
||
while (sp <= ot)
|
||
{if ((t = find_type (*sp++)) >= 0)
|
||
if (talign[t]>=0)
|
||
error (2020,lineno,TIDN,typname[t]);
|
||
else talign[t] = nac;
|
||
}
|
||
nac++;
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
APOINT - define pointer class
|
||
|
||
name - the name of the pointer class
|
||
resolution - the resolution in characters of a pointer
|
||
in the pointer class
|
||
|
||
**********************************************************************/
|
||
|
||
apoint (name, resolution) int name,resolution;
|
||
|
||
{static int current_resolution;
|
||
|
||
if (npc==0) current_resolution=0;
|
||
if (resolution<0 || resolution<=current_resolution)
|
||
{error(2009,lineno);
|
||
return;
|
||
}
|
||
current_resolution=pc_align[pc_enter(name)]=resolution;
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
ACLASS - define register class
|
||
|
||
idn - name of register class
|
||
sp - pointer to list of names of members of the class
|
||
|
||
**********************************************************************/
|
||
|
||
aclass (idn ,sp) int idn, *sp;
|
||
|
||
{int *ot, rc;
|
||
|
||
ot = get_top (sp);
|
||
rc = rc_enter (idn);
|
||
while (sp <= ot) rcp[rc] =| getreg (*sp++);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
ASAVE - define save area size (in characters)
|
||
|
||
**********************************************************************/
|
||
|
||
asave (i)
|
||
|
||
{save_area_size = i;
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
AOR1 - Handle Offset_Range of Form (lo,hi)
|
||
|
||
**********************************************************************/
|
||
|
||
aor1 (idn, lo, hi)
|
||
|
||
{int pc;
|
||
|
||
if ((pc = find_pc (idn)) >= 0)
|
||
{gprint ("int ofok%d (i) {return (i>=%d && i<=%d);}\n",
|
||
++norr, lo, hi);
|
||
pcor[pc] = norr;
|
||
}
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
AOR2 - Handle Offset_Range of Form (lo,)
|
||
|
||
**********************************************************************/
|
||
|
||
aor2 (idn, lo)
|
||
|
||
{int pc;
|
||
|
||
if ((pc = find_pc (idn)) >= 0)
|
||
{gprint ("int ofok%d(i) {return (i>=%d);}\n",
|
||
++norr, lo);
|
||
pcor[pc] = norr;
|
||
}
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
AOR3 - Handle Offset_Range of Form (,hi)
|
||
|
||
**********************************************************************/
|
||
|
||
aor3 (idn, hi)
|
||
|
||
{int pc;
|
||
|
||
if ((pc = find_pc (idn)) >= 0)
|
||
{gprint ("int ofok%d(i) {return (i<=%d);}\n",
|
||
++norr, hi);
|
||
pcor[pc] = norr;
|
||
}
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
AOR4 - Handle Offset_Range of Form (,)
|
||
|
||
**********************************************************************/
|
||
|
||
aor4 (idn)
|
||
|
||
{int pc;
|
||
|
||
if ((pc = find_pc (idn)) >= 0)
|
||
{gprint ("int ofok%d(i) {return (1);}\n", ++norr);
|
||
pcor[pc] = norr;
|
||
}
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
ARETREG - define the types which are returned in a given register
|
||
|
||
REG_NAME - the name of the register
|
||
SP - a pointer to a list of type or pointer_class names
|
||
|
||
**********************************************************************/
|
||
|
||
aretreg (reg_name, sp) int *sp;
|
||
|
||
{int *ot, type_name, type, pc, reg, i;
|
||
|
||
ot = get_top (sp);
|
||
|
||
if ((reg = find_reg (reg_name)) >= 0)
|
||
while (sp<=ot)
|
||
{i = 0;
|
||
type_name = *sp++;
|
||
if ((type=typ_find(type_name)) >= 0) i=type+2;
|
||
else if ((pc=pc_find(type_name)) >= 0) i=pc+ntype+2;
|
||
if (i==0) error(2028,lineno,TIDN,type_name);
|
||
else if (retreg[i]>=0) error(2005,lineno,TIDN,type_name);
|
||
else retreg[i]=reg;
|
||
}
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
ATYPE - define register types
|
||
|
||
type - C type
|
||
sp - pointer to list of register names of that type
|
||
|
||
**********************************************************************/
|
||
|
||
atype (type_name, sp) int type_name, *sp;
|
||
|
||
{int *ot, type;
|
||
|
||
if ((type = typ_find (type_name)) < 0)
|
||
{aptype (type_name, sp);
|
||
return;
|
||
}
|
||
ot = get_top (sp);
|
||
while (sp<=ot) trdt[type] =| getrc (*sp++);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
FTYPE - finished with TYPE statement
|
||
|
||
**********************************************************************/
|
||
|
||
ftype()
|
||
|
||
{int i, r, flt_hack;
|
||
|
||
prcom ("\ttype", typname, trdt, ntype);
|
||
prcom ("pointer class", pcname, prdt, npc);
|
||
|
||
if (save_area_size <0)
|
||
{error (2014, lineno);
|
||
save_area_size=0;
|
||
}
|
||
|
||
flt_hack = 1;
|
||
if (tsize[tdouble]==tsize[tint] && tsize[tfloat]==tsize[tint]
|
||
&& talign[tdouble]<=talign[tint] && talign[tfloat]<=talign[tint])
|
||
flt_hack = 0;
|
||
|
||
/* output OFF_OK array */
|
||
|
||
gprint ("\nint (*off_ok[])() {");
|
||
i = 0;
|
||
for (r=0;r<npc;++r)
|
||
{if (pcor[r]==0)
|
||
{if (i==0) i = ++norr;
|
||
gprint ("ofok%d", i);
|
||
}
|
||
else gprint ("ofok%d", pcor[r]);
|
||
if (r<npc-1) gprint (",");
|
||
}
|
||
gprint ("};\n");
|
||
if (i) gprint ("int ofok%d(i) {return (0);}\n", i);
|
||
gprint ("\n");
|
||
|
||
outarray ("tsize", tsize, ntype);
|
||
outarray ("talign", talign, ntype);
|
||
outarray ("calign", calign, nac);
|
||
outarray ("retreg", retreg, 2+ntype+npc);
|
||
outarray ("tpoint", tpoint, ntype);
|
||
outarray ("spoint", pc_align, npc);
|
||
outarray ("trdt", trdt, ntype);
|
||
outarray ("prdt", prdt, npc);
|
||
outarray ("conf", cfp, nreg);
|
||
outint ("flt_hack", flt_hack);
|
||
gprint ("int xoploc[] {\n");
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
APTYPE - define pointer-types of registers
|
||
|
||
idn - name of pointer class
|
||
sp - pointer to list of names of registers of this type
|
||
|
||
**********************************************************************/
|
||
|
||
aptype (idn, sp) int idn, *sp;
|
||
|
||
{int pc, *ot;
|
||
|
||
ot = get_top (sp);
|
||
if ((pc = find_pc (idn)) >= 0)
|
||
while (sp <= ot) prdt[pc] =| getrc (*sp++);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
ACONF - define a conflicting pair of registers
|
||
|
||
n1 - name of one register
|
||
n2 - name of the other register
|
||
|
||
**********************************************************************/
|
||
|
||
aconf (n1, n2) int n1, n2;
|
||
|
||
{int r1, r2;
|
||
|
||
r1 = find_reg (n1);
|
||
r2 = find_reg (n2);
|
||
if (r1>=0 && r2>=0 && r1!=r2)
|
||
{cfp[r1] =| 1<<r2;
|
||
cfp[r2] =| 1<<r1;
|
||
}
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
AOPL - set a location field in DOPLOC
|
||
|
||
**********************************************************************/
|
||
|
||
aopl (o, f, w)
|
||
|
||
{doploc.flag[o] = f;
|
||
doploc.word[o] = w;
|
||
copflag = l_unknown;
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
ARTOP - set index of a abstract_machine_operator
|
||
|
||
**********************************************************************/
|
||
|
||
aamop (o)
|
||
|
||
{oplist[coplist++] = o;
|
||
amopp[o]=c_amopl;
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
AOPLOC - gprint out an OPLOC
|
||
|
||
**********************************************************************/
|
||
|
||
aoploc (c)
|
||
|
||
{int f, w, i;
|
||
|
||
gprint ("\t%d,%d,%d,", doploc.flag[0], doploc.word[0], doploc.flag[1]);
|
||
gprint ("%d,%d,%d,", doploc.word[1], doploc.flag[2], doploc.word[2]);
|
||
gprint ("%d,\n", c);
|
||
|
||
amopl[c_amopl++] = c_oploc;
|
||
c_oploc =+ 1;
|
||
f = doploc.flag[2];
|
||
if (f==3)
|
||
{f = doploc.flag[0];
|
||
w = doploc.word[0];
|
||
}
|
||
else if (f==4)
|
||
{f = doploc.flag[1];
|
||
w = doploc.word[1];
|
||
}
|
||
else w = doploc.word[2];
|
||
|
||
for (i=0;i<coplist;++i) switch (f) {
|
||
case 1: opreg[oplist[i]] =| w; break;
|
||
case 2: opmem[oplist[i]] =| w; break;
|
||
}
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
AOPE - determine an OP location expression
|
||
|
||
**********************************************************************/
|
||
|
||
aope (n) int n; /* name, either register or mem_ref */
|
||
|
||
{int j, c;
|
||
|
||
if (n == -1) /* INDIRECT */
|
||
{if (copflag==l_register) error (2018, lineno);
|
||
copflag = l_memory;
|
||
return (~0777);
|
||
}
|
||
if (n == -2) /* M */
|
||
{if (copflag==l_register) error (2018, lineno);
|
||
copflag = l_memory;
|
||
return (-1);
|
||
}
|
||
if (copflag==l_unknown || copflag==l_register)
|
||
{if ((j = reg_find (n)) >= 0)
|
||
{copflag = l_register;
|
||
return (1 << j);
|
||
}
|
||
else if ((c = rc_find(n)) >= 0)
|
||
{copflag = l_register;
|
||
return (rcp[c]);
|
||
}
|
||
else if (copflag == l_register)
|
||
{error (2027, lineno, TIDN, n);
|
||
return (0);
|
||
}
|
||
}
|
||
if ((j = find_mem (n)) >= 0)
|
||
{copflag = l_memory;
|
||
return (1 << j);
|
||
}
|
||
return (0);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
ACLOBBER - determine the clobber field
|
||
|
||
**********************************************************************/
|
||
|
||
aclobber (sp) int *sp;
|
||
|
||
{int *ot, i;
|
||
|
||
ot = get_top (sp);
|
||
i = 0;
|
||
while (sp<=ot) i =| getrc (*sp++);
|
||
return (i);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
FOPLOC - finished with OPLOCs
|
||
|
||
**********************************************************************/
|
||
|
||
foploc()
|
||
|
||
{int i;
|
||
|
||
gprint ("\t0};\n");
|
||
|
||
/* set predefined values of OPREG and OPMEM */
|
||
|
||
i = trdt[1];
|
||
opreg[e_not] = opreg[e_and] = opreg[e_or] = opreg[e_qmark] = i;
|
||
opmem[e_not] = opmem[e_and] = opmem[e_or] = opmem[e_qmark] = 0;
|
||
opreg[e_int] = opreg[e_float] = opreg[e_string] = 0;
|
||
opmem[e_int] = 1 << c_integer;
|
||
opmem[e_float] = 1 << c_float;
|
||
opmem[e_string] = 1 << c_string;
|
||
outarray ("rtopp",amopp,namop);
|
||
outarray ("rtopl",amopl,c_amopl);
|
||
outarray ("opreg",opreg,namop);
|
||
outarray ("opmem",opmem,namop);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
MPUSH - push an integer onto DEFLIST
|
||
|
||
**********************************************************************/
|
||
|
||
int mpush (a1)
|
||
|
||
{int j;
|
||
|
||
mdeflist[j = cmdf++] = a1;
|
||
if (cmdf>=mdfsz) error(4002,lineno);
|
||
return (j);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
MPSH2 - push two integers onto DEFLIST
|
||
|
||
**********************************************************************/
|
||
|
||
int mpsh2 (a1, a2)
|
||
|
||
{int j;
|
||
|
||
j = mpush (a1);
|
||
mpush (a2);
|
||
return (j);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
FMACRO - finished with MACRO specifications
|
||
|
||
**********************************************************************/
|
||
|
||
int col;
|
||
|
||
fmacro()
|
||
|
||
{int c, f, lc, *ip, *ep, flag;
|
||
char *p;
|
||
|
||
outarray ("mactab",mactab,namop);
|
||
outint ("ntype",ntype);
|
||
outint ("nmem",nmem);
|
||
outint ("nac",nac);
|
||
outint ("npc",npc);
|
||
outint ("sv_area_sz",save_area_size);
|
||
outint ("nreg",nreg);
|
||
|
||
/* gprint out MCSTORE */
|
||
|
||
lc=col=0;
|
||
flag=TRUE;
|
||
ip=mdeflist;
|
||
ep= &mdeflist[cmdf];
|
||
|
||
p = cstore;
|
||
gprint ("char mcstuff[] {\n");
|
||
|
||
while (TRUE)
|
||
{c = *p++;
|
||
if (p >= cscsp) break;
|
||
if (flag) while (ip < ep) if (*++ip == -3)
|
||
{*ip = lc;
|
||
flag = FALSE;
|
||
break;
|
||
}
|
||
|
||
again: switch(c) {
|
||
|
||
case '\\': switch (c = *p++) {
|
||
|
||
case 't': mputc ('\t'); ++lc; continue;
|
||
case 'n': mputc ('\n'); ++lc; continue;
|
||
case '#': mputs ("\\#"); lc=+2; continue;
|
||
case '\\': mputs ("\\\\"); lc=+2; continue;
|
||
case '\n': continue;
|
||
}
|
||
|
||
mputc ('\\');
|
||
++lc;
|
||
goto again;
|
||
|
||
case 0: flag=TRUE;
|
||
mputc (0);
|
||
++lc;
|
||
continue;
|
||
|
||
case '\"': mputc ('\"');
|
||
++lc;
|
||
continue;
|
||
|
||
case '\t': mputc ('\t');
|
||
++lc;
|
||
continue;
|
||
|
||
case '\n': mputc ('\n');
|
||
++lc;
|
||
continue;
|
||
|
||
case '#': c = *p++;
|
||
if (c == '\'')
|
||
{switch (c = *p++) {
|
||
case 'F':
|
||
mputs("#3,#4");
|
||
lc =+ 5;
|
||
break;
|
||
case 'S':
|
||
mputs("#5,#6");
|
||
lc =+ 5;
|
||
break;
|
||
case 'R':
|
||
mputs("#1,#2");
|
||
lc =+ 5;
|
||
break;
|
||
case 'O':
|
||
mputs("#0");
|
||
lc =+ 2;
|
||
}
|
||
continue;
|
||
}
|
||
mputc ('#');
|
||
mputc (c);
|
||
lc =+ 2;
|
||
continue;
|
||
|
||
default: mputc (c & 0177);
|
||
++lc;
|
||
}
|
||
}
|
||
|
||
gprint ("};\n");
|
||
gprint ("char *mcstore {mcstuff};\n");
|
||
outarray ("macdef",macdef,cmacro);
|
||
gprint ("char *nmacname[] {\n");
|
||
for (f=0;f<nnmacs-1;f++)
|
||
gprint ("\t\"%s\",\n",&cstore[nmacname[f]]);
|
||
gprint ("\t\"%s\"};\n",&cstore[nmacname[nnmacs-1]]);
|
||
outarray ("nmacdef",nmacdef,nnmacs);
|
||
outarray ("mdeflist",mdeflist,cmdf);
|
||
outint ("nnmacs",nnmacs);
|
||
outint ("mdflsz",cmdf);
|
||
outint ("nmacros",cmacro);
|
||
}
|
||
|
||
mputs (s) char *s;
|
||
|
||
{int c;
|
||
|
||
while (c = *s++) mputc (c);
|
||
}
|
||
|
||
mputc (c)
|
||
|
||
{if (c == 0) cputc ('0', f_out);
|
||
else
|
||
{cputc ('\'', f_out);
|
||
switch (c) {
|
||
case '\\': cputc ('\\', f_out);
|
||
cputc ('\\', f_out);
|
||
break;
|
||
case '\t': cputc ('\\', f_out);
|
||
cputc ('t', f_out);
|
||
break;
|
||
case '\n': cputc ('\\', f_out);
|
||
cputc ('n', f_out);
|
||
break;
|
||
case '\'': cputc ('\\', f_out);
|
||
cputc ('\'', f_out);
|
||
break;
|
||
default: cputc (c, f_out);
|
||
}
|
||
cputc ('\'', f_out);
|
||
}
|
||
cputc (',', f_out);
|
||
if (++col >= 12)
|
||
{cputc ('\n', f_out);
|
||
col=0;
|
||
}
|
||
else cputc (' ', f_out);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
OUTINT - write out an integer in C definition format
|
||
|
||
**********************************************************************/
|
||
|
||
outint (n,i) char n[]; int i;
|
||
|
||
{gprint ("int %s { %d };\n", n, i);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
OUTARRAY - write out integer array in C definition format
|
||
|
||
**********************************************************************/
|
||
|
||
outarray (n,v,s) char n[]; int v[],s;
|
||
|
||
{int i;
|
||
|
||
gprint ("int %s[%d] {\n",n,s);
|
||
for(i=0;i<s-1;i++)
|
||
gprint ("%d,%s",*v++,
|
||
(i%10==9)?"\n":"");
|
||
gprint ("%d};\n",*v);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
NMAC - define a named macro
|
||
|
||
**********************************************************************/
|
||
|
||
nmac(idn,def) int idn,def;
|
||
|
||
{int n;
|
||
|
||
for (n=0; n<nnmacs; n++)
|
||
if (nmacname[n]==idn)
|
||
{error(2017,lineno,TIDN,idn);
|
||
return;
|
||
}
|
||
if (nnmacs >= maxnmacs) error(4006,lineno);
|
||
nmacname[nnmacs] = idn;
|
||
nmacdef[nnmacs] = def;
|
||
++nnmacs;
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
XOPEN - Open File with Error Detection
|
||
|
||
open file given
|
||
|
||
file - name of file
|
||
mode - mode of file
|
||
opt - string of system-dependent options
|
||
|
||
If unable to open print a message and exit.
|
||
Otherwise, return the file number.
|
||
|
||
**********************************************************************/
|
||
|
||
xopen (file, mode, opt) char *file, *opt; int mode;
|
||
|
||
{int i;
|
||
|
||
i = copen (file, mode, opt);
|
||
if (i == OPENLOSS)
|
||
{cprint ("Unable to open '%s'.\n", file);
|
||
cexit (100);
|
||
}
|
||
return (i);
|
||
}
|
||
|
||
|