program pboot; {modem downloader}
{by Phillip Hansford, July 1984}

{Modified for MORROW DESIGNS MICRO DECISION with FREEDOM 50/100 TERMINALS
 by Robert L. Parker, Jr., July 30, 1984.}

{When compiled into a .COM file this program takes 10k Disk space. While
 it does NOT provide for pre-prepared text file upload or ASCII capture
 capability, It DOES provide for recieving files via the XMODEM program
 on RCP/M systems and simple terminal mode operation.}

{When used with the MORROW MICRO DECISION computer, the SETBAUD.COM
 program may be used to select 300 or 1200 baud operation.}

{Turbo Pascal version based on 'BMODEM.BAS' by author unknown.
Configured for US Robotics S-100 modem, but should work with
'Password' and other Hayes-like smart modems; perhaps others.
You may need to change I/O ports and routines for your system.
Initialization of the modem is not included, but could be easily
added as inline machine code. All control codes are passed to the
modem during terminal mode except ^D, ^E, and ESC which are used
by the program. ^D toggles duplex, ^E starts block transfer,
ESC quits the program. The keyboard is locked out during transfer.
As with BMODEM, the program begins in terminal mode and returns
there after a transfer. It will run at 1200 baud.}

{$C-}

{$U-}

type
  fName = string[14];
  data  = string[24];
  datab = string[128];
  ldata = string[255];

var
  I,J,K,checksum : integer;
  OK, duplex : boolean;
  initalize,temp1,temp2,temp3: data;
  sourceName,destinatioName : fName;
  settings,X: char;
  filvar,sourceFile,destinationFile : file;
  cmd: string[2];
  line: ldata;
  fileName: fName;
  block_string : datab;

{Port assignments selected }
Const
   Status_Reg: byte= $FF;
   Modem_Reg: byte = $FE;
   In_Mask: byte = 2;
   Out_Mask: byte = 1;

   CR: char = ^M;
   LF: char = ^J;
   ESC: char= ^[;
   BELL: char= ^G;

   SOH: char= ^A;
   EOT: char= ^D;
   ACK: char= ^F;
   NAK: char= ^U;

   CRLF: string[2] = ^M^J;

Function Tstbit(local, local1 : byte): boolean;
{Return TRUE if the bit is set}
begin
  local:= local and local1;
  tstbit:= true;
  if local = 0 then tstbit:= false;
end; {tstbit}

Function Modem_In_Status : boolean;
{Return TRUE if modem character ready}
var
  status : byte;
begin
  status:= port[Status_Reg];
  Modem_In_Status:= tstbit(status, In_Mask);
end; {Modem_In_Status}

Function Modem_Out_Status : boolean;
{Return TRUE if modem ready to send}
var
  status : byte;
begin
  status:= port[Status_Reg];
  Modem_Out_Status:= tstbit(status, Out_Mask);
end; {Modem_Out_Status}

Procedure GetMod(var In_Char: char);
{Read the modem input port, assume char ready}
var
  temp : byte;
begin
  temp:= port[Modem_Reg];
  In_Char:= chr(temp);
end; {GetMod}

Procedure Modem_In(var In_Char: char);
{Read the modem input port}
begin
  repeat until modem_in_status;
  GetMod(In_Char);
end;  {Modem_In}

Procedure Modem_Out(OutChar: char);
{Output a character to the modem}
begin
  repeat until modem_out_status;
  port[Modem_Reg]:= Ord(OutChar);
end;  {Modem_Out}

procedure sinp(var x: char);
{direct I/O from keyboard}
var
  temp: byte;
begin
  temp:= bdos(6,$FF);
  X:= chr(temp);
end; {sinp}

procedure upper(var temp1:data);
{convert string to upper case}
label endProc;
var
   local,local1: integer;
begin
   local := length(temp1); if local=0 then goto endProc;
   for local1 := 1 to local do
   begin
     temp1[local1]:= (upCase(temp1[local1]));
   end;
endProc:
end; {upper}

function findfile(name: fname): boolean;
{look for file, return TRUE if found}
var
   found: boolean;
   f: file;
begin
   assign(f,name);
   {$I-} reset(f) {$I+};
   found:= (IOresult= 0);
   if found then close(f);
   findfile:= found
end;{findfile}

procedure openFile(sourceName: fname);
begin
  assign(sourceFile,sourceName);
  rewrite(sourceFile);
end; {openFile}

procedure saveblock(block_string: datab);
const
  BufSize = 128;
var
  buffer: array[1..BufSize] of byte;
begin
  for K:= 1 to 128 do buffer[K]:= ord(block_string[K]);
  blockWrite(SourceFile,buffer,1);
end; {saveblock}

procedure terminal_mode;
var
  local, local1: char;
begin
  writeln(^['GD Now in terminal mode '^['G0');
  writeln;
  repeat
  sinp(local);
  if local <> ^@ then begin   {if keypressed}
    if local in [^E, ^D, ESC] then else begin;
        modem_out(local);
        if not duplex then write(local);     {half-duplex}
    end;
    case local of
      ^M: begin  {ie. CR}
            modem_out(LF);
            if not duplex then write(LF);
          end;
      ^D: duplex:= not duplex;
    end;
  end;
  if Modem_In_Status then begin
    getMod(local1);
    write(local1);
  end;
  until local in [^E, ESC];
  X:= local;
end; {terminal_mode}

procedure receive_a_file;
label re_nameit, loop1, loop2;
var
  local, local1 : char;
begin
re_nameit:
  write(^['GDEnter NAME of file to recieve:'^['G0 ');
  readln(temp1); upper(temp1);
  if temp1[1] in [^@..' '] then temp1:= '';
  if length(temp1)>0 then sourceName:= temp1
  else begin
    writeln(^['GD++ Return to Terminal mode ++'^['G0');
    writeln;
    goto loop2;
  end;
  if findfile(sourceName) then begin
    writeln(^['GD++ file '^['G6', sourceName,^['GD exists ++'^['G0');
    goto re_nameit;
  end;
  openFile(sourceName);
  modem_out(NAK);
  {now do block}
  for I:= 1 to 32000 do begin
    write(CR,'Awaiting record number: '^['G4 ',I,' '^['G0');
LOOP1:
    checksum:= 0; block_string:= '';
    modem_in(local); {should be SOH}
    if local = EOT then begin
       modem_out(ACK);
       write(BELL);
       close(sourceFile);
       goto loop2; {completed}
    end;
    {get block number}
    modem_in(local); modem_in(local1);
    if ord(local) + ord(local1) <> 255 then checksum:= 13;
    {get block}
    for J:= 1 to 128 do begin
       modem_in(local);
       checksum:= checksum + ord(local);
       block_string:= block_string + local;
    end;
    modem_in(local);
    checksum:= checksum and 255;
    if checksum <> ord(local) then begin
       modem_out(NAK);
       goto loop1;
    end;
    saveBlock(block_string);  {save block to disk}
    modem_out(ACK);
  end;  {do next block}
LOOP2:
end; {recieve_a_file}

{********** program starts here **********}

label LOOP;
begin
   clrScr;
   writeln(^['f< PBOOT Commands: ^E - RECEIVE FILE | ^D - TOGGLE DUPLEX | ESC - QUIT PROGRAM >'^M^[^O^['g');
   duplex:= true;
   writeln('                   '^['G4 P B O O T file transfer program '^['G0');
   writeln;
LOOP:
   terminal_mode;
   if X = ESC then
      begin
        writeln(^['h');
        halt;
      end;
   receive_a_file;
   writeln(' '^['G6++ Transfer Completed ++'^['G0 ');
   goto loop;
end. {program}
