home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / cobol / library / xref / xref.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-10-01  |  24.3 KB  |  848 lines
  1. {$C-,A-,I-,V-,R-}
  2. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3. {+                                                      +}
  4. {+  PROGRAM TITLE:      Cross Reference Generator       +}
  5. {+                                                      +}
  6. {+  AUTHOR:             Peter Grogono, et al.           +}
  7. {+                                                      +}
  8. {+  SUMMARY:                                            +}
  9. {+      1. Output Files:                                +}
  10. {+         a. first output file is a numbered listing   +}
  11. {+            of the input source                       +}
  12. {+         b. second output file is cross reference     +}
  13. {+            with each identifier followed by the      +}
  14. {+            line numbers on which it appears.         +}
  15. {+      2. Listing Device:                              +}
  16. {+         The numbered source listing may optionally   +}
  17. {+         be routed to the screen or printer (but not  +}
  18. {+         both).                                       +}
  19. {+                                                      +}
  20. {+                                                      +}
  21. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  22.  
  23. (* COBOL Version, 10/1/86, David C. Oshel
  24.    Note:  The list of reserved words includes IBM-PC COBOL 1.00 extensions,
  25.    such as BACKGROUND-COLOR, etc., that are not part of Standard COBOL.
  26.  
  27.    This version has been kludged up to take command line arguments so it
  28.    can be used in batch.  Assumes IBM-PC clone.
  29.  
  30.    Type "C>xref ?" for usage.
  31.    Example: xref ptosub1 ptosub2 ptosub3 ptomain
  32.    *)
  33.  
  34.  
  35. PROGRAM XREFT;
  36. { Cross Reference Generator }
  37. CONST
  38.  
  39.         xrefver = 'XREF 3.0 for COBOL';
  40.         datever = 'Oct. 1, 1986, D.C.Oshel';
  41.  
  42.         alfa_length     =  30;
  43.         dflt_str_len    = 255;
  44.         entrygap        =    0;   { # of blank lines between line numbers}
  45.         heading         : string[23] = 'cross-reference list';
  46.         headingsize     =    3;   {number of lines for heading}
  47.         LLmax           = dflt_str_len;
  48.         MaxOnLine       =   8;
  49.         Maxlines        = MAXINT; {longest document permitted}
  50.         MaxWordlen      = alfa_length;{longest word read without truncation}
  51.         Maxlinelen      =   80;   {length of output line}
  52.         MaxOnPage       =   60;   {size of output page}
  53.  
  54.         NumKeys         =  348;   {number of COBOL reseved words}
  55.  
  56.         NumberWidth     =    6;
  57.         space           : char = ' ';
  58.  
  59.  
  60. TYPE
  61.         ALFA    = string[alfa_length];
  62.         CHARNAME = (lletter, uletter, digit, blank, quote, atab,
  63.                       EndOfLine, FileMark, otherchar );
  64.         CHARINFO = RECORD
  65.                      name : charname;
  66.                      valu : CHAR
  67.                    END;
  68.         COUNTER = 1..Maxlines;
  69.         pageindex = BYTE;
  70.         Wordindex = 1..MaxWordlen;
  71.         Queuepointer = ^Queueitem;
  72.         Queueitem = RECORD
  73.                         linenumber : counter;
  74.                         NextInQueue: Queuepointer
  75.                     END;
  76.         EntryType = RECORD
  77.                         Wordvalue : alfa;
  78.                         FirstInQueue,
  79.                         lastinQueue: Queuepointer
  80.                      END;
  81.         treepointer = ^node;
  82.         node = RECORD
  83.                  entry : EntryType;
  84.                  left,
  85.                  right : treepointer
  86.                END;
  87.         GenStr  = string[255];
  88.  
  89.  
  90. VAR
  91.   bell          : CHAR;
  92.   fatal_error   : BOOLEAN;
  93.  
  94.   UseFile,                      { Scratch for command line args }
  95.   FILE_ID,                      { Input file name }
  96.   PRN_ID,                       { basic file name + '.PRN' }
  97.   New_ID        : string[80];   { basic file name + '.XRF' }
  98.   form_feed     : CHAR;
  99.   Key           : ARRAY[1..NumKeys] OF alfa;
  100.   LISTING       : BOOLEAN;
  101.   tab           : CHAR;
  102.   WordTree      : treepointer;
  103.   GAP           : char      ;
  104.   Currentline   : INTEGER;
  105.   FOUT: TEXT; { print output file }
  106.   XOUT: TEXT; { xref  output file }
  107.  
  108.  
  109.  
  110.  
  111. {$I XREF1.INC }
  112.  
  113.  
  114.  
  115.  
  116. Procedure Heapsort;        (* after Knuth, Vol. 3, p. 146 *)
  117.  
  118. label
  119.    lab1,lab2,lab3,lab4,lab5,lab6,lab7,lab8;
  120. const
  121.    B = 1;    Size = NumKeys;
  122. var
  123.    I,J,L,R: Integer;   Temp: ALFA;
  124.  
  125. begin
  126.           L := (Size div 2) + 1;      (* don't ask, it's magic! *)
  127.           R := Size;
  128.     lab1: if L > B then goto lab2;
  129.           Temp := Key[R];
  130.           Key[R] := Key[B];
  131.           R := R - 1;
  132.           if R = B then goto lab8;
  133.           goto lab3;
  134.     lab2: L := L - 1;
  135.           Temp := Key[L];
  136.     lab3: J := L;
  137.     lab4: I := J;
  138.           J := 2 * J;
  139.           if J < R then goto lab5;
  140.           if J = R then goto lab6;
  141.           if J > R then goto lab7;
  142.     lab5: if Key[J] < Key[J+1] then J := J + 1;
  143.     lab6: if Temp >= Key[J] then goto lab7;
  144.           Key[I] := Key[J];
  145.           goto lab4;
  146.     lab7: Key[I] := Temp;
  147.           goto lab1;
  148.     lab8: Key[B] := Temp;  (* finished! *)
  149.  
  150. end;  { Heapsort }
  151.  
  152.  
  153.  
  154.  
  155.  
  156. const flag:Boolean = FALSE;  (* used by SetKey *)
  157.  
  158.  
  159. Procedure SetKey;  (* the set of COBOL reserved words *)
  160. begin
  161.    if not flag then begin
  162.         writeln;
  163.         write(xrefver,': one moment please, sorting ',NumKeys,' reserved words...');
  164.         Key[  1] := 'ACCEPT';
  165.         Key[  2] := 'ACCESS';
  166.         Key[  3] := 'ADD';
  167.         Key[  4] := 'ADVANCING';
  168.         Key[  5] := 'AFTER';
  169.         Key[  6] := 'ALL';
  170.         Key[  7] := 'ALPHABETIC';
  171.         Key[  8] := 'ALSO';
  172.         Key[  9] := 'ALTER';
  173.         Key[ 10] := 'ALTERNATE';
  174.         Key[ 11] := 'AND';
  175.         Key[ 12] := 'ARE';
  176.         Key[ 13] := 'AREA';
  177.         Key[ 14] := 'AREAS';
  178.         Key[ 15] := 'ASCENDING';
  179.         Key[ 16] := 'ASCII';
  180.         Key[ 17] := 'ASSIGN';
  181.         Key[ 18] := 'AT';
  182.         Key[ 19] := 'AUTHOR';
  183.         Key[ 20] := 'AUTO';
  184.         Key[ 21] := 'AUTO-SKIP';
  185.  
  186.         Key[ 22] := 'BACKGROUND-COLOR';
  187.         Key[ 23] := 'BEEP';
  188.         Key[ 24] := 'BEFORE';
  189.         Key[ 25] := 'BELL';
  190.         Key[ 26] := 'BLANK';
  191.         Key[ 27] := 'BLINK';
  192.         Key[ 28] := 'BLOCK';
  193.         Key[ 29] := 'BOTTOM';
  194.         Key[ 30] := 'BY';
  195.  
  196.         Key[ 31] := 'CALL';
  197.         Key[ 32] := 'CANCEL';
  198.         Key[ 33] := 'CD';
  199.         Key[ 34] := 'CF';
  200.         Key[ 35] := 'CH';
  201.         Key[ 36] := 'CHAIN';
  202.         Key[ 37] := 'CHAINING';
  203.         Key[ 38] := 'CHARACTER';
  204.         Key[ 39] := 'CHARACTERS';
  205.         Key[ 40] := 'CLOCK-UNITS';
  206.         Key[ 41] := 'CLOSE';
  207.         Key[ 42] := 'COBOL';
  208.         Key[ 43] := 'CODE';
  209.         Key[ 44] := 'CODE-SET';
  210.         Key[ 45] := 'COL';
  211.         Key[ 46] := 'COLLATING';
  212.         Key[ 47] := 'COLUMN';
  213.         Key[ 48] := 'COMMA';
  214.         Key[ 49] := 'COMMUNICATION';
  215.         Key[ 50] := 'COMP';
  216.         Key[ 51] := 'COMP-0';
  217.         Key[ 52] := 'COMP-3';
  218.         Key[ 53] := 'COMPUTATIONAL';
  219.         Key[ 54] := 'COMPUTATIONAL-0';
  220.         Key[ 55] := 'COMPUTATIONAL-3';
  221.         Key[ 56] := 'COMPUTE';
  222.         Key[ 57] := 'CONFIGURATION';
  223.         Key[ 58] := 'CONTAINS';
  224.         Key[ 59] := 'CONTROL';
  225.         Key[ 60] := 'CONTROLS';
  226.         Key[ 61] := 'COPY';
  227.         Key[ 62] := 'CORR';
  228.         Key[ 63] := 'CORRESPONDING';
  229.         Key[ 64] := 'COUNT';
  230.         Key[ 65] := 'CURRENCY';
  231.  
  232.         Key[ 66] := 'DATA';
  233.         Key[ 67] := 'DATE';
  234.         Key[ 68] := 'DATE-COMPILED';
  235.         Key[ 69] := 'DATE-WRITTEN';
  236.         Key[ 70] := 'DAY';
  237.         Key[ 71] := 'DE';
  238.         Key[ 72] := 'DEBUG-CONTENTS';
  239.         Key[ 73] := 'DEBUG-ITEM';
  240.         Key[ 74] := 'DEBUG-NAME';
  241.         Key[ 75] := 'DEBUG-SUB-1';
  242.         Key[ 76] := 'DEBUG-SUB-2';
  243.         Key[ 77] := 'DEBUG-SUB-3';
  244.         Key[ 78] := 'DEBUGGING';
  245.         Key[ 79] := 'DECIMAL-POINT';
  246.         Key[ 80] := 'DECLARATIVES';
  247.         Key[ 81] := 'DELETE';
  248.         Key[ 82] := 'DELIMITED';
  249.         Key[ 83] := 'DELIMITER';
  250.         Key[ 84] := 'DEPENDING';
  251.         Key[ 85] := 'DESCENDING';
  252.         Key[ 86] := 'DESTINATION';
  253.         Key[ 87] := 'DETAIL';
  254.         Key[ 88] := 'DISABLE';
  255.         Key[ 89] := 'DISK';
  256.         Key[ 90] := 'DISPLAY';
  257.         Key[ 91] := 'DIVIDE';
  258.         Key[ 92] := 'DIVISION';
  259.         Key[ 93] := 'DOWN';
  260.         Key[ 94] := 'DUPLICATES';
  261.         Key[ 95] := 'DYNAMIC';
  262.  
  263.         Key[ 96] := 'EGI';
  264.         Key[ 97] := 'ELSE';
  265.         Key[ 98] := 'EMI';
  266.         Key[ 99] := 'EMPTY-CHECK';
  267.         Key[100] := 'ENABLE';
  268.         Key[101] := 'END';
  269.         Key[102] := 'END-OF-PAGE';
  270.         Key[103] := 'ENTER';
  271.         Key[104] := 'ENVIRONMENT';
  272.         Key[105] := 'EOP';
  273.         Key[106] := 'EQUAL';
  274.         Key[107] := 'ERASE';
  275.         Key[108] := 'ERROR';
  276.         Key[109] := 'ESCAPE';
  277.         Key[110] := 'ESI';
  278.         Key[111] := 'EVERY';
  279.         Key[112] := 'EXCEPTION';
  280.         Key[113] := 'EXHIBIT';
  281.         Key[114] := 'EXIT';
  282.         Key[115] := 'EXTEND';
  283.  
  284.         Key[116] := 'FD';
  285.         Key[117] := 'FILE';
  286.         Key[118] := 'FILE-CONTROL';
  287.         Key[119] := 'FILE-ID';
  288.         Key[120] := 'FILLER';
  289.         Key[121] := 'FINAL';
  290.         Key[122] := 'FIRST';
  291.         Key[123] := 'FOOTING';
  292.         Key[124] := 'FOR';
  293.         Key[125] := 'FOREGROUND-COLOR';
  294.         Key[126] := 'FROM';
  295.         Key[127] := 'FULL';
  296.  
  297.         Key[128] := 'GENERATE';
  298.         Key[129] := 'GIVING';
  299.         Key[130] := 'GO';
  300.         Key[131] := 'GREATER';
  301.         Key[132] := 'GROUP';
  302.  
  303.         Key[133] := 'HEADING';
  304.         Key[134] := 'HIGHLIGHT';
  305.         Key[135] := 'HIGH-VALUE';
  306.         Key[136] := 'HIGH-VALUES';
  307.  
  308.         Key[137] := 'I-O';
  309.         Key[138] := 'I-O-CONTROL';
  310.         Key[139] := 'IDENTIFICATION';
  311.         Key[140] := 'IF';
  312.         Key[141] := 'IN';
  313.         Key[142] := 'INDEX';
  314.         Key[143] := 'INDEXED';
  315.         Key[144] := 'INDICATE';
  316.         Key[145] := 'INITIAL';
  317.         Key[146] := 'INITIATE';
  318.         Key[147] := 'INPUT';
  319.         Key[148] := 'INPUT-OUTPUT';
  320.         Key[149] := 'INSPECT';
  321.         Key[150] := 'INSTALLATION';
  322.         Key[151] := 'INTO';
  323.         Key[152] := 'INVALID';
  324.         Key[153] := 'IS';
  325.  
  326.         Key[154] := 'JUST';
  327.         Key[155] := 'JUSTIFIED';
  328.  
  329.         Key[156] := 'KEY';
  330.  
  331.         Key[157] := 'LABEL';
  332.         Key[158] := 'LAST';
  333.         Key[159] := 'LEADING';
  334.         Key[160] := 'LEFT';
  335.         Key[161] := 'LEFT-JUSTIFY';
  336.         Key[162] := 'LENGTH';
  337.         Key[163] := 'LENGTH-CHECK';
  338.         Key[164] := 'LESS';
  339.         Key[165] := 'LIMIT';
  340.         Key[166] := 'LIMITS';
  341.         Key[167] := 'LIN';
  342.         Key[168] := 'LINAGE';
  343.         Key[169] := 'LINAGE-COUNTER';
  344.         Key[170] := 'LINE';
  345.         Key[171] := 'LINE-COUNTER';
  346.         Key[172] := 'LINES';
  347.         Key[173] := 'LINKAGE';
  348.         Key[174] := 'LOCK';
  349.         Key[175] := 'LOW-VALUE';
  350.         Key[176] := 'LOW-VALUES';
  351.  
  352.         Key[177] := 'MEMORY';
  353.         Key[178] := 'MERGE';
  354.         Key[179] := 'MESSAGE';
  355.         Key[180] := 'MODE';
  356.         Key[181] := 'MODULES';
  357.         Key[182] := 'MOVE';
  358.         Key[183] := 'MULTIPLE';
  359.         Key[184] := 'MULTIPLY';
  360.  
  361.         Key[185] := 'NAMES';
  362.         Key[186] := 'NATIVE';
  363.         Key[187] := 'NEGATIVE';
  364.         Key[188] := 'NEXT';
  365.         Key[189] := 'NO';
  366.         Key[190] := 'NO-ECHO';
  367.         Key[191] := 'NOT';
  368.         Key[192] := 'NUMBER';
  369.         Key[193] := 'NUMERIC';
  370.  
  371.         Key[194] := 'OBJECT-COMPUTER';
  372.         Key[195] := 'OCCURS';
  373.         Key[196] := 'OF';
  374.         Key[197] := 'OFF';
  375.         Key[198] := 'OMITTED';
  376.         Key[199] := 'ON';
  377.         Key[200] := 'OPEN';
  378.         Key[201] := 'OPTIONAL';
  379.         Key[202] := 'OR';
  380.         Key[203] := 'ORGANIZATION';
  381.         Key[204] := 'OUTPUT';
  382.         Key[205] := 'OVERFLOW';
  383.  
  384.         Key[206] := 'PAGE';
  385.         Key[207] := 'PAGE-COUNTER';
  386.         Key[208] := 'PERFORM';
  387.         Key[209] := 'PF';
  388.         Key[210] := 'PH';
  389.         Key[211] := 'PIC';
  390.         Key[212] := 'PICTURE';
  391.         Key[213] := 'PLUS';
  392.         Key[214] := 'POINTER';
  393.         Key[215] := 'POSITION';
  394.         Key[216] := 'POSITIVE';
  395.         Key[217] := 'PRINTER';
  396.         Key[218] := 'PROCEDURE';
  397.         Key[219] := 'PROCEDURES';
  398.         Key[220] := 'PROCEED';
  399.         Key[221] := 'PROGRAM';
  400.         Key[222] := 'PROGRAM-ID';
  401.         Key[223] := 'PROMPT';
  402.  
  403.         Key[224] := 'QUEUE';
  404.         Key[225] := 'QUOTE';
  405.  
  406.         Key[226] := 'RANDOM';
  407.         Key[227] := 'RD';
  408.         Key[228] := 'READ';
  409.         Key[229] := 'READY';
  410.         Key[230] := 'RECEIVE';
  411.         Key[231] := 'RECORD';
  412.         Key[232] := 'RECORDS';
  413.         Key[233] := 'REDEFINES';
  414.         Key[234] := 'REEL';
  415.         Key[235] := 'REFERENCES';
  416.         Key[236] := 'RELATIVE';
  417.         Key[237] := 'RELEASE';
  418.         Key[238] := 'REMAINDER';
  419.         Key[239] := 'REMOVAL';
  420.         Key[240] := 'RENAMES';
  421.         Key[241] := 'REPLACING';
  422.         Key[242] := 'REPORT';
  423.         Key[243] := 'REPORTS';
  424.         Key[244] := 'REPORTING';
  425.         Key[245] := 'REQUIRED';
  426.         Key[246] := 'RERUN';
  427.         Key[247] := 'RESERVE';
  428.         Key[248] := 'RESET';
  429.         Key[249] := 'RETURN';
  430.         Key[250] := 'REVERSE-VIDEO';
  431.         Key[251] := 'REVERSED';
  432.         Key[252] := 'REWIND';
  433.         Key[253] := 'REWRITE';
  434.         Key[254] := 'RF';
  435.         Key[255] := 'RH';
  436.         Key[256] := 'RIGHT';
  437.         Key[257] := 'RIGHT-JUSTIFY';
  438.         Key[258] := 'ROUNDED';
  439.         Key[259] := 'RUN';
  440.  
  441.         Key[260] := 'SAME';
  442.         Key[261] := 'SCREEN';
  443.         Key[262] := 'SD';
  444.         Key[263] := 'SEARCH';
  445.         Key[264] := 'SECTION';
  446.         Key[265] := 'SECURE';
  447.         Key[266] := 'SECURITY';
  448.         Key[267] := 'SEGMENT';
  449.         Key[268] := 'SEGMENT-LINE';
  450.         Key[269] := 'SELECT';
  451.         Key[270] := 'SEND';
  452.         Key[271] := 'SENTENCE';
  453.         Key[272] := 'SEPARATE';
  454.         Key[273] := 'SEQUENCE';
  455.         Key[274] := 'SEQUENTIAL';
  456.         Key[275] := 'SET';
  457.         Key[276] := 'SIGN';
  458.         Key[277] := 'SIZE';
  459.         Key[278] := 'SORT';
  460.         Key[279] := 'SORT-MERGE';
  461.         Key[280] := 'SOURCE';
  462.         Key[281] := 'SOURCE-COMPUTER';
  463.         Key[282] := 'SPACE';
  464.         Key[283] := 'SPACE-FILL';
  465.         Key[284] := 'SPACES';
  466.         Key[285] := 'SPECIAL-NAMES';
  467.         Key[286] := 'STANDARD';
  468.         Key[287] := 'STANDARD-1';
  469.         Key[288] := 'START';
  470.         Key[289] := 'STATUS';
  471.         Key[290] := 'STOP';
  472.         Key[291] := 'STRING';
  473.         Key[292] := 'SUB-QUEUE-1';
  474.         Key[293] := 'SUB-QUEUE-2';
  475.         Key[294] := 'SUB-QUEUE-3';
  476.         Key[295] := 'SUBTRACT';
  477.         Key[296] := 'SUM';
  478.         Key[297] := 'SUPPRESS';
  479.         Key[298] := 'SWITCH-1';
  480.         Key[299] := 'SWITCH-2';
  481.         Key[300] := 'SWITCH-3';
  482.         Key[301] := 'SWITCH-4';
  483.         Key[302] := 'SWITCH-5';
  484.         Key[303] := 'SWITCH-6';
  485.         Key[304] := 'SWITCH-7';
  486.         Key[305] := 'SWITCH-8';
  487.         Key[306] := 'SYMBOLIC';
  488.         Key[307] := 'SYNC';
  489.         Key[308] := 'SYNCHRONIZED';
  490.  
  491.         Key[309] := 'TABLE';
  492.         Key[310] := 'TALLYING';
  493.         Key[311] := 'TAPE';
  494.         Key[312] := 'TERMINAL';
  495.         Key[313] := 'TERMINATE';
  496.         Key[314] := 'TEXT';
  497.         Key[315] := 'THAN';
  498.         Key[316] := 'THROUGH';
  499.         Key[317] := 'THRU';
  500.         Key[318] := 'TIME';
  501.         Key[319] := 'TIMES';
  502.         Key[320] := 'TO';
  503.         Key[321] := 'TOP';
  504.         Key[322] := 'TRACE';
  505.         Key[323] := 'TRAILING';
  506.         Key[324] := 'TRAILING-SIGN';
  507.         Key[325] := 'TYPE';
  508.  
  509.         Key[326] := 'UNDERLINE';
  510.         Key[327] := 'UNIT';
  511.         Key[328] := 'UNSTRING';
  512.         Key[329] := 'UNTIL';
  513.         Key[330] := 'UP';
  514.         Key[331] := 'UPDATE';
  515.         Key[332] := 'UPON';
  516.         Key[333] := 'USAGE';
  517.         Key[334] := 'USE';
  518.         Key[335] := 'USER';
  519.         Key[336] := 'USING';
  520.  
  521.         Key[337] := 'VALUE';
  522.         Key[338] := 'VALUES';
  523.         Key[339] := 'VARYING';
  524.  
  525.         Key[340] := 'WHEN';
  526.         Key[341] := 'WITH';
  527.         Key[342] := 'WORDS';
  528.         Key[343] := 'WORKING-STORAGE';
  529.         Key[344] := 'WRITE';
  530.  
  531.         Key[345] := 'ZERO';
  532.         Key[346] := 'ZERO-FILL';
  533.         Key[347] := 'ZEROES';
  534.         Key[348] := 'ZEROS';
  535.  
  536.         (* Now GUARANTEE that this list is in proper search order! *)
  537.  
  538.         Heapsort;
  539.         end;
  540.     flag := TRUE;
  541.  
  542. end;  { SetKey }
  543.  
  544.  
  545.  
  546.  
  547. PROCEDURE PrintTree(tree: treepointer);
  548. {
  549. GLOBAL
  550.         MaxOnLine   = max line references per line
  551.         NumberWidth = field for each number
  552. }
  553. VAR
  554.   pageposition: pageindex;
  555.    PROCEDURE PrintEntry(subtree: treepointer;
  556.                         VAR position: pageindex);
  557.    VAR  ix: Wordindex;
  558.         itemcount : 0..Maxlinelen;
  559.         itemptr : Queuepointer;
  560.         PROCEDURE PrintLine(VAR Currentposition: pageindex;
  561.                                 newlines: pageindex);
  562.         VAR
  563.           linecounter: pageindex;
  564.         BEGIN
  565.           IF (Currentposition + newlines) < MaxOnPage THEN
  566.             BEGIN
  567.                 FOR linecounter:=1 TO newlines DO WRITELN(XOUT);
  568.                 Currentposition := Currentposition + newlines;
  569.             END
  570.           ELSE
  571.             BEGIN
  572.               PAGE(XOUT);
  573.               WRITELN(XOUT,xrefver,': ',FILE_ID,' ',heading);
  574.               FOR linecounter := 1 TO headingsize - 1 DO
  575.                  WRITELN(XOUT);
  576.               Currentposition := headingsize + 1;
  577.             END
  578.         END;{PrintLine}
  579.  
  580.    BEGIN{PrintEntry}
  581.      IF subtree<>nil THEN
  582.         WITH subtree^ DO BEGIN
  583.           PrintEntry(left,position);
  584.           PrintLine(position,entrygap + 1);
  585.           WITH entry DO BEGIN
  586.             FOR ix := 1 to length(WordValue) do WRITE(XOUT, WordValue[ix]);
  587.             WRITE(XOUT, space:(MaxWordLen-length(WordValue)));
  588.             itemcount := 0;
  589.             itemptr := FirstInQueue;
  590.             WHILE itemptr <> nil DO
  591.               BEGIN
  592.                 itemcount := itemcount + 1;
  593.                 IF itemcount > MaxOnLine THEN
  594.                   BEGIN
  595.                     PrintLine(position,1);
  596.                     WRITE(XOUT, space:MaxWordlen);
  597.                     itemcount := 1;
  598.                   END;
  599.                 WRITE(XOUT, itemptr^.linenumber: numberwidth);
  600.                 itemptr := itemptr^.NextInQueue;
  601.               END;{WHILE}
  602.           END; {WITH entry}
  603.           PrintEntry(right,position);
  604.         END; {WITH subtree^}
  605.    END; {PrintEntry}
  606.  
  607.  
  608. BEGIN{PrintTree}
  609.   PagePosition := MaxOnPage;
  610.   PrintEntry(tree,PagePosition);
  611. END; {of PrintTree}{CLOSE(New_ID);}
  612.  
  613.  
  614.  
  615.  
  616.  
  617.  
  618.  
  619. FUNCTION ConnectFiles: boolean;
  620. TYPE
  621.   Linebuffer = string[80];
  622. VAR
  623.   ix  : BYTE;
  624.   InChar    : Char;
  625.   DotPos    : Integer;
  626.  
  627.  
  628.  Procedure GetNames;
  629.   Begin
  630.    if ParamCount > 0 then FILE_ID := UseFile
  631.    else begin
  632.       WRITELN('Enter pathname (.COB, .PRN, and .XRF are appended as required)') ;
  633.       WRITELN ;
  634.       WRITE('Input File (RETURN to quit): ');
  635.       READLN(FILE_ID);
  636.       end;
  637.  
  638.    DotPos := Length(File_ID);            { Use an available variable }
  639.    If DotPos = 0 THEN HALT;              { for a quick Sanity check  }
  640.  
  641.    DotPos := Pos( '.', File_ID );
  642.    If DotPos = 0 THEN                    { If NO extension (.) }
  643.      Begin
  644.       File_ID := ( File_ID + '.COB' );
  645.       DotPos  := Pos( '.', File_ID )
  646.      End;
  647.  
  648.    Prn_ID := Copy (File_ID, 1, DotPos) ; { Get base filename with dot }
  649.    Prn_ID := ( Prn_ID + 'PRN' );         { and add the proper extension }
  650.    New_ID := Copy (File_ID, 1, DotPos) ;
  651.    New_ID := ( New_ID + 'XRF' );
  652.  
  653.    if ParamCount = 0 then begin
  654.       Writeln;
  655.       Writeln (' Input is from : ',File_Id);
  656.       Writeln (' Print Out to  : ',Prn_Id);
  657.       Writeln (' Cross Ref to  : ',New_Id);
  658.       Writeln;
  659.       Write (' Is this acceptable (Y/N)?  <Y>:');
  660.       Read (Kbd,InChar);
  661.       Writeln;
  662.       If NOT ((InChar=^M) OR (UpCase(InChar)='Y')) THEN
  663.         Begin
  664.           Writeln ('--- Supply complete filenames ---');
  665.           WRITE('Printed output to: ');
  666.           READLN(PRN_ID);
  667.           WRITELN;
  668.           WRITE('Cross-Reference output to: ');
  669.           READLN(NEW_ID);
  670.           WRITELN;
  671.         End;
  672.       end
  673.    End;   { GetNames }
  674.  
  675.  
  676.  
  677. BEGIN     { ConnectFiles *** execution starts here *** }
  678.    File_ID := '';
  679.    fatal_error := FALSE;
  680.    ConnectFiles := TRUE;
  681.    GetNames;
  682.  
  683.    Assign(fout,FILE_ID);  (* PUH-LEEZE test to make sure the source exists! *)
  684.    Reset(fout);
  685.    if IOresult <> 0 then begin
  686.       writeln('error: ',FILE_ID,' not found');
  687.       fatal_error  := TRUE;
  688.       ConnectFiles := FALSE;
  689.       end
  690.    else begin
  691.  
  692.    close(fout);
  693.    Assign(fout,PRN_ID);
  694.    Rewrite(FOUT);
  695.    if IOresult <> 0 then begin
  696.       writeln('error: could not open ',PRN_ID);
  697.       ConnectFiles := FALSE;
  698.       fatal_error  := TRUE;
  699.       end;
  700.   assign(xout,NEW_ID);
  701.   Rewrite(Xout) ;
  702.   if IOresult <> 0 then begin
  703.      writeln('error: could not open ',NEW_ID);
  704.      ConnectFiles := FALSE;
  705.      fatal_error := TRUE;
  706.      end;
  707.  
  708.   end
  709. END{ of ConnectFiles };
  710.  
  711.  
  712.  
  713.  
  714.  
  715.  
  716. PROCEDURE Initialize;
  717. VAR
  718.   Ch: CHAR;
  719. BEGIN
  720.   bell := ^G; GAP := ' ' ;
  721.   Currentline := 0;
  722.   IF ConnectFiles THEN
  723.     BEGIN
  724.         tab       := CHR(9);  { ASCII Tab character }
  725.         form_feed := CHR(12);
  726.         gap       := CHR(32);
  727.         if ParamCount = 0 then begin
  728.            WRITE('List file to console (Y/N)? <Y>:');
  729.            READ(kbd,Ch);
  730.            LISTING := (Ch=^M) or (Upcase(Ch)='Y');
  731.            WRITELN; WRITELN;
  732.            end
  733.         else LISTING := TRUE;
  734.     END; {IF ConnectFiles}
  735. END; {of Initialize}
  736.  
  737.  
  738.  
  739. procedure helpmsg;
  740. begin
  741.              writeln;
  742.              writeln(xrefver,', ',datever);
  743.              writeln;
  744.              writeln('usage: XREF [ ? ][ ! ][ pathname[.typ] ... ]');
  745.              writeln;
  746.              writeln('       ignores reserved words and IBM-PC COBOL 1.0 extensions');
  747.              writeln('       ignores comment lines');
  748.              writeln('       default is .COB file type');
  749.              writeln('       creates pathname.PRN, pathname.XRF');
  750.              writeln('       accepts multiple files, but cannot use wildcards');
  751.              writeln;
  752.              writeln('e.g.,  XREF c:\cobol\filectrl.cpy');
  753.              writeln('       XREF ptosub1 ptosub2 ptosub3 ptomain');
  754.              writeln('       XREF      <- begin interactive');
  755.              writeln('       XREF !    <- list reserved words');
  756.              writeln('       XREF ?    <- display help message');
  757. end;
  758.  
  759.  
  760. Procedure Doit;
  761. begin
  762.  
  763.   SetKey;
  764.  
  765.   clrscr;
  766.   lowvideo;
  767.   if ParamCount = 0 then begin
  768.      helpmsg;
  769.      writeln;writeln;
  770.      writeln('Cross Reference Generator for COBOL Source Files');
  771.      writeln;
  772.      end;
  773.  
  774.   Initialize;
  775.   IF NOT fatal_error THEN
  776.     BEGIN
  777.       if ParamCount > 0 then begin
  778.          writeln( xrefver,': ',FILE_ID )
  779.          end;
  780.  
  781.       WordTree := NIL;          {Make the Tree empty}
  782.       writeln('Pass 1 [Listing] Begins ...');
  783.       BuildTree(WordTree, FILE_ID);
  784.       close(FOUT) ;
  785.       writeln('Pass 2 [Cross-Ref] Begins ...');
  786.       PrintTree(WordTree);
  787.       writeln('Pass 2 [Cross-Ref] Complete..');
  788.       writeln(XOUT);
  789.       close(XOUT);
  790.       writeln;
  791.     END
  792.  
  793. end;  { Doit }
  794.  
  795.  
  796.  
  797. Procedure ProcessArguments;
  798. label errxit;
  799. var i: Integer; ch:Char;
  800. begin
  801.   if ParamCount = 0 then Doit
  802.   else begin
  803.      for i := 1 to ParamCount do begin
  804.          UseFile := ParamSTR(i);
  805.          if UseFile = '?' then begin
  806.      errxit: helpmsg;
  807.              Halt;
  808.              end
  809.          else if UseFile = '!' then begin
  810.              SetKey;
  811.              clrscr;
  812.              writeln(xrefver,':  Reserved Words & IBM-PC Extensions'); writeln;
  813.              for i := 1 to NumKeys do begin
  814.                  writeln( i:3,'. ',Key[i] );
  815.                  if (i mod 22) = 0 then begin
  816.                     write('-more-');
  817.                     read(kbd,ch);
  818.                     write(^M,' ':6,^M);
  819.                     if ch = ^C then halt;
  820.                     end
  821.                  end;
  822.              write('-any key-');
  823.              read(kbd,ch);
  824.              write(^M,' ':9,^M);
  825.              goto errxit;
  826.              end
  827.          else if (Pos('*',UseFile) > 0) or (Pos('?',UseFile) > 0) then begin
  828.              writeln(xrefver,': error: can''t do wildcards');
  829.              goto errxit
  830.              end
  831.          else begin
  832.              Doit;
  833.              if fatal_error then goto errxit
  834.              end
  835.          end
  836.      end
  837. end;  { ProcessArguments }
  838.  
  839.  
  840.  
  841.  
  842. (* main is here *)
  843.  
  844. BEGIN
  845.    ProcessArguments;
  846. END.
  847.  
  848.