util/ass/ass70.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
   7 #include        "ass00.h"
   8 #include        "assex.h"
   9
  10 #ifndef NORCSID
  11 static char rcs_id[] = "$Id: ass70.c,v 2.6 1994/06/24 10:15:20 ceriel Exp $" ;
  12 #endif
  13
  14 /*
  15 ** utilities of EM1-assembler/loader
  16 */
  17
  18 static int globstep;
  19
  20 /*
  21  * glohash returns an index in table and leaves a stepsize in globstep
  22  *
  23  */
  24
  25 static int glohash(aname,size) char *aname; {
  26         register char *p;
  27         register i;
  28         register sum;
  29
  30         /*
  31          * Computes a hash-value from a string.
  32          * Algorithm is adding all the characters after shifting some way.
  33          */
  34
  35         for(sum=i=0,p=aname;*p;i += 3)
  36                 sum += (*p++)<<(i&07);
  37         sum &= 077777;
  38         globstep = (sum / size) % (size - 7) + 7;
  39         return(sum % size);
  40 }
  41
  42 /*
  43  * lookup idname in labeltable , if it is not there enter it
  44  * return index in labeltable
  45  */
  46
  47 glob_t *glo2lookup(name,status) char *name; {
  48
  49         return(glolookup(name,status,mglobs,oursize->n_mlab));
  50 }
  51
  52 glob_t *xglolookup(name,status) char *name; {
  53
  54         return(glolookup(name,status,xglobs,oursize->n_glab));
  55 }
  56
  57 static void findext(g) glob_t *g ; {
  58         glob_t *x;
  59
  60         x = xglolookup(g->g_name,ENTERING);
  61         if (x && (x->g_status&DEF)) {
  62                 g->g_status |= DEF;
  63                 g->g_val.g_addr = x->g_val.g_addr;
  64         }
  65         g->g_status |= EXT;
  66 }
  67
  68 glob_t *glolookup(name,status,table,size)
  69 char *name;     /* name */
  70 int status;     /* kind of lookup */
  71 glob_t *table;  /* which table to use */
  72 int size;       /* size for hash */
  73 {
  74         register glob_t *g;
  75         register rem,j;
  76         int new;
  77
  78         /*
  79          * lookup global symbol name in specified table.
  80          * Various actions are taken depending on status.
  81          *
  82          * DEFINING:
  83          *      Lookup or enter the symbol, check for mult. def.
  84          * OCCURRING:
  85          *      Lookup the symbol, export if not known.
  86          * INTERNING:
  87          *      Enter symbol local to the module.
  88          * EXTERNING:
  89          *      Enter symbol visable from every module.
  90          * SEARCHING:
  91          *      Lookup the symbol, return 0 if not found.
  92          * ENTERING:
  93          *      Lookup or enter the symbol, don't check
  94          */
  95
  96         rem = glohash(name,size);
  97         j = 0; new=0;
  98         g = &table[rem];
  99         while (g->g_name != 0 && strcmp(name,g->g_name) != 0) {
 100                 j++;
 101                 if (j>size)
 102                         fatal("global label table overflow");
 103                 rem = (rem + globstep) % size;
 104                 g = &table[rem];
 105         }
 106         if (g->g_name == 0) {
 107                 /*
 108                  * This symbol is shining new.
 109                  * Enter it in table except for status = SEARCHING
 110                  */
 111                 if (status == SEARCHING)
 112                         return(0);
 113                 g->g_name = (char *) getarea((unsigned) (strlen(name) + 1));
 114                 strcpy(g->g_name,name);
 115                 g->g_status = 0;
 116                 g->g_val.g_addr=0;
 117                 new++;
 118         }
 119         switch(status) {
 120         case SEARCHING: /* nothing special */
 121         case ENTERING:
 122                 break;
 123         case INTERNING:
 124                 if (!new && (g->g_status&EXT))
 125                         werror("INA must be first occurrence of '%s'",name);
 126                 break;
 127         case EXTERNING:          /* lookup in other table */
 128                 /*
 129                  * The If statement is removed to be friendly
 130                  * to Backend writers having to deal with assemblers
 131                  * not following our conventions.
 132                 if (!new)
 133                         error("EXA must be first occurrence of '%s'",name);
 134                 */
 135                 findext(g);
 136                 break;
 137         case DEFINING:  /* Thou shalt not redefine */
 138                 if (g->g_status&DEF)
 139                         error("global symbol '%s' redefined",name);
 140                 g->g_status |= DEF;
 141                 break;
 142         case OCCURRING:
 143                 if ( new )
 144                         findext(g);
 145                 g->g_status |= OCC;
 146                 break;
 147         default:
 148                 fatal("bad status in glolookup");
 149         }
 150         return(g);
 151 }
 152
 153 locl_t *loclookup(an,status) {
 154         register locl_t *lbp,*l_lbp;
 155         register unsigned num;
 156         char hinum;
 157
 158         if ( !pstate.s_locl ) fatal("label outside procedure");
 159         num = an;
 160         if ( num/LOCLABSIZE>255 ) fatal("local label number too large");
 161         hinum = num/LOCLABSIZE;
 162         l_lbp= lbp= &(*pstate.s_locl)[num%LOCLABSIZE];
 163         if ( lbp->l_defined==EMPTY ) {
 164                 lbp= lbp_cast 0 ;
 165         } else {
 166                 while ( lbp!= lbp_cast 0 && lbp->l_hinum != hinum ) {
 167                         l_lbp = lbp ;
 168                         lbp = lbp->l_chain;
 169                 }
 170         }
 171         if ( lbp == lbp_cast 0 ) {
 172                 if ( l_lbp->l_defined!=EMPTY ) {
 173                         lbp = lbp_cast getarea(sizeof *lbp);
 174                         l_lbp->l_chain= lbp ;
 175                 } else lbp= l_lbp ;
 176                 lbp->l_chain= lbp_cast 0 ;
 177                 lbp->l_hinum=hinum;
 178                 lbp->l_defined = (status==OCCURRING ? NO : YES);
 179                 lbp->l_min= line_num;
 180         } else
 181                 if (status == DEFINING) {
 182                         if (lbp->l_defined == YES)
 183                                 error("multiple defined local symbol");
 184                         else
 185                                 lbp->l_defined = YES;
 186                 }
 187         if ( status==DEFINING ) lbp->l_min= line_num ;
 188         return(lbp);
 189 }
 190
 191 proc_t *prolookup(name,status) char *name; {
 192         register proc_t *p;
 193         register pstat;
 194
 195         /*
 196          * Look up a procedure name according to status
 197          *
 198          * PRO_OCC:     Occurrence
 199          *      Search both tables, local table first.
 200          *      If not found, enter in global table
 201          * PRO_INT:     INP
 202          *      Enter symbol in local table.
 203          * PRO_DEF:     Definition
 204          *      Define local procedure.
 205          * PRO_EXT:     EXP
 206          *      Enter symbol in global table.
 207          *
 208          *      The EXT bit in this table indicates the the name is used
 209          *      as external in this module.
 210          */
 211
 212         switch(status) {
 213         case PRO_OCC:
 214                 p = searchproc(name,mprocs,oursize->n_mproc);
 215                 if (p->p_name) {
 216                         p->p_status |= OCC;
 217                         return(p);
 218                 }
 219                 p = searchproc(name,xprocs,oursize->n_xproc);
 220                 if (p->p_name) {
 221                         p->p_status |= OCC;
 222                         return(p);
 223                 }
 224                 pstat = OCC|EXT;
 225                 unresolved++ ;
 226                 break;
 227         case PRO_INT:
 228                 p = searchproc(name,xprocs,oursize->n_xproc);
 229                 if (p->p_name && (p->p_status&EXT) )
 230                         error("pro '%s' conflicting use",name);
 231
 232                 p = searchproc(name,mprocs,oursize->n_mproc);
 233                 if (p->p_name)
 234                         werror("INP must be first occurrence of '%s'",name);
 235                 pstat = 0;
 236                 break;
 237         case PRO_EXT:
 238                 p = searchproc(name,mprocs,oursize->n_mproc);
 239                 if (p->p_name)
 240                         error("pro '%s' exists already localy",name);
 241                 p = searchproc(name,xprocs,oursize->n_xproc);
 242                 if (p->p_name) {
 243                         /*
 244                          * The If statement is removed to be friendly
 245                          * to Backend writers having to deal with assemblers
 246                          * not following our conventions.
 247                         if ( p->p_status&EXT )
 248                                 werror("EXP must be first occurrence of '%s'",
 249                                         name) ;
 250                          */
 251                         p->p_status |= EXT;
 252                         return(p);
 253                 }
 254                 pstat = EXT;
 255                 unresolved++;
 256                 break;
 257         case PRO_DEF:
 258                 p = searchproc(name,xprocs,oursize->n_xproc);
 259                 if (p->p_name && (p->p_status&EXT) ) {
 260                         if (p->p_status&DEF)
 261                                 error("global pro '%s' redeclared",name);
 262                         else
 263                                 unresolved-- ;
 264                         p->p_status |= DEF;
 265                         return(p);
 266                 } else {
 267                         p = searchproc(name,mprocs,oursize->n_mproc);
 268                         if (p->p_name) {
 269                                 if (p->p_status&DEF)
 270                                         error("local pro '%s' redeclared",
 271                                                 name);
 272                                 p->p_status |= DEF;
 273                                 return(p);
 274                         }
 275                 }
 276                 pstat = DEF;
 277                 break;
 278         default:
 279                 fatal("bad status in prolookup");
 280         }
 281         return(enterproc(name,pstat,p));
 282 }
 283
 284 proc_t *searchproc(name,table,size)
 285         char *name;
 286         proc_t *table;
 287         int size;
 288 {
 289         register proc_t *p;
 290         register rem,j;
 291
 292         /*
 293          * return a pointer into table to the place where the procedure
 294          * name is or should be if in the table.
 295          */
 296
 297         rem = glohash(name,size);
 298         j = 0;
 299         p = &table[rem];
 300         while (p->p_name != 0 && strcmp(name,p->p_name) != 0) {
 301                 j++;
 302                 if (j>size)
 303                         fatal("procedure table overflow");
 304                 rem = (rem + globstep) % size;
 305                 p = &table[rem];
 306         }
 307         return(p);
 308 }
 309
 310 proc_t *enterproc(name,status,place)
 311 char *name;
 312 char status;
 313 proc_t *place; {
 314         register proc_t *p;
 315
 316         /*
 317          * Enter the procedure name into the table at place place.
 318          * Place had better be computed by searchproc().
 319          *
 320          * NOTE:
 321          *      At this point the procedure gets assigned a number.
 322          *      This number is used as a parameter of cal and in some
 323          *      other ways. There exists a 1-1 correspondence between
 324          *      procedures and numbers.
 325          *      Two local procedures with the same name in different
 326          *      modules have different numbers.
 327          */
 328
 329         p=place;
 330         p->p_name = (char *) getarea((unsigned) (strlen(name) + 1));
 331         strcpy(p->p_name,name);
 332         p->p_status = status;
 333         if (procnum>=oursize->n_proc)
 334                 fatal("too many procedures");
 335         p->p_num = procnum++;
 336         return(p);
 337 }