home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume4 / fxref / flink.l < prev    next >
Encoding:
Text File  |  1989-02-03  |  10.5 KB  |  477 lines
  1. /* flink -- f77 call mapper -- from Bourne's C xref, p. 204 */
  2. /* Written by Bill Silvert, August 1988 */
  3. %k 100
  4. %a 1000
  5. %o 1000
  6. %n 200
  7. %e 200
  8. %p 1000
  9. %{
  10. #undef ECHO
  11. static char SCCSID[] = "@(#)flink.l    Ver. 1.17, 88/08/17 10:11:33";
  12. char *progname, *filename="-";
  13. #define    FWORD    8
  14. #define    ESIZE    10
  15. #define    SKIP    0
  16. #define    PROG    1
  17. #define    SUBR    2
  18. #define    FUNC    3
  19. #define    BLKD    4
  20. #define    ENTR    5
  21. #define    CALL    9
  22. int status = SKIP;    /* flags to define level of name */
  23. char *routine[] = {    "",
  24.             "PROGRAM",
  25.             "SUBROUTINE",
  26.             "FUNCTION",
  27.             "BLOCK DATA",
  28.             "ENTRY",
  29.             "",
  30.             "",
  31.             "",
  32.             "CALL"
  33.           };
  34. #define OPTTBL    0
  35. #define OPTCAL    1
  36. #define OPTDEP    2
  37. #define OPTENT    3
  38. #define OPTFIL    4
  39. #define OPTBLK    5
  40. #define OPTUNU    6
  41. #define OPTUNS    7
  42. #define OPTSUB    8
  43. int option = OPTTBL;
  44. char *select = NULL;        /* name selected as option */
  45. int verbose=1;
  46. int entered=0, linked=0;    /* initialization flags */
  47. char unit[FWORD];
  48. typedef struct element    {    char name[FWORD];
  49.                 char *file;
  50.                 int level;
  51.                 int hit;
  52.                 int class;
  53.                 struct element *next;
  54.             }    ELEMENT;
  55.  
  56. typedef struct matrix    {    ELEMENT *i;
  57.                 ELEMENT *j;
  58.                 struct matrix *next;
  59.             }    MATRIX;
  60.  
  61. /* arrays for data and pointers -- first element of each array is useless */
  62. ELEMENT entry[ESIZE], *lentry=entry+ESIZE-1, *current, *rec;
  63. ELEMENT *newrecord(), *altrecord(), *addrecord();
  64. MATRIX link[ESIZE], *llink=link+ESIZE-1, *index=link;
  65. int type[10];    /* how many subprograms of each type? */
  66.  
  67. main(argc,argv)
  68. int argc;
  69. char *argv[];
  70. {
  71.     extern int optind;
  72.     extern char *optarg;
  73.     int count, ocount;
  74.  
  75.     progname = argv[0];
  76.     strcpy(entry->name, "------");    /* safety defaults */
  77.     entry->next = NULL;
  78.     link->next = NULL;
  79.     for(count=0; count<10; count++)
  80.         type[count] = 0;
  81.     while((count = getopt(argc, argv, "bcdefqstuvxC:D:F:h")) != EOF)
  82.         switch(count) {
  83.         case 'b': option = OPTBLK;    break;
  84.         case 'C': select = optarg;
  85.         case 'c': option = OPTCAL;    break;
  86.         case 'D': select = optarg;
  87.         case 'd': option = OPTDEP;    break;
  88.         case 'e': option = OPTENT;    break;
  89.         case 'F': select = optarg;
  90.         case 'f': option = OPTFIL;    break;
  91.         case 'q': verbose=0;        break;
  92.         case 's': option = OPTSUB;    break;
  93.         case 't': option = OPTTBL;    break;
  94.         case 'u': option = OPTUNU;    break;
  95.         case 'x': option = OPTUNS;    break;
  96.         case 'v': verbose=2;        break;
  97.         case 'h':
  98.         default:
  99.             fprintf(stderr,
  100.                 "%s [-bcdefqtuvx] [-CDF name] file ...\n",
  101.                     progname);
  102.             fprintf(stderr,
  103.                 "\tb\tBLOCK DATA\n\tc\tCALLs\n\td\tDependencies (reverse of CALLs)\n\te\tENTRY points\n\tf\tFiles in which subprograms occur\n\tq\tQuiet mode\n\tt\tTabular output (default)\n\tu\tUnused subroutines\n\tv\tVerbose mode\n\tx\tunsatisfied eXternals\n\tC name\tCALLs from <name>\n\tD name\tDependencies on <name> (what CALLs it)\n\tF name\tFile in which <name> occurs\n");
  104.             exit(1);
  105.         }
  106.     if(optind >= argc) {
  107.         strcpy(unit, "------");
  108.         yylex();
  109.         if(current && verbose)
  110.             fprintf(stderr,
  111.                 "Missing END statement at end of %s %s\n",
  112.                     routine[current->class], current->name);
  113.     }
  114.     else {
  115.         for(; optind < argc; optind++) {
  116.             if(freopen(argv[optind],"r",stdin)==NULL) {
  117.                 fprintf(stderr,"%s: %s: cannot open\n",
  118.                         progname, argv[optind]);
  119.             }
  120.             else {
  121.                 filename=argv[optind];
  122.                 yylineno=1;
  123.                 strcpy(unit, "------");
  124.                 yylex();
  125.                 if(current && verbose) {
  126.                     fprintf(stderr,
  127.             "Missing END statement at end of %s %s in file %s\n",
  128.                         routine[current->class],
  129.                         current->name,
  130.                         filename);
  131.                     current = NULL;
  132.                 }
  133.             }
  134.         }
  135.     }
  136.     /* Now find all of the dependencies */
  137.     switch(type[PROG]) {
  138.     case 0:            /* no main PROGRAM defined */
  139.         status = 1;        /* flag */
  140.         count = 0;        /* test for blank input */
  141.         for(rec = entry; rec->class != SUBR; rec = rec->next) {
  142.             if(! rec->next) {    /* oops -- made it to end */
  143.                 if(! count)
  144.                     error_("No program units in input");
  145.                 /* at this stage, display what we have */
  146.                 status = 0;
  147.                 break;
  148.             }
  149.             else
  150.                 count++;    /* keep track of input */
  151.         }
  152.         if(status)
  153.             rec->level = 1;    /* process first subroutine */
  154.         else
  155.             if(verbose)
  156.             fprintf(stderr, "No PROGRAM or SUBROUTINE in input\n");
  157.         break;
  158.     case 1:            /* usual case */
  159.         break;
  160.     default: if(verbose)
  161.         fprintf(stderr, "There are %d PROGRAM units\n\n", type[PROG]);
  162.     }
  163.     count = type[PROG] + type[FUNC];
  164.     status = 1;    /* change the use of status to a counter */
  165.     do {
  166.         ocount = count;
  167.         if(verbose>1)
  168.             printf("Level %d, count=%d\n", status-1, count);
  169.         status++;
  170.         for(index = link;;index=index->next) {
  171.             if(index->i->level && !index->j->level) {
  172.                 index->j->hit = status;
  173.             }
  174.             if(! index->next) break;
  175.         }
  176.         for(rec=entry;;rec=rec->next) {
  177.             if(rec->hit && ! rec->level) {
  178.                 rec->level = rec->hit;
  179.                 count++;
  180.             }
  181.             if(! rec->next) break;
  182.         }
  183.     } while(count > ocount);
  184.     if(! entered)
  185.         error_("No subprograms encountered");
  186.     /* now generate output */
  187.     switch(option) {
  188.     case OPTTBL:
  189.             tabulate();
  190.             break;
  191.     case OPTCAL:
  192.             if(! linked) error_("No linkages found");
  193.             calls();
  194.             break;
  195.     case OPTDEP:
  196.             if(! linked) error_("No linkages found");
  197.             depends();
  198.             break;
  199.     case OPTENT:
  200.             if(! linked) error_("No linkages found");
  201.             enters();
  202.             break;
  203.     case OPTFIL:
  204.             file();
  205.             break;
  206.     case OPTBLK:
  207.             blocks();
  208.             break;
  209.     case OPTUNU:
  210.             unused();
  211.             break;
  212.     case OPTUNS:
  213.             external();
  214.             break;
  215.     case OPTSUB:
  216.     default:
  217.             errord("Option %d not implemented", option);
  218.     }
  219.     exit(0);
  220. }
  221.  
  222. tabulate()
  223. {
  224.     printf("\nSubroutines called:\nName\tLevel\tFile\n");
  225.     for(rec=entry;;rec=rec->next) {
  226.         int recl;
  227.         recl = rec->class;
  228.         if(rec->file && rec->level && recl != ENTR && recl != FUNC)
  229.             printf("%s\t%d\t%s\n", rec->name, rec->level-1,rec->file);
  230.         if(! rec->next) break;
  231.     }
  232.     if(type[FUNC]) {
  233.         printf("\nFunctions:\nName\tFile\n");
  234.         for(rec=entry;;rec=rec->next) {
  235.             if(rec->file && rec->class == FUNC) {
  236.                 printf("%s\t%s\n", rec->name, rec->file);
  237.                 rec->level++;    /* don't list as unused */
  238.             }
  239.             if(! rec->next) break;
  240.         }
  241.     }
  242.     if(type[ENTR]) {
  243.         printf("\nAlternate entry points:\nName\tFile\n");
  244.         for(rec=entry;;rec=rec->next) {
  245.             if(rec->file && rec->class == ENTR) {
  246.                 printf("%s\t%s\n", rec->name, rec->file);
  247.                 rec->level++;    /* don't list as unused */
  248.             }
  249.             if(! rec->next) break;
  250.         }
  251.     }
  252.     if(type[BLKD]) {
  253.         printf("\nBLOCK DATA subprograms:\nName\tFile\n");
  254.         blocks();
  255.     }
  256.     printf("\nUnused subprograms:\nName\tFile\n");
  257.     if(! unused())
  258.         printf("(none)\n");
  259.     printf("\nUnsatisfied externals:\nName\tLevel\n");
  260.     if(! external())
  261.         printf("(none)\n");
  262.     /* CALLS to subroutines called by unused subprograms are ignored */
  263. }
  264.  
  265. blocks()
  266. {
  267.     for(rec=entry;;rec=rec->next) {
  268.         if(rec->file && rec->class == BLKD) {
  269.             printf("%s\t%s\n", rec->name, rec->file);
  270.             rec->level++;    /* don't list as unused */
  271.         }
  272.         if(! rec->next) break;
  273.     }
  274. }
  275.  
  276. unused()
  277. {
  278.     int k = 0;
  279.     for(rec=entry;;rec=rec->next) {
  280.         if(rec->file && ! rec->level) {
  281.             printf("%s\t%s\n", rec->name, rec->file);
  282.             k++;
  283.         }
  284.         if(! rec->next) break;
  285.     }
  286.     return k;
  287. }
  288.  
  289. external()
  290. {
  291.     int k = 0;
  292.     for(rec=entry;;rec=rec->next) {
  293.         if(rec->level && ! rec->file) {
  294.             printf("%s\t%d\n", rec->name, rec->level-1);
  295.             k++;
  296.         }
  297.         if(! rec->next) break;
  298.     }
  299.     return k;
  300. }
  301.  
  302. calls()
  303. {
  304.     if(verbose>1)
  305.         printf("Name\tSubroutine called\n");
  306.     for(index = link;;index=index->next) {
  307.         if(index->i->class != ENTR)
  308.             if(!select || !strcmp(index->i->name, select))
  309.                 printf("%s\t%s\n", index->i->name,
  310.                         index->j->name);
  311.         if(! index->next) break;
  312.     }
  313. }
  314.  
  315. depends()
  316. {
  317.     if(verbose>1)
  318.         printf("Name\tCalling subroutine\n");
  319.     for(index = link;;index=index->next) {
  320.         if(index->i->class != ENTR)
  321.             if(!select || !strcmp(index->j->name, select))
  322.                 printf("%s\t%s\n", index->j->name,
  323.                         index->i->name);
  324.         if(! index->next) break;
  325.     }
  326. }
  327.  
  328. enters()
  329. {
  330.     if(verbose>1)
  331.         printf("Name\tAlternate ENTRY\n");
  332.     for(index = link;;index=index->next) {
  333.         if(index->i->class == ENTR)
  334.             /* if(!select || !strcmp(index->j->name, select)) */
  335.                 printf("%s\t%s\n", index->j->name,
  336.                         index->i->name);
  337.         if(! index->next) break;
  338.     }
  339. }
  340.  
  341. file()
  342. {
  343.     if(verbose>1)
  344.         printf("Name\tFile\n");
  345.     for(rec=entry;;rec=rec->next) {
  346.         if(rec->file) {
  347.             if(!select || !strcmp(rec->name, select))
  348.                 printf("%s\t%s\n", rec->name, rec->file);
  349.         }
  350.         if(! rec->next) break;
  351.     }
  352. }
  353.  
  354. ELEMENT *newrecord(recname)    /* encounter a new program unit */
  355. char *recname;
  356. {
  357.     if(current&& verbose)
  358.         fprintf(stderr, "%s %s starts before %s %s ends\n",
  359.             routine[status], recname,
  360.             routine[current->class], current->name);
  361.     return altrecord(recname);
  362. }
  363.  
  364. ELEMENT *altrecord(recname)    /* identify program unit or entry point */
  365. char *recname;
  366. {
  367.     ELEMENT *newrec;
  368.     newrec = addrecord(recname);
  369.     if(newrec->file)
  370.         errors("Duplicate declaration of %s", recname);
  371.     newrec->file = filename;
  372.     newrec->class = status;
  373.     return newrec;
  374. }
  375.  
  376. ELEMENT *addrecord(recname)    /* find or create matching entry */
  377. char *recname;
  378. {
  379.     ELEMENT *add;
  380.     if(entered) {
  381.         ELEMENT *next;
  382.         for(add=entry;;add=add->next) {
  383.             if(! strcmp(recname, add->name))
  384.                 return add;
  385.             if(! add->next)    /* end of list? */
  386.                 break;
  387.         }
  388.         if(add < lentry)
  389.                next = add + 1;
  390.         else {
  391.                 next = (ELEMENT *)
  392.                 calloc(ESIZE,sizeof(ELEMENT));
  393.                 lentry += ESIZE;
  394.         }
  395.         add->next = next;
  396.         add = next;
  397.     }
  398.     else {
  399.         entered = 1;
  400.         add = entry;
  401.     }
  402.     strcpy(add->name, recname);
  403.     add->file = NULL;
  404.     add->level = 0;
  405.     add->hit = 0;
  406.     add->class = 0;
  407.     add->next = NULL;
  408.     return add;
  409. }
  410.  
  411. connect(i, j)
  412. ELEMENT *i, *j;
  413. {
  414.     if(linked) {
  415.         MATRIX *next;
  416.         if(index < llink)
  417.             next = index + 1;
  418.         else {
  419.             next = (MATRIX *) calloc(ESIZE, sizeof(MATRIX));
  420.             llink += ESIZE;
  421.         }
  422.         index->next = next;
  423.         index = next;
  424.     }
  425.     else {
  426.         linked = 1;
  427.         index = link;
  428.     }
  429.     index->i = i;
  430.     index->j = j;
  431.     index->next = NULL;
  432. }
  433. %}
  434. %%
  435. ^[C*].*\n            ;    /* skip comments */
  436. ^[ \t]*PROGRAM            status=PROG;
  437. ^[ \t]*SUBROUTINE        status=SUBR;
  438. FUNCTION            status=FUNC;
  439. ^[ \t]*ENTRY            status=ENTR;
  440. ^[ \t]*BLOCK[ \t]*DATA        status=BLKD;
  441. ^[ \t]*END[ \t]*\n        { strcpy(unit, "------"); current = NULL; }
  442. CALL                status=CALL;
  443. ^[ \t]*EXTERNAL            ;
  444. [0-9.]*[ED][-+0-9]*        ;    /* skip floating point numbers */
  445. [A-Z][A-Z0-9]* { switch(status) {
  446.         case PROG:    /* program definition */
  447.             strcpy(unit, yytext);
  448.             current = newrecord(unit);
  449.             current->level = 1;
  450.             break;
  451.         case SUBR:    /* subroutine */
  452.         case BLKD:    /* block data */
  453.             strcpy(unit, yytext);
  454.             current = newrecord(unit);
  455.             break;
  456.         case FUNC:    /* function */
  457.             strcpy(unit, yytext);
  458.             current = newrecord(unit);
  459.             current->level = 1;    /* assume function is used */
  460.             break;
  461.         case ENTR:    /* entry point */
  462.             strcpy(unit, yytext);
  463.             connect(altrecord(unit), current);
  464.             break;
  465.         case CALL:    /* call */
  466.             if(current)
  467.                 connect(current, addrecord(yytext));
  468.             else
  469.                 errors("CALL %s with no current subprogram",
  470.                     yytext);
  471.             break;
  472.         default:
  473.             break;
  474.         } ++type[status]; status = SKIP; }
  475. .    ;
  476. \n    status=SKIP;
  477.