Fixing the heat

Yes, the weather has been cold here lately, but that is not what this post is about.

In the spring of 07 I was given an assignment to solve the heat equation. The heat equation works simply by finding the average of a point and and all the points around it, setting that new found average as the new value, and repeating. My original attempt at this involved a monitor, three copies of the array in memory, and a lockup that I could not trace down. I would have forgotten about this assignment, but earlier this semester I had an epiphany of why it didn't work. The epiphany was that I only had one point of synchronization in a loop. At certain times threads would be released from that point of synchronization then run through their loop, and come back to the point of synchronization. That point of synchronization was still open because other threads were still in it. Once this happened the threads became out of sync and the program would deadlock.

The new solution: (heat.adb)
with Ada.Command_Line; with Ada.Float_Text_Io; with Ada.Text_Io; procedure Heat is -- Alex "ahab" Habeger -- A quick exercise in thread synchronization. -- Solves the heat equasion for a 10x10 space where the temperatures of the left and right edges -- are given and static. Uses 80 threads. -- Constants Size : constant := 10; -- The height and width of the array to process -- if Heat_Type is changed processing of the Tolerance parameter may need to be changed subtype Heat_Type is Float; subtype Heat_Array_Index_Type is Integer range 1..Size; type Heat_Array_Type is array (Heat_Array_Index_Type, Heat_Array_Index_Type) of Heat_Type; -- In case proper command line parameters are not specified Usage_Error : exception; ----------------------------------------- -- The acutal math for calculating heat procedure Calculate_Heat (Heat_Array : in out Heat_Array_Type; Tolerance : in Heat_Type) is -- Local variables All_Under_Tolerance : Boolean; ----------------------------------------- -- The protected bodies for Synchronizing ----------------------------------------- protected Synchronizer is entry First_Sync (Under_Tolerance : in Boolean); -- Holds all tasks until all check in entry Second_Sync; -- Holds all tasks until all check in private First_Sync_Open : Boolean := False; Second_Sync_Open : Boolean := False; end Synchronizer; protected body Synchronizer is entry First_Sync (Under_Tolerance : in Boolean) when First_Sync'Count = Size * (Size - 2) or First_Sync_Open is begin if First_Sync'Count = Size * (Size - 2) - 1 then All_Under_Tolerance := True; First_Sync_Open := True; -- First one opens door for rest elsif First_Sync'Count = 0 then First_Sync_Open := False; -- Last one out closes the door end if; All_Under_Tolerance := All_Under_Tolerance and Under_Tolerance; end First_Sync; ----------------------------------------- entry Second_Sync when Second_Sync'Count = Size * (Size - 2) or Second_Sync_Open is begin if Second_Sync'Count = Size * (Size - 2) - 1 then Second_Sync_Open := True; -- First one opens door for rest elsif Second_Sync'Count = 0 then Second_Sync_Open := False; -- Last one out closes the door end if; end Second_Sync; end Synchronizer; ----------------------------------------- -- The tasks to do the averaging: ----------------------------------------- task type Averaging_Task is entry Get_Index (New_X : in Heat_Array_Index_Type; New_Y : in Heat_Array_Index_Type); end Averaging_Task; ----------------------------------------- -- 2D array of tasks type Averager_Task_Array is array (Heat_Array_Index_Type'First + 1 .. Heat_Array_Index_Type'Last - 1, Heat_Array_Index_Type'range) of Averaging_Task; Averagers : Averager_Task_Array; ----------------------------------------- task body Averaging_Task is Value : Heat_Type; X : Heat_Array_Index_Type; Y : Heat_Array_Index_Type; begin accept Get_Index (New_X : in Heat_Array_Index_Type; New_Y : in Heat_Array_Index_Type) do X := New_X; Y := New_Y; end Get_Index; Value := Heat_Array(X, Y); -- Averages the heat values -- One averaging per iteration Averaging_Loop: loop if Y = Heat_Array_Index_Type'First then -- Averages the left, right, and above values Value := (Heat_Array(X - 1, Y) + Heat_Array(X + 1, Y) + Heat_Array(X, Y + 1) + Value) / Heat_Type(4); elsif Y = Heat_Array_Index_Type'Last then -- Averages the left, right, and below values Value := (Heat_Array(X - 1, Y) + Heat_Array(X + 1, Y) + Heat_Array(X, Y - 1) + Value) / Heat_Type(4); else -- Averages the left, right, above and below values Value := (Heat_Array(X - 1, Y) + Heat_Array(X + 1, Y) + Heat_Array(X, Y + 1) + Heat_Array(X, Y - 1) + Value) / Heat_Type(5); end if; -- Report if the change is under tolerance and sync Synchronizer.First_Sync (abs(Value - Heat_Array(X, Y)) < Tolerance); Heat_Array(X, Y) := Value; Synchronizer.Second_Sync; exit Averaging_Loop when All_Under_Tolerance; end loop Averaging_Loop; Ada.Text_Io.Put_Line(Integer'Image(X) & "," & Integer'Image(Y) & " has been calculated."); end Averaging_Task; -------------------------- begin -- Initializes the Averagers with their index -- One Averager initialized per iteration for Index_X in Heat_Array_Index_Type'First + 1 ..Heat_Array_Index_Type'Last - 1 loop for Index_Y in Heat_Array_Index_Type'range loop Averagers(Index_X, Index_Y).Get_Index(Index_X, Index_Y); end loop; end loop; end Calculate_Heat; -------------------------- -- Sets a heat array to the default values procedure Initialize_Heat_Array_Type (Target : out Heat_Array_Type; Left : in Heat_Type; Right : in Heat_Type) is begin -- Initializes the left half of the array -- Loops across all the columns except the left edge -- One column initialized per iteration for Index_X in Heat_Array_Index_Type'First..Heat_Array_Index_Type'Last / 2 loop -- Loops across all the rows -- One element initialized per iteration for Index_Y in Heat_Array_Index_Type'range loop Target(Index_X, Index_Y) := Left; end loop; end loop; -- Initializes the remainder of the array to right -- Loops across all the columns except the left edge -- One column initialized per iteration for Index_X in Heat_Array_Index_Type'Last / 2 + 1 ..Heat_Array_Index_Type'Last loop -- Loops across all the rows -- One element initialized per iteration for Index_Y in Heat_Array_Index_Type'range loop Target(Index_X, Index_Y) := Right; end loop; end loop; end Initialize_Heat_Array_Type; -------------------------- -- Puts a heat array to standard out procedure Put_Heat_Array_Type (Source : in Heat_Array_Type) is begin for Index_Y in Heat_Array_Index_Type loop for Index_X in Heat_Array_Index_Type loop Ada.Float_Text_Io.Put ( Item => Source(Index_X, Index_Y), Fore => 4, Aft => 1, Exp => 0); end loop; Ada.Text_IO.New_Line; end loop; end Put_Heat_Array_Type; -------------------------- Heat_Array : Heat_Array_Type; Tolerance : Heat_Type; Left : Heat_Type; Right : Heat_Type; begin if Ada.Command_Line.Argument_Count /= 3 then -- not given the proper number of parameters raise Usage_Error; end if; Tolerance := Heat_Type'Value(Ada.Command_Line.Argument(1)); Left := Heat_Type'Value(Ada.Command_Line.Argument(2)); Right := Heat_Type'Value(Ada.Command_Line.Argument(3)); if Tolerance = 0.0 then raise Usage_Error; end if; Initialize_Heat_Array_Type(Heat_Array, Left, Right); Calculate_Heat(Heat_Array => Heat_Array, Tolerance => Tolerance); Put_Heat_Array_Type(Heat_Array); exception when Usage_Error => Ada.Text_IO.Put_Line("Usage: heat [TOLERANCE] [LEFT] [RIGHT]"); Ada.Text_Io.Put_Line("TOLERANCE must be greater than 0."); Ada.Text_IO.Put_Line("Example: heat 0.01 999 1"); when Constraint_Error => -- In case a non-number was given for a parameter Ada.Text_IO.Put_Line("Usage: heat [TOLERANCE] [LEFT] [RIGHT]"); Ada.Text_Io.Put_Line("TOLERANCE must be greater than 0."); end Heat;
This is not a robust solution, but merely an exercise in task synchronization. I did make two big goofs during development. I wasn't thinking at the time and placed the line "All_Under_Tolerance := True;" in the elsif instead of the if of First_Sync. This had the effect that All_Under_Tolerance was set by the last thread to exit that entry. This took a careful reading of the code to realize this error. The other error was that I had the two lines:

          Synchronizer.Second_Sync;
          exit Averaging_Loop when All_Under_Tolerance;

reversed. This made it so that some tasks would read an unsynchronized value of All_Under_Tolerance. That goof caused some tasks exit their loops and some tasks continue on. That was easy to track down.

What did I learn from all this? I think the Synchronizer in this contains the first burst locks I have ever written. If a burst lock occurs in a loop a second burst lock seems necessary. It might be possible to call one burst lock with a requeue in it so that there are two burst locks in one call. That might be an exercise for later though.