program Install (input,output) ;
{This program writes a submit file for assembling SUPRBDOS.  The submit
file should be executed with EX.COM, not SUBMIT.COM}

type st14 = string[14] ;
     st5 = string[5] ;
var
    BdosAddr, BdosFilePos, offset, Pages : integer ;
    SysFileName : st14 ;

function Hex (i : integer) : st5 ;
  var count, nibble : integer ;
      temp : st5 ;
begin
  for count := 0 to 3 do begin
    nibble := (i shr (count*4)) and $0F ;
    if nibble <= 9
      then temp [5-count] := chr(ord('0')+nibble)
      else temp [5-count] := chr(ord('A')+nibble-10) ;
  end ;
  temp[0] := chr(5) ;
  temp[1] := '0' ;
  Hex := temp ;
end ;

procedure Error ;

begin
  writeln (^G^M) ;
  writeln ('Error- submit file not created.') ;
  halt ;
end ;

procedure GetCpmAddr (var BdosAddr : integer) ;
{This finds the bdos memory address.}

var DosAddr : integer absolute $0006 ;
    BiosAddr: integer absolute $0001 ;
    d, b : integer ;
begin
  d := DosAddr - 6 ;
  b := BiosAddr - 3 ;
  writeln ('Your bdos memory address is ', Hex(d),'.') ;
  writeln ('Your bios memory address is ', Hex(b),'.') ;
  if  (b-d) <> $0E00 then begin
    writeln ('  Your bdos address is invalid.  The bdos and bios addresses') ;
    writeln ('should differ by $0E00.  Yours differs by ',Hex(b-d),'.') ;
    writeln ('  Remove all memory resident programs such as RAM disks, keyboard');
    writeln ('redefinition programs, etc. and try again.') ;
    Error ;
  end
    else BdosAddr := d ;
end ;

procedure ScanSysFile (var BdosFilePos, Pages : integer;
                       var SysFileName : st14) ;

{This finds the location of the bdos in the CP/M system image file.}

type
    pseduoblock = record
                    len : byte ;
                    st : array [1..128] of char;
                  end ;
var f : file ;
    block : string [128] ;
    pblock : pseduoblock absolute block ;
    i, bdosloc : integer ;
    found,ok : boolean ;

begin
  repeat
    write ('Enter name of CP/M system image file <return=CPM.BIN> : ') ;
    readln (SysFileName) ;
    if SysFileName = '' then SysFileName := 'CPM.BIN' ;
    assign (f, SysFileName) ;
    {$i-}  reset (f) {$i+} ;
    ok := (ioresult = 0) ;
    if not ok then writeln ('Cannot find file ',SysFileName, '.  Try again.') ;
  until ok ;
  if odd(filesize(f))
    then Pages := (filesize(f) div 2)+ 1
    else Pages := filesize(f) div 2 ;
  i := 0 ;
  found := false ;
  pblock.len := 128 ;
  while not eof (f) and (not found) do begin
    i := i + 1 ;
    blockread (f,pblock.st,1) ;
    if pos('Bdos',block) <> 0
      then found := true ;
  end ;
  if found then begin
    bdosloc := i * 128;
    writeln ('Your bdos is located at ', Hex(bdosloc), ' in file ',SysFileName) ;
    BdosFilePos :=bdosloc ;
  end
    else begin
      writeln ('Can''t locate bdos in file ',SysFileName,'.  Automatic generation ') ;
      writeln ('of submit file is not possible.  See SUPRBDOS.DOC for instructions ') ;
      writeln ('on manual installation. ') ;
      Error ;
    end ;
end ;

procedure WriteSubFile ;
{This writes the submit file}

var f : text ;

begin
  assign (F,'GO.SUB') ;
  rewrite (F) ;
  writeln (F,'Z80MR DOS.BBZ') ;
  writeln (F,'DDT') ;
  writeln (F,'I',SysFileName) ;
  writeln (F,'R') ;
  writeln (F,'F',Hex(BdosFilePos),' ',Hex(BdosFilePos-1+$0E00),' 0') ;
  writeln (F,'IDOS.Hex') ;
  writeln (F,'R',Hex(offset)) ;
  writeln (F,'G0') ;
  writeln (F,'SAVE ',Pages, ' DOS.BIN') ;
  writeln (F,';SUPRBDOS ready to be written onto disk. To put SUPRBDOS') ;
  writeln (F,'; on your disks, type SYSGEN DOS.BIN') ;
  close (F) ;
  writeln ('GO.SUB file created.') ;
  assign (F,'ORG.DAT') ;
  rewrite (F) ;
  writeln (F,^I,'ORG',^I,Hex(BdosAddr),'H') ;
  close (F) ;
  writeln ('ORG.DAT file created.') ;
end ;

begin {main}
  writeln ('This program creates a submit file for assembling SUPRBDOS.') ;
  GetCpmAddr (BdosAddr) ;
  writeln ;
  ScanSysFile(BdosFilePos, Pages,SysFileName) ;
  write ('Your offset is ') ;
  offset :=BdosFilePos-BdosAddr ;
  writeln (Hex(offset), '.') ;
  WriteSubFile ;
  writeln ('Type "EX GO" to continue SUPRBDOS installation. ') ;
end. {main}