WITH Sequential_IO;

PROCEDURE KSort IS

K          : CONSTANT INTEGER  := 3;      
KSigDig    : CONSTANT INTEGER  := 3;    -- Significant digits for K
NumOfFiles : CONSTANT INTEGER  := K;
IRunSize   : CONSTANT INTEGER  := 25;
--*************************************************************************
--KSort establishes the initial conditions required for balanced K way 
--sort/merge file sorting.   KSort creates the 'K' input files needed before 
--the main sorting & merging takes place.  The run size in each input file 
--in set in 'IRunSize'.  KSigDig establishes the number of significant 
--digits used in writing the filename.  For example, 3 allows use of up 
--to 999 file (1-999) if needed -- FILE001, FILE002, ..., FILE999.  
--*************************************************************************

CharTable  : CONSTANT STRING(1..10) := ("0123456789");
 
SUBTYPE FNameType IS STRING(1..4+KSigDig);

SUBTYPE KeyType  IS STRING(1..5);
SUBTYPE NameType IS STRING(1..10);
SUBTYPE AddrType IS STRING(1..20);
SUBTYPE FoneType IS STRING(1..8);

TYPE ItemType IS RECORD
   Key     : KeyType;
   FName   : NameType;
   LName   : NameType;
   MI      : CHARACTER;
   Address : AddrType;
   Phone   : FoneType;
END RECORD;

PACKAGE SeqPack IS NEW Sequential_IO(ItemType);
USE SeqPack;

TYPE  FTableType  IS ARRAY(1..K) OF SeqPack.FILE_TYPE;
TYPE  RunType IS ARRAY(1..IRunSize) OF ItemType;

RunEndMark  : CONSTANT ItemType := (Key     => "zzzzz",
                                    LName   => "..........",
                                    FName   => "..........",
                                    MI      => '.',
                                    Address => "....................",
                                    Phone   => "........" );

PROCEDURE MakeName(Name : IN OUT FNameType; X : INTEGER) IS
--*************************************************************************
--Using the input X, the output will be the related filename with 'KSigDig' 
--allowed for writing X.  EX: X=5 : KSigDig=3 => Name=FILE005
--*************************************************************************
Divider : INTEGER := 10**KSigDig;
Z       : INTEGER;

BEGIN
   Z := X;
   FOR T IN 1..KSigDig LOOP
      Divider := Divider / 10;
      Name(T+4) := CharTable((Z / Divider) + 1);
      Z := (Z MOD Divider);
   END LOOP;
END MakeName;



PROCEDURE MakeRuns IS
--*************************************************************************
--Creates the initial K input files for required by balanced K way sort/merge. 
--*************************************************************************
OutFile   : FTableType;
MasterPtr : SeqPack.FILE_TYPE;
Run       : RunType;
FSelect   : INTEGER := 1;
Count     : INTEGER;



   PROCEDURE MakeFTable(FilePtr : IN OUT FTableType) IS
   --**********************************************************************
   --Creates a table of K file pointers in the array 'FilePtr' so that 
   --they may be referenced numerically.    
   --**********************************************************************
   FileName : FNameType;

   BEGIN
      FileName(1..4) := "FILE";

      FOR T IN 1..NumOfFiles LOOP
         MakeName(FileName, T);
         CREATE(FilePtr(T), SeqPack.OUT_FILE, FileName );
      END LOOP;

   END MakeFTable;



   PROCEDURE CloseFTable(FilePtr : IN OUT FTableType) IS
   --**********************************************************************
   --Closes all K files in the file table 'FilePtr'. 
   --**********************************************************************
   BEGIN

      FOR T IN 1..NumOfFiles LOOP
         CLOSE(FilePtr(T) );
      END LOOP;

   END CloseFTable;



   PROCEDURE MergeRun(FilePtr : IN OUT SeqPack.FILE_TYPE; Stop : INTEGER) IS
   --**********************************************************************
   --Writes the contents of 'Run()' and the RunEndMark into the file 
   --'FilePtr'. 
   --**********************************************************************
   BEGIN
      FOR T IN 1..Stop LOOP
         WRITE(FilePtr, Run(T) );
      END LOOP;

      WRITE(FilePtr, RunEndMark);
   END MergeRun;



   PROCEDURE SortRun(N : INTEGER) IS 
   --**********************************************************************
   --Sorts the runs according to the field 'Key'.  I used the psuedo code 
   --found in the book 'Computer Algorithms' by Sara Baase.  However, the 
   --listing found in the book was incorrect. Therefore, I made the 
   --necessary correction to the code here (and in the book!).
   --**********************************************************************
   Hold  : ItemType;
   NDown : INTEGER;

      PROCEDURE FixHeap(Base : INTEGER; Item : ItemType; Max : INTEGER) IS
      --*******************************************************************
      --This is the typical data movement procedure required by heapsort.  
      --Basically: When sorting, it moves 'Base' to 'Max' and walks the 
      --associate nodes up the heap.  Get a (correct) book if you want to 
      --know more.  
      --*******************************************************************
      Empty, BigChild : INTEGER;

      BEGIN
         Empty := Base;
         WHILE 2*Empty <= Max LOOP

            BigChild := 2 * Empty;

            IF (2*Empty < Max ) AND (Run(2*Empty+1).Key > Run(2*Empty).Key) THEN   
               BigChild := 2 * Empty + 1;
            END IF;

            IF Item.Key < Run(BigChild).Key THEN
               Run(Empty) := Run(BigChild);
               Empty      := BigChild;
            ELSE 
               EXIT;
            END IF;

         END LOOP;
         Run(Empty) := Item;
      END FixHeap;

   --********************************************************************

   BEGIN
      NDown := INTEGER((float(N)-0.5)/2.0);  -- N/2 forced to round down!  

      FOR I IN REVERSE 1..NDown LOOP         -- This loop creates a heap
        Hold := Run(I);
        FixHeap(I, Hold, N);
      END LOOP;

      FOR HSize IN REVERSE 2..N LOOP         -- This loop sorts the heap
         Hold := Run(1);
         FixHeap(1, Run(HSize), HSize-1);
         Run(HSize) := Hold;
      END LOOP;
   END SortRun;

--*************************************************************************

BEGIN 
   MakeFTable(OutFile);
   OPEN(MasterPtr, SeqPack.IN_FILE,  "Master.dat");

   WHILE NOT END_OF_FILE(MasterPtr) LOOP

      Count := 0;

      WHILE (Count<IRunSize) AND (NOT END_OF_FILE(MasterPtr)) LOOP
         Count := Count + 1;
         READ(MasterPtr, Run(Count) );
      END LOOP;

      SortRun(Count);
      MergeRun(OutFile(FSelect), Count );
      FSelect := (FSelect MOD K) + 1;

   END LOOP;

   CloseFTable(OutFile);
END MakeRuns;

--*************************************************************************

BEGIN

   MakeRuns;	-- Simple procedure => ready for expansion!
   
END KSort;