1. --  (c) Copyright, Real-Time Innovations, $Date:: 2012-02-16 #$ 
  2. --  All rights reserved. 
  3. -- 
  4. --  No duplications, whole or partial, manual or electronic, may be made 
  5. --  without express written permission.  Any such copies, or 
  6. --  revisions thereof, must display this notice unaltered. 
  7. --  This code contains trade secrets of Real-Time Innovations, Inc. 
  8.  
  9. with System; 
  10. with GNAT.Source_Info; 
  11. with RTIDDS.Low_Level.ndds_dds_c_dds_c_sequence_h; 
  12. generic 
  13.    type Element is limited private; 
  14.    type Element_Access is access all Element; 
  15.    type Index_Type is range <>; 
  16.    First_Element : Index_Type; 
  17.    type Element_Array is array (Index_Type range <>) of aliased Element; 
  18.    with procedure Initialize (Self  : in out Element) is <>; 
  19.    with procedure Finalize (Self  : in out Element) is <>; 
  20.    with procedure Copy (Dst : in out Element; Src : in Element) is <>; 
  21.  
  22.    --  <dref>FooSeq</dref> 
  23. package DDS_Support.Sequences_Generic is 
  24.  
  25.    --  This package implents Sequences as defined in 
  26.    --  the RTI C Implementation of Sequences. 
  27.    --  The implementation maps 1 to 1 to the C implementation in order to 
  28.    --  make data interchangeble between tha languages. 
  29.    --  This package may later be replaces by Ada.Containers.Vectors but that would 
  30.    --  require rewriting of the serialization and deserialisation code. 
  31.  
  32.  
  33.    --  <TBD> 
  34.    SEQUENCE_MAGIC_NUMBER : constant := 16#7344#; 
  35.  
  36.    type Memory_Element_Pointer  is 
  37.      array (First_Element .. Index_Type'Last) of aliased Element_Access; 
  38.    subtype Memory_Element_Array is 
  39.      Element_Array (First_Element .. Index_Type'Last); 
  40.  
  41.    type Memory_Element_Array_Pointer is access all Memory_Element_Array with 
  42.      Storage_Size => 0; 
  43.    pragma No_Strict_Aliasing (Memory_Element_Array_Pointer); 
  44.  
  45.    type Element_Array_Access is access all Element_Array  with 
  46.      Storage_Size => 0; 
  47.    pragma No_Strict_Aliasing (Element_Array_Access); 
  48.    type NElement_Access is new Element_Access; 
  49.    type Memory_Element_Pointer_Access is access all Memory_Element_Pointer with 
  50.      Storage_Size => 0; 
  51.    pragma No_Strict_Aliasing (Memory_Element_Pointer_Access); 
  52.    type Sequence is record 
  53.       Owned                     : aliased Boolean := True; 
  54.       Contiguous_Buffer         : aliased Memory_Element_Array_Pointer := null; 
  55.       Discontiguous_Buffer      : aliased Memory_Element_Pointer_Access := null; 
  56.       Maximum                   : aliased Index_Type := 0; 
  57.       Length                    : aliased Index_Type := 0; 
  58.       Sequence_Init             : aliased Integer := SEQUENCE_MAGIC_NUMBER; 
  59.       Read_Token1               : aliased System.Address := System.Null_Address; 
  60.       Read_Token2               : aliased System.Address := System.Null_Address; 
  61.       ElementPointersAllocation : aliased RTIDDS.Low_Level.ndds_dds_c_dds_c_sequence_h.DDS_SeqElementTypeAllocationParams_t := (1, 1, 1); 
  62.       ElementDeallocParams      : aliased RTIDDS.Low_Level.ndds_dds_c_dds_c_sequence_h.DDS_SeqElementTypeDeallocationParams_t := (1, 1); 
  63.       Absolute_Maximum          : aliased Index_Type := Index_Type'Last; 
  64.    end record with 
  65.      Iterable => (First        => I_First_Element, 
  66.                   Next         => I_Next, 
  67.                   Has_Element  => I_Has_Element, 
  68.                   Element      => I_Get_Element); 
  69.    type Sequence_Access is access all Sequence; 
  70.    function I_First_Element (Self : Sequence) return Index_Type; 
  71.    function I_Next (Self : Sequence; C : Index_Type) return Index_Type; 
  72.    function I_Has_Element (Self : Sequence; C : Index_Type) return Standard.Boolean; 
  73.    function I_Get_Element (Self : Sequence; C : Index_Type) return Element_Access; 
  74.  
  75.    --  Used for initialization w/aggregate assignment 
  76.  
  77.  
  78.    procedure Initialize 
  79.      (Self : not null access Sequence); 
  80.    --  <dref>FooSeq_initialize</dref> 
  81.    --  <internal> 
  82.    --  Initialize the structure for future use 
  83.    --  </internal> 
  84.  
  85.    function Get_Reference (Self  : not null access constant Sequence; 
  86.                            Index : Index_Type) return Element_Access; 
  87.    --  <dref>FooSeq_get_reference</dref> 
  88.    --  <internal> 
  89.    --  Get a reference to the Index-th element of the sequence. 
  90.    --  Raises Constraint_Error if index is out of bounds. 
  91.    --  </internal> 
  92.  
  93.    procedure Set_Element (Self  : not null access Sequence; 
  94.                           Index : Index_Type; 
  95.                           Elt   : Element); 
  96.    --  <internal> 
  97.    --  Sets the Index-th element of the sequence to given Element 
  98.    --  Raises Constraint_Error if index is out of bounds. 
  99.    --  </internal> 
  100.  
  101.  
  102.    procedure Append (Self  : not null access Sequence; 
  103.                      Elt   : Element); 
  104.  
  105.    procedure Iterate 
  106.      (Self   : not null access Sequence; 
  107.       Handle : not null access procedure (continue : in out Boolean; elt : Element_Access)); 
  108.  
  109.    function Get (Self  : not null access constant Sequence; 
  110.                  Index : Index_Type) return Element; 
  111.    --  <dref>FooSeq_operatorBracketConst</dref> 
  112.    --  <internal> 
  113.    --  Get the Index-th element of the sequence. 
  114.    --  Raises Constraint_Error if index is out of bounds. 
  115.    --  </internal> 
  116.  
  117.    function Get_Element_Pointers_Allocation 
  118.      (Self : not null access constant Sequence) 
  119.       return Boolean; 
  120.    --  <internal> 
  121.    --  Returns the Element_Pointers_Allocation 
  122.    --  </internal> 
  123.  
  124.    procedure Set_Element_Pointers_Allocation 
  125.      (Self              : not null access Sequence; 
  126.       Allocate_Pointers : in Boolean); 
  127.    --  <internal> 
  128.    --  Sets the Element_Pointers_Allocation 
  129.    --  </internal> 
  130.  
  131.  
  132.    function Get_Maximum 
  133.      (Self : not null access constant Sequence) return Index_Type; 
  134.    --  <dref>FooSeq_get_maximum</dref> 
  135.    --  <internal> 
  136.    --  Get the current maximum of the sequence. 
  137.    --  </internal> 
  138.  
  139.    procedure Set_Maximum (Self    : not null access Sequence; 
  140.                           New_Max : in Index_Type); 
  141.    --  <dref>FooSeq_set_maximum</dref> 
  142.    --  <internal> 
  143.    --  Resize this sequence to a new desired maximum. 
  144.    --  </internal> 
  145.  
  146.    function Get_Length 
  147.      (Self : not null access constant Sequence) return Index_Type; 
  148.    --  <dref>FooSeq_get_length</dref> 
  149.    --  <internal> 
  150.    --  Get the sequence length. 
  151.    --  </internal> 
  152.  
  153.    procedure Set_Length (Self       : not null access Sequence; 
  154.                          New_Length : in Index_Type); 
  155.    --  <dref>FooSeq_set_length</dref> 
  156.    --  <internal> 
  157.    --  Change the length of this sequence. 
  158.    --  Will raise Constraint_Error if new length exceeds Max_Length. 
  159.    --  </internal> 
  160.  
  161.    procedure Ensure_Length (Self   : not null access Sequence; 
  162.                             Length : in Index_Type; 
  163.                             Max    : in Index_Type); 
  164.    --  <dref>FooSeq_ensure_length</dref> 
  165.    --  <internal> 
  166.    --  Set the sequence to the desired length, 
  167.    --  and resize the sequence if necessary. 
  168.    --  Raise 
  169.    --    Program_Error On Illegal use 
  170.    --    Storage_Error if no memory is avalible. 
  171.    --  </internal> 
  172.  
  173.  
  174.  
  175.    procedure Copy_No_Alloc (Self : not null access Sequence; 
  176.                             Src  : not null access constant Sequence); 
  177.    --  <dref>FooSeq_copy_no_alloc</dref> 
  178.    --  <internal> 
  179.    --  Copy elements from another sequence, 
  180.    --  only if the destination sequence has enough capacity. 
  181.    --  </internal> 
  182.  
  183.    procedure Copy (Self : not null access Sequence; 
  184.                    Src  : not null access constant Sequence); 
  185.    --  <dref>FooSeq_copy</dref> 
  186.    --  <internal> 
  187.    --  Copy elements from another sequence, resizing the sequence if necessary. 
  188.    --  </internal> 
  189.  
  190.    procedure From_Array (Self : not null access Sequence; 
  191.                          Src  : in Element_Array); 
  192.    --  <dref>FooSeq_from_array</dref> 
  193.    --  <internal> 
  194.    --  Copy elements from an array of elements, 
  195.    --  resizing the sequence if necessary. 
  196.    --  The original contents of the sequence (if any) are replaced. 
  197.    --  </internal> 
  198.  
  199.    procedure To_Array (Self   : not null access constant Sequence; 
  200.                        Target : out Element_Array); 
  201.    --  <dref>FooSeq_to_array</dref> 
  202.    --  <internal> 
  203.    --  Copy elements to an array of elements. 
  204.    --  The original contents of the array (if any) are replaced. 
  205.    --  Raises constraint error if the target array is to small. 
  206.    --  </internal> 
  207.  
  208.    function To_Array 
  209.      (Self : not null access constant Sequence) return Element_Array; 
  210.    --  Convert elements to an array of elements. 
  211.  
  212.    procedure Loan_Contiguous (Self       : not null access Sequence; 
  213.                               Buffer     : not null access Element_Array; 
  214.                               New_Length : in Index_Type; 
  215.                               New_Max    : in Index_Type); 
  216.    --  <dref>FooSeq_loan_contiguous</dref> 
  217.    --  <internal> 
  218.    --  Loan a contiguous buffer to this sequence. 
  219.    --  </internal> 
  220.  
  221.    procedure Loan_Discontiguous (Self       : access Sequence; 
  222.                                  Buffer     : not null access Element_Access; 
  223.                                  New_Length : in Index_Type; 
  224.                                  New_Max    : in Index_Type); 
  225.    --  <dref>FooSeq_loan_discontiguous</dref> 
  226.    --  <internal> 
  227.    --  Loan a discontiguous buffer to this sequence. 
  228.    --  </internal> 
  229.  
  230.    procedure Unloan  (Self : not null access Sequence); 
  231.    --  <dref>FooSeq_unloan</dref> 
  232.    --  <internal> 
  233.    --  Return the loaned buffer in the sequence. 
  234.    --  </internal> 
  235.  
  236.    function Has_Ownership 
  237.      (Self : not null access constant Sequence) return Boolean; 
  238.    --  <dref>FooSeq_has_ownership</dref> 
  239.    --  <internal> 
  240.    --  The value of the owned flag. 
  241.    --  </internal> 
  242.  
  243.    procedure Finalize (Self : not null access Sequence); 
  244.    --  <dref>FooSeq_delete</dref> 
  245.    --  <internal> 
  246.    --  Deallocate this sequence's buffer. 
  247.    --  </internal> 
  248.  
  249.    SEQUENCE_UNINITIALIZED : exception; 
  250.    SEQUENCE_ERROR : exception; 
  251.  
  252.  
  253.    --  ------------------------------------------------------------------------- 
  254.    --   Implementation routines for internal use only 
  255.    --   It could not be placed in the private part since it to be used by 
  256.    --   packages in the herachy DDS 
  257.    --  ------------------------------------------------------------------------- 
  258.  
  259.  
  260.  
  261.  
  262.    DEFAULT_SEQUENCE : aliased constant Sequence := 
  263.      (Owned => True, 
  264.       Contiguous_Buffer => null, 
  265.       Discontiguous_Buffer => null, 
  266.       Maximum              => 0, 
  267.       Length               => 0, 
  268.       Sequence_Init        => SEQUENCE_MAGIC_NUMBER, 
  269.       Read_Token1          => System.Null_Address, 
  270.       Read_Token2          => System.Null_Address, 
  271.       ElementPointersAllocation => (1, 1, 1), 
  272.       ElementDeallocParams => (1, 1), 
  273.       Absolute_Maximum     => Index_Type'Last); 
  274.  
  275.    procedure Check_InvariantsI 
  276.      (Self             : not null access constant Sequence; 
  277.       Calling_Function : Standard.String := GNAT.Source_Info.Enclosing_Entity); 
  278.    procedure Check_InitI (Self : not null access constant Sequence); 
  279.  
  280.    procedure Copy_No_AllocI (Self : not null access Sequence; 
  281.                              Src  : not null access constant Sequence); 
  282.  
  283.    procedure Get_Read_TokenI (Self   : not null access constant Sequence; 
  284.                               Token1 : not null access System.Address; 
  285.                               Token2 : not null access System.Address); 
  286.  
  287.    procedure Set_Read_TokenI (Self   : not null access Sequence; 
  288.                               Token1 : in System.Address; 
  289.                               Token2 : in System.Address); 
  290.  
  291.    function Get_Contiguous_BufferI  (Self : not null access constant Sequence) 
  292.                                      return access Memory_Element_Array; 
  293.    --  <dref>FooSeq_get_contiguous_buffer</dref> 
  294.  
  295.    function Get_DisContiguous_BufferI (Self : not null access constant Sequence) 
  296.                                        return access Memory_Element_Pointer; 
  297.    --  <dref>FooSeq_get_discontiguous_buffer</dref> 
  298.  
  299. end DDS_Support.Sequences_Generic;