home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_pcdp / ada / tupbody.ada < prev    next >
Encoding:
Text File  |  1996-01-30  |  2.1 KB  |  86 lines
  1. package body Tuple_Package is
  2.  
  3.   Tuple_Space: array(0..50) of Tuples := (others => Null_Tuple);
  4.   Out_of_Tuple_Space: exception;
  5.  
  6.   task Space_Lock is
  7.     entry Lock;
  8.     entry Unlock;
  9.   end Space_Lock;
  10.  
  11.   task Suspend is
  12.     entry Release;
  13.     entry Notify;
  14.     entry Request;
  15.   end Suspend;
  16.  
  17.   task body Space_Lock is separate;
  18.   task body Suspend    is separate;
  19.  
  20.   function Find_Tuple(T: in Tuples) return Integer is
  21.   begin
  22.     Tuple_Space(0) := T;
  23.     for I in reverse Tuple_Space'Range loop
  24.       if Match(T, Tuple_Space(I)) then return I; end if;
  25.     end loop;
  26.   end Find_Tuple;
  27.  
  28.   procedure Out_Tuple(T: Tuples) is
  29.     I: Integer;
  30.   begin
  31.     Space_Lock.Lock;
  32.     I := Find_Tuple(Null_Tuple);
  33.     if I = 0 then raise Out_of_Tuple_Space; end if;
  34.     Tuple_Space(I) := T;
  35.     Suspend.Release;
  36.   end Out_Tuple;
  37.  
  38.   procedure Out_Tuple (T1, T2, T3, T4: Tuple_Element := Null_Element) is
  39.   begin
  40.     Out_Tuple(Create_Tuple(T1, T2, T3, T4));
  41.   end Out_Tuple;
  42.  
  43.   function Find_Tuple_or_Suspend(T: Tuples; Must_Remove: Boolean) 
  44.              return Tuples is
  45.     T1: Tuples;
  46.     I: Integer;
  47.   begin
  48.     loop
  49.       Space_Lock.Lock;
  50.       I := Find_Tuple(T);
  51.       if I /= 0 then
  52.         T1 := Tuple_Space(I);
  53.         if Must_Remove then Tuple_Space(I) := Null_Tuple; end if;
  54.         Space_Lock.Unlock;
  55.         return T1;
  56.       else
  57.         Suspend.Notify;
  58.         Suspend.Request;
  59.       end if;
  60.     end loop;
  61.   end Find_Tuple_or_Suspend;
  62.  
  63.   function In_Tuple(T: Tuples) return Tuples is
  64.   begin
  65.     return Find_Tuple_or_Suspend(T, Must_Remove => True);
  66.   end In_Tuple;
  67.  
  68.   function  In_Tuple  (T1, T2, T3, T4: Tuple_Element := Null_Element) 
  69.      return Tuples is
  70.   begin
  71.      return In_Tuple(Create_Tuple(T1, T2, T3, T4));
  72.   end In_Tuple;
  73.  
  74.   function Read_Tuple(T: Tuples) return Tuples is
  75.   begin
  76.     return Find_Tuple_or_Suspend(T, Must_Remove => False);
  77.   end Read_Tuple;
  78.  
  79.   function  Read_Tuple(T1, T2, T3, T4: Tuple_Element := Null_Element) 
  80.      return Tuples is
  81.   begin
  82.      return Read_Tuple(Create_Tuple(T1, T2, T3, T4));
  83.   end Read_Tuple;
  84.  
  85. end Tuple_Package;
  86.