1. -- 
  2. --  Copyright (c) 2009, 
  3. --  Reto Buerki, Adrian-Ken Rueegsegger 
  4. --  secunet SwissIT AG 
  5. -- 
  6. --  This file is part of Alog. 
  7. -- 
  8. --  Alog is free software; you can redistribute it and/or modify 
  9. --  it under the terms of the GNU Lesser General Public License as published 
  10. --  by the Free Software Foundation; either version 2.1 of the License, or 
  11. --  (at your option) any later version. 
  12. -- 
  13. --  Alog is distributed in the hope that it will be useful, 
  14. --  but WITHOUT ANY WARRANTY; without even the implied warranty of 
  15. --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
  16. --  GNU Lesser General Public License for more details. 
  17. -- 
  18. --  You should have received a copy of the GNU Lesser General Public License 
  19. --  along with Alog; if not, write to the Free Software 
  20. --  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, 
  21. --  MA  02110-1301  USA 
  22. -- 
  23.  
  24. with Ada.Exceptions; 
  25. with Ada.Task_Identification; 
  26. with Ada.Containers.Doubly_Linked_Lists; 
  27.  
  28. with Alog.Log_Request; 
  29. with Alog.Controlled_Map; 
  30.  
  31. --  Alog Protected Containers. This package provides protected containers which 
  32. --  are safe for concurrent access. 
  33. package Alog.Protected_Containers is 
  34.  
  35.    ---------------------- 
  36.    -- Log_Request_List -- 
  37.    ---------------------- 
  38.  
  39.    type Log_Request_Storage is private; 
  40.  
  41.    protected type Log_Request_List is 
  42.  
  43.       procedure Put (Element : Log_Request.Instance); 
  44.       --  Put an element at the end of the request list. 
  45.  
  46.       entry Get (Element : out Log_Request.Instance); 
  47.       --  Get the first element from the list (and delete it). 
  48.  
  49.       procedure Done; 
  50.       --  Signal successfull processing of request previously gotten from list. 
  51.  
  52.       entry All_Done; 
  53.       --  This procedure blocks until the list is empty and there are no pending 
  54.       --  requests. A requests is pending when it is taken off the list via Get 
  55.       --  but it's successfull processing has not been signaled back via the 
  56.       --  procedure Done. 
  57.  
  58.       procedure Clear; 
  59.       --  Clear the request list by deleting all log requests. 
  60.  
  61.       function Length return Natural; 
  62.       --  Return the number of elements in the list. 
  63.  
  64.       function Pending return Natural; 
  65.       --  Return the number of pending requests. 
  66.  
  67.    private 
  68.  
  69.       Requests           : Log_Request_Storage; 
  70.       Requests_Available : Boolean := False; 
  71.       Pending_Counter    : Natural := 0; 
  72.  
  73.    end Log_Request_List; 
  74.    --  Protected variant of a log request list. This list holds log request 
  75.    --  objects and is safe for concurrent access. It operates in FIFO-Mode. 
  76.  
  77.    ----------------------------- 
  78.    -- Protected_Exception_Map -- 
  79.    ----------------------------- 
  80.  
  81.    type Exception_Storage is limited private; 
  82.  
  83.    protected type Protected_Exception_Map is 
  84.  
  85.       procedure Insert 
  86.         (Key  : Ada.Task_Identification.Task_Id; 
  87.          Item : Ada.Exceptions.Exception_Occurrence_Access); 
  88.       --  Insert the given Exception_Occurrence 'Element' with key 'Key' into 
  89.       --  the map. 
  90.  
  91.       procedure Get 
  92.         (Key     :     Ada.Task_Identification.Task_Id; 
  93.          Element : out Ada.Exceptions.Exception_Occurrence); 
  94.       --  Get the Exception_Occurrence with key 'Key' from the map. If the key 
  95.       --  is not found in the map Null_Occurrence is stored in element. 
  96.  
  97.       procedure Delete (Key : Ada.Task_Identification.Task_Id); 
  98.       --  Delete the Exception_Occurrence with key 'Key' from the map. Memory 
  99.       --  of the exception occurrence is freed. The user must make sure to not 
  100.       --  access deleted elements. 
  101.  
  102.       function Contains (Key : Ada.Task_Identification.Task_Id) return Boolean; 
  103.       --  Returns True if an element with key 'Key' is in the map. 
  104.  
  105.       function Is_Empty return Boolean; 
  106.       --  Return True if the map is empty. 
  107.  
  108.       procedure Clear; 
  109.       --  Remove all Exception_Occurrences in the map. Memory of the exception 
  110.       --  occurrences is freed. 
  111.  
  112.    private 
  113.  
  114.       Data : Exception_Storage; 
  115.  
  116.    end Protected_Exception_Map; 
  117.    --  Protected map of exceptions. To make memory management more robust only 
  118.    --  copies of Excpetion_Occurrences and not handles are returned by the map. 
  119.    --  The memory of an occurrence pointed to by a previously inserted handle is 
  120.    --  freed upon calling Delete, Clear or during finalization of the protected 
  121.    --  type. 
  122.  
  123. private 
  124.  
  125.    use type Alog.Log_Request.Instance; 
  126.  
  127.    package List_Of_Log_Requests_Package is 
  128.      new Ada.Containers.Doubly_Linked_Lists 
  129.        (Element_Type => Log_Request.Instance); 
  130.  
  131.    package LOLRP renames List_Of_Log_Requests_Package; 
  132.  
  133.    type Log_Request_Storage is new LOLRP.List with null record; 
  134.  
  135.    function "<" (Left, Right : Ada.Task_Identification.Task_Id) return Boolean; 
  136.    --  Smaller-than function for Task_Id. Needed to use Task_Id as Key_Type. 
  137.  
  138.    package Map_Of_Exceptions_Package is new Alog.Controlled_Map 
  139.      (Key_Type       => Ada.Task_Identification.Task_Id, 
  140.       Element_Type   => Ada.Exceptions.Exception_Occurrence, 
  141.       Element_Handle => Ada.Exceptions.Exception_Occurrence_Access); 
  142.  
  143.    package MOEP renames Map_Of_Exceptions_Package; 
  144.  
  145.    type Exception_Storage is limited new MOEP.Map with null record; 
  146.  
  147. end Alog.Protected_Containers;