1 /* $Id: calltree.c,v 1.8 2002/11/20 23:13:15 moniot Rel $
2
3 Routines for producing call trees and cross-reference lists
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
40 Shared functions defined:
41
42 com_xref_list() Print cross-reference list of com blocks.
43 visit_children() traverses the call tree, doing some checks
44 and printing tree if requested.
45
46 */
47
48
49 #include <stdio.h>
50 #include <string.h>
51 #include "ftnchek.h"
52 #include "symtab.h"
53 #include "pgsymtab.h"
54
55 /* Local routines defined. */
56
57 PROTO(PRIVATE int block_is_volatile,( ComListHeader *clist, Gsymtab *main_module ));
58 PROTO(PRIVATE ComListHeader * com_tree_check,( Gsymtab *comblock, Gsymtab
59 *module, int level ));
60 PROTO(PRIVATE void visit_child,( Gsymtab *gsymt, int level ));
61 PROTO(PRIVATE void visit_child_reflist,( Gsymtab *gsymt ));
62 #ifdef VCG_SUPPORT
63 PROTO(PRIVATE void visit_child_vcg,( Gsymtab *gsymt, int level ));
64 #endif
65 PROTO(PRIVATE ChildList * sort_child_list,( ChildList *child_list ));
66 PROTO(PRIVATE void print_crossrefs,( void ));
67 PROTO(PRIVATE void print_cycle_nodes,( Gsymtab gsymt[], int nsym, Gsymtab
68 *node_list[], int node_count, int
69 parent_count[] ));
70 PROTO(PRIVATE int toposort,( Gsymtab gsymt[], int nsym ));
71 PROTO(PRIVATE ComListHeader * com_declared_by,( Gsymtab *comblock, Gsymtab *module ));
72 PROTO(PRIVATE void print_modules,( unsigned n, Gsymtab *list[] ));
73
74
75
76 /* Things used for common undef check */
77 PRIVATE int com_tree_error;
78 PRIVATE int numvisited;
79
80 /**********************************************************************************
81 *
82 * append_extension (imported as-is from ftnchek.c ftnchek 3.1.1)
83 *
84 * MODE_DEFAULT_EXT: Adds extension to file name s if
85 * none is present, and returns a pointer to the
86 * new name. If extension was added, space is allocated
87 * for the new name. If not, simply returns pointer
88 * to original name.
89 * MODE_REPLACE_EXT: same, except given extension replaces given one if any.
90 *
91 * Returns char * to newly allocated name string.
92 *
93 **********************************************************************************/
94 #define MODE_DEFAULT_EXT 1
95 #define MODE_REPLACE_EXT 2
96 PRIVATE char *
97 #if HAVE_STDC
append_extension(char * s,char * ext,int mode)98 append_extension( char *s, char *ext, int mode )
99 #else /* K&R style */
100 append_extension( s, ext, mode )
101 char *s, *ext;
102 int mode;
103 #endif /* HAVE_STDC */
104 {
105 int i, len;
106 char *newname;
107 #ifdef OPTION_PREFIX_SLASH /* set len=chars to NUL or start
108 * of /opt */
109 for ( len = 0; s[len] != '\0' && s[len] != '/'; len++ )
110 continue;
111 #else
112 len = ( unsigned ) strlen( s );
113 #endif
114 /*
115 * Search backwards till find the dot, but do not search past directory
116 * delimiter
117 */
118 for ( i = len - 1; i > 0; i-- )
119 {
120 if ( s[i] == '.'
121 #ifdef UNIX
122 || s[i] == '/'
123 #endif
124 #ifdef VMS
125 || s[i] == ']' || s[i] == ':'
126 #endif
127 #ifdef MSDOS
128 || s[i] == '\\' || s[i] == ':'
129 #endif
130 )
131 break;
132 }
133
134 if ( mode == MODE_REPLACE_EXT )
135 {
136 if ( s[i] == '.' ) /* declare length = up to the dot */
137 len = i;
138 newname =
139 ( char * )
140 malloc( ( unsigned ) ( len + ( unsigned ) strlen( ext ) + 1 ) );
141 ( void ) strncpy( newname, s, len );
142 ( void ) strcpy( newname + len, ext );
143 }
144 else
145 { /* MODE_DEFAULT_EXT */
146 #ifdef OPTION_PREFIX_SLASH
147 /*
148 * create new string if new ext or trailing /option
149 */
150 if ( s[i] != '.' || s[len] != '\0' )
151 {
152 if ( s[i] != '.' )
153 { /* no extension given */
154 newname = ( char * ) malloc( ( unsigned ) ( len +
155 ( unsigned ) strlen( ext )
156 + 1 ) );
157 ( void ) strncpy( newname, s, len );
158 ( void ) strcpy( newname + len, ext );
159 }
160 else
161 { /* extension given but /option
162 * follows */
163 newname = ( char * ) malloc( ( unsigned ) ( len + 1 ) );
164 ( void ) strncpy( newname, s, len );
165 }
166 }
167 #else
168 if ( s[i] != '.' )
169 {
170 newname = ( char * ) malloc( ( unsigned ) ( len +
171 ( unsigned ) strlen( ext ) +
172 1 ) );
173 ( void ) strcpy( newname, s );
174 ( void ) strcat( newname, ext );
175 }
176 #endif
177 else
178 {
179 newname = s; /* use as is */
180 }
181 }
182
183 return newname;
184 }
185
186
187 void
com_xref_list(VOID)188 com_xref_list(VOID) /* Print cross-reference list of com blocks */
189 {
190 #ifdef DYNAMIC_TABLES /* tables will be mallocked at runtime */
191 Gsymtab **gsymlist,**blocklist;
192 #else
193 Gsymtab *gsymlist[GLOBSYMTABSZ],*blocklist[GLOBSYMTABSZ];
194 #endif
195 int i,numentries,numblocks;
196 ComListHeader *cmlist;
197
198 #ifdef DYNAMIC_TABLES
199 if( (gsymlist=(Gsymtab **)calloc(glob_symtab_top,sizeof(Gsymtab *)))
200 == (Gsymtab **)NULL
201 ||(blocklist=(Gsymtab **)calloc(glob_symtab_top,sizeof(Gsymtab *)))
202 == (Gsymtab **)NULL
203 ) {
204 oops_message(OOPS_FATAL,NO_LINE_NUM,NO_COL_NUM,
205 "Cannot malloc space for common block list");
206 }
207 #endif
208
209 for(i=numblocks=0;i<glob_symtab_top;i++){ /* loop thru global table */
210 if (storage_class_of(glob_symtab[i].type) == class_COMMON_BLOCK){
211 blocklist[numblocks++] = &glob_symtab[i];
212 }
213 }
214 if(numblocks > 0) {
215
216 sort_gsymbols(blocklist,numblocks); /* Sort the common block list */
217
218 (void)fprintf(list_fd,
219 "\n Common block cross-reference list:\n");
220 for(i=0; i<numblocks; i++) {
221 cmlist = blocklist[i]->info.comlist;
222 numentries=0;
223
224 #ifdef DEBUG_COM_USAGE
225 (void)fprintf(list_fd, "\n Common Block %s:\n",blocklist[i]->name );
226 #endif
227
228 while (cmlist != NULL){ /* loop thru declarations */
229
230 if(! irrelevant(cmlist) &&
231 (cmlist->any_used || cmlist->any_set))
232 gsymlist[numentries++] = cmlist->module;
233 #ifdef DEBUG_COM_USAGE
234 print_comvar_usage(cmlist);
235 #endif
236 cmlist = cmlist->next;
237
238 } /* end of while */
239
240 if (numentries >0){ /* print modules that declare this block*/
241
242 (void)fprintf(list_fd, "\nCommon Block %s used in:\n" ,
243 blocklist[i]->name );
244
245 /* Sort modules that declare this block */
246 sort_gsymbols(gsymlist,numentries);
247
248 print_modules((unsigned)numentries,gsymlist);
249
250 } /* end of if numentries >0 */
251
252
253 } /* end of for i = 0 to numblocks */
254
255 (void)fprintf(list_fd,"\n");
256
257 } /* end of if numblocks > 0*/
258
259 }
260
261 void
visit_children(VOID)262 visit_children(VOID)
263 {
264 int i,
265 num_mains, /* number of main programs */
266 num_roots; /* number of uncalled nonlibrary modules */
267 Gsymtab* main_module;
268
269 num_roots = 0;
270 for(i=0; i<glob_symtab_top; i++) {
271 if(storage_class_of(glob_symtab[i].type) == class_SUBPROGRAM
272 && ! glob_symtab[i].internal_entry) {
273 glob_symtab[i].link.child_list=
274 sort_child_list(glob_symtab[i].link.child_list);
275 /* Count defined but uncalled non-library modules for use later */
276 if(glob_symtab[i].defined && !glob_symtab[i].used_flag &&
277 !glob_symtab[i].library_module)
278 ++num_roots; /* Count tree roots for use if no mains */
279 }
280 }
281
282 if(print_ref_list)
283 (void)fprintf(list_fd,"\nList of subprogram references:");
284 #ifdef VCG_SUPPORT
285 else if(print_vcg_list) {
286 if(vcg_fd == stdout)
287 (void)fprintf(vcg_fd,"\n");
288 (void)fprintf(vcg_fd,"graph: {\ntitle: \"%s\"\n",main_filename);
289 /* Global graph options go here. See ftnchek.h.
290 */
291 (void)fprintf(vcg_fd,VCG_GRAPH_OPTIONS);
292 }
293 #endif
294 else if(print_call_tree)
295 (void)fprintf(list_fd,"\nTree of subprogram calls:");
296
297 /* Visit children of all main progs */
298 for(i=0,num_mains=0; i<glob_symtab_top; i++) {
299 if(glob_symtab[i].type == type_byte(class_SUBPROGRAM,type_PROGRAM)) {
300 main_module = &glob_symtab[i];
301 if(print_ref_list)
302 visit_child_reflist(main_module);
303 #ifdef VCG_SUPPORT
304 else if(print_vcg_list)
305 visit_child_vcg(main_module,1);
306 #endif
307 else
308 visit_child(main_module,0);
309 ++num_mains;
310 }
311 }
312 /* If no main program found, give
313 warning unless -noextern was set */
314 if(num_mains == 0) {
315 if(print_call_tree || print_ref_list
316 #ifdef VCG_SUPPORT
317 || print_vcg_list
318 #endif
319 ) {
320 (void)fprintf(list_fd,"\n (no main program found)");
321 }
322 else if(usage_ext_undefined) {
323 (void)fprintf(list_fd,
324 "\nNo main program found");
325 }
326 /* If no main, visit trees rooted at uncalled
327 nonlibrary routines, as the next best thing.
328 If there are no uncalled nonlib modules, use
329 uncalled library routines. If there are no uncalled
330 routines, then there is a cycle!
331 */
332 for(i=0; i<glob_symtab_top; i++) {
333 if(storage_class_of(glob_symtab[i].type) == class_SUBPROGRAM
334 && glob_symtab[i].defined && !glob_symtab[i].used_flag &&
335 (num_roots == 0 || !glob_symtab[i].library_module) ) {
336 if(print_ref_list)
337 visit_child_reflist(&glob_symtab[i]);
338 #ifdef VCG_SUPPORT
339 else if(print_vcg_list)
340 visit_child_vcg(&glob_symtab[i],1);
341 #endif
342 else
343 visit_child(&glob_symtab[i],1); /* indent all trees one level */
344 }
345 }
346 }
347 if(print_call_tree || print_ref_list)
348 (void)fprintf(list_fd,"\n");
349 #ifdef VCG_SUPPORT
350 if(print_vcg_list)
351 (void)fprintf(vcg_fd,"}\n");
352 #endif
353
354
355 /* Print list of callers of all visited
356 or non-library modules, if -crossref
357 flag given. */
358 if(print_xref_list) {
359 print_crossrefs();
360 }
361
362 /* Print linkage-order list of modules. */
363 if( print_topo_sort ) {
364 (void) toposort(glob_symtab,(int)glob_symtab_top);
365 }
366
367 /* Check that common blocks retain definition
368 status between uses. */
369 if(check_com_tree || comcheck_volatile){
370 if(num_mains != 1) {
371 if(check_com_tree)
372 (void)fprintf(list_fd,
373 "\nCommon definition check requires single main program");
374 if(comcheck_volatile)
375 (void)fprintf(list_fd,
376 "\nCommon volatility check requires single main program");
377 }
378 else {
379 numvisited = 0; /* need headcount in case of cycle */
380 for(i=0; i<glob_symtab_top; i++) {
381 if(glob_symtab[i].visited_somewhere)
382 numvisited++;
383 }
384 for(i=0; i<glob_symtab_top; i++) {
385 if(storage_class_of(glob_symtab[i].type) == class_COMMON_BLOCK) {
386 if( block_is_volatile(glob_symtab[i].info.comlist,main_module) ) {
387 if(comcheck_volatile) {
388 (void)fprintf(list_fd,
389 "\nCommon block %s is volatile",
390 glob_symtab[i].name);
391 }
392 if(check_com_tree) {
393 com_tree_error=0;
394 (void)com_tree_check(&glob_symtab[i],main_module,0);
395 }
396 }
397 }
398 }
399 }
400 }
401 }
402
403 /* Returns TRUE unless block is SAVED by any module, or declared by
404 the actual main program or in a BLOCK DATA subprogram. */
405 PRIVATE int
406 #if HAVE_STDC
block_is_volatile(ComListHeader * clist,Gsymtab * main_module)407 block_is_volatile(ComListHeader *clist, Gsymtab *main_module)
408 #else /* K&R style */
409 block_is_volatile(clist,main_module)
410 ComListHeader *clist;
411 Gsymtab *main_module;
412 #endif /* HAVE_STDC */
413 {
414 int t;
415 while(clist != NULL) {
416 if( clist->saved ||
417 (t=datatype_of(clist->module->type)) == type_BLOCK_DATA
418 || (t == type_PROGRAM && clist->module == main_module)) {
419 return FALSE;
420 }
421 clist = clist->next;
422 }
423 return TRUE;
424 }
425
426 /* If block declared by module, returns pointer to the comlist
427 header which describes it. Otherwise returns NULL. */
428 PRIVATE ComListHeader *
429 #if HAVE_STDC
com_declared_by(Gsymtab * comblock,Gsymtab * module)430 com_declared_by(Gsymtab *comblock, Gsymtab *module)
431 #else /* K&R style */
432 com_declared_by(comblock,module)
433 Gsymtab *comblock,*module;
434 #endif /* HAVE_STDC */
435 {
436 ComListHeader *clist=comblock->info.comlist;
437 while(clist != NULL) {
438 if(clist->module == module) {
439 if(clist->saved) {
440 com_tree_error = TRUE; /* not so, but causes bailout */
441 }
442 return clist;
443 }
444 clist = clist->next;
445 }
446 return NULL;
447 }
448
449
450 /* Checks whether common block can become undefined
451 between activations of some module that declares it.
452 Should only be done for blocks that are volatile, i.e.
453 that are not SAVED or declared in main or block_data.
454 Rules used are:
455 (1) Block is declared in two subtrees whose roots
456 are called by a given module, and not in
457 the given module itself or above.
458 (2) Block is declared and elements accessed in a module
459 called by a given module, and not declared in the
460 module itself or above. (Module that declares it but
461 does not access elements, can be holding the
462 block active for its children.)
463 Since Rule 2 is likely to be wrong often due to Ftnchek's
464 lack of knowledge about whether a routine is invoked
465 more than once, it is suppressed for now.
466 */
467 PRIVATE ComListHeader *
468 #if HAVE_STDC
com_tree_check(Gsymtab * comblock,Gsymtab * module,int level)469 com_tree_check(Gsymtab *comblock, Gsymtab *module, int level)
470 #else /* K&R style */
471 com_tree_check(comblock,module,level)
472 Gsymtab *comblock,*module;
473 int level;
474 #endif /* HAVE_STDC */
475 {
476 ComListHeader *clist;
477
478 /* The following only protects against recursion. It is not
479 a full-fledged cycle detector just a stopper. */
480 if(level > numvisited) {
481 (void)fprintf(list_fd,
482 "\nWarning: Call tree has a cycle containing module %s\n",
483 module->name);
484 com_tree_error = TRUE;
485 return NULL;
486 }
487
488 /* If this module declares the block, return its clist */
489 if( (clist=com_declared_by(comblock,module)) != NULL) {
490 #ifdef DEBUG_SAVE
491 (void)fprintf(list_fd,"\n%s declared by %s",comblock->name,module->name);
492 #endif
493 return clist;
494 }
495 else { /* Otherwise see if it is declared in subtree */
496 int any_child_declares_it;
497 ComListHeader *declaring_clist, *this_clist;
498 ChildList *child_list;
499
500 any_child_declares_it=FALSE;
501 declaring_clist=NULL;
502 /* Scan list of children */
503 child_list = (module->internal_entry?module->link.module:module)
504 ->link.child_list;
505 while(child_list != NULL) {
506 this_clist = com_tree_check(comblock,child_list->child,level+1);
507 /* Error was detected below: bail out */
508 if(com_tree_error) {
509 return NULL;
510 }
511 else if(this_clist != NULL) {
512 /* Subtree contains the block */
513 if(any_child_declares_it /* Rule 1 */
514 #ifdef COMTREE_RULE_2
515 || (this_clist->any_used || this_clist->any_set) /* Rule 2 */
516 #endif
517 ){
518 cmp_error_count = 0;
519 (void)comcmp_error_head(comblock->name,this_clist,
520 "may become undefined between activations");
521 com_error_report(this_clist,"Declared");
522 if(declaring_clist != NULL && declaring_clist != this_clist) {
523 com_error_report(declaring_clist,"Declared");
524 }
525 (void)fprintf(list_fd,"\n ");
526 (void)fprintf(list_fd,
527 "Not declared in parent module %s",
528 module->name);
529 com_tree_error = TRUE;
530 return NULL;
531 }
532 else {
533 any_child_declares_it = TRUE;
534 declaring_clist = this_clist;
535 }
536 }
537
538 child_list = child_list->next;
539 }
540 /* If any subtree declares it, say so */
541 return declaring_clist;
542 }
543 }
544
545
546
547 /* Depth-first search of call tree */
548 PRIVATE void
549 #if HAVE_STDC
visit_child(Gsymtab * gsymt,int level)550 visit_child(Gsymtab *gsymt, int level)
551 #else /* K&R style */
552 visit_child(gsymt,level)
553 Gsymtab *gsymt;
554 int level;
555 #endif /* HAVE_STDC */
556 {
557 static char fmt[]="%000s"; /* Variable format for indenting names */
558 ChildList *child_list;
559 static int terminate_href = 0;
560 char *fname=NULL;
561 ArgListHeader *arghdr;
562
563
564 if(print_call_tree) {
565 if ( htmlcalltree_fd ) {
566 /* Look up defn arglist entry to find the
567 filename where this guy is defined.
568 */
569 for ( arghdr = gsymt->info.arglist; arghdr; arghdr=arghdr->next )
570 {
571 if ( arghdr->is_defn && arghdr->filename )
572 {
573 fname = append_extension( arghdr->filename,
574 DEF_HTML_EXTENSION, MODE_REPLACE_EXT );
575 }
576 }
577 if ( terminate_href )
578 {
579 terminate_href = 0;
580 ( void ) fprintf( htmlcalltree_fd, "</A>" );
581 }
582 ( void ) fprintf( htmlcalltree_fd, "\n" );
583 }
584 (void)fprintf(list_fd,"\n");
585 if(level > 0) {
586 (void)sprintf(fmt,"%%%ds",level*4); /* indent 4 spaces per nesting level */
587 (void)fprintf(list_fd,fmt,"");
588 if ( htmlcalltree_fd )
589 {
590 if ( fname )
591 {
592 if ( ! gsymt->internal_entry )
593 ( void ) fprintf( htmlcalltree_fd, "%*.*s<A href=\"%s#%s\">",
594 level * 4, level * 4, " ",
595 fname, gsymt->name );
596 else
597 ( void ) fprintf( htmlcalltree_fd, "%*.*s<A href=\"%s#%s\">",
598 level * 4, level * 4, " ",
599 fname, gsymt->link.module->name );
600 terminate_href = 1;
601 }
602 else
603 {
604 ( void ) fprintf( htmlcalltree_fd, "%*.*s", level * 4, level * 4,
605 " " );
606 terminate_href = 0;
607 }
608 }
609 }
610 if(gsymt->internal_entry)
611 {
612 (void)fprintf(list_fd,"%s entry ",gsymt->link.module->name);
613 if ( htmlcalltree_fd )
614 ( void ) fprintf( htmlcalltree_fd, "%s entry ",
615 gsymt->link.module->name );
616 }
617 (void)fprintf(list_fd,"%s",gsymt->name);
618 if ( htmlcalltree_fd )
619 {
620 if ( level == 0 )
621 {
622 if ( gsymt->internal_entry )
623 {
624 if(fname)
625 ( void ) fprintf( htmlcalltree_fd, "<A href=\"%s#%s\">%s",
626 fname, gsymt->link.module->name, gsymt->name );
627 }
628 else
629 {
630 ( void ) fprintf( htmlcalltree_fd, "<A href=\"%s#%s\">%s",
631 fname, gsymt->name, gsymt->name );
632 }
633 terminate_href = 1;
634 }
635 else
636 ( void ) fprintf( htmlcalltree_fd, "%s", gsymt->name );
637 }
638
639 if(fname)
640 free( fname );
641
642 }
643
644 /* Visit its unvisited children. Note
645 that children of internal entry are
646 taken as those of its superior module.
647 */
648 child_list = (gsymt->internal_entry?gsymt->link.module:gsymt)
649 ->link.child_list;
650
651 /* If already visited, do not visit its
652 children, but give note to reader if it
653 has some. */
654 if(call_tree_prune && gsymt->visited) {
655 if(print_call_tree && child_list != NULL)
656 {
657 (void)fprintf(list_fd," (see above)");
658 if ( htmlcalltree_fd )
659 {
660 if ( terminate_href )
661 {
662 ( void )fprintf( htmlcalltree_fd, "</A>" );
663 terminate_href=0;
664 }
665 ( void ) fprintf( htmlcalltree_fd, " (see above)" );
666 }
667 }
668 }
669 else {
670 /* Mark node as visited */
671 gsymt->visited = TRUE;
672 /* Record that containing module
673 is visited via this entry point*/
674 if(gsymt->internal_entry)
675 gsymt->link.module->visited_somewhere = TRUE;
676 else
677 gsymt->visited_somewhere = TRUE;
678
679 if ( print_call_tree )
680 {
681 if ( terminate_href )
682 {
683 ( void ) fprintf( htmlcalltree_fd, "</A>" );
684 terminate_href = 0;
685 }
686 }
687
688 ++level; /* move to next level */
689 while(child_list != NULL) {
690 visit_child(child_list->child,level);
691 child_list = child_list->next;
692 }
693 }
694 if ( terminate_href )
695 {
696 ( void ) fprintf( htmlcalltree_fd, "</A>" );
697 terminate_href = 0;
698 }
699 }
700
701 /*** visit_child_reflist
702
703 Same as visit_child, except it does a breadth-first search of the call
704 tree, and prints the results in the form of a who-calls-who list.
705
706 Contributed by: Gerome Emmanuel : Esial Troisieme annee
707 Projet commun Esial / Ecole des mines
708 INERIS
709 E-mail: gerome@mines.u-nancy.fr
710 Date received: 20-APR-1993
711 Modified slightly to make it compatible as alternative to call-tree and
712 to make output format consistent.
713 ***/
714
715 PRIVATE void
716 #if HAVE_STDC
visit_child_reflist(Gsymtab * gsymt)717 visit_child_reflist(Gsymtab *gsymt)
718 #else /* K&R style */
719 visit_child_reflist(gsymt)
720 Gsymtab *gsymt;
721 #endif /* HAVE_STDC */
722 {
723 ChildList *child_list;
724
725 child_list = (gsymt->internal_entry?gsymt->link.module:gsymt)
726 ->link.child_list;
727
728 /* If already visited, do not visit its
729 children, but give note to reader if it
730 has some. */
731 if(!gsymt->visited) {
732 /* Mark node as visited */
733 gsymt->visited = TRUE;
734 /* Record that containing module
735 is visited via this entry point*/
736 if(gsymt->internal_entry)
737 gsymt->link.module->visited_somewhere = TRUE;
738 else
739 gsymt->visited_somewhere = TRUE;
740
741 if(print_ref_list) /* Print callees neatly if desired */
742 {
743 #ifdef DYNAMIC_TABLES /* tables will be mallocked at runtime */
744 Gsymtab **gsymlist;
745 #else
746 Gsymtab *gsymlist[GLOBSYMTABSZ];
747 #endif
748 ChildList *child_list2;
749 unsigned numcalls;
750
751 #ifdef DYNAMIC_TABLES
752 if( (gsymlist=(Gsymtab **)calloc(glob_symtab_top,sizeof(Gsymtab *)))
753 == (Gsymtab **)NULL) {
754 oops_message(OOPS_FATAL,NO_LINE_NUM,NO_COL_NUM,
755 "Cannot malloc space for reference list");
756 }
757 #endif
758
759 (void)fprintf(list_fd,"\n%s calls:",gsymt->name);
760
761 numcalls = 0;
762 child_list2 = child_list;
763 while(child_list2 != NULL)
764 {
765 gsymlist[numcalls++] = child_list2->child;
766 child_list2 = child_list2->next;
767 }
768
769 if(numcalls == (unsigned)0)
770 (void)fprintf(list_fd," none");
771 else {
772 (void)fprintf(list_fd,"\n");
773 print_modules(numcalls,gsymlist);
774 }
775 #ifdef DYNAMIC_TABLES
776 (void) cfree(gsymlist);
777 #endif
778 }
779
780 while(child_list != NULL) {
781 visit_child_reflist(child_list->child);
782 child_list = child_list->next;
783 }
784 }
785 }
786
787 /* visit_child_vcg:
788
789 Same as visit_child_reflist except it provides output suitable for
790 visualisation of the call graph, using the vcg graph visualisation
791 program. VCG is freely available from ftp.cs.uni-sb.de and
792 elsewhere. It was written by G. Sander of the University of
793 Saarland, Germany.
794
795 Contributed by: P.A.Rubini@cranfield.ac.uk
796 Date: 3-APR-1995
797 */
798
799 #ifdef VCG_SUPPORT
800 PRIVATE void
801 #if HAVE_STDC
visit_child_vcg(Gsymtab * gsymt,int level)802 visit_child_vcg(Gsymtab *gsymt, int level)
803 #else /* K&R style */
804 visit_child_vcg(gsymt,level)
805 Gsymtab *gsymt;
806 int level;
807 #endif /* HAVE_STDC */
808 {
809 ArgListHeader *arglist;
810 ChildList *child_list;
811
812 child_list = (gsymt->internal_entry?gsymt->link.module:gsymt)
813 ->link.child_list;
814
815 /* If already visited, do not visit its
816 children, but give note to reader if it
817 has some. */
818 if(!gsymt->visited) {
819 /* Mark node as visited */
820 gsymt->visited = TRUE;
821 /* Record that containing module
822 is visited via this entry point*/
823 if(gsymt->internal_entry)
824 gsymt->link.module->visited_somewhere = TRUE;
825 else
826 gsymt->visited_somewhere = TRUE;
827
828 if(print_vcg_list) /* Print callees neatly if desired */
829 {
830 #ifdef DYNAMIC_TABLES /* tables will be mallocked at runtime */
831 Gsymtab **gsymlist;
832 #else
833 Gsymtab *gsymlist[GLOBSYMTABSZ];
834 #endif
835 ChildList *child_list2;
836 int j;
837 int numcalls;
838
839 #ifdef DYNAMIC_TABLES
840 if( (gsymlist=(Gsymtab **)calloc(glob_symtab_top,sizeof(Gsymtab *)))
841 == (Gsymtab **)NULL) {
842 oops_message(OOPS_FATAL,NO_LINE_NUM,NO_COL_NUM,
843 "Cannot malloc space for reference list");
844 }
845 #endif
846
847 numcalls = 0;
848 child_list2 = child_list;
849 while(child_list2 != NULL)
850 {
851 gsymlist[numcalls++] = child_list2->child;
852 child_list2 = child_list2->next;
853 }
854
855 arglist = gsymt->info.arglist;
856 while(arglist != NULL) {
857 if ( arglist->is_defn ) {
858
859 (void)fprintf(vcg_fd,"\ngraph: {\ntitle:\"[%s]\"\n",gsymt->name);
860 (void)fprintf(vcg_fd,
861 "node: { title: \"%s\" label: \"%s \\n (%s)\" info1:\"%d\" }\n",
862 gsymt->name,gsymt->name,
863 arglist->filename,
864 level );
865
866
867 if(numcalls != 0) {
868 for (j=0;j<numcalls;j++){
869 arglist = gsymlist[j]->info.arglist;
870 while(arglist != NULL) {
871 if ( arglist->is_defn ) {
872 (void)fprintf(vcg_fd,
873 "edge: { sourcename: \"%s\" targetname: \"%s\" class:%d} \n",
874 gsymt->name,gsymlist[j]->name,
875 level );
876 break ;
877 }
878 arglist = arglist->next;
879 }
880 }
881 }
882 break;
883 }
884 arglist = arglist->next;
885 }
886 #ifdef DYNAMIC_TABLES
887 (void) cfree(gsymlist);
888 #endif
889
890 ++level; /* move to next level */
891
892 /* while(child_list != NULL) {
893 visit_child_vcg(child_list->child,level);
894 child_list = child_list->next;
895 } */
896
897 for (j=0;j<numcalls;j++){
898 arglist = gsymlist[j]->info.arglist;
899 while(arglist != NULL) {
900 if ( arglist->is_defn ) {
901 visit_child_vcg(gsymlist[j],level);
902 break ;
903 }
904 arglist = arglist->next;
905 }
906 }
907 (void)fprintf(vcg_fd,"}\n");
908 }
909 }
910 }
911
912 #endif /* VCG_SUPPORT */
913
914
915 PRIVATE void
print_crossrefs(VOID)916 print_crossrefs(VOID)
917 {
918 #ifdef DYNAMIC_TABLES /* tables will be mallocked at runtime */
919 Gsymtab **gsymlist, **modulelist;
920 #else
921 Gsymtab *gsymlist[GLOBSYMTABSZ], *modulelist[GLOBSYMTABSZ];
922 #endif
923 ArgListHeader *args;
924 int i,numentries;
925 int numcalls;
926
927 #ifdef DYNAMIC_TABLES
928 if( (gsymlist=(Gsymtab **)calloc(glob_symtab_top,sizeof(Gsymtab *)))
929 == (Gsymtab **)NULL ||
930 (modulelist=(Gsymtab **)calloc(glob_symtab_top,sizeof(Gsymtab *)))
931 == (Gsymtab **)NULL) {
932 oops_message(OOPS_FATAL,NO_LINE_NUM,NO_COL_NUM,
933 "Cannot malloc space for crossref list");
934 }
935 #endif
936
937 /* Gather up all relevant subprograms */
938 for(i=0,numentries=0; i<glob_symtab_top; i++) {
939 if(storage_class_of(glob_symtab[i].type) == class_SUBPROGRAM
940 && (glob_symtab[i].visited || !glob_symtab[i].library_module)) {
941 gsymlist[numentries++] = &glob_symtab[i];
942 }
943 }
944
945 if(numentries > 0) {
946 (void)fprintf(list_fd,"\n\n Cross-reference list:\n");
947
948 /* Sort the subprograms */
949 sort_gsymbols(gsymlist,numentries);
950
951 /* Print their callers */
952 for(i=0; i<numentries; i++) {
953 (void)fprintf(list_fd,"\n");
954 if(gsymlist[i]->internal_entry)
955 (void)fprintf(list_fd,"%s entry ",gsymlist[i]->link.module->name);
956 (void)fprintf(list_fd,"%s",gsymlist[i]->name);
957
958 numcalls=0;
959 args = gsymlist[i]->info.arglist;
960 while(args != NULL) { /* Gather up callers */
961 if(!args->is_defn) {
962 /* (eliminate duplicates) */
963 if(numcalls==0 || args->module != modulelist[numcalls-1])
964 modulelist[numcalls++] = args->module;
965 }
966 args = args->next;
967 }
968
969 if(numcalls == 0) {
970 (void)fprintf(list_fd," not called");
971 if(datatype_of(gsymlist[i]->type) == type_PROGRAM)
972 (void)fprintf(list_fd," (main program)");
973 }
974 else {
975 (void)fprintf(list_fd," called by:\n");
976 sort_gsymbols(modulelist,numcalls); /* Sort the callers */
977 print_modules(numcalls,modulelist);
978 }
979 }
980 (void)fprintf(list_fd,"\n");
981 }
982 #ifdef DYNAMIC_TABLES
983 (void) cfree(gsymlist);
984 (void) cfree(modulelist);
985 #endif
986 }
987
988
989 /* Topological sort of the call tree. Based closely on algorithm
990 on page 314 of Horowitz and Sahni, Fundamentals of Data
991 Structures. Returns TRUE if successful, FALSE if failed
992 due to a cycle being detected.
993 */
994
995 PRIVATE int
996 #if HAVE_STDC
toposort(Gsymtab * gsymt,int nsym)997 toposort(Gsymtab *gsymt, int nsym)
998 #else /* K&R style */
999 toposort(gsymt,nsym)
1000 Gsymtab gsymt[];
1001 int nsym;
1002 #endif /* HAVE_STDC */
1003 {
1004 int i,num_nodes, node_count;
1005 ChildList *child_list;
1006 Gsymtab *child_module; /* Called module's top entry point */
1007 #ifdef DYNAMIC_TABLES /* tables will be mallocked at runtime */
1008 int *parent_count;
1009 Gsymtab **node_list;
1010 #else
1011 int parent_count[GLOBSYMTABSZ];
1012 Gsymtab *node_list[GLOBSYMTABSZ];
1013 #endif
1014
1015 #ifdef DYNAMIC_TABLES
1016 if( (parent_count=(int *)calloc(glob_symtab_top,sizeof(int)))
1017 == (int *)NULL ||
1018 (node_list=(Gsymtab **)calloc(glob_symtab_top,sizeof(Gsymtab *)))
1019 == (Gsymtab **)NULL) {
1020 oops_message(OOPS_FATAL,NO_LINE_NUM,NO_COL_NUM,
1021 "Cannot malloc space for module sort");
1022 }
1023 #endif
1024 /* Initialize array of links/counts */
1025 for(i=0; i<nsym; i++)
1026 parent_count[i] = 0; /* In-order of module as node */
1027
1028 /* Traverse child lists, incrementing their
1029 parent counts.
1030 */
1031 for(i=0,num_nodes=0; i<nsym; i++) {
1032 if(gsymt[i].visited_somewhere) { /* skip entry pts and com blocks */
1033 ++num_nodes;
1034 child_list = gsymt[i].link.child_list;
1035 while(child_list != NULL) {
1036 /* If child is an internal entry, substitute
1037 top entry point of its subprogram unit. */
1038 if( (child_module=child_list->child)->internal_entry )
1039 child_module = child_module->link.module;
1040 ++parent_count[child_module - gsymt]; /* index into table */
1041 child_list = child_list->next;
1042 }
1043 }
1044 }
1045
1046 { /* Start of the sort */
1047 int top=0;
1048 int j,k;
1049
1050 for(i=0; i<nsym; i++) {
1051 if(gsymt[i].visited_somewhere && parent_count[i] == 0) {
1052 parent_count[i] = top; /* Link now-parentless module into stack */
1053 top = i+1;
1054 }
1055 }
1056 for(i=0,node_count=0; i<num_nodes; i++) {
1057 if(top == 0) {
1058 if(print_topo_sort) {
1059 (void)fprintf(list_fd,"\nCall tree has a cycle");
1060 print_cycle_nodes(gsymt,nsym,node_list,node_count,parent_count);
1061 }
1062 break;
1063 }
1064 j = top-1;
1065 top = parent_count[j]; /* Recover the link */
1066
1067 /* Print the next module */
1068 if(print_topo_sort) {
1069 node_list[node_count++] = &gsymt[j];
1070 parent_count[j] = -1;
1071 }
1072 /* Decrease parent count of its children */
1073 child_list = gsymt[j].link.child_list;
1074 while(child_list != NULL) {
1075 if( (child_module=child_list->child)->internal_entry )
1076 child_module = child_module->link.module;
1077 k = child_module - gsymt;
1078 if(--parent_count[k] == 0) { /* Now parentless? Stack it*/
1079 parent_count[k] = top;
1080 top = k+1;
1081 }
1082 child_list = child_list->next;
1083 }
1084 }
1085 }/*end sort*/
1086
1087 if(print_topo_sort && node_count > 0) {
1088 (void)fprintf(list_fd,"\nList of called modules in prerequisite order:\n");
1089 print_modules(node_count,node_list);
1090 (void)fprintf(list_fd,"\n");
1091 }
1092
1093 #ifdef DYNAMIC_TABLES
1094 (void) cfree(parent_count);
1095 (void) cfree(node_list);
1096 #endif
1097
1098 return (node_count==num_nodes); /* Success = TRUE */
1099 }
1100
1101 /* Traces back to find nodes not listed in topological
1102 sort. They are the cycle nodes and their descendants.
1103 */
1104 PRIVATE void
1105 #if HAVE_STDC
print_cycle_nodes(Gsymtab * gsymt,int nsym,Gsymtab ** node_list,int node_count,int * parent_count)1106 print_cycle_nodes(Gsymtab *gsymt, int nsym, Gsymtab **node_list, int node_count, int *parent_count)
1107 #else /* K&R style */
1108 print_cycle_nodes(gsymt,nsym,node_list,node_count,parent_count)
1109 Gsymtab gsymt[];
1110 int nsym;
1111 Gsymtab *node_list[];
1112 int node_count;
1113 int parent_count[];
1114 #endif /* HAVE_STDC */
1115 {
1116 int i;
1117 int k=node_count;
1118 for(i=0; i<nsym; i++) {
1119 if(gsymt[i].visited_somewhere) {
1120 if(parent_count[i] != -1) /* Not tagged */
1121 node_list[k++] = &gsymt[i];
1122 }
1123 }
1124 if(k > node_count)
1125 (void)fprintf(list_fd," containing some of the following modules:\n");
1126 print_modules(k-node_count,node_list+node_count);
1127 }
1128
1129
1130 /* Insertion sort of child list.
1131 Also removes duplicates which
1132 can be introduced via multiple
1133 defns or via project files. */
1134 PRIVATE ChildList *
1135 #if HAVE_STDC
sort_child_list(ChildList * child_list)1136 sort_child_list(ChildList *child_list)
1137 #else /* K&R style */
1138 sort_child_list(child_list)
1139 ChildList *child_list;
1140 #endif /* HAVE_STDC */
1141 {
1142 if( call_tree_sort ) {
1143 ChildList *front,*prev,*next,*cl=child_list;
1144 Gsymtab *temp;
1145 prev = NULL;
1146 while(cl != NULL) {
1147 /* Scan thru list for lexicographically lowest name */
1148 front=cl;
1149 for(next=cl->next; next != NULL; next = next->next) {
1150 if(strcmp(front->child->name,next->child->name) > 0) {
1151 front = next;
1152 }
1153 }
1154 /* Swap child pointers so front is first */
1155 if(front != cl) {
1156 temp = front->child;
1157 front->child = cl->child;
1158 cl->child = temp;
1159 }
1160 /* If duplicate, remove from list */
1161 if(prev != NULL && prev->child == cl->child)
1162 prev->next = cl->next;
1163 else
1164 prev = cl;
1165 cl = cl->next;
1166 }
1167 return child_list;
1168
1169 }
1170 else /* put children in program order, i.e. reverse the list */
1171 {
1172 ChildList *curr,*next,*temp;
1173 if(child_list == NULL)
1174 return child_list;
1175 curr = child_list;
1176 next = curr->next;
1177 while(next != NULL) {
1178 temp = next->next;
1179 next->next = curr; /* switch the pointers to point in reverse */
1180 curr = next;
1181 next = temp;
1182 }
1183 child_list->next = NULL; /* former head is now tail */
1184 return curr; /* and curr now points to new head */
1185 }
1186 }
1187
1188 PRIVATE void
1189 #if HAVE_STDC
print_modules(unsigned int n,Gsymtab ** list)1190 print_modules(unsigned int n, Gsymtab **list) /* formatting of module names */
1191 #else /* K&R style */
1192 print_modules(n,list) /* formatting of module names */
1193 unsigned n;
1194 Gsymtab *list[];
1195 #endif /* HAVE_STDC */
1196 {
1197 COLNO_t col=0;
1198 unsigned len,j;
1199
1200 for (j=0;j<n;j++){
1201 if(list[j]->internal_entry) {
1202 len=strlen(list[j]->link.module->name);
1203 col+= len= (len<=10? 10:len) +9;
1204 if (col >78){
1205 fprintf(list_fd, "\n");
1206 col = len;
1207 } /* end of if */
1208 fprintf(list_fd," %10s entry",list[j]->link.module->name);
1209 len=strlen(list[j]->name)+1;
1210 col+= len;
1211 if (col >78){
1212 fprintf(list_fd, "\n");
1213 col = len;
1214 } /* end of if */
1215 fprintf(list_fd," %s",list[j]->name);
1216 }
1217 else {
1218 len=strlen(list[j]->name);
1219 col+= len= (len<=10? 10:len) +3;
1220 if (col >78){
1221 (void)fprintf(list_fd, "\n");
1222 col = len;
1223 } /* end of if */
1224
1225 (void)fprintf(list_fd," %10s",list[j]->name);
1226 }
1227
1228
1229 } /* end of for */
1230 }
1231 /** End of common block and variable usage checks **/
1232