123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340 |
- /*
- * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
- * See the copyright notice in the ACK home directory, in the file "Copyright".
- */
- #include "bem.h"
- #ifndef NORSCID
- static char rcs_id[] = "$Id$" ;
- #endif
- List *forwardlabel=0;
- Linerecord *firstline,
- *currline,
- *lastline;
- List *newlist()
- {
- List *l;
- /* NOSTRICT */ l = (List *) salloc(sizeof(List));
- return(l);
- }
- /* Line management is handled here */
- Linerecord *srchline(nr)
- int nr;
- {
- Linerecord *l;
- for(l=firstline;l && l->linenr<=nr;l= l->nextline)
- if ( l->linenr== nr) return(l);
- return(0);
- }
- List *srchforward(nr)
- int nr;
- {
- List *l;
- for(l=forwardlabel;l ;l=l->nextlist)
- if ( l->linenr== nr) return(l);
- return(0);
- }
- linewarnings()
- {
- List *l;
- extern int errorcnt;
- l= forwardlabel;
- while (l)
- {
- if ( !srchline(l->linenr))
- {
- fprint(STDERR, "ERROR: line %d not defined\n",l->linenr);
- errorcnt++;
- }
- l=l->nextlist;
- }
- }
- newblock(nr)
- int nr;
- {
- Linerecord *l;
- List *frwrd;
- if ( debug) print("newblock at %d\n",nr);
- if ( nr>0 && currline && currline->linenr>= nr)
- {
- if ( debug) print("old line:%d\n",currline->linenr);
- error("Lines out of sequence");
- }
- frwrd=srchforward(nr);
- if ( frwrd && debug) print("forward found %d\n",frwrd->emlabel);
- l= srchline(nr);
- if ( l)
- {
- error("Line redefined");
- nr= -genlabel();
- }
- /* make new EM block structure */
- /* NOSTRICT */ l= (Linerecord *) salloc(sizeof(*l));
- l->emlabel= frwrd ? frwrd->emlabel : genlabel();
- l->linenr= nr;
- /* insert this record */
- if ( firstline)
- {
- currline->nextline=l;
- l->prevline= currline;
- lastline= currline=l;
- } else
- firstline = lastline =currline=l;
- }
- gotolabel(nr)
- int nr;
- {
- /* simulate a goto statement in the line record table */
- Linerecord *l1;
- List *ll;
- if (debug) print("goto label %d\n",nr);
- /* update currline */
- ll= newlist();
- ll-> linenr=nr;
- ll-> nextlist= currline->gotos;
- currline->gotos= ll;
- /* try to generate code */
- l1= srchline(nr);
- if ( (ll=srchforward(nr))!=0)
- nr= ll->emlabel;
- else
- if ( l1==0)
- {
- /* declare forward label */
- if (debug) print("declare forward %d\n",nr);
- ll= newlist();
- ll->emlabel= genlabel();
- ll-> linenr=nr;
- ll->nextlist= forwardlabel;
- forwardlabel= ll;
- nr= ll->emlabel;
- } else nr= l1->emlabel;
- return(nr);
- }
- gotostmt(nr)
- int nr;
- {
- C_bra((label) gotolabel(nr));
- }
- /* GOSUB-return, assume that proper entries are made to subroutines
- only. The return statement is triggered by a fake constant label */
- List *gosubhead, *gotail;
- int gosubcnt=1;
- List *gosublabel()
- {
- List *l;
- l= newlist();
- l->nextlist=0;
- l->emlabel=genlabel();
- if ( gotail){
- gotail->nextlist=l;
- gotail=l;
- } else gotail= gosubhead=l;
- gosubcnt++;
- return(l);
- }
- gosubstmt(lab)
- int lab;
- {
- List *l;
- int nr,n;
- n=gosubcnt;
- l= gosublabel();
- nr=gotolabel(lab);
- /*return index */
- C_loc((arith) n);
- /* administer legal return */
- C_cal("_gosub");
- C_asp((arith) BEMINTSIZE);
- C_bra((label) nr);
- C_df_ilb((label)l->emlabel);
- }
- genreturns()
- {
- int nr;
- nr= genlabel();
- C_df_dnam("returns");
- C_rom_ilb((label) nr);
- C_rom_cst((arith)1);
- C_rom_cst((arith) (gosubcnt-1));
- while ( gosubhead)
- {
- C_rom_ilb((label) gosubhead->emlabel);
- gosubhead= gosubhead->nextlist;
- }
- C_df_ilb((label) nr);
- C_loc((arith) 1);
- C_cal("error");
- }
- returnstmt()
- {
- C_cal("_retstmt");
- C_lfr((arith) BEMINTSIZE);
- C_lae_dnam("returns",(arith)0);
- C_csa((arith) BEMINTSIZE);
- }
- /* compound goto-gosub statements */
- List *jumphead,*jumptail;
- int jumpcnt;
- jumpelm(nr)
- int nr;
- {
- List *l;
- l= newlist();
- l->emlabel= gotolabel(nr);
- l->nextlist=0;
- if ( jumphead==0) jumphead = jumptail = l;
- else {
- jumptail->nextlist=l;
- jumptail=l;
- }
- jumpcnt++;
- }
- ongotostmt(type)
- int type;
- {
- /* generate the code itself, index in on top of the stack */
- /* blurh, store the number of entries in the descriptor */
- int firstlabel;
- int descr;
- List *l;
- /* create descriptor first */
- descr= genlabel();
- firstlabel=genlabel();
- C_df_dlb((label)descr);
- C_rom_ilb((label)firstlabel);
- C_rom_cst((arith) 1);
- C_rom_cst((arith)(jumpcnt-1));
- l= jumphead;
- while (l)
- {
- C_rom_ilb((label)l->emlabel);
- l= l->nextlist;
- }
- jumphead= jumptail=0; jumpcnt=0;
- if (debug) print("ongotst:%d labels\n", jumpcnt);
- conversion(type,INTTYPE);
- C_dup((arith) BEMINTSIZE);
- C_zlt(err_goto_label);
- C_lae_dlb((label) descr,(arith) 0);
- C_csa((arith) BEMINTSIZE);
- C_df_ilb((label)firstlabel);
- }
- ongosubstmt(type)
- int type;
- {
- List *l;
- int firstlabel;
- int descr;
- /* create descriptor first */
- descr= genlabel();
- firstlabel=genlabel();
- C_df_dlb((label)descr);
- C_rom_ilb((label)firstlabel);
- C_rom_cst((arith)1);
- C_rom_cst((arith)(jumpcnt-1));
- l= jumphead;
- while (l)
- {
- C_rom_ilb((label)l->emlabel);
- l= l->nextlist;
- }
- jumphead= jumptail=0;
- jumpcnt=0;
- l= newlist();
- l->nextlist=0;
- l->emlabel=firstlabel;
- if ( gotail){
- gotail->nextlist=l;
- gotail=l;
- } else gotail=gosubhead=l;
- /* save the return point of the gosub */
- C_loc((arith) gosubcnt);
- C_cal("_gosub");
- C_asp((arith) BEMINTSIZE);
- gosubcnt++;
- /* generate gosub */
- conversion(type,INTTYPE);
- C_dup((arith) BEMINTSIZE);
- C_zlt(err_goto_label);
- C_lae_dlb((label) descr,(arith) 0);
- C_csa((arith) BEMINTSIZE);
- C_df_ilb((label)firstlabel);
- }
- /* REGION ANALYSIS and FINAL VERSION GENERATION */
|