aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.8.1/gcc/ada/a-stzmap.adb
diff options
context:
space:
mode:
authorDan Albert <danalbert@google.com>2016-01-14 16:43:34 -0800
committerDan Albert <danalbert@google.com>2016-01-22 14:51:24 -0800
commit3186be22b6598fbd467b126347d1c7f48ccb7f71 (patch)
tree2b176d3ce027fa5340160978effeb88ec9054aaa /gcc-4.8.1/gcc/ada/a-stzmap.adb
parenta45222a0e5951558bd896b0513bf638eb376e086 (diff)
downloadtoolchain_gcc-3186be22b6598fbd467b126347d1c7f48ccb7f71.tar.gz
toolchain_gcc-3186be22b6598fbd467b126347d1c7f48ccb7f71.tar.bz2
toolchain_gcc-3186be22b6598fbd467b126347d1c7f48ccb7f71.zip
Check in a pristine copy of GCC 4.8.1.
The copy of GCC that we use for Android is still not working for mingw. Rather than finding all the differences that have crept into our GCC, just check in a copy from ftp://ftp.gnu.org/gnu/gcc/gcc-4.9.3/gcc-4.8.1.tar.bz2. GCC 4.8.1 was chosen because it is what we have been using for mingw thus far, and the emulator doesn't yet work when upgrading to 4.9. Bug: http://b/26523949 Change-Id: Iedc0f05243d4332cc27ccd46b8a4b203c88dcaa3
Diffstat (limited to 'gcc-4.8.1/gcc/ada/a-stzmap.adb')
-rw-r--r--gcc-4.8.1/gcc/ada/a-stzmap.adb742
1 files changed, 742 insertions, 0 deletions
diff --git a/gcc-4.8.1/gcc/ada/a-stzmap.adb b/gcc-4.8.1/gcc/ada/a-stzmap.adb
new file mode 100644
index 000000000..08cae19bd
--- /dev/null
+++ b/gcc-4.8.1/gcc/ada/a-stzmap.adb
@@ -0,0 +1,742 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . S T R I N G S . W I D E _ W I D E _ M A P S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2009, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Deallocation;
+
+package body Ada.Strings.Wide_Wide_Maps is
+
+ ---------
+ -- "-" --
+ ---------
+
+ function "-"
+ (Left, Right : Wide_Wide_Character_Set) return Wide_Wide_Character_Set
+ is
+ LS : constant Wide_Wide_Character_Ranges_Access := Left.Set;
+ RS : constant Wide_Wide_Character_Ranges_Access := Right.Set;
+
+ Result : Wide_Wide_Character_Ranges (1 .. LS'Last + RS'Last);
+ -- Each range on the right can generate at least one more range in
+ -- the result, by splitting one of the left operand ranges.
+
+ N : Natural := 0;
+ R : Natural := 1;
+ L : Natural := 1;
+
+ Left_Low : Wide_Wide_Character;
+ -- Left_Low is lowest character of the L'th range not yet dealt with
+
+ begin
+ if LS'Last = 0 or else RS'Last = 0 then
+ return Left;
+ end if;
+
+ Left_Low := LS (L).Low;
+ while R <= RS'Last loop
+
+ -- If next right range is below current left range, skip it
+
+ if RS (R).High < Left_Low then
+ R := R + 1;
+
+ -- If next right range above current left range, copy remainder of
+ -- the left range to the result
+
+ elsif RS (R).Low > LS (L).High then
+ N := N + 1;
+ Result (N).Low := Left_Low;
+ Result (N).High := LS (L).High;
+ L := L + 1;
+ exit when L > LS'Last;
+ Left_Low := LS (L).Low;
+
+ else
+ -- Next right range overlaps bottom of left range
+
+ if RS (R).Low <= Left_Low then
+
+ -- Case of right range complete overlaps left range
+
+ if RS (R).High >= LS (L).High then
+ L := L + 1;
+ exit when L > LS'Last;
+ Left_Low := LS (L).Low;
+
+ -- Case of right range eats lower part of left range
+
+ else
+ Left_Low := Wide_Wide_Character'Succ (RS (R).High);
+ R := R + 1;
+ end if;
+
+ -- Next right range overlaps some of left range, but not bottom
+
+ else
+ N := N + 1;
+ Result (N).Low := Left_Low;
+ Result (N).High := Wide_Wide_Character'Pred (RS (R).Low);
+
+ -- Case of right range splits left range
+
+ if RS (R).High < LS (L).High then
+ Left_Low := Wide_Wide_Character'Succ (RS (R).High);
+ R := R + 1;
+
+ -- Case of right range overlaps top of left range
+
+ else
+ L := L + 1;
+ exit when L > LS'Last;
+ Left_Low := LS (L).Low;
+ end if;
+ end if;
+ end if;
+ end loop;
+
+ -- Copy remainder of left ranges to result
+
+ if L <= LS'Last then
+ N := N + 1;
+ Result (N).Low := Left_Low;
+ Result (N).High := LS (L).High;
+
+ loop
+ L := L + 1;
+ exit when L > LS'Last;
+ N := N + 1;
+ Result (N) := LS (L);
+ end loop;
+ end if;
+
+ return (AF.Controlled with
+ Set => new Wide_Wide_Character_Ranges'(Result (1 .. N)));
+ end "-";
+
+ ---------
+ -- "=" --
+ ---------
+
+ -- The sorted, discontiguous form is canonical, so equality can be used
+
+ function "=" (Left, Right : Wide_Wide_Character_Set) return Boolean is
+ begin
+ return Left.Set.all = Right.Set.all;
+ end "=";
+
+ -----------
+ -- "and" --
+ -----------
+
+ function "and"
+ (Left, Right : Wide_Wide_Character_Set) return Wide_Wide_Character_Set
+ is
+ LS : constant Wide_Wide_Character_Ranges_Access := Left.Set;
+ RS : constant Wide_Wide_Character_Ranges_Access := Right.Set;
+
+ Result : Wide_Wide_Character_Ranges (1 .. LS'Last + RS'Last);
+ N : Natural := 0;
+ L, R : Natural := 1;
+
+ begin
+ -- Loop to search for overlapping character ranges
+
+ while L <= LS'Last and then R <= RS'Last loop
+
+ if LS (L).High < RS (R).Low then
+ L := L + 1;
+
+ elsif RS (R).High < LS (L).Low then
+ R := R + 1;
+
+ -- Here we have LS (L).High >= RS (R).Low
+ -- and RS (R).High >= LS (L).Low
+ -- so we have an overlapping range
+
+ else
+ N := N + 1;
+ Result (N).Low :=
+ Wide_Wide_Character'Max (LS (L).Low, RS (R).Low);
+ Result (N).High :=
+ Wide_Wide_Character'Min (LS (L).High, RS (R).High);
+
+ if RS (R).High = LS (L).High then
+ L := L + 1;
+ R := R + 1;
+ elsif RS (R).High < LS (L).High then
+ R := R + 1;
+ else
+ L := L + 1;
+ end if;
+ end if;
+ end loop;
+
+ return (AF.Controlled with
+ Set => new Wide_Wide_Character_Ranges'(Result (1 .. N)));
+ end "and";
+
+ -----------
+ -- "not" --
+ -----------
+
+ function "not"
+ (Right : Wide_Wide_Character_Set) return Wide_Wide_Character_Set
+ is
+ RS : constant Wide_Wide_Character_Ranges_Access := Right.Set;
+
+ Result : Wide_Wide_Character_Ranges (1 .. RS'Last + 1);
+ N : Natural := 0;
+
+ begin
+ if RS'Last = 0 then
+ N := 1;
+ Result (1) := (Low => Wide_Wide_Character'First,
+ High => Wide_Wide_Character'Last);
+
+ else
+ if RS (1).Low /= Wide_Wide_Character'First then
+ N := N + 1;
+ Result (N).Low := Wide_Wide_Character'First;
+ Result (N).High := Wide_Wide_Character'Pred (RS (1).Low);
+ end if;
+
+ for K in 1 .. RS'Last - 1 loop
+ N := N + 1;
+ Result (N).Low := Wide_Wide_Character'Succ (RS (K).High);
+ Result (N).High := Wide_Wide_Character'Pred (RS (K + 1).Low);
+ end loop;
+
+ if RS (RS'Last).High /= Wide_Wide_Character'Last then
+ N := N + 1;
+ Result (N).Low := Wide_Wide_Character'Succ (RS (RS'Last).High);
+ Result (N).High := Wide_Wide_Character'Last;
+ end if;
+ end if;
+
+ return (AF.Controlled with
+ Set => new Wide_Wide_Character_Ranges'(Result (1 .. N)));
+ end "not";
+
+ ----------
+ -- "or" --
+ ----------
+
+ function "or"
+ (Left, Right : Wide_Wide_Character_Set) return Wide_Wide_Character_Set
+ is
+ LS : constant Wide_Wide_Character_Ranges_Access := Left.Set;
+ RS : constant Wide_Wide_Character_Ranges_Access := Right.Set;
+
+ Result : Wide_Wide_Character_Ranges (1 .. LS'Last + RS'Last);
+ N : Natural;
+ L, R : Natural;
+
+ begin
+ N := 0;
+ L := 1;
+ R := 1;
+
+ -- Loop through ranges in output file
+
+ loop
+ -- If no left ranges left, copy next right range
+
+ if L > LS'Last then
+ exit when R > RS'Last;
+ N := N + 1;
+ Result (N) := RS (R);
+ R := R + 1;
+
+ -- If no right ranges left, copy next left range
+
+ elsif R > RS'Last then
+ N := N + 1;
+ Result (N) := LS (L);
+ L := L + 1;
+
+ else
+ -- We have two ranges, choose lower one
+
+ N := N + 1;
+
+ if LS (L).Low <= RS (R).Low then
+ Result (N) := LS (L);
+ L := L + 1;
+ else
+ Result (N) := RS (R);
+ R := R + 1;
+ end if;
+
+ -- Loop to collapse ranges into last range
+
+ loop
+ -- Collapse next length range into current result range
+ -- if possible.
+
+ if L <= LS'Last
+ and then LS (L).Low <=
+ Wide_Wide_Character'Succ (Result (N).High)
+ then
+ Result (N).High :=
+ Wide_Wide_Character'Max (Result (N).High, LS (L).High);
+ L := L + 1;
+
+ -- Collapse next right range into current result range
+ -- if possible
+
+ elsif R <= RS'Last
+ and then RS (R).Low <=
+ Wide_Wide_Character'Succ (Result (N).High)
+ then
+ Result (N).High :=
+ Wide_Wide_Character'Max (Result (N).High, RS (R).High);
+ R := R + 1;
+
+ -- If neither range collapses, then done with this range
+
+ else
+ exit;
+ end if;
+ end loop;
+ end if;
+ end loop;
+
+ return (AF.Controlled with
+ Set => new Wide_Wide_Character_Ranges'(Result (1 .. N)));
+ end "or";
+
+ -----------
+ -- "xor" --
+ -----------
+
+ function "xor"
+ (Left, Right : Wide_Wide_Character_Set) return Wide_Wide_Character_Set
+ is
+ begin
+ return (Left or Right) - (Left and Right);
+ end "xor";
+
+ ------------
+ -- Adjust --
+ ------------
+
+ procedure Adjust (Object : in out Wide_Wide_Character_Mapping) is
+ begin
+ Object.Map := new Wide_Wide_Character_Mapping_Values'(Object.Map.all);
+ end Adjust;
+
+ procedure Adjust (Object : in out Wide_Wide_Character_Set) is
+ begin
+ Object.Set := new Wide_Wide_Character_Ranges'(Object.Set.all);
+ end Adjust;
+
+ --------------
+ -- Finalize --
+ --------------
+
+ procedure Finalize (Object : in out Wide_Wide_Character_Mapping) is
+
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Wide_Wide_Character_Mapping_Values,
+ Wide_Wide_Character_Mapping_Values_Access);
+
+ begin
+ if Object.Map /= Null_Map'Unrestricted_Access then
+ Free (Object.Map);
+ end if;
+ end Finalize;
+
+ procedure Finalize (Object : in out Wide_Wide_Character_Set) is
+
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Wide_Wide_Character_Ranges,
+ Wide_Wide_Character_Ranges_Access);
+
+ begin
+ if Object.Set /= Null_Range'Unrestricted_Access then
+ Free (Object.Set);
+ end if;
+ end Finalize;
+
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize (Object : in out Wide_Wide_Character_Mapping) is
+ begin
+ Object := Identity;
+ end Initialize;
+
+ procedure Initialize (Object : in out Wide_Wide_Character_Set) is
+ begin
+ Object := Null_Set;
+ end Initialize;
+
+ -----------
+ -- Is_In --
+ -----------
+
+ function Is_In
+ (Element : Wide_Wide_Character;
+ Set : Wide_Wide_Character_Set) return Boolean
+ is
+ L, R, M : Natural;
+ SS : constant Wide_Wide_Character_Ranges_Access := Set.Set;
+
+ begin
+ L := 1;
+ R := SS'Last;
+
+ -- Binary search loop. The invariant is that if Element is in any of
+ -- of the constituent ranges it is in one between Set (L) and Set (R).
+
+ loop
+ if L > R then
+ return False;
+
+ else
+ M := (L + R) / 2;
+
+ if Element > SS (M).High then
+ L := M + 1;
+ elsif Element < SS (M).Low then
+ R := M - 1;
+ else
+ return True;
+ end if;
+ end if;
+ end loop;
+ end Is_In;
+
+ ---------------
+ -- Is_Subset --
+ ---------------
+
+ function Is_Subset
+ (Elements : Wide_Wide_Character_Set;
+ Set : Wide_Wide_Character_Set) return Boolean
+ is
+ ES : constant Wide_Wide_Character_Ranges_Access := Elements.Set;
+ SS : constant Wide_Wide_Character_Ranges_Access := Set.Set;
+
+ S : Positive := 1;
+ E : Positive := 1;
+
+ begin
+ loop
+ -- If no more element ranges, done, and result is true
+
+ if E > ES'Last then
+ return True;
+
+ -- If more element ranges, but no more set ranges, result is false
+
+ elsif S > SS'Last then
+ return False;
+
+ -- Remove irrelevant set range
+
+ elsif SS (S).High < ES (E).Low then
+ S := S + 1;
+
+ -- Get rid of element range that is properly covered by set
+
+ elsif SS (S).Low <= ES (E).Low
+ and then ES (E).High <= SS (S).High
+ then
+ E := E + 1;
+
+ -- Otherwise we have a non-covered element range, result is false
+
+ else
+ return False;
+ end if;
+ end loop;
+ end Is_Subset;
+
+ ---------------
+ -- To_Domain --
+ ---------------
+
+ function To_Domain
+ (Map : Wide_Wide_Character_Mapping) return Wide_Wide_Character_Sequence
+ is
+ begin
+ return Map.Map.Domain;
+ end To_Domain;
+
+ ----------------
+ -- To_Mapping --
+ ----------------
+
+ function To_Mapping
+ (From, To : Wide_Wide_Character_Sequence)
+ return Wide_Wide_Character_Mapping
+ is
+ Domain : Wide_Wide_Character_Sequence (1 .. From'Length);
+ Rangev : Wide_Wide_Character_Sequence (1 .. To'Length);
+ N : Natural := 0;
+
+ begin
+ if From'Length /= To'Length then
+ raise Translation_Error;
+
+ else
+ pragma Warnings (Off); -- apparent uninit use of Domain
+
+ for J in From'Range loop
+ for M in 1 .. N loop
+ if From (J) = Domain (M) then
+ raise Translation_Error;
+ elsif From (J) < Domain (M) then
+ Domain (M + 1 .. N + 1) := Domain (M .. N);
+ Rangev (M + 1 .. N + 1) := Rangev (M .. N);
+ Domain (M) := From (J);
+ Rangev (M) := To (J);
+ goto Continue;
+ end if;
+ end loop;
+
+ Domain (N + 1) := From (J);
+ Rangev (N + 1) := To (J);
+
+ <<Continue>>
+ N := N + 1;
+ end loop;
+
+ pragma Warnings (On);
+
+ return (AF.Controlled with
+ Map => new Wide_Wide_Character_Mapping_Values'(
+ Length => N,
+ Domain => Domain (1 .. N),
+ Rangev => Rangev (1 .. N)));
+ end if;
+ end To_Mapping;
+
+ --------------
+ -- To_Range --
+ --------------
+
+ function To_Range
+ (Map : Wide_Wide_Character_Mapping) return Wide_Wide_Character_Sequence
+ is
+ begin
+ return Map.Map.Rangev;
+ end To_Range;
+
+ ---------------
+ -- To_Ranges --
+ ---------------
+
+ function To_Ranges
+ (Set : Wide_Wide_Character_Set) return Wide_Wide_Character_Ranges
+ is
+ begin
+ return Set.Set.all;
+ end To_Ranges;
+
+ -----------------
+ -- To_Sequence --
+ -----------------
+
+ function To_Sequence
+ (Set : Wide_Wide_Character_Set) return Wide_Wide_Character_Sequence
+ is
+ SS : constant Wide_Wide_Character_Ranges_Access := Set.Set;
+
+ Result : Wide_Wide_String (Positive range 1 .. 2 ** 16);
+ N : Natural := 0;
+
+ begin
+ for J in SS'Range loop
+ for K in SS (J).Low .. SS (J).High loop
+ N := N + 1;
+ Result (N) := K;
+ end loop;
+ end loop;
+
+ return Result (1 .. N);
+ end To_Sequence;
+
+ ------------
+ -- To_Set --
+ ------------
+
+ -- Case of multiple range input
+
+ function To_Set
+ (Ranges : Wide_Wide_Character_Ranges) return Wide_Wide_Character_Set
+ is
+ Result : Wide_Wide_Character_Ranges (Ranges'Range);
+ N : Natural := 0;
+ J : Natural;
+
+ begin
+ -- The output of To_Set is required to be sorted by increasing Low
+ -- values, and discontiguous, so first we sort them as we enter them,
+ -- using a simple insertion sort.
+
+ pragma Warnings (Off);
+ -- Kill bogus warning on Result being uninitialized
+
+ for J in Ranges'Range loop
+ for K in 1 .. N loop
+ if Ranges (J).Low < Result (K).Low then
+ Result (K + 1 .. N + 1) := Result (K .. N);
+ Result (K) := Ranges (J);
+ goto Continue;
+ end if;
+ end loop;
+
+ Result (N + 1) := Ranges (J);
+
+ <<Continue>>
+ N := N + 1;
+ end loop;
+
+ pragma Warnings (On);
+
+ -- Now collapse any contiguous or overlapping ranges
+
+ J := 1;
+ while J < N loop
+ if Result (J).High < Result (J).Low then
+ N := N - 1;
+ Result (J .. N) := Result (J + 1 .. N + 1);
+
+ elsif Wide_Wide_Character'Succ (Result (J).High) >=
+ Result (J + 1).Low
+ then
+ Result (J).High :=
+ Wide_Wide_Character'Max (Result (J).High, Result (J + 1).High);
+
+ N := N - 1;
+ Result (J + 1 .. N) := Result (J + 2 .. N + 1);
+
+ else
+ J := J + 1;
+ end if;
+ end loop;
+
+ if Result (N).High < Result (N).Low then
+ N := N - 1;
+ end if;
+
+ return (AF.Controlled with
+ Set => new Wide_Wide_Character_Ranges'(Result (1 .. N)));
+ end To_Set;
+
+ -- Case of single range input
+
+ function To_Set
+ (Span : Wide_Wide_Character_Range) return Wide_Wide_Character_Set
+ is
+ begin
+ if Span.Low > Span.High then
+ return Null_Set;
+ -- This is safe, because there is no procedure with parameter
+ -- Wide_Wide_Character_Set of mode "out" or "in out".
+
+ else
+ return (AF.Controlled with
+ Set => new Wide_Wide_Character_Ranges'(1 => Span));
+ end if;
+ end To_Set;
+
+ -- Case of wide string input
+
+ function To_Set
+ (Sequence : Wide_Wide_Character_Sequence) return Wide_Wide_Character_Set
+ is
+ R : Wide_Wide_Character_Ranges (1 .. Sequence'Length);
+
+ begin
+ for J in R'Range loop
+ R (J) := (Sequence (J), Sequence (J));
+ end loop;
+
+ return To_Set (R);
+ end To_Set;
+
+ -- Case of single wide character input
+
+ function To_Set
+ (Singleton : Wide_Wide_Character) return Wide_Wide_Character_Set
+ is
+ begin
+ return
+ (AF.Controlled with
+ Set => new Wide_Wide_Character_Ranges'(1 => (Singleton, Singleton)));
+ end To_Set;
+
+ -----------
+ -- Value --
+ -----------
+
+ function Value
+ (Map : Wide_Wide_Character_Mapping;
+ Element : Wide_Wide_Character) return Wide_Wide_Character
+ is
+ L, R, M : Natural;
+
+ MV : constant Wide_Wide_Character_Mapping_Values_Access := Map.Map;
+
+ begin
+ L := 1;
+ R := MV.Domain'Last;
+
+ -- Binary search loop
+
+ loop
+ -- If not found, identity
+
+ if L > R then
+ return Element;
+
+ -- Otherwise do binary divide
+
+ else
+ M := (L + R) / 2;
+
+ if Element < MV.Domain (M) then
+ R := M - 1;
+
+ elsif Element > MV.Domain (M) then
+ L := M + 1;
+
+ else -- Element = MV.Domain (M) then
+ return MV.Rangev (M);
+ end if;
+ end if;
+ end loop;
+ end Value;
+
+end Ada.Strings.Wide_Wide_Maps;