From bc94559e4db5cc76c26d9ce7bd0ffed9efdc64ce Mon Sep 17 00:00:00 2001 From: ceriel Date: Tue, 24 Feb 1987 17:05:53 +0000 Subject: [PATCH] Initial revision --- lang/occam/comp/Makefile | 27 ++ lang/occam/comp/builtin.c | 74 +++++ lang/occam/comp/code.c | 607 +++++++++++++++++++++++++++++++++ lang/occam/comp/code.h | 19 ++ lang/occam/comp/em.c | 405 ++++++++++++++++++++++ lang/occam/comp/em.h | 21 ++ lang/occam/comp/expr.c | 471 ++++++++++++++++++++++++++ lang/occam/comp/expr.h | 61 ++++ lang/occam/comp/keytab.c | 82 +++++ lang/occam/comp/lex.l | 344 +++++++++++++++++++ lang/occam/comp/occam.g | 684 ++++++++++++++++++++++++++++++++++++++ lang/occam/comp/report.c | 19 ++ lang/occam/comp/sizes.h | 5 + lang/occam/comp/symtab.c | 202 +++++++++++ lang/occam/comp/symtab.h | 91 +++++ lang/occam/comp/token.h | 11 + 16 files changed, 3123 insertions(+) create mode 100644 lang/occam/comp/Makefile create mode 100644 lang/occam/comp/builtin.c create mode 100644 lang/occam/comp/code.c create mode 100644 lang/occam/comp/code.h create mode 100644 lang/occam/comp/em.c create mode 100644 lang/occam/comp/em.h create mode 100644 lang/occam/comp/expr.c create mode 100644 lang/occam/comp/expr.h create mode 100644 lang/occam/comp/keytab.c create mode 100644 lang/occam/comp/lex.l create mode 100644 lang/occam/comp/occam.g create mode 100644 lang/occam/comp/report.c create mode 100644 lang/occam/comp/sizes.h create mode 100644 lang/occam/comp/symtab.c create mode 100644 lang/occam/comp/symtab.h create mode 100644 lang/occam/comp/token.h diff --git a/lang/occam/comp/Makefile b/lang/occam/comp/Makefile new file mode 100644 index 000000000..e8608d097 --- /dev/null +++ b/lang/occam/comp/Makefile @@ -0,0 +1,27 @@ +GFILES= occam.g +PRIMARY= occam.o Lpars.o keytab.o lex.yy.o code.o em.o +SECUNDARY= symtab.o expr.o builtin.o +TERTIARY= report.o +LLOPT= +LIBRARY= -lln libemk.a libsystem.a + +all: + make dummy + make oc + +dummy: $(GFILES) + LLgen $(LLOPT) $(GFILES) + touch dummy + +oc: $(PRIMARY) $(SECUNDARY) $(TERTIARY) + $(CC) -o oc $(PRIMARY) $(SECUNDARY) $(TERTIARY) $(LIBRARY) + +lex.yy.c: lex.l + lex lex.l + +$(PRIMARY): Lpars.h +occam.o keytab.o: token.h +occam.o $(SECUNDARY): symtab.h expr.h +$(PRIMARY) $(SECUNDARY): sizes.h +occam.o code.o: code.h +code.o em.o: em.h diff --git a/lang/occam/comp/builtin.c b/lang/occam/comp/builtin.c new file mode 100644 index 000000000..f1c7a9139 --- /dev/null +++ b/lang/occam/comp/builtin.c @@ -0,0 +1,74 @@ +#include +#include "symtab.h" +#include "expr.h" +#include "sizes.h" + +void init_builtins() +/* Insert all builtin names into the outermost symbol table (first statement + * is sym_down() ). Note that this table is never destroy()ed, so static + * initializers may be used. + */ +{ + union type_info info; + + static char file[]="file"; + + static struct par_list + open_list[] = { + { &open_list[1], nil, T_VAR }, /* File descriptor */ + { &open_list[2], nil, T_VALUE|T_ARR }, /* File name */ + { nil, nil, T_VALUE|T_ARR } /* "r", "w", "a" */ + }, + close_list[]= { + { nil, nil, T_VALUE } /* File descriptor */ + }, + exit_list[]= { + { nil, nil, T_VALUE } /* Exit code */ + }; + + sym_down(); /* Add level of symbols above all others */ + + /* CHAN file[20], input=file[0], output=file[1], error=file[2]: */ + + info.vc.st.builtin=file; + info.vc.offset=0; + insert(file, T_CHAN|T_ARR|T_BUILTIN, _NFILE, info); + + info.vc.st.builtin=file; + info.vc.offset=0; + insert("input", T_CHAN|T_BUILTIN, 1, info); + + info.vc.st.builtin=file; + info.vc.offset=wz+pz; + insert("output", T_CHAN|T_BUILTIN, 1, info); + + info.vc.st.builtin=file; + info.vc.offset=2*(wz+pz); + insert("error", T_CHAN|T_BUILTIN, 1, info); + + /* DEF EOF= -1, TEXT= -2, RAW= -3: */ + + info.const=new_const(-1L); + insert("EOF", T_CONST|T_BUILTIN, 0, info); + + info.const=new_const(-2L); + insert("TEXT", T_CONST|T_BUILTIN, 0, info); + + info.const=new_const(-3L); + insert("RAW", T_CONST|T_BUILTIN, 0, info); + + /* PROC open(VAR fd, VALUE name[], mode[])= .... : */ + info.proc.st.builtin="b_open"; + info.proc.pars=open_list; + insert("open", T_PROC|T_BUILTIN, 0, info); + + /* PROC close(VALUE fd)= .... : */ + info.proc.st.builtin="b_close"; + info.proc.pars=close_list; + insert("close", T_PROC|T_BUILTIN, 0, info); + + /* PROC exit(VALUE code)= .... : */ + info.proc.st.builtin="b_exit"; + info.proc.pars=exit_list; + insert("exit", T_PROC|T_BUILTIN, 0, info); +} diff --git a/lang/occam/comp/code.c b/lang/occam/comp/code.c new file mode 100644 index 000000000..d8a752379 --- /dev/null +++ b/lang/occam/comp/code.c @@ -0,0 +1,607 @@ +#include "em.h" +#include "expr.h" +#include "symtab.h" +#include "sizes.h" +#include "Lpars.h" +#include "code.h" + +extern err; + +static void subscript(); +enum addr_val { address, value }; + +void code_val(e) register struct expr *e; +/* Compile e for its value, which is put on the stack. */ +{ + register struct expr *left, *right; + + if (err) return; + + switch(e->kind) { + case E_NODE: + left=e->u.node.left; + right=e->u.node.right; + + switch (e->u.node.op) { + case '+': + case '-': + case '*': + case '/': + case BS: + code_val(left); + code_val(right); + xxi(e->u.node.op); + break; + case '<': + case '>': + case LE: + case GE: + case NE: + case '=': + code_val(left); + code_val(right); + cmi(); + Txx(e->u.node.op); + break; + case AFTER: + code_val(left); + code_val(right); + xxi('-'); + cvw(); + tst(); + Txx('>'); + break; + case BA: + code_val(left); + code_val(right); + and(); + break; + case BO: + code_val(left); + code_val(right); + ior(); + break; + case BX: + code_val(left); + code_val(right); + xor(); + break; + case AND: + case OR: { + int T=0, F=0, L=0; + + code_bool(e, positive, &T, &F); + Label(T); + Loc(-1L); + branch(&L); + Label(F); + Loc(0L); + Label(L); + }break; + case LS: + code_val(left); + code_val(right); + cvw(); + sli(); + break; + case RS: + code_val(left); + code_val(right); + cvw(); + sri(); + break; + case '~': + code_val(left); + ngi(); + break; + case NOT: + code_val(left); + com(); + break; + case '[': + subscript(e, value); + break; + } + break; + case E_VAR: { + register struct symbol *var=e->u.var; + + if (var->type&T_BUILTIN) + Loe(var->info.vc.st.builtin, var->info.vc.offset); + else + if (var->info.vc.st.level==curr_level) + if (var->type&T_PARAM && (var->type&T_TYPE)!=T_VALUE) + Lil(var->info.vc.offset); + else + Lol(var->info.vc.offset); + else { + if (var->info.vc.offset<0) + lxl(curr_level-var->info.vc.st.level); + else + lxa(curr_level-var->info.vc.st.level); + if (var->type&T_PARAM && (var->type&T_TYPE)!=T_VALUE) + Lif(var->info.vc.offset); + else + Lof(var->info.vc.offset); + } + }break; + case E_CONST: + Loc(e->u.const); + break; + case E_NOW: + cal("now"); + lfr(vz); + break; + } +} + +static void subscript(e, av) register struct expr *e; enum addr_val av; +/* Produce code to compute the address or value of e->left[e->right] or + * the address of e->left[e->right->left FOR e->right->right]. + */ +{ + register char *des; + register struct expr *left; + register struct expr *index; + + code_addr(left=e->u.node.left); + + if ((index=e->u.node.right)->kind==E_NODE && index->u.node.op==FOR) + index=index->u.node.left; + + if (left->arr_siz==0) { + if ((left->type&T_TYPE)==T_CHAN) + des="maxcdes"; + else + des= e->type&T_BYTE ? "maxbdes" : "maxwdes"; + } else { + register lsiz=left->arr_siz; + + if (left->type&T_BYTE && !(e->type&T_BYTE)) + lsiz/=vz; + else + if (!(left->type&T_BYTE) && e->type&T_BYTE) + lsiz*=vz; + + if (e->type&T_ARR) + lsiz-=(e->arr_siz -1); + + if (constant(index)) { + if (index->u.const<0 || index->u.const>=lsiz) { + warning("constant index outside vector"); + lin(); + loc(0); + trp(); + } + } else { + loc(lsiz); + + if ((left->type&T_TYPE)==T_CHAN) + des="chandes"; + else + des= e->type&T_BYTE ? "bytedes" : "worddes"; + ste(des, wz); + } + } + if (constant(index)) { + register offset=index->u.const; + + if ((left->type&T_TYPE)==T_CHAN) + offset*=(wz+vz); + else + if ( !(e->type&T_BYTE) ) + offset*=vz; + + if (av==address) + adp(offset); + else { + if (e->type&T_BYTE) { + adp(offset); + loi(1); + cwv(); + } else + Lof(offset); + } + } else { + code_val(index); + cvw(); + lin(); + lae(des, 0); + if (av==address) { + aar(); + } else { + lar(); + if (e->type&T_BYTE) cwv(); + } + } +} + +void code_addr(e) register struct expr *e; +/* The address of e is wat we want. */ +{ + if (err) return; + + switch(e->kind) { + case E_NODE: + subscript(e, address); + break; + case E_VAR: { /* variable or channel */ + register struct symbol *var=e->u.var; + + if (var->type&T_BUILTIN) + lae(var->info.vc.st.builtin, var->info.vc.offset); + else + if (var->info.vc.st.level==curr_level) + if (var->type&T_PARAM + && (var->type&(T_TYPE|T_ARR))!=T_VALUE) + Lolp(var->info.vc.offset); + else + lal(var->info.vc.offset); + else { + if (var->info.vc.offset<0) + lxl(curr_level-var->info.vc.st.level); + else + lxa(curr_level-var->info.vc.st.level); + if (var->type&T_PARAM + && (var->type&(T_TYPE|T_ARR))!=T_VALUE) + Lofp(var->info.vc.offset); + else + adp(var->info.vc.offset); + } + } break; + case E_TABLE: + case E_BTAB: + laedot(e->u.tab); + break; + } +} + +void code_bool(e, pos, T, F) + register struct expr *e; + register pos; + register int *T, *F; +/* if e = pos then + fall through or jump to T; + else + jump to F; + fi + */ +{ + register Default=0; + + if (err) return; + + if (e->kind==E_NODE) { + register struct expr *left=e->u.node.left; + register struct expr *right=e->u.node.right; + + switch(e->u.node.op) { + case '<': + case '>': + case LE: + case GE: + case NE: + case '=': + case AFTER: + code_val(left); + code_val(right); + bxx(pos, e->u.node.op, new_label(F)); + break; + case AND: + case OR: + if ((e->u.node.op==AND && pos) + || (e->u.node.op==OR && !pos) + ) { + int L=0; + code_bool(left, pos, &L, F); + Label(L); + code_bool(right, pos, T, F); + } else { + int L=0; + code_bool(left, !pos, &L, T); + Label(L); + code_bool(right, pos, T, F); + } + break; + case NOT: + code_bool(left, !pos, T, F); + break; + default: + Default=1; + } + } else + Default=1; + + if (Default) { + code_val(e); + if (vz>wz) { + ldc0(); + cmi(); + } else + tst(); + if (pos) zeq(new_label(F)); else zne(new_label(F)); + } +} + +void code_assignment(e) register struct expr *e; +/* e->left := e->right */ +{ + register struct expr *left=e->u.node.left; + register struct expr *right=e->u.node.right; + + if (left->type&T_ARR) { + register siz=left->arr_siz; + + code_addr(right); + code_addr(left); + blm(left->type&T_BYTE ? siz : siz*vz); + } else { + code_val(right); + code_addr(left); + sti(left->type&T_BYTE ? 1 : vz); + } +} + +void code_input(e) register struct expr *e; +/* Input one v from c ? v0; v1; ... */ +{ + if (e==nil) { + lae("any", 0); + cal("chan_in"); + asp(pz); + } else + if (e->type&T_ARR) { + loc(e->arr_siz); + code_addr(e); + cal(e->type&T_BYTE ? "c_ba_in" : "c_wa_in"); + asp(pz+wz); + } else { + code_addr(e); + cal(e->type&T_BYTE ? "cbyte_in" : "chan_in"); + asp(pz); + } +} + +void code_output(e) register struct expr *e; +/* Output one e from c ? e0; e1; ... */ +{ + if (e==nil) { + Loc(0L); + cal("chan_out"); + asp(vz); + } else + if (e->type&T_ARR) { + loc(e->arr_siz); + code_addr(e); + cal(e->type&T_BYTE ? "c_ba_out" : "c_wa_out"); + asp(pz+wz); + } else { + code_val(e); + cal("chan_out"); + asp(vz); + } +} + +void code_any(e, NO) register struct expr *e; int *NO; +/* Test if the channel (push address on stack) has input. If not so remove the + * channel pointer and jump to NO. Otherwise input values. + */ +{ + int YES=0; + register struct expr_list *elp; + + if (err) return; + + code_addr(e->u.io.chan); + cal("chan_any"); + lfr(wz); + tst(); + zne(new_label(&YES)); + asp(pz); + branch(NO); + Label(YES); + elp=e->u.io.args; + while (elp!=nil) { + code_input(elp->arg); + elp=elp->next; + } + asp(pz); +} + +void code_void(e) register struct expr *e; +/* Assignment, I/O, or procedure call. */ +{ + if (err) return; + + switch (e->kind) { + case E_NODE: /* Must be assignment */ + code_assignment(e); + break; + case E_IO: { + register struct expr_list *elp; + + code_addr(e->u.io.chan); + + elp=e->u.io.args; + while (elp!=nil) { + if (e->u.io.out) + code_output(elp->arg); + else + code_input(elp->arg); + elp=elp->next; + } + asp(pz); + } + break; + case E_CALL: { + register size=0; + register struct expr_list *elp=e->u.call.args; + register struct symbol *proc=e->u.call.proc->u.var; + register struct par_list *pars=proc->info.proc.pars; + + while (elp!=nil) { + if (pars->type==T_VALUE) { + code_val(elp->arg); + size+=vz; + } else { + code_addr(elp->arg); + size+=pz; + } + elp=elp->next; + pars=pars->next; + } + if (proc->type&T_BUILTIN) { + cal(proc->info.proc.st.builtin); + asp(size); + } else { + if (proc->info.proc.st.level>curr_level) { + /* Call down */ + lor0(); + } else + if (proc->info.proc.st.level==curr_level) { + /* Call at same level */ + Lolp(0); + } else { + /* Call up */ + lxa(curr_level-proc->info.proc.st.level); + loi(pz); + } + cal(proc_label(proc->info.proc.label, proc->name)); + asp(size+pz); + if (proc->info.proc.file!=curr_file) fil(); + } + } break; + } +} + +void prologue(proc) register struct symbol *proc; +/* Open up the scope for a new proc definition. */ +{ + static P=0; + + if (err) return; + + proc->info.proc.st.level= ++curr_level; + proc->info.proc.file= curr_file; + proc->info.proc.label= ++P; + curr_offset=min_offset=0; + pro(proc_label(proc->info.proc.label, proc->name)); + if (curr_level==1) fil(); +} + +void epilogue(proc) register struct symbol *proc; +/* Close the scope of a proc def. */ +{ + if (err) return; + + curr_level--; + ret(0); + _end(-min_offset); +} + +void rep_init(v, e1, e2, r_info) + struct symbol *v; + register struct expr *e1, *e2; + register struct replicator *r_info; +/* Compile v=[e1 FOR e2]. Info tells rep_test what decisions rep_init makes. */ +{ + if (err) return; + + r_info->BEGIN=r_info->END=0; + + code_val(e1); + Stl(v->info.vc.offset); + + if (!constant(e1) || !constant(e2)) { + if (constant(e2) && word_constant(e2->u.const)) { + r_info->counter=memory(wz); + loc((int) e2->u.const); + stl(r_info->counter); + } else { + r_info->counter=memory(vz); + code_val(e2); + Stl(r_info->counter); + } + } + if (!constant(e2) || e2->u.const<=0L) + branch(&r_info->END); + Label(new_label(&r_info->BEGIN)); +} + +void rep_test(v, e1, e2, r_info) + register struct symbol *v; + register struct expr *e1, *e2; + register struct replicator *r_info; +{ + if (err) return; + + Inl(v->info.vc.offset); + + if (constant(e1) && constant(e2)) { + Lol(v->info.vc.offset); + Loc(e1->u.const+e2->u.const); + if (vz>wz) { + cmi(); + zlt(r_info->BEGIN); + } else + blt(r_info->BEGIN); + Label(r_info->END); + } else { + if (constant(e2) && word_constant(e2->u.const)) { + del(r_info->counter); + Label(r_info->END); + lol(r_info->counter); + tst(); + } else { + Del(r_info->counter); + Label(r_info->END); + Lol(r_info->counter); + if (vz>wz) { + ldc0(); + cmi(); + } else + tst(); + } + zgt(r_info->BEGIN); + } +} + +void chan_init(info, arr_siz) union type_info *info; int arr_siz; +/* Garbage disposal unit for fresh channels. */ +{ + if (err) return; + + loc(arr_siz); + lal(info->vc.offset); + cal("c_init"); + asp(wz+pz); +} + +void leader() +{ + init(); + openfile((char *) nil); + magic(); + meswp(); + maxdes(); +} + +void header() +{ + exp("main"); + pro("main"); + init_rt(); + main_fil(); +} + +void trailer() +{ + if (err) + meserr(); + else { + loc(0); + ret(wz); + _end(-min_offset); + } + closefile(); +} diff --git a/lang/occam/comp/code.h b/lang/occam/comp/code.h new file mode 100644 index 000000000..34f9dd0d9 --- /dev/null +++ b/lang/occam/comp/code.h @@ -0,0 +1,19 @@ +struct replicator { /* Info transferred from rep_init to rep_test */ + int counter; + int BEGIN; + int END; +}; + +void rep_init(), rep_test(); + +void code_val(), code_addr(), code_void(); +void code_assignment(), code_input(), code_any(), code_output(); + +void code_bool(); +#define positive 1 /* Use positive logic for boolean expression */ +#define negative 0 /* Use negative logic, i.e. 0 = true */ + +void epilogue(), prologue(); +void leader(), header(), trailer(); + +void chan_init(); diff --git a/lang/occam/comp/em.c b/lang/occam/comp/em.c new file mode 100644 index 000000000..814b1c1f7 --- /dev/null +++ b/lang/occam/comp/em.c @@ -0,0 +1,405 @@ +#include +#include "sizes.h" +#include "Lpars.h" +#include "em_arith.h" +#include "em_label.h" +#include "em.h" + +/* This file is used to shield code.c as much as possible from em dependant + * details. It introduces some call overhead but not enough for a coffee + * break. (Sorry) + * Note that functions with a leading upper case letter normally decide between + * word or double word arith. + */ + +int wz, pz; +static Lab=0; +char *malloc(); + +void init() +{ + C_init((arith) wz, (arith) pz); +} + +void openfile(file) char *file; +{ + C_open(file); +} + +void meswp() +{ + C_mes_begin(2); + C_cst((arith) wz); + C_cst((arith) pz); + C_mes_end(); +} + +void maxdes() +{ + C_df_dnam("maxcdes"); + rom(wz, 0L); rom(wz, -1L); rom(wz, (long) (wz+pz)); + C_df_dnam("maxwdes"); + rom(wz, 0L); rom(wz, -1L); rom(wz, (long) vz); + C_df_dnam("maxbdes"); + rom(wz, 0L); rom(wz, -1L); rom(wz, 1L); +} + +int new_label(L) register *L; +{ + if (*L==0) *L= ++Lab; + return *L; +} + +void Label(L) register L; +{ + if (L!=0) C_df_ilb((label) L); +} + +static Dot_label=0; + +int new_dot_label(L) int *L; +{ + return *L= ++Dot_label; +} + +void dot_label(L) int L; +{ + C_df_dlb((label) L); +} + +void branch(L) int *L; +{ + C_bra((label) new_label(L)); +} + +char *proc_label(L, name) register L; register char *name; +{ + static char *lab=nil; + register char *n; + + if (lab!=nil) free(lab); + + lab=malloc(strlen(name)+(1+sizeof(int)*3+1)); + /* That is: P\0 */ + + sprintf(lab, "P%d", L); + + n=lab+strlen(lab); + + while (*name!=0) { + *n++ = *name=='.' ? '_' : *name; + name++; + } + *n=0; + return lab; +} + +void magic() /* magic? should be called invisible */ +{ + C_magic(); +} + +void cwv() +{ + if (vz>wz) { + C_loc((arith) wz); + C_loc((arith) vz); + C_cii(); + } +} + +void cvw() +{ + if (vz>wz) { + C_loc((arith) vz); + C_loc((arith) wz); + C_cii(); + } +} + +void Loc(const) long const; +{ + if (vz>wz) C_ldc((arith) const); else C_loc((arith) const); +} + +void Lol(offset) int offset; +{ + if (vz>wz) C_ldl((arith) offset); else C_lol((arith) offset); +} + +void Lolp(offset) int offset; +{ + if (pz>wz) C_ldl((arith) offset); else C_lol((arith) offset); +} + +void Lil(offset) register offset; +{ + if (vz>wz) { + Lolp(offset); + C_loi((arith) vz); + } else + C_lil((arith) offset); +} + +void Lof(offset) int offset; +{ + if (vz>wz) C_ldf((arith) offset); else C_lof((arith) offset); +} + +void Lofp(offset) int offset; +{ + if (pz>wz) C_ldf((arith) offset); else C_lof((arith) offset); +} + +void Lif(offset) register offset; +{ + Lofp(offset); + C_loi((arith) vz); +} + +void Stl(offset) int offset; +{ + if (vz>wz) C_sdl((arith) offset); else C_stl((arith) offset); +} + +void Inl(offset) register offset; +{ + if (vz>wz) { + C_ldl((arith) offset); + C_ldc((arith) 1); + C_adi((arith) vz); + C_sdl((arith) offset); + } else + C_inl((arith) offset); +} + +void Del(offset) register offset; +{ + if (vz>wz) { + C_ldl((arith) offset); + C_ldc((arith) 1); + C_sbi((arith) vz); + C_sdl((arith) offset); + } else + C_del((arith) offset); +} + +void Loe(name, offset) char *name; int offset; +{ + if (vz>wz) + C_lde_dnam(name, (arith) offset); + else + C_loe_dnam(name, (arith) offset); +} + +typedef int (*pfi)(); + +static int operators[]= { '<', '>', '=', GE, LE, NE }; + +extern C_blt(), C_bgt(), C_beq(), C_bge(), C_ble(), C_bne(); +extern C_tlt(), C_tgt(), C_teq(), C_tge(), C_tle(), C_tne(); +extern C_zlt(), C_zgt(), C_zeq(), C_zge(), C_zle(), C_zne(); + +static pfi C_bxx[]= { C_blt, C_bgt, C_beq, C_bge, C_ble, C_bne }; +static pfi C_txx[]= { C_tlt, C_tgt, C_teq, C_tge, C_tle, C_tne }; +static pfi C_zxx[]= { C_zlt, C_zgt, C_zeq, C_zge, C_zle, C_zne }; + +void bxx(pos, op, L) register pos, op, L; +{ + register i; + + if (op==AFTER) { + C_sbi((arith) vz); + if (vz>wz) { + C_ldc((arith) 0); + C_cmi((arith) vz); + } + if (pos) C_zle((label) L); else C_zgt((label) L); + } else { + for (i=0; operators[i]!=op; i++) ; + if (pos && (i+=3)>=6) i-=6; + if (vz>wz) { + C_cmi((arith) vz); + (C_zxx[i])((label) L); + } else { + (C_bxx[i])((label) L); + } + } +} + +void Txx(op) register int op; +{ + register i; + + for (i=0; operators[i]!=op; i++) ; + + (C_txx[i])(); + cwv(); + C_ngi((arith) vz); +} + +extern C_adi(), C_sbi(), C_mli(), C_dvi(), C_rmi(); + +void xxi(op) register op; +{ + static int operators[]= { '+', '-', '*', '/', BS }; + static pfi C_xxi[]= { C_adi, C_sbi, C_mli, C_dvi, C_rmi }; + register i; + + for (i=0; operators[i]!=op; i++) ; + + (C_xxi[i])((arith) vz); +} + +void aar() { C_aar((arith) wz); } +void adp(offset) int offset; { C_adp((arith) offset); } +void and() { C_and((arith) vz); } +void asp(size) int size; { C_asp((arith) size); } +void blm(size) int size; { C_blm((arith) size); } +void blt(lab) int lab; { C_blt((label) lab); } +void cal(lab) char *lab; { C_cal(lab); } +void cmi() { C_cmi((arith) vz); } +void com() { C_com((arith) vz); } +void del(offset) int offset; { C_del((arith) offset); } +void _end(size) int size; { C_end((arith) size); } +void exp(lab) char *lab; { C_exp(lab); } +void ior() { C_ior((arith) vz); } +void lae(lab, offset) char *lab; int offset; + { C_lae_dnam(lab, (arith) offset); } +void laedot(lab) int lab; { C_lae_dlb((label) lab, (arith) 0); } +void lal(offset) int offset; { C_lal((arith) offset); } +void lar() { C_lar((arith) wz); } +void ldc0() { C_ldc((arith) 0); } +void ldl(offset) int offset; { C_ldl((arith) offset); } +void lfr(size) int size; { C_lfr((arith) size); } +void loc(cst) int cst; { C_loc((arith) cst); } +void loi(size) int size; { C_loi((arith) size); } +void lol(offset) int offset; { C_lol((arith) offset); } +void lor0() { C_lor((arith) 0); } +void lxa(offset) int offset; { C_lxa((arith) offset); } +void lxl(offset) int offset; { C_lxl((arith) offset); } +void meserr() { C_mes_begin(0); C_mes_end(); } +void ngi() { C_ngi((arith) vz); } +void pro(lab) char *lab; { C_pro_narg(lab); } +void ret(size) int size; { C_ret((arith) size); } +void init_rt() { C_cal("init"); } +void sli() { C_sli((arith) vz); } +void sri() { C_sri((arith) vz); } +void ste(lab, offset) char *lab; int offset; + { C_ste_dnam(lab, (arith) offset); } +void sti(size) int size; { C_sti((arith) size); } +void stl(offset) int offset; { C_stl((arith) offset); } +void trp() { C_trp(); } +void tst() { /* No flags in EM */ } +void xor() { C_xor((arith) vz); } +void zeq(lab) int lab; { C_zeq((label) lab); } +void zgt(lab) int lab; { C_zgt((label) lab); } +void zlt(lab) int lab; { C_zlt((label) lab); } +void zne(lab) int lab; { C_zne((label) lab); } + +char *itoa(i) long i; +{ + static char a[sizeof(long)*3]; + sprintf(a, "%D", i); + return a; +} + +void rom(size, c) int size; long c; +{ + C_rom_icon(itoa(c), (arith) size); +} + +void lin() +{ + static oldline=0; + extern yylineno; + + if (yylineno!=oldline) + C_lin((arith) (oldline=yylineno)); +} + +static struct ftree { + char *file; + int lab; + struct ftree *left, *right; +} std_f = { "stdin", 0, nil, nil }, *curr_f= &std_f, *main_f=nil; + +char *curr_file="stdin"; + +static void do_fil(f) struct ftree *f; +{ + if (f->lab==0) { + dot_label(new_dot_label(&f->lab)); + C_rom_scon(f->file, (arith) strlen(f->file)); + } + C_fil_dlb((label) f->lab); +} + +void fil() +{ + do_fil(curr_f); +} + +void main_fil() +{ + do_fil(main_f==nil ? &std_f : main_f); +} + +int set_file(f) char *f; +{ + char *strcpy(); + static struct ftree *ftop=nil; + register struct ftree *pf, **apf= &ftop; + register cmp; + + while ((pf= *apf)!=nil && (cmp=strcmp(f, pf->file))!=0) + apf= cmp<0 ? &pf->left : &pf->right; + + if (pf==nil) { + *apf= pf= (struct ftree *) malloc(sizeof *pf); + pf->file=strcpy(malloc(strlen(f)+1), f); + pf->lab=0; + pf->left=pf->right=nil; + } + curr_f=pf; + curr_file=pf->file; + if (main_f==nil) { + main_f=curr_f; + return 0; + } else + return curr_f!=main_f; +} + +void par_begin() +{ + C_lal((arith) curr_offset); + C_cal("pc_begin"); + C_asp((arith) pz); +} + +void par_fork(NONZERO) int *NONZERO; +{ + C_cal("pc_fork"); + C_lfr((arith) wz); + C_zne((label) new_label(NONZERO)); +} + +void resumenext() +{ + C_cal("resumene"); +} + +void no_deadlock() +{ + C_zre_dnam("deadlock", (arith) 0); +} + +void par_end() +{ + C_cal("parend"); +} + +void closefile() +{ + C_close(); +} diff --git a/lang/occam/comp/em.h b/lang/occam/comp/em.h new file mode 100644 index 000000000..3ead99648 --- /dev/null +++ b/lang/occam/comp/em.h @@ -0,0 +1,21 @@ +#ifndef nil +#define nil 0 +#endif + +#define word_constant(c) (-32768L<=(c) && (c)<=32767L) +void Label(), dot_label(), branch(); +int new_label(), new_dot_label(); +char *proc_label(); +extern char *curr_file; + +void cwv(), cvw(); +void bxx(), Loc(), Lol(), Lolp(), Lil(), Lof(), Lofp(), Lif(); +void Txx(), xxi(), Stl(), Inl(), Del(), Loe(); +void cmi(), ngi(), and(), ior(), xor(), sli(), sri(), com(), lar(), lxl(); +void lxa(), lfr(), ste(), lae(), aar(), lal(), adp(), ldc0(), zeq(), zne(); +void zlt(), zgt(), blm(), sti(), cal(), asp(), loc(), lor0(), loi(), pro(); +void ret(), _end(), stl(), laedot(), del(), lol(), ldl(), meswp(), meserr(); +void init_rt(), exp(), rom(), blt(), magic(), lin(), tst(), fil(), trp(); +void main_fil(), init(), openfile(), closefile(), maxdes(); + +void par_begin(), par_fork(), par_end(), resumenext(), no_deadlock(); diff --git a/lang/occam/comp/expr.c b/lang/occam/comp/expr.c new file mode 100644 index 000000000..621d08763 --- /dev/null +++ b/lang/occam/comp/expr.c @@ -0,0 +1,471 @@ +#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': 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); + } +} diff --git a/lang/occam/comp/expr.h b/lang/occam/comp/expr.h new file mode 100644 index 000000000..3b59035b8 --- /dev/null +++ b/lang/occam/comp/expr.h @@ -0,0 +1,61 @@ +#define E_NODE 0 +#define E_VAR 1 /* Variable *or* channel */ +#define E_CONST 2 +#define E_TABLE 3 +#define E_BTAB 4 +#define E_NOW 5 +#define E_IO 6 +#define E_CALL 7 + +struct table { + long val; + struct table *next; +}; + +struct expr; + +struct expr_list { + struct expr *arg; + struct expr_list *next; +}; + +struct expr { + short kind; + short type; + int arr_siz; + union { + struct { + int op; + struct expr *left, *right; + } node; + + struct symbol *var; + + long const; + + int tab; + + struct { + int out; + struct expr *chan; + struct expr_list *args; + } io; + + struct { + struct expr *proc; + struct expr_list *args; + } call; + } u; +}; + +struct expr *new_node(), *new_var(), *new_const(), *new_table(), *new_now(); +struct expr *new_io(), *new_call(), *copy_const(); +void table_add(), expr_list_add(); +void check_param(), check_io(), check_wait(); +void destroy(), used(); + +#define valueless(e) (((e)->type&T_TYPE)==T_VOID) +#define valued(e) (((e)->type&T_TYPE)==T_VALUE) +#define input_process(e) ((e)->kind==E_IO && !(e)->u.io.out) +#define constant(e) ((e)->kind==E_CONST) +#define arr_constant(e) ((e)->kind==E_TABLE || (e)->kind==E_BTAB) diff --git a/lang/occam/comp/keytab.c b/lang/occam/comp/keytab.c new file mode 100644 index 000000000..3ebec19e6 --- /dev/null +++ b/lang/occam/comp/keytab.c @@ -0,0 +1,82 @@ +/* keytab.c */ +# include "Lpars.h" +# include + +# define NKEYWORDS ((sizeof keytab) / (sizeof *keytab)) +# define MAXKEYLEN 8 + +typedef struct { + int k_token; + char *k_str; +} KTAB; + +KTAB keytab[] = { + { AFTER, "AFTER" }, { ALLOCATE, "ALLOCATE" }, + { ALT, "ALT" }, { AND, "AND" }, + { ANY, "ANY" }, { BYTE, "BYTE" }, + { CHAN, "CHAN" }, { DEF, "DEF" }, + { FALSE, "FALSE" }, { FOR, "FOR" }, + { IF, "IF" }, { LOAD, "LOAD" }, + { NOT, "NOT" }, { NOW, "NOW" }, + { OR, "OR" }, { PAR, "PAR" }, + { PLACED, "PLACED" }, { PORT, "PORT" }, + { PRI, "PRI" }, { PROC, "PROC" }, + { SEQ, "SEQ" }, { SKIP, "SKIP" }, + { TABLE, "TABLE" }, { TRUE, "TRUE" }, + { VALUE, "VALUE" }, { VAR, "VAR" }, + { WAIT, "WAIT" }, { WHILE, "WHILE" }, +}; + +/* + * The table of keywords is searched for the occurence of `str', + * if found the corresponding token number is returned, + * otherwise IDENTIFIER is the returned token number. + */ +keyword(str) char *str; +{ + register int high= NKEYWORDS-1; + register int low= 0; + register int i, cmp; + char *lowerupper(); + register char *key; + + if ((key=lowerupper(str))==0) return IDENTIFIER; + + do { + i= (high+low) / 2; + if ((cmp= strcmp(key, keytab[i].k_str)) == 0) break; + else if (cmp > 0) low= i+1; + else high= i-1; + } while (low <= high); + + return low<=high ? keytab[i].k_token : IDENTIFIER; +} + +char *lowerupper(str) register char *str; +{ + static char keyword[MAXKEYLEN+1]; + register char *key=keyword; + + if (islower(*str)) { + do + *key++ = toupper(*str++); + while (keyk_token == key) return kp->k_str; + + return 0; +} diff --git a/lang/occam/comp/lex.l b/lang/occam/comp/lex.l new file mode 100644 index 000000000..86f1277e7 --- /dev/null +++ b/lang/occam/comp/lex.l @@ -0,0 +1,344 @@ +%{ +/* lex.l */ +# include +# include "token.h" +# include "Lpars.h" + +# define TAB 8 /* Size of a acsii tab (\t) in spaces */ +# if (TAB&(TAB-1))!=0 +# define TABSTOP(ind) ((ind)+TAB-(ind)%TAB) +# else +# define TABSTOP(ind) (((ind)+TAB)&(~(TAB-1))) +# endif + +char *malloc(), *strcpy(); + +struct token token; +int ind=0; /* Indentation level of current line */ +static int tab=0; /* First indentation found */ + +int included=0; /* Is current file included? */ +%} + +%% +'((\*[^\n])|([^'\n*]))*' { + if ((token.t_lval=char_constant(yytext+1))== -1L) + report("%s not a character constant", yytext); + + return CHAR_CONST; +} +'[^'\n]*'? { + report("missing '."); + token.t_lval= -1L; + + return CHAR_CONST; +} +\"((\*[^\n])|([^"\n*]))*\" { + char *string(); + + token.t_sval=string(yytext); + + return STRING; +} +\"[^"\n]*\"? { + report("missing \"."); + token.t_sval=""; + + return STRING; +} +#[ \t]*"line"?[ \t]*[0-9]+[ \t]*\"[^"\n]*\" { + set_line_file(yytext); + tab=0; +} +#[A-Fa-f0-9]+ { + long hex_number(); + + token.t_lval=hex_number(yytext+1); + + return NUMBER; +} +[0-9]+ { + long number(); + + token.t_lval=number(yytext); + + return NUMBER; +} +[A-Za-z][A-Za-z0-9.]* { + register key; + + if ((key=keyword(yytext))==IDENTIFIER) + token.t_sval=strcpy(malloc(yyleng+1), yytext); + + return key; +} +\n[ \f\t]*/"--" {/* Line with only a comment, don't set tab */} + +\n[ \f\t]* { + + ind=indentation(yytext+1); + if (tab==0) + tab=ind; + else + if (ind%tab!=0) + warning("indentation not on a %d space boundary", tab); +} +[ \f\t] { /* Nothing */ } +[-=<>:,;+*/\[\]()?!&] return yytext[0]; + +"\\" return BS; +":=" return AS; +"<=" return LE; +">=" return GE; +"<>" return NE; +"<<" return LS; +">>" return RS; +"/\\" return BA; +"\\/" return BO; +"><" return BX; + +"--"[^\n]* { /* Comment is skipped */ } +. { + warning((' '<=yytext[0] && yytext[0]<0177) ? "%s'%c')" : "%soctal: %o)", + "bad character seen (", yytext[0]&0377); +} +%% +char *string(s) char *s; +{ + register c; + register char *p= s; + char *str= s; + + str++; p++; + while (*str != '"') { + if ((c=character(&str)) != -1) + *p++= c; + else + return ""; + } + + *p=0; + *s=p-(s+1); + return s; +} + +long number(s) register char *s; +{ + static char max_str[]="2147483647"; + int maxlen=sizeof max_str-1; + long atol(); + long num; + + while (*s=='0') { /* skip leading nulls */ + *s++; + yyleng--; + } + + if (*s==0) + num=0L; + else { + if ((yyleng>maxlen) || (yyleng==maxlen && strcmp(s, max_str)>0)) + warning("integer constant overflow."); + + num=atol(s); + } + + return num; +} + +long hex_number(s) register char *s; +{ + long number=0L; + + while (*s) + number=(number<<4)+hextoint(*s++); + + return number; +} + +int hextoint(c) register c; +{ + register val; + + if (islower(c)) + val=(c-'a')+10; + else + if (isupper(c)) + val=(c-'A')+10; + else + val=c-'0'; + + return val; +} + +int character(S) register char **S; +{ + register char *s= *S; + register c, cc; + + if ((c= *s++)=='*') { + switch (c= *s++) { + case 'c': + cc='\r'; + break; + case 'n': + cc='\n'; + break; + case 't': + cc='\t'; + break; + case 's': + cc=' '; + break; + case '#': + if (isxdigit(c= *s++) && isxdigit(*s)) { + cc= (hextoint(c)<<4)+hextoint(*s++); + break; + } else { + report("two digit hexadecimal const expected."); + return -1; + } + default: + cc=c; + break; + } + } else + cc=c; + + *S=s; + return cc; +} + +int char_constant(s) char *s; +{ + register cc; + + cc=character(&s); + + return (*s=='\'' && cc!= -1) ? cc : -1; +} + +int indentation(s) register char *s; +{ + register in=0, c; + + while (c= *s++) { + if (c=='\t') + in=TABSTOP(in); + else + if (c=='\f') + in=0; + else + in++; + } + + return in; +} + +int tabulated(oind, ind) register oind, ind; +{ + if (tab>0 && ind>oind+tab) + warning("process' indentation too large (changed to %d tab%s)", + oind/tab+1, oind>=tab ? "s" : ""); + return ind>oind; +} + +int rep_tk=0; +struct token rep_token; + +void repeat_token(tk) +{ + rep_tk=tk; + rep_token=token; +} + +scanner() +{ + register tk; + + if (rep_tk>0) { + tk=rep_tk;; + rep_tk=0; + token=rep_token; + return tk; + } else + return yylex(); +} + +char *tokenname(tk, inst) register tk, inst; +{ + if (tk<0400) { + static char c[7]; + + if (' '=", "<>", "<<", ">>", "/\\", + "\\/", "><", "\\" + }; + register i; + static char qopc[5]; + + for (i=0; op[i]!=tk; i++) ; + sprintf(qopc, "'%s'", opc[i]); + return qopc; + } + } + } +} + +set_line_file(l) register char *l; +{ + register char *file; + + while (*l<'0' || *l>'9') l++; + + yylineno=0; + while ('0'<=*l && *l<='9') + yylineno=yylineno*10+(*l++ - '0'); + + yylineno--; + + while (*l++!='"'); + + file=l; + while (*l++!='"'); + *--l=0; + + included=set_file(file); +} diff --git a/lang/occam/comp/occam.g b/lang/occam/comp/occam.g new file mode 100644 index 000000000..737aee7ed --- /dev/null +++ b/lang/occam/comp/occam.g @@ -0,0 +1,684 @@ +/* OCCAM */ +{ +#include "token.h" +#include "symtab.h" +#include "expr.h" +#include "code.h" +#include "sizes.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; +#include + +main(argc, argv) register argc; register char **argv; +{ + wz= (argc>1 && strcmp(argv[1], "4")==0) ? 4 : 2; + pz= (argc>2 && strcmp(argv[2], "4")==0) ? 4 : wz; + + leader(); + occam(); + trailer(); + + exit(err); +} + +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 */ + fprintf(stderr, "Compiler stack overflow. Compiler ends."); + err=1; trailer(); exit(1); + } + if (++errors==MAXERRORS) { + fprintf(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) + ); + } +} +} diff --git a/lang/occam/comp/report.c b/lang/occam/comp/report.c new file mode 100644 index 000000000..e7385c647 --- /dev/null +++ b/lang/occam/comp/report.c @@ -0,0 +1,19 @@ +#include + +extern int err, yylineno; +extern char *curr_file; + +report(fmt, arg1, arg2, arg3) char *fmt; +{ + fprintf(stderr, "%s (%d) F: ", curr_file, yylineno); + fprintf(stderr, fmt, arg1, arg2, arg3); + putc('\n', stderr); + err=1; +} + +warning(fmt, arg1, arg2, arg3) char *fmt, *arg1; +{ + fprintf(stderr, "%s (%d) E: ", curr_file, yylineno); + fprintf(stderr, fmt, arg1, arg2, arg3); + putc('\n', stderr); +} diff --git a/lang/occam/comp/sizes.h b/lang/occam/comp/sizes.h new file mode 100644 index 000000000..df0b3c7b4 --- /dev/null +++ b/lang/occam/comp/sizes.h @@ -0,0 +1,5 @@ +/* Variable size, wordsize, pointer size. Offsets for local variables. */ + +#define vz 4 +extern int wz, pz; +extern int curr_level, curr_offset, min_offset; diff --git a/lang/occam/comp/symtab.c b/lang/occam/comp/symtab.c new file mode 100644 index 000000000..404942622 --- /dev/null +++ b/lang/occam/comp/symtab.c @@ -0,0 +1,202 @@ +#include "symtab.h" +#include "expr.h" +#include "sizes.h" + +int curr_level=0; /* Current local level */ +int curr_offset=0; /* Current offset within this level */ +int min_offset=0; /* Minimum of all offsets within current level */ + +static struct symtab *sym_table=nil; + +char *malloc(); + +static struct symbol **search_sym(tree, name) + struct symbol **tree; + char *name; +/* Returns a hook in the tree to the where the given name is or should be. */ +{ + register struct symbol **aps=tree, *ps; + register cmp; + + while ((ps= *aps)!=nil && (cmp=strcmp(name, ps->name))!=0) + aps= cmp<0 ? &ps->left : &ps->right; + + return aps; +} + +struct symbol *insert(name, type, arr_siz, info) + char *name; + int type, arr_siz; + union type_info info; +/* Inserts an object with given name and other info into the current symbol + * tree. A pointer is returned to the inserted symbol so that more info may + * or changed. Nil is returned on redeclaration. + */ +{ + register struct symbol **aps, *ps; + extern included; + + if (*(aps=search_sym(&sym_table->local, name))!=nil) { + report("%s redeclared", name); + return nil; + } + + ps= (struct symbol *) malloc(sizeof *ps); + + ps->name=name; + + if (included && curr_level==0) /* Top_level symbol in include file */ + type|=T_USED; /* are always used */ + ps->type=type; + ps->arr_siz=arr_siz; + ps->info=info; + ps->left=ps->right=nil; + *aps=ps; + + return ps; +} + +struct symbol *searchall(name) char *name; +/* Searches for name in all symbol trees from the inner to the outermost. + * If it can't be found then it is inserted as undefined. + */ +{ + register struct symtab *tab=sym_table; + register struct symbol *ps; + + while (tab!=nil) { + if ((ps= *search_sym(&tab->local, name))!=nil) return ps; + + tab=tab->global; + } + report("%s not declared", name); + return insert(name, T_NOTDECL, 0, none); +} + +void check_recursion(proc) + register struct expr *proc; +{ + if (proc->kind==E_VAR && proc->u.var->type&T_RECURS) + warning("recursion not allowed"); +} + +void sym_down() +{ + register struct symtab *ps; + + ps= (struct symtab *) malloc(sizeof *ps); + + ps->local=nil; + ps->global=sym_table; + ps->old_offset=curr_offset; + + sym_table=ps; +} + +static void sym_destroy(ps) register struct symbol *ps; +{ + if (ps!=nil) { + sym_destroy(ps->left); + sym_destroy(ps->right); + if ( !(ps->type&T_NOTDECL) ) { + if ( !(ps->type&T_USED) ) + warning("%s: never used", ps->name); + else + if ( !(ps->type&T_ASSIGNED) && (ps->type&T_TYPE)==T_VAR) + warning("%s: never assigned", ps->name); + } + if ((ps->type&T_TYPE)==T_PROC) { + register struct par_list *par, *junk; + + par=ps->info.proc.pars; + while (par!=nil) { + junk=par; + par=par->next; + free(junk); + } + } else + if ((ps->type&T_TYPE)==T_CONST) + destroy(ps->info.const); + free(ps->name); + free(ps); + } +} + +void sym_up() +{ + register struct symtab *ps; + + ps=sym_table->global; + curr_offset=sym_table->old_offset; + + sym_destroy(sym_table->local); + free(sym_table); + + sym_table=ps; +} + +void var_memory(info, type, n) register union type_info *info; int type, n; +/* Reserves local memory for an object, and stores it in its info field. */ +{ + info->vc.st.level=curr_level; + curr_offset-= (type&T_BYTE) ? (n+wz-1) & (~(wz-1)) : n*vz; + info->vc.offset=curr_offset; + if (curr_offsetvc.st.level=curr_level; + info->vc.offset= curr_offset-=n*(vz+wz); + if (curr_offsettype=type; + pl->var=var; + pl->next= **aapars; + + **aapars=pl; + *aapars= &pl->next; +} + +int form_offsets(pars) register struct par_list *pars; +/* Recursively assign offsets to formal variables. */ +{ + register struct symbol *var; + + if (pars==nil) return pz; + + if ((var=pars->var)!=nil) { + register offset=form_offsets(pars->next); + + switch (var->type&T_TYPE) { + case T_VAR: + case T_CHAN: + var->info.vc.st.level=curr_level; + var->info.vc.offset=offset; + return offset+pz; + case T_VALUE: + var->info.vc.st.level=curr_level; + var->info.vc.offset=offset; + return offset+ ((var->type&T_ARR) ? pz : vz); + } + } +} diff --git a/lang/occam/comp/symtab.h b/lang/occam/comp/symtab.h new file mode 100644 index 000000000..48cd7da29 --- /dev/null +++ b/lang/occam/comp/symtab.h @@ -0,0 +1,91 @@ +#ifndef nil +#define nil 0 +#endif + + /* Symbol/Expression type: */ +#define T_VAR 0x0000 +#define T_CHAN 0x0001 +#define T_CONST 0x0002 +#define T_VALUE 0x0003 +#define T_PROC 0x0004 +#define T_NOW 0x0005 +#define T_VOID 0x0006 + +#define T_TYPE 0x0007 /* Mask for type bits */ + + /* Flags: */ +#define T_ARR 0x0008 /* Object is an array */ +#define T_BYTE 0x0010 /* Object is a byte array if T_ARR */ +#define T_PARAM 0x0020 /* Formal parameter */ +#define T_LVALUE 0x0040 /* This object may be assigned */ +#define T_NOTDECL 0x0080 /* If you didn't declare it */ +#define T_USED 0x0100 /* If you've used it */ +#define T_ASSIGNED 0x0200 /* Or assigned it */ +#define T_REP 0x0400 /* Replicator index */ +#define T_BUILTIN 0x0800 /* Builtin name */ +#define T_RECURS 0x1000 /* This proc is now compiled */ +/* Note that some types and flags are only used for symbols, and others only + * for expressions. + */ + +struct symbol; + +struct par_list { /* List of parameter types for a proc object */ + struct par_list *next; + struct symbol *var; /* The formal parameter while visible */ + int type; /* Its type */ +}; + +struct expr; + +union storage { /* An object is found */ + int level; /* either at a certain local level */ + char *builtin; /* or using a global builtin name */ +}; + +union type_info { + struct { + union storage st; + int offset; /* from its local level or builtin name */ + } vc; /* Variable or channel */ + + struct expr *const; + + struct { + union storage st; + char *file; /* file it is in */ + int label; /* A unique id*/ + struct par_list *pars; + } proc; +}; + +struct symbol { + char *name; + short type; + int arr_siz; + union type_info info; + struct symbol *left, *right; +}; + +struct symtab { + struct symbol *local; + struct symtab *global; + int old_offset; +}; + +struct symbol *insert(); +struct symbol *searchall(); + +void sym_down(); +void sym_up(); +void var_memory(), chan_memory(); + +void pars_add(); +int form_offsets(); +void check_recursion(); + +#define var_constant(v) (((v)->type&T_TYPE)==T_CONST) +#define var_proc(v) (((v)->type&T_TYPE)==T_PROC) +#define var_declared(v) (! ((v)->type&T_NOTDECL)) + +extern union type_info none; diff --git a/lang/occam/comp/token.h b/lang/occam/comp/token.h new file mode 100644 index 000000000..b25f2ee4a --- /dev/null +++ b/lang/occam/comp/token.h @@ -0,0 +1,11 @@ +/* token.h */ + +extern struct token { + long t_lval; + char *t_sval; +} token; + +extern ind; +void repeat_token(); +char *tokenname(); +int tabulated(); -- 2.34.1