Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/msdos/dskutl/reform16.arc/REFORMAT.IN5

Text File | 1990-03-03 | 40.6 KB | 1,151 lines

{-------------------- REFORMAT.IN5 -------------------------------------------}
{Disk, FAT, directory, misc. routines}
{v1.6 Rewrote Check_DOS_Version to permit user override
 of precautionary abort for DOS versions above v3.10
}

PROCEDURE ResetDisk;
  { flush buffers that weren't written   }
  BEGIN
(*  In Turbo:
    Register.ah := $0D;
    msdos(Register);
*)
    InLine(
  $B4/$0D   {  mov  ah,$0D  ;reset disk}
  /$CD/$21  {  int  $21}
);
  END;   { of ResetDisk }


PROCEDURE ResetSubdirectory;
  { DOS might not remember }
{
  The directory information DOS provided us with does not contain the
  driveletter, nor starts it with a backslash.
}
  BEGIN
    Move(CurrentDirectory[0], CurrentDirectory[3], 61);
    CurrentDirectory[0] := DriveLetter;
    CurrentDirectory[1] := ':';
    CurrentDirectory[2] := '\';
(* in Turbo:
    Register.ah := $3B;
    Register.ds := Seg(CurrentDirectory);
    Register.dx := Ofs(CurrentDirectory);
    MSDos(Register);
*)
    Inline(
  $B4/$3B                {mov  ah,$3B}
  /$BA/>CURRENTDIRECTORY {mov  dx,>CurrentDirectory}
  /$CD/$21               {int  $21}
);
  END;   { of ResetSubDirectory                 }

{----------------------- general disk   I/O routines -------------------------}

PROCEDURE Read_Write_Sectors(sectorNumber, numberOfSectors : Word;  {v1.6 INTEGER;}
                             action : Disk_Activity);
  VAR
    intNr : INTEGER;

  FUNCTION CarryFlag: BOOLEAN;
    BEGIN
      CarryFlag := Register.flags AND $01 <> 0;
    END;                                 { of CarryFlag }

  BEGIN
    WITH Register DO REPEAT
      al := driveNumber;
      cx := numberOfSectors;
      dx := sectorNumber;
      ds := Seg(DTAddress^);
      bx := Ofs(DTAddress^);
      IF action = reading
      THEN BEGIN
        intNr := $25;
        NrStr := 'Error Reading Disk....';
      END
      ELSE BEGIN
        intNr := $26;
        NrStr := 'Error Writing Disk....';
        AlreadyWritten := TRUE;     { set it now because the first write
                                      might succeed partially! }
      END;
      int2526(intNr);                  { 25H = read, 26H = write }
      IF CarryFlag THEN BEGIN
        S40 := 'Enter A (abort), R (retry)';
        IF NOT AlreadyWritten THEN BEGIN
          WriteWarning('No data lost!');
          WriteError(NrStr);
          Legals := 'AR';
        END
        ELSE BEGIN
          WriteError('Probably loss of data!');
          WriteDisaster(NrStr);
          S40 := S40 + ', I(gnore)';
          Legals := 'ARI';
        END;

        REPEAT
          Getinput(S40,Instr);
        UNTIL POS(Instr,Legals) <> 0;

        IF Instr = 'A' THEN BEGIN
          GotoXY(1,24); WRITELN;  {leave the screen for him or her }
          HALT;
        END
        ELSE BlankFields;
      END;
    UNTIL NOT CarryFlag;
  END;  { of Read_Write_Sectors }


PROCEDURE ReadCluster(clusterNumber: word);
  VAR   sectorNumber: word;
  BEGIN
(* v1.6
    sectorNumber := W_add(W_mul( clusterSize, clusterNumber - 2 ),
                    firstDataSector);
*)
    sectorNumber := (clusterSize * (clusterNumber-2)) + firstDataSector; {v1.6}

    Read_Write_Sectors(sectorNumber, clusterSize,reading);
  END;  { of ReadCluster }


PROCEDURE WriteCluster(clusterNumber: word);
  VAR   sectorNumber: word;
  BEGIN
(* v1.6
    sectorNumber := W_add(W_mul( clusterSize, clusterNumber - 2 ),
                    firstDataSector);
*)
    sectorNumber := (clusterSize * (clusterNumber-2)) + firstDataSector; {v1.6}

    Read_Write_Sectors(sectorNumber, clusterSize, writing);
  END;  { of WriteCluster }


{----------------------- disk information   routines -------------------------}

PROCEDURE ReadBootSector(VAR DTArea: Buffer);
{
  Read the bootsector from disk.
}
  VAR
    BootInfo:          Boot Absolute DTArea;
  BEGIN
    WriteLog('Reading Bootsector.');
    Read_Write_Sectors(0, 1, reading);
    FOR count := 0 TO 7 DO
      OEM[count]       := Bootinfo.OEM[count];
    totalSectors       := Bootinfo.totalSectors;
    trackSize          := Bootinfo.trackSize;
    hiddenSectors      := Bootinfo.hiddenSectors;
  END;  { of ReadBootSector }


PROCEDURE GetInformation;
{
  Ask DOS for information about the specified drive.
  If we have an error return code from DOS we assume
  that the disk specified was invalid.
  We are using a number of DOS int 21H functions:

  1) function 19H : returns current default drive in al: 0 = a, ..
  2) function 32H : ! undocumented function !
                    returns a parameter table which is laid out
                    in the type Parameter_Table.
  3) function 36H : several, but we only use the disk free space
  4) function 47H : current working directory.

  the remainder of the information we want to have or need, we find
  in the disks bootrecord and in the FAT (bad space and used space).
}
  VAR
    ValidDrive:   BOOLEAN;
    Parms:        Parms_32;
  BEGIN
    IF Instr = ' '
    THEN GetInput('Enter drive letter',Instr);
    WriteLog('Reading Disk Information');
{
    get current disk: MS-DOS function call 19h
    information is returned in AL: 0 = A, 1 = B, etc.
}
    WITH Register DO BEGIN
(* in Turbo:
      ah := $19;                         { DOS returns the default drive in al  }
      MSDos(Register);                   { as: 0 = A, 1 = B .... }
      defaultDrive := al;
*)
      Inline(
  $B4/$19                {mov  ah,$19}
  /$CD/$21               {int  $21}
  /$A2/>DEFAULTDRIVE     {mov  [>defaultDrive],al}
);
      ValidDrive   := FALSE;

      REPEAT                             { keep trying until a good letter }
        IF ORD(Instr) < 64 THEN Instr := CHR($FF);
        DriveLetter := UpCase(Instr);
        driveNumber := ORD(DriveLetter) - 64; { A = 65, so A = 1, B = 2, ...... }
        ah := $36;
        dl := driveNumber;               { must be 0 = default, 1 = A, 2 = B .. }
        MSDos(Register);
        IF ax <> $ffff THEN ValidDrive := TRUE
        ELSE BEGIN
          WriteWarning('Invalid driveletter!');
          GetInput('Enter new letter',Instr);
          WriteWarning(' ');
        END;
      UNTIL ValidDrive;

      freeClusters :=          bx;       { we can find that only here }
{
    In case the drive to be reformatted has a current working directory
    DOS may lose track of the current working directory. So we will get
    the current working directory and will tell DOS what it is, when
    we are done.
}
      dl := driveNumber;                 { must be 0 = default, 1 = A, 2 = B .. }
      ds := Seg(CurrentDirectory);
      si := Ofs(CurrentDirectory);
      ah := $47;                         { DOS returns current working directory}
      MSDos(Register);                   { no error, drive checked before }
{
    We now use the undocumented DOS function call 32H. It was described in the
    May 86 PC Tech Journal article "Finding Disk Parameters" by
    Glenn F. Roberts.
}
      dl := driveNumber;                 { must be 0 = default, 1 = A, 2 = B .. }
      ah := $32;
      MSDos(Register);
      Parms                := Ptr(         ds,          bx);
      sectorSize           := Parms^.sectorSize;
      media                := Parms^.MediaDescriptor;
      numberOfHeads        := SUCC(Parms^.numberOfHeads_1);
      reservedSectors      := Parms^.reservedSectors;
      rootDirSize          := Parms^.rootDirSize;
      numberOfFATs         := Parms^.numberOfFATs;
      fatSize              := Parms^.fatSize;
      clusterSize          := SUCC(Parms^.clusterSize_1);
      firstDataSector      := Parms^.firstDataSector;
      firstDirectorySector := Parms^.firstDirectorySector;
      totalDataClusters    := PRED(Parms^.totalDataClusters_1);
(* v1.6
    BigFAT               := W_cmp(totalDataClusters, Gt, 4086);
*)
      BigFAT             := (totalDataClusters > 4086);  {v1.6}
    END;  {of with Register}

    IF BigFAT THEN BEGIN
      unused          := $0000;
      reservedMinimum := $FFF0;
      reservedMaximum := $FFF6;
      badCluster      := $FFF7;
      lastMinimum     := $FFF8;
      lastMaximum     := $FFFF;
      lastNormal      := $FFFF;
    END;   { small FAT format was defined already }

    deviceDriverAddress  := Parms^.deviceDriverAddress;
    assignedDisk         := Parms^.assignedDisk;
    altAD                := Parms^.altAD;

    firstFATSector       := 1;
    Dec(driveNumber);  {INT 25H and 26H expect 0=A, 1=B, etc. v1.6}
{
  The maximum array for the FAT we can allocate is 65521 bytes.
  The length of the FAT is totalDataClusters + 2, so the largest
  FAT we can proces has (65521 div 2 - 2 = 32758) totalDataClusters.
  So we can use the totalDataClusters as an integer, once we have passed
  this test.
  The situation of more than 32758 totalDataClusters will probably never
  occur, because DOS would have problems too with FATs larger than one
  segment of 64Kb.
}
(* v1.6
    IF W_cmp(totalDataClusters, Gt, 32758) THEN BEGIN
*)
    IF totalDataClusters > 32758 THEN BEGIN       {v1.6}
      WriteError('Disk too big for this program...');
      Exeunt(EnterStr);
    END;
{
  Now read the bootrecord, to collect the remaining information.
  Use that procedure, makes things neater.
}
    GetMem(DTAddress, sectorSize);
    ReadBootSector(DTAddress^);
    FreeMem(DTAddress, sectorSize);
  END;  { of GetInformation }

{------------------- FAT and file information reading ------------------------}

PROCEDURE ReadFat(VAR unscrambledFAT: IntArray; VAR scrambledFAT: Buffer);
{
  Read and unscramble the FAT. Only the first FAT is processed.
  The variable scrambledFAT is really our DTArea.
}
  VAR
    i, temp:     word;  {v1.6 INTEGER;}
  BEGIN
    WriteLog('Reading and unscrambling FAT.');
    Read_Write_Sectors(firstFATSector, fatSize, reading);
    IF BigFAT
    THEN Move(scrambledFAT, unscrambledFAT,
(* v1.6       W_mul(totalDataClusters + 2 , 2)) *)
              (totalDataClusters+2) ShL 1)   {v1.6}
    ELSE FOR i := 0 TO SUCC(totalDataClusters)
    DO BEGIN
      Move( scrambledFAT[3 * i ShR 1], temp, 2);
      IF ODD(i) THEN temp := temp ShR 4 ELSE temp := temp AND $0FFF;
      unscrambledFAT[i] := temp;
    END;
  END;  { of ReadFat }


PROCEDURE ReadSubdirectory(VAR DTArea:      Buffer;
                           VAR FATarea:     INTArray;
                           VAR SubRoot:     DirectoryPointer;
                           startingCluster: Word;  {v1.6 INTEGER;}
                           hidden:          Word  {v1.6 INTEGER} );
{
  Link subdirectory entries in a list. Build a tree (by calling this
  routine recursively) if a subdirectory is found.
}
  VAR
    clusterNumber,
    dirIndex:      word;  {v1.6 INTEGER;}
    Present:       DirectoryPointer;
    EndSearch:     BOOLEAN;
  BEGIN
    IF hidden <> 0 THEN
(*v1.6 hiddenDirectories := SUCC(hiddenDirectories); *)
      Inc(hiddenDirectories);  {v1.6}
(* v1.6 subdirectories    := SUCC(subdirectories); *)
    Inc(subdirectories);  {v1.6}
    clusterNumber     := startingCluster;
    Present           := NIL;
    SubRoot           := NIL;
    EndSearch         := FALSE;
    REPEAT
      ReadCluster(clusterNumber);
      dirIndex  := 0;
      REPEAT
        IF NOT ( DTArea[dirIndex] IN [NEVERUSED, ERASED] )
        THEN BEGIN
          IF SubRoot = NIL THEN BEGIN
            NEW(SubRoot);
            Present := SubRoot;
          END
          ELSE BEGIN
            NEW(Present^.next);
            Present := Present^.next;
          END;
          Move(DTArea[dirIndex], Present^, 32);
          IF (( Present^.attribute AND SUBDIRECTORY) <> 0 )
          AND ( Present^.EntryName[0] <> '.' )
          THEN BEGIN
            ReadSubdirectory(DTArea, FATarea,Present^.subdirectory,
                             Present^.startingCluster,
                             Present^.attribute AND HIDDENFILE);
            Readcluster(clusterNumber);
          END
          ELSE BEGIN
            Present^.subdirectory := NIL;
            IF Present^.Entryname[0] <> '.'
            THEN BEGIN
(* v1.6
              totalFiles       := SUCC(totalFiles);
              inSubdirectories := SUCC(inSubdirectories);
              IF ( Present^.attribute AND HIDDENFILE ) <> 0
              THEN hiddenFiles := SUCC(hiddenFiles);
*)
              Inc(totalFiles);  {v1.6}
              Inc(inSubdirectories); {v1.6}
              IF ( Present^.attribute AND HIDDENFILE ) <> 0
              THEN Inc(hiddenFiles);  {v1.6}
            END;
          END;
        END
        ELSE IF DTArea[dirIndex] = NEVERUSED
        THEN EndSearch := TRUE;
(* v1.6 dirIndex := dirIndex + 32; *)
        Inc(dirIndex,32);  {v1.6}
(*v1.6UNTIL W_cmp(dirIndex, Ge, W_mul(sectorSize, clusterSize)) *)
      UNTIL (dirIndex >= (sectorSize * clustersize))  {v1.6}
      OR EndSearch;
      clusterNumber :=  FATarea[clusterNumber];
(*v1.6UNTIL  W_cmp(clusterNumber, Ge, reservedMinimum) OR EndSearch; *)
    UNTIL (clusterNumber >= reservedMinimum) OR EndSearch;  {v1.6}

    IF Present <> NIL THEN Present^.next := NIL;
  END;  { of ReadSubDirectory }


PROCEDURE ReadDirectories(VAR DTArea: Buffer);
{
  Read the Rootdirectory and whenever an entry for a subdirectory is
  found call ReadSubdirectory. Link all directory entries dynamically
  in a linked list. This list is actually a tree, because the lists
  for subdirectories are linked to this list.
}
  VAR
    EndSearch:     BOOLEAN;
    sectorNumber,
    dirIndex:      word;  {v1.6 INTEGER;}
    Present:       DirectoryPointer;
  BEGIN
    WriteLog('Reading Directory and Subdirectories.');
    sectorNumber := firstDirectorySector;
    RootDir      := NIL;
    Present      := NIL;
    EndSearch    := FALSE;
    REPEAT
      dirIndex := 0;
      Read_Write_Sectors(sectorNumber, 1, reading);
      REPEAT
        IF NOT ( DTArea[dirIndex] IN [NEVERUSED, ERASED] )
        THEN BEGIN
          IF RootDir = NIL THEN BEGIN
            NEW(RootDir);
            Present := RootDir;
          END
          ELSE BEGIN
            NEW(Present^.next);
            Present := Present^.next;
          END;
          Move(DTArea[dirIndex], Present^, 32);
          IF (( Present^.attribute AND SUBDIRECTORY ) <> 0 )
          AND ( Present^.EntryName[0] <> '.' )
          THEN BEGIN
            ReadSubdirectory(DTArea, OldFATaddress^,
                             Present^.subdirectory,
                             Present^.startingCluster,
                             Present^.attribute AND HIDDENFILE);
            Read_Write_Sectors(sectorNumber, 1, reading);
          END
          ELSE BEGIN
            Present^.subdirectory := NIL;
            IF (( Present^.attribute AND VOLUMELABEL ) = 0 )
            AND ( Present^.Entryname[0] <> '.' )
            THEN BEGIN
(* v1.6
              totalFiles       := SUCC(totalFiles);
              inRootDirectory  := SUCC(inRootDirectory);
              IF ( Present^.attribute AND HIDDENFILE ) <> 0
              THEN hiddenFiles := SUCC(hiddenFiles);
*)
              Inc(totalFiles);  {v1.6}
              Inc(inRootDirectory);  {v1.6}
              IF ( Present^.attribute AND HIDDENFILE ) <> 0
              THEN Inc(hiddenFiles);  {v1.6}
            END
            ELSE IF ( Present^.attribute AND VOLUMELABEL ) <> 0
            THEN BEGIN
              FOR count := 0 TO 10 DO
                DiskLabel := DiskLabel +
                             Present^.EntryName[count];
              diskCreationDate := Present^.dateLastUpdated;
              diskCreationTime := Present^.timeLastUpdated;
            END;
          END;
        END
        ELSE IF DTArea[dirIndex] = NEVERUSED
        THEN EndSearch := TRUE;
(* v1.6 dirIndex := dirIndex + 32; *)
        Inc(dirIndex,32);  {v1.6}
      UNTIL (dirIndex >= sectorSize ) OR EndSearch;
(*v1.6sectorNumber := SUCC(sectorNumber); *)
      Inc(sectorNumber);  {v1.6}
    UNTIL ( sectorNumber = firstDataSector ) OR EndSearch;
    IF Present <> NIL THEN Present^.next := NIL;
  END;  { of ReadDirectories }

{-------------------------- reformatting routines ----------------------------}

PROCEDURE RemakeFAT(VAR oldFATarea, newFATarea, permutation: IntArray;
                    Root: DirectoryPointer;
                    parent, thisDir: Word {v1.6 INTEGER} );
{
  This procedure is called recursively.
  From the OldFAT and the directory entries we construct a NewFAT and
  a permutation. The permutation is used by DoIt for moving the
  clusters. This routine is called one extra time for the chain of
  the empty clusters by LinkFreeDataClusters.
  Recursion is used whenever we find an entry for a subdirectory, in
  the following way: first call this routine for the remainder of the
  current directory, then for the subdirectory.
  The function nextFATindex is used to prevent accidental use of clusters
  that were marked as bad or reserved clusters.
}
  FUNCTION nextFATindex: Word;  {v1.6 INTEGER;}
    VAR
      temp: Word;  {v1.6 INTEGER;}
    BEGIN
      temp := SUCC(newFATindex);
(* v1.6
      WHILE W_cmp( oldFATarea[temp], Ge, reservedMinimum ) AND
            W_cmp( oldFATarea[temp], Le, badCluster ) AND
            ( temp <= SUCC(totalDataClusters) )
*)
      WHILE (oldFATarea[temp] >= reservedMinimum)  {v1.6}
        AND (oldFATarea[temp] <= badCluster)
        AND (temp <= SUCC(totalDataClusters))
      DO BEGIN
        newFATarea[temp] := oldFATarea[temp];
(* v1.6
        temp             := SUCC(temp);
        badClusters      := SUCC(badClusters);
*)
        Inc(temp);  {v1.6}
        Inc(badClusters);  {v1.6}
      END;
      nextFATindex := temp;
    END;                               { of nextFATindex }

  VAR
    Present: DirectoryPointer;
    Split:   BOOLEAN;
    temp:    Word;  {v1.6 INTEGER;}
  BEGIN   { RemakeFAT }
    IF newFATindex = 1 THEN newFATindex := nextFATindex;
    Present := Root;
    Split   := FALSE;
    WHILE ( Present <> NIL ) AND NOT Split DO BEGIN
      IF (( Present^.attribute AND VOLUMELABEL) = 0 )
      AND ( Present^.startingCluster <> 0 )
      AND ( Present^.Entryname[0] <> '.')
      THEN BEGIN
        IF Present^.subdirectory <> NIL THEN BEGIN
          Split := TRUE;
          RemakeFAT(oldFATarea, newFATarea, permutation,
                    Present^.next, parent, thisDir);
        END;
        oldFATindex                 := Present^.startingCluster;
        Present^.newStartingCluster := newFATindex;
        permutation[newFATindex]    := oldFATindex;
(* v1.6 WHILE W_cmp( oldFATarea[oldFATindex], Lt, lastMinimum ) DO BEGIN *)
        WHILE (oldFATarea[oldFATindex] < lastMinimum) DO BEGIN  {v1.6}
          temp                     := nextFATindex;
          newFATarea[newFATindex]  := temp;
          newFATindex              := temp;
          oldFATindex              := oldFATarea[oldFATindex];
          permutation[newFATindex] := oldFATindex;
        END;
        newFATarea[newFATindex] := lastNormal;
        newFATindex             := nextFATindex;
        IF Split
        THEN RemakeFAT(oldFATarea, newFATarea, permutation,
                       Present^.subdirectory, thisDir,
                       Present^.newStartingCluster);
      END
      ELSE BEGIN
        IF ( Present^.EntryName[0] = '.'  )
        AND ( Present^.EntryName[1] = '.'  )
        THEN Present^.newStartingCluster := parent
        ELSE IF Present^.EntryName[0] = '.'
        THEN Present^.newStartingCluster := thisDir
        ELSE Present^.newStartingCluster := 0;

     END;
     Present := Present^.next;
    END;
  END;   { of RemakeFAT }


PROCEDURE LinkFreeClusters(VAR oldFATarea, newFATarea: IntArray);
{
  Link Free clusters in a chain, pointed to by Empty^.
  Use RemakeFAT to fill permutation, but clean NewFAT after
  this. This procedure will ensure that permutation is a
  proper permutation, without double entries which might
  cause DoIt to loop indefinitely or destroy our disk.
}
  VAR
    count,
    next,
    previous: Word;  {v1.6 INTEGER;}
    Empty:    DirectoryPointer;
  BEGIN
    NEW(Empty);
    Empty^.next            := NIL;
    Empty^.subdirectory    := NIL;
    Empty^.Entryname[0]    := 'X';
    Empty^.attribute       := HIDDENFILE;
    Empty^.startingCluster := 0;
    count                  := 2;
    WHILE ( count <= SUCC(totalDataClusters) )
    AND ( oldFATarea[count] <> 0 )
(*v1.6DO count := SUCC(count);     { find first zero FAT entry } *)
      DO Inc(count);  {find first zero FAT entry  v1.6}

    IF count <= SUCC(totalDataClusters)
    THEN BEGIN
      Empty^.startingCluster := count;
      Previous               := count;
      WHILE count < SUCC(totalDataClusters)
      DO BEGIN
(* v1.6 count := SUCC(count); *)
        Inc(count);  {v1.6}
        IF oldFATarea[count] = 0
        THEN BEGIN
          oldFATarea[Previous] := count;
          Previous             := count;
        END;
      END;
      oldFATarea[Previous] := lastNormal;
    END;

    IF Empty^.startingCluster <> 0     { plot free clusters in permutation }
    THEN BEGIN
      RemakeFAT(oldFATarea, newFATarea,
                PermutationAddress^, Empty, 0, 0);
      next := Empty^.newStartingCluster;
      WHILE next <> lastNormal      { clean NewFAT }
      DO BEGIN
        Previous             := next;
        next                 := newFATarea[Previous];
        newFATarea[Previous] := 0;
     END;
   END;
  END;  { of LinkFreeClusters }


PROCEDURE DoIt(VAR permutation: IntArray; VAR DTArea, SaveArea: Buffer);
{
  DoIt. This routine performs the actual reformatting of the disk.
  The array permutation contains in every location  [i] (starting
  from 2) which cluster has to be moved to cluster location i.
  Because we have a real permutation, this permutation can be
  parsed into a number of cyclical permutations. We start at the
  first cyclic permutation that is not identity. We save the first
  cluster of this cyclical permutation, proceed through the cyclical
  permutation, moving one cluster at a time, until we finish the
  cycle. We than write the saved cluster to disk.
}
  VAR
    prior,
    next,
    lastStart: Word;  {v1.6 INTEGER;}
  BEGIN
    WriteLog('Reformatting......');
    lastStart := 2;
    WHILE lastStart <= SUCC(totalDataClusters)
    DO BEGIN
      IF lastStart = permutation[lastStart]
(*v1.6THEN lastStart := SUCC(lastStart) *)
      THEN Inc(lastStart)  {v1.6}
      ELSE BEGIN
        ReadCluster(lastStart);
        Move(DTArea, SaveArea, sectorSize * clusterSize);
        prior := lastStart;
        next  := permutation[lastStart];
        REPEAT
          ReadCluster(next);
          WriteCluster(prior);
(* v1.6   movedClusters      := SUCC(movedClusters); *)
          Inc(movedClusters);  {v1.6}
          STR(movedClusters:10,NrStr);
          WriteF(movedFieldX, movedFieldY,NrStr);
          permutation[prior] := prior;
          prior              := next;
          next               := permutation[next];
        UNTIL next = lastStart;
        Move(SaveArea, DTArea, sectorSize * clusterSize);
        WriteCluster(prior);
(* v1.6 movedClusters      := SUCC(movedClusters); *)
        Inc(movedClusters);  {v1.6}
        STR(movedClusters:10,NrStr);
        WriteF(movedFieldX, movedFieldY,NrStr);
        permutation[prior] := prior;
      END;
    END;
    WriteLog(' ');
  END;   { of DoIt }

{------------------- FAT and file information writing ------------------------}

PROCEDURE WriteFat(VAR unscrambledFAT: IntArray; VAR scrambledFAT: Buffer);
{
  Write the FAT back to the disk. The FAT has to be scrambled before
  writing. FAT entries on disk are 12 bits long. If there are
  2 versions of the fat on disk, we write both fats.
}

  VAR
    i,
    temp1,
    temp2:  Word;  {v1.6 INTEGER;}
  BEGIN
    WriteLog('Writing FAT.');
    IF BigFAT
    THEN Move(unscrambledFAT, scrambledFAT,
(* v1.6       W_mul(totalDataClusters + 2, 2)) *)
              (totalDataClusters+2) ShL 1 )  {v1.6}
    ELSE FOR i := 0 TO SUCC(totalDataClusters)
    DO BEGIN
      Temp1 := unscrambledFAT[i];
      Move( scrambledFAT[3 * i ShR 1 ], Temp2, 2);

{ACHING for inline here.}

      IF ODD(i) THEN Temp1 := (Temp2 AND $000F) OR (Temp1 ShL 4)
      ELSE Temp1 := (Temp2 AND $F000) OR Temp1;
      Move( Temp1, scrambledFAT[3 * i ShR 1 ], 2);
    END;
    Read_Write_Sectors(firstFATSector, fatSize, writing);
    IF numberOfFATs = 2
    THEN Read_Write_Sectors(firstFATSector + fatSize, fatSize, writing);
  END;   { of WriteFat }


PROCEDURE  WriteSubdirectory(VAR DTArea: Buffer; VAR oldFATarea: IntArray;
                             Root: DirectoryPointer;
                             start: Word {v1.6 INTEGER} );
{
  Write subdirectories back to disk. Erased entries are removed
  from the subdirectories. The subdirectories are written to their
  old locations, because DoIt will take care of moving the clusters
  to their new places. No effort is done to truncate a subdirectory
  which would be longer than needed after removal of erased entries.
  We will however set all remaining entries to 'NEVERUSED'.
  This routine is used recursively.
}
  VAR
    start1,
    clusterNumber,
    dirIndex:      Word;  {v1.6 INTEGER;}
    Present:       DirectoryPointer;
  BEGIN
    Present       := Root;
    clusterNumber := Start;
    WHILE Present <> NIL DO BEGIN
      dirIndex := 0;
(*v1.6FillChar(DTArea, W_mul(clusterSize, sectorSize), $00); *)
      FillChar(DTArea, (clusterSize * sectorSize), $00);  {v1.6}
      REPEAT
        start1 := Present^.startingCluster;
        Present^.startingCluster := Present^.newStartingCluster;
        Move(Present^, DTArea[dirIndex], 32);
        IF (( Present^.attribute AND SUBDIRECTORY ) <> 0 )
        AND ( Present^.EntryName[0] <> '.' )
        THEN BEGIN
          WriteCluster(clusterNumber);
          WriteSubdirectory(DTArea, oldFATarea,
                            Present^.subdirectory, start1);
          ReadCluster(clusterNumber);
        END;
        Present  := Present^.next;
(* v1.6 dirIndex := dirIndex + 32; *)
        Inc(dirIndex,32);  {v1.6}
(*v1.6UNTIL W_cmp(dirIndex, Ge, W_mul(clusterSize, sectorSize )) *)
      UNTIL (dirIndex >= (clusterSize * sectorsize)) {v1.6}
      OR ( Present = NIL );
      WriteCluster(clusterNumber);
      clusterNumber := oldFATarea[clusterNumber];
    END;
(*v1.6IF W_cmp( clusterNumber, Lt, lastMinimum ) *)
    IF clusterNumber < lastMinimum  {v1.6}
    THEN BEGIN
      FillChar(DTArea, sectorSize * clusterSize, $00);
(*v1.6WHILE W_cmp( clusterNumber, Lt, lastMinimum ) DO BEGIN *)
      WHILE clusterNumber < lastMinimum DO BEGIN  {v1.6}
        WriteCluster(clusterNumber);
        clusterNumber := oldFATarea[clusterNumber];
     END;
   END;
  END;   { of WriteSubdirectory }


PROCEDURE WriteDirectories(VAR DTArea: Buffer);
{
  Write rootdirectory back to disk. Erased entries are removed
  from the directory. When we find a subdirectory entry, we first
  process this subdirectory by calling WriteSubdirectories,
  before we proceed with the root. All entries that are no in use
  are set to 'NEVERUSED'.
}
  VAR
    Start,
    sectorNumber,
    dirIndex:      Word;  {v1.6 INTEGER;}
    Present:       DirectoryPointer;
  BEGIN
    WriteLog('Writing new Directory and Subdirectories.');
    sectorNumber := firstDirectorySector;
    Present      := RootDir;
    WHILE Present <> NIL DO BEGIN
      dirIndex := 0;
      FillChar(DTArea, sectorSize, $00);
      REPEAT
        Start := Present^.startingCluster;
        Present^.startingCluster := Present^.newStartingCluster;
        Move(Present^, DTArea[dirIndex], 32);
        IF (( Present^.attribute AND SUBDIRECTORY ) <> 0 )
        AND ( Present^.EntryName[0] <> '.' )
        THEN BEGIN
          Read_Write_Sectors(sectorNumber, 1, writing);
          WriteSubdirectory(DTArea, OldFATaddress^,
                            Present^.subdirectory, Start);
          Read_Write_Sectors(sectorNumber, 1, reading);
        END;
        Present  := Present^.next;
(* v1.6 dirIndex := dirIndex + 32; *)
        Inc(dirIndex,32);  {v1.6}
      UNTIL ( dirIndex >= sectorSize ) OR ( Present = NIL );
      Read_Write_Sectors(sectorNumber, 1, writing);
(*v1.6sectorNumber := SUCC(sectorNumber); *)
      Inc(sectorNumber);  {v1.6}
    END;
    IF sectorNumber < firstDataSector
    THEN BEGIN
      FillChar(DTArea, sectorSize, $00);
      WHILE sectorNumber < firstDataSector DO BEGIN
        Read_Write_Sectors(sectorNumber, 1, writing);
(* v1.6 sectorNumber := SUCC(sectorNumber); *)
        Inc(sectorNumber);  {v1.6}
      END;
    END;
  END;  { of WriteDirectories }


{----------------------- disk integrety checking routines --------------------}

PROCEDURE CheckSubdirectory(VAR FAT: IntArray;
                            Root: DirectoryPointer;
                            parent, thisDir: Word {v1.6 INTEGER} );
{
  This procedure is called recursively.
  The SubDirectories are checked here. No attempt is made
  to correct any errors found. If any errors are found, a message
  is issued and the program stops. The users must first run CHKDSK from
  DOS before we accept the disk.
}
  VAR
    Present: DirectoryPointer;
    prior,
    next:    Word;  {v1.6 INTEGER;}
  BEGIN
    Present := Root;
    WHILE ( Present <> NIL ) AND ( errors = 0 ) DO BEGIN
      IF  (( Present^.attribute AND VOLUMELABEL ) = 0 )
      AND  ( Present^.startingCluster <> 0 )
      AND  ( Present^.Entryname[0] <> '.')
      THEN BEGIN
        next  := Present^.startingCluster;
        count := 0;
        REPEAT;                  { first time never special value !     }
          IF ( next > SUCC(totalDataClusters) )
          OR ( next < 1 )
(* v1.6   THEN errors := SUCC(errors) *)
          THEN Inc(errors)  {v1.6}
          ELSE BEGIN
            prior      := next;
            next       := FAT[prior];
            FAT[prior] := 0;
            IF next <> SUCC(prior)
(* v1.6     THEN count := SUCC(count); *)
            THEN Inc(count);  {v1.6}
          END;
(* v1.6 UNTIL W_cmp( next, Ge, lastMinimum ) OR ( errors <> 0 ); *)
        UNTIL (next >= lastMinimum) OR (errors <> 0); {v1.6}

        IF count > 1
(* v1.6 THEN nonContiguousFiles := SUCC(nonContiguousFiles); *)
        THEN Inc(nonContiguousFiles);  {v1.6}
        IF Present^.subdirectory <> NIL
        THEN CheckSubdirectory(FAT, Present^.subdirectory,
                               thisDir, Present^.startingCluster);
      END
      ELSE BEGIN
        IF  ( Present^.EntryName[0] = '.' )
        AND ( Present^.EntryName[1] = '.' )
        THEN IF Present^.startingCluster <> parent
        THEN Inc(errors)  {v1.6 errors := SUCC(errors)}
        ELSE
        ELSE IF Present^.EntryName[0] = '.'
        THEN IF Present^.startingCluster <> thisDir
        THEN Inc(errors)  {v1.6 errors := SUCC(errors)}
        ELSE
        ELSE IF Present^.startingCluster <> 0
        THEN Inc(errors);  {v1.6 errors := SUCC(errors);}
      END;
      Present := Present^.next;
    END;
  END;   { of CheckSubdirectory }


PROCEDURE CheckDisk(VAR FAT: IntArray; Root: DirectoryPointer);
{
  The FAT and the Directories are checked here. No attempt is made
  to correct any errors found. If any errors are found, a message
  is issued and the program stops. The users must first run CHKDSK from
  DOS before we accept the disk.
}
  BEGIN
    WriteLog('Checking FAT....');
    CheckSubdirectory(FAT, Root, 0, 0);
    FOR count := 2 TO SUCC(totalDataClusters) DO
    IF ( FAT[count] <> 0 ) AND
(* v1.6
           ( W_cmp( FAT[count], Lt, reservedMinimum )
          OR W_cmp( FAT[count], Gt, badCluster) )
         THEN lostClusters := SUCC(lostClusters);
*)
          ( ( FAT[count] < reservedMinimum)  {v1.6}
            OR (FAT[count] > badCluster) )
    THEN Inc(lostClusters);

    IF errors <> 0 THEN BEGIN
      WriteError('Crosslinked clusters found. Run CHKDSK first.');
      Exeunt(EnterStr);
    END
    ELSE IF lostClusters <> 0
    THEN BEGIN
      WriteError('Lost clusters found. Run CHKDSK first.');
      Exeunt(EnterStr);
    END;
 END;  { of CheckDisk }


{--------------------------- miscellaneous routines --------------------------}

PROCEDURE CountClustersToMove(VAR permutation: IntArray);
  BEGIN
    FOR count := 2 TO SUCC(totalDataClusters) DO
      IF permutation[count] <> count
      THEN Inc(clustersToMove);  {v1.6 clustersToMove := SUCC(clustersToMove);}
  END;   { of CountClustersToMove }


PROCEDURE WriteStatistics;
  BEGIN
    usedClusters := totalDataClusters - badClusters - freeClusters;
    toadY := 4;
    IF DiskLabel <> '' THEN
    WriteF(16, 0, 'Volume Label is . . . . . :   ');
    WRITE(DiskLabel);
    WriteF(16, 0, 'Total # of files. . . . . :');
    WRITE(totalFiles:10);
    IF hiddenFiles <> 0
    THEN WRITE(' (hidden:', hiddenFiles:3,')');
    IF subdirectories = 0
    THEN WriteF(16, 0, 'All files in Rootdirectory.')
    ELSE BEGIN
      WriteF(16, 0, '  in Root directory . . . :');
      WRITE(inRootDirectory:10);
      WriteF(16, 0, '  in Subdirectories . . . :');
      WRITE(inSubdirectories:10);
      WriteF(16, 0, '# of subdirectories . . . :');
      WRITE(subdirectories:10);
      IF hiddenDirectories <> 0
      THEN WRITE(' (hidden:', hiddenDirectories:3,')');
    END;
    WriteF(16, 0, '# of noncontiguous files. :');
    WRITE(nonContiguousFiles:10);
    WriteF(16, 0, '# of clusters to be moved :');
    WRITE(clustersToMove:10);
    WriteF(16, 0, '# of clusters moved . . . :');
    WRITE(movedClusters:10);

    movedFieldX := 43;
    movedFieldY := PRED(toadY);

    STR(totalDataClusters:06, NrStr);
    WriteF(05, SUCC(toadY),
                  'Total space . . :' + NrStr + ' clusters.');
    STR(clusterSize:06, NrStr);
    WriteF(43, PRED(toadY) {0}, 'clusterSize . . :' + NrStr + ' sectors.');
    STR(freeClusters:6,NrStr);
    WriteF(05, 0, 'Free space. . . :' + NrStr + ' clusters.');
    STR(sectorSize:06, NrStr);
    WriteF(43, PRED(toadY) {0}, 'sectorSize. . . :' + NrStr + ' bytes.');
    STR(usedClusters:6,NrStr);
    WriteF(05, 0, 'Used space. . . :' + NrStr + ' clusters.');
    STR(firstDataSector:06, NrStr);
    WriteF(43, PRED(toadY) {0}, 'DOS space . . . :' + NrStr + ' sectors.');
    STR(badClusters:6,NrStr);
    WriteF(05, 0, 'Bad space . . . :' + NrStr + ' clusters.');
(*v1.6toadY := PRED(toadY);              { stay on same line } *)
    Dec(toadY);                        { stay on same line v1.6}
    NrStr := 'Disk type . . . :';
    IF media = FIXEDDISK
    THEN WriteF(43, 0, 'Disk type . . . : Fixed Disk.')
    ELSE IF ( altAD = 0 ) AND ( assignedDisk <> 0 )
    THEN WriteF(43, 0, 'Disk Type . . . : Virtual Disk.')
    ELSE WriteF(43, 0, 'Disk Type . . . : Removable Disk.');
  END;   { of WriteStatistics }


PROCEDURE InitScreen;
  BEGIN
    NormVideo;
    ClrScr;
    Frame(1);
    Frame(0);
    color := $70;                      {inverse}
    WriteF(0, 2,Header + Version);
    color := LIGHTGRAY;                {normal}
    WriteF(3, inputFieldY ,'User Input Field :');
    WriteF(3,  0 ,'Activity Logging :');
    WriteF(3,  0 ,'Warning  Messages:');
    WriteF(3,  0 ,'Error    Messages:');
    WriteF(3,  0 ,'Disaster Messages:');
  END;   { of InitScreen }


PROCEDURE InitCounters;
  BEGIN
(*
   BigFAT              := FALSE;
   oldFATindex         := 0;
   newFATindex         := 1;
   errors              := 0;
   lostClusters        := 0;
   totalFiles          := 0;
   hiddenFiles         := 0;
   hiddenDirectories   := 0;
   inRootDirectory     := 0;
   inSubdirectories    := 0;
   nonContiguousFiles  := 0;
   subdirectories      := 0;
   movedClusters       := 0;
   clustersToMove      := 0;
   count               := 0;
   AlreadyWritten      := FALSE;
   DiskLabel           := '';
   badClusters         := 0;
*)
Inline(
  $31/$C0                {xor  ax,ax  ;get a zero}
  /$A2/>BIGFAT           {mov  [>BigFAT],al          ;boolean}
  /$A3/>OLDFATINDEX      {mov  [>oldFATindex],ax}
  /$A3/>ERRORS           {mov  [>errors],ax}
  /$A3/>LOSTCLUSTERS     {mov  [>lostClusters],ax}
  /$A3/>TOTALFILES       {mov  [>totalFiles],ax}
  /$A3/>HIDDENFILES      {mov  [>hiddenFiles],ax}
  /$A3/>HIDDENDIRECTORIES{mov  [>hiddenDirectories],ax}
  /$A3/>INROOTDIRECTORY  {mov  [>inRootDirectory],ax}
  /$A3/>INSUBDIRECTORIES {mov  [>inSubdirectories],ax}
  /$A3/>NONCONTIGUOUSFILES{mov  [>nonContiguousFiles],ax}
  /$A3/>SUBDIRECTORIES   {mov  [>subdirectories],ax}
  /$A3/>MOVEDCLUSTERS    {mov  [>movedClusters],ax}
  /$A3/>CLUSTERSTOMOVE   {mov  [>clustersToMove],ax}
  /$A3/>COUNT            {mov  [>count],ax}
  /$A2/>ALREADYWRITTEN   {mov  [>AlreadyWritten],al  ;boolean}
  /$A2/>DISKLABEL        {mov  [>DiskLabel],al       ;string}
  /$A3/>BADCLUSTERS      {mov  [>badClusters],ax}
  /$40                   {inc  ax                    ;1}
  /$A3/>NEWFATINDEX      {mov  [>newFATindex],ax}
);
 END;    { of InitCounters }


PROCEDURE WriteDoc;
  BEGIN
    ClrScr;
    Frame(2);
    WriteF( 0,  2, Header);
    WriteF( 0,  0, PDS);
    WriteF( 0, SUCC(toadY),             { skip a line }
                   'Makes all files on a floppy or fixed disk ' +
                   'contiguous again,');
    WriteF( 0,  0, 'improving  disk  performance  dramatically.');
    WriteF( 0,  0, 'Either fixed disks or diskettes. Requires DOS 2.0 or up.');
    WriteF( 0,  0, 'Register at the following address to be on my mailing ' +
                   'list for updates.');
    WriteF( 0, SUCC(toadY),            { skip a line  }
                   'Jos Wennmacker');
    WriteF( 0,  0, 'Universitair Rekencentrum');
    WriteF( 0,  0, 'Geert Grooteplein Zuid 41');
    WriteF( 0,  0, 'NL-6525 GA Nijmegen');
    WriteF( 0,  0, 'The Netherlands');
    WriteF( 0, SUCC(toadY),            { skip a line }
                   '[e-mail]');
    WriteF( 0, SUCC(toadY),            { skip a line }
                   'Also comments, bugs, etc. are expected at this address.');
    GetInput('Press enter to see next page',InStr);

    ClrScr;
    Frame(2);
    WriteF( 0,  2, Header);
    WriteF( 0,  0, PDS);
    WriteF(32, SUCC(toadY),            { skip a line }
'Use: Reformat d:');
    WriteF(27,  0,
'where d: is a driveletter.');
    WriteF( 0, SUCC(toadY),
'This program works for both fixed disks and floppies.');
    color := color + BLINK;
    WriteF( 0, toadY + 2,              { skip 2 lines }
'* WARNING * WARNING * WARNING * WARNING * WARNING * WARNING *');
    color := color - BLINK;
    WriteF( 0, toadY + 2,              { skip 2 lines }
'NEVER use this program on a disk that contains * PROTECTED * software');
    WriteF( 0,  0,
'You might find these programs turned into an illegal copy');
    WriteF( 0,  0,
'or even end up with a scrambled disk!!!!!!');
    WriteF( 0,  0,
'Always *UNINSTALL* this kind of software before using REFORMAT!!');
    WriteF( 0,  0,
'The program will prompt you to confirm this in case of a fixed disk');
    WRITELN;
    WRITELN;
  END;  { of WriteDoc}


PROCEDURE Check_DOS_Version;
{
  ********************************************************************
  DOS_Versions  DOS_Versions  DOS_Versions  DOS_Versions  DOS_Versions
  ********************************************************************
  Currently DOS 2.00 thru 3.10 are supported.  Mainly  because  of the
  use of the undocumented DOS  function call 32H, other versions might
  not be so. DOS function 30H returns the major version number in  al,
  and the minor version number in ah.  Remember that the  minor number
  is a two digit number: DOS 3.1 is really DOS 3.10, DOS 3.2 really is
  3.20
  ********************************************************************
  DOS_Versions  DOS_Versions  DOS_Versions  DOS_Versions  DOS_Versions
  ********************************************************************
  v1.6  Permitting a user override if higher than DOS 3.10.
        On your own head be it!
}
  VAR  r : REAL;
  BEGIN
    WITH Register DO BEGIN
      ah := $30;
      MSDos(Register);
      IF ( al < 2 ) OR (( al = 3 ) AND ( ah > 10 ))
      THEN BEGIN
(* v1.6
        WRITELN('Incorrect DOS version.');
        HALT;
*)

        r := al + (ah / 10);             {convert to a real}
        STR(r:1:2,NrStr);
        S40 := 'Enter A (abort), C (continue)';
        WriteWarning('Untested DOS version!');
        WriteError('DOS ' + NrStr);      {display DOS version}
        Legals := 'AC';

        REPEAT
          Getinput(S40,Instr);
        UNTIL POS(Instr,Legals) <> 0;

        IF Instr = 'A' THEN BEGIN
          GotoXY(1,24); WRITELN;  {leave the screen for him or her }
          HALT;
        END
        ELSE BlankFields;

      END;
    END;
  END;  { of Check_DOS_Version }