home *** CD-ROM | disk | FTP | other *** search
/ ftp.update.uu.se / ftp.update.uu.se.2014.03.zip / ftp.update.uu.se / pub / rainbow / msdos / decus / RB139 / wut312sc.lzh / WUSUBH.PAS < prev    next >
Pascal/Delphi Source File  |  1989-01-31  |  56KB  |  1,434 lines
  1. {** file wusubh.pas ⌐ Copyright 1986 Anthony G. Camas, all rights reserved **}
  2.  
  3. { **************************************************************************
  4.                           MS-DOS INTERFACE ROUTINES
  5.   ************************************************************************** }
  6.  
  7. { GetPATHString - Finds definition of PATH in environment and stores globally }
  8. procedure GetPATHString;
  9. type
  10.   PATHTagArray = Array [0..4] of Char;
  11. const
  12.   PATHTag = 'PATH=';
  13. var
  14.   PATHPtr :^PATHTagArray;
  15.   sg, off :Integer;
  16.   Current :String [255];
  17. begin
  18.   { Set up segment pointer to area containing environment variables }
  19.   sg := MemW[Cseg:$2C];
  20.   { Start at the beginning of this area }
  21.   off := 0;
  22.   PATHPtr := Ptr(sg, off);
  23.   while (Mem[sg:off] <> 0) and (PATHPtr^ <> PATHTag) do
  24.   begin
  25.     repeat
  26.       off := off + 1;
  27.     until Mem[sg:off] = 0;
  28.     off := off + 1;
  29.     PATHPtr := Ptr(sg, off);
  30.   end;
  31.   { When we get here, we've either found the PATH= string, or we've found
  32.     the end of the environment strings area. }
  33.   If Mem[sg:off] = 0 then
  34.   begin
  35.     { No PATH= entry found.  Use nothing. }
  36.     PATHString := '';
  37.     Exit;
  38.   end;
  39.   { Found it.  Copy it to the global string which will keep the data. }
  40.   off := off + 5;               { skip PATH= }
  41.   PATHString[0] := Char(0);     { initial length of zero }
  42.   While Mem[sg:off] <> 0 do
  43.   begin
  44.     PATHString[0] := Succ(PATHString[0]); { increment length }
  45.     PATHString[Ord(PathString[0])] := Char(Mem[sg:off]); { copy character }
  46.     off := off + 1; { next position in memory }
  47.   end;
  48.   { Get current directory and then append to the beginning of the path string }
  49.   GetDir (0, Current);
  50.   If Length(PATHString) > 0 then
  51.     PathString := Concat (Current, ';', PATHString)
  52.   else
  53.     PathString := Current;
  54. end {GetPATHString};
  55.  
  56. { FindOnPATH - Locates arbitrary file using PATH string in global variable.
  57.   This procedure searches for a file, whose name is passed, using first the
  58.   current working directory and then the various directories making up the
  59.   current PATH.  It returns, in the string variable passed to it, the expanded
  60.   file specification of the file that was found, including the path spec.  If
  61.   the file was not found in any of the specified places, it returns a null
  62.   string.  }
  63. procedure FindOnPATH (Var FileName :Str255);
  64. var
  65.   I, J        :Integer;
  66.   CurrentPath :String [255];
  67.   FileSpec    :String [255];
  68.   PathsLeft   :String [255];
  69.   DummyFile   :File;
  70. begin
  71.   PathsLeft := PATHString;
  72.   While Length (PathsLeft) > 0 do
  73.   begin
  74.     { Find semicolon delimiting end of next path entry. }
  75.     I := Pos (';', PathsLeft);
  76.     { If we found nothing, copy the whole thing.  Otherwise, extract the
  77.       individual directory path and remove it (and the semicolon) from the
  78.       list. }
  79.     If I = 0 then
  80.     begin
  81.       CurrentPath := PathsLeft;
  82.       PathsLeft := '';
  83.     end
  84.     else
  85.     begin
  86.       CurrentPath := Copy (PathsLeft, 1, I-1);
  87.       Delete (PathsLeft, 1, I);
  88.     end;
  89.     { If the current path we extracted is blank or just a dot (current
  90.       directory), skip it.  We've already checked it previously. }
  91.     If (CurrentPath <> '') and (CurrentPath <> '.') then
  92.     begin
  93.       { If path does not end with a backslash, add it so we can append our
  94.         filename }
  95.       If Copy (CurrentPath, Length(CurrentPath), 1) <> '\' then
  96.         CurrentPath := Concat (CurrentPath, '\');
  97.       { Now try and find the specified file. }
  98.       FileSpec := Concat (CurrentPath, FileName);
  99. {$I-}
  100.       Assign (DummyFile, FileSpec);
  101.       Reset (DummyFile);
  102. {$I+}
  103.       If IOResult = 0 then
  104.       begin
  105.         { We found the file!  Return the full filespec. }
  106.         FileName := FileSpec;
  107.         Close (DummyFile);
  108.         Exit;
  109.       end;
  110.     end;
  111.   end;
  112.   { If we get here, we did not find the file!  Return a null string. }
  113.   FileName := '';
  114. end {FindOnPATH};
  115.  
  116. { FindOverlay - Locates overlay file and sets overlay path there }
  117. procedure FindOverlay;
  118. const
  119.   OverlayName = 'WUTIL.000';
  120.   OverlayNameLength = 9;
  121. var
  122.   OvrSpec       :Str255;
  123. begin
  124.   { Try to find the overlay file using the usual path stuff }
  125.   OvrSpec := OverlayName;
  126.   FindOnPATH (OvrSpec);
  127.   { If we found it, strip off the file name part and set the overlay path
  128.     appropriately.  If not, print an error and abort.  We can't run without our
  129.     overlay. }
  130.   If Length (OvrSpec) > 0 then
  131.   begin
  132.     OvrSpec := Copy (OvrSpec, 1, Length(OvrSpec)-9);
  133.     { Now set the overlay path according to what we got and exit.  We have
  134.       to remove the trailing backslash from this path unless it is the only
  135.       one (indicating top level directory). }
  136.     If Pos ('\', OvrSpec) <> Length (OvrSpec) then
  137.       OvrSpec[0] := Pred(OvrSpec[0]); { Shorten by one char }
  138.     OvrPath (OvrSpec);
  139.     Exit;
  140.   end;
  141.   { If we get here, we did not find the overlay file!  Say so and exit. }
  142.   WriteLn (^G'UNABLE TO LOCATE OVERLAY FILE WUTIL.000!');
  143.   WriteLn ('This file must be in your current directory or on your PATH');
  144.   Halt (1);
  145. end {FindOverlay};
  146.  
  147. { **************************************************************************
  148.                    SPECIAL MS-DOS BIOS INTERFACE FUNCTIONS
  149.   ************************************************************************** }
  150.  
  151. { FindHDDriver - Step through the device driver chain and locate the hard
  152.   disk drivers.  First step through the user loaded drivers to see, if the
  153.   CHS driver is present.  Set the TwoDrives flag accordingly (TRUE if present,
  154.   FALSE if not present).  Then continue with the standard drivers and locate
  155.   the standard hard disk driver.  Set up pointers to both hard disk driver's
  156.   entry points.  The code attempts to make sure it finds what is expected (in
  157.   the standard driver chain) and returns a function value indicating whether
  158.   it succeeded or not.  It returns TRUE if it succeeded in finding the expected
  159.   standard drivers or FALSE if it failed.  If this function fails, calls to
  160.   DoHDFunction will not work; in other words, if this fails, it is impossible
  161.   to continue. }
  162. function FindHDDriver :Boolean;
  163. const
  164.   CHSString :String[25] = 'C.H.S. External Hard Disk';
  165. type
  166.   DeviceTableEntry = record
  167.     NextOffset, NextSegment     :Integer; { Ptr to next driver }
  168.     Flags                       :Integer;
  169.     Strategy                    :Integer;
  170.     Interrupt                   :Integer;
  171.     DeviceName                  :Array [0..7] of Char;
  172.   end;
  173. var
  174.   EntryPtr                      :^DeviceTableEntry;
  175.   CHSStringLength               :Integer;
  176.   SysVarSeg                     :Integer;
  177.   SysVarOfs                     :Integer;
  178.   Segment                       :Integer;
  179.   Offset                        :Integer;
  180.   Limit                         :Integer;
  181.   I                             :Integer;
  182. begin
  183.   TwoDrives        := FALSE;
  184.   CHSStringLength  := Length(CHSString);
  185.   If MSDOSVersion < 3 then I := 23 else I := 34;
  186.   { We'll find the beginning of the device driver list by means of an undocu-
  187.     mented function call 52H of INT21H.  The call returns a pointer to the
  188.     SYSVAR block in ES:BX.  At offset 34D (23D in MSDOS version 2) this block
  189.     contains a far pointer to the first device driver in the list. }
  190.   Registers.AX     := $5200;
  191.   MSDOS(Registers);
  192.   SysVarSeg        := Registers.ES;
  193.   SysVarOfs        := Registers.BX;
  194.   Offset           := MemW[SysVarSeg:SysVarOfs+I];
  195.   Segment          := MemW[SysVarSeg:SysVarOfs+I+2];
  196.   EntryPtr         := Ptr(Segment,Offset);
  197.   { Now we'll step through the list until we either hit the CHS driver or hit
  198.     the first standard device driver in the BIOS segment. }
  199.   while (Seg(EntryPtr^) <> BIOSSeg) and (not TwoDrives) do
  200.   begin
  201.     if EntryPtr^.Flags = CHSAttrib then
  202.     begin
  203.       { Got a driver with the same attribute as the CHS driver.  Now make sure
  204.         it really is the CHS driver. }
  205.       Offset := Ofs(EntryPtr^) + $800;
  206.       Limit  := Offset + $100;
  207.       while (Offset < Limit) and (not TwoDrives) do
  208.       begin
  209.         if Chr(Mem[Seg(EntryPtr^):Offset]) <> CHSString[1] then
  210.           Offset := Offset + 1
  211.         else
  212.         begin
  213.           I := 2;
  214.           while (I < CHSStringLength)
  215.             and (Chr(Mem[Seg(EntryPtr^):Offset+I-1]) = CHSString[I]) do I:=I+1;
  216.           if I <> CHSStringLength then Offset := Offset + 1
  217.           else
  218.           begin
  219.             TwoDrives := TRUE;
  220.             HDStrategy[2] := Ptr(Seg(EntryPtr^),EntryPtr^.Strategy);
  221.             HDInterrupt[2] := Ptr(Seg(EntryPtr^),EntryPtr^.Interrupt);
  222.           end;
  223.         end;
  224.       end;
  225.     end;
  226.     EntryPtr := Ptr(EntryPtr^.NextSegment,EntryPtr^.NextOffset);
  227.   end;
  228.   { We're pointing at the first standard driver now.  We'll step through
  229.     the chain now to make sure everything is the way we expect it.  Depen-
  230.     ding on the MS-DOS version we expect to find, in turn, either AUX, PRN,
  231.     CLOCK, floppy (for all MS-DOS versions prior V3.10, including V3.10 test
  232.     versions prior V3.10.017), or AUX, COM1, PRN, LPT1, CLOCK, floppy (for
  233.     MS-DOS V3.10).  The floppy driver will have a small number in the first
  234.     byte of the device name field. }
  235.   If EntryPtr^.DeviceName <> 'CON     ' then
  236.   begin
  237.     WriteLn ('**ERROR FindHDDriver - CON');
  238.     FindHDDriver := False;
  239.     Exit;
  240.   end;
  241.   EntryPtr := Ptr (EntryPtr^.NextSegment, EntryPtr^.NextOffset);
  242.   If EntryPtr^.DeviceName <> 'AUX     ' then
  243.   begin
  244.     WriteLn ('**ERROR FindHDDriver - AUX');
  245.     FindHDDriver := False;
  246.     Exit;
  247.   end;
  248.   { If the next entry is COM1, we're running on MS-DOS V3.10.  In this case
  249.     we'll set a flag to look for the LPT1 entry later, as well. }
  250.   EntryPtr := Ptr (EntryPtr^.NextSegment, EntryPtr^.NextOffset);
  251.   If EntryPtr^.DeviceName = 'COM1    ' then
  252.     begin
  253.       LongChain := TRUE;
  254.       EntryPtr := Ptr (EntryPtr^.NextSegment, EntryPtr^.NextOffset);
  255.     end
  256.     else LongChain := FALSE;
  257.  
  258.   If EntryPtr^.DeviceName <> 'PRN     ' then
  259.   begin
  260.     WriteLn ('**ERROR FindHDDriver - PRN');
  261.     FindHDDriver := False;
  262.     Exit;
  263.   end;
  264.   { If we have found COM1 earlier, the next driver must be LPT1 }
  265.   If LongChain = TRUE then
  266.   begin
  267.     EntryPtr := Ptr (EntryPtr^.NextSegment, EntryPtr^.NextOffset);
  268.     If EntryPtr^.DeviceName <> 'LPT1    ' then
  269.     begin
  270.       WriteLn ('**ERROR FindHDDriver - LPT1');
  271.       FindHDDriver := False;
  272.       Exit;
  273.     end;
  274.   end;
  275.   EntryPtr := Ptr (EntryPtr^.NextSegment, EntryPtr^.NextOffset);
  276.   If (EntryPtr^.DeviceName <> 'CLOCK   ') and
  277.      (EntryPtr^.DeviceName <> 'CLOCK$  ') then
  278.   begin
  279.     WriteLn ('**ERROR FindHDDriver - CLOCK/CLOCK$');
  280.     FindHDDriver := False;
  281.     Exit;
  282.   end;
  283.   EntryPtr := Ptr (EntryPtr^.NextSegment, EntryPtr^.NextOffset);
  284.   If Ord(EntryPtr^.DeviceName[0]) > 4 then
  285.   begin
  286.     WriteLn ('**ERROR FindHDDriver - Floppy Driver');
  287.     FindHDDriver := False;
  288.     Exit;
  289.   end;
  290.   { We've found the floppy driver entry.  If the hard disk driver was installed
  291.     in MS-DOS, we'll have an entry for it next.  If it wasn't (because the
  292.     disk wasn't initialized or didn't have MS-DOS partitions), we'll assume
  293.     it immediately follows the floppy entry.  In either case, we'll then check
  294.     what we have to make sure it looks like what we want. }
  295.   If (EntryPtr^.NextSegment <> -1) then
  296.     EntryPtr := Ptr (EntryPtr^.NextSegment, EntryPtr^.NextOffset)
  297.   else
  298.     EntryPtr := Ptr (Seg(EntryPtr^), Ofs(EntryPtr^) + 18);
  299.   { Now see if what we found appears to be the right thing. }
  300.   If ((EntryPtr^.Flags AND $E00F) <> $6000) or
  301.      (Ord(EntryPtr^.DeviceName[0]) > 4) then
  302.   begin
  303.     WriteLn ('**ERROR FindHDDriver - Hard Disk Driver');
  304.     FindHDDriver := False;
  305.     Exit;
  306.   end;
  307.   { Looks like we found the hard disk driver.  Copy the pointers from the
  308.     entry to our global storage locations. }
  309.   HDStrategy[1]  := Ptr (Seg(EntryPtr^), EntryPtr^.Strategy);
  310.   HDInterrupt[1] := Ptr (Seg(EntryPtr^), EntryPtr^.Interrupt);
  311.   { Now we have to check, if our hard disk driver contains code, which prevents
  312.     us from reading the disks HOM block.  This code has been added to the driver
  313.     with MS-DOS V3.10 (and all test versions after V3.10.016).  Since the long
  314.     device driver chain was implemented at the same time, we just use that flag
  315.     to determine, if the code is there.  If it is we have to patch in a JMP
  316.     instruction to skip that code. }
  317.   If LongChain = TRUE then
  318.   begin
  319.     PatchLocation := EntryPtr^.Interrupt + 21;
  320.     MemW[BIOSSeg:PatchLocation] := $10EB;
  321.   end;
  322.   { Now indicate we succeeded, and return. }
  323.   FindHDDriver := True;
  324. end {FindHDDriver};
  325.  
  326. { FindISRFlag - Set up pointer to BIOS Winchester "Done" flag.
  327.   This procedure tries to find the flag set by the MS-DOS Winchester Disk
  328.   interrupt service routine by looking through the code in the routine to find
  329.   the instruction which increments it.  It is passed the interrupt vector to
  330.   trace to the service routine and returns TRUE if it finds the location and
  331.   FALSE if it doesn't.  Global pointer variables ISRSeg and ISRFlag are
  332.   set appropriately if the routine completes successfully. }
  333. function FindISRFlag (Vector :Integer) :Boolean;
  334. const
  335.   ExpectedCodeLength = 4;
  336.   ExpectedCode :array[1..ExpectedCodeLength] of Byte = ($50, $2E, $FE, $06);
  337. var
  338.   Segment    :Integer;
  339.   ISROffset  :Integer;
  340.   VectorAddr :Integer;
  341.   I          :Integer;
  342. begin
  343.   { Determine location of interrupt vector and find the offset and segment
  344.     for the service routine.  Note that if the CHS driver is loaded we end
  345.     up at the flag of the CHS driver first. }
  346.   if TwoDrives then CurrentDrive := 2 else CurrentDrive := 1;
  347.   VectorAddr := Vector * 4;
  348.   ISROffset := MemW[0:VectorAddr];
  349.   Segment := MemW[0:VectorAddr+2];
  350.   { Now trace through ISR and find the code we expect to see.  If we fail at
  351.     any point to find what we expect, return FALSE and get out.  If we succeed,
  352.     then after we're done the word we retrieve will be the offset of the flag
  353.     we want. }
  354.   for I := 1 to ExpectedCodeLength DO
  355.   begin
  356.     if Mem[Segment:ISROffset] <> ExpectedCode[I] THEN
  357.     begin
  358.       FindISRFlag := FALSE;
  359.       Exit;
  360.     end
  361.     ELSE
  362.       ISROffset := ISROffset + 1;
  363.   end;
  364.   { If we get here, we've found what we want. As a sanity check we'll make
  365.     sure it's in the segment we expect it to be in. }
  366.   ISRFlag[CurrentDrive] := Ptr(Segment, MemW[Segment:ISROffset]);
  367.   if TwoDrives then Segment := Seg(HDStrategy[2]^) else Segment := BIOSSeg;
  368.   if Seg(ISRFlag[CurrentDrive]^) <> Segment then
  369.   begin
  370.     FindISRFlag := FALSE;
  371.     Exit;
  372.   end;
  373.   { If the CHS driver is loaded we have found it's flag before.  Now we need
  374.     to find the flag of the standard HD driver. }
  375.   if TwoDrives then
  376.     begin
  377.       CurrentDrive := 1;
  378.       I := Segment;
  379.       Segment := MemW[I:ISROffset-10];
  380.       ISROffset := MemW[I:ISROffset-8];
  381.       for I := 1 to ExpectedCodeLength DO
  382.       begin
  383.         if Mem[Segment:ISROffset] <> ExpectedCode[I] THEN
  384.         begin
  385.           FindISRFlag := FALSE;
  386.           Exit;
  387.         end
  388.         ELSE
  389.           ISROffset := ISROffset + 1;
  390.       end;
  391.       { If we get here, we've found what we want. As a sanity check we'll make
  392.         sure it's in the segment we expect it to be in. }
  393.       ISRFlag[CurrentDrive] := Ptr(Segment, MemW[Segment:ISROffset]);
  394.       if Seg(ISRFlag[CurrentDrive]^) <> BIOSSeg then
  395.       begin
  396.         FindISRFlag := FALSE;
  397.         Exit;
  398.       end;
  399.     end;
  400.   FindISRFlag := TRUE;
  401. end {FindISRFlag};
  402.  
  403. { FindHDData - Set up pointers to certain BIOS data locations.
  404.   This procedure tries to find various data items in the hard disk driver
  405.   by searching for a specific routine that references them.  The routine
  406.   searches for the hard disk BIOS routine "LDTSKF", which references a
  407.   data item called MAXTRK.  Once the location of MAXTRK is found, then
  408.   the locations of STEPRATE and PRECOMP, which follow MAXTRK, are computed.
  409.   When this routine completes, it fills in pointer variables as appropriate
  410.   if it succeeds in finding what it is looking for.  If it cannot find what
  411.   it wants, it returns FALSE as a function value, else it returns TRUE. }
  412. function FindHDData :Boolean;
  413. const
  414.   { This is the code which starts LDTSKF }
  415.   ExpectedCodeLength = 5;
  416.   ExpectedCode :array[0..ExpectedCodeLength] of Byte = ($B8, $01, $10,
  417.                                                         $3B, $16, $00);
  418. var
  419.   Segment    :Integer;
  420.   Offset     :Integer;
  421.   I, J, Limit:Integer;
  422.   Done       :Boolean;
  423. begin
  424.   { Search through the segment containing the hard disk driver for the first
  425.     byte of the expected code.  When we find it, then look for the remaining
  426.     bytes.  Continue to do this until we find the code sequence we want or
  427.     until we hit the location where the ISR Flag is.  If we find this, we have
  428.     gone too far. }
  429.   Offset := 0;
  430.   Segment := Seg(ISRFlag[CurrentDrive]^);
  431.   Limit := Ofs(ISRFlag[CurrentDrive]^);
  432.   Done := FALSE;
  433.   WHILE (NOT Done) AND (Offset < Limit) DO
  434.   begin
  435.     IF Mem[Segment:Offset] <> ExpectedCode[0] THEN
  436.       Offset := Offset + 1
  437.     ELSE
  438.     begin
  439.       I := 1;
  440.       WHILE (I < ExpectedCodeLength) AND
  441.             (Mem[Segment:Offset+I] = ExpectedCode[I]) DO I := I + 1;
  442.       IF I <> ExpectedCodeLength THEN Offset := Offset + 1 ELSE Done := TRUE;
  443.     end;
  444.   end;
  445.   IF NOT Done THEN
  446.   begin
  447.     FindHDData := FALSE;
  448.     EXIT;
  449.   end;
  450.   { We seem to have found the code we want.  Now pick up the next word, which
  451.     is the offset of the first data word we are locating.  Then, as a sanity
  452.     check, make sure it is less than the address where we found the reference
  453.     to it, because if it's not, something is not the way we expect.  NOTE THAT
  454.     THIS CODE USES SIGNED ARITHMETIC AND THAT THINGS WILL GO SERIOUSLY WRONG
  455.     IF THE SEGMENT CONTAINING THE HARD DISK SERVICE IS BIGGER THAN 32K.
  456.     However, this is not considered likely to ever happen in a million years,
  457.     so we'll ignore this problem. }
  458.   Offset := Offset + I;
  459.   I := MemW[Segment:Offset];
  460.   IF I >= Offset THEN
  461.   begin
  462.     FindHDData := FALSE;
  463.     EXIT;
  464.   end;
  465.   { OK, it looks like we've found the address we're looking for.  Note that
  466.     this is the address of MAXTRK, that STEPRATE follows in the next byte
  467.     (I + 2) and PRECOMP follows in the next word (I + 3).  Set up all the
  468.     pointers and then return to show we are OK. }
  469.   HDMAXTRK[CurrentDrive] := Ptr(Segment, I);
  470.   HDSTEPR[CurrentDrive] := Ptr(Segment, I + 2);
  471.   HDPRECOMP[CurrentDrive] := Ptr(Segment, I + 3);
  472.   FindHDData := TRUE;
  473. end {FindHDData};
  474.  
  475. { HDDone - Return TRUE when hard disk "done" interrupt occurs, FALSE if timeout.
  476.   This procedure waits for the hard disk interrupt service routine to set
  477.   its "done" flag.  It waits a maximum of about 8 second (the timeout
  478.   period used by Rainbow MS-DOS).  Note that this timeout is dependent on
  479.   execution of instructions and that the timeout constant may have to be
  480.   adjusted if you are running on an NEC V20 chip.  Routine returns TRUE if
  481.   completion was seen, FALSE if there was a timeout. }
  482. function HDDone :Boolean;
  483. const
  484.   NumSec = 8;          { Number of seconds to wait }
  485.   OneSec = 26000;      { (very) approx number of iterations per second }
  486. var
  487.   I, J :Integer;
  488. begin
  489.   FOR I := 1 TO NumSec DO FOR J := 1 TO OneSec DO IF ISRFlag[CurrentDrive]^ <> 0 THEN
  490.   begin
  491.     HDDone := TRUE;
  492.     EXIT;
  493.   end;
  494.   HDDone := FALSE;
  495. end {HDDone};
  496.  
  497. { ManualSeek - Manually commands controller to seek to given cylinder.
  498.   This procedure is used by the "park heads for shipping" option.  It tells
  499.   the controller to seek to a given cylinder, which would normally be one
  500.   greater than the maximum data cylinder.  A step rate is also passed, which
  501.   should be retrieved from the HOM block so that the correct value is used. }
  502. procedure ManualSeek (Cylinder :Integer; StepRate :Byte);
  503. var
  504.   Temp :Boolean;
  505. begin
  506.   { Load "task file" registers for command }
  507.   Port[SectorCountPort]         := 1;
  508.   Port[SectorNumberPort]        := 1;
  509.   Port[CylinderLowPort]         := Lo(Cylinder);
  510.   Port[CylinderHighPort]        := Hi(Cylinder);
  511.   if (TwoDrives = TRUE) and (CurrentDrive = 2)
  512.      then Port[SDHPort] := $28  { Head 0, Drive 1, 512 bytes/sector }
  513.      else Port[SDHPort] := $20; { Head 0, Drive 0, 512 bytes/sector }
  514.   { Set done flag to false }
  515.   ISRFlag[CurrentDrive]^ := 0;
  516.   { Send seek command to controller, wait for completion.  Status is
  517.     inconsequential. }
  518.   Port[CommandPort]             := ($70 OR (StepRate AND $0F));
  519.   Temp := HDDone;
  520. end {ManualSeek};
  521.  
  522.  
  523. { **************************************************************************
  524.                     HIGHER-LEVEL PROCEDURES AND FUNCTIONS
  525.   ************************************************************************** }
  526.  
  527. { ReadMajorBlocks - Read HOM/OSN/DPD/BAT blocks into global buffers.
  528.   Reads the four major blocks from the disk into the global buffer areas
  529.   HOMBlock, OSNBlock, and DPDBlock, and loads the array SectorTable with
  530.   information about good/bad sectors from the various BAT Blocks.  If all
  531.   this succeeds, returns with function value TRUE.  Else, displays an error
  532.   screen, waits for a key to be pressed, and then returns FALSE.   This routine
  533.   will also check a few pieces of information about the disk's geometry.  Even
  534.   if reading the HOM block succeeds, an error screen will be displayed and
  535.   the value FALSE will be returned if some of the paremters do not match what
  536.   we expect.  It is not necessary for the BAT and AST information to be correct.
  537.   If there is a problem with this information, we'll warn the user but try
  538.   to continue. }
  539.  
  540. function ReadMajorBlocks :Boolean;
  541. var
  542.   I, J          :Integer;
  543.   ErrorSeen     :Boolean;
  544.   BATError      :Boolean;
  545.   ASTError      :Boolean;
  546.   Trk           :Integer;
  547.   Sec           :Byte;
  548.   SaveDPD       :DPDEntry;
  549.   TempString    :Str80;
  550. begin
  551.   { Set number of surfaces in home block to 4 until we have a chance
  552.     to read the REAL number of surfaces.  This will let us do initial
  553.     computations so we can read the home block, which is in track 0. }
  554.   HOMBlock.HOM.Surfaces := 4;
  555.  
  556.   { Read home block and OSN/DPD blocks.  Exit if all OK. }
  557.  
  558.   ErrorSeen := Not(ReadHOMBlock (0, 2, HOMBlock));
  559.  
  560.   IF (Not ErrorSeen) then
  561.   With HOMBlock.HOM do
  562.   If (PartFlag <> $00) or
  563.      (DPDLocation.Length <> 1) or
  564.      (OSNLocation.Length <> 1) or
  565.      (SectorsPerTrack <> 16) or
  566.      (SectorSize <> 512) or
  567.      (NumAltTracks > 50) or
  568.      (Surfaces*Cylinders > (TrackLimit+1)) then
  569.   begin
  570.     DrawOutline;
  571.     StartFastVideo (10, 4, AtBold, 78, 23);
  572.     Center ('Your disk is incompatible with WUTIL');
  573.     WriteLn;
  574.     WriteLn;
  575.     FVAttribute := AtNormal;
  576.     WriteFastLn ('Sorry, but some parameters of your disk (according to data in');
  577.     WriteFastLn ('the disk''s HOMe block) are incompatible with WUTIL.  In order');
  578.     WriteFastLn ('for WUTIL to be used with a disk, the following must be true:');
  579.     FVLMargin := 12;  FVAttribute := AtBold;
  580.     WriteLn;
  581.     WriteFastLn ('- The disk must have 512 byte sectors and 16 sectors/track');
  582.     WriteFastLn ('- There can be no more than 50 alternate sector tracks');
  583.     Str (TrackLimit+1, TempString);
  584.     WriteFastLn (Concat ('- The entire disk capacity can be no more than ',
  585.                          TempString,
  586.                          ' tracks'));
  587.     WriteFastLn ('- There must be exactly 1 DPD block and 1 OSN block');
  588.     FVLMargin := 10;  FVAttribute := AtNormal;
  589.     WriteLn;
  590.     WriteFastLn ('If you believe all the above are true about your disk, then');
  591.     WriteFastLn ('you should use the "Format and Initialize disk" option from');
  592.     WriteFastLn ('the main menu.  This will write correct information on the');
  593.     WriteFastLn ('disk and allow you to use it with WUTIL.');
  594.     FVRow := 22;  FVAttribute := AtBold;
  595.     Center ('Press any key to continue');
  596.     I := RawChar;
  597.     ReadMajorBlocks := FALSE;
  598.     Exit;
  599.   end;
  600.  
  601.   If not ErrorSeen then
  602.     ErrorSeen := Not(ReadDPDBlock (HOMBlock.HOM.DPDLocation.Track,
  603.                                    HOMBlock.HOM.DPDLocation.Sector, DPDBlock));
  604.  
  605.   If not ErrorSeen then
  606.     ErrorSeen := Not(ReadOSNBlock (HOMBlock.HOM.OSNLocation.Track,
  607.                                    HOMBlock.HOM.OSNLocation.Sector, OSNBlock));
  608.  
  609.   { Make sure the entries in the DPD block are in track order.  We don't like
  610.     them any other way.  We'll sort them with a little shell sort here if
  611.     we have to to get 'em right. }
  612.   If Not ErrorSeen then
  613.     With DPDBlock.DPD do For I := 1 To EntryCount-1 do
  614.       For J := I + 1 to EntryCount do
  615.         If Entry[I].FirstTrack > Entry[J].FirstTrack then
  616.         begin
  617.           SaveDPD := Entry[I];
  618.           Entry[I] := Entry[J];
  619.           Entry[J] := SaveDPD;
  620.         end;
  621.  
  622.   { Check the OSN block's storage of operating system names.  If we find
  623.     any names which contain nulls rather than spaces (other than in the
  624.     first position), we'll change those to spaces so that the names will
  625.     be space-padded on the right rather than null-padded.  This code is
  626.     here to try and make OSN data written by "other" partitioning programs
  627.     conform to the DEC standard and to WUTIL. }
  628.   If Not ErrorSeen then
  629.     With OSNBlock.OSN do for I := 0 to 30 do if Entry[I][0] <> #0 then
  630.       For J := 1 to 15 do if Entry[I][J] = #0 then Entry[I][J] := ' ';
  631.  
  632.   { Read all the BAT blocks, one at a time, and load their data into our
  633.     internal table of block data.  If any of this fails, we'll attempt to
  634.     continue, but we'll warn the person that this is happening. }
  635.  
  636.   BATError := False;
  637.   FillChar (SectorTable, 2*(TrackLimit+1), 0); { Initialize data to all zeroes }
  638.   I := 0;
  639.   Trk := HOMBlock.HOM.BATLocation.Track;
  640.   Sec := HOMBlock.HOM.BATLocation.Sector;
  641.   While (I < HOMBlock.HOM.BATLocation.Length) and (Not ErrorSeen)
  642.     and (Not BATError) do
  643.   begin
  644.     BATError := Not(ReadBATBlock (Trk, Sec, I, TempBlock));
  645.     If Not BATError then With TempBlock.BAT do For J := 0 to 249 do
  646.       SectorTable[FirstSector.Track + J] := Entry[J];
  647.     I := I + 1;
  648.     NextSector (Trk, Sec);
  649.   end;
  650.  
  651.   { Read all the AST blocks, one at a time, and load their data into our
  652.     internal table of alternate sector data. }
  653.  
  654.   ASTError := False;
  655.   FillChar (ASTVector, 3*800, 0); { Initialize data to all zeroes }
  656.   I := 0;
  657.   Trk := HOMBlock.HOM.ASTLocation.Track;
  658.   Sec := HOMBlock.HOM.ASTLocation.Sector;
  659.   While (I < HOMBlock.HOM.ASTLocation.Length) and (Not ErrorSeen)
  660.     and (Not ASTError) do
  661.   begin
  662.     ASTError := Not(ReadASTBlock (Trk, Sec, I, TempBlock));
  663.     If Not ASTError then With TempBlock.AST do For J := 0 to EntryCount-1 do
  664.       With Entry[J] do if GoodSector <> 0 then
  665.         ASTData[GoodTrackOffset, GoodSector] := BadSectorAddress;
  666.     I := I + 1;
  667.     NextSector (Trk, Sec);
  668.   end;
  669.  
  670.   IF Not ErrorSeen then
  671.   begin
  672.     IF BATError then
  673.     begin
  674.       DrawOutline;
  675.       Write (^G);
  676.       StartFastVideo (3, 10, AtBold, 78, 23);
  677.       Center ('Bad sector information could not be read from your disk.');
  678.       FVAttribute := AtNormal;
  679.       Center ('This means that either your disk is damaged in some way');
  680.       Center ('or it has not been properly formatted and initialized.');
  681.       Center ('WUTIL will attempt to continue this processing,');
  682.       Center ('but any information about bad sectors is suspect.');
  683.       FVRow := 22;  FVAttribute := AtBold;
  684.       Center ('Press any key to continue');  
  685.       I := RawChar;
  686.     end;
  687.     IF ASTError then
  688.     begin
  689.       DrawOutline;
  690.       Write (^G);
  691.       StartFastVideo (3, 10, AtBold, 78, 23);
  692.       Center ('Alternate sector information could not be read from your disk.');
  693.       FVAttribute := AtNormal;
  694.       Center ('This means that either your disk is damaged in some way');
  695.       Center ('or it has not been properly formatted and initialized.');
  696.       Center ('WUTIL will attempt to continue this processing,');
  697.       Center ('but any information about bad sectors is suspect.');
  698.       FVRow := 22;  FVAttribute := AtBold;
  699.       Center ('Press any key to continue');  
  700.       I := RawChar;
  701.     end;
  702.     ReadMajorBlocks := TRUE;
  703.     Exit;
  704.   end;
  705.  
  706.   { We get here only if something failed (otherwise we would have executed
  707.     the Exit, above.  Display an error screen and wait for a key to be hit.
  708.     Then return FALSE. }
  709.  
  710.   DrawOutline;
  711.   StartFastVideo (3, 10, AtBold, 78, 23);
  712.   Center ('Your disk does not appear to be properly initialized');
  713.   FVAttribute := AtNormal;
  714.   Center ('Major information/partitioning data structures could not be read');
  715.   Center ('from the disk.  This means that either your disk is damaged in');
  716.   Center ('some way or it has not been formatted and initialized.  You must');
  717.   Center ('use the "Format and Initialize disk" option from the main menu');
  718.   Center ('with this disk before you can perform this function.');
  719.   FVRow := 22;  FVAttribute := AtBold;
  720.   Center ('Press any key to continue');  
  721.   I := RawChar;
  722.  
  723.   ReadMajorBlocks := FALSE;
  724.  
  725. end {ReadMajorBlocks};
  726.  
  727. { PrintGeneralDiskInfo - Prints data about disk from HOM block.
  728.   This procedure prints much of the data which appears in the "general
  729.   information" section of the output of the "print disk info" function.  It
  730.   is incorporated as a procedure here because it is also used by the format
  731.   disk routine to confirm that the desired format is being used. }
  732. procedure PrintGeneralDiskInfo;
  733. begin
  734.   With HOMBlock.HOM do
  735.   begin
  736.     WriteFastLn (Concat('Volume ID: ',VolumeID));
  737.     WriteFast ('System ID: ');
  738.     WriteLn (SystemID[0],',',SystemID[1]);
  739.     WriteFast ('Disk type is ');
  740.     Write (TypeCode);
  741.     CASE TypeCode OF
  742.        6:  WriteFast (' (RD53), ');
  743.        8:  WriteFast (' (RD52), ');
  744.       10:  WriteFast (' (RD51), '); { Only these three values }
  745.       12:  WriteFast (' (RD50), '); { have been defined }
  746.       14:  WriteFast (' (RD31), '); { by DEC }
  747.       16:  WriteFast (' (RD32), ');
  748.       ELSE WriteFast (' (Unknown), ');
  749.     end;
  750.     if PartFlag = 0 then
  751.       WriteFastLn ('Partitioned')
  752.     else
  753.       WriteFastLn ('Not Partitioned');
  754.     Write ('Disk contains ',Cylinders,' (');
  755.     WriteHex4 (Cylinders);  Write ('H) cylinders on ',Surfaces,' surfaces');
  756.     WriteLn (' (', (Cylinders * Surfaces), ' logical tracks)');
  757.     WriteFastLn
  758. ('There are 16 (decimal) sectors per track and 512 (decimal) bytes per sector');
  759.     WriteLn;
  760.     Write ('BAT:  '); WriteTSL (BATLocation);  WriteLn;
  761.     Write ('DPD:  '); WriteTSL (DPDLocation);  WriteLn;
  762.     Write ('OSN:  '); WriteTSL (OSNLocation);  WriteLn;
  763.     Write ('BOOT: '); WriteTSL (BOOTLocation);  WriteLn;
  764.     Write ('AST:  '); WriteTSL (ASTLocation);  WriteLn;
  765.     WriteLn;
  766.     WriteFast ('Alternate sector tracks: ');
  767.     if NumAltTracks = 0 then
  768.       WriteFast ('None')
  769.     else
  770.     begin
  771.       WriteFast (Concat(Hex4Digit (FirstAltTrack), 'H thru ',
  772.                         Hex4Digit (FirstAltTrack + NumAltTracks - 1), 'H'));
  773.     end;
  774.     WriteLn;
  775.     WriteFastLn (Concat ('Maintenence tracks:      ',
  776.                          Hex4Digit (MaintCylinder * Surfaces),
  777.                          'H thru ',
  778.                          Hex4Digit
  779.                           ((MaintCylinder * Surfaces) + Surfaces - 1),
  780.                          'H'));
  781.     WriteFastLn (Concat ('Manufacturing tracks:    ',
  782.                          Hex4Digit  (MfgCylinder * Surfaces),
  783.                          'H thru ',
  784.                          Hex4Digit
  785.                           ((MfgCylinder * Surfaces) + Surfaces - 1),
  786.                          'H'));
  787.     WriteLn;
  788.     WriteFast ('Write pre-comp starts at cylinder ');
  789.     Write (PreCompValue * 4);
  790.     WriteFast ('; Step rate = ');
  791.     If StepRate = 0 then WriteFastLn ('35 ╡s')
  792.                     else WriteLn ((0.5 * StepRate):1:1, ' ms');
  793.   end;
  794. end {PrintGeneralDiskInfo};
  795.  
  796. { WriteASTBlocks - Write current AST data in internal array to disk.
  797.   This procedure takes the information in memory about alternate sectors and
  798.   writes it to the disk in the places appropriate for AST blocks.  It is
  799.   expected that the block in HOMBlock contains a current Home block for the
  800.   disk.  Also, TempBlock is used by this routine. }
  801. procedure WriteASTBlocks;
  802. var
  803.   Trk           :Integer;
  804.   Sec           :Byte;
  805.   I, J, K       :Integer;
  806. begin
  807.   { Make sure the number of sectors allocated for alternate sector information
  808.     is sufficient.  If it isn't, we'll skip writing this stuff and warn the
  809.     user that we're doing this. }
  810.   With HOMBlock.HOM do
  811.   If ASTLocation.Length < ComputeASTBlocks (NumAltTracks * 16) then
  812.   begin
  813.     DrawOutline;
  814.     FVRow := 10;  FVAttribute := AtBold;
  815.     Center ('Insufficient space for Alternate Sector Table');
  816.     WriteLn;
  817.     FVAttribute := AtNormal;
  818.     Center ('Your hard disk was initialized with insufficient space to hold');
  819.     Center ('the Alternate Sector Table (AST).');
  820.     Center ('The writing of the Alternate Sector Table is being bypassed.');
  821.     Center ('Correct operation of your disk cannot be guaranteed');
  822.     Center ('under these circumstances.');
  823.     WriteLn;
  824.     Center ('NOTE:  If your disk was formatted with WUTIL, this indicates');
  825.     Center ('a serious error condition.  Please report this bug.');
  826.     FVRow := 22; FVAttribute := AtBold;
  827.     Center ('Press any key to continue...');
  828.     I := RawChar;
  829.     Exit;
  830.   end;
  831.  
  832.   { Everything looks OK.  Initialize and begin writing AST data. }
  833.  
  834.   TempBlock.AST.LBN := $FF;
  835.   TempBlock.AST.MaxEntries := 0;
  836.   TempBlock.AST.EntryCount := 0;
  837.   { Start "Trk" and "Sec" pointing one sector before AST area }
  838.   Trk := HOMBlock.HOM.ASTLocation.Track;
  839.   Sec := HOMBlock.HOM.ASTLocation.Sector;
  840.   PrevSector (Trk, Sec);
  841.   { Loop for each sector in each alternate track }
  842.   For I := 0 to (HOMBlock.HOM.NumAltTracks - 1) do For J := 1 to 16 do
  843.   begin
  844.     { If we have filled current block, write it out and then set up another
  845.       one.  Don't write out logical block $FF, this is a dummy entry to start
  846.       us off! }
  847.     If TempBlock.AST.EntryCount >= TempBlock.AST.MaxEntries then
  848.     begin
  849.       If TempBlock.AST.LBN <> $FF then WriteMajorBlock (Trk, Sec, TempBlock);
  850.       K := Lo(TempBlock.AST.LBN + 1);
  851.       NextSector (Trk, Sec);
  852.       FillChar (TempBlock, 512, 0);
  853.       With TempBlock.AST do
  854.       begin
  855.         ID := 'AST';
  856.         LBN := K;
  857.         MaxEntries := 100;
  858.       end;
  859.     end;
  860.     { Now add entry to current AST block }
  861.     With TempBlock.AST do
  862.     begin
  863.       With Entry[EntryCount] do
  864.       begin
  865.         BadSectorAddress := ASTData[I, J];
  866.         GoodTrackOffset := I;
  867.         GoodSector := J;
  868.       end;
  869.       EntryCount := EntryCount + 1;
  870.     end;
  871.   end;
  872.   { Write the last AST block }
  873.   If TempBlock.AST.LBN <> $FF then WriteMajorBlock (Trk, Sec, TempBlock);
  874. end {WriteASTBlocks};
  875.  
  876. { WriteBATBlocks - Write current BAT data in internal array to disk.
  877.   This procedure takes the information in memory about good/bad sectors and
  878.   writes it to the disk in the places appropriate for BAT blocks.  It is
  879.   expected that the block in HOMBlock contains a current Home block for the
  880.   disk.  Also, TempBlock is used by this routine. }
  881. procedure WriteBATBlocks;
  882. var
  883.   Trk           :Integer;
  884.   Sec           :Byte;
  885.   I, J          :Integer;
  886. begin
  887.   { Make sure the number of sectors allocated for BAT area is sufficient
  888.     If it isn't, we'll skip writing this stuff and warn the user that we're
  889.     doing this. }
  890.   With HOMBlock.HOM do
  891.   If BATLocation.Length < ComputeBATBlocks (Cylinders*Surfaces) then
  892.   begin
  893.     DrawOutline;
  894.     FVRow := 10;  FVAttribute := AtBold;
  895.     Center ('Insufficient space for Bad Sector Information');
  896.     WriteLn;
  897.     FVAttribute := AtNormal;
  898.     Center ('Your hard disk was initialized with insufficient space to hold');
  899.     Center ('the Bad Address Table (BAT).');
  900.     Center ('The writing of the Bad Address Table is being bypassed.');
  901.     Center ('Correct operation of your disk cannot be guaranteed');
  902.     Center ('under these circumstances.');
  903.     WriteLn;
  904.     Center ('NOTE:  If your disk was formatted with WUTIL, this indicates');
  905.     Center ('a serious error condition.  Please report this bug.');
  906.     FVRow := 22; FVAttribute := AtBold;
  907.     Center ('Press any key to continue...');
  908.     I := RawChar;
  909.     Exit;
  910.   end;
  911.  
  912.   { Everything looks OK.  Initialize and begin writing AST data. }
  913.  
  914.   I := 0;
  915.   Trk := HOMBlock.HOM.BATLocation.Track;
  916.   Sec := HOMBlock.HOM.BATLocation.Sector;
  917.   While I < HOMBlock.HOM.BATLocation.Length do
  918.   begin
  919.     FillChar (TempBlock, 512, 0);
  920.     With TempBlock.BAT do
  921.     begin
  922.       ID := 'BAT';
  923.       LBN := I;
  924.       FirstSector.Track := 250 * I;
  925.       FirstSector.Sector := 1;
  926.       LastSector.Track := (250 * (I + 1)) - 1;
  927.       LastSector.Sector := 16;
  928.       For J := 0 to 249 do Entry[J] := SectorTable[FirstSector.Track + J];
  929.     end;
  930.     WriteMajorBlock (Trk, Sec, TempBlock);
  931.     I := I + 1;
  932.     NextSector (Trk, Sec);
  933.   end;
  934. end {WriteBATBlocks};
  935.  
  936. { GetMenuSelection - Displays menu and returns value of selection.
  937.   This function clears the screen, displays a menu according to the information
  938.   in the "menu" structure passed to it, and waits for the user to select an
  939.   item from the menu.  The value of the selected item (of type MenuFunction)
  940.   is returned as a function value.  If the global variable EXITAllowed is
  941.   set to TRUE, the RawChar function which this routine calls will allow
  942.   exit by hitting the EXIT key; this fact will be noted in the instructions
  943.   at the bottom of the screen.  Up to three additional lines of data can be
  944.   passed, which are displayed, centered, on the menu screen in addition to the
  945.   menu.  A set is also passed which describes additional function keys which
  946.   may be typed other than DO, ENTER, or RETURN.  The terminator key code is
  947.   returned, or a zero is returned for DO, ENTER, or RETURN.  NOTE THAT THIS
  948.   ROUTINE TURNS ON FAST VIDEO I/O MODE IF IT HAS NOT ALREADY BEEN TURNED ON
  949.   (IT CALLS StartFastVideo); IT IS ASSUMED ACTUALLY THAT THIS HAS ALREADY BEEN
  950.   CALLED; THIS ROUTINE WILL EXIT WITH FAST VIDEO MODE ENABLED WHETHER IT WAS
  951.   PREVIOUSLY ENABLED OR NOT. }
  952.  
  953. function GetMenuSelection (VAR M:Menu;
  954.                            Functions :KeysAllowed;
  955.                            LineOne, LineTwo, LineThree :Str80;
  956.                            VAR Terminator :Integer) :MenuFunction;
  957. var
  958.   Current     :Integer;         { Currently selected item }
  959.   ItemLength  :Integer;         { Length of descriptive text items }
  960.   I, J, K     :Integer;         { Temporary values }
  961.   Confirmed   :Boolean;         { TRUE once a menu selection has been
  962.                                   confirmed with RETURN, DO, or ENTER }
  963. begin
  964.   { Determine the length items in the menu will have.  Account for four extra
  965.     characters (one digit, a period, and two spaces) }
  966.  
  967.   ItemLength := Length (M.Selection[1].Name) + 4;
  968.  
  969.   { Draw a box around the perimiter of the screen and display the menu
  970.     itself.  Also set up margins, etc. for the menu items. }
  971.  
  972.   DrawOutline;
  973.   StartFastVideo (2, 3, AtNormal, 79, 23);
  974.   Center (LineOne);
  975.   If LineTwo = 'MX' then
  976.     If TwoDrives then
  977.       begin
  978.         FVAttribute := AtBold;
  979.         Center ('Press CTRL-SHIFT-SELECT to select physical drive');
  980.       end
  981.     else
  982.   else Center (LineTwo);
  983.   Center (LineThree);
  984.   FVAttribute := AtBold;
  985.   Center (M.MenuHeader);
  986.   StartFastVideo (((80 - ItemLength) DIV 2 + 1), 8, AtNormal, 79, 24);
  987.   DrawBox (FVLMargin - 2, FVTMargin-1, FVLmargin + ItemLength + 1,
  988.            FVTMargin + M.NumberOfSelections, AtBold);
  989.   FVAttribute := AtNormal;
  990.   for I := 1 TO M.NumberOfSelections do
  991.     WriteFastLn (Concat (Chr(I+Ord('0')), '.  ', M.Selection[I].Name));
  992.  
  993.   FVRow := 20; FVAttribute := AtBold;
  994.   Center ('Use the arrow keys or the number keys to select an item.');
  995.   Center ('Then press RETURN, DO, or ENTER to confirm your selection.');
  996.   if EXITAllowed then
  997.   begin
  998.     if MainScreenKeyVal IN Functions then
  999.       Center ('(Or press MAIN SCREEN for main menu, EXIT to return to MS-DOS)')
  1000.     else
  1001.       Center ('(Or press EXIT to return to MS-DOS)');
  1002.   end
  1003.   else if MainScreenKeyVal in Functions then
  1004.     Center ('(Or press MAIN SCREEN for main menu)');
  1005.  
  1006.   { Now the menu has been displayed.  The big loop below starts by highlighting
  1007.     the currently-selected item.  Then it waits for a key to be pressed.  After
  1008.     the key is pressed, it is acted upon (in some cases by just ringing the
  1009.     bell and doing nothing). }
  1010.  
  1011.   Current := 1;                 { Initially, first choice is "current" }
  1012.   Confirmed := FALSE;           { But not yet confirmed }
  1013.   While not Confirmed do
  1014.   begin
  1015.     { Redisplay current item in reverse video }
  1016.     FVColumn := FVLMargin;  FVRow := FVTMargin + Current - 1;
  1017.     FVAttribute := AtReverse;
  1018.     WriteFast (Concat (Chr(Current+Ord('0')), '.  ', M.Selection[Current].Name));
  1019.  
  1020.     { Get a key }
  1021.     K := (RawChar AND CapsLockMask);
  1022.  
  1023.     { Perform some translations.  Keypad 0-9 is translated to digits 0-9.
  1024.       Enter and DO are translated to RETURN }
  1025.  
  1026.     if ((K = DoKeyCode) or (K = KeypadEnterKeyCode)) then
  1027.       K := ReturnKeyCode
  1028.     else if ((K >= Keypad0KeyCode) and (K <= Keypad9KeyCode)) then
  1029.       K := ((K - Keypad0KeyCode) div 3) + Digit0KeyCode;
  1030.  
  1031.     { Return to normal video for current item, it may be changed }
  1032.     FVColumn := FVLMargin;
  1033.     FVAttribute := AtNormal;
  1034.     WriteFast (Concat (Chr(Current+Ord('0')), '.  ', M.Selection[Current].Name));
  1035.  
  1036.     { Now see what we got for a key and process accordingly }
  1037.  
  1038.     if K = 13 then                      { return or equivalent }
  1039.     begin
  1040.       Terminator := 0;
  1041.       Confirmed := TRUE;
  1042.     end
  1043.     else if (K >  Digit0KeyCode)
  1044.         and (K <= Digit0KeyCode + M.NumberOfSelections) then
  1045.       Current := K - Digit0KeyCode
  1046.     else if K = UpArrowKeyCode then
  1047.     begin
  1048.       Current := Current - 1;
  1049.       if Current < 1 then Current := M.NumberOfSelections;
  1050.     end
  1051.     else if K = DownArrowKeyCode then
  1052.     begin
  1053.       Current := Current + 1;
  1054.       if Current > M.NumberOfSelections then Current := 1;
  1055.     end
  1056.     else if (K-$100) IN Functions then
  1057.     begin
  1058.       Terminator := K;
  1059.       Confirmed := TRUE;
  1060.     end
  1061.     else if TwoDrives and (LineTwo = 'MX') and (K = Ctrl+Shift+SelectKeyCode)
  1062.     then
  1063.     begin
  1064.       CurrentDrive := CurrentDrive + 1;
  1065.       if CurrentDrive = 3 then CurrentDrive := 1;
  1066.       HDStrat      := HDStrategy[CurrentDrive];
  1067.       HDInter      := HDInterrupt[CurrentDrive];
  1068.       FVRow := 24; FVAttribute := AtBold;
  1069.       Center (Concat(' Physical Drive ',Chr($30+CurrentDrive),' selected '));
  1070.     end
  1071.     else                                { invalid key - ring the bell }
  1072.       Write (^G);
  1073.   end;
  1074.  
  1075.   { When we get here, a choice has been confirmed!  Return with the
  1076.     value for the one we selected }
  1077.  
  1078.   GetMenuSelection := M.Selection[Current].Value;
  1079.  
  1080. end {GetMenuSelection};
  1081.  
  1082. { FormatCPMPartition - Builds structures necessary for a (C)CP/M partition.
  1083.   This procedure is passed the starting and ending track numbers for a
  1084.   partition which is to be initialized for use by either CP/M or CCP/M.
  1085.   It is also passed the name of the partition, in case an error message must
  1086.   be printed.  The procedure then performs the actions necessary to build the
  1087.   partition on disk. }
  1088. procedure FormatCPMPartition (StartTrack, EndTrack :Integer; Name :Str60);
  1089. var
  1090.   Data :SectorBlock;
  1091.   I, J, K, Count :Integer;
  1092.   NumAltSectors :Integer;
  1093. begin
  1094.   { First, we want to make sure the alternate sector table jives with this
  1095.     partition and the bad sectors within it.  We'll start by scanning the
  1096.     current AST for sectors falling within the range of tracks which makes
  1097.     up this partition.  We'll delete each of them.  Then we'll go through
  1098.     all the sectors in our partition, find the bad ones, and create entries
  1099.     in the AST (up to a maximum of 100, since that's the most we can fit in
  1100.     our private PAS block). }
  1101.   NumAltSectors := (HOMBlock.HOM.NumAltTracks * 16);
  1102.   For I := 0 to (NumAltSectors - 1) do
  1103.   begin
  1104.     J := ASTVector[I].Track;
  1105.     If (J >= StartTrack) and (J <= EndTrack) then
  1106.     begin
  1107.       ASTVector[I].Track := 0;
  1108.       ASTVector[I].Sector := 0;
  1109.     end;
  1110.   end;
  1111.  
  1112.   Count := 0;
  1113.  
  1114.   For I := StartTrack to EndTrack do
  1115.     If SectorTable[I].Num <> 0 then
  1116.       For J := 1 to 16 do
  1117.         If SectorIsBad (I, J) then
  1118.         begin
  1119.           Count := Count + 1;
  1120.           If Count < 101 then
  1121.           begin
  1122.             K := 0;
  1123.             While (K < NumAltSectors)
  1124.               and (ASTVector[K].Sector <> 0) do K := K + 1;
  1125.             { If we couldn't find an available slot in the AST area, then
  1126.               set the count of bad sectors to a high value, which will force
  1127.               an error message when we leave this loop.  Otherwise, use the
  1128.               slot we found to record this bad sector information. }
  1129.             If K = NumAltSectors then Count := 101
  1130.             else With ASTVector[K] do
  1131.             begin
  1132.               Track := I;
  1133.               Sector := J;
  1134.             end;
  1135.           end;
  1136.         end;
  1137.  {end..end}
  1138.  
  1139.  { We have a value in "Count" which indicates how many bad sectors we found
  1140.    (or it has been dummied to "101" if we filled the alternate sector table).
  1141.    If its value exceeds 100, this means we were not able to create alternate
  1142.    sector entries for all the bad sectors in this partition.  Print a warning
  1143.    message. }
  1144.  
  1145.   If Count > 100 then
  1146.   begin
  1147.     DrawOutline;
  1148.     StartFastVideo (10, 10, AtBold, 79, 23);
  1149.     Write (^G);
  1150.     Center ('Too many bad sectors in CP/M or CCP/M partition');
  1151.     WriteLn;
  1152.     FVAttribute := AtDefault;
  1153.     WriteFastLn (Concat ('Partition:  ', Name));
  1154.     WriteLn;
  1155.     WriteFastLn ('Either (1) The partition named above had more than 100 bad sectors');
  1156.     WriteFastLn ('Or     (2) All available alternate sectors have been used');
  1157.     WriteLn;
  1158.     WriteFastLn ('In either case, the partition may not be usable.');
  1159.     WriteLn;
  1160.     FVAttribute := AtBold;
  1161.     Center ('Press any key to continue');
  1162.     I := RawChar;
  1163.   end;
  1164.  
  1165.   { Now we're ready to build the PAS block, which contains information about
  1166.     alternate sectors to be used by this partition.  We'll build it using
  1167.     data in our alternate sector table.  We'll use the definition for the AST
  1168.     block, because they are actually identical except for the block ID they
  1169.     contain and the scope of the data within them. }
  1170.   FillChar (Data, 512, 0);
  1171.   With Data.AST do
  1172.   begin
  1173.     ID := 'PAS';
  1174.     MaxEntries := 100;
  1175.     For I := 0 to (HOMBlock.HOM.NumAltTracks - 1) do
  1176.     For J := 1 to 16 do
  1177.     begin
  1178.       K := ASTData[I, J].Track;
  1179.       If (K >= StartTrack) and (K <= EndTrack) then
  1180.       begin
  1181.         With Entry[EntryCount] do
  1182.         begin
  1183.           BadSectorAddress := ASTData[I, J];
  1184.           GoodTrackOffset := I;
  1185.           GoodSector := J;
  1186.         end;
  1187.         EntryCount := EntryCount + 1;
  1188.       end;
  1189.     end;
  1190.   end;
  1191.  
  1192.   { We've built all the data for the PAS block.  Now compute a checksum for
  1193.     it and write it to disk (first sector of first track of partition). }
  1194.   Data.AST.Checksum := -(Checksum(Data));
  1195.   WriteNoError (StartTrack, 1, Data);
  1196.  
  1197.   { Now we want to fill the remainder of the first two tracks of the
  1198.     partition with zeroes (the boot area).  }
  1199.   FillChar (Data, 512, 0);
  1200.   For I := StartTrack to StartTrack + 1 do
  1201.   For J := 1 to 16 do
  1202.   If (I > StartTrack) or (J > 1) then { Don't rewrite PAS block! }
  1203.     WriteNoError (I, J, Data);
  1204.  
  1205.   { Now initialize the directory.  We have to set all the directory entries
  1206.     to unused and then write all 16 directory blocks with these entries. }
  1207.   With Data do For I := 0 to 15 do SectorBytes[I*32] := $E5;
  1208.   For J := 1 to 16 do WriteNoError ((StartTrack + 2), J, Data);
  1209.  
  1210.   { The CP/M or CCP/M partition has been built!  Return now. }
  1211. end {FormatCPMPartition};
  1212.  
  1213. { FormatMSDOSPartition - Builds structures necessary for an MS-DOS partition.
  1214.   This procedure is passed the starting and ending track numbers for a
  1215.   partition which is to be initialized for use by MS-DOS.  It is also passed
  1216.   the name of the partition, in case an error message must be printed.
  1217.   The procedure then performs the actions necessary to build the partition
  1218.   on disk. }
  1219. procedure FormatMSDOSPartition (StartTrack, EndTrack :Integer; Name :Str60);
  1220. var
  1221.   Data :SectorBlock;
  1222.   I, J, K :Integer;
  1223.   Temp :Real;
  1224.   FATValue :Integer;
  1225.   FATSize :Integer;
  1226.   DirSize :Integer;
  1227.   NibbleBuffered :Boolean;
  1228.   NibbleBuffer :Byte;
  1229.   FATTrack :Integer;
  1230.   FATSector :Byte;
  1231.   BytesWritten :Integer;
  1232.   BigFAT :Boolean;
  1233.  
  1234.   {sub}procedure WriteFATBlock;
  1235.   var
  1236.     FAT2Track :Integer;
  1237.     FAT2Sector :Byte;
  1238.   begin
  1239.     If FATTrack = -1 then
  1240.     begin
  1241.       FATTrack := StartTrack +2;
  1242.       FATSector := 1;
  1243.     end
  1244.     else
  1245.     begin
  1246.       WriteNoError (FATTrack, Xlate(FATSector), Data);
  1247.       FAT2Track := FATTrack;
  1248.       FAT2Sector := FATSector + FATSize;
  1249.       While FAT2Sector > 16 do
  1250.       begin
  1251.         FAT2Track := FAT2Track + 1;
  1252.         FAT2Sector := FAT2Sector - 16;
  1253.       end;
  1254.       WriteNoError (FAT2Track, Xlate(FAT2Sector), Data);
  1255.       FATSector := FATSector + 1;
  1256.       If FATSector = 17 then
  1257.       begin
  1258.         FATTrack := FATTrack + 1;
  1259.         FATSector := 1;
  1260.       end;
  1261.     end;
  1262.     FillChar (Data, 512, 0);
  1263.     BytesWritten := 0;
  1264.   end {WriteFATBlock};
  1265.  
  1266.   {sub}procedure WriteFATByte (Value :Byte);
  1267.   begin
  1268.     If BytesWritten >= 512 then WriteFATBlock;
  1269.     Data.SectorBytes[BytesWritten] := Value;
  1270.     BytesWritten := BytesWritten + 1;
  1271.   end {WriteFATByte};
  1272.  
  1273.   {sub}procedure WriteFATEntry (Value :Integer);
  1274.   begin
  1275.     If BigFAT then
  1276.     begin
  1277.       WriteFATByte (Lo (Value));
  1278.       WriteFATByte (Hi (Value));
  1279.     end
  1280.     else If NibbleBuffered then
  1281.     begin
  1282.       WriteFATByte (((Value Mod $10) * $10) + NibbleBuffer);
  1283.       WriteFATByte (Value Div $10);
  1284.       NibbleBuffered := False;
  1285.     end
  1286.     else
  1287.     begin
  1288.       WriteFATByte (Lo(Value));
  1289.       NibbleBuffer := Hi (Value);
  1290.       NibbleBuffered := True;
  1291.     end;
  1292.   end {WriteFATEntry};
  1293.  
  1294.   {sub}procedure FinishFATOutput;
  1295.   begin
  1296.     If NibbleBuffered then WriteFATEntry (0);
  1297.     If BytesWritten > 0 then WriteFATBlock;
  1298.   end {FinishFATOutput};
  1299.  
  1300. begin {FormatMSDOSPartition}
  1301.   { Determine whether we will be using a 16-bit FAT or a 12-bit FAT.  We
  1302.     use the 12-bit version whenever the partition has 1025 or fewer tracks
  1303.     (approx. 8MB or less of data space), which is always the case with DOS
  1304.     versions before 3.0.  If we are told to format a partition bigger than
  1305.     1025 tracks, we will assume this is DOS version 3.0 or better, and we
  1306.     will use 16-bit FAT entries. }
  1307.   BigFAT := ((EndTrack - StartTrack + 1) > 1025);
  1308.  
  1309.   { First, we want to make sure the alternate sector table jives with this
  1310.     partition and the bad sectors within it.  We'll start by scanning the
  1311.     current AST for sectors falling within the range of tracks which makes
  1312.     up this partition.  We'll delete each of them.  MS-DOS doesn't use
  1313.     alternate sectors, so there's no use wasting them here. }
  1314.   For I := 0 to ((HOMBlock.HOM.NumAltTracks * 16)- 1) do
  1315.   begin
  1316.     J := ASTVector[I].Track;
  1317.     If (J >= StartTrack) and (J <= EndTrack) then
  1318.     begin
  1319.       ASTVector[I].Track := 0;
  1320.       ASTVector[I].Sector := 0;
  1321.     end;
  1322.   end;
  1323.  
  1324.   { Compute size of FAT in sectors }
  1325.   { **warning** do not change this algorithm.  It must duplicate the
  1326.                 one used by MS-DOS or the disk will not be usable. }
  1327.   If MSDOSVersion < 3 then
  1328.   begin
  1329.     I := ((EndTrack-StartTrack+1)*16)-50;  { Number of data sectors }
  1330.     I := I Div 4;                          { Number of clusters }
  1331.     I := ((I * 3) div 2) + 4;              { Number of FAT bytes }
  1332.     FatSize := (I Div 512) + 1;            { Number of FAT Sectors }
  1333.     DirSize := 1;                          { Number of directory *TRACKS* }
  1334.   end
  1335.   else
  1336.   begin
  1337.     { The algorithm used by version 3.0 and above of MS-DOS is different,
  1338.       and pretty weird, too.  But we'll do what it says.  Note that we
  1339.       will be converting to real and then back to integer, because the
  1340.       numbers here can get to be pretty big and cause nasty integer
  1341.       overflows, which botch the calculation. }
  1342.     If BigFAT then DirSize := 2 else DirSize := 1; { directory tracks }
  1343.     Temp := (EndTrack-StartTrack-1-DirSize)*16.0; { Number of data sectors }
  1344.     If BigFAT then J := 1026                 { Magic number for 16-bit FATs }
  1345.               else J := 1368;                { Magic number for 12-bit FATs }
  1346.     Temp := Temp / J;                        { Compute real quotient }
  1347.     FATSize := Trunc (Temp);                 { Put back in integer variable }
  1348.     If Frac (Temp) <> 0 then
  1349.       FATSize := FATSize + 1;                { Round up if any fraction }
  1350.   end;
  1351.   NumFATSectors := FATSize;           { Write # of FAT sectors into DPD block }
  1352.  
  1353.   { Initialize FAT pointers }
  1354.   FATTrack := -1;
  1355.   FATSector := 0;
  1356.   NibbleBuffered := False;
  1357.   BytesWritten := 512;
  1358.  
  1359.   { FAT always starts with two entries, containing the values "FF8" and
  1360.     "FFF" (or FFF8 and FFFF, depending on the type of FAT).  Write these
  1361.     before we go on. }
  1362.  
  1363.   If BigFAT then
  1364.   begin
  1365.     WriteFATEntry ($FFF8);
  1366.     WriteFATEntry ($FFFF);
  1367.   end
  1368.   else
  1369.   begin
  1370.     WriteFATEntry ($FF8);
  1371.     WriteFATEntry ($FFF);
  1372.   end;
  1373.  
  1374.   { Now determine where the data starts, which will be right after the
  1375.     directory.  The directory is always either 16 sectors (exactly one track)
  1376.     or 32 sectors (exactly two tracks), so all we do is compute the location
  1377.     by starting with the start track plus 2 tracks of boot stuff, plus the
  1378.     proper number of directory tracks; then we adjust by the number of FAT
  1379.     sectors. }
  1380.  
  1381.   I := StartTrack + 2 + DirSize + ((FATSize * 2) div 16);
  1382.   J := 1 + ((FATSize * 2) mod 16);
  1383.  
  1384.   { Now cycle through all the sectors in the partition, determining if there
  1385.     are any bad sectors.  We do this four sectors at a time (the size of an
  1386.     MS-DOS cluster), and write one FAT entry for each cluster.  We'll write
  1387.     a zero (unused) if the cluster contains no bad sectors; we'll write an
  1388.     $FF7 or $FFF7 (bad cluster) if the cluster contains one or more bad
  1389.     sectors.  The process of doing this may actually write one or more FAT
  1390.     blocks to the disk along the way. }
  1391.  
  1392.   Repeat {Until I > EndTrack}
  1393.     FATValue := 0; { Initially, assume block is OK }
  1394.     For K := 1 to 4 do
  1395.     begin
  1396.       If I <= EndTrack then If SectorIsBad (I, Xlate(J)) then FATValue := $FF7;
  1397.       J := J + 1;
  1398.       If J = 17 then
  1399.       begin
  1400.         I := I + 1;
  1401.         J := 1;
  1402.       end;
  1403.     end;
  1404.     If (FATValue = $FF7) and (BigFAT) then FATValue := $FFF7;
  1405.     WriteFATEntry (FATValue);
  1406.   Until I > EndTrack;
  1407.  
  1408.   { Finish up the last blocks of the FAT still in internal buffers }
  1409.  
  1410.   FinishFATOutput;
  1411.  
  1412.   { Now create the directory, which is always either 16 or 32 sectors.  All
  1413.     we have to do is write this many sectors containing zero.  We'll compute
  1414.     its location by using double the number of FAT sectors and adding that to
  1415.     the location of the FAT (start track plus 2, sector 1). }
  1416.  
  1417.   I := StartTrack + 2 + ((FATSize * 2) div 16);
  1418.   J := 1 + ((FATSize * 2) mod 16);
  1419.   FillChar (Data, 512, 0);
  1420.   For K := 1 to DirSize*16 do
  1421.   begin
  1422.     WriteNoError (I, Xlate(J), Data);
  1423.     J := J + 1;
  1424.     If J = 17 then
  1425.     begin
  1426.       I := I + 1;
  1427.       J := 1;
  1428.     end;
  1429.   end;
  1430.  
  1431.   { That's it -- the MS-DOS partition has been built. }
  1432.  
  1433. end {FormatMSDOSPartition};
  1434.