OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2014-01-20  Yannick Moy  <moy@adacore.com>

	* gnat1drv.adb (Gnat1drv): Call Write_ALI with Object=True in GNATprove
	mode.

2014-01-20  Pascal Obry  <obry@adacore.com>

	* 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
This commit is contained in:
Arnaud Charlet 2014-01-20 14:54:43 +01:00
parent 0bd75e44cd
commit c093d3cce4
4 changed files with 110 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/ada/ChangeLog
View File

@ -1,3 +1,15 @@
2014-01-20 Yannick Moy <moy@adacore.com>
* gnat1drv.adb (Gnat1drv): Call Write_ALI with Object=True in GNATprove
mode.
2014-01-20 Pascal Obry <obry@adacore.com>
* 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 <charlet@adacore.com> 2014-01-20 Arnaud Charlet <charlet@adacore.com>
* sem_prag.adb (Process_Import_Or_Interface): In * sem_prag.adb (Process_Import_Or_Interface): In

133
gcc/ada/g-arrspl.adb
View File

@ -39,9 +39,6 @@ package body GNAT.Array_Split is
procedure Free is procedure Free is
new Ada.Unchecked_Deallocation (Separators_Indexes, Indexes_Access); new Ada.Unchecked_Deallocation (Separators_Indexes, Indexes_Access);
procedure Free is
new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access);
function Count function Count
(Source : Element_Sequence; (Source : Element_Sequence;
Pattern : Element_Set) return Natural; Pattern : Element_Set) return Natural;
@ -54,7 +51,7 @@ package body GNAT.Array_Split is
procedure Adjust (S : in out Slice_Set) is procedure Adjust (S : in out Slice_Set) is
begin begin
S.Ref_Counter.all := S.Ref_Counter.all + 1; S.D.Ref_Counter := S.D.Ref_Counter + 1;
end Adjust; end Adjust;
------------ ------------
@ -81,10 +78,11 @@ package body GNAT.Array_Split is
Separators : Element_Set; Separators : Element_Set;
Mode : Separator_Mode := Single) Mode : Separator_Mode := Single)
is is
Result : Slice_Set;
begin begin
Free (S.Source); Result.D.Source := new Element_Sequence'(From);
S.Source := new Element_Sequence'(From); Set (Result, Separators, Mode);
Set (S, Separators, Mode); S := Result;
end Create; end Create;
----------- -----------
@ -116,23 +114,23 @@ package body GNAT.Array_Split is
new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access); new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access);
procedure Free is 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 begin
-- Ensure call is idempotent -- Ensure call is idempotent
S.Ref_Counter := null; S.D := null;
if Ref_Counter /= null then if D /= null then
Ref_Counter.all := Ref_Counter.all - 1; D.Ref_Counter := D.Ref_Counter - 1;
if Ref_Counter.all = 0 then if D.Ref_Counter = 0 then
Free (S.Source); Free (D.Source);
Free (S.Indexes); Free (D.Indexes);
Free (S.Slices); Free (D.Slices);
Free (Ref_Counter); Free (D);
end if; end if;
end if; end if;
end Finalize; end Finalize;
@ -143,7 +141,7 @@ package body GNAT.Array_Split is
procedure Initialize (S : in out Slice_Set) is procedure Initialize (S : in out Slice_Set) is
begin begin
S.Ref_Counter := new Natural'(1); S.D := new Data'(1, null, 0, null, null);
end Initialize; end Initialize;
---------------- ----------------
@ -155,11 +153,11 @@ package body GNAT.Array_Split is
Index : Slice_Number) return Slice_Separators Index : Slice_Number) return Slice_Separators
is is
begin begin
if Index > S.N_Slice then if Index > S.D.N_Slice then
raise Index_Error; raise Index_Error;
elsif Index = 0 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 then
-- Whole string, or no separator used -- Whole string, or no separator used
@ -168,15 +166,15 @@ package body GNAT.Array_Split is
elsif Index = 1 then elsif Index = 1 then
return (Before => Array_End, 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 elsif Index = S.D.N_Slice then
return (Before => S.Source (S.Slices (Index).Start - 1), return (Before => S.D.Source (S.D.Slices (Index).Start - 1),
After => Array_End); After => Array_End);
else else
return (Before => S.Source (S.Slices (Index).Start - 1), return (Before => S.D.Source (S.D.Slices (Index).Start - 1),
After => S.Source (S.Slices (Index).Stop + 1)); After => S.D.Source (S.D.Slices (Index).Stop + 1));
end if; end if;
end Separators; end Separators;
@ -186,7 +184,7 @@ package body GNAT.Array_Split is
function Separators (S : Slice_Set) return Separators_Indexes is function Separators (S : Slice_Set) return Separators_Indexes is
begin begin
return S.Indexes.all; return S.D.Indexes.all;
end Separators; end Separators;
--------- ---------
@ -211,21 +209,55 @@ package body GNAT.Array_Split is
Separators : Element_Set; Separators : Element_Set;
Mode : Separator_Mode := Single) Mode : Separator_Mode := Single)
is 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 begin
-- Free old structure Copy_On_Write (S);
Free (S.Indexes);
Free (S.Slices);
-- Compute all separator's indexes -- Compute all separator's indexes
S.Indexes := new Separators_Indexes (1 .. Count_Sep); S.D.Indexes := new Separators_Indexes (1 .. Count_Sep);
J := S.Indexes'First; J := S.D.Indexes'First;
for K in S.Source'Range loop for K in S.D.Source'Range loop
if Is_In (S.Source (K), Separators) then if Is_In (S.D.Source (K), Separators) then
S.Indexes (J) := K; S.D.Indexes (J) := K;
J := J + 1; J := J + 1;
end if; end if;
end loop; end loop;
@ -238,9 +270,9 @@ package body GNAT.Array_Split is
Start, Stop : Natural; Start, Stop : Natural;
begin begin
S.N_Slice := 0; S.D.N_Slice := 0;
Start := S.Source'First; Start := S.D.Source'First;
Stop := 0; Stop := 0;
loop loop
@ -248,16 +280,16 @@ package body GNAT.Array_Split is
-- No more separators, last slice ends at end of source string -- No more separators, last slice ends at end of source string
Stop := S.Source'Last; Stop := S.D.Source'Last;
else else
Stop := S.Indexes (K) - 1; Stop := S.D.Indexes (K) - 1;
end if; end if;
-- Add slice to the table -- Add slice to the table
S.N_Slice := S.N_Slice + 1; S.D.N_Slice := S.D.N_Slice + 1;
S_Info (S.N_Slice) := (Start, Stop); S_Info (S.D.N_Slice) := (Start, Stop);
exit when K > Count_Sep; 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 -- In this mode just set start to character next to the
-- current separator, advance the separator index. -- current separator, advance the separator index.
Start := S.Indexes (K) + 1; Start := S.D.Indexes (K) + 1;
K := K + 1; K := K + 1;
when Multiple => when Multiple =>
@ -276,16 +308,16 @@ package body GNAT.Array_Split is
-- In this mode skip separators following each other -- In this mode skip separators following each other
loop loop
Start := S.Indexes (K) + 1; Start := S.D.Indexes (K) + 1;
K := K + 1; K := K + 1;
exit when K > Count_Sep 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 loop;
end case; end case;
end loop; 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;
end Set; end Set;
@ -299,13 +331,14 @@ package body GNAT.Array_Split is
is is
begin begin
if Index = 0 then 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; raise Index_Error;
else 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 if;
end Slice; end Slice;
@ -315,7 +348,7 @@ package body GNAT.Array_Split is
function Slice_Count (S : Slice_Set) return Slice_Number is function Slice_Count (S : Slice_Set) return Slice_Number is
begin begin
return S.N_Slice; return S.D.N_Slice;
end Slice_Count; end Slice_Count;
end GNAT.Array_Split; end GNAT.Array_Split;

13
gcc/ada/g-arrspl.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- 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 Element_Access is access Element_Sequence;
type Counter is access Natural;
type Indexes_Access is access Separators_Indexes; type Indexes_Access is access Separators_Indexes;
type Slice_Info is record type Slice_Info is record
@ -172,13 +170,18 @@ private
-- All indexes for fast access to slices. In the Slice_Set we keep only -- 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. -- the original array and the indexes where each slice start and stop.
type Slice_Set is new Ada.Finalization.Controlled with record type Data is record
Ref_Counter : Counter; -- Reference counter, by-address sem Ref_Counter : Natural; -- Reference counter, by-address sem
Source : Element_Access; Source : Element_Access;
N_Slice : Slice_Number := 0; -- Number of slices found N_Slice : Slice_Number := 0; -- Number of slices found
Indexes : Indexes_Access; Indexes : Indexes_Access;
Slices : Slices_Access; Slices : Slices_Access;
end record; 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 Initialize (S : in out Slice_Set);
procedure Adjust (S : in out Slice_Set); procedure Adjust (S : in out Slice_Set);

8
gcc/ada/gnat1drv.adb
View File

@ -1257,7 +1257,13 @@ begin
Exit_Program (E_Errors); Exit_Program (E_Errors);
end if; 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 if not Compilation_Errors then