Natools

Check-in [3b9912ed66]
Login

Check-in [3b9912ed66]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add pragma Preelaborable_Initialization throughout the code
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 3b9912ed6605a9ac16c9421c5fb20fd52fd36ae5
User & Date: nat 2014-07-19 18:27:21.324
Context
2014-07-20
19:03
sxcat: new tool to concatenate and pretty-print S-expressions check-in: 7fadcee47a user: nat tags: trunk
2014-07-19
18:27
Add pragma Preelaborable_Initialization throughout the code check-in: 3b9912ed66 user: nat tags: trunk
2014-07-18
17:35
references__intel: new intel-specific task-safe variant of Natools.References check-in: ca01910925 user: nat tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/natools-accumulators-string_accumulator_linked_lists.ads.
︙︙
25
26
27
28
29
30
31

32
33
34
35
36
37
38

package Natools.Accumulators.String_Accumulator_Linked_Lists is
   pragma Preelaborate (String_Accumulator_Linked_Lists);

   type String_Accumulator_Linked_List
     (Build : not null access function (Depth : Positive)
                              return String_Accumulator'Class)
      is new String_Accumulator_Stack with private;


   procedure Append (To   : in out String_Accumulator_Linked_List;
                     Text : String);
      --  Append the given String to the internal buffer

   procedure Hard_Reset (Acc : in out String_Accumulator_Linked_List);
      --  Empty the internal buffer and free all possible memory








>








25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

package Natools.Accumulators.String_Accumulator_Linked_Lists is
   pragma Preelaborate (String_Accumulator_Linked_Lists);

   type String_Accumulator_Linked_List
     (Build : not null access function (Depth : Positive)
                              return String_Accumulator'Class)
      is new String_Accumulator_Stack with private;
   pragma Preelaborable_Initialization (String_Accumulator_Linked_List);

   procedure Append (To   : in out String_Accumulator_Linked_List;
                     Text : String);
      --  Append the given String to the internal buffer

   procedure Hard_Reset (Acc : in out String_Accumulator_Linked_List);
      --  Empty the internal buffer and free all possible memory
︙︙
Changes to src/natools-cron.ads.
︙︙
42
43
44
45
46
47
48

49
50
51
52
53
54
55

   type Periodic_Time is record
      Origin : Ada.Calendar.Time;
      Period : Duration;
   end record;


   type Cron_Entry is tagged limited private;


   function Create
     (Time : in Periodic_Time;
      Callback : in Cron.Callback'Class)
     return Cron_Entry;
      --  Create a new entry with the given parameters









>








42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

   type Periodic_Time is record
      Origin : Ada.Calendar.Time;
      Period : Duration;
   end record;


   type Cron_Entry is tagged limited private;
   pragma Preelaborable_Initialization (Cron_Entry);

   function Create
     (Time : in Periodic_Time;
      Callback : in Cron.Callback'Class)
     return Cron_Entry;
      --  Create a new entry with the given parameters
︙︙
Changes to src/natools-references__intel.ads.
︙︙
42
43
44
45
46
47
48

49
50
51
52
53
54
55

     limited private;

   type Data_Access is access Held_Data;
   for Data_Access'Storage_Pool use Data_Pool;


   type Immutable_Reference is new Ada.Finalization.Controlled with private;


   function Create
     (Constructor : not null access function return Held_Data)
      return Immutable_Reference;
      --  Create a new held object and return a reference to it

   procedure Replace








>








42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

     limited private;

   type Data_Access is access Held_Data;
   for Data_Access'Storage_Pool use Data_Pool;


   type Immutable_Reference is new Ada.Finalization.Controlled with private;
   pragma Preelaborable_Initialization (Immutable_Reference);

   function Create
     (Constructor : not null access function return Held_Data)
      return Immutable_Reference;
      --  Create a new held object and return a reference to it

   procedure Replace
︙︙
85
86
87
88
89
90
91

92
93
94
95
96
97
98

      Process : not null access procedure (Object : in Held_Data));
      --  Call Process with the held object

   Null_Immutable_Reference : constant Immutable_Reference;


   type Reference is new Immutable_Reference with private;


   function Update (Ref : in Reference) return Mutator;
   pragma Inline (Update);
      --  Return a ereferenciable mutable access to the held object

   procedure Update
     (Ref : in Reference;








>








86
87
88
89
90
91
92
93
94
95
96
97
98
99
100

      Process : not null access procedure (Object : in Held_Data));
      --  Call Process with the held object

   Null_Immutable_Reference : constant Immutable_Reference;


   type Reference is new Immutable_Reference with private;
   pragma Preelaborable_Initialization (Reference);

   function Update (Ref : in Reference) return Mutator;
   pragma Inline (Update);
      --  Return a ereferenciable mutable access to the held object

   procedure Update
     (Ref : in Reference;
︙︙
Changes to src/natools-references__protected.ads.
︙︙
40
41
42
43
44
45
46

47
48
49
50
51
52
53

     limited private;

   type Data_Access is access Held_Data;
   for Data_Access'Storage_Pool use Data_Pool;


   type Immutable_Reference is new Ada.Finalization.Controlled with private;


   function Create
     (Constructor : not null access function return Held_Data)
      return Immutable_Reference;
      --  Create a new held object and return a reference to it

   procedure Replace








>








40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

     limited private;

   type Data_Access is access Held_Data;
   for Data_Access'Storage_Pool use Data_Pool;


   type Immutable_Reference is new Ada.Finalization.Controlled with private;
   pragma Preelaborable_Initialization (Immutable_Reference);

   function Create
     (Constructor : not null access function return Held_Data)
      return Immutable_Reference;
      --  Create a new held object and return a reference to it

   procedure Replace
︙︙
83
84
85
86
87
88
89

90
91
92
93
94
95
96

      Process : not null access procedure (Object : in Held_Data));
      --  Call Process with the held object

   Null_Immutable_Reference : constant Immutable_Reference;


   type Reference is new Immutable_Reference with private;


   function Update (Ref : in Reference) return Mutator;
   pragma Inline (Update);
      --  Return a ereferenciable mutable access to the held object

   procedure Update
     (Ref : in Reference;








>








84
85
86
87
88
89
90
91
92
93
94
95
96
97
98

      Process : not null access procedure (Object : in Held_Data));
      --  Call Process with the held object

   Null_Immutable_Reference : constant Immutable_Reference;


   type Reference is new Immutable_Reference with private;
   pragma Preelaborable_Initialization (Reference);

   function Update (Ref : in Reference) return Mutator;
   pragma Inline (Update);
      --  Return a ereferenciable mutable access to the held object

   procedure Update
     (Ref : in Reference;
︙︙
Changes to src/natools-references__unsafe.ads.
︙︙
39
40
41
42
43
44
45

46
47
48
49
50
51
52

     limited private;

   type Data_Access is access Held_Data;
   for Data_Access'Storage_Pool use Data_Pool;


   type Immutable_Reference is new Ada.Finalization.Controlled with private;


   function Create
     (Constructor : not null access function return Held_Data)
      return Immutable_Reference;
      --  Create a new held object and return a reference to it

   procedure Replace








>








39
40
41
42
43
44
45
46
47
48
49
50
51
52
53

     limited private;

   type Data_Access is access Held_Data;
   for Data_Access'Storage_Pool use Data_Pool;


   type Immutable_Reference is new Ada.Finalization.Controlled with private;
   pragma Preelaborable_Initialization (Immutable_Reference);

   function Create
     (Constructor : not null access function return Held_Data)
      return Immutable_Reference;
      --  Create a new held object and return a reference to it

   procedure Replace
︙︙
82
83
84
85
86
87
88

89
90
91
92
93
94
95

      Process : not null access procedure (Object : in Held_Data));
      --  Call Process with the held object

   Null_Immutable_Reference : constant Immutable_Reference;


   type Reference is new Immutable_Reference with private;


   function Update (Ref : in Reference) return Mutator;
   pragma Inline (Update);
      --  Return a ereferenciable mutable access to the held object

   procedure Update
     (Ref : in Reference;








>








83
84
85
86
87
88
89
90
91
92
93
94
95
96
97

      Process : not null access procedure (Object : in Held_Data));
      --  Call Process with the held object

   Null_Immutable_Reference : constant Immutable_Reference;


   type Reference is new Immutable_Reference with private;
   pragma Preelaborable_Initialization (Reference);

   function Update (Ref : in Reference) return Mutator;
   pragma Inline (Update);
      --  Return a ereferenciable mutable access to the held object

   procedure Update
     (Ref : in Reference;
︙︙
Changes to src/natools-s_expressions-atom_buffers.ads.
︙︙
24
25
26
27
28
29
30

31
32
33
34
35
36
37


with Natools.S_Expressions.Atom_Refs;

package Natools.S_Expressions.Atom_Buffers is
   pragma Preelaborate (Atom_Buffers);

   type Atom_Buffer is tagged private;


   procedure Preallocate (Buffer : in out Atom_Buffer; Length : in Count);
      --  Preallocate enough memory to append Length octets without
      --  any further allocation.

   procedure Append (Buffer : in out Atom_Buffer; Data : in Atom);
   procedure Append (Buffer : in out Atom_Buffer; Data : in Octet);








>








24
25
26
27
28
29
30
31
32
33
34
35
36
37
38


with Natools.S_Expressions.Atom_Refs;

package Natools.S_Expressions.Atom_Buffers is
   pragma Preelaborate (Atom_Buffers);

   type Atom_Buffer is tagged private;
   pragma Preelaborable_Initialization (Atom_Buffer);

   procedure Preallocate (Buffer : in out Atom_Buffer; Length : in Count);
      --  Preallocate enough memory to append Length octets without
      --  any further allocation.

   procedure Append (Buffer : in out Atom_Buffer; Data : in Atom);
   procedure Append (Buffer : in out Atom_Buffer; Data : in Octet);
︙︙
Changes to src/natools-s_expressions-dynamic_interpreters.ads.
︙︙
61
62
63
64
65
66
67

68
69
70
71
72
73
74


   type Null_Command is new Command with null record;

   Do_Nothing : Null_Command := Null_Command'(null record);


   type Interpreter is new Command with private;


   procedure Add_Command
     (Self : in out Interpreter;
      Name : in Atom;
      Cmd : in Command'Class);

   procedure Add








>








61
62
63
64
65
66
67
68
69
70
71
72
73
74
75


   type Null_Command is new Command with null record;

   Do_Nothing : Null_Command := Null_Command'(null record);


   type Interpreter is new Command with private;
   pragma Preelaborable_Initialization (Interpreter);

   procedure Add_Command
     (Self : in out Interpreter;
      Name : in Atom;
      Cmd : in Command'Class);

   procedure Add
︙︙
Changes to src/natools-s_expressions-generic_caches.ads.
︙︙
40
41
42
43
44
45
46

47
48
49
50
51
52
53
54
55
56
57

58
59
60
61
62
63
64

   Counter_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class;
   Structure_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class;

package Natools.S_Expressions.Generic_Caches is
   pragma Preelaborate (Generic_Caches);

   type Reference is new Printers.Printer with private;


   overriding procedure Open_List (Output : in out Reference);
   overriding procedure Append_Atom
     (Output : in out Reference; Data : in Atom);
   overriding procedure Close_List (Output : in out Reference);

   function Duplicate (Cache : Reference) return Reference;
      --  Create a new copy of the S-expression held in Cache and return it


   type Cursor is new Lockable.Descriptor with private;


   overriding function Current_Event (Object : in Cursor) return Events.Event;
   overriding function Current_Atom (Object : in Cursor) return Atom;
   overriding function Current_Level (Object : in Cursor) return Natural;
   overriding procedure Query_Atom
     (Object : in Cursor;
      Process : not null access procedure (Data : in Atom));








>











>








40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

   Counter_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class;
   Structure_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class;

package Natools.S_Expressions.Generic_Caches is
   pragma Preelaborate (Generic_Caches);

   type Reference is new Printers.Printer with private;
   pragma Preelaborable_Initialization (Reference);

   overriding procedure Open_List (Output : in out Reference);
   overriding procedure Append_Atom
     (Output : in out Reference; Data : in Atom);
   overriding procedure Close_List (Output : in out Reference);

   function Duplicate (Cache : Reference) return Reference;
      --  Create a new copy of the S-expression held in Cache and return it


   type Cursor is new Lockable.Descriptor with private;
   pragma Preelaborable_Initialization (Cursor);

   overriding function Current_Event (Object : in Cursor) return Events.Event;
   overriding function Current_Atom (Object : in Cursor) return Atom;
   overriding function Current_Level (Object : in Cursor) return Natural;
   overriding procedure Query_Atom
     (Object : in Cursor;
      Process : not null access procedure (Data : in Atom));
︙︙
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154


   type Reference is new Printers.Printer with record
      Exp : Trees.Reference;
   end record;


   type Cursor is new Lockable.Descriptor with record
      Exp : Trees.Reference := Trees.Null_Reference;
      Position : Node_Access := null;
      Opening : Boolean := False;
      Stack : Lockable.Lock_Stack;
      Locked : Boolean := False;
   end record;

   function Absolute_Level (Object : Cursor) return Natural;

end Natools.S_Expressions.Generic_Caches;








|










140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156


   type Reference is new Printers.Printer with record
      Exp : Trees.Reference;
   end record;


   type Cursor is new Lockable.Descriptor with record
      Exp : Trees.Reference;
      Position : Node_Access := null;
      Opening : Boolean := False;
      Stack : Lockable.Lock_Stack;
      Locked : Boolean := False;
   end record;

   function Absolute_Level (Object : Cursor) return Natural;

end Natools.S_Expressions.Generic_Caches;
Changes to src/natools-s_expressions-interpreters.ads.
︙︙
63
64
65
66
67
68
69

70
71
72
73
74
75
76


   type Null_Command is new Command with null record;

   Do_Nothing : Null_Command := Null_Command'(null record);


   type Interpreter is new Command with private;


   procedure Add_Command
     (Self : in out Interpreter;
      Name : in Atom;
      Cmd : in Command'Class);

   procedure Add








>








63
64
65
66
67
68
69
70
71
72
73
74
75
76
77


   type Null_Command is new Command with null record;

   Do_Nothing : Null_Command := Null_Command'(null record);


   type Interpreter is new Command with private;
   pragma Preelaborable_Initialization (Interpreter);

   procedure Add_Command
     (Self : in out Interpreter;
      Name : in Atom;
      Cmd : in Command'Class);

   procedure Add
︙︙
114
115
116
117
118
119
120


121
122
123
124
125
126
127

     (Self : in Interpreter;
      State : in out Shared_State;
      Context : in Shared_Context;
      Cmd : in out Lockable.Descriptor'Class);
      --  Execute a single command with arguments

   type Command_Description is private;


   type Command_Array is array (Positive range <>) of Command_Description;

   function Build (Commands : Command_Array) return Interpreter;
   function Build (Commands : Command_Array; Fallback : String)
     return Interpreter;
   function Item (Name : String; Cmd : Command'Class)
     return Command_Description;








>
>








115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

     (Self : in Interpreter;
      State : in out Shared_State;
      Context : in Shared_Context;
      Cmd : in out Lockable.Descriptor'Class);
      --  Execute a single command with arguments

   type Command_Description is private;
   pragma Preelaborable_Initialization (Command_Description);

   type Command_Array is array (Positive range <>) of Command_Description;

   function Build (Commands : Command_Array) return Interpreter;
   function Build (Commands : Command_Array; Fallback : String)
     return Interpreter;
   function Item (Name : String; Cmd : Command'Class)
     return Command_Description;
︙︙
Changes to src/natools-s_expressions-lockable.ads.
︙︙
25
26
27
28
29
30
31

32

33
34
35
36
37
38
39

-- call.                                                                    --
------------------------------------------------------------------------------

package Natools.S_Expressions.Lockable is
   pragma Pure (Lockable);

   type Lock_Stack is private;

   type Lock_State is private;


   procedure Push_Level
     (Stack : in out Lock_Stack;
      Level : in Natural;
      State : out Lock_State);
      --  Insert Level on top of Stack and return current State









>

>








25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

-- call.                                                                    --
------------------------------------------------------------------------------

package Natools.S_Expressions.Lockable is
   pragma Pure (Lockable);

   type Lock_Stack is private;
   pragma Preelaborable_Initialization (Lock_Stack);
   type Lock_State is private;
   pragma Preelaborable_Initialization (Lock_State);

   procedure Push_Level
     (Stack : in out Lock_Stack;
      Level : in Natural;
      State : out Lock_State);
      --  Insert Level on top of Stack and return current State
︙︙
69
70
71
72
73
74
75

76
77
78
79
80
81
82

     is abstract;
      --  Undo the effects of previous Lock call, and unwind Object until the
      --  end of locked level (unless Finish is False).


   type Wrapper (Backend : access S_Expressions.Descriptor'Class)
     is new Descriptor with private;

      --  Wrapper layer on top of a non-lockable object, albeit with the
      --  performance penalty of an extra layer.

   function Current_Event (Object : in Wrapper) return Events.Event;
   function Current_Atom (Object : in Wrapper) return Atom;
   function Current_Level (Object : in Wrapper) return Natural;
   procedure Query_Atom








>








71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

     is abstract;
      --  Undo the effects of previous Lock call, and unwind Object until the
      --  end of locked level (unless Finish is False).


   type Wrapper (Backend : access S_Expressions.Descriptor'Class)
     is new Descriptor with private;
   pragma Preelaborable_Initialization (Wrapper);
      --  Wrapper layer on top of a non-lockable object, albeit with the
      --  performance penalty of an extra layer.

   function Current_Event (Object : in Wrapper) return Events.Event;
   function Current_Atom (Object : in Wrapper) return Atom;
   function Current_Level (Object : in Wrapper) return Natural;
   procedure Query_Atom
︙︙
Changes to src/natools-s_expressions-parsers.ads.
︙︙
29
30
31
32
33
34
35

36
37
38
39
40
41
42

with Natools.S_Expressions.Atom_Buffers;
with Natools.S_Expressions.Lockable;

package Natools.S_Expressions.Parsers is
   pragma Preelaborate (Natools.S_Expressions.Parsers);

   type Parser is abstract limited new Lockable.Descriptor with private;


   procedure Read_More
     (Self : in out Parser;
      Buffer : out Atom_Buffers.Atom_Buffer)
     is abstract;
      --  Read data to be parsed.
      --  Leaving the buffer empty signals end of input stream.








>








29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

with Natools.S_Expressions.Atom_Buffers;
with Natools.S_Expressions.Lockable;

package Natools.S_Expressions.Parsers is
   pragma Preelaborate (Natools.S_Expressions.Parsers);

   type Parser is abstract limited new Lockable.Descriptor with private;
   pragma Preelaborable_Initialization (Parser);

   procedure Read_More
     (Self : in out Parser;
      Buffer : out Atom_Buffers.Atom_Buffer)
     is abstract;
      --  Read data to be parsed.
      --  Leaving the buffer empty signals end of input stream.
︙︙
68
69
70
71
72
73
74

75
76
77
78
79
80
81

      State : in out Lockable.Lock_State;
      Finish : in Boolean := True);



   type Stream_Parser (Input : access Ada.Streams.Root_Stream_Type'Class) is
     limited new Lockable.Descriptor with private;


private

   type Internal_State is
     (Waiting,          --  waiting for a marker
      Base64_Atom,      --  reading an atom encoded in base 64
      Base64_Expr,      --  reading an expression encoded in base 64








>








69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

      State : in out Lockable.Lock_State;
      Finish : in Boolean := True);



   type Stream_Parser (Input : access Ada.Streams.Root_Stream_Type'Class) is
     limited new Lockable.Descriptor with private;
   pragma Preelaborable_Initialization (Stream_Parser);

private

   type Internal_State is
     (Waiting,          --  waiting for a marker
      Base64_Atom,      --  reading an atom encoded in base 64
      Base64_Expr,      --  reading an expression encoded in base 64
︙︙
Changes to src/natools-s_expressions-printers-pretty.ads.
︙︙
57
58
59
60
61
62
63

64
65
66
67
68
69
70

   end record;
      --  Default values yield canonical encoding, though fields marked with
      --  an asterisk (*) can have any value and still be canonical.

   Canonical : constant Parameters := (others => <>);

   type Printer is abstract limited new Printers.Printer with private;


   procedure Write_Raw
     (Output : in out Printer;
      Data : in Ada.Streams.Stream_Element_Array)
     is abstract;

   overriding procedure Open_List (Output : in out Printer);








>








57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

   end record;
      --  Default values yield canonical encoding, though fields marked with
      --  an asterisk (*) can have any value and still be canonical.

   Canonical : constant Parameters := (others => <>);

   type Printer is abstract limited new Printers.Printer with private;
   pragma Preelaborable_Initialization (Printer);

   procedure Write_Raw
     (Output : in out Printer;
      Data : in Ada.Streams.Stream_Element_Array)
     is abstract;

   overriding procedure Open_List (Output : in out Printer);
︙︙
Changes to src/natools-string_slices-slice_sets.ads.
︙︙
28
29
30
31
32
33
34

35
36
37
38
39
40
41


private with Ada.Containers.Ordered_Sets;

package Natools.String_Slices.Slice_Sets is
   pragma Preelaborate (Slice_Sets);

   type Slice_Set is tagged private;



   ----------------------------
   -- Conversion subprograms --
   ----------------------------

   function To_Slice (S : Slice_Set) return Slice;








>








28
29
30
31
32
33
34
35
36
37
38
39
40
41
42


private with Ada.Containers.Ordered_Sets;

package Natools.String_Slices.Slice_Sets is
   pragma Preelaborate (Slice_Sets);

   type Slice_Set is tagged private;
   pragma Preelaborable_Initialization (Slice_Set);


   ----------------------------
   -- Conversion subprograms --
   ----------------------------

   function To_Slice (S : Slice_Set) return Slice;
︙︙
Changes to src/natools-string_slices.ads.
︙︙
63
64
65
66
67
68
69

70
71
72
73
74
75
76



   ----------------
   -- Slice type --
   ----------------

   type Slice is tagged private;


   Null_Slice : constant Slice;


   --------------------------
   -- Conversion functions --
   --------------------------








>








63
64
65
66
67
68
69
70
71
72
73
74
75
76
77



   ----------------
   -- Slice type --
   ----------------

   type Slice is tagged private;
   pragma Preelaborable_Initialization (Slice);

   Null_Slice : constant Slice;


   --------------------------
   -- Conversion functions --
   --------------------------
︙︙