From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-0.9 required=5.0 tests=BAYES_00,FORGED_GMAIL_RCVD, FREEMAIL_FROM autolearn=no autolearn_force=no version=3.4.4 X-Google-Thread: 103376,e0e1d3b3f7c994b8 X-Google-Attributes: gid103376,public,usenet X-Google-Language: ENGLISH,ASCII-7-bit Path: g2news1.google.com!postnews.google.com!x30g2000hsd.googlegroups.com!not-for-mail From: Vadim Godunko Newsgroups: comp.lang.ada Subject: Re: Robert Dewar's great article about the Strengths of Ada over other langauges in multiprocessing! Date: Sun, 9 Mar 2008 07:41:33 -0700 (PDT) Organization: http://groups.google.com Message-ID: References: <13t4b2kkjem20f3@corp.supernews.com> <89af8399-94fb-42b3-909d-edf3c98d32e5@n75g2000hsh.googlegroups.com> <47D39DC8.20002@obry.net> <1lbnckly14ak1$.1toakcw8jw12$.dlg@40tude.net> NNTP-Posting-Host: 83.221.215.2 Mime-Version: 1.0 Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: 7bit X-Trace: posting.google.com 1205073693 11913 127.0.0.1 (9 Mar 2008 14:41:33 GMT) X-Complaints-To: groups-abuse@google.com NNTP-Posting-Date: Sun, 9 Mar 2008 14:41:33 +0000 (UTC) Complaints-To: groups-abuse@google.com Injection-Info: x30g2000hsd.googlegroups.com; posting-host=83.221.215.2; posting-account=niG3UgoAAAD7iQ3takWjEn_gw6D9X3ww User-Agent: G2/1.0 X-HTTP-UserAgent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8.1.4) Gecko/20070601 SeaMonkey/1.1.2,gzip(gfe),gzip(gfe) Xref: g2news1.google.com comp.lang.ada:20259 Date: 2008-03-09T07:41:33-07:00 List-Id: On Mar 9, 4:37 pm, "Dmitry A. Kazakov" wrote: > > It is unclear in which the context you are using protected objects. I don't > see why a protected object should be slower than, say, critical section + > operation. > I have attach all source code. Protected object used for atomic reference counting (The design may be looks strange, I just have plans to replace protected object by the inline assembler code). C++ class used inline assembler for the same. Both C++ class and Ada tagged type share internal string data. > > for J in 1 .. 1_000 loop > > if J mod 2 = 1 then > > B := A; > > Is this a deep copy? No. > What is controlled, array, elements, both? Array's elements are controlled. > What is the locking policy, per container, per element, both? Per element. ------->-8-------- private with Ada.Finalization; private with League.Internals.Atomics; package League.Strings is pragma Preelaborate; type Universal_String is tagged private; function To_Universal_String (Item : in Wide_Wide_String) return Universal_String; function To_Wide_Wide_String (Self : in Universal_String'Class) return Wide_Wide_String; function "=" (Left : in Universal_String; Right : in Universal_String) return Boolean; private type Utf16_String is new Wide_String; type Utf16_String_Access is access all Utf16_String; type Private_Data is record Counter : aliased League.Internals.Atomics.Counter; String : Utf16_String_Access; Last : Natural := 0; Length : Natural := 0; end record; type Private_Data_Access is access all Private_Data; Empty_String : aliased Utf16_String := ""; Shared_Empty : aliased Private_Data := (String => Empty_String'Access, others => <>); type Universal_String is new Ada.Finalization.Controlled with record Data : Private_Data_Access := Shared_Empty'Access; end record; overriding procedure Initialize (Self : in out Universal_String); overriding procedure Adjust (Self : in out Universal_String); overriding procedure Finalize (Self : in out Universal_String); end League.Strings; with Ada.Unchecked_Deallocation; package body League.Strings is Surrogate_First : constant := 16#D800#; High_Surrogate_First : constant := 16#D800#; High_Surrogate_Last : constant := 16#DBFF#; Low_Surrogate_First : constant := 16#DC00#; Low_Surrogate_Last : constant := 16#DFFF#; Surrogate_Last : constant := 16#DFFF#; subtype Surrogate_Wide_Character is Wide_Character range Wide_Character'Val (Surrogate_First) .. Wide_Character'Val (Surrogate_Last); subtype High_Surrogate_Wide_Character is Surrogate_Wide_Character range Wide_Character'Val (High_Surrogate_First) .. Wide_Character'Val (High_Surrogate_Last); subtype Low_Surrogate_Wide_Character is Surrogate_Wide_Character range Wide_Character'Val (Low_Surrogate_First) .. Wide_Character'Val (Low_Surrogate_Last); procedure Free is new Ada.Unchecked_Deallocation (Private_Data, Private_Data_Access); procedure Free is new Ada.Unchecked_Deallocation (Utf16_String, Utf16_String_Access); function "=" (Left : in Universal_String; Right : in Universal_String) return Boolean is begin raise Program_Error; return False; end "="; overriding procedure Adjust (Self : in out Universal_String) is begin League.Internals.Atomics.Increment (Self.Data.Counter'Access); end Adjust; overriding procedure Finalize (Self : in out Universal_String) is begin if League.Internals.Atomics.Decrement (Self.Data.Counter'Access) then pragma Assert (Self.Data /= Shared_Empty'Access); Free (Self.Data.String); Free (Self.Data); end if; end Finalize; overriding procedure Initialize (Self : in out Universal_String) is begin League.Internals.Atomics.Increment (Self.Data.Counter'Access); end Initialize; function To_Universal_String (Item : in Wide_Wide_String) return Universal_String is Aux : Utf16_String_Access := new Utf16_String (1 .. Item'Length * 2); -- Reserve memory in assumption of all character will be encoded as -- surrogate pair. Last : Natural := 0; begin for J in Item'Range loop if Item (J) > Wide_Wide_Character'Val (Code_Point'Last) or else Item (J) in Wide_Wide_Character'Val (Surrogate_First) .. Wide_Wide_Character'Val (Surrogate_Last) then raise Constraint_Error with "Wide_Wide_Character is not a valid Unicode code point"; end if; declare C : constant Code_Point := Wide_Wide_Character'Pos (Item (J)); begin if C <= 16#FFFF# then Last := Last + 1; Aux (Last) := Wide_Character'Val (C); else Last := Last + 1; Aux (Last) := Wide_Character'Val (High_Surrogate_First + C / 16#400#); Last := Last + 1; Aux (Last) := Wide_Character'Val (Low_Surrogate_First + C mod 16#400#); end if; end; end loop; return (Ada.Finalization.Controlled with Data => new Private_Data' (Counter => League.Internals.Atomics.One, String => Aux, Last => Last, Length => Item'Length)); exception when others => Free (Aux); raise; end To_Universal_String; function To_Wide_Wide_String (Self : in Universal_String'Class) return Wide_Wide_String is Current : Positive := 1; begin return Result : Wide_Wide_String (1 .. Self.Data.Length) do for J in Result'Range loop if Self.Data.String (Current) in Surrogate_Wide_Character then if Current < Self.Data.Last and then Self.Data.String (Current) in High_Surrogate_Wide_Character and then Self.Data.String (Current + 1) in Low_Surrogate_Wide_Character then Result (J) := Wide_Wide_Character'Val ((Wide_Character'Pos (Self.Data.String (Current)) - High_Surrogate_First) * 16#400# + (Wide_Character'Pos (Self.Data.String (Current + 1)) - Low_Surrogate_First) + 16#1_0000#); Current := Current + 2; else raise Constraint_Error with "Ill-formed UTF-16 string: invalid surrogate pair"; end if; else Result (J) := Wide_Wide_Character'Val (Wide_Character'Pos (Self.Data.String (Current))); Current := Current + 1; end if; end loop; pragma Assert (Current = Self.Data.Last + 1); end return; end To_Wide_Wide_String; end League.Strings; private with Interfaces.C; package League.Internals.Atomics is pragma Preelaborate; type Counter is private; Zero : constant Counter; One : constant Counter; procedure Increment (Self : not null access Counter); -- Atomicaly increment counter value. function Decrement (Self : not null access Counter) return Boolean; -- Atomicaly decrement counter value. Returns True if counter has zero -- value after decrement. private type Counter is record Value : Interfaces.C.int := 1; end record; Zero : constant Counter := (Value => 0); One : constant Counter := (Value => 1); end League.Internals.Atomics; ------------------------------------------------------------------------------ -- This is portable version of the package. ------------------------------------------------------------------------------ package body League.Internals.Atomics is protected Guard is procedure Increment (Self : not null access Counter); procedure Decrement (Self : not null access Counter; Zero : out Boolean); end Guard; function Decrement (Self : not null access Counter) return Boolean is Aux : Boolean; begin Guard.Decrement (Self, Aux); return Aux; end Decrement; protected body Guard is procedure Decrement (Self : not null access Counter; Zero : out Boolean) is use type Interfaces.C.int; begin Self.Value := Self.Value - 1; Zero := Self.Value = 0; end Decrement; procedure Increment (Self : not null access Counter) is use type Interfaces.C.int; begin Self.Value := Self.Value + 1; end Increment; end Guard; procedure Increment (Self : not null access Counter) is begin Guard.Increment (Self); end Increment; end League.Internals.Atomics; package League.Internals is pragma Pure; end League.Internals; package League is pragma Pure; type Code_Point is mod 16#11_0000#; for Code_Point'Size use 32; end League;