Program SST(Input,Output);
{$R+}     (* Range Checking, don't need it anymore?       *)
{$C-}     (* Control Break OFF , speed up screens.        *)
{$I-}     (* I/O Error Handling OFF.                      *)
          (* Program Must be compiled with $ I - to assure*)
          (* that REWRITE.COM Sees generated disk errors. *)

Const
 Off  = False;
 On   = True;

 BackColor  = 0;   { Normal BackGround Color }
 HBackColor = 1;   { Highlight Background Color }
 ForeColor  = 15;  { Normal ForeGround Color.   }

 WriteSysInfo = on ; (* ON will Display SYSTEM information about Disk.      *)
 WatchEntryMak= off; (* ON will Display Dynamic Lst Entry Allocation as done*)
 ExtDiags     = off; (* ON will display extra diagnostics.                  *)
 WatchDskrun  = off; (* ON will display Disk read and write info to screen. *)

 CBSize   = 32767; (* Cluster Buffer Size. *)
 HASHSize = 16382;
 FATSize  = 32767; (* See note Below.      *)
 StackSize = $100;

(*---------------------------------------------------------------------------*)
(* FatSize Controls the Maximum Size of the Memory FILE ALLOCATON TABLE.     *)
(* FAT^.Aray[0..FatSize] is the actual array. It is different from a normally*)
(* allocated pointer variable, in that it is gotten by allocating BYTES using*)
(* the GETMEM procedure. This is used so that only the exact amount of MEM   *)
(* needed will be allocated for storage of the disk FAT in memory.           *)
(*---------------------------------------------------------------------------*)

Label
  GetOut;

Type
  StackRoom = Array[0..StackSize] of Byte;

  Reg=Record
   AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS:Integer;
  End;

  ClustRange = -4..32767;          (* Negatives are for initialization. *)

  FATPointer = ^FatType;
  FATtype = Record
    Aray : Array[0..FatSize] of Byte;   (* `Dummy' Array for FATPointer *)
  End;

  ClustPointer = ^ClustType;
  ClustType = Record
    Aray : Array[0..CBSize] of Byte;    (* `Dummy' Array for ClustPointer.*)
  End;

  EntryPointer = ^Entry;
  Entry = Record                        {  EACH EATS UP ABOUT 27 BYTES       }
   NextEntry:EntryPointer;              (* Set up for a doubly linked list. *)
   FileName :Array[0..7] of Char;       (* Files Name.                      *)
   Extension:Array[0..2] of Char;       (* Files Extension.                 *)
   Attribute:Byte;                      (* Attribute of File,Hidden....     *)
   Time     :Array[0..1] of Byte;
   Date     :Array[0..1] of Byte;
   ClustPtr :ClustRange;                (* Pointer to First Cluster in chain*)
   FileSize :Array[0..3] of Byte;
   NewClust :ClustRange;                (* New updated 1st cluster in chain.*)
  End;

  FancyPointer = ^ClustInfo;            {  EACH EATS UP ABOUT 10 BYTES        }
  ClustInfo    =    Record
   FirstInFile : Boolean;               (* True if first cluster in file.    *)
   ClusterNum  : ClustRange;            (* Cluster Where it is at the moment.*)
   WhereShdBe  : ClustRange;            (* Cluster Where it should be later. *)
   NextFancy   : FancyPointer;          (* Pointer to next entry.            *)
  End;

  FHTYPE   = ^PtrArray;
  PtrArray = Record
    FancyHash : Array[0..HASHSize] of FancyPointer;
  End;
Var
  Stack       :StackRoom;    {  Stack for ASMREAD and ASMWRITE                }
  FH          :FHTYPE;       {  Pointer to New Hash Table.                    }
  BreakHit    :Byte Absolute $0000:$0471;{Equal to 128 if Break has been Hit. }
  WriteDir    :Boolean;      (* ON will Display Dynam List and Attrs to CRT. *)
  WriteEnable :Boolean;      (* OFF will DISable all diskWrites.             *)
  DisplayHeap :Boolean;      (* ON to display heap usage at start & finish.  *)
  WriteFat    :Boolean;      (* ON will Display FAT to CRT.                  *)
  WriteFat2   :Boolean;      (* ON will Display New FAT after Changes.       *)
  WatchChanges:Boolean;      (* ON displays dat for each clst in file 2Bcnged*)
  SORT        :Boolean;      (* True if USERSORT is requested.               *)
  SYSTEMDISK  :Boolean;      (* True if its a system Disk.                   *)
  YNChar      :Char;         (* Used for YES/NO Continue question.           *)
  ReadError   :Boolean;      (* Set True if unrecoverable read error occured *)
  HeapTop     :^Integer;
  FAT         :FATPointer;   (* Storage For File Allocation Table            *)
  FATSeg      :Integer;      (* Segment of memory File Allocation Table.     *)
  FATOfs      :Integer;      (* Offset of Memory File Allocation Table.      *)
  FirstEntry  :EntryPointer; (* Global Pointer Variable. ALWAYS pnts to 1st  *)
  LastEntry   :EntryPointer; (* Global, Used during allocation. Norm. Unused.*)
  NewEntry    :EntryPointer; (* Used to get Dynamic entrys from Heap (NEW)   *)
  TempEntry   :EntryPointer; (* Global, Available for use almost anytime.    *)
  StartEntry  :EntryPointer; (* First Non-System File Entry.                 *)
  FancyStart  :FancyPointer; (* Global, Used to point to First Fancy Fat.    *)
  StartFancy  :FancyPointer; (* Global, Will Point to 1st NON-SYSTEM fancy   *)
  FancyNew    :FancyPointer; (* Global, Used to get FancyPointers.           *)
  FancyLast   :FancyPointer; (* Global, Used while getting Fancy Pointers.   *)
  SrcFancy    :FancyPointer;
  FileNum     :Integer;      (* Used during sector sort to keep track of num *)
  ClustInFile :ClustRange;
  ClusterNum  :ClustRange;
  FileName    :String[11];   (* Used to display FileName                     *)
  Register    :Reg;          (* Used during disk reset & for cursor control. *)
  Buffer      :ClustPointer; (* Data Transfer Buffer for a sector            *)
  Buffer2     :ClustPointer; (* Second Buffer for rewrite storage            *)
  X,Z         :Integer;      (* Counter Variable                             *)
  BytePerSect :Integer;      (* Number of Bytes In each sector on the disk.  *)
  SectPerClust:Integer;      (* Number of Sectors Per Cluster on the disk.   *)
  ResSectors  :Integer;      (* Number of Reserved Boot Sectors on the disk  *)
  FatCount    :Integer;      (* Number of File Allocation Tables on the disk *)
  RootEntries :Integer;      (* Number of Root Directory Entries.            *)
  DiskType    :Integer;      (* F8 for fixed. FD for Floppy.                 *)
  NewStylFat  :Boolean;      (* True if 2 byte fat entries instead of 1.5.   *)
  ValidDrive  :Boolean;      (* True if drive selected was valid             *)
  SectPerFat  :Integer;      (* Number of Sectors Per File allocation Table  *)
  SectPerCyl  :Integer;      (* Number of Sectors Per Cylinder on the disk.  *)
  Heads       :Integer;      (* Number of heads on the disk.                 *)
  RootAT      :Integer;      (* Sector where Root Dir Starts.                *)
  DataAT      :Integer;      (* Sector Where Data starts.                    *)
  RootSectors :Integer;      (* Number of Root directory sectors.            *)
  ClustPerDisk:ClustRange;   (* The Number of Clusters Per Disk.             *)
  SectPerDisk :Real;         (* Number of total sectors on the disk.         *)
  Disk2Use    :Byte;         (* Variable that keeps track of the Disk to use.*)
  FatAT       :Integer;      (* Starting sector of File Allocation Table     *)
  Number2Switch :Integer;    (* Number of Clusters Left to change.           *)
  OldNumLeft  :ClustRange;
  B1Primary   :Boolean;      (* True if Buf1  Primary,False if Buf2 is Prime.*)
  Status      :Integer;      (* Storage for result of disk read or write err.*)
  Tries       :Integer;      (* Storage for the number of disk access tries. *)
  PackOnly    :Boolean;      (* Flag To Only Pack the directories. (NoSORTing*)
  DosFree     :ClustRange;   (* Number of unused clusters on disk.(from dos.)*)
  DosBytePerS :Integer;      (* Number of bytes per sector (gotten from dos.)*)
  DosSectPerC :Integer;      (* Number of Sectors Per Cluster (from dos.)    *)
  GlobalLastUsed:Integer;    (* Used by FAT Clearing routine (Where to start)*)
  HighBadValue  :Integer;
  LowBadValue   :Integer;
  HighLastValue :Integer;
  LowLastValue  :Integer;
  CheckSum      :Integer;    { CheckSum of Screen AND 32767 }
  WeightedS     :Integer;    { CheckSum of Even Bytes }
  OriginalDir   :String[128];{ Storage for Curr Dir on disk to use.           }
  OperatingSys  :String[8];
  CursorValue   :Integer;
  DirsChanged   :Boolean;    { To Keep track if Any Erase entries were Moved. }
{---------------------------------------------}
{---------------------------------------------}
Procedure Explain;
Begin
  Writeln('If the information contained on the First Sector (Boot Sector)');
  Writeln('of the disk does not agree with the way that DOS sees the disk,');
  Writeln('it was probabally caused by using a Format program other than the');
  Writeln('Standard DOS Format program... I.E. a quick Format Utility.');
  Writeln('Many of these programs do not write any information about the Disk');
  Writeln('to the Boot track as DOS says that they should.');
  Writeln;
  Writeln('SST is designed to be compatible with any DOS disk that uses 512 Byte');
  Writeln('Sectors including non-standard disk formats.  Therefore, It is important');
  Writeln('that the BOOT sector Variables agree with the way the DOS says that it');
  Writeln('sees the disk.');
End;
{--------------------------------------------}
{ Tell turbo which video mode to use.        }
{--------------------------------------------}
PROCEDURE SELECT_VIDEO;
Const
  Mono = 7;
VAR
  Active_6845 : Integer Absolute $0000:$0463;
Begin
  Case Active_6845 of
   $3b4 : TextMode(Mono);
   $3d4 : TextMode(C80);
  End;
End;

{---------------------------------------------}
{ This Procedure Flushes all DOS disk buffers }
{---------------------------------------------}
Procedure FlushDos;
Var
  Register:reg;

Begin
  BreakHit := 0;          { Clear out the BIOS BREAK VARIABLE }
  Register.AX := $D00;    { Do The Flush }
  Intr($21,Register);
End;

(**------------------------------------**)
(* This Procedure Turns Cursor off.     *)
(**------------------------------------**)
Procedure CursorOff;
Var
 Register:reg;
Begin
 Register.AX :=$300;             { Get the Current Cursor Type. }
 Intr($10,Register);
 CursorValue := Register.CX;

 Register.AX:=$100;              { Set the Cursor to Nothing.   }
 Register.CX:=$800;
 Intr($10,Register);
End;

(**------------------------------------**)
(* This Procedure Turns Cursor On.      *)
(**------------------------------------**)
Procedure CursorON;
Var
 Register:reg;
Begin
 Register.AX:=$100;
 Register.CX:=CursorValue;
 Intr($10,Register);
End;

(*---------------------------------------------------------*)
(* Procedure to abort program When BREAK is HIT.           *)
(*---------------------------------------------------------*)
Procedure BreakQuit;
Begin
  ClrEol;
  Writeln('CONTROL-BREAK Pressed.');
  ClrEol;
  Writeln('SST Session Aborted.');
  Writeln;
  CursorON;
  Halt;
End;

(*---------------------------------------------------------*)

Procedure TestBreak;
Begin
 If (BREAKHIT AND 128) = 128 Then BreakQuit; { Quit if Control Break Was Hit }
End;
(*---------------------------------------------------------*)
(* Procedure to abort program.                             *)
(*---------------------------------------------------------*)
Procedure Quit;
Begin
  Writeln('SST Session Aborted.');
  CursorON;
  Halt;
End;


{-----------------------------------------------------------}
{ Check for out of memory.                                  }
{-----------------------------------------------------------}
Procedure Check4Amount(MemNeeded : Integer);
Var
  FullSeg   : Real;
  NeedReal  : Real;
  MaxReal   : Real;
  Sixteen   : Real;
Begin
  FullSeg := $FFFF;
  Sixteen := 16;

  MaxReal := MaxAvail;
  If (MaxReal < 0) Then MaxReal := FullSeg - MaxReal;
  MaxReal := (MaxReal * Sixteen);

  NeedReal := MemNeeded;
  If (NeedReal < 0) Then NeedReal := FullSeg - NeedReal;

  If DisplayHeap Then
    Begin
      Writeln;
      Writeln('Maximum Dynamic Memory Block Size = ',MaxReal:10:0);
      Writeln('Needed  Dynamic Memory Block Size = ',NeedReal:10:0);
      Writeln('(DELAYING 1 SECOND STARTING NOW)');
      Delay(1000);
    End;

  If (MaxReal < NeedReal)  Then
    Begin
      {------------------------------}
      { Simulate a runtime error FF. }
      {------------------------------}
      Writeln;
      Writeln('Runtime Error $FF');
      Writeln;
      Writeln('SST Has run out of Available Memory.');
      Writeln('Try Running SST with NO Stay Resident');
      Writeln('Programs in Memory.');
      Writeln;
      Quit;

    End;
End;

(*---------------------------------------------------------*)
(* This Procedure Asks Y or No to continue.                *)
(*---------------------------------------------------------*)
Procedure YesOrHalt;
Begin
  While KeyPressed Do Read(Kbd,YNChar);
  Writeln('旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커');
  Writeln(' PRESS - Y - TO CONTINUE, ANY OTHER KEY TO ABORT. ',Char(7),'');
  Writeln('읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸');
  Read(Kbd,YNChar);
  YNChar := Upcase(YNChar);
  If YNChar <> 'Y' Then QUIT;
End;

{-----------------------------------------------------------}
{  This Procedure sets all of the disk variables from the   }
{  previously done disk boot read.                          }
{-----------------------------------------------------------}
Procedure ReadBootInfo;

    Procedure BadBootSector;
      Begin
        ClrScr;
        Writeln('Data in Boot Sector of Disk Does Not Make Sense');
        Writeln('Or Can`t Work with this type of disk.');
        Explain;
        Quit
      End;

Begin
 If (BREAKHIT AND 128) = 128 Then BreakQuit; { Quit if Control Break Was Hit }
 OperatingSys := '        ';
 For X := 3 to 10 Do OperatingSys[X-2] := Char(Buffer^.Aray[X]);
 BytePerSect  := Buffer^.Aray[11] + (Buffer^.Aray[12] SHL 8);
 SectPerClust := Buffer^.Aray[13];
 ResSectors   := Buffer^.Aray[14] + (Buffer^.Aray[15] SHL 8);
 FatCount     := Buffer^.Aray[16];

 If BytePerSect <> 512 Then BadBootSector; { Make a few Quick checks. }
 If SectPerClust > 64 Then BadBootSector;
 If ResSectors > 4 Then BadBootSector;
 If FatCount <> 2 Then BadBootSector;

 RootEntries  := Buffer^.Aray[17] + (Buffer^.Aray[18] SHL 8);
 SectPerDisk  := Buffer^.Aray[20];
 SectPerDisk  := (SectPerDisk * 256) + Buffer^.Aray[19];
 DiskType     := Buffer^.Aray[21];
 SectPerFat   := Buffer^.Aray[22] + (Buffer^.Aray[23] SHL 8);
 SectPerCyl   := Buffer^.Aray[24] + (Buffer^.Aray[25] SHL 8);
 Heads        := Buffer^.Aray[26];
 RootAT       := ResSectors + (FatCount * SectPerFat);

{ ******** THIS LINE WAS CHANGED FROM VERSION 2.00  ********* }
{ It prevents the overflow that made DATAAT invalid.          }
{                                                             }
{*************************************************************}

 DataAt       := RootAT + Round(RootEntries/(BYTEPERSECT SHR 5));

{*************************************************************}



 RootSectors  := DataAt - RootAT;
 FatAT        := ResSectors;
 ClustPerDisk :=Round((SectPerDisk-ResSectors-(FatCount*SectPerFat)
             -(RootEntries*32/512))/SectPerClust);
 If (ClustPerDisk > 4080) Then
   Begin
     NewStylFat:=True;
     HighLastValue := $FFFF;      { Fix up these values for later use. }
     LowLastValue  := $FFF8;
     HighBadValue  := $FFF7;
     LowBadValue   := $FFF0;
   End
 Else
   Begin
     NewStylFat:=False;
     HighLastValue := $FFF;
     LowLastValue  := $FF8;
     HighBadValue  := $FF7;
     LowBadValue   := $FF0;
   End;
End;

{-----------------------------------------------------------}
{  This Function Returns the Sector number That a cluster   }
{  pointer points to.                                       }
{-----------------------------------------------------------}
Function GetSectFromClust(Cluster:Integer):Integer;
Begin
 GetSectFromClust:=DataAT + (SectPerClust * (Cluster-2));
End;

{$I COPYRIGT.PAS}  { This Included File Prints out the CopyRight. }

(*----------------------------------------------------------*)
(* This Procedure Prints out info gotten from Boot Sector.  *)
(*----------------------------------------------------------*)
Procedure Sysinfo;
Begin

 ClrScr;                     { Clear the whole Screen first.}
 Window(1,1,80,12);          { This will make the upper section white on blue.}
 TextBackGround(HBackColor); { Blue BackGround for now.     }
 ClrScr;                     { Clear the Box out.           }
 Window(61,1,80,12);
 Clrscr;
 Writeln('旼컴컴컴컴컴컴컴컴');
 Writeln('쿞ST Version 2.01C');
 Writeln('쿎opyright 1986,88');
 Writeln('쿌lfred J. Heyman ');
 Writeln('                 ');
 Writeln('쿌ll Rights       ');
 Writeln('쿝eserved.        ');
 Writeln('                 ');
 Writeln('쿟his Version may ');
 Writeln('쿻ot be duplicated');
 Writeln('쿽r re-distributed');
 Write  ('읕컴컴컴컴컴컴컴컴');

 Window(1,1,80,25);        { Back to normal screen size.  }
 GotoXY(1,1);              { Go To Upper Left Corner.     }

 Writeln('旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커');
 Write  (' Disk Type is ');
 Case DiskType of
   $F8:Write('Fixed Disk.');
   $F9:Write('DSQD Floppy');
   $FC:Write('SSDD9 Floppy');
   $FD:Write('DSDD9 Floppy');
   $FE:Write('SSDD8 Floppy');
   $FF:Write('DSDD8 Floppy');
 Else Write('Unknown Disk Type.')
 End;
 GoToXY(30,WhereY); Writeln(' OEM on Boot Sector: ',OperatingSys);

 Write(' Bytes Per Sector.....: ',BytePerSect);
 GoToXY(30,WhereY);
 Writeln(' Sectors Per Disk..: ',SectPerDisk:5:0);

 Write(' Sectors Per Cylinder.: ',SectPerCyl);
 GoToXY(30,WhereY);
 Writeln(' Number of Heads...: ',Heads);

 Write(' Reserved Sectors.....: ',ResSectors);
 GoToXY(30,WhereY);
 Writeln(' Clusters Per Disk.: ',ClustPerDisk);

 Write(' Sects Cluster........: ',SectPerClust);
 GoToXY(30,WhereY);
 Writeln(' Unused Clusters...: ',DosFree);

 Write(' Number of FATs.......: ',FatCount);
 GoToXY(30,WhereY);
 Writeln(' Sectors Per FAT...: ',SectPerFat);

 Write(' Bits per FAT entry...: ');
 If NewStylFat Then Write('16') Else Write('12');
 GoToXY(30,WhereY);
 Writeln(' Entries in Root...: ',RootEntries);

 Write(' Root DIR at Sector...: ',RootAT);
 GoToXY(30,WhereY);
 Writeln(' Data At Sector....: ',DataAT);


 Write(' Cluster Bytes........: ',SectPerClust * BytePerSect);
 GoToXY(30,WhereY);
 Writeln(' Logical Cylinders.: ',((SectPerDisk/Int(SectPerCyl))/Int(Heads)):6:2);

 Writeln(' Root DIR On Drive ',Char(Disk2Use + 65),': is ',RootSectors,' sectors long.');
 Writeln('읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸');
 GotoXY(60,2);
 For X:=1 to 10 Do
   Begin
     GoToXY(60,WhereY);
     Writeln('');
   End;
 Writeln;

 TextBackGround(BackColor); { Change Back to Original Background Color.}
 If (BREAKHIT AND 128) = 128 Then BreakQuit; { Quit if Control Break Was Hit }

{ The following lines check for a few descrepancies in the data. }

If ClustPerDisk > 32767 Then
  Begin
    Writeln;
    Writeln('DISK BOOT SECTOR REPORTS ',CLUSTPERDISK, 'CLUSTERS.');
    Writeln('Can not Handle more than 32767 Clusters.');
    Explain;
    QUIT;
  End;

If (DosBytePerS <> BytePerSect) OR (DosSectPerC <> SectPerClust)
 Then
  Begin
    Writeln;
    Writeln('What? Boot track and DOS disagree!');
    Explain;
    QUIT;
  End;

End;


{------------------------------------------------------------}
{  This Procedure asks dos to set up a disk parm table for   }
{  the drive requested.                                      }
{  It is used by - GetDisk2Use                               }
{------------------------------------------------------------}
Procedure MakeDosPTbl;
Var
  Register : Reg;

Begin
  If (BREAKHIT AND 128) = 128 Then BreakQuit; { Quit if Control Break Was Hit }
  Register.AX := $3200;
  Register.DX := Disk2Use + 1;
  Intr($21,Register);
  If (Register.Ax AND 255) = $FF Then ValidDrive:=False Else ValidDrive:=True;

  Register.AX := $3600;             { Get other info about the disk. }
  Register.DX := Disk2Use + 1;
  Intr($21,Register);
  DosFree     := Register.BX;       { Number of free clusters.     }
  DosBytePerS := Register.CX;       { Number of bytes per sect.    }
  DosSectPerC := Register.AX;       { Number of sectors per clust. }
End;

{------------------------------------------------------------}
{  This Procedure gets the disk to use from the user.        }
{  It is called from - MAIN LOGIC                            }
{  It handles parameters sent from the command line also.    }
{------------------------------------------------------------}
Procedure GetDisk2Use;
Type
  ParmSize = String[80];

Var
  Dsk     : Char;
  InParm  : ParmSize;
  XZZ,HHH : Integer;


    {$V-}
    Procedure UppCase(Var Strg:ParmSize);
    Begin
      Inline($C4/$BE/Strg/$26/$8A/$0D/$FE/$C1/$FE/$C9/$74/$13/$47/$26/$80/$3D/
             $61/$72/$F5/$26/$80/$3D/$7A/$77/$EF/$26/$80/$2D/$20/$EB/$E9);
    End;
    {$V+}

Begin
    PackOnly    := False;
    WriteDir    := OFF;
    WriteEnable := ON ;
    DisplayHeap := OFF;
    WriteFat    := OFF;
    WriteFat2   := OFF;
    WatchChanges:= OFF;
    Sort        := OFF;
    Dsk := Char($FE);
    If (ParamCount <> 0) Then
      Begin
        For XZZ := 1 to ParamCount Do
          Begin
            InParm := ParamStr(XZZ);
            UppCase(Inparm);
            If Inparm[2] = ':' Then Dsk := InParm[1];
            If InParm = 'CLEAR' Then PackOnly := True;
            If InParm = 'DIR' Then WriteDir := ON;
            If InParm = 'TEST' Then WriteEnable := OFF;
            If InParm = 'HEAP' Then DisplayHeap := ON;
            If InParm = 'FAT' Then WriteFat := ON;
            If InParm = 'FAT2' Then WriteFat2 := ON;
            If InParm = 'WATCH' Then WatchChanges := ON;
            If InParm = 'SORT' Then SORT := ON;
            If InParm = 'ID' Then
              Begin
                Writeln('Revision Number -: First Real Release.');
                Writeln('Special thanks to:');
                Writeln;
                Writeln('Dave Summers for bearing with me, and the 32 meg.');
                Writeln('Robert Weatherford for Weeding out algorithms on the phone!');
                Writeln('Matt  Rockwell for additional contributions.');
                Writeln;
                Writeln('Note to Hackers.... Other Command Line Parms are-');
                Writeln('[ DIR][ HEAP][ FAT2][ WATCH][ ID][ SORT].');
              End;
          End;
        If WriteEnable=OFF Then
          Begin
            Writeln(Char(7),'TEST RUN - NO WRITES WILL BE DONE -');
            Delay(1000);
          End;
      End;

  Repeat
    If Dsk = Char($FE) Then
      Begin
        Writeln('旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴');
        Writeln(' Press  to Cancel Run.               ');
        Writeln('                                               ');
        Writeln(' Press The Drive Letter of Disk to Rewrite..:  ');
        Writeln('읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴');
        GotoXy(47,WhereY-2);
        Read(Kbd,Dsk);
        If (BREAKHIT AND 128) = 128 Then BreakQuit; { Quit if Control Break Was Hit }
        If Dsk = Char(3) Then
          Begin
            Writeln;
            Writeln;
            Writeln;
            QUIT;
          End;
        Dsk := Upcase(Dsk);
        Write(Dsk);
        GotoXY(1,WhereY + 2);
      End;

    Disk2Use := (Ord(Dsk) - 65);
    MakeDosPTbl;
    If ValidDrive = False Then
      Begin
        Writeln;
        Writeln('Invalid Drive');
        Dsk := Char($FE);
      End;
  Until ValidDrive = True;

  Register.AX := $E00;
  Register.DX := Disk2Use + 1;
  Intr($21,Register);             { Select the Users Drive. }

  ClrScr;
  Writeln('旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커');
  Writeln('   SST   - Seek Stopper - Ver 2.01C ');
  Writeln('  Copyright 1986  Alfred J. Heyman  ');
  Writeln('                                    ');
  Writeln(' Author is not responsible for use  ');
  Writeln(' or misuse of this program.         ');
  Writeln('                                    ');
  Writeln(' Did you run CHKDSK /F on the disk? ');
  Writeln(' Is your disk backed up?            ');
  Writeln('                                    ');
  Writeln(' Making Changes To Disk In Drive ',Dsk,': ');
  Writeln('읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸');
  GotoXY(1,WhereY+2);
  Delay(750);
End;

{------------------------------------------------------------------}
{ This Procedure reads all files in the root dir.                  }
{------------------------------------------------------------------}
Procedure LookATRootDIR;    { Simply look at all of the file entries in root. }
Type
  Name = String[3];
  FileNameArray = Array[1..20] of byte;
  Reg = Record
   AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS: Integer;
  End;
Var
  FileName   : Name;
  DirString  : FileNameArray;
  UtilCounter: Integer;
  Register   : Reg;
Begin
  Write('Reading Root Directory from DOS to update SUBSTed Drives.');
  GotoXY(1,WhereY);
{ We Must Move the filename into an array so that it will end with Char(0). }
  FileName  := '*.*';
  For UtilCounter := 1 to 20 Do DirString[UtilCounter] := 0;
  For UtilCounter := 1 to Length(FileName) Do
    DirString[UtilCounter] := Ord(FileName[UtilCounter]);

{ Find First Matching File.   }

  Register.AX := $4E00;                   { DOS Find First Function. }
  Register.DS := Seg(DirString[1]);       { Where is its Segment?    }
  Register.DX := Ofs(DirString[1]);       { Where is its Offset?     }
  Register.CX := $FFFF;                   { Look For all attributes. }
  Intr($21,Register);                     { Call on DOS.             }

{ Find Next Matching Files.}
  Repeat                                  { Repeat until all Entries }
    Register.AX := $4F00;                 { Have been read in.       }
    Intr($21,Register);
  Until Register.AX <> 0;
End;

(*----------------------------------------------------------*)
(* This is the Included Code to do DOS Disk Reads.          *)
(* It is used by BLOKREAD and CLUSTREAD.                    *)
(* It expects disk, sector data to be at certain memory locs*)
(*----------------------------------------------------------*)
Procedure AsmRead;
Begin
 Inline($1E/                    { PUSH DS       9}
        $BA/$00/$00/            { MOV DX,0000   }
        $8E/$DA/                { MOV DS,DX     }
        $FA/                    { CLI           }
        $89/$26/$8E/$01/        { MOV [018E],SP }
        $8C/$D4/                { MOV SP,SS     }
        $89/$26/$90/$01/        { MOV [0190],SP }
        $8B/$26/$8C/$01/        { MOV SP,[018C] }
        $8E/$D4/                { MOV SS,SP     }
        $8B/$26/$8A/$01/        { MOV SP,[018A] }
        $FB/                    { STI           }
        $55/                    { PUSH BP       1}
        $9C/                    { PUSHF         2}
        $56/                    { PUSH SI       3}
        $57/                    { PUSH DI       4}
        $50/                    { PUSH AX       5}
        $53/                    { PUSH BX       6}
        $51/                    { PUSH CX       7}
        $52/                    { PUSH DX       8}
        $A1/$80/$01/            { MOV AX,[0180] }
        $8B/$16/$82/$01/        { MOV DX,[0182] }
        $8B/$0E/$84/$01/        { MOV CX,[0184] }
        $8B/$1E/$86/$01/        { MOV BX,[0186] }
        $50/                    { PUSH AX       10}
        $A1/$88/$01/            { MOV AX,[0188] }
        $8E/$D8/                { MOV DS,AX     }
        $58/                    { POP AX        9}
        $CD/$25/                { INT 25        10}
        $9C/                    { PUSHF   Get Flags to look at CY  11}
        $31/$DB/                { XOR BX,BX     }
        $8E/$DB/                { MOV DS,BX     }
        $A3/$80/$01/            { MOV [0180],AX }
        $58/                    { POP AX        10}
        $A3/$82/$01/            { MOV [0182],AX }
        $9D/                    { POPF          9}
        $5A/                    { POP DX        7}
        $59/                    { POP CX        6}
        $5B/                    { POP BX        5}
        $58/                    { POP AX        4}
        $5F/                    { POP DI        3}
        $5E/                    { POP SI        2}
        $9D/                    { POPF          1}
        $5D/                    { POP BP        0}
        $FA/                    { CLI           }
        $8B/$26/$90/$01/        { MOV SP,[0190]  }
        $8E/$D4/                { MOV SS,SP      }
        $8B/$26/$8E/$01/        { MOV SP,[018E]  }
        $FB/                    { STI           }
        $1F);                   { POP DS        8}
End;

(*----------------------------------------------------------*)
(* This is the Included Code to do DOS Disk Writes.         *)
(* It is used by BLOKWRITE and CLUSTWRITE.                  *)
(* It expects disk, sector data to be at certain memory locs*)
(*----------------------------------------------------------*)
Procedure ASMWRITE;
Begin
  Inline($1E/                    { PUSH DS       9}
         $BA/$00/$00/            { MOV DX,0000   }
         $8E/$DA/                { MOV DS,DX     }
         $FA/                    { CLI           }
         $89/$26/$8E/$01/        { MOV [018E],SP }
         $8C/$D4/                { MOV SP,SS     }
         $89/$26/$90/$01/        { MOV [0190],SP }
         $8B/$26/$8C/$01/        { MOV SP,[018C] }
         $8E/$D4/                { MOV SS,SP     }
         $8B/$26/$8A/$01/        { MOV SP,[018A] }
         $FB/                    { STI           }
         $55/                    { PUSH BP       1}
         $9C/                    { PUSHF         2}
         $56/                    { PUSH SI       3}
         $57/                    { PUSH DI       4}
         $50/                    { PUSH AX       5}
         $53/                    { PUSH BX       6}
         $51/                    { PUSH CX       7}
         $52/                    { PUSH DX       8}
         $A1/$80/$01/            { MOV AX,[0180] }
         $8B/$16/$82/$01/        { MOV DX,[0182] }
         $8B/$0E/$84/$01/        { MOV CX,[0184] }
         $8B/$1E/$86/$01/        { MOV BX,[0186] }
         $50/                    { PUSH AX       10}
         $A1/$88/$01/            { MOV AX,[0188] }
         $8E/$D8/                { MOV DS,AX     }
         $58/                    { POP AX        9}
         $CD/$26/                { INT 26        10}
         $9C/                    { PUSHF   Get Flags to look at CY  11}
         $31/$DB/                { XOR BX,BX     }
         $8E/$DB/                { MOV DS,BX     }
         $A3/$80/$01/            { MOV [0180],AX }
         $58/                    { POP AX        10}
         $A3/$82/$01/            { MOV [0182],AX }
         $9D/                    { POPF          9}
         $5A/                    { POP DX        7}
         $59/                    { POP CX        6}
         $5B/                    { POP BX        5}
         $58/                    { POP AX        4}
         $5F/                    { POP DI        3}
         $5E/                    { POP SI        2}
         $9D/                    { POPF          1}
         $5D/                    { POP BP        0}
         $FA/                    { CLI           }
         $8B/$26/$90/$01/        { MOV SP,[0190]  }
         $8E/$D4/                { MOV SS,SP      }
         $8B/$26/$8E/$01/        { MOV SP,[018E]  }
         $FB/                    { STI           }
         $1F);                   { POP DS        8}
End;

{----------------------------------------------------------------}
{ This procedure prints out the type of disk error that occured. }
{----------------------------------------------------------------}
Procedure PrintDiskError;
Begin
  Writeln;
  Case Status of
   $80:Writeln('Attachment Failed to Respond. - Drive Door Open ?');
   $40:Writeln('SEEK Failure.');
   $20:Writeln('Controller Failure.');
   $10:Writeln('Bad CRC on Diskette Read.');
   $08:Writeln('DMA overrun on Operation.');
   $04:Writeln('Requested Sector Not Found');
   $03:Begin
         Writeln('Disk is Write Protected.');
         Writeln('Correct and Press any Key.');
         Tries := Tries - 1;
         Read(Kbd,YNChar);
       End;
   $02:Writeln(' Address Mark Not Found.');
   $00:Writeln(' Unknown Error.');
   Else Writeln(' Error #',Status);
  End;
End;

(*----------------------------------------------------------*)
(* This Procedure Uses Dos Interrupt 25H to Read Sectors.   *)
(* It is used to read in DIR data.                          *)
(*----------------------------------------------------------*)
Procedure BlokRead(Start,Ok2Abort:Integer);
Label
 Restart;
Var
 X:Integer;
Begin
 Tries:=0;
Restart:
 If Tries <> 0 Then
   Begin
     Register.AX:=0;                   (* Reset the Disk if tries > 0. *)
     Intr($13,Register);
   End;
 Tries:=Tries + 1;
 If WatchDskRun Then Write('RS ',Start,'   ',Char($0D));
 Mem[0000:$0180]:=Disk2Use;
 Mem[0000:$0181]:=0;
 Mem[0000:$0182]:=LO(Start);
 Mem[0000:$0183]:=HI(Start);
 Mem[0000:$0184]:=1;
 Mem[0000:$0185]:=0;
 MemW[0000:$0186]:=Ofs(Buffer^.Aray[0]);
 MemW[0000:$0188]:=Seg(Buffer^.Aray[0]);
 MemW[0000:$018A]:=Ofs(Stack[StackSize - 2]);
 MemW[0000:$018C]:=Seg(Stack[StackSize - 2]);
 ASMREAD;
 Status:=Mem[$0000:$0182];
 If (Status AND 1) <> 0 Then
   Begin
     ReadError:=True;
     Status:=Mem[0000:$0181];
     Write('Disk Read Error - ');
     PrintDiskError;
     Register.AX:=0;           (* Reset The Disk System. *)
     Intr($13,Register);
     If Tries < 2 Then Goto Restart;
     If OK2Abort = 1 Then
       Begin
         Writeln;
         Writeln('UNRECOVERABLE READ ERROR.');
         Writeln('NO WRITES WERE DONE TO DISK.');
         Writeln('Sector Number : ',Start);
         QUIT;
       End;
   End;
End;

{----------------------------------------------------------}
{ This Procedure Uses Dos Interrupt 26H to Write Sectors.  }
{ It is used to Write DIR data.                            }
{----------------------------------------------------------}
Procedure BlokWrite(Start,Sectors:Integer);
Label
 Restart;
Var
 X:Integer;
Begin
 Tries:=0;
Restart:
 If Tries <> 0 Then
   Begin
     Register.AX:=0;
     Intr($13,Register);
   End;
 Tries:=Tries + 1;
 If WatchDskRun Then Write('WS ',Start,'    ',Char($0D));
 Mem[0000:$0180]:=Disk2Use;
 Mem[0000:$0181]:=0;
 Mem[0000:$0182]:=LO(Start);   { Was Start Mod 256 }
 Mem[0000:$0183]:=HI(Start);   { Was Start Div 256 }
 Mem[0000:$0184]:=1;
 Mem[0000:$0185]:=0;
 MemW[0000:$0186]:=Ofs(Buffer^.Aray[0]);
 MemW[0000:$0188]:=Seg(Buffer^.Aray[0]);
 MemW[0000:$018A]:=Ofs(Stack[StackSize - 2]);
 MemW[0000:$018C]:=Seg(Stack[StackSize - 2]);

 If WriteEnable Then
 Begin
   ASMWRITE;
   Status:=Mem[$0000:$0182];
   If (Status AND 1) <> 0 Then
     Begin
       Status:=Mem[0000:$0181];
       Write('Disk Write Error - ');
       PrintDiskError;
       Register.AX:=0;           { Reset The Disk System. }
       Intr($13,Register);
       If Tries < 2 Then Goto Restart;
     End;
 End;
End;

{---------------------------------------------------------}
{ This Procedure Reads in a cluster worth of data into    }
{ Either BUFFER or BUFFER2 depending on B1PRIMARY,a       }
{ boolean variable.  START is starting sector.            }
{---------------------------------------------------------}
Procedure ClustRead(Start:Integer);
Label
 Restart;

Var
 X:Integer;

Begin
 Tries := 0;
Restart:
 Tries := Tries + 1;
 Mem[0000:$0180]:=Disk2Use;
 Mem[0000:$0181]:=0;
 Mem[0000:$0182]:=LO(Start);
 Mem[0000:$0183]:=HI(Start);
 Mem[0000:$0184]:=SectPerClust;
 Mem[0000:$0185]:=0;

 If B1Primary Then
   Begin
     MemW[0000:$0186]:=Ofs(Buffer^.Aray[0]);
     MemW[0000:$0188]:=Seg(Buffer^.Aray[0]);
   End
 Else
   Begin
     MemW[0000:$0186]:=Ofs(Buffer2^.Aray[0]);
     MemW[0000:$0188]:=Seg(Buffer2^.Aray[0]);
   End;

 MemW[0000:$018A]:=Ofs(Stack[StackSize - 2]);
 MemW[0000:$018C]:=Seg(Stack[StackSize - 2]);
 ASMREAD;
 Status:=Mem[$0000:$0182];
 If (Status AND 1) <> 0 Then
   Begin
     ReadError:=True;
     Status:=Mem[0000:$0181];
     Write('Disk Read Error - ');
     PrintDiskError;
     Writeln;
     Writeln('Sector #',Start);
     Writeln;
     Register.AX:=0;           { Reset The Disk System. }
     Intr($13,Register);
     If Tries < 2 Then Goto Restart;
   End;
End;

{---------------------------------------------------------}
{ This Proc writes a whole cluster of data to the disk.   }
{ It writes from BUFFER or BUFFER2 depending on the value }
{ of B1PRIMARY, a boolean altered by SWAP.                }
{---------------------------------------------------------}
Procedure ClustWrite(Start:Integer);
Label
 Restart;

Var
 X:Integer;

Begin
 Tries := 0;

Restart:
 Tries := Tries + 1;
 Mem[0000:$0180]:=Disk2Use;
 Mem[0000:$0181]:=0;
 Mem[0000:$0182]:=LO(Start);
 Mem[0000:$0183]:=HI(Start);
 Mem[0000:$0184]:=SectPerClust;
 Mem[0000:$0185]:=0;

 If B1Primary Then
   Begin
     MemW[0000:$0186]:=Ofs(Buffer^.Aray[0]);
     MemW[0000:$0188]:=Seg(Buffer^.Aray[0]);
   End
 Else
   Begin
     MemW[0000:$0186]:=Ofs(Buffer2^.Aray[0]);
     MemW[0000:$0188]:=Seg(Buffer2^.Aray[0]);
   End;

 MemW[0000:$018A]:=Ofs(Stack[StackSize - 2]);
 MemW[0000:$018C]:=Seg(Stack[StackSize - 2]);
 If WriteEnable Then
 Begin
  ASMWRITE;
  Status:=Mem[$0000:$0182];
  If (Status AND 1) <> 0 Then
    Begin
      Write('Disk Write Error - ');
      Status:=Mem[0000:$0181];
      PrintDiskError;
      Writeln('Sector #',Start);
      Writeln;
      Writeln;
      Register.AX:=0;           { Reset The Disk System. }
      Intr($13,Register);
      If Tries < 2 Then Goto Restart;
   End;
 End;
End;

{-------------------------------------------------------------}
{ This Procvedure first switches us into the root directory.  }
{ Then it checks to see if we are in a SUBSTed Drive.         }
{ If we are, Then the program needs to abort.                 }
{-------------------------------------------------------------}
Procedure IsDriveSubst;
Var
  DirString  : String[128];
  DotandZero : Integer;

Begin
  If (BREAKHIT AND 128) = 128 Then BreakQuit; { Quit if Control Break Was Hit }
  GetDir(Disk2Use + 1,OriginalDir);     { Get Current DIR on Drive to use. }
  DirString := Copy(OriginalDir,1,3);   { For Example "C:\TEMP" to "C:\"   }
  ChDir(DirString);                     { Move Into the Dir on Disk to use.}

  DotAndZero := Ord('.');  { No room needed to make search template for "."}
  Register.AX := $4E00;    { DOS Find First }
  Register.DS := Seg(DotAndZero);
  Register.DX := Ofs(DotAndZero);
  Register.CX := $FFFF;
  Intr($21,Register);
  If Register.AX = 0 Then
    Begin
      ClrScr;
      Writeln('SST Will Not Optimize a DOS SUBSTed Drive.');
      Quit;
    End;
end;

{----------------------------------------------------------}
{ This Proc displays the number of sectors to switch.      }
{----------------------------------------------------------}
Procedure Num2Cng;
Begin
  Number2Switch := 0;
  FancyLast := FancyStart;
  While FancyLast^.NextFancy <> NIL Do
    Begin
      If FancyLast^.ClusterNum <> FancyLast^.WhereShdBe Then
        Number2Switch := Number2Switch + 1;
      FancyLast := FancyLast^.NextFancy;
    End;
End;

{---------------------------------------------------------------------}
{  This Procedure is here for diagnostic uses only. Usually for SWAP. }
{---------------------------------------------------------------------}

Procedure PrintFancy;
Var
  SrtFancy : FancyPointer;

Begin
  SrtFancy := FancyStart;
  Writeln;
  While SrtFancy <> NIL Do
    Begin
      If (BREAKHIT AND 128) = 128 Then BreakQuit; { Quit if Control Break Was Hit }
      Writeln('AT:',SrtFancy^.ClusterNum,' TO:',SrtFancy^.WhereShdBe);
      SrtFancy := SrtFancy^.NextFancy;
    End;
End;

{---------------------------------------------------------------------}
{  This Procedure is here for diagnostic uses only. Usually for SWAP. }
{---------------------------------------------------------------------}
Procedure PrintEntries;
Begin
  LastEntry := FirstEntry;
  While LastEntry^.FileName[0] <> Char(0) Do
    Begin
      If (BREAKHIT AND 128) = 128 Then BreakQuit; { Quit if Control Break Was Hit }
      Writeln(LastEntry^.FileName,'.',LastEntry^.Extension);
      LastEntry := LastEntry^.NextEntry;
    End;
End;

{-------------------------------------------------------------------}
{ This Procedure Makes the Hash Table for the FANCY SORT......      }
{-------------------------------------------------------------------}
Procedure MakeHash;
Var
  ZZZ : Integer;
Begin
  If (BREAKHIT AND 128) = 128 Then BreakQuit; { Quit if Control Break Was Hit }
  If WatchChanges Then
    Begin;
      Writeln;
      Writeln('Clusters To Be moved are as follows......');
      PrintFancy;
      Writeln;
    End;
  ClrEol;
  Write('Making Reference table',Char($0D));

{ NIL out the HashTable so that we will be able to see it any given }
{ Cluster is not in the list of clusters to mess with later.        }

  For ZZZ := 0 to ClustPerDisk+2 Do
    Begin
      FH^.FancyHash[ClustPerDisk] := NIL;
    End;


{ Put the clusters that we need to fool with into the HASH.   }

  SrcFancy := FancyStart;
  While (SrcFancy <> Nil) Do
    Begin
      FH^.FancyHash[SrcFancy^.ClusterNum] := SrcFancy;
      SrcFancy := SrcFancy^.NextFancy;
    End;
End;
{-------------------------------------------------------------------}
{ This Procedure Changes the Dir Entries' ClustPtr to what was in   }
{ NewClust.                                                         }
{-------------------------------------------------------------------}
Procedure FixEntries;
Begin
  ClrEol;
  Write('Processing Directory Entries');
  GoToXY(1,WhereY);
  LastEntry := FirstEntry;
  While LastEntry^.FileName[0] <> Char(0) Do
    Begin
      If (BREAKHIT AND 128) = 128 Then BreakQuit; { Quit if Control Break Was Hit }
      Lastentry^.ClustPtr := LastEntry^.NewClust;
      If LastEntry^.FileName[0] = Char($E5) Then LastEntry^.ClustPtr := 0;
      LastEntry := LastEntry^.NextEntry;
    End;
{ Writeln('Intact Fancy List'); Writeln; PrintFancy; }(*DIAGNOSTIC USE*)
End;

{-------------------------------------------------------------------}
{ Dispose all FancyFats that don't have to be moved up until the    }
{ first one to change.                                              }
{-------------------------------------------------------------------}
Procedure DispTilFirst;
Var
  Tmporary1 : FancyPointer;

Begin
  ClrEol;
  Write('Processing Cluster list');
  GoToXY(1,WhereY);
  SrcFancy := FancyStart;
  If (BREAKHIT AND 128) = 128 Then BreakQuit; { Quit if Control Break Was Hit }

  While (SrcFancy^.ClusterNum = SrcFancy^.WhereShdBe) AND
        (SrcFancy^.NextFancy <> Nil) Do
          Begin
            Tmporary1  := SrcFancy;
            SrcFancy   := SrcFancy^.NextFancy;
            FancyStart := SrcFancy;
            Dispose(Tmporary1);
          End;
{ Writeln('First Part Gone..'); Writeln; PrintFancy;} (*DIAGNOSTIC USE*)
End;

{-------------------------------------------------------------------}
{ Dispose all of the Fancys that represent clusters that don't    }
{ Have to be moved anywhere. In other words, Make a removal Pass. }
{-------------------------------------------------------------------}
Procedure DispOthNoMoves;
Var
  Tmporary1 : FancyPointer;

Begin
  SrcFancy := FancyStart;
  While (SrcFancy^.NextFancy <> Nil) Do
    Begin
      Tmporary1 := SrcFancy^.NextFancy;
      If ((Tmporary1^.ClusterNum = Tmporary1^.WhereShdBe) OR
         (Tmporary1^.ClusterNum = -1))  Then
        Begin
          SrcFancy^.NextFancy := Tmporary1^.NextFancy;
          Dispose(Tmporary1);
        End
      Else SrcFancy := SrcFancy^.NextFancy;
    End;
{ Writeln('Fancy List with ALL no moves removed.');PrintFancy; }(*DIAGS*)
End;

{-------------------------------------------------------------------}
{-------------------------------------------------------------------}
PROCEDURE NOTIFY_USER;
  BEGIN
    If DiskType = $F8 Then GoToXY(1,WhereY-1) Else GoToXY(1,WhereY-1);
    Writeln('旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커');
    Writeln('   - READY TO MAKE PERMANENT CHANGES TO DISK -    ');
    Writeln('        - Clusters Need to be Moved or exchanged. ');
    Writeln('읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸');
    GoToXY(3,WhereY - 2);
    Write(Number2Switch - 1);
    GoToXy(1,WhereY + 2);
    If (BREAKHIT AND 128) = 128 Then BreakQuit; { Quit if Control Break Was Hit }
  END;

{-------------------------------------------------------------------}
{ This Procedure Removes all Fancy Entries that represent NO MOVES, }
{ and then sorts out the list for the swap to follow.               }
{-------------------------------------------------------------------}
Procedure SortFancys;
Label
  Scan,EndSort;

Var
  Tmporary1 : FancyPointer;
  Tempvar2  : ClustInfo;
  TempVar   : FancyPointer;   (* Same as what FancyPointers point to.*)
  TempVar3  : FancyPointer;
Begin
  FixEntries;      { Make all Entry^.ClustPtr := Entry^.NewClust.      }
  DispTilFirst;    { Dispose Nomoves up till first to move.            }
  DispOthNoMoves;  { dispose rest of the fancys that don't need moving.}
  MakeHash;        { This Section of Code Builds the HASH Table.       }

{ Now, Sort the fancy list into a form usable by the swap routine......}
  ClrEol;
  Writeln('Sorting Clusters');
  Writeln;

  SrcFancy := FancyStart;
  Number2Switch := 1;

SCAN:
  { Quit if Control Break Was Hit }
  If (BREAKHIT AND 128) = 128 Then BreakQuit;

{ Writeln;
  Writeln('got out of top of ',SrcFancy^.ClusterNum,'  ',SrcFancy^.WhereShdBe);
}
  If (SrcFancy^.NextFancy = NIL) Then Goto EndSort
    Else FH^.FancyHash[SrcFancy^.ClusterNum]:=NIL;
  Number2Switch :=(Number2Switch + 1);

  If (FH^.FancyHash[SrcFancy^.WhereShdBe] = NIL) Then
    Begin
      SrcFancy := SrcFancy^.NextFancy;
      GoTo Scan;
    End
  Else Tmporary1 := FH^.FancyHash[SrcFancy^.WhereShdBe];
{
  Writeln('scanned ahead for ',Tmporary1^.ClusterNum,'  ',Tmporary1^.WhereShdBe);
}
  If Tmporary1 = SrcFancy Then
    Begin
      SrcFancy := SrcFancy^.NextFancy;
      GoTo Scan;
    End;

{ Tmporary1 Should Point to an entry to switch..........................}

{ The assignment of the vars would break the links in the list. }
{ They must be saved in tempvar2 and re-assigned to swap.       }

If ((Tmporary1^.ClusterNum=SrcFancy^.WhereshdBe) AND (Tmporary1<>Nil)) Then
 Begin
  SrcFancy := SrcFancy^.NextFancy;

  TempVar3   := Tmporary1^.NextFancy;      { Save the NextFancy Pointers. }
  TempVar    := SrcFancy^.NextFancy;

  TempVar2   := SrcFancy^;
  SrcFancy^  := Tmporary1^;
  Tmporary1^ := TempVar2;                  { Swap the Data Inside.        }

  SrcFancy^.NextFancy  := TempVar;         { Restore NextFancy Pointers.  }
  Tmporary1^.NextFancy := TempVar3;

  { Now Update the entries in the FANCYHASH (Since we moved the Fancys). }

  FH^.FancyHash[Tmporary1^.ClusterNum] := Tmporary1;
  FH^.FancyHash[SrcFancy^.ClusterNum]  := SrcFancy;
  GoTo SCAN;
 End
 Else
 Begin
   SrcFancy := SrcFancy^.NextFancy;
   If SrcFancy^.NextFancy <> Nil Then Goto Scan;
 End;
ENDSORT:
  NOTIFY_USER;        { TELL THE USER HOW MANY NEED CHANGING. }
End;

{---------------------------------------------------------}
{ Do one last check on the list to verify that it is OK.  }
{---------------------------------------------------------}
Procedure Last_Chance_Out;
Var
  MAXClust : INTEGER;

Begin
  MAXClust := (ClustPerDisk + 2);
  SrcFancy := FancyStart;
  While SrcFancy^.NextFancy <> Nil Do
    Begin
      If (SrcFancy^.WhereShdBe > MaxClust) OR (SrcFancy^.WhereShdBe < 2) Then
        Begin
          Writeln('Sorted Fancy List');PrintFancy; (*DIAGNOSTIC USE*)
          Writeln('BANG! (DAMN)   -: FINAL SWAP LIST FAILED INSPECTION. ');
          Writeln('Cluster ',SrcFancy^.WhereShdBe,' would have been written to.');
          DELAY(5000);
          QUIT;
        End;
      SrcFancy := SrcFancy^.NextFancy;
    End;

  SrcFancy := FancyStart;
  While SrcFancy^.NextFancy <> Nil Do
    Begin
      If (SrcFancy^.ClusterNum > MaxClust) OR (SrcFancy^.ClusterNum < 2) Then
        Begin
          Writeln('Sorted Fancy List');PrintFancy; (*DIAGNOSTIC USE*)
          Writeln('BANG! (DAMN)   -: FINAL SWAP LIST FAILED INSPECTION. ');
          Writeln('Cluster ',SrcFancy^.ClusterNum,' would have been Read From.');
          DELAY(5000);
          QUIT;
        End;
      SrcFancy := SrcFancy^.NextFancy;
    End;
End;

{---------------------------------------------------------}
{ This Procedure Does the actual sector swapping needed   }
{ to make the disk sequential.                            }
{ SWAP CALLS THE FOLLOWING ROUTINES....                   }
{                                                         }
{ Last_Chance_Out                                         }
{ YesOrHalt                                               }
{ ClustRead ---------> BlockRead -----> ASMRead.          }
{ ClustWrite --------> BlockWrite ----> BlockWrite.       }
{---------------------------------------------------------}
Procedure SwapSectors;

Label
  LookAgain,Transfer,NextDest,Writes,Add2List,StartSwap,FoundSrc;

Var
  DestFancy : FancyPointer;
  Tmporary  : FancyPointer;
  Buf3InUse : boolean;   { If dest was in use & was saved,This is True.   }
  SectFrom  : Integer;   { Starting sector of Source Cluster.             }
  SectTo    : Integer;   { Starting sector of Destination Cluster.        }
  CursorY   : Integer;
  CursorY1  : Integer;
  Clust0At  : Integer;   { Where cluster 0 would be if it existed. }
Begin
  YesOrHalt;

StartSwap:
  Writeln(Char(7),'Cluster Swapping - DO NOT INTERRUPT -',Char(7));
  Writeln;
  CursorY   := WhereY - 1;
  CurSorY1  := CursorY + 1;

  B1Primary := True;
  SrcFancy  := FancyStart;
  Clust0at  := DataAt - (2 * SectPerClust);

LookAgain:
{ 1: READ IN CLUSTER TO BE MOVED........................................}

  If SrcFancy = NIL Then EXIT;
  SectFrom := Clust0AT + (SrcFancy^.ClusterNum * SectPerClust);
  SectTo   := Clust0AT + (SrcFancy^.WhereShdBe * SectPerClust);
  ClustRead(SectFrom);

Transfer:
  Number2Switch := Number2Switch - 1;
  If (Number2Switch AND 7) = 7 Then
    Begin
      GotoXY(1,CursorY);        { Using GOTOXY is faster than CR-LF in TURBO }
      Write(Number2Switch,' ');
      GoToXY(1,CursorY1);
    End;

  If SrcFancy = NIL Then EXIT;
  DestFancy := SrcFancy^.NextFancy;
  If DestFancy = NIL Then GoTo Writes;

{ 2: IF SOURCE READ IN ABOVE IS TO BE MOVED TO A LOCATION WITH VALID DATA }
{    THEN READ IN THE DESTINATION DATA TO THE OTHER BUFFER............... }

  Buf3InUse := False;
  If DestFancy^.ClusterNum = SrcFancy^.WhereShdBe Then
    Begin
      B1Primary := Not B1Primary;               { Select other buffer.}
      Buf3InUse := True;
      ClustRead(SectTo);                        { Read in One Sector. }
      B1Primary := Not B1Primary;               { Select Orig. Buffer.}
    End;

{ 3: WRITE ORIGINAL SOURCE DATA TO THE DESTINATION CLUSTER............. }
Writes:
  ClustWrite(SectTo);
  SrcFancy^.ClusterNum := SrcFancy^.WhereShdBe;

{ 4: IF OTHER BUFFER CONTAINS VALID DATA, THEN SWITCH TO THAT BUFFER AND }
{    GOTO STEP 2........................................................ }
  If Buf3Inuse Then
    Begin
      B1Primary := Not B1Primary;               { Select Other Buffer.}
      Buf3InUse := False;
      SrcFancy  := DestFancy;
      SectTo    := Clust0AT + (SrcFancy^.WhereShdBe * SectPerClust);
      GoTo Transfer;
    End
  ELse;

{ 5: INCREMENT TO NEXT SOURCE AND GOTO STEP #1 IF NOT AT END..............}
  If DestFancy = Nil Then EXIT;
  SrcFancy := DestFancy;
  GoTo LookAgain;
End;

{---------------------------------------------------------}
{ This Procedure Allocates Memory for Cluster Buffer.     }
{---------------------------------------------------------}
Procedure GetBufMem;
Var
  Amount : Integer;
Begin
  Amount := (SectPerClust * BytePerSect) + 5;
  Check4Amount(Amount);
  GetMem(Buffer,Amount);
End;


{---------------------------------------------------------}
{ This Procedure Allocates Memory for Cluster Buffer2.    }
{---------------------------------------------------------}
Procedure GetBuf2Mem;
Var
  Amount : Integer;
Begin
  Amount := (SectPerClust * BytePerSect) + 5;
  Check4Amount(Amount);
  GetMem(Buffer2,Amount);
End;

{$I SST2.PAS}