Initial revision
This commit is contained in:
ceriel
parent
a731f979b0
commit
bc94559e4d
16 changed files with 3123 additions and 0 deletions
27
lang/occam/comp/Makefile
Normal file
27
lang/occam/comp/Makefile
Normal file
|
|
@ -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
|
||||||
74
lang/occam/comp/builtin.c
Normal file
74
lang/occam/comp/builtin.c
Normal file
|
|
@ -0,0 +1,74 @@
|
||||||
|
#include <stdio.h>
|
||||||
|
#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);
|
||||||
|
}
|
||||||
607
lang/occam/comp/code.c
Normal file
607
lang/occam/comp/code.c
Normal file
|
|
@ -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();
|
||||||
|
}
|
||||||
19
lang/occam/comp/code.h
Normal file
19
lang/occam/comp/code.h
Normal file
|
|
@ -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();
|
||||||
405
lang/occam/comp/em.c
Normal file
405
lang/occam/comp/em.c
Normal file
|
|
@ -0,0 +1,405 @@
|
||||||
|
#include <stdio.h>
|
||||||
|
#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<L><name>\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();
|
||||||
|
}
|
||||||
21
lang/occam/comp/em.h
Normal file
21
lang/occam/comp/em.h
Normal file
|
|
@ -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();
|
||||||
471
lang/occam/comp/expr.c
Normal file
471
lang/occam/comp/expr.c
Normal file
|
|
@ -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<rc ? -1L : 0L; break;
|
||||||
|
case '>': lc= lc>rc ? -1L : 0L; break;
|
||||||
|
case LE: lc= lc<=rc ? -1L : 0L; break;
|
||||||
|
case GE: lc= lc>=rc ? -1L : 0L; break;
|
||||||
|
case NE: lc= lc!=rc ? -1L : 0L; break;
|
||||||
|
case '=': lc= lc==rc ? -1L : 0L; break;
|
||||||
|
case AFTER: lc= (lc-rc)>0 ? -1L : 0L; break;
|
||||||
|
case BA: lc&=rc; break;
|
||||||
|
case BO: lc|=rc; break;
|
||||||
|
case BX: lc^=rc; break;
|
||||||
|
case AND: lc= lc&&rc ? -1L : 0L; break;
|
||||||
|
case OR: lc= lc||rc ? -1L : 0L; break;
|
||||||
|
case LS: lc<<=rc; break;
|
||||||
|
case RS: lc>>=rc; break;
|
||||||
|
case '~': lc= -lc; break;
|
||||||
|
case NOT: lc= ~lc; break;
|
||||||
|
default:
|
||||||
|
report("illegal operator on constants");
|
||||||
|
}
|
||||||
|
destroy(right);
|
||||||
|
|
||||||
|
left->u.const=lc;
|
||||||
|
return left;
|
||||||
|
} else {
|
||||||
|
register struct expr *pe;
|
||||||
|
int type=0, arr_siz=1;
|
||||||
|
|
||||||
|
switch (op) {
|
||||||
|
case '+': case '-': case '*': case '/':
|
||||||
|
case BS: case '<': case '>': case LE:
|
||||||
|
case GE: case NE: case '=': case AFTER:
|
||||||
|
case BA: case BO: case BX: case AND:
|
||||||
|
case OR: case LS: case RS:
|
||||||
|
rvalue(left);
|
||||||
|
rvalue(right);
|
||||||
|
type=T_VALUE;
|
||||||
|
break;
|
||||||
|
case '~':
|
||||||
|
case NOT:
|
||||||
|
rvalue(left);
|
||||||
|
type=T_VALUE;
|
||||||
|
break;
|
||||||
|
case AS:
|
||||||
|
assignable(left, right);
|
||||||
|
type=T_VOID;
|
||||||
|
break;
|
||||||
|
case '[':
|
||||||
|
subscriptable(left, right, byte, &type, &arr_siz);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
pe= (struct expr *) malloc(sizeof *pe);
|
||||||
|
|
||||||
|
pe->kind=E_NODE;
|
||||||
|
pe->type=type;
|
||||||
|
pe->arr_siz=arr_siz;
|
||||||
|
pe->u.node.op=op;
|
||||||
|
pe->u.node.left=left;
|
||||||
|
pe->u.node.right=right;
|
||||||
|
|
||||||
|
return pe;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
struct expr *new_var(var)
|
||||||
|
register struct symbol *var;
|
||||||
|
/* Given a variable an expression node is constructed. Note the changes in
|
||||||
|
* type! T_VAR becomes T_VALUE with flag T_LVALUE.
|
||||||
|
*/
|
||||||
|
{
|
||||||
|
register struct expr *pe;
|
||||||
|
|
||||||
|
pe= (struct expr *) malloc(sizeof *pe);
|
||||||
|
|
||||||
|
pe->kind=E_VAR;
|
||||||
|
|
||||||
|
if ((var->type&T_TYPE)==T_VAR || var->type&T_NOTDECL) {
|
||||||
|
pe->type=(var->type&(~T_TYPE));
|
||||||
|
pe->type|=T_VALUE|T_LVALUE;
|
||||||
|
} else
|
||||||
|
pe->type=var->type;
|
||||||
|
|
||||||
|
pe->arr_siz=var->arr_siz;
|
||||||
|
|
||||||
|
pe->u.var=var;
|
||||||
|
|
||||||
|
return pe;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct expr *new_const(const)
|
||||||
|
long const;
|
||||||
|
/* Make a constant, which is a VALUE, of course. */
|
||||||
|
{
|
||||||
|
register struct expr *pe;
|
||||||
|
|
||||||
|
pe= (struct expr *) malloc(sizeof *pe);
|
||||||
|
|
||||||
|
pe->kind=E_CONST;
|
||||||
|
pe->type=T_VALUE;
|
||||||
|
pe->u.const=const;
|
||||||
|
|
||||||
|
return pe;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct expr *new_table(kind, tab)
|
||||||
|
register kind;
|
||||||
|
register struct table *tab;
|
||||||
|
/* One table is being made, it is no doubt a VALUEd ARRay, but maybe even a
|
||||||
|
* BYTE array. A label is reserved for it and the individual elements are
|
||||||
|
* rommified.
|
||||||
|
*/
|
||||||
|
{
|
||||||
|
register struct expr *pe;
|
||||||
|
|
||||||
|
pe= (struct expr *) malloc(sizeof *pe);
|
||||||
|
|
||||||
|
pe->kind=kind;
|
||||||
|
pe->type=T_VALUE|T_ARR;
|
||||||
|
if (kind==E_BTAB) pe->type|=T_BYTE;
|
||||||
|
dot_label(new_dot_label(&pe->u.tab));
|
||||||
|
|
||||||
|
pe->arr_siz=0;
|
||||||
|
while (tab!=nil) {
|
||||||
|
register struct table *junk=tab;
|
||||||
|
|
||||||
|
rom(kind==E_BTAB ? 1 : vz, tab->val);
|
||||||
|
|
||||||
|
tab=tab->next;
|
||||||
|
pe->arr_siz++;
|
||||||
|
free(junk);
|
||||||
|
}
|
||||||
|
|
||||||
|
return pe;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct expr *copy_const(e) struct expr *e;
|
||||||
|
/* If you double it up, you've got one you can throw away. (Or do something
|
||||||
|
* useful with).
|
||||||
|
*/
|
||||||
|
{
|
||||||
|
register struct expr *c;
|
||||||
|
|
||||||
|
c= (struct expr *) malloc(sizeof *c);
|
||||||
|
|
||||||
|
*c= *e;
|
||||||
|
return c;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct expr *new_now()
|
||||||
|
/* Now is the time to make a VALUE cell for the clock. */
|
||||||
|
{
|
||||||
|
register struct expr *pe;
|
||||||
|
|
||||||
|
pe= (struct expr *) malloc(sizeof *pe);
|
||||||
|
|
||||||
|
pe->kind=E_NOW;
|
||||||
|
pe->type=T_VALUE;
|
||||||
|
|
||||||
|
return pe;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct expr *new_io(out, chan, args)
|
||||||
|
int out;
|
||||||
|
register struct expr *chan;
|
||||||
|
struct expr_list *args;
|
||||||
|
/* Either c ? v0; v1; v2; ... (out=0) or c ! e0; e1; e2; ... (out=1). */
|
||||||
|
{
|
||||||
|
register struct expr *pe;
|
||||||
|
|
||||||
|
if ( ( (chan->type&T_TYPE) != T_CHAN || (chan->type&T_ARR) )
|
||||||
|
&& ! (chan->type&T_NOTDECL)
|
||||||
|
)
|
||||||
|
report("channel variable expected");
|
||||||
|
used(chan);
|
||||||
|
|
||||||
|
pe= (struct expr *) malloc(sizeof *pe);
|
||||||
|
|
||||||
|
pe->kind=E_IO;
|
||||||
|
pe->type=T_VOID;
|
||||||
|
pe->u.io.out=out;
|
||||||
|
pe->u.io.chan=chan;
|
||||||
|
pe->u.io.args=args;
|
||||||
|
|
||||||
|
return pe;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct expr *new_call(proc, args)
|
||||||
|
struct expr *proc;
|
||||||
|
struct expr_list *args;
|
||||||
|
/* Dial proc(arg1, arg2, ...) and you'll hear the tone of this function.
|
||||||
|
* Dialing yourself is not allowed, but it will work if you ignore the
|
||||||
|
* compiler generated noise.
|
||||||
|
*/
|
||||||
|
{
|
||||||
|
register struct expr *pe;
|
||||||
|
|
||||||
|
pe= (struct expr *) malloc(sizeof *pe);
|
||||||
|
|
||||||
|
used(proc);
|
||||||
|
|
||||||
|
check_recursion(proc);
|
||||||
|
|
||||||
|
pe->kind=E_CALL;
|
||||||
|
pe->type=T_VOID;
|
||||||
|
pe->u.call.proc=proc;
|
||||||
|
pe->u.call.args=args;
|
||||||
|
|
||||||
|
return pe;
|
||||||
|
}
|
||||||
|
|
||||||
|
void table_add(aapt, val) register struct table ***aapt; long val;
|
||||||
|
/* Adds a value to a table using a hook to a hook. */
|
||||||
|
{
|
||||||
|
register struct table *pt;
|
||||||
|
|
||||||
|
pt= (struct table *) malloc(sizeof *pt);
|
||||||
|
|
||||||
|
pt->val=val;
|
||||||
|
pt->next= **aapt;
|
||||||
|
|
||||||
|
**aapt=pt;
|
||||||
|
*aapt= &pt->next;
|
||||||
|
}
|
||||||
|
|
||||||
|
void expr_list_add(aaelp, arg)
|
||||||
|
register struct expr_list ***aaelp;
|
||||||
|
struct expr *arg;
|
||||||
|
/* Another add, this time for actual arguments and the like. */
|
||||||
|
{
|
||||||
|
register struct expr_list *elp;
|
||||||
|
|
||||||
|
elp= (struct expr_list *) malloc(sizeof *elp);
|
||||||
|
|
||||||
|
elp->arg=arg;
|
||||||
|
elp->next= **aaelp;
|
||||||
|
**aaelp=elp;
|
||||||
|
*aaelp= &elp->next;
|
||||||
|
}
|
||||||
|
|
||||||
|
void check_io(out, arg) int out; struct expr *arg;
|
||||||
|
{
|
||||||
|
if (out)
|
||||||
|
outputable(arg);
|
||||||
|
else
|
||||||
|
inputable(arg);
|
||||||
|
}
|
||||||
|
|
||||||
|
void check_wait(e) struct expr *e;
|
||||||
|
{
|
||||||
|
if ((e->type&T_TYPE)!=T_VALUE)
|
||||||
|
report("WAIT process needs valued operand");
|
||||||
|
}
|
||||||
|
|
||||||
|
static void assigned(e) register struct expr *e;
|
||||||
|
/* Tries to tell e that it is assigned to. */
|
||||||
|
{
|
||||||
|
if (e->kind==E_VAR || (e->kind==E_NODE && e->u.node.op=='['
|
||||||
|
&& (e=e->u.node.left)->kind==E_VAR)
|
||||||
|
) {
|
||||||
|
register struct symbol *var;
|
||||||
|
|
||||||
|
if ((var=e->u.var)->type&T_REP) {
|
||||||
|
warning("replicator index %s may not be assigned",
|
||||||
|
var->name);
|
||||||
|
var->type&= ~T_REP;
|
||||||
|
}
|
||||||
|
var->type|=T_ASSIGNED;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void used(e) register struct expr *e;
|
||||||
|
{
|
||||||
|
if (e->kind==E_VAR || (e->kind==E_NODE && e->u.node.op=='['
|
||||||
|
&& (e=e->u.node.left)->kind==E_VAR)
|
||||||
|
) {
|
||||||
|
register struct symbol *var;
|
||||||
|
|
||||||
|
if ( ! ( (var=e->u.var)->type&(T_ASSIGNED|T_BUILTIN))
|
||||||
|
&& (var->type&T_TYPE)==T_VAR
|
||||||
|
&& var->info.vc.st.level==curr_level)
|
||||||
|
warning("%s used before assigned", var->name);
|
||||||
|
var->type|=(T_USED|T_ASSIGNED);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static void rvalue(e) register struct expr *e;
|
||||||
|
{
|
||||||
|
if ((e->type&T_TYPE)!=T_VALUE || e->type&T_ARR)
|
||||||
|
report("illegal operand of arithmetic operator");
|
||||||
|
used(e);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void assignable(l, r) register struct expr *l, *r;
|
||||||
|
/* See if l can be assigned r. */
|
||||||
|
{
|
||||||
|
if ( ! ( (l->type&T_LVALUE && (r->type&T_TYPE)==T_VALUE
|
||||||
|
&& (l->type&T_ARR)==(r->type&T_ARR))
|
||||||
|
|| (l->type|r->type)&T_NOTDECL
|
||||||
|
))
|
||||||
|
report("operands of assignment are not conformable");
|
||||||
|
else
|
||||||
|
if (l->type&T_ARR && ! ( (l->type|r->type)&T_NOTDECL ) ) {
|
||||||
|
register lsiz=l->arr_siz, rsiz=r->arr_siz;
|
||||||
|
|
||||||
|
if (lsiz!=0 && rsiz!=0 && lsiz!=rsiz)
|
||||||
|
report("arrays have incompatible sizes");
|
||||||
|
}
|
||||||
|
used(r);
|
||||||
|
assigned(l);
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
static void inputable(e) struct expr *e;
|
||||||
|
{
|
||||||
|
if ( ! (e->type&T_LVALUE) )
|
||||||
|
report("operand of input process can't be assigned");
|
||||||
|
|
||||||
|
assigned(e);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void outputable(e) struct expr *e;
|
||||||
|
{
|
||||||
|
if ( ! ( (e->type&T_TYPE)==T_VALUE ) )
|
||||||
|
report("operand of output process has no value");
|
||||||
|
used(e);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void subscriptable(l, r, byte, atype, arr_siz)
|
||||||
|
register struct expr *l, *r;
|
||||||
|
register byte;
|
||||||
|
int *atype, *arr_siz;
|
||||||
|
/* Tries to subscript l by r, returning type and array size for slices. */
|
||||||
|
{
|
||||||
|
register type= (l->type&T_TYPE)|byte;
|
||||||
|
|
||||||
|
if ( !(l->type&(T_ARR|T_NOTDECL) ) )
|
||||||
|
report("indexing on a non-array");
|
||||||
|
else
|
||||||
|
if ( ! ( (r->type&T_TYPE)==T_VALUE
|
||||||
|
|| (r->kind==E_NODE && r->u.node.op==FOR)
|
||||||
|
) )
|
||||||
|
report("index is not computable");
|
||||||
|
|
||||||
|
type|=(l->type&T_LVALUE);
|
||||||
|
|
||||||
|
if (r->kind==E_NODE && r->u.node.op==FOR) {
|
||||||
|
type|=T_ARR;
|
||||||
|
if (r->u.node.right->kind!=E_CONST)
|
||||||
|
report("slice must be of constant size");
|
||||||
|
else
|
||||||
|
*arr_siz=r->u.node.right->u.const;
|
||||||
|
used(r->u.node.left);
|
||||||
|
} else
|
||||||
|
used(r);
|
||||||
|
*atype=type;
|
||||||
|
}
|
||||||
|
|
||||||
|
void check_param(aform, act, err)
|
||||||
|
struct par_list **aform;
|
||||||
|
register struct expr *act;
|
||||||
|
int *err;
|
||||||
|
/* Test if formal parameter *aform corresponds with actual act. Err returns
|
||||||
|
* error status. The aform hook is set to the next formal after the check.
|
||||||
|
*/
|
||||||
|
{
|
||||||
|
register struct par_list *form= *aform;
|
||||||
|
register struct expr *left;
|
||||||
|
register struct symbol *var;
|
||||||
|
static char NONCORR[]="actual and formal parameter don't correspond";
|
||||||
|
|
||||||
|
if (form==nil) {
|
||||||
|
if (! *err) {
|
||||||
|
report("too many actual parameters");
|
||||||
|
*err=1;
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
if ((form->type&T_ARR)!=(act->type&T_ARR) && !(act->type&T_NOTDECL) ) {
|
||||||
|
report(NONCORR);
|
||||||
|
} else {
|
||||||
|
switch (form->type&T_TYPE) {
|
||||||
|
case T_VAR:
|
||||||
|
if ( ! (
|
||||||
|
(act->type&T_TYPE)==T_VALUE
|
||||||
|
&& act->type&T_LVALUE
|
||||||
|
&& !(act->type&T_BYTE)
|
||||||
|
))
|
||||||
|
report(NONCORR);
|
||||||
|
assigned(act);
|
||||||
|
used(act);
|
||||||
|
break;
|
||||||
|
case T_CHAN:
|
||||||
|
if((act->type&T_TYPE)!=T_CHAN && !(act->type&T_NOTDECL))
|
||||||
|
report(NONCORR);
|
||||||
|
used(act);
|
||||||
|
break;
|
||||||
|
case T_VALUE:
|
||||||
|
if ((act->type&T_TYPE)!=T_VALUE)
|
||||||
|
report(NONCORR);
|
||||||
|
used(act);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
*aform= form->next;
|
||||||
|
}
|
||||||
|
|
||||||
|
void destroy(e) register struct expr *e;
|
||||||
|
/* Opposite of making. */
|
||||||
|
{
|
||||||
|
if (e!=nil) {
|
||||||
|
switch (e->kind) {
|
||||||
|
case E_NODE:
|
||||||
|
destroy(e->u.node.left);
|
||||||
|
destroy(e->u.node.right);
|
||||||
|
break;
|
||||||
|
case E_IO:
|
||||||
|
case E_CALL:
|
||||||
|
destroy(e->kind==E_IO ? e->u.io.chan : e->u.call.proc);
|
||||||
|
{
|
||||||
|
register struct expr_list *elp, *junk;
|
||||||
|
|
||||||
|
elp= e->kind==E_IO ? e->u.io.args : e->u.call.args;
|
||||||
|
|
||||||
|
while (elp!=nil) {
|
||||||
|
destroy(elp->arg);
|
||||||
|
junk=elp;
|
||||||
|
elp=elp->next;
|
||||||
|
free(junk);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
free(e);
|
||||||
|
}
|
||||||
|
}
|
||||||
61
lang/occam/comp/expr.h
Normal file
61
lang/occam/comp/expr.h
Normal file
|
|
@ -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)
|
||||||
82
lang/occam/comp/keytab.c
Normal file
82
lang/occam/comp/keytab.c
Normal file
|
|
@ -0,0 +1,82 @@
|
||||||
|
/* keytab.c */
|
||||||
|
# include "Lpars.h"
|
||||||
|
# include <ctype.h>
|
||||||
|
|
||||||
|
# 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 (key<keyword+MAXKEYLEN && islower(*str));
|
||||||
|
} else {
|
||||||
|
do
|
||||||
|
*key++ = *str++;
|
||||||
|
while (key<keyword+MAXKEYLEN && isupper(*str));
|
||||||
|
}
|
||||||
|
*key=0;
|
||||||
|
|
||||||
|
return *str==0 ? keyword : 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
char *keyname(key) register int key;
|
||||||
|
{
|
||||||
|
register KTAB *kp;
|
||||||
|
|
||||||
|
for (kp= keytab; kp< keytab+NKEYWORDS; kp++)
|
||||||
|
if (kp->k_token == key) return kp->k_str;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
344
lang/occam/comp/lex.l
Normal file
344
lang/occam/comp/lex.l
Normal file
|
|
@ -0,0 +1,344 @@
|
||||||
|
%{
|
||||||
|
/* lex.l */
|
||||||
|
# include <ctype.h>
|
||||||
|
# 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 (' '<tk && tk<='~')
|
||||||
|
sprintf(c, "'%c'", tk);
|
||||||
|
else
|
||||||
|
sprintf(c, "'*#%02x'", tk);
|
||||||
|
return c;
|
||||||
|
} else {
|
||||||
|
switch (tk) {
|
||||||
|
char *keyname();
|
||||||
|
char fake_id[1+sizeof(int)*3+1];
|
||||||
|
static fake_cnt=0;
|
||||||
|
default:
|
||||||
|
return keyname(tk);
|
||||||
|
case IDENTIFIER:
|
||||||
|
if (inst) {
|
||||||
|
sprintf(fake_id, "_%d", ++fake_cnt);
|
||||||
|
token.t_sval=strcpy(malloc(strlen(fake_id)+1),
|
||||||
|
fake_id);
|
||||||
|
return "IDENTIFIER";
|
||||||
|
} else
|
||||||
|
return token.t_sval;
|
||||||
|
case NUMBER:
|
||||||
|
case CHAR_CONST:
|
||||||
|
token.t_lval=0L;
|
||||||
|
return "NUMBER";
|
||||||
|
case STRING:
|
||||||
|
if (inst) {
|
||||||
|
token.t_sval=malloc(1);
|
||||||
|
token.t_sval[0]=0;
|
||||||
|
} else
|
||||||
|
free(token.t_sval);
|
||||||
|
return "STRING";
|
||||||
|
case AS: case LE: case GE: case NE:
|
||||||
|
case LS: case RS: case BA: case BO:
|
||||||
|
case BX: case BS: {
|
||||||
|
static int op[]= {
|
||||||
|
AS, LE, GE, NE, LS, RS, BA, BO, BX, BS
|
||||||
|
};
|
||||||
|
static char *opc[]= {
|
||||||
|
":=", "<=", ">=", "<>", "<<", ">>", "/\\",
|
||||||
|
"\\/", "><", "\\"
|
||||||
|
};
|
||||||
|
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);
|
||||||
|
}
|
||||||
684
lang/occam/comp/occam.g
Normal file
684
lang/occam/comp/occam.g
Normal file
|
|
@ -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 <stdio.h>
|
||||||
|
|
||||||
|
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)
|
||||||
|
);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
19
lang/occam/comp/report.c
Normal file
19
lang/occam/comp/report.c
Normal file
|
|
@ -0,0 +1,19 @@
|
||||||
|
#include <stdio.h>
|
||||||
|
|
||||||
|
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);
|
||||||
|
}
|
||||||
5
lang/occam/comp/sizes.h
Normal file
5
lang/occam/comp/sizes.h
Normal file
|
|
@ -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;
|
||||||
202
lang/occam/comp/symtab.c
Normal file
202
lang/occam/comp/symtab.c
Normal file
|
|
@ -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_offset<min_offset) min_offset=curr_offset;
|
||||||
|
}
|
||||||
|
|
||||||
|
void chan_memory(info, n) register union type_info *info; int n;
|
||||||
|
{
|
||||||
|
info->vc.st.level=curr_level;
|
||||||
|
info->vc.offset= curr_offset-=n*(vz+wz);
|
||||||
|
if (curr_offset<min_offset) min_offset=curr_offset;
|
||||||
|
}
|
||||||
|
|
||||||
|
int memory(z) int z;
|
||||||
|
/* Reserves z memory bytes */
|
||||||
|
{
|
||||||
|
curr_offset-=z;
|
||||||
|
if (curr_offset<min_offset) min_offset=curr_offset;
|
||||||
|
return curr_offset;
|
||||||
|
}
|
||||||
|
|
||||||
|
void pars_add(aapars, type, var)
|
||||||
|
register struct par_list ***aapars;
|
||||||
|
int type;
|
||||||
|
struct symbol *var;
|
||||||
|
/* Add a formal variable to a parameter list using a hook to a hook. */
|
||||||
|
{
|
||||||
|
register struct par_list *pl;
|
||||||
|
|
||||||
|
pl= (struct par_list *) malloc(sizeof *pl);
|
||||||
|
|
||||||
|
pl->type=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);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
91
lang/occam/comp/symtab.h
Normal file
91
lang/occam/comp/symtab.h
Normal file
|
|
@ -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;
|
||||||
11
lang/occam/comp/token.h
Normal file
11
lang/occam/comp/token.h
Normal file
|
|
@ -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();
|
||||||
Loading…
Reference in a new issue