123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612 |
- /* $Header$ */
- /*
- * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
- * See the copyright notice in the ACK home directory, in the file "Copyright".
- */
- #include "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();
- }
|