Index: natools.gpr ================================================================== --- natools.gpr +++ natools.gpr @@ -1,9 +1,12 @@ project Natools is type Build_Type is ("Release", "Coverage"); Mode : Build_Type := external ("MODE", "Release"); + type Task_Safety is ("None"); + Safety : Task_Safety := external ("TASK_SAFETY", "None"); + Prefix := ""; Extra_Switches := (); case Mode is when "Release" => @@ -61,6 +64,16 @@ end Compiler; package Linker is for Default_Switches ("Ada") use Extra_Switches; end Linker; + + package Naming is + case Safety is + when "None" => + for spec ("Natools.References") + use "natools-references__unsafe.ads"; + for body ("Natools.References") + use "natools-references__unsafe.adb"; + end case; + end Naming; end Natools; DELETED src/natools-references.adb Index: src/natools-references.adb ================================================================== --- src/natools-references.adb +++ src/natools-references.adb @@ -1,154 +0,0 @@ ------------------------------------------------------------------------------- --- Copyright (c) 2013-2014, Natacha Porté -- --- -- --- Permission to use, copy, modify, and distribute this software for any -- --- purpose with or without fee is hereby granted, provided that the above -- --- copyright notice and this permission notice appear in all copies. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- --- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- --- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- --- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- --- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- --- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- --- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- ------------------------------------------------------------------------------- - -with Ada.Unchecked_Deallocation; - -package body Natools.References is - - --------------------------------- - -- Low-level memory management -- - --------------------------------- - - overriding procedure Adjust (Object : in out Immutable_Reference) is - begin - if Object.Count /= null then - Object.Count.all := Object.Count.all + 1; - end if; - end Adjust; - - - overriding procedure Finalize (Object : in out Immutable_Reference) is - procedure Free is - new Ada.Unchecked_Deallocation (Held_Data, Data_Access); - procedure Free is - new Ada.Unchecked_Deallocation (Counter, Counter_Access); - begin - if Object.Count /= null then - Object.Count.all := Object.Count.all - 1; - - if Object.Count.all = 0 then - Free (Object.Count); - Free (Object.Data); - else - Object.Count := null; - Object.Data := null; - end if; - end if; - end Finalize; - - - - ----------------------------------------- - -- Object construction and destruction -- - ----------------------------------------- - - function Create - (Constructor : not null access function return Held_Data) - return Immutable_Reference is - begin - return (Ada.Finalization.Controlled with - Data => new Held_Data'(Constructor.all), - Count => new Counter'(1)); - end Create; - - - procedure Replace - (Ref : in out Immutable_Reference; - Constructor : not null access function return Held_Data) is - begin - Finalize (Ref); - Ref.Data := new Held_Data'(Constructor.all); - Ref.Count := new Counter'(1); - end Replace; - - - function Create (Data : in Data_Access) return Immutable_Reference is - begin - if Data = null then - return Null_Immutable_Reference; - else - return (Ada.Finalization.Controlled with - Data => Data, - Count => new Counter'(1)); - end if; - end Create; - - - procedure Replace - (Ref : in out Immutable_Reference; - Data : in Data_Access) is - begin - Finalize (Ref); - - if Data /= null then - Ref.Data := Data; - Ref.Count := new Counter'(1); - end if; - end Replace; - - - procedure Reset (Ref : in out Immutable_Reference) is - begin - Finalize (Ref); - end Reset; - - - function Is_Empty (Ref : Immutable_Reference) return Boolean is - begin - return Ref.Count = null; - end Is_Empty; - - - function "=" (Left, Right : Immutable_Reference) return Boolean is - begin - return Left.Data = Right.Data; - end "="; - - - - ---------------------- - -- Dereferenciation -- - ---------------------- - - function Query (Ref : in Immutable_Reference) return Accessor is - begin - return Accessor'(Data => Ref.Data, Parent => Ref); - end Query; - - - function Update (Ref : in Reference) return Mutator is - begin - return Mutator'(Data => Ref.Data, Parent => Ref); - end Update; - - - procedure Query - (Ref : in Immutable_Reference; - Process : not null access procedure (Object : in Held_Data)) is - begin - Process.all (Ref.Data.all); - end Query; - - - procedure Update - (Ref : in Reference; - Process : not null access procedure (Object : in out Held_Data)) is - begin - Process.all (Ref.Data.all); - end Update; - -end Natools.References; - DELETED src/natools-references.ads Index: src/natools-references.ads ================================================================== --- src/natools-references.ads +++ src/natools-references.ads @@ -1,135 +0,0 @@ ------------------------------------------------------------------------------- --- Copyright (c) 2013-2014, Natacha Porté -- --- -- --- Permission to use, copy, modify, and distribute this software for any -- --- purpose with or without fee is hereby granted, provided that the above -- --- copyright notice and this permission notice appear in all copies. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- --- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- --- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- --- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- --- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- --- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- --- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- ------------------------------------------------------------------------------- - ------------------------------------------------------------------------------- --- Natools.References implements reference-counted smart pointer to any -- --- type of objects. -- --- This is a basic implementation that does not support weak references or -- --- concurrency. However since there is no internal state, operations on -- --- non-overlapping objects should be thread-safe. -- ------------------------------------------------------------------------------- - -with Ada.Finalization; -with System.Storage_Pools; - -generic - type Held_Data (<>) is limited private; - Counter_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class; - Data_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class; - -package Natools.References is - pragma Preelaborate (References); - - type Accessor (Data : not null access constant Held_Data) is - limited private; - type Mutator (Data : not null access Held_Data) is - 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 - (Ref : in out Immutable_Reference; - Constructor : not null access function return Held_Data); - -- Replace the object held in Ref with a newly created object - - function Create (Data : in Data_Access) return Immutable_Reference; - -- Create a new reference from Data. - -- From this point the referred object is owned by this - -- package and must NOT be freed or changed or accessed. - - procedure Replace (Ref : in out Immutable_Reference; Data : in Data_Access); - -- Integrate Data into Ref. - -- From this point the referred object is owned by this - -- package and must NOT be freed or changed or accessed. - - procedure Reset (Ref : in out Immutable_Reference); - -- Empty Ref - - function Is_Empty (Ref : Immutable_Reference) return Boolean; - -- Check whether Ref refers to an actual object - - function "=" (Left, Right : Immutable_Reference) return Boolean; - -- Check whether Left and Right refer to the same object - - function Query (Ref : in Immutable_Reference) return Accessor; - pragma Inline (Query); - -- Return a derefenciable constant access to the held object - - procedure Query - (Ref : in Immutable_Reference; - 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; - Process : not null access procedure (Object : in out Held_Data)); - -- Call Process with the held object - - Null_Reference : constant Reference; - -private - - type Counter is new Natural; - - type Counter_Access is access Counter; - for Counter_Access'Storage_Pool use Counter_Pool; - - type Immutable_Reference is new Ada.Finalization.Controlled with record - Count : Counter_Access := null; - Data : Data_Access := null; - end record; - - overriding procedure Adjust (Object : in out Immutable_Reference); - -- Increate reference counter - - overriding procedure Finalize (Object : in out Immutable_Reference); - -- Decrease reference counter and release memory if needed - - type Reference is new Immutable_Reference with null record; - - type Accessor (Data : not null access constant Held_Data) is limited record - Parent : Immutable_Reference; - end record; - - type Mutator (Data : not null access Held_Data) is limited record - Parent : Reference; - end record; - - Null_Immutable_Reference : constant Immutable_Reference - := (Ada.Finalization.Controlled with Count => null, Data => null); - - Null_Reference : constant Reference - := (Null_Immutable_Reference with null record); - -end Natools.References; ADDED src/natools-references__unsafe.adb Index: src/natools-references__unsafe.adb ================================================================== --- src/natools-references__unsafe.adb +++ src/natools-references__unsafe.adb @@ -0,0 +1,154 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2013-2014, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +with Ada.Unchecked_Deallocation; + +package body Natools.References is + + --------------------------------- + -- Low-level memory management -- + --------------------------------- + + overriding procedure Adjust (Object : in out Immutable_Reference) is + begin + if Object.Count /= null then + Object.Count.all := Object.Count.all + 1; + end if; + end Adjust; + + + overriding procedure Finalize (Object : in out Immutable_Reference) is + procedure Free is + new Ada.Unchecked_Deallocation (Held_Data, Data_Access); + procedure Free is + new Ada.Unchecked_Deallocation (Counter, Counter_Access); + begin + if Object.Count /= null then + Object.Count.all := Object.Count.all - 1; + + if Object.Count.all = 0 then + Free (Object.Count); + Free (Object.Data); + else + Object.Count := null; + Object.Data := null; + end if; + end if; + end Finalize; + + + + ----------------------------------------- + -- Object construction and destruction -- + ----------------------------------------- + + function Create + (Constructor : not null access function return Held_Data) + return Immutable_Reference is + begin + return (Ada.Finalization.Controlled with + Data => new Held_Data'(Constructor.all), + Count => new Counter'(1)); + end Create; + + + procedure Replace + (Ref : in out Immutable_Reference; + Constructor : not null access function return Held_Data) is + begin + Finalize (Ref); + Ref.Data := new Held_Data'(Constructor.all); + Ref.Count := new Counter'(1); + end Replace; + + + function Create (Data : in Data_Access) return Immutable_Reference is + begin + if Data = null then + return Null_Immutable_Reference; + else + return (Ada.Finalization.Controlled with + Data => Data, + Count => new Counter'(1)); + end if; + end Create; + + + procedure Replace + (Ref : in out Immutable_Reference; + Data : in Data_Access) is + begin + Finalize (Ref); + + if Data /= null then + Ref.Data := Data; + Ref.Count := new Counter'(1); + end if; + end Replace; + + + procedure Reset (Ref : in out Immutable_Reference) is + begin + Finalize (Ref); + end Reset; + + + function Is_Empty (Ref : Immutable_Reference) return Boolean is + begin + return Ref.Count = null; + end Is_Empty; + + + function "=" (Left, Right : Immutable_Reference) return Boolean is + begin + return Left.Data = Right.Data; + end "="; + + + + ---------------------- + -- Dereferenciation -- + ---------------------- + + function Query (Ref : in Immutable_Reference) return Accessor is + begin + return Accessor'(Data => Ref.Data, Parent => Ref); + end Query; + + + function Update (Ref : in Reference) return Mutator is + begin + return Mutator'(Data => Ref.Data, Parent => Ref); + end Update; + + + procedure Query + (Ref : in Immutable_Reference; + Process : not null access procedure (Object : in Held_Data)) is + begin + Process.all (Ref.Data.all); + end Query; + + + procedure Update + (Ref : in Reference; + Process : not null access procedure (Object : in out Held_Data)) is + begin + Process.all (Ref.Data.all); + end Update; + +end Natools.References; + ADDED src/natools-references__unsafe.ads Index: src/natools-references__unsafe.ads ================================================================== --- src/natools-references__unsafe.ads +++ src/natools-references__unsafe.ads @@ -0,0 +1,135 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2013-2014, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.References implements reference-counted smart pointer to any -- +-- type of objects. -- +-- This is a basic implementation that does not support weak references or -- +-- concurrency. However since there is no internal state, operations on -- +-- non-overlapping objects should be thread-safe. -- +------------------------------------------------------------------------------ + +with Ada.Finalization; +with System.Storage_Pools; + +generic + type Held_Data (<>) is limited private; + Counter_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class; + Data_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class; + +package Natools.References is + pragma Preelaborate (References); + + type Accessor (Data : not null access constant Held_Data) is + limited private; + type Mutator (Data : not null access Held_Data) is + 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 + (Ref : in out Immutable_Reference; + Constructor : not null access function return Held_Data); + -- Replace the object held in Ref with a newly created object + + function Create (Data : in Data_Access) return Immutable_Reference; + -- Create a new reference from Data. + -- From this point the referred object is owned by this + -- package and must NOT be freed or changed or accessed. + + procedure Replace (Ref : in out Immutable_Reference; Data : in Data_Access); + -- Integrate Data into Ref. + -- From this point the referred object is owned by this + -- package and must NOT be freed or changed or accessed. + + procedure Reset (Ref : in out Immutable_Reference); + -- Empty Ref + + function Is_Empty (Ref : Immutable_Reference) return Boolean; + -- Check whether Ref refers to an actual object + + function "=" (Left, Right : Immutable_Reference) return Boolean; + -- Check whether Left and Right refer to the same object + + function Query (Ref : in Immutable_Reference) return Accessor; + pragma Inline (Query); + -- Return a derefenciable constant access to the held object + + procedure Query + (Ref : in Immutable_Reference; + 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; + Process : not null access procedure (Object : in out Held_Data)); + -- Call Process with the held object + + Null_Reference : constant Reference; + +private + + type Counter is new Natural; + + type Counter_Access is access Counter; + for Counter_Access'Storage_Pool use Counter_Pool; + + type Immutable_Reference is new Ada.Finalization.Controlled with record + Count : Counter_Access := null; + Data : Data_Access := null; + end record; + + overriding procedure Adjust (Object : in out Immutable_Reference); + -- Increate reference counter + + overriding procedure Finalize (Object : in out Immutable_Reference); + -- Decrease reference counter and release memory if needed + + type Reference is new Immutable_Reference with null record; + + type Accessor (Data : not null access constant Held_Data) is limited record + Parent : Immutable_Reference; + end record; + + type Mutator (Data : not null access Held_Data) is limited record + Parent : Reference; + end record; + + Null_Immutable_Reference : constant Immutable_Reference + := (Ada.Finalization.Controlled with Count => null, Data => null); + + Null_Reference : constant Reference + := (Null_Immutable_Reference with null record); + +end Natools.References; Index: tests.gpr ================================================================== --- tests.gpr +++ tests.gpr @@ -12,6 +12,14 @@ end Compiler; package Linker is for Default_Switches use Natools.Linker'Default_Switches; end Linker; + + package Naming is + case Natools.Safety is + when "None" => + for body ("Natools.References.Tools") + use "natools-references-tools__unsafe.adb"; + end case; + end Naming; end Tests; DELETED tests/natools-references-tools.adb Index: tests/natools-references-tools.adb ================================================================== --- tests/natools-references-tools.adb +++ tests/natools-references-tools.adb @@ -1,40 +0,0 @@ ------------------------------------------------------------------------------- --- Copyright (c) 2013, Natacha Porté -- --- -- --- Permission to use, copy, modify, and distribute this software for any -- --- purpose with or without fee is hereby granted, provided that the above -- --- copyright notice and this permission notice appear in all copies. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- --- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- --- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- --- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- --- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- --- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- --- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- ------------------------------------------------------------------------------- - -package body Natools.References.Tools is - - function Is_Consistent (Left, Right : Reference) return Boolean is - begin - return (Left.Data = Right.Data) = (Left.Count = Right.Count); - end Is_Consistent; - - - function Is_Valid (Ref : Reference) return Boolean is - begin - return (Ref.Data = null) = (Ref.Count = null); - end Is_Valid; - - - function Count (Ref : Reference) return Natural is - begin - if Ref.Count /= null then - return Natural (Ref.Count.all); - else - return 0; - end if; - end Count; - -end Natools.References.Tools; ADDED tests/natools-references-tools__unsafe.adb Index: tests/natools-references-tools__unsafe.adb ================================================================== --- tests/natools-references-tools__unsafe.adb +++ tests/natools-references-tools__unsafe.adb @@ -0,0 +1,40 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2013, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +package body Natools.References.Tools is + + function Is_Consistent (Left, Right : Reference) return Boolean is + begin + return (Left.Data = Right.Data) = (Left.Count = Right.Count); + end Is_Consistent; + + + function Is_Valid (Ref : Reference) return Boolean is + begin + return (Ref.Data = null) = (Ref.Count = null); + end Is_Valid; + + + function Count (Ref : Reference) return Natural is + begin + if Ref.Count /= null then + return Natural (Ref.Count.all); + else + return 0; + end if; + end Count; + +end Natools.References.Tools;