From c093d3cce4323009b79e41dadee5f4f224112924 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 20 Jan 2014 14:54:43 +0100 Subject: [PATCH] [multiple changes] 2014-01-20 Yannick Moy * gnat1drv.adb (Gnat1drv): Call Write_ALI with Object=True in GNATprove mode. 2014-01-20 Pascal Obry * g-arrspl.ads (Slice_Set): New definition (will use a copy on write scheme). * g-arrspl.adb: Adapt all routine to this new implementation. (Set): Copy the Slice_Set definition before reusing it. From-SVN: r206812 --- gcc/ada/ChangeLog | 12 ++++ gcc/ada/g-arrspl.adb | 133 +++++++++++++++++++++++++++---------------- gcc/ada/g-arrspl.ads | 13 +++-- gcc/ada/gnat1drv.adb | 8 ++- 4 files changed, 110 insertions(+), 56 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c3e5d630d16..1908f656840 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2014-01-20 Yannick Moy + + * gnat1drv.adb (Gnat1drv): Call Write_ALI with Object=True in GNATprove + mode. + +2014-01-20 Pascal Obry + + * g-arrspl.ads (Slice_Set): New definition (will use a copy on + write scheme). + * g-arrspl.adb: Adapt all routine to this new implementation. + (Set): Copy the Slice_Set definition before reusing it. + 2014-01-20 Arnaud Charlet * sem_prag.adb (Process_Import_Or_Interface): In diff --git a/gcc/ada/g-arrspl.adb b/gcc/ada/g-arrspl.adb index 9229610554f..82b42b1eba2 100644 --- a/gcc/ada/g-arrspl.adb +++ b/gcc/ada/g-arrspl.adb @@ -39,9 +39,6 @@ package body GNAT.Array_Split is procedure Free is new Ada.Unchecked_Deallocation (Separators_Indexes, Indexes_Access); - procedure Free is - new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access); - function Count (Source : Element_Sequence; Pattern : Element_Set) return Natural; @@ -54,7 +51,7 @@ package body GNAT.Array_Split is procedure Adjust (S : in out Slice_Set) is begin - S.Ref_Counter.all := S.Ref_Counter.all + 1; + S.D.Ref_Counter := S.D.Ref_Counter + 1; end Adjust; ------------ @@ -81,10 +78,11 @@ package body GNAT.Array_Split is Separators : Element_Set; Mode : Separator_Mode := Single) is + Result : Slice_Set; begin - Free (S.Source); - S.Source := new Element_Sequence'(From); - Set (S, Separators, Mode); + Result.D.Source := new Element_Sequence'(From); + Set (Result, Separators, Mode); + S := Result; end Create; ----------- @@ -116,23 +114,23 @@ package body GNAT.Array_Split is new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access); procedure Free is - new Ada.Unchecked_Deallocation (Natural, Counter); + new Ada.Unchecked_Deallocation (Data, Data_Access); - Ref_Counter : Counter := S.Ref_Counter; + D : Data_Access := S.D; begin -- Ensure call is idempotent - S.Ref_Counter := null; + S.D := null; - if Ref_Counter /= null then - Ref_Counter.all := Ref_Counter.all - 1; + if D /= null then + D.Ref_Counter := D.Ref_Counter - 1; - if Ref_Counter.all = 0 then - Free (S.Source); - Free (S.Indexes); - Free (S.Slices); - Free (Ref_Counter); + if D.Ref_Counter = 0 then + Free (D.Source); + Free (D.Indexes); + Free (D.Slices); + Free (D); end if; end if; end Finalize; @@ -143,7 +141,7 @@ package body GNAT.Array_Split is procedure Initialize (S : in out Slice_Set) is begin - S.Ref_Counter := new Natural'(1); + S.D := new Data'(1, null, 0, null, null); end Initialize; ---------------- @@ -155,11 +153,11 @@ package body GNAT.Array_Split is Index : Slice_Number) return Slice_Separators is begin - if Index > S.N_Slice then + if Index > S.D.N_Slice then raise Index_Error; elsif Index = 0 - or else (Index = 1 and then S.N_Slice = 1) + or else (Index = 1 and then S.D.N_Slice = 1) then -- Whole string, or no separator used @@ -168,15 +166,15 @@ package body GNAT.Array_Split is elsif Index = 1 then return (Before => Array_End, - After => S.Source (S.Slices (Index).Stop + 1)); + After => S.D.Source (S.D.Slices (Index).Stop + 1)); - elsif Index = S.N_Slice then - return (Before => S.Source (S.Slices (Index).Start - 1), + elsif Index = S.D.N_Slice then + return (Before => S.D.Source (S.D.Slices (Index).Start - 1), After => Array_End); else - return (Before => S.Source (S.Slices (Index).Start - 1), - After => S.Source (S.Slices (Index).Stop + 1)); + return (Before => S.D.Source (S.D.Slices (Index).Start - 1), + After => S.D.Source (S.D.Slices (Index).Stop + 1)); end if; end Separators; @@ -186,7 +184,7 @@ package body GNAT.Array_Split is function Separators (S : Slice_Set) return Separators_Indexes is begin - return S.Indexes.all; + return S.D.Indexes.all; end Separators; --------- @@ -211,21 +209,55 @@ package body GNAT.Array_Split is Separators : Element_Set; Mode : Separator_Mode := Single) is - Count_Sep : constant Natural := Count (S.Source.all, Separators); - J : Positive; + + procedure Copy_On_Write (S : in out Slice_Set); + -- Make a copy of S if shared with another variable + + ------------------- + -- Copy_On_Write -- + ------------------- + + procedure Copy_On_Write (S : in out Slice_Set) is + begin + if S.D.Ref_Counter > 1 then + -- First let's remove our count from the current data + + S.D.Ref_Counter := S.D.Ref_Counter - 1; + + -- Then duplicate the data + + S.D := new Data'(S.D.all); + S.D.Ref_Counter := 1; + + if S.D.Source /= null then + S.D.Source := new Element_Sequence'(S.D.Source.all); + S.D.Indexes := null; + S.D.Slices := null; + end if; + + else + -- If there is a single reference to this variable, free it now + -- as it will be redefined below. + + Free (S.D.Indexes); + Free (S.D.Slices); + end if; + end Copy_On_Write; + + Count_Sep : constant Natural := Count (S.D.Source.all, Separators); + J : Positive; + begin - -- Free old structure - Free (S.Indexes); - Free (S.Slices); + Copy_On_Write (S); -- Compute all separator's indexes - S.Indexes := new Separators_Indexes (1 .. Count_Sep); - J := S.Indexes'First; + S.D.Indexes := new Separators_Indexes (1 .. Count_Sep); + J := S.D.Indexes'First; - for K in S.Source'Range loop - if Is_In (S.Source (K), Separators) then - S.Indexes (J) := K; + for K in S.D.Source'Range loop + if Is_In (S.D.Source (K), Separators) then + S.D.Indexes (J) := K; J := J + 1; end if; end loop; @@ -238,9 +270,9 @@ package body GNAT.Array_Split is Start, Stop : Natural; begin - S.N_Slice := 0; + S.D.N_Slice := 0; - Start := S.Source'First; + Start := S.D.Source'First; Stop := 0; loop @@ -248,16 +280,16 @@ package body GNAT.Array_Split is -- No more separators, last slice ends at end of source string - Stop := S.Source'Last; + Stop := S.D.Source'Last; else - Stop := S.Indexes (K) - 1; + Stop := S.D.Indexes (K) - 1; end if; -- Add slice to the table - S.N_Slice := S.N_Slice + 1; - S_Info (S.N_Slice) := (Start, Stop); + S.D.N_Slice := S.D.N_Slice + 1; + S_Info (S.D.N_Slice) := (Start, Stop); exit when K > Count_Sep; @@ -268,7 +300,7 @@ package body GNAT.Array_Split is -- In this mode just set start to character next to the -- current separator, advance the separator index. - Start := S.Indexes (K) + 1; + Start := S.D.Indexes (K) + 1; K := K + 1; when Multiple => @@ -276,16 +308,16 @@ package body GNAT.Array_Split is -- In this mode skip separators following each other loop - Start := S.Indexes (K) + 1; + Start := S.D.Indexes (K) + 1; K := K + 1; exit when K > Count_Sep - or else S.Indexes (K) > S.Indexes (K - 1) + 1; + or else S.D.Indexes (K) > S.D.Indexes (K - 1) + 1; end loop; end case; end loop; - S.Slices := new Slices_Indexes'(S_Info (1 .. S.N_Slice)); + S.D.Slices := new Slices_Indexes'(S_Info (1 .. S.D.N_Slice)); end; end Set; @@ -299,13 +331,14 @@ package body GNAT.Array_Split is is begin if Index = 0 then - return S.Source.all; + return S.D.Source.all; - elsif Index > S.N_Slice then + elsif Index > S.D.N_Slice then raise Index_Error; else - return S.Source (S.Slices (Index).Start .. S.Slices (Index).Stop); + return S.D.Source + (S.D.Slices (Index).Start .. S.D.Slices (Index).Stop); end if; end Slice; @@ -315,7 +348,7 @@ package body GNAT.Array_Split is function Slice_Count (S : Slice_Set) return Slice_Number is begin - return S.N_Slice; + return S.D.N_Slice; end Slice_Count; end GNAT.Array_Split; diff --git a/gcc/ada/g-arrspl.ads b/gcc/ada/g-arrspl.ads index ac71af5a4bc..fa7e6603c14 100644 --- a/gcc/ada/g-arrspl.ads +++ b/gcc/ada/g-arrspl.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2013, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -157,8 +157,6 @@ private type Element_Access is access Element_Sequence; - type Counter is access Natural; - type Indexes_Access is access Separators_Indexes; type Slice_Info is record @@ -172,13 +170,18 @@ private -- All indexes for fast access to slices. In the Slice_Set we keep only -- the original array and the indexes where each slice start and stop. - type Slice_Set is new Ada.Finalization.Controlled with record - Ref_Counter : Counter; -- Reference counter, by-address sem + type Data is record + Ref_Counter : Natural; -- Reference counter, by-address sem Source : Element_Access; N_Slice : Slice_Number := 0; -- Number of slices found Indexes : Indexes_Access; Slices : Slices_Access; end record; + type Data_Access is access all Data; + + type Slice_Set is new Ada.Finalization.Controlled with record + D : Data_Access; + end record; procedure Initialize (S : in out Slice_Set); procedure Adjust (S : in out Slice_Set); diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 8693fd193a3..c0ebcfcb6eb 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -1257,7 +1257,13 @@ begin Exit_Program (E_Errors); end if; - Write_ALI (Object => (Back_End_Mode = Generate_Object)); + -- In GNATprove mode, an "object" file is always generated as the + -- result of calling gnat1 or gnat2why, although this is not the + -- same as the object file produced for compilation. + + Write_ALI (Object => (Back_End_Mode = Generate_Object + or else + GNATprove_Mode)); if not Compilation_Errors then