page@swan.ulowell.edu (Bob Page) (03/08/89)
Submitted-by: monty@brahms.Berkeley.EDU (Joe Montgomery)
Posting-number: Volume 89, Issue 30
Archive-name: languages/zc.3
# This is a shell archive.
# Remove everything above and including the cut line.
# Then run the rest of the file through sh.
#----cut here-----cut here-----cut here-----cut here----#
#!/bin/sh
# shar: Shell Archiver
# Run the following text with /bin/sh to create:
# gen.c
# gsub.c
# gunk.c
# main.c
# md.c
# nodes.c
# This archive created: Tue Mar 7 21:50:03 1989
cat << \SHAR_EOF > gen.c
/* Copyright (c) 1988 by Sozobon, Limited. Author: Johann Ruegg
*
* Permission is granted to anyone to use this software for any purpose
* on any computer system, and to redistribute it freely, with the
* following restrictions:
* 1) No charge may be made other than reasonable charges for reproduction.
* 2) Modified versions must be clearly marked as such.
* 3) The authors are not responsible for any harmful consequences
* of using this software, even if they result from defects in it.
*
* gen.c
*
* Generate code.
* Includes main routine and code generation for unary nodes
* and leafs.
* Revised: Dec 1988 Joe Montgomery
*
* Revised gen.c to call externfunref to declare all functions XREF
*
* other modules:
* Revised main.c to use Amiga File System Naming Conventions
* Added ?,C,F switches. ? help
* C force data,bss into Chip memory
* F force data,bss into Fast memory
* To be added -o switch to specify assembly output
* Revised out.c to use MOTOROLA assembly directives in order
* to be compatible with C.Gibbs a68k assembler & blink
* Added END statement
* Changed .comm label,size to label DC.x 0
* Revised d2.c so that externs are declared as XREF -----
* Revised g2.c & gen.c to declare all called functions XREF
* (will need to change this to declare only external functions)
*
*
* All changes labeled JMM
*
*/
#include <stdio.h>
#include "param.h"
#include "bstok.h"
#include "tytok.h"
#include "flags.h"
#include "nodes.h"
#include "gen.h"
NODEP strsave;
int cctest;
static int reserve;
static int tmpused;
extern xflags[];
#define debug xflags['g'-'a']
#define FAIL 0
#define OKAY 1
#define isimmed(np) ((np)->g_flags & IMMEDID)
#define isareg(np) ((np)->g_token == REGVAR && (np)->g_rno >= AREG)
#define isdreg(np) ((np)->g_token == REGVAR && (np)->g_rno < AREG)
#define istdreg(np) ((np)->g_token == REGVAR && (np)->g_rno < DRV_START)
int cookflags[] = {
0,
NOVAL_OK|CC_OK|IMMA_OK, /* FORSIDE */
IMMA_OK, /* FORPUSH */
CC_OK, /* FORCC */
IMMA_OK, /* FORIMA */
0, /* FORADR */
IMMA_OK, /* FORINIT */
0, /* IND0 */
0, /* RETSTRU */
};
extern NODE *blktab;
extern nmerrors;
genx(np, cookie)
register NODEP np;
{
int rv;
if (np == NULL) return;
if (nmerrors)
goto bad;
if (debug) {
printf("GEN enter");
printnode(np);
}
untype(np);
if (debug>1) {
printf("after UNTYPE");
printnode(np);
}
tmpused = 0;
gunk(np);
if (tmpused && tmpused > blktab->b_tsize)
blktab->b_tsize = tmpused;
if (debug > 1) {
printf("after gunk");
printnode(np);
}
order(np);
reserve = 0;
rv = eval(np, cookie);
if (rv == OKAY && debug) {
printf("GEN exit");
codeprint(np);
}
if (rv == OKAY)
rv = cookmon(np, cookie);
else
error("couldnt eval node");
freenode(np);
return rv;
bad:
freenode(np);
return FAIL;
}
eval(np, cookie)
register NODEP np;
{
int rv;
np->g_r1 = np->g_r2 = -1;
if (np == NULL) return FAIL;
switch (np->g_type) {
default:
rv = b_eval(np, cookie);
/* already did freetmps */
free1(np, np->n_left);
free1(np, np->n_right);
break;
case EV_LEFT:
rv = u_eval(np, cookie);
freetmps(np);
free1(np, np->n_left);
break;
case EV_NONE:
rv = l_eval(np);
break;
}
return rv;
}
u_eval(np, cookie)
register NODEP np;
{
int subcook = FORADR;
switch (np->g_token) {
case STAR:
subcook = FORIMA;
break;
case '!':
subcook = FORCC;
break;
}
if (eval(np->n_left, subcook) == FAIL)
return FAIL;
return u_sube(np, cookflags[cookie]);
}
u_sube(np, flags)
register NODEP np;
{
register NODEP lp = np->n_left;
long offs;
int i;
switch (np->g_token) {
case '.':
if (np->g_fldw)
return fldget(np, flags);
offs = np->g_offs;
inherit(np);
np->g_offs += offs;
return OKAY;
case STAR:
if (isimmed(lp)) {
inherit(np);
np->g_flags &= ~IMMEDID;
} else if (isareg(lp)) {
indir(np, lp->g_rno);
} else { /* NEED A temp */
if (lp->g_token == OREG && istemp(lp->g_rno))
i = lp->g_rno;
else
i = ralloc(AREG);
addcode(np, "\tmove.l\t<A,R0\n");
indir(np, i);
}
return OKAY;
case UNARY '&':
if (isimmed(lp))
warn("& ignored");
else if (lp->g_token == REGVAR)
return FAIL;
inherit(np);
np->g_flags |= IMMEDID;
if ((flags & IMMA_OK) == 0)
imm_oreg(np);
return OKAY;
case '~':
utemp(np);
addcode(np, "\tnot.S\tA\n");
cc_hack(np);
return OKAY;
case UNARY '-':
utemp(np);
addcode(np, "\tneg.S\tA\n");
cc_hack(np);
return OKAY;
case TCONV:
castgen(np);
return OKAY;
case PUSHER: /* must not be on left of assign or asn-op */
if ((lp->g_token != OREG && lp->g_token != REGVAR) ||
istemp(lp->g_rno) == 0) {
inherit(np);
return OKAY;
}
addcode(np, "\tmove.S\t<A,-(sp)\n");
return OKAY;
case '(':
if (np->g_ty == ET_A) { /* struct returned */
frc_ral(AREG);
indir(np, AREG);
} else {
frc_ral(0);
retreg(np, 0);
}
/* JMM
? added XREF statement. Note I use this regardless of whether
the function is defined in the module or not. This is horrible
and may cause problems. I will correct this when I can determine
whether the function is defined in the current module or is an
external reference. ?
*/ externfuncref(np); /* see out.c */
addcode(np, "\tjsr\t<A\n");
return OKAY;
case DOUBLE '+':
holdcon(np);
inherit(np);
addcode(np, "\tadd.S\t#K,A\n");
cc_hack(np);
return OKAY;
case DOUBLE '-':
holdcon(np);
inherit(np);
addcode(np, "\tsub.S\t#K,A\n");
cc_hack(np);
return OKAY;
case POSTINC:
if ((flags & NOVAL_OK) == 0) {
i = ralloc(0);
retreg(np, i);
addcode(np, "\tmove.S\t<A,A\n");
}
addcode(np, "\tadd.S\t#O,<A\n");
return OKAY;
case POSTDEC:
if ((flags & NOVAL_OK) == 0) {
i = ralloc(0);
retreg(np, i);
addcode(np, "\tmove.S\t<A,A\n");
}
addcode(np, "\tsub.S\t#O,<A\n");
return OKAY;
case CMPBR:
i = ralloc(0);
retreg(np, i);
addcode(np, "\tsN\tA\n\tand.w\t#1,A\n");
cc_hack(np);
return OKAY;
case '!':
if (flags & CC_OK) {
if (iscc(lp)) {
i = cctok(lp);
i = (i&1) ? i+1 : i-1; /* reverse truth */
} else {
i = B_EQ;
addcode(np, "<Q");
}
np->g_token = i + BR_TOK;
} else {
if (istdreg(lp))
i = lp->g_rno;
else
i = ralloc(0);
retreg(np, i);
if (!iscc(lp))
addcode(np, "<Q");
addcode(np, "\tseq\tA\n\tand.w\t#1,A\n");
}
return OKAY;
default:
printf("Weird u_eval %s ", np->n_name);
return FAIL;
}
}
holdcon(np)
NODEP np;
{
np->g_bsize = np->g_offs;
}
retreg(np, rno)
NODEP np;
{
np->g_token = REGVAR;
np->g_rno = rno;
}
indir(np, rno)
register NODEP np;
{
np->g_token = OREG;
np->g_offs = 0;
np->g_rno = rno;
}
inherit(np)
register NODEP np;
{
NODEP lp = np->n_left;
np->g_token = lp->g_token;
np->g_offs = lp->g_offs;
np->g_rno = lp->g_rno;
np->g_flags |= CHILDNM | (lp->g_flags & IMMEDID);
}
extern FILE *output;
cookmon(np, cookie)
register NODEP np;
{
if (np == NULL) return FAIL;
switch (cookie) {
case FORCC:
if (iscc(np)) {
outcode(np);
cctest = cctok(np);
} else {
if (np->g_token == ICON && isimmed(np)) {
cctest = np->g_offs ? B_YES : B_NO;
return OKAY;
}
outcode(np);
outsub("Q", np);
cctest = B_NE;
}
return OKAY;
case FORINIT:
if (anycode(np) == 0 && (np->g_flags & IMMEDID)) {
out_a(np, output);
return OKAY;
}
error("bad INIT expr");
return FAIL;
case IND0:
outcode(np);
if (np->g_token != REGVAR ||
np->g_rno != 0)
if (np->g_token == ICON && np->g_offs == 0 &&
isimmed(np))
outsub("\tclr.S\td0\n", np);
else
outsub("\tmove.S\tA,d0\n", np);
return OKAY;
case RETSTRU:
outcode(np);
strret(np);
}
outcode(np);
return OKAY;
}
anycode(np)
register NODEP np;
{
if (np->g_code)
return 1;
switch (np->g_type) {
case EV_NONE:
return 0;
case EV_LEFT:
return anycode(np->n_left);
case EV_RIGHT:
return anycode(np->n_right);
case EV_LR:
case EV_RL:
return anycode(np->n_left) || anycode(np->n_right);
}
}
l_eval(np)
register NODEP np;
{
int l1;
switch (np->g_token) {
case ID:
switch (np->g_sc) {
default: /* EXTERN or HERE */
np->g_token = ONAME;
np->g_offs = 0;
if (np->n_name[0] != '%')
nnmins(np, "_");
else /* hack for inline name */
strcpy(np->n_name, &np->n_name[1]);
return OKAY; /* dont free n_nmx */
case K_STATIC:
sprintf(np->n_name, "L%d", (int)np->g_offs);
np->g_offs = 0;
np->g_token = ONAME;
break;
case K_AUTO:
np->g_rno = AREG+6;
np->g_token = OREG;
break;
case K_REGISTER:
np->g_token = REGVAR;
break;
}
if (np->n_nmx) {
freenode(np->n_nmx);
np->n_nmx = NULL;
}
return OKAY;
case ICON:
np->g_flags |= IMMEDID;
return OKAY;
case FCON:
np->g_flags |= IMMEDID;
return OKAY;
case SCON:
np->g_flags |= IMMEDID;
np->g_token = ONAME;
l1 = new_lbl();
save_scon(np, l1);
sprintf(np->n_name, "L%d", l1);
return OKAY;
case OREG:
return OKAY;
}
return FAIL;
}
save_scon(np, lbl)
NODEP np;
{
NODEP tp, copyone();
tp = copyone(np);
tp->g_offs = lbl;
if (np->n_nmx) {
freenode(np->n_nmx);
np->n_nmx = NULL;
}
putlist(&strsave, tp);
}
utemp(np)
NODEP np;
{
NODEP lp = np->n_left;
int i;
if (lp->g_token == REGVAR &&
istemp(lp->g_rno)) {
inherit(np);
return;
}
i = ralloc(0);
retreg(np, i);
addcode(np, "\tmove.S\t<A,A\n");
}
freetmps(np)
register NODEP np;
{
if (np->g_r1 != -1)
rfree(np->g_r1);
if (np->g_r2 != -1)
rfree(np->g_r2);
}
free1(np, cp)
NODEP np, cp;
{
int cr;
if (cp->g_token != OREG && cp->g_token != REGVAR)
return;
cr = cp->g_rno;
if (np && cr == np->g_rno &&
(np->g_token == OREG || np->g_token == REGVAR))
return;
if (istemp(cr))
rfree(cr);
}
istemp(rno)
{
return (rno < DRV_START ||
(rno >= AREG && rno < ARV_START));
}
rfree(rno)
{
reserve &= ~(1<<rno);
}
frc_ral(rno)
{
int i;
i = (1<<rno);
if (reserve & i)
error("rno reserved! ");
reserve |= i;
}
tempr(np, type)
NODEP np;
{
int i;
i = ralloc(type);
if (np->g_r1 == -1)
np->g_r1 = i;
else
np->g_r2 = i;
return i;
}
ralloc(type)
{
int starti, endi;
register int i;
if (type == AREG) {
starti = AREG;
endi = ARV_START;
} else {
starti = 0;
endi = DRV_START;
}
for (i=starti; i<endi; i++)
if ((reserve & (1<<i)) == 0) {
reserve |= (1<<i);
return i;
}
error("Compiler failure - rallo");
return -1;
}
extern NODE *blktab;
tmp_alloc(sz)
{
tmpused += sz;
return blktab->b_size + tmpused;
}
/* fixes nodes with no code or aX is temp that are #d(aX) */
imm_oreg(np)
NODEP np;
{
char *regnm(), buf[30];
int i;
if (np->g_token != OREG)
return;
if ((np->g_flags & IMMEDID) == 0)
return;
np->g_flags &= ~IMMEDID;
if (np->g_offs == 0) { /* #(a0) -> a0 */
np->g_token = REGVAR;
return;
}
if (istemp(np->g_rno)) {
holdcon(np);
addcode(np, "\tadd\t#K,A\n");
np->g_token = REGVAR;
return;
}
sprintf(buf, "\tlea\t%d(%s),A\n", (int)np->g_offs, regnm(np->g_rno));
addcode(np, buf);
i = ralloc(AREG);
retreg(np, i);
}
castgen(tp)
register NODEP tp;
{
register NODEP np = tp->n_left;
int sz = tp->g_sz;
int i;
if (np->g_token == ICON && isimmed(np)) {
if (tp->g_ty == ET_F) {
tp->g_token = FCON;
*(float *)&tp->g_offs = (float)np->g_offs;
tp->g_flags |= IMMEDID;
} else {
inherit(tp);
i_exp(tp, np->g_sz, np->g_ty);
squish(tp);
}
} else if (np->g_token == FCON && isimmed(np)) {
if (tp->g_ty != ET_F) {
tp->g_token = ICON;
tp->g_offs = (long)*(float *)&np->g_offs;
tp->g_flags |= IMMEDID;
squish(tp);
} else {
inherit(tp);
}
} else if (sz > np->g_sz) {
if (np->g_ty == ET_U) {
i = ralloc(0);
retreg(tp, i);
addcode(tp, "\tclr.S\tA\n\tmove.<S\t<A,A\n");
} else {
if (isdreg(np)) {
inherit(tp);
} else {
i = ralloc(0);
retreg(tp, i);
addcode(tp, "\tmove.<S\t<A,A\n");
}
if (sz == 4 && np->g_sz == 1)
addcode(tp, "\text.w\tA\n\text.l\tA\n");
else
addcode(tp, "\text.S\tA\n");
}
return;
}
else if (sz < np->g_sz) {
switch (np->g_token) {
case ONAME:
case OREG:
if (isimmed(np)) {
smfudge:
i = ralloc(0);
retreg(tp, i);
addcode(tp, "\tmove.<S\t<A,A\n");
return;
}
inherit(tp);
tp->g_offs = np->g_offs + (np->g_sz - sz);
break;
case REGVAR:
if (sz == 1 && np->g_rno >= AREG)
goto smfudge;
/* fall through */
default:
inherit(tp);
}
} else
inherit(tp);
}
squish(np)
NODEP np;
{
int neg;
neg = (np->g_ty == ET_S && np->g_offs < 0);
switch (np->g_sz) {
case 1:
if (neg)
np->g_offs |= 0xffffff00L;
else
np->g_offs &= 0xff;
break;
case 2:
if (neg)
np->g_offs |= 0xffff0000L;
else
np->g_offs &= 0xffffL;
break;
}
}
i_exp(np, osz, oty)
NODEP np;
{
long l;
if (oty == ET_S && osz < np->g_sz) {
l = np->g_offs;
switch (osz) {
case 1:
l = (char) l;
break;
case 2:
l = (short) l;
break;
}
np->g_offs = l;
}
}
SHAR_EOF
cat << \SHAR_EOF > gsub.c
/* Copyright (c) 1988 by Sozobon, Limited. Author: Johann Ruegg
*
* Permission is granted to anyone to use this software for any purpose
* on any computer system, and to redistribute it freely, with the
* following restrictions:
* 1) No charge may be made other than reasonable charges for reproduction.
* 2) Modified versions must be clearly marked as such.
* 3) The authors are not responsible for any harmful consequences
* of using this software, even if they result from defects in it.
*
* gsub.c
*
* Various code generation subroutines
* Includes generation of switches and
* conversion of type lists to simple type,size.
*/
#include <stdio.h>
#include "param.h"
#include "bstok.h"
#include "tytok.h"
#include "flags.h"
#include "nodes.h"
#include "gen.h"
#define isimmed(np) ((np)->g_flags & IMMEDID)
#define isareg(np) ((np)->g_token == REGVAR && (np)->g_rno >= AREG)
extern cctest;
extern xflags[];
#define debug xflags['s'-'a']
gen_brt(np, lbl)
NODEP np;
{
p2_expr(&np);
mustty(np, R_SCALAR);
br_sub(np, 0, lbl);
}
gen_brf(np, lbl)
NODEP np;
{
p2_expr(&np);
mustty(np, R_SCALAR);
br_sub(np, 1, lbl);
}
br_sub(np, rev, lbl)
NODEP np;
{
int i;
switch (np->e_token) {
case DOUBLE '&':
br_split(np, lbl, rev);
return;
case DOUBLE '|':
br_split(np, lbl, 2+rev);
return;
}
genx(np, FORCC);
i = cctest;
if (i) {
if (rev)
/* reverse truth */
i = (i&1) ? i+1 : i-1;
out_b(i, lbl);
}
}
br_split(np, lbl, n)
NODEP np;
{
int nlbl;
if (n == 0 || n == 3)
nlbl = new_lbl();
else
nlbl = lbl;
br_sub(np->n_left, n<2, nlbl);
br_sub(np->n_right, n&1, lbl);
freeunit(np);
if (nlbl != lbl)
def_lbl(nlbl);
}
/* generate switch
np - list of nodes with value,label pairs (sorted)
dlbl - default label or -1
*/
#undef min
#undef max
gen_switch(np, odlbl)
NODEP np;
{
int n,min,max;
int dlbl;
register NODEP p;
if (debug) {
printf("gs %d ", odlbl);
printnode(np);
}
/* if no default, make one! */
if (odlbl < 0)
dlbl = new_lbl();
else
dlbl = odlbl;
n = 0;
for (p=np; p; p=p->n_next) {
if (n == 0)
min = max = p->c_casev;
else
max = p->c_casev;
n++;
}
if (n <= C_SIMPLE)
simple_sw(np,odlbl);
else if (n >= max/C_RATIO - min/C_RATIO)
table_sw(np,dlbl,min,max);
else {
half_sw(np,dlbl,max/2+min/2,n);
goto out; /* free already done */
}
freenode(np);
out:
if (odlbl < 0)
def_lbl(dlbl);
}
/* simple if-else type switch
dlbl may be -1 -> fall through
does not free np
*/
simple_sw(np, dlbl)
register NODEP np;
{
while (np) {
out_d0cmp(np->c_casev);
out_b(B_EQ, np->c_casel);
np = np->n_next;
}
if (dlbl >= 0)
out_br(dlbl);
}
/* use table switch
dlbl is not -1
does not free np
*/
table_sw(np, dlbl, min, max)
NODEP np;
{
out_d0cmp(min);
out_b(B_LT, dlbl);
out_d0cmp(max);
out_b(B_GT, dlbl);
if (min)
out_d0sub(min);
out_tsw();
while (np) {
while (min < np->c_casev) {
out_tlbl(dlbl);
min++;
}
out_tlbl(np->c_casel);
min++;
np = np->n_next;
}
}
/* cut switch in half (by value)
dlbl is not -1
will free np
*/
half_sw(np, dlbl, cut, n)
NODEP np;
{
register NODEP p, last;
int nlo, nhi;
int l1;
for (p=np; p->c_casev < cut; p = p->n_next)
last = p;
/* we KNOW both pieces are non-NULL ! */
last->n_next = NULL;
last = p;
nlo = 0;
nhi = 0;
for (p=np; p; p=p->n_next)
nlo++;
nhi = n - nlo;
if (nhi == 1) { /* switch hi and low */
p = np;
np = last;
last = p;
nlo = 1;
nhi = n-1;
}
if (nlo == 1) { /* also nhi == 1 */
out_d0cmp(np->c_casev);
out_b(B_EQ, np->c_casel);
freenode(np);
gen_switch(last, dlbl);
return;
}
l1 = new_lbl();
out_d0cmp(cut);
out_b(B_GE, l1);
gen_switch(np, dlbl);
def_lbl(l1);
gen_switch(last, dlbl);
}
istempa(np)
register NODEP np;
{
if (np->g_token == OREG && istemp(np->g_rno))
return 1;
return 0;
}
strasn(np)
NODEP np;
{
int r;
long size;
int chunk, l;
char buf[40];
int lisa, risa;
if (np->g_ty != ET_A)
return 0;
size = np->g_bsize;
if (size <= 4) { /* pretend its scalar */
np->g_sz = size;
return 0;
}
lisa = istempa(np->n_left);
risa = istempa(np->n_right);
if (lisa)
r = np->n_left->g_rno;
else
r = ralloc(AREG); /* R0 */
indir(np, r);
np->g_offs = -size;
if (size & 3)
chunk = 2;
else
chunk = 4;
if (risa)
np->g_r1 = np->n_right->g_rno;
else
tempr(np, AREG); /* R1 */
tempr(np, 0); /* R2 */
if (!lisa || np->n_left->g_offs)
addcode(np, "\tlea\t<A,R0\n");
if (!risa || np->n_right->g_offs)
addcode(np, "\tlea\t>A,R1\n");
np->g_bsize = size/chunk - 1;
addcode(np, "\tmove.w\t#K,R2\n");
l = new_lbl();
sprintf(buf, "'L%d:\tmove.%c\t(R1)+,(R0)+\n", l, chunk == 4 ?
'l' : 'w');
addcode(np, buf);
sprintf(buf, "\tdbra\tR2,'L%d\n", l);
addcode(np, buf);
return 1;
}
extern funstrl;
strret(np)
NODEP np;
{
strsub(np, funstrl);
}
strpush(np)
NODEP np;
{
strsub(np, 0);
}
strsub(np, tolbl)
register NODEP np;
{
long size;
int chunk, l;
char buf[40];
char *frstr;
size = np->g_bsize;
if (size & 3)
chunk = 2;
else
chunk = 4;
tempr(np, 0);
/* set up 'from' address */
if (np->g_token == OREG && istemp(np->g_rno)) {
frstr = "R0";
if (np->g_offs)
addcode(np, "\tlea\tA,R0\n");
} else {
frstr = "a1";
addcode(np, "\tlea\tA,a1\n");
}
/* set up 'to' address */
if (tolbl) {
sprintf(buf, "\tmove.l\t#'L%d,a2\n", tolbl);
addcode(np, buf);
} else {
sprintf(buf, "\tsub\t#%d,sp\n", (int)size);
addcode(np, buf);
addcode(np, "\tmove.l\tsp,a2\n");
}
/* generate copy loop */
np->g_bsize = size/chunk - 1;
addcode(np, "\tmove.w\t#K,R1\n");
l = new_lbl();
sprintf(buf, "'L%d:\tmove.%c\t(%s)+,(a2)+\n", l, chunk == 4 ?
'l' : 'w', frstr);
addcode(np, buf);
sprintf(buf, "\tdbra\tR1,'L%d\n", l);
addcode(np, buf);
}
specasn(np, flags)
NODEP np;
{
NODEP lp = np->n_left, rp = np->n_right;
int r;
if (rp->g_token == ICON && isimmed(rp)) {
rinherit(np);
if (rp->g_offs == 0 && !isareg(rp))
addcode(np, "\tclr.S\t<A\n");
else
addcode(np, "\tmove.S\t>A,<A\n");
return 1;
}
if (rp->g_token == OREG && isimmed(rp)) {
rp->g_flags &= ~IMMEDID;
if (isareg(lp)) {
inherit(np);
addcode(np, "\tlea\t>A,A\n");
} else {
r = ralloc(AREG);
retreg(np, r);
addcode(np, "\tlea\t>A,A\n");
addcode(np, "\tmove.l\tA,<A\n");
}
return 1;
}
return 0;
}
untype(np)
register NODEP np;
{
if (np == NULL || np->n_tptr == NULL) {
printf("? NULL untype ");
return;
}
switch (np->e_type) {
case E_BIN:
untype(np->n_right);
/* fall through */
case E_UNARY:
if (np->e_token == '.' && np->e_fldw) {
np->g_fldw = np->e_fldw;
np->g_fldo = np->e_fldo;
} else
np->g_fldw = 0;
untype(np->n_left);
}
get_tyinf(np);
if ((np->n_flags & N_COPYT) == 0)
freenode(np->n_tptr);
np->n_tptr = NULL; /* is g_code */
np->g_betw = NULL;
}
static char bty[] = {
ET_U, ET_U, ET_S, ET_S, ET_U, ET_S, ET_S, ET_F, ET_F, 0
};
static char bsz[] = {
SIZE_C, SIZE_L, SIZE_L, SIZE_S, SIZE_U,
SIZE_I, SIZE_C, SIZE_F, SIZE_D, 0
};
get_tyinf(np)
register NODEP np;
{
NODEP tp = np->n_tptr;
int n;
long offs;
offs = np->e_offs;
/* inherit name,token,left,right,nmx from common
and token, flags, type, sc from enode */
switch (tp->t_token) {
case K_STRUCT:
case K_UNION:
np->g_bsize = tp->t_size;
np->g_ty = ET_A;
np->g_sz = 0;
break;
case '(':
break;
case STAR:
np->g_ty = ET_U;
np->g_sz = SIZE_P;
break;
default:
n = tp->t_token-FIRST_BAS;
np->g_ty = bty[n];
np->g_sz = bsz[n];
}
np->g_offs = offs; /* different place */
}
addcode(np, s)
register NODEP np;
char *s;
{
NODEP tp;
int i, c;
while (np->g_code)
np = np->g_code;
tp = allocnode();
np->g_code = tp;
np->n_flags &= ~N_COPYT;
i = strlen(s);
if (i < NMXSIZE) { /* fits in one */
strcpy(tp->n_name, s);
return;
}
/* need to split it */
i = NMXSIZE-1;
c = s[i-1];
if (c == '<' || c == '>' || (c>='A' && c<='Z')) /* special */
i--;
strncpy(tp->n_name, s, i);
tp->n_name[i] = 0;
addcode(tp, &s[i]);
}
SHAR_EOF
cat << \SHAR_EOF > gunk.c
/* Copyright (c) 1988 by Sozobon, Limited. Author: Johann Ruegg
*
* Permission is granted to anyone to use this software for any purpose
* on any computer system, and to redistribute it freely, with the
* following restrictions:
* 1) No charge may be made other than reasonable charges for reproduction.
* 2) Modified versions must be clearly marked as such.
* 3) The authors are not responsible for any harmful consequences
* of using this software, even if they result from defects in it.
*
* gunk.c
*
* Transformations on expression trees
* Most of this stuff is because we cant handle
* floats, long mul/div, or fields directly.
*/
#include <stdio.h>
#include "param.h"
#include "bstok.h"
#include "tytok.h"
#include "flags.h"
#include "nodes.h"
#include "gen.h"
NODEP copyone();
#define gwiden(x) ((x)==1 ? 2 : (x))
#define isfield(np) ((np)->g_token == '.' && (np)->g_fldw)
NODEP npar1, npar2, npar3;
char *spar1, *spar2, *spar3;
int ipar1, ipar2, ipar3;
struct rule {
int (*match)(); /* test for transformation needed */
int (*rewri)(); /* rewrite function */
};
int m_unfold(), unfold(), m_cast(), cast(), m_inline(), inline();
int m_hardas(), hardas(), m_fcmp(), fcmp(), m_md_shf(), md_shf();
int m_eident(), eident(), m_incdec(), incdec(), m_fldas(), fldas();
struct rule gunktbl[] = {
{m_unfold, unfold},
{m_cast, cast},
{m_md_shf, md_shf},
{m_eident, eident},
{m_incdec, incdec},
{m_hardas, hardas},
{m_inline, inline}, /* must cast before inline */
{m_fcmp, fcmp},
{m_fldas, fldas},
{0}
};
int anygunk;
gunk(np)
NODEP np;
{
do {
anygunk = 0;
gunks(np);
} while (anygunk);
}
gunks(np)
register NODEP np;
{
switch (np->g_type) {
case E_BIN:
gunks(np->n_right);
case E_UNARY:
gunks(np->n_left);
}
gunk1(np);
}
gunk1(np)
NODEP np;
{
register struct rule *p;
for (p=gunktbl; p->match; p++)
if ((*p->match)(np)) {
anygunk++;
(*p->rewri)(np);
return;
}
}
/*
* Change pointer arithmetic to equivalent trees
* (main thing is to mult or div by object size)
*/
m_unfold(np)
NODEP np;
{
switch (np->g_token) {
case PTRADD:
ipar1 = '+';
return 1;
case PTRSUB:
ipar1 = '-';
return 1;
case PTRDIFF:
ipar1 = 0;
return 1;
case ASSIGN PTRADD:
ipar1 = ASSIGN '+';
return 1;
case ASSIGN PTRSUB:
ipar1 = ASSIGN '-';
return 1;
}
return 0;
}
unfold(np)
NODEP np;
{
if (ipar1) {
ins_mul(np, np->g_offs);
np->g_token = ipar1;
} else {
ins_div(np, np->g_offs);
}
}
NODEP
newgcon(kon, ty, sz)
long kon;
{
register NODEP kp;
kp = allocnode();
kp->g_token = ICON;
sprintf(kp->n_name, "%ld", kon);
kp->g_offs = kon;
kp->g_type = E_LEAF;
kp->g_ty = ty;
kp->g_sz = sz;
return kp;
}
ins_mul(np, kon)
NODEP np;
long kon;
{
NODEP rp = np->n_right;
register NODEP mp, kp;
if (kon == 1)
return;
if (rp->g_token == ICON) {
rp->g_offs *= kon;
rp->g_sz = gwiden(rp->g_sz);
return;
}
mp = allocnode();
mp->g_token = '*';
sprintf(mp->n_name, "p*");
mp->g_type = E_BIN;
mp->g_ty = rp->g_ty;
mp->g_sz = gwiden(rp->g_sz);
kp = newgcon(kon, mp->g_ty, mp->g_sz);
mp->n_right = kp;
mp->n_left = np->n_right;
np->n_right = mp;
}
ins_div(np, kon)
register NODEP np;
long kon;
{
register NODEP tp, kp;
kp = newgcon(kon, np->g_ty, np->g_sz);
tp = copyone(np);
tp->g_token = '-';
tp->n_left = np->n_left;
tp->n_right = np->n_right;
tp->g_sz = SIZE_P;
tp->g_ty = ET_U;
np->n_left = tp;
np->n_right = kp;
np->g_type = E_BIN;
np->g_token = '/';
sprintf(np->n_name, "p/");
}
#define CAST_LN 1
#define CAST_RN 2
#define CAST_LLONG 3
/*
* Insert needed (implied) casts
*/
m_cast(np)
NODEP np;
{
NODEP lp = np->n_left;
switch (np->g_type) {
case E_LEAF:
return 0;
case E_BIN:
return bm_cast(np);
}
/* must be unary */
switch (np->g_token) {
case UNARY '-':
case '~':
return castup(lp, np, CAST_LN);
case TCONV:
return fcastlong(np);
}
return 0;
}
bm_cast(np)
register NODEP np;
{
NODEP lp = np->n_left, rp = np->n_right;
if (isassign(np->g_token)) {
if (castup(rp, lp, CAST_RN))
return 1;
if (castmagic(rp, lp, CAST_RN, np->g_token - (ASSIGN 0)))
return 1;
return 0;
}
switch (np->g_token) {
case '=':
return castany(rp, lp, CAST_RN);
case '<':
case '>':
case DOUBLE '=':
case NOTEQ:
case LTEQ:
case GTEQ:
if (castup(lp, rp, CAST_LN))
return 1;
return castup(rp, lp, CAST_RN);
case '(':
case ',':
case '?':
case DOUBLE '&':
case DOUBLE '|':
return 0;
case DOUBLE '<':
case DOUBLE '>':
if (castup(lp, np, CAST_LN))
return 1;
return castany(rp, np, CAST_RN);
default:
if (castup(lp, np, CAST_LN))
return 1;
return castup(rp, np, CAST_RN);
}
return 0;
}
fcastlong(np)
NODEP np;
{
NODEP lp = np->n_left;
if (red_con(lp))
return 0;
if (np->g_ty == ET_F && lp->g_ty != ET_F && lp->g_sz != SIZE_L) {
ipar1 = CAST_LLONG;
return 1;
}
if (lp->g_ty == ET_F && np->g_ty != ET_F && np->g_sz != SIZE_L) {
ipar1 = CAST_LLONG;
return 1;
}
return 0;
}
castup(lowp, hip, par)
NODEP lowp, hip;
{
if (stronger(hip, lowp)) {
ipar1 = par;
npar1 = hip;
return 1;
}
return 0;
}
castmagic(p1, p2, par, tok)
NODEP p1, p2;
{
if (xstronger(p1,p2) && magicop(tok)) {
ipar1 = par;
npar1 = p2;
return 1;
}
return 0;
}
castany(p1, p2, par)
NODEP p1, p2;
{
if (p1->g_sz != p2->g_sz ||
((p1->g_ty == ET_F) != (p2->g_ty == ET_F))) {
ipar1 = par;
npar1 = p2;
return 1;
}
return 0;
}
cast(np)
NODEP np;
{
switch (ipar1) {
case CAST_LN:
castsub(npar1->g_ty, npar1->g_sz, &np->n_left, np->n_left);
break;
case CAST_RN:
castsub(npar1->g_ty, npar1->g_sz, &np->n_right, np->n_right);
break;
case CAST_LLONG:
castsub(ET_S, SIZE_L, &np->n_left, np->n_left);
break;
}
}
castsub(ty, sz, npp, np)
NODEP *npp, np;
{
register NODEP tp;
/* ICON cast optimization */
if (np->g_token == ICON &&
np->g_ty == ty &&
np->g_sz < sz) {
np->g_sz = sz;
return;
}
tp = allocnode();
tp->g_token = TCONV;
strcpy(tp->n_name, "cast up");
tp->n_left = np;
*npp = tp;
tp->g_sz = sz;
tp->g_ty = ty;
tp->g_type = E_UNARY;
}
/*
* Change stuff computer cant do to calls to inline functions
* (in this case, all floats and long *%/)
*/
m_inline(np)
NODEP np;
{
int isfloat, isuns;
if (np->g_type == E_LEAF)
return 0;
isfloat = (np->g_ty == ET_F);
isuns = (np->g_ty == ET_U);
if (np->g_type == E_UNARY) {
switch (np->g_token) {
case UNARY '-':
if (!isfloat) return 0;
spar1 = "%fpneg";
return 1;
case TCONV:
if ((np->n_left->g_ty == ET_F) == isfloat)
return 0;
if (red_con(np->n_left))
return 0;
spar1 = isfloat ? "fpltof" : "fpftol";
return 1;
}
return 0;
}
if (np->g_sz != 4) /* longs or floats only */
return 0;
switch (np->g_token) {
case '*':
spar1 = isfloat ? "%fpmul" : (isuns ? "%lmulu" : "%lmul");
return 1;
case '/':
spar1 = isfloat ? "%fpdiv" : (isuns ? "%ldivu" : "%ldiv");
return 1;
case '+':
if (!isfloat) return 0;
spar1 = "%fpadd";
return 1;
case '-':
if (!isfloat) return 0;
spar1 = "%fpsub";
return 1;
case '%':
spar1 = isuns ? "%lremu" : "%lrem";
return 1;
}
return 0;
}
inline(np)
NODEP np;
{
register NODEP nmp, cmap;
int isunary;
isunary = (np->g_type == E_UNARY);
if (isunary) {
np->n_right = np->n_left;
np->g_type = E_BIN;
} else {
cmap = copyone(np);
cmap->n_left = np->n_left;
cmap->n_right = np->n_right;
np->n_right = cmap;
cmap->g_token = ',';
cmap->g_offs = 2;
strcpy(cmap->n_name, ",inl");
}
nmp = allocnode();
np->n_left = nmp;
np->g_token = '(';
strcpy(np->n_name, "inline");
nmp->g_token = ID;
strcpy(nmp->n_name, spar1);
}
/*
* Transform hard ++,-- to equivalent trees
* (for us, floats or fields)
*/
m_incdec(np)
NODEP np;
{
if (np->g_type != E_UNARY)
return 0;
if (np->g_ty != ET_F && !isfield(np->n_left))
return 0;
ipar2 = 0;
switch (np->g_token) {
case DOUBLE '+':
ipar1 = ASSIGN '+';
spar1 = "+=";
break;
case DOUBLE '-':
ipar1 = ASSIGN '-';
spar1 = "-=";
break;
case POSTINC:
ipar1 = DOUBLE '+';
spar1 = "++";
ipar2 = '-';
spar2 = "-";
break;
case POSTDEC:
ipar1 = DOUBLE '-';
spar1 = "--";
ipar2 = '+';
spar2 = "+";
break;
default:
return 0;
}
return 1;
}
incdec(np)
register NODEP np;
{
NODEP t1;
NODEP onep;
onep = newgcon(1L, ET_S, SIZE_I);
if (ipar2 == 0) { /* easy case, ++X becomes X+=1 */
np->g_token = ipar1;
np->g_type = E_BIN;
np->n_right = onep;
strcpy(np->n_name, spar1);
return;
}
/* hard case, X++ becomes (++X - 1) */
t1 = copyone(np);
t1->n_left = np->n_left;
np->n_left = t1;
np->n_right = onep;
np->g_type = E_BIN;
np->g_token = ipar2;
strcpy(np->n_name, spar2);
t1->g_token = ipar1;
strcpy(t1->n_name, spar1);
}
/*
* Transform hard op= trees to equivalent '=' trees
* (in this case, all floats, long or char *%/, fields)
*/
m_hardas(np)
NODEP np;
{
int op;
if (np->g_type != E_BIN)
return 0;
op = np->g_token;
if (isassign(op))
op -= ASSIGN 0;
else
return 0;
if (xstronger(np->n_right, np->n_left) &&
magicop(op) == 0)
return 1;
if (np->g_ty == ET_F || isfield(np->n_left))
return 1;
if (np->g_sz == 4 || np->g_sz == 1)
switch (op) {
case '*':
case '/':
case '%':
return 1;
}
return 0;
}
hardas(np)
NODEP np;
{
NODEP opp, newl;
NODEP copynode();
if (m_vhard(np)) {
vhard(np);
return;
}
opp = copyone(np);
newl = copynode(np->n_left);
opp->n_right = np->n_right;
np->n_right = opp;
opp->n_left = newl;
np->g_token = '=';
strcpy(np->n_name, "unfold");
opp->g_token -= (ASSIGN 0);
bmaxty(opp);
}
/*
* Check for lhs of op= that have side effects or are complex
*/
m_vhard(np)
NODEP np;
{
NODEP lp = np->n_left;
while (lp->g_token == '.')
lp = lp->n_left;
if (lp->g_token != STAR)
return 0;
return isvhard(lp->n_left);
}
isvhard(np)
NODEP np;
{
NODEP rp;
descend:
switch (np->g_type) {
case E_LEAF:
return 0;
case E_UNARY:
switch (np->g_token) {
case '(':
case DOUBLE '+':
case DOUBLE '-':
case POSTINC:
case POSTDEC:
return 1;
default:
np = np->n_left;
goto descend;
}
case E_BIN:
switch (np->g_token) {
case '+':
case '-':
rp = np->n_right;
if (rp->g_token == ICON && np->g_ty != ET_F) {
np = np->n_left;
goto descend;
}
/* fall through */
default:
return 1;
}
}
}
vhard(np)
NODEP np;
{
NODEP starp;
NODEP atree, btree;
NODEP t1, t2;
register NODEP opp;
NODEP tmp_var();
starp = np->n_left;
while (starp->g_token == '.')
starp = starp->n_left;
atree = starp->n_left;
btree = np->n_right;
t1 = tmp_var(ET_U, SIZE_P);
t2 = copyone(t1);
starp->n_left = t2;
opp = copyone(t1);
opp->g_type = E_BIN;
opp->g_token = '=';
strcpy(opp->n_name, "=");
opp->n_right = atree;
opp->n_left = t1;
comma_r(np, opp);
}
comma_r(topp, lp)
NODEP topp, lp;
{
register NODEP newp;
newp = copyone(topp);
topp->g_token = ',';
strcpy(topp->n_name, ",");
newp->n_left = topp->n_left;
newp->n_right = topp->n_right;
topp->n_left = lp;
topp->n_right = newp;
}
NODEP
tmp_var(ty, sz)
{
register NODEP t1;
t1 = allocnode();
t1->g_token = OREG;
t1->g_type = E_LEAF;
t1->g_rno = AREG+6;
t1->g_ty = ty;
t1->g_sz = sz;
t1->g_offs = - tmp_alloc(sz);
strcpy(t1->n_name, "tmp_v");
return t1;
}
/* X op= Y where Y's type is stronger than X's
either unfold it or (default)
cast Y to weaker type (+ or -)
*/
magicop(op)
{
switch (op) {
case '+':
case '-':
case DOUBLE '<':
case DOUBLE '>':
case '&':
case '|':
case '^':
return 1;
}
return 0;
}
stronger(xp, yp)
NODEP xp, yp;
{
if (xp->g_sz > yp->g_sz ||
(xp->g_sz == yp->g_sz && xp->g_ty > yp->g_ty))
return 1;
return 0;
}
/* stronger with ET_S and ET_U considered equal */
xstronger(xp, yp)
NODEP xp, yp;
{
if (xp->g_sz > yp->g_sz ||
(xp->g_ty == ET_F && yp->g_ty != ET_F))
return 1;
return 0;
}
/* give np the type of the stronger child */
bmaxty(np)
NODEP np;
{
NODEP lp = np->n_left, rp = np->n_right;
if (stronger(lp, rp))
rp = lp;
np->g_ty = rp->g_ty;
np->g_sz = gwiden(rp->g_sz);
}
/*
* Change floating compares to inline call
*/
m_fcmp(np)
NODEP np;
{
/* already made L and R same with casts */
if (np->g_type != E_BIN || np->n_left->g_ty != ET_F)
return 0;
switch (np->g_token) {
case '<':
spar2 = "lt";
return 1;
case '>':
spar2 = "gt";
return 1;
case DOUBLE '=':
spar2 = "eq";
return 1;
case NOTEQ:
spar2 = "ne";
return 1;
case GTEQ:
spar2 = "ge";
return 1;
case LTEQ:
spar2 = "le";
return 1;
}
return 0;
}
fcmp(np)
register NODEP np;
{
register NODEP tp;
spar1 = "%fpcmp";
inline(np);
tp = copyone(np);
tp->n_left = np->n_left;
tp->n_right = np->n_right;
np->n_left = tp;
np->n_right = NULL;
np->g_type = E_UNARY;
np->g_token = CMPBR;
sprintf(np->n_name, spar2);
}
/*
* Remove useless binary operations with identity constant
*/
m_eident(np)
NODEP np;
{
NODEP rp = np->n_right;
long l;
int i, op;
if (np->g_type != E_BIN)
return 0;
if (np->g_ty == ET_F)
return 0;
while (rp->g_token == TCONV && rp->g_ty != ET_F)
rp = rp->n_left;
if (rp->g_token != ICON)
return 0;
l = rp->g_offs;
if (l < 0 || l > 1)
return 0;
op = np->g_token;
if (isassign(op))
op -= ASSIGN 0;
switch (op) {
case '+':
case '-':
case DOUBLE '<':
case DOUBLE '>':
case '|':
case '^':
i = 0; break;
case '*':
case '/':
i = 1; break;
default:
return 0;
}
if (l != i)
return 0;
return 1;
}
eident(np)
NODEP np;
{
NODEP lp = np->n_left, rp = np->n_right;
freenode(rp);
lcpy(np, lp, sizeof(NODE)/4);
freeunit(lp);
}
#define MAXLOOK 8
/*
* Change certain mult or div to equivalent shift
*/
m_md_shf(np)
NODEP np;
{
NODEP rp = np->n_right;
long l;
register i, j;
if (np->g_type != E_BIN)
return 0;
if (np->g_ty == ET_F)
return 0;
while (rp->g_token == TCONV && rp->g_ty != ET_F)
rp = rp->n_left;
if (rp->g_token != ICON)
return 0;
switch (np->g_token) {
case '*':
ipar1 = DOUBLE '<'; break;
case '/':
ipar1 = DOUBLE '>'; break;
case ASSIGN '*':
ipar1 = ASSIGN DOUBLE '<'; break;
case ASSIGN '/':
ipar1 = ASSIGN DOUBLE '>'; break;
default:
return 0;
}
l = rp->g_offs;
if (l < 2 || l > (1<<MAXLOOK))
return 0;
i = l;
for (j=1; j<=MAXLOOK; j++)
if (i == 1<<j) {
ipar2 = j;
return 1;
}
return 0;
}
md_shf(np)
NODEP np;
{
NODEP rp = np->n_right;
np->g_token = ipar1;
while (rp->g_token == TCONV)
rp = rp->n_left;
rp->g_offs = ipar2;
}
m_fldas(np)
NODEP np;
{
if (np->g_type != E_BIN)
return 0;
if (np->g_token == '=' && isfield(np->n_left))
return 1;
}
fldas(np)
register NODEP np;
{
NODEP lp = np->n_left;
np->g_fldw = lp->g_fldw;
np->g_fldo = lp->g_fldo;
np->g_token = FIELDAS;
lp->g_fldw = 0;
}
red_con(np)
register NODEP np;
{
while (np->g_token == TCONV)
np = np->n_left;
if (np->g_token == ICON || np->g_token == FCON)
return 1;
return 0;
}
SHAR_EOF
cat << \SHAR_EOF > main.c
/* Copyright (c) 1988 by Sozobon, Limited. Author: Johann Ruegg
*
* Permission is granted to anyone to use this software for any purpose
* on any computer system, and to redistribute it freely, with the
* following restrictions:
* 1) No charge may be made other than reasonable charges for reproduction.
* 2) Modified versions must be clearly marked as such.
* 3) The authors are not responsible for any harmful consequences
* of using this software, even if they result from defects in it.
*
* main.c
*
* Main routine, error handling, keyword lookup.
*
*
* Revised: Dec 1988 Joe Montgomery
*
* Revised main.c to use Amiga File System Naming Conventions
* Added ?,C,F switches. ? help
* C force data,bss into Chip memory
* F force data,bss into Fast memory
* To be added -o switch to specify assembly output
*
* other modules:
* Revised out.c to use MOTOROLA assembly directives in order
* to be compatible with C.Gibbs a68k assembler & blink
* Added END statement
* Changed .comm label,size to label DC.x 0
* Revised d2.c so that externs are declared as XREF -----
* Revised g2.c & gen.c to declare all called functions XREF
* (will need to change this to declare only external functions)
*
*
* All changes labeled JMM
*/
#include <stdio.h>
#include "param.h"
#include "nodes.h"
#include "tok.h"
extern short usechipmemory,usefastmemory;
int lineno;
int nmerrors;
int oflags[26];
int xflags[26];
int pflag = 0; /* enable profiling */
static int anydebug;
#define debug oflags['z'-'a']
FILE *input;
FILE *output;
#if CC68
FILE *fopenb();
#define fopen fopenb
#endif
char *inname;
#if NEEDBUF
char my_ibuf[BUFSIZ];
#endif
NODEP cur;
/* JMM changed defines to be compatible with AMIGA */
static char *defines[] = {
"MC68000",
"mc68000",
"SOZOBON",
"MCH_AMIGA",
"AmigaDOS",
NULL
};
static char Version[] =
"zc: Amiga Version 1.01 Copyright (c) 1988 by Sozobon, Limited.\n";
static char Version2[] =
" modified by J.Montgomery. Now generates Motorola compatible \n";
static char Version3[] =
" assembly code.\n";
extern char *outfilename,*errorfile;
main(argc, argv)
char **argv;
{
char *p, *getenv();
int shownames;
int i;
/* JMM added switches to force data,bss into chip or fast memory */
usefastmemory = 0;
usechipmemory = 0; /* don't force data into either chip or fast*/
outfilename = (char *) NULL;
/* JMM force hcc to always print out version */
printf(Version);
if (sizeof(NODE) & 3) {
printf("sizeof NODE not mult of 4\n");
exit(1);
}
/*
* Define the "built-in" macros
*/
for (i=0; defines[i] != NULL; i++)
optdef(defines[i]);
/*
* Parse the INCLUDE environment variable, if present.
*/
if ((p = getenv("INCLUDE")) != NULL){
if( doincl(p) == 1 )exit(0);
}
shownames = 0;
if (isatty(0)) {
write(1, "\33v", 2);
setbuf(stdout, NULL);
}
/* put author here */
while (argc-- > 1) {
argv++;
if(argv[0][0] == '?') {
doopt(&argv[0][0]);
exit(1);
}
if(argv[0][0] == '-')
doopt(&argv[0][1]);
#if CC68
else if (argv[0][0] == '+') {
upstr(&argv[0][1]);
doopt(&argv[0][1]);
}
#endif
else {
if (argc > 1 || shownames) {
shownames++;
printf("%s:\n", argv[0]);
}
if (input != NULL)
fclose(input);
input = fopen(argv[0], ROPEN);
if (input == NULL) {
printf("Cant open %s\n", argv[0]);
exit(1);
}
#if NEEDBUF
setbuf(input, my_ibuf);
#endif
inname = argv[0];
dofile();
}
}
if (input == NULL) {
input = stdin;
output = stdout;
inname = "<STDIN>";
dofile();
}
exit(0);
}
doincl(s)
char *s;
{
char *malloc(), *strcpy();
char buf[256];
char dir[128];
register char *p;
strcpy(buf, s);
/*
* Convert ',' and ';' to nulls
*/
for (p=buf; *p != '\0' ;p++)
if (*p == ',' || *p == ';')
*p = '\0';
p[1] = '\0'; /* double null terminated */
/*
* Grab each directory, make sure it ends with a slash,
* and add it to the directory list.
*/
for (p=buf; *p != '\0' ;p++) {
strcpy(dir, p);
/* JMM use Amiga file naming conventions */
if (dir[strlen(dir)-1] != '/' && dir[strlen(dir)-1] != ':')
strcat(dir, "/");
optincl( strcpy(malloc((unsigned) (strlen(dir) + 1)), dir) );
while (*p != '\0')
p++;
}
}
extern int nodesmade, nodesavail;
extern NODEP deflist[], symtab[], tagtab;
extern NODEP strsave;
extern int level;
dofile()
{
char *scopy();
int i;
out_start(inname);
inname = scopy(inname);
lineno = 1;
nmerrors = 0;
advnode();
level = 0;
program();
dumpstrs(strsave);
out_end();
if (cur && cur->e_token == EOFTOK)
freenode(cur);
sfree(inname);
for (i=0; i<NHASH; i++) {
if (debug>1 && deflist[i]) {
printf("defines[%d]", i);
printlist(deflist[i]);
}
freenode(deflist[i]);
deflist[i] = NULL;
if (debug && symtab[i]) {
printf("gsyms[%d]", i);
printlist(symtab[i]);
}
freenode(symtab[i]);
symtab[i] = NULL;
}
if (debug) {
printf("structs");
printlist(tagtab);
}
freenode(tagtab);
tagtab = NULL;
freenode(strsave);
strsave = NULL;
if (nmerrors) {
printf("%d errors\n", nmerrors);
exit(1);
}
if (nodesmade != nodesavail) {
printf("lost %d nodes!!!\n", nodesmade-nodesavail);
exit(1);
}
/*
printf("Space = %ldK\n", ((long)nodesavail*sizeof(NODE))/1024);
*/
}
dooutfile(s)
char *s;
{
char *malloc(), *strcpy();
outfilename = strcpy(malloc((unsigned)(strlen(s) + 1)), s );
}
doerrorfile(s)
char *s;
{
char *malloc(),*strcpy();
errorfile = strcpy(malloc((unsigned)(strlen(s) + 1)), s);
}
doopt(s)
char *s;
{
register char c;
while ((c = *s++)) {
#ifdef DEBUG
if (c >= 'a' && c <='z') {
oflags[c-'a']++;
anydebug++;
} else
#endif
if ( (c >= 'A' && c <= 'Z') || c == '?') {
switch (c) {
case 'D':
optdef(s);
return;
case 'U':
optundef(s);
return;
case 'I':
doincl(s);
return;
case 'P':
pflag = 1;
continue;
case 'V':
printf("%s %s",Version2,Version3);
continue;
/* JMM added ?,C,F,O,E switches */
case 'E': /* specify error file */
doerrorfile(s);
return(1);
case 'O':
dooutfile(s);
return(1);
case 'C':
if(usefastmemory){
printf(" Can't use both Chip & Fast memory\n");
return(1);
}
usechipmemory = 1;
continue;
case 'F':
if(usechipmemory){
printf(" Can't use both Chip & Fast memory\n");
return(1);
}
usefastmemory = 1;
continue;
case '?':
printf("%s %s",Version2,Version3);
printf(" The Correct Syntax is \n");
printf("zc [FLAGS] SOURCEFILE \n");
printf(" The valid compiler flags are : \n");
printf("\n -Dxxxx Define xxxx\n -Uxxxx Undefine xxxx\n");
printf(" -Ixxxx Include Directory = xxxx\n -P profiler\n");
printf(" -Oxxxx outputfile name = xxxx\n");
printf(" -V display compiler version\n -? Help\n");
printf(" -C force Data,Bss into Chip memory \n");
printf(" -F force Data,Bss into Fast memory \n");
return(1);
continue;
}
#ifdef DEBUG
xflags[c-'A']++;
anydebug++;
#endif
}
}
return(0);
}
errors(s,t)
char *s, *t;
{
optnl();
printf("error in %s on line %d: %s %s\n", inname, lineno, s,t);
nmerrors++;
}
errorn(s,np)
char *s;
NODE *np;
{
optnl();
printf("error in %s on line %d: %s ", inname, lineno, s);
put_nnm(np);
putchar('\n');
nmerrors++;
}
error(s)
char *s;
{
optnl();
printf("error in %s on line %d: %s\n", inname, lineno, s);
nmerrors++;
}
warns(s,t)
char *s, *t;
{
optnl();
printf("warning in %s on line %d: %s %s\n", inname, lineno, s,t);
}
warnn(s,np)
char *s;
NODE *np;
{
optnl();
printf("warning in %s on line %d: %s ", inname, lineno, s);
put_nnm(np);
putchar('\n');
}
warn(s)
char *s;
{
optnl();
printf("warning in %s on line %d: %s\n", inname, lineno, s);
}
fatals(s,t)
char *s, *t;
{
optnl();
printf("fatal error in %s on line %d: %s %s\n", inname, lineno, s,t);
exit(1);
}
fataln(s,np)
char *s;
NODE *np;
{
optnl();
printf("fatal error in %s on line %d: %s ", inname, lineno, s);
put_nnm(np);
putchar('\n');
exit(1);
}
fatal(s)
char *s;
{
optnl();
printf("fatal error in %s on line %d: %s\n", inname, lineno, s);
exit(1);
}
static
optnl()
{
if (anydebug)
putchar('\n');
}
struct kwtbl {
char *name;
int kwval;
int kflags;
} kwtab[] = {
/* must be sorted */
{"asm", K_ASM},
{"auto", K_AUTO},
{"break", K_BREAK},
{"case", K_CASE},
{"char", K_CHAR},
{"continue", K_CONTINUE},
{"default", K_DEFAULT},
{"do", K_DO},
{"double", K_DOUBLE},
{"else", K_ELSE},
{"enum", K_ENUM},
{"extern", K_EXTERN},
{"float", K_FLOAT},
{"for", K_FOR},
{"goto", K_GOTO},
{"if", K_IF},
{"int", K_INT},
{"long", K_LONG},
{"register", K_REGISTER},
{"return", K_RETURN},
{"short", K_SHORT},
{"sizeof", K_SIZEOF},
{"static", K_STATIC},
{"struct", K_STRUCT},
{"switch", K_SWITCH},
{"typedef", K_TYPEDEF},
{"union", K_UNION},
{"unsigned", K_UNSIGNED},
{"void", K_VOID},
{"while", K_WHILE},
{0,0}
};
#define FIRST_C 'a'
#define LAST_C 'z'
struct kwtbl *kwstart[LAST_C-FIRST_C+1];
kw_init()
{
register struct kwtbl *p;
register c;
for (p=kwtab; p->name; p++) {
c = p->name[0];
if (kwstart[c-FIRST_C] == 0)
kwstart[c-FIRST_C] = p;
}
}
kw_tok(tp)
NODE *tp;
{
register struct kwtbl *kp;
register char *nm;
register i;
static first = 0;
nm = tp->n_name;
if (first == 0) {
kw_init();
first = 1;
}
i = nm[0];
if (i < FIRST_C || i > LAST_C)
return;
kp = kwstart[i-FIRST_C];
if (kp)
for (; kp->name; kp++) {
i = strcmp(nm, kp->name);
if (i == 0) {
tp->e_token = kp->kwval;
tp->e_flags = kp->kflags;
return;
} else if (i < 0)
return;
}
}
#if CC68
/* fix args since stupid lib makes all lower case */
upstr(s)
char *s;
{
while (*s) {
if (*s >= 'a' && *s <= 'z')
*s += 'A'-'a';
s++;
}
}
downstr(s)
char *s;
{
while (*s) {
if (*s >= 'A' && *s <= 'Z')
*s -= 'A'-'a';
s++;
}
}
#endif
SHAR_EOF
cat << \SHAR_EOF > md.c
/* Copyright (c) 1988 by Sozobon, Limited. Author: Johann Ruegg
*
* Permission is granted to anyone to use this software for any purpose
* on any computer system, and to redistribute it freely, with the
* following restrictions:
* 1) No charge may be made other than reasonable charges for reproduction.
* 2) Modified versions must be clearly marked as such.
* 3) The authors are not responsible for any harmful consequences
* of using this software, even if they result from defects in it.
*
* md.c
*
* Machine dependant parts of first pass (parse)
* Also type checking subroutines.
*/
#include <stdio.h>
#include "param.h"
#include "tok.h"
#include "nodes.h"
#include "cookie.h"
NODEP bas_type();
int adjtab[] = {
K_INT, /* none */
K_SHORT, /* short */
K_LONG, /* long */
0, /* short long */
K_UNSIGNED, /* unsigned */
K_UNSIGNED, /* unsigned short */
T_ULONG, /* unsigned long */
0, /* unsigned short long */
};
adj_type(old, adj)
{
int rv;
switch (old) {
case K_CHAR:
if (adj & SAW_UNS)
return T_UCHAR;
break;
case K_INT:
rv = adjtab[adj];
if (rv == 0) {
error("bad type spec");
return K_INT;
}
return rv;
case K_FLOAT:
if (adj & SAW_LONG)
return K_DOUBLE;
break;
}
return old;
}
/* given ICON value, and flags SEE_L,SEE_U
determine final type */
icon_ty(tp)
NODE *tp;
{
int flags;
long val;
int islong, isuns;
flags = tp->e_flags;
val = tp->e_ival;
islong = (flags & SEE_L);
isuns = (flags & SEE_U);
if (islong && isuns)
return T_ULONG;
if (islong || islongv(val))
return K_LONG;
if (isuns)
return K_UNSIGNED;
return isintv((int)val) ? K_INT : K_CHAR;
}
isintv(i)
{
if (i > 0x7f || i < -0x80)
return 1;
return 0;
}
islongv(l)
long l;
{
#ifndef NOLONGS
if (l > MAXUNS || l < MININT)
return 1;
#endif
return 0;
}
mkint(l)
long l;
{
return l;
}
lc_reg(rp, xp)
int *rp;
NODE *xp;
{
switch (xp->n_tptr->t_token) {
case STAR:
return al_areg(rp,xp);
case K_CHAR:
case T_UCHAR:
case T_ULONG:
case K_INT:
case K_UNSIGNED:
case K_LONG:
return al_dreg(rp,xp);
default:
return 0;
}
}
al_areg(rp,xp)
int *rp;
NODEP xp;
{
register rmask, n;
rmask = *rp;
for (n=ARV_START; n<=ARV_END; n++)
if ((rmask & (1<<n)) == 0) {
xp->e_rno = n;
*rp |= (1<<n);
return 1;
}
return 0;
}
al_dreg(rp,xp)
int *rp;
NODEP xp;
{
register rmask, n;
rmask = *rp;
for (n=DRV_START; n<=DRV_END; n++)
if ((rmask & (1<<n)) == 0) {
xp->e_rno = n;
*rp |= (1<<n);
return 1;
}
return 0;
}
long
arg_size(sz,np)
long sz;
NODEP np;
{
np->e_offs = 0;
switch (np->n_tptr->t_token) {
case '[':
printf("GAK! array arg ");
return SIZE_P;
case K_CHAR:
case T_UCHAR:
np->e_offs = SIZE_I - SIZE_C;
return SIZE_I;
#if SIZE_I != SIZE_S
case K_SHORT:
np->e_offs = SIZE_I - SIZE_S;
return SIZE_I;
#endif
default:
return sz;
}
}
mustlval(np)
NODEP np;
{
switch (np->e_token) {
case ID:
case STAR:
case '.':
break;
default:
errorn("not lvalue", np);
return 1;
}
return 0;
}
mustty(np, flags)
NODEP np;
{
switch (np->n_tptr->t_token) {
case STAR:
if (flags & R_POINTER)
return 0;
error("pointer not allowed");
return 1;
case K_STRUCT:
case K_UNION:
if (flags & R_STRUCT)
return 0;
error("struct/union not allowed");
return 1;
case K_CHAR:
case K_SHORT:
case K_INT:
case K_UNSIGNED:
case K_LONG:
case T_UCHAR:
case T_ULONG:
if (flags & R_INTEGRAL)
return 0;
error("integral not allowed");
return 1;
case K_FLOAT:
case K_DOUBLE:
if (flags & R_FLOATING)
return 0;
error("floating not allowed");
return 1;
default:
error("bad type");
return 1;
}
return 0;
}
NODEP
functy(np)
NODEP np;
{
int lt;
lt = np->n_tptr->t_token;
if (lt != K_VOID)
mustty(np, R_ASSN);
switch (lt) {
case STAR:
case K_STRUCT:
case K_UNION:
return np->n_tptr;
}
lt = widen(lt);
return bas_type(lt);
}
NODEP
normalty(lp, rp)
NODEP lp, rp;
{
/* already checked types are R_ARITH */
/* rp may be NULL */
int lt, rt, rett;
lt = lp->n_tptr->t_token;
if (rp)
rt = rp->n_tptr->t_token;
else
rt = K_INT;
rett = maxt(widen(lt), widen(rt));
return bas_type(rett);
}
asn_chk(ltp, rp)
NODEP ltp, rp;
{
switch (ltp->t_token) {
case K_STRUCT:
case K_UNION:
if (same_type(ltp, rp->n_tptr) == 0)
error("bad struct assign");
return;
case STAR:
if (mayzero(rp))
return;
if (mustty(rp, R_POINTER))
return;
if (same_type(ltp->n_tptr, rp->n_tptr->n_tptr)
== 0)
warn("pointer types mismatch");
return;
default:
if (mustty(rp, R_ARITH))
return;
}
}
chkcmp(np)
NODEP np;
{
/* already checked types are R_SCALAR */
int lt, rt;
NODEP lp = np->n_left, rp = np->n_right;
lt = lp->n_tptr->t_token;
lt = (lt == STAR);
rt = rp->n_tptr->t_token;
rt = (rt == STAR);
if (lt && rt) { /* ptr cmp ptr */
if (same_type(lp->n_tptr, rp->n_tptr) == 0) {
warn("cmp of diff ptrs");
}
} else if (lt) { /* ptr cmp intg */
mustzero(rp);
} else if (rt) { /* intg +-[ ptr */
mustzero(lp);
} /* else both ARITH */
}
NODEP
colonty(np)
NODEP np;
{
/* already checked types are R_SCALAR */
int lt, rt;
NODEP lp = np->n_left, rp = np->n_right;
lt = lp->n_tptr->t_token;
lt = (lt == STAR);
rt = rp->n_tptr->t_token;
rt = (rt == STAR);
if (lt && rt) { /* ptr : ptr */
warn(": diff ptrs");
return lp->n_tptr;
} else if (lt) { /* ptr : intg */
mustzero(rp);
return lp->n_tptr;
} else if (rt) {
mustzero(lp);
return rp->n_tptr;
} else
return normalty(lp, rp);
}
NODEP
addty(np)
NODEP np;
{
/* already checked types are R_SCALAR */
/* op is '+' or '-' or '+=' or '-=' or '[' */
int oop = np->e_token;
int op;
int lt, rt;
NODEP lp = np->n_left, rp = np->n_right;
op = oop;
if (isassign(op))
op -= ASSIGN 0;
lt = lp->n_tptr->t_token;
lt = (lt == STAR);
rt = rp->n_tptr->t_token;
rt = (rt == STAR);
if (lt && rt) { /* ptr - ptr */
if (oop != '-' || same_type(lp->n_tptr, rp->n_tptr) == 0) {
error("bad +/-");
return lp->n_tptr;
}
np->e_token = PTRDIFF;
np->e_offs = lp->n_tptr->n_tptr->t_size;
return bas_type(K_INT);
} else if (lt) { /* ptr +-[ intg */
pandi:
mustty(rp, R_INTEGRAL);
np->e_offs = lp->n_tptr->n_tptr->t_size;
if (op == '+')
np->e_token += PTRADD-'+';
else if (op == '-')
np->e_token += PTRSUB-'-';
return lp->n_tptr;
} else if (rt) { /* intg +-[ ptr */
if (isassign(oop) || op == '-') {
error("illegal int op ptr");
return bas_type(K_INT);
}
/* switch sides so intg is on right */
np->n_left = rp;
np->n_right = lp;
lp = rp;
rp = np->n_right;
goto pandi;
} else { /* intg +- intg */
return normalty(lp, rp);
}
}
mustzero(np)
NODEP np;
{
if (np->e_token == ICON && np->e_ival == 0) {
return;
}
error("bad ':' combination");
}
mayzero(np)
NODEP np;
{
if (np->e_token == ICON && np->e_ival == 0) {
return 1;
}
return 0;
}
widen(ty)
{
switch (ty) {
case K_CHAR:
case T_UCHAR:
return K_INT;
case K_SHORT:
return K_INT;
case K_FLOAT:
return K_DOUBLE;
default:
return ty;
}
}
int pri_t[] = {
1, 6, /* uchar, ulong */
5,2,4,3,0, /* long, short, uns, int, char */
7,8,9 /* float, double, void */
};
extern nmerrors;
maxt(t1, t2)
{
if (nmerrors)
return K_INT;
if (pri_t[t1-FIRST_BAS] > pri_t[t2-FIRST_BAS])
return t1;
return t2;
}
SHAR_EOF
cat << \SHAR_EOF > nodes.c
/* Copyright (c) 1988 by Sozobon, Limited. Author: Johann Ruegg
*
* Permission is granted to anyone to use this software for any purpose
* on any computer system, and to redistribute it freely, with the
* following restrictions:
* 1) No charge may be made other than reasonable charges for reproduction.
* 2) Modified versions must be clearly marked as such.
* 3) The authors are not responsible for any harmful consequences
* of using this software, even if they result from defects in it.
*
* nodes.c
*
* Node allocation, deallocation, searching, printing
* and other node handling
*/
#include <stdio.h>
#include "param.h"
#include "nodes.h"
extern FILE *output;
NODE *freelist;
#define NODEINCR 100
extern int oflags[];
#define debug oflags['n'-'a']
#define NODELEN (sizeof(NODE)/4)
int nodesmade, nodesavail;
NODE *
allocnode()
{
char *calloc();
NODE *t;
int i;
retry:
if (freelist != 0) {
t = freelist;
freelist = t->n_next;
lclr(t, NODELEN);
nodesavail--;
if (debug)
printf("%lx+ ", t);
return t;
}
t = (NODE *)calloc(NODEINCR, sizeof(NODE));
if (t == 0) {
printf("malloc failure\n");
exit(1);
}
nodesmade += NODEINCR;
nodesavail += NODEINCR;
for (i=0; i<NODEINCR; i++)
t[i].n_next = &t[i+1];
t[NODEINCR-1].n_next = 0;
freelist = t;
goto retry;
}
freeunit(t)
NODE *t;
{
if (t->n_flags & N_ISFREE) {
printf("%lx ", t);
error("Freeing free node");
exit(1);
} else
t->n_flags |= N_ISFREE;
t->n_next = freelist;
freelist = t;
nodesavail++;
if (debug)
printf("%lx- ", t);
}
freenode(t)
NODE *t;
{
register NODE *nxt;
if (t == NULL) return;
again:
if (t->n_right)
freenode(t->n_right);
if (t->n_nmx)
freenode(t->n_nmx);
if (t->n_tptr && (t->n_flags & N_COPYT) == 0)
freenode(t->n_tptr);
nxt = t->n_left;
freeunit(t);
if (nxt) {
t = nxt;
goto again; /* minimize left recursion */
}
}
put_nnm(t)
NODE *t;
{
printf("%s", t->n_name);
while (t->n_nmx) {
t = t->n_nmx;
printf("%s", t->n_name);
}
}
qput_nnm(t, fd)
NODE *t;
FILE *fd;
{
fprintf(fd, "%s", t->n_name);
while (t->n_nmx) {
t = t->n_nmx;
fprintf(fd, "%s", t->n_name);
}
}
fput_nnm(t)
NODE *t;
{
fprintf(output, "%s", t->n_name);
while (t->n_nmx) {
t = t->n_nmx;
fprintf(output, "%s", t->n_name);
}
}
/* add a short string (less than NMXSIZE) to front of name */
nnmins(t, s)
NODEP t;
char *s;
{
register i, j;
char tbuf[NMSIZE];
NODEP n;
i = strlen(t->n_name);
j = strlen(s);
if (j > NMSIZE-1)
return; /* compiler error */
if (i+j <= NMSIZE-1) { /* fits in node */
strcpy(tbuf, t->n_name);
strcpy(t->n_name, s);
strcpy(t->n_name+j, tbuf);
} else {
n = allocnode();
n->n_nmx = t->n_nmx;
t->n_nmx = n;
strcpy(n->n_name, t->n_name);
strcpy(t->n_name, s);
}
}
/* add a short string (less than NMXSIZE) to end of name */
nnmadd(t, s)
NODE *t;
char *s;
{
register i,j;
int sizeb;
NODEP n;
/* find last node */
sizeb = NMSIZE;
while (t->n_nmx) {
t = t->n_nmx;
sizeb = NMXSIZE;
}
/* fits in current last node? */
i = strlen(s);
j = strlen(t->n_name);
if (i < sizeb-j) {
strcat(t->n_name, s);
return;
}
/* put all of s in new node */
n = allocnode();
t->n_nmx = n;
t = n;
strncpy(t->n_name, s, NMXSIZE-1);
t->n_name[NMXSIZE-1] = 0;
}
nscpy(t, s)
NODE *t;
char *s;
{
register i;
NODEP n;
i = strlen(s);
strncpy(t->n_name, s, NMSIZE-1);
t->n_name[NMSIZE-1] = 0;
i -= NMSIZE-1;
s += NMSIZE-1;
while (i > 0) {
n = allocnode();
t->n_nmx = n;
t = n;
strncpy(t->n_name, s, NMXSIZE-1);
t->n_name[NMXSIZE-1] = 0;
i -= NMXSIZE-1;
s += NMXSIZE-1;
}
}
putlist(head, np)
NODE **head, *np;
{
np->n_next = *head;
*head = np;
}
puthlist(head, np)
NODE *head[], *np;
{
putlist(&head[hash(np->n_name)], np);
}
NODE *
llook(head, np)
NODE *head, *np;
{
register NODEP p;
for (p=head; p != NULL; p = p->n_next)
if (xstrcmp(p, np) == 0) {
return p;
}
return NULL;
}
NODE *
hlook(head, np)
NODE *head[], *np;
{
register NODEP p;
p = head[hash(np->n_name)];
return llook(p, np);
}
hash(s)
register char *s;
{
register hval;
hval = 0;
while (*s)
hval += *s++;
return hval & (NHASH-1);
}
xstrcmp(p1, p2)
NODE *p1, *p2;
{
int rv;
if ((rv = strcmp(p1->n_name, p2->n_name)) != 0)
return rv;
if (p1->n_nmx == NULL) {
if (p2->n_nmx == NULL)
return 0;
return -1;
}
if (p2->n_nmx == NULL)
return 1;
return xstrcmp(p1->n_nmx, p2->n_nmx);
}
char *
scopy(s)
char *s;
{
int i;
char *p;
i = strlen(s)+1;
if (i > sizeof(NODE)) {
error("preproc name too big");
i = sizeof(NODE);
s[i-1] = 0;
}
p = (char *)allocnode();
strcpy(p, s);
return p;
}
sfree(s)
char *s;
{
NODEP np;
np = (NODEP)s;
np->n_flags = 0;
freeunit(np);
}
printlist(np)
NODE *np;
{
putchar('\n');
prln(np, 2);
}
prln(np, indent)
NODE *np;
{
register NODE *svl, *nxtl;
for (svl=np; svl != NULL; svl = nxtl) {
nxtl = svl->n_next;
svl->n_next = NULL;
prnode(svl,indent);
svl->n_next = nxtl;
/* special hack for tag list */
if ((svl->n_flags & N_BRKPR) && svl->n_right)
prln(svl->n_right, indent+2);
}
}
codeprint(np)
NODEP np;
{
putchar('\n');
cprnode(np,0);
}
cprnode(np,indent)
NODE *np;
{
int ni;
NODEP tp;
ni = indent+1;
while (indent--)
putchar(' ');
if (np == NULL) {
printf("<NULL>\n");
return;
}
put_nnm(np); /* Note: BRKPR doesnt break long names */
if (np->g_offs)
printf(" o%ld ", np->g_offs);
if (np->g_rno)
printf(" r%d ", np->g_rno);
if (np->g_needs)
printf(" n%x ", np->g_needs);
if (debug) {
printf("@%lx ", np);
if (np->n_flags & N_COPYT)
printf("C ");
if (np->n_flags & N_BRKPR)
printf("B ");
}
if (np->n_flags & N_BRKPR) {
putchar('\n');
return;
}
if (np->g_betw)
printf(" {%s}", np->g_betw);
if (np->g_code) {
if (np->n_flags & N_COPYT)
printf(" <%s>", np->g_code);
else
for (tp=np->g_code; tp; tp = tp->g_code)
printf(" <%s>", tp->n_name);
}
putchar(' ');
out_a(np, stdout);
putchar('\n');
if (np->n_left) {
cprnode(np->n_left,ni);
} else if (np->n_right)
cprnode(NULL, ni);
if (np->n_right) {
cprnode(np->n_right,ni);
}
}
printnode(np)
NODE *np;
{
putchar('\n');
prnode(np,0);
}
prnode(np,indent)
NODE *np;
{
int ni;
ni = indent+1;
while (indent--)
putchar(' ');
if (np == NULL) {
printf("<NULL>\n");
return;
}
put_nnm(np); /* Note: BRKPR doesnt break long names */
if (np->e_offs)
printf(" o%ld ", np->e_offs);
if (np->e_rno)
printf(" r%d ", np->e_rno);
if (np->e_fldw)
printf(" (%d,%d) ", np->e_fldw, np->e_fldo);
if (debug) {
printf("@%lx ", np);
if (np->n_flags & N_COPYT)
printf("C ");
if (np->n_flags & N_BRKPR)
printf("B ");
}
if (np->n_flags & N_BRKPR) {
putchar('\n');
return;
}
if (np->n_tptr) {
if (np->e_flags & 256) /* IMMEDID */
printf(" $$$ ");
tprint(np->n_tptr);
}
putchar('\n');
if (np->n_left) {
prnode(np->n_left,ni);
} else if (np->n_right)
prnode(NULL, ni);
if (np->n_right) {
prnode(np->n_right,ni);
}
}
tprint(np)
NODEP np;
{
while (np != NULL) {
putchar(' ');
put_nnm(np);
#ifdef HANS
if (np->t_size)
printf(" s%ld", np->t_size);
if (np->t_aln)
printf(" a%d", np->t_aln);
#endif
if (debug)
printf("@%lx", np);
np = np->n_tptr;
}
}
NODEP
copynode(op)
NODEP op;
{
NODEP np;
if (op == NULL) return NULL;
np = allocnode();
lcpy(np, op, NODELEN);
if (np->n_nmx)
np->n_nmx = copynode(np->n_nmx);
if (np->n_right)
np->n_right = copynode(np->n_right);
if (np->n_left)
np->n_left = copynode(np->n_left);
if (np->n_tptr)
np->n_flags |= N_COPYT;
return np;
}
NODEP
copyone(op)
NODEP op;
{
NODEP np;
if (op == NULL) return NULL;
np = allocnode();
lcpy(np, op, NODELEN);
if (np->n_nmx)
np->n_nmx = copyone(np->n_nmx);
if (np->n_right)
np->n_right = NULL;
if (np->n_left)
np->n_left = NULL;
if (np->n_tptr)
np->n_flags |= N_COPYT;
return np;
}
NODEP
copy_nol(op)
NODEP op;
{
NODEP np;
if (op == NULL) return NULL;
np = allocnode();
lcpy(np, op, NODELEN);
if (np->n_nmx)
np->n_nmx = copynode(np->n_nmx);
if (np->n_right) /* break right links */
np->n_right = NULL;
if (np->n_tptr)
np->n_flags |= N_COPYT;
return np;
}
NODEP
copylist(np, tailp)
NODE *np, **tailp;
{
NODEP rv, nx;
register NODEP tail;
if (np == NULL) {
*tailp = NULL;
return NULL;
}
rv = copy_nol(np);
tail = rv;
while (tail->n_left) {
nx = copy_nol(tail->n_left);
tail->n_left = nx;
tail = nx;
}
*tailp = tail;
return rv;
}
NODE *
nthnode(np, n)
NODE *np;
{
while (n--)
if (np == NULL)
return NULL;
else
np=np->n_next;
return np;
}
NODE *
rthnode(np, n)
NODE *np;
{
while (n--)
if (np == NULL)
return NULL;
else
np=np->n_right;
return np;
}
SHAR_EOF
# End of shell archive
exit 0
--
Bob Page, U of Lowell CS Dept. page@swan.ulowell.edu ulowell!page
Have five nice days.