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