CP/M/CPM_CDROM.iso/mbug/mbug169.arc/Z80DOS2B.LBR/INSTALL.PYS/INSTALL.PYS

Text File | 1979-12-31 | 6KB | 166 lines

program Install (input,output) ;
{This program writes a submit file for assembling Z80DOS.  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 ('************************* WARNING *******************************') ;
      writeln ('Can''t locate bdos in file ',SysFileName,'.  Automatic generation ') ;
      writeln ('of submit file is not possible.  See Z80DOS.DOC and Z80DOS.BLD') ;
      writeln (' for instructions on manual installation. ') ;
      writeln ('This is probably due to ''Bdos'' message not being present in CPM.BIN.') ;
      writeln ('Z80DOS/SUPRDOS or similar may allready be resident.') ;
      writeln ('You should still be able to upgrade by manual installation.') ;
      writeln ;

      Error ;
    end ;
end ;

procedure WriteSubFile ;
{This writes the submit file}

var f : text ;

begin
  assign (F,'GO.SUB') ;
  rewrite (F) ;
  writeln (F,'Z80 Z80DOS') ;
  writeln (F,'DDT') ;
  writeln (F,'I',SysFileName) ;
  writeln (F,'R') ;
  writeln (F,'F',Hex(BdosFilePos + 6),' ',Hex(BdosFilePos-1+$0E00),' 0') ;
  writeln (F,'IZ80DOS.Hex') ;
  writeln (F,'R',Hex(offset)) ;
  writeln (F,'G0') ;
  writeln (F,'SAVE ',Pages,' Z80DOS.BIN') ;
  writeln (F,';Z80DOS ready to be written onto disk. To put Z80DOS') ;
  writeln (F,'; on your disks, type SYSGEN Z80DOS.BIN') ;
  writeln ;
  writeln ('************************* WARNINGS *******************************');
  writeln ('       If your system originally came with single sided drives ') ;
  writeln ('drives you may have to do this SYSGEN onto a Single Sided disk.') ;
  writeln ;
  writeln ('If you are using SID instead of DDT you have to edit GO.SUB') ;
  writeln (' before executing.') ;
  writeln ;
  writeln ('If you are operating under ZCPR make sure there are no Z80DOS.HEX') ;
  writeln ('or Z80DOS.PRN files on the disk.') ;
  writeln ('Default NO answer is taken for ''Delete File'' question.') ;
  writeln ;
  close (F) ;
  writeln ('GO.SUB file created.') ;
  assign (F,'Z80DOS.Z80') ;
  rewrite (F) ;
  writeln (F,'BDOS',^I,'EQU',^I,Hex(BdosAddr),'H') ;
  Writeln (F,'BIOS',^I,'EQU',^I,Hex(BdosAddr + $0E00), 'H') ;
  writeln (F,^I,'CHAIN',^I,'''Z80DOSA.Z80''');
  close (F) ;
  writeln ('Z80DOS.Z80 file created.') ;
end ;

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