static int pstmt (void) {
int si, i0, i1;
si = Cnew (C_STMT);
switch (Ltok) {
case L_SEMI:
Csetfp (si, C_NULL);
Lgtok ();
break;
case L_LCB:
Lgtok ();
if (Ltok == L_RCB) {
Csetfp (si, C_NULL);
} else {
i1 = pstmt ();
Csetfp (si, i1);
i0 = i1;
while (Ltok != L_RCB) {
i1 = pstmt ();
Csetnext (i0, i1);
i0 = i1;
}
}
Lgtok ();
break;
case L_IF:
i0 = pifst ();
Csetfp (si, i0);
break;
case L_WHILE:
i0 = pwhilest ();
Csetfp (si, i0);
break;
case L_FOR:
i0 = pforst ();
Csetfp (si, i0);
break;
case L_BREAK:
i0 = pbreakst ();
Csetfp (si, i0);
break;
case L_CONTINUE:
i0 = pcontinuest ();
Csetfp (si, i0);
break;
case L_RETURN:
i0 = preturnst ();
Csetfp (si, i0);
break;
default:
i0 = pexpr ();
Csetfp (si, i0);
GTOKIFEQ (L_SEMI);
}
return si;
}
static int pforst (void) {
int fi, i0, i1, si;
fi = Cnew (C_FOR);
Lgtok ();
GTOKIFEQ (L_LP);
i0 = (Ltok == L_SEMI) ? Cnew (C_NOP): pexpr ();
Csetfp (fi, i0);
if (Ltok == L_IN) {
Csettype (fi, C_FORIN);
Lgtok ();
i1 = pexpr ();
Csetnext (i0, i1);
i0 = i1;
} else {
GTOKIFEQ (L_SEMI);
i1 = (Ltok == L_SEMI) ? Cnew (C_NOP): pexpr ();
Csetnext (i0, i1);
i0 = i1;
GTOKIFEQ (L_SEMI);
i1 = (Ltok == L_SEMI) ? Cnew (C_NOP): pexpr ();
Csetnext (i0, i1);
i0 = i1;
}
GTOKIFEQ (L_RP);
si = pstmt ();
Csetnext (i0, si);
return fi;
}
static int ptcons (void) {
int ti, ei0, ei1;
ti = Cnew (C_TCONS);
Lgtok ();
if (Ltok == L_RB) {
Csetfp (ti, C_NULL);
Lgtok ();
return ti;
}
ei1 = pexpi (0);
Csetfp (ti, ei1);
ei0 = ei1;
GTOKIFEQ (L_ASSIGN);
ei1 = pexpr ();
Csetnext (ei0, ei1);
ei0 = ei1;
GTOKIFEQ (L_SEMI);
while (Ltok != L_RB) {
ei1 = pexpi (0);
Csetnext (ei0, ei1);
ei0 = ei1;
GTOKIFEQ (L_ASSIGN);
ei1 = pexpr ();
Csetnext (ei0, ei1);
ei0 = ei1;
GTOKIFEQ (L_SEMI);
}
Lgtok ();
return ti;
}
//havent a dammed clue, constants everywhere
int
stmt()
{
int jdest;
int tst;
if (istoken('{')) {
while(!istoken('}'))
stmt();
} else if (istoken(T_IF)) {
pexpr();
jdest = emitj(C_JFALSE, 0);
stmt();
if (istoken(T_ELSE)) {
tst = emitj(C_JUMP, 0);
emitat(jdest, curloc);
stmt();
emitat(tst, curloc);
} else {
emitat(jdest, curloc);
}
} else if (istoken(T_WHILE)) {
tst = curloc;
pexpr();
jdest = emitj(C_JFALSE, 0);
stmt();
emitj(C_JUMP, tst);
emitat(jdest, curloc);
} else if (istoken(T_DO)) {
jdest = curloc;
stmt();
expect(T_WHILE);
pexpr();
emit(C_NOT);
emitj(C_JFALSE, jdest);
} else if (istoken(T_RETURN)) {
expr(1, P_NONE);
expect(';');
emit(C_RETURN);
} else if (istoken(';')) {
/* empty */
} else {
/* just an expression */
expr(1, P_NONE);
emit(C_POP);
expect(';');
}
}
static int pifst (void) {
int isi, ii, ti, ei;
if ((isi = EEcnew (C_IF)) == -1) {
SUwarning (0, "pifst", "cannot create statement");
return -1;
}
EElgtok ();
GTOKIFEQ (L_LP);
if ((ii = pexpr ()) == -1) {
SUwarning (0, "pifst", "cannot create expression");
return -1;
}
EEcsetfp (isi, ii);
GTOKIFEQ (L_RP);
if ((ti = pstmt ()) == -1) {
SUwarning (0, "pifst", "cannot create then statement");
return -1;
}
EEcsetnext (ii, ti);
if (EEltok == L_ELSE) {
EElgtok ();
if ((ei = pstmt ()) == -1) {
SUwarning (0, "pifst", "cannot create else statement");
return -1;
}
EEcsetnext (ti, ei);
}
return isi;
}
void
whatis(Lsym *l)
{
int t;
int def;
Type *ti;
if(l == 0) {
fundefs();
return;
}
def = 0;
if(l->v->set) {
t = l->v->type;
Bprint(bout, "%s variable", typenames[t]);
if(t == TINT || t == TFLOAT)
Bprint(bout, " format %c", l->v->fmt);
if(l->v->comt)
Bprint(bout, " complex %s", l->v->comt->base->name);
Bputc(bout, '\n');
def = 1;
}
if(l->lt) {
Bprint(bout, "complex %s {\n", l->name);
for(ti = l->lt; ti; ti = ti->next) {
if(ti->type) {
if(ti->fmt == 'a') {
Bprint(bout, "\t%s %d %s;\n",
ti->type->name, ti->offset,
ti->tag->name);
}
else {
Bprint(bout, "\t'%c' %s %d %s;\n",
ti->fmt, ti->type->name, ti->offset,
ti->tag->name);
}
}
else
Bprint(bout, "\t'%c' %d %s;\n",
ti->fmt, ti->offset, ti->tag->name);
}
Bprint(bout, "};\n");
def = 1;
}
if(l->proc) {
Bprint(bout, "defn %s(", l->name);
pexpr(l->proc->left);
Bprint(bout, ") {\n");
pcode(l->proc->right, 1);
Bprint(bout, "}\n");
def = 1;
}
if(l->builtin) {
Bprint(bout, "builtin function\n");
def = 1;
}
if(def == 0)
Bprint(bout, "%s is undefined\n", l->name);
}
static int pargs (void) {
int ai, ei0, ei1;
ai = Cnew (C_ARGS);
if (Ltok == L_RP) {
Csetfp (ai, C_NULL);
return ai;
}
ei0 = pexpr ();
Csetfp (ai, ei0);
while (Ltok != L_RP) {
GTOKIFEQ (L_COMMA);
if (Ltok == L_RP)
err ("expected expression, found: %s", Lnames[Ltok]);
ei1 = pexpr ();
Csetnext (ei0, ei1);
ei0 = ei1;
}
return ai;
}
static int pwhilest (void) {
int wi, ei, si;
wi = Cnew (C_WHILE);
Lgtok ();
GTOKIFEQ (L_LP);
ei = pexpr ();
Csetfp (wi, ei);
GTOKIFEQ (L_RP);
si = pstmt ();
Csetnext (ei, si);
return wi;
}
static int pstmt (void) {
int si, si0, si1;
if ((si = EEcnew (C_STMT)) == -1) {
SUwarning (0, "pstmt", "cannot create statement");
return -1;
}
switch (EEltok) {
case L_SEMI:
EEcsetfp (si, C_NULL);
EElgtok ();
break;
case L_LCB:
EElgtok ();
if (EEltok == L_RCB) {
EEcsetfp (si, C_NULL);
} else {
if ((si1 = pstmt ()) == -1) {
SUwarning (0, "pstmt", "cannot create compound statement");
return -1;
}
EEcsetfp (si, si1);
si0 = si1;
while (EEltok != L_RCB) {
if ((si1 = pstmt ()) == -1) {
SUwarning (0, "pstmt", "cannot create compound statement");
return -1;
}
EEcsetnext (si0, si1);
si0 = si1;
}
}
EElgtok ();
break;
case L_IF:
if ((si0 = pifst ()) == -1) {
SUwarning (0, "pstmt", "cannot create if statement");
return -1;
}
EEcsetfp (si, si0);
break;
default:
if ((si0 = pexpr ()) == -1) {
SUwarning (0, "pstmt", "cannot create expression");
return -1;
}
EEcsetfp (si, si0);
GTOKIFEQ (L_SEMI);
}
return si;
}
static char * subst(int ind,int arg)
{ int v, l, i;
static shortstr ans;
v = massindpos[ind-1].vrt1;
if (vertmap[v-1] == arg) l = massindpos[ind-1].ln1;
else
{
v = massindpos[ind-1].vrt2;
l = massindpos[ind-1].ln2;
}
sprintf(ans,"%s=>(",iexpr(ind));
if (gammaflag && fermvrt(v))
{
for (i = 0; i < vcs.valence[v-1]; i++) if (i != l-1)
sprintf(ans+strlen(ans),"+%s",pexpr(vcs.vertlist[v-1][i].moment));
}
else sprintf(ans+strlen(ans),"%s",pexpr(-vcs.vertlist[v-1][l-1].moment));
sprintf(ans+strlen(ans),")/%s",prtclbase1[vcs.vertlist[v-1][l-1].partcl].massidnt);
return ans;
}
static int pexpr (void) {
int ai, ei0, ei1;
ei0 = pexpi (0);
if (Ltok != C_ASSIGN)
return ei0;
ai = Cnew (C_ASSIGN);
Csetfp (ai, ei0);
Lgtok ();
ei1 = pexpr ();
Csetnext (ei0, ei1);
return ai;
}
static int preturnst (void) {
int ri, ei;
ri = Cnew (C_RETURN);
Lgtok ();
if (Ltok == L_SEMI) {
Csetfp (ri, C_NULL);
GTOKIFEQ (L_SEMI);
return ri;
}
ei = pexpr ();
Csetfp (ri, ei);
GTOKIFEQ (L_SEMI);
return ri;
}
static int pifst (void) {
int isi, ii, ti, ei;
isi = Cnew (C_IF);
Lgtok ();
GTOKIFEQ (L_LP);
ii = pexpr ();
Csetfp (isi, ii);
GTOKIFEQ (L_RP);
ti = pstmt ();
Csetnext (ii, ti);
if (Ltok == L_ELSE) {
Lgtok ();
ei = pstmt ();
Csetnext (ti, ei);
}
return isi;
}
Tobj Punit (Psrc_t *sp) {
int ui, ei;
Lsetsrc (sp->flag, sp->s, sp->fp, sp->tok, sp->lnum);
Creset ();
flvi = llvi = 0;
if (setjmp (eljbuf) != 0)
return NULL;
while (Ltok == L_SEMI)
Lgtok ();
if (Ltok == L_EOF)
return NULL;
ui = Cnew (C_CODE);
ei = pexpr ();
Csetfp (ui, ei);
Lgetsrc (&sp->flag, &sp->s, &sp->fp, &sp->tok, &sp->lnum);
return Tcode (cbufp, 0, cbufi);
}
static int pexp7 (void) {
int ei0, ei1, ei2;
ei0 = 0;
switch (Ltok) {
case L_FUNCTION:
Lgtok ();
ei0 = pfunc ();
break;
case L_LP:
ei0 = Cnew (C_PEXPR);
Lgtok ();
ei1 = pexpr ();
GTOKIFEQ (L_RP);
Csetfp (ei0, ei1);
break;
case L_LB:
ei0 = ptcons ();
break;
case L_STRING:
case L_NUMBER:
ei0 = pcons ();
break;
case L_ID:
ei0 = pvar ();
if (Ltok == L_LP) { /* ie: it's really a function call */
ei1 = ei0;
ei0 = Cnew (C_FCALL);
Csetfp (ei0, ei1);
Lgtok ();
ei2 = pargs ();
Csetnext (ei1, ei2);
GTOKIFEQ (L_RP);
}
break;
default:
err ("expected EXP7 type token, found: %s", Lnames[Ltok]);
}
return ei0;
}
static index_t ifarr(QSP_ARG_DECL const char *s) /* return index or NOTARR */
{
Typed_Scalar *tsp;
char index_string[MAX_INDEX_STRING_LEN];
int i;
/* need to fix up const stuff */
while( *s && *s != '[' ){
s++; /* skip until end or opening brace */
}
if( *s==0 ) return(NOTARR);
s++; // skip opening brace
/* changed to use expression parser jbm 12-10-92 */
i=0;
while( *s && *s!=']' ){
if( i >= (MAX_INDEX_STRING_LEN-1)){
sprintf(ERROR_STRING,"ifarr: index string too long (%d chars max)",
MAX_INDEX_STRING_LEN-1);
WARN(ERROR_STRING);
return(NOTARR);
}
index_string[i++] = *s++;
}
index_string[i]=0;
if( *s != ']' ) {
WARN("ifarr: no closing brace for index");
return(NOTARR);
}
tsp = pexpr(QSP_ARG index_string );
i = index_for_scalar( tsp );
RELEASE_SCALAR(tsp);
return(i);
}
static int pexp7 (void) {
int ei0, ei1;
switch (EEltok) {
case L_LP:
if ((ei0 = EEcnew (C_PEXPR)) == -1) {
SUwarning (0, "pexp7", "cannot create code");
return -1;
}
EElgtok ();
if ((ei1 = pexpr ()) == -1) {
SUwarning (0, "pexp7", "cannot create expression");
return -1;
}
GTOKIFEQ (L_RP);
EEcsetfp (ei0, ei1);
break;
case L_STRING:
case L_NUMBER:
if ((ei0 = pcons ()) == -1) {
SUwarning (0, "pexp7", "cannot create constant expression");
return -1;
}
break;
case L_ID:
if ((ei0 = pvar ()) == -1) {
SUwarning (0, "pexp7", "cannot create variable expression");
return -1;
}
break;
default:
SUwarning (
0, "pexp7",
"unexpected token: %s, string: %s", EElnames[EEltok], EElgetstr ()
);
}
return ei0;
}
static int pexpr (void) {
int ai, ei0, ei1;
if ((ei0 = pexpi (0)) == -1) {
SUwarning (0, "pexpr", "cannot create lhs expression");
return -1;
}
if (EEltok != C_ASSIGN)
return ei0;
if ((ai = EEcnew (C_ASSIGN)) == -1) {
SUwarning (0, "pexpr", "cannot create rhs code");
return -1;
}
EEcsetfp (ai, ei0);
EElgtok ();
if ((ei1 = pexpr ()) == -1) {
SUwarning (0, "pexpr", "cannot create rhs expression");
return -1;
}
EEcsetnext (ei0, ei1);
return ai;
}
static int pvar (void) {
int vi, ci0, ci1, i;
vi = Cnew (C_GVAR);
ci0 = Cstring (Lstrtok);
Csetfp (vi, ci0);
for (i = flvi; i < llvi; i++) {
if (strcmp (GETLVSTR (i), Lstrtok) == 0) {
Csettype (vi, C_LVAR);
ci1 = Cinteger ((long) GETLVNUM (i));
Csetnext (ci0, ci1);
ci0 = ci1;
break;
}
}
Lgtok ();
if (Ltok != L_DOT && Ltok != L_LB)
return vi;
while (Ltok == L_DOT || Ltok == L_LB) {
if (Ltok == L_DOT) {
Lgtok ();
if (Ltok != L_ID)
err ("expected identifier, found: %s", Lnames[Ltok]);
ci1 = Cstring (Lstrtok);
Csetnext (ci0, ci1);
Lgtok ();
} else {
Lgtok ();
ci1 = pexpr ();
Csetnext (ci0, ci1);
GTOKIFEQ (L_RB);
}
ci0 = ci1;
}
return vi;
}
int dodo() {int jdest; int jtemp;
nlabel++; jdest=nlabel; prlabel(jdest); stmt();
expect(T_WHILE); pexpr(); nlabel++; jtemp=nlabel; prnum(jtemp);
prjump(jdest); prlabel(jtemp); }
void
pexpr(Node *n)
{
Node *r, *l;
if(n == 0)
return;
r = n->right;
l = n->left;
switch(n->op) {
case ONAME:
Bprint(bout, "%s", n->sym->name);
break;
case OCONST:
switch(n->type) {
case TINT:
Bprint(bout, "%lld", n->ival);
break;
case TFLOAT:
Bprint(bout, "%g", n->fval);
break;
case TSTRING:
pstr(n->string);
break;
case TLIST:
break;
}
break;
case OMUL:
case ODIV:
case OMOD:
case OADD:
case OSUB:
case ORSH:
case OLSH:
case OLT:
case OGT:
case OLEQ:
case OGEQ:
case OEQ:
case ONEQ:
case OLAND:
case OXOR:
case OLOR:
case OCAND:
case OCOR:
Bputc(bout, '(');
pexpr(l);
Bprint(bout, binop[n->op]);
pexpr(r);
Bputc(bout, ')');
break;
case OASGN:
pexpr(l);
Bprint(bout, binop[n->op]);
pexpr(r);
break;
case OINDM:
Bprint(bout, "*");
pexpr(l);
break;
case OEDEC:
Bprint(bout, "--");
pexpr(l);
break;
case OEINC:
Bprint(bout, "++");
pexpr(l);
break;
case OPINC:
pexpr(l);
Bprint(bout, "++");
break;
case OPDEC:
pexpr(l);
Bprint(bout, "--");
break;
case ONOT:
Bprint(bout, "!");
pexpr(l);
break;
case OLIST:
pexpr(l);
if(r) {
Bprint(bout, ",");
pexpr(r);
}
break;
case OCALL:
pexpr(l);
Bprint(bout, "(");
pexpr(r);
Bprint(bout, ")");
break;
case OCTRUCT:
Bprint(bout, "{");
pexpr(l);
Bprint(bout, "}");
break;
case OHEAD:
Bprint(bout, "head ");
pexpr(l);
break;
case OTAIL:
Bprint(bout, "tail ");
pexpr(l);
break;
case OAPPEND:
Bprint(bout, "append ");
pexpr(l);
Bprint(bout, ",");
pexpr(r);
break;
case ODELETE:
Bprint(bout, "delete ");
pexpr(l);
Bprint(bout, ",");
pexpr(r);
break;
case ORET:
Bprint(bout, "return ");
pexpr(l);
break;
case OINDEX:
pexpr(l);
Bprint(bout, "[");
pexpr(r);
Bprint(bout, "]");
break;
case OINDC:
Bprint(bout, "@");
pexpr(l);
break;
case ODOT:
pexpr(l);
Bprint(bout, ".%s", n->sym->name);
break;
case OFRAME:
Bprint(bout, "%s:%s", n->sym->name, l->sym->name);
break;
case OCAST:
Bprint(bout, "(%s)", n->sym->name);
pexpr(l);
break;
case OFMT:
pexpr(l);
Bprint(bout, "\\%c", (int)r->ival);
break;
case OEVAL:
Bprint(bout, "eval ");
pexpr(l);
break;
case OWHAT:
Bprint(bout, "whatis");
if(n->sym)
Bprint(bout, " %s", n->sym->name);
break;
}
}
void
pcode(Node *n, int d)
{
Node *r, *l;
if(n == 0)
return;
r = n->right;
l = n->left;
switch(n->op) {
default:
Bprint(bout, "%.*s", d, tabs);
pexpr(n);
Bprint(bout, ";\n");
break;
case OLIST:
pcode(n->left, d);
pcode(n->right, d);
break;
case OLOCAL:
Bprint(bout, "%.*slocal", d, tabs);
while(l) {
Bprint(bout, " %s", l->sym->name);
l = l->left;
if(l == 0)
Bprint(bout, ";\n");
else
Bprint(bout, ",");
}
break;
case OCOMPLEX:
Bprint(bout, "%.*scomplex %s %s;\n", d, tabs, n->sym->name, l->sym->name);
break;
case OIF:
Bprint(bout, "%.*sif ", d, tabs);
pexpr(l);
d++;
Bprint(bout, " then\n");
if(r && r->op == OELSE) {
slist(r->left, d);
Bprint(bout, "%.*selse\n", d-1, tabs);
slist(r->right, d);
}
else
slist(r, d);
break;
case OWHILE:
Bprint(bout, "%.*swhile ", d, tabs);
pexpr(l);
d++;
Bprint(bout, " do\n");
slist(r, d);
break;
case ORET:
Bprint(bout, "%.*sreturn ", d, tabs);
pexpr(l);
Bprint(bout, ";\n");
break;
case ODO:
Bprint(bout, "%.*sloop ", d, tabs);
pexpr(l->left);
Bprint(bout, ", ");
pexpr(l->right);
Bprint(bout, " do\n");
slist(r, d+1);
}
}
int dowhile() {int jdest; int tst; nlabel++; jdest=nlabel;
prlabel(jdest); pexpr(); nlabel++; tst=nlabel; prnum(tst);
stmt(); prjump(jdest); prlabel(tst); }
int doif() {int jdest; int tst; pexpr(); nlabel++; jdest=nlabel;
prnum(jdest); stmt();
if (istoken(T_ELSE)) { nlabel++; tst=nlabel;
prjump(tst); prlabel(jdest); stmt(); prlabel(tst); }
else prlabel(jdest); }