lang/basic/src/graph.c

   1 /*
   2  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
   3  * See the copyright notice in the ACK home directory, in the file "Copyright".
   4  */
   5
   6 #include "bem.h"
   7
   8 #ifndef NORSCID
   9 static char rcs_id[] = "$Id: graph.c,v 1.2 1994/06/24 11:30:49 ceriel Exp $" ;
  10 #endif
  11
  12
  13 List *forwardlabel=0;
  14
  15 Linerecord      *firstline,
  16                 *currline,
  17                 *lastline;
  18
  19
  20
  21 List *newlist()
  22 {
  23         List *l;
  24
  25         /* NOSTRICT */ l = (List *) salloc(sizeof(List));
  26         return(l);
  27 }
  28
  29
  30 /* Line management is handled here */
  31
  32 Linerecord *srchline(nr)
  33 int nr;
  34 {
  35         Linerecord *l;
  36
  37         for(l=firstline;l && l->linenr<=nr;l= l->nextline)
  38                 if ( l->linenr== nr) return(l);
  39         return(0);
  40 }
  41
  42
  43
  44 List *srchforward(nr)
  45 int nr;
  46 {
  47         List *l;
  48
  49         for(l=forwardlabel;l ;l=l->nextlist)
  50                 if ( l->linenr== nr) return(l);
  51         return(0);
  52 }
  53
  54
  55
  56 linewarnings()
  57 {
  58         List *l;
  59         extern int errorcnt;
  60
  61         l= forwardlabel;
  62         while (l)
  63         {
  64                 if ( !srchline(l->linenr))
  65                 {
  66                         fprint(STDERR, "ERROR: line %d not defined\n",l->linenr);
  67                         errorcnt++;
  68                 }
  69                 l=l->nextlist;
  70         }
  71 }
  72
  73
  74
  75 newblock(nr)
  76 int     nr;
  77 {
  78         Linerecord      *l;
  79         List            *frwrd;
  80
  81         if ( debug) print("newblock at %d\n",nr);
  82         if ( nr>0 && currline && currline->linenr>= nr)
  83         {
  84                 if ( debug) print("old line:%d\n",currline->linenr);
  85                 error("Lines out of sequence");
  86         }
  87
  88         frwrd=srchforward(nr);
  89         if ( frwrd && debug) print("forward found %d\n",frwrd->emlabel);
  90         l= srchline(nr);
  91         if ( l)
  92         {
  93                 error("Line redefined");
  94                 nr= -genlabel();
  95         }
  96
  97         /* make new EM block structure */
  98         /* NOSTRICT */ l= (Linerecord *) salloc(sizeof(*l));
  99         l->emlabel= frwrd ? frwrd->emlabel : genlabel();
 100         l->linenr= nr;
 101
 102         /* insert this record */
 103         if ( firstline)
 104         {
 105                 currline->nextline=l;
 106                 l->prevline= currline;
 107                 lastline= currline=l;
 108         } else
 109                 firstline = lastline =currline=l;
 110 }
 111
 112
 113
 114 gotolabel(nr)
 115 int nr;
 116 {
 117         /* simulate a goto statement in the line record table */
 118         Linerecord *l1;
 119         List    *ll;
 120
 121         if (debug) print("goto label %d\n",nr);
 122         /* update currline */
 123         ll= newlist();
 124         ll-> linenr=nr;
 125         ll-> nextlist= currline->gotos;
 126         currline->gotos= ll;
 127
 128         /* try to generate code */
 129         l1= srchline(nr);
 130         if ( (ll=srchforward(nr))!=0)
 131                 nr= ll->emlabel;
 132         else
 133                 if ( l1==0)
 134                 {
 135                         /* declare forward label */
 136                         if (debug) print("declare forward %d\n",nr);
 137                         ll= newlist();
 138                         ll->emlabel= genlabel();
 139                         ll-> linenr=nr;
 140                         ll->nextlist= forwardlabel;
 141                         forwardlabel= ll;
 142                         nr= ll->emlabel;
 143                 } else nr= l1->emlabel;
 144         return(nr);
 145 }
 146
 147
 148
 149 gotostmt(nr)
 150 int nr;
 151 {
 152            C_bra((label) gotolabel(nr));
 153 }
 154
 155 /* GOSUB-return, assume that proper entries are made to subroutines
 156    only. The return statement is triggered by a fake constant label */
 157
 158 List    *gosubhead, *gotail;
 159 int     gosubcnt=1;
 160
 161
 162
 163 List *gosublabel()
 164 {
 165         List *l;
 166
 167         l= newlist();
 168         l->nextlist=0;
 169         l->emlabel=genlabel();
 170         if ( gotail){
 171                 gotail->nextlist=l;
 172                 gotail=l;
 173         } else gotail= gosubhead=l;
 174         gosubcnt++;
 175         return(l);
 176 }
 177
 178
 179
 180 gosubstmt(lab)
 181 int lab;
 182 {
 183         List *l;
 184         int nr,n;
 185
 186         n=gosubcnt;
 187         l= gosublabel();
 188         nr=gotolabel(lab);
 189         /*return index */
 190         C_loc((arith) n);
 191         /* administer legal return */
 192         C_cal("_gosub");
 193         C_asp((arith) BEMINTSIZE);
 194         C_bra((label) nr);
 195         C_df_ilb((label)l->emlabel);
 196 }
 197
 198
 199
 200 genreturns()
 201 {
 202         int nr;
 203
 204         nr= genlabel();
 205         C_df_dnam("returns");
 206         C_rom_ilb((label) nr);
 207         C_rom_cst((arith)1);
 208         C_rom_cst((arith) (gosubcnt-1));
 209
 210         while ( gosubhead)
 211         {
 212                 C_rom_ilb((label) gosubhead->emlabel);
 213                 gosubhead= gosubhead->nextlist;
 214         }
 215         C_df_ilb((label) nr);
 216         C_loc((arith) 1);
 217         C_cal("error");
 218 }
 219
 220
 221
 222
 223 returnstmt()
 224 {
 225         C_cal("_retstmt");
 226         C_lfr((arith) BEMINTSIZE);
 227         C_lae_dnam("returns",(arith)0);
 228         C_csa((arith) BEMINTSIZE);
 229 }
 230
 231
 232
 233 /* compound goto-gosub statements */
 234 List    *jumphead,*jumptail;
 235 int     jumpcnt;
 236
 237
 238 jumpelm(nr)
 239 int nr;
 240 {
 241         List *l;
 242
 243         l= newlist();
 244         l->emlabel= gotolabel(nr);
 245         l->nextlist=0;
 246         if ( jumphead==0) jumphead = jumptail = l;
 247         else {
 248                 jumptail->nextlist=l;
 249                 jumptail=l;
 250         }
 251         jumpcnt++;
 252 }
 253
 254
 255
 256 ongotostmt(type)
 257 int type;
 258 {
 259         /* generate the code itself, index in on top of the stack */
 260         /* blurh, store the number of entries in the descriptor */
 261         int firstlabel;
 262         int descr;
 263         List *l;
 264
 265         /* create descriptor first */
 266         descr= genlabel();
 267         firstlabel=genlabel();
 268         C_df_dlb((label)descr);
 269         C_rom_ilb((label)firstlabel);
 270         C_rom_cst((arith) 1);
 271         C_rom_cst((arith)(jumpcnt-1));
 272         l= jumphead;
 273         while (l)
 274         {
 275                 C_rom_ilb((label)l->emlabel);
 276                 l= l->nextlist;
 277         }
 278         jumphead= jumptail=0; jumpcnt=0;
 279         if (debug) print("ongotst:%d labels\n", jumpcnt);
 280         conversion(type,INTTYPE);
 281         C_dup((arith) BEMINTSIZE);
 282         C_zlt(err_goto_label);
 283         C_lae_dlb((label) descr,(arith) 0);
 284         C_csa((arith) BEMINTSIZE);
 285         C_df_ilb((label)firstlabel);
 286 }
 287
 288
 289
 290 ongosubstmt(type)
 291 int type;
 292 {
 293         List *l;
 294         int firstlabel;
 295         int descr;
 296
 297         /* create descriptor first */
 298         descr= genlabel();
 299         firstlabel=genlabel();
 300         C_df_dlb((label)descr);
 301         C_rom_ilb((label)firstlabel);
 302         C_rom_cst((arith)1);
 303         C_rom_cst((arith)(jumpcnt-1));
 304         l= jumphead;
 305
 306         while (l)
 307         {
 308                 C_rom_ilb((label)l->emlabel);
 309                 l= l->nextlist;
 310         }
 311
 312         jumphead= jumptail=0;
 313         jumpcnt=0;
 314         l= newlist();
 315         l->nextlist=0;
 316         l->emlabel=firstlabel;
 317         if ( gotail){
 318                 gotail->nextlist=l;
 319                 gotail=l;
 320         } else gotail=gosubhead=l;
 321         /* save the return point of the gosub */
 322         C_loc((arith) gosubcnt);
 323         C_cal("_gosub");
 324         C_asp((arith) BEMINTSIZE);
 325         gosubcnt++;
 326         /* generate gosub */
 327         conversion(type,INTTYPE);
 328         C_dup((arith) BEMINTSIZE);
 329         C_zlt(err_goto_label);
 330         C_lae_dlb((label) descr,(arith) 0);
 331         C_csa((arith)  BEMINTSIZE);
 332         C_df_ilb((label)firstlabel);
 333 }
 334
 335
 336
 337
 338 /* REGION ANALYSIS and FINAL VERSION GENERATION */
 339
 340