Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/TURBOPR2.ZIP/TURBOPR2.PAS

Pascal/Delphi Source File | 1985-11-06 | 31.8 KB | 876 lines

program TurboPr2;
(*                                                                          *)
(*  THIS PROGRAM is intended to print listings of Turbo Pascal programs.    *)
(*  It was developed using Turbo Pascal version 3.0.                        *)
(*  It shows LINE NUMBERS which match the record numbers in the source      *)
(*    program so notes made on the listing can be moved to the code easily. *)
(*  It shows the nesting level of BEGIN/END and CASE/END pairs.             *)
(*  It will print a CROSS REFERENCE list after the program list if desired. *)
(*  It will list INCLUDED FILES if desired.                                 *)
(*  It provides print controlling PSEUDO-OPS to start and stop printing and *)
(*    to eject a page.                                                      *)
(*  It provides some support for the Hewlett-Packard LaserJet printer.      *)
(*                                                                          *)
(*  Rewritten by :  Don Mackenzie            11/6/85                        *)
(*                  11065 La Paloma Dr.                                     *)
(*                  Cupertino, CA  95014                                    *)
(*                                                                          *)
(*  with considerable help from others who came before:                     *)
(*    This is based on program named PLIST originally written by Rick       *)
(*    Shaeffer, E. 13611 26th Av, Spokane, Wa.  99216.                      *)
(*    That program was modified by Len Whitten, CIS: [73545,1006] on 7/8/84.*)
(*    Rick Schaeffer again made changes on 7/12/84.                         *)
(*    On 8/28/84, Jay Kadashaw added several features.                      *)
(*    Michael Roberts, [CIS 74226,3045], 3103 Glenview, Royal Oak, MI 48073 *)
(*    added the Cross Referencing facility on 10/30/84.                     *)
(*    The code in WhenCreated was written by Steve Griffen, dated 4/22/85,  *)
(*    and was moved here from another version of the same root program.     *)
(*                                                                          *)
(*  I have removed most of their notes because later changes have undone    *)
(*  some of what earlier contributors did, and it seemed time for a cleanup.*)
(*  All of the earlier notes are in the file TURBOPR2.DOC.                  *)
(*                                                                          *)
(*  EXECUTING THE PROGRAM:                                                  *)
(*    The program prints only one program per execution.  The file to print *)
(*    and the parameters must be specified on the command line (or Option   *)
(*    Parameters within Turbo Pascal).                                      *)
(*        TURBOPR2 [d:][path]filename[.ext] [C] [P] [HP] [NI] [I] [X] [NX]  *)
(*      If [.ext] is omitted, .PAS is assumed.                              *)
(*      Parameters after the filename may be specified in any order.        *)
(*      C  ( default ) specifies output on the Console.                     *)
(*      P  specifies output on a 'normal' printer.                          *)
(*      HP specifies output on a Hewlett Packard LaserJet printer.          *)
(*      NI ( default ) specifies Included files are not to be listed.       *)
(*      I  specifies Included files are to be listed.                       *)
(*      X  ( default ) specifies a Cross-Reference listing is to be shown.  *)
(*      NX specifies the Cross-Reference listing is to be skipped.          *)
(*                                                                          *)
(*    Three pseudo-ops are recognized.  Each must be on a line by itself    *)
(*    and must begin in column 1.  They will be recognized even if embedded *)
(*    in a comment field.  Upper or lower case is the same.                 *)
(*      {.L-}   Causes that line and following lines to not be printed.     *)
(*              All other functions, such as cross-referencing and          *)
(*              begin/end counting do continue.                             *)
(*      {.L+}   Restarts the printing of lines.                             *)
(*      {.PAGE} Causes that line to be printed at the top of a new page.    *)
(*                                                                          *)
(*    The file TURBOPAS.RES must be in the current directory when the       *)
(*    program is run.  This file contains the Turbo 3.0 reserved words.     *)
(*                                                                          *)
(*                                                                          *)
(*  NOTES:                                                                  *)
(*    Finding the File Creation Date:                                       *)
(*         The routine WhenCreated may have problems under DOS 3.x if the   *)
(*         codes for successful completion of the requested operations      *)
(*         have been changed.  This has not been tested.                    *)
(*    LaserJet support:                                                     *)
(*         When HP is selected, printing is attempted with Line Printer     *)
(*         font in Portrait mode at 8 lines per inch with a 10 column       *)
(*         left margin.  This may be changed using constants HPMaxLine      *)
(*         and HPSetupStr.                                                  *)
(*    Normal Printer support:                                               *)
(*         If you want to send special characters for font selection, etc., *)
(*         change constants NormMaxLine, NormSetupStr, and NormEndStr.      *)
(*                                                                          *)
(*                                                                          *)
{.page}

  const
       { to customize code for your printer - adjust the next items }

    NormMaxLine   = 60;  { Used for Console and Normal Printer }
    HPMaxLine     = 78;  { Used for HP LaserJet Printer        }

    HPSetupStr    = #27'E'#27'(s16H'#27'&l8D'#27'&a10L';
    NormSetupStr  = '';

    HPEndStr      = #27'E';
    NormEndStr    = #12;    { Form Feed }

    cr = #13;
    lf = #10;
    ff = #12;

  type

    HeadingType = ( Normal, Include, Xref );

    OutputType = (C,P,HP);  {Output Types are Console        }
                            {                 Normal Printer }
                            {                 HP LaserJet    }


      { Following are used for the Cross Reference Listing system }
    ResWordPtr = ^ResWordRec;
    ResWordRec = Record
                ResWord: String[20];
                Next   : ResWordPtr;
                end;
    XrefWordptr = ^XrefwordRec;
    XrefNumPtr  = ^XrefNumRec;
    XrefWordRec = Record
                 XrefWord: string[20];
                 FirstXrefNum: XrefNumPtr;
                 LastXrefNum : XrefNumPtr;
                 NextXrefWord: XrefwordPtr;
                 end;
    XrefNumRec  = record
                 XrefNum : Integer;
                 NextXrefNum:XrefNumPtr;
                 end;


    Str2   = string[  2];
    Str8   = string[  8];
    Str20  = string[ 20];
    Str76  = string[ 76];   { maximum file name }
    Str80  = string[ 80];
    Str127 = string[127];   { maximum length of input line }
    Str135 = string[135];   { input line with extra room }
    Str255 = string[255];   { max length string for use as a parameter }
    regpack = record
      ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
    end;
{.page}

  var
    MaxLine   : integer;    { Maximum lines allowed on a page. }
    Buff1     : Str127;          {input line buffer}
    Buff2     : Str135;           {working line buffer}

    FirstResWord, LastResWord, NewResWord, SrchResWord: ResWordPtr;
    FirstxRefWord, NewxRefWord, PrevXrefWord, SrchxRefWord: XRefWordPtr;
    NewXRefnum, SrchXRefNum: XRefNumPtr;
    XrefWord  : string[20];
    XrefNum   : Integer;

    ListFile    : text;              {FIB for LST: or CON: output}
    MainFile    : text;              {FIB for Main input file}
    InclFile    : text;              {FIB for Include input file}

    MainFileDate  : Str8;
    MainFileTime  : Str8;

    InclFileDate  : Str8;
    InclFileTime  : Str8;

    InclFileName   : Str76;         {Filename of Included file }

       { Following are parameters set in Command Line }
    MainFileName   : Str76;         {input file name}
    OutputDevice   : OutputType;    {Output file type indicator}
    PrintXref      : boolean;       {Print/Don't Print Xref      }
    ExpandIncludes : boolean;       {Expand/Don't Includes       }

    bcount    : integer;           {begin/end counter}
    kcount    : integer;           {comment counter}
    linect    : integer;           {output file line counter}
    pageno    : integer;           {output page counter}
    Print         : boolean;           (*  turned on/off by {.L+},{.L-}   *)
    ForceHead     : boolean;     { Print a Header, irrespective of line count }
    IncludeActive : boolean;    { true if printing an Included file }

    MainLineCnt  : integer;  { Count of Main File input lines }
    InclLineCnt  : integer;  { Count of Incl File input lines }
{.page}

  function UpCaseStr( StrX : Str255 ) : Str255;
    { Converts StrX to all Upper Case. }
    var
      I : integer;
    begin
      UpCaseStr[0] := StrX[0];
      for I := 1 to length(StrX) do
        UpCaseStr[I] := UpCase(StrX[I]);
    end;

  procedure FillBlanks (var line: Str8);
    var
      i : integer;
    begin
      for i:= 1 to 8 do
        if line[i] = ' ' then
          line[i]:= '0';
    end;  {FillBlanks}

  function SysDate : Str8;
    var
      AllRegs : RegPack;
      Month   : Str2;
      Day     : Str2;
      Year    : Str2;
      Date    : Str8;
    begin
      AllRegs.ax := $2A * 256;
      MsDos(AllRegs);
      with AllRegs do
      begin
        str((dx div 256):2,Month);
        str((dx mod 256):2,Day);
        str((cx -  1900):2,Year);
      end;
      Date := Month + '/' + Day + '/' + Year;
      FillBlanks (Date);
      SysDate := Date;
    end;  {GetDate}

  function SysTime : Str8;
    var
      AllRegs : RegPack;
      Hour    : Str2;
      Minute  : Str2;
      Second  : Str2;
      Time    : Str8;
    begin
      allregs.ax := $2C * 256;
      MsDos(allregs);
      with AllRegs do
      begin
        str((cx div 256):2,Hour);
        str((cx mod 256):2,Minute);
        str((dx div 256):2,Second);
      end;
      Time := Hour + ':' + Minute + ':' + Second;
      FillBlanks (Time);
      SysTime := Time;
    end;  {GetTime}
{.page}
  function RsrvWordListOk : boolean;
    var
      RsrvFile    : text;              {FIB for reserved word file}
      ResWord     : string[20];
    begin
      assign(RsrvFile,'TURBOPAS.RES');
      {$I-}
      reset(RsrvFile);
      {$I+}
      if IOResult = 0 then
      begin
        FirstResWord := nil;
        while not eof(RsrvFile) do
        begin
          readln(RsrvFile,ResWord);
          if length(ResWord) <> 0 then
          begin
            New(NewResWord);
            NewResWord^.ResWord := Resword;
            if FirstResWord = nil then
              FirstResWord := NewResWord
            else
              LastResWord^.next := NewResWord;
            LastResWord := NewResWord;
            LastResWord^.Next := Nil;
          end;
        end;
        Close(RsrvFile);
        RsrvWordListOk := true;
      end
      else
      begin
        writeln(' Reserved Word List File TURBOPAS.RES Not Found. ');
        RsrvWordListOk := false;
      end;
    end;   { RsrvWordListOk }

  function MainFileOk : boolean;
    begin
      assign( MainFile, MainFileName);
      {$I-}
      reset( MainFile );                {check for existence of file}
      {$I+}
      if IOResult = 0 then
        MainFileOk := true
      else
      begin
        writeln;
        writeln('Input File ', MainFileName, ' DOESN''T EXIST');
        MainFileOk := false
      end;
    end; {MainFileOk}

  function InclFileOk : boolean;
    begin
      assign( InclFile, InclFileName);
      {$I-}
      reset( InclFile );                {check for existence of file}
      {$I+}
      if IOResult = 0 then
        InclFileOk := true
      else
        InclFileOk := false;
    end; {InclFileOk}

  Procedure SetUpListFile;
    begin
      case OutputDevice of
         C: begin
              assign(ListFile,'CON:');
              reset(ListFile);
            end;
         P: begin
              assign(ListFile,'LST:');
              reset(ListFile);
              write(ListFile,NormSetupStr);
            end;
        HP: begin
              assign(ListFile,'LST:');
              reset(ListFile);
              write(ListFile,HPSetupStr);
            end;
      end;
    end;  {SetUpListFile}

  procedure ParseCommandLine;
    var
      Parameter : Str2;
      I         : integer;
    begin
      MainFileName := '';            { Set Defaults Inputs }
      ExpandIncludes := false;
      PrintXref := true;
      OutputDevice := C;

      if ParamCount >= 1 then
      begin
        MainFileName := ParamStr(1);
        MainFileName := UpCaseStr(MainFileName);
        if Pos('.',MainFileName) = 0 then
          MainFileName := MainFileName + '.PAS';
      end;
      for I := 2 to ParamCount do
      begin
        Parameter := ParamStr(I);
        Parameter := UpCaseStr(Parameter);
        if      Parameter = 'I'  then ExpandIncludes := true
        else if Parameter = 'NI' then ExpandIncludes := false
        else if Parameter = 'X'  then PrintXref := true
        else if Parameter = 'NX' then PrintXref := false
        else if Parameter = 'HP' then OutputDevice := HP
        else if Parameter = 'P'  then OutputDevice := P
        else if Parameter = 'C'  then OutputDevice := C;
      end;
      if OutputDevice = HP then
      begin
        MaxLine := HPMaxLine;
      end
      else
      begin
        MaxLine := NormMaxLine;
      end
    end;   { ParseCommandLine }

{.page}
  procedure WhenCreated (var date, time: Str8; filename: Str76);

    const
      MonthMask  = $000F;
      DayMask    = $001F;
      MinuteMask = $003F;
      SecondMask = $001F;

    type
      FilRec = Record                          (* DTA layout        *)
        file_ForD   : array[1..21]of byte;    (* reserved for DOS  *)
        file_Attr   : byte;                   (* file attribute    *)
        file_Time   : integer;                (* file time         *)
        file_Date   : integer;                (* file date         *)
        file_Size   : array[1..4] of byte;    (* file size         *)
        file_Name   : array[1..13] of Char;   (* file name         *)
        file_Fill   : array[1..85] of byte;   (* filler - ?????    *)
      end;
    var
      AllRegs : RegPack;
      fulltime,fulldate,DTAds,DTAdx: integer;
      FileFCB    : FilRec;
      filesearch : Str76;
      Year       : Str2;
      Month      : Str2;
      Day        : Str2;
      Hour       : Str2;
      Minute     : Str2;
      Second     : Str2;
    begin         (* Get file date and time through DOS calls       *)
                  (* to make program independent of Turbo versions. *)

                  (* Get current DTA and save location              *)
      allregs.ax := $2F00;
      Intr($21,allregs);
      DTAds := allregs.es;
      DTAdx := allregs.bx;

                  (* Set up DTA to recieve FCB of file.             *)
      allregs.ax := $1A00;
      allregs.dx := ofs(filefcb);
      allregs.ds := seg(filefcb);
      Intr($21,allregs);

                  (* Search for file to print.                      *)
      allregs.ax := $4E00;
      allregs.cx := $37;
      filesearch := filename + chr(0);
      allregs.dx := ofs(filesearch) + 1;
      allregs.ds := Seg(filesearch);
      Intr($21,allregs);
      if Lo(allregs.ax) <> 0 then    (* Note that PCDOS 3.x uses a    *)
                                  (* different flag for successful *)
                                  (* file search, I believe.       *)
      begin
        writeln('          File ',filename,' not found.');
        if Lo(allregs.ax) = 2 Then
          Writeln('          Drive not ready.');
        if Lo(allregs.ax) = 18 Then
          Writeln('Program Error -- No file by that name');
        HALT;
      End;

             (* Restore DTA to previous location.               *)
      allregs.ax := $1A00;
      allregs.dx := DTAdx;
      allregs.ds := DTAds;
      Intr($21,allregs);

       {fulldate  corresponds to bytes 20-21
        of the FCB.                 Format is: bits 0 - 4: day of month
                                                    5 - 8: month of year
                                                    9 -15: year - 1980     }

      with filefcb do
        fulldate := file_Date;
      str(((fulldate shr 9) + 80):2,year);
      str(((fulldate shr 5) and monthmask):2,month);
      str((fulldate and daymask):2,day);
      date:= month + '/' + day + '/' + year;
      FillBlanks(date);

        {fulltime  corresponds to bytes 22-23
         of the FCB.                     Format is: bits 0 - 4: seconds/2
                                                         5 -10: minutes
                                                         11-15: hours         }

      with filefcb do
        fulltime := file_Time;
      str((fulltime shr 11):2,hour);
      str(((fulltime shr 5) and minutemask):2,minute);
      str(((fulltime and secondmask) * 2):2,second);
      time:= hour + ':' + minute + ':' + second;
      FillBlanks (time);
    end;  {WhenCreated}
{.page}

  procedure PrintHeading( Head : HeadingType);
    { Checks conditions and prints a page heading if appropriate.   }
    const
      Space24 = '                          ';
    var
      PrintFileName : string[24];
    begin
      if print and (ForceHead or (LineCt > MaxLine) )then
      begin
        pageno := pageno + 1;
        if LineCt > 0 then
          write(ListFile, ff);  {top of form}
        write(ListFile,'     TURBO Pascal Program Lister');
        writeln(ListFile,' ':8,'Printed: ',sysdate,'  ',
                            systime,'   Page ',pageno:4);
        if Head = Include then
          if length(InclFileName) > 20 then
            PrintFileName := copy(InclFileName,length(InclFileName)-19,20)
          else
            PrintFileName := InclFileName
                            + copy(Space24,1,20-length(InclFileName))
        else
          if length(MainFileName) > 23 then
            PrintFileName := copy(MainFileName,length(MainFileName)-22,23)
          else
            PrintFileName := MainFileName
                            + copy(Space24,1,23-length(MainFileName));

        if Head = Include then
        begin
          writeln(ListFile,'     Include File: ',PrintFileName,
                 ' Created: ',InclFileDate,'  ',InclFileTime);
        end
        else  { Main or Xref type heading }
        begin
          writeln(ListFile,'     Main File: ',PrintFileName,
                ' Created: ',MainFileDate,'  ',MainFileTime);
        end;
        writeln(ListFile);
        if Head = Xref then
          writeln(ListFile,' ':32,'CROSS-REFERENCE')
        else  { Main or Include type heading }
          writeln(ListFile,'      B');
        writeln(ListFile);
        linect := 6;
      end; {check for print}
      ForceHead := false;
    end;  {PrintHeading}

{.page}
  Procedure BuildXref( Word:Str20; LineNo:integer );
    Begin
      if ((FirstXrefWord = nil) or (FirstXrefWord^.XrefWord > word)) then
      begin              { Add Word at beginning of list }
        new(newxrefword);
        NewXrefWord^.NextXrefWord := FirstXrefWord;
        FirstXrefWord := NewXrefWord;
        FirstXrefWord^.XrefWord := word;
        new(NewXrefNum);
        FirstXrefWord^.FirstXrefNum := NewXrefNum;
        FirstXrefWord^.LastXrefNum := NewXrefNum;
        NewXrefNum^.NextXrefNum := nil;
        NewXrefNum^.XrefNum := lineno;
      end
      else
      begin              { Add reference to first word in list }
        If firstXrefWord^.xrefword = word then
        begin
          New(NewXrefNum);
          FirstXrefWord^.LastXrefNum^.NextXrefNum := NewXrefNum;
          FirstXrefWord^.LastXrefNum := NewXrefnum;
          NewXrefNum^.NextXrefNum := Nil;
          NewXrefNum^.XrefNum := lineno;
        end
        else
        Begin          { Look for Word in list }
          SrchXrefWord := FirstXrefword^.NextXrefWord;
          PrevXrefWord := FirstXrefWord;
          While ((SrchXrefWord <> Nil) and
                (SrchXrefWord^.XrefWord < Word)) do
          begin
            PrevXrefWord := SrchXrefWord;
            SrchXrefWord := SrchXrefWord^.NextXrefWord;
          end;
          If ((SrchXrefWord = nil) and
             (PrevXrefWord^.XrefWord < word)) then
          Begin      { Add Word at end of list }
            new(newxrefword);
            NewXrefWord^.NextXrefWord := Nil;
            PrevXrefWord^.NextXrefWord := NewXrefWord;
            NewXrefWord^.XrefWord := word;
            new(NewXrefNum);
            NewXrefWord^.FirstXrefNum := NewXrefNum;
            NewXrefWord^.LastXrefNum := NewXrefNum;
            NewXrefNum^.NextXrefNum := nil;
            NewXrefNum^.XrefNum := lineno;
          end
          else
            if SrchXrefWord^.XrefWord > Word Then
            Begin    { Add Word in middle of list }
              new(newxrefword);
              NewXrefWord^.NextXrefWord := SrchXrefWord;
              PrevXrefWord^.NextXrefWord := NewXrefWord;
              NewXrefWord^.XrefWord := word;
              NewXrefWord^.LastXrefNum := Nil;
              new(NewXrefNum);
              NewXrefWord^.FirstXrefNum := NewXrefNum;
              NewXrefWord^.LastXrefNum := NewXrefNum;
              NewXrefNum^.NextXrefNum := nil;
              NewXrefNum^.XrefNum := lineno;
            end
            else
            begin    { Add reference to an existing word }
              New(NewXrefNum);
              SrchXrefWord^.LastXrefNum^.NextXrefNum := NewXrefNum;
              SrchXrefWord^.LastXrefNum := NewXrefnum;
              NewXrefNum^.NextXrefNum := Nil;
              NewXrefNum^.XrefNum := lineno;
            end
        end;
      end;
    end;   { BuildXref }

  function ReservedWord(var kword: Str20) : boolean;
    Begin
      SrchResWord := firstresword;
      while ((kword > srchresword^.resword) and (srchresword <> nil)) do
        srchresword := srchresword^.next;
      if srchresword = nil then
        ReservedWord := FALSE
      else
        if kword = srchresword^.resword then
          ReservedWord := true
        else
          ReservedWord := false;
    end;   { ReservedWord }
{.page}

  procedure CheckIncludes;
    var
      i : integer;
    begin
      InclFileName := '';
      if copy(Buff2, 1, 3) = '{$I' then
      begin
        i := 4;
        while (Buff2[i] = ' ') and (i <= length(Buff2)) do
          i := i + 1;
        while (length(InclFileName) < 76)
        and   (I <= length(Buff2))
        and   not (Buff2[I] in [' ','}','+','-']) do
        begin
          InclFileName := InclFileName + UpCase(Buff2[i]);
          i := i + 1;
        end;
      end;
      if InclFileName <> '' then
      begin
        if pos('.',InclFileName) = 0 then
          InclFileName := InclFileName + '.PAS';
        IncludeActive := true;
      end;
    end;  {CheckIncludes}

{.page}
  Procedure ScanLine;
    { SCAN_LINE procedure scans one line of Turbo Pascal source code
      looking for BEGIN/END pairs, CASE/END pairs, LITERAL fields
      and COMMENT fields.  BCOUNT is begin/end and case/end counter.
      KCOUNT is comment counter.  Begin/case/ends are only valid
      outside of comment fields and literal constant fields (KCOUNT = 0
      and NOT LITERAL).
      Some of the code in the SCAN_LINE procedure appears at first glance
      to be repitive and/or redundant, but was added to speed up the
      process of scanning each line of source code.}

    var
      Literal    : boolean;          { true if in literal field}
      tmp        : string[7];        { tmp work area }
      i          : integer;          {loop variable index}
      IncFlName  : Str76;            {local include file name}
      WordSwitch : boolean;       {if assembling an identifier}
      WordCheck  : Str20;         {Identifier being assembled}
    begin  { ScanLine }
      Literal := false;
      WordSwitch := false;
      buff2[0] := buff1[0];  {copy input buffer to working buffer}
      for i := 1 to length(buff1) do
        buff2[i] := upcase(buff1[i]);  {and translate to upper case}

      if ExpandIncludes and not IncludeActive then
        CheckIncludes;

      if copy(buff2,1,5) = '{.L-}' then
        print := false;

      if copy(buff2,1,5) = '{.L+}' then
        print := true;

      if copy(buff2,1,7) = '{.PAGE}' then
        ForceHead := true;


      buff2 := concat('  ', buff2, '      ');  {add on some working space}
      for i := 1 to length(buff2) - 6 do
      begin
        tmp := copy(buff2, i, 7);
        if not literal then   {possible to find comment delim}
        begin
          {determine if comment area delim}
          if tmp[1] in ['{', '}', '(', '*'] then
          begin
            if (tmp[1] = '{') or (copy(tmp,1,2)='(*') then
              kcount := succ(kcount);  {count comment opens}
            if (tmp[1] = '}') or (copy(tmp,1,2)='*)') then
              kcount := pred(kcount);  {un-count comment closes}
          end;
        end;

        if kcount = 0 then  {we aren't in a comment area}
        begin
          if tmp[1] = chr(39) then
            Literal := not Literal;   {toggle literal flag}
          if PrintXref and not Literal then
          begin
            if ((not WordSwitch) and
               (buff2[i] in ['A'..'Z','a'..'z'])) then
            Begin
              WordSwitch := true;
              WordCheck := '';
            end;
            if WordSwitch then
              if (buff2[i] in ['A'..'Z','a'..'z','0'..'9','_']) then
                WordCheck := WordCheck + upcase(Buff2[i])
              else
              begin
                WordSwitch := false;
                if not ReservedWord(WordCheck) then
                  if IncludeActive then
                    BuildXref(WordCheck,InclLineCnt)
                  else
                    BuildXref(WordCheck,MainLineCnt);
              end;
          end; { PrintXref and not Literal }
          if not literal and (tmp[2] in ['B','C','E']) then
          begin
            if (tmp = ' BEGIN ') or (copy(tmp,1,6) = ' CASE ') then
            begin
              bcount := succ(bcount);  {count BEGIN}
              i := i + 5;              {skip rest of begin}
            end;
            if (copy(tmp,1,4) = ' END') and
               (tmp[5] in ['.', ' ', ';']) and
               (bcount > 0) then
             begin
               bcount := pred(bcount);   {un-count for END}
               i := i + 4;
             end;
          end;  { if not literal and B, C or E }
        end;  { if kcount = 0 }
      end;  { for i := }
    end;  {ScanLine}
{.page}

  procedure ListInclFile;
    const
      Space8 = '        ';
    begin  { ListInclFile }
      InclFileDate := Space8;
      InclFileTime := Space8;
      if LineCt + 4 > MaxLine then   { be sure at least some of the  }
        ForceHead := true;           { included file is on same page }
      PrintHeading(Include);
      writeln(ListFile,'*************************************');
      writeln(ListFile,'    Including "'+InclFileName+'"');
      writeln(ListFile,'*************************************');
      LineCt := LineCt + 3;
      if InclFileOk then
      begin
        WhenCreated (InclFileDate,InclFileTime,InclFileName);
        InclLineCnt := 0;
        while not eof(InclFile) do
        begin
          readln(InclFile, buff1);
          InclLineCnt := succ(InclLineCnt);
          ScanLine;
          PrintHeading(Include);
          if print then
          begin
            if length(buff1) > 0 then
              writeln(ListFile,InclLineCnt : 4, bcount : 3, ' ', buff1)
            else
              writeln(ListFile,'        ',buff1);
            linect := succ(linect);
          end;
        end; {while not eof}
      end
      else
      begin
        writeln(ListFile,'File ',InclFileName,' Not Found.');
        LineCt := succ(LineCt);
      end;
      if LineCt + 3 > MaxLine then
        ForceHead := true;
      PrintHeading(Include);
      writeln(ListFile,'*************************************');
      writeln(ListFile,'    End of    "'+InclFileName+'"');
      writeln(ListFile,'*************************************');
      IncludeActive := false;
    end; {ListInclFile}

  Procedure ListMainFile;
    begin  { ListMainFile }
      if MainFileOk then
      begin
        WhenCreated (MainFileDate,MainFileTime,MainFileName);
        ForceHead := true;
        MainLineCnt := 0;
        while not eof(MainFile) do
        begin
          readln(MainFile, Buff1);
          MainLineCnt := succ(MainLineCnt);
          ScanLine;
          PrintHeading(Normal);
          if print then
          begin
              if length(buff1) > 0 then
                writeln(ListFile,MainLineCnt : 4, bcount : 3, ' ', buff1)
              else
                writeln(ListFile,'        ',buff1);
              linect := succ(linect);
              if IncludeActive then
                ListInclFile;
          end; {if print}
        end; {while not eof}
      end; {MainFileOk}
    end; {ListMainFile}

  Procedure ListXref;
    Const
      blnk = ' ';
    Var
      x, y: Integer;

    Begin  { ListXref }
      ForceHead := true;
      PrintHeading(Xref);
      Srchxrefword := Firstxrefword;
      while SrchXrefWord <> Nil Do
      Begin
        x := 20 - Length(SrchXrefWord^.XrefWord);
        for y := 1 to x do
          SrchXrefWord^.XrefWord := concat(SrchXrefWord^.XrefWord,blnk);
        Write(ListFile,srchxrefword^.XrefWord);
        x := 0;
        SrchXrefNum := SrchXrefWord^.FirstXrefNum;
        while SrchXrefNum <> Nil do
        begin
          if X < 10 then
          begin
            Write(ListFile,SrchXrefNum^.XrefNum:5);
            x := X + 1;
          end
          else
          begin
            Writeln(ListFile);
            Linect := linect + 1;
            PrintHeading(Xref);
            Write(ListFile,blnk:20,SrchxrefNum^.XrefNum:5);
            x := 0;
          end;
          SrchXrefNum := SrchXrefNum^.NextXrefNum;
        end;
        writeln(ListFile);
        Linect := linect+1;
        PrintHeading(Xref);
        SrchXrefWord := SrchXrefWord^.NextXrefWord;
      end;
    end;   { ListXref }

{.page}
  begin {main procedure}
    if RsrvWordListOk then
    begin
      FirstXrefWord := nil;
      ClrScr;
      GotoXY(2, 2);
      writeln('TURBO Pascal Formatted Listing');
      GotoXY(2, 4);
      ParseCommandLine;
      if MainFileName <> '' then
        if MainFileOk then
        begin
          SetUpListFile;

          pageno := 0;
          linect := 0;      {output line counter}
          kcount := 0;
          bcount := 0;
          ForceHead := true;
          IncludeActive := false;
          print := true;
          ListMainFile;
          if PrintXref then
            ListXref;
          if OutputDevice = HP then
            write(ListFile,HPEndStr)
          else
            write(ListFile,NormEndStr);
        end
        else
      else
        writeln(
              'File Name and Optional Parameters not found on Command Line.');
    end;
  end.  {main procedure}