(*----------------------------------------------------------*)
Procedure MarkHeap;
Begin;
 Mark(HeapTop);
End;

(*----------------------------------------------------------*)
Procedure ReleaseHeap;
Begin
 Release(HeapTop);
End;

(*----------------------------------------------------------*)
(* This Procedure Simply Allocates Raw Memory for storage   *)
(* of the Memory File Allocation Table.                     *)
(*----------------------------------------------------------*)
Procedure GetMem4Fat;
Var
  Amount : Integer;
Begin
  Amount :=((SectPerFat * BytePerSect) + 5);
  Check4Amount(Amount);
  GetMem(Fat,Amount);
End;

(*----------------------------------------------------------*)
(* This Procedure Simply Frees Raw Memory used for storage  *)
(* of the File Memory Allocation Table.                     *)
(*----------------------------------------------------------*)
Procedure FreeMem4Fat;
Begin
  FreeMem(Fat,((SectPerFat * BytePerSect) + 5));    (* 5 is Room to Grow! *)
End;

(*----------------------------------------------------------*)
(* This Procedure Reads in and stores the File Allocation   *)
(* Table to an array Called FAT.                            *)
(*----------------------------------------------------------*)
Procedure StoreFat;
Var
 X,Z      : Integer;
 FatPoint : Integer;

Begin
 Write('Reading FAT',Char($0D));
 FatPoint:=0;                             (* Point to current array location*)

 For X:=FatAT to (SectPerFat+FatAT-1) Do
  Begin
   BlokRead(X,1);
   Move(Buffer^.Aray[0],Fat^.Aray[FatPoint],512);
   FatPoint := FatPoint + 512;
  End;

 If (DiskType <>  Fat^.Aray[0]) Then
   Begin
     Writeln(Char(7));
     Delay(1000);
     ClrScr;
     Writeln('First FAT Byte is -------------:',FAT^.ARAY[0]);
     Writeln('The BOOT Sector says that its -:',DISKTYPE);
     Writeln('SOMEBODYS WRONG!');
     Writeln('SST Will now ABORT - Rather than continue on ASSumptions.');
     Writeln('Try booting up and running SST - WITHOUT StayResident programs in place.');
     Halt;
   End;
End;

(*----------------------------------------------------------*)
(* This Procedure Gets the File Allocation From array FAT   *)
(* and Writes it back to disk.                              *)
(*----------------------------------------------------------*)
Procedure WriteFat2Disk;
Var
 XZ,Z      : Integer;
 FatPoint  : Integer;

Begin
  Writeln('Writing New FAT');
  FatPoint  := 0;                          (* Point to current array location*)

  (* Write the First FAT. *)
  For XZ:=FatAT to (SectPerFat+FatAT-1) Do
    Begin
      Move(Fat^.Aray[FatPoint],Buffer^.Aray[0],512); { Move 512 Bytes }
      FatPoint := FatPoint + 512;
      BlokWrite(XZ,1);
    End;

    (* Write the Second FAT. *)
    If (FatCount = 2) Then
      Begin
        FatPoint := 0;
        For XZ:=FatAT to (SectPerFat+FatAT-1) Do
          Begin
            Move(Fat^.Aray[FatPoint],Buffer^.Aray[0],512);
            FatPoint := FatPoint + 512;
            BlokWrite(XZ + SectPerFat,1);
          End;
      End;
End;

(*----------------------------------------------------------*)
(* This Function returns the value of the next cluster in a *)
(* link.  (4095 if it is the last link in the chain.)       *)
(* or -1 for the new style fats.                            *)
(*----------------------------------------------------------*)
Function NextCluster(Cluster:Integer):Integer;
Var
 Byte1,Byte2,Byte3:Byte;
 Offset,Whichone:Integer;
 X : Real;
Begin
  If NewStylFat Then
    Begin
      X :=(Cluster + Cluster);   { Cluster * 2 }
      NextCluster := Fat^.Aray[Round(X)] + ((Fat^.Aray[Round(X)+1]) SHL 8);
    End
  Else
    Begin
      X:=(Cluster * 1.5);
      If X = Int(X) Then
        Begin
          Byte1:=Fat^.Aray[Round(X)];
          Byte2:=Fat^.Aray[Round(X)+1];
          NextCluster:=(((Byte2 SHL 8)+Byte1) And $FFF);
        End
      Else
        Begin
          X:=Int(X);
          Byte1:=Fat^.Aray[Round(X)];
          Byte2:=Fat^.Aray[Round(X)+1];
          NextCluster:=(((Byte2 SHL 8)+Byte1) Shr 4);
        End;
    End;
End;

(*----------------------------------------------------------*)
(* This Procedure Will Print out a decoded representation   *)
(* of the entire file allocation table.                     *)
(*----------------------------------------------------------*)
Procedure PrintFat;
Var
 Value:Real;
Begin
 Writeln('Clusters In File Allocation Table Are Arranged As Follows.');
 For X:=0 to ClustPerDisk do
 Begin
     Value:=NextCluster(X);
     If NewStylFat Then
       Begin
         Case Round(Value) of
           -1      :  Write('  Last  ');
           -8..-2  :  Write('RootDir ');
           -16..-9 :  Write('  BAD!  ',Char(7));
         Else
           Write('  ',Value:4:0,'  ');
         End;
       End
     Else
       Begin
         Case Round(Value) of
           4095      :  Write('  Last  ');
           4088..4094:  Write('RootDir ');
           4080..4087:  Write('  BAD!  ',Char(7));
         Else
           Write('  ',Value:4:0,'  ');
         End;
       End;
 End;
 Writeln;
 Writeln('End Of File Allocation Table.');
End;

(*----------------------------------------------------------*)
(* This Procedure will Scan the Root directory for valid    *)
(* File Names sector by sector, and adds the entries to a   *)
(* dynamic linked list.                                     *)
(*----------------------------------------------------------*)
Procedure AllocateRootEntries;
Var
 Count,Z,X : Integer;

Begin
 ClrEol;
 Write('Scanning Root DIR For Files.',Char($0D));
 New(NewEntry);
 NewEntry^.FileName[0]:=Char(0);
 FirstEntry:=NewEntry;
 LastEntry:=NewEntry;
 FirstEntry^.NextEntry := Nil;
 For Count:=(0+RootAT) To (RootSectors+RootAt-1) Do
  Begin
   BlokRead(Count,1);
     Z := 0;
     While Z < 16  Do
      Begin
       For X:=0 to 7 Do LastEntry^.FileName[X]:=Char(Buffer^.Aray[(Z SHL 5)+X]);
       If LastEntry^.FileName[0] = Char(0) Then Exit;    (* Last One was Done.*)
       For X:=0 to 2 Do LastEntry^.Extension[X]:=Char(Buffer^.Aray[(Z SHL 5)+X+8]);

       If WatchEntryMak Then
       Writeln(LastEntry^.FileName,' ',LastEntry^.Extension,'     <- Root Entry');
       If LastEntry^.FileName[0] <> Char($E5) Then
         Begin
  LastEntry^.Attribute                    := Buffer^.Aray[(Z SHL 5)+11];
  For X:=0 to 1 Do LastEntry^.Time[X]     := Buffer^.Aray[(Z SHL 5)+X+22];
  For X:=0 to 1 Do LastEntry^.Date[X]     := Buffer^.Aray[(Z SHL 5)+X+24];
  LastEntry^.ClustPtr := Buffer^.Aray[(Z SHL 5)+26]+(Buffer^.Aray[(Z SHL 5)+27] SHL 8);
  LastEntry^.NewClust := Buffer^.Aray[(Z SHL 5)+26]+(Buffer^.Aray[(Z SHL 5)+27] SHL 8);
  For X:=0 to 3 Do LastEntry^.FileSize[X] := Buffer^.Aray[(Z SHL 5)+X+28];
         End
       Else
         Begin
  For X:= 1 to 7 Do LastEntry^.FileName[X] := Char($0);
  For X:= 0 to 2 Do LastEntry^.Extension[X] := Char($0);
  LastEntry^.Attribute := 0;
  For X:= 0 to 1 Do LastEntry^.Time[X] := 0;
  For X:= 0 to 1 Do LastEntry^.Date[X] := 0;
  LastEntry^.ClustPtr := 0;
  LastEntry^.NewClust := 0;
  For X:= 0 to 3 Do LastEntry^.FileSize[X] := 0;
         End;

       New(NewEntry);                       (* Get a new Element          *)
       NewEntry^.FileName[0]:=Char(0);      (* Set up incase its the last.*)
       LastEntry^.NextEntry:=NewEntry;      (* Point the last entry to it *)
       LastEntry:=NewEntry;                 (* It is now the last Entry.  *)
       LastEntry^.NextEntry:= Nil;
       Z := Z + 1;
      End;
  End;
End;

{------------------------------------------------------------------}
{  This Procedure will print out all of the entries in the         }
{  dynamic linked list of file names. Usually for DIAGNOSTIC use.  }
{------------------------------------------------------------------}
Procedure PrintDir;
Begin
  Writeln;
  Writeln('File Names and Attributes Are As Follows.');
  TempEntry:=FirstEntry;
  While (TempEntry^.FileName[0] <> Char(0)) Do
   Begin
      For X:=0 to 7 Do Write(Char(TempEntry^.FileName[X]));  Write(' ');
      For X:=0 to 2 Do Write(Char(TempEntry^.Extension[X])); Write(' -> ');
      If (TempEntry^.Attribute And 1)=1 Then Write('RO ') Else Write('   ');
      If (TempEntry^.Attribute And 2)=2 Then Write('HDN ') Else Write('    ');
      If (TempEntry^.Attribute And 4)=4 Then Write('SYS ') Else Write('    ');
      If (TempEntry^.Attribute And 8)=8 Then Write('VOL ') Else Write('    ');
      If (TempEntry^.Attribute And 16)=16 Then Write('DIR ') Else Write('    ');
      If (TempEntry^.Attribute And 32)=32 Then Write('ARC ') Else Write('    ');
      Write('Cluster# ',TempEntry^.ClustPtr);
      Writeln;
      TempEntry:=TempEntry^.NextEntry;
   End;
   Writeln('End of Name and Attribute list.');
End;

(*---------------------------------------------------------*)
(* This Procedure Scans the Dynamic directory file listing *)
(* and adds subdirectories to the list when it finds them. *)
(*---------------------------------------------------------*)
Procedure GetSubdirFiles;
Label
  ForSim1;

Var
 Sector,X,Z,Count  : Integer;
 CCluster          : Integer;
 BreakPoint        : Integer;
 Last              : Boolean;

Begin
  TempEntry:=FirstEntry;
  ClrEol;
  Write('Searching for directories',Char($0D));
  While (TempEntry^.FileName[0] <> Char(0)) Do
    Begin
      (* Not an Erased Entry.    *)
      (* Must Be A SubDir.       *)
      (* Not a `.' or `..' Entry.*)
      If (TempEntry^.FileName[0] <> Char($2E))  Then
      If ((TempEntry^.Attribute AND $10) = $10) Then
      If (TempEntry^.FileName[0] <> Char($E5))  Then
        Begin
          CCluster:=TempEntry^.ClustPtr;
          Repeat
            Sector:=GetSectFromClust(CCluster);
            BreakPoint := Sector + SectPerClust - 1;
ForSim1:
            Begin
              BlokRead(Sector,1);
              For Z:=0 to 15 Do
              If Buffer^.Aray[(Z*32)] <> 0 Then
                Begin
                  For X:=0 to 7 Do LastEntry^.FileName[X] :=
                  Char(Buffer^.Aray[(Z SHL 5)+X]);
                  If LastEntry^.FileName[0] <> Char($E5) Then
                    Begin
For X:=0 to 2 Do LastEntry^.Extension[X]:= Char(Buffer^.Aray[(Z SHL 5)+X+8]);
LastEntry^.Attribute                    := Buffer^.Aray[(Z SHL 5)+11];
For X:=0 to 1 Do LastEntry^.Time[X]     := Buffer^.Aray[(Z SHL 5)+X+22];
For X:=0 to 1 Do LastEntry^.Date[X]     := Buffer^.Aray[(Z SHL 5)+X+24];
LastEntry^.ClustPtr:= Buffer^.Aray[(Z*32)+26]+(Buffer^.Aray[(Z SHL 5)+27] SHL 8);
LastEntry^.NewClust:= LastEntry^.ClustPtr;
For X:=0 to 3 Do LastEntry^.FileSize[X] := Buffer^.Aray[(Z SHL 5)+X+28];
                    End
                  Else
                    Begin
For X:= 1 to 7 Do LastEntry^.FileName[X] := Char($0);
For X:= 0 to 2 Do LastEntry^.Extension[X] := Char($0);
LastEntry^.Attribute := 0;
For X:= 0 to 1 Do LastEntry^.Time[X] := 0;
For X:= 0 to 1 Do LastEntry^.Date[X] := 0;
LastEntry^.ClustPtr := 0;
LastEntry^.NewClust := 0;
For X:= 0 to 3 Do LastEntry^.FileSize[X] := 0;
                   End;
                 If WatchEntryMak Then
                 Writeln(LastEntry^.FileName,' ',LastEntry^.Extension);
                 New(NewEntry);                  (* Get a new Element         *)
                 NewEntry^.FileName[0]:=Char(0);
                 NewEntry^.NextEntry :=Nil;      (* The Next entry is NIL     *)
                 LastEntry^.NextEntry:=NewEntry; (* Point the last entry to it*)
                 LastEntry:=NewEntry;            (* It is now the last Entry. *)
               End;
             End;
           If Sector <> BreakPoint Then
             Begin
               Sector := Sector + 1;
               Goto ForSim1;
             End;
           CCluster:=NextCluster(CCluster);
           If ((CCluster >= LowLastValue) AND (CCluster <= HighLastValue)) Then
             Last := True Else Last := False;
        Until Last;
      End;
    TempEntry:=TempEntry^.NextEntry;
   End;
End;

(*---------------------------------------------------------*)
(* This Procedure Writes Root directory entries back to    *)
(* the correct sectors.                                    *)
(*---------------------------------------------------------*)
Procedure WriteRoot;
Var
 X,Count:Integer;
 TempEntry:EntryPointer;
 Stop     :Boolean;

Begin
  Writeln('Writing Root Directory');
  TempEntry:=FirstEntry;
  Stop:=False;
  For Count:=(0+RootAT) To (RootSectors+RootAt-1) Do
    Begin
      For Z := 0 to 511 Do Buffer^.Aray[Z] := 0;  { FLUSH THE BUFFER }
      For Z:=0 to 15 Do
        Begin
          If (TempEntry^.FileName[0] = Char(0)) or
             (TempEntry^.FileName[0] = Char($2E)) Then Stop:=True;
          If Stop = False Then
           Begin
              If TempEntry^.FileName[0]=Char($E5) Then
                Buffer^.Aray[(Z SHL 5)] := $E5
              Else
                Begin

  For X:=0 to 7 Do Buffer^.Aray[(Z SHL 5)+X]   :=Ord(TempEntry^.FileName[X]);
  For X:=0 to 2 Do Buffer^.Aray[(Z SHL 5)+X+8] :=Ord(TempEntry^.Extension[X]);
  Buffer^.Aray[(Z SHL 5)+11]                   :=TempEntry^.Attribute;
  For X:=0 to 9 Do Buffer^.Aray[(Z SHL 5)+X+12]:= 0;
  For X:=0 to 1 Do Buffer^.Aray[(Z SHL 5)+X+22]:=TempEntry^.Time[X];
  For X:=0 to 1 Do Buffer^.Aray[(Z SHL 5)+X+24]:=TempEntry^.Date[X];
  Buffer^.Aray[(Z SHL 5)+26] := LO(TempEntry^.ClustPtr);
  Buffer^.Aray[(Z SHL 5)+27] := HI(TempEntry^.ClustPtr);
  For X:=0 to 3 Do Buffer^.Aray[(Z SHL 5)+X+28] := TempEntry^.FileSize[X];

                End;
              TempEntry:=TempEntry^.NextEntry;
           End;
        End;
      BlokWrite(Count,1);
    End;
End;
(*---------------------------------------------------------*)
(* This Procedure Writes a Subdirectory back to the        *)
(* correct sectors. TempPtr Points to its Beginning.       *)
(* This procedure simulates a FOR - DO loop. It simulates  *)
(* it to use turbo's negative integers as unsigned integers*)
(* from 0 to 65535.  This is for the new 4 nibble clusters.*)
(*---------------------------------------------------------*)
Procedure RWrADir;
Label
  ForSim2;
Var
 Sector,Count :Integer;
 CurrentCluster   :Integer;
 Stop             :Boolean;
 BreakPoint       :Integer;
 Last             :Boolean;

Begin
  Stop:=False;
  CurrentCluster:=TempEntry^.ClustPtr;
  Repeat
    Sector:=GetSectFromClust(CurrentCluster);
    BreakPoint := Sector + SectPerClust - 1;

ForSim2:
      Begin
        For Z := 0 to 511 Do Buffer^.Aray[Z] := 0;  { FLUSH THE BUFFER }
        For Z:= 0 to 15 Do
         Begin
          If Stop = False Then (* Cycle Through One Entry  *)
            Begin
             If TempEntry^.FileName[0] = Char($E5) Then
               Buffer^.Aray[(Z SHL 5)] := $E5
             Else
               Begin

   For X:=0 to 7 Do Buffer^.Aray[(Z SHL 5)+X]  :=Ord(TempEntry^.FileName[X]);
   If (Buffer^.Aray[Z SHL 5]=$E5) Then Buffer^.Aray[Z SHL 5]:=0;
   For X:=0 to 2 Do Buffer^.Aray[(Z SHL 5)+X+8]:=Ord(TempEntry^.Extension[X]);
   Buffer^.Aray[(Z SHL 5)+11]                   := TempEntry^.Attribute;
   For X:=0 to 9 Do Buffer^.Aray[(Z SHL 5)+X+12]:= 0;
   For X:=0 to 1 Do Buffer^.Aray[(Z SHL 5)+X+22]:= TempEntry^.Time[X];
   For X:=0 to 1 Do Buffer^.Aray[(Z SHL 5)+X+24]:= TempEntry^.Date[X];
   Buffer^.Aray[(Z SHL 5)+26] := LO(TempEntry^.ClustPtr);
   Buffer^.Aray[(Z SHL 5)+27] := HI(TempEntry^.ClustPtr);
   For X:=0 to 3 Do Buffer^.Aray[(Z SHL 5)+X+28] := TempEntry^.FileSize[X];

               End;
             TempEntry:=TempEntry^.NextEntry;
             If ((TempEntry^.FileName[0] = Char($2E)) And
              (TempEntry^.Filename[1] = Char($20)))
                           Or
              (TempEntry^.FileName[0] = Char(0)) Then Stop:=True;
            End;
         End;
         BlokWrite(Sector,1);
      End;
      If Sector <> BreakPoint Then
        Begin
          Sector := Sector + 1;
          Goto ForSim2;
        End;
      CurrentCluster := NextCluster(Currentcluster);
      If ((CurrentCluster >= LowLastValue) AND
         (CurrentCluster <= HighLastValue)) Then
         Last := True Else Last := False;
  Until Last;
End;

(*---------------------------------------------------------*)
(* This Procedure Writes all of the directory entries back *)
(* to the correct sectors.    (TempEntry is Global.)       *)
(*---------------------------------------------------------*)
Procedure RewritDirs;
Begin
  WriteRoot;                        (* Write the Root Directory Back to Disk *)
  Writeln('Writing Subdirectories');
  TempEntry:=FirstEntry;
  While TempEntry^.FileName[0] <> Char(0) Do
    Begin
      If (TempEntry^.FileName[0] = Char($2E)) And
       (TempEntry^.FileName[1] = Char($20)) Then
        Begin
          RWrADir;
        End
      Else
      TempEntry:=TempEntry^.NextEntry;
    End;
End;

(*----------------------------------------------------------*)
(* This Procedure takes a Number paramater which is a       *)
(* cluster number, and points the FAT entry which it        *)
(* represents to the second parameter or -NEXT- cluster.    *)
(*----------------------------------------------------------*)
Procedure MakePoint(Number,Next:Integer);
Var
 Byte1,Byte2:Byte;
 Offset,Whichone:Integer;
 X : Real;
Begin
  If Number < 2 Then Exit;
  If NewStylFat Then
    Begin
      X := Number + Number;                   { Number * 2 }
      Fat^.Aray[Round(X)]   := Lo(Next);
      Fat^.Aray[Round(X)+1] := HI(Next);
    End
  Else
    Begin
      X:=(Number * 1.5);
      If X = Int(X) Then
        Begin
          Byte1:=Fat^.Aray[Round(X)];
          Byte2:=Fat^.Aray[Round(X)+1];
          Byte1 := LO(Next);
          Byte2 := (Byte2 AND $F0) OR ($0F AND HI(Next));
          Fat^.Aray[Round(X)]   := Byte1;
          Fat^.Aray[Round(X)+1] := Byte2;
        End
      Else
        Begin
          X:=Int(X);
          Byte1:=Fat^.Aray[Round(X)];
          Byte2:=Fat^.Aray[Round(X)+1];
          Byte1 := (Byte1 AND $0F) OR  (LO(Next SHL 4));
          Byte2 := (LO(Next Shr 4));
         Fat^.Aray[Round(X)]   := Byte1;
         Fat^.Aray[Round(X)+1] := Byte2;
       End;
    End;
End;

(*----------------------------------------------------------*)
(* This Procedure Rebuilds the FAT from the dynamic lists.  *)
(*----------------------------------------------------------*)
Procedure MakeNewFat;
Var
  CurrentF   : FancyPointer;
  NextF      : FancyPointer;
  CurClust   : Integer;
  FileN      : Integer;       (* FileNumber of Last Entry Modified.*)
  XXX        : Integer;
  StartPlace : Integer;
  TmpStorage : Integer;

Begin
  ClrEol;
  Write('Building New FAT        -[ WAIT ]-',Char($0D));

  { Zero all except BAD Clusters. }
  { Do not zero it out if it is already zero!   }
  { Also, Start With first Now to be UNUSED     }
  { Cluster Why 0 it if it will be overwritten? }

    If GlobalLastUsed > 2 Then StartPlace := (GlobalLastUsed - 1)
      Else StartPlace := GlobalLastUsed;
    For XXX := StartPlace To (ClustPerDisk + 2) Do
    Begin   (*First Data cluster is cluster #2.--^ *)
      TmpStorage := NextCluster(XXX);
      If ((TmpStorage > HighBadValue) OR (TmpStorage < LowBadValue))
         AND (TmpStorage <> 0) Then MakePoint(XXX,0);
    End;

        {------------ Fix each clusters FAT entry -------------}

LastEntry := FirstEntry;
CurrentF  := FancyStart;
NextF     := FancyStart^.NextFancy;
CurClust  := 2;
While  (LastEntry^.FileName[0] <> Char(0)) Do
  Begin
    WITH LASTENTRY^ DO
      While ((LastEntry^.FileName[0]=Char($E5))       { Increment Pointer  }
        OR  (LastEntry^.FileName[0]=Char($2E)))       { To Next Valid File }
        AND (LastEntry^.FileName[0] <> Char(0) )      { Entry.             }
        Do LastEntry:=LastEntry^.NextEntry;
    If (LastEntry^.FileName[0]=Char(0)) Then Exit;
{*********}
    If (NextF^.FirstInFile = False) AND (NextF^.NextFancy <> NIL) Then
        MakePoint(CurrentF^.WhereShdBe,NextF^.WhereShdBe)   { More in list.}
        Else MakePoint(CurrentF^.WhereShdBe,HighLastValue);{Last clst in list.}
    If NextF^.NextFancy = NIL Then Exit;
    CurrentF := NextF;
    NextF    := NextF^.NextFancy;
    If (CurrentF^.FirstInFile = True) Then
      Begin
        LastEntry := LastEntry^.NextEntry;
      End;
  End;
End;

(*----------------------------------------------------------*)
(* This Function Returns the number of the very next good   *)
(* cluster.                                                 *)
(*----------------------------------------------------------*)
Function IncClust(Clst:Integer):Integer;
Var
  TestValue : Integer;
  Inc       : Integer;

Begin
  Inc := Clst;
  Repeat
    Inc := Inc + 1;
    IncClust := Inc;
  Until (NextCluster(Inc) > HighBadValue) or (NextCluster(Inc) < LowBadValue)
End;

{--------------------------------------------------------------------------}
{ This Procedure makes all of the decisions about where clusters in a file }
{ will end up.  The WHERESHDBE field of the FancyEntry will be modified.   }
{ The first half of the procedure allocates cluster space for all DIRs.    }
{ The second half allocates space normal files.                            }
{--------------------------------------------------------------------------}
Procedure DoFancyList;
Label
  DoAnother,LoopUp;

Var
  ClusterNumber  : Integer;    (* Holds the next valid & available cluster. *)
  DirLevl        : Integer;    (* Holds Cluster Ptr back to the current Dir.*)
  PointHere      : Integer;    (* Temporary Storage for new value.          *)
  IncrementFancy : Boolean;
  IncrementEntry : Boolean;
  StopHere       : Boolean;

Begin
FancyLast     := FancyStart; (* Initialize the Pointer.               *)
LastEntry     := FirstEntry; (* Point to first NON-SYSTEM Entry.      *)
ClusterNumber := 2;          (* Global.. is defined before call. *)
StopHere      := False;
DirLevl       := 0;
ClrEol;
Write('Cluster Process Re-Allocation Pass -[ WAIT ]-',Char($0D));

LoopUp:
{--------------------------------------------------------------------------}
{----------------------------- Erased File --------------------------------}
{--------------------------------------------------------------------------}
If LastEntry^.FileName[0] = Char($E5) Then
  Begin
    LastEntry := LastEntry^.NextEntry;
    GoTo DoAnother;
  End;

{--------------------------------------------------------------------------}
{---------------------------- Zero Track File -----------------------------}
{----------------- NOTE: Process AFTER Erased Files! ----------------------}
{--------------------------------------------------------------------------}

  If (((FancyLast^.FirstInFile = True) And ((LastEntry^.Attribute And $10)<>$10))
   And (LastEntry^.ClustPtr = 0))
  Then
    Begin
      FancyLast^.WhereShdBe := 0;
      LastEntry^.NewClust   := 0;
      FancyLast :=FancyLast^.NextFancy;
      LastEntry := LastEntry^.NextEntry;            { Increment to next Entry}
      GoTo DoAnother;
    End;

{--------------------------------------------------------------------------}
{----------------------- Case of a Normal File ----------------------------}
{--------------------- NOTE: Process After Zero Track Files ---------------}
{--------------------------------------------------------------------------}
If (LastEntry^.FileName[0] <> Char($E5)) AND         { Not Erased.}
   ((LastEntry^.Attribute AND $10) <> $10) Then      { Not A Dir. }
   Begin
     LastEntry^.NewClust   := ClusterNumber;         { Store New Pointer.}
     FancyLast^.WhereShdBe := ClusterNumber;
     ClusterNumber := IncClust(ClusterNumber);       { Get Next Good Cluster.}
     FancyLast     := FancyLast^.NextFancy;          { Increment to Next Fancy}
     { Do The Rest of the File }
     While (FancyLast^.FirstInFile = False) Do
     Begin
       FancyLast^.WhereShdBe := ClusterNumber;       { Update Pointer.       }
       ClusterNumber    := IncClust(ClusterNumber);  { Get Next Good Cluster.}
       FancyLast        := FancyLast^.NextFancy;     { Move to Next Fancy    }
     End;
     LastEntry := LastEntry^.NextEntry;              { Increment to next Entry}
     GoTo DoAnother;
   End;
{--------------------------------------------------------------------------}
{---------------------------- Normal Directory ----------------------------}
{--------------------------------------------------------------------------}
If (LastEntry^.FileName[0] <> Char($2E)) AND
   ((LastEntry^.Attribute AND $10) = $10) Then
  Begin

   { Scan Ahead for the corresponding `.' Dir entry }

   TempEntry := LastEntry;
   Repeat
     TempEntry := TempEntry^.NextEntry;
   Until ((TempEntry^.FileName[0] = Char($2E)) And
         (TempEntry^.FileName[1] = Char($20))) And
         (TempEntry^.ClustPtr = LastEntry^.ClustPtr);
   TempEntry := TempEntry^.NextEntry;

   { Fix The `..' Dir Level Entry to Point to its' Parent dir at DirLevl. }

   TempEntry^.NewClust := DirLevl;

   { Increment to Next Entry.             }

   LastEntry := LastEntry^.NextEntry;
   GoTo DoAnother;
 End;

{--------------------------------------------------------------------------}
{--------------------------- `.' Dir Directory ----------------------------}
{--------------------------------------------------------------------------}
If (LastEntry^.FileName[0] = Char($2E)) AND
   (LastEntry^.FileName[1] = Char($20)) Then
  Begin

   { Treat it Like it was a normal File. }

   DirLevl       := ClusterNumber;           { UpDate the New Parent Level. }
   LastEntry^.NewClust   := ClusterNumber;         { Store New Pointer.     }
   FancyLast^.WhereShdBe := ClusterNumber;
   ClusterNumber := IncClust(ClusterNumber);       { Get Next Good Cluster. }
   FancyLast     := FancyLast^.NextFancy;          { Increment to Next Fancy}
   { Do The Rest of the File/.Dir }
   While (FancyLast^.FirstInFile = False) Do
   Begin
     FancyLast^.WhereShdBe := ClusterNumber;       { Update Pointer.       }
     ClusterNumber    := IncClust(ClusterNumber);  { Get Next Good Cluster.}
     FancyLast        := FancyLast^.NextFancy;     { Move to Next Fancy    }
   End;

   { Now, Go Back and find the Corresponding DIR entry and Point here. }

   TempEntry := FirstEntry;
   While((((TempEntry^.Attribute AND $10) = $10) And
         (FileName[0] <> Char($2E))) AND
         (TempEntry^.ClustPtr = LastEntry^.ClustPtr) = False) Do
         TempEntry := TempEntry^.NextEntry;

   { Fix The `DIR' Entry to Point here to its' File. }

   TempEntry^.NewClust := DirLevl;

   LastEntry := LastEntry^.NextEntry;              { Increment to next Entry}

{--------------------------------------------------------------------------}
{-------------------------- `..' Dir Directory ----------------------------}
{--------------------------------------------------------------------------}
   { The `..' Entry was Fixed when the DIR entry was hit. }
   { Therefore Do Nothing.                                }

   LastEntry := LastEntry^.NextEntry;              { Increment to next Entry}
   GoTo DoAnother;
 End;

{--------------------------------------------------------------------------}
DoAnother:

If (LastEntry^.FileName[0] = Char(0)) Then
  Begin
    GlobalLastUsed := ClusterNumber;
    Exit;
  End
Else
  GoTo LoopUp;
End;

(*----------------------------------------------------------*)
(* This Function helps the Procedure below find EOF.        *)
(*----------------------------------------------------------*)
Function StopIt(Clst:Integer):Boolean;
Begin
  StopIt := False;
  IF ExtDiags Then Writeln(Clst);
  If ((Clst >= LowLastValue) AND (Clst <= HighLastValue)) Then StopIt := True;
End;

(*----------------------------------------------------------*)
(* This Procedure Follows a file out through all of its     *)
(* Clusters and adds each to the FancyFat List.             *)
(*----------------------------------------------------------*)
(* TempEntry Points to the Files directory entry.           *)
(* FancyLast points to the next available entry.            *)
(*----------------------------------------------------------*)

Procedure FollowFile;        (* Follow File Pointed to by TempEntry *)
Var
  ClusterNum : Integer;
  FCLINFile  : Boolean;
  NxtCluster : Integer;  (* Temporary storage for last cluster number.*)

Begin
  (* Place the first clusters data in the FancyEntry. *)
  FClinFile :=True;
  FancyLast^.FirstInFile := FClinFile;                  (* Start us off.     *)
  FClinFile := False;                           (* Its not the first anymore.*)

  NxtCluster := TempEntry^.ClustPtr;
  FancyLast^.ClusterNum  := NxtCluster;                 (* Store 1st cluster *)

  (*     Get an new fancy pointer variable from heap. *)
  New(FancyNew);                               (* Get a new Element          *)
  FancyNew^.NextFancy  := Nil;                 (* The Next entry is NIL      *)
  FancyNew^.WhereShdBe := -1;                  (* Initialize WhereShdBe      *)
  FancyNew^.ClusterNum := -1;                  (* Initialize ClusterNum.     *)
  FancyLast^.NextFancy := FancyNew;            (* Point the last entry to it *)
  FancyLast            := FancyNew;            (* It is now the last Entry.  *)
  While (Not StopIt(NextCluster(NxtCluster)))  do
    Begin
      NxtCluster := NextCluster(NxtCluster);   (* Get next cluster in chain. *)
      FancyLast^.FirstInFile := FCLINFile;  (* We will need this for sorting *)
      FancyLast^.ClusterNum  := NxtCluster; (* Store the next cluster.       *)
      (*     Get an new fancy pointer variable from heap. *)
      New(FancyNew);                         (* Get a new Element            *)
      FancyNew^.NextFancy  := Nil;           (* The Next entry is NIL        *)

      FancyLast^.NextFancy := FancyNew;      (* Point the last entry to it   *)
      FancyLast            := FancyNew;      (* It is now the last Entry.    *)
      FancyLast^.WhereShdBe  := -1;          (* Initialize WhereShdBe.       *)
      FancyLast^.ClusterNum  := -1;          (* Initialize ClusterNum.       *)
      FancyLast^.FirstInFile := True; {MUST BE TRUE -In case its last in list.}
    End;
End;


(*----------------------------------------------------------*)
(* This Procedure Sorts all of the sectors out on the disk. *)
(* A Linked List is made which holds the files number,      *)
(* (Starting at zero), The Cluster number within the file,  *)
(* (Starting at zero), and the current cluster pointer to   *)
(* that cluster.  Erased files are not traced.              *)
(* Only Directories names `..' are traced.                  *)
(* There is no specific end of file marker, except to note  *)
(* that a file has ended when the file number is higher.    *)
(*----------------------------------------------------------*)
Procedure GetFancyList;
Var
 ZZ : Integer;     (* Used To Set up File Name String. *)

Begin
  ClrEol;
  Write('Making Cluster List     -[ WAIT ]-');
  GotoXY(1,WhereY);
  FileNum:=0;
  (* Get a Fancy Pointer Variable from the Heap.                        *)
  TempEntry:=FirstEntry;
  New(FancyNew);                             (* Allocate one of them.   *)
  FancyStart:=FancyNew;                      (* Set up the Pointers.    *)
  FancyLast :=FancyNew;
  FancyLast^.WhereShdBe:= -1;                (* Initialize WhereShdBe.  *)
  FancyLast^.ClusterNum:= -1;                (* Initialize ClusterNum.  *)

  FileName := '           ';

  While TempEntry^.Filename[0] <> Char(0) Do
   Begin              If

       ((TempEntry^.FileName[0]=Char($2E)) And
       (TempEntry^.FileName[1]=Char($20)))

                      OR

       ((TempEntry^.FileName[0]<>Char($E5)) AND
       ((TempEntry^.Attribute AND $10) <> $10))

                     Then
     Begin
      (* Put the File's Name and extension into the FILENAME string.    *)
      For ZZ := 0 to 7 Do FileName[ZZ+1]:=TempEntry^.FileName[ZZ];
      For ZZ := 0 to 2 Do FileName[ZZ+9]:=TempEntry^.Extension[ZZ];
      FollowFile;     (* Follow the file out.     *)
      FileNum := FileNum + 1;
     End;
    TempEntry:=TempEntry^.NextEntry;      (* Point to next file.      *)
   End;
End;

{------------------------------------------------------------------------}
{ This Procedure Gets Space back from Directories that have shortened up }
{ and now have more space allocated to them than they need.              }
{------------------------------------------------------------------------}
Procedure PackDirs;
Begin

  { NOT IMPLEMENTED YET }

End;

(*---------------------------------------------------------*)
(* This Procedure Puts erased entries at the end of each   *)
(* directory.  It Gets control just after the entry list   *)
(* made.                                                   *)
(*---------------------------------------------------------*)
Procedure SortDeleted;
Label
  SortAgain,SortThrough,AbortThisOne;

Var
  StartPointer : EntryPointer;
  EndPointer   : EntryPointer;
  ScanPointer  : EntryPointer;
  TempPointer2 : EntryPointer;

Begin
  ClrEol;
  Write('Removing Deleted Entries',Char($0d));
  StartPointer := FirstEntry;
  EndPointer   := StartPointer;
  DirsChanged  := False;   { Keep track of whether or not Directories Changed.}

SortAgain:
  StartPointer := EndPointer;
  If StartPointer^.FileName[0] = Char(0) Then Exit;  (* End of list. *)

  (*---------(0) Find Last Entry in a group of entries.------------*)
  While
    ((EndPointer^.FileName[0] <> Char(0)) AND
    (EndPointer^.FileName[0] <> Char($2E)))
      DO EndPointer := EndPointer^.NextEntry;

SortThrough:

  (*----------(1) Find Next Erased Entry in Sort group.------------*)
  (*                 Make StartPointer Point to it.                *)

  While ((StartPointer^.FileName[0] <> Char($E5))
    And (StartPointer <> EndPointer)) Do StartPointer:= StartPointer^.NextEntry;
  If StartPointer = Endpointer Then Goto AbortThisOne;

  (*----------(2) Find Next Good Entry after it.------------------*)
  ScanPointer := StartPointer;
  While ((ScanPointer^.FileName[0] = Char($E5))
    And (ScanPointer <> EndPointer)) Do ScanPointer:= ScanPointer^.NextEntry;
  If ScanPointer = Endpointer Then Goto AbortThisOne;

  (*-----------(3) Move Good Data to Erased Entry.----------------*)
  (* StartPointer points to erased. ScanPointer points to good.   *)
  TempPointer2 := StartPointer^.NextEntry;
  StartPointer^ := ScanPointer^;
  StartPointer^.NextEntry := TempPointer2;
  Dirschanged := True;

  (*------------(4) Erase the now bad entry. ---------------------*)
  ScanPointer^.FileName[0] := Char($E5);

  (*------------(5) Go up to search for another.------------------*)

  Goto SortThrough;

AbortThisOne:

  If EndPointer^.FileName[0] = Char(0) Then Exit;  (* We must be finished.   *)

  EndPointer := EndPointer^.NextEntry;   (* Point to the Next valid entry... *)
  EndPointer := EndPointer^.NextEntry;   (* ....After the `.' and `..'       *)
  GoTo SortAgain;                        (* Loop up to do next sort.         *)
End;

{----------------------------------------------------------------------------}
{ This Procedure Checks to see if the disk is a system disk.  If it is, then }
{ the starting points for REALLOCATION are adjusted so that the system files }
{ will not be moved or changed in any way.                                   }
{ -----:Specifically, This Procedure Modifies three Variables. It Modifies   }
{ GLOBALLASTUSED-: Points to First cluster available after system files.     }
{ STARTENTRY   --: Points to First NON-SYSTEM entry.                         }
{ STARTFANCY   --: First Fancy for entry above.                              }
{ If we do find that it looks like a system disk, then the first two entries }
{ will be TURNED INTO DIRS, for DIRPACK and re,adjusted later.               }
{----------------------------------------------------------------------------}
Procedure Check4SystemDisk;

Var
  TestEntry1  : EntryPointer;
  TestEntry2  : EntryPointer;

Begin
  SystemDisk := False;
  TestEntry1 := FirstEntry;   { Point to the first Entry. }
  TestEntry2 := FirstEntry^.NextEntry;

{--- If Only ONE entry, then it is a nonSystem Disk.-----}

  If FirstEntry^.NextEntry = NIL Then Exit;

{--- If First File doesn't start at cluster #2 then it can't be SYSTEM DISK --}
   If TestEntry1^.ClustPtr <> 2 Then Exit;

{--- If either 1st or 2nd files are SUB-directories, Then NONSYSTEM disk. ---}
  If (TestEntry1^.Attribute AND $10) = $10 Then Exit;
  If (TestEntry2^.Attribute AND $10) = $10 Then Exit;

{--- Check for Known System Disk Names -----}
{--- Check for Zeinth System Files.    -----}
  If ((TestEntry1^.FileName = 'IO      ') And (TestEntry1^.Extension = 'SYS'))
     AND
     ((TestEntry2^.FileName = 'MSDOS   ') And (TestEntry1^.Extension = 'SYS'))
     Then SystemDisk := True;

  If ((TestEntry1^.FileName = 'IBMBIO  ') And (TestEntry1^.Extension = 'COM'))
     AND
     ((TestEntry2^.FileName = 'IBMDOS  ') And (TestEntry1^.Extension = 'COM'))
     Then SystemDisk := True;


{--- If First Two Files are hidden, then it might be a system disk ---}

  If ((TestEntry1^.Attribute AND $02) = 2) AND
     ((TestEntry2^.Attribute AND $02) = 2) Then SystemDisk := True;

End;

{----------------------------------------------------------------------------}
{ This Procedure Shifts DIR entries in a directory to the top of the DIR.    }
{----------------------------------------------------------------------------}
Procedure ShiftDirsUp;
Label
  SCOOT,FINISHEDMOVING;

Var
  PTR1 : EntryPointer;
  PTR2 : EntryPointer;
  PTR3 : EntryPointer;
  PTR4 : EntryPointer;

Begin
  Write('Optimizing Directory Entries Now.');
  GotoXY(1,WhereY);
  Check4SystemDisk;
  New(PTR4);

{ Create a Fake DIR entry and Make it the first in the list of entries. }
{ This makes the logic flow much better.                                }
  NEW(TempEntry);
  PTR1 := FirstEntry;
  FirstEntry := TempEntry;
  FirstEntry^.NextEntry := PTR1;
  FirstEntry^.Attribute := $10;
  FirstEntry^.FileName[0] := 'X';
  FirstEntry^.ClustPtr := 0;
  FirstEntry^.NewClust := 0;

{ NOW...: Dynamic Entry List seems to start with a DIR entry.}
  PTR1 := FirstEntry;
  PTR2 := FirstEntry^.NextEntry;

{ Take System Disks into account,   }
  If SYSTEMDISK Then
    Begin
      PTR1 := PTR1^.NextEntry;  { PTR1 Now Points at IO.SYS }
      PTR1 := PTR1^.NextEntry;  { PTR1 Now Points at MSDOS.SYS }
      PTR2 := PTR1^.NextEntry;
    End;

{ PTR1 and PTR2 now look just like they would look even if we were }
{ past the root.                                                   }

SCOOT:

{ SCOOT PTR1 and PTR2 down the list until PTR1 Points at a DIR and }
{ PTR2 Points at a normal file entry. Jump to FinishedMoving if    }
{ End of List is encountered.                                      }

WHILE
  ((PTR2^.Attribute AND $10) = $10) AND (PTR2^.FileName[0] <> Char(0)) DO
    Begin
      PTR1 := PTR2;
      PTR2 := PTR2^.NextEntry;
    End;

If PTR2^.FileName[0] = Char(0) Then Goto FinishedMoving;

{ Now Scan Ahead for a normal DIR entry to insert between PTR1 and PTR2  }
{ IF a new Subdirectory is entered, Move PTR1 to Point to the `..' entry }
{ and PTR2 to the one after that, and jump back up to SCOOT. If end of   }
{ list is encounteded, Then goto FinishedMoving.                         }

PTR3 := PTR2;
WHILE
  ((PTR3^.Attribute AND $10) <> $10) AND (PTR3^.FileName[0] <> Char(0)) DO
  Begin
    PTR3 := PTR3^.NextEntry;
  End;

IF PTR3^.FileName[0] = Char(0) Then GoTo FINISHEDMOVING;
IF PTR3^.FileName[0] = Char($2E)
  THEN
    Begin
      PTR1 := PTR3^.NextEntry;
      PTR2 := PTR1^.NextEntry;
    End
  ELSE
    Begin
      PTR1^.NextEntry  := PTR4 ;  { Insert the new blank entry.      }
      PTR4^            := PTR3^;  { Fill new with insertthis's data. }
      PTR4^.NextEntry  := PTR2 ;  { Connect new to befores entry.    }

      PTR4   := PTR3^.NextEntry ; { Point at data after one to we inserted.}
      PTR3^  := PTR4^ ;           { Move data to old inserted entry.       }

      PTR3 := PTR2;
      PTR1 := PTR1^.NextEntry;
    End;

GOTO SCOOT;

FINISHEDMOVING:

{ Delete and Dispose the First Fake DIR entry. }

  TempEntry := FirstEntry;
  FirstEntry := FirstEntry^.NextEntry;
End;

{----------------------------------------------------------------------------}
{ This Procedure Lets the User Do a Hand or automated sort on the Directory. }
{----------------------------------------------------------------------------}
Procedure UserFileNameSort;
Begin
  Writeln('User Filename Sort Not Implemented This Version.');

  { NOT IMPLEMENTED YET }

End;

{-----------------------------------------------------------}
{  This Procedure is called after SST is run on a HARD DISK }
{-----------------------------------------------------------}
Procedure Finished;
Begin
  Writeln;
  Writeln('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
  Writeln('³ SST Session Completed ³');
  Writeln('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
End;

(*---------------------------------------------------------*)
(*                                                         *)
(*---------------------------------------------------------*)
Procedure DoWarningMsg;
Begin
 If (OldNumLeft = 0) AND (Not PackONly) Then
   Begin
     Writeln('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
     Writeln('³ Disk is Sequential, Ready to Clean up Directories Now.  ³');
     Writeln('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
   End;

 If PackOnly Then
   Begin
     If DirsChanged = True Then
       Begin
         Writeln('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
         Writeln('³ Set to Clear Erased Entries Only. ³');
         Writeln('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
       End
     Else
       Begin
         Writeln('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
         Writeln('³ No Erased Entries to Remove. No Work to Do! ³');
         Writeln('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
         Quit;
       End
   End;
End;

(*---------------------------------------------------------*)
(*                                                         *)
(*---------------------------------------------------------*)
Procedure GtDskPrntCright;
Begin
  ClrScr;
  WriteIntro;                   (* Print CopyRight.                 *)
  GetDisk2use;
  Writeln('Reading Boot Track Information.');
End;

(*---------------------------------------------------------*)
(*      Main Logic Starts Here.                            *)
(*---------------------------------------------------------*)
Begin

{----------------------------------------------------------------------}
{ SPECIAL DIAGNOSTIC.                                                  }
{----------------------------------------------------------------------}
 FOR X:=0 TO StackSize DO STACK[X]:=0;
{----------------------------------------------------------------------}
 Select_Video;                 {  Choose Mono or Color for windows. }
 TextBackGround(BackColor);    {  Black Backgound.                  }
 TextColor(ForeColor);         {  Bright White Forground.           }
 CursorOFF;                    {  Turn the Cursor off.              }
 FlushDos;                     {  Clear All Dos Disk Buffers.       }
 If DisplayHeap=ON Then
   Begin
     Writeln('Largest Free Block is as follows:');
     Check4Amount(0);
   End;
 GtDskPrntCright;              (* Get disk & Print CopyRight.      *)
 IsDriveSubst;                 {  CHDIR to Root and See if SUBSTed  }
 MarkHeap;                     (* Mark the start of dynamic memory *)

 (* Set up temporary buffer parameters to read in boot track.      *)
 GetMem(Buffer,1024);          (* Allocate Block for Cluster Buffer*)
 BlokRead(0,1);                (* Read in the Boot Sector for info *)
 ReadBootInfo;                 (* Read in all boot track variables *)
 FreeMem(Buffer,1024);         (* Free the initial block of memory.*)

 (* Now, Get the Proper Amount of memory.                          *)
 GetMem4Fat;                          (* Allocate Block of memory for FAT.*)
 GetMem(FH,((ClustPerDisk+2)* 4)+8);  {  Get Memory for new hash type.     }
 GetBufMem;                           (* Allocate Block for Cluster Buffer*)
 GetBuf2Mem;                          (* Allocate Block for Clust2 Buffer *)
 If WriteSysINfo Then Sysinfo;        (* Write The system information     *)
 TestBreak;                           {  Quit if Control Break Was Hit     }
 StoreFat;                            (* Store The File Allocation Table  *)
 If WriteFat Then PrintFat;           (* Decode The Fat Entries           *)
 TestBreak;                           {  Quit if Control Break Was Hit     }

 AllocateRootEntries;                 (* Add all Root Entries to list     *)
 TestBreak;                           {  Quit if Control Break Was Hit     }
 GetSubDirFiles;                      (* Add all SubDir Entries to list   *)
 TestBreak;                           {  Quit if Control Break Was Hit     }
 IF DisplayHeap Then Check4Amount(0); {********DISPLAY THE HEAP********}
 SortDeleted;                         (* Sort Through all deleted entries.*)
 TestBreak;                           {  Quit if Control Break Was Hit     }

 If Not PackOnly Then
   Begin
     PackDirs;                        (* Pack Dirs that use to much space. *)
     TestBreak;                       {  Quit if Control Break Was Hit      }
     ShiftDirsUp;                     (* Shift Subdir Entries Up in DIR.   *)
     TestBreak;                       {  Quit if Control Break Was Hit      }
     If SORT Then UserFileNameSort;   (* Let Users Sort Files As They Want *)
     TestBreak;                       {  Quit if Control Break Was Hit      }
     GetFancyList;                    (* Sort sectors into sequential ord. *)
     TestBreak;                       {  Quit if Control Break Was Hit      }
     DoFancyList;                     (* Make changes to dynamic list.     *)
     TestBreak;                       {  Quit if Control Break Was Hit      }
     Num2Cng;                         (* Figure Number to Change           *)
     OldNumLeft := Number2Switch;
   End;

 If WriteDir Then PrintDir;           (* Print out Dynamic list if wanted  *)
 DoWarningMsg;
 If (OldNumLeft <> 0) AND (Not PackOnly) Then
   Begin
     MakeNewFat;                      (* Make a new FAT to memory.         *)
   End;
 TestBreak;                           { Quit if Control Break Was Hit       }

 If (OldNumLeft <> 0) AND (NOT PackONly) Then
   Begin
     If WriteFat2 Then PrintFat;      (* Print out the New Altered FAT.    *)
     SortFancys;                      (* Sort out the Fancy Fat list.      *)
     FreeMem(FH,((ClustPerDisk+2)* 4)+8);  { Free Memory for new hash type. }
     If DisplayHeap Then Check4Amount(0);
     Last_Chance_Out;              (* Check For Screw Ups!             *)
     TestBreak;

 (* Can't abort without creating disk errors after this line.      *)
     SwapSectors;                  (* Do the dirty work.               *)
     WriteFat2Disk;                (* Write the New FAT(s) to disk.    *)
   End;
 For X:= 0 to BytePerSect Do Buffer^.Aray[X] := 0;(* Flush Buffer.     *)
 RewritDirs;                   (* Update Dirs with changed entries     *)
 FreeMem4Fat;                  (* Free the memory Used by the FAT. *)
 ReleaseHeap;                  (* Release or free dynamic memory       *)

 FlushDos;                     {  Clear All Dos Disk Buffers.          }
 LookAtRootDir;                {  Read in all filenames For SUBST correction. }
 CursorON;
 FINISHED;                     {  Echo " all done here!"               }

{----------------------------------------------------------------------}
{ SPECIAL DIAGNOSTIC.                                                  }
{----------------------------------------------------------------------}
 If DisplayHeap Then
   Begin
     Writeln('STACK SUMMARY');
     X:=0;
     REPEAT X:=X+1; UNTIL (STACK[X] <> 0) OR (X >= StackSize);
     WRITELN('UNUSED STACK = ',X,' USED STACK = ',StackSize - X);
   End;
End.