Skip to content

R
riscv-gcc-1
Commit 8b4c5f1d by Arnaud Charlet Committed by Arnaud Charlet
Options

* g-spipat.adb, a-swunau.adb, a-swunau.ads, g-spitbo.adb, 

	a-szunau.adb, a-szunau.ads, a-stunau.adb, a-stunau.ads,
	a-strunb.adb (Big_String. Big_String_Access): New type.

From-SVN: r160981
parent ed2233dc
Showing with 113 additions and 124 deletions
gcc/ada/ChangeLog
......@@ -11,6 +11,10 @@
sem_disp.adb, prepcomp.adb, par-ch7.adb, sem_elab.adb, exp_ch4.adb,
errout.ads: Update comments. Minor reformatting.
* g-spipat.adb, a-swunau.adb, a-swunau.ads, g-spitbo.adb,
a-szunau.adb, a-szunau.ads, a-stunau.adb, a-stunau.ads,
a-strunb.adb (Big_String. Big_String_Access): New type.
2010-06-18 Geert Bosch <bosch@adacore.com>
* i-forbla-darwin.adb: Include -lgnala and -lm in linker options for
......
gcc/ada/a-strunb.adb
......@@ -914,9 +914,14 @@ package body Ada.Strings.Unbounded is
function To_Unbounded_String (Source : String) return Unbounded_String is
Result : Unbounded_String;
begin
-- Do not allocate an empty string: keep the default
if Source'Length > 0 then
Result.Last := Source'Length;
Result.Reference := new String (1 .. Source'Length);
Result.Reference.all := Source;
end if;
return Result;
end To_Unbounded_String;
......@@ -924,9 +929,15 @@ package body Ada.Strings.Unbounded is
(Length : Natural) return Unbounded_String
is
Result : Unbounded_String;
begin
-- Do not allocate an empty string: keep the default
if Length > 0 then
Result.Last := Length;
Result.Reference := new String (1 .. Length);
end if;
return Result;
end To_Unbounded_String;
......
gcc/ada/a-stunau.adb
......@@ -37,11 +37,14 @@ package body Ada.Strings.Unbounded.Aux is
procedure Get_String
(U : Unbounded_String;
S : out String_Access;
S : out Big_String_Access;
L : out Natural)
is
X : aliased Big_String;
for X'Address use U.Reference.all'Address;
begin
S := U.Reference;
S := X'Unchecked_Access;
L := U.Last;
end Get_String;
......@@ -49,17 +52,6 @@ package body Ada.Strings.Unbounded.Aux is
-- Set_String --
----------------
procedure Set_String (UP : in out Unbounded_String; S : String) is
begin
if S'Length > UP.Last then
Finalize (UP);
UP.Reference := new String (1 .. S'Length);
end if;
UP.Reference (1 .. S'Length) := S;
UP.Last := S'Length;
end Set_String;
procedure Set_String (UP : in out Unbounded_String; S : String_Access) is
begin
Finalize (UP);
......
gcc/ada/a-stunau.ads
......@@ -37,9 +37,12 @@
package Ada.Strings.Unbounded.Aux is
pragma Preelaborate;
subtype Big_String is String (1 .. Positive'Last);
type Big_String_Access is access all Big_String;
procedure Get_String
(U : Unbounded_String;
S : out String_Access;
S : out Big_String_Access;
L : out Natural);
pragma Inline (Get_String);
-- This procedure returns the internal string pointer used in the
......@@ -54,18 +57,16 @@ package Ada.Strings.Unbounded.Aux is
-- referenced string returned by this call is always one, so the actual
-- string data is always accessible as S (1 .. L).
procedure Set_String (UP : in out Unbounded_String; S : String);
pragma Inline (Set_String);
-- This function sets the string contents of the referenced unbounded
-- string to the given string value. It is significantly more efficient
-- than the use of To_Unbounded_String with an assignment, since it
-- avoids the necessity of messing with finalization chains. The lower
-- bound of the string S is not required to be one.
procedure Set_String (UP : out Unbounded_String; S : String)
renames Set_Unbounded_String;
-- This function is simply a renaming of the new Ada 2005 function as shown
-- above. It is provided for historical reasons, but should be removed at
-- this stage???
procedure Set_String (UP : in out Unbounded_String; S : String_Access);
pragma Inline (Set_String);
-- This version of Set_String takes a string access value, rather than a
-- string. The lower bound of the string value is required to be one, and
-- this requirement is not checked.
-- This version of Set_Unbounded_String takes a string access value, rather
-- than a string. The lower bound of the string value is required to be
-- one, and this requirement is not checked.
end Ada.Strings.Unbounded.Aux;
gcc/ada/a-swunau.adb
......@@ -37,11 +37,14 @@ package body Ada.Strings.Wide_Unbounded.Aux is
procedure Get_Wide_String
(U : Unbounded_Wide_String;
S : out Wide_String_Access;
S : out Big_Wide_String_Access;
L : out Natural)
is
X : aliased Big_Wide_String;
for X'Address use U.Reference.all'Address;
begin
S := U.Reference;
S := X'Unchecked_Access;
L := U.Last;
end Get_Wide_String;
......@@ -51,20 +54,6 @@ package body Ada.Strings.Wide_Unbounded.Aux is
procedure Set_Wide_String
(UP : in out Unbounded_Wide_String;
S : Wide_String)
is
begin
if S'Length > UP.Last then
Finalize (UP);
UP.Reference := new Wide_String (1 .. S'Length);
end if;
UP.Reference (1 .. S'Length) := S;
UP.Last := S'Length;
end Set_Wide_String;
procedure Set_Wide_String
(UP : in out Unbounded_Wide_String;
S : Wide_String_Access)
is
begin
......
gcc/ada/a-swunau.ads
......@@ -37,9 +37,12 @@
package Ada.Strings.Wide_Unbounded.Aux is
pragma Preelaborate;
subtype Big_Wide_String is Wide_String (Positive'Range);
type Big_Wide_String_Access is access all Big_Wide_String;
procedure Get_Wide_String
(U : Unbounded_Wide_String;
S : out Wide_String_Access;
S : out Big_Wide_String_Access;
L : out Natural);
pragma Inline (Get_Wide_String);
-- This procedure returns the internal string pointer used in the
......@@ -54,10 +57,8 @@ package Ada.Strings.Wide_Unbounded.Aux is
-- referenced string returned by this call is always one, so the actual
-- string data is always accessible as S (1 .. L).
procedure Set_Wide_String
(UP : in out Unbounded_Wide_String;
S : Wide_String);
pragma Inline (Set_Wide_String);
procedure Set_Wide_String (UP : out Unbounded_Wide_String; S : Wide_String)
renames Set_Unbounded_Wide_String;
-- This function sets the string contents of the referenced unbounded
-- string to the given string value. It is significantly more efficient
-- than the use of To_Unbounded_Wide_String with an assignment, since it
......
gcc/ada/a-szunau.adb
......@@ -31,37 +31,26 @@
package body Ada.Strings.Wide_Wide_Unbounded.Aux is
--------------------
--------------------------
-- Get_Wide_Wide_String --
---------------------
--------------------------
procedure Get_Wide_Wide_String
(U : Unbounded_Wide_Wide_String;
S : out Wide_Wide_String_Access;
S : out Big_Wide_Wide_String_Access;
L : out Natural)
is
X : aliased Big_Wide_Wide_String;
for X'Address use U.Reference.all'Address;
begin
S := U.Reference;
S := X'Unchecked_Access;
L := U.Last;
end Get_Wide_Wide_String;
---------------------
--------------------------
-- Set_Wide_Wide_String --
---------------------
procedure Set_Wide_Wide_String
(UP : in out Unbounded_Wide_Wide_String;
S : Wide_Wide_String)
is
begin
if S'Length > UP.Last then
Finalize (UP);
UP.Reference := new Wide_Wide_String (1 .. S'Length);
end if;
UP.Reference (1 .. S'Length) := S;
UP.Last := S'Length;
end Set_Wide_Wide_String;
--------------------------
procedure Set_Wide_Wide_String
(UP : in out Unbounded_Wide_Wide_String;
......
gcc/ada/a-szunau.ads
......@@ -37,9 +37,12 @@
package Ada.Strings.Wide_Wide_Unbounded.Aux is
pragma Preelaborate;
subtype Big_Wide_Wide_String is Wide_Wide_String (Positive);
type Big_Wide_Wide_String_Access is access all Big_Wide_Wide_String;
procedure Get_Wide_Wide_String
(U : Unbounded_Wide_Wide_String;
S : out Wide_Wide_String_Access;
S : out Big_Wide_Wide_String_Access;
L : out Natural);
pragma Inline (Get_Wide_Wide_String);
-- This procedure returns the internal string pointer used in the
......@@ -55,9 +58,9 @@ package Ada.Strings.Wide_Wide_Unbounded.Aux is
-- string data is always accessible as S (1 .. L).
procedure Set_Wide_Wide_String
(UP : in out Unbounded_Wide_Wide_String;
S : Wide_Wide_String);
pragma Inline (Set_Wide_Wide_String);
(UP : out Unbounded_Wide_Wide_String;
S : Wide_Wide_String)
renames Set_Unbounded_Wide_Wide_String;
-- This function sets the string contents of the referenced unbounded
-- string to the given string value. It is significantly more efficient
-- than the use of To_Unbounded_Wide_Wide_String with an assignment, since
......
gcc/ada/g-spipat.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2008, AdaCore --
-- Copyright (C) 1998-2009, AdaCore --
-- --
-- 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- --
......@@ -2793,9 +2793,8 @@ package body GNAT.Spitbol.Patterns is
(Subject : VString;
Pat : Pattern) return Boolean
is
S : String_Access;
S : Big_String_Access;
L : Natural;
Start : Natural;
Stop : Natural;
pragma Unreferenced (Stop);
......@@ -2838,7 +2837,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -2867,7 +2866,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -2892,7 +2891,7 @@ package body GNAT.Spitbol.Patterns is
(Subject : VString;
Pat : Pattern)
is
S : String_Access;
S : Big_String_Access;
L : Natural;
Start : Natural;
......@@ -2933,7 +2932,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -2958,7 +2957,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -2980,7 +2979,7 @@ package body GNAT.Spitbol.Patterns is
Pat : PString) return Boolean
is
Pat_Len : constant Natural := Pat'Length;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -3038,7 +3037,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -3067,7 +3066,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -3092,7 +3091,7 @@ package body GNAT.Spitbol.Patterns is
(Subject : VString;
Pat : PString)
is
S : String_Access;
S : Big_String_Access;
L : Natural;
Start : Natural;
......@@ -3133,7 +3132,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -3158,7 +3157,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -3182,7 +3181,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -3213,7 +3212,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -3362,7 +3361,7 @@ package body GNAT.Spitbol.Patterns is
(Result : in out Match_Result;
Replace : VString)
is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -3955,7 +3954,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Any_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -3975,7 +3974,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Any_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -4142,7 +4141,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Break_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -4163,7 +4162,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Break_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -4210,7 +4209,7 @@ package body GNAT.Spitbol.Patterns is
when PC_BreakX_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -4231,7 +4230,7 @@ package body GNAT.Spitbol.Patterns is
when PC_BreakX_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -4376,7 +4375,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NotAny_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -4397,7 +4396,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NotAny_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -4440,7 +4439,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NSpan_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -4459,7 +4458,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NSpan_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -4682,7 +4681,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Span_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
P : Natural;
......@@ -4708,7 +4707,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Span_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
P : Natural;
......@@ -4809,7 +4808,7 @@ package body GNAT.Spitbol.Patterns is
when PC_String_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -4829,7 +4828,7 @@ package body GNAT.Spitbol.Patterns is
when PC_String_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -5354,7 +5353,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Any_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -5376,7 +5375,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Any_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -5563,7 +5562,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Break_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -5585,7 +5584,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Break_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -5637,7 +5636,7 @@ package body GNAT.Spitbol.Patterns is
when PC_BreakX_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -5659,7 +5658,7 @@ package body GNAT.Spitbol.Patterns is
when PC_BreakX_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -5826,7 +5825,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NotAny_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -5848,7 +5847,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NotAny_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -5896,7 +5895,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NSpan_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -5916,7 +5915,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NSpan_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -6172,7 +6171,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Span_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
P : Natural;
......@@ -6199,7 +6198,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Span_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
P : Natural;
......@@ -6314,7 +6313,7 @@ package body GNAT.Spitbol.Patterns is
when PC_String_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -6335,7 +6334,7 @@ package body GNAT.Spitbol.Patterns is
when PC_String_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......
gcc/ada/g-spitbo.adb
......@@ -135,7 +135,7 @@ package body GNAT.Spitbol is
-------
function N (Str : VString) return Integer is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
Get_String (Str, S, L);
......@@ -147,7 +147,7 @@ package body GNAT.Spitbol is
--------------------
function Reverse_String (Str : VString) return VString is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -177,7 +177,7 @@ package body GNAT.Spitbol is
end Reverse_String;
procedure Reverse_String (Str : in out VString) is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -191,7 +191,7 @@ package body GNAT.Spitbol is
Result (J) := S (L + 1 - J);
end loop;
Set_String (Str, Result);
Set_Unbounded_String (Str, Result);
end;
end Reverse_String;
......@@ -284,7 +284,7 @@ package body GNAT.Spitbol is
Start : Positive;
Len : Natural) return VString
is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
......@@ -413,7 +413,7 @@ package body GNAT.Spitbol is
if Elmt.Name /= null then
loop
Set_String (TA (P).Name, Elmt.Name.all);
Set_Unbounded_String (TA (P).Name, Elmt.Name.all);
TA (P).Value := Elmt.Value;
P := P + 1;
Elmt := Elmt.Next;
......@@ -458,7 +458,7 @@ package body GNAT.Spitbol is
end Delete;
procedure Delete (T : in out Table; Name : VString) is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
Get_String (Name, S, L);
......@@ -584,7 +584,7 @@ package body GNAT.Spitbol is
end Get;
function Get (T : Table; Name : VString) return Value_Type is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
Get_String (Name, S, L);
......@@ -625,7 +625,7 @@ package body GNAT.Spitbol is
end Present;
function Present (T : Table; Name : VString) return Boolean is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
Get_String (Name, S, L);
......@@ -661,7 +661,7 @@ package body GNAT.Spitbol is
---------
procedure Set (T : in out Table; Name : VString; Value : Value_Type) is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
Get_String (Name, S, L);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment