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.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; 
  42.    pragma No_Strict_Aliasing (Memory_Element_Array_Pointer); 
  43.  
  44.    type Element_Array_Access is access all Element_Array; 
  45.    type NElement_Access is new Element_Access; 
  46.    type Memory_Element_Pointer_Access is access all Memory_Element_Pointer; 
  47.    type Sequence is record 
  48.       Owned                     : aliased Boolean := True; 
  49.       Contiguous_Buffer         : aliased Memory_Element_Array_Pointer := null; 
  50.       Discontiguous_Buffer      : aliased Memory_Element_Pointer_Access := null; 
  51.       Maximum                   : aliased Index_Type := 0; 
  52.       Length                    : aliased Index_Type := 0; 
  53.       Sequence_Init             : aliased Integer := SEQUENCE_MAGIC_NUMBER; 
  54.       Read_Token1               : aliased System.Address := System.Null_Address; 
  55.       Read_Token2               : aliased System.Address := System.Null_Address; 
  56.       ElementPointersAllocation : aliased RTIDDS.Low_Level.dds_c.sequence_h.DDS_SeqElementTypeAllocationParams_t := (1, 1, 1); 
  57.       ElementDeallocParams      : aliased RTIDDS.Low_Level.dds_c.sequence_h.DDS_SeqElementTypeDeallocationParams_t := (1, 1); 
  58.    end record with 
  59.      Iterable => (First        => I_First_Element, 
  60.                   Next         => I_Next, 
  61.                   Has_Element  => I_Has_Element, 
  62.                   Element      => I_Get_Element); 
  63.    type Sequence_Access is access all Sequence; 
  64.    function I_First_Element (Self : Sequence) return Index_Type; 
  65.    function I_Next (Self : Sequence; C : Index_Type) return Index_Type; 
  66.    function I_Has_Element (Self : Sequence; C : Index_Type) return Standard.Boolean; 
  67.    function I_Get_Element (Self : Sequence; C : Index_Type) return Element_Access; 
  68.  
  69.    --  Used for initialization w/aggregate assignment 
  70.  
  71.  
  72.    procedure Initialize 
  73.      (Self : not null access Sequence); 
  74.    --  <dref>FooSeq_initialize</dref> 
  75.    --  <internal> 
  76.    --  Initialize the structure for future use 
  77.    --  </internal> 
  78.  
  79.    function Get_Reference (Self  : not null access constant Sequence; 
  80.                            Index : Index_Type) return Element_Access; 
  81.    --  <dref>FooSeq_get_reference</dref> 
  82.    --  <internal> 
  83.    --  Get a reference to the Index-th element of the sequence. 
  84.    --  Raises Constraint_Error if index is out of bounds. 
  85.    --  </internal> 
  86.  
  87.    procedure Set_Element (Self  : not null access Sequence; 
  88.                           Index : Index_Type; 
  89.                           Elt   : Element); 
  90.    --  <internal> 
  91.    --  Sets the Index-th element of the sequence to given Element 
  92.    --  Raises Constraint_Error if index is out of bounds. 
  93.    --  </internal> 
  94.  
  95.  
  96.    procedure Append (Self  : not null access Sequence; 
  97.                      Elt   : Element); 
  98.  
  99.    procedure Iterate 
  100.      (Self   : not null access Sequence; 
  101.       Handle : not null access procedure (continue : in out Boolean; elt : Element_Access)); 
  102.  
  103.    function Get (Self  : not null access constant Sequence; 
  104.                  Index : Index_Type) return Element; 
  105.    --  <dref>FooSeq_operatorBracketConst</dref> 
  106.    --  <internal> 
  107.    --  Get the Index-th element of the sequence. 
  108.    --  Raises Constraint_Error if index is out of bounds. 
  109.    --  </internal> 
  110.  
  111.    function Get_Element_Pointers_Allocation 
  112.      (Self : not null access constant Sequence) 
  113.       return Boolean; 
  114.    --  <internal> 
  115.    --  Returns the Element_Pointers_Allocation 
  116.    --  </internal> 
  117.  
  118.    procedure Set_Element_Pointers_Allocation 
  119.      (Self              : not null access Sequence; 
  120.       Allocate_Pointers : in Boolean); 
  121.    --  <internal> 
  122.    --  Sets the Element_Pointers_Allocation 
  123.    --  </internal> 
  124.  
  125.  
  126.    function Get_Maximum 
  127.      (Self : not null access constant Sequence) return Index_Type; 
  128.    --  <dref>FooSeq_get_maximum</dref> 
  129.    --  <internal> 
  130.    --  Get the current maximum of the sequence. 
  131.    --  </internal> 
  132.  
  133.    procedure Set_Maximum (Self    : not null access Sequence; 
  134.                           New_Max : in Index_Type); 
  135.    --  <dref>FooSeq_set_maximum</dref> 
  136.    --  <internal> 
  137.    --  Resize this sequence to a new desired maximum. 
  138.    --  </internal> 
  139.  
  140.    function Get_Length 
  141.      (Self : not null access constant Sequence) return Index_Type; 
  142.    --  <dref>FooSeq_get_length</dref> 
  143.    --  <internal> 
  144.    --  Get the sequence length. 
  145.    --  </internal> 
  146.  
  147.    procedure Set_Length (Self       : not null access Sequence; 
  148.                          New_Length : in Index_Type); 
  149.    --  <dref>FooSeq_set_length</dref> 
  150.    --  <internal> 
  151.    --  Change the length of this sequence. 
  152.    --  Will raise Constraint_Error if new length exceeds Max_Length. 
  153.    --  </internal> 
  154.  
  155.    procedure Ensure_Length (Self   : not null access Sequence; 
  156.                             Length : in Index_Type; 
  157.                             Max    : in Index_Type); 
  158.    --  <dref>FooSeq_ensure_length</dref> 
  159.    --  <internal> 
  160.    --  Set the sequence to the desired length, 
  161.    --  and resize the sequence if necessary. 
  162.    --  Raise 
  163.    --    Program_Error On Illegal use 
  164.    --    Storage_Error if no memory is avalible. 
  165.    --  </internal> 
  166.  
  167.  
  168.  
  169.    procedure Copy_No_Alloc (Self : not null access Sequence; 
  170.                             Src  : not null access constant Sequence); 
  171.    --  <dref>FooSeq_copy_no_alloc</dref> 
  172.    --  <internal> 
  173.    --  Copy elements from another sequence, 
  174.    --  only if the destination sequence has enough capacity. 
  175.    --  </internal> 
  176.  
  177.    procedure Copy (Self : not null access Sequence; 
  178.                    Src  : not null access constant Sequence); 
  179.    --  <dref>FooSeq_copy</dref> 
  180.    --  <internal> 
  181.    --  Copy elements from another sequence, resizing the sequence if necessary. 
  182.    --  </internal> 
  183.  
  184.    procedure From_Array (Self : not null access Sequence; 
  185.                          Src  : in Element_Array); 
  186.    --  <dref>FooSeq_from_array</dref> 
  187.    --  <internal> 
  188.    --  Copy elements from an array of elements, 
  189.    --  resizing the sequence if necessary. 
  190.    --  The original contents of the sequence (if any) are replaced. 
  191.    --  </internal> 
  192.  
  193.    procedure To_Array (Self   : not null access constant Sequence; 
  194.                        Target : out Element_Array); 
  195.    --  <dref>FooSeq_to_array</dref> 
  196.    --  <internal> 
  197.    --  Copy elements to an array of elements. 
  198.    --  The original contents of the array (if any) are replaced. 
  199.    --  Raises constraint error if the target array is to small. 
  200.    --  </internal> 
  201.  
  202.    function To_Array 
  203.      (Self : not null access constant Sequence) return Element_Array; 
  204.    --  Convert elements to an array of elements. 
  205.  
  206.    procedure Loan_Contiguous (Self       : not null access Sequence; 
  207.                               Buffer     : not null access Element_Array; 
  208.                               New_Length : in Index_Type; 
  209.                               New_Max    : in Index_Type); 
  210.    --  <dref>FooSeq_loan_contiguous</dref> 
  211.    --  <internal> 
  212.    --  Loan a contiguous buffer to this sequence. 
  213.    --  </internal> 
  214.  
  215.    procedure Loan_Discontiguous (Self       : access Sequence; 
  216.                                  Buffer     : not null access Element_Access; 
  217.                                  New_Length : in Index_Type; 
  218.                                  New_Max    : in Index_Type); 
  219.    --  <dref>FooSeq_loan_discontiguous</dref> 
  220.    --  <internal> 
  221.    --  Loan a discontiguous buffer to this sequence. 
  222.    --  </internal> 
  223.  
  224.    procedure Unloan  (Self : not null access Sequence); 
  225.    --  <dref>FooSeq_unloan</dref> 
  226.    --  <internal> 
  227.    --  Return the loaned buffer in the sequence. 
  228.    --  </internal> 
  229.  
  230.    function Has_Ownership 
  231.      (Self : not null access constant Sequence) return Boolean; 
  232.    --  <dref>FooSeq_has_ownership</dref> 
  233.    --  <internal> 
  234.    --  The value of the owned flag. 
  235.    --  </internal> 
  236.  
  237.    procedure Finalize (Self : not null access Sequence); 
  238.    --  <dref>FooSeq_delete</dref> 
  239.    --  <internal> 
  240.    --  Deallocate this sequence's buffer. 
  241.    --  </internal> 
  242.  
  243.    SEQUENCE_UNINITIALIZED : exception; 
  244.    SEQUENCE_ERROR : exception; 
  245.  
  246.  
  247.    --  ------------------------------------------------------------------------- 
  248.    --   Implementation routines for internal use only 
  249.    --   It could not be placed in the private part since it to be used by 
  250.    --   packages in the herachy DDS 
  251.    --  ------------------------------------------------------------------------- 
  252.  
  253.  
  254.  
  255.  
  256.    DEFAULT_SEQUENCE : aliased constant Sequence := 
  257.      (Owned => True, 
  258.       Contiguous_Buffer => null, 
  259.       Discontiguous_Buffer => null, 
  260.       Maximum              => 0, 
  261.       Length               => 0, 
  262.       Sequence_Init        => SEQUENCE_MAGIC_NUMBER, 
  263.       Read_Token1          => System.Null_Address, 
  264.       Read_Token2          => System.Null_Address, 
  265.       ElementPointersAllocation => (1, 1, 1), 
  266.       ElementDeallocParams => (1, 1)); 
  267.  
  268.    procedure Check_InvariantsI 
  269.      (Self             : not null access constant Sequence; 
  270.       Calling_Function : Standard.String := GNAT.Source_Info.Enclosing_Entity); 
  271.    procedure Check_InitI (Self : not null access constant Sequence); 
  272.  
  273.    procedure Copy_No_AllocI (Self : not null access Sequence; 
  274.                              Src  : not null access constant Sequence); 
  275.  
  276.    procedure Get_Read_TokenI (Self   : not null access constant Sequence; 
  277.                               Token1 : not null access System.Address; 
  278.                               Token2 : not null access System.Address); 
  279.  
  280.    procedure Set_Read_TokenI (Self   : not null access Sequence; 
  281.                               Token1 : in System.Address; 
  282.                               Token2 : in System.Address); 
  283.  
  284.    function Get_Contiguous_BufferI  (Self : not null access constant Sequence) 
  285.                                      return access Memory_Element_Array; 
  286.    --  <dref>FooSeq_get_contiguous_buffer</dref> 
  287.  
  288.    function Get_DisContiguous_BufferI (Self : not null access constant Sequence) 
  289.                                        return access Memory_Element_Pointer; 
  290.    --  <dref>FooSeq_get_discontiguous_buffer</dref> 
  291.  
  292. end DDS_Support.Sequences_Generic;