Experimental multithreaded version of Read_Bundles added

2 files changed, 140 insertions, 1 deletions

diff --git a/src/bundles-containers.adb b/src/bundles-containers.adb
index d1b1130..0550f6d 100644
--- a/src/bundles-containers.adb
+++ b/src/bundles-containers.adb
@@ -2,19 +2,148 @@
 
 with
 
-    Ada.Strings.Unbounded,
+    Ada.Strings.Unbounded.Text_IO,
     Ada.Text_IO,
     CSV;
 
+use
+
+    Ada.Strings.Unbounded.Text_IO,
+    Ada.Text_IO;
+
 
 package body Bundles.Containers is
 
 
+    package My_CSV is new CSV;
     package SU renames Ada.Strings.Unbounded;
 
 
 
 
+    protected type Preference_Input is
+        procedure Open (Filename : in String);
+        procedure Read_Line
+               (Line : out SU.Unbounded_String;
+                EOF  : out Boolean);
+        procedure Close;
+    private
+        Source : File_Type;
+    end Preference_Input;
+
+
+    protected body Preference_Input is
+        procedure Open (Filename : in String) is
+        begin
+            Open (Source, In_File, Filename);
+        end Open;
+        procedure Read_Line
+               (Line : out SU.Unbounded_String;
+                EOF  : out Boolean) is
+        begin
+            if End_Of_File (Source) then
+                EOF := True;
+            else
+                EOF := False;
+                Line := Get_Line (Source);
+            end if;
+        end Read_Line;
+        procedure Close is
+        begin
+            Ada.Text_IO.Close (Source);
+        end Close;
+    end Preference_Input;
+
+
+
+
+    type Paper_Array is array (Valid_CandidateID) of Paper_Vectors.Vector;
+    type Paper_Array_Array is array (1 .. Num_Threads) of Paper_Array;
+
+
+    Empty_Paper_Array : Paper_Array :=
+        (others => Paper_Vectors.Empty_Vector);
+
+
+
+
+    task type Parse_Worker
+           (Input  : access Preference_Input;
+            Output : access Paper_Array_Array) is
+        entry Start (On : in Positive);
+    end Parse_Worker;
+
+
+    task body Parse_Worker is
+        use type Candidates.CandidateID;
+
+        Work_On : Positive;
+
+        Current_Line    : SU.Unbounded_String;
+        Current_Record  : My_CSV.CSV_Record;
+        Current_Prefs   : Given_Prefs.Preference_Array;
+        Are_We_Done_Yet : Boolean;
+    begin
+        accept Start (On : in Positive) do
+            Work_On := On;
+        end Start;
+        loop
+            Input.Read_Line (Current_Line, Are_We_Done_Yet);
+            exit when Are_We_Done_Yet;
+            Current_Record := My_CSV.Parse_Line (SU.To_String (Current_Line));
+            if Integer (Current_Record.Length) > 0 then
+                Current_Prefs := Given_Prefs.Parse_Preferences
+                    (SU.To_String (Current_Record.Last_Element));
+                if Current_Prefs (Given_Prefs.Preference_Range'First) /=
+                    Candidates.No_Candidate
+                then
+                    Output (Work_On) (Current_Prefs (Given_Prefs.Preference_Range'First)).Append
+                        (Current_Prefs);
+                end if;
+            end if;
+        end loop;
+    end Parse_Worker;
+
+
+
+
+    procedure Read_Bundles_Threaded
+           (Filename : in     String;
+            Result   :    out Bundle_Collection)
+    is
+        use type Bundle_Vector;
+
+        Input : aliased Preference_Input;
+        Outputs : aliased Paper_Array_Array :=
+            (others => Empty_Paper_Array);
+    begin
+        Result := (others => Bundle_Vectors.Empty_Vector & Empty_Bundle);
+        Input.Open (Filename);
+
+        declare
+            Workers : array (1 .. Num_Threads) of Parse_Worker
+                (Input'Access, Outputs'Access);
+        begin
+            for I in Workers'Range loop
+                Workers (I).Start (I);
+            end loop;
+        end;
+
+        Input.Close;
+        for CID in Valid_CandidateID loop
+            for O of Outputs loop
+                Result (CID).Reference (1).Papers.Append (O (CID));
+                O (CID) := Paper_Vectors.Empty_Vector;
+            end loop;
+            if Result (CID).Reference (1) = Empty_Bundle then
+                Result (CID).Delete (1);
+            end if;
+        end loop;
+    end Read_Bundles_Threaded;
+
+
+
+
     procedure Read_Bundles
            (Filename : in     String;
             Result   :    out Bundle_Collection)
diff --git a/src/bundles-containers.ads b/src/bundles-containers.ads
index 8caf263..1361026 100644
--- a/src/bundles-containers.ads
+++ b/src/bundles-containers.ads
@@ -8,6 +8,7 @@ with
 generic
     Min_Valid : Candidates.CandidateID;
     Max_Valid : Candidates.CandidateID;
+    Num_Threads : Positive := 2;
 package Bundles.Containers is
 
 
@@ -26,6 +27,15 @@ package Bundles.Containers is
             Result   :    out Bundle_Collection);
 
 
+    --  Current implementation slightly faster, but not worth it.
+    --  Probably needs to be reworked to read in the entire file at once for decent
+    --  increase in speed, but that would involve approx doubling memory usage,
+    --  which is unacceptable.
+    procedure Read_Bundles_Threaded
+           (Filename : in     String;
+            Result   :    out Bundle_Collection);
+
+
 end Bundles.Containers;