lang/occam/comp/expr.c

   1 /* $Id: expr.c,v 1.9 1994/06/24 12:26:55 ceriel Exp $ */
   2 /*
   3  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
   4  * See the copyright notice in the ACK home directory, in the file "Copyright".
   5  */
   6 #include "symtab.h"
   7 #include "sizes.h"
   8 #include "expr.h"
   9 #include "Lpars.h"
  10
  11 static void rvalue(), assignable(), inputable(), outputable(), subscriptable();
  12 static void assigned();
  13 char *Malloc();
  14
  15 /* The new_* functions make use of the used() and assinged() functions to
  16  * make known what is done to a variable.
  17  */
  18
  19 struct expr *new_node(op, left, right, byte)
  20         int op;
  21         register struct expr *left, *right;
  22         int byte;
  23 /* Makes a new node with given operator, left and right operand.
  24  * Constant folding is done if possible.
  25  */
  26 {
  27         if (op!=FOR && constant(left) && (right==nil || constant(right))) {
  28                 register long lc, rc;
  29
  30                 lc=left->u.cst;
  31                 if (right) rc=right->u.cst; else rc = 0;
  32
  33                 switch (op) {
  34                 case '+':       lc+=rc; break;
  35                 case '-':       lc-=rc; break;
  36                 case '*':       lc*=rc; break;
  37                 case '/':       if (rc==0L)
  38                                         report("division by zero");
  39                                 else
  40                                         lc/=rc;
  41                                 break;
  42                 case BS:        lc%=rc; break;
  43                 case '<':       lc= lc<rc ? -1L : 0L; break;
  44                 case '>':       lc= lc>rc ? -1L : 0L; break;
  45                 case LE:        lc= lc<=rc ? -1L : 0L; break;
  46                 case GE:        lc= lc>=rc ? -1L : 0L; break;
  47                 case NE:        lc= lc!=rc ? -1L : 0L; break;
  48                 case '=':       lc= lc==rc ? -1L : 0L; break;
  49                 case AFTER:     lc= (lc-rc)>0 ? -1L : 0L; break;
  50                 case BA:        lc&=rc; break;
  51                 case BO:        lc|=rc; break;
  52                 case BX:        lc^=rc; break;
  53                 case AND:       lc= lc&&rc ? -1L : 0L; break;
  54                 case OR:        lc= lc||rc ? -1L : 0L; break;
  55                 case LS:        lc<<=rc; break;
  56                 case RS:        lc>>=rc; break;
  57                 case '~':       lc= -lc; break;
  58                 case NOT:       lc= ~lc; break;
  59                 default:
  60                         report("illegal operator on constants");
  61                 }
  62                 destroy(right);
  63
  64                 left->u.cst=lc;
  65                 return left;
  66         } else {
  67                 register struct expr *pe;
  68                 int type=0, arr_siz=1;
  69
  70                 switch (op) {
  71                 case '+':       case '-':       case '*':       case '/':
  72                 case BS:        case '<':       case '>':       case LE:
  73                 case GE:        case NE:        case '=':       case AFTER:
  74                 case BA:        case BO:        case BX:        case AND:
  75                 case OR:        case LS:        case RS:
  76                         rvalue(left);
  77                         rvalue(right);
  78                         type=T_VALUE;
  79                         break;
  80                 case '~':
  81                 case NOT:
  82                         rvalue(left);
  83                         type=T_VALUE;
  84                         break;
  85                 case AS:
  86                         assignable(left, right);
  87                         type=T_VOID;
  88                         break;
  89                 case '[':
  90                         subscriptable(left, right, byte, &type, &arr_siz);
  91                         break;
  92                 }
  93                 pe= (struct expr *) Malloc(sizeof *pe);
  94
  95                 pe->kind=E_NODE;
  96                 pe->type=type;
  97                 pe->arr_siz=arr_siz;
  98                 pe->u.node.op=op;
  99                 pe->u.node.left=left;
 100                 pe->u.node.right=right;
 101
 102                 return pe;
 103         }
 104 }
 105
 106 struct expr *new_var(var)
 107         register struct symbol *var;
 108 /* Given a variable an expression node is constructed.  Note the changes in
 109  * type!  T_VAR becomes T_VALUE with flag T_LVALUE.
 110  */
 111 {
 112         register struct expr *pe;
 113
 114         pe= (struct expr *) Malloc(sizeof *pe);
 115
 116         pe->kind=E_VAR;
 117
 118         if ((var->s_type&T_TYPE)==T_VAR || var->s_type&T_NOTDECL) {
 119                 pe->type=(var->s_type&(~T_TYPE));
 120                 pe->type|=T_VALUE|T_LVALUE;
 121         } else
 122                 pe->type=var->s_type;
 123
 124         pe->arr_siz=var->s_arr_siz;
 125
 126         pe->u.var=var;
 127
 128         return pe;
 129 }
 130
 131 struct expr *new_const(cst)
 132         long cst;
 133 /* Make a constant, which is a VALUE, of course. */
 134 {
 135         register struct expr *pe;
 136
 137         pe= (struct expr *) Malloc(sizeof *pe);
 138
 139         pe->kind=E_CONST;
 140         pe->type=T_VALUE;
 141         pe->u.cst=cst;
 142
 143         return pe;
 144 }
 145
 146 struct expr *new_table(kind, tab)
 147         register kind;
 148         register struct table *tab;
 149 /* One table is being made, it is no doubt a VALUEd ARRay, but maybe even a
 150  * BYTE array.  A label is reserved for it and the individual elements are
 151  * rommified.
 152  */
 153 {
 154         register struct expr *pe;
 155
 156         pe= (struct expr *) Malloc(sizeof *pe);
 157
 158         pe->kind=kind;
 159         pe->type=T_VALUE|T_ARR;
 160         if (kind==E_BTAB) pe->type|=T_BYTE;
 161         dot_label(new_dot_label(&pe->u.tab));
 162
 163         pe->arr_siz=0;
 164         while (tab!=nil) {
 165                 register struct table *junk=tab;
 166
 167                 rom(kind==E_BTAB ? 1 : vz, tab->val);
 168
 169                 tab=tab->next;
 170                 pe->arr_siz++;
 171                 free((char *)junk);
 172         }
 173
 174         return pe;
 175 }
 176
 177 struct expr *copy_const(e) struct expr *e;
 178 /* If you double it up, you've got one you can throw away.  (Or do something
 179  * useful with).
 180  */
 181 {
 182         register struct expr *c;
 183
 184         c= (struct expr *) Malloc(sizeof *c);
 185
 186         *c= *e;
 187         return c;
 188 }
 189
 190 struct expr *new_now()
 191 /* Now is the time to make a VALUE cell for the clock. */
 192 {
 193         register struct expr *pe;
 194
 195         pe= (struct expr *) Malloc(sizeof *pe);
 196
 197         pe->kind=E_NOW;
 198         pe->type=T_VALUE;
 199
 200         return pe;
 201 }
 202
 203 struct expr *new_io(out, chan, args)
 204         int out;
 205         register struct expr *chan;
 206         struct expr_list *args;
 207 /* Either c ? v0; v1; v2; ... (out=0) or c ! e0; e1; e2; ... (out=1). */
 208 {
 209         register struct expr *pe;
 210
 211         if ( ( (chan->type&T_TYPE) != T_CHAN || (chan->type&T_ARR) )
 212                 && ! (chan->type&T_NOTDECL)
 213         )
 214                 report("channel variable expected");
 215         used(chan);
 216
 217         pe= (struct expr *) Malloc(sizeof *pe);
 218
 219         pe->kind=E_IO;
 220         pe->type=T_VOID;
 221         pe->u.io.out=out;
 222         pe->u.io.chan=chan;
 223         pe->u.io.args=args;
 224
 225         return pe;
 226 }
 227
 228 struct expr *new_call(proc, args)
 229         struct expr *proc;
 230         struct expr_list *args;
 231 /* Dial proc(arg1, arg2, ...) and you'll hear the tone of this function.
 232  * Dialing yourself is not allowed, but it will work if you ignore the
 233  * compiler generated noise.
 234  */
 235 {
 236         register struct expr *pe;
 237
 238         pe= (struct expr *) Malloc(sizeof *pe);
 239
 240         used(proc);
 241
 242         check_recursion(proc);
 243
 244         pe->kind=E_CALL;
 245         pe->type=T_VOID;
 246         pe->u.call.c_proc=proc;
 247         pe->u.call.c_args=args;
 248
 249         return pe;
 250 }
 251
 252 void table_add(aapt, val) register struct table ***aapt; long val;
 253 /* Adds a value to a table using a hook to a hook. */
 254 {
 255         register struct table *pt;
 256
 257         pt= (struct table *) Malloc(sizeof *pt);
 258
 259         pt->val=val;
 260         pt->next= **aapt;
 261
 262         **aapt=pt;
 263         *aapt= &pt->next;
 264 }
 265
 266 void expr_list_add(aaelp, arg)
 267         register struct expr_list ***aaelp;
 268         struct expr *arg;
 269 /* Another add, this time for actual arguments and the like. */
 270 {
 271         register struct expr_list *elp;
 272
 273         elp= (struct expr_list *) Malloc(sizeof *elp);
 274
 275         elp->arg=arg;
 276         elp->next= **aaelp;
 277         **aaelp=elp;
 278         *aaelp= &elp->next;
 279 }
 280
 281 void check_io(out, arg) int out; struct expr *arg;
 282 {
 283         if (out)
 284                 outputable(arg);
 285         else
 286                 inputable(arg);
 287 }
 288
 289 void check_wait(e) struct expr *e;
 290 {
 291         if ((e->type&T_TYPE)!=T_VALUE)
 292                 report("WAIT process needs valued operand");
 293 }
 294
 295 static void assigned(e) register struct expr *e;
 296 /* Tries to tell e that it is assigned to. */
 297 {
 298         if (e->kind==E_VAR || (e->kind==E_NODE && e->u.node.op=='['
 299                 && (e=e->u.node.left)->kind==E_VAR)
 300         ) {
 301                 register struct symbol *var;
 302
 303                 if ((var=e->u.var)->s_type&T_REP) {
 304                         warning("replicator index %s may not be assigned",
 305                                 var->s_name);
 306                         var->s_type&= ~T_REP;
 307                 }
 308                 var->s_type|=T_ASSIGNED;
 309         }
 310 }
 311
 312 void used(e) register struct expr *e;
 313 {
 314         if (e->kind==E_VAR || (e->kind==E_NODE && e->u.node.op=='['
 315                 && (e=e->u.node.left)->kind==E_VAR)
 316         ) {
 317                 register struct symbol *var;
 318
 319                 if ( ! ( (var=e->u.var)->s_type&(T_ASSIGNED|T_BUILTIN))
 320                     && (var->s_type&T_TYPE)==T_VAR
 321                     && var->s_info.vc.st.level==curr_level)
 322                         warning("%s used before assigned", var->s_name);
 323                 var->s_type|=(T_USED|T_ASSIGNED);
 324         }
 325 }
 326
 327 static void rvalue(e) register struct expr *e;
 328 {
 329         if ((e->type&T_TYPE)!=T_VALUE || e->type&T_ARR)
 330                 report("illegal operand of arithmetic operator");
 331         used(e);
 332 }
 333
 334 static void assignable(l, r) register struct expr *l, *r;
 335 /* See if l can be assigned r. */
 336 {
 337         if ( ! ( (l->type&T_LVALUE && (r->type&T_TYPE)==T_VALUE
 338                   && (l->type&T_ARR)==(r->type&T_ARR))
 339                 || (l->type|r->type)&T_NOTDECL
 340         ))
 341                 report("operands of assignment are not conformable");
 342         else
 343         if (l->type&T_ARR && ! ( (l->type|r->type)&T_NOTDECL ) ) {
 344                 register lsiz=l->arr_siz, rsiz=r->arr_siz;
 345
 346                 if (lsiz!=0 && rsiz!=0 && lsiz!=rsiz)
 347                         report("arrays have incompatible sizes");
 348         }
 349         used(r);
 350         assigned(l);
 351
 352 }
 353
 354 static void inputable(e) struct expr *e;
 355 {
 356         if ( ! (e->type&T_LVALUE) )
 357                 report("operand of input process can't be assigned");
 358
 359         assigned(e);
 360 }
 361
 362 static void outputable(e) struct expr *e;
 363 {
 364         if ( ! ( (e->type&T_TYPE)==T_VALUE ) )
 365                 report("operand of output process has no value");
 366         used(e);
 367 }
 368
 369 static void subscriptable(l, r, byte, atype, arr_siz)
 370         register struct expr *l, *r;
 371         register byte;
 372         int *atype, *arr_siz;
 373 /* Tries to subscript l by r, returning type and array size for slices. */
 374 {
 375         register type= (l->type&T_TYPE)|byte;
 376
 377         if ( !(l->type&(T_ARR|T_NOTDECL) ) )
 378                 report("indexing on a non-array");
 379         else
 380         if ( ! ( (r->type&T_TYPE)==T_VALUE
 381                 || (r->kind==E_NODE && r->u.node.op==FOR)
 382         ) )
 383                 report("index is not computable");
 384
 385         type|=(l->type&T_LVALUE);
 386
 387         if (r->kind==E_NODE && r->u.node.op==FOR) {
 388                 type|=T_ARR;
 389                 if (r->u.node.right->kind!=E_CONST)
 390                         report("slice must be of constant size");
 391                 else
 392                         *arr_siz=r->u.node.right->u.cst;
 393                 used(r->u.node.left);
 394         } else
 395                 used(r);
 396         *atype=type;
 397 }
 398
 399 void check_param(aform, act, err)
 400         struct par_list **aform;
 401         register struct expr *act;
 402         int *err;
 403 /* Test if formal parameter *aform corresponds with actual act.  Err returns
 404  * error status.  The aform hook is set to the next formal after the check.
 405  */
 406 {
 407         register struct par_list *form= *aform;
 408         register struct expr *left;
 409         register struct symbol *var;
 410         static char NONCORR[]="actual and formal parameter don't correspond";
 411
 412         if (form==nil) {
 413                 if (! *err) {
 414                         report("too many actual parameters");
 415                         *err=1;
 416                 }
 417                 return;
 418         }
 419
 420         if ((form->pr_type&T_ARR)!=(act->type&T_ARR) && !(act->type&T_NOTDECL) ) {
 421                         report(NONCORR);
 422         } else {
 423                 switch (form->pr_type&T_TYPE) {
 424                 case T_VAR:
 425                         if ( ! (
 426                                 (act->type&T_TYPE)==T_VALUE
 427                                 && act->type&T_LVALUE
 428                                 && !(act->type&T_BYTE)
 429                         ))
 430                                 report(NONCORR);
 431                         assigned(act);
 432                         used(act);
 433                         break;
 434                 case T_CHAN:
 435                         if((act->type&T_TYPE)!=T_CHAN && !(act->type&T_NOTDECL))
 436                                 report(NONCORR);
 437                         used(act);
 438                         break;
 439                 case T_VALUE:
 440                         if ((act->type&T_TYPE)!=T_VALUE)
 441                                 report(NONCORR);
 442                         used(act);
 443                         break;
 444                 }
 445         }
 446         *aform= form->pr_next;
 447 }
 448
 449 void destroy(e) register struct expr *e;
 450 /* Opposite of making. */
 451 {
 452         if (e!=nil) {
 453                 switch (e->kind) {
 454                 case E_NODE:
 455                         destroy(e->u.node.left);
 456                         destroy(e->u.node.right);
 457                         break;
 458                 case E_IO:
 459                 case E_CALL:
 460                         destroy(e->kind==E_IO ? e->u.io.chan : e->u.call.c_proc);
 461                         {
 462                                 register struct expr_list *elp, *junk;
 463
 464                                 elp= e->kind==E_IO ? e->u.io.args : e->u.call.c_args;
 465
 466                                 while (elp!=nil) {
 467                                         destroy(elp->arg);
 468                                         junk=elp;
 469                                         elp=elp->next;
 470                                         free((char *)junk);
 471                                 }
 472                         }
 473                         break;
 474                 }
 475                 free((char *)e);
 476         }
 477 }