1 /* $Id: plsymtab.c,v 1.33 2003/03/26 01:16:28 moniot Exp $
2
3 Routines associated with printing of local symbol table info
4
5 */
6
7 /*
8
9
10 Copyright (c) 2001 by Robert K. Moniot.
11
12 Permission is hereby granted, free of charge, to any person
13 obtaining a copy of this software and associated documentation
14 files (the "Software"), to deal in the Software without
15 restriction, including without limitation the rights to use,
16 copy, modify, merge, publish, distribute, sublicense, and/or
17 sell copies of the Software, and to permit persons to whom the
18 Software is furnished to do so, subject to the following
19 conditions:
20
21 The above copyright notice and this permission notice shall be
22 included in all copies or substantial portions of the
23 Software.
24
25 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY
26 KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
27 WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
28 PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
29 COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
30 LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
31 OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
32 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
33
34 Acknowledgement: the above permission notice is what is known
35 as the "MIT License."
36 */
37
38 /*
39 Shared functions defined:
40
41 local_err_head Prints module name and file name (for errors)
42 local_warn_head Prints module name and file name (for warnings)
43 debug_symtabs() Prints debugging info about symbol tables
44 choose_tag Decides on tag & line no to use
45 print_lsyms Prints symbol lists
46 print_lsyms_briefly Brief symbol lists
47 print_variables Prints variable symbol table
48 sort_lsymbols Sorts a list of Lsymtab ptrs alphabetically
49 sort_parameters Sorts Lsymtab list by seq num instead of name
50
51 Private functions defined:
52
53 local_msg_head Print error/warning head.
54 print_lsyms_verbosely(sym_list,n,do_types) Verbose symbol lists.
55
56 */
57
58 #include <stdio.h>
59 #include <ctype.h>
60 #include <string.h>
61 #include "ftnchek.h"
62 #define PLSYMTAB
63 #include "symtab.h"
64 #include "plsymtab.h"
65
66 /* Declarations of local functions */
67 PROTO(PRIVATE void local_msg_head,( const char *problem, const char *mod_name,
68 const char *filename,
69 LINENO_t lineno, const Lsymtab *symt,
70 int force_lineno, const char *msg ));
71 PROTO(PRIVATE int print_lsyms_verbosely,( Lsymtab **sym_list,
72 int n, int do_types ));
73 PROTO(PRIVATE int print_var_type,( FILE *fd, const Lsymtab *symt ));
74
75 #ifdef DEBUG_SYMTABS
76 PROTO(PRIVATE void print_arg_array,( ArgListHeader *arglist ));
77 PROTO(PRIVATE void print_com_array,( ComListHeader *cmlist ));
78 PROTO(PRIVATE void print_tokenlist,( TokenListHeader *toklist ));
79 #endif
80
81
82 void
83 #if HAVE_STDC
sort_parameters(Lsymtab ** sp,int n)84 sort_parameters(Lsymtab **sp, int n) /* sort a given list by sequence num instead of name */
85 #else /* K&R style */
86 sort_parameters(sp,n)
87 Lsymtab **sp;
88 int n;
89 #endif /* HAVE_STDC */
90 {
91 int i,j,swaps;
92
93 for (i = 0; i < n; i++)
94 {
95 swaps = 0;
96 for (j = n-1; j >= i+1; j--)
97 {
98 if ( sp[j-1]->info.param->seq_num > sp[j]->info.param->seq_num )
99 {
100 Lsymtab *temp = sp[j-1]; /* swap ptrs j and j-1 */
101 sp[j-1] = sp[j];
102 sp[j] = temp;
103 swaps ++;
104 }
105 }
106 if(swaps == 0)
107 break;
108 }
109 }
110
111
112 void
113 #if HAVE_STDC
sort_lsymbols(Lsymtab ** sp,int n)114 sort_lsymbols(Lsymtab **sp, int n) /* bubble-sorts a given list */
115 #else /* K&R style */
116 sort_lsymbols(sp,n)
117 Lsymtab **sp;
118 int n;
119 #endif /* HAVE_STDC */
120 {
121 int i,j,swaps;
122 for(i=0;i<n;i++) {
123 swaps = 0;
124 for(j=n-1;j>=i+1;j--) {
125 if((strcmp(sp[j-1]->name, sp[j]->name)) > 0) {
126 Lsymtab *temp = sp[j-1]; /* swap ptrs j and j-1 */
127 sp[j-1] = sp[j];
128 sp[j] = temp;
129 swaps ++;
130 }
131 }
132 if(swaps == 0) break;
133 }
134 }
135
136
137 void
138 #if HAVE_STDC
local_err_head(const char * mod_name,const char * filename,LINENO_t lineno,const Lsymtab * symt,int force_lineno,const char * msg)139 local_err_head(const char *mod_name, const char *filename, LINENO_t lineno, const Lsymtab *symt,
140 int force_lineno, const char *msg)
141 #else /* K&R style */
142 local_err_head(mod_name, filename, lineno, symt, force_lineno, msg)
143 char *mod_name; /* name of module where warning reported */
144 char *filename; /* -1 if not an include file */
145 LINENO_t lineno;
146 Lsymtab *symt; /* line number for expert-style warnings */
147 int force_lineno; /* print line number even if brief/novice */
148 char *msg; /* error message */
149 #endif /* HAVE_STDC */
150 {
151 local_msg_head("Error", mod_name, filename,
152 lineno, symt, force_lineno, msg);
153
154 ++error_count;
155 }
156
157
158 void
159 #if HAVE_STDC
local_warn_head(const char * mod_name,const char * filename,LINENO_t lineno,const Lsymtab * symt,int force_lineno,const char * msg)160 local_warn_head(const char *mod_name, const char *filename, LINENO_t lineno, const Lsymtab *symt,
161 int force_lineno, const char *msg)
162 #else /* K&R style */
163 local_warn_head(mod_name, filename, lineno, symt, force_lineno, msg)
164 char *mod_name; /* name of module where warning reported */
165 char *filename; /* file name within which problem occurred */
166 LINENO_t lineno; /* line number for expert-style warnings */
167 Lsymtab *symt; /* symbol table entry of the item */
168 int force_lineno; /* print line number even if brief/novice */
169 char *msg; /* error message */
170 #endif /* HAVE_STDC */
171 {
172 local_msg_head("Warning", mod_name, filename, lineno, symt,
173 force_lineno, msg);
174
175 ++warning_count;
176 }
177
178 PRIVATE void
179 #if HAVE_STDC
local_msg_head(const char * problem,const char * mod_name,const char * filename,LINENO_t lineno,const Lsymtab * symt,int force_lineno,const char * msg)180 local_msg_head(const char *problem, const char *mod_name, const char *filename, LINENO_t lineno, const Lsymtab *symt,
181 int force_lineno, const char *msg)
182 #else /* K&R style */
183 local_msg_head(problem, mod_name, filename, lineno, symt, force_lineno, msg)
184 char *problem; /* Error or Warning */
185 char *mod_name; /* name of module where warning reported */
186 char *filename; /* file name within which problem occurred */
187 LINENO_t lineno; /* line number for expert-style warnings */
188 Lsymtab *symt; /* symbol table entry of the item */
189 int force_lineno; /* print line number even if brief/novice */
190 char *msg; /* error message */
191 #endif /* HAVE_STDC */
192 {
193 char intro[MAXIDSIZE+19]; /* introduction to warning/error message */
194 char *tag; /* placeholder in choose_tag call */
195
196 /* Line number makes no sense in brief or novice modes,
197 except when no detail follows. For that case, caller
198 sets force_lineno = 1. In verbose expert mode, must
199 get the right line number to accompany message, matching
200 the line number that will appear with the first detail
201 item (pointed to symt). Caller sets symt to NULL to cause
202 given lineno to be used.
203 */
204 if( (brief || novice_help) && ! force_lineno) {
205 lineno = NO_LINE_NUM;
206 }
207 else if( symt != (Lsymtab *)NULL ) {
208 choose_tag(TAG_DEFN,symt,&tag,&lineno);
209 /* Use include-file name if applicable */
210 filename = choose_filename(symt,file_used);
211 }
212
213 if( ! quiet ) /* space between warning blocks */
214 (void)fprintf(list_fd,"\n");
215 (void)sprintf(intro,"%s in module %s",problem,mod_name);
216 local_message(filename,lineno,msg,intro);
217
218 }
219
220
221
222 /* Print list of symbols, either in brief many-per-line
223 style, or verbosely one-per-line.
224 */
225 int
226 #if HAVE_STDC
print_lsyms(Lsymtab ** sym_list,int n,int do_types)227 print_lsyms(Lsymtab **sym_list, int n, int do_types)
228 #else /* K&R style */
229 print_lsyms(sym_list,n,do_types)
230 Lsymtab **sym_list;
231 int n;
232 int do_types;
233 #endif /* HAVE_STDC */
234 {
235 if(brief)
236 return print_lsyms_briefly(sym_list,n,do_types);
237 else
238 return print_lsyms_verbosely(sym_list,n,do_types);
239 }
240
241 /* This routine prints symbol names in brief format. If do_types is true
242 also prints types, with * next to implicitly
243 typed identifiers, and returns count thereof. */
244
245 int
246 #if HAVE_STDC
print_lsyms_briefly(Lsymtab ** sym_list,int n,int do_types)247 print_lsyms_briefly(Lsymtab **sym_list, int n, int do_types)
248 #else /* K&R style */
249 print_lsyms_briefly(sym_list,n,do_types)
250 Lsymtab **sym_list;
251 int n;
252 int do_types;
253 #endif /* HAVE_STDC */
254 {
255 int i,col=0,len,implicits=0;
256
257 (void)fprintf(list_fd,"\n");
258
259 for(i=0;i<n;i++) {
260 len = strlen(sym_list[i]->name);/* len=actual length of name */
261 /* Revise len to max(10,len)+extra 9=width
262 of field to be printed. Adjust column
263 count to see where this will take us. */
264 col += len = (len <= 10? 10: len) + 9;
265 /* If this will run past 78 start a new line */
266 if(col > 78) {
267 (void)fprintf(list_fd,"\n");
268 col = len;
269 }
270 (void)fprintf(list_fd,"%10s",sym_list[i]->name);/* Print the name in 10 cols */
271
272 if( do_types ) { /* Optionally print the datatype */
273 if(sym_list[i]->intrinsic)
274 (void)fprintf(list_fd,": intrns ");
275 else {
276 (void)fprintf(list_fd,":");
277 (void) print_var_type(list_fd,sym_list[i]);
278 if(datatype_of(sym_list[i]->type) == type_UNDECL) {
279 implicits++; /* Flag and count undeclareds */
280 (void)fprintf(list_fd,"*");
281 }
282 else if(sym_list[i]->size == size_DEFAULT)
283 (void)fprintf(list_fd," ");
284 (void)fprintf(list_fd," ");
285 }
286 }
287 else /* Otherwise just 9 blanks */
288 (void)fprintf(list_fd,"%9s","");
289 }
290
291 (void)fprintf(list_fd,"\n");
292
293 return implicits;
294
295 }/*print_lsyms_briefly*/
296
297
298 /* This routine prints symbol names in verbose format, one per line
299 with line number where defined and a tag message ("declared" or
300 "first occurrence"). If do_types is true, also prints types, with
301 * next to implicitly typed identifiers, and returns count thereof.
302 */
303
304 PRIVATE int
305 #if HAVE_STDC
print_lsyms_verbosely(Lsymtab ** sym_list,int n,int do_types)306 print_lsyms_verbosely(Lsymtab **sym_list, int n, int do_types)
307 #else /* K&R style */
308 print_lsyms_verbosely(sym_list,n,do_types)
309 Lsymtab **sym_list;
310 int n;
311 int do_types;
312 #endif /* HAVE_STDC */
313 {
314 int i,implicits=0;
315 char msgbuf[6+MAX_TAG_LEN+MAXIDSIZE]; /* see sprintf below */
316 for(i=0;i<n;i++) {
317 char *tag;
318 LINENO_t lineno;
319 short inc_index;
320 choose_tag(TAG_DEFN, sym_list[i], &tag, &lineno);
321
322 if( sprintf(msgbuf," %s %s", sym_list[i]->name, tag)
323 > (int)sizeof(msgbuf)-1 ) {
324 oops_message(OOPS_NONFATAL,NO_LINE_NUM,NO_COL_NUM,
325 "buffer too small in print_lsyms_verbosely for");
326 msg_tail(msgbuf);
327 }
328 inc_index = sym_list[i]->file_declared;
329 local_detail(inc_index,lineno,(char *)NULL,msgbuf);
330 if( do_types ) { /* Optionally print the datatype */
331 if(sym_list[i]->intrinsic)
332 msg_tail("(intrinsic function)");
333 else {
334 int t,s;
335 t = get_type(sym_list[i]);
336 s = get_size(sym_list[i],t);
337 msg_tail("with type");
338 msg_tail(typespec(t,(s != size_DEFAULT),s,FALSE,0L));
339 if(datatype_of(sym_list[i]->type) == type_UNDECL) {
340 implicits++; /* Flag and count undeclareds */
341 msg_tail("(implicitly typed)");
342 }
343 }
344 }
345 }
346
347 return implicits;
348
349 }/*print_lsyms_verbosely*/
350
351 /* This routine handles the messy business of tracing
352 a local warning detail back into an include file. The
353 argument inc_index is the index into incfile_list
354 for the instance (declared, used, set) being reported.
355 If that is -1 then no include file is involved. Otherwise
356 the table entry gives the include file name and the line
357 in top file where the file was included.
358 */
local_detail(int inc_index,LINENO_t lineno,const char * tag,const char * msg)359 void local_detail(int inc_index, LINENO_t lineno,
360 const char *tag, const char *msg)
361 {
362 char *fname;
363 if( inc_index >= 0 ) {
364 fname = incfile_list[inc_index].fname;
365 }
366 else {
367 fname = top_filename;
368 }
369 /* Issue the main message here. */
370 local_message(fname,lineno,tag,msg);
371
372 if( inc_index >= 0 ) {
373 local_message(top_filename,
374 incfile_list[inc_index].line,
375 tag,
376 novice_help?" included":" (where included)");
377 }
378 }
379
380 /* This routine prints the variables nicely, and returns
381 count of number implicitly defined.
382 */
383 int
384 #if HAVE_STDC
print_variables(Lsymtab ** sym_list,int n)385 print_variables(Lsymtab **sym_list, int n)
386 #else /* K&R style */
387 print_variables(sym_list,n)
388 Lsymtab **sym_list;
389 int n;
390 #endif /* HAVE_STDC */
391 {
392 int i,implicits=0,adjustables=0;
393
394 (void)fprintf(list_fd,"\n ");
395
396 for(i=0; i<4; i++) {
397 (void)fprintf(list_fd,"%5sName Type Dims","");
398 /* 12345678901234567890 template for above*/
399 }
400 for(i=0; i<n; i++) {
401
402 if(i % 4 == 0)
403 (void)fprintf(list_fd,"\n");
404 else
405 (void)fprintf(list_fd," ");
406
407 (void)fprintf(list_fd,"%10s",sym_list[i]->name);
408 adjustables += print_var_type(list_fd,sym_list[i]);
409
410 /* Print a * next to implicitly declared variables */
411 if(datatype_of(sym_list[i]->type) == type_UNDECL ) {
412 implicits++;
413 (void)fprintf(list_fd,"*");
414 }
415 else if(sym_list[i]->size == size_DEFAULT)
416 (void)fprintf(list_fd," "); /* print blank if no size or * */
417
418
419 /* print no. of dimensions next to var name */
420 if(sym_list[i]->array_var) {
421 (void)fprintf(list_fd," %ld",
422 array_dims(sym_list[i]->info.array_dim));
423 }
424 else {
425 (void)fprintf(list_fd,"%2s","");
426 }
427 }
428
429 if(adjustables > 0)
430 (void)fprintf(list_fd,"\nchar+ indicates adjustable size");
431 (void)fprintf(list_fd,"\n");
432
433 return implicits;
434
435 }/*print_variables*/
436
437
438 PRIVATE int
439 #if HAVE_STDC
print_var_type(FILE * fd,const Lsymtab * symt)440 print_var_type(FILE *fd, const Lsymtab *symt) /* Prints type name then size if explicit */
441 #else /* K&R style */
442 print_var_type(fd,symt) /* Prints type name then size if explicit */
443 #endif /* HAVE_STDC */
444 /* Returns 1 if adjustable size, else 0 */
445 #if HAVE_STDC
446 #else /* K&R style */
447 FILE *fd;
448 Lsymtab *symt;
449 #endif /* HAVE_STDC */
450 {
451 int adjustable=0;
452 int t = get_type(symt);
453 int s = get_size(symt,t);
454
455 (void)fprintf(fd," %4s",type_name[t]);
456
457 /* Usually either size or * will be printed, and usually
458 size is 1 digit. So mostly we print 1 column in
459 the next set of (void)fprintf's. Output will be ragged
460 if size > 9 or implicit type has explicit size. */
461 if( s != size_DEFAULT ) {
462 if(t != type_STRING || s > 1)
463 (void)fprintf(fd,"%d",s);
464 else
465 if(s == size_ADJUSTABLE) {
466 adjustable++;
467 (void)fprintf(fd,"+");
468 }
469 else
470 (void)fprintf(fd," ");
471 }
472 return adjustable;
473 }
474
475
476
477 #ifdef DEBUG_SYMTABS
478 PRIVATE void
print_arg_array(arglist)479 print_arg_array(arglist) /* prints type and flag info for arguments */
480 ArgListHeader *arglist;
481 {
482 int i, count;
483 ArgListElement *a;
484
485 count = arglist->numargs;
486 if(arglist->external_decl || arglist->actual_arg)
487 count = 0;
488 a = arglist->arg_array;
489 (void)fprintf(list_fd,
490 "\n Arg list in module %s file %s line %u",
491 arglist->module->name,
492 arglist->filename,
493 arglist->line_num
494 );
495 if( arglist->topfile != arglist->filename )
496 (void)fprintf(list_fd,
497 " (topfile %s line %u)",
498 arglist->topfile,
499 arglist->top_line_num
500 );
501 (void)fprintf(list_fd,": defn%d call%d ext%d arg%d",
502 arglist->is_defn,
503 arglist->is_call,
504 arglist->external_decl,
505 arglist->actual_arg);
506 if(count == 0)
507 (void)fprintf(list_fd,"\n\t(Empty list)");
508 else {
509 for (i=0; i<count; i++) {
510 (void)fprintf(list_fd,
511 "\n\t%d %s %s %s",
512 i+1,
513 a[i].name,
514 class_name[storage_class_of(a[i].type)],
515 type_name[datatype_of(a[i].type)]
516 );
517 if(a[i].size != size_DEFAULT)
518 (void)fprintf(list_fd,
519 "*%ld",
520 a[i].size
521 );
522 if(a[i].array_var)
523 (void)fprintf(list_fd,
524 ":%ldD(%ld)",
525 array_dims(a[i].info.array_dim),
526 array_size(a[i].info.array_dim)
527 );
528 (void)fprintf(list_fd,
529 " lval%d set%d asg%d ubs%d ary%d are%d ext%d do%d",
530 a[i].is_lvalue,
531 a[i].set_flag,
532 a[i].assigned_flag,
533 a[i].used_before_set,
534 a[i].array_var,
535 a[i].array_element,
536 a[i].declared_external,
537 a[i].active_do_var
538 );
539 if(a[i].common_block != NULL)
540 (void)fprintf(list_fd,
541 "\n\t item %ld in block %s",
542 a[i].common_index,
543 a[i].common_block->name
544 );
545 }
546 }
547 }/* print_arg_array */
548 #endif
549
550 #ifdef DEBUG_SYMTABS
551 /* prints type and dimen info for common vars */
552 PRIVATE void
print_com_array(cmlist)553 print_com_array(cmlist)
554 ComListHeader *cmlist;
555 {
556 int i, count;
557 ComListElement *c;
558
559 count = cmlist->numargs;
560 c = cmlist->com_list_array;
561 (void)fprintf(list_fd,
562 "\n Com list in module %s file %s line %u",
563 cmlist->module->name,
564 cmlist->filename,
565 cmlist->line_num
566 );
567 if( cmlist->topfile != cmlist->filename )
568 (void)fprintf(list_fd,
569 " (topfile %s line %u)",
570 cmlist->topfile,
571 cmlist->top_line_num
572 );
573 (void)fprintf(list_fd,
574 ": anyuse%d anyset%d saved%d",
575 cmlist->any_used,
576 cmlist->any_set,
577 cmlist->saved
578 );
579 if(count == 0)
580 (void)fprintf(list_fd,"\n\t(Empty list)");
581 else {
582 for (i=0; i<count; i++){
583 (void)fprintf(list_fd,
584 "\n\t%d %s %s",
585 i+1,
586 c[i].name,
587 type_name[datatype_of(c[i].type)]
588 );
589 if(c[i].size != size_DEFAULT)
590 (void)fprintf(list_fd,
591 "*%ld",
592 c[i].size
593 );
594 if(c[i].dimen_info != array_dim_info(0,1))
595 (void)fprintf(list_fd,
596 ":%ldD(%ld)",
597 array_dims(c[i].dimen_info),
598 array_size(c[i].dimen_info)
599 );
600 (void)fprintf(list_fd,
601 " use%d set%d ubs%d asg%d",
602 c[i].used,
603 c[i].set,
604 c[i].used_before_set,
605 c[i].assigned
606 );
607 }
608 }
609 }/* print_com_array */
610 #endif
611
612 #ifdef DEBUG_SYMTABS
613 PRIVATE void
print_tokenlist(toklist)614 print_tokenlist(toklist) /* prints list of token names or types */
615 TokenListHeader *toklist;
616 {
617 int numargs=0;
618 Token *t;
619 if (toklist == NULL){
620 (void)fprintf(list_fd,"\n\t(No list)");
621 }
622 else {
623 t = toklist->tokenlist;
624 while(t != NULL){
625 ++numargs;
626 (void)fprintf(list_fd,"\n\t%d ",numargs);
627 (void)fprintf(list_fd," %s %s %s",
628 t->src_text,
629 class_name[storage_class_of(t->TOK_type)],
630 type_name[datatype_of(t->TOK_type)]
631 );
632 t = t->next_token;
633 }
634 if(numargs == 0)
635 (void)fprintf(list_fd,"\n\t(Empty list)");
636 }
637 }/* print_tokenlist */
638 #endif
639
640
641
642
643 void
debug_symtabs(VOID)644 debug_symtabs(VOID) /* Debugging output: hashtable and symbol tables */
645 {
646 #ifdef DEBUG_SYMTABS
647 /* local symtab info printout is very incomplete */
648 if(debug_loc_symtab) {
649 int i;
650 (void)fprintf(list_fd,"\nLocal Symbol table:\n");
651 for(i=0; i < loc_symtab_top; i++) {
652 (void)fprintf(list_fd,
653 "\n%4d %s type %s %s",
654 i,
655 loc_symtab[i].name,
656 class_name[storage_class_of(loc_symtab[i].type)],
657 type_name[datatype_of(loc_symtab[i].type)]
658 );
659 if( loc_symtab[i].size != size_DEFAULT )
660 (void)fprintf(list_fd,
661 "*%ld",
662 loc_symtab[i].size
663 );
664 if(loc_symtab[i].common_block != NULL)
665 (void)fprintf(list_fd,
666 "\n\t item %ld in block %s",
667 loc_symtab[i].common_index,
668 loc_symtab[i].common_block->name
669 );
670 switch( storage_class_of(loc_symtab[i].type) ) {
671 case class_SUBPROGRAM:
672 case class_COMMON_BLOCK:
673 print_tokenlist(loc_symtab[i].info.toklist);
674 break;
675 }
676 }
677 (void)fprintf(list_fd,"\n");
678 }
679
680 if(debug_hashtab) {
681 int i;
682 (void)fprintf(list_fd,"\n\nContents of hashtable\n");
683 for(i=0; i<HASHSZ; i++) {
684 if(hashtab[i].name != NULL) {
685 (void)fprintf(list_fd,"\n%4d %s",i,hashtab[i].name);
686 if(hashtab[i].loc_symtab != NULL)
687 (void)fprintf(list_fd," loc %d",hashtab[i].loc_symtab-loc_symtab);
688 if(hashtab[i].glob_symtab != NULL)
689 (void)fprintf(list_fd,
690 " glob %d",hashtab[i].glob_symtab-glob_symtab);
691 if(hashtab[i].com_loc_symtab != NULL)
692 (void)fprintf(list_fd,
693 " Cloc %d",hashtab[i].com_loc_symtab-loc_symtab);
694 if(hashtab[i].com_glob_symtab != NULL)
695 (void)fprintf(list_fd,
696 " Cglob %d",hashtab[i].com_glob_symtab-glob_symtab);
697 }
698 }
699 }
700
701 if(debug_glob_symtab) {
702 int i;
703 (void)fprintf(list_fd,"\n\nContents of global symbol table");
704
705 for(i=0; i<glob_symtab_top; i++) {
706 (void)fprintf(list_fd,
707 "\n%4d %s type %s %s",
708 i,
709 glob_symtab[i].name,
710 class_name[storage_class_of(glob_symtab[i].type)],
711 type_name[datatype_of(glob_symtab[i].type)]
712 );
713 if( glob_symtab[i].size != size_DEFAULT )
714 (void)fprintf(list_fd,
715 "*%ld",
716 glob_symtab[i].size
717 );
718 (void)fprintf(list_fd,
719 ": use%d set%d asg%d rec%d lib%d ent%d inf%d vis%d smw%d def%d incl%d ext%d ",
720 glob_symtab[i].used_flag,
721 glob_symtab[i].set_flag,
722 glob_symtab[i].assigned_flag,
723 glob_symtab[i].recursive,
724 glob_symtab[i].library_module,
725 glob_symtab[i].internal_entry,
726 glob_symtab[i].invoked_as_func,
727 glob_symtab[i].visited,
728 glob_symtab[i].visited_somewhere,
729 glob_symtab[i].defined,
730 glob_symtab[i].defined_in_include,
731 glob_symtab[i].declared_external
732 );
733 switch(storage_class_of(glob_symtab[i].type)){
734 case class_COMMON_BLOCK:{
735 ComListHeader *clist;
736 clist=glob_symtab[i].info.comlist;
737 while(clist != NULL){
738 print_com_array(clist);
739 clist = clist->next;
740 }
741 break;
742 }
743 case class_SUBPROGRAM:{
744 ArgListHeader *alist;
745 alist=glob_symtab[i].info.arglist;
746 while(alist != NULL){
747 print_arg_array(alist);
748 alist = alist->next;
749 }
750 break;
751 }
752 }
753 }
754 }
755 #endif
756 }/* debug_symtabs*/
757
758
759 /* Figure out the appropriate message to use
760 based on what kind of item. Special cases:
761 if symbol is an external, its line_declared
762 is not set, so we need to change to
763 line_used and say "referenced" instead of
764 "defined"; if current module is a function
765 it has class_VAR but should say "declared"
766 even if not typed.
767 */
768 void
769 #if HAVE_STDC
choose_tag(int tag_type,const Lsymtab * symt,char ** tag,LINENO_t * lineno)770 choose_tag(int tag_type, const Lsymtab *symt, char **tag, LINENO_t *lineno)
771 #else /* K&R style */
772 choose_tag(tag_type, symt, tag, lineno)
773 int tag_type; /* what kind of tag: defn, set, used */
774 Lsymtab *symt; /* the item for which tag is needed */
775 char **tag; /* output var = string, e.g. "defined" */
776 LINENO_t *lineno; /* output var = relevant line number */
777 #endif /* HAVE_STDC */
778 {
779 /* Maintainer note: the tags defined below must
780 not exceed MAX_TAG_LEN defined in plsymtab.h. */
781 switch(tag_type) {
782 case TAG_DEFN:
783 (*lineno) = symt->line_declared;
784 switch( storage_class_of(symt->type) ) {
785 case class_VAR:
786 if(datatype_of(symt->type) == type_UNDECL
787 && !(symt->argument) /* args are considered declared */
788 && symt != hashtab[current_module_hash].loc_symtab)
789 (*tag) = "first occurrence";
790 else
791 (*tag) = "declared";
792 break;
793 case class_COMMON_BLOCK:
794 (*tag) = "declared";
795 break;
796 default: /* subprograms & stmt functions */
797 (*tag) = "defined";
798 if( (*lineno) == NO_LINE_NUM ) {
799 /* External routines not explicitly declared
800 will have line_declared unset. (Stmt functions
801 never do.) Use invocation instead. */
802 (*tag) = "referenced";
803 (*lineno) = symt->line_used;
804 }
805 break;
806 }
807 break;
808
809 case TAG_USED:
810 (*lineno) = symt->line_used;
811 (*tag) = "used";
812 break;
813
814 case TAG_SET:
815 (*lineno) = symt->line_set;
816 if(storage_class_of(symt->type) != class_VAR)
817 (*tag) = "defined";
818 else {
819 if(symt->assigned_flag)
820 (*tag) = "set";
821 else
822 (*tag) = "may be set";
823 }
824 break;
825
826 default: /* for our forgetful authors, just in case */
827 oops_message(OOPS_FATAL,NO_LINE_NUM,NO_COL_NUM,
828 "choose_tag called with unimplemented tag type");
829 break;
830 }/* switch(tag_type) */
831
832 #ifdef DEVELOPMENT /* bug catcher */
833 if(strlen(*tag) > MAX_TAG_LEN) {
834 (void)fprintf(stderr,"\n%s",*tag);
835 oops_message(OOPS_FATAL,NO_LINE_NUM,NO_COL_NUM,
836 "choose_tag yields tag longer than MAX_TAG_LEN");
837 }
838 #endif
839 }
840