home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / OS / SUPRDOS2.ARC / INSTALL.PAS < prev    next >
Pascal/Delphi Source File  |  1990-09-21  |  4KB  |  145 lines
  1. program Install (input,output) ;
  2. {This program writes a submit file for assembling SUPRBDOS.  The submit
  3. file should be executed with EX.COM, not SUBMIT.COM}
  4.  
  5. type st14 = string[14] ;
  6.      st5 = string[5] ;
  7. var
  8.     BdosAddr, BdosFilePos, offset, Pages : integer ;
  9.     SysFileName : st14 ;
  10.  
  11. function Hex (i : integer) : st5 ;
  12.   var count, nibble : integer ;
  13.       temp : st5 ;
  14. begin
  15.   for count := 0 to 3 do begin
  16.     nibble := (i shr (count*4)) and $0F ;
  17.     if nibble <= 9
  18.       then temp [5-count] := chr(ord('0')+nibble)
  19.       else temp [5-count] := chr(ord('A')+nibble-10) ;
  20.   end ;
  21.   temp[0] := chr(5) ;
  22.   temp[1] := '0' ;
  23.   Hex := temp ;
  24. end ;
  25.  
  26. procedure Error ;
  27.  
  28. begin
  29.   writeln (^G^M) ;
  30.   writeln ('Error- submit file not created.') ;
  31.   halt ;
  32. end ;
  33.  
  34. procedure GetCpmAddr (var BdosAddr : integer) ;
  35. {This finds the bdos memory address.}
  36.  
  37. var DosAddr : integer absolute $0006 ;
  38.     BiosAddr: integer absolute $0001 ;
  39.     d, b : integer ;
  40. begin
  41.   d := DosAddr - 6 ;
  42.   b := BiosAddr - 3 ;
  43.   writeln ('Your bdos memory address is ', Hex(d),'.') ;
  44.   writeln ('Your bios memory address is ', Hex(b),'.') ;
  45.   if  (b-d) <> $0E00 then begin
  46.     writeln ('  Your bdos address is invalid.  The bdos and bios addresses') ;
  47.     writeln ('should differ by $0E00.  Yours differs by ',Hex(b-d),'.') ;
  48.     writeln ('  Remove all memory resident programs such as RAM disks, keyboard');
  49.     writeln ('redefinition programs, etc. and try again.') ;
  50.     Error ;
  51.   end
  52.     else BdosAddr := d ;
  53. end ;
  54.  
  55. procedure ScanSysFile (var BdosFilePos, Pages : integer;
  56.                        var SysFileName : st14) ;
  57.  
  58. {This finds the location of the bdos in the CP/M system image file.}
  59.  
  60. type
  61.     pseduoblock = record
  62.                     len : byte ;
  63.                     st : array [1..128] of char;
  64.                   end ;
  65. var f : file ;
  66.     block : string [128] ;
  67.     pblock : pseduoblock absolute block ;
  68.     i, bdosloc : integer ;
  69.     found,ok : boolean ;
  70.  
  71. begin
  72.   repeat
  73.     write ('Enter name of CP/M system image file <return=CPM.BIN> : ') ;
  74.     readln (SysFileName) ;
  75.     if SysFileName = '' then SysFileName := 'CPM.BIN' ;
  76.     assign (f, SysFileName) ;
  77.     {$i-}  reset (f) {$i+} ;
  78.     ok := (ioresult = 0) ;
  79.     if not ok then writeln ('Cannot find file ',SysFileName, '.  Try again.') ;
  80.   until ok ;
  81.   if odd(filesize(f))
  82.     then Pages := (filesize(f) div 2)+ 1
  83.     else Pages := filesize(f) div 2 ;
  84.   i := 0 ;
  85.   found := false ;
  86.   pblock.len := 128 ;
  87.   while not eof (f) and (not found) do begin
  88.     i := i + 1 ;
  89.     blockread (f,pblock.st,1) ;
  90.     if pos('Bdos',block) <> 0
  91.       then found := true ;
  92.   end ;
  93.   if found then begin
  94.     bdosloc := i * 128;
  95.     writeln ('Your bdos is located at ', Hex(bdosloc), ' in file ',SysFileName) ;
  96.     BdosFilePos :=bdosloc ;
  97.   end
  98.     else begin
  99.       writeln ('Can''t locate bdos in file ',SysFileName,'.  Automatic generation ') ;
  100.       writeln ('of submit file is not possible.  See SUPRBDOS.DOC for instructions ') ;
  101.       writeln ('on manual installation. ') ;
  102.       Error ;
  103.     end ;
  104. end ;
  105.  
  106. procedure WriteSubFile ;
  107. {This writes the submit file}
  108.  
  109. var f : text ;
  110.  
  111. begin
  112.   assign (F,'GO.SUB') ;
  113.   rewrite (F) ;
  114.   writeln (F,'Z80MR DOS.BBZ') ;
  115.   writeln (F,'DDT') ;
  116.   writeln (F,'I',SysFileName) ;
  117.   writeln (F,'R') ;
  118.   writeln (F,'F',Hex(BdosFilePos),' ',Hex(BdosFilePos-1+$0E00),' 0') ;
  119.   writeln (F,'IDOS.Hex') ;
  120.   writeln (F,'R',Hex(offset)) ;
  121.   writeln (F,'G0') ;
  122.   writeln (F,'SAVE ',Pages, ' DOS.BIN') ;
  123.   writeln (F,';SUPRBDOS ready to be written onto disk. To put SUPRBDOS') ;
  124.   writeln (F,'; on your disks, type SYSGEN DOS.BIN') ;
  125.   close (F) ;
  126.   writeln ('GO.SUB file created.') ;
  127.   assign (F,'ORG.DAT') ;
  128.   rewrite (F) ;
  129.   writeln (F,^I,'ORG',^I,Hex(BdosAddr),'H') ;
  130.   close (F) ;
  131.   writeln ('ORG.DAT file created.') ;
  132. end ;
  133.  
  134. begin {main}
  135.   writeln ('This program creates a submit file for assembling SUPRBDOS.') ;
  136.   GetCpmAddr (BdosAddr) ;
  137.   writeln ;
  138.   ScanSysFile(BdosFilePos, Pages,SysFileName) ;
  139.   write ('Your offset is ') ;
  140.   offset :=BdosFilePos-BdosAddr ;
  141.   writeln (Hex(offset), '.') ;
  142.   WriteSubFile ;
  143.   writeln ('Type "EX GO" to continue SUPRBDOS installation. ') ;
  144. end. {main}
  145.