home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 351.lha / ProcCheck_v1.1 / ProcCheck.mod < prev    next >
Text File  |  1990-03-09  |  18KB  |  605 lines
  1. MODULE ProcCheck;
  2.  
  3. (* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  4.  * ProcCheck is public domain. Use it any way you see fit, but please  *
  5.  * leave my name and E-Mail address in both the source code and        *
  6.  * executables throughout all revisions. If you make any enhancements, *
  7.  * I would appreciate hearing about it. Thank you.                     *
  8.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  9.  *                                                                     *
  10.  * ProcCheck.mod   V1.0 (12-Sept-1989) by David Czaya                  *
  11.  *                 V1.1 (15-Feb-1990)  cleaned up a bit and tried      *
  12.  *                                     to make the code semi-generic   *
  13.  *                                     for portability.                *
  14.  *                                                                     *
  15.  *                               E-mail: CIS 73445,407                 *
  16.  *                                       PeopleLink -Dave-             *
  17.  *                                       GEnie DCzaya                  *
  18.  *                                                                     *
  19.  * Originally written in "Benchmark Modula 2" for the Amiga! I tried   *
  20.  * to use standard Modula 2 procedures (with certain exceptions) so    *
  21.  * that this code could be easily ported to other implementations and  *
  22.  * machines. Machine specifics are marked.                             *
  23.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  24.  *                                                                     *
  25.  *  ProcCheck (PROCEDURE CHECK) is a PRE-COMPILE utility which         *
  26.  *  scans through Modula 2 source code and attempts to pick out all    *
  27.  *  the procedures that have been referenced. It then divides the      *
  28.  *  procedures into the following categories:                          *
  29.  *                                                                     *
  30.  *  1) Undeclared Procedures - very useful before compiling. Tells     *
  31.  *     you which procedures have been used, but not IMPORTed or        *
  32.  *     defined.                                                        *
  33.  *                                                                     *
  34.  *  2) Unused Procedures - shows procedures which have been IMPORTed   *
  35.  *     or defined, but never called. Excellent for cleaning up the     *
  36.  *     code.                                                           *
  37.  *                                                                     *
  38.  *  3) Standard Identifiers, Internal procedures and IMPORTed          *
  39.  *     procedures are all identified and the number of calls made to   *
  40.  *  each is recorded. This is handy for optimizing your code. You can  *
  41.  *  tell at a glance whether certain procedures are being overworked,  *
  42.  *  etc.                                                               *
  43.  *                                                                     *
  44.  *  One of these days, I might make it parse out variables, constants, *
  45.  *  enumerations, etc. Let me know if you're interested.               *
  46.  *                                                                     *
  47.  *  Oh, and it timestamps the report file, of course.                  *
  48.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  49.  *                                                                     *
  50.  * Caveats: ProcCheck is not the greatest code parser in the world.    *
  51.  *          It's not too difficult to confuse it into picking up or    *
  52.  *          missing information depending on your style of writing.    *
  53.  *          Nevertheless, it's output is not critical and it should    *
  54.  *          be somewhat useful.                                        *
  55.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
  56.  
  57.  
  58. FROM AmigaDOS   IMPORT  DateStamp, DateStampRecord;
  59. FROM InOut      IMPORT  WriteString, WriteLn, ReadString, Read, Done, Echo,
  60.                         OpenOutputFile, CloseOutput, Write, WriteInt;
  61. FROM LongInOut  IMPORT  WriteLongInt;
  62. FROM Strings    IMPORT  CompareString, Relation, CopyString, ConcatString,
  63.                         StringLength, LocateSubString, ConvStringToUpperCase;
  64. FROM FileSystem IMPORT  File, Response, Close, Lookup, SetPos,
  65.                         GetPos, ReadChar;
  66. FROM Memory     IMPORT  AllocMem, FreeMem, MemReqSet, MemPublic, MemClear;
  67.  
  68. TYPE
  69.     ProcRecPtr = POINTER TO ProcRec;
  70.     ProcRec = RECORD
  71.         prFileName  :   ARRAY [0..30] OF CHAR;
  72.         prProcName  :   ARRAY [0..255] OF CHAR;
  73.         prCount     :   INTEGER;
  74.         prDeclared  :   BOOLEAN;
  75.         prTag       :   BOOLEAN;
  76.         next        :   ProcRecPtr;
  77.     END;
  78.  
  79.     Control = (off,on);
  80.  
  81. CONST
  82.     ProgName    = 'ProcCheck';
  83.     BadInput    = 'Invalid input.\n';
  84.     ColumnWidth = 55;
  85.     Separator   = '*';
  86.     ColorReset  = '\x9Bm';
  87.     Color       = '\x9B33m';            (* Color 3 *)
  88.     CursorOff   = '\x9B0 p';
  89.     CursorOn    = '\x9B p';
  90.  
  91. VAR
  92.     inFile : File;
  93.     str,
  94.     moduleName : ARRAY [0..128] OF CHAR;
  95.     nextChar : CHAR;
  96.     memHead,
  97.     memLast : ProcRecPtr;
  98.     ansi : Control;
  99.  
  100.  
  101. PROCEDURE ColorOn();                    (* Amiga specific *)
  102. BEGIN
  103.     IF ansi = on THEN
  104.         WriteString(Color);
  105.     END;
  106. END ColorOn;
  107.  
  108.  
  109. PROCEDURE ColorOff();                   (* Amiga specific *)
  110. BEGIN
  111.     IF ansi = on THEN
  112.         WriteString(ColorReset);
  113.     END;
  114. END ColorOff;
  115.  
  116.  
  117. PROCEDURE GetDate();                    (* Amiga specific *)
  118. VAR
  119.     dsRec  : DateStampRecord;
  120.     n,
  121.     m, d, y,
  122.     hrs, min, sec : CARDINAL;
  123.  
  124.     AmPm  : ARRAY[0..4] OF CHAR;
  125.  
  126.   PROCEDURE Spacer(VAR in : CARDINAL);
  127.   BEGIN
  128.     IF in < 10 THEN
  129.         Write(60C);
  130.         WriteInt(in,1);
  131.     ELSE
  132.         WriteInt(in,2);
  133.     END;
  134.   END Spacer;
  135.  
  136. BEGIN
  137.     DateStamp(dsRec);
  138.     n := dsRec.dsDays - 2251D;
  139.     y :=  (4 * n + 3) DIV 1461;
  140.     n := n -  ((1461 * y) DIV 4);
  141.     y := y + 1984;
  142.     m :=  ((5 * n + 2) DIV 153);
  143.     d :=  (n) - (153 * m + 2) DIV 5 + 1;
  144.     m := m + 3;
  145.     IF m > 12 THEN
  146.         INC(y);
  147.         DEC(m,12);
  148.     END;
  149.  
  150.     AmPm := " am\t\t";
  151.     hrs := 0;
  152.     min := dsRec.dsMinute;
  153.     sec := dsRec.dsTick DIV 50D;
  154.  
  155.     IF min > 59 THEN
  156.         hrs := min DIV 60;
  157.         min := min MOD 60;
  158.     END;
  159.  
  160.     IF hrs > 11 THEN
  161.         AmPm := " pm\t\t";
  162.     END;
  163.  
  164.     IF hrs > 12 THEN DEC(hrs,12) END;
  165.     IF hrs = 0 THEN INC(hrs,12) END;
  166.  
  167.     WriteInt(m,0);      Write('/');
  168.     WriteInt(d,0);      Write('/');
  169.     WriteInt(y-1900,0); Write('\n');
  170.  
  171.     WriteInt(hrs,2);                    (* Write formatted hour *)
  172.     Write(72C);
  173.     Spacer(min);
  174.     Write(72C);
  175.     Spacer(sec);
  176.     WriteString(AmPm);                  (* Write am/pm msg. *)
  177. END GetDate;
  178.  
  179.  
  180. PROCEDURE AlphaNum(c: CHAR): BOOLEAN;
  181. BEGIN
  182.     RETURN(((c >= 'A') AND (c <= 'Z')) OR
  183.             ((c >= 'a') AND (c <= 'z')) OR
  184.              ((c >= '0') AND (c <= '9')));
  185. END AlphaNum;
  186.  
  187.  
  188. PROCEDURE DrawCharLine(c: CHAR; len: CARDINAL);
  189. BEGIN
  190.     WHILE len > 0 DO
  191.         Write(c);
  192.         DEC(len);
  193.     END;
  194. END DrawCharLine;
  195.  
  196.  
  197. PROCEDURE WriteInfo();
  198. CONST
  199.     Undeclared = 'Undeclared Procedures\n\n';
  200.     Unused     = 'Unused Procedures (IMPORTed variables, constants, etc.)\n\n';
  201.     Idents     = 'Standard Identifiers';
  202.     Internal   = 'Internal Procedures';
  203.     Imports    = 'IMPORTed Procedures (variables, constants, etc.)';
  204. VAR
  205.     tempStr : ARRAY [0..255] OF CHAR;
  206.  
  207. BEGIN
  208.     IF ansi = on THEN
  209.         WriteString(CursorOff);
  210.     END;
  211.  
  212.     DrawCharLine(Separator,ColumnWidth); WriteLn;
  213.     ColorOn();
  214.       WriteString(Undeclared);
  215.     ColorOff();
  216.  
  217.     memLast := memHead;
  218.     WHILE memLast # NIL DO
  219.         WITH memLast^ DO
  220.             IF (NOT prDeclared) THEN
  221.                 prTag := TRUE;
  222.                 CopyString(tempStr,prFileName);
  223.                 ConcatString(tempStr,'.');
  224.                 ConcatString(tempStr,prProcName);
  225.                 WriteString(tempStr);
  226.                 WriteLn;
  227.             END;
  228.         END;
  229.         memLast := memLast^.next;
  230.     END;
  231.  
  232.     DrawCharLine(Separator,ColumnWidth); WriteLn;
  233.     ColorOn();
  234.       WriteString(Unused);
  235.     ColorOff();
  236.  
  237.     memLast := memHead;
  238.     WHILE memLast # NIL DO
  239.         WITH memLast^ DO
  240.             IF (prCount <= 0) THEN
  241.                 prTag := TRUE;
  242.                 CopyString(tempStr,prFileName);
  243.                 ConcatString(tempStr,'.');
  244.                 ConcatString(tempStr,prProcName);
  245.                 WriteString(tempStr);
  246.                 WriteLn;
  247.             END;
  248.         END;
  249.         memLast := memLast^.next;
  250.     END;
  251.  
  252.     DrawCharLine(Separator,ColumnWidth); WriteLn;
  253.     ColorOn();
  254.       WriteString(Idents);
  255.       DrawCharLine(' ',ColumnWidth - StringLength(Idents) - 5);
  256.       WriteString('Calls\n\n');
  257.     ColorOff();
  258.  
  259.     memLast := memHead;
  260.     WHILE memLast # NIL DO
  261.         WITH memLast^ DO
  262.             IF (CompareString('Std',prFileName) = equal) THEN
  263.                 prTag := TRUE;
  264.                 WriteString(prProcName);
  265.                 DrawCharLine('.',ColumnWidth-StringLength(prProcName)-4);
  266.                 WriteInt(prCount,4);
  267.                 WriteLn;
  268.             END;
  269.         END;
  270.         memLast := memLast^.next;
  271.     END;
  272.  
  273.     DrawCharLine(Separator,ColumnWidth); WriteLn;
  274.     ColorOn();
  275.       WriteString(Internal);
  276.       DrawCharLine(' ',ColumnWidth - StringLength(Internal) - 5);
  277.       WriteString('Calls\n\n');
  278.     ColorOff();
  279.  
  280.     memLast := memHead;
  281.     WHILE memLast # NIL DO
  282.         WITH memLast^ DO
  283.             IF (CompareString(prFileName,'Internal') = equal) THEN
  284.                 prTag := TRUE;
  285.                 WriteString(prProcName);
  286.                 DrawCharLine('.',ColumnWidth - StringLength(prProcName) - 4);
  287.                 WriteInt(prCount,4);
  288.                 WriteLn;
  289.             END;
  290.         END;
  291.         memLast := memLast^.next;
  292.     END;
  293.  
  294.     DrawCharLine(Separator,ColumnWidth); WriteLn;
  295.     ColorOn();
  296.       WriteString(Imports);
  297.       DrawCharLine(' ',ColumnWidth - StringLength(Imports) - 5);
  298.       WriteString('Calls\n\n');
  299.     ColorOff();
  300.  
  301.     memLast := memHead;
  302.     WHILE memLast # NIL DO
  303.         WITH memLast^ DO
  304.             IF (NOT prTag) THEN
  305.                 CopyString(tempStr,prFileName);
  306.                 ConcatString(tempStr,'.');
  307.                 ConcatString(tempStr,prProcName);
  308.                 WriteString(tempStr);
  309.                 DrawCharLine('.',ColumnWidth - StringLength(tempStr) - 4);
  310.                 WriteInt(prCount,4);
  311.                 WriteLn;
  312.             END;
  313.         END;
  314.         memLast := memLast^.next;
  315.     END;
  316.     DrawCharLine(Separator,ColumnWidth); WriteLn;
  317.  
  318.     IF ansi = on THEN
  319.         WriteString(CursorOn);
  320.     END;
  321. END WriteInfo;
  322.  
  323.  
  324. PROCEDURE Cleanup(err: ARRAY OF CHAR);
  325. VAR
  326.     last : ProcRecPtr;
  327. BEGIN
  328.     IF err[0] = 0C THEN
  329.         WriteInfo();
  330.     ELSE
  331.         WriteString(err);
  332.     END;
  333.  
  334.     CloseOutput();
  335.  
  336.     IF inFile.handle # NIL THEN
  337.         Close(inFile);
  338.         IF (inFile.err # 0D) THEN                   (* Amiga specific *)
  339.             WriteString('Error '); WriteLongInt(inFile.err,0);
  340.             WriteString(' occurred while closing source file!\n');
  341.         END;
  342.     END;
  343.  
  344.     memLast := memHead;
  345.     WHILE memLast # NIL DO
  346.         last := memLast;
  347.         memLast := memLast^.next;
  348.         FreeMem(last,SIZE(last^));
  349.     END;
  350.  
  351.     HALT;
  352. END Cleanup;
  353.  
  354.  
  355. PROCEDURE GetNextWord(VAR nextWord: ARRAY OF CHAR; VAR nextChar: CHAR);
  356. VAR
  357.     currPos : LONGCARD;
  358.     charPos : CARDINAL;
  359.     lastChar : CHAR;
  360. BEGIN
  361.     GetPos(inFile,currPos);
  362.  
  363.     charPos := 0;
  364.     lastChar := 0C;
  365.  
  366.     LOOP
  367.         ReadChar(inFile,nextChar);
  368.         nextWord[charPos] := nextChar;
  369.  
  370.         INC(currPos);
  371.         INC(charPos);
  372.         SetPos(inFile,currPos);
  373.         IF (inFile.eof) THEN Cleanup('') END;
  374.  
  375.         IF (nextChar = '(') AND
  376.             AlphaNum(lastChar) THEN
  377.             ReadChar(inFile,nextChar);
  378.             IF (nextChar # '*') THEN
  379.                 nextChar := '(';
  380.                 nextWord[charPos] := 0C;
  381.                 DEC(currPos);
  382.                 SetPos(inFile,currPos);
  383.                 RETURN;
  384.             END;
  385.          END;
  386.          IF (NOT AlphaNum(nextChar)) THEN
  387.             IF (charPos > 1) THEN
  388.                 nextWord[charPos-1] := 0C;
  389.                 RETURN;
  390.             ELSE
  391.                 charPos := 0;
  392.             END;
  393.         END;
  394.         lastChar := nextChar;
  395.     END;
  396. END GetNextWord;
  397.  
  398.  
  399. PROCEDURE AddToList(filename,procname: ARRAY OF CHAR;
  400.                      sureProc,declared: BOOLEAN; count: INTEGER);
  401. VAR
  402.     last : ProcRecPtr;
  403. BEGIN
  404.     memLast := memHead;
  405.     WHILE memLast # NIL DO
  406.         IF (CompareString(procname,memLast^.prProcName) = equal) THEN
  407.             INC(memLast^.prCount);
  408.             IF declared THEN
  409.                 memLast^.prDeclared := declared;
  410.             END;
  411.             RETURN;
  412.         END;
  413.         last := memLast;
  414.         memLast := memLast^.next;
  415.     END;
  416.                                         (* Amiga specific - just use   *)
  417.                                         (* ALLOCATE, DEALLOCATE or new *)
  418.     IF sureProc THEN
  419.         memLast := AllocMem(SIZE(memLast^),MemReqSet{MemPublic,MemClear});
  420.         IF memLast = NIL THEN
  421.             Cleanup('Memory disorder...\n');
  422.         END;
  423.  
  424.         IF memHead = NIL THEN
  425.             memHead := memLast;
  426.         END;
  427.  
  428.         CopyString(memLast^.prFileName,filename);
  429.         CopyString(memLast^.prProcName,procname);
  430.         memLast^.prCount := count;
  431.         memLast^.prDeclared := declared;
  432.  
  433.         last^.next := memLast;
  434.         memLast := NIL;
  435.     END;
  436. END AddToList;
  437.  
  438.  
  439. PROCEDURE GetImports(str: ARRAY OF CHAR);
  440. VAR
  441.     importName,
  442.     tempName,
  443.     procName : ARRAY [0..128] OF CHAR;
  444.     currPos  : LONGCARD;
  445.     charPos  : CARDINAL;
  446.     myChar   : CHAR;
  447. BEGIN
  448.     IF (CompareString(str,'FROM') = equal) THEN                 (* FROM *)
  449.         GetNextWord(importName,myChar);
  450.         GetNextWord(tempName,myChar);
  451.         IF (CompareString(tempName,'IMPORT') = equal) THEN
  452.             LOOP
  453.                 GetNextWord(procName,myChar);
  454.                 AddToList(importName,procName,TRUE,TRUE,0);
  455.                 IF (myChar = ';') THEN
  456.                     RETURN;
  457.                 END;
  458.             END;
  459.         END;
  460.     END;
  461.  END GetImports;
  462.  
  463.  
  464. PROCEDURE ProcessFile(VAR nextWord: ARRAY OF CHAR);
  465. CONST
  466.  
  467. (* BITSET,FLOAT,INC and some others are in here somewhere. *)
  468. (* Line continuation is compiler specific - may have to    *)
  469. (* extend this on one long line.                           *)
  470.  
  471. StdIdent =
  472. 'ABSBOOLEANCAPCARDINALCHARCHRDECDISPOSE\
  473. EXCLFALSEFLOATDHALTHIGHINCLINLINEINTEGER\
  474. LONGBITSETLONGCARDLONGINTLONGREALMAXMIN\
  475. NEWODDORDPROCRETURNREALSIZETRUETRUNCDVAL';
  476.  
  477. VAR
  478.     nextChar : CHAR;
  479.     currPos : LONGCARD;
  480.     bof     : LONGINT;
  481.     charPos : CARDINAL;
  482.     procTag : BOOLEAN;
  483.     declared : BOOLEAN;
  484. BEGIN
  485.     LOOP
  486.         declared := FALSE;
  487.         GetNextWord(nextWord,nextChar);
  488.         GetImports(nextWord);
  489.         IF (CompareString(nextWord,'PROCEDURE') = equal) THEN
  490.             GetNextWord(nextWord,nextChar);
  491.             declared := TRUE;
  492.         END;
  493.  
  494.         AddToList('',nextWord,FALSE,FALSE,1);
  495.         nextWord[StringLength(str)-1] := 0C;
  496.         IF (nextChar = '(') THEN
  497.             IF (LocateSubString(StdIdent,nextWord,0,
  498.                                  StringLength(StdIdent)) # -1) THEN
  499.                 AddToList('Std',nextWord,TRUE,TRUE,1);
  500.             ELSE
  501.                 AddToList('Internal',nextWord,TRUE,declared,-1);
  502.             END;
  503.         END;
  504.     END;
  505. END ProcessFile;
  506.  
  507.  
  508. PROCEDURE Startup();
  509. CONST
  510.  
  511. ReportStr =
  512. 'Send report to: (\x9B33mS\x9Bmcreen/\x9B33mF\x9Bmile) ';
  513. AnsiStr =
  514. 'Do you want \x9B33mANSI\x9Bm color codes in this file? (Y/N) ';
  515.  
  516. VAR
  517.     fileName,
  518.     reportName : ARRAY [0..128] OF CHAR;
  519.     chances : CARDINAL;
  520.     kbChar : CHAR;
  521. BEGIN
  522.     ColorOn();
  523.       WriteString(ProgName);
  524.     ColorOff();
  525.     WriteString(' - lists PROCEDURE usage in a Modula 2 source file.\n');
  526.     WriteString('Public domain by David Czaya (CIS 73445,407) (1989/1990) V1.1\n\n');
  527.  
  528.     Echo := FALSE;
  529.     chances := 3;
  530.     LOOP
  531.         ColorOn();              (* ANSI screen controls *)
  532.             WriteString('Source');
  533.         ColorOff();
  534.         WriteString(' file: ');
  535.         ReadString(fileName); WriteLn;
  536.         Lookup(inFile,fileName,FALSE);
  537.         IF (inFile.res = done) THEN EXIT END;
  538.         DEC(chances);
  539.         IF (chances = 0) THEN
  540.             WriteString(BadInput);
  541.             HALT;
  542.         END;
  543.     END;
  544.  
  545.     chances := 3;
  546.     LOOP
  547.         WriteString(ReportStr);
  548.         Read(kbChar);
  549.         IF (CAP(kbChar) = 'S') OR
  550.             (CAP(kbChar) = 'F') THEN
  551.             EXIT;
  552.         END;
  553.         DEC(chances);
  554.         IF (chances = 0) THEN Cleanup(BadInput) END;
  555.     END;
  556.  
  557.     IF (CAP(kbChar) = 'F') THEN
  558.         Read(kbChar);                          (* flush <RETURN> *)
  559.         chances := 3;
  560.         LOOP
  561.             WriteString(AnsiStr);
  562.             Read(kbChar);
  563.             IF (CAP(kbChar) = 'N') OR
  564.                 (CAP(kbChar) = 'Y') THEN
  565.                 EXIT;
  566.             END;
  567.             DEC(chances);
  568.             IF (chances = 0) THEN Cleanup(BadInput) END;
  569.         END;
  570.  
  571.         chances := 3;
  572.         LOOP
  573.             ColorOn();
  574.               WriteString('Report');
  575.             ColorOff();
  576.             WriteString(' file: ');
  577.             ReadString(reportName); WriteLn;
  578.             OpenOutputFile(reportName);
  579.             DEC(chances);
  580.             IF (chances = 0) THEN Cleanup(BadInput) END;
  581.             IF Done THEN EXIT END;
  582.         END;
  583.  
  584.         IF (CAP(kbChar) = 'N') THEN
  585.             ansi := off;
  586.         END;
  587.     ELSE
  588.         Read(kbChar);                   (* flush <RETURN> *)
  589.     END;
  590.  
  591.     GetDate();
  592.     ConvStringToUpperCase(fileName);
  593.     WriteString(fileName);
  594.     WriteString('\n\n');
  595. END Startup;
  596.  
  597.  
  598. BEGIN
  599.     ansi := on;
  600.     Startup();
  601.     ProcessFile(str);
  602. END ProcCheck.
  603.  
  604.  
  605.