program rescue;
(************************************************************************)
{                                                                        }
{ date: 21 AUGUST 85                              author: Steve Mitton   }
{ ver 2.0                                                                }
{ purpose : Find lost text file in memory and write it to RESCUE.TXT.    }
{                                                                        }
{           This program was primarily developed for the TURBO PASCAL    }
{           programmer who sometimes neglects to save his program before }
{           trying to run it, loosing his program or updates in the      }
{           process. No matter how cautious you are, having a program    }
{           hang up in a loop or warm boot back to CP/M could be         }
{           disastrous without the ability to 'rescue' the text that is  }
{           still in memory.                                             }
{                                                                        }
(************************************************************************)
const start = 16000.0;
      CharSet : set of char = [' '..'~'];
      cr = ^M;
      lf = ^J;
      crlf = ^M^J;
      maxint = 32767;
      AddrConv = 65536.0;
      linesize = 72;
      conin = 1;
      resetDOS = 13;
      closefile = 16;
      delfile = 19;
      writesector = 21;
      makefile = 22;
      setdma = 26;

type FcbType = record
              dr : byte;
              name : array [1..11] of char;
              data : array [12..35] of byte
            end;

var FileOut : FcbType;
    LocSt, LocEnd, Loc : real;
    drive, Achar, Command, response : char;
    Done, goodnum, StartSelected : boolean;

procedure readchar(var anychar: char);
(************************************************************************)
{ This procedure allows a response to be entered without a carriage      }
{ return and translates all inputs to uppercase.                         }
(************************************************************************)
var areg : byte;
begin
  repeat
  until keypressed;
  areg := Bdos(conin);
  anychar := UPCASE(chr(areg))
end; { readchar }

procedure readnum ( var areal : real; var goodnum : boolean);
(************************************************************************)
{ By reading numbers in as a string, the VAL function built into TURBO   }
{ provides an easy way to ensure a number has been input.                }
(************************************************************************)
var code : integer;
    astring : string[5];
begin
  readln(astring);
  VAL (astring, areal, code);
  if code = 0 then
    begin
      goodnum := true;
      areal := int(areal)
    end
  else goodnum := false
end; { readnum }

procedure initialize;
(************************************************************************)
begin
  LocSt := 0;
  LocEnd := 0;
  drive := chr($40);
  StartSelected := false;
  done := false
end; { initialize }

procedure init_msg;
(************************************************************************)
  begin clrscr;
writeln('                           RESCUE.COM ver 2.0');
writeln('     Copyright (C) 1985 by Steve Mitton (tel 703 339-5842).');
writeln('     Released to the PUBLIC DOMAIN for non-commercial use.');
writeln;
writeln('     The purpose of RESCUE.COM is:');
writeln('         (1) to SEARCH the TPA for a lost program text');
writeln('and once found,');
writeln('         (2) to WRITE it to disk as RESCUE.TXT.');
writeln('     In principal, a lost text can be recovered after a WARM BOOT');
writeln('(control--c), and sometimes after a COLD BOOT (restart button).');
writeln('     When a program crashes, load RESCUE.COM immediately. Be sure');
writeln('sure to insert a disk that has enough empty space to accept the');
writeln('recovered file. The drive you select to write the file RESCUE.TXT');
writeln('on is automatically reset by RESCUE.COM to a R/W status.');
writeln('     Learn how to use RESCUE.COM before you really need it.');
writeln('In an emergency, you want to be right -- the first time!');
writeln('     Note: In a 64k computer, its memory is deployed like this:');
writeln('                0 -- 100        reserved for CP/M');
writeln('              100 -- 16,000     occupied by RESCUE.COM itself');
writeln('           16,000 -- 60,000     Transient Program Area');
writeln('           60,000 -- 64,000     CP/M Operating System');
writeln;
write('                    ===> M -- GO TO MENU <===   ');
    repeat
    until keypressed;
    clrscr
end; { init_msg }

function MemoryMarked : boolean;
(************************************************************************)
begin
  if StartSelected and (LocSt < LocEnd) then MemoryMarked := true
  else MemoryMarked := false
end; { MemoryMarked }

procedure WriteFile;
(************************************************************************)
label EXIT;
var NumSectors, I, Areg, Try: byte;
    DMA : integer;
    WroteSector : boolean;
begin
  { Verify addresses and drive and initialize FCB }
  write(crlf, 'START ADDRESS = ', LocSt:1:0,
        crlf, 'END ADDRESS   = ', LocEnd:1:0,
        crlf, 'Write file RESCUE.TXT to');
  case drive of
        '@'   : writeln(' default drive? <Y/N>');       { '@' is ASCII 40H }
     'A'..'P' : writeln(' drive ', drive, '? <Y/N>');
  end; {case}
  readchar(response);
  if response <> 'Y' then goto EXIT;
  FileOut.dr := ord(drive) - $40;
  FileOut.name := 'RESCUE  TXT';
  fillchar (FileOut.data[12], 23, 0);
  BDOS(resetDOS);

  {                Open file RESCUE.TXT                      }
  { If a file RESCUE.TXT exists and it will be deleted first }
  Areg := BDOS(delfile, addr(FileOut));
  Areg := BDOS (makefile, addr(FileOut));
  if Areg in [0..3] then writeln(crlf, 'Writing file . . .')
  else
    begin
      writeln('Cannot open file');
      goto EXIT
    end;

  {       Have to be careful since max integer 32767.      }
  { The initial 128 substracted will be incremented below. }
  if LocSt < maxint then DMA := round(LocSt) - 128
  else begin
         DMA := round(LocST - AddrConv) - 128;
       end;
  NumSectors := round((LocEnd - LocSt)/128) + 1;
  writeln('Start address = ', LocSt:1:0);
  writeln('End address   = ', LocEnd:1:0);
  writeln('Number of sectors = ', NUMSECTORS:1, ' ');
  writeln('. . .');
  for I := 1 to NumSectors do
    begin
      DMA := DMA + 128;      { increment DMA }
      BDOS (setdma, DMA);
      Try := 0; WroteSector := false;
      repeat
        Areg := BDOS (writesector, addr(FileOut));
        if Areg <> 0 then Try := succ(Try)
        else WroteSector := true
      until (Try = 5) or (WroteSector);
      if Try = 5 then writeln(^g, '** Warning ** error writing sector ', i)
    end;  { do }

    { Close file }
    Areg := BDOS (closefile, addr(FileOut));
    if Areg in [0..3] then
      begin
        writeln ('RESCUE.TXT written');
        done := true
      end
    else writeln (^G, '** error ** file write error ??');
EXIT:
end; { Write_File }

procedure Scroll (var StartLoc : real);
(*************************************************************************)
{ This procedure will scroll through memory beginning at StartLoc. It will}
{ only print the characters in CharSet ( the printable ASCII's ) as well  }
{ cr and lf characters. All other ASCII's are represented by a '.'.       }
{ For readability a cr followed lf will constitute an EOL, otherwise the  }
{ length of the string 'line' will determine the EOL. Before exiting,     }
{ StartLoc is reset so that the scroll can resume at the last address     }
{ scanned if desired.}
(*************************************************************************)
label CONTINUE, EXIT;
var address : integer;
    line : string[linesize];
    Areg : byte;
    achar : char;

function NextChar : char;
(************************************************************************)
{ This function returns the character at the current 'address' and       }
{ increments 'address' for the next read.                                }
{ It also does a check to ensure 'address, is within 64K.}
(************************************************************************)
  begin
    NextChar := chr (mem [address]);
    address := succ(address);
    If address = 0 then
      writeln (^G, crlf, 'Warning *** End of 64K memory ***', ^G)
  end; { NextChar }

procedure PrintLine;
(************************************************************************)
{ This procedure will print a string, the global 'line' along with the   }
{ line number for the following line.}
(************************************************************************)
var LineNum : real;
  begin
    if address < 0 then LineNum := address + AddrConv
    else LineNum := address;
    write ('  ', line, crlf, LineNum:5:0);
    line := ''
  end; { PrintLine }

begin  { Scroll }
  if StartLoc < maxint then address := round(StartLoc)
  else address := round(StartLoc - AddrConv);
  line := '';
  write (StartLoc:5:0);

  repeat
    achar := NextChar;
CONTINUE:
    If length(line) >= linesize then PrintLine;
    If achar in CharSet then line := line + achar
    else
      if achar = cr then
        begin
          achar := NextChar;
          if achar = lf then
            begin
              PrintLine;
              achar := NextChar;
              goto CONTINUE
            end
          else
            begin
              line := line + '.';
              { concats cr to line as a '.'}
              { no need to advance read to next char }
              goto CONTINUE
            end  { else if lf }
        end { if cr }
      else line := line + '.';
  until keypressed;

  Areg := BDOS (conin);
  command := Upcase(chr(Areg));
  if Command = ^S then
    begin
      repeat
      until keypressed;
      Areg := BDOS(conin);
      Command :=  Upcase(chr(Areg));
      if Command = ^S then goto CONTINUE
    end;
EXIT:
  if address < 0 then StartLoc := address + AddrConv
  else StartLoc := address
end; { Scroll }

procedure DisplayHelp;
(************************************************************************)
begin
writeln('                        ===>  MENU  <===');
writeln;
writeln('               Q -- to QUIT rescue.com at any time');
writeln;
writeln;
writeln('                ===> TO SEARCH THROUGH MEMORY <=== ');
writeln;
writeln(' B -- to BEGIN the search [at 16,000, the default address] ');
writeln(' A -- [at any time] to specify a start/restart ADDRESS ');
writeln('^S -- temporary pause/resume search scroll');
writeln(' M -- pause display to go to MENU');
writeln(' C -- to CONTINUE the scroll from the last address shown');
writeln;
writeln;
writeln('             ===> TO RECLAIM AN AREA OF MEMORY <===');
writeln;
writeln(' S -- to specify a STARTING address for rescue.txt');
writeln(' E -- to specify an ENDING address [important: be sure this address');
writeln('        is at least two lines below the end of your program');
writeln('        so that a proper End-of-File will be included.] ');
writeln(' D -- to specify the DRIVE that rescue.txt is to be sent to.');
writeln(' W -- to WRITE rescue.txt to the disk in the drive specified');
write('Command selected ->         GOOD LUCK  ');
gotoxy(21, 24);
readchar(command);
writeln
end; { DisplayHelp }

(*************************** main program *****************************)
begin
  initialize;
  init_msg;
  clrscr;
  writeln;
  DisplayHelp;

  repeat
     case command of
       'A' : begin
               write(crlf, 'Address to resume scroll',
                     crlf, '<cr> will resume scroll at last address -> ');
               readnum (Loc, goodnum);
               if not goodnum then
                 begin
                   writeln(^g, '** Input error ** bad number ??');
                   DisplayHelp
                 end
               else command := 'C';
               writeln;
             end;

       'B' : begin
               Loc := start;
               scroll(Loc)
             end;

       'C' : scroll(Loc);

       'D' : begin
               writeln(crlf, 'Select the drive to write RESCUE.TXT.',
               crlf, '<cr> selects default drive, or select ''A'' thru ''P''');
               readchar(drive);
               if not (drive in ['A'..'P']) then
                 begin
                   drive := chr($40);
                   writeln(crlf, 'Default drive selected')
                 end
              else writeln(crlf, 'Drive ', drive, ' selected');
              DisplayHelp
            end;

       'E' : if StartSelected then
               begin
                 write (crlf, 'Select RESCUE.TXT end address -> ');
                 readnum(LocEnd, goodnum);
                 if not goodnum then
                   begin
                     writeln(crlf, ^g, '** Input error ** bad number ??');
                     DisplayHelp
                   end
                 else
                   if MemoryMarked then
                     begin
                       WriteFile;
                       if not done then DisplayHelp
                     end
                    { note DONE set to true by WriteFile if write good }
                   else
                     begin
                       write(crlf, ^G,'** error ** end address too small',
                                    '   START ADDRESS = ', LocSt:1:0,
                                    '   END ADDRESS = ', LocEnd:1:0);
                       DisplayHelp
                     end
               end
             else
               begin
                 writeln (^G, crlf, 'Start address has not been selected');
                 DisplayHelp;
               end;

       'M' : begin
               writeln;
               DisplayHelp
             end;

       'Q' : begin
               writeln(^G, crlf, 'Abort rescue operation? <Y/N>');
               readchar(response);
               if response <> 'Y' then
                 begin
                   writeln(^G, crlf, '** Continue RESCUE ** ');
                   DisplayHelp
                 end
               else
                 begin
                   writeln(^G, crlf, 'Abort at user request');
                   done := true
                 end
             end;

       'S' : begin
               write (crlf, 'Select RESCUE.TXT starting address -> ');
               readnum(LocSt, goodnum);
               if goodnum then
                 begin
                   StartSelected := true;
                   command := 'A'
                 end { if goodnum }
               else
                 begin
                   writeln(crlf, ^g, '** Input error ** bad number ??');
                   DisplayHelp
                 end;
             end;

       'W' : if MemoryMarked then
               begin
                 WriteFile;
                 if not done then DisplayHelp
               end
              { note DONE set to true by WriteFile if write good }
             else
               begin
                 writeln(crlf, ^g, '** error ** memory not marked ??');
                 DisplayHelp
               end;
       else
         begin
           writeln( ^G, crlf, '** error ** bad command ??');
           DisplayHelp
         end
     end; {case}
  until done
END.