home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1988 / 12 / pxref.asc < prev    next >
Text File  |  1988-12-31  |  19KB  |  585 lines
  1. _STRUCTURED PROGRAMMING COLUMN_
  2. by Kent Porter
  3.  
  4. [LISTING 1]
  5.  
  6.    1| Program number;
  7.    2| 
  8.    3|   { Puts line numbers at start of each line, stores in file by same
  9.    4|     name except extension is .NUM }
  10.    5| 
  11.    6| USES crt;
  12.    7| 
  13.    8| VAR   Filename, Newname : STRING [80];
  14.    9|       I, O              : TEXT;
  15.   10|       Line              : STRING [135];
  16.   11|       Nbr, len, p       : WORD;
  17.   12|       Num               : STRING [4];
  18.   13| 
  19.   14| BEGIN
  20.   15|   Nbr := 0;
  21.   16|   Newname := '';
  22.   17|   IF ParamCount < 1 THEN BEGIN
  23.   18|     Writeln ('USAGE: NUMBER <Filename.ext>');
  24.   19|     EXIT;
  25.   20|   END;
  26.   21|   Filename := ParamStr (1);
  27.   22| 
  28.   23|   Len := pos ('.', Filename);
  29.   24|   IF len = 0 THEN
  30.   25|     Newname := Filename + '.NUM'
  31.   26|   ELSE BEGIN
  32.   27|     FOR p := 1 TO len DO
  33.   28|       Newname := Newname + Filename [p];
  34.   29|     Newname := Newname + 'NUM';
  35.   30|   END;
  36.   31|   Assign (I, Filename);
  37.   32|   {$I-}
  38.   33|   Reset (I);
  39.   34|   {$I+}
  40.   35|   IF IOResult <> 0 THEN BEGIN
  41.   36|     Writeln ('Unable to open ', Filename);
  42.   37|     EXIT;
  43.   38|   END;
  44.   39|   Assign (O, Newname);
  45.   40|   Rewrite (O);
  46.   41|   Writeln;
  47.   42| 
  48.   43|   WHILE NOT eof (I) DO BEGIN
  49.   44|     Readln (I, Line);
  50.   45|     INC (Nbr);
  51.   46|     GotoXY (1, WhereY-1); Writeln (Nbr);
  52.   47|     Str (Nbr:4, Num);
  53.   48|     Line := Num + '| ' + Line;
  54.   49|     Writeln (O, Line);
  55.   50|   END;
  56.   51|   Close (O);
  57.   52|   Close (I);
  58.   53|   GotoXY (1, WhereY-1); Writeln (nbr, ' lines in file');
  59.   54|   Writeln ('Output is in ', Newname);
  60.   55| END.
  61.   56| 
  62.   57| 
  63.  
  64.  
  65. [LISTING 2]
  66.  
  67. Case-sensitive symbolic cross-reference for number.pas
  68.  
  69. 0 (3), 15, 24, 35
  70. 1 (7), 17, 21, 27, 46, 46, 53, 53
  71. 135 (1), 10
  72. 4 (2), 12, 47
  73. 80 (1), 8
  74. Assign (2), 31, 39
  75. Close (2), 51, 52
  76. crt (1), 6
  77. eof (1), 43
  78. EXIT (2), 19, 37
  79. Filename (7), 8, 21, 23, 25, 28, 31, 36
  80. GotoXY (2), 46, 53
  81. I (6), 9, 31, 33, 43, 44, 52
  82. IOResult (1), 35
  83. Len (1), 23
  84. len (3), 11, 24, 27
  85. Line (5), 10, 44, 48, 48, 49
  86. Nbr (5), 11, 15, 45, 46, 47
  87. nbr (1), 53
  88. Newname (9), 8, 16, 25, 28, 28, 29, 29, 39, 54
  89. NOT (1), 43
  90. Num (3), 12, 47, 48
  91. number (1), 1
  92. O (5), 9, 39, 40, 49, 51
  93. p (3), 11, 27, 28
  94. ParamCount (1), 17
  95. ParamStr (1), 21
  96. pos (1), 23
  97. Program (1), 1
  98. Readln (1), 44
  99. Reset (1), 33
  100. Rewrite (1), 40
  101. Str (1), 47
  102. STRING (3), 8, 10, 12
  103. TEXT (1), 9
  104. USES (1), 6
  105. WhereY (2), 46, 53
  106. WORD (1), 11
  107. Writeln (7), 18, 36, 41, 46, 49, 53, 54
  108.  
  109. -- 40 symbols reported
  110.  
  111. [LISTING 3]
  112.  
  113.    1| PROGRAM Xref;
  114.    2| 
  115.    3| { Builds and lists a Pascal/Modula-2 symbol cross-reference report   }
  116.    4| { Uses binary trees and doubly-linked lists to effect B-Tree         }
  117.    5| { Command line is XREF <filename.ext> [/C|/N]                        }
  118.    6| { /C makes xref case-sensitive                                       }
  119.    7| { /N makes it non-case sensitive (default)                           }
  120.    8| { Turbo Pascal 5.0 (4.0 will work, too)                              }
  121.    9| { K. Porter, DDJ, December '88 Structured Programming Column         }
  122.   10| 
  123.   11| USES crt, printer;
  124.   12| 
  125.   13| TYPE  SymString = STRING [39];
  126.   14|       CharSet = SET OF CHAR;
  127.   15|       LineString = STRING [135];
  128.   16|       XLinePtr = ^XLineNode;      { Pointer to xref line number node }
  129.   17|       XLineNode = RECORD          { Xref line number structure (SLL) }
  130.   18|         Line : WORD;
  131.   19|         Next : XLinePtr;
  132.   20|       END;
  133.   21| 
  134.   22|       SymTreePtr = ^SymTreeNode;       { Pointer to symbol tree node }
  135.   23|       SymTreeNode = RECORD                 { Binary tree symbol node }
  136.   24|         Symbol       : SymString;
  137.   25|         UCsymbol     : SymString;
  138.   26|         Count        : WORD;
  139.   27|         XList        : XLinePtr;
  140.   28|         LLink, RLink : SymTreePtr;
  141.   29|       END;
  142.   30| 
  143.   31| CONST Quote =  #39;
  144.   32|       DQuote = #34;
  145.   33|       Eject =  #12;
  146.   34|       SymChars : CharSet = ['0'..'9','A'..'Z','a'..'z','.','_','^'];
  147.   35|       PComment : CharSet = ['{', '}', '(', '*', ')', Quote, DQuote];
  148.   36|       Heading  = ' symbolic cross-reference for ';
  149.   37| 
  150.   38| VAR   Filepath       : STRING [80];
  151.   39|       Case_Sensitive : BOOLEAN;
  152.   40|       F              : TEXT;
  153.   41|       Head, Alpha    : SymTreePtr;
  154.   42|       CommentLevel   : WORD;
  155.   43|       Line           : LineString;
  156.   44|       LineNumber     : WORD;
  157.   45|       NSymbols       : WORD;
  158.   46| { ------------------------------------------------------------------ }
  159.   47| 
  160.   48| PROCEDURE FindEndOfComment (VAR line : LineString;
  161.   49|                             VAR i    : WORD;
  162.   50|                                 eoc  : CHAR);
  163.   51|   { Scan until end of current comment is found }
  164.   52| 
  165.   53| VAR   ch        : CHAR;
  166.   54|       Searching : BOOLEAN;
  167.   55| 
  168.   56| BEGIN
  169.   57|   Searching := TRUE;
  170.   58|   WHILE Searching DO BEGIN
  171.   59|     WHILE i <= Length (Line) DO BEGIN
  172.   60|       ch := Line [i];
  173.   61|       INC (i);
  174.   62|       IF ch = eoc THEN
  175.   63|         CASE eoc OF
  176.   64|           '}':    Searching := FALSE;
  177.   65|           '*':    IF line [i] = ')' THEN BEGIN
  178.   66|                     Searching := FALSE;
  179.   67|                     INC (i);
  180.   68|                   END;
  181.   69|           Quote:  Searching := FALSE;
  182.   70|           DQuote: Searching := FALSE;
  183.   71|         END;
  184.   72| 
  185.   73|       IF Searching = FALSE THEN BEGIN
  186.   74|         DEC (CommentLevel);
  187.   75|         EXIT;
  188.   76|       END;
  189.   77|     END;
  190.   78| 
  191.   79|     { If we get here, the comment continues on the next line }
  192.   80|     Readln (F, Line);
  193.   81|     i := 1;
  194.   82|     INC (LineNumber);
  195.   83|   END;
  196.   84| END;
  197.   85| { --------------------------- }
  198.   86| 
  199.   87| FUNCTION UpShift (VAR Symbol : SymString) : SymString;
  200.   88|   { Return upshifted version of passed string }
  201.   89| 
  202.   90| VAR   p : INTEGER;
  203.   91|       s : SymString;
  204.   92| 
  205.   93| BEGIN
  206.   94|   s := '';
  207.   95|   FOR p := 1 TO Length (Symbol) DO
  208.   96|     s := s + UpCase (Symbol [p]);
  209.   97|   UpShift := s;
  210.   98| END;
  211.   99| { --------------------------- }
  212.  100| 
  213.  101| FUNCTION NewNode (VAR Symbol : SymString) : SymTreePtr;
  214.  102|   { Allocate and set up new symbol node, return pointer }
  215.  103| 
  216.  104| VAR   node : SymTreePtr;
  217.  105| 
  218.  106| BEGIN
  219.  107|   NEW (node);
  220.  108|   Node^.Symbol   := Symbol;
  221.  109|   Node^.UCSymbol := UpShift (Symbol);
  222.  110|   Node^.Count    := 1;
  223.  111|   Node^.XList    := NIL;
  224.  112|   Node^.RLink    := NIL;
  225.  113|   Node^.LLink    := NIL;
  226.  114|   Node^.RLink    := NIL;
  227.  115|   NewNode := node;
  228.  116| END;
  229.  117| { --------------------------- }
  230.  118| 
  231.  119| FUNCTION Token (VAR line : LineString;
  232.  120|                 VAR i : WORD) : SymString;
  233.  121|   { Return next symbol or keyword from line }
  234.  122|   { Index to next char returned as a side-effect }
  235.  123|   { Also checks for comments }
  236.  124| 
  237.  125| VAR   sym          : SymString;
  238.  126|       ch, ScanChar : CHAR;
  239.  127|       nch          : WORD;
  240.  128| 
  241.  129| BEGIN
  242.  130|   { Scan for first valid alphanumeric or for comment }
  243.  131|   ScanChar := #0;
  244.  132|   WHILE (NOT (Line [i] IN SymChars)) AND (i <= Length (line)) DO BEGIN
  245.  133|     ch := line [i];
  246.  134|     INC (i);
  247.  135|     IF ch IN PComment THEN BEGIN
  248.  136|       CASE ch OF
  249.  137|         Quote: BEGIN
  250.  138|                  INC (CommentLevel);
  251.  139|                  ScanChar := Quote;
  252.  140|                END;
  253.  141|         '{':   BEGIN
  254.  142|                  INC (CommentLevel);
  255.  143|                  ScanChar := '}';
  256.  144|                END;
  257.  145|         '}':   IF CommentLevel > 0 THEN
  258.  146|                  DEC (CommentLevel);
  259.  147|         '(':   IF line [i] = '*' THEN BEGIN
  260.  148|                  INC (CommentLevel);
  261.  149|                  ScanChar := '*';
  262.  150|                  INC (i);
  263.  151|                END;
  264.  152|         '*':   IF line [i] = ')' THEN
  265.  153|                  IF CommentLevel > 0 THEN BEGIN
  266.  154|                    DEC (CommentLevel);
  267.  155|                    INC (i);
  268.  156|                  END;
  269.  157|       END;
  270.  158|       IF CommentLevel > 0 THEN
  271.  159|         FindEndOfComment (line, i, ScanChar);
  272.  160|     END;
  273.  161|   END;
  274.  162| 
  275.  163|   { Pull out the symbol }
  276.  164|   sym := '';
  277.  165|   nch := 1;
  278.  166|   IF i < Length (Line) THEN
  279.  167|     REPEAT
  280.  168|       ch := Line [i];
  281.  169|       IF ch IN SymChars THEN BEGIN
  282.  170|         IF (ch = '^') AND (nch = 1) THEN
  283.  171|           { Skip leading pointer char }
  284.  172|         ELSE BEGIN
  285.  173|           sym := sym + ch;
  286.  174|           INC (nch);
  287.  175|         END;
  288.  176|         INC (i);
  289.  177|       END;
  290.  178|     UNTIL (NOT (ch IN SymChars)) OR (i > Length (Line));
  291.  179|   IF NOT Case_Sensitive THEN
  292.  180|     Token := UpShift (sym)
  293.  181|   ELSE
  294.  182|     Token := sym;
  295.  183| END;
  296.  184| { --------------------------- }
  297.  185| 
  298.  186| FUNCTION BNode (VAR sym : SymString) : SymTreePtr;
  299.  187|   { Find sym's node in binary tree, or add it if it doesn't exist }
  300.  188| 
  301.  189| VAR   Node, Parent : SymTreePtr;
  302.  190| 
  303.  191| BEGIN
  304.  192|   Node := Head;
  305.  193|   WHILE ((Node^.Symbol <> sym) AND (Node <> NIL)) DO BEGIN
  306.  194|     Parent := Node;
  307.  195|     IF sym < Node^.Symbol THEN
  308.  196|       Node := Node^.LLink
  309.  197|     ELSE
  310.  198|       Node := Node^.RLink
  311.  199|   END;
  312.  200|   IF Node <> NIL THEN                  { Node exists for this symbol }
  313.  201|     INC (Node^.Count)
  314.  202|   ELSE BEGIN                      { Else add new node to binary tree }
  315.  203|     Node := NewNode (sym);
  316.  204|     IF sym < Parent^.Symbol THEN           { Update parent's pointer }
  317.  205|       Parent^.LLink := Node
  318.  206|     ELSE
  319.  207|       Parent^.RLink := Node
  320.  208|   END;
  321.  209|   BNode := Node;
  322.  210| END;
  323.  211| { --------------------------- }
  324.  212| 
  325.  213| PROCEDURE Append (Target : SymTreePtr; LineNbr : WORD);
  326.  214|   { Add line cross-ref to target's dependent list }
  327.  215| 
  328.  216| VAR    XR, Parent : XLinePtr;
  329.  217| 
  330.  218| BEGIN
  331.  219|   IF Target^.XList = NIL THEN BEGIN     { First occurrence of symbol }
  332.  220|       NEW (XR);
  333.  221|       XR^.Line := LineNbr;
  334.  222|       XR^.Next := NIL;
  335.  223|       Target^.XList := XR;
  336.  224|     END
  337.  225|   ELSE BEGIN                        { Append to end of existing list }
  338.  226|       XR := Target^.Xlist;
  339.  227|       REPEAT
  340.  228|         Parent := XR;
  341.  229|         XR := XR^.Next
  342.  230|       UNTIL XR = NIL;                             { Find list's tail }
  343.  231|       NEW (XR);                                       { Append there }
  344.  232|       XR^.Line := LineNbr;
  345.  233|       XR^.Next := NIL;
  346.  234|       Parent^.Next := XR;
  347.  235|   END;
  348.  236| END;
  349.  237| { --------------------------- }
  350.  238| 
  351.  239| PROCEDURE AddToTree (VAR Symbol : SymString; LineNbr : WORD);
  352.  240|   { Place symbol into binary tree, add line xref to dependent list }
  353.  241| 
  354.  242| VAR   Target : SymTreePtr;
  355.  243| 
  356.  244| BEGIN
  357.  245|   IF Head = NIL THEN BEGIN          { The tree is empty, so start it }
  358.  246|       Head := NewNode (Symbol);            { Build first binary node }
  359.  247|       Append (Head, LineNbr);                { Build first XREF node }
  360.  248|     END
  361.  249|   ELSE BEGIN
  362.  250|       Target := BNode (Symbol);
  363.  251|       Append (Target, LineNbr);
  364.  252|   END;
  365.  253| END;
  366.  254| { --------------------------- }
  367.  255| 
  368.  256| PROCEDURE Process (VAR Line : LineString);
  369.  257|   { Controls parsing and construction of BTree }
  370.  258| 
  371.  259| VAR   Symbol  : SymString;
  372.  260|       p, oldp : WORD;
  373.  261| 
  374.  262| BEGIN
  375.  263|   p := 1;
  376.  264|   IF Length (Line) > 0 THEN
  377.  265|     WHILE p <= Length (Line) DO BEGIN
  378.  266|       oldp := p;
  379.  267|       Symbol := Token (line, p);                        { Get symbol }
  380.  268|       IF Symbol = 'BEGIN' THEN Symbol := ''     { Weed out nuisances }
  381.  269|       ELSE IF Symbol = 'END'     THEN Symbol := ''
  382.  270|       ELSE IF Symbol = 'IF'      THEN Symbol := ''
  383.  271|       ELSE IF Symbol = 'THEN'    THEN Symbol := ''
  384.  272|       ELSE IF Symbol = 'ELSE'    THEN Symbol := ''
  385.  273|       ELSE IF Symbol = 'DO'      THEN Symbol := ''
  386.  274|       ELSE IF Symbol = 'WHILE'   THEN Symbol := ''
  387.  275|       ELSE IF Symbol = 'FOR'     THEN Symbol := ''
  388.  276|       ELSE IF Symbol = 'TO'      THEN Symbol := ''
  389.  277|       ELSE IF Symbol = 'VAR'     THEN Symbol := ''
  390.  278|       ELSE IF Symbol = 'INC'     THEN Symbol := ''
  391.  279|       ELSE IF Symbol = 'DEC'     THEN Symbol := ''
  392.  280|       ELSE IF Symbol = 'OF'      THEN Symbol := ''
  393.  281|       ELSE IF Symbol = 'PROGRAM' THEN Symbol := ''
  394.  282|       ELSE IF Symbol = 'END.'    THEN Symbol := '';
  395.  283|       IF Length (Symbol) > 0 THEN
  396.  284|         AddToTree (Symbol, LineNumber);        { Place info in BTree }
  397.  285|       IF p = oldp THEN INC (p);              { Prevents endless loop }
  398.  286|     END;
  399.  287| END;
  400.  288| { --------------------------- }
  401.  289| 
  402.  290| PROCEDURE Report (Node : SymTreePtr);
  403.  291|   { Print symbol cross-reference listing }
  404.  292|   { In-order (recursive) traversal of binary tree, printing the info
  405.  293|       and dependent list for each node }
  406.  294| 
  407.  295| VAR   Col, Width : WORD;
  408.  296|       Lnode      : XLinePtr;
  409.  297| 
  410.  298|   PROCEDURE NewLine;
  411.  299|     { Control pagination }
  412.  300|   BEGIN
  413.  301|     Writeln (LST);
  414.  302|     Col := 0;
  415.  303|     INC (LineNumber);
  416.  304|     IF LineNumber > 58 THEN BEGIN
  417.  305|       Write (LST, Eject);
  418.  306|       Writeln (LST, 'Continuing cross-reference for ', Filepath);
  419.  307|       Writeln (LST);
  420.  308|       LineNumber := 2;
  421.  309|     END;
  422.  310|   END;                                        { End nested procedure }
  423.  311| 
  424.  312| BEGIN
  425.  313|   IF node <> NIL THEN BEGIN
  426.  314|     Report (Node^.LLink);                    { Follow left-hand path }
  427.  315| 
  428.  316|     { Print info from node }
  429.  317|     Col := 0;
  430.  318|     Write (LST, Node^.Symbol, ' (', Node^.Count, ')');
  431.  319|     Col := Col + Length (Node^.Symbol) + 6;
  432.  320| 
  433.  321|     { Print line number references }
  434.  322|     Lnode := Node^.XList;
  435.  323|     While Lnode <> NIL DO BEGIN
  436.  324|       IF Col > 0 THEN
  437.  325|         Write (LST, ', ', Lnode^.Line)
  438.  326|       ELSE
  439.  327|         Write (LST, '  ', Lnode^.Line);
  440.  328|       IF Lnode^.Line < 10 THEN Width := 1
  441.  329|         ELSE IF Lnode^.Line > 99 THEN Width := 3
  442.  330|           ELSE Width := 2;
  443.  331|       Col := Col + Width + 2;
  444.  332|       IF (Col > 70) AND (Lnode^.Next <> NIL) THEN NewLine;
  445.  333|       Lnode := Lnode^.Next;
  446.  334|     END;
  447.  335|     NewLine;
  448.  336| 
  449.  337|     Report (Node^.RLink);              { Then follow right-hand path }
  450.  338|   END;
  451.  339| END;
  452.  340| { --------------------------- }
  453.  341| 
  454.  342| PROCEDURE Alphabetize (sym : SymTreePtr);
  455.  343|   { Rearrange tree when case-sensitive so that upper- and lower-case
  456.  344|     identifiers occur in alphabetic order regardless of case }
  457.  345|   { RECURSIVE: Traverses symbol table in-order, builds alpha list }
  458.  346| 
  459.  347|   PROCEDURE Resort (sym : SymTreePtr);
  460.  348|     { NESTED: Place new node in tree headed by Alpha pointer }
  461.  349| 
  462.  350|   VAR   Node, Parent : SymTreePtr;
  463.  351|         UCsymbol     : SymString;
  464.  352| 
  465.  353|   BEGIN
  466.  354|     IF Alpha = NIL THEN BEGIN       { Make first node in sorted tree }
  467.  355|         Alpha := NewNode (sym^.symbol);
  468.  356|         Alpha^.count    := sym^.count;
  469.  357|         Alpha^.XList    := sym^.XList;
  470.  358|       END
  471.  359|     ELSE BEGIN                               { Add new node in order }
  472.  360|         UCsymbol := UpShift (sym^.symbol);
  473.  361|         Node := Alpha;
  474.  362|         WHILE node <> NIL DO BEGIN            { Find insertion point }
  475.  363|           Parent := node;
  476.  364|           IF UCsymbol < Node^.UCsymbol THEN    { based on U/C symbol }
  477.  365|             Node := Parent^.LLink
  478.  366|           ELSE
  479.  367|             Node := Parent^.RLink;
  480.  368|         END;
  481.  369|         Node := NewNode (sym^.symbol);                    { Add node }
  482.  370|         Node^.Count    := sym^.count;
  483.  371|         Node^.XList    := sym^.XList;
  484.  372|         IF UCsymbol < Parent^.UCsymbol THEN
  485.  373|           Parent^.LLink := node
  486.  374|         ELSE
  487.  375|           Parent^.RLink := node;
  488.  376|       END;
  489.  377|   END;
  490.  378| 
  491.  379| BEGIN  { Body of Alphabetize }
  492.  380|   IF sym <> NIL THEN BEGIN
  493.  381|     Alphabetize (sym^.LLink);                     { Do nodes to left }
  494.  382|     Resort (sym);                          { Realphabetize this node }
  495.  383|     Alphabetize (sym^.RLink);                { Now do nodes to right }
  496.  384|     Dispose (sym);                         { All thru with this node }
  497.  385|   END;
  498.  386| END;
  499.  387| { --------------------------- }
  500.  388| 
  501.  389| PROCEDURE Count (Node : SymTreePtr);
  502.  390|   { Count nodes in tree }
  503.  391| BEGIN
  504.  392|   IF node <> NIL THEN BEGIN
  505.  393|     Count (Node^.LLink);
  506.  394|     INC (NSymbols);
  507.  395|     Count (Node^.RLink);
  508.  396|   END
  509.  397| END;
  510.  398| { --------------------------- }
  511.  399| 
  512.  400| BEGIN
  513.  401|   { Initialize }
  514.  402|   Head := NIL;
  515.  403|   Alpha := NIL;
  516.  404|   CommentLevel := 0;
  517.  405|   LineNumber := 0;
  518.  406|   NSymbols := 0;
  519.  407| 
  520.  408|   { Process command line }
  521.  409|   IF ParamCount < 1 THEN BEGIN
  522.  410|     Writeln ('USAGE: XREF <Filename.[ext]> [/C|/N]');
  523.  411|     EXIT;
  524.  412|   END;
  525.  413|   Filepath := ParamStr (1);
  526.  414|   IF pos ('.', Filepath) = 0 THEN
  527.  415|     Filepath := Filepath + '.PAS';          { Default is Pascal file }
  528.  416|   Case_Sensitive := FALSE;            { Set default case sensitivity }
  529.  417|   IF ParamCount = 2 THEN                 { or alter per command line }
  530.  418|     IF (ParamStr (2) = '/c') OR (ParamStr (2) = '/C') THEN
  531.  419|       Case_Sensitive := TRUE;
  532.  420| 
  533.  421|   { Open the file }
  534.  422|   Assign (F, Filepath);
  535.  423|   {$I-}
  536.  424|   Reset (F);
  537.  425|   {$I+}
  538.  426|   IF IOResult <> 0 THEN BEGIN
  539.  427|     Writeln ('Unable to open ', Filepath);
  540.  428|     EXIT;
  541.  429|   END;
  542.  430| 
  543.  431|   { Announce the program }
  544.  432|   ClrScr;
  545.  433|   IF Case_Sensitive THEN
  546.  434|     Write ('Case-sensitive')
  547.  435|   ELSE
  548.  436|     Write ('Non-case sensitive');
  549.  437|   Writeln (Heading, Filepath);
  550.  438|   Writeln;
  551.  439| 
  552.  440|   { Process the file }
  553.  441|   WHILE NOT eof (F) DO BEGIN
  554.  442|     Readln (F, line);
  555.  443|     INC (LineNumber);
  556.  444|     GotoXY (1, WhereY-1); Writeln (LineNumber);  { Meter line number }
  557.  445|     Process (Line);
  558.  446|   END;
  559.  447|   Close (F);
  560.  448|   GotoXY (1, WhereY-1); Writeln (LineNumber, ' lines in file');
  561.  449|   IF CommentLevel <> 0 THEN
  562.  450|     Writeln ('Unbalanced comments detected');
  563.  451| 
  564.  452|   { Alphabetize tree into non-ASCII order if case-sensitive }
  565.  453|   LineNumber := 3;
  566.  454|   IF Case_Sensitive THEN BEGIN
  567.  455|       Alphabetize (Head);
  568.  456|       Writeln (LST, 'Case-sensitive', Heading, Filepath);
  569.  457|       Writeln (LST);     
  570.  458|       Report (Alpha);
  571.  459|       Count (Alpha);
  572.  460|     END
  573.  461|   ELSE BEGIN
  574.  462|       Writeln (LST, 'Non-case sensitive', Heading, Filepath);
  575.  463|       Writeln (LST);
  576.  464|       Report (Head);
  577.  465|       Count (Head);
  578.  466|     END;
  579.  467|   Writeln (LST);
  580.  468|   Writeln (LST, '-- ', NSymbols, ' symbols reported');
  581.  469|   Write (LST, Eject);
  582.  470| END.
  583.  
  584.  
  585.