123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476 |
- /* $Header$ */
- /*
- * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
- * See the copyright notice in the ACK home directory, in the file "Copyright".
- */
- #include "symtab.h"
- #include "sizes.h"
- #include "expr.h"
- #include "Lpars.h"
- static void rvalue(), assignable(), inputable(), outputable(), subscriptable();
- static void assigned();
- /* The new_* functions make use of the used() and assinged() functions to
- * make known what is done to a variable.
- */
- struct expr *new_node(op, left, right, byte)
- int op;
- register struct expr *left, *right;
- int byte;
- /* Makes a new node with given operator, left and right operand.
- * Constant folding is done if possible.
- */
- {
- if (op!=FOR && constant(left) && (right==nil || constant(right))) {
- register long lc, rc;
- lc=left->u.const;
- rc=right->u.const;
- switch (op) {
- case '+': lc+=rc; break;
- case '-': lc-=rc; break;
- case '*': lc*=rc; break;
- case '/': if (rc==0L)
- report("division by zero");
- else
- lc/=rc;
- break;
- case BS: lc%=rc; break;
- case '<': lc= lc<rc ? -1L : 0L; break;
- case '>': lc= lc>rc ? -1L : 0L; break;
- case LE: lc= lc<=rc ? -1L : 0L; break;
- case GE: lc= lc>=rc ? -1L : 0L; break;
- case NE: lc= lc!=rc ? -1L : 0L; break;
- case '=': lc= lc==rc ? -1L : 0L; break;
- case AFTER: lc= (lc-rc)>0 ? -1L : 0L; break;
- case BA: lc&=rc; break;
- case BO: lc|=rc; break;
- case BX: lc^=rc; break;
- case AND: lc= lc&&rc ? -1L : 0L; break;
- case OR: lc= lc||rc ? -1L : 0L; break;
- case LS: lc<<=rc; break;
- case RS: lc>>=rc; break;
- case '~': lc= -lc; break;
- case NOT: lc= ~lc; break;
- default:
- report("illegal operator on constants");
- }
- destroy(right);
- left->u.const=lc;
- return left;
- } else {
- register struct expr *pe;
- int type=0, arr_siz=1;
- switch (op) {
- case '+': case '-': case '*': case '/':
- case BS: case '<': case '>': case LE:
- case GE: case NE: case '=': case AFTER:
- case BA: case BO: case BX: case AND:
- case OR: case LS: case RS:
- rvalue(left);
- rvalue(right);
- type=T_VALUE;
- break;
- case '~':
- case NOT:
- rvalue(left);
- type=T_VALUE;
- break;
- case AS:
- assignable(left, right);
- type=T_VOID;
- break;
- case '[':
- subscriptable(left, right, byte, &type, &arr_siz);
- break;
- }
- pe= (struct expr *) malloc(sizeof *pe);
- pe->kind=E_NODE;
- pe->type=type;
- pe->arr_siz=arr_siz;
- pe->u.node.op=op;
- pe->u.node.left=left;
- pe->u.node.right=right;
- return pe;
- }
- }
- struct expr *new_var(var)
- register struct symbol *var;
- /* Given a variable an expression node is constructed. Note the changes in
- * type! T_VAR becomes T_VALUE with flag T_LVALUE.
- */
- {
- register struct expr *pe;
- pe= (struct expr *) malloc(sizeof *pe);
- pe->kind=E_VAR;
- if ((var->type&T_TYPE)==T_VAR || var->type&T_NOTDECL) {
- pe->type=(var->type&(~T_TYPE));
- pe->type|=T_VALUE|T_LVALUE;
- } else
- pe->type=var->type;
- pe->arr_siz=var->arr_siz;
- pe->u.var=var;
- return pe;
- }
- struct expr *new_const(const)
- long const;
- /* Make a constant, which is a VALUE, of course. */
- {
- register struct expr *pe;
- pe= (struct expr *) malloc(sizeof *pe);
- pe->kind=E_CONST;
- pe->type=T_VALUE;
- pe->u.const=const;
- return pe;
- }
- struct expr *new_table(kind, tab)
- register kind;
- register struct table *tab;
- /* One table is being made, it is no doubt a VALUEd ARRay, but maybe even a
- * BYTE array. A label is reserved for it and the individual elements are
- * rommified.
- */
- {
- register struct expr *pe;
- pe= (struct expr *) malloc(sizeof *pe);
- pe->kind=kind;
- pe->type=T_VALUE|T_ARR;
- if (kind==E_BTAB) pe->type|=T_BYTE;
- dot_label(new_dot_label(&pe->u.tab));
- pe->arr_siz=0;
- while (tab!=nil) {
- register struct table *junk=tab;
-
- rom(kind==E_BTAB ? 1 : vz, tab->val);
- tab=tab->next;
- pe->arr_siz++;
- free(junk);
- }
- return pe;
- }
- struct expr *copy_const(e) struct expr *e;
- /* If you double it up, you've got one you can throw away. (Or do something
- * useful with).
- */
- {
- register struct expr *c;
- c= (struct expr *) malloc(sizeof *c);
- *c= *e;
- return c;
- }
- struct expr *new_now()
- /* Now is the time to make a VALUE cell for the clock. */
- {
- register struct expr *pe;
- pe= (struct expr *) malloc(sizeof *pe);
- pe->kind=E_NOW;
- pe->type=T_VALUE;
- return pe;
- }
- struct expr *new_io(out, chan, args)
- int out;
- register struct expr *chan;
- struct expr_list *args;
- /* Either c ? v0; v1; v2; ... (out=0) or c ! e0; e1; e2; ... (out=1). */
- {
- register struct expr *pe;
- if ( ( (chan->type&T_TYPE) != T_CHAN || (chan->type&T_ARR) )
- && ! (chan->type&T_NOTDECL)
- )
- report("channel variable expected");
- used(chan);
- pe= (struct expr *) malloc(sizeof *pe);
- pe->kind=E_IO;
- pe->type=T_VOID;
- pe->u.io.out=out;
- pe->u.io.chan=chan;
- pe->u.io.args=args;
- return pe;
- }
- struct expr *new_call(proc, args)
- struct expr *proc;
- struct expr_list *args;
- /* Dial proc(arg1, arg2, ...) and you'll hear the tone of this function.
- * Dialing yourself is not allowed, but it will work if you ignore the
- * compiler generated noise.
- */
- {
- register struct expr *pe;
- pe= (struct expr *) malloc(sizeof *pe);
- used(proc);
- check_recursion(proc);
- pe->kind=E_CALL;
- pe->type=T_VOID;
- pe->u.call.proc=proc;
- pe->u.call.args=args;
- return pe;
- }
- void table_add(aapt, val) register struct table ***aapt; long val;
- /* Adds a value to a table using a hook to a hook. */
- {
- register struct table *pt;
- pt= (struct table *) malloc(sizeof *pt);
- pt->val=val;
- pt->next= **aapt;
- **aapt=pt;
- *aapt= &pt->next;
- }
- void expr_list_add(aaelp, arg)
- register struct expr_list ***aaelp;
- struct expr *arg;
- /* Another add, this time for actual arguments and the like. */
- {
- register struct expr_list *elp;
- elp= (struct expr_list *) malloc(sizeof *elp);
- elp->arg=arg;
- elp->next= **aaelp;
- **aaelp=elp;
- *aaelp= &elp->next;
- }
- void check_io(out, arg) int out; struct expr *arg;
- {
- if (out)
- outputable(arg);
- else
- inputable(arg);
- }
- void check_wait(e) struct expr *e;
- {
- if ((e->type&T_TYPE)!=T_VALUE)
- report("WAIT process needs valued operand");
- }
- static void assigned(e) register struct expr *e;
- /* Tries to tell e that it is assigned to. */
- {
- if (e->kind==E_VAR || (e->kind==E_NODE && e->u.node.op=='['
- && (e=e->u.node.left)->kind==E_VAR)
- ) {
- register struct symbol *var;
- if ((var=e->u.var)->type&T_REP) {
- warning("replicator index %s may not be assigned",
- var->name);
- var->type&= ~T_REP;
- }
- var->type|=T_ASSIGNED;
- }
- }
- void used(e) register struct expr *e;
- {
- if (e->kind==E_VAR || (e->kind==E_NODE && e->u.node.op=='['
- && (e=e->u.node.left)->kind==E_VAR)
- ) {
- register struct symbol *var;
- if ( ! ( (var=e->u.var)->type&(T_ASSIGNED|T_BUILTIN))
- && (var->type&T_TYPE)==T_VAR
- && var->info.vc.st.level==curr_level)
- warning("%s used before assigned", var->name);
- var->type|=(T_USED|T_ASSIGNED);
- }
- }
- static void rvalue(e) register struct expr *e;
- {
- if ((e->type&T_TYPE)!=T_VALUE || e->type&T_ARR)
- report("illegal operand of arithmetic operator");
- used(e);
- }
- static void assignable(l, r) register struct expr *l, *r;
- /* See if l can be assigned r. */
- {
- if ( ! ( (l->type&T_LVALUE && (r->type&T_TYPE)==T_VALUE
- && (l->type&T_ARR)==(r->type&T_ARR))
- || (l->type|r->type)&T_NOTDECL
- ))
- report("operands of assignment are not conformable");
- else
- if (l->type&T_ARR && ! ( (l->type|r->type)&T_NOTDECL ) ) {
- register lsiz=l->arr_siz, rsiz=r->arr_siz;
- if (lsiz!=0 && rsiz!=0 && lsiz!=rsiz)
- report("arrays have incompatible sizes");
- }
- used(r);
- assigned(l);
-
- }
- static void inputable(e) struct expr *e;
- {
- if ( ! (e->type&T_LVALUE) )
- report("operand of input process can't be assigned");
- assigned(e);
- }
- static void outputable(e) struct expr *e;
- {
- if ( ! ( (e->type&T_TYPE)==T_VALUE ) )
- report("operand of output process has no value");
- used(e);
- }
- static void subscriptable(l, r, byte, atype, arr_siz)
- register struct expr *l, *r;
- register byte;
- int *atype, *arr_siz;
- /* Tries to subscript l by r, returning type and array size for slices. */
- {
- register type= (l->type&T_TYPE)|byte;
- if ( !(l->type&(T_ARR|T_NOTDECL) ) )
- report("indexing on a non-array");
- else
- if ( ! ( (r->type&T_TYPE)==T_VALUE
- || (r->kind==E_NODE && r->u.node.op==FOR)
- ) )
- report("index is not computable");
- type|=(l->type&T_LVALUE);
- if (r->kind==E_NODE && r->u.node.op==FOR) {
- type|=T_ARR;
- if (r->u.node.right->kind!=E_CONST)
- report("slice must be of constant size");
- else
- *arr_siz=r->u.node.right->u.const;
- used(r->u.node.left);
- } else
- used(r);
- *atype=type;
- }
- void check_param(aform, act, err)
- struct par_list **aform;
- register struct expr *act;
- int *err;
- /* Test if formal parameter *aform corresponds with actual act. Err returns
- * error status. The aform hook is set to the next formal after the check.
- */
- {
- register struct par_list *form= *aform;
- register struct expr *left;
- register struct symbol *var;
- static char NONCORR[]="actual and formal parameter don't correspond";
- if (form==nil) {
- if (! *err) {
- report("too many actual parameters");
- *err=1;
- }
- return;
- }
- if ((form->type&T_ARR)!=(act->type&T_ARR) && !(act->type&T_NOTDECL) ) {
- report(NONCORR);
- } else {
- switch (form->type&T_TYPE) {
- case T_VAR:
- if ( ! (
- (act->type&T_TYPE)==T_VALUE
- && act->type&T_LVALUE
- && !(act->type&T_BYTE)
- ))
- report(NONCORR);
- assigned(act);
- used(act);
- break;
- case T_CHAN:
- if((act->type&T_TYPE)!=T_CHAN && !(act->type&T_NOTDECL))
- report(NONCORR);
- used(act);
- break;
- case T_VALUE:
- if ((act->type&T_TYPE)!=T_VALUE)
- report(NONCORR);
- used(act);
- break;
- }
- }
- *aform= form->next;
- }
- void destroy(e) register struct expr *e;
- /* Opposite of making. */
- {
- if (e!=nil) {
- switch (e->kind) {
- case E_NODE:
- destroy(e->u.node.left);
- destroy(e->u.node.right);
- break;
- case E_IO:
- case E_CALL:
- destroy(e->kind==E_IO ? e->u.io.chan : e->u.call.proc);
- {
- register struct expr_list *elp, *junk;
- elp= e->kind==E_IO ? e->u.io.args : e->u.call.args;
- while (elp!=nil) {
- destroy(elp->arg);
- junk=elp;
- elp=elp->next;
- free(junk);
- }
- }
- break;
- }
- free(e);
- }
- }
|