src/basesuif/suif1/misc.cc

   1 /*  Miscellaneous Definitions */
   2
   3 /*  Copyright (c) 1994 Stanford University
   4
   5     All rights reserved.
   6
   7     This software is provided under the terms described in
   8     the "suif_copyright.h" include file. */
   9
  10 #include <suif_copyright.h>
  11
  12 #define _MODULE_ "libsuif.a"
  13
  14 #define RCS_BASE_FILE misc_cc
  15
  16 #include "suif1.h"
  17 #include "suif_internal.h"
  18 #include <stdarg.h>
  19 #include <setjmp.h>
  20 #include <string.h>
  21
  22 RCS_BASE(
  23     "$Id: misc.cc,v 1.2 1999/08/25 03:29:12 brm Exp $")
  24
  25 INCLUDE_SUIF_COPYRIGHT_NAMED(lib_suif)
  26
  27
  28 class clue_data
  29   {
  30 private:
  31     /* We make explicit copy constructor and assignment operator and
  32      * make them private to foil C++'s automatic default versions. */
  33     clue_data(const clue_data &);
  34     clue_data &operator=(const clue_data &);
  35
  36 public:
  37     boolean is_annote;
  38     union
  39       {
  40         annote *the_annote;
  41         suif_object *the_object;
  42       } u;
  43
  44     clue_data(annote *initial_annote) : is_annote(TRUE)
  45       { u.the_annote = initial_annote; }
  46     clue_data(suif_object *initial_object): is_annote(FALSE)
  47       { u.the_object = initial_object; }
  48   };
  49
  50 clue_data::clue_data(const clue_data &) : is_annote(0)
  51 { assert(FALSE); }
  52 clue_data &clue_data::operator=(const clue_data &)
  53 { assert(FALSE); return *this; }
  54
  55
  56 DECLARE_DLIST_CLASS(clue_data_list, clue_data *);
  57
  58
  59 /*  global string table */
  60 string_table *lexicon;
  61
  62 /*  target machine parameters */
  63 machine_params target;
  64
  65 boolean ignore_warnings = FALSE;
  66 boolean _suif_no_types = FALSE;
  67 boolean _suif_no_symtabs = FALSE;
  68 boolean _suif_raw_syms = FALSE;
  69 boolean _suif_flat_annotes = FALSE;
  70
  71 char *_suif_program_name;
  72 char *_suif_prog_base_name;
  73 char *_suif_command_line;
  74
  75 boolean show_error_context = FALSE;
  76
  77 static proc_sym *last_diagnostic_proc = NULL;
  78 static clue_data_list *clue_stack = NULL;
  79 static boolean in_context_search = FALSE;
  80 static char **warnings_seen = NULL;
  81 static unsigned long warning_record_length = 0;
  82
  83 static void announce_proc(proc_sym *the_proc);
  84 static void show_context(void);
  85
  86
  87 /*****************************************************************************/
  88
  89
  90 /*
  91  *  Miscellaneous utility functions.
  92  */
  93
  94 int
  95 suif_round_to_int (int n)
  96 {
  97     return (n + sizeof(int) - 1) / sizeof(int);
  98 }
  99
 100
 101
 102 boolean
 103 is_power_of_2 (int n)
 104 {
 105     return !(n & (n-1));
 106 }
 107
 108
 109 /*
 110  *  Make a constant string: In C++ there is no guarantee that a string
 111  *  passed to a routine will remain a constant since there may be other
 112  *  pointers to it.  When it is imperative that a string be a constant,
 113  *  const_string is called to create private copies of the strings.
 114  */
 115
 116 const char *
 117 const_string (const char *s)
 118 {
 119     return (s == NULL) ? NULL : strcpy(new char[strlen(s) + 1], s);
 120 }
 121
 122
 123 /*
 124  *  Indent a certain number of spaces.
 125  */
 126
 127 void
 128 suif_indent (FILE *f, int n)
 129 {
 130     for (int i = 0; i < n; i++) {
 131         fprintf(f, "  ");
 132     }
 133 }
 134
 135
 136 /*
 137  *  Check if two instructions in a flat list are within the
 138  *  same expression tree.  This is used for converting to call-by-ref
 139  *  form and also by the newsuif conversion program.  Search backwards
 140  *  from the destination instruction to the source instruction to see
 141  *  if there are any assignments in between.  If so, then the two
 142  *  instructions are not within the same expression, and the function
 143  *  returns FALSE.
 144  */
 145
 146 boolean
 147 within_expr (instruction *dst, instruction *src)
 148 {
 149     tree_node_list_e *pos = dst->parent()->list_e()->prev();
 150     while (TRUE) {
 151
 152         if (!pos || !pos->contents->is_instr()) {
 153             assert_msg(FALSE, ("cannot find source instruction %u",
 154                                src->number()));
 155         }
 156
 157         tree_instr *ti = (tree_instr *)pos->contents;
 158         if (ti->instr() == src) break;
 159
 160         /* instructions with temporary destinations are allowed */
 161         operand pdst = ti->instr()->dst_op();
 162         if (!pdst.is_instr()) return FALSE;
 163
 164         pos = pos->prev();
 165     }
 166     return TRUE;
 167 }
 168
 169
 170 /*****************************************************************************/
 171
 172
 173 const char *__suif_assert_file = NULL;
 174 int __suif_assert_line = -1;
 175 const char *__suif_assert_module = NULL;
 176 jmp_buf * _suif_longjmp_env = NULL;
 177
 178
 179 /*
 180  *  Assert, with no message.
 181  */
 182
 183 void
 184 __suif_assert (const char *expr, const char *file, int line, const char *module)
 185 {
 186     fflush(stdout);
 187     if (_suif_longjmp_env) longjmp(*_suif_longjmp_env, 1);
 188     if (in_context_search)
 189         fprintf(stderr, "\n[assertion failure in context search: ]\n");
 190     if (_suif_program_name)
 191         fprintf(stderr, "\n**** Program: %s", _suif_program_name);
 192     fprintf(stderr, "\n**** Assertion failure in file \"%s\" at line %d",
 193             file, line);
 194     if (module)
 195         fprintf(stderr, "  (module %s)", module);
 196     fprintf(stderr, "\n**** False expression: %s\n", expr);
 197     fflush(stderr);
 198     show_context();
 199     abort();
 200 }
 201
 202
 203 /*
 204  *  Assert, with a message.
 205  */
 206
 207 void
 208 __suif_assert_msg (const char *msg ...)
 209 {
 210     va_list ap;
 211     va_start(ap, msg);
 212
 213     fflush(stdout);
 214     if (_suif_longjmp_env) longjmp(*_suif_longjmp_env, 1);
 215     if (in_context_search)
 216         fprintf(stderr, "\n[assertion failure in context search: ]\n");
 217     if (_suif_program_name)
 218         fprintf(stderr, "\n**** Program: %s", _suif_program_name);
 219     fprintf(stderr, "\n**** Assertion failure in file \"%s\" at line %d",
 220             __suif_assert_file, __suif_assert_line);
 221     if (__suif_assert_module)
 222         fprintf(stderr, "  (module %s)", __suif_assert_module);
 223     fprintf(stderr, "\n**** ");
 224     vfprintf(stderr, msg, ap);
 225     va_end(ap);
 226
 227     putc('\n', stderr);
 228     fflush(stderr);
 229     show_context();
 230     abort();
 231 }
 232
 233
 234 static void find_file_and_line(suif_object *the_object, const char **filename,
 235                                unsigned *linenum);
 236 static void read_line_annote(immed_list *line_immeds, const char **filename,
 237                              unsigned *line_num);
 238 static proc_sym *find_enclosing_proc(suif_object *the_object);
 239
 240
 241 /*
 242  *  This returns the line number in the original source code which generated
 243  *  the_object, or at least the code in which the_object is now situated, as
 244  *  best suif can figure it.  This line number is within the file whose name
 245  *  is returned by source_line_num().  If no line number information can be
 246  *  found, zero is returned.
 247  */
 248
 249 unsigned
 250 source_line_num (suif_object *the_object)
 251 {
 252     unsigned result;
 253     find_file_and_line(the_object, NULL, &result);
 254     return result;
 255 }
 256
 257
 258 /*
 259  *  This returns the name of the original source code file which generated
 260  *  the_object, or at least the code in which the_object is now situated, as
 261  *  best suif can figure it.  If the source file information cannot be
 262  *  found, NULL is returned.
 263  */
 264
 265 const char *
 266 source_file_name (suif_object *the_object)
 267 {
 268     const char *result;
 269     find_file_and_line(the_object, &result, NULL);
 270     return result;
 271 }
 272
 273
 274 /*
 275  *  This function finds the last k_line annotation on a tree_node or mark
 276  *  instruction before or including the tree_node containing the_object on
 277  *  the same list or any ancestor list.  This is the line annotation that is
 278  *  currently in effect.  Note that this means that the scope of a k_line
 279  *  declaration is limited to the rest of the current tree_node_list,
 280  *  including sub lists of following nodes.  It does not carry to the
 281  *  remainder of ancestor lists or sibling lists.
 282  *
 283  *  If no such k_line annoation can be found, it looks for a
 284  *  k_source_file_name annotation on the enclosing file_set_entry, if one can
 285  *  be found.  If none of these is successful, it sets the filename to NULL
 286  *  and the line to zero.
 287  */
 288
 289 static void
 290 find_file_and_line (suif_object *the_object, const char **filename,
 291                     unsigned *linenum)
 292 {
 293     if (filename != NULL)
 294         *filename = NULL;
 295     if (linenum != NULL)
 296         *linenum = 0;
 297
 298     if (the_object == NULL)
 299         return;
 300
 301     switch (the_object->object_kind()) {
 302         case FILE_OBJ:
 303           {
 304             file_set_entry *the_fse = (file_set_entry *)the_object;
 305             immed_list *the_immeds =
 306                     (immed_list *)(the_fse->peek_annote(k_source_file_name));
 307             if (the_immeds != NULL) {
 308                 assert(the_immeds->count() == 1);
 309                 immed value = the_immeds->head()->contents;
 310                 assert(value.is_string());
 311                 if (filename != NULL)
 312                     *filename = value.string();
 313             }
 314             break;
 315           }
 316         case TREE_OBJ:
 317           {
 318             tree_node *the_node = (tree_node *)the_object;
 319             immed_list *the_immeds =
 320                     (immed_list *)(the_node->peek_annote(k_line));
 321             if (the_immeds != NULL) {
 322                 read_line_annote(the_immeds, filename, linenum);
 323                 return;
 324             }
 325             tree_node_list_e *current_element = the_node->list_e();
 326             while (current_element != NULL) {
 327                 tree_node *test_node = current_element->contents;
 328                 assert(test_node != NULL);
 329                 immed_list *the_immeds =
 330                         (immed_list *)(test_node->peek_annote(k_line));
 331                 if (the_immeds != NULL) {
 332                     read_line_annote(the_immeds, filename, linenum);
 333                     return;
 334                 }
 335                 if (test_node->kind() == TREE_INSTR) {
 336                     tree_instr *the_tree_instr = (tree_instr *)test_node;
 337                     instruction *the_instr = the_tree_instr->instr();
 338                     if ((the_instr != NULL) &&
 339                         (the_instr->opcode() == io_mrk)) {
 340                         immed_list *the_immeds =
 341                                 (immed_list *)(the_instr->peek_annote(k_line));
 342                         if (the_immeds != NULL) {
 343                             read_line_annote(the_immeds, filename, linenum);
 344                             return;
 345                         }
 346                     }
 347                 }
 348                 current_element = current_element->prev();
 349             }
 350
 351             tree_node_list *parent = the_node->parent();
 352             if (parent == NULL) {
 353                 if (the_node->is_proc()) {
 354                     tree_proc *the_proc = (tree_proc *)the_node;
 355                     find_file_and_line(the_proc->proc()->file(), filename,
 356                                        linenum);
 357                 }
 358             } else {
 359                 find_file_and_line(parent->parent(), filename, linenum);
 360             }
 361             return;
 362           }
 363         case INSTR_OBJ:
 364           {
 365             instruction *the_instr = (instruction *)the_object;
 366             find_file_and_line(the_instr->owner(), filename, linenum);
 367             break;
 368           }
 369         case SYMTAB_OBJ:
 370           {
 371             base_symtab *the_symtab = (base_symtab *)the_object;
 372             if (the_symtab->is_block()) {
 373                 find_file_and_line(((block_symtab *)the_symtab)->block(),
 374                                    filename, linenum);
 375             } else if (the_symtab->is_file()) {
 376                 find_file_and_line(((file_symtab *)the_symtab)->fse(),
 377                                    filename, linenum);
 378             }
 379             break;
 380           }
 381         case SYM_OBJ:
 382           {
 383             sym_node *the_symbol = (sym_node *)the_object;
 384             find_file_and_line(the_symbol->parent(), filename, linenum);
 385             break;
 386           }
 387         case DEF_OBJ:
 388           {
 389             var_def *the_def = (var_def *)the_object;
 390             find_file_and_line(the_def->parent(), filename, linenum);
 391             break;
 392           }
 393         case TYPE_OBJ:
 394           {
 395             type_node *the_type = (type_node *)the_object;
 396             find_file_and_line(the_type->parent(), filename, linenum);
 397             break;
 398           }
 399         default:
 400             assert(FALSE);
 401     }
 402 }
 403
 404
 405 /*
 406  *  This function finds the enclosing procedure, if any, of the given object.
 407  */
 408
 409 static proc_sym *find_enclosing_proc(suif_object *the_object)
 410 {
 411     if (the_object == NULL)
 412         return NULL;
 413
 414     switch (the_object->object_kind()) {
 415         case FILE_OBJ:
 416             break;
 417         case TREE_OBJ:
 418           {
 419             tree_node *the_node = (tree_node *)the_object;
 420             return the_node->proc();
 421           }
 422         case INSTR_OBJ:
 423           {
 424             instruction *the_instr = (instruction *)the_object;
 425             return find_enclosing_proc(the_instr->owner());
 426           }
 427         case SYMTAB_OBJ:
 428           {
 429             base_symtab *the_symtab = (base_symtab *)the_object;
 430             if (the_symtab->is_block()) {
 431                 block_symtab *the_block_symtab = (block_symtab *)the_symtab;
 432                 return find_enclosing_proc(the_block_symtab->block());
 433             }
 434             break;
 435           }
 436         case SYM_OBJ:
 437           {
 438             sym_node *the_symbol = (sym_node *)the_object;
 439             return find_enclosing_proc(the_symbol->parent());
 440           }
 441         case DEF_OBJ:
 442           {
 443             var_def *the_def = (var_def *)the_object;
 444             return find_enclosing_proc(the_def->parent());
 445           }
 446         case TYPE_OBJ:
 447           {
 448             type_node *the_type = (type_node *)the_object;
 449             return find_enclosing_proc(the_type->parent());
 450           }
 451         default:
 452             assert(FALSE);
 453     }
 454     return NULL;
 455 }
 456
 457
 458 /*
 459  *  This function reads the contents of the immed list assuming they are in
 460  *  the form used in a k_line annotation.
 461  */
 462
 463 static void
 464 read_line_annote(immed_list *line_immeds, const char **filename, unsigned *line_num)
 465 {
 466     immed_list_iter the_iter(line_immeds);
 467     if (the_iter.is_empty())
 468         error_line(1, NULL, "bad format in \"line\" annotation");
 469
 470     immed value = the_iter.step();
 471     if (!value.is_unsigned_int())
 472         error_line(1, NULL, "bad format in \"line\" annotation");
 473
 474     if (line_num != NULL)
 475         *line_num = value.unsigned_int();
 476
 477     if (the_iter.is_empty())
 478         error_line(1, NULL, "bad format in \"line\" annotation");
 479
 480     value = the_iter.step();
 481     if (!value.is_string())
 482         error_line(1, NULL, "bad format in \"line\" annotation");
 483
 484     if (filename != NULL)
 485         *filename = value.string();
 486 }
 487
 488
 489 /*
 490  *  These two functions print a diagnostic error message to stderr and then
 491  *  optionally exits or aborts the program.  The diagnostic message printed is
 492  *  exactly what would be printed by warning_line() except that the word
 493  *  ``Error'', not ``Warning'', is used.  After that, if the return_code is
 494  *  zero the function just returns normally.  If the return code is negative,
 495  *  the program will abort(), which customarily causes a core dump.  If the
 496  *  return code is positive, the program will exit() with that return code.
 497  */
 498
 499 void
 500 error_line (int return_code, suif_object *the_object, char *fmt, ...)
 501 {
 502     va_list ap;
 503     va_start(ap, fmt);
 504     verror_line(return_code, the_object, fmt, ap);
 505     va_end(ap);
 506 }
 507
 508
 509 void
 510 verror_line (int return_code, suif_object *the_object, char *fmt, va_list ap)
 511 {
 512     unsigned src_line;
 513     const char *src_file_name;
 514     find_file_and_line(the_object, &src_file_name, &src_line);
 515
 516     proc_sym *this_proc_sym = find_enclosing_proc(the_object);
 517
 518     fflush(stdout);
 519     if (_suif_longjmp_env) longjmp(*_suif_longjmp_env, 1);
 520
 521     if (in_context_search)
 522         fprintf(stderr, "\n[error in context search: ]\n");
 523
 524     if ((this_proc_sym != NULL) && (this_proc_sym != last_diagnostic_proc)) {
 525         last_diagnostic_proc = this_proc_sym;
 526         announce_proc(this_proc_sym);
 527     }
 528
 529     if (src_file_name != NULL) {
 530         fprintf(stderr, "%s:", src_file_name);
 531         if (src_line != 0)
 532             fprintf(stderr, "%u:", src_line);
 533         fprintf(stderr, "Error");
 534         if (_suif_prog_base_name != NULL)
 535             fprintf(stderr, "(%s)", _suif_prog_base_name);
 536     } else {
 537         if (_suif_prog_base_name != NULL)
 538             fprintf(stderr, "%s:", _suif_prog_base_name);
 539         else
 540             fprintf(stderr, "%s:", "suif");
 541         fprintf(stderr, "Error");
 542     }
 543     fprintf(stderr, ": ");
 544     vfprintf(stderr, fmt, ap);
 545     putc('\n', stderr);
 546     fflush(stderr);
 547     show_context();
 548
 549     if (return_code < 0)
 550         abort();
 551     if (return_code > 0)
 552         exit(return_code);
 553 }
 554
 555
 556 /*
 557  *  These two functions print a diagnostic warning to stderr in the form
 558  *
 559  *      <srcfile>:<srcline>:Warning(<passname>): <message text>
 560  *
 561  *  where <srcfile> is the name of the source file and <srcline> the decimal
 562  *  representation of the line within that file that generated this part of
 563  *  the suif representation, as nearly as suif can figure it; <passname> is
 564  *  the name of the program printing the warning; and <message text> is the
 565  *  text of the warning message as determined by the format string fmt and
 566  *  optional arguments or argument list, in the manner of printf() or
 567  *  vprintf() respectively.  The suif_object the_object is used to locate the
 568  *  error relative to the source code, by way of the functions
 569  *  source_line_num() and source_file_name().  If the <srcline> cannot be
 570  *  determined, that and the following colon are omitted from the above
 571  *  format.  If the passname is not known, it and the surrounding parentheses
 572  *  are omitted.
 573  *
 574  *  If the_object is NULL or the <srcfile> cannot be determined for any other
 575  *  reason, the diagnostic warning takes the form
 576  *
 577  *      <passname>:Warning: <message text>
 578  *
 579  *  instead.
 580  */
 581
 582 void
 583 warning_line (suif_object *the_object, char *fmt, ...)
 584 {
 585     va_list ap;
 586     va_start(ap, fmt);
 587     vwarning_line(the_object, fmt, ap);
 588     va_end(ap);
 589 }
 590
 591
 592 void
 593 vwarning_line (suif_object *the_object, char *fmt, va_list ap)
 594 {
 595     if (ignore_warnings)
 596         return;
 597
 598     if (warn_only_once)
 599       {
 600         if (warnings_seen == NULL)
 601           {
 602             warnings_seen = new char *[20];
 603             warning_record_length = 20;
 604             warnings_seen[0] = NULL;
 605           }
 606         else
 607           {
 608             char **follow_warnings = &(warnings_seen[0]);
 609             while (*follow_warnings != NULL)
 610               {
 611                 if (*follow_warnings == fmt)
 612                     return;
 613                 ++follow_warnings;
 614               }
 615             if (follow_warnings == &(warnings_seen[warning_record_length - 1]))
 616               {
 617                 char **new_block = new char *[warning_record_length * 2];
 618                 memcpy(new_block, warnings_seen,
 619                        warning_record_length * sizeof(char *));
 620                 delete[] warnings_seen;
 621                 warnings_seen = new_block;
 622                 warnings_seen[warning_record_length - 1] = fmt;
 623                 warnings_seen[warning_record_length] = NULL;
 624                 warning_record_length *= 2;
 625               }
 626             else
 627               {
 628                 *follow_warnings = fmt;
 629                 follow_warnings[1] = NULL;
 630               }
 631           }
 632       }
 633
 634     unsigned src_line;
 635     const char *src_file_name;
 636     find_file_and_line(the_object, &src_file_name, &src_line);
 637
 638     proc_sym *this_proc_sym = find_enclosing_proc(the_object);
 639
 640     fflush(stdout);
 641
 642     if (in_context_search)
 643         fprintf(stderr, "\n[warning in context search: ]\n");
 644
 645     if ((this_proc_sym != NULL) && (this_proc_sym != last_diagnostic_proc)) {
 646         last_diagnostic_proc = this_proc_sym;
 647         announce_proc(this_proc_sym);
 648     }
 649
 650     if (src_file_name != NULL) {
 651         fprintf(stderr, "%s:", src_file_name);
 652         if (src_line != 0)
 653             fprintf(stderr, "%u:", src_line);
 654         fprintf(stderr, "Warning");
 655         if (_suif_prog_base_name != NULL)
 656             fprintf(stderr, "(%s)", _suif_prog_base_name);
 657     } else {
 658         if (_suif_prog_base_name != NULL)
 659             fprintf(stderr, "%s:", _suif_prog_base_name);
 660         else
 661             fprintf(stderr, "%s:", "suif");
 662         fprintf(stderr, "Warning");
 663     }
 664     fprintf(stderr, ": ");
 665     vfprintf(stderr, fmt, ap);
 666     putc('\n', stderr);
 667     fflush(stderr);
 668     show_context();
 669 }
 670
 671
 672 static void
 673 announce_proc (proc_sym *the_proc)
 674 {
 675     if ((the_proc == NULL) || (the_proc->name() == NULL))
 676         return;
 677
 678     const char *src_file_name = source_file_name(the_proc);
 679     if (src_file_name != NULL)
 680         fprintf(stderr, "%s: ", src_file_name);
 681     fprintf(stderr, "In function `%s':\n", the_proc->name());
 682 }
 683
 684 static void
 685 show_context (void)
 686 {
 687     if (in_context_search || (!show_error_context))
 688         return;
 689
 690     in_context_search = TRUE;
 691
 692     clue_data_list_e *follow_e = clue_stack->head();
 693     while (follow_e != NULL)
 694       {
 695         clue_data *this_clue = follow_e->contents;
 696         fprintf(stderr, "[while processing ");
 697         if (this_clue->is_annote)
 698           {
 699             fprintf(stderr, "annotation \"%s\"",
 700                     this_clue->u.the_annote->name());
 701           }
 702         else
 703           {
 704             suif_object *this_object = this_clue->u.the_object;
 705             switch (this_object->object_kind())
 706               {
 707                 case FILE_OBJ:
 708                   {
 709                     file_set_entry *the_fse = (file_set_entry *)this_object;
 710                     const char *in_name = the_fse->in_name();
 711                     const char *out_name = the_fse->out_name();
 712                     fprintf(stderr, "file");
 713                     if (in_name || out_name)
 714                         fprintf(stderr, " ");
 715                     if (in_name)
 716                         fprintf(stderr, "\"%s\"", in_name);
 717                     if (in_name && out_name)
 718                         fprintf(stderr, "/");
 719                     if (out_name)
 720                         fprintf(stderr, "\"%s\"", out_name);
 721                     break;
 722                   }
 723                 case TREE_OBJ:
 724                   {
 725                     tree_node *the_node = (tree_node *)this_object;
 726                     switch (the_node->kind())
 727                       {
 728                         case TREE_INSTR:
 729                             fprintf(stderr, "tree_instr");
 730                             break;
 731                         case TREE_LOOP:
 732                             fprintf(stderr, "tree_loop");
 733                             break;
 734                         case TREE_FOR:
 735                           {
 736                             tree_for *the_for = (tree_for *)the_node;
 737                             fprintf(stderr, "tree_for on `%s'",
 738                                     the_for->index()->name());
 739                             break;
 740                           }
 741                         case TREE_IF:
 742                             fprintf(stderr, "tree_if");
 743                             break;
 744                         case TREE_BLOCK:
 745                             fprintf(stderr, "tree_block");
 746                             break;
 747                         default:
 748                             assert(FALSE);
 749                       }
 750                     fprintf(stderr, " #%u", the_node->number());
 751                     break;
 752                   }
 753                 case INSTR_OBJ:
 754                   {
 755                     instruction *the_instr = (instruction *)this_object;
 756                     fprintf(stderr, "%s instruction #%u",
 757                             if_ops_name(the_instr->opcode()),
 758                             the_instr->number());
 759                     break;
 760                   }
 761                 case SYMTAB_OBJ:
 762                   {
 763                     base_symtab *the_symtab = (base_symtab *)this_object;
 764                     switch (the_symtab->kind())
 765                       {
 766                         case SYMTAB_GLOBAL:
 767                             fprintf(stderr, "inter-file global");
 768                             break;
 769                         case SYMTAB_FILE:
 770                             fprintf(stderr, "file");
 771                             break;
 772                         case SYMTAB_PROC:
 773                             fprintf(stderr, "procedure");
 774                             break;
 775                         case SYMTAB_BLOCK:
 776                             fprintf(stderr, "block");
 777                             break;
 778                         default:
 779                             assert(FALSE);
 780                       }
 781                     fprintf(stderr, " symbol table `%s'", the_symtab->name());
 782                     break;
 783                   }
 784                 case SYM_OBJ:
 785                   {
 786                     sym_node *the_sym = (sym_node *)this_object;
 787                     switch (the_sym->kind())
 788                       {
 789                         case SYM_PROC:
 790                             fprintf(stderr, "procedure");
 791                             break;
 792                         case SYM_LABEL:
 793                             fprintf(stderr, "label");
 794                             break;
 795                         case SYM_VAR:
 796                             fprintf(stderr, "variable");
 797                             break;
 798                         default:
 799                             assert(FALSE);
 800                       }
 801                     fprintf(stderr, " symbol `%s'", the_sym->name());
 802                     break;
 803                   }
 804                 case DEF_OBJ:
 805                   {
 806                     var_def *the_def = (var_def *)this_object;
 807                     fprintf(stderr, "var_def for variable `%s'",
 808                             the_def->variable()->name());
 809                     break;
 810                   }
 811                 case TYPE_OBJ:
 812                   {
 813                     type_node *the_type = (type_node *)this_object;
 814                     switch (the_type->op())
 815                       {
 816                         case TYPE_INT:
 817                             fprintf(stderr, "integer");
 818                             break;
 819                         case TYPE_FLOAT:
 820                             fprintf(stderr, "floating-point");
 821                             break;
 822                         case TYPE_VOID:
 823                             fprintf(stderr, "void");
 824                             break;
 825                         case TYPE_PTR:
 826                             fprintf(stderr, "pointer");
 827                             break;
 828                         case TYPE_ARRAY:
 829                             fprintf(stderr, "array");
 830                             break;
 831                         case TYPE_FUNC:
 832                             fprintf(stderr, "function");
 833                             break;
 834                         case TYPE_GROUP:
 835                             fprintf(stderr, "group");
 836                             break;
 837                         case TYPE_STRUCT:
 838                             fprintf(stderr, "struct");
 839                             break;
 840                         case TYPE_UNION:
 841                             fprintf(stderr, "union");
 842                             break;
 843                         case TYPE_ENUM:
 844                             fprintf(stderr, "enum");
 845                             break;
 846                         case TYPE_CONST:
 847                             fprintf(stderr, "constant");
 848                             break;
 849                         case TYPE_VOLATILE:
 850                             fprintf(stderr, "volatile");
 851                             break;
 852                         case TYPE_CALL_BY_REF:
 853                             fprintf(stderr, "call-by-reference");
 854                             break;
 855                         case TYPE_NULL:
 856                             fprintf(stderr, "null modifier");
 857                             break;
 858                         default:
 859                             assert(FALSE);
 860                       }
 861                     fprintf(stderr, " type #%u (", the_type->type_id());
 862                     the_type->print_abbrev(stderr);
 863                     fprintf(stderr, ")");
 864                     break;
 865                   }
 866                 default:
 867                     assert(FALSE);
 868               }
 869           }
 870         fprintf(stderr, "]\n");
 871         follow_e = follow_e->next();
 872       }
 873
 874     fflush(stderr);
 875
 876     in_context_search = FALSE;
 877 }
 878
 879
 880 void
 881 push_clue (suif_object *the_object)
 882 {
 883     clue_stack->push(new clue_data(the_object));
 884 }
 885
 886
 887 void
 888 push_clue (annote *the_annote)
 889 {
 890     clue_stack->push(new clue_data(the_annote));
 891 }
 892
 893
 894 void
 895 pop_clue (suif_object *the_object)
 896 {
 897     if (clue_stack->is_empty())
 898         error_line(1, the_object, "pop_clue() called with empty clue stack");
 899     clue_data *this_clue = clue_stack->pop();
 900     if (this_clue->is_annote || (this_clue->u.the_object != the_object))
 901         error_line(1, the_object, "popped clue does not match stack");
 902     delete this_clue;
 903 }
 904
 905
 906 void
 907 pop_clue (annote *the_annote)
 908 {
 909     if (clue_stack->is_empty())
 910         error_line(1, NULL, "pop_clue() called with empty clue stack");
 911     clue_data *this_clue = clue_stack->pop();
 912     if ((!this_clue->is_annote) || (this_clue->u.the_annote != the_annote))
 913         error_line(1, NULL, "popped clue does not match stack");
 914     delete this_clue;
 915 }
 916
 917
 918 void
 919 init_error_handler (void)
 920 {
 921     assert(clue_stack == NULL || clue_stack_empty());
 922     if (clue_stack == NULL)
 923         clue_stack = new clue_data_list;
 924 }
 925
 926 boolean
 927 clue_stack_empty (void)
 928 {
 929     return clue_stack->is_empty();
 930 }
 931
 932
 933 /*****************************************************************************/
 934
 935
 936 /*
 937  *  Procedure iterator.
 938  */
 939
 940 void
 941 suif_proc_iter (int argc, char * argv[], prociter_f fun,
 942                 boolean writeback,
 943                 boolean exp_trees,
 944                 boolean use_fortran_form)
 945 {
 946     if (writeback) {
 947         if (argc < 2)
 948             error_line(1, NULL, "No files given");
 949         if (argc == 2)
 950             error_line(1, NULL, "No file to write back");
 951         if (argc % 2 != 1)
 952             error_line(1, NULL, "File mismatch, file missing to write back");
 953         for (int i = 1; i < argc; i += 2) {
 954             fileset->add_file(argv[i], argv[i+1]);
 955         }
 956     } else {
 957         if (argc < 2)
 958             error_line(1, NULL, "No files given");
 959         for (int i = 1; i < argc; i++) {
 960             fileset->add_file(argv[i], NULL);
 961         }
 962     }
 963
 964     fileset->reset_iter();
 965     file_set_entry *fse;
 966
 967     while ((fse = fileset->next_file())) {
 968         fse->reset_proc_iter();
 969
 970         proc_sym *ps;
 971         while ((ps = fse->next_proc())) {
 972             if ((!ps->is_readable()) && (!ps->is_in_memory()))
 973                 continue;
 974
 975             if (!ps->is_in_memory()) {
 976                 ps->read_proc(exp_trees,
 977                               (ps->src_lang() == src_fortran) ?
 978                               use_fortran_form : FALSE);
 979             }
 980
 981             push_clue(ps->block());
 982             (fun)(ps->block());
 983             pop_clue(ps->block());
 984
 985             if (writeback && !ps->is_written())
 986                 ps->write_proc(fse);
 987             ps->flush_proc();
 988         }
 989     }
 990
 991     exit_suif1();
 992 }
 993
 994
 995 /*****************************************************************************/
 996
 997
 998 /*
 999  *  Print out the target machine parameters.
1000  */
1001
1002 void
1003 machine_params::print (FILE *fp, int depth)
1004 {
1005     suif_indent(fp, depth);
1006     fprintf(fp, "Target machine parameters:\n");
1007
1008     suif_indent(fp, depth+1);
1009     if (is_big_endian) {
1010         fprintf(fp, "Big endian\n");
1011     } else {
1012         fprintf(fp, "Little endian\n");
1013     }
1014
1015     suif_indent(fp, depth+1);
1016     fprintf(fp, "Size of addressable units = %d\n", addressable_size);
1017
1018     suif_indent(fp, depth+1);
1019     if (char_is_signed) {
1020         fprintf(fp, "Default char type is signed\n");
1021     } else {
1022         fprintf(fp, "Default char type is unsigned\n");
1023     }
1024
1025     suif_indent(fp, depth+1);
1026     fprintf(fp, "char type:       size = %d, align = %d\n",
1027             size[C_char], align[C_char]);
1028
1029     suif_indent(fp, depth+1);
1030     fprintf(fp, "short type:      size = %d, align = %d\n",
1031             size[C_short], align[C_short]);
1032
1033     suif_indent(fp, depth+1);
1034     fprintf(fp, "int type:        size = %d, align = %d\n",
1035             size[C_int], align[C_int]);
1036
1037     suif_indent(fp, depth+1);
1038     fprintf(fp, "long type:       size = %d, align = %d\n",
1039             size[C_long], align[C_long]);
1040
1041     suif_indent(fp, depth+1);
1042     fprintf(fp, "longlong type:   size = %d, align = %d\n",
1043             size[C_longlong], align[C_longlong]);
1044
1045     suif_indent(fp, depth+1);
1046     fprintf(fp, "float type:      size = %d, align = %d\n",
1047             size[C_float], align[C_float]);
1048
1049     suif_indent(fp, depth+1);
1050     fprintf(fp, "double type:     size = %d, align = %d\n",
1051             size[C_double], align[C_double]);
1052
1053     suif_indent(fp, depth+1);
1054     fprintf(fp, "longdouble type: size = %d, align = %d\n",
1055             size[C_longdouble], align[C_longdouble]);
1056
1057     suif_indent(fp, depth+1);
1058     fprintf(fp, "ptr type:        size = %d, align = %d\n",
1059             size[C_ptr], align[C_ptr]);
1060
1061     suif_indent(fp, depth+1);
1062     fprintf(fp, "Array alignment = %d\n", array_align);
1063
1064     suif_indent(fp, depth+1);
1065     fprintf(fp, "Structure alignment = %d\n", struct_align);
1066
1067     suif_indent(fp, depth+1);
1068     fprintf(fp, "Pointer difference type = %d (see C_types enum)\n",
1069             ptr_diff_type);
1070 }
1071
1072
1073 boolean
1074 machine_params::operator== (machine_params &other)
1075 {
1076     for (int type_num = 0; type_num < num_C_types; ++type_num) {
1077         if (size[type_num] != other.size[type_num])
1078             return FALSE;
1079         if (align[type_num] != other.align[type_num])
1080             return FALSE;
1081     }
1082     return ((is_big_endian == other.is_big_endian) &&
1083             (addressable_size == other.addressable_size) &&
1084             (char_is_signed == other.char_is_signed) &&
1085             (array_align == other.array_align) &&
1086             (struct_align == other.struct_align) &&
1087             (ptr_diff_type == other.ptr_diff_type));
1088 }