re PR ada/13470 (64bits Ada bootstrap failure:xnmake etc. crash generating nmake...

2005-03-08  Robert Dewar  <dewar@adacore.com>

	PR ada/13470

	* a-stunau.ads, a-stunau.adb:
	Change interface to allow efficient (and correct) implementation
	The previous changes to allow extra space in unbounded strings had
	left this interface a bit broken.

	* a-suteio.adb: Avoid unnecessary use of Get/Set_String

	* g-spipat.ads, g-spipat.adb: New interface for Get_String
	Minor reformatting (function specs)

	* g-spitbo.adb: New interface for Get_String

	* g-spitbo.ads: Minor reformatting

	* a-swunau.ads, a-swunau.adb: New interface for Get_Wide_String

	* a-szunau.ads, a-szunau.adb: New interface for Get_Wide_Wide_String

From-SVN: r96488

diff --git a/gcc/ada/a-stunau.adb b/gcc/ada/a-stunau.adb
index 9b23cb2d1f6961e8667c45bb70e3e99ac25ee7a8..0dbd3fd48c711dbf2f257c543fca31c75d265c8a 100644 (file)
--- a/gcc/ada/a-stunau.adb
+++ b/gcc/ada/a-stunau.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2002, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2005, 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- --
@@ -37,31 +37,14 @@ package body Ada.Strings.Unbounded.Aux is
    -- Get_String --
    ----------------
 
-   function Get_String (U : Unbounded_String) return String_Access is
+   procedure Get_String
+     (U : Unbounded_String;
+      S : out String_Access;
+      L : out Natural)
+   is
    begin
-      if U.Last = U.Reference'Length then
-         return U.Reference;
-
-      else
-         declare
-            type Unbounded_String_Access is access all Unbounded_String;
-
-            U_Ptr : constant Unbounded_String_Access := U'Unrestricted_Access;
-            --  Unbounded_String is a controlled type which is always passed
-            --  by reference.  It is always safe to take the pointer to such
-            --  object here.  This pointer is used to set the U.Reference
-            --  value which would not be possible otherwise as U is read-only.
-
-            Old : String_Access := U.Reference;
-            Ret : String_Access;
-
-         begin
-            Ret := new String'(U.Reference (1 .. U.Last));
-            U_Ptr.Reference := Ret;
-            Free (Old);
-            return Ret;
-         end;
-      end if;
+      S := U.Reference;
+      L := U.Last;
    end Get_String;
 
    ----------------
@@ -70,21 +53,13 @@ package body Ada.Strings.Unbounded.Aux is
 
    procedure Set_String (UP : in out Unbounded_String; S : String) is
    begin
-      if UP.Last = S'Length then
-         UP.Reference.all := S;
-
-      else
-         declare
-            subtype String_1 is String (1 .. S'Length);
-            Tmp : String_Access;
-
-         begin
-            Tmp := new String'(String_1 (S));
-            Finalize (UP);
-            UP.Reference := Tmp;
-            UP.Last := UP.Reference'Length;
-         end;
+      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

diff --git a/gcc/ada/a-stunau.ads b/gcc/ada/a-stunau.ads
index 6ba3e567140b2f82300a92644580c2fe9e274830..05fbe126623b2c071586e202cd29587187212c7b 100644 (file)
--- a/gcc/ada/a-stunau.ads
+++ b/gcc/ada/a-stunau.ads
@@ -39,19 +39,22 @@
 package Ada.Strings.Unbounded.Aux is
 pragma Preelaborate (Aux);
 
-   function Get_String (U : Unbounded_String) return String_Access;
+   procedure Get_String
+     (U : Unbounded_String;
+      S : out String_Access;
+      L : out Natural);
    pragma Inline (Get_String);
-   --  This function returns the internal string pointer used in the
-   --  representation of an unbounded string. There is no copy involved,
-   --  so the value obtained references the same string as the original
-   --  unbounded string. The characters of this string may not be modified
-   --  via the returned pointer, and are valid only as long as the original
-   --  unbounded string is not modified. Violating either of these two
-   --  rules results in erroneous execution.
+   --  This procedure returns the internal string pointer used in the
+   --  representation of an unbounded string as well as the actual current
+   --  length (which may be less than S.all'Length because in general there
+   --  can be extra space assigned). The characters of this string may be
+   --  not be modified via the returned pointer,  and are valid only as
+   --  long as the original unbounded string is not accessed or modified.
    --
-   --  This function is much more efficient than the use of To_String
+   --  This procedure is much more efficient than the use of To_String
    --  since it avoids the need to copy the string. The lower bound of the
-   --  referenced string returned by this call is always one.
+   --  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);

diff --git a/gcc/ada/a-swunau.adb b/gcc/ada/a-swunau.adb
index 2d9a2dd0b1ca8150ea6fcbc2188ae7d6e298ee33..2f4c127b71b85908177d59a368021da291dadc70 100644 (file)
--- a/gcc/ada/a-swunau.adb
+++ b/gcc/ada/a-swunau.adb
@@ -37,33 +37,14 @@ package body Ada.Strings.Wide_Unbounded.Aux is
    -- Get_Wide_String --
    ---------------------
 
-   function Get_Wide_String
-     (U : Unbounded_Wide_String) return Wide_String_Access
+   procedure Get_Wide_String
+     (U : Unbounded_Wide_String;
+      S : out Wide_String_Access;
+      L : out Natural)
    is
    begin
-      if U.Last = U.Reference'Length then
-         return U.Reference;
-
-      else
-         declare
-            type Unbounded_Wide_String_Access is
-              access all Unbounded_Wide_String;
-
-            U_Ptr : constant Unbounded_Wide_String_Access :=
-                      U'Unrestricted_Access;
-            --  Unbounded_Wide_String is a controlled type which is always
-            --  passed by copy it is always safe to take the pointer to such
-            --  object here. This pointer is used to set the U.Reference value
-            --  which would not be possible otherwise as U is read-only.
-
-            Old : Wide_String_Access := U.Reference;
-
-         begin
-            U_Ptr.Reference := new Wide_String'(U.Reference (1 .. U.Last));
-            Free (Old);
-            return U.Reference;
-         end;
-      end if;
+      S := U.Reference;
+      L := U.Last;
    end Get_Wide_String;
 
    ---------------------
@@ -75,20 +56,13 @@ package body Ada.Strings.Wide_Unbounded.Aux is
       S  : Wide_String)
    is
    begin
-      if UP.Last = S'Length then
-         UP.Reference.all := S;
-
-      else
-         declare
-            subtype String_1 is Wide_String (1 .. S'Length);
-            Tmp : Wide_String_Access;
-         begin
-            Tmp := new Wide_String'(String_1 (S));
-            Finalize (UP);
-            UP.Reference := Tmp;
-            UP.Last := UP.Reference'Length;
-         end;
+      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

diff --git a/gcc/ada/a-swunau.ads b/gcc/ada/a-swunau.ads
index dbecd4f0b118d00bb082181956bb27d16ee779c1..da8bfc02342bad12bf4bd9f28fc9b22b77a5fa45 100644 (file)
--- a/gcc/ada/a-swunau.ads
+++ b/gcc/ada/a-swunau.ads
@@ -39,20 +39,22 @@
 package Ada.Strings.Wide_Unbounded.Aux is
 pragma Preelaborate (Aux);
 
-   function Get_Wide_String
-     (U : Unbounded_Wide_String) return Wide_String_Access;
+   procedure Get_Wide_String
+     (U : Unbounded_Wide_String;
+      S : out Wide_String_Access;
+      L : out Natural);
    pragma Inline (Get_Wide_String);
-   --  This function returns the internal string pointer used in the
-   --  representation of an unbounded string. There is no copy involved,
-   --  so the value obtained references the same string as the original
-   --  unbounded string. The characters of this string may not be modified
-   --  via the returned pointer, and are valid only as long as the original
-   --  unbounded string is not modified. Violating either of these two
-   --  rules results in erroneous execution.
+   --  This procedure returns the internal string pointer used in the
+   --  representation of an unbounded string as well as the actual current
+   --  length (which may be less than S.all'Length because in general there
+   --  can be extra space assigned). The characters of this string may be
+   --  not be modified via the returned pointer,  and are valid only as
+   --  long as the original unbounded string is not accessed or modified.
    --
-   --  This function is much more efficient than the use of To_Wide_String
+   --  This procedure is much more efficient than the use of To_Wide_String
    --  since it avoids the need to copy the string. The lower bound of the
-   --  referenced string returned by this call is always one.
+   --  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;

diff --git a/gcc/ada/a-szunau.adb b/gcc/ada/a-szunau.adb
index e0f1acf50a8a29f7090fe2799480d955cc58529b..c022a5b28e3a1ff446426946470b9bf56cf4759a 100644 (file)
--- a/gcc/ada/a-szunau.adb
+++ b/gcc/ada/a-szunau.adb
@@ -33,63 +33,36 @@
 
 package body Ada.Strings.Wide_Wide_Unbounded.Aux is
 
-   --------------------------
+   --------------------
    -- Get_Wide_Wide_String --
-   --------------------------
+   ---------------------
 
-   function Get_Wide_Wide_String
-     (U : Unbounded_Wide_Wide_String) return Wide_Wide_String_Access
+   procedure Get_Wide_Wide_String
+     (U : Unbounded_Wide_Wide_String;
+      S : out Wide_Wide_String_Access;
+      L : out Natural)
    is
    begin
-      if U.Last = U.Reference'Length then
-         return U.Reference;
-
-      else
-         declare
-            type Unbounded_Wide_Wide_String_Access is
-              access all Unbounded_Wide_Wide_String;
-
-            U_Ptr : constant Unbounded_Wide_Wide_String_Access :=
-                      U'Unrestricted_Access;
-            --  Unbounded_Wide_Wide_String is a controlled type which is always
-            --  passed by copy it is always safe to take the pointer to such
-            --  object here. This pointer is used to set the U.Reference value
-            --  which would not be possible otherwise as U is read-only.
-
-            Old : Wide_Wide_String_Access := U.Reference;
-
-         begin
-            U_Ptr.Reference :=
-              new Wide_Wide_String'(U.Reference (1 .. U.Last));
-            Free (Old);
-            return U.Reference;
-         end;
-      end if;
+      S := U.Reference;
+      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 UP.Last = S'Length then
-         UP.Reference.all := S;
-
-      else
-         declare
-            subtype String_1 is Wide_Wide_String (1 .. S'Length);
-            Tmp : Wide_Wide_String_Access;
-         begin
-            Tmp := new Wide_Wide_String'(String_1 (S));
-            Finalize (UP);
-            UP.Reference := Tmp;
-            UP.Last := UP.Reference'Length;
-         end;
+      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

diff --git a/gcc/ada/a-szunau.ads b/gcc/ada/a-szunau.ads
index dff8cb8e6c9fb2c1159e0e6477e7aa0380e27947..6333a1e7459b99b19748dcc273ecb7105328054b 100644 (file)
--- a/gcc/ada/a-szunau.ads
+++ b/gcc/ada/a-szunau.ads
@@ -39,20 +39,22 @@
 package Ada.Strings.Wide_Wide_Unbounded.Aux is
 pragma Preelaborate (Aux);
 
-   function Get_Wide_Wide_String
-     (U : Unbounded_Wide_Wide_String) return Wide_Wide_String_Access;
+   procedure Get_Wide_Wide_String
+     (U : Unbounded_Wide_Wide_String;
+      S : out Wide_Wide_String_Access;
+      L : out Natural);
    pragma Inline (Get_Wide_Wide_String);
-   --  This function returns the internal string pointer used in the
-   --  representation of an unbounded string. There is no copy involved,
-   --  so the value obtained references the same string as the original
-   --  unbounded string. The characters of this string may not be modified
-   --  via the returned pointer, and are valid only as long as the original
-   --  unbounded string is not modified. Violating either of these two
-   --  rules results in erroneous execution.
+   --  This procedure returns the internal string pointer used in the
+   --  representation of an unbounded string as well as the actual current
+   --  length (which may be less than S.all'Length because in general there
+   --  can be extra space assigned). The characters of this string may be
+   --  not be modified via the returned pointer,  and are valid only as
+   --  long as the original unbounded string is not accessed or modified.
    --
-   --  This function is much more efficient than the use of To_Wide_Wide_String
+   --  This procedure is more efficient than the use of To_Wide_Wide_String
    --  since it avoids the need to copy the string. The lower bound of the
-   --  referenced string returned by this call is always one.
+   --  referenced string returned by this call is always one, so the actual
+   --  string data is always accessible as S (1 .. L).
 
    procedure Set_Wide_Wide_String
      (UP : in out Unbounded_Wide_Wide_String;

diff --git a/gcc/ada/g-spipat.adb b/gcc/ada/g-spipat.adb
index 06f7542759c05444904fbe8250f12416c408b86d..6bc5f2480d956f549c8c7b68c4e53e3251fb014b 100644 (file)
--- a/gcc/ada/g-spipat.adb
+++ b/gcc/ada/g-spipat.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 1998-2004, Ada Core Technologies, Inc.           --
+--           Copyright (C) 1998-2005, Ada Core Technologies, 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- --
@@ -2802,16 +2802,20 @@ package body GNAT.Spitbol.Patterns is
 
    function Match
      (Subject : VString;
-      Pat     : Pattern)
-      return    Boolean
+      Pat     : Pattern) return Boolean
    is
-      Start, Stop : Natural;
+      Start : Natural;
+      Stop  : Natural;
+      S     : String_Access;
+      L     : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Debug_Mode then
-         XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       else
-         XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       end if;
 
       return Start /= 0;
@@ -2819,8 +2823,7 @@ package body GNAT.Spitbol.Patterns is
 
    function Match
      (Subject : String;
-      Pat     : Pattern)
-      return    Boolean
+      Pat     : Pattern) return Boolean
    is
       Start, Stop : Natural;
       subtype String1 is String (1 .. Subject'Length);
@@ -2838,24 +2841,28 @@ package body GNAT.Spitbol.Patterns is
    function Match
      (Subject : VString_Var;
       Pat     : Pattern;
-      Replace : VString)
-      return    Boolean
+      Replace : VString) return Boolean
    is
-      Start, Stop : Natural;
+      Start : Natural;
+      Stop  : Natural;
+      S     : String_Access;
+      L     : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Debug_Mode then
-         XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       else
-         XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       end if;
 
       if Start = 0 then
          return False;
       else
+         Get_String (Replace, S, L);
          Replace_Slice
-           (Subject'Unrestricted_Access.all,
-            Start, Stop, Get_String (Replace).all);
+           (Subject'Unrestricted_Access.all, Start, Stop, S (1 .. L));
          return True;
       end if;
    end Match;
@@ -2863,16 +2870,20 @@ package body GNAT.Spitbol.Patterns is
    function Match
      (Subject : VString_Var;
       Pat     : Pattern;
-      Replace : String)
-      return    Boolean
+      Replace : String) return Boolean
    is
-      Start, Stop : Natural;
+      Start : Natural;
+      Stop  : Natural;
+      S     : String_Access;
+      L     : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Debug_Mode then
-         XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       else
-         XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       end if;
 
       if Start = 0 then
@@ -2888,15 +2899,19 @@ package body GNAT.Spitbol.Patterns is
      (Subject : VString;
       Pat     : Pattern)
    is
-      Start, Stop : Natural;
+      Start : Natural;
+      Stop  : Natural;
+      S     : String_Access;
+      L     : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Debug_Mode then
-         XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       else
-         XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       end if;
-
    end Match;
 
    procedure Match
@@ -2918,17 +2933,23 @@ package body GNAT.Spitbol.Patterns is
       Pat     : Pattern;
       Replace : VString)
    is
-      Start, Stop : Natural;
+      Start : Natural;
+      Stop  : Natural;
+      S     : String_Access;
+      L     : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Debug_Mode then
-         XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       else
-         XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       end if;
 
       if Start /= 0 then
-         Replace_Slice (Subject, Start, Stop, Get_String (Replace).all);
+         Get_String (Replace, S, L);
+         Replace_Slice (Subject, Start, Stop, S (1 .. L));
       end if;
    end Match;
 
@@ -2937,13 +2958,18 @@ package body GNAT.Spitbol.Patterns is
       Pat     : Pattern;
       Replace : String)
    is
-      Start, Stop : Natural;
+      Start : Natural;
+      Stop  : Natural;
+      S     : String_Access;
+      L     : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Debug_Mode then
-         XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       else
-         XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       end if;
 
       if Start /= 0 then
@@ -2953,24 +2979,25 @@ package body GNAT.Spitbol.Patterns is
 
    function Match
      (Subject : VString;
-      Pat     : PString)
-      return    Boolean
+      Pat     : PString) return Boolean
    is
-      Pat_Len : constant Natural       := Pat'Length;
-      Sub_Len : constant Natural       := Length (Subject);
-      Sub_Str : constant String_Access := Get_String (Subject);
+      Pat_Len : constant Natural := Pat'Length;
+      S       : String_Access;
+      L       : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Anchored_Mode then
-         if Pat_Len > Sub_Len then
+         if Pat_Len > L then
             return False;
          else
-            return Pat = Sub_Str.all (1 .. Pat_Len);
+            return Pat = S (1 .. Pat_Len);
          end if;
 
       else
-         for J in 1 .. Sub_Len - Pat_Len + 1 loop
-            if Pat = Sub_Str.all (J .. J + (Pat_Len - 1)) then
+         for J in 1 .. L - Pat_Len + 1 loop
+            if Pat = S (J .. J + (Pat_Len - 1)) then
                return True;
             end if;
          end loop;
@@ -2981,8 +3008,7 @@ package body GNAT.Spitbol.Patterns is
 
    function Match
      (Subject : String;
-      Pat     : PString)
-      return    Boolean
+      Pat     : PString) return Boolean
    is
       Pat_Len : constant Natural := Pat'Length;
       Sub_Len : constant Natural := Subject'Length;
@@ -3010,24 +3036,28 @@ package body GNAT.Spitbol.Patterns is
    function Match
      (Subject : VString_Var;
       Pat     : PString;
-      Replace : VString)
-      return    Boolean
+      Replace : VString) return Boolean
    is
-      Start, Stop : Natural;
+      Start : Natural;
+      Stop  : Natural;
+      S     : String_Access;
+      L     : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Debug_Mode then
-         XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
+         XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
       else
-         XMatch  (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
+         XMatch  (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
       end if;
 
       if Start = 0 then
          return False;
       else
+         Get_String (Replace, S, L);
          Replace_Slice
-           (Subject'Unrestricted_Access.all,
-            Start, Stop, Get_String (Replace).all);
+           (Subject'Unrestricted_Access.all, Start, Stop, S (1 .. L));
          return True;
       end if;
    end Match;
@@ -3035,16 +3065,20 @@ package body GNAT.Spitbol.Patterns is
    function Match
      (Subject : VString_Var;
       Pat     : PString;
-      Replace : String)
-      return    Boolean
+      Replace : String) return Boolean
    is
-      Start, Stop : Natural;
+      Start : Natural;
+      Stop  : Natural;
+      S     : String_Access;
+      L     : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Debug_Mode then
-         XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
+         XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
       else
-         XMatch  (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
+         XMatch  (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
       end if;
 
       if Start = 0 then
@@ -3060,13 +3094,18 @@ package body GNAT.Spitbol.Patterns is
      (Subject : VString;
       Pat     : PString)
    is
-      Start, Stop : Natural;
+      Start : Natural;
+      Stop  : Natural;
+      S     : String_Access;
+      L     : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Debug_Mode then
-         XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
+         XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
       else
-         XMatch  (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
+         XMatch  (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
       end if;
    end Match;
 
@@ -3090,17 +3129,23 @@ package body GNAT.Spitbol.Patterns is
       Pat     : PString;
       Replace : VString)
    is
-      Start, Stop : Natural;
+      Start : Natural;
+      Stop  : Natural;
+      S     : String_Access;
+      L     : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Debug_Mode then
-         XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
+         XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
       else
-         XMatch  (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
+         XMatch  (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
       end if;
 
       if Start /= 0 then
-         Replace_Slice (Subject, Start, Stop, Get_String (Replace).all);
+         Get_String (Replace, S, L);
+         Replace_Slice (Subject, Start, Stop, S (1 .. L));
       end if;
    end Match;
 
@@ -3109,13 +3154,18 @@ package body GNAT.Spitbol.Patterns is
       Pat     : PString;
       Replace : String)
    is
-      Start, Stop : Natural;
+      Start : Natural;
+      Stop  : Natural;
+      S     : String_Access;
+      L     : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Debug_Mode then
-         XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
+         XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
       else
-         XMatch  (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
+         XMatch  (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
       end if;
 
       if Start /= 0 then
@@ -3126,16 +3176,20 @@ package body GNAT.Spitbol.Patterns is
    function Match
      (Subject : VString_Var;
       Pat     : Pattern;
-      Result  : Match_Result_Var)
-      return    Boolean
+      Result  : Match_Result_Var) return Boolean
    is
-      Start, Stop : Natural;
+      Start : Natural;
+      Stop  : Natural;
+      S     : String_Access;
+      L     : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Debug_Mode then
-         XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       else
-         XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       end if;
 
       if Start = 0 then
@@ -3155,18 +3209,22 @@ package body GNAT.Spitbol.Patterns is
       Pat     : Pattern;
       Result  : out Match_Result)
    is
-      Start, Stop : Natural;
+      Start : Natural;
+      Stop  : Natural;
+      S     : String_Access;
+      L     : Natural;
 
    begin
+      Get_String (Subject, S, L);
+
       if Debug_Mode then
-         XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       else
-         XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
+         XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
       end if;
 
       if Start = 0 then
          Result.Var := null;
-
       else
          Result.Var   := Subject'Unrestricted_Access;
          Result.Start := Start;
@@ -3302,13 +3360,14 @@ package body GNAT.Spitbol.Patterns is
      (Result  : in out Match_Result;
       Replace : VString)
    is
+      S : String_Access;
+      L : Natural;
+
    begin
+      Get_String (Replace, S, L);
+
       if Result.Var /= null then
-         Replace_Slice
-           (Result.Var.all,
-            Result.Start,
-            Result.Stop,
-            Get_String (Replace).all);
+         Replace_Slice (Result.Var.all, Result.Start, Result.Stop, S (1 .. L));
          Result.Var := null;
       end if;
    end Replace;
@@ -3487,7 +3546,6 @@ package body GNAT.Spitbol.Patterns is
 
    function Str_BF (A : Boolean_Func) return String is
       function To_A is new Unchecked_Conversion (Boolean_Func, Address);
-
    begin
       return "BF(" & Image (To_A (A)) & ')';
    end Str_BF;
@@ -3507,7 +3565,6 @@ package body GNAT.Spitbol.Patterns is
 
    function Str_NF (A : Natural_Func) return String is
       function To_A is new Unchecked_Conversion (Natural_Func, Address);
-
    begin
       return "NF(" & Image (To_A (A)) & ')';
    end Str_NF;
@@ -3536,7 +3593,6 @@ package body GNAT.Spitbol.Patterns is
 
    function Str_VF (A : VString_Func) return String is
       function To_A is new Unchecked_Conversion (VString_Func, Address);
-
    begin
       return "VF(" & Image (To_A (A)) & ')';
    end Str_VF;
@@ -3897,12 +3953,15 @@ package body GNAT.Spitbol.Patterns is
          --  Any (string function case)
 
          when PC_Any_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
 
          begin
+            Get_String (U, S, L);
+
             if Cursor < Length
-              and then Is_In (Subject (Cursor + 1), Str.all)
+              and then Is_In (Subject (Cursor + 1), S (1 .. L))
             then
                Cursor := Cursor + 1;
                goto Succeed;
@@ -3914,11 +3973,15 @@ package body GNAT.Spitbol.Patterns is
          --  Any (string pointer case)
 
          when PC_Any_VP => declare
-            Str : constant String_Access := Get_String (Node.VP.all);
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
 
          begin
+            Get_String (U, S, L);
+
             if Cursor < Length
-              and then Is_In (Subject (Cursor + 1), Str.all)
+              and then Is_In (Subject (Cursor + 1), S (1 .. L))
             then
                Cursor := Cursor + 1;
                goto Succeed;
@@ -4077,12 +4140,15 @@ package body GNAT.Spitbol.Patterns is
          --  Break (string function case)
 
          when PC_Break_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
 
          begin
+            Get_String (U, S, L);
+
             while Cursor < Length loop
-               if Is_In (Subject (Cursor + 1), Str.all) then
+               if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                   goto Succeed;
                else
                   Cursor := Cursor + 1;
@@ -4095,11 +4161,15 @@ package body GNAT.Spitbol.Patterns is
          --  Break (string pointer case)
 
          when PC_Break_VP => declare
-            Str : constant String_Access := Get_String (Node.VP.all);
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
 
          begin
+            Get_String (U, S, L);
+
             while Cursor < Length loop
-               if Is_In (Subject (Cursor + 1), Str.all) then
+               if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                   goto Succeed;
                else
                   Cursor := Cursor + 1;
@@ -4138,12 +4208,15 @@ package body GNAT.Spitbol.Patterns is
          --  BreakX (string function case)
 
          when PC_BreakX_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
 
          begin
+            Get_String (U, S, L);
+
             while Cursor < Length loop
-               if Is_In (Subject (Cursor + 1), Str.all) then
+               if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                   goto Succeed;
                else
                   Cursor := Cursor + 1;
@@ -4156,11 +4229,15 @@ package body GNAT.Spitbol.Patterns is
          --  BreakX (string pointer case)
 
          when PC_BreakX_VP => declare
-            Str : constant String_Access := Get_String (Node.VP.all);
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
 
          begin
+            Get_String (U, S, L);
+
             while Cursor < Length loop
-               if Is_In (Subject (Cursor + 1), Str.all) then
+               if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                   goto Succeed;
                else
                   Cursor := Cursor + 1;
@@ -4298,13 +4375,16 @@ package body GNAT.Spitbol.Patterns is
          --  NotAny (string function case)
 
          when PC_NotAny_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
 
          begin
+            Get_String (U, S, L);
+
             if Cursor < Length
               and then
-                not Is_In (Subject (Cursor + 1), Str.all)
+                not Is_In (Subject (Cursor + 1), S (1 .. L))
             then
                Cursor := Cursor + 1;
                goto Succeed;
@@ -4316,12 +4396,16 @@ package body GNAT.Spitbol.Patterns is
          --  NotAny (string pointer case)
 
          when PC_NotAny_VP => declare
-            Str : constant String_Access := Get_String (Node.VP.all);
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
 
          begin
+            Get_String (U, S, L);
+
             if Cursor < Length
               and then
-                not Is_In (Subject (Cursor + 1), Str.all)
+                not Is_In (Subject (Cursor + 1), S (1 .. L))
             then
                Cursor := Cursor + 1;
                goto Succeed;
@@ -4355,12 +4439,15 @@ package body GNAT.Spitbol.Patterns is
          --  NSpan (string function case)
 
          when PC_NSpan_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
 
          begin
+            Get_String (U, S, L);
+
             while Cursor < Length
-              and then Is_In (Subject (Cursor + 1), Str.all)
+              and then Is_In (Subject (Cursor + 1), S (1 .. L))
             loop
                Cursor := Cursor + 1;
             end loop;
@@ -4371,11 +4458,15 @@ package body GNAT.Spitbol.Patterns is
          --  NSpan (string pointer case)
 
          when PC_NSpan_VP => declare
-            Str : constant String_Access := Get_String (Node.VP.all);
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
 
          begin
+            Get_String (U, S, L);
+
             while Cursor < Length
-              and then Is_In (Subject (Cursor + 1), Str.all)
+              and then Is_In (Subject (Cursor + 1), S (1 .. L))
             loop
                Cursor := Cursor + 1;
             end loop;
@@ -4591,13 +4682,17 @@ package body GNAT.Spitbol.Patterns is
          --  Span (string function case)
 
          when PC_Span_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
-            P   : Natural := Cursor;
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
+            P : Natural;
 
          begin
+            Get_String (U, S, L);
+
+            P := Cursor;
             while P < Length
-              and then Is_In (Subject (P + 1), Str.all)
+              and then Is_In (Subject (P + 1), S (1 .. L))
             loop
                P := P + 1;
             end loop;
@@ -4613,12 +4708,17 @@ package body GNAT.Spitbol.Patterns is
          --  Span (string pointer case)
 
          when PC_Span_VP => declare
-            Str : constant String_Access := Get_String (Node.VP.all);
-            P   : Natural := Cursor;
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
+            P : Natural;
 
          begin
+            Get_String (U, S, L);
+
+            P := Cursor;
             while P < Length
-              and then Is_In (Subject (P + 1), Str.all)
+              and then Is_In (Subject (P + 1), S (1 .. L))
             loop
                P := P + 1;
             end loop;
@@ -4710,15 +4810,17 @@ package body GNAT.Spitbol.Patterns is
          --  String (function case)
 
          when PC_String_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
-            Len : constant Natural       := Str'Length;
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            if (Length - Cursor) >= Len
-              and then Str.all = Subject (Cursor + 1 .. Cursor + Len)
+            Get_String (U, S, L);
+
+            if (Length - Cursor) >= L
+              and then S (1 .. L) = Subject (Cursor + 1 .. Cursor + L)
             then
-               Cursor := Cursor + Len;
+               Cursor := Cursor + L;
                goto Succeed;
             else
                goto Fail;
@@ -4728,14 +4830,17 @@ package body GNAT.Spitbol.Patterns is
          --  String (pointer case)
 
          when PC_String_VP => declare
-            S   : constant String_Access := Get_String (Node.VP.all);
-            Len : constant Natural       := S'Length;
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            if (Length - Cursor) >= Len
-              and then S.all = Subject (Cursor + 1 .. Cursor + Len)
+            Get_String (U, S, L);
+
+            if (Length - Cursor) >= L
+              and then S (1 .. L) = Subject (Cursor + 1 .. Cursor + L)
             then
-               Cursor := Cursor + Len;
+               Cursor := Cursor + L;
                goto Succeed;
             else
                goto Fail;
@@ -5251,14 +5356,17 @@ package body GNAT.Spitbol.Patterns is
          --  Any (string function case)
 
          when PC_Any_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            Dout (Img (Node) & "matching Any", Str.all);
+            Get_String (U, S, L);
+
+            Dout (Img (Node) & "matching Any", S (1 .. L));
 
             if Cursor < Length
-              and then Is_In (Subject (Cursor + 1), Str.all)
+              and then Is_In (Subject (Cursor + 1), S (1 .. L))
             then
                Cursor := Cursor + 1;
                goto Succeed;
@@ -5270,13 +5378,16 @@ package body GNAT.Spitbol.Patterns is
          --  Any (string pointer case)
 
          when PC_Any_VP => declare
-            Str : constant String_Access := Get_String (Node.VP.all);
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            Dout (Img (Node) & "matching Any", Str.all);
+            Get_String (U, S, L);
+            Dout (Img (Node) & "matching Any", S (1 .. L));
 
             if Cursor < Length
-              and then Is_In (Subject (Cursor + 1), Str.all)
+              and then Is_In (Subject (Cursor + 1), S (1 .. L))
             then
                Cursor := Cursor + 1;
                goto Succeed;
@@ -5454,14 +5565,16 @@ package body GNAT.Spitbol.Patterns is
          --  Break (string function case)
 
          when PC_Break_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            Dout (Img (Node) & "matching Break", Str.all);
+            Get_String (U, S, L);
+            Dout (Img (Node) & "matching Break", S (1 .. L));
 
             while Cursor < Length loop
-               if Is_In (Subject (Cursor + 1), Str.all) then
+               if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                   goto Succeed;
                else
                   Cursor := Cursor + 1;
@@ -5474,13 +5587,16 @@ package body GNAT.Spitbol.Patterns is
          --  Break (string pointer case)
 
          when PC_Break_VP => declare
-            Str : constant String_Access := Get_String (Node.VP.all);
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            Dout (Img (Node) & "matching Break", Str.all);
+            Get_String (U, S, L);
+            Dout (Img (Node) & "matching Break", S (1 .. L));
 
             while Cursor < Length loop
-               if Is_In (Subject (Cursor + 1), Str.all) then
+               if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                   goto Succeed;
                else
                   Cursor := Cursor + 1;
@@ -5523,14 +5639,16 @@ package body GNAT.Spitbol.Patterns is
          --  BreakX (string function case)
 
          when PC_BreakX_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            Dout (Img (Node) & "matching BreakX", Str.all);
+            Get_String (U, S, L);
+            Dout (Img (Node) & "matching BreakX", S (1 .. L));
 
             while Cursor < Length loop
-               if Is_In (Subject (Cursor + 1), Str.all) then
+               if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                   goto Succeed;
                else
                   Cursor := Cursor + 1;
@@ -5543,13 +5661,16 @@ package body GNAT.Spitbol.Patterns is
          --  BreakX (string pointer case)
 
          when PC_BreakX_VP => declare
-            Str : constant String_Access := Get_String (Node.VP.all);
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            Dout (Img (Node) & "matching BreakX", Str.all);
+            Get_String (U, S, L);
+            Dout (Img (Node) & "matching BreakX", S (1 .. L));
 
             while Cursor < Length loop
-               if Is_In (Subject (Cursor + 1), Str.all) then
+               if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                   goto Succeed;
                else
                   Cursor := Cursor + 1;
@@ -5565,7 +5686,6 @@ package body GNAT.Spitbol.Patterns is
 
          when PC_BreakX_X =>
             Dout (Img (Node) & "extending BreakX");
-
             Cursor := Cursor + 1;
             goto Succeed;
 
@@ -5708,15 +5828,17 @@ package body GNAT.Spitbol.Patterns is
          --  NotAny (string function case)
 
          when PC_NotAny_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            Dout (Img (Node) & "matching NotAny", Str.all);
+            Get_String (U, S, L);
+            Dout (Img (Node) & "matching NotAny", S (1 .. L));
 
             if Cursor < Length
               and then
-                not Is_In (Subject (Cursor + 1), Str.all)
+                not Is_In (Subject (Cursor + 1), S (1 .. L))
             then
                Cursor := Cursor + 1;
                goto Succeed;
@@ -5728,14 +5850,17 @@ package body GNAT.Spitbol.Patterns is
          --  NotAny (string pointer case)
 
          when PC_NotAny_VP => declare
-            Str : constant String_Access := Get_String (Node.VP.all);
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            Dout (Img (Node) & "matching NotAny", Str.all);
+            Get_String (U, S, L);
+            Dout (Img (Node) & "matching NotAny", S (1 .. L));
 
             if Cursor < Length
               and then
-                not Is_In (Subject (Cursor + 1), Str.all)
+                not Is_In (Subject (Cursor + 1), S (1 .. L))
             then
                Cursor := Cursor + 1;
                goto Succeed;
@@ -5773,14 +5898,16 @@ package body GNAT.Spitbol.Patterns is
          --  NSpan (string function case)
 
          when PC_NSpan_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            Dout (Img (Node) & "matching NSpan", Str.all);
+            Get_String (U, S, L);
+            Dout (Img (Node) & "matching NSpan", S (1 .. L));
 
             while Cursor < Length
-              and then Is_In (Subject (Cursor + 1), Str.all)
+              and then Is_In (Subject (Cursor + 1), S (1 .. L))
             loop
                Cursor := Cursor + 1;
             end loop;
@@ -5791,13 +5918,16 @@ package body GNAT.Spitbol.Patterns is
          --  NSpan (string pointer case)
 
          when PC_NSpan_VP => declare
-            Str : constant String_Access := Get_String (Node.VP.all);
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            Dout (Img (Node) & "matching NSpan", Str.all);
+            Get_String (U, S, L);
+            Dout (Img (Node) & "matching NSpan", S (1 .. L));
 
             while Cursor < Length
-              and then Is_In (Subject (Cursor + 1), Str.all)
+              and then Is_In (Subject (Cursor + 1), S (1 .. L))
             loop
                Cursor := Cursor + 1;
             end loop;
@@ -6044,15 +6174,18 @@ package body GNAT.Spitbol.Patterns is
          --  Span (string function case)
 
          when PC_Span_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
-            P   : Natural := Cursor;
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
+            P : Natural;
 
          begin
-            Dout (Img (Node) & "matching Span", Str.all);
+            Get_String (U, S, L);
+            Dout (Img (Node) & "matching Span", S (1 .. L));
 
+            P := Cursor;
             while P < Length
-              and then Is_In (Subject (P + 1), Str.all)
+              and then Is_In (Subject (P + 1), S (1 .. L))
             loop
                P := P + 1;
             end loop;
@@ -6068,14 +6201,18 @@ package body GNAT.Spitbol.Patterns is
          --  Span (string pointer case)
 
          when PC_Span_VP => declare
-            Str : constant String_Access := Get_String (Node.VP.all);
-            P   : Natural := Cursor;
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
+            P : Natural;
 
          begin
-            Dout (Img (Node) & "matching Span", Str.all);
+            Get_String (U, S, L);
+            Dout (Img (Node) & "matching Span", S (1 .. L));
 
+            P := Cursor;
             while P < Length
-              and then Is_In (Subject (P + 1), Str.all)
+              and then Is_In (Subject (P + 1), S (1 .. L))
             loop
                P := P + 1;
             end loop;
@@ -6179,17 +6316,18 @@ package body GNAT.Spitbol.Patterns is
          --  String (function case)
 
          when PC_String_VF => declare
-            U   : constant VString       := Node.VF.all;
-            Str : constant String_Access := Get_String (U);
-            Len : constant Natural       := Str'Length;
+            U : constant VString := Node.VF.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            Dout (Img (Node) & "matching " & Image (Str.all));
+            Get_String (U, S, L);
+            Dout (Img (Node) & "matching " & Image (S (1 .. L)));
 
-            if (Length - Cursor) >= Len
-              and then Str.all = Subject (Cursor + 1 .. Cursor + Len)
+            if (Length - Cursor) >= L
+              and then S (1 .. L) = Subject (Cursor + 1 .. Cursor + L)
             then
-               Cursor := Cursor + Len;
+               Cursor := Cursor + L;
                goto Succeed;
             else
                goto Fail;
@@ -6199,18 +6337,18 @@ package body GNAT.Spitbol.Patterns is
          --  String (vstring pointer case)
 
          when PC_String_VP => declare
-            S   : constant String_Access := Get_String (Node.VP.all);
-            Len : constant Natural :=
-                    Ada.Strings.Unbounded.Length (Node.VP.all);
+            U : constant VString := Node.VP.all;
+            S : String_Access;
+            L : Natural;
 
          begin
-            Dout
-              (Img (Node) & "matching " & Image (S.all));
+            Get_String (U, S, L);
+            Dout (Img (Node) & "matching " & Image (S (1 .. L)));
 
-            if (Length - Cursor) >= Len
-              and then S.all = Subject (Cursor + 1 .. Cursor + Len)
+            if (Length - Cursor) >= L
+              and then S (1 .. L) = Subject (Cursor + 1 .. Cursor + L)
             then
-               Cursor := Cursor + Len;
+               Cursor := Cursor + L;
                goto Succeed;
             else
                goto Fail;

diff --git a/gcc/ada/g-spipat.ads b/gcc/ada/g-spipat.ads
index 3a62e1c0ec1a4f2af08182f68d37b9f248e611a3..4574da1d589d6660e940392a82ec26dbb2175c38 100644 (file)
--- a/gcc/ada/g-spipat.ads
+++ b/gcc/ada/g-spipat.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---           Copyright (C) 1997-2002 Ada Core Technologies, Inc.            --
+--           Copyright (C) 1997-2005 Ada Core Technologies, 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- --
@@ -953,23 +953,19 @@ pragma Elaborate_Body (Patterns);
 
    function Match
      (Subject : VString;
-      Pat     : Pattern)
-      return    Boolean;
+      Pat     : Pattern) return Boolean;
 
    function Match
      (Subject : VString;
-      Pat     : PString)
-      return    Boolean;
+      Pat     : PString) return Boolean;
 
    function Match
      (Subject : String;
-      Pat     : Pattern)
-      return    Boolean;
+      Pat     : Pattern) return Boolean;
 
    function Match
      (Subject : String;
-      Pat     : PString)
-      return    Boolean;
+      Pat     : PString) return Boolean;
 
    --  Replacement functions. The subject is matched against the pattern.
    --  Any immediate or deferred assignments or writes are executed, and
@@ -980,26 +976,22 @@ pragma Elaborate_Body (Patterns);
    function Match
      (Subject : VString_Var;
       Pat     : Pattern;
-      Replace : VString)
-      return    Boolean;
+      Replace : VString) return Boolean;
 
    function Match
      (Subject : VString_Var;
       Pat     : PString;
-      Replace : VString)
-      return    Boolean;
+      Replace : VString) return Boolean;
 
    function Match
      (Subject : VString_Var;
       Pat     : Pattern;
-      Replace : String)
-      return    Boolean;
+      Replace : String) return Boolean;
 
    function Match
      (Subject : VString_Var;
       Pat     : PString;
-      Replace : String)
-      return    Boolean;
+      Replace : String) return Boolean;
 
    --  Simple match procedures. The subject is matched against the pattern.
    --  Any immediate or deferred assignments or writes are executed. No
@@ -1063,8 +1055,7 @@ pragma Elaborate_Body (Patterns);
    function Match
      (Subject : VString_Var;
       Pat     : Pattern;
-      Result  : Match_Result_Var)
-      return    Boolean;
+      Result  : Match_Result_Var) return Boolean;
 
    procedure Match
      (Subject : in out VString;

diff --git a/gcc/ada/g-spitbo.adb b/gcc/ada/g-spitbo.adb
index 64613e12687826d71f34461a0beb7a26c5e9be0a..68eec8928422f04712129fae787d617d4e202359 100644 (file)
--- a/gcc/ada/g-spitbo.adb
+++ b/gcc/ada/g-spitbo.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---            Copyright (C) 1998-2002 Ada Core Technologies, Inc.           --
+--            Copyright (C) 1998-2005 Ada Core Technologies, 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- --
@@ -79,10 +79,9 @@ package body GNAT.Spitbol is
    ----------
 
    function Lpad
-     (Str  : VString;
-      Len  : Natural;
-      Pad  : Character := ' ')
-      return VString
+     (Str : VString;
+      Len : Natural;
+      Pad : Character := ' ') return VString
    is
    begin
       if Length (Str) >= Len then
@@ -93,10 +92,9 @@ package body GNAT.Spitbol is
    end Lpad;
 
    function Lpad
-     (Str  : String;
-      Len  : Natural;
-      Pad  : Character := ' ')
-      return VString
+     (Str : String;
+      Len : Natural;
+      Pad : Character := ' ') return VString
    is
    begin
       if Str'Length >= Len then
@@ -135,8 +133,11 @@ package body GNAT.Spitbol is
    -------
 
    function N (Str : VString) return Integer is
+      S : String_Access;
+      L : Natural;
    begin
-      return Integer'Value (Get_String (Str).all);
+      Get_String (Str, S, L);
+      return Integer'Value (S (1 .. L));
    end N;
 
    --------------------
@@ -144,16 +145,22 @@ package body GNAT.Spitbol is
    --------------------
 
    function Reverse_String (Str : VString) return VString is
-      Len    : constant Natural       := Length (Str);
-      Chars  : constant String_Access := Get_String (Str);
-      Result : String (1 .. Len);
+      S : String_Access;
+      L : Natural;
 
    begin
-      for J in 1 .. Len loop
-         Result (J) := Chars (Len + 1 - J);
-      end loop;
+      Get_String (Str, S, L);
 
-      return V (Result);
+      declare
+         Result : String (1 .. L);
+
+      begin
+         for J in 1 .. L loop
+            Result (J) := S (L + 1 - J);
+         end loop;
+
+         return V (Result);
+      end;
    end Reverse_String;
 
    function Reverse_String (Str : String) return VString is
@@ -168,16 +175,22 @@ package body GNAT.Spitbol is
    end Reverse_String;
 
    procedure Reverse_String (Str : in out VString) is
-      Len    : constant Natural := Length (Str);
-      Chars  : constant String_Access := Get_String (Str);
-      Temp   : Character;
+      S : String_Access;
+      L : Natural;
 
    begin
-      for J in 1 .. Len / 2 loop
-         Temp := Chars (J);
-         Chars (J) := Chars (Len + 1 - J);
-         Chars (Len + 1 - J) := Temp;
-      end loop;
+      Get_String (Str, S, L);
+
+      declare
+         Result : String (1 .. L);
+
+      begin
+         for J in 1 .. L loop
+            Result (J) := S (L + 1 - J);
+         end loop;
+
+         Set_String (Str, Result);
+      end;
    end Reverse_String;
 
    ----------
@@ -185,10 +198,9 @@ package body GNAT.Spitbol is
    ----------
 
    function Rpad
-     (Str  : VString;
-      Len  : Natural;
-      Pad  : Character := ' ')
-      return VString
+     (Str : VString;
+      Len : Natural;
+      Pad : Character := ' ') return VString
    is
    begin
       if Length (Str) >= Len then
@@ -199,10 +211,9 @@ package body GNAT.Spitbol is
    end Rpad;
 
    function Rpad
-     (Str  : String;
-      Len  : Natural;
-      Pad  : Character := ' ')
-      return VString
+     (Str : String;
+      Len : Natural;
+      Pad : Character := ' ') return VString
    is
    begin
       if Str'Length >= Len then
@@ -269,34 +280,33 @@ package body GNAT.Spitbol is
    function Substr
      (Str   : VString;
       Start : Positive;
-      Len   : Natural)
-      return  VString
+      Len   : Natural) return VString
    is
+      S : String_Access;
+      L : Natural;
+
    begin
-      if Start > Length (Str) then
-         raise Index_Error;
+      Get_String (Str, S, L);
 
-      elsif Start + Len - 1 > Length (Str) then
+      if Start > L then
+         raise Index_Error;
+      elsif Start + Len - 1 > L then
          raise Length_Error;
-
       else
-         return V (Get_String (Str).all (Start .. Start + Len - 1));
+         return V (S (Start .. Start + Len - 1));
       end if;
    end Substr;
 
    function Substr
      (Str   : String;
       Start : Positive;
-      Len   : Natural)
-      return  VString
+      Len   : Natural) return VString
    is
    begin
       if Start > Str'Length then
          raise Index_Error;
-
       elsif Start + Len > Str'Length then
          raise Length_Error;
-
       else
          return
            V (Str (Str'First + Start - 1 .. Str'First + Start + Len - 2));
@@ -446,8 +456,11 @@ package body GNAT.Spitbol is
       end Delete;
 
       procedure Delete (T : in out Table; Name  : VString) is
+         S : String_Access;
+         L : Natural;
       begin
-         Delete (T, Get_String (Name).all);
+         Get_String (Name, S, L);
+         Delete (T, S (1 .. L));
       end Delete;
 
       procedure Delete (T : in out Table; Name  : String) is
@@ -569,8 +582,11 @@ package body GNAT.Spitbol is
       end Get;
 
       function Get (T : Table; Name : VString) return Value_Type is
+         S : String_Access;
+         L : Natural;
       begin
-         return Get (T, Get_String (Name).all);
+         Get_String (Name, S, L);
+         return Get (T, S (1 .. L));
       end Get;
 
       function Get (T : Table; Name : String) return Value_Type is
@@ -623,8 +639,11 @@ package body GNAT.Spitbol is
       end Present;
 
       function Present (T : Table; Name : VString) return Boolean is
+         S : String_Access;
+         L : Natural;
       begin
-         return Present (T, Get_String (Name).all);
+         Get_String (Name, S, L);
+         return Present (T, S (1 .. L));
       end Present;
 
       function Present (T : Table; Name : String) return Boolean is
@@ -656,8 +675,11 @@ package body GNAT.Spitbol is
       ---------
 
       procedure Set (T : in out Table; Name : VString; Value : Value_Type) is
+         S : String_Access;
+         L : Natural;
       begin
-         Set (T, Get_String (Name).all, Value);
+         Get_String (Name, S, L);
+         Set (T, S (1 .. L), Value);
       end Set;
 
       procedure Set (T : in out Table; Name : Character; Value : Value_Type) is

diff --git a/gcc/ada/g-spitbo.ads b/gcc/ada/g-spitbo.ads
index 1bac7f357eefcdc1bdd687e96dc2260eaa64bd8e..0a96ca57a6ffa46ef849d38755b6e47a514fab66 100644 (file)
--- a/gcc/ada/g-spitbo.ads
+++ b/gcc/ada/g-spitbo.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---           Copyright (C) 1997-1999 Ada Core Technologies, Inc.            --
+--           Copyright (C) 1997-2005 Ada Core Technologies, 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- --
@@ -120,15 +120,13 @@ pragma Preelaborate (Spitbol);
    --  Equivalent to Character'Val (Num)
 
    function Lpad
-     (Str  : VString;
-      Len  : Natural;
-      Pad  : Character := ' ')
-      return VString;
+     (Str : VString;
+      Len : Natural;
+      Pad : Character := ' ') return VString;
    function Lpad
-     (Str  : String;
-      Len  : Natural;
-      Pad  : Character := ' ')
-      return VString;
+     (Str : String;
+      Len : Natural;
+      Pad : Character := ' ') return VString;
    --  If the length of Str is greater than or equal to Len, then Str is
    --  returned unchanged. Otherwise, The value returned is obtained by
    --  concatenating Length (Str) - Len instances of the Pad character to
@@ -151,15 +149,13 @@ pragma Preelaborate (Spitbol);
    --  result overwrites the input argument Str.
 
    function Rpad
-     (Str  : VString;
-      Len  : Natural;
-      Pad  : Character := ' ')
-      return VString;
+     (Str : VString;
+      Len : Natural;
+      Pad : Character := ' ') return VString;
    function Rpad
-     (Str  : String;
-      Len  : Natural;
-      Pad  : Character := ' ')
-      return VString;
+     (Str : String;
+      Len : Natural;
+      Pad : Character := ' ') return VString;
    --  If the length of Str is greater than or equal to Len, then Str is
    --  returned unchanged. Otherwise, The value returned is obtained by
    --  concatenating Length (Str) - Len instances of the Pad character to
@@ -178,13 +174,11 @@ pragma Preelaborate (Spitbol);
    function Substr
      (Str   : VString;
       Start : Positive;
-      Len   : Natural)
-      return  VString;
+      Len   : Natural) return  VString;
    function Substr
      (Str   : String;
       Start : Positive;
-      Len   : Natural)
-      return  VString;
+      Len   : Natural) return  VString;
    --  Returns the substring starting at the given character position (which
    --  is always counted from the start of the string, regardless of bounds,
    --  e.g. 2 means starting with the second character of the string), and