user/a60/symtab.c

   1 /*
   2  * Copyright (C) 1991,1992 Erik Schoenfelder (schoenfr@ibr.cs.tu-bs.de)
   3  *
   4  * This file is part of NASE A60.
   5  *
   6  * NASE A60 is free software; you can redistribute it and/or modify it
   7  * under the terms of the GNU General Public License as published by
   8  * the Free Software Foundation; either version 2, or (at your option)
   9  * any later version.
  10  *
  11  * NASE A60 is distributed in the hope that it will be useful, but
  12  * WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14  * General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU General Public License
  17  * along with NASE A60; see the file COPYING.  If not, write to the Free
  18  * Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19  *
  20  * symtab.c:                                    aug '90
  21  *
  22  * Erik Schoenfelder (schoenfr@ibr.cs.tu-bs.de)
  23  */
  24
  25 #include "comm.h"
  26 #include "util.h"
  27 #include "a60.h"
  28 #include "run.h"
  29 #include "tree.h"
  30
  31
  32 char *sym_tag_name[] = {
  33         "defined",
  34         "undef'd",
  35         "by-name",
  36         "by-value",
  37         "last_sym_tag_name"
  38 };
  39
  40
  41 SYMTAB *
  42 new_symbol (name, type, tag)
  43 char *name;
  44 ENUM type_tag type;
  45 ENUM sym_tag tag;
  46 {
  47         SYMTAB *new = TALLOC (SYMTAB);
  48
  49         new->name = name;
  50         new->type = type;
  51         new->tag = tag;
  52         new->own = 0;
  53         new->actidx = -1;
  54         new->next = 0;
  55
  56         new->source = infname;
  57         new->lineno = lineno;
  58
  59         return new;
  60 }
  61
  62
  63 /*
  64  * return a new data record; next-ptr (last activation) is appended
  65  * from the parameter.
  66  */
  67
  68 DATA *
  69 new_data ()
  70 {
  71         DATA *new = TALLOC (DATA);
  72
  73         return new;
  74 }
  75
  76
  77
  78 void
  79 sym_all_type (s, type, own)
  80 SYMTAB *s;
  81 ENUM type_tag type;
  82 int own;
  83 {
  84         while (s) {
  85                 s->type = type;
  86                 s->own = own;
  87                 s = s->next;
  88         }
  89 }
  90
  91
  92 SYMTAB *
  93 find_in_symtab (symtab, name)
  94 SYMTAB *symtab;
  95 char *name;
  96 {
  97         for ( ; symtab && strcmp (symtab->name, name);
  98              symtab=symtab->next);
  99
 100         return symtab;
 101 }
 102
 103
 104 void
 105 append_symtab (s1, s2)
 106 SYMTAB **s1, *s2;
 107 {
 108         while (*s1)
 109                 s1 = & (*s1)->next;
 110
 111         *s1 = s2;
 112 }
 113
 114
 115 void
 116 examine_and_append_symtab (s1, s2)
 117 SYMTAB **s1, *s2;
 118 {
 119         SYMTAB *s;
 120
 121         if(! s2 || ! s1) {
 122                 return;
 123         }
 124
 125         for (s=s2; s; s=s->next) {
 126
 127                 if (find_in_symtab (*s1, s->name)) {
 128                         a60_error (infname, lineno,
 129                                    "duplicate symbol name `%s'\n", s->name);
 130                         nerrors++;
 131                 }
 132         }
 133
 134         append_symtab (s1, s2);
 135 }
 136
 137
 138 /*
 139  *  remove spaces...
 140  */
 141
 142 char *
 143 cleanup_identifier (str)
 144 char *str;
 145 {
 146         char *from_ptr = str, *to_ptr = str;
 147
 148         while (*from_ptr) {
 149                 if (*from_ptr != ' ')
 150                         *to_ptr++ = *from_ptr;
 151                 from_ptr++;
 152         }
 153
 154         *to_ptr = 0;
 155
 156         return str;
 157 }
 158
 159
 160 static void
 161 print_bounds (b)
 162 BOUND *b;
 163 {
 164         if (! b)
 165                 return;
 166
 167         printf ("[");
 168         print_expr (b->low);
 169         printf (":");
 170         print_expr (b->high);
 171         printf ("]");
 172
 173         print_bounds (b->next);
 174 }
 175
 176
 177 static void
 178 print_indent_proc (s, n)
 179 SYMTAB *s;
 180 int n;
 181 {
 182         print_indent (n);
 183
 184         if (s->type == ty_proc)
 185                 printf ("(void) ");
 186         else
 187                 printf ("(%s) ",
 188                         type_tag_name[TPROC_BASE(s->type)]);
 189         printf("PROC [nparms: %d] pblock: (0x%lx; up 0x%lx; ext_ref %d)\n",
 190                s->u.pproc->nparm, (long) s->u.pproc->block,
 191                (long) s->u.pproc->block->up,
 192                (int) s->u.pproc->block->ext_ref);
 193
 194
 195         print_indent_symtab (s->u.pproc->block->symtab, n+4);
 196
 197         if(! s->u.pproc->block->stmt) {
 198                 print_indent (n+4);
 199                 printf ("<external reference>\n");
 200         }
 201         else
 202                 print_indent_tree (s->u.pproc->block->stmt, 0, n+4);
 203 }
 204
 205
 206 static void
 207 print_indent_switch_decl (s, n)
 208 SYMTAB *s;
 209 int n;
 210 {
 211         EXPR *expr;
 212
 213         for (expr = s->u.dexpr; expr; expr = expr->next) {
 214                 if (expr != s->u.dexpr)
 215                         print_indent (n);
 216                 print_expr (expr);
 217                 if (expr->next)
 218                         printf (",\n");
 219                 else
 220                         printf (";\n");
 221         }
 222 }
 223
 224
 225 void
 226 print_indent_symbol (s, n)
 227 SYMTAB *s;
 228 int n;
 229 {
 230         if (! s)
 231                 return;
 232
 233         print_indent (n);
 234         printf ("%s %s (%s)",
 235                 type_tag_name[s->type],
 236                 s->name,
 237                 sym_tag_name[s->tag]);
 238
 239         if (TIS_ARR(s->type)) {
 240                 if (! s->u.arr)
 241                         a60_error ("INTERNAL", 0, "INTERNAL: arr in nil\n");
 242                 else {
 243                         printf (" dim %d; ", s->u.arr->dim);
 244                         print_bounds (s->u.arr->bound);
 245                 }
 246         }
 247
 248         printf (" (sym 0x%lx;%s idx %d; block 0x%lx)\n",
 249                 (long) s, (s->own) ? " OWN" : "",
 250                 s->actidx, (long) s->block);
 251
 252         if (s->tag != s_byname && TIS_PROC(s->type))
 253                 print_indent_proc (s, n+2);
 254
 255         if (s->tag != s_byname && s->type == ty_switch) {
 256                 print_indent (n+4);
 257                 printf (" := ");
 258                 print_indent_switch_decl (s, n+8);
 259         }
 260 }
 261
 262
 263 void
 264 print_indent_symtab (s, n)
 265 SYMTAB *s;
 266 int n;
 267 {
 268         if (s) {
 269                 print_indent_symbol (s, n);
 270                 print_indent_symtab (s->next, n);
 271         }
 272 }
 273
 274
 275 /*
 276  * scope management; on parsetime the scope list is handled like
 277  * a stack; a new scope is instered at the beginning on a block
 278  * entry and removed on exit.
 279  */
 280
 281 SCOPE *current_scope = 0;
 282 static SCOPE *sroot = 0;
 283
 284 void
 285 open_new_scope ()
 286 {
 287         SCOPE *new = TALLOC (SCOPE);
 288         new->symtab = 0;
 289         new->marked = 0;
 290         new->block = TALLOC (BLOCK);
 291         if (current_scope)
 292                 new->block->up = current_scope->block;
 293         else
 294                 new->block->up = 0;
 295         new->symtab = & new->block->symtab;
 296         new->next = sroot;
 297         sroot = new;
 298
 299         current_scope = sroot;
 300 }
 301
 302 void
 303 close_current_scope ()
 304 {
 305         if(! current_scope)
 306                 xabort("close_current_scope: nil ???");
 307
 308         if (current_scope->marked)
 309                 examine_marked ();
 310
 311         current_scope = sroot = current_scope->next;
 312 }
 313
 314
 315 /*
 316  * add a new symbol to the marked list for `symbol not found'...
 317  */
 318
 319 static void
 320 add_marked_sym (lhelm)
 321 LHELM *lhelm;
 322 {
 323         MARK *new =TALLOC (MARK);
 324
 325         new->lhelm = lhelm;
 326         new->next = current_scope->marked;
 327         current_scope->marked = new;
 328 }
 329
 330
 331 void
 332 examine_marked ()
 333 {
 334         MARK *mark = current_scope->marked;
 335         LHELM *lhelm;
 336         SYMTAB *sym, *osym;
 337         char *name;
 338         int nscop;
 339
 340         while (mark) {
 341                 lhelm = mark->lhelm;
 342                 osym = lhelm->sym;
 343                 name = osym->name;
 344
 345                 if (osym->tag != s_undef)
 346                         xabort ("INTERNAL: examine_marked: still defd");
 347
 348                 sym = find_symbol_anywhere (name, current_scope->block,
 349                                             &nscop);
 350
 351                 if (! sym) {
 352                         a60_error (osym->source, osym->lineno,
 353                                    "undeclared symbol `%s'\n", name);
 354                         nerrors++;
 355                 }
 356                 else {
 357                         xfree ((char *) osym);
 358                         lhelm->sym = sym;
 359                         lhelm->nscop = nscop;
 360                 }
 361
 362                 mark = mark->next;
 363         }
 364 }
 365
 366
 367 /*
 368  * climb through the scopes looking for the given symbol.
 369  */
 370
 371 SYMTAB *
 372 find_symbol_anywhere (name, block, nscop)
 373 char *name;
 374 BLOCK *block;
 375 int *nscop;
 376 {
 377         SYMTAB *s;
 378         int up_ref = 0;
 379
 380         if (! block || ! name)
 381                 return (SYMTAB *) 0;
 382
 383         s = find_in_symtab (block->symtab, name);
 384         if (s) {
 385                 *nscop = 0;
 386                 return s;
 387         }
 388
 389         /*
 390          * extra check for extern reference:
 391          * (allow recursion and check for func-var on lefthand)
 392          */
 393         if (block->up && (s = find_in_symtab (block->up->symtab, name)))
 394                 up_ref = 1;
 395
 396         s = find_symbol_anywhere (name, block->up, nscop);
 397         (*nscop)++;
 398
 399         if (! s || ! up_ref || ! TIS_PROC(s->type)) {
 400                 /* inc extern reference: */
 401                 block->ext_ref++;
 402         }
 403
 404         return s;
 405 }
 406
 407
 408 /*
 409  * return number of bounds.
 410  */
 411
 412 int
 413 num_bounds (b)
 414 BOUND *b;
 415 {
 416         int n;
 417
 418         for (n=0; b; n++, b=b->next)
 419                 continue;
 420
 421         return n;
 422 }
 423
 424
 425
 426 /*
 427  * return number of symbols in symtab.
 428  */
 429
 430 int
 431 num_symbols (s)
 432 SYMTAB *s;
 433 {
 434         int n;
 435
 436         for (n=0; s; n++, s=s->next)
 437                 continue;
 438
 439         return n;
 440 }
 441
 442
 443 /*
 444  * set all syms in symtab to call_by_value;
 445  * the syms are freed.
 446  */
 447
 448 void
 449 set_by_value (symtab, syms)
 450 SYMTAB *symtab, *syms;
 451 {
 452         SYMTAB *sym, *fnd;
 453
 454         while (syms) {
 455
 456                 sym = syms;
 457                 fnd = find_in_symtab (symtab, sym->name);
 458                 if (fnd) {
 459                         if (fnd->type == ty_unknown) {
 460                                 a60_error (sym->source, sym->lineno,
 461                            "no specification present for `%s'\n", sym->name);
 462                                 nerrors++;
 463                         }
 464                         fnd->tag = s_byvalue;
 465                 }
 466                 else {
 467                         a60_error (sym->source, sym->lineno,
 468                            "not in parameter list `%s'\n", sym->name);
 469                         nerrors++;
 470                 }
 471                 syms = syms->next;
 472                 xfree ((char *) sym);
 473         }
 474 }
 475
 476
 477 /*
 478  * replace the type from syms in symtab;
 479  * free syms.
 480  */
 481
 482 void
 483 replace_type (symtab, syms)
 484 SYMTAB *symtab, *syms;
 485 {
 486         SYMTAB *sym, *fnd;
 487
 488         while (syms) {
 489
 490                 sym = syms;
 491                 fnd = find_in_symtab (symtab, sym->name);
 492                 if (fnd) {
 493                         if (fnd->type != ty_unknown)
 494                                 a60_error ("INTERNAL", 0,
 495                                    "INTERNAL: replace_type: still defd\n");
 496                         fnd->type = sym->type;
 497                 }
 498                 else {
 499                         a60_error (sym->source, sym->lineno,
 500                            "not in parameter list `%s'\n", sym->name);
 501                         nerrors++;
 502                 }
 503                 syms = syms->next;
 504                 xfree ((char *) sym);
 505         }
 506 }
 507
 508
 509 static int
 510 set_idx(symtab, n)
 511 SYMTAB *symtab;
 512 int n;
 513 {
 514         if (! symtab)
 515                 return n;
 516
 517         symtab->actidx = n;
 518         return set_idx (symtab->next, n+1);
 519 }
 520
 521 int
 522 set_actidx (symtab)
 523 SYMTAB *symtab;
 524 {
 525         return set_idx (symtab, 0);
 526 }
 527
 528
 529 /*
 530  * find the reference for an identifier.
 531  */
 532
 533 LHELM *
 534 make_var_ref (name, mark)
 535 char *name;
 536 int mark;
 537 {
 538         int nscop;
 539         LHELM *new;
 540         int not_found;
 541         SYMTAB *sym;
 542
 543         if (current_scope)
 544                 sym = find_symbol_anywhere (name, current_scope->block,
 545                                             &nscop);
 546         else
 547                 sym = (SYMTAB *) 0;
 548
 549         not_found = ! sym;
 550
 551         if (not_found) {
 552                 if (! mark) {
 553                         a60_error (infname, lineno,
 554                                    "undeclared symbol `%s'\n", name);
 555                         nerrors++;
 556                         return (LHELM *) 0;
 557                 }
 558                 else {
 559                         sym = new_symbol (name, ty_unknown, s_undef);
 560                         nscop = -1;
 561                 }
 562         }
 563
 564         new = new_lhelm (sym);
 565         new->nscop = nscop;
 566
 567         if (not_found && mark)
 568                 add_marked_sym (new);
 569
 570         return new;
 571 }
 572
 573 /* end of symtab.c */