Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/TURBOPM.ZIP/TURBOPRT.PAS

Pascal/Delphi Source File | 1985-11-01 | 26.0 KB | 818 lines

program TURBOPRT;
(*
  Written by: Michael Roberts
              3103 Glenview
              Royal Oak, Mi 48073
              Compuserve : 74226,3045

            Please let me know if you run into any problems or
            have any suggestions!  This program is built on a listing
            program by Rick Schaeffer of Washington.
*)

(* Supported pseudo operations:
    1) Listing control: {.L-} turns it off, {.L+} turns it back on,
       must be in column 1
    2. Page ejection: {.PAGE}, must be in column 1.
    *)

 { When program is first run will check for a file
   name passed by DOS, and will try to open that file.  If no name is
   passed, will ask operator for a file name to open.  Proc will tell
   operator if file doesn't exist and will allow multiple retrys.

   Optionally the file name can be passed via the command line.  Typing
   a "/I" after the filename will expand includes. Examples:

     TURBOPRT  -  will invoke program and ask for file name to be listed

     TURBOPRT MYPROG.PAS  -  will list file "MYPROG.PAS"
                             and not expand includes

     TURBOPRT MYPROG /I  -  will list file "MYPROG.PAS" and will expand
                            includes.

   On 2nd and later executions, proc will not check for DOS passed file
   name.  In all cases, proc will assume a file type of .PAS if file
   type is not specified.
   PROGRAM EXIT from this proc when a null string is encountered in
   response to a file name request. }

{.PAGE}
const
  monthmask  = $000F;
  daymask    = $001F;
  minutemask = $003F;
  secondmask = $001F;
  First      : boolean = true;    {true when prog is run}

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

  maxline = 58;
  cp = #15;         {compressed print}
  rp = #18;         {regular width }
  cr = #13;
  lf = #10;
  ff = #12;

type
   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;

   alfa        = string[15];
   two_letters = string[2];
   dtstr       = string[8];
   fnmtype     = string[40];
   instring    = string[135];
   IntPtrType  = ^Integer;
   regpack     = record
      ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
   end;

Var
  answer    : char;
  Buff1     : instring;          {input line buffer}

  FirstResWord, LastResWord, NewResWord, SrchResWord: ResWordPtr;

  FirstxRefWord, NewxRefWord, PrevXrefWord, SrchxRefWord: XRefWordPtr;

  NewXRefnum, SrchXRefNum: XRefNumPtr;

  ResWord   : string[20];
  XrefWord  : string[20];
  XrefNum   : Integer;
  wordchk   : alfa;
  heaptop   : IntPtrType;
  listfil   : text;              {FIB for LST: or CON: output}
  infile    : text;              {FIB for input file}
  initfile  : text;              {FIB for reserved word file}
  fnam      : fnmtype;            {input file name}
  file_path : fnmtype;           {path to input file}
  bcount    : integer;           {begin/end counter}
  kcount    : integer;           {comment counter}
  linect    : integer;           {output file line counter}
  RefLine   : integer;           {Line Reference number counter}
  pageno    : integer;           {page counter}
  offset    : integer;
  print     : boolean;           (* {.L-} don't print *)
                                 (* {.L+} print       *)
  print_head : boolean;
  Print_Xref : boolean;
  path_found : boolean;
  Word_switch: Boolean;
  c,Print_opt: char;

  month, day, year,
  hour, minute, second : two_letters;

  sysdate, systime,
  filedate, filetime : dtstr;

  Lower_Right_X : Byte Absolute Cseg:$16A;
  Lower_Right_Y : Byte Absolute Cseg:$16B;

  expand_includes    : boolean;
  holdarg            : instring;
  allregs            : regpack;
{.page}

function parse_cmd(argno : integer) : instring;
var
   i,j : integer;
   wkstr : instring;
   done : boolean;
   cmdline : ^instring;
begin
   cmdline := ptr(CSEG,$0080);
   wkstr := '';
   done := false; i := 1; j := 0;
   if length(cmdline^) < i then done := true;
   repeat
      while ((cmdline^[i] = ' ') and (not done)) do begin
         i := i + 1;
         if i > length(cmdline^) then done := true;
      end;
      if not done then j := j + 1;
      while ((cmdline^[i] <> ' ') and (not done)) do begin
         wkstr := wkstr + cmdline^[i];
         i := i + 1;
         if i > length(cmdline^) then done := true;
      end;
      if (j <> argno) then wkstr := '';
   until (done or (j = argno));
   for i := 1 to length(wkstr) do
      wkstr[i] := upcase(wkstr[i]); {all arguments forced to upper case}
   parse_cmd := wkstr;
end;

procedure getchar(var char_value : char);
   begin
     allregs.ax := $0000;
     intr($16, allregs);
     char_value := chr(ord(lo(allregs.ax)));
   end; {getchar}

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

Procedure Release_heap (a_heap_pointer : IntPtrType);
var
   i : integer;

begin
   i := ((seg(heapptr^) - seg(a_heap_pointer^)) shl 4) +
        (ofs(heapptr^) - ofs(a_heap_pointer^));
   FreeMem(a_heap_pointer,i);
end; {release_heap}

procedure getdate(var date : dtstr);

begin
   allregs.ax := $2A * 256;
   MsDos(allregs);
   str((allregs.dx div 256):2,month);
   str((allregs.dx mod 256):2,day);
   str((allregs.cx - 1900):2,year);
   date := month + '/' + day + '/' + year;
   fill_blanks (date);
end;  {getdate}

procedure gettime(var time : dtstr);

begin
   allregs.ax := $2C * 256;
   MsDos(allregs);
   str((allregs.cx div 256):2,hour);
   str((allregs.cx mod 256):2,minute);
   str((allregs.dx div 256):2,second);
   time := hour + ':' + minute + ':' + second;
   fill_blanks (time);
end;  {gettime}

procedure WhenCreated (var date, time: dtstr; var infile: text);

var fulltime,fulldate: integer;

begin

{fulldate gets the area of the FIB which 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                     }

    fulldate:= memw [seg(infile):ofs(infile)+31];
    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;
    fill_blanks(date);

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

    fulltime:= memw [seg(infile):ofs(infile)+33];
    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;
    fill_blanks (time);
end;  {WhenCreated}

PROCEDURE Initialize;

{Here we load in the reserved word file and create a linked list}

BEGIN
     assign(initfile,'TURBOPAS.RES');
     {$I-} reset(initfile) {$I+};
     if IOresult <> 0 then begin
        writeln('File TURBOPAS.RES not found... Program aborted!!!');
        halt;
     end;
     FirstResWord := nil;
     while not eof(initfile) do
     begin
          readln(initfile,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(initfile);
END; {of Initialize}

Function Find_in_Reserve(var kword: alfa) : boolean;

{ This routine returns a boolean true false if the word passed to it is found
  in the linked list of reserved words }

Begin
    SrchResWord := firstresword;

    while ((kword > srchresword^.resword) and (srchresword <> nil)) do
          srchresword := srchresword^.next;

    if srchresword = nil then
       Find_in_Reserve := FALSE
    else
        if kword = srchresword^.resword then
           Find_in_reserve := true
        else
            Find_in_reserve := False;
End;

Procedure BuildXref;

Procedure NewNum(var current, last: xrefnumptr);
Begin
     new(NewXrefNum);
     current := NewXrefNum;
     Last    := NewXrefNum;
     NewXrefNum^.NextXrefNum := nil;
     NewXrefNum^.XrefNum := RefLine;
end;

Begin
     if ((FirstXrefWord = nil) or (FirstXrefWord^.XrefWord > wordchk)) then
        begin
             new(newxrefword);
             NewXrefWord^.NextXrefWord := FirstXrefWord;
             FirstXrefWord := NewXrefWord;
             FirstXrefWord^.XrefWord := wordchk;
             NewNum(FirstXrefWord^.FirstXrefNum, FirstXrefWord^.LastXrefNum);
         end
     else
     begin
          If firstXrefWord^.xrefword = wordchk then
               NewNum(FirstXrefWord^.LastXrefNum^.NextXrefNum,
                      FirstXrefWord^.LastXrefNum)
          else
          Begin
               SrchXrefWord := FirstXrefword^.NextXrefWord;
               PrevXrefWord := FirstXrefWord;
               While ((SrchXrefWord <> Nil) and
               (SrchXrefWord^.XrefWord < WordChk)) do
               begin
                    PrevXrefWord := SrchXrefWord;
                    SrchXrefWord := SrchXrefWord^.NextXrefWord;
               end;
               If ((SrchXrefWord = nil) and
                  (PrevXrefWord^.XrefWord < wordchk)) then
                  Begin
                       new(newxrefword);
                       NewXrefWord^.NextXrefWord := Nil;
                       PrevXrefWord^.NextXrefWord := NewXrefWord;
                       NewXrefWord^.XrefWord := wordchk;
                       NewNum(NewXrefWord^.FirstXrefNum,
                              NewXrefWord^.LastXrefNum);
                  end
                  else
                      if SrchXrefWord^.XrefWord > Wordchk Then
                      Begin
                           new(newxrefword);
                           NewXrefWord^.NextXrefWord := SrchXrefWord;
                           PrevXrefWord^.NextXrefWord := NewXrefWord;
                           NewXrefWord^.XrefWord := wordchk;
                           NewXrefWord^.LastXrefNum := Nil;
                           NewNum(NewXrefWord^.FirstXrefNum,
                                  NewXrefWord^.LastXrefNum);
                      end
                      else
                           If SrchXrefword^.lastxrefnum^.Xrefnum <> RefLine
                           then
                                NewNum(SrchXrefWord^.LastXrefNum^.NextXrefNum,
                                       SrchXrefWord^.LastXrefNum);
          end;
     end;
end;

procedure print_heading(filename : fnmtype);

var offset_inc: integer;

begin
   if print then
     begin
       pageno := pageno + 1;
       write(listfil, ff);  {top of form}
       writeln(listfil);
       write(listfil,'     TURBO Pascal Program Lister');
       writeln(listfil,' ':8,'Printed: ',sysdate,'  ',
               systime,'   Page ',pageno:4);
       if filename <> fnam then begin
          offset_inc:= 21 - length (filename);
          write(listfil,'     Include File: ',filename,' ':offset_inc,
             'Created: ',filedate,'  ',filetime);
       end
       else write(listfil,'     Main File: ',fnam,' ':offset,
             'Created: ',filedate,'  ',filetime);
       writeln(listfil); writeln(listfil);
       If Print_Xref then
          Writeln(Listfil,' ':32,'CROSS-REFERENCE')
       else
           writeln(listfil, '      K  B');
       writeln(listfil);
       linect := 6;
     end; {check for print}
end;  {print_heading}

procedure printline(iptline : instring; filename : fnmtype);
begin
   if print then
     begin
       if linect < 56 then
         begin
          writeln(listfil,'     ',iptline);
          linect := linect + 1;
         end
          else
           begin
             print_heading(filename);
           end;
     end; {check for print}
end;  {printline}

{.page}
function chkinc(var iptline : instring; var incflname : fnmtype) : boolean;
var
   done : boolean;
   i, j : integer;
begin
   i := 4; j := 1; incflname := '';
   if ((copy(iptline, 1, 3) = '{$I') or
       (copy(iptline, 1, 4) = '(*$I')) then begin
         if copy(iptline, 1, 4) = '(*$I' then i := 5;
         incflname := '';
         while (iptline[i] = ' ') and (i <= length(iptline)) do i := i + 1;
         done := false;
         while not done do begin
               if i <= length(iptline) then begin
                  if not (iptline[i] in [' ','}','+','-','*']) then begin
                     incflname[j] := iptline[i];
                     i := i + 1; j := j + 1;
                  end else done := true;
              end else done := true;
              if j > 14 then done := true;
         end;
         incflname[0] := chr(j - 1);
   end;
   if incflname <> '' then
     begin
          chkinc := true;
          for i := 1 to length(Incflname) do
              incflname[i] := upcase(incflname[i]);
     end
     else
         chkinc := false;
end;  {chkinc}


 PROCEDURE GET_IN_FILE;     {GETS INPUT FILE NAME }
   var
    existing : boolean;
    i        : integer;
  begin
    repeat             {until file exists}
      holdarg := parse_cmd(1); {get command line argument # 1}
      if (length(holdarg) in [1..40]) and first then
        fnam := holdarg  {move possible file name to fnam}
      else
        begin
          clrscr;
          gotoxy(1,1);
          write(' ':30,'TURBOPRT - Release 1.0');
          gotoxy(1,3);
          write(' ENTER FILE NAME TO LIST or <cr> to EXIT  ');
          readln(fnam);
          if fnam <> '' then
             begin
                  writeln;write(' EXPAND INCLUDES? (Y/N) ');
                  readln(answer);
                  if upcase(answer) = 'Y' then
                     expand_includes := true
                  else
                      expand_includes := false
             end
        end;

     for i := 1 to length(fnam) do
         fnam[i] := upcase(fnam[i]);

     if fnam = '' then          {***** EXIT *****}
     begin
          clrscr;
          halt;
     end;

     if pos('.',fnam) = 0 then       {file type given?}
       fnam := concat(fnam,'.PAS');  {file default to .PAS type}

     {get optional command line argument # 2}
     if (length(holdarg) in [1..14]) and first then
       begin
         holdarg := parse_cmd(2);
         if holdarg = '/I' then expand_includes := true
            else expand_includes := false;
       end;

     first := false;                 {get passed file name only once}
     assign( infile, fnam);
       {$I-}
     reset( infile );                {check for existence of file}
       {$I+}
     existing := (ioresult = 0);     {true if file found}
     if not existing then
       begin
        writeln;
        writeln(' FILE DOESN''T EXIST'); {tell operator the sad news}
        sound(500);
        delay(250);
        nosound;
        delay(2000);
       end;
     if existing then
       begin                             {obtain path for include files}
          I := length(fnam);
          path_found := false;
          while ((I > 0) and Not Path_found) do
             if (fnam[i] in ['\',':']) then Path_found := true
             else I := I - 1;

          if Path_found then
          begin
             file_path := copy(fnam,1,I);
             fnam := copy(fnam,(i+1),(length(fnam)));
          end;
       end;
    until existing;                     {until file exists}


 end; {GET_IN_FILE}

{ GET_OUT_FILE procedure asks operator to select output to console
  device or list device, and then assigns and resets a file control
  block to the appropriate device.  'C' or 'P' is only correct
  response, and multiple retrys are allowed. }

Procedure Get_Out_File;
  begin
    repeat    {until good selection}
      gotoxy(1,7);
      clreol;
      write(' OUTPUT LISTING TO (C)ONSOLE OR (P)RINTER ?  ');
      getchar(c);
      c := upcase(c); write(c);
   until c in ['C', 'P'];

   writeln;
   if c = 'C' then
      assign (listfil, 'CON:')
   else
      assign (listfil, 'LST:');

   reset(listfil);
   if c = 'P' then begin
     repeat
      gotoxy(1,9);
      clreol;
      Write(' (C)OMPRESSED PRINT OR (R)EGULAR PRINT ? ');
      getchar(print_opt);
      print_opt := upcase(print_opt);
      write(print_opt);
    until print_opt in ['C','R'];
    writeln;
    if print_opt = 'R' then write(listfil,rp);
   end;
 end;  {GET_OUT_FILE}
{.page}
Procedure ListIt(filename : fnmtype); forward;
{ 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.}

Procedure SCAN_LINE;
  var
    literal : boolean;          { true if in literal field}
    tmp     : string[7];        { tmp work area }
    i       : integer;          {loop variable index}
    buff2   : instring;         {working line buffer}
    incflname : fnmtype;        {in file name}
    filedate_save : dtstr;
    filetime_save : dtstr;
  begin
    literal := 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 chkinc(buff2, incflname) and expand_includes then
       begin
       for i := 1 to length(incflname) do
           incflname[i] := upcase(incflname[i]);
          if pos('.',incflname) = 0 then incflname := incflname + '.PAS';
          printline('*************************************',incflname);
          printline('    Including "'+incflname+'"', incflname);
          printline('*************************************',incflname);
          filedate_save := filedate;  {save filedate & filetime for}
          filetime_save := filetime;  {main file                   }
          listit(incflname);
          filedate := filedate_save;  {restore}
          filetime := filetime_save;
          printline('*************************************',incflname);
          printline('    End of    "'+incflname+'"', incflname);
          printline('*************************************',incflname);
          RefLine := RefLine - 1;
         end;  {include file check}

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

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

    if copy(buff2,1,7) = '{.PAGE}' then
       begin
            print_head := true;
            if length(buff2) = 7 then
               RefLine := RefLine - 1;
       end;

    if length(buff2) > 0 then
       RefLine := RefLine + 1;

    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 not literal then
            begin
              if ((not Word_switch) and
                 (buff2[i] in ['A'..'Z']) and
                 (not (buff2[i-1] in ['0'..'9','A'..'Z']))) then
                           Begin
                                Word_switch := true;
                                wordchk := '';
                           end;
              if word_switch then
                 if (buff2[i] in ['A'..'Z','0'..'9','_']) then
                    wordchk := concat(wordchk,Buff2[i])
                 else
                 begin
                      word_switch := false;
                      if not find_in_reserve(wordchk) then
                         BuildXref;
                 end;
              end;
           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}
           end;  { if kcount = 0 }
        end;  { for i := }
    end;  {SCAN_LINE}
{.page}
Procedure ListIt;
  var
    infile : text;
    full_filename : fnmtype;
  begin
    if path_found then
       full_filename := concat(file_path,filename)
    else
       Full_filename := filename;
     assign(infile, full_filename);
   {$I-} reset(infile) {$I+} ;
   if IOresult <> 0 then begin
      writeln ('File ',filename,' not found.');
      halt;
   end;
     WhenCreated (filedate,filetime,infile);
     if filename = fnam then
         print_heading(filename);
         while not eof(infile) do
           begin
            readln(infile, buff1);
            scan_line;
            if print_head then
                print_heading(filename);
            if print and (not print_head) then
              begin
                if length(buff1) > 0 then
                   if print_opt = 'C' then
                      writeln(listfil,RefLine:4, kcount:3,bcount:3,
                      ' ',cp,buff1,rp)
                   else
                       writeln(listfil,RefLine:4, kcount:3,bcount:3,
                       ' ',buff1)
                else
                   writeln(listfil,'        ',buff1);
                linect := succ(linect);
                if linect > maxline then
                  begin
                    print_heading(filename);
                  end;
              end;
            print_head := false;
         end;     {while not eof}
  end; {ListIt}

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

Begin
     Print_Xref := True;
     Print_heading(fnam);
     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(listfil,srchxrefword^.XrefWord);
          x := 0;
          SrchXrefNum := SrchXrefWord^.FirstXrefNum;
          while SrchXrefNum <> Nil do
          begin
               if X < 10 then
               begin
                    Write(listfil,SrchXrefNum^.XrefNum:5);
                    x := X + 1;
               end
               else
               begin
                    Writeln(listfil);
                    Linect := linect + 1;
                    if linect > maxline then Print_heading(fnam);
                    Write(listfil,blnk:20,SrchxrefNum^.XrefNum:5);
                    x := 0;
               end;
               SrchXrefNum := SrchXrefNum^.NextXrefNum;
          end;
          writeln(listfil);
          Linect := linect+1;
          if linect > Maxline then Print_heading(fnam);
          SrchXrefWord := SrchXrefWord^.NextXrefWord;
     end;
end;
{.page}
  begin {main procedure}
     getdate(sysdate);
     gettime(systime);
     expand_includes := false;       {default settings}
     print := true;
     initialize;
     Mark(heaptop);

   repeat {forever}

     Print_opt := ' ';
     FirstXrefWord := nil;
     ClrScr;
     GotoXY(2, 2);
     get_in_file;      {file to list}
     offset := 24 - length(fnam);
     get_out_file;     {where to list it}
     pageno := 0;
     linect := 1;      {output line counter}
     kcount := 0;
     RefLine := 0;
     bcount := 0;
     print_head := false;
     Print_xref := False;
     word_switch:= False;
     listit(fnam);
     Listxref;
     writeln(listfil);
     Release_Heap(heaptop); {purge previous cross reference}
     write(cr, lf, 'HIT ANY KEY TO CONTINUE ');  {allow op to see end
                                                 of listing}
    getchar(c);
    until false {repeat forever - exit is in GET_IN_FILE PROCEDURE}
 end.  {main procedure}
includes := false;       {default settings}
     print := true;
     initialize;
     Mark(heaptop);

   repeat {forever}