123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750 |
- /* $Header$ */
- /*
- * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
- * See the copyright notice in the ACK home directory, in the file "Copyright".
- */
- /* OCCAM */
- {
- #include "token.h"
- #include "symtab.h"
- #include "expr.h"
- #include "code.h"
- #include "sizes.h"
- #include <system.h>
- #include <em.h>
- #define MAXERRORS 10 /* Maximum number of insert/delete errors */
- static void nonconst(), nonpositive(), rep_cleanup(), check_assoc();
- void init_builtins();
- extern int yylineno, LLsymb;
- union type_info info, none;
- }
- %token AFTER, ALLOCATE, ALT, AND, ANY, BYTE, CHAN, DEF, FALSE, FOR, IF, LOAD;
- %token NOT, NOW, OR, PAR, PLACED, PORT, PRI, PROC, SEQ, SKIP, TABLE, TRUE;
- %token VALUE, VAR, WAIT, WHILE;
- %token IDENTIFIER, NUMBER, CHAR_CONST, STRING;
- %token AS, LE, GE, NE, LS, RS, BA, BO, BX, BS;
- %start occam, program;
- program : { init_builtins();
- header();
- }
- process
- ;
- process : primitive
- | construct
- | { sym_down(); }
- declaration ':' process
- { sym_up(); }
- ;
- primitive { struct expr *e; } :
- statement(&e) { if (!valueless(e))
- report("primitive may not have a value");
- code_void(e);
- destroy(e);
- }
- | WAIT val_expr(&e) { int BEGIN=0, END=0, TEST=0;
- check_wait(e);
- no_deadlock();
- branch(&TEST);
- Label(new_label(&BEGIN));
- resumenext();
- Label(TEST);
- code_bool(e, positive, &END, &BEGIN);
- Label(END);
- destroy(e);
- }
- | SKIP
- ;
- guard(register *F;) { struct expr *e1, *e2;
- register full_guard=0;
- int T=0;
- static char EXPECT_INP[]="input process expected as guard";
- } :
- expression(&e1)
- [ '&' { full_guard=1;
- if (!valued(e1))
- report("boolean part of guard has no value");
- code_bool(e1, positive, &T, F);
- Label(T);
- }
- [ statement(&e2)
- { if (!input_process(e2))
- report(EXPECT_INP);
- code_any(e2, F);
- destroy(e2);
- }
- | WAIT val_expr(&e2)
- { check_wait(e2);
- code_bool(e2, positive, &T, F);
- Label(T);
- destroy(e2);
- }
- | SKIP
- ]
- ]?
- { if (!full_guard) {
- if (!input_process(e1))
- report(EXPECT_INP);
- code_any(e1, F);
- }
- destroy(e1);
- }
- | WAIT val_expr(&e1)
- { check_wait(e1);
- code_bool(e1, positive, &T, F);
- Label(T);
- destroy(e1);
- }
- | SKIP
- ;
- guarded_process(register *END;) { struct symbol *v;
- struct expr *e1, *e2;
- struct replicator to_test;
- register line, oind;
- int F=0;
- } :
- guard(&F) process { branch(END);
- Label(F);
- }
- | ALT { line=yylineno; oind=ind; }
- [ %if (line==yylineno)
- replicator(&v, &e1, &e2)
- { rep_init(v, e1, e2, &to_test); }
- guarded_process(END)
- { rep_test(v, e1, e2, &to_test);
- rep_cleanup(e1, e2);
- }
- |
- [ %while (tabulated(oind, ind)) guarded_process(END) ]*
- ]
- ;
- conditional(register *END; ) { struct symbol *v;
- struct expr *e1, *e2;
- struct replicator to_test;
- register line, oind;
- int T=0, F=0;
- } :
- val_expr(&e1) { if (!valued(e1))
- report("conditional needs valued expression");
- code_bool(e1, positive, &T, &F);
- Label(T);
- destroy(e1);
- }
- process
- { branch(END);
- Label(F);
- }
- | IF { line=yylineno; oind=ind; }
- [ %if (line==yylineno)
- replicator(&v, &e1, &e2)
- { rep_init(v, e1, e2, &to_test); }
- conditional(END)
- { rep_test(v, e1, e2, &to_test);
- rep_cleanup(e1, e2);
- }
- |
- [ %while (tabulated(oind, ind)) conditional(END) ]*
- ]
- ;
- replicator(register struct symbol **s; register struct expr **e1, **e2; )
- { register char *index; }:
- IDENTIFIER { index=token.t_sval; }
- '=' '[' val_expr(e1) FOR val_expr(e2) ']'
- { if (!valued(*e1) || !valued(*e2))
- report("replicator needs valued expressions");
- sym_down();
- var_memory(&info, T_VAR, 1);
- *s=insert(index,
- T_VAR|T_REP|T_USED|T_ASSIGNED, 1, &info);
- }
- ;
- construct { struct symbol *v;
- struct expr *e1, *e2;
- struct replicator to_test;
- register line, oind;
- int BEGIN=0, END=0, NONZERO;
- }:
- SEQ { line=yylineno; oind=ind; }
- [ %if (line==yylineno)
- replicator(&v, &e1, &e2)
- { rep_init(v, e1, e2, &to_test); }
- process
- { rep_test(v, e1, e2, &to_test);
- rep_cleanup(e1, e2);
- }
- |
- [ %while (tabulated(oind, ind)) process ]*
- ]
- | PRI ?
- [ PAR { line=yylineno; oind=ind;
- par_begin();
- }
- [ %if (line==yylineno)
- replicator(&v, &e1, &e2)
- { rep_init(v, e1, e2, &to_test);
- NONZERO=0;
- par_fork(&NONZERO);
- }
- process
- { branch(&END);
- Label(NONZERO);
- rep_test(v, e1, e2, &to_test);
- rep_cleanup(e1, e2);
- }
- |
- [ %while (tabulated(oind, ind))
- { NONZERO=0;
- par_fork(&NONZERO);
- }
- process
- { branch(&END);
- Label(NONZERO);
- }
- ]*
- ]
- { Label(END);
- par_end();
- }
- | ALT { line=yylineno; oind=ind;
- no_deadlock();
- Label(new_label(&BEGIN));
- }
- [ %if (line==yylineno)
- replicator(&v, &e1, &e2)
- { rep_init(v, e1, e2, &to_test); }
- guarded_process(&END)
- { rep_test(v, e1, e2, &to_test);
- rep_cleanup(e1, e2);
- }
- |
- [ %while (tabulated(oind, ind)) guarded_process(&END)
- ]*
- ]
- { resumenext();
- branch(&BEGIN);
- Label(END);
- }
- ]
- | IF { line=yylineno; oind=ind; }
- [ %if (line==yylineno)
- replicator(&v, &e1, &e2)
- { rep_init(v, e1, e2, &to_test); }
- conditional(&END)
- { rep_test(v, e1, e2, &to_test);
- rep_cleanup(e1, e2);
- }
- |
- [ %while (tabulated(oind, ind)) conditional(&END) ]*
- ]
- { Label(END); }
- | WHILE val_expr(&e1) { if (!valued(e1))
- report("WHILE needs valued expression");
- branch(&END);
- Label(new_label(&BEGIN));
- }
- process
- { int DONE=0;
- Label(END);
- code_bool(e1, negative, &DONE, &BEGIN);
- Label(DONE);
- destroy(e1);
- }
- ;
- subscript(register *byte; register struct expr **e; )
- { struct expr *e1;
- register slice=0, err=0;
- } :
- '[' { *byte=0; }
- [ BYTE { *byte=T_BYTE; }
- ]?
- val_expr(e) { if (!valued(*e))
- err++;
- }
- [ FOR expression(&e1)
- { static char siz[]="slize size";
- if (!constant(e1)) {
- if (!err)
- nonconst(siz);
- destroy(e1);
- e1=new_const(0L);
- } else
- if (e1->u.const<=0)
- nonpositive(siz);
- *e=new_node(FOR, *e, e1);
- slice=1;
- }
- ]?
- ']'
- { if (err)
- report(slice ?
- "slice must be '[' value FOR constant ']'" :
- "subscript needs valued expression");
- }
- ;
- chan { register type, arr_siz=1; register char *name; struct expr *e; }:
- IDENTIFIER { type=T_CHAN;
- name=token.t_sval;
- }
- [ '[' expression(&e) ']'
- { static char siz[]="channel array size";
- if (!constant(e))
- nonconst(siz);
- else
- if (e->u.const<0)
- nonpositive(siz);
- else
- arr_siz=e->u.const;
- destroy(e);
- type|=T_ARR;
- }
- ]?
- { chan_memory(&info, arr_siz);
- chan_init(&info, arr_siz);
- insert(name, type, arr_siz, &info);
- }
- ;
- var { register type, byte=0, arr_siz=1;
- register char *name;
- struct expr *e;
- }:
- IDENTIFIER { type=T_VAR; name=token.t_sval; }
- [ '['
- [ BYTE { byte=T_BYTE; }
- ]?
- expression(&e) ']'
- { static char siz[]="variable array size";
- if (!constant(e))
- nonconst(siz);
- else
- if (e->u.const<=0)
- nonpositive(siz);
- else
- arr_siz=e->u.const;
- destroy(e);
- type|=T_ARR|byte;
- }
- ]?
- { var_memory(&info, type, arr_siz);
- insert(name, type, arr_siz, &info);
- }
- ;
- const_def { register char *name; struct expr *e; }:
- IDENTIFIER { name=token.t_sval; }
- '=' expression(&e)
- { if (!constant(e) && !arr_constant(e))
- nonconst("expression in constant definition");
- info.const=e;
- insert(name, T_CONST|T_USED, 0, &info);
- }
- ;
- form_parm(register struct par_list ***aapars; register *g_type;)
- { register char *name;
- register type= *g_type;
- }:
- [ VAR { type=T_VAR|T_ASSIGNED|T_USED; }
- | CHAN { type=T_CHAN; }
- | VALUE { type=T_VALUE|T_ASSIGNED; }
- ]?
- IDENTIFIER {
- if (type<0) {
- report("VAR, CHAN or VALUE expected");
- type=T_VAR;
- }
- name=token.t_sval;
- *g_type=type;
- }
- [ '[' ']'
- { type|=T_ARR; }
- ]?
- { pars_add(aapars, type&(T_TYPE|T_ARR),
- insert(name, type|T_PARAM, 0, &none));
- }
- ;
- form_parms(struct par_list **apars;) { int type= -1; }:
- '(' form_parm(&apars, &type)
- [ ',' form_parm(&apars, &type)
- ]*
- ')'
- ;
- declaration:
- VAR
- var [ ',' var ]*
- | CHAN
- chan [ ',' chan ]*
- | DEF
- const_def [ ',' const_def ]*
- | proc_declaration
- ;
-
- proc_declaration { struct par_list *pars=nil;
- register struct symbol *proc;
- int OVER=0;
- register old_min_offset;
- }:
- PROC IDENTIFIER { branch(&OVER);
- proc=insert(token.t_sval,
- T_PROC|T_RECURS, 0, &none);
- old_min_offset=min_offset;
- sym_down();
- prologue(proc);
- }
- form_parms(&pars) ? { form_offsets(pars);
- proc->info.proc.pars=pars;
- }
- '=' process { epilogue(proc);
- sym_up();
- proc->type&= ~T_RECURS;
- min_offset=old_min_offset;
- Label(OVER);
- }
- ;
- vector_constant(register struct expr **e;)
- { struct table *pt=nil, **apt= &pt;
- register Tlen=0;
- }:
- table(e)
- | STRING { register char *ps= token.t_sval;
- register len;
- Tlen+= len= (*ps++ & 0377);
- while (--len>=0)
- table_add(&apt, (long) *ps++);
- }
- [ %while (1) STRING
- { register char *ps= token.t_sval;
- register len;
- Tlen+= len= (*ps++ & 0377);
- while (--len>=0)
- table_add(&apt, (long) *ps++);
- }
- ]*
- { apt= &pt;
- table_add(&apt, (long) Tlen);
- *e=new_table(E_BTAB, pt);
- }
- ;
- item(register struct expr **e;)
- { struct expr *e1;
- register struct symbol *var;
- struct par_list *pars=nil;
- register line, oind;
- int byte, err=0, subs_call=0;
- struct expr_list *elp=nil, **aelp= &elp;
- }:
- IDENTIFIER { line=yylineno;
- oind=ind;
- var=searchall(token.t_sval);
- if (var_constant(var))
- *e=copy_const(var->info.const);
- else {
- if (var_proc(var))
- pars=var->info.proc.pars;
- *e=new_var(var);
- }
- }
- [ %while (line==yylineno || tabulated(oind, ind))
- [ subscript(&byte, &e1)
- { *e=new_node('[', *e, e1, byte); }
- | '(' { if (!var_declared(var)) {
- var->type=T_PROC|T_USED|T_NOTDECL;
- var->info.proc.pars=nil;
- err=1;
- }
- if (!var_proc(var)) {
- report("%s is not a named process",
- var->name);
- err=1;
- }
- }
- expression(&e1)
- { check_param(&pars, e1, &err);
- expr_list_add(&aelp, e1);
- }
- [ ',' expression(&e1)
- { check_param(&pars, e1, &err);
- expr_list_add(&aelp, e1);
- }
- ]*
- {
- if (pars!=nil)
- report("too few actual parameters");
- }
- ')'
- { *e=new_call(*e, elp); }
- ]
- { subs_call=1; }
- ]?
- { if (!subs_call && var_proc(var)) {
- if (pars!=nil)
- report("no actual parameters");
- *e=new_call(*e, nil);
- }
- }
- | vector_constant(e)
- [ subscript(&byte, &e1)
- { *e=new_node('[', *e, e1, byte); }
- ]?
- ;
- statement(register struct expr **e;)
- { struct expr *e1;
- struct expr_list *elp=nil, **aelp= &elp;
- register out;
- }:
- item(e)
- [ AS expression(&e1)
- { *e=new_node(AS, *e, e1); }
- | [
- '?' { out=0; }
- | '!' { out=1; }
- ]
- io_arg(&e1)
- { if (e1!=nil) check_io(out, e1);
- expr_list_add(&aelp, e1);
- }
- [ %while (1) ';' io_arg(&e1)
- { if (e1!=nil) check_io(out, e1);
- expr_list_add(&aelp, e1);
- }
- ]*
- { *e=new_io(out, *e, elp); }
- ]?
- ;
- io_arg(struct expr **e; ) :
- expression(e)
- | ANY { *e=nil; }
- ;
- table(register struct expr **e;)
- { struct table *pt=nil, **apt= &pt;
- struct expr *e1;
- register type;
- }:
- TABLE '[' { type=E_TABLE; }
- [ BYTE { type=E_BTAB; }
- ]?
- expression(&e1) { if (!constant(e1))
- nonconst("table element");
- else
- table_add(&apt, e1->u.const);
- destroy(e1);
- }
- [ ',' expression(&e1)
- { if (!constant(e1))
- nonconst("table element");
- else
- table_add(&apt, e1->u.const);
- destroy(e1);
- }
- ]*
- { *e=new_table(type, pt); }
- ']'
- ;
- arithmetic_op: '+' | '-' | '*' | '/' | BS
- ;
- comparison_op: '<' | '>' | LE | GE | NE | '=' | AFTER
- ;
- logical_op: BA | BO | BX
- ;
- boolean_op: AND | OR
- ;
- shift_op: LS | RS
- ;
- monadic_op(register *op;):
- '-' { *op='~'; }
- | NOT { *op=NOT; }
- ;
- operator: arithmetic_op | comparison_op | logical_op | boolean_op | shift_op
- ;
- element(register struct expr **e;) :
- %default NUMBER { *e=new_const(token.t_lval); }
- | statement(e)
- | TRUE { *e=new_const(-1L); }
- | FALSE { *e=new_const(0L); }
- | NOW { *e=new_now(); }
- | CHAR_CONST { *e=new_const(token.t_lval); }
- | '(' expression(e) ')' { if (valueless(*e))
- warning("primitive should not be parenthesized");
- }
- ;
- expression(register struct expr **e;)
- { int op=0;
- struct expr *e1;
- }:
- element(e)
- [ %while (1) { if (op!=0) check_assoc(op, LLsymb);
- op=LLsymb;
- }
- operator element(&e1)
- { *e=new_node(op, *e, e1); }
- ]*
- | monadic_op(&op) element(&e1)
- { *e=new_node(op, e1, nil); }
- ;
- val_expr(register struct expr **e;) :
- expression(e) { used(*e); }
- ;
- %lexical scanner;
- {
- int err=0;
- main(argc, argv) register argc; register char **argv;
- {
- while (argc > 1 && argv[1][0] == '-') {
- do_option(&argv[1][1]);
- argc--;
- argv++;
- }
- leader();
- occam();
- trailer();
- exit(err);
- }
- do_option(text)
- char *text;
- {
- extern int Lflag;
- switch(*text++) {
- default:
- fatal("illegal option: %c", *--text);
- case 'L' : /* no fil/lin */
- Lflag++;
- break;
- case 'V' : /* set object sizes and alignment requirements */
- {
- arith size, align;
- char c;
- while (c = *text++) {
- size = txt2int(&text);
- switch (c) {
- case 'w': /* word */
- if (size != (arith)0)
- wz = size;
- break;
- case 'p': /* pointer */
- if (size != (arith)0)
- pz = size;
- break;
- case 'l': /* long */
- if (size != (arith)0)
- vz = size;
- break;
- default:
- fatal("-V: bad type indicator %c\n", c);
- }
- }
- break;
- }
- }
- }
- int
- txt2int(tp)
- char **tp;
- {
- /* the integer pointed to by *tp is read, while increasing
- *tp; the resulting value is yielded.
- */
- register int val = 0, ch;
-
- while (ch = **tp, ch >= '0' && ch <= '9') {
- val = val * 10 + ch - '0';
- (*tp)++;
- }
- return val;
- }
- LLmessage(tk) register tk;
- {
- static errors=0;
- if (tk>0) {
- repeat_token(LLsymb);
- warning("syntax error: %s expected (inserted)", tokenname(tk, 1));
- } else
- if (tk==0)
- warning("syntax error: bad token %s (deleted)", tokenname(LLsymb, 0));
- else { /* tk<0 */
- warning("syntax error: garbage at end of program");
- }
- if (++errors==MAXERRORS) {
- fprint(STDERR, "Too many insert/delete errors. Compiler ends.\n");
- err=1; trailer(); exit(1);
- }
- }
- static void nonconst(siz) char *siz;
- {
- report("%s should be a constant", siz);
- }
- static void nonpositive(siz) char *siz;
- {
- report("%s must be positive", siz);
- }
- static void rep_cleanup(e1, e2) struct expr *e1, *e2;
- {
- destroy(e1);
- destroy(e2);
- sym_up();
- }
- static void check_assoc(prev_op, op) register prev_op, op;
- {
- switch (op) {
- char prev[5];
- case '+': case '*':
- case AND: case OR:
- case BA: case BO: case BX:
- if (prev_op==op) break;
- default:
- strcpy(prev, tokenname(prev_op, 0));
- warning("Operators %s and %s don't associate",
- prev, tokenname(op, 0)
- );
- }
- }
- }
|