diff options
142 files changed, 14587 insertions, 7009 deletions
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 4c01553fe50..282cbff9569 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -1,5 +1,5 @@ # Makefile.rtl for GNU Ada Compiler (GNAT). -# Copyright (C) 2003 Free Software Foundation, Inc. +# Copyright (C) 2003, 2004 Free Software Foundation, Inc. #This file is part of GCC. @@ -75,13 +75,40 @@ GNATRTL_TASKING_OBJS= \ GNATRTL_NONTASKING_OBJS= \ a-caldel$(objext) \ a-calend$(objext) \ + a-cdlili$(objext) \ + a-cgaaso$(objext) \ + a-cgarso$(objext) \ + a-cgcaso$(objext) \ a-chahan$(objext) \ a-charac$(objext) \ a-chlat1$(objext) \ a-chlat9$(objext) \ + a-chtgke$(objext) \ + a-chtgop$(objext) \ + a-chzla1$(objext) \ + a-chzla9$(objext) \ + a-cidlli$(objext) \ + a-cihama$(objext) \ + a-cihase$(objext) \ + a-ciorma$(objext) \ + a-ciormu$(objext) \ + a-ciorse$(objext) \ + a-cohama$(objext) \ + a-cohase$(objext) \ + a-cohata$(objext) \ + a-coinve$(objext) \ a-colien$(objext) \ a-colire$(objext) \ a-comlin$(objext) \ + a-contai$(objext) \ + a-convec$(objext) \ + a-coorma$(objext) \ + a-coormu$(objext) \ + a-coorse$(objext) \ + a-coprnu$(objext) \ + a-crbltr$(objext) \ + a-crbtgk$(objext) \ + a-crbtgo$(objext) \ a-cwila1$(objext) \ a-cwila9$(objext) \ a-decima$(objext) \ @@ -102,12 +129,16 @@ GNATRTL_NONTASKING_OBJS= \ a-iwteio$(objext) \ a-lfteio$(objext) \ a-lfwtio$(objext) \ + a-lfztio$(objext) \ a-liteio$(objext) \ a-liwtio$(objext) \ + a-liztio$(objext) \ a-llftio$(objext) \ a-llfwti$(objext) \ + a-llfzti$(objext) \ a-llitio$(objext) \ a-lliwti$(objext) \ + a-llizti$(objext) \ a-ncelfu$(objext) \ a-ngcefu$(objext) \ a-ngcoty$(objext) \ @@ -127,20 +158,28 @@ GNATRTL_NONTASKING_OBJS= \ a-nuflra$(objext) \ a-numaux$(objext) \ a-numeri$(objext) \ + a-rbtgso$(objext) \ + a-secain$(objext) \ a-sequio$(objext) \ a-sfteio$(objext) \ a-sfwtio$(objext) \ + a-sfztio$(objext) \ + a-shcain$(objext) \ a-siocst$(objext) \ a-siteio$(objext) \ a-siwtio$(objext) \ + a-siztio$(objext) \ + a-slcain$(objext) \ a-ssicst$(objext) \ a-ssitio$(objext) \ a-ssiwti$(objext) \ + a-ssizti$(objext) \ a-stmaco$(objext) \ a-storio$(objext) \ a-strbou$(objext) \ a-stream$(objext) \ a-strfix$(objext) \ + a-strhas$(objext) \ a-string$(objext) \ a-strmap$(objext) \ a-strsea$(objext) \ @@ -148,15 +187,30 @@ GNATRTL_NONTASKING_OBJS= \ a-strunb$(objext) \ a-ststio$(objext) \ a-stunau$(objext) \ + a-stunha$(objext) \ a-stwibo$(objext) \ a-stwifi$(objext) \ + a-stwiha$(objext) \ a-stwima$(objext) \ a-stwise$(objext) \ a-stwisu$(objext) \ a-stwiun$(objext) \ + a-stzbou$(objext) \ + a-stzfix$(objext) \ + a-stzhas$(objext) \ + a-stzmap$(objext) \ + a-stzsea$(objext) \ + a-stzsup$(objext) \ + a-stzunb$(objext) \ a-suteio$(objext) \ - a-swuwti$(objext) \ a-swmwco$(objext) \ + a-swunau$(objext) \ + a-swunha$(objext) \ + a-swuwti$(objext) \ + a-szmzco$(objext) \ + a-szunau$(objext) \ + a-szunha$(objext) \ + a-szuzti$(objext) \ a-tags$(objext) \ a-teioed$(objext) \ a-textio$(objext) \ @@ -176,6 +230,7 @@ GNATRTL_NONTASKING_OBJS= \ a-timoio$(objext) \ a-tiocst$(objext) \ a-titest$(objext) \ + a-tiunio$(objext) \ a-unccon$(objext) \ a-uncdea$(objext) \ a-witeio$(objext) \ @@ -196,6 +251,26 @@ GNATRTL_NONTASKING_OBJS= \ a-wtmoau$(objext) \ a-wtmoio$(objext) \ a-wttest$(objext) \ + a-wwunio$(objext) \ + a-ztcoau$(objext) \ + a-ztcoio$(objext) \ + a-ztcstr$(objext) \ + a-ztdeau$(objext) \ + a-ztdeio$(objext) \ + a-ztedit$(objext) \ + a-ztenau$(objext) \ + a-ztenio$(objext) \ + a-ztexio$(objext) \ + a-ztfiio$(objext) \ + a-ztflau$(objext) \ + a-ztflio$(objext) \ + a-ztgeau$(objext) \ + a-ztinau$(objext) \ + a-ztinio$(objext) \ + a-ztmoau$(objext) \ + a-ztmoio$(objext) \ + a-zttest$(objext) \ + a-zzunio$(objext) \ ada$(objext) \ calendar$(objext) \ g-arrspl$(objext) \ @@ -256,7 +331,9 @@ GNATRTL_NONTASKING_OBJS= \ g-table$(objext) \ g-tasloc$(objext) \ g-traceb$(objext) \ + g-utf_32$(objext) \ g-wistsp$(objext) \ + g-zstspl$(objext) \ gnat$(objext) \ i-c$(objext) \ i-cexten$(objext) \ diff --git a/gcc/ada/a-chahan.adb b/gcc/ada/a-chahan.adb index 11733401137..c94a999ddf3 100644 --- a/gcc/ada/a-chahan.adb +++ b/gcc/ada/a-chahan.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2001 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- -- @@ -281,7 +281,7 @@ package body Ada.Characters.Handling is -- Is_Alphanumeric -- --------------------- - function Is_Alphanumeric (Item : in Character) return Boolean is + function Is_Alphanumeric (Item : Character) return Boolean is begin return (Char_Map (Item) and Alphanum) /= 0; end Is_Alphanumeric; @@ -290,7 +290,7 @@ package body Ada.Characters.Handling is -- Is_Basic -- -------------- - function Is_Basic (Item : in Character) return Boolean is + function Is_Basic (Item : Character) return Boolean is begin return (Char_Map (Item) and Basic) /= 0; end Is_Basic; @@ -299,16 +299,21 @@ package body Ada.Characters.Handling is -- Is_Character -- ------------------ - function Is_Character (Item : in Wide_Character) return Boolean is + function Is_Character (Item : Wide_Character) return Boolean is begin return Wide_Character'Pos (Item) < 256; end Is_Character; + function Is_Character (Item : Wide_Wide_Character) return Boolean is + begin + return Wide_Wide_Character'Pos (Item) < 256; + end Is_Character; + ---------------- -- Is_Control -- ---------------- - function Is_Control (Item : in Character) return Boolean is + function Is_Control (Item : Character) return Boolean is begin return (Char_Map (Item) and Control) /= 0; end Is_Control; @@ -317,7 +322,7 @@ package body Ada.Characters.Handling is -- Is_Digit -- -------------- - function Is_Digit (Item : in Character) return Boolean is + function Is_Digit (Item : Character) return Boolean is begin return Item in '0' .. '9'; end Is_Digit; @@ -326,7 +331,7 @@ package body Ada.Characters.Handling is -- Is_Graphic -- ---------------- - function Is_Graphic (Item : in Character) return Boolean is + function Is_Graphic (Item : Character) return Boolean is begin return (Char_Map (Item) and Graphic) /= 0; end Is_Graphic; @@ -335,7 +340,7 @@ package body Ada.Characters.Handling is -- Is_Hexadecimal_Digit -- -------------------------- - function Is_Hexadecimal_Digit (Item : in Character) return Boolean is + function Is_Hexadecimal_Digit (Item : Character) return Boolean is begin return (Char_Map (Item) and Hex_Digit) /= 0; end Is_Hexadecimal_Digit; @@ -344,7 +349,7 @@ package body Ada.Characters.Handling is -- Is_ISO_646 -- ---------------- - function Is_ISO_646 (Item : in Character) return Boolean is + function Is_ISO_646 (Item : Character) return Boolean is begin return Item in ISO_646; end Is_ISO_646; @@ -352,7 +357,7 @@ package body Ada.Characters.Handling is -- Note: much more efficient coding of the following function is possible -- by testing several 16#80# bits in a complete word in a single operation - function Is_ISO_646 (Item : in String) return Boolean is + function Is_ISO_646 (Item : String) return Boolean is begin for J in Item'Range loop if Item (J) not in ISO_646 then @@ -367,7 +372,7 @@ package body Ada.Characters.Handling is -- Is_Letter -- --------------- - function Is_Letter (Item : in Character) return Boolean is + function Is_Letter (Item : Character) return Boolean is begin return (Char_Map (Item) and Letter) /= 0; end Is_Letter; @@ -376,7 +381,7 @@ package body Ada.Characters.Handling is -- Is_Lower -- -------------- - function Is_Lower (Item : in Character) return Boolean is + function Is_Lower (Item : Character) return Boolean is begin return (Char_Map (Item) and Lower) /= 0; end Is_Lower; @@ -385,7 +390,7 @@ package body Ada.Characters.Handling is -- Is_Special -- ---------------- - function Is_Special (Item : in Character) return Boolean is + function Is_Special (Item : Character) return Boolean is begin return (Char_Map (Item) and Special) /= 0; end Is_Special; @@ -394,7 +399,7 @@ package body Ada.Characters.Handling is -- Is_String -- --------------- - function Is_String (Item : in Wide_String) return Boolean is + function Is_String (Item : Wide_String) return Boolean is begin for J in Item'Range loop if Wide_Character'Pos (Item (J)) >= 256 then @@ -405,25 +410,60 @@ package body Ada.Characters.Handling is return True; end Is_String; + function Is_String (Item : Wide_Wide_String) return Boolean is + begin + for J in Item'Range loop + if Wide_Wide_Character'Pos (Item (J)) >= 256 then + return False; + end if; + end loop; + + return True; + end Is_String; + -------------- -- Is_Upper -- -------------- - function Is_Upper (Item : in Character) return Boolean is + function Is_Upper (Item : Character) return Boolean is begin return (Char_Map (Item) and Upper) /= 0; end Is_Upper; + ----------------------- + -- Is_Wide_Character -- + ----------------------- + + function Is_Wide_Character (Item : Wide_Wide_Character) return Boolean is + begin + return Wide_Wide_Character'Pos (Item) < 2**16; + end Is_Wide_Character; + + -------------------- + -- Is_Wide_String -- + -------------------- + + function Is_Wide_String (Item : Wide_Wide_String) return Boolean is + begin + for J in Item'Range loop + if Wide_Wide_Character'Pos (Item (J)) >= 2**16 then + return False; + end if; + end loop; + + return True; + end Is_Wide_String; + -------------- -- To_Basic -- -------------- - function To_Basic (Item : in Character) return Character is + function To_Basic (Item : Character) return Character is begin return Value (Basic_Map, Item); end To_Basic; - function To_Basic (Item : in String) return String is + function To_Basic (Item : String) return String is Result : String (1 .. Item'Length); begin @@ -439,9 +479,8 @@ package body Ada.Characters.Handling is ------------------ function To_Character - (Item : in Wide_Character; - Substitute : in Character := ' ') - return Character + (Item : Wide_Character; + Substitute : Character := ' ') return Character is begin if Is_Character (Item) then @@ -451,14 +490,25 @@ package body Ada.Characters.Handling is end if; end To_Character; + function To_Character + (Item : Wide_Wide_Character; + Substitute : Character := ' ') return Character + is + begin + if Is_Character (Item) then + return Character'Val (Wide_Wide_Character'Pos (Item)); + else + return Substitute; + end if; + end To_Character; + ---------------- -- To_ISO_646 -- ---------------- function To_ISO_646 - (Item : in Character; - Substitute : in ISO_646 := ' ') - return ISO_646 + (Item : Character; + Substitute : ISO_646 := ' ') return ISO_646 is begin if Item in ISO_646 then @@ -469,9 +519,8 @@ package body Ada.Characters.Handling is end To_ISO_646; function To_ISO_646 - (Item : in String; - Substitute : in ISO_646 := ' ') - return String + (Item : String; + Substitute : ISO_646 := ' ') return String is Result : String (1 .. Item'Length); @@ -491,12 +540,12 @@ package body Ada.Characters.Handling is -- To_Lower -- -------------- - function To_Lower (Item : in Character) return Character is + function To_Lower (Item : Character) return Character is begin return Value (Lower_Case_Map, Item); end To_Lower; - function To_Lower (Item : in String) return String is + function To_Lower (Item : String) return String is Result : String (1 .. Item'Length); begin @@ -512,9 +561,22 @@ package body Ada.Characters.Handling is --------------- function To_String - (Item : in Wide_String; - Substitute : in Character := ' ') - return String + (Item : Wide_String; + Substitute : Character := ' ') return String + is + Result : String (1 .. Item'Length); + + begin + for J in Item'Range loop + Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute); + end loop; + + return Result; + end To_String; + + function To_String + (Item : Wide_Wide_String; + Substitute : Character := ' ') return String is Result : String (1 .. Item'Length); @@ -522,6 +584,7 @@ package body Ada.Characters.Handling is for J in Item'Range loop Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute); end loop; + return Result; end To_String; @@ -530,16 +593,14 @@ package body Ada.Characters.Handling is -------------- function To_Upper - (Item : in Character) - return Character + (Item : Character) return Character is begin return Value (Upper_Case_Map, Item); end To_Upper; function To_Upper - (Item : in String) - return String + (Item : String) return String is Result : String (1 .. Item'Length); @@ -556,20 +617,30 @@ package body Ada.Characters.Handling is ----------------------- function To_Wide_Character - (Item : in Character) - return Wide_Character + (Item : Character) return Wide_Character is begin return Wide_Character'Val (Character'Pos (Item)); end To_Wide_Character; + function To_Wide_Character + (Item : Wide_Wide_Character; + Substitute : Wide_Character := ' ') return Wide_Character + is + begin + if Wide_Wide_Character'Pos (Item) < 2**16 then + return Wide_Character'Val (Wide_Wide_Character'Pos (Item)); + else + return Substitute; + end if; + end To_Wide_Character; + -------------------- -- To_Wide_String -- -------------------- function To_Wide_String - (Item : in String) - return Wide_String + (Item : String) return Wide_String is Result : Wide_String (1 .. Item'Length); @@ -580,4 +651,68 @@ package body Ada.Characters.Handling is return Result; end To_Wide_String; + + function To_Wide_String + (Item : Wide_Wide_String; + Substitute : Wide_Character := ' ') return Wide_String + is + Result : Wide_String (1 .. Item'Length); + + begin + for J in Item'Range loop + Result (J - (Item'First - 1)) := + To_Wide_Character (Item (J), Substitute); + end loop; + + return Result; + end To_Wide_String; + + ---------------------------- + -- To_Wide_Wide_Character -- + ---------------------------- + + function To_Wide_Wide_Character + (Item : Character) return Wide_Wide_Character + is + begin + return Wide_Wide_Character'Val (Character'Pos (Item)); + end To_Wide_Wide_Character; + + function To_Wide_Wide_Character + (Item : Wide_Character) return Wide_Wide_Character + is + begin + return Wide_Wide_Character'Val (Wide_Character'Pos (Item)); + end To_Wide_Wide_Character; + + ------------------------- + -- To_Wide_Wide_String -- + ------------------------- + + function To_Wide_Wide_String + (Item : String) return Wide_Wide_String + is + Result : Wide_Wide_String (1 .. Item'Length); + + begin + for J in Item'Range loop + Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J)); + end loop; + + return Result; + end To_Wide_Wide_String; + + function To_Wide_Wide_String + (Item : Wide_String) return Wide_Wide_String + is + Result : Wide_Wide_String (1 .. Item'Length); + + begin + for J in Item'Range loop + Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J)); + end loop; + + return Result; + end To_Wide_Wide_String; + end Ada.Characters.Handling; diff --git a/gcc/ada/a-chahan.ads b/gcc/ada/a-chahan.ads index 0a0162d1d67..ca29d752419 100644 --- a/gcc/ada/a-chahan.ads +++ b/gcc/ada/a-chahan.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-1997 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -43,30 +43,30 @@ pragma Preelaborate (Handling); -- Character Classification Functions -- ---------------------------------------- - function Is_Control (Item : in Character) return Boolean; - function Is_Graphic (Item : in Character) return Boolean; - function Is_Letter (Item : in Character) return Boolean; - function Is_Lower (Item : in Character) return Boolean; - function Is_Upper (Item : in Character) return Boolean; - function Is_Basic (Item : in Character) return Boolean; - function Is_Digit (Item : in Character) return Boolean; - function Is_Decimal_Digit (Item : in Character) return Boolean - renames Is_Digit; - function Is_Hexadecimal_Digit (Item : in Character) return Boolean; - function Is_Alphanumeric (Item : in Character) return Boolean; - function Is_Special (Item : in Character) return Boolean; + function Is_Control (Item : Character) return Boolean; + function Is_Graphic (Item : Character) return Boolean; + function Is_Letter (Item : Character) return Boolean; + function Is_Lower (Item : Character) return Boolean; + function Is_Upper (Item : Character) return Boolean; + function Is_Basic (Item : Character) return Boolean; + function Is_Digit (Item : Character) return Boolean; + function Is_Decimal_Digit (Item : Character) return Boolean + renames Is_Digit; + function Is_Hexadecimal_Digit (Item : Character) return Boolean; + function Is_Alphanumeric (Item : Character) return Boolean; + function Is_Special (Item : Character) return Boolean; --------------------------------------------------- -- Conversion Functions for Character and String -- --------------------------------------------------- - function To_Lower (Item : in Character) return Character; - function To_Upper (Item : in Character) return Character; - function To_Basic (Item : in Character) return Character; + function To_Lower (Item : Character) return Character; + function To_Upper (Item : Character) return Character; + function To_Basic (Item : Character) return Character; - function To_Lower (Item : in String) return String; - function To_Upper (Item : in String) return String; - function To_Basic (Item : in String) return String; + function To_Lower (Item : String) return String; + function To_Upper (Item : String) return String; + function To_Basic (Item : String) return String; ---------------------------------------------------------------------- -- Classifications of and Conversions Between Character and ISO 646 -- @@ -75,42 +75,69 @@ pragma Preelaborate (Handling); subtype ISO_646 is Character range Character'Val (0) .. Character'Val (127); - function Is_ISO_646 (Item : in Character) return Boolean; - function Is_ISO_646 (Item : in String) return Boolean; + function Is_ISO_646 (Item : Character) return Boolean; + function Is_ISO_646 (Item : String) return Boolean; function To_ISO_646 - (Item : in Character; - Substitute : in ISO_646 := ' ') - return ISO_646; + (Item : Character; + Substitute : ISO_646 := ' ') return ISO_646; function To_ISO_646 - (Item : in String; - Substitute : in ISO_646 := ' ') - return String; + (Item : String; + Substitute : ISO_646 := ' ') return String; ------------------------------------------------------ -- Classifications of Wide_Character and Characters -- ------------------------------------------------------ - function Is_Character (Item : in Wide_Character) return Boolean; - function Is_String (Item : in Wide_String) return Boolean; + function Is_Character (Item : Wide_Character) return Boolean; + function Is_Character (Item : Wide_Wide_Character) return Boolean; + function Is_String (Item : Wide_String) return Boolean; + function Is_String (Item : Wide_Wide_String) return Boolean; + function Is_Wide_Character (Item : Wide_Wide_Character) return Boolean; + function Is_Wide_String (Item : Wide_Wide_String) return Boolean; - ------------------------------------------------------ - -- Conversions between Wide_Character and Character -- - ------------------------------------------------------ + --------------------------------------------------------------------------- + -- Conversions between Wide_Wide_Character, Wide_Character and Character -- + --------------------------------------------------------------------------- function To_Character - (Item : in Wide_Character; - Substitute : in Character := ' ') - return Character; + (Item : Wide_Character; + Substitute : Character := ' ') return Character; + + function To_Character + (Item : Wide_Wide_Character; + Substitute : Character := ' ') return Character; function To_String - (Item : in Wide_String; - Substitute : in Character := ' ') - return String; + (Item : Wide_String; + Substitute : Character := ' ') return String; - function To_Wide_Character (Item : in Character) return Wide_Character; - function To_Wide_String (Item : in String) return Wide_String; + function To_String + (Item : Wide_Wide_String; + Substitute : Character := ' ') return String; + + function To_Wide_Character + (Item : Character) return Wide_Character; + function To_Wide_Character + (Item : Wide_Wide_Character; + Substitute : Wide_Character := ' ') return Wide_Character; + + function To_Wide_String + (Item : String) return Wide_String; + function To_Wide_String + (Item : Wide_Wide_String; + Substitute : Wide_Character := ' ') return Wide_String; + + function To_Wide_Wide_Character + (Item : Character) return Wide_Wide_Character; + function To_Wide_Wide_Character + (Item : Wide_Character) return Wide_Wide_Character; + + function To_Wide_Wide_String + (Item : String) return Wide_Wide_String; + function To_Wide_Wide_String + (Item : Wide_String) return Wide_Wide_String; private pragma Inline (Is_Control); @@ -130,5 +157,6 @@ private pragma Inline (Is_Character); pragma Inline (To_Character); pragma Inline (To_Wide_Character); + pragma Inline (To_Wide_Wide_Character); end Ada.Characters.Handling; diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb index 1ca819011c5..7470d545039 100644 --- a/gcc/ada/a-except.adb +++ b/gcc/ada/a-except.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -484,6 +484,7 @@ package body Ada.Exceptions is procedure Rcheck_27 (File : Big_String_Ptr; Line : Integer); procedure Rcheck_28 (File : Big_String_Ptr; Line : Integer); procedure Rcheck_29 (File : Big_String_Ptr; Line : Integer); + procedure Rcheck_30 (File : Big_String_Ptr; Line : Integer); pragma Export (C, Rcheck_00, "__gnat_rcheck_00"); pragma Export (C, Rcheck_01, "__gnat_rcheck_01"); @@ -515,6 +516,7 @@ package body Ada.Exceptions is pragma Export (C, Rcheck_27, "__gnat_rcheck_27"); pragma Export (C, Rcheck_28, "__gnat_rcheck_28"); pragma Export (C, Rcheck_29, "__gnat_rcheck_29"); + pragma Export (C, Rcheck_30, "__gnat_rcheck_30"); -- None of these procedures ever returns (they raise an exception!). By -- using pragma No_Return, we ensure that any junk code after the call, @@ -550,6 +552,7 @@ package body Ada.Exceptions is pragma No_Return (Rcheck_27); pragma No_Return (Rcheck_28); pragma No_Return (Rcheck_29); + pragma No_Return (Rcheck_30); --------------------------------------------- -- Reason Strings for Run-Time Check Calls -- @@ -568,29 +571,30 @@ package body Ada.Exceptions is Rmsg_05 : constant String := "index check failed" & NUL; Rmsg_06 : constant String := "invalid data" & NUL; Rmsg_07 : constant String := "length check failed" & NUL; - Rmsg_08 : constant String := "overflow check failed" & NUL; - Rmsg_09 : constant String := "partition check failed" & NUL; - Rmsg_10 : constant String := "range check failed" & NUL; - Rmsg_11 : constant String := "tag check failed" & NUL; - Rmsg_12 : constant String := "access before elaboration" & NUL; - Rmsg_13 : constant String := "accessibility check failed" & NUL; - Rmsg_14 : constant String := "all guards closed" & NUL; - Rmsg_15 : constant String := "duplicated entry address" & NUL; - Rmsg_16 : constant String := "explicit raise" & NUL; - Rmsg_17 : constant String := "finalize/adjust raised exception" & NUL; - Rmsg_18 : constant String := "misaligned address value" & NUL; - Rmsg_19 : constant String := "missing return" & NUL; - Rmsg_20 : constant String := "overlaid controlled object" & NUL; - Rmsg_21 : constant String := "potentially blocking operation" & NUL; - Rmsg_22 : constant String := "stubbed subprogram called" & NUL; - Rmsg_23 : constant String := "unchecked union restriction" & NUL; - Rmsg_24 : constant String := "illegal use of" + Rmsg_08 : constant String := "null-exclusion check failed" & NUL; + Rmsg_09 : constant String := "overflow check failed" & NUL; + Rmsg_10 : constant String := "partition check failed" & NUL; + Rmsg_11 : constant String := "range check failed" & NUL; + Rmsg_12 : constant String := "tag check failed" & NUL; + Rmsg_13 : constant String := "access before elaboration" & NUL; + Rmsg_14 : constant String := "accessibility check failed" & NUL; + Rmsg_15 : constant String := "all guards closed" & NUL; + Rmsg_16 : constant String := "duplicated entry address" & NUL; + Rmsg_17 : constant String := "explicit raise" & NUL; + Rmsg_18 : constant String := "finalize/adjust raised exception" & NUL; + Rmsg_19 : constant String := "misaligned address value" & NUL; + Rmsg_20 : constant String := "missing return" & NUL; + Rmsg_21 : constant String := "overlaid controlled object" & NUL; + Rmsg_22 : constant String := "potentially blocking operation" & NUL; + Rmsg_23 : constant String := "stubbed subprogram called" & NUL; + Rmsg_24 : constant String := "unchecked union restriction" & NUL; + Rmsg_25 : constant String := "illegal use of" & " remote access-to-class-wide type, see RM E.4(18)" & NUL; - Rmsg_25 : constant String := "empty storage pool" & NUL; - Rmsg_26 : constant String := "explicit raise" & NUL; - Rmsg_27 : constant String := "infinite recursion" & NUL; - Rmsg_28 : constant String := "object too large" & NUL; - Rmsg_29 : constant String := "restriction violation" & NUL; + Rmsg_26 : constant String := "empty storage pool" & NUL; + Rmsg_27 : constant String := "explicit raise" & NUL; + Rmsg_28 : constant String := "infinite recursion" & NUL; + Rmsg_29 : constant String := "object too large" & NUL; + Rmsg_30 : constant String := "restriction violation" & NUL; ----------------------- -- Polling Interface -- @@ -1097,7 +1101,7 @@ package body Ada.Exceptions is procedure Rcheck_12 (File : Big_String_Ptr; Line : Integer) is begin - Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_12'Address)); + Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_12'Address)); end Rcheck_12; procedure Rcheck_13 (File : Big_String_Ptr; Line : Integer) is @@ -1162,7 +1166,7 @@ package body Ada.Exceptions is procedure Rcheck_25 (File : Big_String_Ptr; Line : Integer) is begin - Raise_Storage_Error_Msg (File, Line, To_Ptr (Rmsg_25'Address)); + Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_25'Address)); end Rcheck_25; procedure Rcheck_26 (File : Big_String_Ptr; Line : Integer) is @@ -1185,6 +1189,11 @@ package body Ada.Exceptions is Raise_Storage_Error_Msg (File, Line, To_Ptr (Rmsg_29'Address)); end Rcheck_29; + procedure Rcheck_30 (File : Big_String_Ptr; Line : Integer) is + begin + Raise_Storage_Error_Msg (File, Line, To_Ptr (Rmsg_30'Address)); + end Rcheck_30; + ------------- -- Reraise -- ------------- diff --git a/gcc/ada/a-strbou.adb b/gcc/ada/a-strbou.adb index 886c03ff68a..08d339d0b68 100644 --- a/gcc/ada/a-strbou.adb +++ b/gcc/ada/a-strbou.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 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- -- @@ -35,23 +35,26 @@ package body Ada.Strings.Bounded is package body Generic_Bounded_Length is + -- The subprograms in this body are those for which there is no + -- Bounded_String input, and hence no implicit information on the + -- maximum size. This means that the maximum size has to be passed + -- explicitly to the routine in Superbounded. + --------- -- "*" -- --------- function "*" - (Left : in Natural; - Right : in Character) - return Bounded_String + (Left : Natural; + Right : Character) return Bounded_String is begin return Times (Left, Right, Max_Length); end "*"; function "*" - (Left : in Natural; - Right : in String) - return Bounded_String + (Left : Natural; + Right : String) return Bounded_String is begin return Times (Left, Right, Max_Length); @@ -62,34 +65,30 @@ package body Ada.Strings.Bounded is --------------- function Replicate - (Count : in Natural; - Item : in Character; - Drop : in Strings.Truncation := Strings.Error) - return Bounded_String + (Count : Natural; + Item : Character; + Drop : Strings.Truncation := Strings.Error) return Bounded_String is begin return Super_Replicate (Count, Item, Drop, Max_Length); end Replicate; function Replicate - (Count : in Natural; - Item : in String; - Drop : in Strings.Truncation := Strings.Error) - return Bounded_String + (Count : Natural; + Item : String; + Drop : Strings.Truncation := Strings.Error) return Bounded_String is begin return Super_Replicate (Count, Item, Drop, Max_Length); end Replicate; - ----------------------- -- To_Bounded_String -- ----------------------- function To_Bounded_String - (Source : in String; - Drop : in Strings.Truncation := Strings.Error) - return Bounded_String + (Source : String; + Drop : Strings.Truncation := Strings.Error) return Bounded_String is begin return To_Super_String (Source, Max_Length, Drop); diff --git a/gcc/ada/a-strbou.ads b/gcc/ada/a-strbou.ads index 7e9f54f1b0a..5b8346ad102 100644 --- a/gcc/ada/a-strbou.ads +++ b/gcc/ada/a-strbou.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -55,214 +55,245 @@ pragma Preelaborate (Bounded); subtype Length_Range is Natural range 0 .. Max_Length; - function Length (Source : in Bounded_String) return Length_Range; + function Length (Source : Bounded_String) return Length_Range; -------------------------------------------------------- -- Conversion, Concatenation, and Selection Functions -- -------------------------------------------------------- function To_Bounded_String - (Source : in String; - Drop : in Truncation := Error) - return Bounded_String; + (Source : String; + Drop : Truncation := Error) return Bounded_String; - function To_String (Source : in Bounded_String) return String; + function To_String (Source : Bounded_String) return String; + + procedure Set_Bounded_String + (Target : out Bounded_String; + Source : String; + Drop : Truncation := Error); + pragma Ada_05 (Set_Bounded_String); function Append - (Left, Right : in Bounded_String; - Drop : in Truncation := Error) - return Bounded_String; + (Left : Bounded_String; + Right : Bounded_String; + Drop : Truncation := Error) return Bounded_String; function Append - (Left : in Bounded_String; - Right : in String; - Drop : in Truncation := Error) - return Bounded_String; + (Left : Bounded_String; + Right : String; + Drop : Truncation := Error) return Bounded_String; function Append - (Left : in String; - Right : in Bounded_String; - Drop : in Truncation := Error) - return Bounded_String; + (Left : String; + Right : Bounded_String; + Drop : Truncation := Error) return Bounded_String; function Append - (Left : in Bounded_String; - Right : in Character; - Drop : in Truncation := Error) - return Bounded_String; + (Left : Bounded_String; + Right : Character; + Drop : Truncation := Error) return Bounded_String; function Append - (Left : in Character; - Right : in Bounded_String; - Drop : in Truncation := Error) - return Bounded_String; + (Left : Character; + Right : Bounded_String; + Drop : Truncation := Error) return Bounded_String; procedure Append (Source : in out Bounded_String; - New_Item : in Bounded_String; - Drop : in Truncation := Error); + New_Item : Bounded_String; + Drop : Truncation := Error); procedure Append (Source : in out Bounded_String; - New_Item : in String; - Drop : in Truncation := Error); + New_Item : String; + Drop : Truncation := Error); procedure Append (Source : in out Bounded_String; - New_Item : in Character; - Drop : in Truncation := Error); + New_Item : Character; + Drop : Truncation := Error); function "&" - (Left, Right : in Bounded_String) - return Bounded_String; + (Left : Bounded_String; + Right : Bounded_String) return Bounded_String; function "&" - (Left : in Bounded_String; - Right : in String) - return Bounded_String; + (Left : Bounded_String; + Right : String) return Bounded_String; function "&" - (Left : in String; - Right : in Bounded_String) - return Bounded_String; + (Left : String; + Right : Bounded_String) return Bounded_String; function "&" - (Left : in Bounded_String; - Right : in Character) - return Bounded_String; + (Left : Bounded_String; + Right : Character) return Bounded_String; function "&" - (Left : in Character; - Right : in Bounded_String) - return Bounded_String; + (Left : Character; + Right : Bounded_String) return Bounded_String; function Element - (Source : in Bounded_String; - Index : in Positive) - return Character; + (Source : Bounded_String; + Index : Positive) return Character; procedure Replace_Element (Source : in out Bounded_String; - Index : in Positive; - By : in Character); + Index : Positive; + By : Character); function Slice - (Source : in Bounded_String; - Low : in Positive; - High : in Natural) - return String; + (Source : Bounded_String; + Low : Positive; + High : Natural) return String; + + function Bounded_Slice + (Source : Bounded_String; + Low : Positive; + High : Natural) return Bounded_String; + pragma Ada_05 (Bounded_Slice); + + procedure Bounded_Slice + (Source : Bounded_String; + Target : out Bounded_String; + Low : Positive; + High : Natural); + pragma Ada_05 (Bounded_Slice); - function "=" (Left, Right : in Bounded_String) return Boolean; + function "=" + (Left : Bounded_String; + Right : Bounded_String) return Boolean; function "=" - (Left : in Bounded_String; - Right : in String) - return Boolean; + (Left : Bounded_String; + Right : String) return Boolean; function "=" - (Left : in String; - Right : in Bounded_String) - return Boolean; + (Left : String; + Right : Bounded_String) return Boolean; - function "<" (Left, Right : in Bounded_String) return Boolean; + function "<" + (Left : Bounded_String; + Right : Bounded_String) return Boolean; function "<" - (Left : in Bounded_String; - Right : in String) - return Boolean; + (Left : Bounded_String; + Right : String) return Boolean; function "<" - (Left : in String; - Right : in Bounded_String) - return Boolean; + (Left : String; + Right : Bounded_String) return Boolean; - function "<=" (Left, Right : in Bounded_String) return Boolean; + function "<=" + (Left : Bounded_String; + Right : Bounded_String) return Boolean; function "<=" - (Left : in Bounded_String; - Right : in String) - return Boolean; + (Left : Bounded_String; + Right : String) return Boolean; function "<=" - (Left : in String; - Right : in Bounded_String) - return Boolean; + (Left : String; + Right : Bounded_String) return Boolean; - function ">" (Left, Right : in Bounded_String) return Boolean; + function ">" + (Left : Bounded_String; + Right : Bounded_String) return Boolean; function ">" - (Left : in Bounded_String; - Right : in String) - return Boolean; + (Left : Bounded_String; + Right : String) return Boolean; function ">" - (Left : in String; - Right : in Bounded_String) - return Boolean; + (Left : String; + Right : Bounded_String) return Boolean; - function ">=" (Left, Right : in Bounded_String) return Boolean; + function ">=" + (Left : Bounded_String; + Right : Bounded_String) return Boolean; function ">=" - (Left : in Bounded_String; - Right : in String) - return Boolean; + (Left : Bounded_String; + Right : String) return Boolean; function ">=" - (Left : in String; - Right : in Bounded_String) - return Boolean; + (Left : String; + Right : Bounded_String) return Boolean; ---------------------- -- Search Functions -- ---------------------- function Index - (Source : in Bounded_String; - Pattern : in String; - Going : in Direction := Forward; - Mapping : in Maps.Character_Mapping := Maps.Identity) - return Natural; + (Source : Bounded_String; + Pattern : String; + Going : Direction := Forward; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural; + + function Index + (Source : Bounded_String; + Pattern : String; + Going : Direction := Forward; + Mapping : Maps.Character_Mapping_Function) return Natural; function Index - (Source : in Bounded_String; - Pattern : in String; - Going : in Direction := Forward; - Mapping : in Maps.Character_Mapping_Function) - return Natural; + (Source : Bounded_String; + Set : Maps.Character_Set; + Test : Membership := Inside; + Going : Direction := Forward) return Natural; function Index - (Source : in Bounded_String; - Set : in Maps.Character_Set; - Test : in Membership := Inside; - Going : in Direction := Forward) - return Natural; + (Source : Bounded_String; + Pattern : String; + From : Positive; + Going : Direction := Forward; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural; + pragma Ada_05 (Index); + + function Index + (Source : Bounded_String; + Pattern : String; + From : Positive; + Going : Direction := Forward; + Mapping : Maps.Character_Mapping_Function) return Natural; + pragma Ada_05 (Index); + + function Index + (Source : Bounded_String; + Set : Maps.Character_Set; + From : Positive; + Test : Membership := Inside; + Going : Direction := Forward) return Natural; + pragma Ada_05 (Index); function Index_Non_Blank - (Source : in Bounded_String; - Going : in Direction := Forward) - return Natural; + (Source : Bounded_String; + Going : Direction := Forward) return Natural; + + function Index_Non_Blank + (Source : Bounded_String; + From : Positive; + Going : Direction := Forward) return Natural; + pragma Ada_05 (Index_Non_Blank); function Count - (Source : in Bounded_String; - Pattern : in String; - Mapping : in Maps.Character_Mapping := Maps.Identity) - return Natural; + (Source : Bounded_String; + Pattern : String; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural; function Count - (Source : in Bounded_String; - Pattern : in String; - Mapping : in Maps.Character_Mapping_Function) - return Natural; + (Source : Bounded_String; + Pattern : String; + Mapping : Maps.Character_Mapping_Function) return Natural; function Count - (Source : in Bounded_String; - Set : in Maps.Character_Set) - return Natural; + (Source : Bounded_String; + Set : Maps.Character_Set) return Natural; procedure Find_Token - (Source : in Bounded_String; - Set : in Maps.Character_Set; - Test : in Membership; + (Source : Bounded_String; + Set : Maps.Character_Set; + Test : Membership; First : out Positive; Last : out Natural); @@ -271,569 +302,588 @@ pragma Preelaborate (Bounded); ------------------------------------ function Translate - (Source : in Bounded_String; - Mapping : in Maps.Character_Mapping) - return Bounded_String; + (Source : Bounded_String; + Mapping : Maps.Character_Mapping) return Bounded_String; procedure Translate (Source : in out Bounded_String; - Mapping : in Maps.Character_Mapping); + Mapping : Maps.Character_Mapping); function Translate - (Source : in Bounded_String; - Mapping : in Maps.Character_Mapping_Function) - return Bounded_String; + (Source : Bounded_String; + Mapping : Maps.Character_Mapping_Function) return Bounded_String; procedure Translate (Source : in out Bounded_String; - Mapping : in Maps.Character_Mapping_Function); + Mapping : Maps.Character_Mapping_Function); --------------------------------------- -- String Transformation Subprograms -- --------------------------------------- function Replace_Slice - (Source : in Bounded_String; - Low : in Positive; - High : in Natural; - By : in String; - Drop : in Truncation := Error) - return Bounded_String; + (Source : Bounded_String; + Low : Positive; + High : Natural; + By : String; + Drop : Truncation := Error) return Bounded_String; procedure Replace_Slice (Source : in out Bounded_String; - Low : in Positive; - High : in Natural; - By : in String; - Drop : in Truncation := Error); + Low : Positive; + High : Natural; + By : String; + Drop : Truncation := Error); function Insert - (Source : in Bounded_String; - Before : in Positive; - New_Item : in String; - Drop : in Truncation := Error) - return Bounded_String; + (Source : Bounded_String; + Before : Positive; + New_Item : String; + Drop : Truncation := Error) return Bounded_String; procedure Insert (Source : in out Bounded_String; - Before : in Positive; - New_Item : in String; - Drop : in Truncation := Error); + Before : Positive; + New_Item : String; + Drop : Truncation := Error); function Overwrite - (Source : in Bounded_String; - Position : in Positive; - New_Item : in String; - Drop : in Truncation := Error) - return Bounded_String; + (Source : Bounded_String; + Position : Positive; + New_Item : String; + Drop : Truncation := Error) return Bounded_String; procedure Overwrite (Source : in out Bounded_String; - Position : in Positive; - New_Item : in String; - Drop : in Truncation := Error); + Position : Positive; + New_Item : String; + Drop : Truncation := Error); function Delete - (Source : in Bounded_String; - From : in Positive; - Through : in Natural) - return Bounded_String; + (Source : Bounded_String; + From : Positive; + Through : Natural) return Bounded_String; procedure Delete (Source : in out Bounded_String; - From : in Positive; - Through : in Natural); + From : Positive; + Through : Natural); --------------------------------- -- String Selector Subprograms -- --------------------------------- function Trim - (Source : in Bounded_String; - Side : in Trim_End) - return Bounded_String; + (Source : Bounded_String; + Side : Trim_End) return Bounded_String; procedure Trim (Source : in out Bounded_String; - Side : in Trim_End); + Side : Trim_End); function Trim - (Source : in Bounded_String; - Left : in Maps.Character_Set; - Right : in Maps.Character_Set) - return Bounded_String; + (Source : Bounded_String; + Left : Maps.Character_Set; + Right : Maps.Character_Set) return Bounded_String; procedure Trim (Source : in out Bounded_String; - Left : in Maps.Character_Set; - Right : in Maps.Character_Set); + Left : Maps.Character_Set; + Right : Maps.Character_Set); function Head - (Source : in Bounded_String; - Count : in Natural; - Pad : in Character := Space; - Drop : in Truncation := Error) - return Bounded_String; + (Source : Bounded_String; + Count : Natural; + Pad : Character := Space; + Drop : Truncation := Error) return Bounded_String; procedure Head (Source : in out Bounded_String; - Count : in Natural; - Pad : in Character := Space; - Drop : in Truncation := Error); + Count : Natural; + Pad : Character := Space; + Drop : Truncation := Error); function Tail - (Source : in Bounded_String; - Count : in Natural; - Pad : in Character := Space; - Drop : in Truncation := Error) - return Bounded_String; + (Source : Bounded_String; + Count : Natural; + Pad : Character := Space; + Drop : Truncation := Error) return Bounded_String; procedure Tail (Source : in out Bounded_String; - Count : in Natural; - Pad : in Character := Space; - Drop : in Truncation := Error); + Count : Natural; + Pad : Character := Space; + Drop : Truncation := Error); ------------------------------------ -- String Constructor Subprograms -- ------------------------------------ function "*" - (Left : in Natural; - Right : in Character) - return Bounded_String; + (Left : Natural; + Right : Character) return Bounded_String; function "*" - (Left : in Natural; - Right : in String) - return Bounded_String; + (Left : Natural; + Right : String) return Bounded_String; function "*" - (Left : in Natural; - Right : in Bounded_String) - return Bounded_String; + (Left : Natural; + Right : Bounded_String) return Bounded_String; function Replicate - (Count : in Natural; - Item : in Character; - Drop : in Truncation := Error) - return Bounded_String; + (Count : Natural; + Item : Character; + Drop : Truncation := Error) return Bounded_String; function Replicate - (Count : in Natural; - Item : in String; - Drop : in Truncation := Error) - return Bounded_String; + (Count : Natural; + Item : String; + Drop : Truncation := Error) return Bounded_String; function Replicate - (Count : in Natural; - Item : in Bounded_String; - Drop : in Truncation := Error) - return Bounded_String; + (Count : Natural; + Item : Bounded_String; + Drop : Truncation := Error) return Bounded_String; private - - -- Most of the implementation is in the non generic package + -- Most of the implementation is in the separate non generic package -- Ada.Strings.Superbounded. Type Bounded_String is derived from type - -- Superbounded.Super_String with the maximum length constraint. - -- Except for five, all subprograms are renames of subprograms that - -- are inherited from Superbounded.Super_String. + -- Superbounded.Super_String with the maximum length constraint. In + -- almost all cases, the routines in Superbounded can be called with + -- no requirement to pass the maximum length explicitly, since there + -- is at least one Bounded_String argument from which the maximum + -- length can be obtained. For all such routines, the implementation + -- in this private part is simply a renaming of the corresponding + -- routine in the super bouded package. + + -- The five exceptions are the * and Replicate routines operating on + -- character values. For these cases, we have a routine in the body + -- that calls the superbounded routine passing the maximum length + -- explicitly as an extra parameter. type Bounded_String is new Superbounded.Super_String (Max_Length); + -- Deriving Bounded_String from Superbounded.Super_String is the + -- real trick, it ensures that the type Bounded_String declared in + -- the generic instantiation is compatible with the Super_String + -- type declared in the Superbounded package. Null_Bounded_String : constant Bounded_String := - (Max_Length => Max_Length, - Current_Length => 0, - Data => (1 .. Max_Length => ASCII.NUL)); + (Max_Length => Max_Length, + Current_Length => 0, + Data => + (1 .. Max_Length => ASCII.NUL)); pragma Inline (To_Bounded_String); - function Length (Source : in Bounded_String) return Length_Range - renames Super_Length; + procedure Set_Bounded_String + (Target : out Bounded_String; + Source : String; + Drop : Truncation := Error) + renames Set_Super_String; - function To_String (Source : in Bounded_String) return String - renames Super_To_String; + function Length + (Source : Bounded_String) return Length_Range + renames Super_Length; + + function To_String + (Source : Bounded_String) return String + renames Super_To_String; function Append - (Left, Right : in Bounded_String; - Drop : in Truncation := Error) - return Bounded_String - renames Super_Append; + (Left : Bounded_String; + Right : Bounded_String; + Drop : Truncation := Error) return Bounded_String + renames Super_Append; function Append - (Left : in Bounded_String; - Right : in String; - Drop : in Truncation := Error) - return Bounded_String - renames Super_Append; + (Left : Bounded_String; + Right : String; + Drop : Truncation := Error) return Bounded_String + renames Super_Append; function Append - (Left : in String; - Right : in Bounded_String; - Drop : in Truncation := Error) - return Bounded_String - renames Super_Append; + (Left : String; + Right : Bounded_String; + Drop : Truncation := Error) return Bounded_String + renames Super_Append; function Append - (Left : in Bounded_String; - Right : in Character; - Drop : in Truncation := Error) - return Bounded_String - renames Super_Append; + (Left : Bounded_String; + Right : Character; + Drop : Truncation := Error) return Bounded_String + renames Super_Append; function Append - (Left : in Character; - Right : in Bounded_String; - Drop : in Truncation := Error) - return Bounded_String - renames Super_Append; + (Left : Character; + Right : Bounded_String; + Drop : Truncation := Error) return Bounded_String + renames Super_Append; procedure Append (Source : in out Bounded_String; - New_Item : in Bounded_String; - Drop : in Truncation := Error) - renames Super_Append; + New_Item : Bounded_String; + Drop : Truncation := Error) + renames Super_Append; procedure Append (Source : in out Bounded_String; - New_Item : in String; - Drop : in Truncation := Error) - renames Super_Append; + New_Item : String; + Drop : Truncation := Error) + renames Super_Append; procedure Append (Source : in out Bounded_String; - New_Item : in Character; - Drop : in Truncation := Error) - renames Super_Append; + New_Item : Character; + Drop : Truncation := Error) + renames Super_Append; function "&" - (Left, Right : in Bounded_String) - return Bounded_String - renames Concat; + (Left : Bounded_String; + Right : Bounded_String) return Bounded_String + renames Concat; function "&" - (Left : in Bounded_String; - Right : in String) - return Bounded_String - renames Concat; + (Left : Bounded_String; + Right : String) return Bounded_String + renames Concat; function "&" - (Left : in String; - Right : in Bounded_String) - return Bounded_String - renames Concat; + (Left : String; + Right : Bounded_String) return Bounded_String + renames Concat; function "&" - (Left : in Bounded_String; - Right : in Character) - return Bounded_String - renames Concat; + (Left : Bounded_String; + Right : Character) return Bounded_String + renames Concat; function "&" - (Left : in Character; - Right : in Bounded_String) - return Bounded_String - renames Concat; + (Left : Character; + Right : Bounded_String) return Bounded_String + renames Concat; function Element - (Source : in Bounded_String; - Index : in Positive) - return Character - renames Super_Element; + (Source : Bounded_String; + Index : Positive) return Character + renames Super_Element; procedure Replace_Element (Source : in out Bounded_String; - Index : in Positive; - By : in Character) - renames Super_Replace_Element; + Index : Positive; + By : Character) + renames Super_Replace_Element; function Slice - (Source : in Bounded_String; - Low : in Positive; - High : in Natural) - return String - renames Super_Slice; + (Source : Bounded_String; + Low : Positive; + High : Natural) return String + renames Super_Slice; + + function Bounded_Slice + (Source : Bounded_String; + Low : Positive; + High : Natural) return Bounded_String + renames Super_Slice; + + procedure Bounded_Slice + (Source : Bounded_String; + Target : out Bounded_String; + Low : Positive; + High : Natural) + renames Super_Slice; - function "=" (Left, Right : in Bounded_String) return Boolean - renames Equal; + function "=" + (Left : Bounded_String; + Right : Bounded_String) return Boolean + renames Equal; function "=" - (Left : in Bounded_String; - Right : in String) - return Boolean - renames Equal; + (Left : Bounded_String; + Right : String) return Boolean + renames Equal; function "=" - (Left : in String; - Right : in Bounded_String) - return Boolean - renames Equal; + (Left : String; + Right : Bounded_String) return Boolean + renames Equal; - function "<" (Left, Right : in Bounded_String) return Boolean - renames Less; + function "<" + (Left : Bounded_String; + Right : Bounded_String) return Boolean + renames Less; function "<" - (Left : in Bounded_String; - Right : in String) - return Boolean - renames Less; + (Left : Bounded_String; + Right : String) return Boolean + renames Less; function "<" - (Left : in String; - Right : in Bounded_String) - return Boolean - renames Less; + (Left : String; + Right : Bounded_String) return Boolean + renames Less; - function "<=" (Left, Right : in Bounded_String) return Boolean - renames Less_Or_Equal; + function "<=" + (Left : Bounded_String; + Right : Bounded_String) return Boolean + renames Less_Or_Equal; function "<=" - (Left : in Bounded_String; - Right : in String) - return Boolean - renames Less_Or_Equal; + (Left : Bounded_String; + Right : String) return Boolean + renames Less_Or_Equal; function "<=" - (Left : in String; - Right : in Bounded_String) - return Boolean - renames Less_Or_Equal; + (Left : String; + Right : Bounded_String) return Boolean + renames Less_Or_Equal; - function ">" (Left, Right : in Bounded_String) return Boolean - renames Greater; + function ">" + (Left : Bounded_String; + Right : Bounded_String) return Boolean + renames Greater; function ">" - (Left : in Bounded_String; - Right : in String) - return Boolean - renames Greater; + (Left : Bounded_String; + Right : String) return Boolean + renames Greater; function ">" - (Left : in String; - Right : in Bounded_String) - return Boolean - renames Greater; + (Left : String; + Right : Bounded_String) return Boolean + renames Greater; - function ">=" (Left, Right : in Bounded_String) return Boolean - renames Greater_Or_Equal; + function ">=" + (Left : Bounded_String; + Right : Bounded_String) return Boolean + renames Greater_Or_Equal; function ">=" - (Left : in Bounded_String; - Right : in String) - return Boolean - renames Greater_Or_Equal; + (Left : Bounded_String; + Right : String) return Boolean + renames Greater_Or_Equal; function ">=" - (Left : in String; - Right : in Bounded_String) - return Boolean - renames Greater_Or_Equal; + (Left : String; + Right : Bounded_String) return Boolean + renames Greater_Or_Equal; + + function Index + (Source : Bounded_String; + Pattern : String; + Going : Direction := Forward; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural + renames Super_Index; + + function Index + (Source : Bounded_String; + Pattern : String; + Going : Direction := Forward; + Mapping : Maps.Character_Mapping_Function) return Natural + renames Super_Index; function Index - (Source : in Bounded_String; - Pattern : in String; - Going : in Direction := Forward; - Mapping : in Maps.Character_Mapping := Maps.Identity) - return Natural - renames Super_Index; + (Source : Bounded_String; + Set : Maps.Character_Set; + Test : Membership := Inside; + Going : Direction := Forward) return Natural + renames Super_Index; function Index - (Source : in Bounded_String; - Pattern : in String; - Going : in Direction := Forward; - Mapping : in Maps.Character_Mapping_Function) - return Natural - renames Super_Index; + (Source : Bounded_String; + Pattern : String; + From : Positive; + Going : Direction := Forward; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural + renames Super_Index; function Index - (Source : in Bounded_String; - Set : in Maps.Character_Set; - Test : in Membership := Inside; - Going : in Direction := Forward) - return Natural - renames Super_Index; + (Source : Bounded_String; + Pattern : String; + From : Positive; + Going : Direction := Forward; + Mapping : Maps.Character_Mapping_Function) return Natural + renames Super_Index; + + function Index + (Source : Bounded_String; + Set : Maps.Character_Set; + From : Positive; + Test : Membership := Inside; + Going : Direction := Forward) return Natural + renames Super_Index; + + function Index_Non_Blank + (Source : Bounded_String; + Going : Direction := Forward) return Natural + renames Super_Index_Non_Blank; function Index_Non_Blank - (Source : in Bounded_String; - Going : in Direction := Forward) - return Natural - renames Super_Index_Non_Blank; + (Source : Bounded_String; + From : Positive; + Going : Direction := Forward) return Natural + renames Super_Index_Non_Blank; function Count - (Source : in Bounded_String; - Pattern : in String; - Mapping : in Maps.Character_Mapping := Maps.Identity) - return Natural - renames Super_Count; + (Source : Bounded_String; + Pattern : String; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural + renames Super_Count; function Count - (Source : in Bounded_String; - Pattern : in String; - Mapping : in Maps.Character_Mapping_Function) - return Natural - renames Super_Count; + (Source : Bounded_String; + Pattern : String; + Mapping : Maps.Character_Mapping_Function) return Natural + renames Super_Count; function Count - (Source : in Bounded_String; - Set : in Maps.Character_Set) - return Natural - renames Super_Count; + (Source : Bounded_String; + Set : Maps.Character_Set) return Natural + renames Super_Count; procedure Find_Token - (Source : in Bounded_String; - Set : in Maps.Character_Set; - Test : in Membership; + (Source : Bounded_String; + Set : Maps.Character_Set; + Test : Membership; First : out Positive; Last : out Natural) - renames Super_Find_Token; + renames Super_Find_Token; function Translate - (Source : in Bounded_String; - Mapping : in Maps.Character_Mapping) - return Bounded_String - renames Super_Translate; + (Source : Bounded_String; + Mapping : Maps.Character_Mapping) return Bounded_String + renames Super_Translate; procedure Translate (Source : in out Bounded_String; - Mapping : in Maps.Character_Mapping) - renames Super_Translate; + Mapping : Maps.Character_Mapping) + renames Super_Translate; function Translate - (Source : in Bounded_String; - Mapping : in Maps.Character_Mapping_Function) - return Bounded_String - renames Super_Translate; + (Source : Bounded_String; + Mapping : Maps.Character_Mapping_Function) return Bounded_String + renames Super_Translate; procedure Translate (Source : in out Bounded_String; - Mapping : in Maps.Character_Mapping_Function) - renames Super_Translate; + Mapping : Maps.Character_Mapping_Function) + renames Super_Translate; function Replace_Slice - (Source : in Bounded_String; - Low : in Positive; - High : in Natural; - By : in String; - Drop : in Truncation := Error) - return Bounded_String - renames Super_Replace_Slice; + (Source : Bounded_String; + Low : Positive; + High : Natural; + By : String; + Drop : Truncation := Error) return Bounded_String + renames Super_Replace_Slice; procedure Replace_Slice (Source : in out Bounded_String; - Low : in Positive; - High : in Natural; - By : in String; - Drop : in Truncation := Error) - renames Super_Replace_Slice; + Low : Positive; + High : Natural; + By : String; + Drop : Truncation := Error) + renames Super_Replace_Slice; function Insert - (Source : in Bounded_String; - Before : in Positive; - New_Item : in String; - Drop : in Truncation := Error) - return Bounded_String - renames Super_Insert; + (Source : Bounded_String; + Before : Positive; + New_Item : String; + Drop : Truncation := Error) return Bounded_String + renames Super_Insert; procedure Insert (Source : in out Bounded_String; - Before : in Positive; - New_Item : in String; - Drop : in Truncation := Error) - renames Super_Insert; + Before : Positive; + New_Item : String; + Drop : Truncation := Error) + renames Super_Insert; function Overwrite - (Source : in Bounded_String; - Position : in Positive; - New_Item : in String; - Drop : in Truncation := Error) - return Bounded_String - renames Super_Overwrite; + (Source : Bounded_String; + Position : Positive; + New_Item : String; + Drop : Truncation := Error) return Bounded_String + renames Super_Overwrite; procedure Overwrite (Source : in out Bounded_String; - Position : in Positive; - New_Item : in String; - Drop : in Truncation := Error) - renames Super_Overwrite; + Position : Positive; + New_Item : String; + Drop : Truncation := Error) + renames Super_Overwrite; function Delete - (Source : in Bounded_String; - From : in Positive; - Through : in Natural) - return Bounded_String - renames Super_Delete; + (Source : Bounded_String; + From : Positive; + Through : Natural) return Bounded_String + renames Super_Delete; procedure Delete (Source : in out Bounded_String; - From : in Positive; - Through : in Natural) - renames Super_Delete; + From : Positive; + Through : Natural) + renames Super_Delete; function Trim - (Source : in Bounded_String; - Side : in Trim_End) - return Bounded_String - renames Super_Trim; + (Source : Bounded_String; + Side : Trim_End) return Bounded_String + renames Super_Trim; procedure Trim (Source : in out Bounded_String; - Side : in Trim_End) - renames Super_Trim; + Side : Trim_End) + renames Super_Trim; function Trim - (Source : in Bounded_String; - Left : in Maps.Character_Set; - Right : in Maps.Character_Set) - return Bounded_String - renames Super_Trim; + (Source : Bounded_String; + Left : Maps.Character_Set; + Right : Maps.Character_Set) return Bounded_String + renames Super_Trim; procedure Trim (Source : in out Bounded_String; - Left : in Maps.Character_Set; - Right : in Maps.Character_Set) - renames Super_Trim; + Left : Maps.Character_Set; + Right : Maps.Character_Set) + renames Super_Trim; function Head - (Source : in Bounded_String; - Count : in Natural; - Pad : in Character := Space; - Drop : in Truncation := Error) - return Bounded_String - renames Super_Head; + (Source : Bounded_String; + Count : Natural; + Pad : Character := Space; + Drop : Truncation := Error) return Bounded_String + renames Super_Head; procedure Head (Source : in out Bounded_String; - Count : in Natural; - Pad : in Character := Space; - Drop : in Truncation := Error) - renames Super_Head; + Count : Natural; + Pad : Character := Space; + Drop : Truncation := Error) + renames Super_Head; function Tail - (Source : in Bounded_String; - Count : in Natural; - Pad : in Character := Space; - Drop : in Truncation := Error) - return Bounded_String - renames Super_Tail; + (Source : Bounded_String; + Count : Natural; + Pad : Character := Space; + Drop : Truncation := Error) return Bounded_String + renames Super_Tail; procedure Tail (Source : in out Bounded_String; - Count : in Natural; - Pad : in Character := Space; - Drop : in Truncation := Error) - renames Super_Tail; + Count : Natural; + Pad : Character := Space; + Drop : Truncation := Error) + renames Super_Tail; function "*" - (Left : in Natural; - Right : in Bounded_String) - return Bounded_String - renames Times; + (Left : Natural; + Right : Bounded_String) return Bounded_String + renames Times; function Replicate - (Count : in Natural; - Item : in Bounded_String; - Drop : in Truncation := Error) - return Bounded_String + (Count : Natural; + Item : Bounded_String; + Drop : Truncation := Error) return Bounded_String renames Super_Replicate; end Generic_Bounded_Length; diff --git a/gcc/ada/a-string.ads b/gcc/ada/a-string.ads index e8ec5ac3690..5b9d803a200 100644 --- a/gcc/ada/a-string.ads +++ b/gcc/ada/a-string.ads @@ -16,8 +16,13 @@ package Ada.Strings is pragma Pure (Strings); - Space : constant Character := ' '; - Wide_Space : constant Wide_Character := ' '; + Space : constant Character := ' '; + Wide_Space : constant Wide_Character := ' '; + + -- The following declaration is for Ada 2005 (AI-285) + + Wide_Wide_Space : constant Wide_Wide_Character := ' '; + pragma Ada_05 (Wide_Wide_Space); Length_Error, Pattern_Error, Index_Error, Translation_Error : exception; diff --git a/gcc/ada/a-strsup.adb b/gcc/ada/a-strsup.adb index 8ae039336d9..f32398e71b0 100644 --- a/gcc/ada/a-strsup.adb +++ b/gcc/ada/a-strsup.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2003-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- -- @@ -42,8 +42,7 @@ package body Ada.Strings.Superbounded is function Concat (Left : Super_String; - Right : Super_String) - return Super_String + Right : Super_String) return Super_String is Result : Super_String (Left.Max_Length); Llen : constant Natural := Left.Current_Length; @@ -64,8 +63,7 @@ package body Ada.Strings.Superbounded is function Concat (Left : Super_String; - Right : String) - return Super_String + Right : String) return Super_String is Result : Super_String (Left.Max_Length); Llen : constant Natural := Left.Current_Length; @@ -85,8 +83,7 @@ package body Ada.Strings.Superbounded is function Concat (Left : String; - Right : Super_String) - return Super_String + Right : Super_String) return Super_String is Result : Super_String (Right.Max_Length); Llen : constant Natural := Left'Length; @@ -107,8 +104,7 @@ package body Ada.Strings.Superbounded is function Concat (Left : Super_String; - Right : Character) - return Super_String + Right : Character) return Super_String is Result : Super_String (Left.Max_Length); Llen : constant Natural := Left.Current_Length; @@ -127,8 +123,7 @@ package body Ada.Strings.Superbounded is function Concat (Left : Character; - Right : Super_String) - return Super_String + Right : Super_String) return Super_String is Result : Super_String (Right.Max_Length); Rlen : constant Natural := Right.Current_Length; @@ -149,22 +144,29 @@ package body Ada.Strings.Superbounded is -- Equal -- ----------- - function "=" (Left, Right : Super_String) return Boolean is + function "=" + (Left : Super_String; + Right : Super_String) return Boolean + is begin return Left.Current_Length = Right.Current_Length and then Left.Data (1 .. Left.Current_Length) = Right.Data (1 .. Right.Current_Length); end "="; - function Equal (Left : Super_String; Right : String) - return Boolean is + function Equal + (Left : Super_String; + Right : String) return Boolean + is begin return Left.Current_Length = Right'Length and then Left.Data (1 .. Left.Current_Length) = Right; end Equal; - function Equal (Left : String; Right : Super_String) - return Boolean is + function Equal + (Left : String; + Right : Super_String) return Boolean + is begin return Left'Length = Right.Current_Length and then Left = Right.Data (1 .. Right.Current_Length); @@ -174,7 +176,10 @@ package body Ada.Strings.Superbounded is -- Greater -- ------------- - function Greater (Left, Right : Super_String) return Boolean is + function Greater + (Left : Super_String; + Right : Super_String) return Boolean + is begin return Left.Data (1 .. Left.Current_Length) > Right.Data (1 .. Right.Current_Length); @@ -182,8 +187,7 @@ package body Ada.Strings.Superbounded is function Greater (Left : Super_String; - Right : String) - return Boolean + Right : String) return Boolean is begin return Left.Data (1 .. Left.Current_Length) > Right; @@ -191,8 +195,7 @@ package body Ada.Strings.Superbounded is function Greater (Left : String; - Right : Super_String) - return Boolean + Right : Super_String) return Boolean is begin return Left > Right.Data (1 .. Right.Current_Length); @@ -202,7 +205,10 @@ package body Ada.Strings.Superbounded is -- Greater_Or_Equal -- ---------------------- - function Greater_Or_Equal (Left, Right : Super_String) return Boolean is + function Greater_Or_Equal + (Left : Super_String; + Right : Super_String) return Boolean + is begin return Left.Data (1 .. Left.Current_Length) >= Right.Data (1 .. Right.Current_Length); @@ -210,8 +216,7 @@ package body Ada.Strings.Superbounded is function Greater_Or_Equal (Left : Super_String; - Right : String) - return Boolean + Right : String) return Boolean is begin return Left.Data (1 .. Left.Current_Length) >= Right; @@ -219,8 +224,7 @@ package body Ada.Strings.Superbounded is function Greater_Or_Equal (Left : String; - Right : Super_String) - return Boolean + Right : Super_String) return Boolean is begin return Left >= Right.Data (1 .. Right.Current_Length); @@ -230,7 +234,10 @@ package body Ada.Strings.Superbounded is -- Less -- ---------- - function Less (Left, Right : Super_String) return Boolean is + function Less + (Left : Super_String; + Right : Super_String) return Boolean + is begin return Left.Data (1 .. Left.Current_Length) < Right.Data (1 .. Right.Current_Length); @@ -238,8 +245,7 @@ package body Ada.Strings.Superbounded is function Less (Left : Super_String; - Right : String) - return Boolean + Right : String) return Boolean is begin return Left.Data (1 .. Left.Current_Length) < Right; @@ -247,8 +253,7 @@ package body Ada.Strings.Superbounded is function Less (Left : String; - Right : Super_String) - return Boolean + Right : Super_String) return Boolean is begin return Left < Right.Data (1 .. Right.Current_Length); @@ -258,7 +263,10 @@ package body Ada.Strings.Superbounded is -- Less_Or_Equal -- ------------------- - function Less_Or_Equal (Left, Right : Super_String) return Boolean is + function Less_Or_Equal + (Left : Super_String; + Right : Super_String) return Boolean + is begin return Left.Data (1 .. Left.Current_Length) <= Right.Data (1 .. Right.Current_Length); @@ -266,8 +274,7 @@ package body Ada.Strings.Superbounded is function Less_Or_Equal (Left : Super_String; - Right : String) - return Boolean + Right : String) return Boolean is begin return Left.Data (1 .. Left.Current_Length) <= Right; @@ -275,13 +282,47 @@ package body Ada.Strings.Superbounded is function Less_Or_Equal (Left : String; - Right : Super_String) - return Boolean + Right : Super_String) return Boolean is begin return Left <= Right.Data (1 .. Right.Current_Length); end Less_Or_Equal; + ---------------------- + -- Set_Super_String -- + ---------------------- + + procedure Set_Super_String + (Target : out Super_String; + Source : String; + Drop : Truncation := Error) + is + Slen : constant Natural := Source'Length; + Max_Length : constant Positive := Target.Max_Length; + + begin + if Slen <= Max_Length then + Target.Current_Length := Slen; + Target.Data (1 .. Slen) := Source; + + else + case Drop is + when Strings.Right => + Target.Current_Length := Max_Length; + Target.Data (1 .. Max_Length) := + Source (Source'First .. Source'First - 1 + Max_Length); + + when Strings.Left => + Target.Current_Length := Max_Length; + Target.Data (1 .. Max_Length) := + Source (Source'Last - (Max_Length - 1) .. Source'Last); + + when Strings.Error => + raise Ada.Strings.Length_Error; + end case; + end if; + end Set_Super_String; + ------------------ -- Super_Append -- ------------------ @@ -289,9 +330,9 @@ package body Ada.Strings.Superbounded is -- Case of Super_String and Super_String function Super_Append - (Left, Right : Super_String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + (Left : Super_String; + Right : Super_String; + Drop : Truncation := Error) return Super_String is Max_Length : constant Positive := Left.Max_Length; Result : Super_String (Max_Length); @@ -341,7 +382,7 @@ package body Ada.Strings.Superbounded is procedure Super_Append (Source : in out Super_String; New_Item : Super_String; - Drop : Truncation := Error) + Drop : Truncation := Error) is Max_Length : constant Positive := Source.Max_Length; Llen : constant Natural := Source.Current_Length; @@ -386,8 +427,7 @@ package body Ada.Strings.Superbounded is function Super_Append (Left : Super_String; Right : String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Left.Max_Length; Result : Super_String (Max_Length); @@ -440,7 +480,7 @@ package body Ada.Strings.Superbounded is procedure Super_Append (Source : in out Super_String; New_Item : String; - Drop : Truncation := Error) + Drop : Truncation := Error) is Max_Length : constant Positive := Source.Max_Length; Llen : constant Natural := Source.Current_Length; @@ -488,8 +528,7 @@ package body Ada.Strings.Superbounded is function Super_Append (Left : String; Right : Super_String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Right.Max_Length; Result : Super_String (Max_Length); @@ -543,8 +582,7 @@ package body Ada.Strings.Superbounded is function Super_Append (Left : Super_String; Right : Character; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Left.Max_Length; Result : Super_String (Max_Length); @@ -578,7 +616,7 @@ package body Ada.Strings.Superbounded is procedure Super_Append (Source : in out Super_String; New_Item : Character; - Drop : Truncation := Error) + Drop : Truncation := Error) is Max_Length : constant Positive := Source.Max_Length; Llen : constant Natural := Source.Current_Length; @@ -612,8 +650,7 @@ package body Ada.Strings.Superbounded is function Super_Append (Left : Character; Right : Super_String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Right.Max_Length; Result : Super_String (Max_Length); @@ -649,10 +686,9 @@ package body Ada.Strings.Superbounded is ----------------- function Super_Count - (Source : Super_String; - Pattern : String; - Mapping : Maps.Character_Mapping := Maps.Identity) - return Natural + (Source : Super_String; + Pattern : String; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural is begin return @@ -661,10 +697,9 @@ package body Ada.Strings.Superbounded is end Super_Count; function Super_Count - (Source : Super_String; - Pattern : String; - Mapping : Maps.Character_Mapping_Function) - return Natural + (Source : Super_String; + Pattern : String; + Mapping : Maps.Character_Mapping_Function) return Natural is begin return @@ -674,8 +709,7 @@ package body Ada.Strings.Superbounded is function Super_Count (Source : Super_String; - Set : Maps.Character_Set) - return Natural + Set : Maps.Character_Set) return Natural is begin return Search.Count (Source.Data (1 .. Source.Current_Length), Set); @@ -688,8 +722,7 @@ package body Ada.Strings.Superbounded is function Super_Delete (Source : Super_String; From : Positive; - Through : Natural) - return Super_String + Through : Natural) return Super_String is Result : Super_String (Source.Max_Length); Slen : constant Natural := Source.Current_Length; @@ -747,8 +780,7 @@ package body Ada.Strings.Superbounded is function Super_Element (Source : Super_String; - Index : Positive) - return Character + Index : Positive) return Character is begin if Index in 1 .. Source.Current_Length then @@ -782,8 +814,7 @@ package body Ada.Strings.Superbounded is (Source : Super_String; Count : Natural; Pad : Character := Space; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Source.Max_Length; Result : Super_String (Max_Length); @@ -830,7 +861,7 @@ package body Ada.Strings.Superbounded is procedure Super_Head (Source : in out Super_String; Count : Natural; - Pad : Character := Space; + Pad : Character := Space; Drop : Truncation := Error) is Max_Length : constant Positive := Source.Max_Length; @@ -878,11 +909,10 @@ package body Ada.Strings.Superbounded is ----------------- function Super_Index - (Source : Super_String; - Pattern : String; - Going : Strings.Direction := Strings.Forward; - Mapping : Maps.Character_Mapping := Maps.Identity) - return Natural + (Source : Super_String; + Pattern : String; + Going : Strings.Direction := Strings.Forward; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural is begin return Search.Index @@ -890,11 +920,10 @@ package body Ada.Strings.Superbounded is end Super_Index; function Super_Index - (Source : Super_String; - Pattern : String; - Going : Direction := Forward; - Mapping : Maps.Character_Mapping_Function) - return Natural + (Source : Super_String; + Pattern : String; + Going : Direction := Forward; + Mapping : Maps.Character_Mapping_Function) return Natural is begin return Search.Index @@ -905,22 +934,58 @@ package body Ada.Strings.Superbounded is (Source : Super_String; Set : Maps.Character_Set; Test : Strings.Membership := Strings.Inside; - Going : Strings.Direction := Strings.Forward) - return Natural + Going : Strings.Direction := Strings.Forward) return Natural is begin return Search.Index (Source.Data (1 .. Source.Current_Length), Set, Test, Going); end Super_Index; + function Super_Index + (Source : Super_String; + Pattern : String; + From : Positive; + Going : Direction := Forward; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural + is + begin + return Search.Index + (Source.Data (1 .. Source.Current_Length), + Pattern, From, Going, Mapping); + end Super_Index; + + function Super_Index + (Source : Super_String; + Pattern : String; + From : Positive; + Going : Direction := Forward; + Mapping : Maps.Character_Mapping_Function) return Natural + is + begin + return Search.Index + (Source.Data (1 .. Source.Current_Length), + Pattern, From, Going, Mapping); + end Super_Index; + + function Super_Index + (Source : Super_String; + Set : Maps.Character_Set; + From : Positive; + Test : Membership := Inside; + Going : Direction := Forward) return Natural + is + begin + return Search.Index + (Source.Data (1 .. Source.Current_Length), Set, From, Test, Going); + end Super_Index; + --------------------------- -- Super_Index_Non_Blank -- --------------------------- function Super_Index_Non_Blank (Source : Super_String; - Going : Strings.Direction := Strings.Forward) - return Natural + Going : Strings.Direction := Strings.Forward) return Natural is begin return @@ -928,6 +993,17 @@ package body Ada.Strings.Superbounded is (Source.Data (1 .. Source.Current_Length), Going); end Super_Index_Non_Blank; + function Super_Index_Non_Blank + (Source : Super_String; + From : Positive; + Going : Direction := Forward) return Natural + is + begin + return + Search.Index_Non_Blank + (Source.Data (1 .. Source.Current_Length), From, Going); + end Super_Index_Non_Blank; + ------------------ -- Super_Insert -- ------------------ @@ -936,8 +1012,7 @@ package body Ada.Strings.Superbounded is (Source : Super_String; Before : Positive; New_Item : String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Source.Max_Length; Result : Super_String (Max_Length); @@ -1032,11 +1107,10 @@ package body Ada.Strings.Superbounded is --------------------- function Super_Overwrite - (Source : Super_String; - Position : Positive; - New_Item : String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + (Source : Super_String; + Position : Positive; + New_Item : String; + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Source.Max_Length; Result : Super_String (Max_Length); @@ -1172,12 +1246,11 @@ package body Ada.Strings.Superbounded is ------------------------- function Super_Replace_Slice - (Source : Super_String; - Low : Positive; - High : Natural; - By : String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + (Source : Super_String; + Low : Positive; + High : Natural; + By : String; + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Source.Max_Length; Slen : constant Natural := Source.Current_Length; @@ -1273,8 +1346,7 @@ package body Ada.Strings.Superbounded is (Count : Natural; Item : Character; Drop : Truncation := Error; - Max_Length : Positive) - return Super_String + Max_Length : Positive) return Super_String is Result : Super_String (Max_Length); @@ -1297,8 +1369,7 @@ package body Ada.Strings.Superbounded is (Count : Natural; Item : String; Drop : Truncation := Error; - Max_Length : Positive) - return Super_String + Max_Length : Positive) return Super_String is Length : constant Integer := Count * Item'Length; Result : Super_String (Max_Length); @@ -1354,8 +1425,7 @@ package body Ada.Strings.Superbounded is function Super_Replicate (Count : Natural; Item : Super_String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is begin return @@ -1373,8 +1443,7 @@ package body Ada.Strings.Superbounded is function Super_Slice (Source : Super_String; Low : Positive; - High : Natural) - return String + High : Natural) return String is begin -- Note: test of High > Length is in accordance with AI95-00128 @@ -1388,6 +1457,43 @@ package body Ada.Strings.Superbounded is end if; end Super_Slice; + function Super_Slice + (Source : Super_String; + Low : Positive; + High : Natural) return Super_String + is + Result : Super_String (Source.Max_Length); + + begin + if Low > Source.Current_Length + 1 + or else High > Source.Current_Length + then + raise Index_Error; + else + Result.Current_Length := High - Low + 1; + Result.Data (1 .. Source.Current_Length) := Source.Data (Low .. High); + end if; + + return Result; + end Super_Slice; + + procedure Super_Slice + (Source : Super_String; + Target : out Super_String; + Low : Positive; + High : Natural) + is + begin + if Low > Source.Current_Length + 1 + or else High > Source.Current_Length + then + raise Index_Error; + else + Target.Current_Length := High - Low + 1; + Target.Data (1 .. Source.Current_Length) := Source.Data (Low .. High); + end if; + end Super_Slice; + ---------------- -- Super_Tail -- ---------------- @@ -1396,8 +1502,7 @@ package body Ada.Strings.Superbounded is (Source : Super_String; Count : Natural; Pad : Character := Space; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Source.Max_Length; Result : Super_String (Max_Length); @@ -1445,7 +1550,7 @@ package body Ada.Strings.Superbounded is procedure Super_Tail (Source : in out Super_String; Count : Natural; - Pad : Character := Space; + Pad : Character := Space; Drop : Truncation := Error) is Max_Length : constant Positive := Source.Max_Length; @@ -1497,7 +1602,7 @@ package body Ada.Strings.Superbounded is -- Super_To_String -- --------------------- - function Super_To_String (Source : in Super_String) return String is + function Super_To_String (Source : Super_String) return String is begin return Source.Data (1 .. Source.Current_Length); end Super_To_String; @@ -1508,8 +1613,7 @@ package body Ada.Strings.Superbounded is function Super_Translate (Source : Super_String; - Mapping : Maps.Character_Mapping) - return Super_String + Mapping : Maps.Character_Mapping) return Super_String is Result : Super_String (Source.Max_Length); @@ -1535,8 +1639,7 @@ package body Ada.Strings.Superbounded is function Super_Translate (Source : Super_String; - Mapping : Maps.Character_Mapping_Function) - return Super_String + Mapping : Maps.Character_Mapping_Function) return Super_String is Result : Super_String (Source.Max_Length); @@ -1564,8 +1667,9 @@ package body Ada.Strings.Superbounded is -- Super_Trim -- ---------------- - function Super_Trim (Source : Super_String; Side : Trim_End) - return Super_String + function Super_Trim + (Source : Super_String; + Side : Trim_End) return Super_String is Result : Super_String (Source.Max_Length); Last : Natural := Source.Current_Length; @@ -1621,8 +1725,7 @@ package body Ada.Strings.Superbounded is function Super_Trim (Source : Super_String; Left : Maps.Character_Set; - Right : Maps.Character_Set) - return Super_String + Right : Maps.Character_Set) return Super_String is Result : Super_String (Source.Max_Length); @@ -1688,8 +1791,7 @@ package body Ada.Strings.Superbounded is function Times (Left : Natural; Right : Character; - Max_Length : Positive) - return Super_String + Max_Length : Positive) return Super_String is Result : Super_String (Max_Length); @@ -1711,8 +1813,7 @@ package body Ada.Strings.Superbounded is function Times (Left : Natural; Right : String; - Max_Length : Positive) - return Super_String + Max_Length : Positive) return Super_String is Result : Super_String (Max_Length); Pos : Positive := 1; @@ -1739,8 +1840,7 @@ package body Ada.Strings.Superbounded is function Times (Left : Natural; - Right : Super_String) - return Super_String + Right : Super_String) return Super_String is Result : Super_String (Right.Max_Length); Pos : Positive := 1; @@ -1773,8 +1873,7 @@ package body Ada.Strings.Superbounded is function To_Super_String (Source : String; Max_Length : Natural; - Drop : Truncation := Error) - return Super_String + Drop : Truncation := Error) return Super_String is Result : Super_String (Max_Length); Slen : constant Natural := Source'Length; diff --git a/gcc/ada/a-strsup.ads b/gcc/ada/a-strsup.ads index 7716ca79e25..542f821e74f 100644 --- a/gcc/ada/a-strsup.ads +++ b/gcc/ada/a-strsup.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2003-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- -- @@ -63,8 +63,7 @@ pragma Preelaborate (Superbounded); function To_Super_String (Source : String; Max_Length : Natural; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; -- Note the additional parameter Max_Length, which specifies the maximum -- length setting of the resulting Super_String value. @@ -73,34 +72,35 @@ pragma Preelaborate (Superbounded); function Super_To_String (Source : Super_String) return String; + procedure Set_Super_String + (Target : out Super_String; + Source : String; + Drop : Truncation := Error); + function Super_Append - (Left, Right : Super_String; - Drop : Truncation := Error) - return Super_String; + (Left : Super_String; + Right : Super_String; + Drop : Truncation := Error) return Super_String; function Super_Append (Left : Super_String; Right : String; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; function Super_Append (Left : String; Right : Super_String; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; function Super_Append (Left : Super_String; Right : Character; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; function Super_Append (Left : Character; Right : Super_String; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; procedure Super_Append (Source : in out Super_String; @@ -118,33 +118,28 @@ pragma Preelaborate (Superbounded); Drop : Truncation := Error); function Concat - (Left, Right : Super_String) - return Super_String; + (Left : Super_String; + Right : Super_String) return Super_String; function Concat (Left : Super_String; - Right : String) - return Super_String; + Right : String) return Super_String; function Concat (Left : String; - Right : Super_String) - return Super_String; + Right : Super_String) return Super_String; function Concat (Left : Super_String; - Right : Character) - return Super_String; + Right : Character) return Super_String; function Concat (Left : Character; - Right : Super_String) - return Super_String; + Right : Super_String) return Super_String; function Super_Element (Source : Super_String; - Index : Positive) - return Character; + Index : Positive) return Character; procedure Super_Replace_Element (Source : in out Super_String; @@ -154,70 +149,82 @@ pragma Preelaborate (Superbounded); function Super_Slice (Source : Super_String; Low : Positive; - High : Natural) - return String; + High : Natural) return String; + + function Super_Slice + (Source : Super_String; + Low : Positive; + High : Natural) return Super_String; + + procedure Super_Slice + (Source : Super_String; + Target : out Super_String; + Low : Positive; + High : Natural); - function "=" (Left, Right : Super_String) return Boolean; + function "=" + (Left : Super_String; + Right : Super_String) return Boolean; - function Equal (Left, Right : Super_String) return Boolean renames "="; + function Equal + (Left : Super_String; + Right : Super_String) return Boolean renames "="; function Equal (Left : Super_String; - Right : String) - return Boolean; + Right : String) return Boolean; function Equal (Left : String; - Right : Super_String) - return Boolean; + Right : Super_String) return Boolean; - function Less (Left, Right : Super_String) return Boolean; + function Less + (Left : Super_String; + Right : Super_String) return Boolean; function Less (Left : Super_String; - Right : String) - return Boolean; + Right : String) return Boolean; function Less (Left : String; - Right : Super_String) - return Boolean; + Right : Super_String) return Boolean; - function Less_Or_Equal (Left, Right : Super_String) return Boolean; + function Less_Or_Equal + (Left : Super_String; + Right : Super_String) return Boolean; function Less_Or_Equal (Left : Super_String; - Right : String) - return Boolean; + Right : String) return Boolean; function Less_Or_Equal (Left : String; - Right : Super_String) - return Boolean; + Right : Super_String) return Boolean; - function Greater (Left, Right : Super_String) return Boolean; + function Greater + (Left : Super_String; + Right : Super_String) return Boolean; function Greater (Left : Super_String; - Right : String) - return Boolean; + Right : String) return Boolean; function Greater (Left : String; - Right : Super_String) - return Boolean; + Right : Super_String) return Boolean; - function Greater_Or_Equal (Left, Right : Super_String) return Boolean; + function Greater_Or_Equal + (Left : Super_String; + Right : Super_String) return Boolean; function Greater_Or_Equal (Left : Super_String; - Right : String) - return Boolean; + Right : String) return Boolean; function Greater_Or_Equal (Left : String; - Right : Super_String) - return Boolean; + Right : Super_String) return Boolean; ---------------------- -- Search Functions -- @@ -227,44 +234,63 @@ pragma Preelaborate (Superbounded); (Source : Super_String; Pattern : String; Going : Direction := Forward; - Mapping : Maps.Character_Mapping := Maps.Identity) - return Natural; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural; function Super_Index (Source : Super_String; Pattern : String; Going : Direction := Forward; - Mapping : Maps.Character_Mapping_Function) - return Natural; + Mapping : Maps.Character_Mapping_Function) return Natural; function Super_Index (Source : Super_String; Set : Maps.Character_Set; Test : Membership := Inside; - Going : Direction := Forward) - return Natural; + Going : Direction := Forward) return Natural; + + function Super_Index + (Source : Super_String; + Pattern : String; + From : Positive; + Going : Direction := Forward; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural; + + function Super_Index + (Source : Super_String; + Pattern : String; + From : Positive; + Going : Direction := Forward; + Mapping : Maps.Character_Mapping_Function) return Natural; + + function Super_Index + (Source : Super_String; + Set : Maps.Character_Set; + From : Positive; + Test : Membership := Inside; + Going : Direction := Forward) return Natural; + + function Super_Index_Non_Blank + (Source : Super_String; + Going : Direction := Forward) return Natural; function Super_Index_Non_Blank (Source : Super_String; - Going : Direction := Forward) - return Natural; + From : Positive; + Going : Direction := Forward) return Natural; function Super_Count (Source : Super_String; Pattern : String; - Mapping : Maps.Character_Mapping := Maps.Identity) - return Natural; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural; function Super_Count (Source : Super_String; Pattern : String; - Mapping : Maps.Character_Mapping_Function) - return Natural; + Mapping : Maps.Character_Mapping_Function) return Natural; function Super_Count (Source : Super_String; - Set : Maps.Character_Set) - return Natural; + Set : Maps.Character_Set) return Natural; procedure Super_Find_Token (Source : Super_String; @@ -278,9 +304,8 @@ pragma Preelaborate (Superbounded); ------------------------------------ function Super_Translate - (Source : Super_String; - Mapping : Maps.Character_Mapping) - return Super_String; + (Source : Super_String; + Mapping : Maps.Character_Mapping) return Super_String; procedure Super_Translate (Source : in out Super_String; @@ -288,8 +313,7 @@ pragma Preelaborate (Superbounded); function Super_Translate (Source : Super_String; - Mapping : Maps.Character_Mapping_Function) - return Super_String; + Mapping : Maps.Character_Mapping_Function) return Super_String; procedure Super_Translate (Source : in out Super_String; @@ -300,26 +324,24 @@ pragma Preelaborate (Superbounded); --------------------------------------- function Super_Replace_Slice - (Source : Super_String; - Low : Positive; - High : Natural; - By : String; - Drop : Truncation := Error) - return Super_String; + (Source : Super_String; + Low : Positive; + High : Natural; + By : String; + Drop : Truncation := Error) return Super_String; procedure Super_Replace_Slice - (Source : in out Super_String; - Low : Positive; - High : Natural; - By : String; - Drop : Truncation := Error); + (Source : in out Super_String; + Low : Positive; + High : Natural; + By : String; + Drop : Truncation := Error); function Super_Insert (Source : Super_String; Before : Positive; New_Item : String; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; procedure Super_Insert (Source : in out Super_String; @@ -328,11 +350,10 @@ pragma Preelaborate (Superbounded); Drop : Truncation := Error); function Super_Overwrite - (Source : Super_String; - Position : Positive; - New_Item : String; - Drop : Truncation := Error) - return Super_String; + (Source : Super_String; + Position : Positive; + New_Item : String; + Drop : Truncation := Error) return Super_String; procedure Super_Overwrite (Source : in out Super_String; @@ -343,8 +364,7 @@ pragma Preelaborate (Superbounded); function Super_Delete (Source : Super_String; From : Positive; - Through : Natural) - return Super_String; + Through : Natural) return Super_String; procedure Super_Delete (Source : in out Super_String; @@ -357,18 +377,16 @@ pragma Preelaborate (Superbounded); function Super_Trim (Source : Super_String; - Side : Trim_End) - return Super_String; + Side : Trim_End) return Super_String; procedure Super_Trim (Source : in out Super_String; Side : Trim_End); function Super_Trim - (Source : Super_String; + (Source : Super_String; Left : Maps.Character_Set; - Right : Maps.Character_Set) - return Super_String; + Right : Maps.Character_Set) return Super_String; procedure Super_Trim (Source : in out Super_String; @@ -379,26 +397,24 @@ pragma Preelaborate (Superbounded); (Source : Super_String; Count : Natural; Pad : Character := Space; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; procedure Super_Head (Source : in out Super_String; Count : Natural; - Pad : Character := Space; + Pad : Character := Space; Drop : Truncation := Error); function Super_Tail (Source : Super_String; Count : Natural; - Pad : Character := Space; - Drop : Truncation := Error) - return Super_String; + Pad : Character := Space; + Drop : Truncation := Error) return Super_String; procedure Super_Tail (Source : in out Super_String; Count : Natural; - Pad : Character := Space; + Pad : Character := Space; Drop : Truncation := Error); ------------------------------------ @@ -412,46 +428,39 @@ pragma Preelaborate (Superbounded); function Times (Left : Natural; Right : Character; - Max_Length : Positive) - return Super_String; + Max_Length : Positive) return Super_String; -- Note the additional parameter Max_Length function Times (Left : Natural; Right : String; - Max_Length : Positive) - return Super_String; + Max_Length : Positive) return Super_String; -- Note the additional parameter Max_Length function Times (Left : Natural; - Right : Super_String) - return Super_String; + Right : Super_String) return Super_String; function Super_Replicate (Count : Natural; Item : Character; Drop : Truncation := Error; - Max_Length : Positive) - return Super_String; + Max_Length : Positive) return Super_String; -- Note the additional parameter Max_Length function Super_Replicate (Count : Natural; Item : String; Drop : Truncation := Error; - Max_Length : Positive) - return Super_String; + Max_Length : Positive) return Super_String; -- Note the additional parameter Max_Length function Super_Replicate (Count : Natural; Item : Super_String; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; private - -- Pragma Inline declarations pragma Inline ("="); diff --git a/gcc/ada/a-stunau.ads b/gcc/ada/a-stunau.ads index 2da87482fa0..6ba3e567140 100644 --- a/gcc/ada/a-stunau.ads +++ b/gcc/ada/a-stunau.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -34,7 +34,7 @@ -- This child package of Ada.Strings.Unbounded provides some specialized -- access functions which are intended to allow more efficient use of the -- facilities of Ada.Strings.Unbounded, particularly by other layered --- utilities (such as GNAT.Patterns). +-- utilities (such as GNAT.SPITBOL.Patterns). package Ada.Strings.Unbounded.Aux is pragma Preelaborate (Aux); diff --git a/gcc/ada/a-stwibo.adb b/gcc/ada/a-stwibo.adb index 9d0661a6c96..a53dd7a3569 100644 --- a/gcc/ada/a-stwibo.adb +++ b/gcc/ada/a-stwibo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 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- -- @@ -40,18 +40,16 @@ package body Ada.Strings.Wide_Bounded is --------- function "*" - (Left : in Natural; - Right : in Wide_Character) - return Bounded_Wide_String + (Left : Natural; + Right : Wide_Character) return Bounded_Wide_String is begin return Times (Left, Right, Max_Length); end "*"; function "*" - (Left : in Natural; - Right : in Wide_String) - return Bounded_Wide_String + (Left : Natural; + Right : Wide_String) return Bounded_Wide_String is begin return Times (Left, Right, Max_Length); @@ -62,39 +60,37 @@ package body Ada.Strings.Wide_Bounded is --------------- function Replicate - (Count : in Natural; - Item : in Wide_Character; - Drop : in Strings.Truncation := Strings.Error) - return Bounded_Wide_String + (Count : Natural; + Item : Wide_Character; + Drop : Strings.Truncation := Strings.Error) + return Bounded_Wide_String is begin return Super_Replicate (Count, Item, Drop, Max_Length); end Replicate; function Replicate - (Count : in Natural; - Item : in Wide_String; - Drop : in Strings.Truncation := Strings.Error) - return Bounded_Wide_String + (Count : Natural; + Item : Wide_String; + Drop : Strings.Truncation := Strings.Error) + return Bounded_Wide_String is begin return Super_Replicate (Count, Item, Drop, Max_Length); end Replicate; - - ----------------------- - -- To_Bounded_String -- - ----------------------- + ---------------------------- + -- To_Bounded_Wide_String -- + ---------------------------- function To_Bounded_Wide_String - (Source : in Wide_String; - Drop : in Strings.Truncation := Strings.Error) - return Bounded_Wide_String + (Source : Wide_String; + Drop : Strings.Truncation := Strings.Error) + return Bounded_Wide_String is begin return To_Super_String (Source, Max_Length, Drop); end To_Bounded_Wide_String; end Generic_Bounded_Length; - end Ada.Strings.Wide_Bounded; diff --git a/gcc/ada/a-stwibo.ads b/gcc/ada/a-stwibo.ads index 9cebf6f484b..5c3bfd215b7 100644 --- a/gcc/ada/a-stwibo.ads +++ b/gcc/ada/a-stwibo.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -55,805 +55,848 @@ pragma Preelaborate (Wide_Bounded); subtype Length_Range is Natural range 0 .. Max_Length; - function Length (Source : in Bounded_Wide_String) return Length_Range; + function Length (Source : Bounded_Wide_String) return Length_Range; -------------------------------------------------------- -- Conversion, Concatenation, and Selection Functions -- -------------------------------------------------------- function To_Bounded_Wide_String - (Source : in Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Source : Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String; function To_Wide_String - (Source : in Bounded_Wide_String) - return Wide_String; + (Source : Bounded_Wide_String) return Wide_String; + + procedure Set_Bounded_Wide_String + (Target : out Bounded_Wide_String; + Source : Wide_String; + Drop : Truncation := Error); + pragma Ada_05 (Set_Bounded_Wide_String); function Append - (Left, Right : in Bounded_Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String; function Append - (Left : in Bounded_Wide_String; - Right : in Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Left : Bounded_Wide_String; + Right : Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String; function Append - (Left : in Wide_String; - Right : in Bounded_Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Left : Wide_String; + Right : Bounded_Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String; function Append - (Left : in Bounded_Wide_String; - Right : in Wide_Character; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Left : Bounded_Wide_String; + Right : Wide_Character; + Drop : Truncation := Error) return Bounded_Wide_String; function Append - (Left : in Wide_Character; - Right : in Bounded_Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Left : Wide_Character; + Right : Bounded_Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String; procedure Append (Source : in out Bounded_Wide_String; - New_Item : in Bounded_Wide_String; - Drop : in Truncation := Error); + New_Item : Bounded_Wide_String; + Drop : Truncation := Error); procedure Append (Source : in out Bounded_Wide_String; - New_Item : in Wide_String; - Drop : in Truncation := Error); + New_Item : Wide_String; + Drop : Truncation := Error); procedure Append (Source : in out Bounded_Wide_String; - New_Item : in Wide_Character; - Drop : in Truncation := Error); + New_Item : Wide_Character; + Drop : Truncation := Error); function "&" - (Left, Right : in Bounded_Wide_String) - return Bounded_Wide_String; + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String) return Bounded_Wide_String; function "&" - (Left : in Bounded_Wide_String; - Right : in Wide_String) - return Bounded_Wide_String; + (Left : Bounded_Wide_String; + Right : Wide_String) return Bounded_Wide_String; function "&" - (Left : in Wide_String; - Right : in Bounded_Wide_String) - return Bounded_Wide_String; + (Left : Wide_String; + Right : Bounded_Wide_String) return Bounded_Wide_String; function "&" - (Left : in Bounded_Wide_String; - Right : in Wide_Character) - return Bounded_Wide_String; + (Left : Bounded_Wide_String; + Right : Wide_Character) return Bounded_Wide_String; function "&" - (Left : in Wide_Character; - Right : in Bounded_Wide_String) - return Bounded_Wide_String; + (Left : Wide_Character; + Right : Bounded_Wide_String) return Bounded_Wide_String; function Element - (Source : in Bounded_Wide_String; - Index : in Positive) - return Wide_Character; + (Source : Bounded_Wide_String; + Index : Positive) return Wide_Character; procedure Replace_Element (Source : in out Bounded_Wide_String; - Index : in Positive; - By : in Wide_Character); + Index : Positive; + By : Wide_Character); function Slice - (Source : in Bounded_Wide_String; - Low : in Positive; - High : in Natural) - return Wide_String; + (Source : Bounded_Wide_String; + Low : Positive; + High : Natural) return Wide_String; + + function Bounded_Slice + (Source : Bounded_Wide_String; + Low : Positive; + High : Natural) return Bounded_Wide_String; + pragma Ada_05 (Bounded_Slice); + + procedure Bounded_Slice + (Source : Bounded_Wide_String; + Target : out Bounded_Wide_String; + Low : Positive; + High : Natural); + pragma Ada_05 (Bounded_Slice); function "=" - (Left : in Bounded_Wide_String; - Right : in Bounded_Wide_String) - return Boolean; + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String) return Boolean; function "=" - (Left : in Bounded_Wide_String; - Right : in Wide_String) - return Boolean; + (Left : Bounded_Wide_String; + Right : Wide_String) return Boolean; function "=" - (Left : in Wide_String; - Right : in Bounded_Wide_String) - return Boolean; + (Left : Wide_String; + Right : Bounded_Wide_String) return Boolean; function "<" - (Left : in Bounded_Wide_String; - Right : in Bounded_Wide_String) - return Boolean; + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String) return Boolean; function "<" - (Left : in Bounded_Wide_String; - Right : in Wide_String) - return Boolean; + (Left : Bounded_Wide_String; + Right : Wide_String) return Boolean; function "<" - (Left : in Wide_String; - Right : in Bounded_Wide_String) - return Boolean; + (Left : Wide_String; + Right : Bounded_Wide_String) return Boolean; function "<=" - (Left : in Bounded_Wide_String; - Right : in Bounded_Wide_String) - return Boolean; + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String) return Boolean; function "<=" - (Left : in Bounded_Wide_String; - Right : in Wide_String) - return Boolean; + (Left : Bounded_Wide_String; + Right : Wide_String) return Boolean; function "<=" - (Left : in Wide_String; - Right : in Bounded_Wide_String) - return Boolean; + (Left : Wide_String; + Right : Bounded_Wide_String) return Boolean; function ">" - (Left : in Bounded_Wide_String; - Right : in Bounded_Wide_String) - return Boolean; + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String) return Boolean; function ">" - (Left : in Bounded_Wide_String; - Right : in Wide_String) - return Boolean; + (Left : Bounded_Wide_String; + Right : Wide_String) return Boolean; function ">" - (Left : in Wide_String; - Right : in Bounded_Wide_String) - return Boolean; + (Left : Wide_String; + Right : Bounded_Wide_String) return Boolean; function ">=" - (Left : in Bounded_Wide_String; - Right : in Bounded_Wide_String) - return Boolean; + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String) return Boolean; function ">=" - (Left : in Bounded_Wide_String; - Right : in Wide_String) - return Boolean; + (Left : Bounded_Wide_String; + Right : Wide_String) return Boolean; function ">=" - (Left : in Wide_String; - Right : in Bounded_Wide_String) - return Boolean; + (Left : Wide_String; + Right : Bounded_Wide_String) return Boolean; ---------------------- -- Search Functions -- ---------------------- function Index - (Source : in Bounded_Wide_String; - Pattern : in Wide_String; - Going : in Direction := Forward; - Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) - return Natural; + (Source : Bounded_Wide_String; + Pattern : Wide_String; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural; + + function Index + (Source : Bounded_Wide_String; + Pattern : Wide_String; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural; + + function Index + (Source : Bounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set; + Test : Membership := Inside; + Going : Direction := Forward) return Natural; + + function Index + (Source : Bounded_Wide_String; + Pattern : Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural; + pragma Ada_05 (Index); function Index - (Source : in Bounded_Wide_String; - Pattern : in Wide_String; - Going : in Direction := Forward; - Mapping : in Wide_Maps.Wide_Character_Mapping_Function) - return Natural; + (Source : Bounded_Wide_String; + Pattern : Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural; + pragma Ada_05 (Index); function Index - (Source : in Bounded_Wide_String; - Set : in Wide_Maps.Wide_Character_Set; - Test : in Membership := Inside; - Going : in Direction := Forward) - return Natural; + (Source : Bounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set; + From : Positive; + Test : Membership := Inside; + Going : Direction := Forward) return Natural; + pragma Ada_05 (Index); + + function Index_Non_Blank + (Source : Bounded_Wide_String; + Going : Direction := Forward) return Natural; function Index_Non_Blank - (Source : in Bounded_Wide_String; - Going : in Direction := Forward) - return Natural; + (Source : Bounded_Wide_String; + From : Positive; + Going : Direction := Forward) return Natural; + pragma Ada_05 (Index_Non_Blank); function Count - (Source : in Bounded_Wide_String; - Pattern : in Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) - return Natural; + (Source : Bounded_Wide_String; + Pattern : Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural; function Count - (Source : in Bounded_Wide_String; - Pattern : in Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping_Function) - return Natural; + (Source : Bounded_Wide_String; + Pattern : Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural; function Count - (Source : in Bounded_Wide_String; - Set : in Wide_Maps.Wide_Character_Set) - return Natural; + (Source : Bounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set) return Natural; procedure Find_Token - (Source : in Bounded_Wide_String; - Set : in Wide_Maps.Wide_Character_Set; - Test : in Membership; + (Source : Bounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set; + Test : Membership; First : out Positive; Last : out Natural); ------------------------------------ - -- Wide_String Translation Subprograms -- + -- String Translation Subprograms -- ------------------------------------ function Translate - (Source : in Bounded_Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping) - return Bounded_Wide_String; + (Source : Bounded_Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping) + return Bounded_Wide_String; procedure Translate - (Source : in out Bounded_Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping); + (Source : in out Bounded_Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping); function Translate - (Source : in Bounded_Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping_Function) - return Bounded_Wide_String; + (Source : Bounded_Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) + return Bounded_Wide_String; procedure Translate (Source : in out Bounded_Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping_Function); + Mapping : Wide_Maps.Wide_Character_Mapping_Function); --------------------------------------- - -- Wide_String Transformation Subprograms -- + -- String Transformation Subprograms -- --------------------------------------- function Replace_Slice - (Source : in Bounded_Wide_String; - Low : in Positive; - High : in Natural; - By : in Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Source : Bounded_Wide_String; + Low : Positive; + High : Natural; + By : Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String; procedure Replace_Slice (Source : in out Bounded_Wide_String; - Low : in Positive; - High : in Natural; - By : in Wide_String; - Drop : in Truncation := Error); + Low : Positive; + High : Natural; + By : Wide_String; + Drop : Truncation := Error); function Insert - (Source : in Bounded_Wide_String; - Before : in Positive; - New_Item : in Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Source : Bounded_Wide_String; + Before : Positive; + New_Item : Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String; procedure Insert (Source : in out Bounded_Wide_String; - Before : in Positive; - New_Item : in Wide_String; - Drop : in Truncation := Error); + Before : Positive; + New_Item : Wide_String; + Drop : Truncation := Error); function Overwrite - (Source : in Bounded_Wide_String; - Position : in Positive; - New_Item : in Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Source : Bounded_Wide_String; + Position : Positive; + New_Item : Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String; procedure Overwrite (Source : in out Bounded_Wide_String; - Position : in Positive; - New_Item : in Wide_String; - Drop : in Truncation := Error); + Position : Positive; + New_Item : Wide_String; + Drop : Truncation := Error); function Delete - (Source : in Bounded_Wide_String; - From : in Positive; - Through : in Natural) - return Bounded_Wide_String; + (Source : Bounded_Wide_String; + From : Positive; + Through : Natural) return Bounded_Wide_String; procedure Delete (Source : in out Bounded_Wide_String; - From : in Positive; - Through : in Natural); + From : Positive; + Through : Natural); --------------------------------- - -- Wide_String Selector Subprograms -- + -- String Selector Subprograms -- --------------------------------- function Trim - (Source : in Bounded_Wide_String; - Side : in Trim_End) - return Bounded_Wide_String; + (Source : Bounded_Wide_String; + Side : Trim_End) return Bounded_Wide_String; procedure Trim (Source : in out Bounded_Wide_String; - Side : in Trim_End); + Side : Trim_End); function Trim - (Source : in Bounded_Wide_String; - Left : in Wide_Maps.Wide_Character_Set; - Right : in Wide_Maps.Wide_Character_Set) - return Bounded_Wide_String; + (Source : Bounded_Wide_String; + Left : Wide_Maps.Wide_Character_Set; + Right : Wide_Maps.Wide_Character_Set) return Bounded_Wide_String; procedure Trim (Source : in out Bounded_Wide_String; - Left : in Wide_Maps.Wide_Character_Set; - Right : in Wide_Maps.Wide_Character_Set); + Left : Wide_Maps.Wide_Character_Set; + Right : Wide_Maps.Wide_Character_Set); function Head - (Source : in Bounded_Wide_String; - Count : in Natural; - Pad : in Wide_Character := Wide_Space; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Source : Bounded_Wide_String; + Count : Natural; + Pad : Wide_Character := Wide_Space; + Drop : Truncation := Error) return Bounded_Wide_String; procedure Head (Source : in out Bounded_Wide_String; - Count : in Natural; - Pad : in Wide_Character := Wide_Space; - Drop : in Truncation := Error); + Count : Natural; + Pad : Wide_Character := Wide_Space; + Drop : Truncation := Error); function Tail - (Source : in Bounded_Wide_String; - Count : in Natural; - Pad : in Wide_Character := Wide_Space; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Source : Bounded_Wide_String; + Count : Natural; + Pad : Wide_Character := Wide_Space; + Drop : Truncation := Error) return Bounded_Wide_String; procedure Tail (Source : in out Bounded_Wide_String; - Count : in Natural; - Pad : in Wide_Character := Wide_Space; - Drop : in Truncation := Error); + Count : Natural; + Pad : Wide_Character := Wide_Space; + Drop : Truncation := Error); ------------------------------------ - -- Wide_String Constructor Subprograms -- + -- String Constructor Subprograms -- ------------------------------------ function "*" - (Left : in Natural; - Right : in Wide_Character) - return Bounded_Wide_String; + (Left : Natural; + Right : Wide_Character) return Bounded_Wide_String; function "*" - (Left : in Natural; - Right : in Wide_String) - return Bounded_Wide_String; + (Left : Natural; + Right : Wide_String) return Bounded_Wide_String; function "*" - (Left : in Natural; - Right : in Bounded_Wide_String) - return Bounded_Wide_String; + (Left : Natural; + Right : Bounded_Wide_String) return Bounded_Wide_String; function Replicate - (Count : in Natural; - Item : in Wide_Character; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Count : Natural; + Item : Wide_Character; + Drop : Truncation := Error) return Bounded_Wide_String; function Replicate - (Count : in Natural; - Item : in Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Count : Natural; + Item : Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String; function Replicate - (Count : in Natural; - Item : in Bounded_Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String; + (Count : Natural; + Item : Bounded_Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String; private - - -- Most of the implementation is in the non generic package - -- Ada.Strings.Superbounded. Type Bounded_Wide_String is derived from - -- type Wide_Superbounded.Super_String with the maximum length - -- constraint. Except for five, all subprograms are renames of - -- subprograms that are inherited from Wide_Superbounded.Super_String. + -- Most of the implementation is in the separate non generic package + -- Ada.Strings.Wide_Superbounded. Type Bounded_Wide_String is derived + -- from type Wide_Superbounded.Super_String with the maximum length + -- constraint. In almost all cases, the routines in Wide_Superbounded + -- can be called with no requirement to pass the maximum length + -- explicitly, since there is at least one Bounded_Wide_String argument + -- from which the maximum length can be obtained. For all such + -- routines, the implementation in this private part is simply a + -- renaming of the corresponding routine in the super bouded package. + + -- The five exceptions are the * and Replicate routines operating on + -- character values. For these cases, we have a routine in the body + -- that calls the superbounded routine passing the maximum length + -- explicitly as an extra parameter. type Bounded_Wide_String is new Wide_Superbounded.Super_String (Max_Length); + -- Deriving Bounded_Wide_String from Wide_Superbounded.Super_String is + -- the real trick, it ensures that the type Bounded_Wide_String + -- declared in the generic instantiation is compatible with the + -- Super_String type declared in the Wide_Superbounded package. Null_Bounded_Wide_String : constant Bounded_Wide_String := - (Max_Length => Max_Length, - Current_Length => 0, - Data => (1 .. Max_Length => Wide_Superbounded.Wide_NUL)); + (Max_Length => Max_Length, + Current_Length => 0, + Data => + (1 .. Max_Length => + Wide_Superbounded.Wide_NUL)); pragma Inline (To_Bounded_Wide_String); - function Length (Source : in Bounded_Wide_String) return Length_Range - renames Super_Length; + procedure Set_Bounded_Wide_String + (Target : out Bounded_Wide_String; + Source : Wide_String; + Drop : Truncation := Error) + renames Set_Super_String; + + function Length + (Source : Bounded_Wide_String) return Length_Range + renames Super_Length; function To_Wide_String - (Source : in Bounded_Wide_String) - return Wide_String - renames Super_To_String; + (Source : Bounded_Wide_String) return Wide_String + renames Super_To_String; function Append - (Left, Right : in Bounded_Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String - renames Super_Append; + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String + renames Super_Append; function Append - (Left : in Bounded_Wide_String; - Right : in Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String - renames Super_Append; + (Left : Bounded_Wide_String; + Right : Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String + renames Super_Append; function Append - (Left : in Wide_String; - Right : in Bounded_Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String - renames Super_Append; + (Left : Wide_String; + Right : Bounded_Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String + renames Super_Append; function Append - (Left : in Bounded_Wide_String; - Right : in Wide_Character; - Drop : in Truncation := Error) - return Bounded_Wide_String - renames Super_Append; + (Left : Bounded_Wide_String; + Right : Wide_Character; + Drop : Truncation := Error) return Bounded_Wide_String + renames Super_Append; function Append - (Left : in Wide_Character; - Right : in Bounded_Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String - renames Super_Append; + (Left : Wide_Character; + Right : Bounded_Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String + renames Super_Append; procedure Append (Source : in out Bounded_Wide_String; - New_Item : in Bounded_Wide_String; - Drop : in Truncation := Error) - renames Super_Append; + New_Item : Bounded_Wide_String; + Drop : Truncation := Error) + renames Super_Append; procedure Append (Source : in out Bounded_Wide_String; - New_Item : in Wide_String; - Drop : in Truncation := Error) - renames Super_Append; + New_Item : Wide_String; + Drop : Truncation := Error) + renames Super_Append; procedure Append (Source : in out Bounded_Wide_String; - New_Item : in Wide_Character; - Drop : in Truncation := Error) - renames Super_Append; + New_Item : Wide_Character; + Drop : Truncation := Error) + renames Super_Append; function "&" - (Left, Right : in Bounded_Wide_String) - return Bounded_Wide_String - renames Concat; + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String) return Bounded_Wide_String + renames Concat; function "&" - (Left : in Bounded_Wide_String; - Right : in Wide_String) - return Bounded_Wide_String - renames Concat; + (Left : Bounded_Wide_String; + Right : Wide_String) return Bounded_Wide_String + renames Concat; function "&" - (Left : in Wide_String; - Right : in Bounded_Wide_String) - return Bounded_Wide_String - renames Concat; + (Left : Wide_String; + Right : Bounded_Wide_String) return Bounded_Wide_String + renames Concat; function "&" - (Left : in Bounded_Wide_String; - Right : in Wide_Character) - return Bounded_Wide_String - renames Concat; + (Left : Bounded_Wide_String; + Right : Wide_Character) return Bounded_Wide_String + renames Concat; function "&" - (Left : in Wide_Character; - Right : in Bounded_Wide_String) - return Bounded_Wide_String - renames Concat; + (Left : Wide_Character; + Right : Bounded_Wide_String) return Bounded_Wide_String + renames Concat; function Element - (Source : in Bounded_Wide_String; - Index : in Positive) - return Wide_Character - renames Super_Element; + (Source : Bounded_Wide_String; + Index : Positive) return Wide_Character + renames Super_Element; procedure Replace_Element (Source : in out Bounded_Wide_String; - Index : in Positive; - By : in Wide_Character) - renames Super_Replace_Element; + Index : Positive; + By : Wide_Character) + renames Super_Replace_Element; function Slice - (Source : in Bounded_Wide_String; - Low : in Positive; - High : in Natural) - return Wide_String - renames Super_Slice; + (Source : Bounded_Wide_String; + Low : Positive; + High : Natural) return Wide_String + renames Super_Slice; + + function Bounded_Slice + (Source : Bounded_Wide_String; + Low : Positive; + High : Natural) return Bounded_Wide_String + renames Super_Slice; + + procedure Bounded_Slice + (Source : Bounded_Wide_String; + Target : out Bounded_Wide_String; + Low : Positive; + High : Natural) + renames Super_Slice; - function "=" (Left, Right : in Bounded_Wide_String) return Boolean - renames Equal; + function "=" + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String) return Boolean + renames Equal; function "=" - (Left : in Bounded_Wide_String; - Right : in Wide_String) - return Boolean - renames Equal; + (Left : Bounded_Wide_String; + Right : Wide_String) return Boolean + renames Equal; function "=" - (Left : in Wide_String; - Right : in Bounded_Wide_String) - return Boolean - renames Equal; + (Left : Wide_String; + Right : Bounded_Wide_String) return Boolean + renames Equal; - function "<" (Left, Right : in Bounded_Wide_String) return Boolean - renames Less; + function "<" + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String) return Boolean + renames Less; function "<" - (Left : in Bounded_Wide_String; - Right : in Wide_String) - return Boolean - renames Less; + (Left : Bounded_Wide_String; + Right : Wide_String) return Boolean + renames Less; function "<" - (Left : in Wide_String; - Right : in Bounded_Wide_String) - return Boolean - renames Less; + (Left : Wide_String; + Right : Bounded_Wide_String) return Boolean + renames Less; - function "<=" (Left, Right : in Bounded_Wide_String) return Boolean - renames Less_Or_Equal; + function "<=" + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String) return Boolean + renames Less_Or_Equal; function "<=" - (Left : in Bounded_Wide_String; - Right : in Wide_String) - return Boolean - renames Less_Or_Equal; + (Left : Bounded_Wide_String; + Right : Wide_String) return Boolean + renames Less_Or_Equal; function "<=" - (Left : in Wide_String; - Right : in Bounded_Wide_String) - return Boolean - renames Less_Or_Equal; + (Left : Wide_String; + Right : Bounded_Wide_String) return Boolean + renames Less_Or_Equal; - function ">" (Left, Right : in Bounded_Wide_String) return Boolean - renames Greater; + function ">" + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String) return Boolean + renames Greater; function ">" - (Left : in Bounded_Wide_String; - Right : in Wide_String) - return Boolean - renames Greater; + (Left : Bounded_Wide_String; + Right : Wide_String) return Boolean + renames Greater; function ">" - (Left : in Wide_String; - Right : in Bounded_Wide_String) - return Boolean - renames Greater; + (Left : Wide_String; + Right : Bounded_Wide_String) return Boolean + renames Greater; - function ">=" (Left, Right : in Bounded_Wide_String) return Boolean - renames Greater_Or_Equal; + function ">=" + (Left : Bounded_Wide_String; + Right : Bounded_Wide_String) return Boolean + renames Greater_Or_Equal; function ">=" - (Left : in Bounded_Wide_String; - Right : in Wide_String) - return Boolean - renames Greater_Or_Equal; + (Left : Bounded_Wide_String; + Right : Wide_String) return Boolean + renames Greater_Or_Equal; function ">=" - (Left : in Wide_String; - Right : in Bounded_Wide_String) - return Boolean - renames Greater_Or_Equal; + (Left : Wide_String; + Right : Bounded_Wide_String) return Boolean + renames Greater_Or_Equal; + + function Index + (Source : Bounded_Wide_String; + Pattern : Wide_String; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural + renames Super_Index; + + function Index + (Source : Bounded_Wide_String; + Pattern : Wide_String; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural + renames Super_Index; + + function Index + (Source : Bounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set; + Test : Membership := Inside; + Going : Direction := Forward) return Natural + renames Super_Index; function Index - (Source : in Bounded_Wide_String; - Pattern : in Wide_String; - Going : in Direction := Forward; - Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) - return Natural - renames Super_Index; + (Source : Bounded_Wide_String; + Pattern : Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural + renames Super_Index; function Index - (Source : in Bounded_Wide_String; - Pattern : in Wide_String; - Going : in Direction := Forward; - Mapping : in Wide_Maps.Wide_Character_Mapping_Function) - return Natural - renames Super_Index; + (Source : Bounded_Wide_String; + Pattern : Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural + renames Super_Index; function Index - (Source : in Bounded_Wide_String; - Set : in Wide_Maps.Wide_Character_Set; - Test : in Membership := Inside; - Going : in Direction := Forward) - return Natural - renames Super_Index; + (Source : Bounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set; + From : Positive; + Test : Membership := Inside; + Going : Direction := Forward) return Natural + renames Super_Index; + + function Index_Non_Blank + (Source : Bounded_Wide_String; + Going : Direction := Forward) return Natural + renames Super_Index_Non_Blank; function Index_Non_Blank - (Source : in Bounded_Wide_String; - Going : in Direction := Forward) - return Natural - renames Super_Index_Non_Blank; + (Source : Bounded_Wide_String; + From : Positive; + Going : Direction := Forward) return Natural + renames Super_Index_Non_Blank; function Count - (Source : in Bounded_Wide_String; - Pattern : in Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) - return Natural - renames Super_Count; + (Source : Bounded_Wide_String; + Pattern : Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural + renames Super_Count; function Count - (Source : in Bounded_Wide_String; - Pattern : in Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping_Function) - return Natural - renames Super_Count; + (Source : Bounded_Wide_String; + Pattern : Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural + renames Super_Count; function Count - (Source : in Bounded_Wide_String; - Set : in Wide_Maps.Wide_Character_Set) - return Natural - renames Super_Count; + (Source : Bounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set) return Natural + renames Super_Count; procedure Find_Token - (Source : in Bounded_Wide_String; - Set : in Wide_Maps.Wide_Character_Set; - Test : in Membership; + (Source : Bounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set; + Test : Membership; First : out Positive; Last : out Natural) - renames Super_Find_Token; + renames Super_Find_Token; function Translate - (Source : in Bounded_Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping) - return Bounded_Wide_String - renames Super_Translate; + (Source : Bounded_Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping) + return Bounded_Wide_String + renames Super_Translate; procedure Translate (Source : in out Bounded_Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping) - renames Super_Translate; + Mapping : Wide_Maps.Wide_Character_Mapping) + renames Super_Translate; function Translate - (Source : in Bounded_Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping_Function) - return Bounded_Wide_String - renames Super_Translate; + (Source : Bounded_Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) + return Bounded_Wide_String + renames Super_Translate; procedure Translate (Source : in out Bounded_Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping_Function) - renames Super_Translate; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) + renames Super_Translate; function Replace_Slice - (Source : in Bounded_Wide_String; - Low : in Positive; - High : in Natural; - By : in Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String - renames Super_Replace_Slice; + (Source : Bounded_Wide_String; + Low : Positive; + High : Natural; + By : Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String + renames Super_Replace_Slice; procedure Replace_Slice (Source : in out Bounded_Wide_String; - Low : in Positive; - High : in Natural; - By : in Wide_String; - Drop : in Truncation := Error) - renames Super_Replace_Slice; + Low : Positive; + High : Natural; + By : Wide_String; + Drop : Truncation := Error) + renames Super_Replace_Slice; function Insert - (Source : in Bounded_Wide_String; - Before : in Positive; - New_Item : in Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String - renames Super_Insert; + (Source : Bounded_Wide_String; + Before : Positive; + New_Item : Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String + renames Super_Insert; procedure Insert (Source : in out Bounded_Wide_String; - Before : in Positive; - New_Item : in Wide_String; - Drop : in Truncation := Error) - renames Super_Insert; + Before : Positive; + New_Item : Wide_String; + Drop : Truncation := Error) + renames Super_Insert; function Overwrite - (Source : in Bounded_Wide_String; - Position : in Positive; - New_Item : in Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String - renames Super_Overwrite; + (Source : Bounded_Wide_String; + Position : Positive; + New_Item : Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String + renames Super_Overwrite; procedure Overwrite (Source : in out Bounded_Wide_String; - Position : in Positive; - New_Item : in Wide_String; - Drop : in Truncation := Error) - renames Super_Overwrite; + Position : Positive; + New_Item : Wide_String; + Drop : Truncation := Error) + renames Super_Overwrite; function Delete - (Source : in Bounded_Wide_String; - From : in Positive; - Through : in Natural) - return Bounded_Wide_String - renames Super_Delete; + (Source : Bounded_Wide_String; + From : Positive; + Through : Natural) return Bounded_Wide_String + renames Super_Delete; procedure Delete (Source : in out Bounded_Wide_String; - From : in Positive; - Through : in Natural) - renames Super_Delete; + From : Positive; + Through : Natural) + renames Super_Delete; function Trim - (Source : in Bounded_Wide_String; - Side : in Trim_End) - return Bounded_Wide_String - renames Super_Trim; + (Source : Bounded_Wide_String; + Side : Trim_End) return Bounded_Wide_String + renames Super_Trim; procedure Trim (Source : in out Bounded_Wide_String; - Side : in Trim_End) - renames Super_Trim; + Side : Trim_End) + renames Super_Trim; function Trim - (Source : in Bounded_Wide_String; - Left : in Wide_Maps.Wide_Character_Set; - Right : in Wide_Maps.Wide_Character_Set) - return Bounded_Wide_String - renames Super_Trim; + (Source : Bounded_Wide_String; + Left : Wide_Maps.Wide_Character_Set; + Right : Wide_Maps.Wide_Character_Set) return Bounded_Wide_String + renames Super_Trim; procedure Trim (Source : in out Bounded_Wide_String; - Left : in Wide_Maps.Wide_Character_Set; - Right : in Wide_Maps.Wide_Character_Set) - renames Super_Trim; + Left : Wide_Maps.Wide_Character_Set; + Right : Wide_Maps.Wide_Character_Set) + renames Super_Trim; function Head - (Source : in Bounded_Wide_String; - Count : in Natural; - Pad : in Wide_Character := Wide_Space; - Drop : in Truncation := Error) - return Bounded_Wide_String - renames Super_Head; + (Source : Bounded_Wide_String; + Count : Natural; + Pad : Wide_Character := Wide_Space; + Drop : Truncation := Error) return Bounded_Wide_String + renames Super_Head; procedure Head (Source : in out Bounded_Wide_String; - Count : in Natural; - Pad : in Wide_Character := Wide_Space; - Drop : in Truncation := Error) - renames Super_Head; + Count : Natural; + Pad : Wide_Character := Wide_Space; + Drop : Truncation := Error) + renames Super_Head; function Tail - (Source : in Bounded_Wide_String; - Count : in Natural; - Pad : in Wide_Character := Wide_Space; - Drop : in Truncation := Error) - return Bounded_Wide_String - renames Super_Tail; + (Source : Bounded_Wide_String; + Count : Natural; + Pad : Wide_Character := Wide_Space; + Drop : Truncation := Error) return Bounded_Wide_String + renames Super_Tail; procedure Tail (Source : in out Bounded_Wide_String; - Count : in Natural; - Pad : in Wide_Character := Wide_Space; - Drop : in Truncation := Error) - renames Super_Tail; + Count : Natural; + Pad : Wide_Character := Wide_Space; + Drop : Truncation := Error) + renames Super_Tail; function "*" - (Left : in Natural; - Right : in Bounded_Wide_String) - return Bounded_Wide_String - renames Times; + (Left : Natural; + Right : Bounded_Wide_String) return Bounded_Wide_String + renames Times; function Replicate - (Count : in Natural; - Item : in Bounded_Wide_String; - Drop : in Truncation := Error) - return Bounded_Wide_String + (Count : Natural; + Item : Bounded_Wide_String; + Drop : Truncation := Error) return Bounded_Wide_String renames Super_Replicate; end Generic_Bounded_Length; diff --git a/gcc/ada/a-stwisu.adb b/gcc/ada/a-stwisu.adb index ebf15f71264..bdaac0b64df 100644 --- a/gcc/ada/a-stwisu.adb +++ b/gcc/ada/a-stwisu.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2003-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- -- @@ -42,8 +42,7 @@ package body Ada.Strings.Wide_Superbounded is function Concat (Left : Super_String; - Right : Super_String) - return Super_String + Right : Super_String) return Super_String is Result : Super_String (Left.Max_Length); Llen : constant Natural := Left.Current_Length; @@ -64,8 +63,7 @@ package body Ada.Strings.Wide_Superbounded is function Concat (Left : Super_String; - Right : Wide_String) - return Super_String + Right : Wide_String) return Super_String is Result : Super_String (Left.Max_Length); Llen : constant Natural := Left.Current_Length; @@ -85,8 +83,7 @@ package body Ada.Strings.Wide_Superbounded is function Concat (Left : Wide_String; - Right : Super_String) - return Super_String + Right : Super_String) return Super_String is Result : Super_String (Right.Max_Length); Llen : constant Natural := Left'Length; @@ -107,8 +104,7 @@ package body Ada.Strings.Wide_Superbounded is function Concat (Left : Super_String; - Right : Wide_Character) - return Super_String + Right : Wide_Character) return Super_String is Result : Super_String (Left.Max_Length); Llen : constant Natural := Left.Current_Length; @@ -127,8 +123,7 @@ package body Ada.Strings.Wide_Superbounded is function Concat (Left : Wide_Character; - Right : Super_String) - return Super_String + Right : Super_String) return Super_String is Result : Super_String (Right.Max_Length); Rlen : constant Natural := Right.Current_Length; @@ -149,22 +144,29 @@ package body Ada.Strings.Wide_Superbounded is -- Equal -- ----------- - function "=" (Left, Right : Super_String) return Boolean is + function "=" + (Left : Super_String; + Right : Super_String) return Boolean + is begin return Left.Current_Length = Right.Current_Length and then Left.Data (1 .. Left.Current_Length) = Right.Data (1 .. Right.Current_Length); end "="; - function Equal (Left : Super_String; Right : Wide_String) - return Boolean is + function Equal + (Left : Super_String; + Right : Wide_String) return Boolean + is begin return Left.Current_Length = Right'Length and then Left.Data (1 .. Left.Current_Length) = Right; end Equal; - function Equal (Left : Wide_String; Right : Super_String) - return Boolean is + function Equal + (Left : Wide_String; + Right : Super_String) return Boolean + is begin return Left'Length = Right.Current_Length and then Left = Right.Data (1 .. Right.Current_Length); @@ -174,7 +176,10 @@ package body Ada.Strings.Wide_Superbounded is -- Greater -- ------------- - function Greater (Left, Right : Super_String) return Boolean is + function Greater + (Left : Super_String; + Right : Super_String) return Boolean + is begin return Left.Data (1 .. Left.Current_Length) > Right.Data (1 .. Right.Current_Length); @@ -182,8 +187,7 @@ package body Ada.Strings.Wide_Superbounded is function Greater (Left : Super_String; - Right : Wide_String) - return Boolean + Right : Wide_String) return Boolean is begin return Left.Data (1 .. Left.Current_Length) > Right; @@ -191,8 +195,7 @@ package body Ada.Strings.Wide_Superbounded is function Greater (Left : Wide_String; - Right : Super_String) - return Boolean + Right : Super_String) return Boolean is begin return Left > Right.Data (1 .. Right.Current_Length); @@ -202,7 +205,10 @@ package body Ada.Strings.Wide_Superbounded is -- Greater_Or_Equal -- ---------------------- - function Greater_Or_Equal (Left, Right : Super_String) return Boolean is + function Greater_Or_Equal + (Left : Super_String; + Right : Super_String) return Boolean + is begin return Left.Data (1 .. Left.Current_Length) >= Right.Data (1 .. Right.Current_Length); @@ -210,8 +216,7 @@ package body Ada.Strings.Wide_Superbounded is function Greater_Or_Equal (Left : Super_String; - Right : Wide_String) - return Boolean + Right : Wide_String) return Boolean is begin return Left.Data (1 .. Left.Current_Length) >= Right; @@ -219,8 +224,7 @@ package body Ada.Strings.Wide_Superbounded is function Greater_Or_Equal (Left : Wide_String; - Right : Super_String) - return Boolean + Right : Super_String) return Boolean is begin return Left >= Right.Data (1 .. Right.Current_Length); @@ -230,7 +234,10 @@ package body Ada.Strings.Wide_Superbounded is -- Less -- ---------- - function Less (Left, Right : Super_String) return Boolean is + function Less + (Left : Super_String; + Right : Super_String) return Boolean + is begin return Left.Data (1 .. Left.Current_Length) < Right.Data (1 .. Right.Current_Length); @@ -238,8 +245,7 @@ package body Ada.Strings.Wide_Superbounded is function Less (Left : Super_String; - Right : Wide_String) - return Boolean + Right : Wide_String) return Boolean is begin return Left.Data (1 .. Left.Current_Length) < Right; @@ -247,8 +253,7 @@ package body Ada.Strings.Wide_Superbounded is function Less (Left : Wide_String; - Right : Super_String) - return Boolean + Right : Super_String) return Boolean is begin return Left < Right.Data (1 .. Right.Current_Length); @@ -258,7 +263,10 @@ package body Ada.Strings.Wide_Superbounded is -- Less_Or_Equal -- ------------------- - function Less_Or_Equal (Left, Right : Super_String) return Boolean is + function Less_Or_Equal + (Left : Super_String; + Right : Super_String) return Boolean + is begin return Left.Data (1 .. Left.Current_Length) <= Right.Data (1 .. Right.Current_Length); @@ -266,8 +274,7 @@ package body Ada.Strings.Wide_Superbounded is function Less_Or_Equal (Left : Super_String; - Right : Wide_String) - return Boolean + Right : Wide_String) return Boolean is begin return Left.Data (1 .. Left.Current_Length) <= Right; @@ -275,13 +282,47 @@ package body Ada.Strings.Wide_Superbounded is function Less_Or_Equal (Left : Wide_String; - Right : Super_String) - return Boolean + Right : Super_String) return Boolean is begin return Left <= Right.Data (1 .. Right.Current_Length); end Less_Or_Equal; + ---------------------- + -- Set_Super_String -- + ---------------------- + + procedure Set_Super_String + (Target : out Super_String; + Source : Wide_String; + Drop : Truncation := Error) + is + Slen : constant Natural := Source'Length; + Max_Length : constant Positive := Target.Max_Length; + + begin + if Slen <= Max_Length then + Target.Current_Length := Slen; + Target.Data (1 .. Slen) := Source; + + else + case Drop is + when Strings.Right => + Target.Current_Length := Max_Length; + Target.Data (1 .. Max_Length) := + Source (Source'First .. Source'First - 1 + Max_Length); + + when Strings.Left => + Target.Current_Length := Max_Length; + Target.Data (1 .. Max_Length) := + Source (Source'Last - (Max_Length - 1) .. Source'Last); + + when Strings.Error => + raise Ada.Strings.Length_Error; + end case; + end if; + end Set_Super_String; + ------------------ -- Super_Append -- ------------------ @@ -289,9 +330,9 @@ package body Ada.Strings.Wide_Superbounded is -- Case of Super_String and Super_String function Super_Append - (Left, Right : Super_String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + (Left : Super_String; + Right : Super_String; + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Left.Max_Length; Result : Super_String (Max_Length); @@ -386,8 +427,7 @@ package body Ada.Strings.Wide_Superbounded is function Super_Append (Left : Super_String; Right : Wide_String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Left.Max_Length; Result : Super_String (Max_Length); @@ -488,8 +528,7 @@ package body Ada.Strings.Wide_Superbounded is function Super_Append (Left : Wide_String; Right : Super_String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Right.Max_Length; Result : Super_String (Max_Length); @@ -543,8 +582,7 @@ package body Ada.Strings.Wide_Superbounded is function Super_Append (Left : Super_String; Right : Wide_Character; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Left.Max_Length; Result : Super_String (Max_Length); @@ -612,8 +650,7 @@ package body Ada.Strings.Wide_Superbounded is function Super_Append (Left : Wide_Character; Right : Super_String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Right.Max_Length; Result : Super_String (Max_Length); @@ -649,10 +686,10 @@ package body Ada.Strings.Wide_Superbounded is ----------------- function Super_Count - (Source : Super_String; - Pattern : Wide_String; - Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) - return Natural + (Source : Super_String; + Pattern : Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural is begin return @@ -661,10 +698,9 @@ package body Ada.Strings.Wide_Superbounded is end Super_Count; function Super_Count - (Source : Super_String; - Pattern : Wide_String; - Mapping : Wide_Maps.Wide_Character_Mapping_Function) - return Natural + (Source : Super_String; + Pattern : Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural is begin return @@ -674,8 +710,7 @@ package body Ada.Strings.Wide_Superbounded is function Super_Count (Source : Super_String; - Set : Wide_Maps.Wide_Character_Set) - return Natural + Set : Wide_Maps.Wide_Character_Set) return Natural is begin return Wide_Search.Count (Source.Data (1 .. Source.Current_Length), Set); @@ -688,8 +723,7 @@ package body Ada.Strings.Wide_Superbounded is function Super_Delete (Source : Super_String; From : Positive; - Through : Natural) - return Super_String + Through : Natural) return Super_String is Result : Super_String (Source.Max_Length); Slen : constant Natural := Source.Current_Length; @@ -747,8 +781,7 @@ package body Ada.Strings.Wide_Superbounded is function Super_Element (Source : Super_String; - Index : Positive) - return Wide_Character + Index : Positive) return Wide_Character is begin if Index in 1 .. Source.Current_Length then @@ -782,8 +815,7 @@ package body Ada.Strings.Wide_Superbounded is (Source : Super_String; Count : Natural; Pad : Wide_Character := Wide_Space; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Source.Max_Length; Result : Super_String (Max_Length); @@ -830,7 +862,7 @@ package body Ada.Strings.Wide_Superbounded is procedure Super_Head (Source : in out Super_String; Count : Natural; - Pad : Wide_Character := Wide_Space; + Pad : Wide_Character := Wide_Space; Drop : Truncation := Error) is Max_Length : constant Positive := Source.Max_Length; @@ -878,11 +910,11 @@ package body Ada.Strings.Wide_Superbounded is ----------------- function Super_Index - (Source : Super_String; - Pattern : Wide_String; - Going : Strings.Direction := Strings.Forward; - Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) - return Natural + (Source : Super_String; + Pattern : Wide_String; + Going : Strings.Direction := Strings.Forward; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural is begin return Wide_Search.Index @@ -890,11 +922,10 @@ package body Ada.Strings.Wide_Superbounded is end Super_Index; function Super_Index - (Source : Super_String; - Pattern : Wide_String; - Going : Direction := Forward; - Mapping : Wide_Maps.Wide_Character_Mapping_Function) - return Natural + (Source : Super_String; + Pattern : Wide_String; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural is begin return Wide_Search.Index @@ -905,22 +936,59 @@ package body Ada.Strings.Wide_Superbounded is (Source : Super_String; Set : Wide_Maps.Wide_Character_Set; Test : Strings.Membership := Strings.Inside; - Going : Strings.Direction := Strings.Forward) - return Natural + Going : Strings.Direction := Strings.Forward) return Natural is begin return Wide_Search.Index (Source.Data (1 .. Source.Current_Length), Set, Test, Going); end Super_Index; + function Super_Index + (Source : Super_String; + Pattern : Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural + is + begin + return Wide_Search.Index + (Source.Data (1 .. Source.Current_Length), + Pattern, From, Going, Mapping); + end Super_Index; + + function Super_Index + (Source : Super_String; + Pattern : Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural + is + begin + return Wide_Search.Index + (Source.Data (1 .. Source.Current_Length), + Pattern, From, Going, Mapping); + end Super_Index; + + function Super_Index + (Source : Super_String; + Set : Wide_Maps.Wide_Character_Set; + From : Positive; + Test : Membership := Inside; + Going : Direction := Forward) return Natural + is + begin + return Wide_Search.Index + (Source.Data (1 .. Source.Current_Length), Set, From, Test, Going); + end Super_Index; + --------------------------- -- Super_Index_Non_Blank -- --------------------------- function Super_Index_Non_Blank (Source : Super_String; - Going : Strings.Direction := Strings.Forward) - return Natural + Going : Strings.Direction := Strings.Forward) return Natural is begin return @@ -928,6 +996,17 @@ package body Ada.Strings.Wide_Superbounded is (Source.Data (1 .. Source.Current_Length), Going); end Super_Index_Non_Blank; + function Super_Index_Non_Blank + (Source : Super_String; + From : Positive; + Going : Direction := Forward) return Natural + is + begin + return + Wide_Search.Index_Non_Blank + (Source.Data (1 .. Source.Current_Length), From, Going); + end Super_Index_Non_Blank; + ------------------ -- Super_Insert -- ------------------ @@ -936,8 +1015,7 @@ package body Ada.Strings.Wide_Superbounded is (Source : Super_String; Before : Positive; New_Item : Wide_String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Source.Max_Length; Result : Super_String (Max_Length); @@ -948,9 +1026,9 @@ package body Ada.Strings.Wide_Superbounded is Alen : constant Integer := Slen - Blen; Droplen : constant Integer := Tlen - Max_Length; - -- Tlen is the length of the total Wide_String before possible - -- truncation. Blen, Alen are the lengths of the before and after - -- pieces of the source Wide_String. + -- Tlen is the length of the total string before possible truncation. + -- Blen, Alen are the lengths of the before and after pieces of the + -- source string. begin if Alen < 0 then @@ -1032,11 +1110,10 @@ package body Ada.Strings.Wide_Superbounded is --------------------- function Super_Overwrite - (Source : Super_String; - Position : Positive; - New_Item : Wide_String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + (Source : Super_String; + Position : Positive; + New_Item : Wide_String; + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Source.Max_Length; Result : Super_String (Max_Length); @@ -1172,12 +1249,11 @@ package body Ada.Strings.Wide_Superbounded is ------------------------- function Super_Replace_Slice - (Source : Super_String; - Low : Positive; - High : Natural; - By : Wide_String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + (Source : Super_String; + Low : Positive; + High : Natural; + By : Wide_String; + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Source.Max_Length; Slen : constant Natural := Source.Current_Length; @@ -1197,10 +1273,10 @@ package body Ada.Strings.Wide_Superbounded is Droplen : constant Integer := Tlen - Max_Length; Result : Super_String (Max_Length); - -- Tlen is the total length of the result Wide_String before any + -- Tlen is the total length of the result string before any -- truncation. Blen and Alen are the lengths of the pieces - -- of the original Wide_String that end up in the result - -- Wide_String before and after the replaced slice. + -- of the original string that end up in the result string + -- before and after the replaced slice. begin if Droplen <= 0 then @@ -1273,8 +1349,7 @@ package body Ada.Strings.Wide_Superbounded is (Count : Natural; Item : Wide_Character; Drop : Truncation := Error; - Max_Length : Positive) - return Super_String + Max_Length : Positive) return Super_String is Result : Super_String (Max_Length); @@ -1297,8 +1372,7 @@ package body Ada.Strings.Wide_Superbounded is (Count : Natural; Item : Wide_String; Drop : Truncation := Error; - Max_Length : Positive) - return Super_String + Max_Length : Positive) return Super_String is Length : constant Integer := Count * Item'Length; Result : Super_String (Max_Length); @@ -1354,8 +1428,7 @@ package body Ada.Strings.Wide_Superbounded is function Super_Replicate (Count : Natural; Item : Super_String; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is begin return @@ -1373,8 +1446,7 @@ package body Ada.Strings.Wide_Superbounded is function Super_Slice (Source : Super_String; Low : Positive; - High : Natural) - return Wide_String + High : Natural) return Wide_String is begin -- Note: test of High > Length is in accordance with AI95-00128 @@ -1388,6 +1460,43 @@ package body Ada.Strings.Wide_Superbounded is end if; end Super_Slice; + function Super_Slice + (Source : Super_String; + Low : Positive; + High : Natural) return Super_String + is + Result : Super_String (Source.Max_Length); + + begin + if Low > Source.Current_Length + 1 + or else High > Source.Current_Length + then + raise Index_Error; + else + Result.Current_Length := High - Low + 1; + Result.Data (1 .. Source.Current_Length) := Source.Data (Low .. High); + end if; + + return Result; + end Super_Slice; + + procedure Super_Slice + (Source : Super_String; + Target : out Super_String; + Low : Positive; + High : Natural) + is + begin + if Low > Source.Current_Length + 1 + or else High > Source.Current_Length + then + raise Index_Error; + else + Target.Current_Length := High - Low + 1; + Target.Data (1 .. Source.Current_Length) := Source.Data (Low .. High); + end if; + end Super_Slice; + ---------------- -- Super_Tail -- ---------------- @@ -1396,8 +1505,7 @@ package body Ada.Strings.Wide_Superbounded is (Source : Super_String; Count : Natural; Pad : Wide_Character := Wide_Space; - Drop : Strings.Truncation := Strings.Error) - return Super_String + Drop : Strings.Truncation := Strings.Error) return Super_String is Max_Length : constant Positive := Source.Max_Length; Result : Super_String (Max_Length); @@ -1445,7 +1553,7 @@ package body Ada.Strings.Wide_Superbounded is procedure Super_Tail (Source : in out Super_String; Count : Natural; - Pad : Wide_Character := Wide_Space; + Pad : Wide_Character := Wide_Space; Drop : Truncation := Error) is Max_Length : constant Positive := Source.Max_Length; @@ -1497,7 +1605,7 @@ package body Ada.Strings.Wide_Superbounded is -- Super_To_String -- --------------------- - function Super_To_String (Source : in Super_String) return Wide_String is + function Super_To_String (Source : Super_String) return Wide_String is begin return Source.Data (1 .. Source.Current_Length); end Super_To_String; @@ -1508,8 +1616,7 @@ package body Ada.Strings.Wide_Superbounded is function Super_Translate (Source : Super_String; - Mapping : Wide_Maps.Wide_Character_Mapping) - return Super_String + Mapping : Wide_Maps.Wide_Character_Mapping) return Super_String is Result : Super_String (Source.Max_Length); @@ -1535,8 +1642,7 @@ package body Ada.Strings.Wide_Superbounded is function Super_Translate (Source : Super_String; - Mapping : Wide_Maps.Wide_Character_Mapping_Function) - return Super_String + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Super_String is Result : Super_String (Source.Max_Length); @@ -1566,8 +1672,7 @@ package body Ada.Strings.Wide_Superbounded is function Super_Trim (Source : Super_String; - Side : Trim_End) - return Super_String + Side : Trim_End) return Super_String is Result : Super_String (Source.Max_Length); Last : Natural := Source.Current_Length; @@ -1623,8 +1728,7 @@ package body Ada.Strings.Wide_Superbounded is function Super_Trim (Source : Super_String; Left : Wide_Maps.Wide_Character_Set; - Right : Wide_Maps.Wide_Character_Set) - return Super_String + Right : Wide_Maps.Wide_Character_Set) return Super_String is Result : Super_String (Source.Max_Length); @@ -1690,8 +1794,7 @@ package body Ada.Strings.Wide_Superbounded is function Times (Left : Natural; Right : Wide_Character; - Max_Length : Positive) - return Super_String + Max_Length : Positive) return Super_String is Result : Super_String (Max_Length); @@ -1713,8 +1816,7 @@ package body Ada.Strings.Wide_Superbounded is function Times (Left : Natural; Right : Wide_String; - Max_Length : Positive) - return Super_String + Max_Length : Positive) return Super_String is Result : Super_String (Max_Length); Pos : Positive := 1; @@ -1741,8 +1843,7 @@ package body Ada.Strings.Wide_Superbounded is function Times (Left : Natural; - Right : Super_String) - return Super_String + Right : Super_String) return Super_String is Result : Super_String (Right.Max_Length); Pos : Positive := 1; @@ -1775,8 +1876,7 @@ package body Ada.Strings.Wide_Superbounded is function To_Super_String (Source : Wide_String; Max_Length : Natural; - Drop : Truncation := Error) - return Super_String + Drop : Truncation := Error) return Super_String is Result : Super_String (Max_Length); Slen : constant Natural := Source'Length; diff --git a/gcc/ada/a-stwisu.ads b/gcc/ada/a-stwisu.ads index 8ea068642f8..a9df6fa2547 100644 --- a/gcc/ada/a-stwisu.ads +++ b/gcc/ada/a-stwisu.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2003-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- -- @@ -35,7 +35,7 @@ -- generic package Ada.Strings.Wide_Bounded.Generic_Bounded_Length. -- It defines type Super_String as a discriminated record with the maximum --- length as the discriminant. Individual instantiations of +-- length as the discriminant. Individual instantiations of the package -- Strings.Wide_Bounded.Generic_Bounded_Length use this type with -- an appropriate discriminant value set. @@ -50,14 +50,12 @@ pragma Preelaborate (Wide_Superbounded); Current_Length : Natural := 0; Data : Wide_String (1 .. Max_Length) := (others => Wide_NUL); end record; - -- Type Wide_Bounded_String in - -- Ada.Strings.Wide_Bounded.Generic_Bounded_Length is derived from this - -- type, with the constraint of the maximum length. + -- Ada.Strings.Wide_Bounded.Generic_Bounded_Length.Wide_Bounded_String is + -- derived from this type, with the constraint of the maximum length. - -- The subprograms defined for Super_String are similar to those - -- defined for Wide_Bounded_String, except that they have different names, - -- so that they can be renamed in - -- Ada.Strings.Wide_Bounded.Generic_Bounded_Length. + -- The subprograms defined for Super_String are similar to those defined + -- for Bounded_Wide_String, except that they have different names, so that + -- they can be renamed in Ada.Strings.Wide_Bounded.Generic_Bounded_Length. function Super_Length (Source : Super_String) return Natural; @@ -68,88 +66,83 @@ pragma Preelaborate (Wide_Superbounded); function To_Super_String (Source : Wide_String; Max_Length : Natural; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; -- Note the additional parameter Max_Length, which specifies the maximum -- length setting of the resulting Super_String value. -- The following procedures have declarations (and semantics) that are - -- exactly analogous to those declared in Ada.Strings.Bounded. + -- exactly analogous to those declared in Ada.Strings.Wide_Bounded. function Super_To_String (Source : Super_String) return Wide_String; + procedure Set_Super_String + (Target : out Super_String; + Source : Wide_String; + Drop : Truncation := Error); + function Super_Append - (Left, Right : Super_String; - Drop : Truncation := Error) - return Super_String; + (Left : Super_String; + Right : Super_String; + Drop : Truncation := Error) return Super_String; function Super_Append (Left : Super_String; Right : Wide_String; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; function Super_Append (Left : Wide_String; Right : Super_String; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; function Super_Append (Left : Super_String; Right : Wide_Character; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; function Super_Append (Left : Wide_Character; Right : Super_String; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; procedure Super_Append (Source : in out Super_String; New_Item : Super_String; - Drop : Truncation := Error); + Drop : Truncation := Error); procedure Super_Append (Source : in out Super_String; New_Item : Wide_String; - Drop : Truncation := Error); + Drop : Truncation := Error); procedure Super_Append (Source : in out Super_String; New_Item : Wide_Character; - Drop : Truncation := Error); + Drop : Truncation := Error); function Concat - (Left, Right : Super_String) - return Super_String; + (Left : Super_String; + Right : Super_String) return Super_String; function Concat (Left : Super_String; - Right : Wide_String) - return Super_String; + Right : Wide_String) return Super_String; function Concat (Left : Wide_String; - Right : Super_String) - return Super_String; + Right : Super_String) return Super_String; function Concat (Left : Super_String; - Right : Wide_Character) - return Super_String; + Right : Wide_Character) return Super_String; function Concat (Left : Wide_Character; - Right : Super_String) - return Super_String; + Right : Super_String) return Super_String; function Super_Element (Source : Super_String; - Index : Positive) - return Wide_Character; + Index : Positive) return Wide_Character; procedure Super_Replace_Element (Source : in out Super_String; @@ -159,70 +152,82 @@ pragma Preelaborate (Wide_Superbounded); function Super_Slice (Source : Super_String; Low : Positive; - High : Natural) - return Wide_String; + High : Natural) return Wide_String; + + function Super_Slice + (Source : Super_String; + Low : Positive; + High : Natural) return Super_String; + + procedure Super_Slice + (Source : Super_String; + Target : out Super_String; + Low : Positive; + High : Natural); - function "=" (Left, Right : Super_String) return Boolean; + function "=" + (Left : Super_String; + Right : Super_String) return Boolean; - function Equal (Left, Right : Super_String) return Boolean renames "="; + function Equal + (Left : Super_String; + Right : Super_String) return Boolean renames "="; function Equal (Left : Super_String; - Right : Wide_String) - return Boolean; + Right : Wide_String) return Boolean; function Equal (Left : Wide_String; - Right : Super_String) - return Boolean; + Right : Super_String) return Boolean; - function Less (Left, Right : Super_String) return Boolean; + function Less + (Left : Super_String; + Right : Super_String) return Boolean; function Less (Left : Super_String; - Right : Wide_String) - return Boolean; + Right : Wide_String) return Boolean; function Less (Left : Wide_String; - Right : Super_String) - return Boolean; + Right : Super_String) return Boolean; - function Less_Or_Equal (Left, Right : Super_String) return Boolean; + function Less_Or_Equal + (Left : Super_String; + Right : Super_String) return Boolean; function Less_Or_Equal (Left : Super_String; - Right : Wide_String) - return Boolean; + Right : Wide_String) return Boolean; function Less_Or_Equal (Left : Wide_String; - Right : Super_String) - return Boolean; + Right : Super_String) return Boolean; - function Greater (Left, Right : Super_String) return Boolean; + function Greater + (Left : Super_String; + Right : Super_String) return Boolean; function Greater (Left : Super_String; - Right : Wide_String) - return Boolean; + Right : Wide_String) return Boolean; function Greater (Left : Wide_String; - Right : Super_String) - return Boolean; + Right : Super_String) return Boolean; - function Greater_Or_Equal (Left, Right : Super_String) return Boolean; + function Greater_Or_Equal + (Left : Super_String; + Right : Super_String) return Boolean; function Greater_Or_Equal (Left : Super_String; - Right : Wide_String) - return Boolean; + Right : Wide_String) return Boolean; function Greater_Or_Equal (Left : Wide_String; - Right : Super_String) - return Boolean; + Right : Super_String) return Boolean; ---------------------- -- Search Functions -- @@ -233,43 +238,65 @@ pragma Preelaborate (Wide_Superbounded); Pattern : Wide_String; Going : Direction := Forward; Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) - return Natural; + return Natural; function Super_Index (Source : Super_String; Pattern : Wide_String; Going : Direction := Forward; - Mapping : Wide_Maps.Wide_Character_Mapping_Function) - return Natural; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural; function Super_Index (Source : Super_String; Set : Wide_Maps.Wide_Character_Set; Test : Membership := Inside; - Going : Direction := Forward) - return Natural; + Going : Direction := Forward) return Natural; + + function Super_Index + (Source : Super_String; + Pattern : Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural; + + function Super_Index + (Source : Super_String; + Pattern : Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural; + + function Super_Index + (Source : Super_String; + Set : Wide_Maps.Wide_Character_Set; + From : Positive; + Test : Membership := Inside; + Going : Direction := Forward) return Natural; + + function Super_Index_Non_Blank + (Source : Super_String; + Going : Direction := Forward) return Natural; function Super_Index_Non_Blank (Source : Super_String; - Going : Direction := Forward) - return Natural; + From : Positive; + Going : Direction := Forward) return Natural; function Super_Count (Source : Super_String; Pattern : Wide_String; Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) - return Natural; + return Natural; function Super_Count (Source : Super_String; Pattern : Wide_String; - Mapping : Wide_Maps.Wide_Character_Mapping_Function) - return Natural; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural; function Super_Count (Source : Super_String; - Set : Wide_Maps.Wide_Character_Set) - return Natural; + Set : Wide_Maps.Wide_Character_Set) return Natural; procedure Super_Find_Token (Source : Super_String; @@ -278,14 +305,13 @@ pragma Preelaborate (Wide_Superbounded); First : out Positive; Last : out Natural); - ----------------------------------------- - -- Wide_String Translation Subprograms -- - ----------------------------------------- + ------------------------------------ + -- String Translation Subprograms -- + ------------------------------------ function Super_Translate - (Source : Super_String; - Mapping : Wide_Maps.Wide_Character_Mapping) - return Super_String; + (Source : Super_String; + Mapping : Wide_Maps.Wide_Character_Mapping) return Super_String; procedure Super_Translate (Source : in out Super_String; @@ -293,38 +319,35 @@ pragma Preelaborate (Wide_Superbounded); function Super_Translate (Source : Super_String; - Mapping : Wide_Maps.Wide_Character_Mapping_Function) - return Super_String; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Super_String; procedure Super_Translate (Source : in out Super_String; Mapping : Wide_Maps.Wide_Character_Mapping_Function); - -------------------------------------------- - -- Wide_String Transformation Subprograms -- - -------------------------------------------- + --------------------------------------- + -- String Transformation Subprograms -- + --------------------------------------- function Super_Replace_Slice - (Source : Super_String; - Low : Positive; - High : Natural; - By : Wide_String; - Drop : Truncation := Error) - return Super_String; + (Source : Super_String; + Low : Positive; + High : Natural; + By : Wide_String; + Drop : Truncation := Error) return Super_String; procedure Super_Replace_Slice - (Source : in out Super_String; - Low : Positive; - High : Natural; - By : Wide_String; - Drop : Truncation := Error); + (Source : in out Super_String; + Low : Positive; + High : Natural; + By : Wide_String; + Drop : Truncation := Error); function Super_Insert (Source : Super_String; Before : Positive; New_Item : Wide_String; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; procedure Super_Insert (Source : in out Super_String; @@ -333,11 +356,10 @@ pragma Preelaborate (Wide_Superbounded); Drop : Truncation := Error); function Super_Overwrite - (Source : Super_String; - Position : Positive; - New_Item : Wide_String; - Drop : Truncation := Error) - return Super_String; + (Source : Super_String; + Position : Positive; + New_Item : Wide_String; + Drop : Truncation := Error) return Super_String; procedure Super_Overwrite (Source : in out Super_String; @@ -348,32 +370,29 @@ pragma Preelaborate (Wide_Superbounded); function Super_Delete (Source : Super_String; From : Positive; - Through : Natural) - return Super_String; + Through : Natural) return Super_String; procedure Super_Delete (Source : in out Super_String; From : Positive; Through : Natural); - -------------------------------------- - -- Wide_String Selector Subprograms -- - -------------------------------------- + --------------------------------- + -- String Selector Subprograms -- + --------------------------------- function Super_Trim (Source : Super_String; - Side : Trim_End) - return Super_String; + Side : Trim_End) return Super_String; procedure Super_Trim (Source : in out Super_String; Side : Trim_End); function Super_Trim - (Source : Super_String; + (Source : Super_String; Left : Wide_Maps.Wide_Character_Set; - Right : Wide_Maps.Wide_Character_Set) - return Super_String; + Right : Wide_Maps.Wide_Character_Set) return Super_String; procedure Super_Trim (Source : in out Super_String; @@ -384,30 +403,28 @@ pragma Preelaborate (Wide_Superbounded); (Source : Super_String; Count : Natural; Pad : Wide_Character := Wide_Space; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; procedure Super_Head (Source : in out Super_String; Count : Natural; Pad : Wide_Character := Wide_Space; - Drop : Truncation := Error); + Drop : Truncation := Error); function Super_Tail (Source : Super_String; Count : Natural; Pad : Wide_Character := Wide_Space; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; procedure Super_Tail (Source : in out Super_String; Count : Natural; Pad : Wide_Character := Wide_Space; - Drop : Truncation := Error); + Drop : Truncation := Error); ------------------------------------ - -- Wide_String Constructor Subprograms -- + -- String Constructor Subprograms -- ------------------------------------ -- Note: in some of the following routines, there is an extra parameter @@ -417,46 +434,39 @@ pragma Preelaborate (Wide_Superbounded); function Times (Left : Natural; Right : Wide_Character; - Max_Length : Positive) - return Super_String; + Max_Length : Positive) return Super_String; -- Note the additional parameter Max_Length function Times (Left : Natural; Right : Wide_String; - Max_Length : Positive) - return Super_String; + Max_Length : Positive) return Super_String; -- Note the additional parameter Max_Length function Times (Left : Natural; - Right : Super_String) - return Super_String; + Right : Super_String) return Super_String; function Super_Replicate (Count : Natural; Item : Wide_Character; Drop : Truncation := Error; - Max_Length : Positive) - return Super_String; + Max_Length : Positive) return Super_String; -- Note the additional parameter Max_Length function Super_Replicate (Count : Natural; Item : Wide_String; Drop : Truncation := Error; - Max_Length : Positive) - return Super_String; + Max_Length : Positive) return Super_String; -- Note the additional parameter Max_Length function Super_Replicate (Count : Natural; Item : Super_String; - Drop : Truncation := Error) - return Super_String; + Drop : Truncation := Error) return Super_String; private - -- Pragma Inline declarations pragma Inline ("="); diff --git a/gcc/ada/a-stwiun.adb b/gcc/ada/a-stwiun.adb index 5e88d3e9997..b4217720079 100644 --- a/gcc/ada/a-stwiun.adb +++ b/gcc/ada/a-stwiun.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- -- @@ -55,8 +55,7 @@ package body Ada.Strings.Wide_Unbounded is function "&" (Left : Unbounded_Wide_String; - Right : Unbounded_Wide_String) - return Unbounded_Wide_String + Right : Unbounded_Wide_String) return Unbounded_Wide_String is L_Length : constant Natural := Left.Last; R_Length : constant Natural := Right.Last; @@ -77,8 +76,7 @@ package body Ada.Strings.Wide_Unbounded is function "&" (Left : Unbounded_Wide_String; - Right : Wide_String) - return Unbounded_Wide_String + Right : Wide_String) return Unbounded_Wide_String is L_Length : constant Natural := Left.Last; Result : Unbounded_Wide_String; @@ -96,8 +94,7 @@ package body Ada.Strings.Wide_Unbounded is function "&" (Left : Wide_String; - Right : Unbounded_Wide_String) - return Unbounded_Wide_String + Right : Unbounded_Wide_String) return Unbounded_Wide_String is R_Length : constant Natural := Right.Last; Result : Unbounded_Wide_String; @@ -116,8 +113,7 @@ package body Ada.Strings.Wide_Unbounded is function "&" (Left : Unbounded_Wide_String; - Right : Wide_Character) - return Unbounded_Wide_String + Right : Wide_Character) return Unbounded_Wide_String is Result : Unbounded_Wide_String; @@ -135,8 +131,7 @@ package body Ada.Strings.Wide_Unbounded is function "&" (Left : Wide_Character; - Right : Unbounded_Wide_String) - return Unbounded_Wide_String + Right : Unbounded_Wide_String) return Unbounded_Wide_String is Result : Unbounded_Wide_String; @@ -157,8 +152,7 @@ package body Ada.Strings.Wide_Unbounded is function "*" (Left : Natural; - Right : Wide_Character) - return Unbounded_Wide_String + Right : Wide_Character) return Unbounded_Wide_String is Result : Unbounded_Wide_String; @@ -174,9 +168,8 @@ package body Ada.Strings.Wide_Unbounded is end "*"; function "*" - (Left : Natural; - Right : Wide_String) - return Unbounded_Wide_String + (Left : Natural; + Right : Wide_String) return Unbounded_Wide_String is Len : constant Natural := Right'Length; K : Positive; @@ -198,8 +191,7 @@ package body Ada.Strings.Wide_Unbounded is function "*" (Left : Natural; - Right : Unbounded_Wide_String) - return Unbounded_Wide_String + Right : Unbounded_Wide_String) return Unbounded_Wide_String is Len : constant Natural := Right.Last; K : Positive; @@ -226,8 +218,7 @@ package body Ada.Strings.Wide_Unbounded is function "<" (Left : Unbounded_Wide_String; - Right : Unbounded_Wide_String) - return Boolean + Right : Unbounded_Wide_String) return Boolean is begin return @@ -236,8 +227,7 @@ package body Ada.Strings.Wide_Unbounded is function "<" (Left : Unbounded_Wide_String; - Right : Wide_String) - return Boolean + Right : Wide_String) return Boolean is begin return Left.Reference (1 .. Left.Last) < Right; @@ -245,8 +235,7 @@ package body Ada.Strings.Wide_Unbounded is function "<" (Left : Wide_String; - Right : Unbounded_Wide_String) - return Boolean + Right : Unbounded_Wide_String) return Boolean is begin return Left < Right.Reference (1 .. Right.Last); @@ -258,8 +247,7 @@ package body Ada.Strings.Wide_Unbounded is function "<=" (Left : Unbounded_Wide_String; - Right : Unbounded_Wide_String) - return Boolean + Right : Unbounded_Wide_String) return Boolean is begin return @@ -268,8 +256,7 @@ package body Ada.Strings.Wide_Unbounded is function "<=" (Left : Unbounded_Wide_String; - Right : Wide_String) - return Boolean + Right : Wide_String) return Boolean is begin return Left.Reference (1 .. Left.Last) <= Right; @@ -277,8 +264,7 @@ package body Ada.Strings.Wide_Unbounded is function "<=" (Left : Wide_String; - Right : Unbounded_Wide_String) - return Boolean + Right : Unbounded_Wide_String) return Boolean is begin return Left <= Right.Reference (1 .. Right.Last); @@ -290,8 +276,7 @@ package body Ada.Strings.Wide_Unbounded is function "=" (Left : Unbounded_Wide_String; - Right : Unbounded_Wide_String) - return Boolean + Right : Unbounded_Wide_String) return Boolean is begin return @@ -300,8 +285,7 @@ package body Ada.Strings.Wide_Unbounded is function "=" (Left : Unbounded_Wide_String; - Right : Wide_String) - return Boolean + Right : Wide_String) return Boolean is begin return Left.Reference (1 .. Left.Last) = Right; @@ -309,8 +293,7 @@ package body Ada.Strings.Wide_Unbounded is function "=" (Left : Wide_String; - Right : Unbounded_Wide_String) - return Boolean + Right : Unbounded_Wide_String) return Boolean is begin return Left = Right.Reference (1 .. Right.Last); @@ -322,8 +305,7 @@ package body Ada.Strings.Wide_Unbounded is function ">" (Left : Unbounded_Wide_String; - Right : Unbounded_Wide_String) - return Boolean + Right : Unbounded_Wide_String) return Boolean is begin return @@ -332,8 +314,7 @@ package body Ada.Strings.Wide_Unbounded is function ">" (Left : Unbounded_Wide_String; - Right : Wide_String) - return Boolean + Right : Wide_String) return Boolean is begin return Left.Reference (1 .. Left.Last) > Right; @@ -341,8 +322,7 @@ package body Ada.Strings.Wide_Unbounded is function ">" (Left : Wide_String; - Right : Unbounded_Wide_String) - return Boolean + Right : Unbounded_Wide_String) return Boolean is begin return Left > Right.Reference (1 .. Right.Last); @@ -354,8 +334,7 @@ package body Ada.Strings.Wide_Unbounded is function ">=" (Left : Unbounded_Wide_String; - Right : Unbounded_Wide_String) - return Boolean + Right : Unbounded_Wide_String) return Boolean is begin return @@ -364,8 +343,7 @@ package body Ada.Strings.Wide_Unbounded is function ">=" (Left : Unbounded_Wide_String; - Right : Wide_String) - return Boolean + Right : Wide_String) return Boolean is begin return Left.Reference (1 .. Left.Last) >= Right; @@ -373,8 +351,7 @@ package body Ada.Strings.Wide_Unbounded is function ">=" (Left : Wide_String; - Right : Unbounded_Wide_String) - return Boolean + Right : Unbounded_Wide_String) return Boolean is begin return Left >= Right.Reference (1 .. Right.Last); @@ -438,11 +415,11 @@ package body Ada.Strings.Wide_Unbounded is ----------- function Count - (Source : Unbounded_Wide_String; - Pattern : Wide_String; - Mapping : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.Identity) - return Natural + (Source : Unbounded_Wide_String; + Pattern : Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping := + Wide_Maps.Identity) + return Natural is begin return Wide_Search.Count @@ -450,10 +427,9 @@ package body Ada.Strings.Wide_Unbounded is end Count; function Count - (Source : Unbounded_Wide_String; - Pattern : Wide_String; - Mapping : Wide_Maps.Wide_Character_Mapping_Function) - return Natural + (Source : Unbounded_Wide_String; + Pattern : Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural is begin return Wide_Search.Count @@ -461,9 +437,8 @@ package body Ada.Strings.Wide_Unbounded is end Count; function Count - (Source : Unbounded_Wide_String; - Set : Wide_Maps.Wide_Character_Set) - return Natural + (Source : Unbounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set) return Natural is begin return Wide_Search.Count (Source.Reference (1 .. Source.Last), Set); @@ -476,8 +451,7 @@ package body Ada.Strings.Wide_Unbounded is function Delete (Source : Unbounded_Wide_String; From : Positive; - Through : Natural) - return Unbounded_Wide_String + Through : Natural) return Unbounded_Wide_String is begin return To_Unbounded_Wide_String @@ -515,8 +489,7 @@ package body Ada.Strings.Wide_Unbounded is function Element (Source : Unbounded_Wide_String; - Index : Positive) - return Wide_Character + Index : Positive) return Wide_Character is begin if Index <= Source.Last then @@ -581,8 +554,7 @@ package body Ada.Strings.Wide_Unbounded is function Head (Source : Unbounded_Wide_String; Count : Natural; - Pad : Wide_Character := Wide_Space) - return Unbounded_Wide_String + Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String is begin return @@ -609,12 +581,11 @@ package body Ada.Strings.Wide_Unbounded is ----------- function Index - (Source : Unbounded_Wide_String; - Pattern : Wide_String; - Going : Strings.Direction := Strings.Forward; - Mapping : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.Identity) - return Natural + (Source : Unbounded_Wide_String; + Pattern : Wide_String; + Going : Strings.Direction := Strings.Forward; + Mapping : Wide_Maps.Wide_Character_Mapping := + Wide_Maps.Identity) return Natural is begin return Wide_Search.Index @@ -622,11 +593,10 @@ package body Ada.Strings.Wide_Unbounded is end Index; function Index - (Source : Unbounded_Wide_String; - Pattern : Wide_String; - Going : Direction := Forward; - Mapping : Wide_Maps.Wide_Character_Mapping_Function) - return Natural + (Source : Unbounded_Wide_String; + Pattern : Wide_String; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural is begin return Wide_Search.Index @@ -637,8 +607,7 @@ package body Ada.Strings.Wide_Unbounded is (Source : Unbounded_Wide_String; Set : Wide_Maps.Wide_Character_Set; Test : Strings.Membership := Strings.Inside; - Going : Strings.Direction := Strings.Forward) - return Natural + Going : Strings.Direction := Strings.Forward) return Natural is begin return Wide_Search.Index @@ -647,8 +616,7 @@ package body Ada.Strings.Wide_Unbounded is function Index_Non_Blank (Source : Unbounded_Wide_String; - Going : Strings.Direction := Strings.Forward) - return Natural + Going : Strings.Direction := Strings.Forward) return Natural is begin return Wide_Search.Index_Non_Blank @@ -672,8 +640,7 @@ package body Ada.Strings.Wide_Unbounded is function Insert (Source : Unbounded_Wide_String; Before : Positive; - New_Item : Wide_String) - return Unbounded_Wide_String + New_Item : Wide_String) return Unbounded_Wide_String is begin return To_Unbounded_Wide_String @@ -715,11 +682,10 @@ package body Ada.Strings.Wide_Unbounded is --------------- function Overwrite - (Source : Unbounded_Wide_String; - Position : Positive; - New_Item : Wide_String) - return Unbounded_Wide_String is - + (Source : Unbounded_Wide_String; + Position : Positive; + New_Item : Wide_String) return Unbounded_Wide_String + is begin return To_Unbounded_Wide_String (Wide_Fixed.Overwrite @@ -800,11 +766,10 @@ package body Ada.Strings.Wide_Unbounded is ------------------- function Replace_Slice - (Source : Unbounded_Wide_String; - Low : Positive; - High : Natural; - By : Wide_String) - return Unbounded_Wide_String + (Source : Unbounded_Wide_String; + Low : Positive; + High : Natural; + By : Wide_String) return Unbounded_Wide_String is begin return @@ -836,8 +801,7 @@ package body Ada.Strings.Wide_Unbounded is function Slice (Source : Unbounded_Wide_String; Low : Positive; - High : Natural) - return Wide_String + High : Natural) return Wide_String is begin -- Note: test of High > Length is in accordance with AI95-00128 @@ -857,9 +821,8 @@ package body Ada.Strings.Wide_Unbounded is function Tail (Source : Unbounded_Wide_String; Count : Natural; - Pad : Wide_Character := Wide_Space) - return Unbounded_Wide_String is - + Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String + is begin return To_Unbounded_Wide_String (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad)); @@ -884,11 +847,9 @@ package body Ada.Strings.Wide_Unbounded is ------------------------------ function To_Unbounded_Wide_String - (Source : Wide_String) - return Unbounded_Wide_String + (Source : Wide_String) return Unbounded_Wide_String is Result : Unbounded_Wide_String; - begin Result.Last := Source'Length; Result.Reference := new Wide_String (1 .. Source'Length); @@ -896,11 +857,10 @@ package body Ada.Strings.Wide_Unbounded is return Result; end To_Unbounded_Wide_String; - function To_Unbounded_Wide_String (Length : Natural) - return Unbounded_Wide_String + function To_Unbounded_Wide_String + (Length : Natural) return Unbounded_Wide_String is Result : Unbounded_Wide_String; - begin Result.Last := Length; Result.Reference := new Wide_String (1 .. Length); @@ -912,8 +872,7 @@ package body Ada.Strings.Wide_Unbounded is -------------------- function To_Wide_String - (Source : Unbounded_Wide_String) - return Wide_String + (Source : Unbounded_Wide_String) return Wide_String is begin return Source.Reference (1 .. Source.Last); @@ -925,8 +884,7 @@ package body Ada.Strings.Wide_Unbounded is function Translate (Source : Unbounded_Wide_String; - Mapping : Wide_Maps.Wide_Character_Mapping) - return Unbounded_Wide_String + Mapping : Wide_Maps.Wide_Character_Mapping) return Unbounded_Wide_String is begin return To_Unbounded_Wide_String @@ -944,7 +902,7 @@ package body Ada.Strings.Wide_Unbounded is function Translate (Source : Unbounded_Wide_String; Mapping : Wide_Maps.Wide_Character_Mapping_Function) - return Unbounded_Wide_String + return Unbounded_Wide_String is begin return To_Unbounded_Wide_String @@ -965,8 +923,7 @@ package body Ada.Strings.Wide_Unbounded is function Trim (Source : Unbounded_Wide_String; - Side : Trim_End) - return Unbounded_Wide_String + Side : Trim_End) return Unbounded_Wide_String is begin return To_Unbounded_Wide_String @@ -988,8 +945,7 @@ package body Ada.Strings.Wide_Unbounded is function Trim (Source : Unbounded_Wide_String; Left : Wide_Maps.Wide_Character_Set; - Right : Wide_Maps.Wide_Character_Set) - return Unbounded_Wide_String + Right : Wide_Maps.Wide_Character_Set) return Unbounded_Wide_String is begin return To_Unbounded_Wide_String diff --git a/gcc/ada/a-stwiun.ads b/gcc/ada/a-stwiun.ads index 6b348d456fd..ed231b2e66c 100644 --- a/gcc/ada/a-stwiun.ads +++ b/gcc/ada/a-stwiun.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -56,195 +56,165 @@ pragma Preelaborate (Wide_Unbounded); -------------------------------------------------------- function To_Unbounded_Wide_String - (Source : Wide_String) - return Unbounded_Wide_String; + (Source : Wide_String) return Unbounded_Wide_String; function To_Unbounded_Wide_String - (Length : in Natural) - return Unbounded_Wide_String; + (Length : Natural) return Unbounded_Wide_String; function To_Wide_String - (Source : Unbounded_Wide_String) - return Wide_String; + (Source : Unbounded_Wide_String) return Wide_String; procedure Append (Source : in out Unbounded_Wide_String; - New_Item : in Unbounded_Wide_String); + New_Item : Unbounded_Wide_String); procedure Append (Source : in out Unbounded_Wide_String; - New_Item : in Wide_String); + New_Item : Wide_String); procedure Append (Source : in out Unbounded_Wide_String; - New_Item : in Wide_Character); + New_Item : Wide_Character); function "&" - (Left, Right : Unbounded_Wide_String) - return Unbounded_Wide_String; + (Left, Right : Unbounded_Wide_String) return Unbounded_Wide_String; function "&" - (Left : in Unbounded_Wide_String; - Right : in Wide_String) - return Unbounded_Wide_String; + (Left : Unbounded_Wide_String; + Right : Wide_String) return Unbounded_Wide_String; function "&" - (Left : in Wide_String; - Right : in Unbounded_Wide_String) - return Unbounded_Wide_String; + (Left : Wide_String; + Right : Unbounded_Wide_String) return Unbounded_Wide_String; function "&" - (Left : in Unbounded_Wide_String; - Right : in Wide_Character) - return Unbounded_Wide_String; + (Left : Unbounded_Wide_String; + Right : Wide_Character) return Unbounded_Wide_String; function "&" - (Left : in Wide_Character; - Right : in Unbounded_Wide_String) - return Unbounded_Wide_String; + (Left : Wide_Character; + Right : Unbounded_Wide_String) return Unbounded_Wide_String; function Element - (Source : in Unbounded_Wide_String; - Index : in Positive) - return Wide_Character; + (Source : Unbounded_Wide_String; + Index : Positive) return Wide_Character; procedure Replace_Element (Source : in out Unbounded_Wide_String; - Index : in Positive; + Index : Positive; By : Wide_Character); function Slice - (Source : in Unbounded_Wide_String; - Low : in Positive; - High : in Natural) - return Wide_String; + (Source : Unbounded_Wide_String; + Low : Positive; + High : Natural) return Wide_String; function "=" - (Left : in Unbounded_Wide_String; - Right : in Unbounded_Wide_String) - return Boolean; + (Left : Unbounded_Wide_String; + Right : Unbounded_Wide_String) return Boolean; function "=" - (Left : in Unbounded_Wide_String; - Right : in Wide_String) - return Boolean; + (Left : Unbounded_Wide_String; + Right : Wide_String) return Boolean; function "=" - (Left : in Wide_String; - Right : in Unbounded_Wide_String) - return Boolean; + (Left : Wide_String; + Right : Unbounded_Wide_String) return Boolean; function "<" - (Left : in Unbounded_Wide_String; - Right : in Unbounded_Wide_String) - return Boolean; + (Left : Unbounded_Wide_String; + Right : Unbounded_Wide_String) return Boolean; function "<" - (Left : in Unbounded_Wide_String; - Right : in Wide_String) - return Boolean; + (Left : Unbounded_Wide_String; + Right : Wide_String) return Boolean; function "<" - (Left : in Wide_String; - Right : in Unbounded_Wide_String) - return Boolean; + (Left : Wide_String; + Right : Unbounded_Wide_String) return Boolean; function "<=" - (Left : in Unbounded_Wide_String; - Right : in Unbounded_Wide_String) - return Boolean; + (Left : Unbounded_Wide_String; + Right : Unbounded_Wide_String) return Boolean; function "<=" - (Left : in Unbounded_Wide_String; - Right : in Wide_String) - return Boolean; + (Left : Unbounded_Wide_String; + Right : Wide_String) return Boolean; function "<=" - (Left : in Wide_String; - Right : in Unbounded_Wide_String) - return Boolean; + (Left : Wide_String; + Right : Unbounded_Wide_String) return Boolean; function ">" - (Left : in Unbounded_Wide_String; - Right : in Unbounded_Wide_String) - return Boolean; + (Left : Unbounded_Wide_String; + Right : Unbounded_Wide_String) return Boolean; function ">" - (Left : in Unbounded_Wide_String; - Right : in Wide_String) - return Boolean; + (Left : Unbounded_Wide_String; + Right : Wide_String) return Boolean; function ">" - (Left : in Wide_String; - Right : in Unbounded_Wide_String) - return Boolean; + (Left : Wide_String; + Right : Unbounded_Wide_String) return Boolean; function ">=" - (Left : in Unbounded_Wide_String; - Right : in Unbounded_Wide_String) - return Boolean; + (Left : Unbounded_Wide_String; + Right : Unbounded_Wide_String) return Boolean; function ">=" - (Left : in Unbounded_Wide_String; - Right : in Wide_String) - return Boolean; + (Left : Unbounded_Wide_String; + Right : Wide_String) return Boolean; function ">=" - (Left : in Wide_String; - Right : in Unbounded_Wide_String) - return Boolean; + (Left : Wide_String; + Right : Unbounded_Wide_String) return Boolean; ------------------------ -- Search Subprograms -- ------------------------ function Index - (Source : in Unbounded_Wide_String; - Pattern : in Wide_String; - Going : in Direction := Forward; - Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) - return Natural; + (Source : Unbounded_Wide_String; + Pattern : Wide_String; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural; function Index - (Source : in Unbounded_Wide_String; - Pattern : in Wide_String; - Going : in Direction := Forward; - Mapping : in Wide_Maps.Wide_Character_Mapping_Function) - return Natural; + (Source : Unbounded_Wide_String; + Pattern : Wide_String; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural; function Index - (Source : in Unbounded_Wide_String; - Set : in Wide_Maps.Wide_Character_Set; - Test : in Membership := Inside; - Going : in Direction := Forward) - return Natural; + (Source : Unbounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set; + Test : Membership := Inside; + Going : Direction := Forward) return Natural; function Index_Non_Blank - (Source : in Unbounded_Wide_String; - Going : in Direction := Forward) - return Natural; + (Source : Unbounded_Wide_String; + Going : Direction := Forward) return Natural; function Count - (Source : in Unbounded_Wide_String; - Pattern : in Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) - return Natural; + (Source : Unbounded_Wide_String; + Pattern : Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural; function Count - (Source : in Unbounded_Wide_String; - Pattern : in Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping_Function) - return Natural; + (Source : Unbounded_Wide_String; + Pattern : Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural; function Count - (Source : in Unbounded_Wide_String; - Set : in Wide_Maps.Wide_Character_Set) - return Natural; + (Source : Unbounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set) return Natural; procedure Find_Token - (Source : in Unbounded_Wide_String; - Set : in Wide_Maps.Wide_Character_Set; - Test : in Membership; + (Source : Unbounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set; + Test : Membership; First : out Positive; Last : out Natural); @@ -253,129 +223,117 @@ pragma Preelaborate (Wide_Unbounded); ------------------------------------ function Translate - (Source : in Unbounded_Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping) - return Unbounded_Wide_String; + (Source : Unbounded_Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping) return Unbounded_Wide_String; procedure Translate (Source : in out Unbounded_Wide_String; Mapping : Wide_Maps.Wide_Character_Mapping); function Translate - (Source : in Unbounded_Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping_Function) - return Unbounded_Wide_String; + (Source : Unbounded_Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) + return Unbounded_Wide_String; procedure Translate (Source : in out Unbounded_Wide_String; - Mapping : in Wide_Maps.Wide_Character_Mapping_Function); + Mapping : Wide_Maps.Wide_Character_Mapping_Function); --------------------------------------- -- Wide_String Transformation Subprograms -- --------------------------------------- function Replace_Slice - (Source : in Unbounded_Wide_String; - Low : in Positive; - High : in Natural; - By : in Wide_String) - return Unbounded_Wide_String; + (Source : Unbounded_Wide_String; + Low : Positive; + High : Natural; + By : Wide_String) return Unbounded_Wide_String; procedure Replace_Slice (Source : in out Unbounded_Wide_String; - Low : in Positive; - High : in Natural; - By : in Wide_String); + Low : Positive; + High : Natural; + By : Wide_String); function Insert - (Source : in Unbounded_Wide_String; - Before : in Positive; - New_Item : in Wide_String) - return Unbounded_Wide_String; + (Source : Unbounded_Wide_String; + Before : Positive; + New_Item : Wide_String) return Unbounded_Wide_String; procedure Insert (Source : in out Unbounded_Wide_String; - Before : in Positive; - New_Item : in Wide_String); + Before : Positive; + New_Item : Wide_String); function Overwrite - (Source : in Unbounded_Wide_String; - Position : in Positive; - New_Item : in Wide_String) - return Unbounded_Wide_String; + (Source : Unbounded_Wide_String; + Position : Positive; + New_Item : Wide_String) return Unbounded_Wide_String; procedure Overwrite (Source : in out Unbounded_Wide_String; - Position : in Positive; - New_Item : in Wide_String); + Position : Positive; + New_Item : Wide_String); function Delete - (Source : in Unbounded_Wide_String; - From : in Positive; - Through : in Natural) - return Unbounded_Wide_String; + (Source : Unbounded_Wide_String; + From : Positive; + Through : Natural) return Unbounded_Wide_String; procedure Delete (Source : in out Unbounded_Wide_String; - From : in Positive; - Through : in Natural); + From : Positive; + Through : Natural); function Trim - (Source : in Unbounded_Wide_String; - Side : in Trim_End) - return Unbounded_Wide_String; + (Source : Unbounded_Wide_String; + Side : Trim_End) return Unbounded_Wide_String; procedure Trim (Source : in out Unbounded_Wide_String; - Side : in Trim_End); + Side : Trim_End); function Trim - (Source : in Unbounded_Wide_String; - Left : in Wide_Maps.Wide_Character_Set; - Right : in Wide_Maps.Wide_Character_Set) - return Unbounded_Wide_String; + (Source : Unbounded_Wide_String; + Left : Wide_Maps.Wide_Character_Set; + Right : Wide_Maps.Wide_Character_Set) return Unbounded_Wide_String; procedure Trim (Source : in out Unbounded_Wide_String; - Left : in Wide_Maps.Wide_Character_Set; - Right : in Wide_Maps.Wide_Character_Set); + Left : Wide_Maps.Wide_Character_Set; + Right : Wide_Maps.Wide_Character_Set); function Head - (Source : in Unbounded_Wide_String; - Count : in Natural; - Pad : in Wide_Character := Wide_Space) - return Unbounded_Wide_String; + (Source : Unbounded_Wide_String; + Count : Natural; + Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String; procedure Head (Source : in out Unbounded_Wide_String; - Count : in Natural; - Pad : in Wide_Character := Wide_Space); + Count : Natural; + Pad : Wide_Character := Wide_Space); function Tail - (Source : in Unbounded_Wide_String; - Count : in Natural; - Pad : in Wide_Character := Wide_Space) - return Unbounded_Wide_String; + (Source : Unbounded_Wide_String; + Count : Natural; + Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String; procedure Tail (Source : in out Unbounded_Wide_String; - Count : in Natural; - Pad : in Wide_Character := Wide_Space); + Count : Natural; + Pad : Wide_Character := Wide_Space); function "*" - (Left : in Natural; - Right : in Wide_Character) - return Unbounded_Wide_String; + (Left : Natural; + Right : Wide_Character) return Unbounded_Wide_String; function "*" - (Left : in Natural; - Right : in Wide_String) - return Unbounded_Wide_String; + (Left : Natural; + Right : Wide_String) return Unbounded_Wide_String; function "*" - (Left : in Natural; - Right : in Unbounded_Wide_String) - return Unbounded_Wide_String; + (Left : Natural; + Right : Unbounded_Wide_String) return Unbounded_Wide_String; private pragma Inline (Length); diff --git a/gcc/ada/a-suteio.adb b/gcc/ada/a-suteio.adb index 737f3c7b35d..b1ddff23741 100644 --- a/gcc/ada/a-suteio.adb +++ b/gcc/ada/a-suteio.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-1999 Free Software Foundation, Inc. -- +-- Copyright (C) 1997-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- -- @@ -50,7 +50,6 @@ package body Ada.Strings.Unbounded.Text_IO is begin Get_Line (Buffer, Last); Str1 := new String'(Buffer (1 .. Last)); - while Last = Buffer'Last loop Get_Line (Buffer, Last); Str2 := new String'(Str1.all & Buffer (1 .. Last)); @@ -72,7 +71,6 @@ package body Ada.Strings.Unbounded.Text_IO is begin Get_Line (File, Buffer, Last); Str1 := new String'(Buffer (1 .. Last)); - while Last = Buffer'Last loop Get_Line (File, Buffer, Last); Str2 := new String'(Str1.all & Buffer (1 .. Last)); @@ -84,6 +82,47 @@ package body Ada.Strings.Unbounded.Text_IO is return Result; end Get_Line; + procedure Get_Line (Item : out Unbounded_String) is + Buffer : String (1 .. 1000); + Last : Natural; + Str1 : String_Access; + Str2 : String_Access; + + begin + Get_Line (Buffer, Last); + Str1 := new String'(Buffer (1 .. Last)); + while Last = Buffer'Last loop + Get_Line (Buffer, Last); + Str2 := new String'(Str1.all & Buffer (1 .. Last)); + Free (Str1); + Str1 := Str2; + end loop; + + Set_String (Item, Str1); + end Get_Line; + + procedure Get_Line + (File : Ada.Text_IO.File_Type; + Item : out Unbounded_String) + is + Buffer : String (1 .. 1000); + Last : Natural; + Str1 : String_Access; + Str2 : String_Access; + + begin + Get_Line (File, Buffer, Last); + Str1 := new String'(Buffer (1 .. Last)); + while Last = Buffer'Last loop + Get_Line (Buffer, Last); + Str2 := new String'(Str1.all & Buffer (1 .. Last)); + Free (Str1); + Str1 := Str2; + end loop; + + Set_String (Item, Str1); + end Get_Line; + --------- -- Put -- --------- diff --git a/gcc/ada/a-suteio.ads b/gcc/ada/a-suteio.ads index c98f453f64b..e743bdf7243 100644 --- a/gcc/ada/a-suteio.ads +++ b/gcc/ada/a-suteio.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1997-1999 Free Software Foundation, Inc. -- +-- Copyright (C) 1997-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- -- @@ -46,6 +46,12 @@ package Ada.Strings.Unbounded.Text_IO is -- as an unbounded string of appropriate length. If no File parameter -- is present, input is from Current_Input. + procedure Get_Line + (File : Ada.Text_IO.File_Type; + Item : out Unbounded_String); + procedure Get_Line (Item : out Unbounded_String); + -- Similar to the above, but in procedure form with an out parameter + procedure Put (U : Unbounded_String); procedure Put (File : Ada.Text_IO.File_Type; U : Unbounded_String); procedure Put_Line (U : Unbounded_String); diff --git a/gcc/ada/a-swuwti.adb b/gcc/ada/a-swuwti.adb index adf4ba7f05c..9836ae5b58c 100644 --- a/gcc/ada/a-swuwti.adb +++ b/gcc/ada/a-swuwti.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-1999 Free Software Foundation, Inc. -- +-- Copyright (C) 1997-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- -- @@ -31,7 +31,8 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Wide_Text_IO; use Ada.Wide_Text_IO; +with Ada.Strings.Wide_Unbounded.Aux; use Ada.Strings.Wide_Unbounded.Aux; +with Ada.Wide_Text_IO; use Ada.Wide_Text_IO; package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is @@ -44,11 +45,11 @@ package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is Last : Natural; Str1 : Wide_String_Access; Str2 : Wide_String_Access; + Result : Unbounded_Wide_String; begin Get_Line (Buffer, Last); Str1 := new Wide_String'(Buffer (1 .. Last)); - while Last = Buffer'Last loop Get_Line (Buffer, Last); Str2 := new Wide_String'(Str1.all & Buffer (1 .. Last)); @@ -56,17 +57,18 @@ package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is Str1 := Str2; end loop; - return To_Unbounded_Wide_String (Str1.all); + Set_Wide_String (Result, Str1); + return Result; end Get_Line; function Get_Line - (File : Ada.Wide_Text_IO.File_Type) - return Unbounded_Wide_String + (File : Ada.Wide_Text_IO.File_Type) return Unbounded_Wide_String is Buffer : Wide_String (1 .. 1000); Last : Natural; Str1 : Wide_String_Access; Str2 : Wide_String_Access; + Result : Unbounded_Wide_String; begin Get_Line (File, Buffer, Last); @@ -79,7 +81,49 @@ package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is Str1 := Str2; end loop; - return To_Unbounded_Wide_String (Str1.all); + Set_Wide_String (Result, Str1); + return Result; + end Get_Line; + + procedure Get_Line (Item : out Unbounded_Wide_String) is + Buffer : Wide_String (1 .. 1000); + Last : Natural; + Str1 : Wide_String_Access; + Str2 : Wide_String_Access; + + begin + Get_Line (Buffer, Last); + Str1 := new Wide_String'(Buffer (1 .. Last)); + while Last = Buffer'Last loop + Get_Line (Buffer, Last); + Str2 := new Wide_String'(Str1.all & Buffer (1 .. Last)); + Free (Str1); + Str1 := Str2; + end loop; + + Set_Wide_String (Item, Str1); + end Get_Line; + + procedure Get_Line + (File : Ada.Wide_Text_IO.File_Type; + Item : out Unbounded_Wide_String) + is + Buffer : Wide_String (1 .. 1000); + Last : Natural; + Str1 : Wide_String_Access; + Str2 : Wide_String_Access; + + begin + Get_Line (File, Buffer, Last); + Str1 := new Wide_String'(Buffer (1 .. Last)); + while Last = Buffer'Last loop + Get_Line (Buffer, Last); + Str2 := new Wide_String'(Str1.all & Buffer (1 .. Last)); + Free (Str1); + Str1 := Str2; + end loop; + + Set_Wide_String (Item, Str1); end Get_Line; --------- @@ -88,12 +132,12 @@ package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is procedure Put (U : Unbounded_Wide_String) is begin - Put (To_Wide_String (U)); + Put (Get_Wide_String (U).all); end Put; procedure Put (File : File_Type; U : Unbounded_Wide_String) is begin - Put (File, To_Wide_String (U)); + Put (File, Get_Wide_String (U).all); end Put; -------------- @@ -102,12 +146,12 @@ package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is procedure Put_Line (U : Unbounded_Wide_String) is begin - Put_Line (To_Wide_String (U)); + Put_Line (Get_Wide_String (U).all); end Put_Line; procedure Put_Line (File : File_Type; U : Unbounded_Wide_String) is begin - Put_Line (File, To_Wide_String (U)); + Put_Line (File, Get_Wide_String (U).all); end Put_Line; end Ada.Strings.Wide_Unbounded.Wide_Text_IO; diff --git a/gcc/ada/a-swuwti.ads b/gcc/ada/a-swuwti.ads index fca6211b00d..ff8acf75273 100644 --- a/gcc/ada/a-swuwti.ads +++ b/gcc/ada/a-swuwti.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1997-1999 Free Software Foundation, Inc. -- +-- Copyright (C) 1997-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- -- @@ -32,9 +32,9 @@ ------------------------------------------------------------------------------ -- This child package of Ada.Strings.Wide_Unbounded provides specialized --- Text_IO routines that work directly with unbounded strings, avoiding the --- inefficiencies of access via the standard interface, and also taking --- direct advantage of the variable length semantics of these strings. +-- Wide_Text_IO routines that work directly with unbounded wide strings, +-- avoiding the inefficiencies of access via the standard interface, and also +-- taking direct advantage of the variable length semantics of these strings. with Ada.Wide_Text_IO; @@ -43,12 +43,17 @@ package Ada.Strings.Wide_Unbounded.Wide_Text_IO is function Get_Line return Unbounded_Wide_String; function Get_Line - (File : Ada.Wide_Text_IO.File_Type) - return Unbounded_Wide_String; + (File : Ada.Wide_Text_IO.File_Type) return Unbounded_Wide_String; -- Reads up to the end of the current line, returning the result -- as an unbounded string of appropriate length. If no File parameter -- is present, input is from Current_Input. + procedure Get_Line + (File : Ada.Wide_Text_IO.File_Type; + Item : out Unbounded_Wide_String); + procedure Get_Line (Item : out Unbounded_Wide_String); + -- Similar to the above, but in procedure form with an out parameter + procedure Put (U : Unbounded_Wide_String); procedure Put diff --git a/gcc/ada/a-tags.adb b/gcc/ada/a-tags.adb index dddf1bb8835..03221948d34 100644 --- a/gcc/ada/a-tags.adb +++ b/gcc/ada/a-tags.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -32,36 +32,35 @@ ------------------------------------------------------------------------------ with Ada.Exceptions; - with System.HTable; -with Unchecked_Conversion; - pragma Elaborate_All (System.HTable); package body Ada.Tags is -- Structure of the GNAT Dispatch Table --- +----------------------+ --- | TSD pointer ---|-----> Type Specific Data --- +----------------------+ +-------------------+ --- | table of | | inheritance depth | --- : primitive ops : +-------------------+ --- | pointers | | expanded name | --- +----------------------+ +-------------------+ --- | external tag | --- +-------------------+ --- | Hash table link | --- +-------------------+ --- | Remotely Callable | --- +-------------------+ --- | Rec Ctrler offset | --- +-------------------+ --- | table of | --- : ancestor : --- | tags | --- +-------------------+ +-- +-----------------------+ +-- | Offset_To_Top | +-- +-----------------------+ +-- | Typeinfo_Ptr/TSD_Ptr |----> Type Specific Data +-- Tag ---> +-----------------------+ +-------------------+ +-- | table of | | inheritance depth | +-- : primitive ops : +-------------------+ +-- | pointers | | expanded name | +-- +-----------------------+ +-------------------+ +-- | external tag | +-- +-------------------+ +-- | Hash table link | +-- +-------------------+ +-- | Remotely Callable | +-- +-------------------+ +-- | Rec Ctrler offset | +-- +-------------------+ +-- | table of | +-- : ancestor : +-- | tags | +-- +-------------------+ subtype Cstring is String (Positive); type Cstring_Ptr is access all Cstring; @@ -69,12 +68,12 @@ package body Ada.Tags is type Tag_Table is array (Natural range <>) of Tag; pragma Suppress_Initialization (Tag_Table); pragma Suppress (Index_Check, On => Tag_Table); - -- We suppress index checks because the declared size in the record - -- below is a dummy size of one (see below). + -- We suppress index checks because the declared size in the record below + -- is a dummy size of one (see below). type Wide_Boolean is new Boolean; - -- This name should probably be changed sometime ??? and indeed - -- probably this field could simply be of type Standard.Boolean. + -- This name should probably be changed sometime ??? and indeed probably + -- this field could simply be of type Standard.Boolean. type Type_Specific_Data is record Idepth : Natural; @@ -85,31 +84,48 @@ package body Ada.Tags is RC_Offset : SSE.Storage_Offset; Ancestor_Tags : Tag_Table (0 .. 1); end record; - -- The size of the Ancestor_Tags array actually depends on the tagged - -- type to which it applies. We are using the same mechanism as for - -- the Prims_Ptr array in the Dispatch_Table record. See comments - -- below for more details. + -- The size of the Ancestor_Tags array actually depends on the tagged type + -- to which it applies. We are using the same mechanism as for the + -- Prims_Ptr array in the Dispatch_Table record. See comments below for + -- more details. type Dispatch_Table is record - TSD : Type_Specific_Data_Ptr; - Prims_Ptr : Address_Array (1 .. 1); + -- Offset_To_Top : Integer := 0; + -- Typeinfo_Ptr : System.Address; -- Currently TSD is also here??? + Prims_Ptr : Address_Array (Positive); end record; - -- The size of the Prims_Ptr array actually depends on the tagged - -- type to which it applies. For each tagged type, the expander - -- computes the actual array size, and allocates the Dispatch_Table - -- record accordingly. + + -- Note on the commented out fields of the Dispatch_Table + -- ------------------------------------------------------ + -- According to the C++ ABI the components Offset_To_Top and Typeinfo_Ptr + -- are stored just "before" the dispatch table (that is, the Prims_Ptr + -- table), and they are referenced with negative offsets referring to the + -- base of the dispatch table. The _Tag (or the VTable_Ptr in C++ termi- + -- nology) must point to the base of the virtual table, just after these + -- components, to point to the Prims_Ptr table. For this purpose the + -- expander generates a Prims_Ptr table that has enough space for these + -- additional components, and generates code that displaces the _Tag to + -- point after these components. + -- ----------------------------------------------------------------------- + + -- The size of the Prims_Ptr array actually depends on the tagged type to + -- which it applies. For each tagged type, the expander computes the + -- actual array size, allocates the Dispatch_Table record accordingly, and + -- generates code that displaces the base of the record after the + -- Typeinfo_Ptr component. For this reason the first two components have + -- been commented in the previous declaration. The access to these + -- components is done by means of local functions. -- - -- To avoid the use of discriminants to define the actual size - -- of the dispatch table, we used to declare the tag as a pointer - -- to a record that contains an arbitrary array of addresses, using - -- Positive as its index. This ensures that there are never range - -- checks when accessing the dispatch table, but it prevents GDB - -- from displaying tagged types properly. A better approach is - -- to declare this record type as holding a small number of addresses, - -- and to explicitly suppress checks on it. + -- To avoid the use of discriminants to define the actual size of the + -- dispatch table, we used to declare the tag as a pointer to a record + -- that contains an arbitrary array of addresses, using Positive as its + -- index. This ensures that there are never range checks when accessing + -- the dispatch table, but it prevents GDB from displaying tagged types + -- properly. A better approach is to declare this record type as holding a + -- small number of addresses, and to explicitly suppress checks on it. -- - -- Note that in both cases, this type is never allocated, and serves - -- only to declare the corresponding access type. + -- Note that in both cases, this type is never allocated, and serves only + -- to declare the corresponding access type. --------------------------------------------- -- Unchecked Conversions for String Fields -- @@ -121,13 +137,34 @@ package body Ada.Tags is function To_Address is new Unchecked_Conversion (Cstring_Ptr, System.Address); + ----------------------------------------------------------- + -- Unchecked Conversions for the component offset_to_top -- + ----------------------------------------------------------- + + type Int_Ptr is access Integer; + + function To_Int_Ptr is + new Unchecked_Conversion (System.Address, Int_Ptr); + ----------------------- -- Local Subprograms -- ----------------------- function Length (Str : Cstring_Ptr) return Natural; - -- Length of string represented by the given pointer (treating the - -- string as a C-style string, which is Nul terminated). + -- Length of string represented by the given pointer (treating the string + -- as a C-style string, which is Nul terminated). + + function Offset_To_Top (T : Tag) return Integer; + -- Returns the current value of the offset_to_top component available in + -- the prologue of the dispatch table. + + function Typeinfo_Ptr (T : Tag) return System.Address; + -- Returns the current value of the typeinfo_ptr component available in + -- the prologue of the dispatch table. + + pragma Unreferenced (Offset_To_Top); + pragma Unreferenced (Typeinfo_Ptr); + -- These functions will be used for full compatibility with the C++ ABI ------------------------- -- External_Tag_HTable -- @@ -135,9 +172,9 @@ package body Ada.Tags is type HTable_Headers is range 1 .. 64; - -- The following internal package defines the routines used for - -- the instantiation of a new System.HTable.Static_HTable (see - -- below). See spec in g-htable.ads for details of usage. + -- The following internal package defines the routines used for the + -- instantiation of a new System.HTable.Static_HTable (see below). See + -- spec in g-htable.ads for details of usage. package HTable_Subprograms is procedure Set_HT_Link (T : Tag; Next : Tag); @@ -195,7 +232,7 @@ package body Ada.Tags is function Get_HT_Link (T : Tag) return Tag is begin - return T.TSD.HT_Link; + return TSD (T).HT_Link; end Get_HT_Link; ---------- @@ -216,7 +253,7 @@ package body Ada.Tags is procedure Set_HT_Link (T : Tag; Next : Tag) is begin - T.TSD.HT_Link := Next; + TSD (T).HT_Link := Next; end Set_HT_Link; end HTable_Subprograms; @@ -241,9 +278,9 @@ package body Ada.Tags is -- = Typ'tag function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return Boolean is - Pos : constant Integer := Obj_Tag.TSD.Idepth - Typ_Tag.TSD.Idepth; + Pos : constant Integer := TSD (Obj_Tag).Idepth - TSD (Typ_Tag).Idepth; begin - return Pos >= 0 and then Obj_Tag.TSD.Ancestor_Tags (Pos) = Typ_Tag; + return Pos >= 0 and then TSD (Obj_Tag).Ancestor_Tags (Pos) = Typ_Tag; end CW_Membership; ------------------- @@ -251,7 +288,7 @@ package body Ada.Tags is ------------------- function Expanded_Name (T : Tag) return String is - Result : constant Cstring_Ptr := T.TSD.Expanded_Name; + Result : constant Cstring_Ptr := TSD (T).Expanded_Name; begin return Result (1 .. Length (Result)); end Expanded_Name; @@ -261,7 +298,7 @@ package body Ada.Tags is ------------------ function External_Tag (T : Tag) return String is - Result : constant Cstring_Ptr := T.TSD.External_Tag; + Result : constant Cstring_Ptr := TSD (T).External_Tag; begin return Result (1 .. Length (Result)); end External_Tag; @@ -272,7 +309,7 @@ package body Ada.Tags is function Get_Expanded_Name (T : Tag) return System.Address is begin - return To_Address (T.TSD.Expanded_Name); + return To_Address (TSD (T).Expanded_Name); end Get_Expanded_Name; ---------------------- @@ -281,7 +318,7 @@ package body Ada.Tags is function Get_External_Tag (T : Tag) return System.Address is begin - return To_Address (T.TSD.External_Tag); + return To_Address (TSD (T).External_Tag); end Get_External_Tag; --------------------------- @@ -290,7 +327,7 @@ package body Ada.Tags is function Get_Inheritance_Depth (T : Tag) return Natural is begin - return T.TSD.Idepth; + return TSD (T).Idepth; end Get_Inheritance_Depth; ------------------------- @@ -311,7 +348,7 @@ package body Ada.Tags is function Get_RC_Offset (T : Tag) return SSE.Storage_Offset is begin - return T.TSD.RC_Offset; + return TSD (T).RC_Offset; end Get_RC_Offset; --------------------------- @@ -320,7 +357,7 @@ package body Ada.Tags is function Get_Remotely_Callable (T : Tag) return Boolean is begin - return T.TSD.Remotely_Callable = True; + return TSD (T).Remotely_Callable = True; end Get_Remotely_Callable; ------------- @@ -328,8 +365,11 @@ package body Ada.Tags is ------------- function Get_TSD (T : Tag) return System.Address is + use type System.Storage_Elements.Storage_Offset; + TSD_Ptr : constant Addr_Ptr := + To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size); begin - return To_Address (T.TSD); + return TSD_Ptr.all; end Get_TSD; ---------------- @@ -353,20 +393,21 @@ package body Ada.Tags is ----------------- procedure Inherit_TSD (Old_TSD : System.Address; New_Tag : Tag) is - TSD : constant Type_Specific_Data_Ptr := - To_Type_Specific_Data_Ptr (Old_TSD); - New_TSD : Type_Specific_Data renames New_Tag.TSD.all; + Old_TSD_Ptr : constant Type_Specific_Data_Ptr := + To_Type_Specific_Data_Ptr (Old_TSD); + New_TSD_Ptr : constant Type_Specific_Data_Ptr := + TSD (New_Tag); begin - if TSD /= null then - New_TSD.Idepth := TSD.Idepth + 1; - New_TSD.Ancestor_Tags (1 .. New_TSD.Idepth) - := TSD.Ancestor_Tags (0 .. TSD.Idepth); + if Old_TSD_Ptr /= null then + New_TSD_Ptr.Idepth := Old_TSD_Ptr.Idepth + 1; + New_TSD_Ptr.Ancestor_Tags (1 .. New_TSD_Ptr.Idepth) := + Old_TSD_Ptr.Ancestor_Tags (0 .. Old_TSD_Ptr.Idepth); else - New_TSD.Idepth := 0; + New_TSD_Ptr.Idepth := 0; end if; - New_TSD.Ancestor_Tags (0) := New_Tag; + New_TSD_Ptr.Ancestor_Tags (0) := New_Tag; end Inherit_TSD; ------------------ @@ -389,7 +430,6 @@ package body Ada.Tags is declare Msg1 : constant String := "unknown tagged type: "; Msg2 : String (1 .. Msg1'Length + External'Length); - begin Msg2 (1 .. Msg1'Length) := Msg1; Msg2 (Msg1'Length + 1 .. Msg1'Length + External'Length) := @@ -430,7 +470,7 @@ package body Ada.Tags is (Obj : System.Address; T : Tag) return SSE.Storage_Count is - Parent_Tag : constant Tag := T.TSD.Ancestor_Tags (1); + Parent_Tag : constant Tag := TSD (T).Ancestor_Tags (1); -- The tag of the parent type through the dispatch table F : constant Acc_Size := To_Acc_Size (Parent_Tag.Prims_Ptr (1)); @@ -449,7 +489,7 @@ package body Ada.Tags is function Parent_Tag (T : Tag) return Tag is begin - return T.TSD.Ancestor_Tags (1); + return TSD (T).Ancestor_Tags (1); end Parent_Tag; ------------------ @@ -467,7 +507,7 @@ package body Ada.Tags is procedure Set_Expanded_Name (T : Tag; Value : System.Address) is begin - T.TSD.Expanded_Name := To_Cstring_Ptr (Value); + TSD (T).Expanded_Name := To_Cstring_Ptr (Value); end Set_Expanded_Name; ---------------------- @@ -476,7 +516,7 @@ package body Ada.Tags is procedure Set_External_Tag (T : Tag; Value : System.Address) is begin - T.TSD.External_Tag := To_Cstring_Ptr (Value); + TSD (T).External_Tag := To_Cstring_Ptr (Value); end Set_External_Tag; --------------------------- @@ -488,7 +528,7 @@ package body Ada.Tags is Value : Natural) is begin - T.TSD.Idepth := Value; + TSD (T).Idepth := Value; end Set_Inheritance_Depth; ------------------------- @@ -510,7 +550,7 @@ package body Ada.Tags is procedure Set_RC_Offset (T : Tag; Value : SSE.Storage_Offset) is begin - T.TSD.RC_Offset := Value; + TSD (T).RC_Offset := Value; end Set_RC_Offset; --------------------------- @@ -520,9 +560,9 @@ package body Ada.Tags is procedure Set_Remotely_Callable (T : Tag; Value : Boolean) is begin if Value then - T.TSD.Remotely_Callable := True; + TSD (T).Remotely_Callable := True; else - T.TSD.Remotely_Callable := False; + TSD (T).Remotely_Callable := False; end if; end Set_Remotely_Callable; @@ -531,8 +571,44 @@ package body Ada.Tags is ------------- procedure Set_TSD (T : Tag; Value : System.Address) is + use type System.Storage_Elements.Storage_Offset; + TSD_Ptr : constant Addr_Ptr := + To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size); begin - T.TSD := To_Type_Specific_Data_Ptr (Value); + TSD_Ptr.all := Value; end Set_TSD; + ------------------- + -- Offset_To_Top -- + ------------------- + + function Offset_To_Top (T : Tag) return Integer is + use type System.Storage_Elements.Storage_Offset; + TSD_Ptr : constant Int_Ptr := + To_Int_Ptr (To_Address (T) - DT_Prologue_Size); + begin + return TSD_Ptr.all; + end Offset_To_Top; + + ------------------ + -- Typeinfo_Ptr -- + ------------------ + + function Typeinfo_Ptr (T : Tag) return System.Address is + use type System.Storage_Elements.Storage_Offset; + TSD_Ptr : constant Addr_Ptr := + To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size); + begin + return TSD_Ptr.all; + end Typeinfo_Ptr; + + --------- + -- TSD -- + --------- + + function TSD (T : Tag) return Type_Specific_Data_Ptr is + begin + return To_Type_Specific_Data_Ptr (Get_TSD (T)); + end TSD; + end Ada.Tags; diff --git a/gcc/ada/a-tags.ads b/gcc/ada/a-tags.ads index 5dc3d1e378d..92715a85b14 100644 --- a/gcc/ada/a-tags.ads +++ b/gcc/ada/a-tags.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -79,6 +79,12 @@ private -- initialize those structures and uses the GET functions to -- retreive the information when needed + type Dispatch_Table; + type Tag is access all Dispatch_Table; + + type Type_Specific_Data; + type Type_Specific_Data_Ptr is access all Type_Specific_Data; + package SSE renames System.Storage_Elements; function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return Boolean; @@ -188,16 +194,26 @@ private procedure Set_Remotely_Callable (T : Tag; Value : Boolean); -- Set to true if the type has been declared in a context described - -- in E.4 (18) + -- in E.4 (18). + + function TSD (T : Tag) return Type_Specific_Data_Ptr; + -- This function is conceptually equivalent to Get_TSD, but + -- returning a Type_Specific_Data_Ptr type (rather than an Address) + -- simplifies the implementation of the other subprograms. DT_Prologue_Size : constant SSE.Storage_Count := SSE.Storage_Count - (Standard'Address_Size / System.Storage_Unit); + (2 * (Standard'Address_Size / System.Storage_Unit)); -- Size of the first part of the dispatch table + DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count := + SSE.Storage_Count + (Standard'Address_Size / System.Storage_Unit); + -- Size of the Typeinfo_Ptr field of the Dispatch Table. + DT_Entry_Size : constant SSE.Storage_Count := SSE.Storage_Count - (Standard'Address_Size / System.Storage_Unit); + (1 * (Standard'Address_Size / System.Storage_Unit)); -- Size of each primitive operation entry in the Dispatch Table. TSD_Prologue_Size : constant SSE.Storage_Count := @@ -206,7 +222,7 @@ private -- Size of the first part of the type specific data TSD_Entry_Size : constant SSE.Storage_Count := - SSE.Storage_Count (Standard'Address_Size / System.Storage_Unit); + SSE.Storage_Count (1 * (Standard'Address_Size / System.Storage_Unit)); -- Size of each ancestor tag entry in the TSD type Address_Array is array (Natural range <>) of System.Address; @@ -215,18 +231,20 @@ private -- of this type are declared with a dummy size of 1, the actual size -- depending on the number of primitive operations. - type Dispatch_Table; - type Tag is access all Dispatch_Table; - - type Type_Specific_Data; - type Type_Specific_Data_Ptr is access all Type_Specific_Data; - function To_Type_Specific_Data_Ptr is new Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr); function To_Address is new Unchecked_Conversion (Type_Specific_Data_Ptr, System.Address); + function To_Address is + new Unchecked_Conversion (Tag, System.Address); + + type Addr_Ptr is access System.Address; + + function To_Addr_Ptr is + new Unchecked_Conversion (System.Address, Addr_Ptr); + -- Primitive dispatching operations are always inlined, to facilitate -- use in a minimal/no run-time environment for high integrity use. @@ -247,5 +265,6 @@ private pragma Inline_Always (Set_RC_Offset); pragma Inline_Always (Set_Remotely_Callable); pragma Inline_Always (Set_TSD); + pragma Inline_Always (TSD); end Ada.Tags; diff --git a/gcc/ada/ada-tree.h b/gcc/ada/ada-tree.h index fde996972c9..fad1513ab8f 100644 --- a/gcc/ada/ada-tree.h +++ b/gcc/ada/ada-tree.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2004 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- * @@ -64,7 +64,8 @@ struct lang_type GTY(()) {tree t; }; /* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this is a record being used as a fat pointer (only true for RECORD_TYPE). */ -#define TYPE_IS_FAT_POINTER_P(NODE) TYPE_LANG_FLAG_0 (NODE) +#define TYPE_IS_FAT_POINTER_P(NODE) \ + TYPE_LANG_FLAG_0 (RECORD_OR_UNION_CHECK (NODE)) #define TYPE_FAT_POINTER_P(NODE) \ (TREE_CODE (NODE) == RECORD_TYPE && TYPE_IS_FAT_POINTER_P (NODE)) @@ -159,6 +160,9 @@ struct lang_type GTY(()) {tree t; }; padding or alignment. */ #define TYPE_IS_PADDING_P(NODE) TYPE_LANG_FLAG_5 (RECORD_TYPE_CHECK (NODE)) +/* For a UNION_TYPE, nonzero if this is an unchecked union. */ +#define TYPE_UNCHECKED_UNION_P(NODE) TYPE_LANG_FLAG_6 (UNION_TYPE_CHECK (NODE)) + /* This field is only defined for FUNCTION_TYPE nodes. If the Ada subprogram contains no parameters passed by copy in/copy out then this field is 0. Otherwise it points to a list of nodes used to specify the diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb index 1bf114a59e6..518d1df8a83 100644 --- a/gcc/ada/ali-util.adb +++ b/gcc/ada/ali-util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -291,8 +291,8 @@ package body ALI.Util is -- set the Interface flag in the Withs table, so that its -- dependant are not considered for elaboration order. - if ALIs.Table (Idread).Interface then - Withs.Table (W).Interface := True; + if ALIs.Table (Idread).SAL_Interface then + Withs.Table (W).SAL_Interface := True; Interface_Library_Unit := True; -- Set the entry in the Interfaces hash table, so that other @@ -313,7 +313,7 @@ package body ALI.Util is -- set the flag in the entry of the Withs table. elsif Interface_Library_Unit and then Interfaces.Get (Afile) then - Withs.Table (W).Interface := True; + Withs.Table (W).SAL_Interface := True; end if; end loop; end loop; diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 0f182055571..4c8a08b05a8 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -654,6 +654,7 @@ package body ALI is Ofile_Full_Name => Full_Object_File_Name, Queuing_Policy => ' ', Restrictions => Restrictions_Initial, + SAL_Interface => False, Sfile => No_Name, Task_Dispatching_Policy => ' ', Time_Slice_Value => -1, @@ -661,7 +662,6 @@ package body ALI is Unit_Exception_Table => False, Ver => (others => ' '), Ver_Len => 0, - Interface => False, Zero_Cost_Exceptions => False); -- Now we acquire the input lines from the ALI file. Note that the @@ -878,7 +878,7 @@ package body ALI is -- Processing for SL if C = 'L' then - ALIs.Table (Id).Interface := True; + ALIs.Table (Id).SAL_Interface := True; -- Processing for SS @@ -1194,7 +1194,8 @@ package body ALI is Units.Table (Units.Last).First_With := Withs.Last + 1; Units.Table (Units.Last).First_Arg := First_Arg; Units.Table (Units.Last).Elab_Position := 0; - Units.Table (Units.Last).Interface := ALIs.Table (Id).Interface; + Units.Table (Units.Last).SAL_Interface := ALIs.Table (Id). + SAL_Interface; Units.Table (Units.Last).Body_Needed_For_SAL := False; if Debug_Flag_U then @@ -1290,7 +1291,6 @@ package body ALI is Fatal_Error_Ignore; end if; - -- DE parameter (Dynamic elaboration checks) elsif C = 'D' then @@ -1376,7 +1376,6 @@ package body ALI is Fatal_Error_Ignore; end if; - -- PR/PU/PK parameters elsif C = 'P' then @@ -1459,7 +1458,7 @@ package body ALI is Withs.Table (Withs.Last).Elaborate := False; Withs.Table (Withs.Last).Elaborate_All := False; Withs.Table (Withs.Last).Elab_All_Desirable := False; - Withs.Table (Withs.Last).Interface := False; + Withs.Table (Withs.Last).SAL_Interface := False; -- Generic case with no object file available diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 48b1732f315..cab4b062365 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -103,7 +103,7 @@ package ALI is -- Length of characters stored in Ver. Not set if V lines are -- ignored as a result of the Ignore_Lines parameter. - Interface : Boolean; + SAL_Interface : Boolean; -- Set True when this is an interface to a standalone library First_Unit : Unit_Id; @@ -332,7 +332,7 @@ package ALI is -- Set True if IS qualifier appears in ALI file, indicating that -- an Initialize_Scalars pragma applies to the unit. - Interface : Boolean; + SAL_Interface : Boolean; -- Set True when this is an interface to a standalone library Body_Needed_For_SAL : Boolean; @@ -475,7 +475,7 @@ package ALI is Elab_All_Desirable : Boolean; -- Indicates presence of ED parameter - Interface : Boolean := False; + SAL_Interface : Boolean := False; -- True if the Unit is an Interface of a Stand-Alone Library end record; diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 149203a5ca8..8122d85068c 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -191,7 +191,7 @@ package body Atree is Unchecked_Conversion (Union_Id_Ptr, Flag_Word2_Ptr); -- The following declarations are used to store flags 152-183 in the - -- Field12 field of the fourth component of an extended (entity) node. + -- Field11 field of the fourth component of an extended (entity) node. type Flag_Word3 is record Flag152 : Boolean; @@ -2960,11 +2960,16 @@ package body Atree is return String_Id (Nodes.Table (N).Field3); end Str3; - function Char_Code2 (N : Node_Id) return Char_Code is - begin + function Uint2 (N : Node_Id) return Uint is pragma Assert (N in Nodes.First .. Nodes.Last); - return Char_Code (Nodes.Table (N).Field2 - Char_Code_Bias); - end Char_Code2; + U : constant Union_Id := Nodes.Table (N).Field2; + begin + if U = 0 then + return Uint_0; + else + return From_Union (U); + end if; + end Uint2; function Uint3 (N : Node_Id) return Uint is pragma Assert (N in Nodes.First .. Nodes.Last); @@ -4858,6 +4863,12 @@ package body Atree is Nodes.Table (N).Field3 := Union_Id (Val); end Set_Str3; + procedure Set_Uint2 (N : Node_Id; Val : Uint) is + begin + pragma Assert (N in Nodes.First .. Nodes.Last); + Nodes.Table (N).Field2 := To_Union (Val); + end Set_Uint2; + procedure Set_Uint3 (N : Node_Id; Val : Uint) is begin pragma Assert (N in Nodes.First .. Nodes.Last); @@ -4960,12 +4971,6 @@ package body Atree is Nodes.Table (N + 3).Field8 := To_Union (Val); end Set_Ureal21; - procedure Set_Char_Code2 (N : Node_Id; Val : Char_Code) is - begin - pragma Assert (N in Nodes.First .. Nodes.Last); - Nodes.Table (N).Field2 := Union_Id (Val) + Char_Code_Bias; - end Set_Char_Code2; - procedure Set_Flag4 (N : Node_Id; Val : Boolean) is begin pragma Assert (N in Nodes.First .. Nodes.Last); diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index aeee0f5ec6e..8b08b524a1f 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -124,7 +124,6 @@ package Atree is -- Field4 -- Field5 Five fields holding Union_Id values - -- Char_CodeN Synonym for FieldN typed as Char_Code -- ElistN Synonym for FieldN typed as Elist_Id -- ListN Synonym for FieldN typed as List_Id -- NameN Synonym for FieldN typed as Name_Id @@ -133,14 +132,14 @@ package Atree is -- UintN Synonym for FieldN typed as Uint (Empty = Uint_0) -- UrealN Synonym for FieldN typed as Ureal - -- Note: the actual usage of FieldN (i.e. whether it contains a Char_Code, - -- Elist_Id, List_Id, Name_Id, Node_Id, String_Id, Uint or Ureal), depends - -- on the value in Nkind. Generally the access to this field is always via - -- the functional interface, so the field names Char_CodeN, ElistN, ListN, - -- NameN, NodeN, StrN, UintN and UrealN are used only in the bodies of the - -- access functions (i.e. in the bodies of Sinfo and Einfo). These access - -- functions contain debugging code that checks that the use is consistent - -- with Nkind and Ekind values. + -- Note: the actual usage of FieldN (i.e. whether it contains a Elist_Id, + -- List_Id, Name_Id, Node_Id, String_Id, Uint or Ureal), depends on the + -- value in Nkind. Generally the access to this field is always via the + -- functional interface, so the field names ElistN, ListN, NameN, NodeN, + -- StrN, UintN and UrealN are used only in the bodies of the access + -- functions (i.e. in the bodies of Sinfo and Einfo). These access + -- functions contain debugging code that checks that the use is + -- consistent with Nkind and Ekind values. -- However, in specialized circumstances (examples are the circuit in -- generic instantiation to copy trees, and in the tree dump routine), @@ -988,9 +987,6 @@ package Atree is function Name2 (N : Node_Id) return Name_Id; pragma Inline (Name2); - function Char_Code2 (N : Node_Id) return Char_Code; - pragma Inline (Char_Code2); - function Str3 (N : Node_Id) return String_Id; pragma Inline (Str3); @@ -999,6 +995,9 @@ package Atree is -- Uint_0 is returned. This avoids the rather tricky requirement -- of initializing all Uint fields in nodes and entities. + function Uint2 (N : Node_Id) return Uint; + pragma Inline (Uint2); + function Uint3 (N : Node_Id) return Uint; pragma Inline (Uint3); @@ -1910,12 +1909,12 @@ package Atree is procedure Set_Name2 (N : Node_Id; Val : Name_Id); pragma Inline (Set_Name2); - procedure Set_Char_Code2 (N : Node_Id; Val : Char_Code); - pragma Inline (Set_Char_Code2); - procedure Set_Str3 (N : Node_Id; Val : String_Id); pragma Inline (Set_Str3); + procedure Set_Uint2 (N : Node_Id; Val : Uint); + pragma Inline (Set_Uint2); + procedure Set_Uint3 (N : Node_Id; Val : Uint); pragma Inline (Set_Uint3); @@ -2780,9 +2779,9 @@ package Atree is Field4 : Union_Id; Field5 : Union_Id; -- Five general use fields, which can contain Node_Id, List_Id, - -- Elist_Id, String_Id, Name_Id, or Char_Code values depending - -- on the values in Nkind and (for extended nodes), in Ekind. - -- See packages Sinfo and Einfo for details of their use. + -- Elist_Id, String_Id, or Name_Id values depending on the + -- values in Nkind and (for extended nodes), in Ekind. See + -- packages Sinfo and Einfo for details of their use. -- Extension (second component) of extended node diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h index 3c40799f4bb..0d06969467e 100644 --- a/gcc/ada/atree.h +++ b/gcc/ada/atree.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2003, 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- * @@ -216,6 +216,46 @@ struct Flag_Word3 Boolean flag183 : 1; }; +/* Structure used for extra flags in fifth component overlaying Field11 */ +struct Flag_Word4 +{ + Boolean flag184 : 1; + Boolean flag185 : 1; + Boolean flag186 : 1; + Boolean flag187 : 1; + Boolean flag188 : 1; + Boolean flag189 : 1; + Boolean flag190 : 1; + Boolean flag191 : 1; + + Boolean flag192 : 1; + Boolean flag193 : 1; + Boolean flag194 : 1; + Boolean flag195 : 1; + Boolean flag196 : 1; + Boolean flag197 : 1; + Boolean flag198 : 1; + Boolean flag199 : 1; + + Boolean flag200 : 1; + Boolean flag201 : 1; + Boolean flag202 : 1; + Boolean flag203 : 1; + Boolean flag204 : 1; + Boolean flag205 : 1; + Boolean flag206 : 1; + Boolean flag207 : 1; + + Boolean flag208 : 1; + Boolean flag209 : 1; + Boolean flag210 : 1; + Boolean flag211 : 1; + Boolean flag212 : 1; + Boolean flag213 : 1; + Boolean flag214 : 1; + Boolean flag215 : 1; +}; + struct Non_Extended { Source_Ptr sloc; @@ -238,14 +278,15 @@ struct Extended union { Int field11; - struct Flag_Word3 fw3; + struct Flag_Word3 fw3; + struct Flag_Word4 fw4; } X; union { Int field12; - struct Flag_Word fw; - struct Flag_Word2 fw2; + struct Flag_Word fw; + struct Flag_Word2 fw2; } U; }; @@ -272,7 +313,6 @@ struct Node that Node_Id values can be used as subscripts. */ extern struct Node *Nodes_Ptr; - #define Parent atree__parent extern Node_Id Parent (Node_Id); @@ -338,6 +378,10 @@ extern Node_Id Current_Error_Node; #define Field21(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.field8) #define Field22(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.field9) #define Field23(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.field10) +#define Field24(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field6) +#define Field25(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field7) +#define Field26(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field8) +#define Field27(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.field9) #define Node1(N) Field1 (N) #define Node2(N) Field2 (N) @@ -362,6 +406,10 @@ extern Node_Id Current_Error_Node; #define Node21(N) Field21 (N) #define Node22(N) Field22 (N) #define Node23(N) Field23 (N) +#define Node24(N) Field24 (N) +#define Node25(N) Field25 (N) +#define Node26(N) Field26 (N) +#define Node27(N) Field27 (N) #define List1(N) Field1 (N) #define List2(N) Field2 (N) @@ -388,6 +436,7 @@ extern Node_Id Current_Error_Node; #define Str3(N) Field3 (N) +#define Uint2(N) ((Field2 (N) == 0) ? Uint_0 : Field2 (N)) #define Uint3(N) ((Field3 (N) == 0) ? Uint_0 : Field3 (N)) #define Uint4(N) ((Field4 (N) == 0) ? Uint_0 : Field4 (N)) #define Uint5(N) ((Field5 (N) == 0) ? Uint_0 : Field5 (N)) @@ -599,3 +648,36 @@ extern Node_Id Current_Error_Node; #define Flag181(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag181) #define Flag182(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag182) #define Flag183(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag183) + +#define Flag184(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag184) +#define Flag185(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag185) +#define Flag186(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag186) +#define Flag187(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag187) +#define Flag188(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag188) +#define Flag189(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag189) +#define Flag190(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag190) +#define Flag191(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag191) +#define Flag192(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag192) +#define Flag193(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag193) +#define Flag194(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag194) +#define Flag195(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag195) +#define Flag196(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag196) +#define Flag197(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag197) +#define Flag198(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag198) +#define Flag199(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag199) +#define Flag200(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag200) +#define Flag201(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag201) +#define Flag202(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag202) +#define Flag203(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag203) +#define Flag204(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag204) +#define Flag205(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag205) +#define Flag206(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag206) +#define Flag207(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag207) +#define Flag208(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag208) +#define Flag209(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag209) +#define Flag210(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag210) +#define Flag211(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag211) +#define Flag212(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag212) +#define Flag213(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag213) +#define Flag214(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag214) +#define Flag215(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag215) diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb index d90c75ee064..cc40af1964d 100644 --- a/gcc/ada/binde.adb +++ b/gcc/ada/binde.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 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- -- @@ -770,7 +770,7 @@ package body Binde is -- Skip also if no ALI file for this with, happens with certain -- specialized generic files that do not get compiled. - if not Withs.Table (W).Interface + if not Withs.Table (W).SAL_Interface and then Withs.Table (W).Afile /= No_File and then Generic_Separately_Compiled (Withs.Table (W).Sfile) then @@ -1011,7 +1011,7 @@ package body Binde is -- there is a body and a spec, then spec must be elaborated first -- Note that the corresponding spec immediately follows the body - if not Units.Table (U).Interface + if not Units.Table (U).SAL_Interface and then Units.Table (U).Utype = Is_Body then Build_Link (Corresponding_Spec (U), U, Spec_First); @@ -1021,12 +1021,12 @@ package body Binde is -- process WITH references for this unit ignoring generic units and -- interfaces to stand-alone libraries. - if not Units.Table (U).Interface then + if not Units.Table (U).SAL_Interface then for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop if Withs.Table (W).Sfile /= No_File - and then (not Withs.Table (W).Interface) + and then (not Withs.Table (W).SAL_Interface) then -- Check for special case of withing a unit that does not -- exist any more. If the unit was completely missing we diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index d2e0652fb79..49d73c4bcc2 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -390,7 +390,7 @@ package body Bindgen is -- Don't generate reference for stand alone library - and then not U.Interface + and then not U.SAL_Interface -- Don't generate reference for predefined file in No_Run_Time -- mode, since we don't include the object files in this case @@ -715,7 +715,7 @@ package body Bindgen is -- Don't generate reference for stand alone library - and then not U.Interface + and then not U.SAL_Interface -- Don't generate reference for predefined file in No_Run_Time -- mode, since we don't include the object files in this case @@ -979,7 +979,7 @@ package body Bindgen is -- to True, we do not need to test if this has already been -- done, since it is quicker to set the flag than to test it. - if not U.Interface and then U.Utype = Is_Body + if not U.SAL_Interface and then U.Utype = Is_Body and then Units.Table (Unum_Spec).Set_Elab_Entity then Set_String (" E"); @@ -1004,7 +1004,7 @@ package body Bindgen is -- The uname_E assignment is skipped if this is a separate spec, -- since the assignment will be done when we process the body. - elsif not U.Interface then + elsif not U.SAL_Interface then if Force_Checking_Of_Elaboration_Flags or Interface_Library_Unit or (not Bind_Main_Program) @@ -1097,7 +1097,7 @@ package body Bindgen is -- to True, we do not need to test if this has already been -- done, since it is quicker to set the flag than to test it. - if not U.Interface and then U.Utype = Is_Body + if not U.SAL_Interface and then U.Utype = Is_Body and then Units.Table (Unum_Spec).Set_Elab_Entity then Set_String (" "); @@ -1118,7 +1118,7 @@ package body Bindgen is -- The uname_E assignment is skipped if this is a separate spec, -- since the assignment will be done when we process the body. - elsif not U.Interface then + elsif not U.SAL_Interface then Get_Name_String (U.Uname); if Force_Checking_Of_Elaboration_Flags or @@ -1270,7 +1270,7 @@ package body Bindgen is Num := 0; for A in ALIs.First .. ALIs.Last loop - if not ALIs.Table (A).Interface + if not ALIs.Table (A).SAL_Interface and then ALIs.Table (A).Unit_Exception_Table then Num := Num + 1; @@ -1308,7 +1308,7 @@ package body Bindgen is end if; for A in ALIs.First .. ALIs.Last loop - if not ALIs.Table (A).Interface + if not ALIs.Table (A).SAL_Interface and then ALIs.Table (A).Unit_Exception_Table then Get_Decoded_Name_String_With_Brackets @@ -1436,7 +1436,7 @@ package body Bindgen is Num := 0; for A in ALIs.First .. ALIs.Last loop - if not ALIs.Table (A).Interface + if not ALIs.Table (A).SAL_Interface and then ALIs.Table (A).Unit_Exception_Table then Num := Num + 1; @@ -1466,7 +1466,7 @@ package body Bindgen is Num2 := 0; for A in ALIs.First .. ALIs.Last loop - if not ALIs.Table (A).Interface + if not ALIs.Table (A).SAL_Interface and then ALIs.Table (A).Unit_Exception_Table then Num2 := Num2 + 1; @@ -1584,15 +1584,24 @@ package body Bindgen is Write_Statement_Buffer; end if; + if Opt.Default_Exit_Status /= 0 + and then Bind_Main_Program + and then not Configurable_Run_Time_Mode + then + WBI (" procedure Set_Exit_Status (Status : Integer);"); + WBI (" pragma Import (C, Set_Exit_Status, " & + """__gnat_set_exit_status"");"); + WBI (""); + end if; + -- Initialize and Finalize if not Cumulative_Restrictions.Set (No_Finalization) then - WBI (" procedure initialize;"); + WBI (" procedure initialize (Addr : System.Address);"); WBI (" pragma Import (C, initialize, ""__gnat_initialize"");"); WBI (""); WBI (" procedure finalize;"); WBI (" pragma Import (C, finalize, ""__gnat_finalize"");"); - WBI (""); end if; -- Deal with declarations for main program case @@ -1630,6 +1639,13 @@ package body Bindgen is Write_Statement_Buffer; WBI (""); + + if Bind_Main_Program + and then not Suppress_Standard_Library_On_Target + then + WBI (" SEH : aliased array (1 .. 2) of Integer;"); + WBI (""); + end if; end if; -- Generate a reference to Ada_Main_Program_Name. This symbol is @@ -1670,8 +1686,26 @@ package body Bindgen is WBI (" gnat_envp := System.Null_Address;"); end if; + if Opt.Default_Exit_Status /= 0 + and then Bind_Main_Program + and then not Configurable_Run_Time_Mode + then + Set_String (" Set_Exit_Status ("); + Set_Int (Opt.Default_Exit_Status); + Set_String (");"); + Write_Statement_Buffer; + end if; + if not Cumulative_Restrictions.Set (No_Finalization) then - WBI (" Initialize;"); + + if not No_Main_Subprogram + and then Bind_Main_Program + and then not Suppress_Standard_Library_On_Target + then + WBI (" Initialize (SEH'Address);"); + else + WBI (" Initialize (System.Null_Address);"); + end if; end if; WBI (" " & Ada_Init_Name.all & ";"); @@ -1758,6 +1792,13 @@ package body Bindgen is WBI (" char *ensure_reference __attribute__ ((__unused__)) = " & "__gnat_ada_main_program_name;"); WBI (""); + + if not Suppress_Standard_Library_On_Target + and then not No_Main_Subprogram + then + WBI (" int SEH [2];"); + WBI (""); + end if; end if; -- If main program is a function, generate result variable @@ -1790,11 +1831,24 @@ package body Bindgen is WBI (" gnat_envp = 0;"); end if; + if Opt.Default_Exit_Status /= 0 + and then Bind_Main_Program + and then not Configurable_Run_Time_Mode + then + Set_String (" __gnat_set_exit_status ("); + Set_Int (Opt.Default_Exit_Status); + Set_String (");"); + Write_Statement_Buffer; + end if; + -- The __gnat_initialize routine is used only if we have a run-time if not Suppress_Standard_Library_On_Target then - WBI - (" __gnat_initialize ();"); + if not No_Main_Subprogram and then Bind_Main_Program then + WBI (" __gnat_initialize ((void *)SEH);"); + else + WBI (" __gnat_initialize ((void *)0);"); + end if; end if; WBI (" " & Ada_Init_Name.all & " ();"); @@ -1938,7 +1992,7 @@ package body Bindgen is -- If not spec that has an associated body, then generate a -- comment giving the name of the corresponding object file. - if (not Units.Table (Elab_Order.Table (E)).Interface) + if (not Units.Table (Elab_Order.Table (E)).SAL_Interface) and then Units.Table (Elab_Order.Table (E)).Utype /= Is_Spec then Get_Name_String @@ -2502,7 +2556,7 @@ package body Bindgen is end if; if not Suppress_Standard_Library_On_Target then - WBI ("extern void __gnat_initialize (void);"); + WBI ("extern void __gnat_initialize (void *);"); WBI ("extern void __gnat_finalize (void);"); WBI ("extern void __gnat_install_handler (void);"); end if; @@ -2530,7 +2584,6 @@ package body Bindgen is WBI ("extern int gnat_argc;"); WBI ("extern char **gnat_argv;"); WBI ("extern char **gnat_envp;"); - WBI ("extern int gnat_exit_status;"); -- If configurable run time and no command line args, then the -- generation of these variables is entirely suppressed. @@ -2545,7 +2598,6 @@ package body Bindgen is WBI ("int gnat_argc;"); WBI ("char **gnat_argv;"); WBI ("char **gnat_envp;"); - WBI ("int gnat_exit_status = 0;"); end if; -- Similarly deal with exit status diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb index e5bae217018..31b0ba823f7 100644 --- a/gcc/ada/bindusg.adb +++ b/gcc/ada/bindusg.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -227,6 +227,11 @@ begin Write_Str ("ject consistency only)"); Write_Eol; + -- Line for X switch + + Write_Str (" -Xnnn Default exit status value = nnn"); + Write_Eol; + -- Line for -z switch Write_Str (" -z No main subprogram (zero main)"); diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index b26e4d981db..6801837afc7 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -2591,19 +2591,28 @@ package body Checks is then case Msg_K is when Components => - Error_Msg_N - ("(Ada 2005) NULL not allowed in null-excluding " & - "components", Expr); + Apply_Compile_Time_Constraint_Error + (N => Expr, + Msg => "(Ada 2005) NULL not allowed in" + & " null-excluding components?", + Reason => CE_Null_Not_Allowed, + Rep => False); when Formals => - Error_Msg_N - ("(Ada 2005) NULL not allowed in null-excluding formals", - Expr); + Apply_Compile_Time_Constraint_Error + (N => Expr, + Msg => "(Ada 2005) NULL not allowed in" + & " null-excluding formals?", + Reason => CE_Null_Not_Allowed, + Rep => False); when Objects => - Error_Msg_N - ("(Ada 2005) NULL not allowed in null-excluding objects", - Expr); + Apply_Compile_Time_Constraint_Error + (N => Expr, + Msg => "(Ada 2005) NULL not allowed in" + & " null-excluding objects?", + Reason => CE_Null_Not_Allowed, + Rep => False); end case; end if; end Check_Null_Not_Allowed; @@ -3478,6 +3487,15 @@ package body Checks is Set_Do_Range_Check (N, True); return; end if; + + -- Ditto if the prefix is an explicit dereference whose + -- designated type is unconstrained. + + elsif Nkind (Prefix (P)) = N_Explicit_Dereference + and then not Is_Constrained (Atyp) + then + Set_Do_Range_Check (N, True); + return; end if; Indx := First_Index (Atyp); diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 73afd401c2f..1f45f5e6d63 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -195,13 +195,14 @@ package body CStand is Binary_Ops : constant array (S_Binary_Ops) of Name_Id := -- There is one entry here for each binary operator, except for the - -- case of concatenation, where there are two entries, one for a - -- String result, and one for a Wide_String result. + -- case of concatenation, where there are three entries, one for a + -- String result, one for Wide_String, and one for Wide_Wide_String. (Name_Op_Add, Name_Op_And, Name_Op_Concat, Name_Op_Concat, + Name_Op_Concat, Name_Op_Divide, Name_Op_Eq, Name_Op_Expon, @@ -222,24 +223,25 @@ package body CStand is -- This table has the corresponding result types. The entries are -- ordered so they correspond to the Binary_Ops array above. - (Universal_Integer, -- Add - Standard_Boolean, -- And - Standard_String, -- Concat (String) - Standard_Wide_String, -- Concat (Wide_String) - Universal_Integer, -- Divide - Standard_Boolean, -- Eq - Universal_Integer, -- Expon - Standard_Boolean, -- Ge - Standard_Boolean, -- Gt - Standard_Boolean, -- Le - Standard_Boolean, -- Lt - Universal_Integer, -- Mod - Universal_Integer, -- Multiply - Standard_Boolean, -- Ne - Standard_Boolean, -- Or - Universal_Integer, -- Rem - Universal_Integer, -- Subtract - Standard_Boolean); -- Xor + (Universal_Integer, -- Add + Standard_Boolean, -- And + Standard_String, -- Concat (String) + Standard_Wide_String, -- Concat (Wide_String) + Standard_Wide_Wide_String, -- Concat (Wide_Wide_String) + Universal_Integer, -- Divide + Standard_Boolean, -- Eq + Universal_Integer, -- Expon + Standard_Boolean, -- Ge + Standard_Boolean, -- Gt + Standard_Boolean, -- Le + Standard_Boolean, -- Lt + Universal_Integer, -- Mod + Universal_Integer, -- Multiply + Standard_Boolean, -- Ne + Standard_Boolean, -- Or + Universal_Integer, -- Rem + Universal_Integer, -- Subtract + Standard_Boolean); -- Xor Unary_Ops : constant array (S_Unary_Ops) of Name_Id := @@ -277,13 +279,20 @@ package body CStand is -- For concatenation, we create a separate operator for each -- array type. This simplifies the resolution of the component- -- component concatenation operation. In Standard, we set the types - -- of the formals for string and wide string concatenation. + -- of the formals for string, wide [wide]_string, concatenations. Set_Etype (First_Entity (Standard_Op_Concat), Standard_String); Set_Etype (Last_Entity (Standard_Op_Concat), Standard_String); Set_Etype (First_Entity (Standard_Op_Concatw), Standard_Wide_String); Set_Etype (Last_Entity (Standard_Op_Concatw), Standard_Wide_String); + + Set_Etype (First_Entity (Standard_Op_Concatww), + Standard_Wide_Wide_String); + + Set_Etype (Last_Entity (Standard_Op_Concatww), + Standard_Wide_Wide_String); + end Create_Operators; --------------------- @@ -537,8 +546,8 @@ package body CStand is B_Node := New_Node (N_Character_Literal, Stloc); Set_Is_Static_Expression (B_Node); Set_Chars (B_Node, No_Name); - Set_Char_Literal_Value (B_Node, 16#00#); - Set_Entity (B_Node, Empty); + Set_Char_Literal_Value (B_Node, Uint_0); + Set_Entity (B_Node, Empty); Set_Etype (B_Node, Standard_Character); Set_Low_Bound (R_Node, B_Node); @@ -547,8 +556,8 @@ package body CStand is B_Node := New_Node (N_Character_Literal, Stloc); Set_Is_Static_Expression (B_Node); Set_Chars (B_Node, No_Name); - Set_Char_Literal_Value (B_Node, 16#FF#); - Set_Entity (B_Node, Empty); + Set_Char_Literal_Value (B_Node, UI_From_Int (16#FF#)); + Set_Entity (B_Node, Empty); Set_Etype (B_Node, Standard_Character); Set_High_Bound (R_Node, B_Node); @@ -582,8 +591,8 @@ package body CStand is B_Node := New_Node (N_Character_Literal, Stloc); Set_Is_Static_Expression (B_Node); Set_Chars (B_Node, No_Name); -- ??? - Set_Char_Literal_Value (B_Node, 16#0000#); - Set_Entity (B_Node, Empty); + Set_Char_Literal_Value (B_Node, Uint_0); + Set_Entity (B_Node, Empty); Set_Etype (B_Node, Standard_Wide_Character); Set_Low_Bound (R_Node, B_Node); @@ -592,8 +601,8 @@ package body CStand is B_Node := New_Node (N_Character_Literal, Stloc); Set_Is_Static_Expression (B_Node); Set_Chars (B_Node, No_Name); -- ??? - Set_Char_Literal_Value (B_Node, 16#FFFF#); - Set_Entity (B_Node, Empty); + Set_Char_Literal_Value (B_Node, UI_From_Int (16#FFFF#)); + Set_Entity (B_Node, Empty); Set_Etype (B_Node, Standard_Wide_Character); Set_High_Bound (R_Node, B_Node); @@ -601,6 +610,54 @@ package body CStand is Set_Etype (R_Node, Standard_Wide_Character); Set_Parent (R_Node, Standard_Wide_Character); + -- Create type definition for type Wide_Wide_Character. Note that we + -- do not set the Literals field, since type Wide_Wide_Character is + -- handled with special routines that do not need a literal list. + + Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc); + Set_Type_Definition (Parent (Standard_Wide_Wide_Character), Tdef_Node); + + Set_Ekind (Standard_Wide_Wide_Character, E_Enumeration_Type); + Set_Etype (Standard_Wide_Wide_Character, + Standard_Wide_Wide_Character); + Init_Size (Standard_Wide_Wide_Character, + Standard_Wide_Wide_Character_Size); + + Set_Elem_Alignment (Standard_Wide_Wide_Character); + Set_Is_Unsigned_Type (Standard_Wide_Wide_Character); + Set_Is_Character_Type (Standard_Wide_Wide_Character); + Set_Is_Known_Valid (Standard_Wide_Wide_Character); + Set_Size_Known_At_Compile_Time (Standard_Wide_Wide_Character); + Set_Is_Ada_2005 (Standard_Wide_Wide_Character); + + -- Create the bounds for type Wide_Wide_Character + + R_Node := New_Node (N_Range, Stloc); + + -- Low bound for type Wide_Wide_Character + + B_Node := New_Node (N_Character_Literal, Stloc); + Set_Is_Static_Expression (B_Node); + Set_Chars (B_Node, No_Name); -- ??? + Set_Char_Literal_Value (B_Node, Uint_0); + Set_Entity (B_Node, Empty); + Set_Etype (B_Node, Standard_Wide_Wide_Character); + Set_Low_Bound (R_Node, B_Node); + + -- High bound for type Wide_Wide_Character + + B_Node := New_Node (N_Character_Literal, Stloc); + Set_Is_Static_Expression (B_Node); + Set_Chars (B_Node, No_Name); -- ??? + Set_Char_Literal_Value (B_Node, UI_From_Int (16#7FFF_FFFF#)); + Set_Entity (B_Node, Empty); + Set_Etype (B_Node, Standard_Wide_Wide_Character); + Set_High_Bound (R_Node, B_Node); + + Set_Scalar_Range (Standard_Wide_Wide_Character, R_Node); + Set_Etype (R_Node, Standard_Wide_Wide_Character); + Set_Parent (R_Node, Standard_Wide_Wide_Character); + -- Create type definition node for type String Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc); @@ -609,9 +666,9 @@ package body CStand is CompDef_Node : Node_Id; begin CompDef_Node := New_Node (N_Component_Definition, Stloc); - Set_Aliased_Present (CompDef_Node, False); - Set_Access_Definition (CompDef_Node, Empty); - Set_Subtype_Indication (CompDef_Node, Identifier_For (S_Character)); + Set_Aliased_Present (CompDef_Node, False); + Set_Access_Definition (CompDef_Node, Empty); + Set_Subtype_Indication (CompDef_Node, Identifier_For (S_Character)); Set_Component_Definition (Tdef_Node, CompDef_Node); end; @@ -637,6 +694,7 @@ package body CStand is -- Create type definition node for type Wide_String Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc); + declare CompDef_Node : Node_Id; begin @@ -647,6 +705,7 @@ package body CStand is Identifier_For (S_Wide_Character)); Set_Component_Definition (Tdef_Node, CompDef_Node); end; + Set_Subtype_Marks (Tdef_Node, New_List); Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node)); Set_Type_Definition (Parent (Standard_Wide_String), Tdef_Node); @@ -665,6 +724,42 @@ package body CStand is Set_Entity (E_Id, Standard_Positive); Set_Etype (E_Id, Standard_Positive); + -- Create type definition node for type Wide_Wide_String + + Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc); + + declare + CompDef_Node : Node_Id; + begin + CompDef_Node := New_Node (N_Component_Definition, Stloc); + Set_Aliased_Present (CompDef_Node, False); + Set_Access_Definition (CompDef_Node, Empty); + Set_Subtype_Indication (CompDef_Node, + Identifier_For (S_Wide_Wide_Character)); + Set_Component_Definition (Tdef_Node, CompDef_Node); + end; + + Set_Subtype_Marks (Tdef_Node, New_List); + Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node)); + Set_Type_Definition (Parent (Standard_Wide_Wide_String), Tdef_Node); + + Set_Ekind (Standard_Wide_Wide_String, E_String_Type); + Set_Etype (Standard_Wide_Wide_String, + Standard_Wide_Wide_String); + Set_Component_Type (Standard_Wide_Wide_String, + Standard_Wide_Wide_Character); + Set_Component_Size (Standard_Wide_Wide_String, Uint_32); + Init_Size_Align (Standard_Wide_Wide_String); + Set_Is_Ada_2005 (Standard_Wide_Wide_String); + + -- Set index type of Wide_Wide_String + + E_Id := First + (Subtype_Marks (Type_Definition (Parent (Standard_Wide_Wide_String)))); + Set_First_Index (Standard_Wide_Wide_String, E_Id); + Set_Entity (E_Id, Standard_Positive); + Set_Etype (E_Id, Standard_Positive); + -- Create subtype declaration for Natural Decl := New_Node (N_Subtype_Declaration, Stloc); @@ -760,7 +855,7 @@ package body CStand is Set_Is_Static_Expression (Expr_Decl); Set_Chars (Expr_Decl, No_Name); Set_Etype (Expr_Decl, Standard_Character); - Set_Char_Literal_Value (Expr_Decl, Ccode); + Set_Char_Literal_Value (Expr_Decl, UI_From_Int (Int (Ccode))); end; Append (Decl, Decl_A); @@ -1703,6 +1798,12 @@ package body CStand is P (" -- See RM A.1(36) for details of this type"); Write_Eol; + P (" type Wide_Wide_Character is (...)"); + Write_Str (" for Wide_Character'Size use "); + Write_Int (Standard_Wide_Wide_Character_Size); + P (";"); + P (" -- See RM A.1(36) for details of this type"); + P (" type String is array (Positive range <>) of Character;"); P (" pragma Pack (String);"); Write_Eol; @@ -1712,6 +1813,11 @@ package body CStand is P (" pragma Pack (Wide_String);"); Write_Eol; + P (" type Wide_Wide_String is array (Positive range <>)" & + " of Wide_Wide_Character;"); + P (" pragma Pack (Wide_Wide_String);"); + Write_Eol; + -- Here it's OK to use the Duration type of the host compiler since -- the implementation of Duration in GNAT is target independent. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 39ab9634e75..8606bf0958a 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -209,7 +209,8 @@ package body Einfo is -- Privals_Chain Elist23 -- Protected_Operation Node23 - -- (unused) Node24 + -- Obsolescent_Warning Node24 + -- (unused) Node25 -- (unused) Node26 -- (unused) Node27 @@ -391,6 +392,7 @@ package body Einfo is -- Vax_Float Flag151 -- Entry_Accepted Flag152 + -- Is_Obsolescent Flag153 -- Has_Per_Object_Constraint Flag154 -- Has_Private_Declaration Flag155 -- Referenced Flag156 @@ -424,10 +426,9 @@ package body Einfo is -- Has_Contiguous_Rep Flag181 -- Has_Xref_Entry Flag182 -- Must_Be_On_Byte_Boundary Flag183 + -- Has_Stream_Size_Clause Flag184 + -- Is_Ada_2005 Flag185 - -- (unused) Flag153 - -- (unused) Flag184 - -- (unused) Flag185 -- (unused) Flag186 -- (unused) Flag187 -- (unused) Flag188 @@ -459,6 +460,36 @@ package body Einfo is -- (unused) Flag214 -- (unused) Flag215 + ----------------------- + -- Local subprograms -- + ----------------------- + + function Rep_Clause (Id : E; Rep_Name : Name_Id) return N; + -- Returns the attribute definition clause whose name is Rep_Name. Returns + -- Empty if not found. + + ---------------- + -- Rep_Clause -- + ---------------- + + function Rep_Clause (Id : E; Rep_Name : Name_Id) return N is + Ritem : Node_Id; + + begin + Ritem := First_Rep_Item (Id); + while Present (Ritem) loop + if Nkind (Ritem) = N_Attribute_Definition_Clause + and then Chars (Ritem) = Rep_Name + then + return Ritem; + else + Ritem := Next_Rep_Item (Ritem); + end if; + end loop; + + return Empty; + end Rep_Clause; + -------------------------------- -- Attribute Access Functions -- -------------------------------- @@ -1238,6 +1269,12 @@ package body Einfo is return Flag23 (Implementation_Base_Type (Id)); end Has_Storage_Size_Clause; + function Has_Stream_Size_Clause (Id : E) return B is + begin + pragma Assert (Is_Elementary_Type (Id)); + return Flag184 (Id); + end Has_Stream_Size_Clause; + function Has_Subprogram_Descriptor (Id : E) return B is begin return Flag93 (Id); @@ -1317,6 +1354,11 @@ package body Einfo is return Flag69 (Id); end Is_Access_Constant; + function Is_Ada_2005 (Id : E) return B is + begin + return Flag185 (Id); + end Is_Ada_2005; + function Is_Aliased (Id : E) return B is begin pragma Assert (Nkind (Id) in N_Entity); @@ -1574,6 +1616,12 @@ package body Einfo is return Flag178 (Id); end Is_Null_Init_Proc; + function Is_Obsolescent (Id : E) return B is + begin + pragma Assert (Is_Subprogram (Id)); + return Flag153 (Id); + end Is_Obsolescent; + function Is_Optional_Parameter (Id : E) return B is begin pragma Assert (Is_Formal (Id)); @@ -1881,6 +1929,12 @@ package body Einfo is return Node17 (Id); end Object_Ref; + function Obsolescent_Warning (Id : E) return N is + begin + pragma Assert (Is_Subprogram (Id)); + return Node24 (Id); + end Obsolescent_Warning; + function Original_Access_Type (Id : E) return E is begin pragma Assert @@ -3171,6 +3225,12 @@ package body Einfo is Set_Flag23 (Id, V); end Set_Has_Storage_Size_Clause; + procedure Set_Has_Stream_Size_Clause (Id : E; V : B := True) is + begin + pragma Assert (Is_Elementary_Type (Id)); + Set_Flag184 (Id, V); + end Set_Has_Stream_Size_Clause; + procedure Set_Has_Subprogram_Descriptor (Id : E; V : B := True) is begin Set_Flag93 (Id, V); @@ -3254,6 +3314,11 @@ package body Einfo is Set_Flag69 (Id, V); end Set_Is_Access_Constant; + procedure Set_Is_Ada_2005 (Id : E; V : B := True) is + begin + Set_Flag185 (Id, V); + end Set_Is_Ada_2005; + procedure Set_Is_Aliased (Id : E; V : B := True) is begin pragma Assert (Nkind (Id) in N_Entity); @@ -3528,6 +3593,12 @@ package body Einfo is Set_Flag178 (Id, V); end Set_Is_Null_Init_Proc; + procedure Set_Is_Obsolescent (Id : E; V : B := True) is + begin + pragma Assert (Is_Subprogram (Id)); + Set_Flag153 (Id, V); + end Set_Is_Obsolescent; + procedure Set_Is_Optional_Parameter (Id : E; V : B := True) is begin pragma Assert (Is_Formal (Id)); @@ -3840,6 +3911,12 @@ package body Einfo is Set_Node17 (Id, V); end Set_Object_Ref; + procedure Set_Obsolescent_Warning (Id : E; V : N) is + begin + pragma Assert (Is_Subprogram (Id)); + Set_Node24 (Id, V); + end Set_Obsolescent_Warning; + procedure Set_Original_Access_Type (Id : E; V : E) is begin pragma Assert @@ -4421,21 +4498,8 @@ package body Einfo is -------------------- function Address_Clause (Id : E) return N is - Ritem : Node_Id; - begin - Ritem := First_Rep_Item (Id); - while Present (Ritem) loop - if Nkind (Ritem) = N_Attribute_Definition_Clause - and then Chars (Ritem) = Name_Address - then - return Ritem; - else - Ritem := Next_Rep_Item (Ritem); - end if; - end loop; - - return Empty; + return Rep_Clause (Id, Name_Address); end Address_Clause; ---------------------- @@ -4443,35 +4507,20 @@ package body Einfo is ---------------------- function Alignment_Clause (Id : E) return N is - Ritem : Node_Id; - begin - Ritem := First_Rep_Item (Id); - while Present (Ritem) loop - if Nkind (Ritem) = N_Attribute_Definition_Clause - and then Chars (Ritem) = Name_Alignment - then - return Ritem; - else - Ritem := Next_Rep_Item (Ritem); - end if; - end loop; - - return Empty; + return Rep_Clause (Id, Name_Alignment); end Alignment_Clause; ---------------------- -- Ancestor_Subtype -- ---------------------- - function Ancestor_Subtype (Id : E) return E is + function Ancestor_Subtype (Id : E) return E is begin -- If this is first subtype, or is a base type, then there is no -- ancestor subtype, so we return Empty to indicate this fact. - if Is_First_Subtype (Id) - or else Id = Base_Type (Id) - then + if Is_First_Subtype (Id) or else Id = Base_Type (Id) then return Empty; end if; @@ -4623,7 +4672,7 @@ package body Einfo is then Full_D := Parent (Full_View (Id)); - -- The full view may have been rewritten as an object renaming. + -- The full view may have been rewritten as an object renaming if Nkind (Full_D) = N_Object_Renaming_Declaration then return Name (Full_D); @@ -4779,7 +4828,7 @@ package body Einfo is Ent := Next_Entity (Ent); end if; - -- Skip all hidden stored discriminants if any. + -- Skip all hidden stored discriminants if any while Present (Ent) loop exit when Ekind (Ent) = E_Discriminant @@ -5583,7 +5632,7 @@ package body Einfo is -- E_Discriminant d2 -- ... - -- so it is critical not to go past the leading discriminants. + -- so it is critical not to go past the leading discriminants D : E := Id; @@ -5903,23 +5952,19 @@ package body Einfo is ----------------- function Size_Clause (Id : E) return N is - Ritem : Node_Id; - begin - Ritem := First_Rep_Item (Id); - while Present (Ritem) loop - if Nkind (Ritem) = N_Attribute_Definition_Clause - and then Chars (Ritem) = Name_Size - then - return Ritem; - else - Ritem := Next_Rep_Item (Ritem); - end if; - end loop; - - return Empty; + return Rep_Clause (Id, Name_Size); end Size_Clause; + ------------------------ + -- Stream_Size_Clause -- + ------------------------ + + function Stream_Size_Clause (Id : E) return N is + begin + return Rep_Clause (Id, Name_Stream_Size); + end Stream_Size_Clause; + ------------------ -- Subtype_Kind -- ------------------ @@ -6216,6 +6261,7 @@ package body Einfo is W ("Has_Small_Clause", Flag67 (Id)); W ("Has_Specified_Layout", Flag100 (Id)); W ("Has_Storage_Size_Clause", Flag23 (Id)); + W ("Has_Stream_Size_Clause", Flag184 (Id)); W ("Has_Subprogram_Descriptor", Flag93 (Id)); W ("Has_Task", Flag30 (Id)); W ("Has_Unchecked_Union", Flag123 (Id)); @@ -6228,6 +6274,7 @@ package body Einfo is W ("Is_AST_Entry", Flag132 (Id)); W ("Is_Abstract", Flag19 (Id)); W ("Is_Access_Constant", Flag69 (Id)); + W ("Is_Ada_2005", Flag185 (Id)); W ("Is_Aliased", Flag15 (Id)); W ("Is_Asynchronous", Flag81 (Id)); W ("Is_Atomic", Flag85 (Id)); @@ -6275,6 +6322,7 @@ package body Einfo is W ("Is_Machine_Code_Subprogram", Flag137 (Id)); W ("Is_Non_Static_Subtype", Flag109 (Id)); W ("Is_Null_Init_Proc", Flag178 (Id)); + W ("Is_Obsolescent", Flag153 (Id)); W ("Is_Optional_Parameter", Flag134 (Id)); W ("Is_Overriding_Operation", Flag39 (Id)); W ("Is_Package_Body_Entity", Flag160 (Id)); @@ -7207,6 +7255,9 @@ package body Einfo is procedure Write_Field24_Name (Id : Entity_Id) is begin case Ekind (Id) is + when Subprogram_Kind => + Write_Str ("Obsolescent_Warning"); + when others => Write_Str ("Field24??"); end case; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index c61ce663a28..573539fa1ba 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -41,6 +41,10 @@ package Einfo is -- This package defines the annotations to the abstract syntax tree that -- are needed to support semantic processing of an Ada compilation. +-- Note that after editing this spec and the corresponding body it is +-- required to run ceinfo to check the consistentcy of spec and body. +-- See ceinfo.adb for more information about the checks made. + -- These annotations are for the most part attributes of declared entities, -- and they correspond to conventional symbol table information. Other -- attributes include sets of meanings for overloaded names, possible @@ -527,7 +531,7 @@ package Einfo is -- Component_Size (Uint22) [implementation base type only] -- Present in array types. It contains the component size value for --- the array. A value of zero means that the value is not yet set. +-- the array. A value of No_Uint means that the value is not yet set. -- The value can be set by the use of a component size clause, or -- by the front end in package Layout, or by the backend. A negative -- value is used to represent a value which is not known at compile @@ -1517,6 +1521,10 @@ package Einfo is -- of access types, this flag is present only in the root type, since a -- storage size clause cannot be given to a derived type. +-- Has_Stream_Size_Clause (Flag184) +-- This flag is set on types which have a Stream_Size clause attribute. +-- Used to prevent multiple Stream_Size clauses for a given entity. + -- Has_Subprogram_Descriptor (Flag93) -- This flag is set on entities for which zero-cost exception subprogram -- descriptors can be generated (subprograms and library level package @@ -1650,6 +1658,10 @@ package Einfo is -- Is_Access_Type (synthesized) -- Applies to all entities, true for access types and subtypes +-- Is_Ada_2005 (Flag185) +-- Applies to all entities, true if a valid pragma Ada_05 applies to the +-- entity, indicating that the entity is Ada 2005 only. + -- Is_Aliased (Flag15) -- Present in objects whose declarations carry the keyword aliased, -- and on record components that have the keyword. @@ -2091,6 +2103,10 @@ package Einfo is -- Applies to all entities, true for entities representing objects, -- including generic formal parameters. +-- Is_Obsolescent (Flag153) +-- Present in subprogram entities. Set if a valid pragma Obsolescent +-- applies to the subprogram. + -- Is_Optional_Parameter (Flag134) -- Present in parameter entities. Set if the parameter is specified as -- optional by use of a First_Optional_Parameter argument to one of the @@ -2649,6 +2665,11 @@ package Einfo is -- Applies to subprograms and subprogram types. Yields the number of -- formals as a value of type Pos. +-- Obsolescent_Warning (Node24) +-- Present in subprogram entities. Set non-empty only if the pragma +-- Obsolescent had a string argument, in which case it records the +-- contents of the corresponding string literal node. + -- Original_Access_Type (Node21) -- Present in access to subprogram types. Anonymous access to protected -- subprogram types are replaced by an occurrence of an internal access @@ -3912,6 +3933,7 @@ package Einfo is -- Has_Qualified_Name (Flag161) -- Has_Unknown_Discriminants (Flag72) -- Has_Xref_Entry (Flag182) + -- Is_Ada_2005 (Flag185) -- Is_Bit_Packed_Array (Flag122) (base type only) -- Is_Child_Unit (Flag73) -- Is_Compilation_Unit (Flag149) @@ -4297,6 +4319,7 @@ package Einfo is -- Generic_Renamings (Elist23) (for an instance) -- Inner_Instances (Elist23) (for a generic function) -- Privals_Chain (Elist23) (for a protected function) + -- Obsolescent_Warning (Node24) -- Body_Needed_For_SAL (Flag40) -- Elaboration_Entity_Required (Flag174) -- Function_Returns_With_DSP (Flag169) @@ -4321,6 +4344,7 @@ package Einfo is -- Is_Instantiated (Flag126) (generic case only) -- Is_Intrinsic_Subprogram (Flag64) -- Is_Machine_Code_Subprogram (Flag137) (non-generic case only) + -- Is_Obsolescent (Flag153) -- Is_Overriding_Operation (Flag39) (non-generic case only) -- Is_Private_Descendant (Flag53) -- Is_Pure (Flag44) @@ -4542,6 +4566,7 @@ package Einfo is -- Generic_Renamings (Elist23) (for an instance) -- Inner_Instances (Elist23) (for a generic procedure) -- Privals_Chain (Elist23) (for a protected procedure) + -- Obsolescent_Warning (Node24) -- Body_Needed_For_SAL (Flag40) -- Elaboration_Entity_Required (Flag174) -- Function_Returns_With_DSP (Flag169) (always False for procedure) @@ -4566,6 +4591,7 @@ package Einfo is -- Is_Intrinsic_Subprogram (Flag64) -- Is_Machine_Code_Subprogram (Flag137) (non-generic case only) -- Is_Null_Init_Proc (Flag178) + -- Is_Obsolescent (Flag153) -- Is_Overriding_Operation (Flag39) (non-generic case only) -- Is_Private_Descendant (Flag53) -- Is_Pure (Flag44) @@ -5114,6 +5140,7 @@ package Einfo is function Has_Small_Clause (Id : E) return B; function Has_Specified_Layout (Id : E) return B; function Has_Storage_Size_Clause (Id : E) return B; + function Has_Stream_Size_Clause (Id : E) return B; function Has_Subprogram_Descriptor (Id : E) return B; function Has_Task (Id : E) return B; function Has_Unchecked_Union (Id : E) return B; @@ -5130,6 +5157,7 @@ package Einfo is function Is_AST_Entry (Id : E) return B; function Is_Abstract (Id : E) return B; function Is_Access_Constant (Id : E) return B; + function Is_Ada_2005 (Id : E) return B; function Is_Aliased (Id : E) return B; function Is_Asynchronous (Id : E) return B; function Is_Atomic (Id : E) return B; @@ -5172,6 +5200,7 @@ package Einfo is function Is_Machine_Code_Subprogram (Id : E) return B; function Is_Non_Static_Subtype (Id : E) return B; function Is_Null_Init_Proc (Id : E) return B; + function Is_Obsolescent (Id : E) return B; function Is_Optional_Parameter (Id : E) return B; function Is_Package_Body_Entity (Id : E) return B; function Is_Packed (Id : E) return B; @@ -5225,6 +5254,7 @@ package Einfo is function Normalized_Position (Id : E) return U; function Normalized_Position_Max (Id : E) return U; function Object_Ref (Id : E) return E; + function Obsolescent_Warning (Id : E) return N; function Original_Access_Type (Id : E) return E; function Original_Array_Type (Id : E) return E; function Original_Record_Component (Id : E) return E; @@ -5385,6 +5415,7 @@ package Einfo is function Root_Type (Id : E) return E; function Scope_Depth_Set (Id : E) return B; function Size_Clause (Id : E) return N; + function Stream_Size_Clause (Id : E) return N; function Tag_Component (Id : E) return E; function Type_High_Bound (Id : E) return N; function Type_Low_Bound (Id : E) return N; @@ -5583,6 +5614,7 @@ package Einfo is procedure Set_Has_Small_Clause (Id : E; V : B := True); procedure Set_Has_Specified_Layout (Id : E; V : B := True); procedure Set_Has_Storage_Size_Clause (Id : E; V : B := True); + procedure Set_Has_Stream_Size_Clause (Id : E; V : B := True); procedure Set_Has_Subprogram_Descriptor (Id : E; V : B := True); procedure Set_Has_Task (Id : E; V : B := True); procedure Set_Has_Unchecked_Union (Id : E; V : B := True); @@ -5599,6 +5631,7 @@ package Einfo is procedure Set_Is_AST_Entry (Id : E; V : B := True); procedure Set_Is_Abstract (Id : E; V : B := True); procedure Set_Is_Access_Constant (Id : E; V : B := True); + procedure Set_Is_Ada_2005 (Id : E; V : B := True); procedure Set_Is_Aliased (Id : E; V : B := True); procedure Set_Is_Asynchronous (Id : E; V : B := True); procedure Set_Is_Atomic (Id : E; V : B := True); @@ -5646,6 +5679,7 @@ package Einfo is procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True); procedure Set_Is_Non_Static_Subtype (Id : E; V : B := True); procedure Set_Is_Null_Init_Proc (Id : E; V : B := True); + procedure Set_Is_Obsolescent (Id : E; V : B := True); procedure Set_Is_Optional_Parameter (Id : E; V : B := True); procedure Set_Is_Overriding_Operation (Id : E; V : B := True); procedure Set_Is_Package_Body_Entity (Id : E; V : B := True); @@ -5699,6 +5733,7 @@ package Einfo is procedure Set_Normalized_Position (Id : E; V : U); procedure Set_Normalized_Position_Max (Id : E; V : U); procedure Set_Object_Ref (Id : E; V : E); + procedure Set_Obsolescent_Warning (Id : E; V : N); procedure Set_Original_Access_Type (Id : E; V : E); procedure Set_Original_Array_Type (Id : E; V : E); procedure Set_Original_Record_Component (Id : E; V : E); @@ -6109,6 +6144,7 @@ package Einfo is pragma Inline (Has_Small_Clause); pragma Inline (Has_Specified_Layout); pragma Inline (Has_Storage_Size_Clause); + pragma Inline (Has_Stream_Size_Clause); pragma Inline (Has_Subprogram_Descriptor); pragma Inline (Has_Task); pragma Inline (Has_Unchecked_Union); @@ -6125,6 +6161,7 @@ package Einfo is pragma Inline (Is_AST_Entry); pragma Inline (Is_Abstract); pragma Inline (Is_Access_Constant); + pragma Inline (Is_Ada_2005); pragma Inline (Is_Access_Type); pragma Inline (Is_Aliased); pragma Inline (Is_Array_Type); @@ -6194,6 +6231,7 @@ package Einfo is pragma Inline (Is_Named_Number); pragma Inline (Is_Non_Static_Subtype); pragma Inline (Is_Null_Init_Proc); + pragma Inline (Is_Obsolescent); pragma Inline (Is_Numeric_Type); pragma Inline (Is_Object); pragma Inline (Is_Optional_Parameter); @@ -6261,6 +6299,7 @@ package Einfo is pragma Inline (Normalized_Position); pragma Inline (Normalized_Position_Max); pragma Inline (Object_Ref); + pragma Inline (Obsolescent_Warning); pragma Inline (Original_Access_Type); pragma Inline (Original_Array_Type); pragma Inline (Original_Record_Component); @@ -6468,6 +6507,7 @@ package Einfo is pragma Inline (Set_Is_AST_Entry); pragma Inline (Set_Is_Abstract); pragma Inline (Set_Is_Access_Constant); + pragma Inline (Set_Is_Ada_2005); pragma Inline (Set_Is_Aliased); pragma Inline (Set_Is_Asynchronous); pragma Inline (Set_Is_Atomic); @@ -6515,6 +6555,7 @@ package Einfo is pragma Inline (Set_Is_Machine_Code_Subprogram); pragma Inline (Set_Is_Non_Static_Subtype); pragma Inline (Set_Is_Null_Init_Proc); + pragma Inline (Set_Is_Obsolescent); pragma Inline (Set_Is_Optional_Parameter); pragma Inline (Set_Is_Overriding_Operation); pragma Inline (Set_Is_Package_Body_Entity); @@ -6568,6 +6609,7 @@ package Einfo is pragma Inline (Set_Normalized_Position); pragma Inline (Set_Normalized_Position_Max); pragma Inline (Set_Object_Ref); + pragma Inline (Set_Obsolescent_Warning); pragma Inline (Set_Original_Access_Type); pragma Inline (Set_Original_Array_Type); pragma Inline (Set_Original_Record_Component); diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 9751d2a2ceb..6ddda3f0d45 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -1090,7 +1090,9 @@ package body Errout is -- Source_Reference. This ensures outputting the proper name of -- the source file in this situation. - if Num_SRef_Pragmas (Main_Source_File) /= 0 then + if Main_Source_File = No_Source_File or else + Num_SRef_Pragmas (Main_Source_File) /= 0 + then Current_Error_Source_File := No_Source_File; end if; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index fa99d8bd1ad..7c965cd2a7f 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -497,12 +497,15 @@ package body Exp_Attr is -- Start of processing for Expand_N_Attribute_Reference begin - -- Do required validity checking + -- Do required validity checking, if enabled. Do not apply check to + -- output parameters of an Asm instruction, since the value of this + -- is not set till after the attribute has been elaborated. - if Validity_Checks_On and Validity_Check_Operands then + if Validity_Checks_On and then Validity_Check_Operands + and then Id /= Attribute_Asm_Output + then declare Expr : Node_Id; - begin Expr := First (Expressions (N)); while Present (Expr) loop @@ -1901,7 +1904,7 @@ package body Exp_Attr is -- Now we need to get the entity for the call, and construct -- a function call node, where we preset a reference to Dnn -- as the controlling argument (doing an unchecked - -- conversion to the classwide tagged type to make it + -- conversion to the class-wide tagged type to make it -- look like a real tagged object). Fname := Find_Prim_Op (Rtyp, TSS_Stream_Input); @@ -2398,8 +2401,6 @@ package body Exp_Attr is Make_Integer_Literal (Loc, Intval => 1)))))))); - - end if; Analyze_And_Resolve (N, Btyp); @@ -3153,7 +3154,7 @@ package body Exp_Attr is Rewrite (Prefix (N), New_Occurrence_Of (Entity (Pref), Loc)); return; - -- For x'Size applied to an object of a class wide type, transform + -- For x'Size applied to an object of a class-wide type, transform -- X'Size into a call to the primitive operation _Size applied to X. elsif Is_Class_Wide_Type (Ptyp) then @@ -3232,8 +3233,7 @@ package body Exp_Attr is -- Common processing for record and array component case if Siz /= 0 then - Rewrite (N, - Make_Integer_Literal (Loc, Siz)); + Rewrite (N, Make_Integer_Literal (Loc, Siz)); Analyze_And_Resolve (N, Typ); @@ -3364,6 +3364,29 @@ package body Exp_Attr is end if; end Storage_Size; + ----------------- + -- Stream_Size -- + ----------------- + + when Attribute_Stream_Size => Stream_Size : declare + Ptyp : constant Entity_Id := Etype (Pref); + Size : Int; + + begin + -- If we have a Stream_Size clause for this type use it, otherwise + -- the Stream_Size if the size of the type. + + if Has_Stream_Size_Clause (Ptyp) then + Size := UI_To_Int + (Static_Integer (Expression (Stream_Size_Clause (Ptyp)))); + else + Size := UI_To_Int (Esize (Ptyp)); + end if; + + Rewrite (N, Make_Integer_Literal (Loc, Intval => Size)); + Analyze_And_Resolve (N, Typ); + end Stream_Size; + ---------- -- Succ -- ---------- @@ -3998,6 +4021,39 @@ package body Exp_Attr is Analyze_And_Resolve (N, Standard_Wide_String); end Wide_Image; + --------------------- + -- Wide_Wide_Image -- + --------------------- + + -- We expand typ'Wide_Wide_Image (X) into + + -- String_To_Wide_Wide_String + -- (typ'Image (X), Wide_Character_Encoding_Method) + + -- This works in all cases because String_To_Wide_Wide_String converts + -- any wide character escape sequences resulting from the Image call to + -- the proper Wide_Character equivalent + + -- not quite right for typ = Wide_Wide_Character ??? + + when Attribute_Wide_Wide_Image => Wide_Wide_Image : + begin + Rewrite (N, + Make_Function_Call (Loc, + Name => New_Reference_To + (RTE (RE_String_To_Wide_Wide_String), Loc), + Parameter_Associations => New_List ( + Make_Attribute_Reference (Loc, + Prefix => Pref, + Attribute_Name => Name_Image, + Expressions => Exprs), + + Make_Integer_Literal (Loc, + Intval => Int (Wide_Character_Encoding_Method))))); + + Analyze_And_Resolve (N, Standard_Wide_Wide_String); + end Wide_Wide_Image; + ---------------- -- Wide_Value -- ---------------- @@ -4036,6 +4092,53 @@ package body Exp_Attr is Analyze_And_Resolve (N, Typ); end Wide_Value; + --------------------- + -- Wide_Wide_Value -- + --------------------- + + -- We expand typ'Wide_Value_Value (X) into + + -- typ'Value + -- (Wide_Wide_String_To_String (X, Wide_Character_Encoding_Method)) + + -- Wide_Wide_String_To_String is a runtime function that converts its + -- wide string argument to String, converting any non-translatable + -- characters into appropriate escape sequences. This preserves the + -- required semantics of Wide_Wide_Value in all cases, and results in a + -- very simple implementation approach. + + -- It's not quite right where typ = Wide_Wide_Character, because the + -- encoding method may not cover the whole character type ??? + + when Attribute_Wide_Wide_Value => Wide_Wide_Value : + begin + Rewrite (N, + Make_Attribute_Reference (Loc, + Prefix => Pref, + Attribute_Name => Name_Value, + + Expressions => New_List ( + Make_Function_Call (Loc, + Name => + New_Reference_To (RTE (RE_Wide_Wide_String_To_String), Loc), + + Parameter_Associations => New_List ( + Relocate_Node (First (Exprs)), + Make_Integer_Literal (Loc, + Intval => Int (Wide_Character_Encoding_Method))))))); + + Analyze_And_Resolve (N, Typ); + end Wide_Wide_Value; + + --------------------- + -- Wide_Wide_Width -- + --------------------- + + -- Wide_Wide_Width attribute is handled in separate unit Exp_Imgv + + when Attribute_Wide_Wide_Width => + Exp_Imgv.Expand_Width_Attribute (N, Wide_Wide); + ---------------- -- Wide_Width -- ---------------- @@ -4043,7 +4146,7 @@ package body Exp_Attr is -- Wide_Width attribute is handled in separate unit Exp_Imgv when Attribute_Wide_Width => - Exp_Imgv.Expand_Width_Attribute (N, Wide => True); + Exp_Imgv.Expand_Width_Attribute (N, Wide); ----------- -- Width -- @@ -4052,7 +4155,7 @@ package body Exp_Attr is -- Width attribute is handled in separate unit Exp_Imgv when Attribute_Width => - Exp_Imgv.Expand_Width_Attribute (N, Wide => False); + Exp_Imgv.Expand_Width_Attribute (N, Normal); ----------- -- Write -- @@ -4318,7 +4421,6 @@ package body Exp_Attr is New_Reference_To (Base_Type (Etype (Prefix (N))), Loc), Attribute_Name => Cnam)), Reason => CE_Overflow_Check_Failed)); - end Expand_Pred_Succ; ------------------------ @@ -4354,7 +4456,6 @@ package body Exp_Attr is end if; return Proc; - end Find_Inherited_TSS; ---------------------------- diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 80ac70db61a..35084860c8c 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -921,7 +921,9 @@ package body Exp_Ch11 is -- Lang component: 'A' Append_To (L, - Make_Character_Literal (Loc, Name_uA, Get_Char_Code ('A'))); + Make_Character_Literal (Loc, + Chars => Name_uA, + Char_Literal_Value => UI_From_Int (Character'Pos ('A')))); -- Name_Length component: Nam'Length diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index a09f7f57288..1d027d05176 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -60,7 +60,6 @@ with Stand; use Stand; with Snames; use Snames; with Tbuild; use Tbuild; with Ttypes; use Ttypes; -with Uintp; use Uintp; with Validsw; use Validsw; package body Exp_Ch3 is @@ -487,7 +486,9 @@ package body Exp_Ch3 is return New_List ( Make_Assignment_Statement (Loc, Name => Comp, - Expression => Get_Simple_Init_Val (Comp_Type, Loc))); + Expression => + Get_Simple_Init_Val + (Comp_Type, Loc, Component_Size (A_Type)))); else return @@ -567,11 +568,12 @@ package body Exp_Ch3 is -- apply in this case), and we must generate a procedure (even if it is -- null) to satisfy the call in this case. - -- Exception: do not build an array init_proc for a type whose root type - -- is Standard.String or Standard.Wide_String, since there is no place - -- to put the code, and in any case we handle initialization of such - -- types (in the Initialize_Scalars case, that's the only time the issue - -- arises) in a special manner anyway which does not need an init_proc. + -- Exception: do not build an array init_proc for a type whose root + -- type is Standard.String or Standard.Wide_[Wide_]String, since there + -- is no place to put the code, and in any case we handle initialization + -- of such types (in the Initialize_Scalars case, that's the only time + -- the issue arises) in a special manner anyway which does not need an + -- init_proc. if Has_Non_Null_Base_Init_Proc (Comp_Type) or else Needs_Simple_Initialization (Comp_Type) @@ -579,7 +581,8 @@ package body Exp_Ch3 is or else (not Restriction_Active (No_Initialize_Scalars) and then Is_Public (A_Type) and then Root_Type (A_Type) /= Standard_String - and then Root_Type (A_Type) /= Standard_Wide_String) + and then Root_Type (A_Type) /= Standard_Wide_String + and then Root_Type (A_Type) /= Standard_Wide_Wide_String) then Proc_Id := Make_Defining_Identifier (Loc, Make_Init_Proc_Name (A_Type)); @@ -654,6 +657,7 @@ package body Exp_Ch3 is -- Nothing to do if we already built a master entity for this scope if not Has_Master_Entity (Scope (T)) then + -- first build the master entity -- _Master : constant Master_Id := Current_Master.all; -- and insert it just before the current declaration @@ -1996,7 +2000,8 @@ package body Exp_Ch3 is elsif Component_Needs_Simple_Initialization (Typ) then Stmts := - Build_Assignment (Id, Get_Simple_Init_Val (Typ, Loc)); + Build_Assignment + (Id, Get_Simple_Init_Val (Typ, Loc, Esize (Id))); -- Nothing needed for this case @@ -2058,7 +2063,8 @@ package body Exp_Ch3 is elsif Component_Needs_Simple_Initialization (Typ) then Append_List_To (Statement_List, - Build_Assignment (Id, Get_Simple_Init_Val (Typ, Loc))); + Build_Assignment + (Id, Get_Simple_Init_Val (Typ, Loc, Esize (Id)))); end if; end if; @@ -3403,7 +3409,7 @@ package body Exp_Ch3 is elsif Needs_Simple_Initialization (Typ) then Set_No_Initialization (N, False); - Set_Expression (N, Get_Simple_Init_Val (Typ, Loc)); + Set_Expression (N, Get_Simple_Init_Val (Typ, Loc, Esize (Def_Id))); Analyze_And_Resolve (Expression (N), Typ); end if; @@ -3877,13 +3883,14 @@ package body Exp_Ch3 is then null; - -- We do not need an init proc for string or wide string, since - -- the only time these need initialization in normalize or + -- We do not need an init proc for string or wide [wide] string, + -- since the only time these need initialization in normalize or -- initialize scalars mode, and these types are treated specially -- and do not need initialization procedures. elsif Root_Type (Base) = Standard_String or else Root_Type (Base) = Standard_Wide_String + or else Root_Type (Base) = Standard_Wide_Wide_String then null; @@ -4878,14 +4885,87 @@ package body Exp_Ch3 is ------------------------- function Get_Simple_Init_Val - (T : Entity_Id; - Loc : Source_Ptr) return Node_Id + (T : Entity_Id; + Loc : Source_Ptr; + Size : Uint := No_Uint) return Node_Id is Val : Node_Id; - Typ : Node_Id; Result : Node_Id; Val_RE : RE_Id; + Size_To_Use : Uint; + -- This is the size to be used for computation of the appropriate + -- initial value for the Normalize_Scalars and Initialize_Scalars case. + + Lo_Bound : Uint; + Hi_Bound : Uint; + -- These are the values computed by the procedure Check_Subtype_Bounds + + procedure Check_Subtype_Bounds; + -- This procedure examines the subtype T, and its ancestor subtypes + -- and derived types to determine the best known information about + -- the bounds of the subtype. After the call Lo_Bound is set either + -- to No_Uint if no information can be determined, or to a value which + -- represents a known low bound, i.e. a valid value of the subtype can + -- not be less than this value. Hi_Bound is similarly set to a known + -- high bound (valid value cannot be greater than this). + + -------------------------- + -- Check_Subtype_Bounds -- + -------------------------- + + procedure Check_Subtype_Bounds is + ST1 : Entity_Id; + ST2 : Entity_Id; + Lo : Node_Id; + Hi : Node_Id; + Loval : Uint; + Hival : Uint; + + begin + Lo_Bound := No_Uint; + Hi_Bound := No_Uint; + + -- Loop to climb ancestor subtypes and derived types + + ST1 := T; + loop + if not Is_Discrete_Type (ST1) then + return; + end if; + + Lo := Type_Low_Bound (ST1); + Hi := Type_High_Bound (ST1); + + if Compile_Time_Known_Value (Lo) then + Loval := Expr_Value (Lo); + + if Lo_Bound = No_Uint or else Lo_Bound < Loval then + Lo_Bound := Loval; + end if; + end if; + + if Compile_Time_Known_Value (Hi) then + Hival := Expr_Value (Hi); + + if Hi_Bound = No_Uint or else Hi_Bound > Hival then + Hi_Bound := Hival; + end if; + end if; + + ST2 := Ancestor_Subtype (ST1); + + if No (ST2) then + ST2 := Etype (ST1); + end if; + + exit when ST1 = ST2; + ST1 := ST2; + end loop; + end Check_Subtype_Bounds; + + -- Start of processing for Get_Simple_Init_Val + begin -- For a private type, we should always have an underlying type -- (because this was already checked in Needs_Simple_Initialization). @@ -4893,7 +4973,7 @@ package body Exp_Ch3 is -- do an Unchecked_Convert to the private type. if Is_Private_Type (T) then - Val := Get_Simple_Init_Val (Underlying_Type (T), Loc); + Val := Get_Simple_Init_Val (Underlying_Type (T), Loc, Size); -- A special case, if the underlying value is null, then qualify -- it with the underlying type, so that the null is properly typed @@ -4927,46 +5007,98 @@ package body Exp_Ch3 is elsif Is_Scalar_Type (T) then pragma Assert (Init_Or_Norm_Scalars); + -- Compute size of object. If it is given by the caller, we can + -- use it directly, otherwise we use Esize (T) as an estimate. As + -- far as we know this covers all cases correctly. + + if Size = No_Uint or else Size <= Uint_0 then + Size_To_Use := UI_Max (Uint_1, Esize (T)); + else + Size_To_Use := Size; + end if; + + -- Maximum size to use is 64 bits, since we will create values + -- of type Unsigned_64 and the range must fit this type. + + if Size_To_Use /= No_Uint and then Size_To_Use > Uint_64 then + Size_To_Use := Uint_64; + end if; + + -- Check known bounds of subtype + + Check_Subtype_Bounds; + -- Processing for Normalize_Scalars case if Normalize_Scalars then - -- First prepare a value (out of subtype range if possible) + -- If zero is invalid, it is a convenient value to use that is + -- for sure an appropriate invalid value in all situations. + + if Lo_Bound /= No_Uint and then Lo_Bound > Uint_0 then + Val := Make_Integer_Literal (Loc, 0); + + -- Cases where all one bits is the appropriate invalid value + + -- For modular types, all 1 bits is either invalid or valid. If + -- it is valid, then there is nothing that can be done since there + -- are no invalid values (we ruled out zero already). + + -- For signed integer types that have no negative values, either + -- there is room for negative values, or there is not. If there + -- is, then all 1 bits may be interpretecd as minus one, which is + -- certainly invalid. Alternatively it is treated as the largest + -- positive value, in which case the observation for modular types + -- still applies. + + -- For float types, all 1-bits is a NaN (not a number), which is + -- certainly an appropriately invalid value. - if Is_Real_Type (T) or else Is_Integer_Type (T) then - Val := - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Base_Type (T), Loc), - Attribute_Name => Name_First); + elsif Is_Unsigned_Type (T) + or else Is_Floating_Point_Type (T) + or else Is_Enumeration_Type (T) + then + Val := Make_Integer_Literal (Loc, 2 ** Size_To_Use - 1); + + -- Resolve as Unsigned_64, because the largest number we + -- can generate is out of range of universal integer. + + Analyze_And_Resolve (Val, RTE (RE_Unsigned_64)); - elsif Is_Modular_Integer_Type (T) then - Val := - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Base_Type (T), Loc), - Attribute_Name => Name_Last); + -- Case of signed types else - pragma Assert (Is_Enumeration_Type (T)); - - if Esize (T) <= 8 then - Typ := RTE (RE_Unsigned_8); - elsif Esize (T) <= 16 then - Typ := RTE (RE_Unsigned_16); - elsif Esize (T) <= 32 then - Typ := RTE (RE_Unsigned_32); - else - Typ := RTE (RE_Unsigned_64); - end if; + declare + Signed_Size : constant Uint := + UI_Min (Uint_63, Size_To_Use - 1); + + begin + -- Normally we like to use the most negative number. The + -- one exception is when this number is in the known subtype + -- range and the largest positive number is not in the known + -- subtype range. + + -- For this exceptional case, use largest positive value - Val := - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Typ, Loc), - Attribute_Name => Name_Last); + if Lo_Bound /= No_Uint and then Hi_Bound /= No_Uint + and then Lo_Bound <= (-(2 ** Signed_Size)) + and then Hi_Bound < 2 ** Signed_Size + then + Val := Make_Integer_Literal (Loc, 2 ** Signed_Size - 1); + + -- Normal case of largest negative value + + else + Val := Make_Integer_Literal (Loc, -(2 ** Signed_Size)); + end if; + end; end if; -- Here for Initialize_Scalars case else + -- For float types, use float values from System.Scalar_Values + if Is_Floating_Point_Type (T) then if Root_Type (T) = Standard_Short_Float then Val_RE := RE_IS_Isf; @@ -4978,25 +5110,42 @@ package body Exp_Ch3 is Val_RE := RE_IS_Ill; end if; - elsif Is_Unsigned_Type (Base_Type (T)) then - if Esize (T) = 8 then + -- If zero is invalid, use zero values from System.Scalar_Values + + elsif Lo_Bound /= No_Uint and then Lo_Bound > Uint_0 then + if Size_To_Use <= 8 then + Val_RE := RE_IS_Iz1; + elsif Size_To_Use <= 16 then + Val_RE := RE_IS_Iz2; + elsif Size_To_Use <= 32 then + Val_RE := RE_IS_Iz4; + else + Val_RE := RE_IS_Iz8; + end if; + + -- For unsigned, use unsigned values from System.Scalar_Values + + elsif Is_Unsigned_Type (T) then + if Size_To_Use <= 8 then Val_RE := RE_IS_Iu1; - elsif Esize (T) = 16 then + elsif Size_To_Use <= 16 then Val_RE := RE_IS_Iu2; - elsif Esize (T) = 32 then + elsif Size_To_Use <= 32 then Val_RE := RE_IS_Iu4; - else pragma Assert (Esize (T) = 64); + else Val_RE := RE_IS_Iu8; end if; - else -- signed type - if Esize (T) = 8 then + -- For signed, use signed values from System.Scalar_Values + + else + if Size_To_Use <= 8 then Val_RE := RE_IS_Is1; - elsif Esize (T) = 16 then + elsif Size_To_Use <= 16 then Val_RE := RE_IS_Is2; - elsif Esize (T) = 32 then + elsif Size_To_Use <= 32 then Val_RE := RE_IS_Is4; - else pragma Assert (Esize (T) = 64); + else Val_RE := RE_IS_Is8; end if; end if; @@ -5004,11 +5153,11 @@ package body Exp_Ch3 is Val := New_Occurrence_Of (RTE (Val_RE), Loc); end if; - -- The final expression is obtained by doing an unchecked - -- conversion of this result to the base type of the - -- required subtype. We use the base type to avoid the - -- unchecked conversion from chopping bits, and then we - -- set Kill_Range_Check to preserve the "bad" value. + -- The final expression is obtained by doing an unchecked conversion + -- of this result to the base type of the required subtype. We use + -- the base type to avoid the unchecked conversion from chopping + -- bits, and then we set Kill_Range_Check to preserve the "bad" + -- value. Result := Unchecked_Convert_To (Base_Type (T), Val); @@ -5022,11 +5171,13 @@ package body Exp_Ch3 is return Result; - -- String or Wide_String (must have Initialize_Scalars set) + -- String or Wide_[Wide]_String (must have Initialize_Scalars set) elsif Root_Type (T) = Standard_String or else Root_Type (T) = Standard_Wide_String + or else + Root_Type (T) = Standard_Wide_Wide_String then pragma Assert (Init_Or_Norm_Scalars); @@ -5037,7 +5188,8 @@ package body Exp_Ch3 is Choices => New_List ( Make_Others_Choice (Loc)), Expression => - Get_Simple_Init_Val (Component_Type (T), Loc)))); + Get_Simple_Init_Val + (Component_Type (T), Loc, Esize (Root_Type (T)))))); -- Access type is initialized to null @@ -5570,7 +5722,8 @@ package body Exp_Ch3 is elsif Init_Or_Norm_Scalars and then (Root_Type (T) = Standard_String - or else Root_Type (T) = Standard_Wide_String) + or else Root_Type (T) = Standard_Wide_String + or else Root_Type (T) = Standard_Wide_Wide_String) and then (not Is_Itype (T) or else Nkind (Associated_Node_For_Itype (T)) /= N_Aggregate) diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads index 27cd7d8c1a3..59f8ef71008 100644 --- a/gcc/ada/exp_ch3.ads +++ b/gcc/ada/exp_ch3.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -28,6 +28,7 @@ with Types; use Types; with Elists; use Elists; +with Uintp; use Uintp; package Exp_Ch3 is @@ -96,10 +97,16 @@ package Exp_Ch3 is function Get_Simple_Init_Val (T : Entity_Id; - Loc : Source_Ptr) return Node_Id; + Loc : Source_Ptr; + Size : Uint := No_Uint) return Node_Id; -- For a type which Needs_Simple_Initialization (see above), prepares -- the tree for an expression representing the required initial value. -- Loc is the source location used in constructing this tree which is - -- returned as the result of the call. + -- returned as the result of the call. The Size parameter indicates the + -- target size of the object if it is known (indicated by a value that + -- is not No_Uint and is greater than zero). If Size is not given (Size + -- set to No_Uint, or non-positive), then the Esize of T is used as an + -- estimate of the Size. The object size is needed to prepare a known + -- invalid value for use by Normalize_Scalars. end Exp_Ch3; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 0b6447aad4e..6305f5dd746 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -1733,7 +1733,7 @@ package body Exp_Ch6 is and then Present (Controlling_Argument (N)) and then not Java_VM then - Expand_Dispatch_Call (N); + Expand_Dispatching_Call (N); -- The following return is worrisome. Is it really OK to -- skip all remaining processing in this procedure ??? diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index f2284d408e8..f0f7f0a0ad4 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1996-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- -- @@ -793,8 +793,7 @@ package body Exp_Dbug is elsif Nkind (Choice) = N_Character_Literal and then No (Entity (Choice)) then - Add_Uint_To_Buffer - (UI_From_Int (Int (Char_Literal_Value (Choice)))); + Add_Uint_To_Buffer (Char_Literal_Value (Choice)); else declare diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index fb8f6be31e0..9cc9fb0098e 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -142,11 +142,11 @@ package body Exp_Disp is -- Check if the type has a private view or if the public view appears -- in the visible part of a package spec. - -------------------------- - -- Expand_Dispatch_Call -- - -------------------------- + ----------------------------- + -- Expand_Dispatching_Call -- + ----------------------------- - procedure Expand_Dispatch_Call (Call_Node : Node_Id) is + procedure Expand_Dispatching_Call (Call_Node : Node_Id) is Loc : constant Source_Ptr := Sloc (Call_Node); Call_Typ : constant Entity_Id := Etype (Call_Node); @@ -154,21 +154,25 @@ package body Exp_Disp is Param_List : constant List_Id := Parameter_Associations (Call_Node); Subp : Entity_Id := Entity (Name (Call_Node)); - CW_Typ : Entity_Id; - New_Call : Node_Id; - New_Call_Name : Node_Id; - New_Params : List_Id := No_List; - Param : Node_Id; - Res_Typ : Entity_Id; - Subp_Ptr_Typ : Entity_Id; - Subp_Typ : Entity_Id; - Typ : Entity_Id; - Eq_Prim_Op : Entity_Id := Empty; + CW_Typ : Entity_Id; + New_Call : Node_Id; + New_Call_Name : Node_Id; + New_Params : List_Id := No_List; + Param : Node_Id; + Res_Typ : Entity_Id; + Subp_Ptr_Typ : Entity_Id; + Subp_Typ : Entity_Id; + Typ : Entity_Id; + Eq_Prim_Op : Entity_Id := Empty; + Controlling_Tag : Node_Id; function New_Value (From : Node_Id) return Node_Id; -- From is the original Expression. New_Value is equivalent to a call -- to Duplicate_Subexpr with an explicit dereference when From is an - -- access parameter + -- access parameter. + + function Controlling_Type (Subp : Entity_Id) return Entity_Id; + -- Returns the tagged type for which Subp is a primitive subprogram --------------- -- New_Value -- @@ -176,7 +180,6 @@ package body Exp_Disp is function New_Value (From : Node_Id) return Node_Id is Res : constant Node_Id := Duplicate_Subexpr (From); - begin if Is_Access_Type (Etype (From)) then return Make_Explicit_Dereference (Sloc (From), Res); @@ -185,10 +188,45 @@ package body Exp_Disp is end if; end New_Value; - -- Start of processing for Expand_Dispatch_Call + ---------------------- + -- Controlling_Type -- + ---------------------- + + function Controlling_Type (Subp : Entity_Id) return Entity_Id is + begin + if Ekind (Subp) = E_Function + and then Has_Controlling_Result (Subp) + then + return Base_Type (Etype (Subp)); + + else + declare + Formal : Entity_Id := First_Formal (Subp); + + begin + while Present (Formal) loop + if Is_Controlling_Formal (Formal) then + if Is_Access_Type (Etype (Formal)) then + return Base_Type (Designated_Type (Etype (Formal))); + else + return Base_Type (Etype (Formal)); + end if; + end if; + + Next_Formal (Formal); + end loop; + end; + end if; + + -- Controlling type not found (should never happen) + + return Empty; + end Controlling_Type; + + -- Start of processing for Expand_Dispatching_Call begin - -- If this is an inherited operation that was overriden, the body + -- If this is an inherited operation that was overridden, the body -- that is being called is its alias. if Present (Alias (Subp)) @@ -198,17 +236,31 @@ package body Exp_Disp is Subp := Alias (Subp); end if; - -- Expand_Dispatch is called directly from the semantics, so we need - -- a check to see whether expansion is active before proceeding + -- Expand_Dispatching_Call is called directly from the semantics, + -- so we need a check to see whether expansion is active before + -- proceeding. if not Expander_Active then return; end if; - -- Definition of the ClassWide Type and the Tagged type + -- Definition of the class-wide type and the tagged type + + -- If the controlling argument is itself a tag rather than a tagged + -- object, then use the class-wide type associated with the subprogram's + -- controlling type. This case can occur when a call to an inherited + -- primitive has an actual that originated from a default parameter + -- given by a tag-indeterminate call and when there is no other + -- controlling argument providing the tag (AI-239 requires dispatching). + -- This capability of dispatching directly by tag is also needed by the + -- implementation of AI-260 (for the generic dispatching constructors). - if Is_Access_Type (Etype (Ctrl_Arg)) then + if Etype (Ctrl_Arg) = RTE (RE_Tag) then + CW_Typ := Class_Wide_Type (Controlling_Type (Subp)); + + elsif Is_Access_Type (Etype (Ctrl_Arg)) then CW_Typ := Designated_Type (Etype (Ctrl_Arg)); + else CW_Typ := Etype (Ctrl_Arg); end if; @@ -291,7 +343,7 @@ package body Exp_Disp is elsif No (Find_Controlling_Arg (Param)) then Append_To (New_Params, Relocate_Node (Param)); - -- No tag check for function dispatching on result it the + -- No tag check for function dispatching on result if the -- Tag given by the context is this one elsif Find_Controlling_Arg (Param) = Ctrl_Arg then @@ -362,7 +414,7 @@ package body Exp_Disp is if Etype (Subp) = Typ then Res_Typ := CW_Typ; else - Res_Typ := Etype (Subp); + Res_Typ := Etype (Subp); end if; Subp_Typ := Create_Itype (E_Subprogram_Type, Call_Node); @@ -389,9 +441,9 @@ package body Exp_Disp is Set_Scope (New_Formal, Subp_Typ); -- Change all the controlling argument types to be class-wide - -- to avoid a recursion in dispatching + -- to avoid a recursion in dispatching. - if Is_Controlling_Actual (Param) then + if Is_Controlling_Formal (New_Formal) then Set_Etype (New_Formal, Etype (Param)); end if; @@ -443,6 +495,20 @@ package body Exp_Disp is Set_Etype (Subp_Ptr_Typ, Subp_Ptr_Typ); Set_Directly_Designated_Type (Subp_Ptr_Typ, Subp_Typ); + -- If the controlling argument is a value of type Ada.Tag then + -- use it directly. Otherwise, the tag must be extracted from + -- the controlling object. + + if Etype (Ctrl_Arg) = RTE (RE_Tag) then + Controlling_Tag := Duplicate_Subexpr (Ctrl_Arg); + + else + Controlling_Tag := + Make_Selected_Component (Loc, + Prefix => Duplicate_Subexpr_Move_Checks (Ctrl_Arg), + Selector_Name => New_Reference_To (DTC_Entity (Subp), Loc)); + end if; + -- Generate: -- Subp_Ptr_Typ!(Get_Prim_Op_Address (Ctrl._Tag, pos)); @@ -454,9 +520,7 @@ package body Exp_Disp is -- Vptr - Make_Selected_Component (Loc, - Prefix => Duplicate_Subexpr_Move_Checks (Ctrl_Arg), - Selector_Name => New_Reference_To (DTC_Entity (Subp), Loc)), + Controlling_Tag, -- Position @@ -468,11 +532,10 @@ package body Exp_Disp is Name => New_Call_Name, Parameter_Associations => New_Params); - -- if this is a dispatching "=", we must first compare the tags so + -- If this is a dispatching "=", we must first compare the tags so -- we generate: x.tag = y.tag and then x = y if Subp = Eq_Prim_Op then - Param := First_Actual (Call_Node); New_Call := Make_And_Then (Loc, @@ -504,7 +567,7 @@ package body Exp_Disp is Rewrite (Call_Node, New_Call); Analyze_And_Resolve (Call_Node, Call_Typ); - end Expand_Dispatch_Call; + end Expand_Dispatching_Call; ------------- -- Fill_DT -- @@ -651,6 +714,11 @@ package body Exp_Disp is -- or -- DT_Ptr : Vtable_Ptr := Vtable_Ptr!(DT'Address); CPP case + -- According to the C++ ABI, the base of the vtable is located + -- after the following prologue: Offset_To_Top, Typeinfo_Ptr. + -- Hence, move the pointer to the base of the vtable down, after + -- this prologue. + Append_To (Result, Make_Object_Declaration (Loc, Defining_Identifier => DT_Ptr, @@ -658,9 +726,15 @@ package body Exp_Disp is Object_Definition => New_Reference_To (Generalized_Tag, Loc), Expression => Unchecked_Convert_To (Generalized_Tag, - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (DT, Loc), - Attribute_Name => Name_Address)))); + Make_Op_Add (Loc, + Left_Opnd => + Unchecked_Convert_To (RTE (RE_Storage_Offset), + Make_Attribute_Reference (Loc, + Prefix => New_Reference_To (DT, Loc), + Attribute_Name => Name_Address)), + Right_Opnd => + Make_DT_Access_Action (Typ, + DT_Prologue_Size, No_List))))); -- Generate code to define the boolean that controls registration, in -- order to avoid multiple registrations for tagged types defined in diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads index aedda2d7d01..34bcffc5c59 100644 --- a/gcc/ada/exp_disp.ads +++ b/gcc/ada/exp_disp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2001 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- -- @@ -76,7 +76,7 @@ package Exp_Disp is -- Class case check that no pragma CPP_Virtual is missing and that the -- DT_Position are coherent - procedure Expand_Dispatch_Call (Call_Node : Node_Id); + procedure Expand_Dispatching_Call (Call_Node : Node_Id); -- Expand the call to the operation through the dispatch table and perform -- the required tag checks when appropriate. For CPP types the call is -- done through the Vtable (tag checks are not relevant) diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 63c6d3cb21f..4c756b13317 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -358,7 +358,7 @@ package body Exp_Dist is -- Mapping between a RCI subprogram and the corresponding calling stubs procedure Add_Stub_Type - (Designated_Type : Entity_Id; + (Designated_Type : Entity_Id; RACW_Type : Entity_Id; Decls : List_Id; Stub_Type : out Entity_Id; @@ -551,10 +551,18 @@ package body Exp_Dist is -- class-wide type before doing the real call using any of the RACW type -- pointing on the designated type. + procedure Specific_Add_Obj_RPC_Receiver_Completion + (Loc : Source_Ptr; + Decls : List_Id; + RPC_Receiver : Entity_Id; + Stub_Elements : Stub_Structure); + -- Add the necessary code to Decls after the completion of generation + -- of the RACW RPC receiver described by Stub_Elements. + procedure Specific_Add_Receiving_Stubs_To_Declarations (Pkg_Spec : Node_Id; Decls : List_Id); - -- Add receiving stubs to the declarative part + -- Add receiving stubs to the declarative part of an RCI unit package GARLIC_Support is @@ -611,6 +619,12 @@ package body Exp_Dist is RACW_Type : Entity_Id := Empty; Parent_Primitive : Entity_Id := Empty) return Node_Id; + procedure Add_Obj_RPC_Receiver_Completion + (Loc : Source_Ptr; + Decls : List_Id; + RPC_Receiver : Entity_Id; + Stub_Elements : Stub_Structure); + procedure Add_Receiving_Stubs_To_Declarations (Pkg_Spec : Node_Id; Decls : List_Id); @@ -680,6 +694,12 @@ package body Exp_Dist is RACW_Type : Entity_Id := Empty; Parent_Primitive : Entity_Id := Empty) return Node_Id; + procedure Add_Obj_RPC_Receiver_Completion + (Loc : Source_Ptr; + Decls : List_Id; + RPC_Receiver : Entity_Id; + Stub_Elements : Stub_Structure); + procedure Add_Receiving_Stubs_To_Declarations (Pkg_Spec : Node_Id; Decls : List_Id); @@ -1108,6 +1128,7 @@ package body Exp_Dist is RPC_Receiver : Entity_Id; RPC_Receiver_Statements : List_Id; RPC_Receiver_Case_Alternatives : constant List_Id := New_List; + RPC_Receiver_Elsif_Parts : List_Id; RPC_Receiver_Request : Entity_Id; RPC_Receiver_Subp_Id : Entity_Id; RPC_Receiver_Subp_Index : Entity_Id; @@ -1145,6 +1166,20 @@ package body Exp_Dist is Subp_Index => RPC_Receiver_Subp_Index, Stmts => RPC_Receiver_Statements, Decl => RPC_Receiver_Decl); + + if Get_PCS_Name = Name_PolyORB_DSA then + + -- For the case of PolyORB, we need to map a textual operation + -- name into a primitive index. Currently we do so using a + -- simple sequence of string comparisons. + + RPC_Receiver_Elsif_Parts := New_List; + Append_To (RPC_Receiver_Statements, + Make_Implicit_If_Statement (Designated_Type, + Condition => New_Occurrence_Of (Standard_False, Loc), + Then_Statements => New_List, + Elsif_Parts => RPC_Receiver_Elsif_Parts)); + end if; end if; -- Build callers, receivers for every primitive operations and a RPC @@ -1238,6 +1273,26 @@ package body Exp_Dist is -- Add a case alternative to the receiver + if Get_PCS_Name = Name_PolyORB_DSA then + Append_To (RPC_Receiver_Elsif_Parts, + Make_Elsif_Part (Loc, + Condition => + Make_Function_Call (Loc, + Name => + New_Occurrence_Of ( + RTE (RE_Caseless_String_Eq), Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (RPC_Receiver_Subp_Id, Loc), + Make_String_Literal (Loc, Subp_Str))), + Then_Statements => New_List ( + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of ( + RPC_Receiver_Subp_Index, Loc), + Expression => + Make_Integer_Literal (Loc, + Current_Primitive_Number))))); + end if; + Append_To (RPC_Receiver_Case_Alternatives, Make_Case_Statement_Alternative (Loc, Discrete_Choices => New_List ( @@ -1275,21 +1330,8 @@ package body Exp_Dist is Alternatives => RPC_Receiver_Case_Alternatives)); Append_To (Decls, RPC_Receiver_Decl); - - -- The RPC receiver body should not be the completion of the - -- declaration recorded in the stub structure, because then the - -- occurrences of the formal parameters within the body should - -- refer to the entities from the declaration, not from the - -- completion, to which we do not have easy access. Instead, the - -- RPC receiver body acts as its own declaration, and the RPC - -- receiver declaration is completed by a renaming-as-body. - - Append_To (Decls, - Make_Subprogram_Renaming_Declaration (Loc, - Specification => - Copy_Specification (Loc, - Specification (Stub_Elements.RPC_Receiver_Decl)), - Name => New_Occurrence_Of (RPC_Receiver, Loc))); + Specific_Add_Obj_RPC_Receiver_Completion (Loc, + Decls, RPC_Receiver, Stub_Elements); end if; -- Do not analyze RPC receiver at this stage since it will otherwise @@ -2170,7 +2212,12 @@ package body Exp_Dist is E : Entity_Id) return Node_Id is begin - return Make_Integer_Literal (Loc, Get_Subprogram_Id (E)); + case Get_PCS_Name is + when Name_PolyORB_DSA => + return Make_String_Literal (Loc, Get_Subprogram_Id (E)); + when others => + return Make_Integer_Literal (Loc, Get_Subprogram_Id (E)); + end case; end Build_Subprogram_Id; ------------------------ @@ -2442,7 +2489,12 @@ package body Exp_Dist is begin if Nkind (Unit_Node) = N_Package_Declaration then Spec := Specification (Unit_Node); - Decls := Visible_Declarations (Spec); + Decls := Private_Declarations (Spec); + + if No (Decls) then + Decls := Visible_Declarations (Spec); + end if; + New_Scope (Scope_Of_Spec (Spec)); Specific_Add_Receiving_Stubs_To_Declarations (Spec, Decls); @@ -2497,6 +2549,32 @@ package body Exp_Dist is procedure Add_RAS_Access_TSS (N : Node_Id); -- Add a subprogram body for RAS Access TSS + ------------------------------------- + -- Add_Obj_RPC_Receiver_Completion -- + ------------------------------------- + + procedure Add_Obj_RPC_Receiver_Completion + (Loc : Source_Ptr; + Decls : List_Id; + RPC_Receiver : Entity_Id; + Stub_Elements : Stub_Structure) is + begin + -- The RPC receiver body should not be the completion of the + -- declaration recorded in the stub structure, because then the + -- occurrences of the formal parameters within the body should + -- refer to the entities from the declaration, not from the + -- completion, to which we do not have easy access. Instead, the + -- RPC receiver body acts as its own declaration, and the RPC + -- receiver declaration is completed by a renaming-as-body. + + Append_To (Decls, + Make_Subprogram_Renaming_Declaration (Loc, + Specification => + Copy_Specification (Loc, + Specification (Stub_Elements.RPC_Receiver_Decl)), + Name => New_Occurrence_Of (RPC_Receiver, Loc))); + end Add_Obj_RPC_Receiver_Completion; + ----------------------- -- Add_RACW_Features -- ----------------------- @@ -5051,6 +5129,52 @@ package body Exp_Dist is procedure Add_RAS_Access_TSS (N : Node_Id); -- Add a subprogram body for RAS Access TSS + ------------------------------------- + -- Add_Obj_RPC_Receiver_Completion -- + ------------------------------------- + + procedure Add_Obj_RPC_Receiver_Completion + (Loc : Source_Ptr; + Decls : List_Id; + RPC_Receiver : Entity_Id; + Stub_Elements : Stub_Structure) + is + Desig : constant Entity_Id := + Etype (Designated_Type (Stub_Elements.RACW_Type)); + begin + Append_To (Decls, + Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of ( + RTE (RE_Register_Obj_Receiving_Stub), Loc), + + Parameter_Associations => New_List ( + + -- Name + + Make_String_Literal (Loc, + Full_Qualified_Name (Desig)), + + -- Handler + + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of ( + Defining_Unit_Name (Parent (RPC_Receiver)), Loc), + Attribute_Name => + Name_Access), + + -- Receiver + + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of ( + Defining_Identifier ( + Stub_Elements.RPC_Receiver_Decl), Loc), + Attribute_Name => + Name_Access)))); + end Add_Obj_RPC_Receiver_Completion; + ----------------------- -- Add_RACW_Features -- ----------------------- @@ -8137,6 +8261,9 @@ package body Exp_Dist is elsif U_Type = Standard_Wide_Character then Lib_RE := RE_FA_WC; + elsif U_Type = Standard_Wide_Wide_Character then + Lib_RE := RE_FA_WWC; + -- Floating point types elsif U_Type = Standard_Short_Float then @@ -8915,6 +9042,9 @@ package body Exp_Dist is elsif U_Type = Standard_Wide_Character then Lib_RE := RE_TA_WC; + elsif U_Type = Standard_Wide_Wide_Character then + Lib_RE := RE_TA_WWC; + -- Floating point types elsif U_Type = Standard_Short_Float then @@ -9619,6 +9749,9 @@ package body Exp_Dist is elsif U_Type = Standard_Wide_Character then Lib_RE := RE_TC_WC; + elsif U_Type = Standard_Wide_Wide_Character then + Lib_RE := RE_TC_WWC; + -- Floating point types elsif U_Type = Standard_Short_Float then @@ -10664,6 +10797,26 @@ package body Exp_Dist is Set_TSS (Typ, Snam); end Set_Renaming_TSS; + ---------------------------------------------- + -- Specific_Add_Obj_RPC_Receiver_Completion -- + ---------------------------------------------- + + procedure Specific_Add_Obj_RPC_Receiver_Completion + (Loc : Source_Ptr; + Decls : List_Id; + RPC_Receiver : Entity_Id; + Stub_Elements : Stub_Structure) is + begin + case Get_PCS_Name is + when Name_PolyORB_DSA => + PolyORB_Support.Add_Obj_RPC_Receiver_Completion (Loc, + Decls, RPC_Receiver, Stub_Elements); + when others => + GARLIC_Support.Add_Obj_RPC_Receiver_Completion (Loc, + Decls, RPC_Receiver, Stub_Elements); + end case; + end Specific_Add_Obj_RPC_Receiver_Completion; + -------------------------------- -- Specific_Add_RACW_Features -- -------------------------------- @@ -10674,8 +10827,7 @@ package body Exp_Dist is Stub_Type : Entity_Id; Stub_Type_Access : Entity_Id; RPC_Receiver_Decl : Node_Id; - Declarations : List_Id) - is + Declarations : List_Id) is begin case Get_PCS_Name is when Name_PolyORB_DSA => diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 5989cbc3b5c..65bcc3d3821 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -194,6 +194,11 @@ package body Exp_Imgv is -- tv = Wide_Character (Expr) -- pm = Wide_Character_Encoding_Method + -- For types whose root type is Wide_Wide_Character + -- xx = Wide_Wide_haracter + -- tv = Wide_Wide_Character (Expr) + -- pm = Wide_Character_Encoding_Method + -- For floating-point types -- xx = Floating_Point -- tv = Long_Long_Float (Expr) @@ -254,6 +259,10 @@ package body Exp_Imgv is Imid := RE_Image_Wide_Character; Tent := Rtyp; + elsif Rtyp = Standard_Wide_Wide_Character then + Imid := RE_Image_Wide_Wide_Character; + Tent := Rtyp; + elsif Is_Signed_Integer_Type (Rtyp) then if Esize (Rtyp) <= Esize (Standard_Integer) then Imid := RE_Image_Integer; @@ -382,9 +391,11 @@ package body Exp_Imgv is Prefix => New_Reference_To (Ptyp, Loc), Attribute_Name => Name_Aft)); - -- For wide character, append encoding method + -- For wide [wide] character, append encoding method - elsif Rtyp = Standard_Wide_Character then + elsif Rtyp = Standard_Wide_Character + or else Rtyp = Standard_Wide_Wide_Character + then Append_To (Arglist, Make_Integer_Literal (Loc, Intval => Int (Wide_Character_Encoding_Method))); @@ -445,6 +456,10 @@ package body Exp_Imgv is -- Value_Wide_Character (X, Wide_Character_Encoding_Method) + -- For types derived from Wide_Wide_Character, typ'Value (X) expands into + + -- Value_Wide_Wide_Character (X, Wide_Character_Encoding_Method) + -- For decimal types with size <= Integer'Size, typ'Value (X) -- expands into @@ -455,7 +470,7 @@ package body Exp_Imgv is -- btyp?(Value_Long_Long_Decimal (X, typ'Scale)) -- For enumeration types other than those derived from types Boolean, - -- Character, and Wide_Character in Standard, typ'Value (X) expands to: + -- Character, Wide_[Wide_]Character in Standard, typ'Value (X) expands to: -- Enum'Val (Value_Enumeration_NN (typS, typI'Address, Num, X)) @@ -493,6 +508,12 @@ package body Exp_Imgv is Make_Integer_Literal (Loc, Intval => Int (Wide_Character_Encoding_Method))); + elsif Rtyp = Standard_Wide_Wide_Character then + Vid := RE_Value_Wide_Wide_Character; + Append_To (Args, + Make_Integer_Literal (Loc, + Intval => Int (Wide_Character_Encoding_Method))); + elsif Rtyp = Base_Type (Standard_Short_Short_Integer) or else Rtyp = Base_Type (Standard_Short_Integer) or else Rtyp = Base_Type (Standard_Integer) @@ -624,20 +645,28 @@ package body Exp_Imgv is -- Expand_Width_Attribute -- ---------------------------- - -- The processing here also handles the case of Wide_Width. With the + -- The processing here also handles the case of Wide_[Wide_]Width. With the -- exceptions noted, the processing is identical -- For scalar types derived from Boolean, character and integer types -- in package Standard. Note that the Width attribute is computed at -- compile time for all cases except those involving non-static sub- - -- types. For such subtypes, typ'Width and typ'Wide_Width expands into: + -- types. For such subtypes, typ'[Wide_[Wide_]]Width expands into: -- Result_Type (xx (yy (Ptyp'First), yy (Ptyp'Last))) -- where -- For types whose root type is Character - -- xx = Width_Character (Wide_Width_Character for Wide_Width case) + -- xx = Width_Character + -- yy = Character + + -- For types whose root type is Wide_Character + -- xx = Wide_Width_Character + -- yy = Character + + -- For types whose root type is Wide_Wide_Character + -- xx = Wide_Wide_Width_Character -- yy = Character -- For types whose root type is Boolean @@ -664,8 +693,37 @@ package body Exp_Imgv is -- Result_Type (Wide_Width_Wide_Character ( -- Wide_Character (typ'First), -- Wide_Character (typ'Last)); + -- Wide_Character_Encoding_Method); + + -- and typ'Wide_Wide_Width expands into + + -- Result_Type (Wide_Wide_Width_Wide_Character ( + -- Wide_Character (typ'First), + -- Wide_Character (typ'Last)); + -- Wide_Character_Encoding_Method); + + -- For types derived from Wide_Wide_Character, typ'Width expands into + + -- Result_Type (Width_Wide_Wide_Character ( + -- Wide_Wide_Character (typ'First), + -- Wide_Wide_Character (typ'Last), + -- Wide_Character_Encoding_Method); + + -- and typ'Wide_Width expands into: + + -- Result_Type (Wide_Width_Wide_Wide_Character ( + -- Wide_Wide_Character (typ'First), + -- Wide_Wide_Character (typ'Last)); + -- Wide_Character_Encoding_Method); - -- For real types, typ'Width and typ'Wide_Width expand into + -- and typ'Wide_Wide_Width expands into + + -- Result_Type (Wide_Wide_Width_Wide_Wide_Char ( + -- Wide_Wide_Character (typ'First), + -- Wide_Wide_Character (typ'Last)); + -- Wide_Character_Encoding_Method); + + -- For real types, typ'Width and typ'Wide_[Wide_]Width expand into -- if Ptyp'First > Ptyp'Last then 0 else btyp'Width end if @@ -690,11 +748,20 @@ package body Exp_Imgv is -- typ'Pos (Typ'Last)) -- Wide_Character_Encoding_Method); + -- and typ'Wide_Wide_Width expands into: + + -- Result_Type (Wide_Wide_Width_Enumeration_NN + -- (typS, + -- typI, + -- typ'Pos (typ'First), + -- typ'Pos (Typ'Last)) + -- Wide_Character_Encoding_Method); + -- where typS and typI are the enumeration image strings and -- indexes table, as described in Build_Enumeration_Image_Tables. -- NN is 8/16/32 for depending on the element type for typI. - procedure Expand_Width_Attribute (N : Node_Id; Wide : Boolean) is + procedure Expand_Width_Attribute (N : Node_Id; Attr : Atype := Normal) is Loc : constant Source_Ptr := Sloc (N); Typ : constant Entity_Id := Etype (N); Pref : constant Node_Id := Prefix (N); @@ -715,22 +782,33 @@ package body Exp_Imgv is -- Types derived from Standard.Character elsif Rtyp = Standard_Character then - if not Wide then - XX := RE_Width_Character; - else - XX := RE_Wide_Width_Character; - end if; + case Attr is + when Normal => XX := RE_Width_Character; + when Wide => XX := RE_Wide_Width_Character; + when Wide_Wide => XX := RE_Wide_Wide_Width_Character; + end case; YY := Rtyp; -- Types derived from Standard.Wide_Character elsif Rtyp = Standard_Wide_Character then - if not Wide then - XX := RE_Width_Wide_Character; - else - XX := RE_Wide_Width_Wide_Character; - end if; + case Attr is + when Normal => XX := RE_Width_Wide_Character; + when Wide => XX := RE_Wide_Width_Wide_Character; + when Wide_Wide => XX := RE_Wide_Wide_Width_Wide_Character; + end case; + + YY := Rtyp; + + -- Types derived from Standard.Wide_Wide_Character + + elsif Rtyp = Standard_Wide_Wide_Character then + case Attr is + when Normal => XX := RE_Width_Wide_Wide_Character; + when Wide => XX := RE_Wide_Width_Wide_Wide_Character; + when Wide_Wide => XX := RE_Wide_Wide_Width_Wide_Wide_Char; + end case; YY := Rtyp; @@ -781,24 +859,34 @@ package body Exp_Imgv is Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp))); - if not Wide then - if Ttyp = Standard_Integer_8 then - XX := RE_Width_Enumeration_8; - elsif Ttyp = Standard_Integer_16 then - XX := RE_Width_Enumeration_16; - else - XX := RE_Width_Enumeration_32; - end if; - - else - if Ttyp = Standard_Integer_8 then - XX := RE_Wide_Width_Enumeration_8; - elsif Ttyp = Standard_Integer_16 then - XX := RE_Wide_Width_Enumeration_16; - else - XX := RE_Wide_Width_Enumeration_32; - end if; - end if; + case Attr is + when Normal => + if Ttyp = Standard_Integer_8 then + XX := RE_Width_Enumeration_8; + elsif Ttyp = Standard_Integer_16 then + XX := RE_Width_Enumeration_16; + else + XX := RE_Width_Enumeration_32; + end if; + + when Wide => + if Ttyp = Standard_Integer_8 then + XX := RE_Wide_Width_Enumeration_8; + elsif Ttyp = Standard_Integer_16 then + XX := RE_Wide_Width_Enumeration_16; + else + XX := RE_Wide_Width_Enumeration_32; + end if; + + when Wide_Wide => + if Ttyp = Standard_Integer_8 then + XX := RE_Wide_Wide_Width_Enumeration_8; + elsif Ttyp = Standard_Integer_16 then + XX := RE_Wide_Wide_Width_Enumeration_16; + else + XX := RE_Wide_Wide_Width_Enumeration_32; + end if; + end case; Arglist := New_List ( @@ -826,9 +914,9 @@ package body Exp_Imgv is Prefix => New_Reference_To (Ptyp, Loc), Attribute_Name => Name_Last)))); - -- For enumeration'Wide_Width, add encoding method parameter + -- For enumeration'Wide_[Wide_]Width, add encoding method parameter - if Wide then + if Attr /= Normal then Append_To (Arglist, Make_Integer_Literal (Loc, Intval => Int (Wide_Character_Encoding_Method))); @@ -857,9 +945,12 @@ package body Exp_Imgv is Prefix => New_Reference_To (Ptyp, Loc), Attribute_Name => Name_Last))); - -- For Wide_Character'Width, add encoding method parameter + -- For Wide_[Wide_]Character'Width, add encoding method parameter - if Rtyp = Standard_Wide_Character and then Wide then + if (Rtyp = Standard_Wide_Character + or else + Rtyp = Standard_Wide_Wide_Character) + and then Attr /= Normal then Append_To (Arglist, Make_Integer_Literal (Loc, Intval => Int (Wide_Character_Encoding_Method))); diff --git a/gcc/ada/exp_imgv.ads b/gcc/ada/exp_imgv.ads index 7df2692a76f..5f601dd7fe8 100644 --- a/gcc/ada/exp_imgv.ads +++ b/gcc/ada/exp_imgv.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-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- -- @@ -78,8 +78,12 @@ package Exp_Imgv is -- This procedure is called from Exp_Attr to expand an occurrence -- of the attribute Value. - procedure Expand_Width_Attribute (N : Node_Id; Wide : Boolean); - -- This procedure is called from Exp_Attr to expand an occurrence of - -- the attributes Width (Wide = False) or Wide_Width (Wide = True). + type Atype is (Normal, Wide, Wide_Wide); + -- Type of attribute in call to Expand_Width_Attribute + + procedure Expand_Width_Attribute (N : Node_Id; Attr : Atype := Normal); + -- This procedure is called from Exp_Attr to expand an occurrence of the + -- attributes Width (Attr = Normal), or Wide_Width (Attr Wide), or + -- Wide_Wide_Width (Attr = Wide_Wide). end Exp_Imgv; diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index cbaef5b5a15..27ec905f1cd 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -517,19 +517,22 @@ package body Exp_Prag is Rewrite (Expression (Lang1), Make_Character_Literal (Loc, Chars => Name_uV, - Char_Literal_Value => Get_Char_Code ('V'))); + Char_Literal_Value => + UI_From_Int (Character'Pos ('V')))); Analyze (Expression (Lang1)); Rewrite (Expression (Lang2), Make_Character_Literal (Loc, Chars => Name_uM, - Char_Literal_Value => Get_Char_Code ('M'))); + Char_Literal_Value => + UI_From_Int (Character'Pos ('M')))); Analyze (Expression (Lang2)); Rewrite (Expression (Lang3), Make_Character_Literal (Loc, Chars => Name_uS, - Char_Literal_Value => Get_Char_Code ('S'))); + Char_Literal_Value => + UI_From_Int (Character'Pos ('S')))); Analyze (Expression (Lang3)); if Exception_Code (Id) /= No_Uint then diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index 9a5129efb9d..a38ce46007a 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -24,19 +24,20 @@ -- -- ------------------------------------------------------------------------------ -with Atree; use Atree; -with Einfo; use Einfo; -with Namet; use Namet; -with Nlists; use Nlists; -with Nmake; use Nmake; -with Rtsfind; use Rtsfind; -with Sinfo; use Sinfo; -with Snames; use Snames; -with Stand; use Stand; -with Tbuild; use Tbuild; -with Ttypes; use Ttypes; -with Exp_Tss; use Exp_Tss; -with Uintp; use Uintp; +with Atree; use Atree; +with Einfo; use Einfo; +with Namet; use Namet; +with Nlists; use Nlists; +with Nmake; use Nmake; +with Rtsfind; use Rtsfind; +with Sem_Util; use Sem_Util; +with Sinfo; use Sinfo; +with Snames; use Snames; +with Stand; use Stand; +with Tbuild; use Tbuild; +with Ttypes; use Ttypes; +with Exp_Tss; use Exp_Tss; +with Uintp; use Uintp; package body Exp_Strm is @@ -446,13 +447,22 @@ package body Exp_Strm is U_Type : constant Entity_Id := Underlying_Type (P_Type); Rt_Type : constant Entity_Id := Root_Type (U_Type); FST : constant Entity_Id := First_Subtype (U_Type); - P_Size : constant Uint := Esize (FST); - Res : Node_Id; Strm : constant Node_Id := First (Expressions (N)); Targ : constant Node_Id := Next (Strm); + P_Size : Uint; + Res : Node_Id; Lib_RE : RE_Id; begin + -- Compute the size of the stream element. This is either the size of + -- the first subtype or if given the size of the Stream_Size attribute. + + if Is_Elementary_Type (FST) and then Has_Stream_Size_Clause (FST) then + P_Size := Static_Integer (Expression (Stream_Size_Clause (FST))); + else + P_Size := Esize (FST); + end if; + -- Check first for Boolean and Character. These are enumeration types, -- but we treat them specially, since they may require special handling -- in the transfer protocol. However, this special handling only applies @@ -474,20 +484,24 @@ package body Exp_Strm is then Lib_RE := RE_I_WC; + elsif Rt_Type = Standard_Wide_Wide_Character + and then Has_Stream_Standard_Rep (U_Type) + then + Lib_RE := RE_I_WWC; + -- Floating point types elsif Is_Floating_Point_Type (U_Type) then - - if Rt_Type = Standard_Short_Float then + if P_Size <= Standard_Short_Float_Size then Lib_RE := RE_I_SF; - elsif Rt_Type = Standard_Float then + elsif P_Size <= Standard_Float_Size then Lib_RE := RE_I_F; - elsif Rt_Type = Standard_Long_Float then + elsif P_Size <= Standard_Long_Float_Size then Lib_RE := RE_I_LF; - else pragma Assert (Rt_Type = Standard_Long_Long_Float); + else Lib_RE := RE_I_LLF; end if; @@ -615,13 +629,22 @@ package body Exp_Strm is U_Type : constant Entity_Id := Underlying_Type (P_Type); Rt_Type : constant Entity_Id := Root_Type (U_Type); FST : constant Entity_Id := First_Subtype (U_Type); - P_Size : constant Uint := Esize (FST); Strm : constant Node_Id := First (Expressions (N)); Item : constant Node_Id := Next (Strm); + P_Size : Uint; Lib_RE : RE_Id; Libent : Entity_Id; begin + -- Compute the size of the stream element. This is either the size of + -- the first subtype or if given the size of the Stream_Size attribute. + + if Is_Elementary_Type (FST) and then Has_Stream_Size_Clause (FST) then + P_Size := Static_Integer (Expression (Stream_Size_Clause (FST))); + else + P_Size := Esize (FST); + end if; + -- Find the routine to be called -- Check for First Boolean and Character. These are enumeration types, @@ -645,20 +668,21 @@ package body Exp_Strm is then Lib_RE := RE_W_WC; + elsif Rt_Type = Standard_Wide_Wide_Character + and then Has_Stream_Standard_Rep (U_Type) + then + Lib_RE := RE_W_WWC; + -- Floating point types elsif Is_Floating_Point_Type (U_Type) then - - if Rt_Type = Standard_Short_Float then + if P_Size <= Standard_Short_Float_Size then Lib_RE := RE_W_SF; - - elsif Rt_Type = Standard_Float then + elsif P_Size <= Standard_Float_Size then Lib_RE := RE_W_F; - - elsif Rt_Type = Standard_Long_Float then + elsif P_Size <= Standard_Long_Float_Size then Lib_RE := RE_W_LF; - - else pragma Assert (Rt_Type = Standard_Long_Long_Float); + else Lib_RE := RE_W_LLF; end if; @@ -695,16 +719,12 @@ package body Exp_Strm is then if P_Size <= Standard_Short_Short_Integer_Size then Lib_RE := RE_W_SSI; - elsif P_Size <= Standard_Short_Integer_Size then Lib_RE := RE_W_SI; - elsif P_Size <= Standard_Integer_Size then Lib_RE := RE_W_I; - elsif P_Size <= Standard_Long_Integer_Size then Lib_RE := RE_W_LI; - else Lib_RE := RE_W_LLI; end if; @@ -723,16 +743,12 @@ package body Exp_Strm is then if P_Size <= Standard_Short_Short_Integer_Size then Lib_RE := RE_W_SSU; - elsif P_Size <= Standard_Short_Integer_Size then Lib_RE := RE_W_SU; - elsif P_Size <= Standard_Integer_Size then Lib_RE := RE_W_U; - elsif P_Size <= Standard_Long_Integer_Size then Lib_RE := RE_W_LU; - else Lib_RE := RE_W_LLU; end if; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 25522c4b509..162b939f125 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -489,7 +489,7 @@ package body Exp_Util is Make_Character_Literal (Loc, Chars => Name_Find, Char_Literal_Value => - Char_Code (Character'Pos ('('))))); + UI_From_Int (Character'Pos ('('))))); Append_To (Stats, Make_Assignment_Statement (Loc, @@ -548,7 +548,7 @@ package body Exp_Util is Make_Character_Literal (Loc, Chars => Name_Find, Char_Literal_Value => - Char_Code (Character'Pos (','))))); + UI_From_Int (Character'Pos (','))))); Append_To (Stats, Make_Assignment_Statement (Loc, @@ -571,7 +571,7 @@ package body Exp_Util is Make_Character_Literal (Loc, Chars => Name_Find, Char_Literal_Value => - Char_Code (Character'Pos (')'))))); + UI_From_Int (Character'Pos (')'))))); return Build_Task_Image_Function (Loc, Decls, Stats, Res); end Build_Task_Array_Image; @@ -870,7 +870,7 @@ package body Exp_Util is Make_Character_Literal (Loc, Chars => Name_Find, Char_Literal_Value => - Char_Code (Character'Pos ('.'))))); + UI_From_Int (Character'Pos ('.'))))); Append_To (Stats, Make_Assignment_Statement (Loc, @@ -1833,8 +1833,9 @@ package body Exp_Util is N_Entry_Body | N_Exception_Declaration | N_Exception_Renaming_Declaration | + N_Formal_Abstract_Subprogram_Declaration | + N_Formal_Concrete_Subprogram_Declaration | N_Formal_Object_Declaration | - N_Formal_Subprogram_Declaration | N_Formal_Type_Declaration | N_Full_Type_Declaration | N_Function_Instantiation | diff --git a/gcc/ada/g-utf_32.adb b/gcc/ada/g-utf_32.adb new file mode 100644 index 00000000000..5aa5b01ad71 --- /dev/null +++ b/gcc/ada/g-utf_32.adb @@ -0,0 +1,1622 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUNTIME COMPONENTS -- +-- -- +-- G N A T . U T F _ 3 2 -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 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- -- +-- ware Foundation; either version 2, 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +pragma Style_Checks (Off); +-- Allow long lines in this unit + +package body GNAT.UTF_32 is + + ---------------------- + -- Character Tables -- + ---------------------- + + -- Note these tables are derived from those given in AI-285. For details + -- see //www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs/AI-00285.TXT?rev=1.22. + + type UTF_32_Range is record + Lo : UTF_32; + Hi : UTF_32; + end record; + + type UTF_32_Ranges is array (Positive range <>) of UTF_32_Range; + + -- The following array includes all characters considered digits, i.e. + -- all characters from the Unicode table with categories: + + -- Number, Decimal Digit (Nd) + + UTF_32_Digits : constant UTF_32_Ranges := ( + (16#00030#, 16#00039#), -- DIGIT ZERO .. DIGIT NINE + (16#00660#, 16#00669#), -- ARABIC-INDIC DIGIT ZERO .. ARABIC-INDIC DIGIT NINE + (16#006F0#, 16#006F9#), -- EXTENDED ARABIC-INDIC DIGIT ZERO .. EXTENDED ARABIC-INDIC DIGIT NINE + (16#00966#, 16#0096F#), -- DEVANAGARI DIGIT ZERO .. DEVANAGARI DIGIT NINE + (16#009E6#, 16#009EF#), -- BENGALI DIGIT ZERO .. BENGALI DIGIT NINE + (16#00A66#, 16#00A6F#), -- GURMUKHI DIGIT ZERO .. GURMUKHI DIGIT NINE + (16#00AE6#, 16#00AEF#), -- GUJARATI DIGIT ZERO .. GUJARATI DIGIT NINE + (16#00B66#, 16#00B6F#), -- ORIYA DIGIT ZERO .. ORIYA DIGIT NINE + (16#00BE7#, 16#00BEF#), -- TAMIL DIGIT ONE .. TAMIL DIGIT NINE + (16#00C66#, 16#00C6F#), -- TELUGU DIGIT ZERO .. TELUGU DIGIT NINE + (16#00CE6#, 16#00CEF#), -- KANNADA DIGIT ZERO .. KANNADA DIGIT NINE + (16#00D66#, 16#00D6F#), -- MALAYALAM DIGIT ZERO .. MALAYALAM DIGIT NINE + (16#00E50#, 16#00E59#), -- THAI DIGIT ZERO .. THAI DIGIT NINE + (16#00ED0#, 16#00ED9#), -- LAO DIGIT ZERO .. LAO DIGIT NINE + (16#00F20#, 16#00F29#), -- TIBETAN DIGIT ZERO .. TIBETAN DIGIT NINE + (16#01040#, 16#01049#), -- MYANMAR DIGIT ZERO .. MYANMAR DIGIT NINE + (16#01369#, 16#01371#), -- ETHIOPIC DIGIT ONE .. ETHIOPIC DIGIT NINE + (16#017E0#, 16#017E9#), -- KHMER DIGIT ZERO .. KHMER DIGIT NINE + (16#01810#, 16#01819#), -- MONGOLIAN DIGIT ZERO .. MONGOLIAN DIGIT NINE + (16#01946#, 16#0194F#), -- LIMBU DIGIT ZERO .. LIMBU DIGIT NINE + (16#0FF10#, 16#0FF19#), -- FULLWIDTH DIGIT ZERO .. FULLWIDTH DIGIT NINE + (16#104A0#, 16#104A9#), -- OSMANYA DIGIT ZERO .. OSMANYA DIGIT NINE + (16#1D7CE#, 16#1D7FF#)); -- MATHEMATICAL BOLD DIGIT ZERO .. MATHEMATICAL MONOSPACE DIGIT NINE + + -- The following table includes all characters considered letters, i.e. + -- all characters from the Unicode table with categories: + + -- Letter, Uppercase (Lu) + -- Letter, Lowercase (Ll) + -- Letter, Titlecase (Lt) + -- Letter, Modifier (Lm) + -- Letter, Other (Lo) + -- Number, Letter (Nl) + + UTF_32_Letters : constant UTF_32_Ranges := ( + (16#00041#, 16#0005A#), -- LATIN CAPITAL LETTER A .. LATIN CAPITAL LETTER Z + (16#00061#, 16#0007A#), -- LATIN SMALL LETTER A .. LATIN SMALL LETTER Z + (16#000AA#, 16#000AA#), -- FEMININE ORDINAL INDICATOR .. FEMININE ORDINAL INDICATOR + (16#000B5#, 16#000B5#), -- MICRO SIGN .. MICRO SIGN + (16#000BA#, 16#000BA#), -- MASCULINE ORDINAL INDICATOR .. MASCULINE ORDINAL INDICATOR + (16#000C0#, 16#000D6#), -- LATIN CAPITAL LETTER A WITH GRAVE .. LATIN CAPITAL LETTER O WITH DIAERESIS + (16#000D8#, 16#000F6#), -- LATIN CAPITAL LETTER O WITH STROKE .. LATIN SMALL LETTER O WITH DIAERESIS + (16#000F8#, 16#00236#), -- LATIN SMALL LETTER O WITH STROKE .. LATIN SMALL LETTER T WITH CURL + (16#00250#, 16#002C1#), -- LATIN SMALL LETTER TURNED A .. MODIFIER LETTER REVERSED GLOTTAL STOP + (16#002C6#, 16#002D1#), -- MODIFIER LETTER CIRCUMFLEX ACCENT .. MODIFIER LETTER HALF TRIANGULAR COLON + (16#002E0#, 16#002E4#), -- MODIFIER LETTER SMALL GAMMA .. MODIFIER LETTER SMALL REVERSED GLOTTAL STOP + (16#002EE#, 16#002EE#), -- MODIFIER LETTER DOUBLE APOSTROPHE .. MODIFIER LETTER DOUBLE APOSTROPHE + (16#0037A#, 16#0037A#), -- GREEK YPOGEGRAMMENI .. GREEK YPOGEGRAMMENI + (16#00386#, 16#00386#), -- GREEK CAPITAL LETTER ALPHA WITH TONOS .. GREEK CAPITAL LETTER ALPHA WITH TONOS + (16#00388#, 16#0038A#), -- GREEK CAPITAL LETTER EPSILON WITH TONOS .. GREEK CAPITAL LETTER IOTA WITH TONOS + (16#0038C#, 16#0038C#), -- GREEK CAPITAL LETTER OMICRON WITH TONOS .. GREEK CAPITAL LETTER OMICRON WITH TONOS + (16#0038E#, 16#003A1#), -- GREEK CAPITAL LETTER UPSILON WITH TONOS .. GREEK CAPITAL LETTER RHO + (16#003A3#, 16#003CE#), -- GREEK CAPITAL LETTER SIGMA .. GREEK SMALL LETTER OMEGA WITH TONOS + (16#003D0#, 16#003F5#), -- GREEK BETA SYMBOL .. GREEK LUNATE EPSILON SYMBOL + (16#003F7#, 16#003FB#), -- GREEK CAPITAL LETTER SHO .. GREEK SMALL LETTER SAN + (16#00400#, 16#00481#), -- CYRILLIC CAPITAL LETTER IE WITH GRAVE .. CYRILLIC SMALL LETTER KOPPA + (16#0048A#, 16#004CE#), -- CYRILLIC CAPITAL LETTER SHORT I WITH TAIL .. CYRILLIC SMALL LETTER EM WITH TAIL + (16#004D0#, 16#004F5#), -- CYRILLIC CAPITAL LETTER A WITH BREVE .. CYRILLIC SMALL LETTER CHE WITH DIAERESIS + (16#004F8#, 16#004F9#), -- CYRILLIC CAPITAL LETTER YERU WITH DIAERESIS .. CYRILLIC SMALL LETTER YERU WITH DIAERESIS + (16#00500#, 16#0050F#), -- CYRILLIC CAPITAL LETTER KOMI DE .. CYRILLIC SMALL LETTER KOMI TJE + (16#00531#, 16#00556#), -- ARMENIAN CAPITAL LETTER AYB .. ARMENIAN CAPITAL LETTER FEH + (16#00559#, 16#00559#), -- ARMENIAN MODIFIER LETTER LEFT HALF RING .. ARMENIAN MODIFIER LETTER LEFT HALF RING + (16#00561#, 16#00587#), -- ARMENIAN SMALL LETTER AYB .. ARMENIAN SMALL LIGATURE ECH YIWN + (16#005D0#, 16#005EA#), -- HEBREW LETTER ALEF .. HEBREW LETTER TAV + (16#005F0#, 16#005F2#), -- HEBREW LIGATURE YIDDISH DOUBLE VAV .. HEBREW LIGATURE YIDDISH DOUBLE YOD + (16#00621#, 16#0063A#), -- ARABIC LETTER HAMZA .. ARABIC LETTER GHAIN + (16#00640#, 16#0064A#), -- ARABIC TATWEEL .. ARABIC LETTER YEH + (16#0066E#, 16#0066F#), -- ARABIC LETTER DOTLESS BEH .. ARABIC LETTER DOTLESS QAF + (16#00671#, 16#006D3#), -- ARABIC LETTER ALEF WASLA .. ARABIC LETTER YEH BARREE WITH HAMZA ABOVE + (16#006D5#, 16#006D5#), -- ARABIC LETTER AE .. ARABIC LETTER AE + (16#006E5#, 16#006E6#), -- ARABIC SMALL WAW .. ARABIC SMALL YEH + (16#006EE#, 16#006EF#), -- ARABIC LETTER DAL WITH INVERTED V .. ARABIC LETTER REH WITH INVERTED V + (16#006FA#, 16#006FC#), -- ARABIC LETTER SHEEN WITH DOT BELOW .. ARABIC LETTER GHAIN WITH DOT BELOW + (16#006FF#, 16#006FF#), -- ARABIC LETTER HEH WITH INVERTED V .. ARABIC LETTER HEH WITH INVERTED V + (16#00710#, 16#00710#), -- SYRIAC LETTER ALAPH .. SYRIAC LETTER ALAPH + (16#00712#, 16#0072F#), -- SYRIAC LETTER BETH .. SYRIAC LETTER PERSIAN DHALATH + (16#0074D#, 16#0074F#), -- SYRIAC LETTER SOGDIAN ZHAIN .. SYRIAC LETTER SOGDIAN FE + (16#00780#, 16#007A5#), -- THAANA LETTER HAA .. THAANA LETTER WAAVU + (16#007B1#, 16#007B1#), -- THAANA LETTER NAA .. THAANA LETTER NAA + (16#00904#, 16#00939#), -- DEVANAGARI LETTER SHORT A .. DEVANAGARI LETTER HA + (16#0093D#, 16#0093D#), -- DEVANAGARI SIGN AVAGRAHA .. DEVANAGARI SIGN AVAGRAHA + (16#00950#, 16#00950#), -- DEVANAGARI OM .. DEVANAGARI OM + (16#00958#, 16#00961#), -- DEVANAGARI LETTER QA .. DEVANAGARI LETTER VOCALIC LL + (16#00985#, 16#0098C#), -- BENGALI LETTER A .. BENGALI LETTER VOCALIC L + (16#0098F#, 16#00990#), -- BENGALI LETTER E .. BENGALI LETTER AI + (16#00993#, 16#009A8#), -- BENGALI LETTER O .. BENGALI LETTER NA + (16#009AA#, 16#009B0#), -- BENGALI LETTER PA .. BENGALI LETTER RA + (16#009B2#, 16#009B2#), -- BENGALI LETTER LA .. BENGALI LETTER LA + (16#009B6#, 16#009B9#), -- BENGALI LETTER SHA .. BENGALI LETTER HA + (16#009BD#, 16#009BD#), -- BENGALI SIGN AVAGRAHA .. BENGALI SIGN AVAGRAHA + (16#009DC#, 16#009DD#), -- BENGALI LETTER RRA .. BENGALI LETTER RHA + (16#009DF#, 16#009E1#), -- BENGALI LETTER YYA .. BENGALI LETTER VOCALIC LL + (16#009F0#, 16#009F1#), -- BENGALI LETTER RA WITH MIDDLE DIAGONAL .. BENGALI LETTER RA WITH LOWER DIAGONAL + (16#00A05#, 16#00A0A#), -- GURMUKHI LETTER A .. GURMUKHI LETTER UU + (16#00A0F#, 16#00A10#), -- GURMUKHI LETTER EE .. GURMUKHI LETTER AI + (16#00A13#, 16#00A28#), -- GURMUKHI LETTER OO .. GURMUKHI LETTER NA + (16#00A2A#, 16#00A30#), -- GURMUKHI LETTER PA .. GURMUKHI LETTER RA + (16#00A32#, 16#00A33#), -- GURMUKHI LETTER LA .. GURMUKHI LETTER LLA + (16#00A35#, 16#00A36#), -- GURMUKHI LETTER VA .. GURMUKHI LETTER SHA + (16#00A38#, 16#00A39#), -- GURMUKHI LETTER SA .. GURMUKHI LETTER HA + (16#00A59#, 16#00A5C#), -- GURMUKHI LETTER KHHA .. GURMUKHI LETTER RRA + (16#00A5E#, 16#00A5E#), -- GURMUKHI LETTER FA .. GURMUKHI LETTER FA + (16#00A72#, 16#00A74#), -- GURMUKHI IRI .. GURMUKHI EK ONKAR + (16#00A85#, 16#00A8D#), -- GUJARATI LETTER A .. GUJARATI VOWEL CANDRA E + (16#00A8F#, 16#00A91#), -- GUJARATI LETTER E .. GUJARATI VOWEL CANDRA O + (16#00A93#, 16#00AA8#), -- GUJARATI LETTER O .. GUJARATI LETTER NA + (16#00AAA#, 16#00AB0#), -- GUJARATI LETTER PA .. GUJARATI LETTER RA + (16#00AB2#, 16#00AB3#), -- GUJARATI LETTER LA .. GUJARATI LETTER LLA + (16#00AB5#, 16#00AB9#), -- GUJARATI LETTER VA .. GUJARATI LETTER HA + (16#00ABD#, 16#00ABD#), -- GUJARATI SIGN AVAGRAHA .. GUJARATI SIGN AVAGRAHA + (16#00AD0#, 16#00AD0#), -- GUJARATI OM .. GUJARATI OM + (16#00AE0#, 16#00AE1#), -- GUJARATI LETTER VOCALIC RR .. GUJARATI LETTER VOCALIC LL + (16#00B05#, 16#00B0C#), -- ORIYA LETTER A .. ORIYA LETTER VOCALIC L + (16#00B0F#, 16#00B10#), -- ORIYA LETTER E .. ORIYA LETTER AI + (16#00B13#, 16#00B28#), -- ORIYA LETTER O .. ORIYA LETTER NA + (16#00B2A#, 16#00B30#), -- ORIYA LETTER PA .. ORIYA LETTER RA + (16#00B32#, 16#00B33#), -- ORIYA LETTER LA .. ORIYA LETTER LLA + (16#00B35#, 16#00B39#), -- ORIYA LETTER VA .. ORIYA LETTER HA + (16#00B3D#, 16#00B3D#), -- ORIYA SIGN AVAGRAHA .. ORIYA SIGN AVAGRAHA + (16#00B5C#, 16#00B5D#), -- ORIYA LETTER RRA .. ORIYA LETTER RHA + (16#00B5F#, 16#00B61#), -- ORIYA LETTER YYA .. ORIYA LETTER VOCALIC LL + (16#00B71#, 16#00B71#), -- ORIYA LETTER WA .. ORIYA LETTER WA + (16#00B83#, 16#00B83#), -- TAMIL SIGN VISARGA .. TAMIL SIGN VISARGA + (16#00B85#, 16#00B8A#), -- TAMIL LETTER A .. TAMIL LETTER UU + (16#00B8E#, 16#00B90#), -- TAMIL LETTER E .. TAMIL LETTER AI + (16#00B92#, 16#00B95#), -- TAMIL LETTER O .. TAMIL LETTER KA + (16#00B99#, 16#00B9A#), -- TAMIL LETTER NGA .. TAMIL LETTER CA + (16#00B9C#, 16#00B9C#), -- TAMIL LETTER JA .. TAMIL LETTER JA + (16#00B9E#, 16#00B9F#), -- TAMIL LETTER NYA .. TAMIL LETTER TTA + (16#00BA3#, 16#00BA4#), -- TAMIL LETTER NNA .. TAMIL LETTER TA + (16#00BA8#, 16#00BAA#), -- TAMIL LETTER NA .. TAMIL LETTER PA + (16#00BAE#, 16#00BB5#), -- TAMIL LETTER MA .. TAMIL LETTER VA + (16#00BB7#, 16#00BB9#), -- TAMIL LETTER SSA .. TAMIL LETTER HA + (16#00C05#, 16#00C0C#), -- TELUGU LETTER A .. TELUGU LETTER VOCALIC L + (16#00C0E#, 16#00C10#), -- TELUGU LETTER E .. TELUGU LETTER AI + (16#00C12#, 16#00C28#), -- TELUGU LETTER O .. TELUGU LETTER NA + (16#00C2A#, 16#00C33#), -- TELUGU LETTER PA .. TELUGU LETTER LLA + (16#00C35#, 16#00C39#), -- TELUGU LETTER VA .. TELUGU LETTER HA + (16#00C60#, 16#00C61#), -- TELUGU LETTER VOCALIC RR .. TELUGU LETTER VOCALIC LL + (16#00C85#, 16#00C8C#), -- KANNADA LETTER A .. KANNADA LETTER VOCALIC L + (16#00C8E#, 16#00C90#), -- KANNADA LETTER E .. KANNADA LETTER AI + (16#00C92#, 16#00CA8#), -- KANNADA LETTER O .. KANNADA LETTER NA + (16#00CAA#, 16#00CB3#), -- KANNADA LETTER PA .. KANNADA LETTER LLA + (16#00CB5#, 16#00CB9#), -- KANNADA LETTER VA .. KANNADA LETTER HA + (16#00CBD#, 16#00CBD#), -- KANNADA SIGN AVAGRAHA .. KANNADA SIGN AVAGRAHA + (16#00CDE#, 16#00CDE#), -- KANNADA LETTER FA .. KANNADA LETTER FA + (16#00CE0#, 16#00CE1#), -- KANNADA LETTER VOCALIC RR .. KANNADA LETTER VOCALIC LL + (16#00D05#, 16#00D0C#), -- MALAYALAM LETTER A .. MALAYALAM LETTER VOCALIC L + (16#00D0E#, 16#00D10#), -- MALAYALAM LETTER E .. MALAYALAM LETTER AI + (16#00D12#, 16#00D28#), -- MALAYALAM LETTER O .. MALAYALAM LETTER NA + (16#00D2A#, 16#00D39#), -- MALAYALAM LETTER PA .. MALAYALAM LETTER HA + (16#00D60#, 16#00D61#), -- MALAYALAM LETTER VOCALIC RR .. MALAYALAM LETTER VOCALIC LL + (16#00D85#, 16#00D96#), -- SINHALA LETTER AYANNA .. SINHALA LETTER AUYANNA + (16#00D9A#, 16#00DB1#), -- SINHALA LETTER ALPAPRAANA KAYANNA .. SINHALA LETTER DANTAJA NAYANNA + (16#00DB3#, 16#00DBB#), -- SINHALA LETTER SANYAKA DAYANNA .. SINHALA LETTER RAYANNA + (16#00DBD#, 16#00DBD#), -- SINHALA LETTER DANTAJA LAYANNA .. SINHALA LETTER DANTAJA LAYANNA + (16#00DC0#, 16#00DC6#), -- SINHALA LETTER VAYANNA .. SINHALA LETTER FAYANNA + (16#00E01#, 16#00E30#), -- THAI CHARACTER KO KAI .. THAI CHARACTER SARA A + (16#00E32#, 16#00E33#), -- THAI CHARACTER SARA AA .. THAI CHARACTER SARA AM + (16#00E40#, 16#00E46#), -- THAI CHARACTER SARA E .. THAI CHARACTER MAIYAMOK + (16#00E81#, 16#00E82#), -- LAO LETTER KO .. LAO LETTER KHO SUNG + (16#00E84#, 16#00E84#), -- LAO LETTER KHO TAM .. LAO LETTER KHO TAM + (16#00E87#, 16#00E88#), -- LAO LETTER NGO .. LAO LETTER CO + (16#00E8A#, 16#00E8A#), -- LAO LETTER SO TAM .. LAO LETTER SO TAM + (16#00E8D#, 16#00E8D#), -- LAO LETTER NYO .. LAO LETTER NYO + (16#00E94#, 16#00E97#), -- LAO LETTER DO .. LAO LETTER THO TAM + (16#00E99#, 16#00E9F#), -- LAO LETTER NO .. LAO LETTER FO SUNG + (16#00EA1#, 16#00EA3#), -- LAO LETTER MO .. LAO LETTER LO LING + (16#00EA5#, 16#00EA5#), -- LAO LETTER LO LOOT .. LAO LETTER LO LOOT + (16#00EA7#, 16#00EA7#), -- LAO LETTER WO .. LAO LETTER WO + (16#00EAA#, 16#00EAB#), -- LAO LETTER SO SUNG .. LAO LETTER HO SUNG + (16#00EAD#, 16#00EB0#), -- LAO LETTER O .. LAO VOWEL SIGN A + (16#00EB2#, 16#00EB3#), -- LAO VOWEL SIGN AA .. LAO VOWEL SIGN AM + (16#00EBD#, 16#00EBD#), -- LAO SEMIVOWEL SIGN NYO .. LAO SEMIVOWEL SIGN NYO + (16#00EC0#, 16#00EC4#), -- LAO VOWEL SIGN E .. LAO VOWEL SIGN AI + (16#00EC6#, 16#00EC6#), -- LAO KO LA .. LAO KO LA + (16#00EDC#, 16#00EDD#), -- LAO HO NO .. LAO HO MO + (16#00F00#, 16#00F00#), -- TIBETAN SYLLABLE OM .. TIBETAN SYLLABLE OM + (16#00F40#, 16#00F47#), -- TIBETAN LETTER KA .. TIBETAN LETTER JA + (16#00F49#, 16#00F6A#), -- TIBETAN LETTER NYA .. TIBETAN LETTER FIXED-FORM RA + (16#00F88#, 16#00F8B#), -- TIBETAN SIGN LCE TSA CAN .. TIBETAN SIGN GRU MED RGYINGS + (16#01000#, 16#01021#), -- MYANMAR LETTER KA .. MYANMAR LETTER A + (16#01023#, 16#01027#), -- MYANMAR LETTER I .. MYANMAR LETTER E + (16#01029#, 16#0102A#), -- MYANMAR LETTER O .. MYANMAR LETTER AU + (16#01050#, 16#01055#), -- MYANMAR LETTER SHA .. MYANMAR LETTER VOCALIC LL + (16#010A0#, 16#010C5#), -- GEORGIAN CAPITAL LETTER AN .. GEORGIAN CAPITAL LETTER HOE + (16#010D0#, 16#010F8#), -- GEORGIAN LETTER AN .. GEORGIAN LETTER ELIFI + (16#01100#, 16#01159#), -- HANGUL CHOSEONG KIYEOK .. HANGUL CHOSEONG YEORINHIEUH + (16#0115F#, 16#011A2#), -- HANGUL CHOSEONG FILLER .. HANGUL JUNGSEONG SSANGARAEA + (16#011A8#, 16#011F9#), -- HANGUL JONGSEONG KIYEOK .. HANGUL JONGSEONG YEORINHIEUH + (16#01200#, 16#01206#), -- ETHIOPIC SYLLABLE HA .. ETHIOPIC SYLLABLE HO + (16#01208#, 16#01246#), -- ETHIOPIC SYLLABLE LA .. ETHIOPIC SYLLABLE QO + (16#01248#, 16#01248#), -- ETHIOPIC SYLLABLE QWA .. ETHIOPIC SYLLABLE QWA + (16#0124A#, 16#0124D#), -- ETHIOPIC SYLLABLE QWI .. ETHIOPIC SYLLABLE QWE + (16#01250#, 16#01256#), -- ETHIOPIC SYLLABLE QHA .. ETHIOPIC SYLLABLE QHO + (16#01258#, 16#01258#), -- ETHIOPIC SYLLABLE QHWA .. ETHIOPIC SYLLABLE QHWA + (16#0125A#, 16#0125D#), -- ETHIOPIC SYLLABLE QHWI .. ETHIOPIC SYLLABLE QHWE + (16#01260#, 16#01286#), -- ETHIOPIC SYLLABLE BA .. ETHIOPIC SYLLABLE XO + (16#01288#, 16#01288#), -- ETHIOPIC SYLLABLE XWA .. ETHIOPIC SYLLABLE XWA + (16#0128A#, 16#0128D#), -- ETHIOPIC SYLLABLE XWI .. ETHIOPIC SYLLABLE XWE + (16#01290#, 16#012AE#), -- ETHIOPIC SYLLABLE NA .. ETHIOPIC SYLLABLE KO + (16#012B0#, 16#012B0#), -- ETHIOPIC SYLLABLE KWA .. ETHIOPIC SYLLABLE KWA + (16#012B2#, 16#012B5#), -- ETHIOPIC SYLLABLE KWI .. ETHIOPIC SYLLABLE KWE + (16#012B8#, 16#012BE#), -- ETHIOPIC SYLLABLE KXA .. ETHIOPIC SYLLABLE KXO + (16#012C0#, 16#012C0#), -- ETHIOPIC SYLLABLE KXWA .. ETHIOPIC SYLLABLE KXWA + (16#012C2#, 16#012C5#), -- ETHIOPIC SYLLABLE KXWI .. ETHIOPIC SYLLABLE KXWE + (16#012C8#, 16#012CE#), -- ETHIOPIC SYLLABLE WA .. ETHIOPIC SYLLABLE WO + (16#012D0#, 16#012D6#), -- ETHIOPIC SYLLABLE PHARYNGEAL A .. ETHIOPIC SYLLABLE PHARYNGEAL O + (16#012D8#, 16#012EE#), -- ETHIOPIC SYLLABLE ZA .. ETHIOPIC SYLLABLE YO + (16#012F0#, 16#0130E#), -- ETHIOPIC SYLLABLE DA .. ETHIOPIC SYLLABLE GO + (16#01310#, 16#01310#), -- ETHIOPIC SYLLABLE GWA .. ETHIOPIC SYLLABLE GWA + (16#01312#, 16#01315#), -- ETHIOPIC SYLLABLE GWI .. ETHIOPIC SYLLABLE GWE + (16#01318#, 16#0131E#), -- ETHIOPIC SYLLABLE GGA .. ETHIOPIC SYLLABLE GGO + (16#01320#, 16#01346#), -- ETHIOPIC SYLLABLE THA .. ETHIOPIC SYLLABLE TZO + (16#01348#, 16#0135A#), -- ETHIOPIC SYLLABLE FA .. ETHIOPIC SYLLABLE FYA + (16#013A0#, 16#013F4#), -- CHEROKEE LETTER A .. CHEROKEE LETTER YV + (16#01401#, 16#0166C#), -- CANADIAN SYLLABICS E .. CANADIAN SYLLABICS CARRIER TTSA + (16#0166F#, 16#01676#), -- CANADIAN SYLLABICS QAI .. CANADIAN SYLLABICS NNGAA + (16#01681#, 16#0169A#), -- OGHAM LETTER BEITH .. OGHAM LETTER PEITH + (16#016A0#, 16#016EA#), -- RUNIC LETTER FEHU FEOH FE F .. RUNIC LETTER X + (16#016EE#, 16#016F0#), -- RUNIC ARLAUG SYMBOL .. RUNIC BELGTHOR SYMBOL + (16#01700#, 16#0170C#), -- TAGALOG LETTER A .. TAGALOG LETTER YA + (16#0170E#, 16#01711#), -- TAGALOG LETTER LA .. TAGALOG LETTER HA + (16#01720#, 16#01731#), -- HANUNOO LETTER A .. HANUNOO LETTER HA + (16#01740#, 16#01751#), -- BUHID LETTER A .. BUHID LETTER HA + (16#01760#, 16#0176C#), -- TAGBANWA LETTER A .. TAGBANWA LETTER YA + (16#0176E#, 16#01770#), -- TAGBANWA LETTER LA .. TAGBANWA LETTER SA + (16#01780#, 16#017B3#), -- KHMER LETTER KA .. KHMER INDEPENDENT VOWEL QAU + (16#017D7#, 16#017D7#), -- KHMER SIGN LEK TOO .. KHMER SIGN LEK TOO + (16#017DC#, 16#017DC#), -- KHMER SIGN AVAKRAHASANYA .. KHMER SIGN AVAKRAHASANYA + (16#01820#, 16#01877#), -- MONGOLIAN LETTER A .. MONGOLIAN LETTER MANCHU ZHA + (16#01880#, 16#018A8#), -- MONGOLIAN LETTER ALI GALI ANUSVARA ONE .. MONGOLIAN LETTER MANCHU ALI GALI BHA + (16#01900#, 16#0191C#), -- LIMBU VOWEL-CARRIER LETTER .. LIMBU LETTER HA + (16#01950#, 16#0196D#), -- TAI LE LETTER KA .. TAI LE LETTER AI + (16#01970#, 16#01974#), -- TAI LE LETTER TONE-2 .. TAI LE LETTER TONE-6 + (16#01D00#, 16#01D6B#), -- LATIN LETTER SMALL CAPITAL A .. LATIN SMALL LETTER UE + (16#01E00#, 16#01E9B#), -- LATIN CAPITAL LETTER A WITH RING BELOW .. LATIN SMALL LETTER LONG S WITH DOT ABOVE + (16#01EA0#, 16#01EF9#), -- LATIN CAPITAL LETTER A WITH DOT BELOW .. LATIN SMALL LETTER Y WITH TILDE + (16#01F00#, 16#01F15#), -- GREEK SMALL LETTER ALPHA WITH PSILI .. GREEK SMALL LETTER EPSILON WITH DASIA AND OXIA + (16#01F18#, 16#01F1D#), -- GREEK CAPITAL LETTER EPSILON WITH PSILI .. GREEK CAPITAL LETTER EPSILON WITH DASIA AND OXIA + (16#01F20#, 16#01F45#), -- GREEK SMALL LETTER ETA WITH PSILI .. GREEK SMALL LETTER OMICRON WITH DASIA AND OXIA + (16#01F48#, 16#01F4D#), -- GREEK CAPITAL LETTER OMICRON WITH PSILI .. GREEK CAPITAL LETTER OMICRON WITH DASIA AND OXIA + (16#01F50#, 16#01F57#), -- GREEK SMALL LETTER UPSILON WITH PSILI .. GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI + (16#01F59#, 16#01F59#), -- GREEK CAPITAL LETTER UPSILON WITH DASIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA + (16#01F5B#, 16#01F5B#), -- GREEK CAPITAL LETTER UPSILON WITH DASIA AND VARIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA AND VARIA + (16#01F5D#, 16#01F5D#), -- GREEK CAPITAL LETTER UPSILON WITH DASIA AND OXIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA AND OXIA + (16#01F5F#, 16#01F7D#), -- GREEK CAPITAL LETTER UPSILON WITH DASIA AND PERISPOMENI .. GREEK SMALL LETTER OMEGA WITH OXIA + (16#01F80#, 16#01FB4#), -- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI + (16#01FB6#, 16#01FBC#), -- GREEK SMALL LETTER ALPHA WITH PERISPOMENI .. GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI + (16#01FBE#, 16#01FBE#), -- GREEK PROSGEGRAMMENI .. GREEK PROSGEGRAMMENI + (16#01FC2#, 16#01FC4#), -- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI + (16#01FC6#, 16#01FCC#), -- GREEK SMALL LETTER ETA WITH PERISPOMENI .. GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI + (16#01FD0#, 16#01FD3#), -- GREEK SMALL LETTER IOTA WITH VRACHY .. GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA + (16#01FD6#, 16#01FDB#), -- GREEK SMALL LETTER IOTA WITH PERISPOMENI .. GREEK CAPITAL LETTER IOTA WITH OXIA + (16#01FE0#, 16#01FEC#), -- GREEK SMALL LETTER UPSILON WITH VRACHY .. GREEK CAPITAL LETTER RHO WITH DASIA + (16#01FF2#, 16#01FF4#), -- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI + (16#01FF6#, 16#01FFC#), -- GREEK SMALL LETTER OMEGA WITH PERISPOMENI .. GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI + (16#02071#, 16#02071#), -- SUPERSCRIPT LATIN SMALL LETTER I .. SUPERSCRIPT LATIN SMALL LETTER I + (16#0207F#, 16#0207F#), -- SUPERSCRIPT LATIN SMALL LETTER N .. SUPERSCRIPT LATIN SMALL LETTER N + (16#02102#, 16#02102#), -- DOUBLE-STRUCK CAPITAL C .. DOUBLE-STRUCK CAPITAL C + (16#02107#, 16#02107#), -- EULER CONSTANT .. EULER CONSTANT + (16#0210A#, 16#02113#), -- SCRIPT SMALL G .. SCRIPT SMALL L + (16#02115#, 16#02115#), -- DOUBLE-STRUCK CAPITAL N .. DOUBLE-STRUCK CAPITAL N + (16#02119#, 16#0211D#), -- DOUBLE-STRUCK CAPITAL P .. DOUBLE-STRUCK CAPITAL R + (16#02124#, 16#02124#), -- DOUBLE-STRUCK CAPITAL Z .. DOUBLE-STRUCK CAPITAL Z + (16#02126#, 16#02126#), -- OHM SIGN .. OHM SIGN + (16#02128#, 16#02128#), -- BLACK-LETTER CAPITAL Z .. BLACK-LETTER CAPITAL Z + (16#0212A#, 16#0212D#), -- KELVIN SIGN .. BLACK-LETTER CAPITAL C + (16#0212F#, 16#02131#), -- SCRIPT SMALL E .. SCRIPT CAPITAL F + (16#02133#, 16#02139#), -- SCRIPT CAPITAL M .. INFORMATION SOURCE + (16#0213D#, 16#0213F#), -- DOUBLE-STRUCK SMALL GAMMA .. DOUBLE-STRUCK CAPITAL PI + (16#02145#, 16#02149#), -- DOUBLE-STRUCK ITALIC CAPITAL D .. DOUBLE-STRUCK ITALIC SMALL J + (16#02160#, 16#02183#), -- ROMAN NUMERAL ONE .. ROMAN NUMERAL REVERSED ONE HUNDRED + (16#03005#, 16#03007#), -- IDEOGRAPHIC ITERATION MARK .. IDEOGRAPHIC NUMBER ZERO + (16#03021#, 16#03029#), -- HANGZHOU NUMERAL ONE .. HANGZHOU NUMERAL NINE + (16#03031#, 16#03035#), -- VERTICAL KANA REPEAT MARK .. VERTICAL KANA REPEAT MARK LOWER HALF + (16#03038#, 16#0303C#), -- HANGZHOU NUMERAL TEN .. MASU MARK + (16#03041#, 16#03096#), -- HIRAGANA LETTER SMALL A .. HIRAGANA LETTER SMALL KE + (16#0309D#, 16#0309F#), -- HIRAGANA ITERATION MARK .. HIRAGANA DIGRAPH YORI + (16#030A1#, 16#030FA#), -- KATAKANA LETTER SMALL A .. KATAKANA LETTER VO + (16#030FC#, 16#030FF#), -- KATAKANA-HIRAGANA PROLONGED SOUND MARK .. KATAKANA DIGRAPH KOTO + (16#03105#, 16#0312C#), -- BOPOMOFO LETTER B .. BOPOMOFO LETTER GN + (16#03131#, 16#0318E#), -- HANGUL LETTER KIYEOK .. HANGUL LETTER ARAEAE + (16#031A0#, 16#031B7#), -- BOPOMOFO LETTER BU .. BOPOMOFO FINAL LETTER H + (16#031F0#, 16#031FF#), -- KATAKANA LETTER SMALL KU .. KATAKANA LETTER SMALL RO + (16#03400#, 16#04DB5#), -- <CJK Ideograph Extension A, First> .. <CJK Ideograph Extension A, Last> + (16#04E00#, 16#09FA5#), -- <CJK Ideograph, First> .. <CJK Ideograph, Last> + (16#0A000#, 16#0A48C#), -- YI SYLLABLE IT .. YI SYLLABLE YYR + (16#0AC00#, 16#0D7A3#), -- <Hangul Syllable, First> .. <Hangul Syllable, Last> + (16#0F900#, 16#0FA2D#), -- CJK COMPATIBILITY IDEOGRAPH-F900 .. CJK COMPATIBILITY IDEOGRAPH-FA2D + (16#0FA30#, 16#0FA6A#), -- CJK COMPATIBILITY IDEOGRAPH-FA30 .. CJK COMPATIBILITY IDEOGRAPH-FA6A + (16#0FB00#, 16#0FB06#), -- LATIN SMALL LIGATURE FF .. LATIN SMALL LIGATURE ST + (16#0FB13#, 16#0FB17#), -- ARMENIAN SMALL LIGATURE MEN NOW .. ARMENIAN SMALL LIGATURE MEN XEH + (16#0FB1D#, 16#0FB1D#), -- HEBREW LETTER YOD WITH HIRIQ .. HEBREW LETTER YOD WITH HIRIQ + (16#0FB1F#, 16#0FB28#), -- HEBREW LIGATURE YIDDISH YOD YOD PATAH .. HEBREW LETTER WIDE TAV + (16#0FB2A#, 16#0FB36#), -- HEBREW LETTER SHIN WITH SHIN DOT .. HEBREW LETTER ZAYIN WITH DAGESH + (16#0FB38#, 16#0FB3C#), -- HEBREW LETTER TET WITH DAGESH .. HEBREW LETTER LAMED WITH DAGESH + (16#0FB3E#, 16#0FB3E#), -- HEBREW LETTER MEM WITH DAGESH .. HEBREW LETTER MEM WITH DAGESH + (16#0FB40#, 16#0FB41#), -- HEBREW LETTER NUN WITH DAGESH .. HEBREW LETTER SAMEKH WITH DAGESH + (16#0FB43#, 16#0FB44#), -- HEBREW LETTER FINAL PE WITH DAGESH .. HEBREW LETTER PE WITH DAGESH + (16#0FB46#, 16#0FBB1#), -- HEBREW LETTER TSADI WITH DAGESH .. ARABIC LETTER YEH BARREE WITH HAMZA ABOVE FINAL FORM + (16#0FBD3#, 16#0FD3D#), -- ARABIC LETTER NG ISOLATED FORM .. ARABIC LIGATURE ALEF WITH FATHATAN ISOLATED FORM + (16#0FD50#, 16#0FD8F#), -- ARABIC LIGATURE TEH WITH JEEM WITH MEEM INITIAL FORM .. ARABIC LIGATURE MEEM WITH KHAH WITH MEEM INITIAL FORM + (16#0FD92#, 16#0FDC7#), -- ARABIC LIGATURE MEEM WITH JEEM WITH KHAH INITIAL FORM .. ARABIC LIGATURE NOON WITH JEEM WITH YEH FINAL FORM + (16#0FDF0#, 16#0FDFB#), -- ARABIC LIGATURE SALLA USED AS KORANIC STOP SIGN ISOLATED FORM .. ARABIC LIGATURE JALLAJALALOUHOU + (16#0FE70#, 16#0FE74#), -- ARABIC FATHATAN ISOLATED FORM .. ARABIC KASRATAN ISOLATED FORM + (16#0FE76#, 16#0FEFC#), -- ARABIC FATHA ISOLATED FORM .. ARABIC LIGATURE LAM WITH ALEF FINAL FORM + (16#0FF21#, 16#0FF3A#), -- FULLWIDTH LATIN CAPITAL LETTER A .. FULLWIDTH LATIN CAPITAL LETTER Z + (16#0FF41#, 16#0FF5A#), -- FULLWIDTH LATIN SMALL LETTER A .. FULLWIDTH LATIN SMALL LETTER Z + (16#0FF66#, 16#0FFBE#), -- HALFWIDTH KATAKANA LETTER WO .. HALFWIDTH HANGUL LETTER HIEUH + (16#0FFC2#, 16#0FFC7#), -- HALFWIDTH HANGUL LETTER A .. HALFWIDTH HANGUL LETTER E + (16#0FFCA#, 16#0FFCF#), -- HALFWIDTH HANGUL LETTER YEO .. HALFWIDTH HANGUL LETTER OE + (16#0FFD2#, 16#0FFD7#), -- HALFWIDTH HANGUL LETTER YO .. HALFWIDTH HANGUL LETTER YU + (16#0FFDA#, 16#0FFDC#), -- HALFWIDTH HANGUL LETTER EU .. HALFWIDTH HANGUL LETTER I + (16#10000#, 16#1000B#), -- LINEAR B SYLLABLE B008 A .. LINEAR B SYLLABLE B046 JE + (16#1000D#, 16#10026#), -- LINEAR B SYLLABLE B036 JO .. LINEAR B SYLLABLE B032 QO + (16#10028#, 16#1003A#), -- LINEAR B SYLLABLE B060 RA .. LINEAR B SYLLABLE B042 WO + (16#1003C#, 16#1003D#), -- LINEAR B SYLLABLE B017 ZA .. LINEAR B SYLLABLE B074 ZE + (16#1003F#, 16#1004D#), -- LINEAR B SYLLABLE B020 ZO .. LINEAR B SYLLABLE B091 TWO + (16#10050#, 16#1005D#), -- LINEAR B SYMBOL B018 .. LINEAR B SYMBOL B089 + (16#10080#, 16#100FA#), -- LINEAR B IDEOGRAM B100 MAN .. LINEAR B IDEOGRAM VESSEL B305 + (16#10300#, 16#1031E#), -- OLD ITALIC LETTER A .. OLD ITALIC LETTER UU + (16#10330#, 16#1034A#), -- GOTHIC LETTER AHSA .. GOTHIC LETTER NINE HUNDRED + (16#10380#, 16#1039D#), -- UGARITIC LETTER ALPA .. UGARITIC LETTER SSU + (16#10400#, 16#1049D#), -- DESERET CAPITAL LETTER LONG I .. OSMANYA LETTER OO + (16#10800#, 16#10805#), -- CYPRIOT SYLLABLE A .. CYPRIOT SYLLABLE JA + (16#10808#, 16#10808#), -- CYPRIOT SYLLABLE JO .. CYPRIOT SYLLABLE JO + (16#1080A#, 16#10835#), -- CYPRIOT SYLLABLE KA .. CYPRIOT SYLLABLE WO + (16#10837#, 16#10838#), -- CYPRIOT SYLLABLE XA .. CYPRIOT SYLLABLE XE + (16#1083C#, 16#1083C#), -- CYPRIOT SYLLABLE ZA .. CYPRIOT SYLLABLE ZA + (16#1083F#, 16#1083F#), -- CYPRIOT SYLLABLE ZO .. CYPRIOT SYLLABLE ZO + (16#1D400#, 16#1D454#), -- MATHEMATICAL BOLD CAPITAL A .. MATHEMATICAL ITALIC SMALL G + (16#1D456#, 16#1D49C#), -- MATHEMATICAL ITALIC SMALL I .. MATHEMATICAL SCRIPT CAPITAL A + (16#1D49E#, 16#1D49F#), -- MATHEMATICAL SCRIPT CAPITAL C .. MATHEMATICAL SCRIPT CAPITAL D + (16#1D4A2#, 16#1D4A2#), -- MATHEMATICAL SCRIPT CAPITAL G .. MATHEMATICAL SCRIPT CAPITAL G + (16#1D4A5#, 16#1D4A6#), -- MATHEMATICAL SCRIPT CAPITAL J .. MATHEMATICAL SCRIPT CAPITAL K + (16#1D4A9#, 16#1D4AC#), -- MATHEMATICAL SCRIPT CAPITAL N .. MATHEMATICAL SCRIPT CAPITAL Q + (16#1D4AE#, 16#1D4B9#), -- MATHEMATICAL SCRIPT CAPITAL S .. MATHEMATICAL SCRIPT SMALL D + (16#1D4BB#, 16#1D4BB#), -- MATHEMATICAL SCRIPT SMALL F .. MATHEMATICAL SCRIPT SMALL F + (16#1D4BD#, 16#1D4C3#), -- MATHEMATICAL SCRIPT SMALL H .. MATHEMATICAL SCRIPT SMALL N + (16#1D4C5#, 16#1D505#), -- MATHEMATICAL SCRIPT SMALL P .. MATHEMATICAL FRAKTUR CAPITAL B + (16#1D507#, 16#1D50A#), -- MATHEMATICAL FRAKTUR CAPITAL D .. MATHEMATICAL FRAKTUR CAPITAL G + (16#1D50D#, 16#1D514#), -- MATHEMATICAL FRAKTUR CAPITAL J .. MATHEMATICAL FRAKTUR CAPITAL Q + (16#1D516#, 16#1D51C#), -- MATHEMATICAL FRAKTUR CAPITAL S .. MATHEMATICAL FRAKTUR CAPITAL Y + (16#1D51E#, 16#1D539#), -- MATHEMATICAL FRAKTUR SMALL A .. MATHEMATICAL DOUBLE-STRUCK CAPITAL B + (16#1D53B#, 16#1D53E#), -- MATHEMATICAL DOUBLE-STRUCK CAPITAL D .. MATHEMATICAL DOUBLE-STRUCK CAPITAL G + (16#1D540#, 16#1D544#), -- MATHEMATICAL DOUBLE-STRUCK CAPITAL I .. MATHEMATICAL DOUBLE-STRUCK CAPITAL M + (16#1D546#, 16#1D546#), -- MATHEMATICAL DOUBLE-STRUCK CAPITAL O .. MATHEMATICAL DOUBLE-STRUCK CAPITAL O + (16#1D54A#, 16#1D550#), -- MATHEMATICAL DOUBLE-STRUCK CAPITAL S .. MATHEMATICAL DOUBLE-STRUCK CAPITAL Y + (16#1D552#, 16#1D6A3#), -- MATHEMATICAL DOUBLE-STRUCK SMALL A .. MATHEMATICAL MONOSPACE SMALL Z + (16#1D6A8#, 16#1D6C0#), -- MATHEMATICAL BOLD CAPITAL ALPHA .. MATHEMATICAL BOLD CAPITAL OMEGA + (16#1D6C2#, 16#1D6DA#), -- MATHEMATICAL BOLD SMALL ALPHA .. MATHEMATICAL BOLD SMALL OMEGA + (16#1D6DC#, 16#1D6FA#), -- MATHEMATICAL BOLD EPSILON SYMBOL .. MATHEMATICAL ITALIC CAPITAL OMEGA + (16#1D6FC#, 16#1D714#), -- MATHEMATICAL ITALIC SMALL ALPHA .. MATHEMATICAL ITALIC SMALL OMEGA + (16#1D716#, 16#1D734#), -- MATHEMATICAL ITALIC EPSILON SYMBOL .. MATHEMATICAL BOLD ITALIC CAPITAL OMEGA + (16#1D736#, 16#1D74E#), -- MATHEMATICAL BOLD ITALIC SMALL ALPHA .. MATHEMATICAL BOLD ITALIC SMALL OMEGA + (16#1D750#, 16#1D76E#), -- MATHEMATICAL BOLD ITALIC EPSILON SYMBOL .. MATHEMATICAL SANS-SERIF BOLD CAPITAL OMEGA + (16#1D770#, 16#1D788#), -- MATHEMATICAL SANS-SERIF BOLD SMALL ALPHA .. MATHEMATICAL SANS-SERIF BOLD SMALL OMEGA + (16#1D78A#, 16#1D7A8#), -- MATHEMATICAL SANS-SERIF BOLD EPSILON SYMBOL .. MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL OMEGA + (16#1D7AA#, 16#1D7C2#), -- MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL ALPHA .. MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL OMEGA + (16#1D7C4#, 16#1D7C9#), -- MATHEMATICAL SANS-SERIF BOLD ITALIC EPSILON SYMBOL .. MATHEMATICAL SANS-SERIF BOLD ITALIC PI SYMBOL + (16#20000#, 16#2A6D6#), -- <CJK Ideograph Extension B, First> .. <CJK Ideograph Extension B, Last> + (16#2F800#, 16#2FA1D#)); -- CJK COMPATIBILITY IDEOGRAPH-2F800 .. CJK COMPATIBILITY IDEOGRAPH-2FA1D + + -- The following table includes all characters considered spaces, i.e. + -- all characters from the Unicode table with categories: + + -- Separator, Space (Zs) + + UTF_32_Spaces : constant UTF_32_Ranges := ( + (16#00020#, 16#00020#), -- SPACE .. SPACE + (16#000A0#, 16#000A0#), -- NO-BREAK SPACE .. NO-BREAK SPACE + (16#01680#, 16#01680#), -- OGHAM SPACE MARK .. OGHAM SPACE MARK + (16#0180E#, 16#0180E#), -- MONGOLIAN VOWEL SEPARATOR .. MONGOLIAN VOWEL SEPARATOR + (16#02000#, 16#0200B#), -- EN QUAD .. ZERO WIDTH SPACE + (16#0202F#, 16#0202F#), -- NARROW NO-BREAK SPACE .. NARROW NO-BREAK SPACE + (16#0205F#, 16#0205F#), -- MEDIUM MATHEMATICAL SPACE .. MEDIUM MATHEMATICAL SPACE + (16#03000#, 16#03000#)); -- IDEOGRAPHIC SPACE .. IDEOGRAPHIC SPACE + + -- The following table includes all characters considered punctuation, + -- i.e. all characters from the Unicode table with categories: + + -- Punctuation, Connector (Pc) + + UTF_32_Punctuation : constant UTF_32_Ranges := ( + (16#0005F#, 16#0005F#), -- LOW LINE .. LOW LINE + (16#0203F#, 16#02040#), -- UNDERTIE .. CHARACTER TIE + (16#02054#, 16#02054#), -- INVERTED UNDERTIE .. INVERTED UNDERTIE + (16#030FB#, 16#030FB#), -- KATAKANA MIDDLE DOT .. KATAKANA MIDDLE DOT + (16#0FE33#, 16#0FE34#), -- PRESENTATION FORM FOR VERTICAL LOW LINE .. PRESENTATION FORM FOR VERTICAL WAVY LOW LINE + (16#0FE4D#, 16#0FE4F#), -- DASHED LOW LINE .. WAVY LOW LINE + (16#0FF3F#, 16#0FF3F#), -- FULLWIDTH LOW LINE .. FULLWIDTH LOW LINE + (16#0FF65#, 16#0FF65#)); -- HALFWIDTH KATAKANA MIDDLE DOT .. HALFWIDTH KATAKANA MIDDLE DOT + + -- The following table includes all characters considered as other format, + -- i.e. all characters from the Unicode table with categories: + + -- Other, Format (Cf) + + UTF_32_Other_Format : constant UTF_32_Ranges := ( + (16#000AD#, 16#000AD#), -- SOFT HYPHEN .. SOFT HYPHEN + (16#00600#, 16#00603#), -- ARABIC NUMBER SIGN .. ARABIC SIGN SAFHA + (16#006DD#, 16#006DD#), -- ARABIC END OF AYAH .. ARABIC END OF AYAH + (16#0070F#, 16#0070F#), -- SYRIAC ABBREVIATION MARK .. SYRIAC ABBREVIATION MARK + (16#017B4#, 16#017B5#), -- KHMER VOWEL INHERENT AQ .. KHMER VOWEL INHERENT AA + (16#0200C#, 16#0200F#), -- ZERO WIDTH NON-JOINER .. RIGHT-TO-LEFT MARK + (16#0202A#, 16#0202E#), -- LEFT-TO-RIGHT EMBEDDING .. RIGHT-TO-LEFT OVERRIDE + (16#02060#, 16#02063#), -- WORD JOINER .. INVISIBLE SEPARATOR + (16#0206A#, 16#0206F#), -- INHIBIT SYMMETRIC SWAPPING .. NOMINAL DIGIT SHAPES + (16#0FEFF#, 16#0FEFF#), -- ZERO WIDTH NO-BREAK SPACE .. ZERO WIDTH NO-BREAK SPACE + (16#0FFF9#, 16#0FFFB#), -- INTERLINEAR ANNOTATION ANCHOR .. INTERLINEAR ANNOTATION TERMINATOR + (16#1D173#, 16#1D17A#), -- MUSICAL SYMBOL BEGIN BEAM .. MUSICAL SYMBOL END PHRASE + (16#E0001#, 16#E0001#), -- LANGUAGE TAG .. LANGUAGE TAG + (16#E0020#, 16#E007F#)); -- TAG SPACE .. CANCEL TAG + + -- The following table includes all characters considered marks i.e. + -- all characters from the Unicode table with categories: + + -- Mark, Nonspacing (Mn) + -- Mark, Spacing Combining (Mc) + + UTF_32_Marks : constant UTF_32_Ranges := ( + (16#00300#, 16#00357#), -- COMBINING GRAVE ACCENT .. COMBINING RIGHT HALF RING ABOVE + (16#0035D#, 16#0036F#), -- COMBINING DOUBLE BREVE .. COMBINING LATIN SMALL LETTER X + (16#00483#, 16#00486#), -- COMBINING CYRILLIC TITLO .. COMBINING CYRILLIC PSILI PNEUMATA + (16#00591#, 16#005A1#), -- HEBREW ACCENT ETNAHTA .. HEBREW ACCENT PAZER + (16#005A3#, 16#005B9#), -- HEBREW ACCENT MUNAH .. HEBREW POINT HOLAM + (16#005BB#, 16#005BD#), -- HEBREW POINT QUBUTS .. HEBREW POINT METEG + (16#005BF#, 16#005BF#), -- HEBREW POINT RAFE .. HEBREW POINT RAFE + (16#005C1#, 16#005C2#), -- HEBREW POINT SHIN DOT .. HEBREW POINT SIN DOT + (16#005C4#, 16#005C4#), -- HEBREW MARK UPPER DOT .. HEBREW MARK UPPER DOT + (16#00610#, 16#00615#), -- ARABIC SIGN SALLALLAHOU ALAYHE WASSALLAM .. ARABIC SMALL HIGH TAH + (16#0064B#, 16#00658#), -- ARABIC FATHATAN .. ARABIC MARK NOON GHUNNA + (16#00670#, 16#00670#), -- ARABIC LETTER SUPERSCRIPT ALEF .. ARABIC LETTER SUPERSCRIPT ALEF + (16#006D6#, 16#006DC#), -- ARABIC SMALL HIGH LIGATURE SAD WITH LAM WITH ALEF MAKSURA .. ARABIC SMALL HIGH SEEN + (16#006DF#, 16#006E4#), -- ARABIC SMALL HIGH ROUNDED ZERO .. ARABIC SMALL HIGH MADDA + (16#006E7#, 16#006E8#), -- ARABIC SMALL HIGH YEH .. ARABIC SMALL HIGH NOON + (16#006EA#, 16#006ED#), -- ARABIC EMPTY CENTRE LOW STOP .. ARABIC SMALL LOW MEEM + (16#00711#, 16#00711#), -- SYRIAC LETTER SUPERSCRIPT ALAPH .. SYRIAC LETTER SUPERSCRIPT ALAPH + (16#00730#, 16#0074A#), -- SYRIAC PTHAHA ABOVE .. SYRIAC BARREKH + (16#007A6#, 16#007B0#), -- THAANA ABAFILI .. THAANA SUKUN + (16#00901#, 16#00903#), -- DEVANAGARI SIGN CANDRABINDU .. DEVANAGARI SIGN VISARGA + (16#0093C#, 16#0093C#), -- DEVANAGARI SIGN NUKTA .. DEVANAGARI SIGN NUKTA + (16#0093E#, 16#0094D#), -- DEVANAGARI VOWEL SIGN AA .. DEVANAGARI SIGN VIRAMA + (16#00951#, 16#00954#), -- DEVANAGARI STRESS SIGN UDATTA .. DEVANAGARI ACUTE ACCENT + (16#00962#, 16#00963#), -- DEVANAGARI VOWEL SIGN VOCALIC L .. DEVANAGARI VOWEL SIGN VOCALIC LL + (16#00981#, 16#00983#), -- BENGALI SIGN CANDRABINDU .. BENGALI SIGN VISARGA + (16#009BC#, 16#009BC#), -- BENGALI SIGN NUKTA .. BENGALI SIGN NUKTA + (16#009BE#, 16#009C4#), -- BENGALI VOWEL SIGN AA .. BENGALI VOWEL SIGN VOCALIC RR + (16#009C7#, 16#009C8#), -- BENGALI VOWEL SIGN E .. BENGALI VOWEL SIGN AI + (16#009CB#, 16#009CD#), -- BENGALI VOWEL SIGN O .. BENGALI SIGN VIRAMA + (16#009D7#, 16#009D7#), -- BENGALI AU LENGTH MARK .. BENGALI AU LENGTH MARK + (16#009E2#, 16#009E3#), -- BENGALI VOWEL SIGN VOCALIC L .. BENGALI VOWEL SIGN VOCALIC LL + (16#00A01#, 16#00A03#), -- GURMUKHI SIGN ADAK BINDI .. GURMUKHI SIGN VISARGA + (16#00A3C#, 16#00A3C#), -- GURMUKHI SIGN NUKTA .. GURMUKHI SIGN NUKTA + (16#00A3E#, 16#00A42#), -- GURMUKHI VOWEL SIGN AA .. GURMUKHI VOWEL SIGN UU + (16#00A47#, 16#00A48#), -- GURMUKHI VOWEL SIGN EE .. GURMUKHI VOWEL SIGN AI + (16#00A4B#, 16#00A4D#), -- GURMUKHI VOWEL SIGN OO .. GURMUKHI SIGN VIRAMA + (16#00A70#, 16#00A71#), -- GURMUKHI TIPPI .. GURMUKHI ADDAK + (16#00A81#, 16#00A83#), -- GUJARATI SIGN CANDRABINDU .. GUJARATI SIGN VISARGA + (16#00ABC#, 16#00ABC#), -- GUJARATI SIGN NUKTA .. GUJARATI SIGN NUKTA + (16#00ABE#, 16#00AC5#), -- GUJARATI VOWEL SIGN AA .. GUJARATI VOWEL SIGN CANDRA E + (16#00AC7#, 16#00AC9#), -- GUJARATI VOWEL SIGN E .. GUJARATI VOWEL SIGN CANDRA O + (16#00ACB#, 16#00ACD#), -- GUJARATI VOWEL SIGN O .. GUJARATI SIGN VIRAMA + (16#00AE2#, 16#00AE3#), -- GUJARATI VOWEL SIGN VOCALIC L .. GUJARATI VOWEL SIGN VOCALIC LL + (16#00B01#, 16#00B03#), -- ORIYA SIGN CANDRABINDU .. ORIYA SIGN VISARGA + (16#00B3C#, 16#00B3C#), -- ORIYA SIGN NUKTA .. ORIYA SIGN NUKTA + (16#00B3E#, 16#00B43#), -- ORIYA VOWEL SIGN AA .. ORIYA VOWEL SIGN VOCALIC R + (16#00B47#, 16#00B48#), -- ORIYA VOWEL SIGN E .. ORIYA VOWEL SIGN AI + (16#00B4B#, 16#00B4D#), -- ORIYA VOWEL SIGN O .. ORIYA SIGN VIRAMA + (16#00B56#, 16#00B57#), -- ORIYA AI LENGTH MARK .. ORIYA AU LENGTH MARK + (16#00B82#, 16#00B82#), -- TAMIL SIGN ANUSVARA .. TAMIL SIGN ANUSVARA + (16#00BBE#, 16#00BC2#), -- TAMIL VOWEL SIGN AA .. TAMIL VOWEL SIGN UU + (16#00BC6#, 16#00BC8#), -- TAMIL VOWEL SIGN E .. TAMIL VOWEL SIGN AI + (16#00BCA#, 16#00BCD#), -- TAMIL VOWEL SIGN O .. TAMIL SIGN VIRAMA + (16#00BD7#, 16#00BD7#), -- TAMIL AU LENGTH MARK .. TAMIL AU LENGTH MARK + (16#00C01#, 16#00C03#), -- TELUGU SIGN CANDRABINDU .. TELUGU SIGN VISARGA + (16#00C3E#, 16#00C44#), -- TELUGU VOWEL SIGN AA .. TELUGU VOWEL SIGN VOCALIC RR + (16#00C46#, 16#00C48#), -- TELUGU VOWEL SIGN E .. TELUGU VOWEL SIGN AI + (16#00C4A#, 16#00C4D#), -- TELUGU VOWEL SIGN O .. TELUGU SIGN VIRAMA + (16#00C55#, 16#00C56#), -- TELUGU LENGTH MARK .. TELUGU AI LENGTH MARK + (16#00C82#, 16#00C83#), -- KANNADA SIGN ANUSVARA .. KANNADA SIGN VISARGA + (16#00CBC#, 16#00CBC#), -- KANNADA SIGN NUKTA .. KANNADA SIGN NUKTA + (16#00CBE#, 16#00CC4#), -- KANNADA VOWEL SIGN AA .. KANNADA VOWEL SIGN VOCALIC RR + (16#00CC6#, 16#00CC8#), -- KANNADA VOWEL SIGN E .. KANNADA VOWEL SIGN AI + (16#00CCA#, 16#00CCD#), -- KANNADA VOWEL SIGN O .. KANNADA SIGN VIRAMA + (16#00CD5#, 16#00CD6#), -- KANNADA LENGTH MARK .. KANNADA AI LENGTH MARK + (16#00D02#, 16#00D03#), -- MALAYALAM SIGN ANUSVARA .. MALAYALAM SIGN VISARGA + (16#00D3E#, 16#00D43#), -- MALAYALAM VOWEL SIGN AA .. MALAYALAM VOWEL SIGN VOCALIC R + (16#00D46#, 16#00D48#), -- MALAYALAM VOWEL SIGN E .. MALAYALAM VOWEL SIGN AI + (16#00D4A#, 16#00D4D#), -- MALAYALAM VOWEL SIGN O .. MALAYALAM SIGN VIRAMA + (16#00D57#, 16#00D57#), -- MALAYALAM AU LENGTH MARK .. MALAYALAM AU LENGTH MARK + (16#00D82#, 16#00D83#), -- SINHALA SIGN ANUSVARAYA .. SINHALA SIGN VISARGAYA + (16#00DCA#, 16#00DCA#), -- SINHALA SIGN AL-LAKUNA .. SINHALA SIGN AL-LAKUNA + (16#00DCF#, 16#00DD4#), -- SINHALA VOWEL SIGN AELA-PILLA .. SINHALA VOWEL SIGN KETTI PAA-PILLA + (16#00DD6#, 16#00DD6#), -- SINHALA VOWEL SIGN DIGA PAA-PILLA .. SINHALA VOWEL SIGN DIGA PAA-PILLA + (16#00DD8#, 16#00DDF#), -- SINHALA VOWEL SIGN GAETTA-PILLA .. SINHALA VOWEL SIGN GAYANUKITTA + (16#00DF2#, 16#00DF3#), -- SINHALA VOWEL SIGN DIGA GAETTA-PILLA .. SINHALA VOWEL SIGN DIGA GAYANUKITTA + (16#00E31#, 16#00E31#), -- THAI CHARACTER MAI HAN-AKAT .. THAI CHARACTER MAI HAN-AKAT + (16#00E34#, 16#00E3A#), -- THAI CHARACTER SARA I .. THAI CHARACTER PHINTHU + (16#00E47#, 16#00E4E#), -- THAI CHARACTER MAITAIKHU .. THAI CHARACTER YAMAKKAN + (16#00EB1#, 16#00EB1#), -- LAO VOWEL SIGN MAI KAN .. LAO VOWEL SIGN MAI KAN + (16#00EB4#, 16#00EB9#), -- LAO VOWEL SIGN I .. LAO VOWEL SIGN UU + (16#00EBB#, 16#00EBC#), -- LAO VOWEL SIGN MAI KON .. LAO SEMIVOWEL SIGN LO + (16#00EC8#, 16#00ECD#), -- LAO TONE MAI EK .. LAO NIGGAHITA + (16#00F18#, 16#00F19#), -- TIBETAN ASTROLOGICAL SIGN -KHYUD PA .. TIBETAN ASTROLOGICAL SIGN SDONG TSHUGS + (16#00F35#, 16#00F35#), -- TIBETAN MARK NGAS BZUNG NYI ZLA .. TIBETAN MARK NGAS BZUNG NYI ZLA + (16#00F37#, 16#00F37#), -- TIBETAN MARK NGAS BZUNG SGOR RTAGS .. TIBETAN MARK NGAS BZUNG SGOR RTAGS + (16#00F39#, 16#00F39#), -- TIBETAN MARK TSA -PHRU .. TIBETAN MARK TSA -PHRU + (16#00F3E#, 16#00F3F#), -- TIBETAN SIGN YAR TSHES .. TIBETAN SIGN MAR TSHES + (16#00F71#, 16#00F84#), -- TIBETAN VOWEL SIGN AA .. TIBETAN MARK HALANTA + (16#00F86#, 16#00F87#), -- TIBETAN SIGN LCI RTAGS .. TIBETAN SIGN YANG RTAGS + (16#00F90#, 16#00F97#), -- TIBETAN SUBJOINED LETTER KA .. TIBETAN SUBJOINED LETTER JA + (16#00F99#, 16#00FBC#), -- TIBETAN SUBJOINED LETTER NYA .. TIBETAN SUBJOINED LETTER FIXED-FORM RA + (16#00FC6#, 16#00FC6#), -- TIBETAN SYMBOL PADMA GDAN .. TIBETAN SYMBOL PADMA GDAN + (16#0102C#, 16#01032#), -- MYANMAR VOWEL SIGN AA .. MYANMAR VOWEL SIGN AI + (16#01036#, 16#01039#), -- MYANMAR SIGN ANUSVARA .. MYANMAR SIGN VIRAMA + (16#01056#, 16#01059#), -- MYANMAR VOWEL SIGN VOCALIC R .. MYANMAR VOWEL SIGN VOCALIC LL + (16#01712#, 16#01714#), -- TAGALOG VOWEL SIGN I .. TAGALOG SIGN VIRAMA + (16#01732#, 16#01734#), -- HANUNOO VOWEL SIGN I .. HANUNOO SIGN PAMUDPOD + (16#01752#, 16#01753#), -- BUHID VOWEL SIGN I .. BUHID VOWEL SIGN U + (16#01772#, 16#01773#), -- TAGBANWA VOWEL SIGN I .. TAGBANWA VOWEL SIGN U + (16#017B6#, 16#017D3#), -- KHMER VOWEL SIGN AA .. KHMER SIGN BATHAMASAT + (16#017DD#, 16#017DD#), -- KHMER SIGN ATTHACAN .. KHMER SIGN ATTHACAN + (16#0180B#, 16#0180D#), -- MONGOLIAN FREE VARIATION SELECTOR ONE .. MONGOLIAN FREE VARIATION SELECTOR THREE + (16#018A9#, 16#018A9#), -- MONGOLIAN LETTER ALI GALI DAGALGA .. MONGOLIAN LETTER ALI GALI DAGALGA + (16#01920#, 16#0192B#), -- LIMBU VOWEL SIGN A .. LIMBU SUBJOINED LETTER WA + (16#01930#, 16#0193B#), -- LIMBU SMALL LETTER KA .. LIMBU SIGN SA-I + (16#020D0#, 16#020DC#), -- COMBINING LEFT HARPOON ABOVE .. COMBINING FOUR DOTS ABOVE + (16#020E1#, 16#020E1#), -- COMBINING LEFT RIGHT ARROW ABOVE .. COMBINING LEFT RIGHT ARROW ABOVE + (16#020E5#, 16#020EA#), -- COMBINING REVERSE SOLIDUS OVERLAY .. COMBINING LEFTWARDS ARROW OVERLAY + (16#0302A#, 16#0302F#), -- IDEOGRAPHIC LEVEL TONE MARK .. HANGUL DOUBLE DOT TONE MARK + (16#03099#, 16#0309A#), -- COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK .. COMBINING KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK + (16#0FB1E#, 16#0FB1E#), -- HEBREW POINT JUDEO-SPANISH VARIKA .. HEBREW POINT JUDEO-SPANISH VARIKA + (16#0FE00#, 16#0FE0F#), -- VARIATION SELECTOR-1 .. VARIATION SELECTOR-16 + (16#0FE20#, 16#0FE23#), -- COMBINING LIGATURE LEFT HALF .. COMBINING DOUBLE TILDE RIGHT HALF + (16#1D165#, 16#1D169#), -- MUSICAL SYMBOL COMBINING STEM .. MUSICAL SYMBOL COMBINING TREMOLO-3 + (16#1D16D#, 16#1D172#), -- MUSICAL SYMBOL COMBINING AUGMENTATION DOT .. MUSICAL SYMBOL COMBINING FLAG-5 + (16#1D17B#, 16#1D182#), -- MUSICAL SYMBOL COMBINING ACCENT .. MUSICAL SYMBOL COMBINING LOURE + (16#1D185#, 16#1D18B#), -- MUSICAL SYMBOL COMBINING DOIT .. MUSICAL SYMBOL COMBINING TRIPLE TONGUE + (16#1D1AA#, 16#1D1AD#), -- MUSICAL SYMBOL COMBINING DOWN BOW .. MUSICAL SYMBOL COMBINING SNAP PIZZICATO + (16#E0100#, 16#E01EF#)); -- VARIATION SELECTOR-17 .. VARIATION SELECTOR-256 + + -- The following table includes all characters considered non-graphic, + -- i.e. all characters from the Unicode table with categories: + + -- Other, Control (Cc) + -- Other, Private Use (Co) + -- Other, Surrogate (Cs) + -- Other, Format (Cf) + -- Separator, Line (Zl) + -- Separator, Paragraph (Zp) + + -- In addition, the characters FFFE and FFFF are excluded. Note that the + -- defined Ada category of format effector is subsumed by the above set + -- of Unicode categories. + + UTF_32_Non_Graphic : constant UTF_32_Ranges := ( + (16#00000#, 16#0001F#), -- <control> .. <control> + (16#0007F#, 16#0009F#), -- <control> .. <control> + (16#000AD#, 16#000AD#), -- SOFT HYPHEN .. SOFT HYPHEN + (16#00600#, 16#00603#), -- ARABIC NUMBER SIGN .. ARABIC SIGN SAFHA + (16#006DD#, 16#006DD#), -- ARABIC END OF AYAH .. ARABIC END OF AYAH + (16#0070F#, 16#0070F#), -- SYRIAC ABBREVIATION MARK .. SYRIAC ABBREVIATION MARK + (16#017B4#, 16#017B5#), -- KHMER VOWEL INHERENT AQ .. KHMER VOWEL INHERENT AA + (16#0200C#, 16#0200F#), -- ZERO WIDTH NON-JOINER .. RIGHT-TO-LEFT MARK + (16#02028#, 16#0202E#), -- LINE SEPARATOR .. RIGHT-TO-LEFT OVERRIDE + (16#02060#, 16#02063#), -- WORD JOINER .. INVISIBLE SEPARATOR + (16#0206A#, 16#0206F#), -- INHIBIT SYMMETRIC SWAPPING .. NOMINAL DIGIT SHAPES + (16#0D800#, 16#0F8FF#), -- <Non Private Use High Surrogate, First> .. <Private Use, Last> + (16#0FEFF#, 16#0FEFF#), -- ZERO WIDTH NO-BREAK SPACE .. ZERO WIDTH NO-BREAK SPACE + (16#0FFF9#, 16#0FFFB#), -- INTERLINEAR ANNOTATION ANCHOR .. INTERLINEAR ANNOTATION TERMINATOR + (16#0FFFE#, 16#0FFFF#), -- excluded code positions + (16#1D173#, 16#1D17A#), -- MUSICAL SYMBOL BEGIN BEAM .. MUSICAL SYMBOL END PHRASE + (16#E0001#, 16#E0001#), -- LANGUAGE TAG .. LANGUAGE TAG + (16#E0020#, 16#E007F#), -- TAG SPACE .. CANCEL TAG + (16#F0000#, 16#FFFFD#), -- <Plane 15 Private Use, First> .. <Plane 15 Private Use, Last> + (16#100000#, 16#10FFFD#)); -- <Plane 16 Private Use, First> .. <Plane 16 Private Use, Last> + + -- The following two tables define the mapping to upper case. The first + -- table gives the ranges of lower case letters. The corresponding entry + -- in Uppercase_Adjust shows the amount to be added (or subtracted) from + -- the code value to get the corresponding upper case letter. + + -- Note that this folding is not reversible, for example lower case + -- dotless i folds to normal upper case I, and that cannot be reversed. + + Lower_Case_Letters : constant UTF_32_Ranges := ( + (16#00061#, 16#0007A#), -- LATIN SMALL LETTER A .. LATIN SMALL LETTER Z + (16#000B5#, 16#000B5#), -- MICRO SIGN .. MICRO SIGN + (16#000E0#, 16#000F6#), -- LATIN SMALL LETTER A WITH GRAVE .. LATIN SMALL LETTER O WITH DIAERESIS + (16#000F8#, 16#000FE#), -- LATIN SMALL LETTER O WITH STROKE .. LATIN SMALL LETTER THORN + (16#000FF#, 16#000FF#), -- LATIN SMALL LETTER Y WITH DIAERESIS .. LATIN SMALL LETTER Y WITH DIAERESIS + (16#00101#, 16#00101#), -- LATIN SMALL LETTER A WITH MACRON .. LATIN SMALL LETTER A WITH MACRON + (16#00103#, 16#00103#), -- LATIN SMALL LETTER A WITH BREVE .. LATIN SMALL LETTER A WITH BREVE + (16#00105#, 16#00105#), -- LATIN SMALL LETTER A WITH OGONEK .. LATIN SMALL LETTER A WITH OGONEK + (16#00107#, 16#00107#), -- LATIN SMALL LETTER C WITH ACUTE .. LATIN SMALL LETTER C WITH ACUTE + (16#00109#, 16#00109#), -- LATIN SMALL LETTER C WITH CIRCUMFLEX .. LATIN SMALL LETTER C WITH CIRCUMFLEX + (16#0010B#, 16#0010B#), -- LATIN SMALL LETTER C WITH DOT ABOVE .. LATIN SMALL LETTER C WITH DOT ABOVE + (16#0010D#, 16#0010D#), -- LATIN SMALL LETTER C WITH CARON .. LATIN SMALL LETTER C WITH CARON + (16#0010F#, 16#0010F#), -- LATIN SMALL LETTER D WITH CARON .. LATIN SMALL LETTER D WITH CARON + (16#00111#, 16#00111#), -- LATIN SMALL LETTER D WITH STROKE .. LATIN SMALL LETTER D WITH STROKE + (16#00113#, 16#00113#), -- LATIN SMALL LETTER E WITH MACRON .. LATIN SMALL LETTER E WITH MACRON + (16#00115#, 16#00115#), -- LATIN SMALL LETTER E WITH BREVE .. LATIN SMALL LETTER E WITH BREVE + (16#00117#, 16#00117#), -- LATIN SMALL LETTER E WITH DOT ABOVE .. LATIN SMALL LETTER E WITH DOT ABOVE + (16#00119#, 16#00119#), -- LATIN SMALL LETTER E WITH OGONEK .. LATIN SMALL LETTER E WITH OGONEK + (16#0011B#, 16#0011B#), -- LATIN SMALL LETTER E WITH CARON .. LATIN SMALL LETTER E WITH CARON + (16#0011D#, 16#0011D#), -- LATIN SMALL LETTER G WITH CIRCUMFLEX .. LATIN SMALL LETTER G WITH CIRCUMFLEX + (16#0011F#, 16#0011F#), -- LATIN SMALL LETTER G WITH BREVE .. LATIN SMALL LETTER G WITH BREVE + (16#00121#, 16#00121#), -- LATIN SMALL LETTER G WITH DOT ABOVE .. LATIN SMALL LETTER G WITH DOT ABOVE + (16#00123#, 16#00123#), -- LATIN SMALL LETTER G WITH CEDILLA .. LATIN SMALL LETTER G WITH CEDILLA + (16#00125#, 16#00125#), -- LATIN SMALL LETTER H WITH CIRCUMFLEX .. LATIN SMALL LETTER H WITH CIRCUMFLEX + (16#00127#, 16#00127#), -- LATIN SMALL LETTER H WITH STROKE .. LATIN SMALL LETTER H WITH STROKE + (16#00129#, 16#00129#), -- LATIN SMALL LETTER I WITH TILDE .. LATIN SMALL LETTER I WITH TILDE + (16#0012B#, 16#0012B#), -- LATIN SMALL LETTER I WITH MACRON .. LATIN SMALL LETTER I WITH MACRON + (16#0012D#, 16#0012D#), -- LATIN SMALL LETTER I WITH BREVE .. LATIN SMALL LETTER I WITH BREVE + (16#0012F#, 16#0012F#), -- LATIN SMALL LETTER I WITH OGONEK .. LATIN SMALL LETTER I WITH OGONEK + (16#00131#, 16#00131#), -- LATIN SMALL LETTER DOTLESS I .. LATIN SMALL LETTER DOTLESS I + (16#00133#, 16#00133#), -- LATIN SMALL LIGATURE IJ .. LATIN SMALL LIGATURE IJ + (16#00135#, 16#00135#), -- LATIN SMALL LETTER J WITH CIRCUMFLEX .. LATIN SMALL LETTER J WITH CIRCUMFLEX + (16#00137#, 16#00137#), -- LATIN SMALL LETTER K WITH CEDILLA .. LATIN SMALL LETTER K WITH CEDILLA + (16#0013A#, 16#0013A#), -- LATIN SMALL LETTER L WITH ACUTE .. LATIN SMALL LETTER L WITH ACUTE + (16#0013C#, 16#0013C#), -- LATIN SMALL LETTER L WITH CEDILLA .. LATIN SMALL LETTER L WITH CEDILLA + (16#0013E#, 16#0013E#), -- LATIN SMALL LETTER L WITH CARON .. LATIN SMALL LETTER L WITH CARON + (16#00140#, 16#00140#), -- LATIN SMALL LETTER L WITH MIDDLE DOT .. LATIN SMALL LETTER L WITH MIDDLE DOT + (16#00142#, 16#00142#), -- LATIN SMALL LETTER L WITH STROKE .. LATIN SMALL LETTER L WITH STROKE + (16#00144#, 16#00144#), -- LATIN SMALL LETTER N WITH ACUTE .. LATIN SMALL LETTER N WITH ACUTE + (16#00146#, 16#00146#), -- LATIN SMALL LETTER N WITH CEDILLA .. LATIN SMALL LETTER N WITH CEDILLA + (16#00148#, 16#00148#), -- LATIN SMALL LETTER N WITH CARON .. LATIN SMALL LETTER N WITH CARON + (16#0014B#, 16#0014B#), -- LATIN SMALL LETTER ENG .. LATIN SMALL LETTER ENG + (16#0014D#, 16#0014D#), -- LATIN SMALL LETTER O WITH MACRON .. LATIN SMALL LETTER O WITH MACRON + (16#0014F#, 16#0014F#), -- LATIN SMALL LETTER O WITH BREVE .. LATIN SMALL LETTER O WITH BREVE + (16#00151#, 16#00151#), -- LATIN SMALL LETTER O WITH DOUBLE ACUTE .. LATIN SMALL LETTER O WITH DOUBLE ACUTE + (16#00153#, 16#00153#), -- LATIN SMALL LIGATURE OE .. LATIN SMALL LIGATURE OE + (16#00155#, 16#00155#), -- LATIN SMALL LETTER R WITH ACUTE .. LATIN SMALL LETTER R WITH ACUTE + (16#00157#, 16#00157#), -- LATIN SMALL LETTER R WITH CEDILLA .. LATIN SMALL LETTER R WITH CEDILLA + (16#00159#, 16#00159#), -- LATIN SMALL LETTER R WITH CARON .. LATIN SMALL LETTER R WITH CARON + (16#0015B#, 16#0015B#), -- LATIN SMALL LETTER S WITH ACUTE .. LATIN SMALL LETTER S WITH ACUTE + (16#0015D#, 16#0015D#), -- LATIN SMALL LETTER S WITH CIRCUMFLEX .. LATIN SMALL LETTER S WITH CIRCUMFLEX + (16#0015F#, 16#0015F#), -- LATIN SMALL LETTER S WITH CEDILLA .. LATIN SMALL LETTER S WITH CEDILLA + (16#00161#, 16#00161#), -- LATIN SMALL LETTER S WITH CARON .. LATIN SMALL LETTER S WITH CARON + (16#00163#, 16#00163#), -- LATIN SMALL LETTER T WITH CEDILLA .. LATIN SMALL LETTER T WITH CEDILLA + (16#00165#, 16#00165#), -- LATIN SMALL LETTER T WITH CARON .. LATIN SMALL LETTER T WITH CARON + (16#00167#, 16#00167#), -- LATIN SMALL LETTER T WITH STROKE .. LATIN SMALL LETTER T WITH STROKE + (16#00169#, 16#00169#), -- LATIN SMALL LETTER U WITH TILDE .. LATIN SMALL LETTER U WITH TILDE + (16#0016B#, 16#0016B#), -- LATIN SMALL LETTER U WITH MACRON .. LATIN SMALL LETTER U WITH MACRON + (16#0016D#, 16#0016D#), -- LATIN SMALL LETTER U WITH BREVE .. LATIN SMALL LETTER U WITH BREVE + (16#0016F#, 16#0016F#), -- LATIN SMALL LETTER U WITH RING ABOVE .. LATIN SMALL LETTER U WITH RING ABOVE + (16#00171#, 16#00171#), -- LATIN SMALL LETTER U WITH DOUBLE ACUTE .. LATIN SMALL LETTER U WITH DOUBLE ACUTE + (16#00173#, 16#00173#), -- LATIN SMALL LETTER U WITH OGONEK .. LATIN SMALL LETTER U WITH OGONEK + (16#00175#, 16#00175#), -- LATIN SMALL LETTER W WITH CIRCUMFLEX .. LATIN SMALL LETTER W WITH CIRCUMFLEX + (16#00177#, 16#00177#), -- LATIN SMALL LETTER Y WITH CIRCUMFLEX .. LATIN SMALL LETTER Y WITH CIRCUMFLEX + (16#0017A#, 16#0017A#), -- LATIN SMALL LETTER Z WITH ACUTE .. LATIN SMALL LETTER Z WITH ACUTE + (16#0017C#, 16#0017C#), -- LATIN SMALL LETTER Z WITH DOT ABOVE .. LATIN SMALL LETTER Z WITH DOT ABOVE + (16#0017E#, 16#0017E#), -- LATIN SMALL LETTER Z WITH CARON .. LATIN SMALL LETTER Z WITH CARON + (16#0017F#, 16#0017F#), -- LATIN SMALL LETTER LONG S .. LATIN SMALL LETTER LONG S + (16#00183#, 16#00183#), -- LATIN SMALL LETTER B WITH TOPBAR .. LATIN SMALL LETTER B WITH TOPBAR + (16#00185#, 16#00185#), -- LATIN SMALL LETTER TONE SIX .. LATIN SMALL LETTER TONE SIX + (16#00188#, 16#00188#), -- LATIN SMALL LETTER C WITH HOOK .. LATIN SMALL LETTER C WITH HOOK + (16#0018C#, 16#0018C#), -- LATIN SMALL LETTER D WITH TOPBAR .. LATIN SMALL LETTER D WITH TOPBAR + (16#00192#, 16#00192#), -- LATIN SMALL LETTER F WITH HOOK .. LATIN SMALL LETTER F WITH HOOK + (16#00195#, 16#00195#), -- LATIN SMALL LETTER HV .. LATIN SMALL LETTER HV + (16#00199#, 16#00199#), -- LATIN SMALL LETTER K WITH HOOK .. LATIN SMALL LETTER K WITH HOOK + (16#0019E#, 16#0019E#), -- LATIN SMALL LETTER N WITH LONG RIGHT LEG .. LATIN SMALL LETTER N WITH LONG RIGHT LEG + (16#001A1#, 16#001A1#), -- LATIN SMALL LETTER O WITH HORN .. LATIN SMALL LETTER O WITH HORN + (16#001A3#, 16#001A3#), -- LATIN SMALL LETTER OI .. LATIN SMALL LETTER OI + (16#001A5#, 16#001A5#), -- LATIN SMALL LETTER P WITH HOOK .. LATIN SMALL LETTER P WITH HOOK + (16#001A8#, 16#001A8#), -- LATIN SMALL LETTER TONE TWO .. LATIN SMALL LETTER TONE TWO + (16#001AD#, 16#001AD#), -- LATIN SMALL LETTER T WITH HOOK .. LATIN SMALL LETTER T WITH HOOK + (16#001B0#, 16#001B0#), -- LATIN SMALL LETTER U WITH HORN .. LATIN SMALL LETTER U WITH HORN + (16#001B4#, 16#001B4#), -- LATIN SMALL LETTER Y WITH HOOK .. LATIN SMALL LETTER Y WITH HOOK + (16#001B6#, 16#001B6#), -- LATIN SMALL LETTER Z WITH STROKE .. LATIN SMALL LETTER Z WITH STROKE + (16#001B9#, 16#001B9#), -- LATIN SMALL LETTER EZH REVERSED .. LATIN SMALL LETTER EZH REVERSED + (16#001BD#, 16#001BD#), -- LATIN SMALL LETTER TONE FIVE .. LATIN SMALL LETTER TONE FIVE + (16#001BF#, 16#001BF#), -- LATIN LETTER WYNN .. LATIN LETTER WYNN + (16#001C5#, 16#001C5#), -- LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON + (16#001C6#, 16#001C6#), -- LATIN SMALL LETTER DZ WITH CARON .. LATIN SMALL LETTER DZ WITH CARON + (16#001C8#, 16#001C8#), -- LATIN CAPITAL LETTER L WITH SMALL LETTER J .. LATIN CAPITAL LETTER L WITH SMALL LETTER J + (16#001C9#, 16#001C9#), -- LATIN SMALL LETTER LJ .. LATIN SMALL LETTER LJ + (16#001CB#, 16#001CB#), -- LATIN CAPITAL LETTER N WITH SMALL LETTER J .. LATIN CAPITAL LETTER N WITH SMALL LETTER J + (16#001CC#, 16#001CC#), -- LATIN SMALL LETTER NJ .. LATIN SMALL LETTER NJ + (16#001CE#, 16#001CE#), -- LATIN SMALL LETTER A WITH CARON .. LATIN SMALL LETTER A WITH CARON + (16#001D0#, 16#001D0#), -- LATIN SMALL LETTER I WITH CARON .. LATIN SMALL LETTER I WITH CARON + (16#001D2#, 16#001D2#), -- LATIN SMALL LETTER O WITH CARON .. LATIN SMALL LETTER O WITH CARON + (16#001D4#, 16#001D4#), -- LATIN SMALL LETTER U WITH CARON .. LATIN SMALL LETTER U WITH CARON + (16#001D6#, 16#001D6#), -- LATIN SMALL LETTER U WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER U WITH DIAERESIS AND MACRON + (16#001D8#, 16#001D8#), -- LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE + (16#001DA#, 16#001DA#), -- LATIN SMALL LETTER U WITH DIAERESIS AND CARON .. LATIN SMALL LETTER U WITH DIAERESIS AND CARON + (16#001DC#, 16#001DC#), -- LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE .. LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE + (16#001DD#, 16#001DD#), -- LATIN SMALL LETTER TURNED E .. LATIN SMALL LETTER TURNED E + (16#001DF#, 16#001DF#), -- LATIN SMALL LETTER A WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER A WITH DIAERESIS AND MACRON + (16#001E1#, 16#001E1#), -- LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON + (16#001E3#, 16#001E3#), -- LATIN SMALL LETTER AE WITH MACRON .. LATIN SMALL LETTER AE WITH MACRON + (16#001E5#, 16#001E5#), -- LATIN SMALL LETTER G WITH STROKE .. LATIN SMALL LETTER G WITH STROKE + (16#001E7#, 16#001E7#), -- LATIN SMALL LETTER G WITH CARON .. LATIN SMALL LETTER G WITH CARON + (16#001E9#, 16#001E9#), -- LATIN SMALL LETTER K WITH CARON .. LATIN SMALL LETTER K WITH CARON + (16#001EB#, 16#001EB#), -- LATIN SMALL LETTER O WITH OGONEK .. LATIN SMALL LETTER O WITH OGONEK + (16#001ED#, 16#001ED#), -- LATIN SMALL LETTER O WITH OGONEK AND MACRON .. LATIN SMALL LETTER O WITH OGONEK AND MACRON + (16#001EF#, 16#001EF#), -- LATIN SMALL LETTER EZH WITH CARON .. LATIN SMALL LETTER EZH WITH CARON + (16#001F2#, 16#001F2#), -- LATIN CAPITAL LETTER D WITH SMALL LETTER Z .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z + (16#001F3#, 16#001F3#), -- LATIN SMALL LETTER DZ .. LATIN SMALL LETTER DZ + (16#001F5#, 16#001F5#), -- LATIN SMALL LETTER G WITH ACUTE .. LATIN SMALL LETTER G WITH ACUTE + (16#001F9#, 16#001F9#), -- LATIN SMALL LETTER N WITH GRAVE .. LATIN SMALL LETTER N WITH GRAVE + (16#001FB#, 16#001FB#), -- LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE .. LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE + (16#001FD#, 16#001FD#), -- LATIN SMALL LETTER AE WITH ACUTE .. LATIN SMALL LETTER AE WITH ACUTE + (16#001FF#, 16#001FF#), -- LATIN SMALL LETTER O WITH STROKE AND ACUTE .. LATIN SMALL LETTER O WITH STROKE AND ACUTE + (16#00201#, 16#00201#), -- LATIN SMALL LETTER A WITH DOUBLE GRAVE .. LATIN SMALL LETTER A WITH DOUBLE GRAVE + (16#00203#, 16#00203#), -- LATIN SMALL LETTER A WITH INVERTED BREVE .. LATIN SMALL LETTER A WITH INVERTED BREVE + (16#00205#, 16#00205#), -- LATIN SMALL LETTER E WITH DOUBLE GRAVE .. LATIN SMALL LETTER E WITH DOUBLE GRAVE + (16#00207#, 16#00207#), -- LATIN SMALL LETTER E WITH INVERTED BREVE .. LATIN SMALL LETTER E WITH INVERTED BREVE + (16#00209#, 16#00209#), -- LATIN SMALL LETTER I WITH DOUBLE GRAVE .. LATIN SMALL LETTER I WITH DOUBLE GRAVE + (16#0020B#, 16#0020B#), -- LATIN SMALL LETTER I WITH INVERTED BREVE .. LATIN SMALL LETTER I WITH INVERTED BREVE + (16#0020D#, 16#0020D#), -- LATIN SMALL LETTER O WITH DOUBLE GRAVE .. LATIN SMALL LETTER O WITH DOUBLE GRAVE + (16#0020F#, 16#0020F#), -- LATIN SMALL LETTER O WITH INVERTED BREVE .. LATIN SMALL LETTER O WITH INVERTED BREVE + (16#00211#, 16#00211#), -- LATIN SMALL LETTER R WITH DOUBLE GRAVE .. LATIN SMALL LETTER R WITH DOUBLE GRAVE + (16#00213#, 16#00213#), -- LATIN SMALL LETTER R WITH INVERTED BREVE .. LATIN SMALL LETTER R WITH INVERTED BREVE + (16#00215#, 16#00215#), -- LATIN SMALL LETTER U WITH DOUBLE GRAVE .. LATIN SMALL LETTER U WITH DOUBLE GRAVE + (16#00217#, 16#00217#), -- LATIN SMALL LETTER U WITH INVERTED BREVE .. LATIN SMALL LETTER U WITH INVERTED BREVE + (16#00219#, 16#00219#), -- LATIN SMALL LETTER S WITH COMMA BELOW .. LATIN SMALL LETTER S WITH COMMA BELOW + (16#0021B#, 16#0021B#), -- LATIN SMALL LETTER T WITH COMMA BELOW .. LATIN SMALL LETTER T WITH COMMA BELOW + (16#0021D#, 16#0021D#), -- LATIN SMALL LETTER YOGH .. LATIN SMALL LETTER YOGH + (16#0021F#, 16#0021F#), -- LATIN SMALL LETTER H WITH CARON .. LATIN SMALL LETTER H WITH CARON + (16#00223#, 16#00223#), -- LATIN SMALL LETTER OU .. LATIN SMALL LETTER OU + (16#00225#, 16#00225#), -- LATIN SMALL LETTER Z WITH HOOK .. LATIN SMALL LETTER Z WITH HOOK + (16#00227#, 16#00227#), -- LATIN SMALL LETTER A WITH DOT ABOVE .. LATIN SMALL LETTER A WITH DOT ABOVE + (16#00229#, 16#00229#), -- LATIN SMALL LETTER E WITH CEDILLA .. LATIN SMALL LETTER E WITH CEDILLA + (16#0022B#, 16#0022B#), -- LATIN SMALL LETTER O WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER O WITH DIAERESIS AND MACRON + (16#0022D#, 16#0022D#), -- LATIN SMALL LETTER O WITH TILDE AND MACRON .. LATIN SMALL LETTER O WITH TILDE AND MACRON + (16#0022F#, 16#0022F#), -- LATIN SMALL LETTER O WITH DOT ABOVE .. LATIN SMALL LETTER O WITH DOT ABOVE + (16#00231#, 16#00231#), -- LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON + (16#00233#, 16#00233#), -- LATIN SMALL LETTER Y WITH MACRON .. LATIN SMALL LETTER Y WITH MACRON + (16#00253#, 16#00253#), -- LATIN SMALL LETTER B WITH HOOK .. LATIN SMALL LETTER B WITH HOOK + (16#00254#, 16#00254#), -- LATIN SMALL LETTER OPEN O .. LATIN SMALL LETTER OPEN O + (16#00256#, 16#00257#), -- LATIN SMALL LETTER D WITH TAIL .. LATIN SMALL LETTER D WITH HOOK + (16#00259#, 16#00259#), -- LATIN SMALL LETTER SCHWA .. LATIN SMALL LETTER SCHWA + (16#0025B#, 16#0025B#), -- LATIN SMALL LETTER OPEN E .. LATIN SMALL LETTER OPEN E + (16#00260#, 16#00260#), -- LATIN SMALL LETTER G WITH HOOK .. LATIN SMALL LETTER G WITH HOOK + (16#00263#, 16#00263#), -- LATIN SMALL LETTER GAMMA .. LATIN SMALL LETTER GAMMA + (16#00268#, 16#00268#), -- LATIN SMALL LETTER I WITH STROKE .. LATIN SMALL LETTER I WITH STROKE + (16#00269#, 16#00269#), -- LATIN SMALL LETTER IOTA .. LATIN SMALL LETTER IOTA + (16#0026F#, 16#0026F#), -- LATIN SMALL LETTER TURNED M .. LATIN SMALL LETTER TURNED M + (16#00272#, 16#00272#), -- LATIN SMALL LETTER N WITH LEFT HOOK .. LATIN SMALL LETTER N WITH LEFT HOOK + (16#00275#, 16#00275#), -- LATIN SMALL LETTER BARRED O .. LATIN SMALL LETTER BARRED O + (16#00280#, 16#00280#), -- LATIN LETTER SMALL CAPITAL R .. LATIN LETTER SMALL CAPITAL R + (16#00283#, 16#00283#), -- LATIN SMALL LETTER ESH .. LATIN SMALL LETTER ESH + (16#00288#, 16#00288#), -- LATIN SMALL LETTER T WITH RETROFLEX HOOK .. LATIN SMALL LETTER T WITH RETROFLEX HOOK + (16#0028A#, 16#0028B#), -- LATIN SMALL LETTER UPSILON .. LATIN SMALL LETTER V WITH HOOK + (16#00292#, 16#00292#), -- LATIN SMALL LETTER EZH .. LATIN SMALL LETTER EZH + (16#003AC#, 16#003AC#), -- GREEK SMALL LETTER ALPHA WITH TONOS .. GREEK SMALL LETTER ALPHA WITH TONOS + (16#003AD#, 16#003AF#), -- GREEK SMALL LETTER EPSILON WITH TONOS .. GREEK SMALL LETTER IOTA WITH TONOS + (16#003B1#, 16#003C1#), -- GREEK SMALL LETTER ALPHA .. GREEK SMALL LETTER RHO + (16#003C2#, 16#003C2#), -- GREEK SMALL LETTER FINAL SIGMA .. GREEK SMALL LETTER FINAL SIGMA + (16#003C3#, 16#003CB#), -- GREEK SMALL LETTER SIGMA .. GREEK SMALL LETTER UPSILON WITH DIALYTIKA + (16#003CC#, 16#003CC#), -- GREEK SMALL LETTER OMICRON WITH TONOS .. GREEK SMALL LETTER OMICRON WITH TONOS + (16#003CD#, 16#003CE#), -- GREEK SMALL LETTER UPSILON WITH TONOS .. GREEK SMALL LETTER OMEGA WITH TONOS + (16#003D0#, 16#003D0#), -- GREEK BETA SYMBOL .. GREEK BETA SYMBOL + (16#003D1#, 16#003D1#), -- GREEK THETA SYMBOL .. GREEK THETA SYMBOL + (16#003D5#, 16#003D5#), -- GREEK PHI SYMBOL .. GREEK PHI SYMBOL + (16#003D6#, 16#003D6#), -- GREEK PI SYMBOL .. GREEK PI SYMBOL + (16#003D9#, 16#003D9#), -- GREEK SMALL LETTER ARCHAIC KOPPA .. GREEK SMALL LETTER ARCHAIC KOPPA + (16#003DB#, 16#003DB#), -- GREEK SMALL LETTER STIGMA .. GREEK SMALL LETTER STIGMA + (16#003DD#, 16#003DD#), -- GREEK SMALL LETTER DIGAMMA .. GREEK SMALL LETTER DIGAMMA + (16#003DF#, 16#003DF#), -- GREEK SMALL LETTER KOPPA .. GREEK SMALL LETTER KOPPA + (16#003E1#, 16#003E1#), -- GREEK SMALL LETTER SAMPI .. GREEK SMALL LETTER SAMPI + (16#003E3#, 16#003E3#), -- COPTIC SMALL LETTER SHEI .. COPTIC SMALL LETTER SHEI + (16#003E5#, 16#003E5#), -- COPTIC SMALL LETTER FEI .. COPTIC SMALL LETTER FEI + (16#003E7#, 16#003E7#), -- COPTIC SMALL LETTER KHEI .. COPTIC SMALL LETTER KHEI + (16#003E9#, 16#003E9#), -- COPTIC SMALL LETTER HORI .. COPTIC SMALL LETTER HORI + (16#003EB#, 16#003EB#), -- COPTIC SMALL LETTER GANGIA .. COPTIC SMALL LETTER GANGIA + (16#003ED#, 16#003ED#), -- COPTIC SMALL LETTER SHIMA .. COPTIC SMALL LETTER SHIMA + (16#003EF#, 16#003EF#), -- COPTIC SMALL LETTER DEI .. COPTIC SMALL LETTER DEI + (16#003F0#, 16#003F0#), -- GREEK KAPPA SYMBOL .. GREEK KAPPA SYMBOL + (16#003F1#, 16#003F1#), -- GREEK RHO SYMBOL .. GREEK RHO SYMBOL + (16#003F2#, 16#003F2#), -- GREEK LUNATE SIGMA SYMBOL .. GREEK LUNATE SIGMA SYMBOL + (16#003F5#, 16#003F5#), -- GREEK LUNATE EPSILON SYMBOL .. GREEK LUNATE EPSILON SYMBOL + (16#00430#, 16#0044F#), -- CYRILLIC SMALL LETTER A .. CYRILLIC SMALL LETTER YA + (16#00450#, 16#0045F#), -- CYRILLIC SMALL LETTER IE WITH GRAVE .. CYRILLIC SMALL LETTER DZHE + (16#00461#, 16#00461#), -- CYRILLIC SMALL LETTER OMEGA .. CYRILLIC SMALL LETTER OMEGA + (16#00463#, 16#00463#), -- CYRILLIC SMALL LETTER YAT .. CYRILLIC SMALL LETTER YAT + (16#00465#, 16#00465#), -- CYRILLIC SMALL LETTER IOTIFIED E .. CYRILLIC SMALL LETTER IOTIFIED E + (16#00467#, 16#00467#), -- CYRILLIC SMALL LETTER LITTLE YUS .. CYRILLIC SMALL LETTER LITTLE YUS + (16#00469#, 16#00469#), -- CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS .. CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS + (16#0046B#, 16#0046B#), -- CYRILLIC SMALL LETTER BIG YUS .. CYRILLIC SMALL LETTER BIG YUS + (16#0046D#, 16#0046D#), -- CYRILLIC SMALL LETTER IOTIFIED BIG YUS .. CYRILLIC SMALL LETTER IOTIFIED BIG YUS + (16#0046F#, 16#0046F#), -- CYRILLIC SMALL LETTER KSI .. CYRILLIC SMALL LETTER KSI + (16#00471#, 16#00471#), -- CYRILLIC SMALL LETTER PSI .. CYRILLIC SMALL LETTER PSI + (16#00473#, 16#00473#), -- CYRILLIC SMALL LETTER FITA .. CYRILLIC SMALL LETTER FITA + (16#00475#, 16#00475#), -- CYRILLIC SMALL LETTER IZHITSA .. CYRILLIC SMALL LETTER IZHITSA + (16#00477#, 16#00477#), -- CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT .. CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT + (16#00479#, 16#00479#), -- CYRILLIC SMALL LETTER UK .. CYRILLIC SMALL LETTER UK + (16#0047B#, 16#0047B#), -- CYRILLIC SMALL LETTER ROUND OMEGA .. CYRILLIC SMALL LETTER ROUND OMEGA + (16#0047D#, 16#0047D#), -- CYRILLIC SMALL LETTER OMEGA WITH TITLO .. CYRILLIC SMALL LETTER OMEGA WITH TITLO + (16#0047F#, 16#0047F#), -- CYRILLIC SMALL LETTER OT .. CYRILLIC SMALL LETTER OT + (16#00481#, 16#00481#), -- CYRILLIC SMALL LETTER KOPPA .. CYRILLIC SMALL LETTER KOPPA + (16#0048B#, 16#0048B#), -- CYRILLIC SMALL LETTER SHORT I WITH TAIL .. CYRILLIC SMALL LETTER SHORT I WITH TAIL + (16#0048D#, 16#0048D#), -- CYRILLIC SMALL LETTER SEMISOFT SIGN .. CYRILLIC SMALL LETTER SEMISOFT SIGN + (16#0048F#, 16#0048F#), -- CYRILLIC SMALL LETTER ER WITH TICK .. CYRILLIC SMALL LETTER ER WITH TICK + (16#00491#, 16#00491#), -- CYRILLIC SMALL LETTER GHE WITH UPTURN .. CYRILLIC SMALL LETTER GHE WITH UPTURN + (16#00493#, 16#00493#), -- CYRILLIC SMALL LETTER GHE WITH STROKE .. CYRILLIC SMALL LETTER GHE WITH STROKE + (16#00495#, 16#00495#), -- CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK + (16#00497#, 16#00497#), -- CYRILLIC SMALL LETTER ZHE WITH DESCENDER .. CYRILLIC SMALL LETTER ZHE WITH DESCENDER + (16#00499#, 16#00499#), -- CYRILLIC SMALL LETTER ZE WITH DESCENDER .. CYRILLIC SMALL LETTER ZE WITH DESCENDER + (16#0049B#, 16#0049B#), -- CYRILLIC SMALL LETTER KA WITH DESCENDER .. CYRILLIC SMALL LETTER KA WITH DESCENDER + (16#0049D#, 16#0049D#), -- CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE + (16#0049F#, 16#0049F#), -- CYRILLIC SMALL LETTER KA WITH STROKE .. CYRILLIC SMALL LETTER KA WITH STROKE + (16#004A1#, 16#004A1#), -- CYRILLIC SMALL LETTER BASHKIR KA .. CYRILLIC SMALL LETTER BASHKIR KA + (16#004A3#, 16#004A3#), -- CYRILLIC SMALL LETTER EN WITH DESCENDER .. CYRILLIC SMALL LETTER EN WITH DESCENDER + (16#004A5#, 16#004A5#), -- CYRILLIC SMALL LIGATURE EN GHE .. CYRILLIC SMALL LIGATURE EN GHE + (16#004A7#, 16#004A7#), -- CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK + (16#004A9#, 16#004A9#), -- CYRILLIC SMALL LETTER ABKHASIAN HA .. CYRILLIC SMALL LETTER ABKHASIAN HA + (16#004AB#, 16#004AB#), -- CYRILLIC SMALL LETTER ES WITH DESCENDER .. CYRILLIC SMALL LETTER ES WITH DESCENDER + (16#004AD#, 16#004AD#), -- CYRILLIC SMALL LETTER TE WITH DESCENDER .. CYRILLIC SMALL LETTER TE WITH DESCENDER + (16#004AF#, 16#004AF#), -- CYRILLIC SMALL LETTER STRAIGHT U .. CYRILLIC SMALL LETTER STRAIGHT U + (16#004B1#, 16#004B1#), -- CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE .. CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE + (16#004B3#, 16#004B3#), -- CYRILLIC SMALL LETTER HA WITH DESCENDER .. CYRILLIC SMALL LETTER HA WITH DESCENDER + (16#004B5#, 16#004B5#), -- CYRILLIC SMALL LIGATURE TE TSE .. CYRILLIC SMALL LIGATURE TE TSE + (16#004B7#, 16#004B7#), -- CYRILLIC SMALL LETTER CHE WITH DESCENDER .. CYRILLIC SMALL LETTER CHE WITH DESCENDER + (16#004B9#, 16#004B9#), -- CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE + (16#004BB#, 16#004BB#), -- CYRILLIC SMALL LETTER SHHA .. CYRILLIC SMALL LETTER SHHA + (16#004BD#, 16#004BD#), -- CYRILLIC SMALL LETTER ABKHASIAN CHE .. CYRILLIC SMALL LETTER ABKHASIAN CHE + (16#004BF#, 16#004BF#), -- CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER .. CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER + (16#004C2#, 16#004C2#), -- CYRILLIC SMALL LETTER ZHE WITH BREVE .. CYRILLIC SMALL LETTER ZHE WITH BREVE + (16#004C4#, 16#004C4#), -- CYRILLIC SMALL LETTER KA WITH HOOK .. CYRILLIC SMALL LETTER KA WITH HOOK + (16#004C6#, 16#004C6#), -- CYRILLIC SMALL LETTER EL WITH TAIL .. CYRILLIC SMALL LETTER EL WITH TAIL + (16#004C8#, 16#004C8#), -- CYRILLIC SMALL LETTER EN WITH HOOK .. CYRILLIC SMALL LETTER EN WITH HOOK + (16#004CA#, 16#004CA#), -- CYRILLIC SMALL LETTER EN WITH TAIL .. CYRILLIC SMALL LETTER EN WITH TAIL + (16#004CC#, 16#004CC#), -- CYRILLIC SMALL LETTER KHAKASSIAN CHE .. CYRILLIC SMALL LETTER KHAKASSIAN CHE + (16#004CE#, 16#004CE#), -- CYRILLIC SMALL LETTER EM WITH TAIL .. CYRILLIC SMALL LETTER EM WITH TAIL + (16#004D1#, 16#004D1#), -- CYRILLIC SMALL LETTER A WITH BREVE .. CYRILLIC SMALL LETTER A WITH BREVE + (16#004D3#, 16#004D3#), -- CYRILLIC SMALL LETTER A WITH DIAERESIS .. CYRILLIC SMALL LETTER A WITH DIAERESIS + (16#004D5#, 16#004D5#), -- CYRILLIC SMALL LIGATURE A IE .. CYRILLIC SMALL LIGATURE A IE + (16#004D7#, 16#004D7#), -- CYRILLIC SMALL LETTER IE WITH BREVE .. CYRILLIC SMALL LETTER IE WITH BREVE + (16#004D9#, 16#004D9#), -- CYRILLIC SMALL LETTER SCHWA .. CYRILLIC SMALL LETTER SCHWA + (16#004DB#, 16#004DB#), -- CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS .. CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS + (16#004DD#, 16#004DD#), -- CYRILLIC SMALL LETTER ZHE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZHE WITH DIAERESIS + (16#004DF#, 16#004DF#), -- CYRILLIC SMALL LETTER ZE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZE WITH DIAERESIS + (16#004E1#, 16#004E1#), -- CYRILLIC SMALL LETTER ABKHASIAN DZE .. CYRILLIC SMALL LETTER ABKHASIAN DZE + (16#004E3#, 16#004E3#), -- CYRILLIC SMALL LETTER I WITH MACRON .. CYRILLIC SMALL LETTER I WITH MACRON + (16#004E5#, 16#004E5#), -- CYRILLIC SMALL LETTER I WITH DIAERESIS .. CYRILLIC SMALL LETTER I WITH DIAERESIS + (16#004E7#, 16#004E7#), -- CYRILLIC SMALL LETTER O WITH DIAERESIS .. CYRILLIC SMALL LETTER O WITH DIAERESIS + (16#004E9#, 16#004E9#), -- CYRILLIC SMALL LETTER BARRED O .. CYRILLIC SMALL LETTER BARRED O + (16#004EB#, 16#004EB#), -- CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS .. CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS + (16#004ED#, 16#004ED#), -- CYRILLIC SMALL LETTER E WITH DIAERESIS .. CYRILLIC SMALL LETTER E WITH DIAERESIS + (16#004EF#, 16#004EF#), -- CYRILLIC SMALL LETTER U WITH MACRON .. CYRILLIC SMALL LETTER U WITH MACRON + (16#004F1#, 16#004F1#), -- CYRILLIC SMALL LETTER U WITH DIAERESIS .. CYRILLIC SMALL LETTER U WITH DIAERESIS + (16#004F3#, 16#004F3#), -- CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE .. CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE + (16#004F5#, 16#004F5#), -- CYRILLIC SMALL LETTER CHE WITH DIAERESIS .. CYRILLIC SMALL LETTER CHE WITH DIAERESIS + (16#004F9#, 16#004F9#), -- CYRILLIC SMALL LETTER YERU WITH DIAERESIS .. CYRILLIC SMALL LETTER YERU WITH DIAERESIS + (16#00501#, 16#00501#), -- CYRILLIC SMALL LETTER KOMI DE .. CYRILLIC SMALL LETTER KOMI DE + (16#00503#, 16#00503#), -- CYRILLIC SMALL LETTER KOMI DJE .. CYRILLIC SMALL LETTER KOMI DJE + (16#00505#, 16#00505#), -- CYRILLIC SMALL LETTER KOMI ZJE .. CYRILLIC SMALL LETTER KOMI ZJE + (16#00507#, 16#00507#), -- CYRILLIC SMALL LETTER KOMI DZJE .. CYRILLIC SMALL LETTER KOMI DZJE + (16#00509#, 16#00509#), -- CYRILLIC SMALL LETTER KOMI LJE .. CYRILLIC SMALL LETTER KOMI LJE + (16#0050B#, 16#0050B#), -- CYRILLIC SMALL LETTER KOMI NJE .. CYRILLIC SMALL LETTER KOMI NJE + (16#0050D#, 16#0050D#), -- CYRILLIC SMALL LETTER KOMI SJE .. CYRILLIC SMALL LETTER KOMI SJE + (16#0050F#, 16#0050F#), -- CYRILLIC SMALL LETTER KOMI TJE .. CYRILLIC SMALL LETTER KOMI TJE + (16#00561#, 16#00586#), -- ARMENIAN SMALL LETTER AYB .. ARMENIAN SMALL LETTER FEH + (16#01E01#, 16#01E01#), -- LATIN SMALL LETTER A WITH RING BELOW .. LATIN SMALL LETTER A WITH RING BELOW + (16#01E03#, 16#01E03#), -- LATIN SMALL LETTER B WITH DOT ABOVE .. LATIN SMALL LETTER B WITH DOT ABOVE + (16#01E05#, 16#01E05#), -- LATIN SMALL LETTER B WITH DOT BELOW .. LATIN SMALL LETTER B WITH DOT BELOW + (16#01E07#, 16#01E07#), -- LATIN SMALL LETTER B WITH LINE BELOW .. LATIN SMALL LETTER B WITH LINE BELOW + (16#01E09#, 16#01E09#), -- LATIN SMALL LETTER C WITH CEDILLA AND ACUTE .. LATIN SMALL LETTER C WITH CEDILLA AND ACUTE + (16#01E0B#, 16#01E0B#), -- LATIN SMALL LETTER D WITH DOT ABOVE .. LATIN SMALL LETTER D WITH DOT ABOVE + (16#01E0D#, 16#01E0D#), -- LATIN SMALL LETTER D WITH DOT BELOW .. LATIN SMALL LETTER D WITH DOT BELOW + (16#01E0F#, 16#01E0F#), -- LATIN SMALL LETTER D WITH LINE BELOW .. LATIN SMALL LETTER D WITH LINE BELOW + (16#01E11#, 16#01E11#), -- LATIN SMALL LETTER D WITH CEDILLA .. LATIN SMALL LETTER D WITH CEDILLA + (16#01E13#, 16#01E13#), -- LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW + (16#01E15#, 16#01E15#), -- LATIN SMALL LETTER E WITH MACRON AND GRAVE .. LATIN SMALL LETTER E WITH MACRON AND GRAVE + (16#01E17#, 16#01E17#), -- LATIN SMALL LETTER E WITH MACRON AND ACUTE .. LATIN SMALL LETTER E WITH MACRON AND ACUTE + (16#01E19#, 16#01E19#), -- LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW + (16#01E1B#, 16#01E1B#), -- LATIN SMALL LETTER E WITH TILDE BELOW .. LATIN SMALL LETTER E WITH TILDE BELOW + (16#01E1D#, 16#01E1D#), -- LATIN SMALL LETTER E WITH CEDILLA AND BREVE .. LATIN SMALL LETTER E WITH CEDILLA AND BREVE + (16#01E1F#, 16#01E1F#), -- LATIN SMALL LETTER F WITH DOT ABOVE .. LATIN SMALL LETTER F WITH DOT ABOVE + (16#01E21#, 16#01E21#), -- LATIN SMALL LETTER G WITH MACRON .. LATIN SMALL LETTER G WITH MACRON + (16#01E23#, 16#01E23#), -- LATIN SMALL LETTER H WITH DOT ABOVE .. LATIN SMALL LETTER H WITH DOT ABOVE + (16#01E25#, 16#01E25#), -- LATIN SMALL LETTER H WITH DOT BELOW .. LATIN SMALL LETTER H WITH DOT BELOW + (16#01E27#, 16#01E27#), -- LATIN SMALL LETTER H WITH DIAERESIS .. LATIN SMALL LETTER H WITH DIAERESIS + (16#01E29#, 16#01E29#), -- LATIN SMALL LETTER H WITH CEDILLA .. LATIN SMALL LETTER H WITH CEDILLA + (16#01E2B#, 16#01E2B#), -- LATIN SMALL LETTER H WITH BREVE BELOW .. LATIN SMALL LETTER H WITH BREVE BELOW + (16#01E2D#, 16#01E2D#), -- LATIN SMALL LETTER I WITH TILDE BELOW .. LATIN SMALL LETTER I WITH TILDE BELOW + (16#01E2F#, 16#01E2F#), -- LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE + (16#01E31#, 16#01E31#), -- LATIN SMALL LETTER K WITH ACUTE .. LATIN SMALL LETTER K WITH ACUTE + (16#01E33#, 16#01E33#), -- LATIN SMALL LETTER K WITH DOT BELOW .. LATIN SMALL LETTER K WITH DOT BELOW + (16#01E35#, 16#01E35#), -- LATIN SMALL LETTER K WITH LINE BELOW .. LATIN SMALL LETTER K WITH LINE BELOW + (16#01E37#, 16#01E37#), -- LATIN SMALL LETTER L WITH DOT BELOW .. LATIN SMALL LETTER L WITH DOT BELOW + (16#01E39#, 16#01E39#), -- LATIN SMALL LETTER L WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER L WITH DOT BELOW AND MACRON + (16#01E3B#, 16#01E3B#), -- LATIN SMALL LETTER L WITH LINE BELOW .. LATIN SMALL LETTER L WITH LINE BELOW + (16#01E3D#, 16#01E3D#), -- LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW + (16#01E3F#, 16#01E3F#), -- LATIN SMALL LETTER M WITH ACUTE .. LATIN SMALL LETTER M WITH ACUTE + (16#01E41#, 16#01E41#), -- LATIN SMALL LETTER M WITH DOT ABOVE .. LATIN SMALL LETTER M WITH DOT ABOVE + (16#01E43#, 16#01E43#), -- LATIN SMALL LETTER M WITH DOT BELOW .. LATIN SMALL LETTER M WITH DOT BELOW + (16#01E45#, 16#01E45#), -- LATIN SMALL LETTER N WITH DOT ABOVE .. LATIN SMALL LETTER N WITH DOT ABOVE + (16#01E47#, 16#01E47#), -- LATIN SMALL LETTER N WITH DOT BELOW .. LATIN SMALL LETTER N WITH DOT BELOW + (16#01E49#, 16#01E49#), -- LATIN SMALL LETTER N WITH LINE BELOW .. LATIN SMALL LETTER N WITH LINE BELOW + (16#01E4B#, 16#01E4B#), -- LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW + (16#01E4D#, 16#01E4D#), -- LATIN SMALL LETTER O WITH TILDE AND ACUTE .. LATIN SMALL LETTER O WITH TILDE AND ACUTE + (16#01E4F#, 16#01E4F#), -- LATIN SMALL LETTER O WITH TILDE AND DIAERESIS .. LATIN SMALL LETTER O WITH TILDE AND DIAERESIS + (16#01E51#, 16#01E51#), -- LATIN SMALL LETTER O WITH MACRON AND GRAVE .. LATIN SMALL LETTER O WITH MACRON AND GRAVE + (16#01E53#, 16#01E53#), -- LATIN SMALL LETTER O WITH MACRON AND ACUTE .. LATIN SMALL LETTER O WITH MACRON AND ACUTE + (16#01E55#, 16#01E55#), -- LATIN SMALL LETTER P WITH ACUTE .. LATIN SMALL LETTER P WITH ACUTE + (16#01E57#, 16#01E57#), -- LATIN SMALL LETTER P WITH DOT ABOVE .. LATIN SMALL LETTER P WITH DOT ABOVE + (16#01E59#, 16#01E59#), -- LATIN SMALL LETTER R WITH DOT ABOVE .. LATIN SMALL LETTER R WITH DOT ABOVE + (16#01E5B#, 16#01E5B#), -- LATIN SMALL LETTER R WITH DOT BELOW .. LATIN SMALL LETTER R WITH DOT BELOW + (16#01E5D#, 16#01E5D#), -- LATIN SMALL LETTER R WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER R WITH DOT BELOW AND MACRON + (16#01E5F#, 16#01E5F#), -- LATIN SMALL LETTER R WITH LINE BELOW .. LATIN SMALL LETTER R WITH LINE BELOW + (16#01E61#, 16#01E61#), -- LATIN SMALL LETTER S WITH DOT ABOVE .. LATIN SMALL LETTER S WITH DOT ABOVE + (16#01E63#, 16#01E63#), -- LATIN SMALL LETTER S WITH DOT BELOW .. LATIN SMALL LETTER S WITH DOT BELOW + (16#01E65#, 16#01E65#), -- LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE .. LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE + (16#01E67#, 16#01E67#), -- LATIN SMALL LETTER S WITH CARON AND DOT ABOVE .. LATIN SMALL LETTER S WITH CARON AND DOT ABOVE + (16#01E69#, 16#01E69#), -- LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE .. LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE + (16#01E6B#, 16#01E6B#), -- LATIN SMALL LETTER T WITH DOT ABOVE .. LATIN SMALL LETTER T WITH DOT ABOVE + (16#01E6D#, 16#01E6D#), -- LATIN SMALL LETTER T WITH DOT BELOW .. LATIN SMALL LETTER T WITH DOT BELOW + (16#01E6F#, 16#01E6F#), -- LATIN SMALL LETTER T WITH LINE BELOW .. LATIN SMALL LETTER T WITH LINE BELOW + (16#01E71#, 16#01E71#), -- LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW + (16#01E73#, 16#01E73#), -- LATIN SMALL LETTER U WITH DIAERESIS BELOW .. LATIN SMALL LETTER U WITH DIAERESIS BELOW + (16#01E75#, 16#01E75#), -- LATIN SMALL LETTER U WITH TILDE BELOW .. LATIN SMALL LETTER U WITH TILDE BELOW + (16#01E77#, 16#01E77#), -- LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW + (16#01E79#, 16#01E79#), -- LATIN SMALL LETTER U WITH TILDE AND ACUTE .. LATIN SMALL LETTER U WITH TILDE AND ACUTE + (16#01E7B#, 16#01E7B#), -- LATIN SMALL LETTER U WITH MACRON AND DIAERESIS .. LATIN SMALL LETTER U WITH MACRON AND DIAERESIS + (16#01E7D#, 16#01E7D#), -- LATIN SMALL LETTER V WITH TILDE .. LATIN SMALL LETTER V WITH TILDE + (16#01E7F#, 16#01E7F#), -- LATIN SMALL LETTER V WITH DOT BELOW .. LATIN SMALL LETTER V WITH DOT BELOW + (16#01E81#, 16#01E81#), -- LATIN SMALL LETTER W WITH GRAVE .. LATIN SMALL LETTER W WITH GRAVE + (16#01E83#, 16#01E83#), -- LATIN SMALL LETTER W WITH ACUTE .. LATIN SMALL LETTER W WITH ACUTE + (16#01E85#, 16#01E85#), -- LATIN SMALL LETTER W WITH DIAERESIS .. LATIN SMALL LETTER W WITH DIAERESIS + (16#01E87#, 16#01E87#), -- LATIN SMALL LETTER W WITH DOT ABOVE .. LATIN SMALL LETTER W WITH DOT ABOVE + (16#01E89#, 16#01E89#), -- LATIN SMALL LETTER W WITH DOT BELOW .. LATIN SMALL LETTER W WITH DOT BELOW + (16#01E8B#, 16#01E8B#), -- LATIN SMALL LETTER X WITH DOT ABOVE .. LATIN SMALL LETTER X WITH DOT ABOVE + (16#01E8D#, 16#01E8D#), -- LATIN SMALL LETTER X WITH DIAERESIS .. LATIN SMALL LETTER X WITH DIAERESIS + (16#01E8F#, 16#01E8F#), -- LATIN SMALL LETTER Y WITH DOT ABOVE .. LATIN SMALL LETTER Y WITH DOT ABOVE + (16#01E91#, 16#01E91#), -- LATIN SMALL LETTER Z WITH CIRCUMFLEX .. LATIN SMALL LETTER Z WITH CIRCUMFLEX + (16#01E93#, 16#01E93#), -- LATIN SMALL LETTER Z WITH DOT BELOW .. LATIN SMALL LETTER Z WITH DOT BELOW + (16#01E95#, 16#01E95#), -- LATIN SMALL LETTER Z WITH LINE BELOW .. LATIN SMALL LETTER Z WITH LINE BELOW + (16#01E9B#, 16#01E9B#), -- LATIN SMALL LETTER LONG S WITH DOT ABOVE .. LATIN SMALL LETTER LONG S WITH DOT ABOVE + (16#01EA1#, 16#01EA1#), -- LATIN SMALL LETTER A WITH DOT BELOW .. LATIN SMALL LETTER A WITH DOT BELOW + (16#01EA3#, 16#01EA3#), -- LATIN SMALL LETTER A WITH HOOK ABOVE .. LATIN SMALL LETTER A WITH HOOK ABOVE + (16#01EA5#, 16#01EA5#), -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE + (16#01EA7#, 16#01EA7#), -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE + (16#01EA9#, 16#01EA9#), -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE + (16#01EAB#, 16#01EAB#), -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE + (16#01EAD#, 16#01EAD#), -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW + (16#01EAF#, 16#01EAF#), -- LATIN SMALL LETTER A WITH BREVE AND ACUTE .. LATIN SMALL LETTER A WITH BREVE AND ACUTE + (16#01EB1#, 16#01EB1#), -- LATIN SMALL LETTER A WITH BREVE AND GRAVE .. LATIN SMALL LETTER A WITH BREVE AND GRAVE + (16#01EB3#, 16#01EB3#), -- LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE .. LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE + (16#01EB5#, 16#01EB5#), -- LATIN SMALL LETTER A WITH BREVE AND TILDE .. LATIN SMALL LETTER A WITH BREVE AND TILDE + (16#01EB7#, 16#01EB7#), -- LATIN SMALL LETTER A WITH BREVE AND DOT BELOW .. LATIN SMALL LETTER A WITH BREVE AND DOT BELOW + (16#01EB9#, 16#01EB9#), -- LATIN SMALL LETTER E WITH DOT BELOW .. LATIN SMALL LETTER E WITH DOT BELOW + (16#01EBB#, 16#01EBB#), -- LATIN SMALL LETTER E WITH HOOK ABOVE .. LATIN SMALL LETTER E WITH HOOK ABOVE + (16#01EBD#, 16#01EBD#), -- LATIN SMALL LETTER E WITH TILDE .. LATIN SMALL LETTER E WITH TILDE + (16#01EBF#, 16#01EBF#), -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE + (16#01EC1#, 16#01EC1#), -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE + (16#01EC3#, 16#01EC3#), -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE + (16#01EC5#, 16#01EC5#), -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE + (16#01EC7#, 16#01EC7#), -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW + (16#01EC9#, 16#01EC9#), -- LATIN SMALL LETTER I WITH HOOK ABOVE .. LATIN SMALL LETTER I WITH HOOK ABOVE + (16#01ECB#, 16#01ECB#), -- LATIN SMALL LETTER I WITH DOT BELOW .. LATIN SMALL LETTER I WITH DOT BELOW + (16#01ECD#, 16#01ECD#), -- LATIN SMALL LETTER O WITH DOT BELOW .. LATIN SMALL LETTER O WITH DOT BELOW + (16#01ECF#, 16#01ECF#), -- LATIN SMALL LETTER O WITH HOOK ABOVE .. LATIN SMALL LETTER O WITH HOOK ABOVE + (16#01ED1#, 16#01ED1#), -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE + (16#01ED3#, 16#01ED3#), -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE + (16#01ED5#, 16#01ED5#), -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE + (16#01ED7#, 16#01ED7#), -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE + (16#01ED9#, 16#01ED9#), -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW + (16#01EDB#, 16#01EDB#), -- LATIN SMALL LETTER O WITH HORN AND ACUTE .. LATIN SMALL LETTER O WITH HORN AND ACUTE + (16#01EDD#, 16#01EDD#), -- LATIN SMALL LETTER O WITH HORN AND GRAVE .. LATIN SMALL LETTER O WITH HORN AND GRAVE + (16#01EDF#, 16#01EDF#), -- LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE + (16#01EE1#, 16#01EE1#), -- LATIN SMALL LETTER O WITH HORN AND TILDE .. LATIN SMALL LETTER O WITH HORN AND TILDE + (16#01EE3#, 16#01EE3#), -- LATIN SMALL LETTER O WITH HORN AND DOT BELOW .. LATIN SMALL LETTER O WITH HORN AND DOT BELOW + (16#01EE5#, 16#01EE5#), -- LATIN SMALL LETTER U WITH DOT BELOW .. LATIN SMALL LETTER U WITH DOT BELOW + (16#01EE7#, 16#01EE7#), -- LATIN SMALL LETTER U WITH HOOK ABOVE .. LATIN SMALL LETTER U WITH HOOK ABOVE + (16#01EE9#, 16#01EE9#), -- LATIN SMALL LETTER U WITH HORN AND ACUTE .. LATIN SMALL LETTER U WITH HORN AND ACUTE + (16#01EEB#, 16#01EEB#), -- LATIN SMALL LETTER U WITH HORN AND GRAVE .. LATIN SMALL LETTER U WITH HORN AND GRAVE + (16#01EED#, 16#01EED#), -- LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE + (16#01EEF#, 16#01EEF#), -- LATIN SMALL LETTER U WITH HORN AND TILDE .. LATIN SMALL LETTER U WITH HORN AND TILDE + (16#01EF1#, 16#01EF1#), -- LATIN SMALL LETTER U WITH HORN AND DOT BELOW .. LATIN SMALL LETTER U WITH HORN AND DOT BELOW + (16#01EF3#, 16#01EF3#), -- LATIN SMALL LETTER Y WITH GRAVE .. LATIN SMALL LETTER Y WITH GRAVE + (16#01EF5#, 16#01EF5#), -- LATIN SMALL LETTER Y WITH DOT BELOW .. LATIN SMALL LETTER Y WITH DOT BELOW + (16#01EF7#, 16#01EF7#), -- LATIN SMALL LETTER Y WITH HOOK ABOVE .. LATIN SMALL LETTER Y WITH HOOK ABOVE + (16#01EF9#, 16#01EF9#), -- LATIN SMALL LETTER Y WITH TILDE .. LATIN SMALL LETTER Y WITH TILDE + (16#01F00#, 16#01F07#), -- GREEK SMALL LETTER ALPHA WITH PSILI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI + (16#01F10#, 16#01F15#), -- GREEK SMALL LETTER EPSILON WITH PSILI .. GREEK SMALL LETTER EPSILON WITH DASIA AND OXIA + (16#01F20#, 16#01F27#), -- GREEK SMALL LETTER ETA WITH PSILI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI + (16#01F30#, 16#01F37#), -- GREEK SMALL LETTER IOTA WITH PSILI .. GREEK SMALL LETTER IOTA WITH DASIA AND PERISPOMENI + (16#01F40#, 16#01F45#), -- GREEK SMALL LETTER OMICRON WITH PSILI .. GREEK SMALL LETTER OMICRON WITH DASIA AND OXIA + (16#01F51#, 16#01F51#), -- GREEK SMALL LETTER UPSILON WITH DASIA .. GREEK SMALL LETTER UPSILON WITH DASIA + (16#01F53#, 16#01F53#), -- GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA .. GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA + (16#01F55#, 16#01F55#), -- GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA .. GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA + (16#01F57#, 16#01F57#), -- GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI .. GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI + (16#01F60#, 16#01F67#), -- GREEK SMALL LETTER OMEGA WITH PSILI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI + (16#01F70#, 16#01F71#), -- GREEK SMALL LETTER ALPHA WITH VARIA .. GREEK SMALL LETTER ALPHA WITH OXIA + (16#01F72#, 16#01F75#), -- GREEK SMALL LETTER EPSILON WITH VARIA .. GREEK SMALL LETTER ETA WITH OXIA + (16#01F76#, 16#01F77#), -- GREEK SMALL LETTER IOTA WITH VARIA .. GREEK SMALL LETTER IOTA WITH OXIA + (16#01F78#, 16#01F79#), -- GREEK SMALL LETTER OMICRON WITH VARIA .. GREEK SMALL LETTER OMICRON WITH OXIA + (16#01F7A#, 16#01F7B#), -- GREEK SMALL LETTER UPSILON WITH VARIA .. GREEK SMALL LETTER UPSILON WITH OXIA + (16#01F7C#, 16#01F7D#), -- GREEK SMALL LETTER OMEGA WITH VARIA .. GREEK SMALL LETTER OMEGA WITH OXIA + (16#01F80#, 16#01F87#), -- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI + (16#01F90#, 16#01F97#), -- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI + (16#01FA0#, 16#01FA7#), -- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI + (16#01FB0#, 16#01FB1#), -- GREEK SMALL LETTER ALPHA WITH VRACHY .. GREEK SMALL LETTER ALPHA WITH MACRON + (16#01FB3#, 16#01FB3#), -- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI + (16#01FBE#, 16#01FBE#), -- GREEK PROSGEGRAMMENI .. GREEK PROSGEGRAMMENI + (16#01FC3#, 16#01FC3#), -- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI + (16#01FD0#, 16#01FD1#), -- GREEK SMALL LETTER IOTA WITH VRACHY .. GREEK SMALL LETTER IOTA WITH MACRON + (16#01FE0#, 16#01FE1#), -- GREEK SMALL LETTER UPSILON WITH VRACHY .. GREEK SMALL LETTER UPSILON WITH MACRON + (16#01FE5#, 16#01FE5#), -- GREEK SMALL LETTER RHO WITH DASIA .. GREEK SMALL LETTER RHO WITH DASIA + (16#01FF3#, 16#01FF3#), -- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI + (16#0FF41#, 16#0FF5A#), -- FULLWIDTH LATIN SMALL LETTER A .. FULLWIDTH LATIN SMALL LETTER Z + (16#10428#, 16#1044D#)); -- DESERET SMALL LETTER LONG I .. DESERET SMALL LETTER ENG + + Upper_Case_Adjust : constant array (Lower_Case_Letters'Range) of UTF_32 := ( + -32, -- LATIN SMALL LETTER A .. LATIN SMALL LETTER Z + 743, -- MICRO SIGN .. MICRO SIGN + -32, -- LATIN SMALL LETTER A WITH GRAVE .. LATIN SMALL LETTER O WITH DIAERESIS + -32, -- LATIN SMALL LETTER O WITH STROKE .. LATIN SMALL LETTER THORN + 121, -- LATIN SMALL LETTER Y WITH DIAERESIS .. LATIN SMALL LETTER Y WITH DIAERESIS + -1, -- LATIN SMALL LETTER A WITH MACRON .. LATIN SMALL LETTER A WITH MACRON + -1, -- LATIN SMALL LETTER A WITH BREVE .. LATIN SMALL LETTER A WITH BREVE + -1, -- LATIN SMALL LETTER A WITH OGONEK .. LATIN SMALL LETTER A WITH OGONEK + -1, -- LATIN SMALL LETTER C WITH ACUTE .. LATIN SMALL LETTER C WITH ACUTE + -1, -- LATIN SMALL LETTER C WITH CIRCUMFLEX .. LATIN SMALL LETTER C WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER C WITH DOT ABOVE .. LATIN SMALL LETTER C WITH DOT ABOVE + -1, -- LATIN SMALL LETTER C WITH CARON .. LATIN SMALL LETTER C WITH CARON + -1, -- LATIN SMALL LETTER D WITH CARON .. LATIN SMALL LETTER D WITH CARON + -1, -- LATIN SMALL LETTER D WITH STROKE .. LATIN SMALL LETTER D WITH STROKE + -1, -- LATIN SMALL LETTER E WITH MACRON .. LATIN SMALL LETTER E WITH MACRON + -1, -- LATIN SMALL LETTER E WITH BREVE .. LATIN SMALL LETTER E WITH BREVE + -1, -- LATIN SMALL LETTER E WITH DOT ABOVE .. LATIN SMALL LETTER E WITH DOT ABOVE + -1, -- LATIN SMALL LETTER E WITH OGONEK .. LATIN SMALL LETTER E WITH OGONEK + -1, -- LATIN SMALL LETTER E WITH CARON .. LATIN SMALL LETTER E WITH CARON + -1, -- LATIN SMALL LETTER G WITH CIRCUMFLEX .. LATIN SMALL LETTER G WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER G WITH BREVE .. LATIN SMALL LETTER G WITH BREVE + -1, -- LATIN SMALL LETTER G WITH DOT ABOVE .. LATIN SMALL LETTER G WITH DOT ABOVE + -1, -- LATIN SMALL LETTER G WITH CEDILLA .. LATIN SMALL LETTER G WITH CEDILLA + -1, -- LATIN SMALL LETTER H WITH CIRCUMFLEX .. LATIN SMALL LETTER H WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER H WITH STROKE .. LATIN SMALL LETTER H WITH STROKE + -1, -- LATIN SMALL LETTER I WITH TILDE .. LATIN SMALL LETTER I WITH TILDE + -1, -- LATIN SMALL LETTER I WITH MACRON .. LATIN SMALL LETTER I WITH MACRON + -1, -- LATIN SMALL LETTER I WITH BREVE .. LATIN SMALL LETTER I WITH BREVE + -1, -- LATIN SMALL LETTER I WITH OGONEK .. LATIN SMALL LETTER I WITH OGONEK + -232, -- LATIN SMALL LETTER DOTLESS I .. LATIN SMALL LETTER DOTLESS I + -1, -- LATIN SMALL LIGATURE IJ .. LATIN SMALL LIGATURE IJ + -1, -- LATIN SMALL LETTER J WITH CIRCUMFLEX .. LATIN SMALL LETTER J WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER K WITH CEDILLA .. LATIN SMALL LETTER K WITH CEDILLA + -1, -- LATIN SMALL LETTER L WITH ACUTE .. LATIN SMALL LETTER L WITH ACUTE + -1, -- LATIN SMALL LETTER L WITH CEDILLA .. LATIN SMALL LETTER L WITH CEDILLA + -1, -- LATIN SMALL LETTER L WITH CARON .. LATIN SMALL LETTER L WITH CARON + -1, -- LATIN SMALL LETTER L WITH MIDDLE DOT .. LATIN SMALL LETTER L WITH MIDDLE DOT + -1, -- LATIN SMALL LETTER L WITH STROKE .. LATIN SMALL LETTER L WITH STROKE + -1, -- LATIN SMALL LETTER N WITH ACUTE .. LATIN SMALL LETTER N WITH ACUTE + -1, -- LATIN SMALL LETTER N WITH CEDILLA .. LATIN SMALL LETTER N WITH CEDILLA + -1, -- LATIN SMALL LETTER N WITH CARON .. LATIN SMALL LETTER N WITH CARON + -1, -- LATIN SMALL LETTER ENG .. LATIN SMALL LETTER ENG + -1, -- LATIN SMALL LETTER O WITH MACRON .. LATIN SMALL LETTER O WITH MACRON + -1, -- LATIN SMALL LETTER O WITH BREVE .. LATIN SMALL LETTER O WITH BREVE + -1, -- LATIN SMALL LETTER O WITH DOUBLE ACUTE .. LATIN SMALL LETTER O WITH DOUBLE ACUTE + -1, -- LATIN SMALL LIGATURE OE .. LATIN SMALL LIGATURE OE + -1, -- LATIN SMALL LETTER R WITH ACUTE .. LATIN SMALL LETTER R WITH ACUTE + -1, -- LATIN SMALL LETTER R WITH CEDILLA .. LATIN SMALL LETTER R WITH CEDILLA + -1, -- LATIN SMALL LETTER R WITH CARON .. LATIN SMALL LETTER R WITH CARON + -1, -- LATIN SMALL LETTER S WITH ACUTE .. LATIN SMALL LETTER S WITH ACUTE + -1, -- LATIN SMALL LETTER S WITH CIRCUMFLEX .. LATIN SMALL LETTER S WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER S WITH CEDILLA .. LATIN SMALL LETTER S WITH CEDILLA + -1, -- LATIN SMALL LETTER S WITH CARON .. LATIN SMALL LETTER S WITH CARON + -1, -- LATIN SMALL LETTER T WITH CEDILLA .. LATIN SMALL LETTER T WITH CEDILLA + -1, -- LATIN SMALL LETTER T WITH CARON .. LATIN SMALL LETTER T WITH CARON + -1, -- LATIN SMALL LETTER T WITH STROKE .. LATIN SMALL LETTER T WITH STROKE + -1, -- LATIN SMALL LETTER U WITH TILDE .. LATIN SMALL LETTER U WITH TILDE + -1, -- LATIN SMALL LETTER U WITH MACRON .. LATIN SMALL LETTER U WITH MACRON + -1, -- LATIN SMALL LETTER U WITH BREVE .. LATIN SMALL LETTER U WITH BREVE + -1, -- LATIN SMALL LETTER U WITH RING ABOVE .. LATIN SMALL LETTER U WITH RING ABOVE + -1, -- LATIN SMALL LETTER U WITH DOUBLE ACUTE .. LATIN SMALL LETTER U WITH DOUBLE ACUTE + -1, -- LATIN SMALL LETTER U WITH OGONEK .. LATIN SMALL LETTER U WITH OGONEK + -1, -- LATIN SMALL LETTER W WITH CIRCUMFLEX .. LATIN SMALL LETTER W WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER Y WITH CIRCUMFLEX .. LATIN SMALL LETTER Y WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER Z WITH ACUTE .. LATIN SMALL LETTER Z WITH ACUTE + -1, -- LATIN SMALL LETTER Z WITH DOT ABOVE .. LATIN SMALL LETTER Z WITH DOT ABOVE + -1, -- LATIN SMALL LETTER Z WITH CARON .. LATIN SMALL LETTER Z WITH CARON + -300, -- LATIN SMALL LETTER LONG S .. LATIN SMALL LETTER LONG S + -1, -- LATIN SMALL LETTER B WITH TOPBAR .. LATIN SMALL LETTER B WITH TOPBAR + -1, -- LATIN SMALL LETTER TONE SIX .. LATIN SMALL LETTER TONE SIX + -1, -- LATIN SMALL LETTER C WITH HOOK .. LATIN SMALL LETTER C WITH HOOK + -1, -- LATIN SMALL LETTER D WITH TOPBAR .. LATIN SMALL LETTER D WITH TOPBAR + -1, -- LATIN SMALL LETTER F WITH HOOK .. LATIN SMALL LETTER F WITH HOOK + 97, -- LATIN SMALL LETTER HV .. LATIN SMALL LETTER HV + -1, -- LATIN SMALL LETTER K WITH HOOK .. LATIN SMALL LETTER K WITH HOOK + 130, -- LATIN SMALL LETTER N WITH LONG RIGHT LEG .. LATIN SMALL LETTER N WITH LONG RIGHT LEG + -1, -- LATIN SMALL LETTER O WITH HORN .. LATIN SMALL LETTER O WITH HORN + -1, -- LATIN SMALL LETTER OI .. LATIN SMALL LETTER OI + -1, -- LATIN SMALL LETTER P WITH HOOK .. LATIN SMALL LETTER P WITH HOOK + -1, -- LATIN SMALL LETTER TONE TWO .. LATIN SMALL LETTER TONE TWO + -1, -- LATIN SMALL LETTER T WITH HOOK .. LATIN SMALL LETTER T WITH HOOK + -1, -- LATIN SMALL LETTER U WITH HORN .. LATIN SMALL LETTER U WITH HORN + -1, -- LATIN SMALL LETTER Y WITH HOOK .. LATIN SMALL LETTER Y WITH HOOK + -1, -- LATIN SMALL LETTER Z WITH STROKE .. LATIN SMALL LETTER Z WITH STROKE + -1, -- LATIN SMALL LETTER EZH REVERSED .. LATIN SMALL LETTER EZH REVERSED + -1, -- LATIN SMALL LETTER TONE FIVE .. LATIN SMALL LETTER TONE FIVE + 56, -- LATIN LETTER WYNN .. LATIN LETTER WYNN + -1, -- LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON + -2, -- LATIN SMALL LETTER DZ WITH CARON .. LATIN SMALL LETTER DZ WITH CARON + -1, -- LATIN CAPITAL LETTER L WITH SMALL LETTER J .. LATIN CAPITAL LETTER L WITH SMALL LETTER J + -2, -- LATIN SMALL LETTER LJ .. LATIN SMALL LETTER LJ + -1, -- LATIN CAPITAL LETTER N WITH SMALL LETTER J .. LATIN CAPITAL LETTER N WITH SMALL LETTER J + -2, -- LATIN SMALL LETTER NJ .. LATIN SMALL LETTER NJ + -1, -- LATIN SMALL LETTER A WITH CARON .. LATIN SMALL LETTER A WITH CARON + -1, -- LATIN SMALL LETTER I WITH CARON .. LATIN SMALL LETTER I WITH CARON + -1, -- LATIN SMALL LETTER O WITH CARON .. LATIN SMALL LETTER O WITH CARON + -1, -- LATIN SMALL LETTER U WITH CARON .. LATIN SMALL LETTER U WITH CARON + -1, -- LATIN SMALL LETTER U WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER U WITH DIAERESIS AND MACRON + -1, -- LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE + -1, -- LATIN SMALL LETTER U WITH DIAERESIS AND CARON .. LATIN SMALL LETTER U WITH DIAERESIS AND CARON + -1, -- LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE .. LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE + -79, -- LATIN SMALL LETTER TURNED E .. LATIN SMALL LETTER TURNED E + -1, -- LATIN SMALL LETTER A WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER A WITH DIAERESIS AND MACRON + -1, -- LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON + -1, -- LATIN SMALL LETTER AE WITH MACRON .. LATIN SMALL LETTER AE WITH MACRON + -1, -- LATIN SMALL LETTER G WITH STROKE .. LATIN SMALL LETTER G WITH STROKE + -1, -- LATIN SMALL LETTER G WITH CARON .. LATIN SMALL LETTER G WITH CARON + -1, -- LATIN SMALL LETTER K WITH CARON .. LATIN SMALL LETTER K WITH CARON + -1, -- LATIN SMALL LETTER O WITH OGONEK .. LATIN SMALL LETTER O WITH OGONEK + -1, -- LATIN SMALL LETTER O WITH OGONEK AND MACRON .. LATIN SMALL LETTER O WITH OGONEK AND MACRON + -1, -- LATIN SMALL LETTER EZH WITH CARON .. LATIN SMALL LETTER EZH WITH CARON + -1, -- LATIN CAPITAL LETTER D WITH SMALL LETTER Z .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z + -2, -- LATIN SMALL LETTER DZ .. LATIN SMALL LETTER DZ + -1, -- LATIN SMALL LETTER G WITH ACUTE .. LATIN SMALL LETTER G WITH ACUTE + -1, -- LATIN SMALL LETTER N WITH GRAVE .. LATIN SMALL LETTER N WITH GRAVE + -1, -- LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE .. LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE + -1, -- LATIN SMALL LETTER AE WITH ACUTE .. LATIN SMALL LETTER AE WITH ACUTE + -1, -- LATIN SMALL LETTER O WITH STROKE AND ACUTE .. LATIN SMALL LETTER O WITH STROKE AND ACUTE + -1, -- LATIN SMALL LETTER A WITH DOUBLE GRAVE .. LATIN SMALL LETTER A WITH DOUBLE GRAVE + -1, -- LATIN SMALL LETTER A WITH INVERTED BREVE .. LATIN SMALL LETTER A WITH INVERTED BREVE + -1, -- LATIN SMALL LETTER E WITH DOUBLE GRAVE .. LATIN SMALL LETTER E WITH DOUBLE GRAVE + -1, -- LATIN SMALL LETTER E WITH INVERTED BREVE .. LATIN SMALL LETTER E WITH INVERTED BREVE + -1, -- LATIN SMALL LETTER I WITH DOUBLE GRAVE .. LATIN SMALL LETTER I WITH DOUBLE GRAVE + -1, -- LATIN SMALL LETTER I WITH INVERTED BREVE .. LATIN SMALL LETTER I WITH INVERTED BREVE + -1, -- LATIN SMALL LETTER O WITH DOUBLE GRAVE .. LATIN SMALL LETTER O WITH DOUBLE GRAVE + -1, -- LATIN SMALL LETTER O WITH INVERTED BREVE .. LATIN SMALL LETTER O WITH INVERTED BREVE + -1, -- LATIN SMALL LETTER R WITH DOUBLE GRAVE .. LATIN SMALL LETTER R WITH DOUBLE GRAVE + -1, -- LATIN SMALL LETTER R WITH INVERTED BREVE .. LATIN SMALL LETTER R WITH INVERTED BREVE + -1, -- LATIN SMALL LETTER U WITH DOUBLE GRAVE .. LATIN SMALL LETTER U WITH DOUBLE GRAVE + -1, -- LATIN SMALL LETTER U WITH INVERTED BREVE .. LATIN SMALL LETTER U WITH INVERTED BREVE + -1, -- LATIN SMALL LETTER S WITH COMMA BELOW .. LATIN SMALL LETTER S WITH COMMA BELOW + -1, -- LATIN SMALL LETTER T WITH COMMA BELOW .. LATIN SMALL LETTER T WITH COMMA BELOW + -1, -- LATIN SMALL LETTER YOGH .. LATIN SMALL LETTER YOGH + -1, -- LATIN SMALL LETTER H WITH CARON .. LATIN SMALL LETTER H WITH CARON + -1, -- LATIN SMALL LETTER OU .. LATIN SMALL LETTER OU + -1, -- LATIN SMALL LETTER Z WITH HOOK .. LATIN SMALL LETTER Z WITH HOOK + -1, -- LATIN SMALL LETTER A WITH DOT ABOVE .. LATIN SMALL LETTER A WITH DOT ABOVE + -1, -- LATIN SMALL LETTER E WITH CEDILLA .. LATIN SMALL LETTER E WITH CEDILLA + -1, -- LATIN SMALL LETTER O WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER O WITH DIAERESIS AND MACRON + -1, -- LATIN SMALL LETTER O WITH TILDE AND MACRON .. LATIN SMALL LETTER O WITH TILDE AND MACRON + -1, -- LATIN SMALL LETTER O WITH DOT ABOVE .. LATIN SMALL LETTER O WITH DOT ABOVE + -1, -- LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON + -1, -- LATIN SMALL LETTER Y WITH MACRON .. LATIN SMALL LETTER Y WITH MACRON + -210, -- LATIN SMALL LETTER B WITH HOOK .. LATIN SMALL LETTER B WITH HOOK + -206, -- LATIN SMALL LETTER OPEN O .. LATIN SMALL LETTER OPEN O + -205, -- LATIN SMALL LETTER D WITH TAIL .. LATIN SMALL LETTER D WITH HOOK + -202, -- LATIN SMALL LETTER SCHWA .. LATIN SMALL LETTER SCHWA + -203, -- LATIN SMALL LETTER OPEN E .. LATIN SMALL LETTER OPEN E + -205, -- LATIN SMALL LETTER G WITH HOOK .. LATIN SMALL LETTER G WITH HOOK + -207, -- LATIN SMALL LETTER GAMMA .. LATIN SMALL LETTER GAMMA + -209, -- LATIN SMALL LETTER I WITH STROKE .. LATIN SMALL LETTER I WITH STROKE + -211, -- LATIN SMALL LETTER IOTA .. LATIN SMALL LETTER IOTA + -211, -- LATIN SMALL LETTER TURNED M .. LATIN SMALL LETTER TURNED M + -213, -- LATIN SMALL LETTER N WITH LEFT HOOK .. LATIN SMALL LETTER N WITH LEFT HOOK + -214, -- LATIN SMALL LETTER BARRED O .. LATIN SMALL LETTER BARRED O + -218, -- LATIN LETTER SMALL CAPITAL R .. LATIN LETTER SMALL CAPITAL R + -218, -- LATIN SMALL LETTER ESH .. LATIN SMALL LETTER ESH + -218, -- LATIN SMALL LETTER T WITH RETROFLEX HOOK .. LATIN SMALL LETTER T WITH RETROFLEX HOOK + -217, -- LATIN SMALL LETTER UPSILON .. LATIN SMALL LETTER V WITH HOOK + -219, -- LATIN SMALL LETTER EZH .. LATIN SMALL LETTER EZH + -38, -- GREEK SMALL LETTER ALPHA WITH TONOS .. GREEK SMALL LETTER ALPHA WITH TONOS + -37, -- GREEK SMALL LETTER EPSILON WITH TONOS .. GREEK SMALL LETTER IOTA WITH TONOS + -32, -- GREEK SMALL LETTER ALPHA .. GREEK SMALL LETTER RHO + -31, -- GREEK SMALL LETTER FINAL SIGMA .. GREEK SMALL LETTER FINAL SIGMA + -32, -- GREEK SMALL LETTER SIGMA .. GREEK SMALL LETTER UPSILON WITH DIALYTIKA + -64, -- GREEK SMALL LETTER OMICRON WITH TONOS .. GREEK SMALL LETTER OMICRON WITH TONOS + -63, -- GREEK SMALL LETTER UPSILON WITH TONOS .. GREEK SMALL LETTER OMEGA WITH TONOS + -62, -- GREEK BETA SYMBOL .. GREEK BETA SYMBOL + -57, -- GREEK THETA SYMBOL .. GREEK THETA SYMBOL + -47, -- GREEK PHI SYMBOL .. GREEK PHI SYMBOL + -54, -- GREEK PI SYMBOL .. GREEK PI SYMBOL + -1, -- GREEK SMALL LETTER ARCHAIC KOPPA .. GREEK SMALL LETTER ARCHAIC KOPPA + -1, -- GREEK SMALL LETTER STIGMA .. GREEK SMALL LETTER STIGMA + -1, -- GREEK SMALL LETTER DIGAMMA .. GREEK SMALL LETTER DIGAMMA + -1, -- GREEK SMALL LETTER KOPPA .. GREEK SMALL LETTER KOPPA + -1, -- GREEK SMALL LETTER SAMPI .. GREEK SMALL LETTER SAMPI + -1, -- COPTIC SMALL LETTER SHEI .. COPTIC SMALL LETTER SHEI + -1, -- COPTIC SMALL LETTER FEI .. COPTIC SMALL LETTER FEI + -1, -- COPTIC SMALL LETTER KHEI .. COPTIC SMALL LETTER KHEI + -1, -- COPTIC SMALL LETTER HORI .. COPTIC SMALL LETTER HORI + -1, -- COPTIC SMALL LETTER GANGIA .. COPTIC SMALL LETTER GANGIA + -1, -- COPTIC SMALL LETTER SHIMA .. COPTIC SMALL LETTER SHIMA + -1, -- COPTIC SMALL LETTER DEI .. COPTIC SMALL LETTER DEI + -86, -- GREEK KAPPA SYMBOL .. GREEK KAPPA SYMBOL + -80, -- GREEK RHO SYMBOL .. GREEK RHO SYMBOL + -79, -- GREEK LUNATE SIGMA SYMBOL .. GREEK LUNATE SIGMA SYMBOL + -96, -- GREEK LUNATE EPSILON SYMBOL .. GREEK LUNATE EPSILON SYMBOL + -32, -- CYRILLIC SMALL LETTER A .. CYRILLIC SMALL LETTER YA + -80, -- CYRILLIC SMALL LETTER IE WITH GRAVE .. CYRILLIC SMALL LETTER DZHE + -1, -- CYRILLIC SMALL LETTER OMEGA .. CYRILLIC SMALL LETTER OMEGA + -1, -- CYRILLIC SMALL LETTER YAT .. CYRILLIC SMALL LETTER YAT + -1, -- CYRILLIC SMALL LETTER IOTIFIED E .. CYRILLIC SMALL LETTER IOTIFIED E + -1, -- CYRILLIC SMALL LETTER LITTLE YUS .. CYRILLIC SMALL LETTER LITTLE YUS + -1, -- CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS .. CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS + -1, -- CYRILLIC SMALL LETTER BIG YUS .. CYRILLIC SMALL LETTER BIG YUS + -1, -- CYRILLIC SMALL LETTER IOTIFIED BIG YUS .. CYRILLIC SMALL LETTER IOTIFIED BIG YUS + -1, -- CYRILLIC SMALL LETTER KSI .. CYRILLIC SMALL LETTER KSI + -1, -- CYRILLIC SMALL LETTER PSI .. CYRILLIC SMALL LETTER PSI + -1, -- CYRILLIC SMALL LETTER FITA .. CYRILLIC SMALL LETTER FITA + -1, -- CYRILLIC SMALL LETTER IZHITSA .. CYRILLIC SMALL LETTER IZHITSA + -1, -- CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT .. CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT + -1, -- CYRILLIC SMALL LETTER UK .. CYRILLIC SMALL LETTER UK + -1, -- CYRILLIC SMALL LETTER ROUND OMEGA .. CYRILLIC SMALL LETTER ROUND OMEGA + -1, -- CYRILLIC SMALL LETTER OMEGA WITH TITLO .. CYRILLIC SMALL LETTER OMEGA WITH TITLO + -1, -- CYRILLIC SMALL LETTER OT .. CYRILLIC SMALL LETTER OT + -1, -- CYRILLIC SMALL LETTER KOPPA .. CYRILLIC SMALL LETTER KOPPA + -1, -- CYRILLIC SMALL LETTER SHORT I WITH TAIL .. CYRILLIC SMALL LETTER SHORT I WITH TAIL + -1, -- CYRILLIC SMALL LETTER SEMISOFT SIGN .. CYRILLIC SMALL LETTER SEMISOFT SIGN + -1, -- CYRILLIC SMALL LETTER ER WITH TICK .. CYRILLIC SMALL LETTER ER WITH TICK + -1, -- CYRILLIC SMALL LETTER GHE WITH UPTURN .. CYRILLIC SMALL LETTER GHE WITH UPTURN + -1, -- CYRILLIC SMALL LETTER GHE WITH STROKE .. CYRILLIC SMALL LETTER GHE WITH STROKE + -1, -- CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK + -1, -- CYRILLIC SMALL LETTER ZHE WITH DESCENDER .. CYRILLIC SMALL LETTER ZHE WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER ZE WITH DESCENDER .. CYRILLIC SMALL LETTER ZE WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER KA WITH DESCENDER .. CYRILLIC SMALL LETTER KA WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE + -1, -- CYRILLIC SMALL LETTER KA WITH STROKE .. CYRILLIC SMALL LETTER KA WITH STROKE + -1, -- CYRILLIC SMALL LETTER BASHKIR KA .. CYRILLIC SMALL LETTER BASHKIR KA + -1, -- CYRILLIC SMALL LETTER EN WITH DESCENDER .. CYRILLIC SMALL LETTER EN WITH DESCENDER + -1, -- CYRILLIC SMALL LIGATURE EN GHE .. CYRILLIC SMALL LIGATURE EN GHE + -1, -- CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK + -1, -- CYRILLIC SMALL LETTER ABKHASIAN HA .. CYRILLIC SMALL LETTER ABKHASIAN HA + -1, -- CYRILLIC SMALL LETTER ES WITH DESCENDER .. CYRILLIC SMALL LETTER ES WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER TE WITH DESCENDER .. CYRILLIC SMALL LETTER TE WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER STRAIGHT U .. CYRILLIC SMALL LETTER STRAIGHT U + -1, -- CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE .. CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE + -1, -- CYRILLIC SMALL LETTER HA WITH DESCENDER .. CYRILLIC SMALL LETTER HA WITH DESCENDER + -1, -- CYRILLIC SMALL LIGATURE TE TSE .. CYRILLIC SMALL LIGATURE TE TSE + -1, -- CYRILLIC SMALL LETTER CHE WITH DESCENDER .. CYRILLIC SMALL LETTER CHE WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE + -1, -- CYRILLIC SMALL LETTER SHHA .. CYRILLIC SMALL LETTER SHHA + -1, -- CYRILLIC SMALL LETTER ABKHASIAN CHE .. CYRILLIC SMALL LETTER ABKHASIAN CHE + -1, -- CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER .. CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER ZHE WITH BREVE .. CYRILLIC SMALL LETTER ZHE WITH BREVE + -1, -- CYRILLIC SMALL LETTER KA WITH HOOK .. CYRILLIC SMALL LETTER KA WITH HOOK + -1, -- CYRILLIC SMALL LETTER EL WITH TAIL .. CYRILLIC SMALL LETTER EL WITH TAIL + -1, -- CYRILLIC SMALL LETTER EN WITH HOOK .. CYRILLIC SMALL LETTER EN WITH HOOK + -1, -- CYRILLIC SMALL LETTER EN WITH TAIL .. CYRILLIC SMALL LETTER EN WITH TAIL + -1, -- CYRILLIC SMALL LETTER KHAKASSIAN CHE .. CYRILLIC SMALL LETTER KHAKASSIAN CHE + -1, -- CYRILLIC SMALL LETTER EM WITH TAIL .. CYRILLIC SMALL LETTER EM WITH TAIL + -1, -- CYRILLIC SMALL LETTER A WITH BREVE .. CYRILLIC SMALL LETTER A WITH BREVE + -1, -- CYRILLIC SMALL LETTER A WITH DIAERESIS .. CYRILLIC SMALL LETTER A WITH DIAERESIS + -1, -- CYRILLIC SMALL LIGATURE A IE .. CYRILLIC SMALL LIGATURE A IE + -1, -- CYRILLIC SMALL LETTER IE WITH BREVE .. CYRILLIC SMALL LETTER IE WITH BREVE + -1, -- CYRILLIC SMALL LETTER SCHWA .. CYRILLIC SMALL LETTER SCHWA + -1, -- CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS .. CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER ZHE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZHE WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER ZE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZE WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER ABKHASIAN DZE .. CYRILLIC SMALL LETTER ABKHASIAN DZE + -1, -- CYRILLIC SMALL LETTER I WITH MACRON .. CYRILLIC SMALL LETTER I WITH MACRON + -1, -- CYRILLIC SMALL LETTER I WITH DIAERESIS .. CYRILLIC SMALL LETTER I WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER O WITH DIAERESIS .. CYRILLIC SMALL LETTER O WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER BARRED O .. CYRILLIC SMALL LETTER BARRED O + -1, -- CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS .. CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER E WITH DIAERESIS .. CYRILLIC SMALL LETTER E WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER U WITH MACRON .. CYRILLIC SMALL LETTER U WITH MACRON + -1, -- CYRILLIC SMALL LETTER U WITH DIAERESIS .. CYRILLIC SMALL LETTER U WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE .. CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE + -1, -- CYRILLIC SMALL LETTER CHE WITH DIAERESIS .. CYRILLIC SMALL LETTER CHE WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER YERU WITH DIAERESIS .. CYRILLIC SMALL LETTER YERU WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER KOMI DE .. CYRILLIC SMALL LETTER KOMI DE + -1, -- CYRILLIC SMALL LETTER KOMI DJE .. CYRILLIC SMALL LETTER KOMI DJE + -1, -- CYRILLIC SMALL LETTER KOMI ZJE .. CYRILLIC SMALL LETTER KOMI ZJE + -1, -- CYRILLIC SMALL LETTER KOMI DZJE .. CYRILLIC SMALL LETTER KOMI DZJE + -1, -- CYRILLIC SMALL LETTER KOMI LJE .. CYRILLIC SMALL LETTER KOMI LJE + -1, -- CYRILLIC SMALL LETTER KOMI NJE .. CYRILLIC SMALL LETTER KOMI NJE + -1, -- CYRILLIC SMALL LETTER KOMI SJE .. CYRILLIC SMALL LETTER KOMI SJE + -1, -- CYRILLIC SMALL LETTER KOMI TJE .. CYRILLIC SMALL LETTER KOMI TJE + -48, -- ARMENIAN SMALL LETTER AYB .. ARMENIAN SMALL LETTER FEH + -1, -- LATIN SMALL LETTER A WITH RING BELOW .. LATIN SMALL LETTER A WITH RING BELOW + -1, -- LATIN SMALL LETTER B WITH DOT ABOVE .. LATIN SMALL LETTER B WITH DOT ABOVE + -1, -- LATIN SMALL LETTER B WITH DOT BELOW .. LATIN SMALL LETTER B WITH DOT BELOW + -1, -- LATIN SMALL LETTER B WITH LINE BELOW .. LATIN SMALL LETTER B WITH LINE BELOW + -1, -- LATIN SMALL LETTER C WITH CEDILLA AND ACUTE .. LATIN SMALL LETTER C WITH CEDILLA AND ACUTE + -1, -- LATIN SMALL LETTER D WITH DOT ABOVE .. LATIN SMALL LETTER D WITH DOT ABOVE + -1, -- LATIN SMALL LETTER D WITH DOT BELOW .. LATIN SMALL LETTER D WITH DOT BELOW + -1, -- LATIN SMALL LETTER D WITH LINE BELOW .. LATIN SMALL LETTER D WITH LINE BELOW + -1, -- LATIN SMALL LETTER D WITH CEDILLA .. LATIN SMALL LETTER D WITH CEDILLA + -1, -- LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW + -1, -- LATIN SMALL LETTER E WITH MACRON AND GRAVE .. LATIN SMALL LETTER E WITH MACRON AND GRAVE + -1, -- LATIN SMALL LETTER E WITH MACRON AND ACUTE .. LATIN SMALL LETTER E WITH MACRON AND ACUTE + -1, -- LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW + -1, -- LATIN SMALL LETTER E WITH TILDE BELOW .. LATIN SMALL LETTER E WITH TILDE BELOW + -1, -- LATIN SMALL LETTER E WITH CEDILLA AND BREVE .. LATIN SMALL LETTER E WITH CEDILLA AND BREVE + -1, -- LATIN SMALL LETTER F WITH DOT ABOVE .. LATIN SMALL LETTER F WITH DOT ABOVE + -1, -- LATIN SMALL LETTER G WITH MACRON .. LATIN SMALL LETTER G WITH MACRON + -1, -- LATIN SMALL LETTER H WITH DOT ABOVE .. LATIN SMALL LETTER H WITH DOT ABOVE + -1, -- LATIN SMALL LETTER H WITH DOT BELOW .. LATIN SMALL LETTER H WITH DOT BELOW + -1, -- LATIN SMALL LETTER H WITH DIAERESIS .. LATIN SMALL LETTER H WITH DIAERESIS + -1, -- LATIN SMALL LETTER H WITH CEDILLA .. LATIN SMALL LETTER H WITH CEDILLA + -1, -- LATIN SMALL LETTER H WITH BREVE BELOW .. LATIN SMALL LETTER H WITH BREVE BELOW + -1, -- LATIN SMALL LETTER I WITH TILDE BELOW .. LATIN SMALL LETTER I WITH TILDE BELOW + -1, -- LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE + -1, -- LATIN SMALL LETTER K WITH ACUTE .. LATIN SMALL LETTER K WITH ACUTE + -1, -- LATIN SMALL LETTER K WITH DOT BELOW .. LATIN SMALL LETTER K WITH DOT BELOW + -1, -- LATIN SMALL LETTER K WITH LINE BELOW .. LATIN SMALL LETTER K WITH LINE BELOW + -1, -- LATIN SMALL LETTER L WITH DOT BELOW .. LATIN SMALL LETTER L WITH DOT BELOW + -1, -- LATIN SMALL LETTER L WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER L WITH DOT BELOW AND MACRON + -1, -- LATIN SMALL LETTER L WITH LINE BELOW .. LATIN SMALL LETTER L WITH LINE BELOW + -1, -- LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW + -1, -- LATIN SMALL LETTER M WITH ACUTE .. LATIN SMALL LETTER M WITH ACUTE + -1, -- LATIN SMALL LETTER M WITH DOT ABOVE .. LATIN SMALL LETTER M WITH DOT ABOVE + -1, -- LATIN SMALL LETTER M WITH DOT BELOW .. LATIN SMALL LETTER M WITH DOT BELOW + -1, -- LATIN SMALL LETTER N WITH DOT ABOVE .. LATIN SMALL LETTER N WITH DOT ABOVE + -1, -- LATIN SMALL LETTER N WITH DOT BELOW .. LATIN SMALL LETTER N WITH DOT BELOW + -1, -- LATIN SMALL LETTER N WITH LINE BELOW .. LATIN SMALL LETTER N WITH LINE BELOW + -1, -- LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW + -1, -- LATIN SMALL LETTER O WITH TILDE AND ACUTE .. LATIN SMALL LETTER O WITH TILDE AND ACUTE + -1, -- LATIN SMALL LETTER O WITH TILDE AND DIAERESIS .. LATIN SMALL LETTER O WITH TILDE AND DIAERESIS + -1, -- LATIN SMALL LETTER O WITH MACRON AND GRAVE .. LATIN SMALL LETTER O WITH MACRON AND GRAVE + -1, -- LATIN SMALL LETTER O WITH MACRON AND ACUTE .. LATIN SMALL LETTER O WITH MACRON AND ACUTE + -1, -- LATIN SMALL LETTER P WITH ACUTE .. LATIN SMALL LETTER P WITH ACUTE + -1, -- LATIN SMALL LETTER P WITH DOT ABOVE .. LATIN SMALL LETTER P WITH DOT ABOVE + -1, -- LATIN SMALL LETTER R WITH DOT ABOVE .. LATIN SMALL LETTER R WITH DOT ABOVE + -1, -- LATIN SMALL LETTER R WITH DOT BELOW .. LATIN SMALL LETTER R WITH DOT BELOW + -1, -- LATIN SMALL LETTER R WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER R WITH DOT BELOW AND MACRON + -1, -- LATIN SMALL LETTER R WITH LINE BELOW .. LATIN SMALL LETTER R WITH LINE BELOW + -1, -- LATIN SMALL LETTER S WITH DOT ABOVE .. LATIN SMALL LETTER S WITH DOT ABOVE + -1, -- LATIN SMALL LETTER S WITH DOT BELOW .. LATIN SMALL LETTER S WITH DOT BELOW + -1, -- LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE .. LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE + -1, -- LATIN SMALL LETTER S WITH CARON AND DOT ABOVE .. LATIN SMALL LETTER S WITH CARON AND DOT ABOVE + -1, -- LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE .. LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE + -1, -- LATIN SMALL LETTER T WITH DOT ABOVE .. LATIN SMALL LETTER T WITH DOT ABOVE + -1, -- LATIN SMALL LETTER T WITH DOT BELOW .. LATIN SMALL LETTER T WITH DOT BELOW + -1, -- LATIN SMALL LETTER T WITH LINE BELOW .. LATIN SMALL LETTER T WITH LINE BELOW + -1, -- LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW + -1, -- LATIN SMALL LETTER U WITH DIAERESIS BELOW .. LATIN SMALL LETTER U WITH DIAERESIS BELOW + -1, -- LATIN SMALL LETTER U WITH TILDE BELOW .. LATIN SMALL LETTER U WITH TILDE BELOW + -1, -- LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW + -1, -- LATIN SMALL LETTER U WITH TILDE AND ACUTE .. LATIN SMALL LETTER U WITH TILDE AND ACUTE + -1, -- LATIN SMALL LETTER U WITH MACRON AND DIAERESIS .. LATIN SMALL LETTER U WITH MACRON AND DIAERESIS + -1, -- LATIN SMALL LETTER V WITH TILDE .. LATIN SMALL LETTER V WITH TILDE + -1, -- LATIN SMALL LETTER V WITH DOT BELOW .. LATIN SMALL LETTER V WITH DOT BELOW + -1, -- LATIN SMALL LETTER W WITH GRAVE .. LATIN SMALL LETTER W WITH GRAVE + -1, -- LATIN SMALL LETTER W WITH ACUTE .. LATIN SMALL LETTER W WITH ACUTE + -1, -- LATIN SMALL LETTER W WITH DIAERESIS .. LATIN SMALL LETTER W WITH DIAERESIS + -1, -- LATIN SMALL LETTER W WITH DOT ABOVE .. LATIN SMALL LETTER W WITH DOT ABOVE + -1, -- LATIN SMALL LETTER W WITH DOT BELOW .. LATIN SMALL LETTER W WITH DOT BELOW + -1, -- LATIN SMALL LETTER X WITH DOT ABOVE .. LATIN SMALL LETTER X WITH DOT ABOVE + -1, -- LATIN SMALL LETTER X WITH DIAERESIS .. LATIN SMALL LETTER X WITH DIAERESIS + -1, -- LATIN SMALL LETTER Y WITH DOT ABOVE .. LATIN SMALL LETTER Y WITH DOT ABOVE + -1, -- LATIN SMALL LETTER Z WITH CIRCUMFLEX .. LATIN SMALL LETTER Z WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER Z WITH DOT BELOW .. LATIN SMALL LETTER Z WITH DOT BELOW + -1, -- LATIN SMALL LETTER Z WITH LINE BELOW .. LATIN SMALL LETTER Z WITH LINE BELOW + -59, -- LATIN SMALL LETTER LONG S WITH DOT ABOVE .. LATIN SMALL LETTER LONG S WITH DOT ABOVE + -1, -- LATIN SMALL LETTER A WITH DOT BELOW .. LATIN SMALL LETTER A WITH DOT BELOW + -1, -- LATIN SMALL LETTER A WITH HOOK ABOVE .. LATIN SMALL LETTER A WITH HOOK ABOVE + -1, -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE + -1, -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE + -1, -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE + -1, -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE + -1, -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW + -1, -- LATIN SMALL LETTER A WITH BREVE AND ACUTE .. LATIN SMALL LETTER A WITH BREVE AND ACUTE + -1, -- LATIN SMALL LETTER A WITH BREVE AND GRAVE .. LATIN SMALL LETTER A WITH BREVE AND GRAVE + -1, -- LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE .. LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE + -1, -- LATIN SMALL LETTER A WITH BREVE AND TILDE .. LATIN SMALL LETTER A WITH BREVE AND TILDE + -1, -- LATIN SMALL LETTER A WITH BREVE AND DOT BELOW .. LATIN SMALL LETTER A WITH BREVE AND DOT BELOW + -1, -- LATIN SMALL LETTER E WITH DOT BELOW .. LATIN SMALL LETTER E WITH DOT BELOW + -1, -- LATIN SMALL LETTER E WITH HOOK ABOVE .. LATIN SMALL LETTER E WITH HOOK ABOVE + -1, -- LATIN SMALL LETTER E WITH TILDE .. LATIN SMALL LETTER E WITH TILDE + -1, -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE + -1, -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE + -1, -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE + -1, -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE + -1, -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW + -1, -- LATIN SMALL LETTER I WITH HOOK ABOVE .. LATIN SMALL LETTER I WITH HOOK ABOVE + -1, -- LATIN SMALL LETTER I WITH DOT BELOW .. LATIN SMALL LETTER I WITH DOT BELOW + -1, -- LATIN SMALL LETTER O WITH DOT BELOW .. LATIN SMALL LETTER O WITH DOT BELOW + -1, -- LATIN SMALL LETTER O WITH HOOK ABOVE .. LATIN SMALL LETTER O WITH HOOK ABOVE + -1, -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE + -1, -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE + -1, -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE + -1, -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE + -1, -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW + -1, -- LATIN SMALL LETTER O WITH HORN AND ACUTE .. LATIN SMALL LETTER O WITH HORN AND ACUTE + -1, -- LATIN SMALL LETTER O WITH HORN AND GRAVE .. LATIN SMALL LETTER O WITH HORN AND GRAVE + -1, -- LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE + -1, -- LATIN SMALL LETTER O WITH HORN AND TILDE .. LATIN SMALL LETTER O WITH HORN AND TILDE + -1, -- LATIN SMALL LETTER O WITH HORN AND DOT BELOW .. LATIN SMALL LETTER O WITH HORN AND DOT BELOW + -1, -- LATIN SMALL LETTER U WITH DOT BELOW .. LATIN SMALL LETTER U WITH DOT BELOW + -1, -- LATIN SMALL LETTER U WITH HOOK ABOVE .. LATIN SMALL LETTER U WITH HOOK ABOVE + -1, -- LATIN SMALL LETTER U WITH HORN AND ACUTE .. LATIN SMALL LETTER U WITH HORN AND ACUTE + -1, -- LATIN SMALL LETTER U WITH HORN AND GRAVE .. LATIN SMALL LETTER U WITH HORN AND GRAVE + -1, -- LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE + -1, -- LATIN SMALL LETTER U WITH HORN AND TILDE .. LATIN SMALL LETTER U WITH HORN AND TILDE + -1, -- LATIN SMALL LETTER U WITH HORN AND DOT BELOW .. LATIN SMALL LETTER U WITH HORN AND DOT BELOW + -1, -- LATIN SMALL LETTER Y WITH GRAVE .. LATIN SMALL LETTER Y WITH GRAVE + -1, -- LATIN SMALL LETTER Y WITH DOT BELOW .. LATIN SMALL LETTER Y WITH DOT BELOW + -1, -- LATIN SMALL LETTER Y WITH HOOK ABOVE .. LATIN SMALL LETTER Y WITH HOOK ABOVE + -1, -- LATIN SMALL LETTER Y WITH TILDE .. LATIN SMALL LETTER Y WITH TILDE + 8, -- GREEK SMALL LETTER ALPHA WITH PSILI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI + 8, -- GREEK SMALL LETTER EPSILON WITH PSILI .. GREEK SMALL LETTER EPSILON WITH DASIA AND OXIA + 8, -- GREEK SMALL LETTER ETA WITH PSILI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI + 8, -- GREEK SMALL LETTER IOTA WITH PSILI .. GREEK SMALL LETTER IOTA WITH DASIA AND PERISPOMENI + 8, -- GREEK SMALL LETTER OMICRON WITH PSILI .. GREEK SMALL LETTER OMICRON WITH DASIA AND OXIA + 8, -- GREEK SMALL LETTER UPSILON WITH DASIA .. GREEK SMALL LETTER UPSILON WITH DASIA + 8, -- GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA .. GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA + 8, -- GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA .. GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA + 8, -- GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI .. GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI + 8, -- GREEK SMALL LETTER OMEGA WITH PSILI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI + 74, -- GREEK SMALL LETTER ALPHA WITH VARIA .. GREEK SMALL LETTER ALPHA WITH OXIA + 86, -- GREEK SMALL LETTER EPSILON WITH VARIA .. GREEK SMALL LETTER ETA WITH OXIA + 100, -- GREEK SMALL LETTER IOTA WITH VARIA .. GREEK SMALL LETTER IOTA WITH OXIA + 128, -- GREEK SMALL LETTER OMICRON WITH VARIA .. GREEK SMALL LETTER OMICRON WITH OXIA + 112, -- GREEK SMALL LETTER UPSILON WITH VARIA .. GREEK SMALL LETTER UPSILON WITH OXIA + 126, -- GREEK SMALL LETTER OMEGA WITH VARIA .. GREEK SMALL LETTER OMEGA WITH OXIA + 8, -- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI + 8, -- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI + 8, -- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI + 8, -- GREEK SMALL LETTER ALPHA WITH VRACHY .. GREEK SMALL LETTER ALPHA WITH MACRON + 9, -- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI + -7205, -- GREEK PROSGEGRAMMENI .. GREEK PROSGEGRAMMENI + 9, -- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI + 8, -- GREEK SMALL LETTER IOTA WITH VRACHY .. GREEK SMALL LETTER IOTA WITH MACRON + 8, -- GREEK SMALL LETTER UPSILON WITH VRACHY .. GREEK SMALL LETTER UPSILON WITH MACRON + 7, -- GREEK SMALL LETTER RHO WITH DASIA .. GREEK SMALL LETTER RHO WITH DASIA + 9, -- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI + -32, -- FULLWIDTH LATIN SMALL LETTER A .. FULLWIDTH LATIN SMALL LETTER Z + -40); -- DESERET SMALL LETTER LONG I .. DESERET SMALL LETTER ENG + + + ----------------------- + -- Local Subprograms -- + ----------------------- + + function Range_Search (U : UTF_32; R : UTF_32_Ranges) return Natural; + -- Searches the given ranges (which must be in ascending order by Lo value) + -- and returns the index of the matching range in R if U matches one of the + -- ranges. If U matches none of the ranges, returns zero. + + --------------------- + -- Is_UTF_32_Digit -- + --------------------- + + function Is_UTF_32_Digit (U : UTF_32) return Boolean is + begin + return Range_Search (U, UTF_32_Digits) /= 0; + end Is_UTF_32_Digit; + + ---------------------- + -- Is_UTF_32_Letter -- + ---------------------- + + function Is_UTF_32_Letter (U : UTF_32) return Boolean is + begin + return Range_Search (U, UTF_32_Letters) /= 0; + end Is_UTF_32_Letter; + + ------------------------------- + -- Is_UTF_32_Line_Terminator -- + ------------------------------- + + function Is_UTF_32_Line_Terminator (U : UTF_32) return Boolean is + begin + return U in 10 .. 13 -- Ascii.LF Ascii.VT Ascii.FF Ascii.CR + or else U = 16#02028# -- LINE SEPARATOR + or else U = 16#02029#; -- PARAGRAPH SEPARATOR + end Is_UTF_32_Line_Terminator; + + -------------------- + -- Is_UTF_32_Mark -- + -------------------- + + function Is_UTF_32_Mark (U : UTF_32) return Boolean is + begin + return Range_Search (U, UTF_32_Marks) /= 0; + end Is_UTF_32_Mark; + + --------------------------- + -- Is_UTF_32_Non_Graphic -- + --------------------------- + + function Is_UTF_32_Non_Graphic (U : UTF_32) return Boolean is + begin + return Range_Search (U, UTF_32_Non_Graphic) /= 0; + end Is_UTF_32_Non_Graphic; + + --------------------- + -- Is_UTF_32_Other -- + --------------------- + + function Is_UTF_32_Other (U : UTF_32) return Boolean is + begin + return Range_Search (U, UTF_32_Other_Format) /= 0; + end Is_UTF_32_Other; + + --------------------------- + -- Is_UTF_32_Punctuation -- + --------------------------- + + function Is_UTF_32_Punctuation (U : UTF_32) return Boolean is + begin + return Range_Search (U, UTF_32_Punctuation) /= 0; + end Is_UTF_32_Punctuation; + + --------------------- + -- Is_UTF_32_Space -- + --------------------- + + function Is_UTF_32_Space (U : UTF_32) return Boolean is + begin + return Range_Search (U, UTF_32_Spaces) /= 0; + end Is_UTF_32_Space; + + ------------------ + -- Range_Search -- + ------------------ + + function Range_Search (U : UTF_32; R : UTF_32_Ranges) return Natural is + Lo : Integer; + Hi : Integer; + Mid : Integer; + + begin + Lo := R'First; + Hi := R'Last; + + loop + Mid := (Lo + Hi) / 2; + + if U < R (Mid).Lo then + Hi := Mid - 1; + + if Hi < Lo then + return 0; + end if; + + elsif R (Mid).Hi < U then + Lo := Mid + 1; + + if Hi < Lo then + return 0; + end if; + + else + return Mid; + end if; + end loop; + end Range_Search; + + -------------------------- + -- UTF_32_To_Upper_Case -- + -------------------------- + + function UTF_32_To_Upper_Case (U : UTF_32) return UTF_32 is + Index : constant Integer := Range_Search (U, Lower_Case_Letters); + begin + if Index = 0 then + return U; + else + return U + Upper_Case_Adjust (Index); + end if; + end UTF_32_To_Upper_Case; + +end GNAT.UTF_32; diff --git a/gcc/ada/g-utf_32.ads b/gcc/ada/g-utf_32.ads new file mode 100644 index 00000000000..1da9cf68fb8 --- /dev/null +++ b/gcc/ada/g-utf_32.ads @@ -0,0 +1,124 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUNTIME COMPONENTS -- +-- -- +-- G N A T . U T F _ 3 2 -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 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- -- +-- ware Foundation; either version 2, 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package is an internal package that provides basic character +-- classification capabilities needed by the compiler for handling full +-- 32-bit wide wide characters. We avoid the use of the actual type +-- Wide_Wide_Character, since we want to use these routines in the compiler +-- itself, and we want to be able to compile the compiler with old versions +-- of GNAT that did not implement Wide_Wide_Character. + +-- This package is not available directly for use in application programs, +-- but it serves as the basis for GNAT.Wide_Case_Utilities and +-- GNAT.Wide_Wide_Case_Utilities, which can be used directly. + +package GNAT.UTF_32 is + + type UTF_32 is mod 2 ** 32; + -- The actual allowed range is 16#00_0000# .. 16#01_FFFF# + + function Is_UTF_32_Letter (U : UTF_32) return Boolean; + pragma Inline (Is_UTF_32_Letter); + -- Returns true iff U is a letter that can be used to start an identifier. + -- This means that it is in one of the following categories: + -- Letter, Uppercase (Lu) + -- Letter, Lowercase (Ll) + -- Letter, Titlecase (Lt) + -- Letter, Modifier (Lm) + -- Letter, Other (Lo) + -- Number, Letter (Nl) + + function Is_UTF_32_Digit (U : UTF_32) return Boolean; + pragma Inline (Is_UTF_32_Digit); + -- Returns true iff U is a digit that can be used to extend an identifer, + -- which means it is in one of the following categories: + -- Number, Decimal_Digit (Nd) + + function Is_UTF_32_Line_Terminator (U : UTF_32) return Boolean; + pragma Inline (Is_UTF_32_Line_Terminator); + -- Returns true iff U is an allowed line terminator for source programs, + -- which means it is in one of the following categories: + -- Separator, Line (Zl) + -- Separator, Paragraph (Zp) + -- or that it is a conventional line terminator (CR, LF, VT, FF) + + function Is_UTF_32_Mark (U : UTF_32) return Boolean; + pragma Inline (Is_UTF_32_Mark); + -- Returns true iff U is a mark character which can be used to extend + -- an identifier. This means it is in one of the following categories: + -- Mark, Non-Spacing (Mn) + -- Mark, Spacing Combining (Mc) + + function Is_UTF_32_Other (U : UTF_32) return Boolean; + pragma Inline (Is_UTF_32_Other); + -- Returns true iff U is an other format character, which means that it + -- can be used to extend an identifier, but is ignored for the purposes of + -- matching of identiers. This means that it is in one of the following + -- categories: + -- Other, Format (Cf) + + function Is_UTF_32_Punctuation (U : UTF_32) return Boolean; + pragma Inline (Is_UTF_32_Punctuation); + -- Returns true iff U is a punctuation character that can be used to + -- separate pices of an identifier. This means that it is in one of the + -- following categories: + -- Punctuation, Connector (Pc) + + function Is_UTF_32_Space (U : UTF_32) return Boolean; + pragma Inline (Is_UTF_32_Space); + -- Returns true iff U is considered a space to be ignored, which means + -- that it is in one of the following categories: + -- Separator, Space (Zs) + + function Is_UTF_32_Non_Graphic (U : UTF_32) return Boolean; + pragma Inline (Is_UTF_32_Non_Graphic); + -- Returns true iff U is considered to be a non-graphic character, + -- which means that it is in one of the following categories: + -- Other, Control (Cc) + -- Other, Private Use (Co) + -- Other, Surrogate (Cs) + -- Other, Format (Cf) + -- Separator, Line (Zl) + -- Separator, Paragraph (Zp) + -- + -- Note that the Ada category format effector is subsumed by the above + -- list of Unicode categories. + + function UTF_32_To_Upper_Case (U : UTF_32) return UTF_32; + pragma Inline (UTF_32_To_Upper_Case); + -- If U represents a lower case letter, returns the corresponding upper + -- case letter, otherwise U is returned unchanged. The folding is locale + -- independent as defined by documents referenced in the note in section + -- 1 of ISO/IEC 10646:2003 + +end GNAT.UTF_32; diff --git a/gcc/ada/g-zstspl.ads b/gcc/ada/g-zstspl.ads new file mode 100644 index 00000000000..8ec6e0cd85e --- /dev/null +++ b/gcc/ada/g-zstspl.ads @@ -0,0 +1,46 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . W I D E _ W I D E _ S T R I N G _ S P L I T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2002-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- -- +-- ware Foundation; either version 2, 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- Useful wide_string-manipulation routines: given a set of separators, split +-- a wide_string wherever the separators appear, and provide direct access +-- to the resulting slices. See GNAT.Array_Split for full documentation. + +with Ada.Strings.Wide_Wide_Maps; use Ada.Strings; +with GNAT.Array_Split; + +package GNAT.Wide_Wide_String_Split is new GNAT.Array_Split + (Element => Wide_Wide_Character, + Element_Sequence => Wide_Wide_String, + Element_Set => Wide_Wide_Maps.Wide_Wide_Character_Set, + To_Set => Wide_Wide_Maps.To_Set, + Is_In => Wide_Wide_Maps.Is_In); diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index a64990ec590..d13af031bc8 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -120,7 +120,7 @@ procedure Gnatbind is Max_Storage_At_Blocking => True, -- Not checkable at compile time - others => False); + others => False); Additional_Restrictions_Listed : Boolean := False; -- Set True if we have listed header for restrictions @@ -337,8 +337,8 @@ procedure Gnatbind is Opt.Bind_Alternate_Main_Name := True; Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last)); - -- All other options are single character and are handled - -- by Scan_Binder_Switches. + -- All other options are single character and are handled by + -- Scan_Binder_Switches. else Scan_Binder_Switches (Argv); @@ -438,10 +438,10 @@ begin Osint.Add_Default_Search_Dirs; -- Carry out package initializations. These are initializations which - -- might logically be performed at elaboration time, but Namet at - -- least can't be done that way (because it is used in the Compiler), - -- and we decide to be consistent. Like elaboration, the order in - -- which these calls are made is in some cases important. + -- might logically be performed at elaboration time, but Namet at least + -- can't be done that way (because it is used in the Compiler), and we + -- decide to be consistent. Like elaboration, the order in which these + -- calls are made is in some cases important. Csets.Initialize; Namet.Initialize; @@ -481,7 +481,7 @@ begin Write_Str ("GNATBIND "); Write_Str (Gnat_Version_String); Write_Eol; - Write_Str ("Copyright 1995-2004 Free Software Foundation, Inc."); + Write_Str ("Copyright 1995-2005 Free Software Foundation, Inc."); Write_Eol; end if; @@ -562,7 +562,7 @@ begin -- ALI files. for Index in ALIs.First .. ALIs.Last loop - ALIs.Table (Index).Interface := False; + ALIs.Table (Index).SAL_Interface := False; end loop; -- Add System.Standard_Library to list to ensure that these files are @@ -654,7 +654,7 @@ begin Write_Eol; for J in Elab_Order.First .. Elab_Order.Last loop - if not Units.Table (Elab_Order.Table (J)).Interface then + if not Units.Table (Elab_Order.Table (J)).SAL_Interface then Write_Str (" "); Write_Unit_Name (Units.Table (Elab_Order.Table (J)).Uname); @@ -680,7 +680,7 @@ begin Total_Warnings := Total_Warnings + Warnings_Detected; end; - -- All done. Set proper exit status. + -- All done. Set proper exit status Finalize_Binderr; Namet.Finalize; diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index f8fec48d0e4..900b0ead18a 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -52,11 +52,12 @@ procedure Gnatls is -- Name of the env. variable that contains path name(s) of directories -- where project files may reside. + -- NOTE : The following string may be used by other tools, such as GPS. So + -- it can only be modified if these other uses are checked and coordinated. + Project_Search_Path : constant String := "Project Search Path:"; -- Label displayed in verbose mode before the directories in the project - -- search path. - -- NOTE: This string may be used by other tools, such as GPS; so, it - -- should not be modified inconsiderately. + -- search path. Do not modify without checking NOTE above. No_Project_Default_Dir : constant String := "-"; @@ -549,6 +550,7 @@ procedure Gnatls is -- Remove any encoding info (%s or %b) Get_Name_String (N); + if Name_Len > 2 and then Name_Buffer (Name_Len - 1) = '%' then @@ -977,7 +979,7 @@ procedure Gnatls is U.Internal or U.Is_Generic or U.Init_Scalars or - U.Interface or + U.SAL_Interface or U.Body_Needed_For_SAL or U.Elaborate_Body then @@ -1032,8 +1034,8 @@ procedure Gnatls is Write_Str (" Init_Scalars"); end if; - if U.Interface then - Write_Str (" Interface"); + if U.SAL_Interface then + Write_Str (" SAL_Interface"); end if; if U.Body_Needed_For_SAL then @@ -1247,6 +1249,7 @@ procedure Gnatls is -- Scan the file line by line while Index < Buffer'Last loop + -- Find the end of line Last := Index; @@ -1448,10 +1451,9 @@ procedure Gnatls is Output_Status (ST, Verbose => True); Write_Eol; end loop; - end Usage; --- Start of processing for Gnatls +-- Start of processing for Gnatls begin -- Initialize standard packages @@ -1498,7 +1500,7 @@ begin Write_Str ("GNATLS "); Write_Str (Gnat_Version_String); Write_Eol; - Write_Str ("Copyright 1997-2004 Free Software Foundation, Inc."); + Write_Str ("Copyright 1997-2005 Free Software Foundation, Inc."); Write_Eol; Write_Eol; Write_Str ("Source Search Path:"); @@ -1583,6 +1585,7 @@ begin Add_Default_Dir := False; elsif First /= Last or else Project_Path (First) /= '.' then + -- If the directory is ".", skip it as it is the current -- directory and it is already the first directory in the -- project path. @@ -1755,7 +1758,6 @@ begin Write_Str ("depends upon"); Write_Eol; Write_Str (" "); - else Write_Eol; end if; diff --git a/gcc/ada/i-c.adb b/gcc/ada/i-c.adb index 844f016441e..da8e3146f66 100644 --- a/gcc/ada/i-c.adb +++ b/gcc/ada/i-c.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -63,6 +63,32 @@ package body Interfaces.C is return False; end Is_Nul_Terminated; + -- Case of char16_array + + function Is_Nul_Terminated (Item : char16_array) return Boolean is + begin + for J in Item'Range loop + if Item (J) = char16_nul then + return True; + end if; + end loop; + + return False; + end Is_Nul_Terminated; + + -- Case of char32_array + + function Is_Nul_Terminated (Item : char32_array) return Boolean is + begin + for J in Item'Range loop + if Item (J) = char32_nul then + return True; + end if; + end loop; + + return False; + end Is_Nul_Terminated; + ------------ -- To_Ada -- ------------ @@ -78,8 +104,7 @@ package body Interfaces.C is function To_Ada (Item : char_array; - Trim_Nul : Boolean := True) - return String + Trim_Nul : Boolean := True) return String is Count : Natural; From : size_t; @@ -119,10 +144,10 @@ package body Interfaces.C is -- Convert char_array to String (procedure form) procedure To_Ada - (Item : char_array; - Target : out String; - Count : out Natural; - Trim_Nul : Boolean := True) + (Item : char_array; + Target : out String; + Count : out Natural; + Trim_Nul : Boolean := True) is From : size_t; To : Positive; @@ -173,8 +198,7 @@ package body Interfaces.C is function To_Ada (Item : wchar_array; - Trim_Nul : Boolean := True) - return Wide_String + Trim_Nul : Boolean := True) return Wide_String is Count : Natural; From : size_t; @@ -214,13 +238,13 @@ package body Interfaces.C is -- Convert wchar_array to Wide_String (procedure form) procedure To_Ada - (Item : wchar_array; - Target : out Wide_String; - Count : out Natural; - Trim_Nul : Boolean := True) + (Item : wchar_array; + Target : out Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True) is - From : size_t; - To : Positive; + From : size_t; + To : Positive; begin if Trim_Nul then @@ -254,7 +278,192 @@ package body Interfaces.C is To := To + 1; end loop; end if; + end To_Ada; + + -- Convert char16_t to Wide_Character + + function To_Ada (Item : char16_t) return Wide_Character is + begin + return Wide_Character'Val (char16_t'Pos (Item)); + end To_Ada; + + -- Convert char16_array to Wide_String (function form) + + function To_Ada + (Item : char16_array; + Trim_Nul : Boolean := True) return Wide_String + is + Count : Natural; + From : size_t; + + begin + if Trim_Nul then + From := Item'First; + + loop + if From > Item'Last then + raise Terminator_Error; + elsif Item (From) = char16_t'Val (0) then + exit; + else + From := From + 1; + end if; + end loop; + + Count := Natural (From - Item'First); + + else + Count := Item'Length; + end if; + + declare + R : Wide_String (1 .. Count); + + begin + for J in R'Range loop + R (J) := To_Ada (Item (size_t (J) + (Item'First - 1))); + end loop; + + return R; + end; + end To_Ada; + + -- Convert char16_array to Wide_String (procedure form) + + procedure To_Ada + (Item : char16_array; + Target : out Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True) + is + From : size_t; + To : Positive; + + begin + if Trim_Nul then + From := Item'First; + loop + if From > Item'Last then + raise Terminator_Error; + elsif Item (From) = char16_t'Val (0) then + exit; + else + From := From + 1; + end if; + end loop; + + Count := Natural (From - Item'First); + + else + Count := Item'Length; + end if; + + if Count > Target'Length then + raise Constraint_Error; + + else + From := Item'First; + To := Target'First; + + for J in 1 .. Count loop + Target (To) := To_Ada (Item (From)); + From := From + 1; + To := To + 1; + end loop; + end if; + end To_Ada; + + -- Convert char32_t to Wide_Wide_Character + + function To_Ada (Item : char32_t) return Wide_Wide_Character is + begin + return Wide_Wide_Character'Val (char32_t'Pos (Item)); + end To_Ada; + + -- Convert char32_array to Wide_Wide_String (function form) + + function To_Ada + (Item : char32_array; + Trim_Nul : Boolean := True) return Wide_Wide_String + is + Count : Natural; + From : size_t; + + begin + if Trim_Nul then + From := Item'First; + + loop + if From > Item'Last then + raise Terminator_Error; + elsif Item (From) = char32_t'Val (0) then + exit; + else + From := From + 1; + end if; + end loop; + + Count := Natural (From - Item'First); + + else + Count := Item'Length; + end if; + + declare + R : Wide_Wide_String (1 .. Count); + + begin + for J in R'Range loop + R (J) := To_Ada (Item (size_t (J) + (Item'First - 1))); + end loop; + return R; + end; + end To_Ada; + + -- Convert char32_array to Wide_Wide_String (procedure form) + + procedure To_Ada + (Item : char32_array; + Target : out Wide_Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True) + is + From : size_t; + To : Positive; + + begin + if Trim_Nul then + From := Item'First; + loop + if From > Item'Last then + raise Terminator_Error; + elsif Item (From) = char32_t'Val (0) then + exit; + else + From := From + 1; + end if; + end loop; + + Count := Natural (From - Item'First); + + else + Count := Item'Length; + end if; + + if Count > Target'Length then + raise Constraint_Error; + + else + From := Item'First; + To := Target'First; + + for J in 1 .. Count loop + Target (To) := To_Ada (Item (From)); + From := From + 1; + To := To + 1; + end loop; + end if; end To_Ada; ---------- @@ -272,8 +481,7 @@ package body Interfaces.C is function To_C (Item : String; - Append_Nul : Boolean := True) - return char_array + Append_Nul : Boolean := True) return char_array is begin if Append_Nul then @@ -292,12 +500,11 @@ package body Interfaces.C is -- Append_Nul False else - - -- A nasty case, if the string is null, we must return - -- a null char_array. The lower bound of this array is - -- required to be zero (RM B.3(50)) but that is of course - -- impossible given that size_t is unsigned. According to - -- Ada 2005 AI-258, the result is to raise Constraint_Error. + -- A nasty case, if the string is null, we must return a null + -- char_array. The lower bound of this array is required to be zero + -- (RM B.3(50)) but that is of course impossible given that size_t + -- is unsigned. According to Ada 2005 AI-258, the result is to raise + -- Constraint_Error. if Item'Length = 0 then raise Constraint_Error; @@ -365,8 +572,7 @@ package body Interfaces.C is function To_C (Item : Wide_String; - Append_Nul : Boolean := True) - return wchar_array + Append_Nul : Boolean := True) return wchar_array is begin if Append_Nul then @@ -383,23 +589,105 @@ package body Interfaces.C is end; else - -- A nasty case, if the string is null, we must return - -- a null char_array. The lower bound of this array is - -- required to be zero (RM B.3(50)) but that is of course - -- impossible given that size_t is unsigned. This needs - -- ARG resolution, but for now GNAT returns bounds 1 .. 0 + -- A nasty case, if the string is null, we must return a null + -- wchar_array. The lower bound of this array is required to be zero + -- (RM B.3(50)) but that is of course impossible given that size_t + -- is unsigned. According to Ada 2005 AI-258, the result is to raise + -- Constraint_Error. if Item'Length = 0 then + raise Constraint_Error; + + else declare - R : wchar_array (1 .. 0); + R : wchar_array (0 .. Item'Length - 1); begin + for J in size_t range 0 .. Item'Length - 1 loop + R (J) := To_C (Item (Integer (J) + Item'First)); + end loop; + return R; end; + end if; + end if; + end To_C; + + -- Convert Wide_String to wchar_array (procedure form) + + procedure To_C + (Item : Wide_String; + Target : out wchar_array; + Count : out size_t; + Append_Nul : Boolean := True) + is + To : size_t; + + begin + if Target'Length < Item'Length then + raise Constraint_Error; + + else + To := Target'First; + for From in Item'Range loop + Target (To) := To_C (Item (From)); + To := To + 1; + end loop; + + if Append_Nul then + if To > Target'Last then + raise Constraint_Error; + else + Target (To) := wide_nul; + Count := Item'Length + 1; + end if; + + else + Count := Item'Length; + end if; + end if; + end To_C; + + -- Convert Wide_Character to char16_t + + function To_C (Item : Wide_Character) return char16_t is + begin + return char16_t'Val (Wide_Character'Pos (Item)); + end To_C; + + -- Convert Wide_String to char16_array (function form) + + function To_C + (Item : Wide_String; + Append_Nul : Boolean := True) return char16_array + is + begin + if Append_Nul then + declare + R : char16_array (0 .. Item'Length); + + begin + for J in Item'Range loop + R (size_t (J - Item'First)) := To_C (Item (J)); + end loop; + + R (R'Last) := char16_t'Val (0); + return R; + end; + + else + -- A nasty case, if the string is null, we must return a null + -- char16_array. The lower bound of this array is required to be zero + -- (RM B.3(50)) but that is of course impossible given that size_t + -- is unsigned. According to Ada 2005 AI-258, the result is to raise + -- Constraint_Error. + + if Item'Length = 0 then + raise Constraint_Error; else declare - R : wchar_array (0 .. Item'Length - 1); + R : char16_array (0 .. Item'Length - 1); begin for J in size_t range 0 .. Item'Length - 1 loop @@ -412,11 +700,11 @@ package body Interfaces.C is end if; end To_C; - -- Convert Wide_String to wchar_array (procedure form) + -- Convert Wide_String to char16_array (procedure form) procedure To_C (Item : Wide_String; - Target : out wchar_array; + Target : out char16_array; Count : out size_t; Append_Nul : Boolean := True) is @@ -437,7 +725,94 @@ package body Interfaces.C is if To > Target'Last then raise Constraint_Error; else - Target (To) := wide_nul; + Target (To) := char16_t'Val (0); + Count := Item'Length + 1; + end if; + + else + Count := Item'Length; + end if; + end if; + end To_C; + + -- Convert Wide_Character to char32_t + + function To_C (Item : Wide_Wide_Character) return char32_t is + begin + return char32_t'Val (Wide_Wide_Character'Pos (Item)); + end To_C; + + -- Convert Wide_Wide_String to char32_array (function form) + + function To_C + (Item : Wide_Wide_String; + Append_Nul : Boolean := True) return char32_array + is + begin + if Append_Nul then + declare + R : char32_array (0 .. Item'Length); + + begin + for J in Item'Range loop + R (size_t (J - Item'First)) := To_C (Item (J)); + end loop; + + R (R'Last) := char32_t'Val (0); + return R; + end; + + else + -- A nasty case, if the string is null, we must return a null + -- char32_array. The lower bound of this array is required to be zero + -- (RM B.3(50)) but that is of course impossible given that size_t + -- is unsigned. According to Ada 2005 AI-258, the result is to raise + -- Constraint_Error. + + if Item'Length = 0 then + raise Constraint_Error; + + else + declare + R : char32_array (0 .. Item'Length - 1); + + begin + for J in size_t range 0 .. Item'Length - 1 loop + R (J) := To_C (Item (Integer (J) + Item'First)); + end loop; + + return R; + end; + end if; + end if; + end To_C; + + -- Convert Wide_Wide_String to char32_array (procedure form) + + procedure To_C + (Item : Wide_Wide_String; + Target : out char32_array; + Count : out size_t; + Append_Nul : Boolean := True) + is + To : size_t; + + begin + if Target'Length < Item'Length then + raise Constraint_Error; + + else + To := Target'First; + for From in Item'Range loop + Target (To) := To_C (Item (From)); + To := To + 1; + end loop; + + if Append_Nul then + if To > Target'Last then + raise Constraint_Error; + else + Target (To) := char32_t'Val (0); Count := Item'Length + 1; end if; diff --git a/gcc/ada/i-c.ads b/gcc/ada/i-c.ads index bcd77a897e4..f264850589e 100644 --- a/gcc/ada/i-c.ads +++ b/gcc/ada/i-c.ads @@ -6,32 +6,10 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- --- -- --- This specification is derived from the Ada Reference Manual for use with -- --- GNAT. The copyright notice above, and the license provisions that follow -- --- apply solely to the contents of the part following the private keyword. -- --- -- --- 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 2, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- This specification is adapted from the Ada Reference Manual for use with -- +-- GNAT. In accordance with the copyright of that document, you can freely -- +-- copy and modify this specification, provided that if you redistribute a -- +-- modified version, any changes that you have made are clearly indicated. -- -- -- ------------------------------------------------------------------------------ @@ -104,26 +82,24 @@ pragma Pure (C); function Is_Nul_Terminated (Item : in char_array) return Boolean; function To_C - (Item : in String; - Append_Nul : in Boolean := True) - return char_array; + (Item : String; + Append_Nul : Boolean := True) return char_array; function To_Ada - (Item : in char_array; - Trim_Nul : in Boolean := True) - return String; + (Item : char_array; + Trim_Nul : Boolean := True) return String; procedure To_C - (Item : in String; + (Item : String; Target : out char_array; Count : out size_t; - Append_Nul : in Boolean := True); + Append_Nul : Boolean := True); procedure To_Ada - (Item : in char_array; + (Item : char_array; Target : out String; Count : out Natural; - Trim_Nul : in Boolean := True); + Trim_Nul : Boolean := True); ------------------------------------ -- Wide Character and Wide String -- @@ -134,37 +110,121 @@ pragma Pure (C); wide_nul : constant wchar_t := wchar_t'First; - function To_C (Item : in Wide_Character) return wchar_t; - function To_Ada (Item : in wchar_t) return Wide_Character; + function To_C (Item : Wide_Character) return wchar_t; + function To_Ada (Item : wchar_t) return Wide_Character; type wchar_array is array (size_t range <>) of aliased wchar_t; - function Is_Nul_Terminated (Item : in wchar_array) return Boolean; + function Is_Nul_Terminated (Item : wchar_array) return Boolean; function To_C - (Item : in Wide_String; - Append_Nul : in Boolean := True) - return wchar_array; + (Item : Wide_String; + Append_Nul : Boolean := True) return wchar_array; function To_Ada - (Item : in wchar_array; - Trim_Nul : in Boolean := True) - return Wide_String; + (Item : wchar_array; + Trim_Nul : Boolean := True) return Wide_String; procedure To_C - (Item : in Wide_String; + (Item : Wide_String; Target : out wchar_array; Count : out size_t; - Append_Nul : in Boolean := True); + Append_Nul : Boolean := True); procedure To_Ada - (Item : in wchar_array; + (Item : wchar_array; Target : out Wide_String; Count : out Natural; - Trim_Nul : in Boolean := True); + Trim_Nul : Boolean := True); Terminator_Error : exception; -private - -- No private declarations required + -- The remaining declarations are for Ada 2005 (AI-285) + + -- ISO/IEC 10646:2003 compatible types defined by SC22/WG14 document N1010 + + type char16_t is new Wide_Character; + pragma Ada_05 (char16_t); + + char16_nul : constant char16_t := char16_t'Val (0); + pragma Ada_05 (char16_nul); + + function To_C (Item : Wide_Character) return char16_t; + pragma Ada_05 (To_C); + + function To_Ada (Item : char16_t) return Wide_Character; + pragma Ada_05 (To_Ada); + + type char16_array is array (size_t range <>) of aliased char16_t; + pragma Ada_05 (char16_array); + + function Is_Nul_Terminated (Item : char16_array) return Boolean; + pragma Ada_05 (Is_Nul_Terminated); + + function To_C + (Item : Wide_String; + Append_Nul : Boolean := True) return char16_array; + pragma Ada_05 (To_C); + + function To_Ada + (Item : char16_array; + Trim_Nul : Boolean := True) return Wide_String; + pragma Ada_05 (To_Ada); + + procedure To_C + (Item : Wide_String; + Target : out char16_array; + Count : out size_t; + Append_Nul : Boolean := True); + pragma Ada_05 (To_C); + + procedure To_Ada + (Item : char16_array; + Target : out Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True); + pragma Ada_05 (To_Ada); + + type char32_t is new Wide_Wide_Character; + pragma Ada_05 (char32_t); + + char32_nul : constant char32_t := char32_t'Val (0); + pragma Ada_05 (char32_nul); + + function To_C (Item : Wide_Wide_Character) return char32_t; + pragma Ada_05 (To_C); + + function To_Ada (Item : char32_t) return Wide_Wide_Character; + pragma Ada_05 (To_Ada); + + type char32_array is array (size_t range <>) of aliased char32_t; + pragma Ada_05 (char32_array); + + function Is_Nul_Terminated (Item : char32_array) return Boolean; + pragma Ada_05 (Is_Nul_Terminated); + + function To_C + (Item : Wide_Wide_String; + Append_Nul : Boolean := True) return char32_array; + pragma Ada_05 (To_C); + + function To_Ada + (Item : char32_array; + Trim_Nul : Boolean := True) return Wide_Wide_String; + pragma Ada_05 (To_Ada); + + procedure To_C + (Item : Wide_Wide_String; + Target : out char32_array; + Count : out size_t; + Append_Nul : Boolean := True); + pragma Ada_05 (To_C); + + procedure To_Ada + (Item : char32_array; + Target : out Wide_Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True); + pragma Ada_05 (To_Ada); + end Interfaces.C; diff --git a/gcc/ada/i-cpp.adb b/gcc/ada/i-cpp.adb index 24015f10d0b..7eaa2197b9f 100644 --- a/gcc/ada/i-cpp.adb +++ b/gcc/ada/i-cpp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -34,10 +34,33 @@ with Ada.Tags; use Ada.Tags; with System; use System; with System.Storage_Elements; use System.Storage_Elements; -with Unchecked_Conversion; package body Interfaces.CPP is +-- Structure of the Dispatch Table + +-- +-----------------------+ +-- | Offset_To_Top | +-- +-----------------------+ +-- | Typeinfo_Ptr/TSD_Ptr |----> Type Specific Data +-- Tag ---> +-----------------------+ +-------------------+ +-- | table of | | inheritance depth | +-- : primitive ops : +-------------------+ +-- | pointers | | expanded name | +-- +-----------------------+ +-------------------+ +-- | external tag | +-- +-------------------+ +-- | Hash table link | +-- +-------------------+ +-- | Remotely Callable | +-- +-------------------+ +-- | Rec Ctrler offset | +-- +-------------------+ +-- | table of | +-- : ancestor : +-- | tags | +-- +-------------------+ + -- The declarations below need (extensive) comments ??? subtype Cstring is String (Positive); @@ -57,27 +80,32 @@ package body Interfaces.CPP is Pfn : System.Address; end record; - type Type_Specific_Data_Ptr is access all Type_Specific_Data; type Vtable_Entry_Array is array (Positive range <>) of Vtable_Entry; type VTable is record - Prims_Ptr : Vtable_Entry_Array (Positive); - TSD : Type_Specific_Data_Ptr; + -- Offset_To_Top : Integer; + -- Typeinfo_Ptr : System.Address; -- TSD is currently also here??? + Prims_Ptr : Vtable_Entry_Array (Positive); end record; + -- Note: See comment in a-tags.adb explaining why the components + -- Offset_To_Top and Typeinfo_Ptr have been commented out. + -- ----------------------------------------------------------------------- + -- The size of the Prims_Ptr array actually depends on the tagged type to + -- which it applies. For each tagged type, the expander computes the + -- actual array size, allocates the Dispatch_Table record accordingly, and + -- generates code that displaces the base of the record after the + -- Typeinfo_Ptr component. For this reason the first two components have + -- been commented in the previous declaration. The access to these + -- components is done by means of local functions. - -------------------------------------------------------- - -- Unchecked Conversions for Tag, Vtable_Ptr, and TSD -- - -------------------------------------------------------- - - function To_Type_Specific_Data_Ptr is - new Unchecked_Conversion (Address, Type_Specific_Data_Ptr); + --------------------------- + -- Unchecked Conversions -- + --------------------------- - function To_Address is - new Unchecked_Conversion (Type_Specific_Data_Ptr, Address); + type Int_Ptr is access Integer; - --------------------------------------------- - -- Unchecked Conversions for String Fields -- - --------------------------------------------- + function To_Int_Ptr is + new Unchecked_Conversion (System.Address, Int_Ptr); function To_Cstring_Ptr is new Unchecked_Conversion (Address, Cstring_Ptr); @@ -90,8 +118,20 @@ package body Interfaces.CPP is ----------------------- function Length (Str : Cstring_Ptr) return Natural; - -- Length of string represented by the given pointer (treating the - -- string as a C-style string, which is Nul terminated). + -- Length of string represented by the given pointer (treating the string + -- as a C-style string, which is Nul terminated). + + function Offset_To_Top (T : Vtable_Ptr) return Integer; + -- Returns the current value of the offset_to_top component available in + -- the prologue of the dispatch table. + + function Typeinfo_Ptr (T : Vtable_Ptr) return System.Address; + -- Returns the current value of the typeinfo_ptr component available in + -- the prologue of the dispatch table. + + pragma Unreferenced (Offset_To_Top); + pragma Unreferenced (Typeinfo_Ptr); + -- These functions will be used for full compatibility with the C++ ABI ----------------------- -- CPP_CW_Membership -- @@ -101,9 +141,9 @@ package body Interfaces.CPP is (Obj_Tag : Vtable_Ptr; Typ_Tag : Vtable_Ptr) return Boolean is - Pos : constant Integer := Obj_Tag.TSD.Idepth - Typ_Tag.TSD.Idepth; + Pos : constant Integer := TSD (Obj_Tag).Idepth - TSD (Typ_Tag).Idepth; begin - return Pos >= 0 and then Obj_Tag.TSD.Ancestor_Tags (Pos) = Typ_Tag; + return Pos >= 0 and then TSD (Obj_Tag).Ancestor_Tags (Pos) = Typ_Tag; end CPP_CW_Membership; --------------------------- @@ -112,7 +152,7 @@ package body Interfaces.CPP is function CPP_Get_Expanded_Name (T : Vtable_Ptr) return Address is begin - return To_Address (T.TSD.Expanded_Name); + return To_Address (TSD (T).Expanded_Name); end CPP_Get_Expanded_Name; -------------------------- @@ -121,7 +161,7 @@ package body Interfaces.CPP is function CPP_Get_External_Tag (T : Vtable_Ptr) return Address is begin - return To_Address (T.TSD.External_Tag); + return To_Address (TSD (T).External_Tag); end CPP_Get_External_Tag; ------------------------------- @@ -130,7 +170,7 @@ package body Interfaces.CPP is function CPP_Get_Inheritance_Depth (T : Vtable_Ptr) return Natural is begin - return T.TSD.Idepth; + return TSD (T).Idepth; end CPP_Get_Inheritance_Depth; ------------------------- @@ -170,8 +210,11 @@ package body Interfaces.CPP is ----------------- function CPP_Get_TSD (T : Vtable_Ptr) return Address is + use type System.Storage_Elements.Storage_Offset; + TSD_Ptr : constant Addr_Ptr := + To_Addr_Ptr (To_Address (T) - CPP_DT_Typeinfo_Ptr_Size); begin - return To_Address (T.TSD); + return TSD_Ptr.all; end CPP_Get_TSD; -------------------- @@ -198,21 +241,22 @@ package body Interfaces.CPP is (Old_TSD : Address; New_Tag : Vtable_Ptr) is - TSD : constant Type_Specific_Data_Ptr := - To_Type_Specific_Data_Ptr (Old_TSD); + Old_TSD_Ptr : constant Type_Specific_Data_Ptr := + To_Type_Specific_Data_Ptr (Old_TSD); - New_TSD : Type_Specific_Data renames New_Tag.TSD.all; + New_TSD_Ptr : constant Type_Specific_Data_Ptr := + TSD (New_Tag); begin - if TSD /= null then - New_TSD.Idepth := TSD.Idepth + 1; - New_TSD.Ancestor_Tags (1 .. New_TSD.Idepth) - := TSD.Ancestor_Tags (0 .. TSD.Idepth); + if Old_TSD_Ptr /= null then + New_TSD_Ptr.Idepth := Old_TSD_Ptr.Idepth + 1; + New_TSD_Ptr.Ancestor_Tags (1 .. New_TSD_Ptr.Idepth) := + Old_TSD_Ptr.Ancestor_Tags (0 .. Old_TSD_Ptr.Idepth); else - New_TSD.Idepth := 0; + New_TSD_Ptr.Idepth := 0; end if; - New_TSD.Ancestor_Tags (0) := New_Tag; + New_TSD_Ptr.Ancestor_Tags (0) := New_Tag; end CPP_Inherit_TSD; --------------------------- @@ -221,7 +265,7 @@ package body Interfaces.CPP is procedure CPP_Set_Expanded_Name (T : Vtable_Ptr; Value : Address) is begin - T.TSD.Expanded_Name := To_Cstring_Ptr (Value); + TSD (T).Expanded_Name := To_Cstring_Ptr (Value); end CPP_Set_Expanded_Name; -------------------------- @@ -230,7 +274,7 @@ package body Interfaces.CPP is procedure CPP_Set_External_Tag (T : Vtable_Ptr; Value : Address) is begin - T.TSD.External_Tag := To_Cstring_Ptr (Value); + TSD (T).External_Tag := To_Cstring_Ptr (Value); end CPP_Set_External_Tag; ------------------------------- @@ -242,7 +286,7 @@ package body Interfaces.CPP is Value : Natural) is begin - T.TSD.Idepth := Value; + TSD (T).Idepth := Value; end CPP_Set_Inheritance_Depth; ----------------------------- @@ -285,8 +329,11 @@ package body Interfaces.CPP is ----------------- procedure CPP_Set_TSD (T : Vtable_Ptr; Value : Address) is + use type System.Storage_Elements.Storage_Offset; + TSD_Ptr : constant Addr_Ptr := + To_Addr_Ptr (To_Address (T) - CPP_DT_Typeinfo_Ptr_Size); begin - T.TSD := To_Type_Specific_Data_Ptr (Value); + TSD_Ptr.all := Value; end CPP_Set_TSD; -------------------- @@ -314,7 +361,7 @@ package body Interfaces.CPP is ------------------- function Expanded_Name (T : Vtable_Ptr) return String is - Result : constant Cstring_Ptr := T.TSD.Expanded_Name; + Result : constant Cstring_Ptr := TSD (T).Expanded_Name; begin return Result (1 .. Length (Result)); end Expanded_Name; @@ -324,7 +371,7 @@ package body Interfaces.CPP is ------------------ function External_Tag (T : Vtable_Ptr) return String is - Result : constant Cstring_Ptr := T.TSD.External_Tag; + Result : constant Cstring_Ptr := TSD (T).External_Tag; begin return Result (1 .. Length (Result)); end External_Tag; @@ -344,4 +391,38 @@ package body Interfaces.CPP is return Len - 1; end Length; + ------------------ + -- Offset_To_Top -- + ------------------ + + function Offset_To_Top (T : Vtable_Ptr) return Integer is + use type System.Storage_Elements.Storage_Offset; + + TSD_Ptr : constant Int_Ptr + := To_Int_Ptr (To_Address (T) - CPP_DT_Prologue_Size); + begin + return TSD_Ptr.all; + end Offset_To_Top; + + ------------------ + -- Typeinfo_Ptr -- + ------------------ + + function Typeinfo_Ptr (T : Vtable_Ptr) return System.Address is + use type System.Storage_Elements.Storage_Offset; + TSD_Ptr : constant Addr_Ptr := + To_Addr_Ptr (To_Address (T) - CPP_DT_Typeinfo_Ptr_Size); + begin + return TSD_Ptr.all; + end Typeinfo_Ptr; + + --------- + -- TSD -- + --------- + + function TSD (T : Vtable_Ptr) return Type_Specific_Data_Ptr is + begin + return To_Type_Specific_Data_Ptr (CPP_Get_TSD (T)); + end TSD; + end Interfaces.CPP; diff --git a/gcc/ada/i-cpp.ads b/gcc/ada/i-cpp.ads index a53c38b2242..df39bdb4df0 100644 --- a/gcc/ada/i-cpp.ads +++ b/gcc/ada/i-cpp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -45,18 +45,25 @@ with System; with System.Storage_Elements; +with Unchecked_Conversion; package Interfaces.CPP is - package S renames System; - package SSE renames System.Storage_Elements; - type Vtable_Ptr is private; function Expanded_Name (T : Vtable_Ptr) return String; function External_Tag (T : Vtable_Ptr) return String; private + package S renames System; + package SSE renames System.Storage_Elements; + + type Vtable; + type Vtable_Ptr is access all Vtable; + + type Type_Specific_Data; + type Type_Specific_Data_Ptr is access all Type_Specific_Data; + -- These subprograms are in the private part. They are never accessed -- directly except from compiler generated code, which has access to -- private components of packages via the Rtsfind interface. @@ -98,9 +105,14 @@ private CPP_DT_Prologue_Size : constant SSE.Storage_Count := SSE.Storage_Count - (1 * (Standard'Address_Size / S.Storage_Unit)); + (2 * (Standard'Address_Size / S.Storage_Unit)); -- Size of the first part of the dispatch table + CPP_DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count := + SSE.Storage_Count + (Standard'Address_Size / System.Storage_Unit); + -- Size of the Typeinfo_Ptr field of the Dispatch Table. + CPP_DT_Entry_Size : constant SSE.Storage_Count := SSE.Storage_Count (1 * (Standard'Address_Size / S.Storage_Unit)); @@ -174,8 +186,21 @@ private -- compatible with MI. -- (used for virtual function calls) - type Vtable; - type Vtable_Ptr is access all Vtable; + function TSD (T : Vtable_Ptr) return Type_Specific_Data_Ptr; + -- This function is conceptually equivalent to Get_TSD, but + -- returning a Type_Specific_Data_Ptr type (rather than an Address) + -- simplifies the implementation of the other subprograms. + + type Addr_Ptr is access System.Address; + + function To_Address is + new Unchecked_Conversion (Vtable_Ptr, System.Address); + + function To_Addr_Ptr is + new Unchecked_Conversion (System.Address, Addr_Ptr); + + function To_Type_Specific_Data_Ptr is + new Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr); pragma Inline (CPP_Set_Prim_Op_Address); pragma Inline (CPP_Get_Prim_Op_Address); @@ -192,5 +217,6 @@ private pragma Inline (CPP_Set_Remotely_Callable); pragma Inline (CPP_Get_Remotely_Callable); pragma Inline (Displaced_This); + pragma Inline (TSD); end Interfaces.CPP; diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index d2e1d5daea3..2202ac3a14e 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-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- -- @@ -26,25 +26,29 @@ with Lib; use Lib; with Namet; use Namet; -with Opt; use Opt; package body Impunit is subtype File_Name_8 is String (1 .. 8); type File_List is array (Nat range <>) of File_Name_8; - -- The following is a giant string containing the concenated names - -- of all non-implementation internal files, i.e. the complete list - -- of files for internal units which a program may legitimately WITH. + ------------------ + -- Ada 95 Units -- + ------------------ - -- Note that this list should match the list of units documented in - -- the "GNAT Library" section of the GNAT Reference Manual. + -- The following is a giant string list containing the names of all + -- non-implementation internal files, i.e. the complete list of files for + -- internal units which a program may legitimately WITH when operating in + -- either Ada 95 or Ada 05 mode. - Non_Imp_File_Names : constant File_List := ( + -- Note that this list should match the list of units documented in the + -- "GNAT Library" section of the GNAT Reference Manual. - ----------------------------------------------- - -- Ada Hierarchy Units from Reference Manual -- - ----------------------------------------------- + Non_Imp_File_Names_95 : constant File_List := ( + + ------------------------------------------------------ + -- Ada Hierarchy Units from Ada-83 Reference Manual -- + ------------------------------------------------------ "a-astaco", -- Ada.Asynchronous_Task_Control "a-calend", -- Ada.Calendar @@ -53,7 +57,6 @@ package body Impunit is "a-chlat1", -- Ada.Characters.Latin_1 "a-comlin", -- Ada.Command_Line "a-decima", -- Ada.Decimal - "a-direct", -- Ada.Directories "a-direio", -- Ada.Direct_IO "a-dynpri", -- Ada.Dynamic_Priorities "a-except", -- Ada.Exceptions @@ -144,6 +147,7 @@ package body Impunit is "a-cwila9", -- Ada.Characters.Wide_Latin_9 "a-diocst", -- Ada.Direct_IO.C_Streams "a-einuoc", -- Ada.Exceptions.Is_Null_Occurrence + "a-elchha", -- Ada.Exceptions.Last_Chance_Handler "a-exctra", -- Ada.Exceptions.Traceback "a-siocst", -- Ada.Sequential_IO.C_Streams "a-ssicst", -- Ada.Streams.Stream_IO.C_Streams @@ -305,32 +309,126 @@ package body Impunit is "s-wchcnv", -- System.Wch_Cnv "s-wchcon"); -- System.Wch_Con - ------------------------- - -- Implementation_Unit -- - ------------------------- + -------------------- + -- Ada 2005 Units -- + -------------------- + + -- The following units should be used only in Ada 05 mode + + Non_Imp_File_Names_05 : constant File_List := ( + + -------------------------------------------------------- + -- Ada Hierarchy Units from Ada 2005 Reference Manual -- + -------------------------------------------------------- + + "a-cdlili", -- Ada.Containers.Doubly_Linked_Lists + "a-cgaaso", -- Ada.Containers.Generic_Anonymous_Array_Sort + "a-cgarso", -- Ada.Containers.Generic_Array_Sort + "a-cgcaso", -- Ada.Containers.Generic_Constrained_Array_Sort + "a-chtgke", -- Ada.Containers.Hash_Tables.Generic_Keys + "a-chtgop", -- Ada.Containers.Hash_Tables.Generic_Operations + "a-cidlli", -- Ada.Containers.Indefinite_Doubly_Linked_Lists + "a-cihama", -- Ada.Containers.Indefinite_Hashed_Maps + "a-cihase", -- Ada.Containers.Indefinite_Hashed_Sets + "a-ciorma", -- Ada.Containers.Indefinite_Ordered_Maps + "a-ciormu", -- Ada.Containers.Indefinite_Ordered_Multisets + "a-ciorse", -- Ada.Containers.Indefinite_Ordered_Sets + "a-cohama", -- Ada.Containers.Hashed_Maps + "a-cohase", -- Ada.Containers.Hashed_Sets + "a-cohata", -- Ada.Containers.Hash_Tables + "a-coinve", -- Ada.Containers.Indefinite_Vectors + "a-contai", -- Ada.Containers + "a-convec", -- Ada.Containers.Vectors + "a-coorma", -- Ada.Containers.Ordered_Maps + "a-coormu", -- Ada.Containers.Ordered_Multisets + "a-coorse", -- Ada.Containers.Ordered_Sets + "a-coprnu", -- Ada.Containers.Prime_Numbers + "a-crbltr", -- Ada.Containers.Red_Black_Trees + "a-crbtgk", -- Ada.Containers.Red_Black_Trees.Generic_Keys + "a-crbtgo", -- Ada.Containers.Red_Black_Trees.Generic_Operations + "a-direct", -- Ada.Directories + "a-rbtgso", -- Ada.Containers.Red_Black_Trees.Generic_Set_Operations + "a-secain", -- Ada.Strings.Equal_Case_Insensitive + "a-shcain", -- Ada.Strings.Hash_Case_Insensitive + "a-slcain", -- Ada.Strings.Less_Case_Insensitive + "a-strhas", -- Ada.Strings.Hash + "a-stunha", -- Ada.Strings.Unbounded.Hash + "a-stwiha", -- Ada.Strings.Wide_Hash + "a-stzbou", -- Ada.Strings.Wide_Wide_Bounded + "a-stzfix", -- Ada.Strings.Wide_Wide_Fixed + "a-stzhas", -- Ada.Strings.Wide_Wide_Hash + "a-stzmap", -- Ada.Strings.Wide_Wide_Maps + "a-stzunb", -- Ada.Strings.Wide_Wide_Unbounded + "a-swunha", -- Ada.Strings.Wide_Unbounded.Hash + "a-szmzco", -- Ada.Strings.Wide_Wide_Maps.Wide_Wide_Constants; + "a-szunha", -- Ada.Strings.Wide_Wide_Unbounded.Hash + "a-tiunio", -- Ada.Text_IO.Unbounded_IO; + "a-wwunio", -- Ada.Wide_Text_IO.Wide_Unbounded_IO; + "a-zttest", -- Ada.Wide_Wide_Text_IO.Text_Streams + "a-ztexio", -- Ada.Wide_Wide_Text_IO + "a-zzunio", -- Ada.Wide_Wide_Text_IO.Wide_Wide_Unbounded_IO + + ------------------------------------------------------ + -- RM Required Additions to Ada 2005 for GNAT Types -- + ------------------------------------------------------ + + "a-lfztio", -- Ada.Long_Float_Wide_Wide_Text_IO + "a-liztio", -- Ada.Long_Integer_Wide_Wide_Text_IO + "a-llfzti", -- Ada.Long_Long_Float_Wide_Wide_Text_IO + "a-llizti", -- Ada.Long_Long_Integer_Wide_Wide_Text_IO + "a-sfztio", -- Ada.Short_Float_Wide_Wide_Text_IO + "a-siztio", -- Ada.Short_Integer_Wide_Wide_Text_IO + "a-ssizti", -- Ada.Short_Short_Integer_Wide_Wide_Text_IO + "a-ztcstr", -- Ada.Wide_Wide_Text_IO.C_Streams + + ---------------------------------------- + -- GNAT Defined Additions to Ada 2005 -- + ---------------------------------------- + + "a-chzla1", -- Ada.Characters.Wide_Wide_Latin_1 + "a-chzla9", -- Ada.Characters.Wide_Wide_Latin_9 + "a-szuzti", -- Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO - function Implementation_Unit (U : Unit_Number_Type) return Boolean is - Fname : constant File_Name_Type := Unit_File_Name (U); + --------------------------- + -- GNAT Special IO Units -- + --------------------------- - begin - -- All units are OK in GNAT mode + -- See Ada 95 section for further information. These packages are for the + -- implementation of the Wide_Wide_Text_IO generic packages. - if GNAT_Mode then - return False; - end if; + "a-ztdeio", -- Ada.Wide_Wide_Text_IO.Decimal_IO + "a-ztenio", -- Ada.Wide_Wide_Text_IO.Enumeration_IO + "a-ztfiio", -- Ada.Wide_Wide_Text_IO.Fixed_IO + "a-ztflio", -- Ada.Wide_Wide_Text_IO.Float_IO + "a-ztinio", -- Ada.Wide_Wide_Text_IO.Integer_IO + "a-ztmoio", -- Ada.Wide_Wide_Text_IO.Modular_IO - -- If length of file name is greater than 12, definitely OK! + ------------------------ + -- GNAT Library Units -- + ------------------------ + + "g-zstspl"); -- GNAT.Wide_Wide_String_Split + + ---------------------- + -- Get_Kind_Of_Unit -- + ---------------------- + + function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit is + Fname : constant File_Name_Type := Unit_File_Name (U); + + begin + -- If length of file name is greater than 12, not predefined. -- The value 12 here is an 8 char name with extension .ads. if Length_Of_Name (Fname) > 12 then - return False; + return Not_Predefined_Unit; end if; -- Otherwise test file name Get_Name_String (Fname); - -- Definitely OK if file name does not start with a- g- s- i- + -- Not predefined if file name does not start with a- g- s- i- if Name_Len < 3 or else Name_Buffer (2) /= '-' @@ -342,14 +440,14 @@ package body Impunit is and then Name_Buffer (1) /= 's') then - return False; + return Not_Predefined_Unit; end if; - -- Definitely OK if file name does not end in .ads. This can + -- Not predefined if file name does not end in .ads. This can -- happen when non-standard file names are being used. if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" then - return False; + return Not_Predefined_Unit; end if; -- Otherwise normalize file name to 8 characters @@ -360,42 +458,48 @@ package body Impunit is Name_Buffer (Name_Len) := ' '; end loop; - -- Definitely OK if name is in list + -- See if name is in 95 list - for J in Non_Imp_File_Names'Range loop - if Name_Buffer (1 .. 8) = Non_Imp_File_Names (J) then - return False; + for J in Non_Imp_File_Names_95'Range loop + if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J) then + return Ada_95_Unit; end if; end loop; - -- Only remaining special possibilities are children of - -- System.RPC and System.Garlic and special files of the - -- form System.Aux... + -- See if name is in 05 list + + for J in Non_Imp_File_Names_05'Range loop + if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J) then + return Ada_05_Unit; + end if; + end loop; + + -- Only remaining special possibilities are children of System.RPC and + -- System.Garlic and special files of the form System.Aux... Get_Name_String (Unit_Name (U)); if Name_Len > 12 and then Name_Buffer (1 .. 11) = "system.rpc." then - return False; + return Ada_95_Unit; end if; if Name_Len > 15 and then Name_Buffer (1 .. 14) = "system.garlic." then - return False; + return Ada_95_Unit; end if; if Name_Len > 11 and then Name_Buffer (1 .. 10) = "system.aux" then - return False; + return Ada_95_Unit; end if; -- All tests failed, this is definitely an implementation unit - return True; - - end Implementation_Unit; + return Implementation_Unit; + end Get_Kind_Of_Unit; end Impunit; diff --git a/gcc/ada/impunit.ads b/gcc/ada/impunit.ads index 02917ccd8d8..075772b7323 100644 --- a/gcc/ada/impunit.ads +++ b/gcc/ada/impunit.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-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- -- @@ -26,17 +26,36 @@ -- This package contains data and functions used to determine if a given -- unit is an internal unit intended only for use by the implementation --- and which should not be directly WITH'ed by user code. +-- and which should not be directly WITH'ed by user code. It also checks +-- for Ada 05 units that should only be WITH'ed in Ada 05 mode. with Types; use Types; package Impunit is - function Implementation_Unit (U : Unit_Number_Type) return Boolean; - -- Given the unit number of a unit, this function determines if it is a - -- unit that is intended to be used only internally by the implementation. - -- This is used for posting warnings for improper WITH's of such units - -- (such WITH's are allowed without warnings only in GNAT_Mode set by - -- the use of -gnatg). True is returned if a warning should be posted. + type Kind_Of_Unit is + (Implementation_Unit, + -- Unit from predefined library intended to be used only by the + -- compiler generated code, or from the implementation of the run time. + -- Use of such a unit generates a warning unless the client is compiled + -- with the -gnatg switch. If we are being super strict, this should be + -- an error for the case of Ada units, but that seems over strenuous. + + Not_Predefined_Unit, + -- This is not a predefined unit, so no checks are needed + + Ada_95_Unit, + -- This unit is defined in the Ada 95 RM, and can be freely with'ed + -- in both Ada 95 mode and Ada 05 mode. Note that in Ada 83 mode, no + -- child units are allowed, so you can't even name such a unit. + + Ada_05_Unit); + -- This unit is defined in the Ada 05 RM. Withing this unit from a + -- Ada 95 mode program will generate a warning (again, strictly speaking + -- this should be an error, but that seems over-strenuous). + + function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit; + -- Given the unit number of a unit, this function determines the type + -- of the unit, as defined above. end Impunit; diff --git a/gcc/ada/krunch.adb b/gcc/ada/krunch.adb index da0929c49d4..a325063d2f5 100644 --- a/gcc/ada/krunch.adb +++ b/gcc/ada/krunch.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2000 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- -- @@ -44,6 +44,7 @@ is Krlen : Natural; Num_Seps : Natural; Startloc : Natural; + J : Natural; begin -- Deal with special predefined children cases. Startloc is the first @@ -64,6 +65,15 @@ begin Curlen := Len - 12; Krlen := 8; + elsif Len >= 23 + and then Buffer (1 .. 22) = "ada-wide_wide_text_io-" + then + Startloc := 3; + Buffer (2 .. 5) := "-zt-"; + Buffer (6 .. Len - 17) := Buffer (23 .. Len); + Curlen := Len - 17; + Krlen := 8; + elsif Len >= 4 and then Buffer (1 .. 4) = "ada-" then Startloc := 3; Buffer (2 .. Len - 2) := Buffer (4 .. Len); @@ -138,6 +148,26 @@ begin return; end if; + -- If string contains Wide_Wide, replace by a single z + + J := Startloc; + while J <= Curlen - 8 loop + if Buffer (J .. J + 8) = "wide_wide" + and then (J = Startloc + or else Buffer (J - 1) = '-' + or else Buffer (J - 1) = '_') + and then (J + 8 = Curlen + or else Buffer (J + 9) = '-' + or else Buffer (J + 9) = '_') + then + Buffer (J) := 'z'; + Buffer (J + 1 .. Curlen - 8) := Buffer (J + 9 .. Curlen); + Curlen := Curlen - 8; + end if; + + J := J + 1; + end loop; + -- For now, refuse to krunch a name that contains an ESC character (wide -- character sequence) since it's too much trouble to do this right ??? @@ -152,7 +182,6 @@ begin -- the krunching process, and then we eliminate them as the last step Num_Seps := 0; - for J in Startloc .. Curlen loop if Buffer (J) = '-' or else Buffer (J) = '_' then Buffer (J) := ' '; diff --git a/gcc/ada/krunch.ads b/gcc/ada/krunch.ads index 2cf94360cee..f4637fbc788 100644 --- a/gcc/ada/krunch.ads +++ b/gcc/ada/krunch.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-1997 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- -- @@ -111,7 +111,12 @@ -- a-wtflio --- This is the only irregularity required (so far!) to keep the file names +-- More problems arise with Wide_Wide, so we replace this sequence by +-- a z (which is not used much) and also (as in the Wide_Text_IO case), +-- we replace the prefix ada.wide_wide_text_io- by a-zt- and then +-- the normal crunching rules are applied. + +-- These are the only irregularity required (so far!) to keep the file names -- unique in the standard predefined libraries. procedure Krunch diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index eae80ff022c..5afc12bf13f 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-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- -- @@ -261,10 +261,18 @@ package body Lib.Xref is begin pragma Assert (Nkind (E) in N_Entity); + -- Check for obsolescent reference to ASCII + if E = Standard_ASCII then Check_Restriction (No_Obsolescent_Features, N); end if; + -- Warn if reference to Ada 2005 entity not in Ada 2005 mode + + if Is_Ada_2005 (E) and then Ada_Version < Ada_05 then + Error_Msg_NE ("& is only defined in Ada 2005?", N, E); + end if; + -- Never collect references if not in main source unit. However, -- we omit this test if Typ is 'e' or 'k', since these entries are -- really structural, and it is useful to have them in units diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index c33559c3968..03ca2d0ee96 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004, Ada Core Technologies, Inc. -- +-- Copyright (C) 2001-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- -- @@ -1419,19 +1419,19 @@ package body MLib.Prj is Data := Projects.Table (For_Project); declare - Interface : String_List_Id := Data.Lib_Interface_ALIs; - ALI : File_Name_Type; + Iface : String_List_Id := Data.Lib_Interface_ALIs; + ALI : File_Name_Type; begin - while Interface /= Nil_String loop - ALI := String_Elements.Table (Interface).Value; + while Iface /= Nil_String loop + ALI := String_Elements.Table (Iface).Value; Interface_ALIs.Set (ALI, True); - Get_Name_String (String_Elements.Table (Interface).Value); + Get_Name_String (String_Elements.Table (Iface).Value); Add_Argument (Name_Buffer (1 .. Name_Len)); - Interface := String_Elements.Table (Interface).Next; + Iface := String_Elements.Table (Iface).Next; end loop; - Interface := Data.Lib_Interface_ALIs; + Iface := Data.Lib_Interface_ALIs; if not Opt.Quiet_Output then @@ -1439,10 +1439,10 @@ package body MLib.Prj is -- library that is needed by an interface should also be an -- interface. If it is not the case, output a warning. - while Interface /= Nil_String loop - ALI := String_Elements.Table (Interface).Value; + while Iface /= Nil_String loop + ALI := String_Elements.Table (Iface).Value; Process (ALI); - Interface := String_Elements.Table (Interface).Next; + Iface := String_Elements.Table (Iface).Next; end loop; end if; end; diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb index df8796f30cd..65efb4c65a7 100644 --- a/gcc/ada/mlib.adb +++ b/gcc/ada/mlib.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2004, Ada Core Technologies, Inc. -- +-- Copyright (C) 1999-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- -- @@ -101,9 +101,9 @@ package body MLib is To : Name_Id; Interfaces : String_List) is - Success : Boolean := False; - To_Dir : constant String := Get_Name_String (To); - Interface : Boolean := False; + Success : Boolean := False; + To_Dir : constant String := Get_Name_String (To); + Is_Interface : Boolean := False; procedure Verbose_Copy (Index : Positive); -- In verbose mode, output a message that the indexed file is copied @@ -154,11 +154,11 @@ package body MLib is -- Check if this is one of the interface ALIs - Interface := False; + Is_Interface := False; for Index in Interfaces'Range loop if File_Name = Interfaces (Index).all then - Interface := True; + Is_Interface := True; exit; end if; end loop; @@ -167,7 +167,7 @@ package body MLib is -- the interface indication at the end of the P line. -- Do not copy ALI files that are not Interfaces. - if Interface then + if Is_Interface then Success := False; Verbose_Copy (Index); diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index 8bd712754f9..d462d1152e5 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -273,9 +273,9 @@ package body Namet is procedure Copy_One_Character; -- Copy a character from Name_Buffer to New_Buf. Includes case - -- of copying a Uhh or Whhhh sequence and decoding it. + -- of copying a Uhh,Whhhh,WWhhhhhhhh sequence and decoding it. - function Hex (N : Natural) return Natural; + function Hex (N : Natural) return Word; -- Scans past N digits using Old pointer and returns hex value procedure Insert_Character (C : Character); @@ -301,6 +301,15 @@ package body Namet is Old := Old + 1; Insert_Character (Character'Val (Hex (2))); + -- WW (wide wide character insertion) + + elsif C = 'W' + and then Old < Name_Len + and then Name_Buffer (Old + 1) = 'W' + then + Old := Old + 2; + Widechar.Set_Wide (Char_Code (Hex (8)), New_Buf, New_Len); + -- W (wide character insertion) elsif C = 'W' @@ -323,8 +332,8 @@ package body Namet is -- Hex -- --------- - function Hex (N : Natural) return Natural is - T : Natural := 0; + function Hex (N : Natural) return Word is + T : Word := 0; C : Character; begin @@ -492,7 +501,7 @@ package body Namet is elsif Name_Buffer (1) = 'Q' then Get_Decoded_Name_String (Id); - -- Only remaining issue is U/W sequences + -- Only remaining issue is U/W/WW sequences else Get_Name_String (Id); @@ -502,6 +511,8 @@ package body Namet is if Name_Buffer (P + 1) in 'A' .. 'Z' then P := P + 1; + -- Uhh encoding + elsif Name_Buffer (P) = 'U' then for J in reverse P + 3 .. P + Name_Len loop Name_Buffer (J + 3) := Name_Buffer (J); @@ -516,22 +527,38 @@ package body Namet is Name_Buffer (P + 5) := ']'; P := P + 6; + -- WWhhhhhhhh encoding + + elsif Name_Buffer (P) = 'W' + and then P + 9 <= Name_Len + and then Name_Buffer (P + 1) = 'W' + and then Name_Buffer (P + 2) not in 'A' .. 'Z' + and then Name_Buffer (P + 2) /= '_' + then + Name_Buffer (P + 12 .. Name_Len + 2) := + Name_Buffer (P + 10 .. Name_Len); + Name_Buffer (P) := '['; + Name_Buffer (P + 1) := '"'; + Name_Buffer (P + 10) := '"'; + Name_Buffer (P + 11) := ']'; + Name_Len := Name_Len + 2; + P := P + 12; + + -- Whhhh encoding + elsif Name_Buffer (P) = 'W' and then P < Name_Len and then Name_Buffer (P + 1) not in 'A' .. 'Z' and then Name_Buffer (P + 1) /= '_' then - Name_Buffer (P + 8 .. P + Name_Len + 5) := + Name_Buffer (P + 8 .. P + Name_Len + 3) := Name_Buffer (P + 5 .. Name_Len); - Name_Buffer (P + 5) := Name_Buffer (P + 4); - Name_Buffer (P + 4) := Name_Buffer (P + 3); - Name_Buffer (P + 3) := Name_Buffer (P + 2); - Name_Buffer (P + 2) := Name_Buffer (P + 1); + Name_Buffer (P + 2 .. P + 5) := Name_Buffer (P + 1 .. P + 4); Name_Buffer (P) := '['; Name_Buffer (P + 1) := '"'; Name_Buffer (P + 6) := '"'; Name_Buffer (P + 7) := ']'; - Name_Len := Name_Len + 5; + Name_Len := Name_Len + 3; P := P + 8; else @@ -1135,19 +1162,25 @@ package body Namet is procedure Store_Encoded_Character (C : Char_Code) is - procedure Set_Hex_Chars (N : Natural); + procedure Set_Hex_Chars (C : Char_Code); -- Stores given value, which is in the range 0 .. 255, as two hex - -- digits (using lower case a-f) in Name_Buffer, incrementing Name_Len + -- digits (using lower case a-f) in Name_Buffer, incrementing Name_Len. - procedure Set_Hex_Chars (N : Natural) is - Hexd : constant String := "0123456789abcdef"; + ------------------- + -- Set_Hex_Chars -- + ------------------- + procedure Set_Hex_Chars (C : Char_Code) is + Hexd : constant String := "0123456789abcdef"; + N : constant Natural := Natural (C); begin Name_Buffer (Name_Len + 1) := Hexd (N / 16 + 1); Name_Buffer (Name_Len + 2) := Hexd (N mod 16 + 1); Name_Len := Name_Len + 2; end Set_Hex_Chars; + -- Start of processing for Store_Encoded_Character + begin Name_Len := Name_Len + 1; @@ -1159,16 +1192,24 @@ package body Namet is Name_Buffer (Name_Len) := CC; else Name_Buffer (Name_Len) := 'U'; - Set_Hex_Chars (Natural (C)); + Set_Hex_Chars (C); end if; end; + elsif In_Wide_Character_Range (C) then + Name_Buffer (Name_Len) := 'W'; + Set_Hex_Chars (C / 256); + Set_Hex_Chars (C mod 256); + else Name_Buffer (Name_Len) := 'W'; - Set_Hex_Chars (Natural (C) / 256); - Set_Hex_Chars (Natural (C) mod 256); + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := 'W'; + Set_Hex_Chars (C / 2 ** 24); + Set_Hex_Chars ((C / 2 ** 16) mod 256); + Set_Hex_Chars ((C / 256) mod 256); + Set_Hex_Chars (C mod 256); end if; - end Store_Encoded_Character; -------------------------------------- diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index bf4ec2cc261..3a3e5e03748 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -48,17 +48,18 @@ package Namet is -- The forms of the entries are as follows: --- Identifiers Stored with upper case letters folded to lower case. --- Upper half (16#80# bit set) and wide characters are --- stored in an encoded form (Uhh for upper half and --- Whhhh for wide characters, as provided by the routine --- Store_Encoded_Character, where hh are hex digits for --- the character code using lower case a-f). Normally --- the use of U or W in other internal names is avoided, --- but these letters may be used in internal names --- (without this special meaning), if the appear as --- the last character of the name, or they are followed --- by an upper case letter or an underscore. +-- Identifiers Stored with upper case letters folded to lower case. Upper +-- half (16#80# bit set) and wide characters are stored +-- in an encoded form (Uhh for upper half char, Whhhh +-- for wide characters, WWhhhhhhhh as provided by the +-- routine Store_Encoded_Character, where hh are hex +-- digits for the character code using lower case a-f). +-- Normally the use of U or W in other internal names is +-- avoided, but these letters may be used in internal +-- names (without this special meaning), if they appear +-- as the last character of the name, or they are +-- followed by an upper case letter (other than the WW +-- sequence), or an underscore. -- Operator symbols Stored with an initial letter O, and the remainder @@ -73,7 +74,7 @@ package Namet is -- Character literals Character literals have names that are used only for -- debugging and error message purposes. The form is a -- upper case Q followed by a single lower case letter, --- or by a Uxx or Wxxxx encoding as described for +-- or by a Uxx/Wxxxx/WWxxxxxxx encoding as described for -- identifiers. The Set_Character_Literal_Name procedure -- should be used to construct these encodings. Normally -- the use of O in other internal names is avoided, but @@ -83,9 +84,9 @@ package Namet is -- underscore. -- Unit names Stored with upper case letters folded to lower case, --- using Uhh/Whhhh encoding as described for identifiers, --- and a %s or %b suffix for specs/bodies. See package --- Uname for further details. +-- using Uhh/Whhhh/WWhhhhhhhh encoding as described for +-- identifiers, and a %s or %b suffix for specs/bodies. +-- See package Uname for further details. -- File names Are stored in the form provided by Osint. Typically -- they may include wide character escape sequences and @@ -100,12 +101,12 @@ package Namet is -- characters may appear for such entries. -- Note: the encodings Uhh (upper half characters), Whhhh (wide characters), --- and Qx (character literal names) are described in the spec, since they are --- visible throughout the system (e.g. in debugging output). However, no code --- should depend on these particular encodings, so it should be possible to --- change the encodings by making changes only to the Namet specification (to --- change these comments) and the body (which actually implements the --- encodings). +-- WWhhhhhhhh (wide wide characters) and Qx (character literal names) are +-- described in the spec, since they are visible throughout the system (e.g. +-- in debugging output). However, no code should depend on these particular +-- encodings, so it should be possible to change the encodings by making +-- changes only to the Namet specification (to change these comments) and the +-- body (which actually implements the encodings). -- The names are hashed so that a given name appears only once in the table, -- except that names entered with Name_Enter as opposed to Name_Find are @@ -188,13 +189,14 @@ package Namet is procedure Get_Decoded_Name_String_With_Brackets (Id : Name_Id); -- This routine is similar to Decoded_Name, except that the brackets - -- notation (Uhh replaced by ["hh"], Whhhh replaced by ["hhhh"]) is used - -- for all non-lower half characters, regardless of the setting of - -- Opt.Wide_Character_Encoding_Method, and also in that characters in the - -- range 16#80# .. 16#FF# are converted to brackets notation in all cases. - -- This routine can be used when there is a requirement for a canonical - -- representation not affected by the character set options (e.g. in the - -- binder generation of symbols). + -- notation (Uhh replaced by ["hh"], Whhhh replaced by ["hhhh"], + -- WWhhhhhhhh replaced by ["hhhhhhhh"]) is used for all non-lower half + -- characters, regardless of how Opt.Wide_Character_Encoding_Method is + -- set, and also in that characters in the range 16#80# .. 16#FF# are + -- converted to brackets notation in all cases. This routine can be used + -- when there is a requirement for a canonical representation not affected + -- by the character set options (e.g. in the binder generation of + -- symbols). function Get_Name_Table_Byte (Id : Name_Id) return Byte; pragma Inline (Get_Name_Table_Byte); @@ -328,11 +330,12 @@ package Namet is -- Stores given character code at the end of Name_Buffer, updating the -- value in Name_Len appropriately. Lower case letters and digits are -- stored unchanged. Other 8-bit characters are stored using the Uhh - -- encoding (hh = hex code), and other 16-bit wide-character values are - -- stored using the Whhhh (hhhh = hex code) encoding. Note that this - -- procedure does not fold upper case letters (they are stored using the - -- Uhh encoding). If folding is required, it must be done by the caller - -- prior to the call. + -- encoding (hh = hex code), other 16-bit wide character values are stored + -- using the Whhhh (hhhh = hex code) encoding, and other 32-bit wide wide + -- character values are stored using the WWhhhhhhhh (hhhhhhhh = hex code). + -- Note that this procedure does not fold upper case letters (they are + -- stored using the Uhh encoding). If folding is required, it must be done + -- by the caller prior to the call. procedure Tree_Read; -- Initializes internal tables from current tree file using the relevant diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index e710275b74a..1627831ab17 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -271,6 +271,11 @@ package Opt is -- of the original source code. Causes debugging information to be -- written with respect to the generated code file that is written. + Default_Exit_Status : Int := 0; + -- GNATBIND + -- Set the default exit status value. Set by the -Xnnn switch for the + -- binder. + Default_Sec_Stack_Size : Int := -1; -- GNATBIND -- Set to default secondary stack size in units of kilobytes. Set by diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb index e9fe5537136..7dcc6ba08e1 100644 --- a/gcc/ada/par-ch12.adb +++ b/gcc/ada/par-ch12.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -808,8 +808,15 @@ package body Ch12 is ----------------------------------------- -- FORMAL_SUBPROGRAM_DECLARATION ::= + -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION + -- | FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION + + -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION ::= -- with SUBPROGRAM_SPECIFICATION [is SUBPROGRAM_DEFAULT]; + -- FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION ::= + -- with SUBPROGRAM_SPECIFICATION is abstract [SUBPROGRAM_DEFAULT]; + -- SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <> -- DEFAULT_NAME ::= NAME @@ -817,32 +824,55 @@ package body Ch12 is -- The caller has checked that the initial tokens are WITH FUNCTION or -- WITH PROCEDURE, and the initial WITH has been scanned out. - -- Note: we separate this into two procedures because the name is allowed - -- to be an operator symbol for a function, but not for a procedure. - -- Error recovery: cannot raise Error_Resync function P_Formal_Subprogram_Declaration return Node_Id is - Def_Node : Node_Id; + Prev_Sloc : constant Source_Ptr := Prev_Token_Ptr; + Spec_Node : constant Node_Id := P_Subprogram_Specification; + Def_Node : Node_Id; begin - Def_Node := New_Node (N_Formal_Subprogram_Declaration, Prev_Token_Ptr); - Set_Specification (Def_Node, P_Subprogram_Specification); - if Token = Tok_Is then T_Is; -- past IS, skip extra IS or ";" - if Token = Tok_Box then + if Token = Tok_Abstract then + Def_Node := + New_Node (N_Formal_Abstract_Subprogram_Declaration, Prev_Sloc); + Scan; -- past ABSTRACT + + if Ada_Version < Ada_05 then + Error_Msg_SP + ("formal abstract subprograms are an Ada 2005 extension"); + Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); + end if; + + else + Def_Node := + New_Node (N_Formal_Concrete_Subprogram_Declaration, Prev_Sloc); + end if; + + Set_Specification (Def_Node, Spec_Node); + + if Token = Tok_Semicolon then + Scan; -- past ";" + + elsif Token = Tok_Box then Set_Box_Present (Def_Node, True); Scan; -- past <> + T_Semicolon; else Set_Default_Name (Def_Node, P_Name); + T_Semicolon; end if; + else + Def_Node := + New_Node (N_Formal_Concrete_Subprogram_Declaration, Prev_Sloc); + Set_Specification (Def_Node, Spec_Node); + T_Semicolon; end if; - T_Semicolon; return Def_Node; end P_Formal_Subprogram_Declaration; diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb index dd58e1f9cdc..8b843e56c88 100644 --- a/gcc/ada/par-ch2.adb +++ b/gcc/ada/par-ch2.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 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- -- @@ -54,6 +54,21 @@ package body Ch2 is -- All set if we do indeed have an identifier if Token = Tok_Identifier then + + -- Ada 2005 (AI-284): Compiling in Ada95 mode we notify + -- that interface, overriding, and synchronized are + -- new reserved words + + if Ada_Version = Ada_95 then + if Token_Name = Name_Overriding + or else Token_Name = Name_Synchronized + or else (Token_Name = Name_Interface + and then Prev_Token /= Tok_Pragma) + then + Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node); + end if; + end if; + Ident_Node := Token_Node; Scan; -- past Identifier return Ident_Node; @@ -251,9 +266,21 @@ package body Ch2 is Style.Check_Pragma_Name; end if; - Ident_Node := P_Identifier; + -- Ada 2005 (AI-284): INTERFACE is a new reserved word but it is + -- allowed as a pragma name. + + if Ada_Version >= Ada_05 + and then Token = Tok_Interface + then + Pragma_Name := Name_Interface; + Ident_Node := Token_Node; + Scan; -- past INTERFACE + else + Ident_Node := P_Identifier; + Delete_Node (Ident_Node); + end if; + Set_Chars (Pragma_Node, Pragma_Name); - Delete_Node (Ident_Node); -- See if special INTERFACE/IMPORT check is required diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 440f6468637..5da4a3e10e1 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -174,7 +174,20 @@ package body Ch3 is -- separate declaration (but not use) of a reserved identifier. if Token = Tok_Identifier then - null; + + -- Ada 2005 (AI-284): Compiling in Ada95 mode we notify + -- that interface, overriding, and synchronized are + -- new reserved words + + if Ada_Version = Ada_95 then + if Token_Name = Name_Overriding + or else Token_Name = Name_Synchronized + or else (Token_Name = Name_Interface + and then Prev_Token /= Tok_Pragma) + then + Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node); + end if; + end if; -- If we have a reserved identifier, manufacture an identifier with -- a corresponding name after posting an appropriate error message diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index d22c5243cee..3288aadec6a 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -306,10 +306,13 @@ begin -- This pragma must be processed at parse time, since we want to set -- the Ada version properly at parse time to recognize the appropriate - -- Ada version syntax. + -- Ada version syntax. However, it is only the zero argument form that + -- must be processed at parse time. when Pragma_Ada_05 => - Ada_Version := Ada_05; + if Arg_Count = 0 then + Ada_Version := Ada_05; + end if; ----------- -- Debug -- @@ -1060,7 +1063,6 @@ begin Pragma_Normalize_Scalars | Pragma_Optimize | Pragma_Optional_Overriding | - Pragma_Overriding | Pragma_Pack | Pragma_Passive | Pragma_Polling | diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index edf3a38155a..15a2fd1c86d 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -159,7 +159,7 @@ package body Rtsfind is -- A value of False means nothing special need be done. A value of -- True indicates that this flag must be set to True. It is needed -- only in the Text_IO_Kludge procedure, which may materialize an - -- entity of Text_IO (or Wide_Text_IO) that was previously unknown. + -- entity of Text_IO (or [Wide_]Wide_Text_IO) that was previously unknown. -- Id is the RE_Id value of the entity which was originally requested. -- Id is used only for error message detail, and if it is RE_Null, then -- the attempt to output the entity name is ignored. @@ -248,6 +248,9 @@ package body Rtsfind is elsif U_Id in Ada_Wide_Text_IO_Child then Name_Buffer (17) := '.'; + + elsif U_Id in Ada_Wide_Wide_Text_IO_Child then + Name_Buffer (22) := '.'; end if; elsif U_Id in Interfaces_Child then @@ -435,7 +438,11 @@ package body Rtsfind is return Nkind (Prf) = N_Identifier and then - (Chars (Prf) = Name_Text_IO or else Chars (Prf) = Name_Wide_Text_IO) + (Chars (Prf) = Name_Text_IO + or else + Chars (Prf) = Name_Wide_Text_IO + or else + Chars (Prf) = Name_Wide_Wide_Text_IO) and then Nkind (Sel) = N_Identifier and then @@ -830,7 +837,7 @@ package body Rtsfind is or else E = RE_Params_Stream_Type or else - E = RE_RPC_Receiver) + E = RE_Request_Access) then declare DSA_Implementation : constant Entity_Id := @@ -1143,6 +1150,14 @@ package body Rtsfind is Name_Integer_IO => Ada_Wide_Text_IO_Integer_IO, Name_Modular_IO => Ada_Wide_Text_IO_Modular_IO); + Wide_Wide_Name_Map : constant Name_Map_Type := Name_Map_Type'( + Name_Decimal_IO => Ada_Wide_Wide_Text_IO_Decimal_IO, + Name_Enumeration_IO => Ada_Wide_Wide_Text_IO_Enumeration_IO, + Name_Fixed_IO => Ada_Wide_Wide_Text_IO_Fixed_IO, + Name_Float_IO => Ada_Wide_Wide_Text_IO_Float_IO, + Name_Integer_IO => Ada_Wide_Wide_Text_IO_Integer_IO, + Name_Modular_IO => Ada_Wide_Wide_Text_IO_Modular_IO); + begin -- Nothing to do if name is not identifier or a selected component -- whose selector_name is not an identifier. @@ -1161,7 +1176,7 @@ package body Rtsfind is -- Nothing to do if name is not one of the Text_IO subpackages -- Otherwise look through loaded units, and if we find Text_IO - -- or Wide_Text_IO already loaded, then load the proper child. + -- or [Wide_]Wide_Text_IO already loaded, then load the proper child. if Chrs in Text_IO_Package_Name then for U in Main_Unit .. Last_Unit loop @@ -1169,17 +1184,17 @@ package body Rtsfind is if Name_Len = 12 then - -- Here is where we do the loads if we find one of the - -- units Ada.Text_IO or Ada.Wide_Text_IO. An interesting - -- detail is that these units may already be used (i.e. - -- their In_Use flags may be set). Normally when the In_Use - -- flag is set, the Is_Potentially_Use_Visible flag of all - -- entities in the package is set, but the new entity we - -- are mysteriously adding was not there to have its flag - -- set at the time. So that's why we pass the extra parameter - -- to RTU_Find, to make sure the flag does get set now. - -- Given that those generic packages are in fact child units, - -- we must indicate that they are visible. + -- Here is where we do the loads if we find one of the units + -- Ada.Text_IO or Ada.[Wide_]Wide_Text_IO. An interesting + -- detail is that these units may already be used (i.e. their + -- In_Use flags may be set). Normally when the In_Use flag is + -- set, the Is_Potentially_Use_Visible flag of all entities in + -- the package is set, but the new entity we are mysteriously + -- adding was not there to have its flag set at the time. So + -- that's why we pass the extra parameter to RTU_Find, to make + -- sure the flag does get set now. Given that those generic + -- packages are in fact child units, we must indicate that + -- they are visible. if Name_Buffer (1 .. 12) = "a-textio.ads" then Load_RTU @@ -1194,6 +1209,13 @@ package body Rtsfind is Use_Setting => In_Use (Cunit_Entity (U))); Set_Is_Visible_Child_Unit (RT_Unit_Table (Wide_Name_Map (Chrs)).Entity); + + elsif Name_Buffer (1 .. 12) = "a-ztexio.ads" then + Load_RTU + (Wide_Wide_Name_Map (Chrs), + Use_Setting => In_Use (Cunit_Entity (U))); + Set_Is_Visible_Child_Unit + (RT_Unit_Table (Wide_Wide_Name_Map (Chrs)).Entity); end if; end if; end loop; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 2faf0b91b70..ac1e94a7164 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -69,6 +69,9 @@ package Rtsfind is -- Names of the form Ada_Wide_Text_IO_xxx are second level children -- of Ada.Wide_Text_IO. + -- Names of the form Ada_Wide_Wide_Text_IO_xxx are second level children + -- of Ada.Wide_Wide_Text_IO. + -- Names of the form Interfaces_xxx are first level children of -- Interfaces_CPP refers to package Interfaces.CPP @@ -156,6 +159,15 @@ package Rtsfind is Ada_Wide_Text_IO_Integer_IO, Ada_Wide_Text_IO_Modular_IO, + -- Children of Ada.Wide_Wide_Text_IO (for Text_IO_Kludge) + + Ada_Wide_Wide_Text_IO_Decimal_IO, + Ada_Wide_Wide_Text_IO_Enumeration_IO, + Ada_Wide_Wide_Text_IO_Fixed_IO, + Ada_Wide_Wide_Text_IO_Float_IO, + Ada_Wide_Wide_Text_IO_Integer_IO, + Ada_Wide_Wide_Text_IO_Modular_IO, + -- Interfaces Interfaces, @@ -343,7 +355,7 @@ package Rtsfind is System_Tasking_Stages); subtype Ada_Child is RTU_Id - range Ada_Calendar .. Ada_Wide_Text_IO_Modular_IO; + range Ada_Calendar .. Ada_Wide_Wide_Text_IO_Modular_IO; -- Range of values for children or grand-children of Ada subtype Ada_Calendar_Child is Ada_Child @@ -373,6 +385,10 @@ package Rtsfind is range Ada_Wide_Text_IO_Decimal_IO .. Ada_Wide_Text_IO_Modular_IO; -- Range of values for children of Ada.Text_IO + subtype Ada_Wide_Wide_Text_IO_Child is Ada_Child + range Ada_Wide_Wide_Text_IO_Decimal_IO .. + Ada_Wide_Wide_Text_IO_Modular_IO; + subtype Interfaces_Child is RTU_Id range Interfaces_CPP .. Interfaces_Packed_Decimal; -- Range of values for children of Interfaces @@ -700,6 +716,7 @@ package Rtsfind is RE_Image_Unsigned, -- System.Img_Uns RE_Image_Wide_Character, -- System.Img_WChar + RE_Image_Wide_Wide_Character, -- System.Img_WChar RE_Bind_Interrupt_To_Entry, -- System.Interrupts RE_Default_Interrupt_Priority, -- System.Interrupts @@ -1033,7 +1050,6 @@ package Rtsfind is RE_Do_Rpc, -- System.RPC RE_Params_Stream_Type, -- System.RPC RE_Partition_ID, -- System.RPC - RE_RPC_Receiver, -- System.RPC RE_To_PolyORB_String, -- System.PolyORB_Interface RE_To_Standard_String, -- System.PolyORB_Interface @@ -1103,6 +1119,7 @@ package Rtsfind is RE_FA_SU, -- System.PolyORB_Interface RE_FA_U, -- System.PolyORB_Interface RE_FA_WC, -- System.PolyORB_Interface + RE_FA_WWC, -- System.PolyORB_Interface RE_FA_String, -- System.PolyORB_Interface RE_FA_ObjRef, -- System.PolyORB_Interface @@ -1125,6 +1142,7 @@ package Rtsfind is RE_TA_SU, -- System.PolyORB_Interface RE_TA_U, -- System.PolyORB_Interface RE_TA_WC, -- System.PolyORB_Interface + RE_TA_WWC, -- System.PolyORB_Interface RE_TA_String, -- System.PolyORB_Interface RE_TA_ObjRef, -- System.PolyORB_Interface RE_TA_TC, -- System.PolyORB_Interface @@ -1154,6 +1172,7 @@ package Rtsfind is RE_TC_Void, -- System.PolyORB_Interface RE_TC_Opaque, -- System.PolyORB_Interface, RE_TC_WC, -- System.PolyORB_Interface + RE_TC_WWC, -- System.PolyORB_Interface RE_TC_Array, -- System.PolyORB_Interface, RE_TC_Sequence, -- System.PolyORB_Interface, RE_TC_String, -- System.PolyORB_Interface, @@ -1169,6 +1188,10 @@ package Rtsfind is RE_IS_Iu2, -- System.Scalar_Values RE_IS_Iu4, -- System.Scalar_Values RE_IS_Iu8, -- System.Scalar_Values + RE_IS_Iz1, -- System.Scalar_Values + RE_IS_Iz2, -- System.Scalar_Values + RE_IS_Iz4, -- System.Scalar_Values + RE_IS_Iz8, -- System.Scalar_Values RE_IS_Isf, -- System.Scalar_Values RE_IS_Ifl, -- System.Scalar_Values RE_IS_Ilf, -- System.Scalar_Values @@ -1222,6 +1245,7 @@ package Rtsfind is RE_I_SU, -- System.Stream_Attributes RE_I_U, -- System.Stream_Attributes RE_I_WC, -- System.Stream_Attributes + RE_I_WWC, -- System.Stream_Attributes RE_W_AD, -- System.Stream_Attributes RE_W_AS, -- System.Stream_Attributes @@ -1242,6 +1266,7 @@ package Rtsfind is RE_W_SU, -- System.Stream_Attributes RE_W_U, -- System.Stream_Attributes RE_W_WC, -- System.Stream_Attributes + RE_W_WWC, -- System.Stream_Attributes RE_Block_Stream_Ops_OK, -- System.Stream_Attributes @@ -1249,8 +1274,6 @@ package Rtsfind is RE_Str_Concat_CC, -- System.String_Ops RE_Str_Concat_CS, -- System.String_Ops RE_Str_Concat_SC, -- System.String_Ops - RE_Str_Normalize, -- System.String_Ops - RE_Wide_Str_Normalize, -- System.String_Ops RE_Str_Concat_3, -- System.String_Ops_Concat_3 @@ -1350,6 +1373,7 @@ package Rtsfind is RE_Value_Unsigned, -- System.Val_Uns RE_Value_Wide_Character, -- System.Val_WChar + RE_Value_Wide_Wide_Character, -- System.Val_WChar RE_D, -- System.Vax_Float_Operations RE_F, -- System.Vax_Float_Operations @@ -1398,16 +1422,26 @@ package Rtsfind is RE_Register_VMS_Exception, -- System.VMS_Exception_Table RE_String_To_Wide_String, -- System.WCh_StW + RE_String_To_Wide_Wide_String, -- System.WCh_StW RE_Wide_String_To_String, -- System.WCh_WtS + RE_Wide_Wide_String_To_String, -- System.WCh_WtS RE_Wide_Width_Character, -- System.WWd_Char + RE_Wide_Wide_Width_Character, -- System.WWd_Char + + RE_Wide_Wide_Width_Enumeration_8, -- System.WWd_Enum + RE_Wide_Wide_Width_Enumeration_16, -- System.WWd_Enum + RE_Wide_Wide_Width_Enumeration_32, -- System.WWd_Enum RE_Wide_Width_Enumeration_8, -- System.WWd_Enum RE_Wide_Width_Enumeration_16, -- System.WWd_Enum RE_Wide_Width_Enumeration_32, -- System.WWd_Enum + RE_Wide_Wide_Width_Wide_Character, -- System.WWd_Wchar + RE_Wide_Wide_Width_Wide_Wide_Char, -- System.WWd_Wchar RE_Wide_Width_Wide_Character, -- System.WWd_Wchar + RE_Wide_Width_Wide_Wide_Character, -- System.WWd_Wchar RE_Width_Boolean, -- System.Wid_Bool @@ -1422,6 +1456,7 @@ package Rtsfind is RE_Width_Long_Long_Unsigned, -- System.Wid_LLU RE_Width_Wide_Character, -- System.Wid_WChar + RE_Width_Wide_Wide_Character, -- System.Wid_WChar RE_Protected_Entry_Body_Array, -- Tasking.Protected_Objects.Entries RE_Protection_Entries, -- Tasking.Protected_Objects.Entries @@ -1781,6 +1816,7 @@ package Rtsfind is RE_Image_Unsigned => System_Img_Uns, RE_Image_Wide_Character => System_Img_WChar, + RE_Image_Wide_Wide_Character => System_Img_WChar, RE_Bind_Interrupt_To_Entry => System_Interrupts, RE_Default_Interrupt_Priority => System_Interrupts, @@ -2174,6 +2210,7 @@ package Rtsfind is RE_FA_SU => System_PolyORB_Interface, RE_FA_U => System_PolyORB_Interface, RE_FA_WC => System_PolyORB_Interface, + RE_FA_WWC => System_PolyORB_Interface, RE_FA_String => System_PolyORB_Interface, RE_FA_ObjRef => System_PolyORB_Interface, @@ -2196,6 +2233,7 @@ package Rtsfind is RE_TA_SU => System_PolyORB_Interface, RE_TA_U => System_PolyORB_Interface, RE_TA_WC => System_PolyORB_Interface, + RE_TA_WWC => System_PolyORB_Interface, RE_TA_String => System_PolyORB_Interface, RE_TA_ObjRef => System_PolyORB_Interface, RE_TA_TC => System_PolyORB_Interface, @@ -2225,6 +2263,7 @@ package Rtsfind is RE_TC_Void => System_PolyORB_Interface, RE_TC_Opaque => System_PolyORB_Interface, RE_TC_WC => System_PolyORB_Interface, + RE_TC_WWC => System_PolyORB_Interface, RE_TC_Array => System_PolyORB_Interface, RE_TC_Sequence => System_PolyORB_Interface, RE_TC_String => System_PolyORB_Interface, @@ -2240,7 +2279,6 @@ package Rtsfind is RE_Do_Rpc => System_RPC, RE_Params_Stream_Type => System_RPC, RE_Partition_ID => System_RPC, - RE_RPC_Receiver => System_RPC, RE_IS_Is1 => System_Scalar_Values, RE_IS_Is2 => System_Scalar_Values, @@ -2250,6 +2288,10 @@ package Rtsfind is RE_IS_Iu2 => System_Scalar_Values, RE_IS_Iu4 => System_Scalar_Values, RE_IS_Iu8 => System_Scalar_Values, + RE_IS_Iz1 => System_Scalar_Values, + RE_IS_Iz2 => System_Scalar_Values, + RE_IS_Iz4 => System_Scalar_Values, + RE_IS_Iz8 => System_Scalar_Values, RE_IS_Isf => System_Scalar_Values, RE_IS_Ifl => System_Scalar_Values, RE_IS_Ilf => System_Scalar_Values, @@ -2303,6 +2345,7 @@ package Rtsfind is RE_I_SU => System_Stream_Attributes, RE_I_U => System_Stream_Attributes, RE_I_WC => System_Stream_Attributes, + RE_I_WWC => System_Stream_Attributes, RE_W_AD => System_Stream_Attributes, RE_W_AS => System_Stream_Attributes, @@ -2323,12 +2366,10 @@ package Rtsfind is RE_W_SU => System_Stream_Attributes, RE_W_U => System_Stream_Attributes, RE_W_WC => System_Stream_Attributes, - + RE_W_WWC => System_Stream_Attributes, RE_Block_Stream_Ops_OK => System_Stream_Attributes, RE_Str_Concat => System_String_Ops, - RE_Str_Normalize => System_String_Ops, - RE_Wide_Str_Normalize => System_String_Ops, RE_Str_Concat_CC => System_String_Ops, RE_Str_Concat_CS => System_String_Ops, RE_Str_Concat_SC => System_String_Ops, @@ -2431,6 +2472,7 @@ package Rtsfind is RE_Value_Unsigned => System_Val_Uns, RE_Value_Wide_Character => System_Val_WChar, + RE_Value_Wide_Wide_Character => System_Val_WChar, RE_D => System_Vax_Float_Operations, RE_F => System_Vax_Float_Operations, @@ -2479,16 +2521,27 @@ package Rtsfind is RE_Register_VMS_Exception => System_VMS_Exception_Table, RE_String_To_Wide_String => System_WCh_StW, + RE_String_To_Wide_Wide_String => System_WCh_StW, RE_Wide_String_To_String => System_WCh_WtS, + RE_Wide_Wide_String_To_String => System_WCh_WtS, + RE_Wide_Wide_Width_Character => System_WWd_Char, RE_Wide_Width_Character => System_WWd_Char, + RE_Wide_Wide_Width_Enumeration_8 => System_WWd_Enum, + RE_Wide_Wide_Width_Enumeration_16 => System_WWd_Enum, + RE_Wide_Wide_Width_Enumeration_32 => System_WWd_Enum, + RE_Wide_Width_Enumeration_8 => System_WWd_Enum, RE_Wide_Width_Enumeration_16 => System_WWd_Enum, RE_Wide_Width_Enumeration_32 => System_WWd_Enum, + RE_Wide_Wide_Width_Wide_Character => System_WWd_Wchar, + RE_Wide_Wide_Width_Wide_Wide_Char => System_WWd_Wchar, + RE_Wide_Width_Wide_Character => System_WWd_Wchar, + RE_Wide_Width_Wide_Wide_Character => System_WWd_Wchar, RE_Width_Boolean => System_Wid_Bool, @@ -2503,6 +2556,7 @@ package Rtsfind is RE_Width_Long_Long_Unsigned => System_Wid_LLU, RE_Width_Wide_Character => System_Wid_WChar, + RE_Width_Wide_Wide_Character => System_Wid_WChar, RE_Protected_Entry_Body_Array => System_Tasking_Protected_Objects_Entries, @@ -2754,13 +2808,13 @@ package Rtsfind is -- with'ed automatically. The important result of this approach is that -- Text_IO does not drag in all the code for the subpackages unless they -- are used. Our test is a little crude, and could drag in stuff when it - -- is not necessary, but that doesn't matter. Wide_Text_IO is handled in - -- a similar manner. + -- is not necessary, but that doesn't matter. Wide_[Wide_]Text_IO is + -- handled in a similar manner. function Is_Text_IO_Kludge_Unit (Nam : Node_Id) return Boolean; - -- Returns True if the given Nam is an Expanded Name, whose Prefix is - -- Ada, and whose selector is either Text_IO.xxx or Wide_Text_IO.xxx - -- where xxx is one of the subpackages of Text_IO that is specially - -- handled as described above for Text_IO_Kludge. + -- Returns True if the given Nam is an Expanded Name, whose Prefix is Ada, + -- and whose selector is either Text_IO.xxx or Wide_Text_IO.xxx or + -- Wide_Wide_Text_IO.xxx, where xxx is one of the subpackages of Text_IO + -- that is specially handled as described above for Text_IO_Kludge. end Rtsfind; diff --git a/gcc/ada/s-imgwch.adb b/gcc/ada/s-imgwch.adb index 61bf08fa130..09d4e5844c4 100644 --- a/gcc/ada/s-imgwch.adb +++ b/gcc/ada/s-imgwch.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, 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- -- @@ -42,9 +42,8 @@ package body System.Img_WChar is -------------------------- function Image_Wide_Character - (V : Wide_Character; - EM : WC_Encoding_Method) - return String + (V : Wide_Character; + EM : WC_Encoding_Method) return String is Val : constant Natural := Wide_Character'Pos (V); WS : Wide_String (1 .. 3); @@ -79,7 +78,38 @@ package body System.Img_WChar is return Wide_String_To_String (WS, EM); end if; - end Image_Wide_Character; + ------------------------------- + -- Image_Wide_Wide_Character -- + ------------------------------- + + function Image_Wide_Wide_Character + (V : Wide_Wide_Character; + EM : WC_Encoding_Method) return String + is + Val : constant Natural := Wide_Wide_Character'Pos (V); + WS : Wide_Wide_String (1 .. 3); + + begin + -- If in range of standard Wide_Character, then we use the + -- Wide_Character routine + + if Val <= 16#FFFF# then + return Image_Wide_Character (Wide_Character'Val (Val), EM); + + -- Otherwise return an appropriate escape sequence (i.e. one matching + -- the convention implemented by Scn.Wide_Wide_Char). The easiest thing + -- is to build a wide string for the result, and then use the + -- Wide_Wide_Value function to build the resulting String. + + else + WS (1) := '''; + WS (2) := V; + WS (3) := '''; + + return Wide_Wide_String_To_String (WS, EM); + end if; + end Image_Wide_Wide_Character; + end System.Img_WChar; diff --git a/gcc/ada/s-imgwch.ads b/gcc/ada/s-imgwch.ads index f6dc11fb477..fa472aa26d4 100644 --- a/gcc/ada/s-imgwch.ads +++ b/gcc/ada/s-imgwch.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2000 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- -- @@ -31,7 +31,7 @@ -- -- ------------------------------------------------------------------------------ --- Wide_Character'Image +-- Wide_[Wide_]Character'Image with System.WCh_Con; @@ -39,10 +39,18 @@ package System.Img_WChar is pragma Pure (Img_WChar); function Image_Wide_Character - (V : Wide_Character; - EM : System.WCh_Con.WC_Encoding_Method) - return String; - -- Computes Wode_Character'Image (V) and returns the computed result, + (V : Wide_Character; + EM : System.WCh_Con.WC_Encoding_Method) return String; + -- Computes Wide_Character'Image (V) and returns the computed result, + -- The argument EM is a constant representing the encoding method in use. + -- The encoding method used is guaranteed to be consistent across a + -- given program execution and to correspond to the method used in the + -- source programs. + + function Image_Wide_Wide_Character + (V : Wide_Wide_Character; + EM : System.WCh_Con.WC_Encoding_Method) return String; + -- Computes Wide_Wide_Character'Image (V) and returns the computed result, -- The argument EM is a constant representing the encoding method in use. -- The encoding method used is guaranteed to be consistent across a -- given program execution and to correspond to the method used in the diff --git a/gcc/ada/s-scaval.adb b/gcc/ada/s-scaval.adb index 97a5f87d9ba..b6ca08c16dd 100644 --- a/gcc/ada/s-scaval.adb +++ b/gcc/ada/s-scaval.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2003-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- -- @@ -159,6 +159,11 @@ package body System.Scalar_Values is IS_Iu4 := 16#FFFF_FFFF#; IS_Iu8 := 16#FFFF_FFFF_FFFF_FFFF#; + IS_Iz1 := 16#00#; + IS_Iz2 := 16#0000#; + IS_Iz4 := 16#0000_0000#; + IS_Iz8 := 16#0000_0000_0000_0000#; + IV_Isf := IS_Iu4; IV_Ifl := IS_Iu4; IV_Ilf := IS_Iu8; @@ -180,6 +185,11 @@ package body System.Scalar_Values is IS_Iu4 := 16#0000_0000#; IS_Iu8 := 16#0000_0000_0000_0000#; + IS_Iz1 := 16#00#; + IS_Iz2 := 16#0000#; + IS_Iz4 := 16#0000_0000#; + IS_Iz8 := 16#0000_0000_0000_0000#; + IV_Isf := 16#FF80_0000#; IV_Ifl := 16#FF80_0000#; IV_Ilf := 16#FFF0_0000_0000_0000#; @@ -201,6 +211,11 @@ package body System.Scalar_Values is IS_Iu4 := 16#FFFF_FFFF#; IS_Iu8 := 16#FFFF_FFFF_FFFF_FFFF#; + IS_Iz1 := 16#FF#; + IS_Iz2 := 16#FFFF#; + IS_Iz4 := 16#FFFF_FFFF#; + IS_Iz8 := 16#FFFF_FFFF_FFFF_FFFF#; + IV_Isf := 16#7F80_0000#; IV_Ifl := 16#7F80_0000#; IV_Ilf := 16#7FF0_0000_0000_0000#; @@ -238,6 +253,11 @@ package body System.Scalar_Values is IS_Iu4 := IS_Is4; IS_Iu8 := IS_Is8; + IS_Iz1 := IS_Is1; + IS_Iz2 := IS_Is2; + IS_Iz4 := IS_Is4; + IS_Iz8 := IS_Is8; + IV_Isf := IS_Is4; IV_Ifl := IS_Is4; IV_Ilf := IS_Is8; @@ -259,8 +279,6 @@ package body System.Scalar_Values is IV_Ill := To_ByteLF (IV_Ilf); end; end if; - - end Initialize; end System.Scalar_Values; diff --git a/gcc/ada/s-scaval.ads b/gcc/ada/s-scaval.ads index 9db3c9830d8..da8e809baea 100644 --- a/gcc/ada/s-scaval.ads +++ b/gcc/ada/s-scaval.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -53,14 +53,27 @@ package System.Scalar_Values is -- The explicit initializations here are not really required, since these -- variables are always set by System.Scalar_Values.Initialize. - IS_Is1 : Byte1 := 0; -- Initialize 1 byte signed - IS_Is2 : Byte2 := 0; -- Initialize 2 byte signed - IS_Is4 : Byte4 := 0; -- Initialize 4 byte signed - IS_Is8 : Byte8 := 0; -- Initialize 8 byte signed - IS_Iu1 : Byte1 := 0; -- Initialize 1 byte unsigned - IS_Iu2 : Byte2 := 0; -- Initialize 2 byte unsigned - IS_Iu4 : Byte4 := 0; -- Initialize 4 byte unsigned - IS_Iu8 : Byte8 := 0; -- Initialize 8 byte unsigned + IS_Is1 : Byte1 := 0; -- Initialize 1 byte signed + IS_Is2 : Byte2 := 0; -- Initialize 2 byte signed + IS_Is4 : Byte4 := 0; -- Initialize 4 byte signed + IS_Is8 : Byte8 := 0; -- Initialize 8 byte signed + -- For the above cases, the undefined value (set by the binder -Sin switch) + -- is the largest negative number (1 followed by all zero bits). + + IS_Iu1 : Byte1 := 0; -- Initialize 1 byte unsigned + IS_Iu2 : Byte2 := 0; -- Initialize 2 byte unsigned + IS_Iu4 : Byte4 := 0; -- Initialize 4 byte unsigned + IS_Iu8 : Byte8 := 0; -- Initialize 8 byte unsigned + -- For the above cases, the undefined value (set by the binder -Sin switch) + -- is the largest unsigned number (all 1 bits). + + IS_Iz1 : Byte1 := 0; -- Initialize 1 byte zeroes + IS_Iz2 : Byte2 := 0; -- Initialize 2 byte zeroes + IS_Iz4 : Byte4 := 0; -- Initialize 4 byte zeroes + IS_Iz8 : Byte8 := 0; -- Initialize 8 byte zeroes + -- For the above cases, the undefined value (set by the binder -Sin switch) + -- is the zero (all 0 bits). This is used when zero is known to be an + -- invalid value. -- The float definitions are aliased, because we use overlays to set them diff --git a/gcc/ada/s-strops.adb b/gcc/ada/s-strops.adb index 5440f72f53e..ae7e267cb9c 100644 --- a/gcc/ada/s-strops.adb +++ b/gcc/ada/s-strops.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- -- @@ -102,26 +102,4 @@ package body System.String_Ops is end if; end Str_Concat_SC; - ------------------- - -- Str_Normalize -- - ------------------- - - procedure Str_Normalize (A : in out String) is - begin - for J in A'Range loop - A (J) := Character'Last; - end loop; - end Str_Normalize; - - ------------------------ - -- Wide_Str_Normalize -- - ------------------------ - - procedure Wide_Str_Normalize (A : in out Wide_String) is - begin - for J in A'Range loop - A (J) := Wide_Character'Last; - end loop; - end Wide_Str_Normalize; - end System.String_Ops; diff --git a/gcc/ada/s-strops.ads b/gcc/ada/s-strops.ads index aac2fd66f81..da5fcdfbddf 100644 --- a/gcc/ada/s-strops.ads +++ b/gcc/ada/s-strops.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -49,12 +49,4 @@ pragma Pure (String_Ops); function Str_Concat_CC (X, Y : Character) return String; -- Concatenate two characters - procedure Str_Normalize (A : in out String); - -- Initialize String object if pragma Normalize_Scalars is in effect. - - procedure Wide_Str_Normalize (A : in out Wide_String); - -- Ditto for Wide_String. - - pragma Inline (Str_Normalize); - pragma Inline (Wide_Str_Normalize); end System.String_Ops; diff --git a/gcc/ada/s-valwch.adb b/gcc/ada/s-valwch.adb index 5e75a979d5a..8d4604552dc 100644 --- a/gcc/ada/s-valwch.adb +++ b/gcc/ada/s-valwch.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-1997, 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- -- @@ -31,6 +31,7 @@ -- -- ------------------------------------------------------------------------------ +with Interfaces; use Interfaces; with System.Val_Util; use System.Val_Util; with System.WCh_Con; use System.WCh_Con; with System.WCh_StW; use System.WCh_StW; @@ -42,9 +43,27 @@ package body System.Val_WChar is -------------------------- function Value_Wide_Character - (Str : String; - EM : WC_Encoding_Method) - return Wide_Character + (Str : String; + EM : WC_Encoding_Method) return Wide_Character + is + WWC : constant Wide_Wide_Character := + Value_Wide_Wide_Character (Str, EM); + WWV : constant Unsigned_32 := Wide_Wide_Character'Pos (WWC); + begin + if WWV > 16#FFFF# then + raise Constraint_Error; + else + return Wide_Character'Val (WWV); + end if; + end Value_Wide_Character; + + ------------------------------- + -- Value_Wide_Wide_Character -- + ------------------------------- + + function Value_Wide_Wide_Character + (Str : String; + EM : System.WCh_Con.WC_Encoding_Method) return Wide_Wide_Character is F : Natural; L : Natural; @@ -60,21 +79,20 @@ package body System.Val_WChar is -- If just three characters, simple character case if L - F = 2 then - return Wide_Character'Val (Character'Pos (S (F + 1))); + return Wide_Wide_Character'Val (Character'Pos (S (F + 1))); -- Otherwise must be a wide character in quotes. The easiest - -- thing is to convert the string to a wide string and then + -- thing is to convert the string to a wide wide string and then -- pick up the single character that it should contain. else declare - WS : constant Wide_String := - String_To_Wide_String (S (F + 1 .. L - 1), EM); + WS : constant Wide_Wide_String := + String_To_Wide_Wide_String (S (F + 1 .. L - 1), EM); begin if WS'Length /= 1 then raise Constraint_Error; - else return WS (WS'First); end if; @@ -84,29 +102,28 @@ package body System.Val_WChar is -- the last two values of the type have language-defined names: elsif S = "FFFE" then - return Wide_Character'Val (16#FFFE#); + return Wide_Wide_Character'Val (16#FFFE#); elsif S = "FFFF" then - return Wide_Character'Val (16#FFFF#); + return Wide_Wide_Character'Val (16#FFFF#); -- Otherwise must be a control character else for C in Character'Val (16#00#) .. Character'Val (16#1F#) loop if S (F .. L) = Character'Image (C) then - return Wide_Character'Val (Character'Pos (C)); + return Wide_Wide_Character'Val (Character'Pos (C)); end if; end loop; for C in Character'Val (16#7F#) .. Character'Val (16#9F#) loop if S (F .. L) = Character'Image (C) then - return Wide_Character'Val (Character'Pos (C)); + return Wide_Wide_Character'Val (Character'Pos (C)); end if; end loop; raise Constraint_Error; end if; - - end Value_Wide_Character; + end Value_Wide_Wide_Character; end System.Val_WChar; diff --git a/gcc/ada/s-valwch.ads b/gcc/ada/s-valwch.ads index d8d0a82e83e..5075f756c2e 100644 --- a/gcc/ada/s-valwch.ads +++ b/gcc/ada/s-valwch.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2000 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- -- @@ -31,15 +31,21 @@ -- -- ------------------------------------------------------------------------------ +-- Processing for Wide_[Wide_]Value attribute + with System.WCh_Con; package System.Val_WChar is pragma Pure (Val_WChar); function Value_Wide_Character - (Str : String; - EM : System.WCh_Con.WC_Encoding_Method) - return Wide_Character; + (Str : String; + EM : System.WCh_Con.WC_Encoding_Method) return Wide_Character; + -- Computes Wide_Character'Value (Str). + + function Value_Wide_Wide_Character + (Str : String; + EM : System.WCh_Con.WC_Encoding_Method) return Wide_Wide_Character; -- Computes Wide_Character'Value (Str). end System.Val_WChar; diff --git a/gcc/ada/s-wchcnv.adb b/gcc/ada/s-wchcnv.adb index 3da16f854ea..77ee233b70f 100644 --- a/gcc/ada/s-wchcnv.adb +++ b/gcc/ada/s-wchcnv.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2001 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- -- @@ -41,54 +41,70 @@ with System.WCh_JIS; use System.WCh_JIS; package body System.WCh_Cnv is - -------------------------------- - -- Char_Sequence_To_Wide_Char -- - -------------------------------- + ----------------------------- + -- Char_Sequence_To_UTF_32 -- + ----------------------------- - function Char_Sequence_To_Wide_Char - (C : Character; - EM : WC_Encoding_Method) - return Wide_Character + function Char_Sequence_To_UTF_32 + (C : Character; + EM : WC_Encoding_Method) return UTF_32_Code is - B1 : Integer; + B1 : Unsigned_32; C1 : Character; - U : Unsigned_16; - W : Unsigned_16; + U : Unsigned_32; + W : Unsigned_32; procedure Get_Hex (N : Character); -- If N is a hex character, then set B1 to 16 * B1 + character N. -- Raise Constraint_Error if character N is not a hex character. + procedure Get_UTF_Byte; + pragma Inline (Get_UTF_Byte); + -- Used to interpret a 2#10xxxxxx# continuation byte in UTF-8 mode. + -- Reads a byte, and raises CE if the first two bits are not 10. + -- Otherwise shifts W 6 bits left and or's in the 6 xxxxxx bits. + ------------- -- Get_Hex -- ------------- procedure Get_Hex (N : Character) is - B2 : constant Integer := Character'Pos (N); - + B2 : constant Unsigned_32 := Character'Pos (N); begin if B2 in Character'Pos ('0') .. Character'Pos ('9') then B1 := B1 * 16 + B2 - Character'Pos ('0'); - elsif B2 in Character'Pos ('A') .. Character'Pos ('F') then B1 := B1 * 16 + B2 - (Character'Pos ('A') - 10); - elsif B2 in Character'Pos ('a') .. Character'Pos ('f') then B1 := B1 * 16 + B2 - (Character'Pos ('a') - 10); - else raise Constraint_Error; end if; end Get_Hex; - -- Start of processing for Char_Sequence_To_Wide_Char + ------------------ + -- Get_UTF_Byte -- + ------------------ + + procedure Get_UTF_Byte is + begin + U := Unsigned_32 (Character'Pos (In_Char)); + + if (U and 2#11000000#) /= 2#10_000000# then + raise Constraint_Error; + end if; + + W := Shift_Left (W, 6) or (U and 2#00111111#); + end Get_UTF_Byte; + + -- Start of processing for Char_Sequence_To_Wide begin case EM is when WCEM_Hex => if C /= ASCII.ESC then - return Wide_Character'Val (Character'Pos (C)); + return Character'Pos (C); else B1 := 0; @@ -97,82 +113,106 @@ package body System.WCh_Cnv is Get_Hex (In_Char); Get_Hex (In_Char); - return Wide_Character'Val (B1); + return UTF_32_Code (B1); end if; when WCEM_Upper => if C > ASCII.DEL then - return - Wide_Character'Val - (Integer (256 * Character'Pos (C)) + - Character'Pos (In_Char)); + return 256 * Character'Pos (C) + Character'Pos (In_Char); else - return Wide_Character'Val (Character'Pos (C)); + return Character'Pos (C); end if; when WCEM_Shift_JIS => if C > ASCII.DEL then - return Shift_JIS_To_JIS (C, In_Char); + return Wide_Character'Pos (Shift_JIS_To_JIS (C, In_Char)); else - return Wide_Character'Val (Character'Pos (C)); + return Character'Pos (C); end if; when WCEM_EUC => if C > ASCII.DEL then - return EUC_To_JIS (C, In_Char); + return Wide_Character'Pos (EUC_To_JIS (C, In_Char)); else - return Wide_Character'Val (Character'Pos (C)); + return Character'Pos (C); end if; when WCEM_UTF8 => - if C > ASCII.DEL then - -- 16#0080#-16#07ff#: 2#110xxxxx# 2#10xxxxxx# - -- 16#0800#-16#ffff#: 2#1110xxxx# 2#10xxxxxx# 2#10xxxxxx# + -- Note: for details of UTF8 encoding see RFC 3629 - U := Unsigned_16 (Character'Pos (C)); + U := Unsigned_32 (Character'Pos (C)); - if (U and 2#11100000#) = 2#11000000# then - W := Shift_Left (U and 2#00011111#, 6); - U := Unsigned_16 (Character'Pos (In_Char)); + -- 16#00_0000#-16#00_007F#: 0xxxxxxx - if (U and 2#11000000#) /= 2#10000000# then - raise Constraint_Error; - end if; + if (U and 2#10000000#) = 2#00000000# then + return Character'Pos (C); - W := W or (U and 2#00111111#); + -- 16#00_0080#-16#00_07FF#: 110xxxxx 10xxxxxx - elsif (U and 2#11110000#) = 2#11100000# then - W := Shift_Left (U and 2#00001111#, 12); - U := Unsigned_16 (Character'Pos (In_Char)); + elsif (U and 2#11100000#) = 2#110_00000# then + W := Shift_Left (U and 2#00011111#, 6); + U := Unsigned_32 (Character'Pos (In_Char)); - if (U and 2#11000000#) /= 2#10000000# then - raise Constraint_Error; - end if; + if (U and 2#11000000#) /= 2#10_000000# then + raise Constraint_Error; + end if; - W := W or Shift_Left (U and 2#00111111#, 6); - U := Unsigned_16 (Character'Pos (In_Char)); + W := W or (U and 2#00111111#); - if (U and 2#11000000#) /= 2#10000000# then - raise Constraint_Error; - end if; + return UTF_32_Code (W); - W := W or (U and 2#00111111#); + -- 16#00_0800#-16#00_ffff#: 1110xxxx 10xxxxxx 10xxxxxx - else - raise Constraint_Error; - end if; + elsif (U and 2#11110000#) = 2#1110_0000# then + W := U and 2#00001111#; + Get_UTF_Byte; + Get_UTF_Byte; + return UTF_32_Code (W); + + -- 16#01_0000#-16#10_FFFF#: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx + + elsif (U and 2#11111000#) = 2#11110_000# then + W := U and 2#00000111#; + + for K in 1 .. 3 loop + Get_UTF_Byte; + end loop; - return Wide_Character'Val (W); + return UTF_32_Code (W); + + -- 16#0020_0000#-16#03FF_FFFF#: 111110xx 10xxxxxx 10xxxxxx + -- 10xxxxxx 10xxxxxx + + elsif (U and 2#11111100#) = 2#111110_00# then + W := U and 2#00000011#; + + for K in 1 .. 4 loop + Get_UTF_Byte; + end loop; + + return UTF_32_Code (W); + + -- 16#0400_0000#-16#7FFF_FFFF#: 1111110x 10xxxxxx 10xxxxxx + -- 10xxxxxx 10xxxxxx 10xxxxxx + + elsif (U and 2#11111110#) = 2#1111110_0# then + W := U and 2#00000001#; + + for K in 1 .. 5 loop + Get_UTF_Byte; + end loop; + + return UTF_32_Code (W); else - return Wide_Character'Val (Character'Pos (C)); + raise Constraint_Error; end if; when WCEM_Brackets => if C /= '[' then - return Wide_Character'Val (Character'Pos (C)); + return Character'Pos (C); end if; if In_Char /= '"' then @@ -182,15 +222,33 @@ package body System.WCh_Cnv is B1 := 0; Get_Hex (In_Char); Get_Hex (In_Char); + C1 := In_Char; if C1 /= '"' then Get_Hex (C1); Get_Hex (In_Char); + C1 := In_Char; if C1 /= '"' then - raise Constraint_Error; + Get_Hex (C1); + Get_Hex (In_Char); + + C1 := In_Char; + + if C1 /= '"' then + Get_Hex (C1); + Get_Hex (In_Char); + + if B1 > Unsigned_32 (UTF_32_Code'Last) then + raise Constraint_Error; + end if; + + if In_Char /= '"' then + raise Constraint_Error; + end if; + end if; end if; end if; @@ -198,23 +256,44 @@ package body System.WCh_Cnv is raise Constraint_Error; end if; - return Wide_Character'Val (B1); + return UTF_32_Code (B1); end case; - end Char_Sequence_To_Wide_Char; + end Char_Sequence_To_UTF_32; -------------------------------- - -- Wide_Char_To_Char_Sequence -- + -- Char_Sequence_To_Wide_Char -- -------------------------------- - procedure Wide_Char_To_Char_Sequence - (WC : Wide_Character; - EM : WC_Encoding_Method) + function Char_Sequence_To_Wide_Char + (C : Character; + EM : System.WCh_Con.WC_Encoding_Method) return Wide_Character + is + function Char_Sequence_To_UTF is new Char_Sequence_To_UTF_32 (In_Char); + + U : constant UTF_32_Code := Char_Sequence_To_UTF (C, EM); + + begin + if U > 16#FFFF# then + raise Constraint_Error; + else + return Wide_Character'Val (U); + end if; + end Char_Sequence_To_Wide_Char; + + ----------------------------- + -- UTF_32_To_Char_Sequence -- + ----------------------------- + + procedure UTF_32_To_Char_Sequence + (Val : UTF_32_Code; + EM : System.WCh_Con.WC_Encoding_Method) is - Val : constant Natural := Wide_Character'Pos (WC); - Hexc : constant array (0 .. 15) of Character := "0123456789ABCDEF"; + Hexc : constant array (UTF_32_Code range 0 .. 15) of Character := + "0123456789ABCDEF"; + C1, C2 : Character; - U : Unsigned_16; + U : Unsigned_32; begin case EM is @@ -222,22 +301,21 @@ package body System.WCh_Cnv is when WCEM_Hex => if Val < 256 then Out_Char (Character'Val (Val)); - - else + elsif Val <= 16#FFFF# then Out_Char (ASCII.ESC); Out_Char (Hexc (Val / (16**3))); Out_Char (Hexc ((Val / (16**2)) mod 16)); Out_Char (Hexc ((Val / 16) mod 16)); Out_Char (Hexc (Val mod 16)); + else + raise Constraint_Error; end if; when WCEM_Upper => if Val < 128 then Out_Char (Character'Val (Val)); - - elsif Val < 16#8000# then + elsif Val < 16#8000# or else Val > 16#FFFF# then raise Constraint_Error; - else Out_Char (Character'Val (Val / 256)); Out_Char (Character'Val (Val mod 256)); @@ -246,58 +324,136 @@ package body System.WCh_Cnv is when WCEM_Shift_JIS => if Val < 128 then Out_Char (Character'Val (Val)); - else - JIS_To_Shift_JIS (WC, C1, C2); + elsif Val <= 16#FFFF# then + JIS_To_Shift_JIS (Wide_Character'Val (Val), C1, C2); Out_Char (C1); Out_Char (C2); + else + raise Constraint_Error; end if; when WCEM_EUC => if Val < 128 then Out_Char (Character'Val (Val)); - else - JIS_To_EUC (WC, C1, C2); + elsif Val <= 16#FFFF# then + JIS_To_EUC (Wide_Character'Val (Val), C1, C2); Out_Char (C1); Out_Char (C2); + else + raise Constraint_Error; end if; when WCEM_UTF8 => - U := Unsigned_16 (Val); - -- 16#0000#-16#007f#: 2#0xxxxxxx# - -- 16#0080#-16#07ff#: 2#110xxxxx# 2#10xxxxxx# - -- 16#0800#-16#ffff#: 2#1110xxxx# 2#10xxxxxx# 2#10xxxxxx# + -- Note: for details of UTF8 encoding see RFC 3629 + + U := Unsigned_32 (Val); + + -- 16#00_0000#-16#00_007F#: 0xxxxxxx - if U < 16#80# then + if U <= 16#00_007F# then Out_Char (Character'Val (U)); - elsif U < 16#0800# then + -- 16#00_0080#-16#00_07FF#: 110xxxxx 10xxxxxx + + elsif U <= 16#00_07FF# then Out_Char (Character'Val (2#11000000# or Shift_Right (U, 6))); Out_Char (Character'Val (2#10000000# or (U and 2#00111111#))); - else + -- 16#00_0800#-16#00_FFFF#: 1110xxxx 10xxxxxx 10xxxxxx + + elsif U <= 16#00_FFFF# then Out_Char (Character'Val (2#11100000# or Shift_Right (U, 12))); Out_Char (Character'Val (2#10000000# or (Shift_Right (U, 6) - and 2#00111111#))); + and 2#00111111#))); + Out_Char (Character'Val (2#10000000# or (U and 2#00111111#))); + + -- 16#01_0000#-16#10_FFFF#: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx + + elsif U <= 16#10_FFFF# then + Out_Char (Character'Val (2#11110000# or Shift_Right (U, 18))); + Out_Char (Character'Val (2#10000000# or (Shift_Right (U, 12) + and 2#00111111#))); + Out_Char (Character'Val (2#10000000# or (Shift_Right (U, 6) + and 2#00111111#))); + Out_Char (Character'Val (2#10000000# or (U and 2#00111111#))); + + -- 16#0020_0000#-16#03FF_FFFF#: 111110xx 10xxxxxx 10xxxxxx + -- 10xxxxxx 10xxxxxx + + elsif U <= 16#03FF_FFFF# then + Out_Char (Character'Val (2#11111000# or Shift_Right (U, 24))); + Out_Char (Character'Val (2#10000000# or (Shift_Right (U, 18) + and 2#00111111#))); + Out_Char (Character'Val (2#10000000# or (Shift_Right (U, 12) + and 2#00111111#))); + Out_Char (Character'Val (2#10000000# or (Shift_Right (U, 6) + and 2#00111111#))); Out_Char (Character'Val (2#10000000# or (U and 2#00111111#))); + + -- 16#0400_0000#-16#7FFF_FFFF#: 1111110x 10xxxxxx 10xxxxxx + -- 10xxxxxx 10xxxxxx 10xxxxxx + + elsif U <= 16#7FFF_FFFF# then + Out_Char (Character'Val (2#11111100# or Shift_Right (U, 30))); + Out_Char (Character'Val (2#10000000# or (Shift_Right (U, 24) + and 2#00111111#))); + Out_Char (Character'Val (2#10000000# or (Shift_Right (U, 18) + and 2#00111111#))); + Out_Char (Character'Val (2#10000000# or (Shift_Right (U, 12) + and 2#00111111#))); + Out_Char (Character'Val (2#10000000# or (Shift_Right (U, 6) + and 2#00111111#))); + Out_Char (Character'Val (2#10000000# or (U and 2#00111111#))); + + else + raise Constraint_Error; end if; when WCEM_Brackets => - if Val < 256 then Out_Char (Character'Val (Val)); else Out_Char ('['); Out_Char ('"'); - Out_Char (Hexc (Val / (16**3))); - Out_Char (Hexc ((Val / (16**2)) mod 16)); + + if Val > 16#FFFF# then + if Val > 16#00FF_FFFF# then + if Val > 16#7FFF_FFFF# then + raise Constraint_Error; + end if; + + Out_Char (Hexc (Val / 16 ** 7)); + Out_Char (Hexc ((Val / 16 ** 6) mod 16)); + end if; + + Out_Char (Hexc ((Val / 16 ** 5) mod 16)); + Out_Char (Hexc ((Val / 16 ** 4) mod 16)); + end if; + + Out_Char (Hexc ((Val / 16 ** 3) mod 16)); + Out_Char (Hexc ((Val / 16 ** 2) mod 16)); Out_Char (Hexc ((Val / 16) mod 16)); Out_Char (Hexc (Val mod 16)); + Out_Char ('"'); Out_Char (']'); end if; end case; + end UTF_32_To_Char_Sequence; + + -------------------------------- + -- Wide_Char_To_Char_Sequence -- + -------------------------------- + + procedure Wide_Char_To_Char_Sequence + (WC : Wide_Character; + EM : System.WCh_Con.WC_Encoding_Method) + is + procedure UTF_To_Char_Sequence is new UTF_32_To_Char_Sequence (Out_Char); + begin + UTF_To_Char_Sequence (Wide_Character'Pos (WC), EM); end Wide_Char_To_Char_Sequence; end System.WCh_Cnv; diff --git a/gcc/ada/s-wchcnv.ads b/gcc/ada/s-wchcnv.ads index 65180ca2a57..e0bde89604a 100644 --- a/gcc/ada/s-wchcnv.ads +++ b/gcc/ada/s-wchcnv.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2003 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- -- @@ -31,24 +31,23 @@ -- -- ------------------------------------------------------------------------------ --- This package contains generic subprograms used for converting between --- sequences of Character and Wide_Character. All access to wide character --- sequences is isolated in this unit. - -- This unit may be used directly from an application program by providing -- an appropriate WITH, and the interface can be expected to remain stable. with System.WCh_Con; package System.WCh_Cnv is -pragma Pure (WCh_Cnv); + pragma Pure (WCh_Cnv); + + type UTF_32_Code is range 0 .. 16#7FFF_FFFF#; + for UTF_32_Code'Size use 32; + -- Range of allowed UTF-32 encoding values generic with function In_Char return Character; function Char_Sequence_To_Wide_Char - (C : Character; - EM : System.WCh_Con.WC_Encoding_Method) - return Wide_Character; + (C : Character; + EM : System.WCh_Con.WC_Encoding_Method) return Wide_Character; -- C is the first character of a sequence of one or more characters which -- represent a wide character sequence. Calling the function In_Char for -- additional characters as required, Char_To_Wide_Char returns the @@ -57,6 +56,16 @@ pragma Pure (WCh_Cnv); -- sequence for the given encoding method. generic + with function In_Char return Character; + function Char_Sequence_To_UTF_32 + (C : Character; + EM : System.WCh_Con.WC_Encoding_Method) return UTF_32_Code; + -- This is similar to the above, but the function returns a code from + -- the full UTF_32 code set, which covers the full range of possible + -- values in Wide_Wide_Character. The result can be converted to + -- Wide_Wide_Character form using Wide_Wide_Character'Val. + + generic with procedure Out_Char (C : Character); procedure Wide_Char_To_Char_Sequence (WC : Wide_Character; @@ -66,4 +75,14 @@ pragma Pure (WCh_Cnv); -- Constraint_Error is raised if the given wide character value is -- not a valid value for the given encoding method. + generic + with procedure Out_Char (C : Character); + procedure UTF_32_To_Char_Sequence + (Val : UTF_32_Code; + EM : System.WCh_Con.WC_Encoding_Method); + -- This is similar to the above, but the input value is a code from the + -- full UTF_32 code set, which covers the full range of possible values + -- in Wide_Wide_Character. To convert a Wide_Wide_Character value, the + -- caller can use Wide_Wide_Character'Pos in the call. + end System.WCh_Cnv; diff --git a/gcc/ada/s-wchcon.ads b/gcc/ada/s-wchcon.ads index 3c08176edf6..eecfe9f34ee 100644 --- a/gcc/ada/s-wchcon.ads +++ b/gcc/ada/s-wchcon.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2003 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- -- @@ -46,8 +46,8 @@ pragma Pure (WCh_Con); ------------------------------------- -- A wide character encoding method is a method for uniquely representing - -- a Wide_Character value using a one or more Character values. Three - -- types of encoding method are supported by GNAT: + -- a Wide_Character or Wide_Wide_Character value using a one or more + -- Character values. Three types of encoding method are supported by GNAT: -- An escape encoding method uses ESC as the first character of the -- sequence, and subsequent characters determine the wide character @@ -62,9 +62,10 @@ pragma Pure (WCh_Con); -- Any character in the lower half (16#00# .. 16#7F#) represents -- itself as a single character. - -- The brackets notation, where a wide character is represented - -- by the sequence ["xx"] or ["xxxx"] where xx are hexadecimal - -- characters. + -- The brackets notation, where a wide character is represented by the + -- sequence ["xx"] or ["xxxx"] or ["xxxxxx"] where xx are hexadecimal + -- characters. Note that currently this is the only encoding that + -- supports the full UTF-32 range. -- Note that GNAT does not currently support escape-in, escape-out -- encoding methods, where an escape sequence is used to set a mode @@ -130,25 +131,32 @@ pragma Pure (WCh_Con); -- An ISO 10646-1 BMP/Unicode wide character is represented in -- UCS Transformation Format 8 (UTF-8) as defined in Annex R of ISO -- 10646-1/Am.2. Depending on the character value, a Unicode character - -- is represented as the one, two, or three byte sequence + -- is represented as the one to six byte sequence. -- - -- 16#0000#-16#007f#: 2#0xxxxxxx# - -- 16#0080#-16#07ff#: 2#110xxxxx# 2#10xxxxxx# - -- 16#0800#-16#ffff#: 2#1110xxxx# 2#10xxxxxx# 2#10xxxxxx# + -- 16#0000_0000#-16#0000_007f#: 2#0xxxxxxx# + -- 16#0000_0080#-16#0000_07ff#: 2#110xxxxx# 2#10xxxxxx# + -- 16#0000_0800#-16#0000_ffff#: 2#1110xxxx# 2#10xxxxxx# 2#10xxxxxx# + -- 16#0001_0000#-16#001F_FFFF#: 2#11110xxx# 2#10xxxxxx# 2#10xxxxxx# + -- 2#10xxxxxx# + -- 16#0020_0000#-16#03FF_FFFF#: 2#111110xx# 2#10xxxxxx# 2#10xxxxxx# + -- 2#10xxxxxx# 2#10xxxxxx# + -- 16#0400_0000#-16#7FFF_FFFF#: 2#1111110x# 2#10xxxxxx# 2#10xxxxxx# + -- 2#10xxxxxx# 2#10xxxxxx# 2#10xxxxxx# -- - -- where the xxx bits correspond to the left-padded bits of the the + -- where the xxx bits correspond to the left-padded bits of the -- 16-bit character value. Note that all lower half ASCII characters -- are represented as ASCII bytes and all upper half characters and - -- other wide characters are represented as sequences of upper-half - -- (The full UTF-8 scheme allows for encoding 31-bit characters as - -- 6-byte sequences, but in this implementation, all UTF-8 sequences - -- of four or more bytes length will raise a Constraint_Error, as - -- will all illegal UTF-8 sequences.) + -- other wide characters are represented as sequences of upper-half. WCEM_Brackets : constant WC_Encoding_Method := 6; - -- A wide character is represented as the sequence ["abcd"] where abcd - -- are four hexadecimal characters. In this mode, the sequence ["ab"] - -- is also recognized for the case of character codes in the range 0-255. + -- A wide character is represented using one of the following sequences: + -- + -- ["xx"] + -- ["xxxx"] + -- ["xxxxxx"] + -- ["xxxxxxxx"] + -- + -- where xx are hexadecimal digits representing the character code. WC_Encoding_Letters : constant array (WC_Encoding_Method) of Character := (WCEM_Hex => 'h', @@ -170,8 +178,8 @@ pragma Pure (WCh_Con); -- Encoding methods using an upper half character (16#80#..16#FF) at -- the start of the sequence. - WC_Longest_Sequence : constant := 8; - -- The longest number of characters that can be used for a wide - -- character sequence for any of the active encoding methods. + WC_Longest_Sequence : constant := 10; + -- The longest number of characters that can be used for a wide character + -- or wide wide character sequence for any of the active encoding methods. end System.WCh_Con; diff --git a/gcc/ada/s-wchstw.adb b/gcc/ada/s-wchstw.adb index 6e8d5cb7b72..0deb55631e2 100644 --- a/gcc/ada/s-wchstw.adb +++ b/gcc/ada/s-wchstw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2000 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- -- @@ -31,189 +31,142 @@ -- -- ------------------------------------------------------------------------------ -with Interfaces; use Interfaces; with System.WCh_Con; use System.WCh_Con; -with System.WCh_JIS; use System.WCh_JIS; +with System.WCh_Cnv; use System.WCh_Cnv; package body System.WCh_StW is - --------------------------- - -- String_To_Wide_String -- - --------------------------- - - function String_To_Wide_String - (S : String; - EM : WC_Encoding_Method) - return Wide_String + ----------------------- + -- Local Subprograms -- + ----------------------- + + procedure Get_Next_Code + (S : String; + P : in out Natural; + V : out UTF_32_Code; + EM : WC_Encoding_Method); + -- Scans next character starting at S(P) and returns its value in V. On + -- exit P is updated past the last character read. Raises Constraint_Error + -- if the string is not well formed. Raises Constraint_Error if the code + -- value is greater than 16#7FFF_FFFF#. On entry P <= S'Last. + + ------------------- + -- Get_Next_Code -- + ------------------- + + procedure Get_Next_Code + (S : String; + P : in out Natural; + V : out UTF_32_Code; + EM : WC_Encoding_Method) is - R : Wide_String (1 .. S'Length); - RP : Natural; - SP : Natural; - U1 : Unsigned_16; - U2 : Unsigned_16; - U3 : Unsigned_16; - U : Unsigned_16; - - Last : constant Natural := S'Last; + function In_Char return Character; + -- Function to return a character, bumping P, raises Constraint_Error + -- if P > S'Last on entry. - function Get_Hex (C : Character) return Unsigned_16; - -- Converts character from hex digit to value in range 0-15. The - -- input must be in 0-9, A-F, or a-f, and no check is needed. + function Get_UTF_32 is new Char_Sequence_To_UTF_32 (In_Char); + -- Function to get next UFT_32 value. - procedure Get_Hex_4; - -- Translates four hex characters starting at S (SP) to a single - -- wide character. Used in WCEM_Hex and WCEM_Brackets mode. SP - -- is not modified by the call. The resulting wide character value - -- is stored in R (RP). RP is not modified by the call. + ------------- + -- In_Char -- + ------------- - function Get_Hex (C : Character) return Unsigned_16 is + function In_Char return Character is begin - if C in '0' .. '9' then - return Character'Pos (C) - Character'Pos ('0'); - elsif C in 'A' .. 'F' then - return Character'Pos (C) - Character'Pos ('A') + 10; + if P > S'Last then + raise Constraint_Error; else - return Character'Pos (C) - Character'Pos ('a') + 10; + P := P + 1; + return S (P - 1); end if; - end Get_Hex; + end In_Char; - procedure Get_Hex_4 is - begin - R (RP) := Wide_Character'Val ( - Get_Hex (S (SP + 3)) + 16 * - (Get_Hex (S (SP + 2)) + 16 * - (Get_Hex (S (SP + 1)) + 16 * - (Get_Hex (S (SP + 0)))))); - end Get_Hex_4; + begin + -- Check for wide character encoding - -- Start of processing for String_To_Wide_String + case EM is + when WCEM_Hex => + if S (P) = ASCII.ESC then + V := Get_UTF_32 (In_Char, EM); + return; + end if; + + when WCEM_Upper | WCEM_Shift_JIS | WCEM_EUC | WCEM_UTF8 => + if S (P) >= Character'Val (16#80#) then + V := Get_UTF_32 (In_Char, EM); + return; + end if; + + when WCEM_Brackets => + if P + 2 <= S'Last + and then S (P) = '[' + and then S (P + 1) = '"' + and then S (P + 2) /= '"' + then + V := Get_UTF_32 (In_Char, EM); + return; + end if; + end case; + + -- If it is not a wide character code, just get it + + V := Character'Pos (S (P)); + P := P + 1; + end Get_Next_Code; + + --------------------------- + -- String_To_Wide_String -- + --------------------------- + + function String_To_Wide_String + (S : String; + EM : WC_Encoding_Method) return Wide_String + is + R : Wide_String (1 .. S'Length); + RP : Natural; + SP : Natural; + V : UTF_32_Code; begin SP := S'First; RP := 0; + while SP <= S'Last loop + Get_Next_Code (S, SP, V, EM); - case EM is + if V > 16#FFFF# then + raise Constraint_Error; + end if; - -- ESC-Hex representation + RP := RP + 1; + R (RP) := Wide_Character'Val (V); + end loop; - when WCEM_Hex => - while SP <= Last - 4 loop - RP := RP + 1; - - if S (SP) = ASCII.ESC then - SP := SP + 1; - Get_Hex_4; - SP := SP + 4; - else - R (RP) := Wide_Character'Val (Character'Pos (S (SP))); - SP := SP + 1; - end if; - end loop; - - -- Upper bit shift, internal code = external code - - when WCEM_Upper => - while SP < Last loop - RP := RP + 1; - - if S (SP) >= Character'Val (16#80#) then - U1 := Character'Pos (S (SP)); - U2 := Character'Pos (S (SP + 1)); - R (RP) := Wide_Character'Val (256 * U1 + U2); - SP := SP + 2; - else - R (RP) := Wide_Character'Val (Character'Pos (S (SP))); - SP := SP + 1; - end if; - end loop; - - -- Upper bit shift, shift-JIS - - when WCEM_Shift_JIS => - while SP < Last loop - RP := RP + 1; - - if S (SP) >= Character'Val (16#80#) then - R (RP) := Shift_JIS_To_JIS (S (SP), S (SP + 1)); - SP := SP + 2; - else - R (RP) := Wide_Character'Val (Character'Pos (S (SP))); - SP := SP + 1; - end if; - end loop; - - -- Upper bit shift, EUC - - when WCEM_EUC => - while SP < Last loop - RP := RP + 1; - - if S (SP) >= Character'Val (16#80#) then - R (RP) := EUC_To_JIS (S (SP), S (SP + 1)); - SP := SP + 2; - else - R (RP) := Wide_Character'Val (Character'Pos (S (SP))); - SP := SP + 1; - end if; - end loop; - - -- Upper bit shift, UTF-8 - - when WCEM_UTF8 => - while SP < Last loop - RP := RP + 1; - - if S (SP) >= Character'Val (16#80#) then - U1 := Character'Pos (S (SP)); - U2 := Character'Pos (S (SP + 1)); - - U := Shift_Left (U1 and 2#00011111#, 6) + - (U2 and 2#00111111#); - SP := SP + 2; - - if U1 >= 2#11100000# then - U3 := Character'Pos (S (SP)); - U := Shift_Left (U, 6) + (U3 and 2#00111111#); - SP := SP + 1; - end if; - - R (RP) := Wide_Character'Val (U); - - else - R (RP) := Wide_Character'Val (Character'Pos (S (SP))); - SP := SP + 1; - end if; - end loop; - - -- Brackets representation + return R (1 .. RP); + end String_To_Wide_String; - when WCEM_Brackets => - while SP <= Last - 7 loop - RP := RP + 1; - - if S (SP) = '[' - and then S (SP + 1) = '"' - and then S (SP + 2) /= '"' - then - SP := SP + 2; - Get_Hex_4; - SP := SP + 6; - - else - R (RP) := Wide_Character'Val (Character'Pos (S (SP))); - SP := SP + 1; - end if; - end loop; + -------------------------------- + -- String_To_Wide_Wide_String -- + -------------------------------- - end case; + function String_To_Wide_Wide_String + (S : String; + EM : WC_Encoding_Method) return Wide_Wide_String + is + R : Wide_Wide_String (1 .. S'Length); + RP : Natural; + SP : Natural; + V : UTF_32_Code; - while SP <= Last loop + begin + SP := S'First; + RP := 0; + while SP <= S'Last loop + Get_Next_Code (S, SP, V, EM); RP := RP + 1; - R (RP) := Wide_Character'Val (Character'Pos (S (SP))); - SP := SP + 1; + R (RP) := Wide_Wide_Character'Val (V); end loop; return R (1 .. RP); - end String_To_Wide_String; + end String_To_Wide_Wide_String; end System.WCh_StW; diff --git a/gcc/ada/s-wchstw.ads b/gcc/ada/s-wchstw.ads index c58066c1204..c1d33eb3f85 100644 --- a/gcc/ada/s-wchstw.ads +++ b/gcc/ada/s-wchstw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-1998 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- -- @@ -31,8 +31,8 @@ -- -- ------------------------------------------------------------------------------ --- This package contains the routine used to convert strings to wide --- strings for use by wide character attributes (value, image etc.) +-- This package contains the routine used to convert strings to wide (wide) +-- strings for use by wide (wide) character attributes (value, image etc.) with System.WCh_Con; @@ -40,9 +40,8 @@ package System.WCh_StW is pragma Pure (WCh_StW); function String_To_Wide_String - (S : String; - EM : System.WCh_Con.WC_Encoding_Method) - return Wide_String; + (S : String; + EM : System.WCh_Con.WC_Encoding_Method) return Wide_String; -- This routine simply takes its argument and converts it to wide string -- format. In the context of the Wide_Image attribute, the argument is -- the corresponding 'Image attribute. Any wide character escape sequences @@ -57,4 +56,9 @@ pragma Pure (WCh_StW); -- Note: in the WCEM_Brackets case, the brackets escape sequence is used -- only for codes greater than 16#FF#. + function String_To_Wide_Wide_String + (S : String; + EM : System.WCh_Con.WC_Encoding_Method) return Wide_Wide_String; + -- Same function with Wide_Wide_String output + end System.WCh_StW; diff --git a/gcc/ada/s-wchwts.adb b/gcc/ada/s-wchwts.adb index c9894f7c038..21174aad370 100644 --- a/gcc/ada/s-wchwts.adb +++ b/gcc/ada/s-wchwts.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2000 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- -- @@ -31,133 +31,94 @@ -- -- ------------------------------------------------------------------------------ -with Interfaces; use Interfaces; with System.WCh_Con; use System.WCh_Con; -with System.WCh_JIS; use System.WCh_JIS; +with System.WCh_Cnv; use System.WCh_Cnv; package body System.WCh_WtS is + ----------------------- + -- Local Subprograms -- + ----------------------- + + procedure Store_UTF_32_Character + (U : UTF_32_Code; + S : out String; + P : in out Integer; + EM : WC_Encoding_Method); + -- Stores the string representation of the wide or wide wide character + -- whose code is given as U, starting at S (P + 1). P is incremented to + -- point to the last character stored. Raises CE if character cannot be + -- stored using the given encoding method. + + ---------------------------- + -- Store_UTF_32_Character -- + ---------------------------- + + procedure Store_UTF_32_Character + (U : UTF_32_Code; + S : out String; + P : in out Integer; + EM : WC_Encoding_Method) + is + procedure Out_Char (C : Character); + pragma Inline (Out_Char); + -- Procedure to increment P and store C at S (P) + + procedure Store_Chars is new UTF_32_To_Char_Sequence (Out_Char); + + -------------- + -- Out_Char -- + -------------- + + procedure Out_Char (C : Character) is + begin + P := P + 1; + S (P) := C; + end Out_Char; + + begin + Store_Chars (U, EM); + end Store_UTF_32_Character; + --------------------------- -- Wide_String_To_String -- --------------------------- function Wide_String_To_String - (S : Wide_String; - EM : WC_Encoding_Method) - return String + (S : Wide_String; + EM : WC_Encoding_Method) return String is R : String (1 .. 5 * S'Length); -- worst case length! RP : Natural; - C1 : Character; - C2 : Character; begin RP := 0; - for SP in S'Range loop - declare - C : constant Wide_Character := S (SP); - CV : constant Unsigned_16 := Wide_Character'Pos (C); - Hex : constant array (Unsigned_16 range 0 .. 15) of Character := - "0123456789ABCDEF"; - - begin - if CV <= 127 then - RP := RP + 1; - R (RP) := Character'Val (CV); - - else - case EM is - - -- Hex ESC sequence encoding - - when WCEM_Hex => - if CV <= 16#FF# then - RP := RP + 1; - R (RP) := Character'Val (CV); - - else - R (RP + 1) := ASCII.ESC; - R (RP + 2) := Hex (Shift_Right (CV, 12)); - R (RP + 3) := Hex (Shift_Right (CV, 8) and 16#000F#); - R (RP + 4) := Hex (Shift_Right (CV, 4) and 16#000F#); - R (RP + 5) := Hex (CV and 16#000F#); - RP := RP + 5; - end if; - - -- Upper bit shift (internal code = external code) - - when WCEM_Upper => - R (RP + 1) := Character'Val (Shift_Right (CV, 8)); - R (RP + 2) := Character'Val (CV and 16#FF#); - RP := RP + 2; - - -- Upper bit shift (EUC) - - when WCEM_EUC => - JIS_To_EUC (C, C1, C2); - R (RP + 1) := C1; - R (RP + 2) := C2; - RP := RP + 2; - - -- Upper bit shift (Shift-JIS) - - when WCEM_Shift_JIS => - JIS_To_Shift_JIS (C, C1, C2); - R (RP + 1) := C1; - R (RP + 2) := C2; - RP := RP + 2; - - -- Upper bit shift (UTF-8) - - -- 16#0080#-16#07ff#: 2#110xxxxx# 2#10xxxxxx# - -- 16#0800#-16#ffff#: 2#1110xxxx# 2#10xxxxxx# 2#10xxxxxx# - - when WCEM_UTF8 => - if CV < 16#0800# then - R (RP + 1) := - Character'Val (2#11000000# or Shift_Right (CV, 6)); - R (RP + 2) := - Character'Val (2#10000000# or (CV and 2#00111111#)); - RP := RP + 2; - - else - R (RP + 1) := - Character'Val (2#11100000# or Shift_Right (CV, 12)); - R (RP + 2) := - Character'Val (2#10000000# or - (Shift_Right (CV, 6) and - 2#00111111#)); - R (RP + 3) := - Character'Val (2#10000000# or (CV and 2#00111111#)); - RP := RP + 3; - end if; - - -- Brackets encoding - - when WCEM_Brackets => - if CV <= 16#FF# then - RP := RP + 1; - R (RP) := Character'Val (CV); - - else - R (RP + 1) := '['; - R (RP + 2) := '"'; - R (RP + 3) := Hex (Shift_Right (CV, 12)); - R (RP + 4) := Hex (Shift_Right (CV, 8) and 16#000F#); - R (RP + 5) := Hex (Shift_Right (CV, 4) and 16#000F#); - R (RP + 6) := Hex (CV and 16#000F#); - R (RP + 7) := '"'; - R (RP + 8) := ']'; - RP := RP + 8; - end if; - - end case; - end if; - end; + Store_UTF_32_Character (Wide_Character'Pos (S (SP)), R, RP, EM); end loop; return R (1 .. RP); end Wide_String_To_String; + -------------------------------- + -- Wide_Wide_Sring_To_String -- + -------------------------------- + + function Wide_Wide_String_To_String + (S : Wide_Wide_String; + EM : WC_Encoding_Method) return String + is + R : String (1 .. 7 * S'Length); -- worst case length! + RP : Natural; + + begin + RP := 0; + + for SP in S'Range loop + Store_UTF_32_Character (Wide_Wide_Character'Pos (S (SP)), R, RP, EM); + end loop; + + return R (1 .. RP); + end Wide_Wide_String_To_String; + end System.WCh_WtS; diff --git a/gcc/ada/s-wchwts.ads b/gcc/ada/s-wchwts.ads index 053d4132fca..936045992df 100644 --- a/gcc/ada/s-wchwts.ads +++ b/gcc/ada/s-wchwts.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-1998 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- -- @@ -31,9 +31,10 @@ -- -- ------------------------------------------------------------------------------ --- This package contains the routine used to convert wide strings to --- strings for use by wide character attributes (value, image etc.) and --- also by the numeric IO subpackages of Ada.Text_IO.Wide_Text_IO. +-- This package contains the routine used to convert wide strings and wide +-- wide stringsto strings for use by wide and wide wide character attributes +-- (value, image etc.) and also by the numeric IO subpackages of +-- Ada.Text_IO.Wide_Text_IO and Ada.Text_IO.Wide_Wide_Text_IO. with System.WCh_Con; @@ -41,9 +42,8 @@ package System.WCh_WtS is pragma Pure (WCh_WtS); function Wide_String_To_String - (S : Wide_String; - EM : System.WCh_Con.WC_Encoding_Method) - return String; + (S : Wide_String; + EM : System.WCh_Con.WC_Encoding_Method) return String; -- This routine simply takes its argument and converts it to a string, -- using the internal compiler escape sequence convention (defined in -- package Widechar) to translate characters that are out of range @@ -56,4 +56,9 @@ pragma Pure (WCh_WtS); -- Note: in the WCEM_Brackets case, we only use the brackets encoding -- for characters greater than 16#FF#. + function Wide_Wide_String_To_String + (S : Wide_Wide_String; + EM : System.WCh_Con.WC_Encoding_Method) return String; + -- Same processing, except for Wide_Wide_String + end System.WCh_WtS; diff --git a/gcc/ada/s-widwch.adb b/gcc/ada/s-widwch.adb index a5eaa0451b3..3797bf52c99 100644 --- a/gcc/ada/s-widwch.adb +++ b/gcc/ada/s-widwch.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-1998 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- -- @@ -41,15 +41,13 @@ package body System.Wid_WChar is function Width_Wide_Character (Lo, Hi : Wide_Character; - EM : WC_Encoding_Method) - return Natural + EM : WC_Encoding_Method) return Natural is W : Natural; P : Natural; begin W := 0; - for C in Lo .. Hi loop P := Wide_Character'Pos (C); @@ -97,4 +95,64 @@ package body System.Wid_WChar is return W; end Width_Wide_Character; + ------------------------------- + -- Width_Wide_Wide_Character -- + ------------------------------- + + function Width_Wide_Wide_Character + (Lo, Hi : Wide_Wide_Character; + EM : WC_Encoding_Method) return Natural + is + W : Natural; + P : Natural; + + begin + W := 0; + for C in Lo .. Hi loop + P := Wide_Wide_Character'Pos (C); + + -- Here if we find a character in wide wide character range + + if P > 16#FF# then + case EM is + when WCEM_Hex => + return Natural'Max (W, 5); + + when WCEM_Upper => + return Natural'Max (W, 2); + + when WCEM_Shift_JIS => + return Natural'Max (W, 2); + + when WCEM_EUC => + return Natural'Max (W, 2); + + when WCEM_UTF8 => + if Hi > Wide_Wide_Character'Val (16#FFFF#) then + return Natural'Max (W, 4); + elsif Hi > Wide_Wide_Character'Val (16#07FF#) then + return Natural'Max (W, 3); + else + return Natural'Max (W, 2); + end if; + + when WCEM_Brackets => + return Natural'Max (W, 10); + + end case; + + -- If we are in character range then use length of character image + + else + declare + S : constant String := Character'Image (Character'Val (P)); + begin + W := Natural'Max (W, S'Length); + end; + end if; + end loop; + + return W; + end Width_Wide_Wide_Character; + end System.Wid_WChar; diff --git a/gcc/ada/s-widwch.ads b/gcc/ada/s-widwch.ads index ab5649abf61..15c8705053d 100644 --- a/gcc/ada/s-widwch.ads +++ b/gcc/ada/s-widwch.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992,1993,1994 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- -- @@ -31,7 +31,7 @@ -- -- ------------------------------------------------------------------------------ --- This package contains the routine used for Wide_Character'Width +-- This package contains the routines used for Wide_[Wide_]Character'Width with System.WCh_Con; @@ -40,10 +40,14 @@ pragma Pure (Wid_WChar); function Width_Wide_Character (Lo, Hi : Wide_Character; - EM : System.WCh_Con.WC_Encoding_Method) - return Natural; + EM : System.WCh_Con.WC_Encoding_Method) return Natural; -- Compute Width attribute for non-static type derived from Wide_Character. -- The arguments are the low and high bounds for the type. EM is the -- wide-character encoding method. + function Width_Wide_Wide_Character + (Lo, Hi : Wide_Wide_Character; + EM : System.WCh_Con.WC_Encoding_Method) return Natural; + -- Same function for type derived from Wide_Wide_Character + end System.Wid_WChar; diff --git a/gcc/ada/s-wwdcha.adb b/gcc/ada/s-wwdcha.adb index 18928fdf848..82db6f39758 100644 --- a/gcc/ada/s-wwdcha.adb +++ b/gcc/ada/s-wwdcha.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- -- @@ -42,11 +42,9 @@ package body System.WWd_Char is begin W := 0; - for C in Lo .. Hi loop declare S : constant Wide_String := Character'Wide_Image (C); - begin W := Natural'Max (W, S'Length); end; @@ -55,4 +53,24 @@ package body System.WWd_Char is return W; end Wide_Width_Character; + ------------------------------- + -- Wide_Wide_Width_Character -- + ------------------------------- + + function Wide_Wide_Width_Character (Lo, Hi : Character) return Natural is + W : Natural; + + begin + W := 0; + for C in Lo .. Hi loop + declare + S : constant Wide_Wide_String := Character'Wide_Wide_Image (C); + begin + W := Natural'Max (W, S'Length); + end; + end loop; + + return W; + end Wide_Wide_Width_Character; + end System.WWd_Char; diff --git a/gcc/ada/s-wwdcha.ads b/gcc/ada/s-wwdcha.ads index 9981cff710e..9431fb7f12d 100644 --- a/gcc/ada/s-wwdcha.ads +++ b/gcc/ada/s-wwdcha.ads @@ -6,8 +6,8 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992,1993,1994 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- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- @@ -31,7 +31,7 @@ -- -- ------------------------------------------------------------------------------ --- This package contains the routine used for Character'Wide_Width +-- This package contains the routine used for Character'Wide_[Wide_]Width package System.WWd_Char is pragma Pure (WWd_Char); @@ -40,4 +40,8 @@ pragma Pure (WWd_Char); -- Compute Wide_Width attribute for non-static type derived from -- Character. The arguments are the low and high bounds for the type. + function Wide_Wide_Width_Character (Lo, Hi : Character) return Natural; + -- Compute Wide_Wide_Width attribute for non-static type derived from + -- Character. The arguments are the low and high bounds for the type. + end System.WWd_Char; diff --git a/gcc/ada/s-wwdenu.adb b/gcc/ada/s-wwdenu.adb index 9a942591d2b..444d018da36 100644 --- a/gcc/ada/s-wwdenu.adb +++ b/gcc/ada/s-wwdenu.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2000 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- -- @@ -38,6 +38,117 @@ with Unchecked_Conversion; package body System.WWd_Enum is + ----------------------------------- + -- Wide_Wide_Width_Enumeration_8 -- + ----------------------------------- + + function Wide_Wide_Width_Enumeration_8 + (Names : String; + Indexes : System.Address; + Lo, Hi : Natural; + EM : WC_Encoding_Method) return Natural + is + W : Natural; + + type Natural_8 is range 0 .. 2 ** 7 - 1; + type Index_Table is array (Natural) of Natural_8; + type Index_Table_Ptr is access Index_Table; + + function To_Index_Table_Ptr is + new Unchecked_Conversion (System.Address, Index_Table_Ptr); + + IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes); + + begin + W := 0; + for J in Lo .. Hi loop + declare + WS : constant Wide_Wide_String := + String_To_Wide_Wide_String + (Names (Natural (IndexesT (J)) .. + Natural (IndexesT (J + 1)) - 1), EM); + begin + W := Natural'Max (W, WS'Length); + end; + end loop; + + return W; + end Wide_Wide_Width_Enumeration_8; + + ------------------------------------ + -- Wide_Wide_Width_Enumeration_16 -- + ------------------------------------ + + function Wide_Wide_Width_Enumeration_16 + (Names : String; + Indexes : System.Address; + Lo, Hi : Natural; + EM : WC_Encoding_Method) return Natural + is + W : Natural; + + type Natural_16 is range 0 .. 2 ** 15 - 1; + type Index_Table is array (Natural) of Natural_16; + type Index_Table_Ptr is access Index_Table; + + function To_Index_Table_Ptr is + new Unchecked_Conversion (System.Address, Index_Table_Ptr); + + IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes); + + begin + W := 0; + for J in Lo .. Hi loop + declare + WS : constant Wide_Wide_String := + String_To_Wide_Wide_String + (Names (Natural (IndexesT (J)) .. + Natural (IndexesT (J + 1)) - 1), EM); + begin + W := Natural'Max (W, WS'Length); + end; + end loop; + + return W; + end Wide_Wide_Width_Enumeration_16; + + ------------------------------------ + -- Wide_Wide_Width_Enumeration_32 -- + ------------------------------------ + + function Wide_Wide_Width_Enumeration_32 + (Names : String; + Indexes : System.Address; + Lo, Hi : Natural; + EM : WC_Encoding_Method) return Natural + is + W : Natural; + + type Natural_32 is range 0 .. 2 ** 31 - 1; + type Index_Table is array (Natural) of Natural_32; + type Index_Table_Ptr is access Index_Table; + + function To_Index_Table_Ptr is + new Unchecked_Conversion (System.Address, Index_Table_Ptr); + + IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes); + + begin + W := 0; + for J in Lo .. Hi loop + declare + WS : constant Wide_Wide_String := + String_To_Wide_Wide_String + (Names (Natural (IndexesT (J)) .. + Natural (IndexesT (J + 1)) - 1), EM); + begin + W := Natural'Max (W, WS'Length); + end; + end loop; + + return W; + end Wide_Wide_Width_Enumeration_32; + ------------------------------ -- Wide_Width_Enumeration_8 -- ------------------------------ @@ -46,8 +157,7 @@ package body System.WWd_Enum is (Names : String; Indexes : System.Address; Lo, Hi : Natural; - EM : WC_Encoding_Method) - return Natural + EM : WC_Encoding_Method) return Natural is W : Natural; @@ -62,14 +172,12 @@ package body System.WWd_Enum is begin W := 0; - for J in Lo .. Hi loop declare WS : constant Wide_String := - String_To_Wide_String - (Names (Natural (IndexesT (J)) .. - Natural (IndexesT (J + 1)) - 1), EM); - + String_To_Wide_String + (Names (Natural (IndexesT (J)) .. + Natural (IndexesT (J + 1)) - 1), EM); begin W := Natural'Max (W, WS'Length); end; @@ -86,8 +194,7 @@ package body System.WWd_Enum is (Names : String; Indexes : System.Address; Lo, Hi : Natural; - EM : WC_Encoding_Method) - return Natural + EM : WC_Encoding_Method) return Natural is W : Natural; @@ -102,14 +209,12 @@ package body System.WWd_Enum is begin W := 0; - for J in Lo .. Hi loop declare WS : constant Wide_String := - String_To_Wide_String - (Names (Natural (IndexesT (J)) .. - Natural (IndexesT (J + 1)) - 1), EM); - + String_To_Wide_String + (Names (Natural (IndexesT (J)) .. + Natural (IndexesT (J + 1)) - 1), EM); begin W := Natural'Max (W, WS'Length); end; @@ -126,8 +231,7 @@ package body System.WWd_Enum is (Names : String; Indexes : System.Address; Lo, Hi : Natural; - EM : WC_Encoding_Method) - return Natural + EM : WC_Encoding_Method) return Natural is W : Natural; @@ -142,14 +246,12 @@ package body System.WWd_Enum is begin W := 0; - for J in Lo .. Hi loop declare WS : constant Wide_String := - String_To_Wide_String - (Names (Natural (IndexesT (J)) .. - Natural (IndexesT (J + 1)) - 1), EM); - + String_To_Wide_String + (Names (Natural (IndexesT (J)) .. + Natural (IndexesT (J + 1)) - 1), EM); begin W := Natural'Max (W, WS'Length); end; diff --git a/gcc/ada/s-wwdenu.ads b/gcc/ada/s-wwdenu.ads index 9bb400fefb3..3c64764915d 100644 --- a/gcc/ada/s-wwdenu.ads +++ b/gcc/ada/s-wwdenu.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2000 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- -- @@ -31,7 +31,7 @@ -- -- ------------------------------------------------------------------------------ --- This package contains the routine used for Enumeration_Type'Wide_Width +-- This package contains routines used for Enumeration_Type'Wide_[Wide_]Width with System.WCh_Con; @@ -42,8 +42,7 @@ pragma Pure (WWd_Enum); (Names : String; Indexes : System.Address; Lo, Hi : Natural; - EM : System.WCh_Con.WC_Encoding_Method) - return Natural; + EM : System.WCh_Con.WC_Encoding_Method) return Natural; -- Used to compute Enum'Wide_Width where Enum is an enumeration subtype -- other than those defined in package Standard. Names is a string with -- a lower bound of 1 containing the characters of all the enumeration @@ -65,8 +64,7 @@ pragma Pure (WWd_Enum); (Names : String; Indexes : System.Address; Lo, Hi : Natural; - EM : System.WCh_Con.WC_Encoding_Method) - return Natural; + EM : System.WCh_Con.WC_Encoding_Method) return Natural; -- Identical to Wide_Width_Enumeration_8 except that it handles types -- using array (0 .. Num) of Natural_16 for the Indexes table. @@ -74,9 +72,29 @@ pragma Pure (WWd_Enum); (Names : String; Indexes : System.Address; Lo, Hi : Natural; - EM : System.WCh_Con.WC_Encoding_Method) - return Natural; + EM : System.WCh_Con.WC_Encoding_Method) return Natural; -- Identical to Wide_Width_Enumeration_8 except that it handles types -- using array (0 .. Num) of Natural_32 for the Indexes table. + function Wide_Wide_Width_Enumeration_8 + (Names : String; + Indexes : System.Address; + Lo, Hi : Natural; + EM : System.WCh_Con.WC_Encoding_Method) return Natural; + -- Same function for Wide_Wide_Width attribute + + function Wide_Wide_Width_Enumeration_16 + (Names : String; + Indexes : System.Address; + Lo, Hi : Natural; + EM : System.WCh_Con.WC_Encoding_Method) return Natural; + -- Same function for Wide_Wide_Width attribute + + function Wide_Wide_Width_Enumeration_32 + (Names : String; + Indexes : System.Address; + Lo, Hi : Natural; + EM : System.WCh_Con.WC_Encoding_Method) return Natural; + -- Same function for Wide_Wide_Width attribute + end System.WWd_Enum; diff --git a/gcc/ada/s-wwdwch.adb b/gcc/ada/s-wwdwch.adb index eb9d2fb6ac4..ac3d1e9cc45 100644 --- a/gcc/ada/s-wwdwch.adb +++ b/gcc/ada/s-wwdwch.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- -- @@ -31,46 +31,147 @@ -- -- ------------------------------------------------------------------------------ +with Interfaces; use Interfaces; + +with System.WWd_Char; + package body System.Wwd_WChar is + ------------------------------------ + -- Wide_Wide_Width_Wide_Character -- + ------------------------------------ + + -- This is the case where we are talking about the Wide_Wide_Image of + -- a Wide_Character, which is always the same character sequence as the + -- Wide_Image of the same Wide_Character. + + function Wide_Wide_Width_Wide_Character + (Lo, Hi : Wide_Character) return Natural + is + begin + return Wide_Width_Wide_Character (Lo, Hi); + end Wide_Wide_Width_Wide_Character; + + ------------------------------------ + -- Wide_Wide_Width_Wide_Wide_Char -- + ------------------------------------ + + function Wide_Wide_Width_Wide_Wide_Char + (Lo, Hi : Wide_Wide_Character) return Natural + is + W : Natural := 0; + LV : constant Unsigned_32 := Wide_Wide_Character'Pos (Lo); + HV : constant Unsigned_32 := Wide_Wide_Character'Pos (Hi); + + begin + -- Return zero if empty range + + if LV > HV then + return 0; + end if; + + -- If any characters in normal character range, then use normal + -- Wide_Wide_Width attribute on this range to find out a starting point. + -- Otherwise start with zero. + + if LV <= 255 then + W := + System.WWd_Char.Wide_Wide_Width_Character + (Lo => Character'Val (LV), + Hi => Character'Val (Unsigned_32'Min (255, HV))); + else + W := 0; + end if; + + -- Increase to at least 4 if FFFE or FFFF present. These correspond + -- to the special language defined names FFFE/FFFF for these values. + + if 16#FFFF# in LV .. HV or else 16#FFFE# in LV .. HV then + W := Natural'Max (W, 4); + end if; + + -- Increase to at least 3 if any wide characters, corresponding to + -- the normal ' character ' sequence. We know that the character fits. + + if HV > 255 then + W := Natural'Max (W, 3); + end if; + + return W; + end Wide_Wide_Width_Wide_Wide_Char; + ------------------------------- -- Wide_Width_Wide_Character -- ------------------------------- function Wide_Width_Wide_Character - (Lo, Hi : Wide_Character) - return Natural + (Lo, Hi : Wide_Character) return Natural is - W : Natural; - P : Natural; + W : Natural := 0; + LV : constant Unsigned_32 := Wide_Character'Pos (Lo); + HV : constant Unsigned_32 := Wide_Character'Pos (Hi); begin - W := 0; + -- Return zero if empty range - for C in Lo .. Hi loop - P := Wide_Character'Pos (C); + if LV > HV then + return 0; + end if; - -- If we are in wide character range, the length is always 3 - -- and we are done, since all remaining characters are the same. + -- If any characters in normal character range, then use normal + -- Wide_Wide_Width attribute on this range to find out a starting point. + -- Otherwise start with zero. - if P > 255 then - return Natural'Max (W, 3); + if LV <= 255 then + W := + System.WWd_Char.Wide_Width_Character + (Lo => Character'Val (LV), + Hi => Character'Val (Unsigned_32'Min (255, HV))); + else + W := 0; + end if; - -- If we are in character range then use length of character image - -- Is this right, what about wide char encodings of 80-FF??? + -- Increase to at least 4 if FFFE or FFFF present. These correspond + -- to the special language defined names FFFE/FFFF for these values. - else - declare - S : constant Wide_String := - Character'Wide_Image (Character'Val (P)); + if 16#FFFF# in LV .. HV or else 16#FFFE# in LV .. HV then + W := Natural'Max (W, 4); + end if; - begin - W := Natural'Max (W, S'Length); - end; - end if; - end loop; + -- Increase to at least 3 if any wide characters, corresponding to + -- the normal 'character' sequence. We know that the character fits. + + if HV > 255 then + W := Natural'Max (W, 3); + end if; return W; end Wide_Width_Wide_Character; + ------------------------------------ + -- Wide_Width_Wide_Wide_Character -- + ------------------------------------ + + -- This is a nasty case, because we get into the business of representing + -- out of range wide wide characters as wide strings. Let's let image do + -- the work here. Too bad if this takes lots of time. It's silly anyway! + + function Wide_Width_Wide_Wide_Character + (Lo, Hi : Wide_Wide_Character) return Natural + is + W : Natural; + + begin + W := 0; + for J in Lo .. Hi loop + declare + S : constant Wide_String := Wide_Wide_Character'Wide_Image (J); + begin + W := Natural'Max (W, S'Length); + end; + end loop; + + return W; + end Wide_Width_Wide_Wide_Character; + end System.Wwd_WChar; diff --git a/gcc/ada/s-wwdwch.ads b/gcc/ada/s-wwdwch.ads index e8f06679804..b158be26292 100644 --- a/gcc/ada/s-wwdwch.ads +++ b/gcc/ada/s-wwdwch.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992,1993,1994 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- -- @@ -31,16 +31,33 @@ -- -- ------------------------------------------------------------------------------ --- This package contains the routine used for Wide_Character'Wide_Width +-- This package contains routines for [Wide_]Wide_Character'[Wide_]Wide_Width package System.Wwd_WChar is pragma Pure (Wwd_WChar); function Wide_Width_Wide_Character - (Lo, Hi : Wide_Character) - return Natural; + (Lo, Hi : Wide_Character) return Natural; -- Compute Wide_Width attribute for non-static type derived from -- Wide_Character. The arguments are the low and high bounds for -- the type. EM is the wide-character encoding method. + function Wide_Width_Wide_Wide_Character + (Lo, Hi : Wide_Wide_Character) return Natural; + -- Compute Wide_Width attribute for non-static type derived from + -- Wide_Wide_Character. The arguments are the low and high bounds for + -- the type. EM is the wide-character encoding method. + + function Wide_Wide_Width_Wide_Character + (Lo, Hi : Wide_Character) return Natural; + -- Compute Wide_Wide_Width attribute for non-static type derived from + -- Wide_Character. The arguments are the low and high bounds for + -- the type. EM is the wide-character encoding method. + + function Wide_Wide_Width_Wide_Wide_Char + (Lo, Hi : Wide_Wide_Character) return Natural; + -- Compute Wide_Wide_Width attribute for non-static type derived from + -- Wide_Wide_Character. The arguments are the low and high bounds for + -- the type. EM is the wide-character encoding method. + end System.Wwd_WChar; diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads index b8f5c397654..8c7870fbc57 100644 --- a/gcc/ada/scans.ads +++ b/gcc/ada/scans.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2003 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- -- @@ -124,6 +124,7 @@ package Scans is Tok_Constant, -- CONSTANT Eterm, Sterm Tok_Do, -- DO Eterm, Sterm Tok_Is, -- IS Eterm, Sterm + Tok_Interface, -- INTERFACE Eterm, Sterm Tok_Limited, -- LIMITED Eterm, Sterm Tok_Of, -- OF Eterm, Sterm Tok_Out, -- OUT Eterm, Sterm @@ -166,6 +167,8 @@ package Scans is Tok_Task, -- TASK Eterm, Sterm, Declk, Deckn, After_SM Tok_Type, -- TYPE Eterm, Sterm, Declk, Deckn, After_SM Tok_Subtype, -- SUBTYPE Eterm, Sterm, Declk, Deckn, After_SM + Tok_Overriding, -- OVERRIDING Eterm, Sterm, Declk, Declk, After_SM + Tok_Synchronized, -- SYNCHRONIZED Eterm, Sterm, Declk, Deckn, After_SM Tok_Use, -- USE Eterm, Sterm, Declk, Deckn, After_SM Tok_Function, -- FUNCTION Eterm, Sterm, Cunit, Declk, After_SM diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb index a60d28e1fe8..b83be649810 100644 --- a/gcc/ada/scn.adb +++ b/gcc/ada/scn.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -33,6 +33,7 @@ with Rident; use Rident; with Scans; use Scans; with Sinfo; use Sinfo; with Sinput; use Sinput; +with Uintp; use Uintp; package body Scn is @@ -64,7 +65,7 @@ package body Scn is case Token is when Tok_Char_Literal => Token_Node := New_Node (N_Character_Literal, Token_Ptr); - Set_Char_Literal_Value (Token_Node, Character_Code); + Set_Char_Literal_Value (Token_Node, UI_From_CC (Character_Code)); Set_Chars (Token_Node, Token_Name); when Tok_Identifier => diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index 486fbffe45d..158524df989 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -94,7 +94,13 @@ package body Scng is procedure Accumulate_Checksum (C : Char_Code) is begin - Accumulate_Checksum (Character'Val (C / 256)); + if C > 16#FFFF# then + Accumulate_Checksum (Character'Val (C / 2 ** 16)); + Accumulate_Checksum (Character'Val ((C / 256) mod 256)); + else + Accumulate_Checksum (Character'Val (C / 256)); + end if; + Accumulate_Checksum (Character'Val (C mod 256)); end Accumulate_Checksum; @@ -135,80 +141,103 @@ package body Scng is (Unit : Unit_Number_Type; Index : Source_File_Index) is + procedure Set_Reserved (N : Name_Id; T : Token_Type); + pragma Inline (Set_Reserved); + -- Set given name as a reserved keyword (T is the corresponding token) + + ------------- + -- Set_NTB -- + ------------- + + procedure Set_Reserved (N : Name_Id; T : Token_Type) is + begin + -- Set up Token_Type values in Names Table entries for reserved + -- keywords We use the Pos value of the Token_Type value. Note we + -- rely on the fact that Token_Type'Val (0) is not a reserved word! + + Set_Name_Table_Byte (N, Token_Type'Pos (T)); + end Set_Reserved; + + -- Start of processing for Initialize_Scanner + begin - -- Set up Token_Type values in Names Table entries for reserved keywords - -- We use the Pos value of the Token_Type value. Note we are relying on - -- the fact that Token_Type'Val (0) is not a reserved word! - - Set_Name_Table_Byte (Name_Abort, Token_Type'Pos (Tok_Abort)); - Set_Name_Table_Byte (Name_Abs, Token_Type'Pos (Tok_Abs)); - Set_Name_Table_Byte (Name_Abstract, Token_Type'Pos (Tok_Abstract)); - Set_Name_Table_Byte (Name_Accept, Token_Type'Pos (Tok_Accept)); - Set_Name_Table_Byte (Name_Access, Token_Type'Pos (Tok_Access)); - Set_Name_Table_Byte (Name_And, Token_Type'Pos (Tok_And)); - Set_Name_Table_Byte (Name_Aliased, Token_Type'Pos (Tok_Aliased)); - Set_Name_Table_Byte (Name_All, Token_Type'Pos (Tok_All)); - Set_Name_Table_Byte (Name_Array, Token_Type'Pos (Tok_Array)); - Set_Name_Table_Byte (Name_At, Token_Type'Pos (Tok_At)); - Set_Name_Table_Byte (Name_Begin, Token_Type'Pos (Tok_Begin)); - Set_Name_Table_Byte (Name_Body, Token_Type'Pos (Tok_Body)); - Set_Name_Table_Byte (Name_Case, Token_Type'Pos (Tok_Case)); - Set_Name_Table_Byte (Name_Constant, Token_Type'Pos (Tok_Constant)); - Set_Name_Table_Byte (Name_Declare, Token_Type'Pos (Tok_Declare)); - Set_Name_Table_Byte (Name_Delay, Token_Type'Pos (Tok_Delay)); - Set_Name_Table_Byte (Name_Delta, Token_Type'Pos (Tok_Delta)); - Set_Name_Table_Byte (Name_Digits, Token_Type'Pos (Tok_Digits)); - Set_Name_Table_Byte (Name_Do, Token_Type'Pos (Tok_Do)); - Set_Name_Table_Byte (Name_Else, Token_Type'Pos (Tok_Else)); - Set_Name_Table_Byte (Name_Elsif, Token_Type'Pos (Tok_Elsif)); - Set_Name_Table_Byte (Name_End, Token_Type'Pos (Tok_End)); - Set_Name_Table_Byte (Name_Entry, Token_Type'Pos (Tok_Entry)); - Set_Name_Table_Byte (Name_Exception, Token_Type'Pos (Tok_Exception)); - Set_Name_Table_Byte (Name_Exit, Token_Type'Pos (Tok_Exit)); - Set_Name_Table_Byte (Name_For, Token_Type'Pos (Tok_For)); - Set_Name_Table_Byte (Name_Function, Token_Type'Pos (Tok_Function)); - Set_Name_Table_Byte (Name_Generic, Token_Type'Pos (Tok_Generic)); - Set_Name_Table_Byte (Name_Goto, Token_Type'Pos (Tok_Goto)); - Set_Name_Table_Byte (Name_If, Token_Type'Pos (Tok_If)); - Set_Name_Table_Byte (Name_In, Token_Type'Pos (Tok_In)); - Set_Name_Table_Byte (Name_Is, Token_Type'Pos (Tok_Is)); - Set_Name_Table_Byte (Name_Limited, Token_Type'Pos (Tok_Limited)); - Set_Name_Table_Byte (Name_Loop, Token_Type'Pos (Tok_Loop)); - Set_Name_Table_Byte (Name_Mod, Token_Type'Pos (Tok_Mod)); - Set_Name_Table_Byte (Name_New, Token_Type'Pos (Tok_New)); - Set_Name_Table_Byte (Name_Not, Token_Type'Pos (Tok_Not)); - Set_Name_Table_Byte (Name_Null, Token_Type'Pos (Tok_Null)); - Set_Name_Table_Byte (Name_Of, Token_Type'Pos (Tok_Of)); - Set_Name_Table_Byte (Name_Or, Token_Type'Pos (Tok_Or)); - Set_Name_Table_Byte (Name_Others, Token_Type'Pos (Tok_Others)); - Set_Name_Table_Byte (Name_Out, Token_Type'Pos (Tok_Out)); - Set_Name_Table_Byte (Name_Package, Token_Type'Pos (Tok_Package)); - Set_Name_Table_Byte (Name_Pragma, Token_Type'Pos (Tok_Pragma)); - Set_Name_Table_Byte (Name_Private, Token_Type'Pos (Tok_Private)); - Set_Name_Table_Byte (Name_Procedure, Token_Type'Pos (Tok_Procedure)); - Set_Name_Table_Byte (Name_Protected, Token_Type'Pos (Tok_Protected)); - Set_Name_Table_Byte (Name_Raise, Token_Type'Pos (Tok_Raise)); - Set_Name_Table_Byte (Name_Range, Token_Type'Pos (Tok_Range)); - Set_Name_Table_Byte (Name_Record, Token_Type'Pos (Tok_Record)); - Set_Name_Table_Byte (Name_Rem, Token_Type'Pos (Tok_Rem)); - Set_Name_Table_Byte (Name_Renames, Token_Type'Pos (Tok_Renames)); - Set_Name_Table_Byte (Name_Requeue, Token_Type'Pos (Tok_Requeue)); - Set_Name_Table_Byte (Name_Return, Token_Type'Pos (Tok_Return)); - Set_Name_Table_Byte (Name_Reverse, Token_Type'Pos (Tok_Reverse)); - Set_Name_Table_Byte (Name_Select, Token_Type'Pos (Tok_Select)); - Set_Name_Table_Byte (Name_Separate, Token_Type'Pos (Tok_Separate)); - Set_Name_Table_Byte (Name_Subtype, Token_Type'Pos (Tok_Subtype)); - Set_Name_Table_Byte (Name_Tagged, Token_Type'Pos (Tok_Tagged)); - Set_Name_Table_Byte (Name_Task, Token_Type'Pos (Tok_Task)); - Set_Name_Table_Byte (Name_Terminate, Token_Type'Pos (Tok_Terminate)); - Set_Name_Table_Byte (Name_Then, Token_Type'Pos (Tok_Then)); - Set_Name_Table_Byte (Name_Type, Token_Type'Pos (Tok_Type)); - Set_Name_Table_Byte (Name_Until, Token_Type'Pos (Tok_Until)); - Set_Name_Table_Byte (Name_Use, Token_Type'Pos (Tok_Use)); - Set_Name_Table_Byte (Name_When, Token_Type'Pos (Tok_When)); - Set_Name_Table_Byte (Name_While, Token_Type'Pos (Tok_While)); - Set_Name_Table_Byte (Name_With, Token_Type'Pos (Tok_With)); - Set_Name_Table_Byte (Name_Xor, Token_Type'Pos (Tok_Xor)); + -- Establish reserved words + + Set_Reserved (Name_Abort, Tok_Abort); + Set_Reserved (Name_Abs, Tok_Abs); + Set_Reserved (Name_Abstract, Tok_Abstract); + Set_Reserved (Name_Accept, Tok_Accept); + Set_Reserved (Name_Access, Tok_Access); + Set_Reserved (Name_And, Tok_And); + Set_Reserved (Name_Aliased, Tok_Aliased); + Set_Reserved (Name_All, Tok_All); + Set_Reserved (Name_Array, Tok_Array); + Set_Reserved (Name_At, Tok_At); + Set_Reserved (Name_Begin, Tok_Begin); + Set_Reserved (Name_Body, Tok_Body); + Set_Reserved (Name_Case, Tok_Case); + Set_Reserved (Name_Constant, Tok_Constant); + Set_Reserved (Name_Declare, Tok_Declare); + Set_Reserved (Name_Delay, Tok_Delay); + Set_Reserved (Name_Delta, Tok_Delta); + Set_Reserved (Name_Digits, Tok_Digits); + Set_Reserved (Name_Do, Tok_Do); + Set_Reserved (Name_Else, Tok_Else); + Set_Reserved (Name_Elsif, Tok_Elsif); + Set_Reserved (Name_End, Tok_End); + Set_Reserved (Name_Entry, Tok_Entry); + Set_Reserved (Name_Exception, Tok_Exception); + Set_Reserved (Name_Exit, Tok_Exit); + Set_Reserved (Name_For, Tok_For); + Set_Reserved (Name_Function, Tok_Function); + Set_Reserved (Name_Generic, Tok_Generic); + Set_Reserved (Name_Goto, Tok_Goto); + Set_Reserved (Name_If, Tok_If); + Set_Reserved (Name_In, Tok_In); + Set_Reserved (Name_Is, Tok_Is); + Set_Reserved (Name_Limited, Tok_Limited); + Set_Reserved (Name_Loop, Tok_Loop); + Set_Reserved (Name_Mod, Tok_Mod); + Set_Reserved (Name_New, Tok_New); + Set_Reserved (Name_Not, Tok_Not); + Set_Reserved (Name_Null, Tok_Null); + Set_Reserved (Name_Of, Tok_Of); + Set_Reserved (Name_Or, Tok_Or); + Set_Reserved (Name_Others, Tok_Others); + Set_Reserved (Name_Out, Tok_Out); + Set_Reserved (Name_Package, Tok_Package); + Set_Reserved (Name_Pragma, Tok_Pragma); + Set_Reserved (Name_Private, Tok_Private); + Set_Reserved (Name_Procedure, Tok_Procedure); + Set_Reserved (Name_Protected, Tok_Protected); + Set_Reserved (Name_Raise, Tok_Raise); + Set_Reserved (Name_Range, Tok_Range); + Set_Reserved (Name_Record, Tok_Record); + Set_Reserved (Name_Rem, Tok_Rem); + Set_Reserved (Name_Renames, Tok_Renames); + Set_Reserved (Name_Requeue, Tok_Requeue); + Set_Reserved (Name_Return, Tok_Return); + Set_Reserved (Name_Reverse, Tok_Reverse); + Set_Reserved (Name_Select, Tok_Select); + Set_Reserved (Name_Separate, Tok_Separate); + Set_Reserved (Name_Subtype, Tok_Subtype); + Set_Reserved (Name_Tagged, Tok_Tagged); + Set_Reserved (Name_Task, Tok_Task); + Set_Reserved (Name_Terminate, Tok_Terminate); + Set_Reserved (Name_Then, Tok_Then); + Set_Reserved (Name_Type, Tok_Type); + Set_Reserved (Name_Until, Tok_Until); + Set_Reserved (Name_Use, Tok_Use); + Set_Reserved (Name_When, Tok_When); + Set_Reserved (Name_While, Tok_While); + Set_Reserved (Name_With, Tok_With); + Set_Reserved (Name_Xor, Tok_Xor); + + -- Ada 2005 reserved words + + Set_Reserved (Name_Interface, Tok_Interface); + Set_Reserved (Name_Overriding, Tok_Overriding); + Set_Reserved (Name_Synchronized, Tok_Synchronized); -- Initialize scan control variables @@ -246,10 +275,22 @@ package body Scng is procedure Scan is Start_Of_Comment : Source_Ptr; + -- Record start of comment position + + Underline_Found : Boolean; + -- During scanning of an identifier, set to True if last character + -- scanned was an underline or other punctuation character. This + -- is used to flag the error of two underlines/punctuations in a + -- row or ending an identifier with a underline/punctuation. Here + -- punctuation means any UTF_32 character in the Unicode category + -- Punctuation,Connector. + + Wptr : Source_Ptr; + -- Used to remember start of last wide character scanned procedure Check_End_Of_Line; - -- Called when end of line encountered. Checks that line is not - -- too long, and that other style checks for the end of line are met. + -- Called when end of line encountered. Checks that line is not too + -- long, and that other style checks for the end of line are met. function Double_Char_Token (C : Character) return Boolean; -- This function is used for double character tokens like := or <>. It @@ -262,8 +303,8 @@ package body Scng is -- since we do not want a junk message for a case like &-space-&). procedure Error_Illegal_Character; - -- Give illegal character error, Scan_Ptr points to character. - -- On return, Scan_Ptr is bumped past the illegal character. + -- Give illegal character error, Scan_Ptr points to character. On + -- return, Scan_Ptr is bumped past the illegal character. procedure Error_Illegal_Wide_Character; -- Give illegal wide character message. On return, Scan_Ptr is bumped @@ -274,7 +315,8 @@ package body Scng is -- Signal error of excessively long line procedure Error_No_Double_Underline; - -- Signal error of double underline character + -- Signal error of two underline or punctuation characters in a row. + -- Called with Scan_Ptr pointing to second underline/punctuation char. procedure Nlit; -- This is the procedure for scanning out numeric literals. On entry, @@ -353,8 +395,7 @@ package body Scng is procedure Error_Illegal_Wide_Character is begin - Error_Msg_S ("illegal wide character, check -gnatW switch"); - Scan_Ptr := Scan_Ptr + 1; + Error_Msg ("illegal wide character", Wptr); end Error_Illegal_Wide_Character; --------------------- @@ -374,7 +415,28 @@ package body Scng is procedure Error_No_Double_Underline is begin - Error_Msg_S ("two consecutive underlines not permitted"); + Underline_Found := False; + + -- There are four cases, and we special case the messages + + if Source (Scan_Ptr) = '_' then + if Source (Scan_Ptr - 1) = '_' then + Error_Msg_S + ("two consecutive underlines not permitted"); + else + Error_Msg_S + ("underline cannot follow punctuation character"); + end if; + + else + if Source (Scan_Ptr - 1) = '_' then + Error_Msg_S + ("punctuation character cannot follow underline"); + else + Error_Msg_S + ("two consecutive punctuation characters not permitted"); + end if; + end if; end Error_No_Double_Underline; ---------- @@ -425,13 +487,13 @@ package body Scng is -- which the digit was expected on input, and is unchanged on return. procedure Scan_Integer; - -- Procedure to scan integer literal. On entry, Scan_Ptr points to - -- a digit, on exit Scan_Ptr points past the last character of - -- the integer. + -- Procedure to scan integer literal. On entry, Scan_Ptr points to a + -- digit, on exit Scan_Ptr points past the last character of the + -- integer. -- - -- For each digit encountered, UI_Int_Value is multiplied by 10, - -- and the value of the digit added to the result. In addition, - -- the value in Scale is decremented by one for each actual digit + -- For each digit encountered, UI_Int_Value is multiplied by 10, and + -- the value of the digit added to the result. In addition, the + -- value in Scale is decremented by one for each actual digit -- scanned. -------------------------- @@ -464,6 +526,8 @@ package body Scng is Scale := Scale - 1; C := Source (Scan_Ptr); + -- Case of underline encountered + if C = '_' then -- We do not accumulate the '_' in the checksum, so that @@ -486,12 +550,9 @@ package body Scng is exit when C not in '0' .. '9'; end if; end loop; - end Scan_Integer; - ---------------------------------- - -- Start of Processing for Nlit -- - ---------------------------------- + -- Start of Processing for Nlit begin Base := 10; @@ -503,8 +564,8 @@ package body Scng is Point_Scanned := False; UI_Num_Value := UI_Int_Value; - -- Various possibilities now for continuing the literal are - -- period, E/e (for exponent), or :/# (for based literal). + -- Various possibilities now for continuing the literal are period, + -- E/e (for exponent), or :/# (for based literal). Scale := 0; C := Source (Scan_Ptr); @@ -534,11 +595,11 @@ package body Scng is end if; end loop; - -- Based literal case. The base is the value we already scanned. - -- In the case of colon, we insist that the following character - -- is indeed an extended digit or a period. This catches a number - -- of common errors, as well as catching the well known tricky - -- bug otherwise arising from "x : integer range 1 .. 10:= 6;" + -- Based literal case. The base is the value we already scanned. + -- In the case of colon, we insist that the following character + -- is indeed an extended digit or a period. This catches a number + -- of common errors, as well as catching the well known tricky + -- bug otherwise arising from "x : integer range 1 .. 10:= 6;" elsif C = '#' or else (C = ':' and then @@ -561,7 +622,6 @@ package body Scng is end if; end if; - Accumulate_Checksum (C); Base_Char := C; UI_Base := UI_Int_Value; @@ -712,7 +772,7 @@ package body Scng is Den => -UI_Scale, Rbase => Base); - -- Case of integer literal to be returned + -- Case of integer literal to be returned else Token := Tok_Integer_Literal; @@ -720,9 +780,9 @@ package body Scng is if UI_Scale = 0 then Int_Literal_Value := UI_Num_Value; - -- Avoid doing possibly expensive calculations in cases like - -- parsing 163E800_000# when semantics will not be done anyway. - -- This is especially useful when parsing garbled input. + -- Avoid doing possibly expensive calculations in cases like + -- parsing 163E800_000# when semantics will not be done anyway. + -- This is especially useful when parsing garbled input. elsif Operating_Mode /= Check_Syntax and then (Serious_Errors_Detected = 0 or else Try_Semantics) @@ -731,15 +791,12 @@ package body Scng is else Int_Literal_Value := No_Uint; - end if; - end if; Accumulate_Token_Checksum; return; - end Nlit; ---------- @@ -762,8 +819,8 @@ package body Scng is procedure Error_Bad_String_Char; -- Signal bad character in string/character literal. On entry - -- Scan_Ptr points to the improper character encountered during - -- the scan. Scan_Ptr is not modified, so it still points to the bad + -- Scan_Ptr points to the improper character encountered during the + -- scan. Scan_Ptr is not modified, so it still points to the bad -- character on return. procedure Error_Unterminated_String; @@ -773,11 +830,11 @@ package body Scng is procedure Set_String; -- Procedure used to distinguish between string and operator symbol. - -- On entry the string has been scanned out, and its characters start - -- at Token_Ptr and end one character before Scan_Ptr. On exit Token - -- is set to Tok_String_Literal or Tok_Operator_Symbol as - -- appropriate, and Token_Node is appropriately initialized. - -- In addition, in the operator symbol case, Token_Name is + -- On entry the string has been scanned out, and its characters + -- start at Token_Ptr and end one character before Scan_Ptr. On exit + -- Token is set to Tok_String_Literal or Tok_Operator_Symbol as + -- appropriate, and Token_Node is appropriately initialized. In + -- addition, in the operator symbol case, Token_Name is -- appropriately set. --------------------------- @@ -981,9 +1038,9 @@ package body Scng is end if; - -- If it is an operator symbol, then Token_Name is set. - -- If it is some other string value, then Token_Name still - -- contains Error_Name. + -- If it is an operator symbol, then Token_Name is set. If it is + -- some other string value, then Token_Name still contains + -- Error_Name. if Token_Name = Error_Name then Token := Tok_String_Literal; @@ -991,18 +1048,15 @@ package body Scng is else Token := Tok_Operator_Symbol; end if; - end Set_String; - ---------- - -- Slit -- - ---------- + -- Start of processing for Slit begin -- On entry, Scan_Ptr points to the opening character of the string - -- which is either a percent, double quote, or apostrophe - -- (single quote). The latter case is an error detected by - -- the character literal circuit. + -- which is either a percent, double quote, or apostrophe (single + -- quote). The latter case is an error detected by the character + -- literal circuit. Delimiter := Source (Scan_Ptr); Accumulate_Checksum (Delimiter); @@ -1030,28 +1084,32 @@ package body Scng is Scan_Ptr := Scan_Ptr + 1; elsif (C = ESC - and then - Wide_Character_Encoding_Method - in WC_ESC_Encoding_Method) - or else - (C in Upper_Half_Character - and then - Upper_Half_Encoding) - or else - (C = '[' - and then - Source (Scan_Ptr + 1) = '"' - and then - Identifier_Char (Source (Scan_Ptr + 2))) + and then Wide_Character_Encoding_Method + in WC_ESC_Encoding_Method) + or else (C in Upper_Half_Character + and then Upper_Half_Encoding) + or else (C = '[' + and then Source (Scan_Ptr + 1) = '"' + and then Identifier_Char (Source (Scan_Ptr + 2))) then + Wptr := Scan_Ptr; Scan_Wide (Source, Scan_Ptr, Code, Err); - Accumulate_Checksum (Code); if Err then Error_Illegal_Wide_Character; Code := Get_Char_Code (' '); end if; + Accumulate_Checksum (Code); + + if Ada_Version >= Ada_05 + and then Is_UTF_32_Non_Graphic (Code) + then + Error_Msg + ("(Ada 2005) non-graphic character not permitted " & + "in string literal", Wptr); + end if; + else Accumulate_Checksum (C); @@ -1085,10 +1143,9 @@ package body Scng is String_Literal_Id := End_String; Set_String; return; - end Slit; - -- Start of body of Scan + -- Start of processing for Scan begin Prev_Token := Token; @@ -1100,11 +1157,12 @@ package body Scng is -- encountered and skipped, or some error situation, such as an -- illegal character, is encountered. + <<Scan_Next_Character>> + loop -- Skip past blanks, loop is opened up for speed while Source (Scan_Ptr) = ' ' loop - if Source (Scan_Ptr + 1) /= ' ' then Scan_Ptr := Scan_Ptr + 1; exit; @@ -1148,50 +1206,15 @@ package body Scng is Token_Ptr := Scan_Ptr; - -- Here begins the main case statement which transfers control on - -- the basis of the non-blank character we have encountered. + -- Here begins the main case statement which transfers control on the + -- basis of the non-blank character we have encountered. case Source (Scan_Ptr) is -- Line terminator characters - when CR | LF | FF | VT => Line_Terminator_Case : begin - - -- Check line too long - - Check_End_Of_Line; - - -- Set Token_Ptr, if End_Of_Line is a token, for the case when - -- it is a physical line. - - if End_Of_Line_Is_Token then - Token_Ptr := Scan_Ptr; - end if; - - declare - Physical : Boolean; - - begin - Skip_Line_Terminators (Scan_Ptr, Physical); - - -- If we are at start of physical line, update scan pointers - -- to reflect the start of the new line. - - if Physical then - Current_Line_Start := Scan_Ptr; - Start_Column := Set_Start_Column; - First_Non_Blank_Location := Scan_Ptr; - - -- If End_Of_Line is a token, we return it as it is - -- a physical line. - - if End_Of_Line_Is_Token then - Token := Tok_End_Of_Line; - return; - end if; - end if; - end; - end Line_Terminator_Case; + when CR | LF | FF | VT => + goto Scan_Line_Terminator; -- Horizontal tab, just skip past it @@ -1199,15 +1222,14 @@ package body Scng is if Style_Check then Style.Check_HT; end if; Scan_Ptr := Scan_Ptr + 1; - -- End of file character, treated as an end of file only if it - -- is the last character in the buffer, otherwise it is ignored. + -- End of file character, treated as an end of file only if it is + -- the last character in the buffer, otherwise it is ignored. when EOF => if Scan_Ptr = Source_Last (Current_Source_File) then Check_End_Of_Line; Token := Tok_EOF; return; - else Scan_Ptr := Scan_Ptr + 1; end if; @@ -1229,8 +1251,8 @@ package body Scng is return; end if; - -- Asterisk (can be multiplication operator or double asterisk - -- which is the exponentiation compound delimiter). + -- Asterisk (can be multiplication operator or double asterisk which + -- is the exponentiation compound delimiter). when '*' => Accumulate_Checksum ('*'); @@ -1286,8 +1308,7 @@ package body Scng is when '[' => if Source (Scan_Ptr + 1) = '"' then - Name_Len := 0; - goto Scan_Identifier; + goto Scan_Wide_Character; else Error_Msg_S ("illegal character, replaced by ""("""); @@ -1313,9 +1334,9 @@ package body Scng is if Style_Check then Style.Check_Comma; end if; return; - -- Dot, which is either an isolated period, or part of a double - -- dot compound delimiter sequence. We also check for the case of - -- a digit following the period, to give a better error message. + -- Dot, which is either an isolated period, or part of a double dot + -- compound delimiter sequence. We also check for the case of a + -- digit following the period, to give a better error message. when '.' => Accumulate_Checksum ('.'); @@ -1430,6 +1451,15 @@ package body Scng is loop -- Scan to non graphic character (opened up for speed) + -- Note that we just eat left brackets, which means that + -- bracket notation cannot be used for end of line + -- characters in comments. This seems a reasonable choice, + -- since no one would ever use brackets notation in a real + -- program in this situation, and if we allow brackets + -- notation, we forbid some valid comments which contain a + -- brackets sequence that happens to match an end of line + -- character. + loop exit when Source (Scan_Ptr) not in Graphic_Character; Scan_Ptr := Scan_Ptr + 1; @@ -1460,13 +1490,44 @@ package body Scng is elsif Source (Scan_Ptr) = EOF then exit; + -- If we have a wide character, we have to scan it out, + -- because it might be a legitimate line terminator + + elsif (Source (Scan_Ptr) = ESC + and then Identifier_Char (ESC)) + or else + (Source (Scan_Ptr) in Upper_Half_Character + and then Upper_Half_Encoding) + then + declare + Wptr : constant Source_Ptr := Scan_Ptr; + Code : Char_Code; + Err : Boolean; + + begin + Scan_Wide (Source, Scan_Ptr, Code, Err); + + -- If not well formed wide character, then just skip + -- past it and ignore it. + + if Err then + Scan_Ptr := Wptr + 1; + + -- If UTF_32 terminator, terminate comment scan + + elsif Is_UTF_32_Line_Terminator (Code) then + Scan_Ptr := Wptr; + exit; + end if; + end; + -- Keep going if character in 80-FF range, or is ESC. These -- characters are allowed in comments by RM-2.1(1), 2.7(2). -- They are allowed even in Ada 83 mode according to the -- approved AI. ESC was added to the AI in June 93. elsif Source (Scan_Ptr) in Upper_Half_Character - or else Source (Scan_Ptr) = ESC + or else Source (Scan_Ptr) = ESC then Scan_Ptr := Scan_Ptr + 1; @@ -1475,7 +1536,6 @@ package body Scng is else Error_Illegal_Character; end if; - end loop; -- Note that, except when comments are tokens, we do NOT @@ -1538,10 +1598,10 @@ package body Scng is -- Here is where we make the test to distinguish the cases. Treat -- as apostrophe if previous token is an identifier, right paren -- or the reserved word "all" (latter case as in A.all'Address) - -- (or the reserved word "project" in project files). - -- Also treat it as apostrophe after a literal (this catches - -- some legitimate cases, like A."abs"'Address, and also gives - -- better error behavior for impossible cases like 123'xxx). + -- (or the reserved word "project" in project files). Also treat + -- it as apostrophe after a literal (this catches some legitimate + -- cases, like A."abs"'Address, and also gives better error + -- behavior for impossible cases like 123'xxx). if Prev_Token = Tok_Identifier or else Prev_Token = Tok_Right_Paren @@ -1556,7 +1616,7 @@ package body Scng is -- Otherwise the apostrophe starts a character literal else - -- Case of wide character literal with ESC or [ encoding + -- Case of wide character literal if (Source (Scan_Ptr) = ESC and then @@ -1570,11 +1630,20 @@ package body Scng is and then Source (Scan_Ptr + 1) = '"') then + Wptr := Scan_Ptr; Scan_Wide (Source, Scan_Ptr, Code, Err); Accumulate_Checksum (Code); if Err then Error_Illegal_Wide_Character; + Code := Character'Pos (' '); + + elsif Ada_Version >= Ada_05 + and then Is_UTF_32_Non_Graphic (Code) + then + Error_Msg + ("(Ada 2005) non-graphic character not permitted " & + "in character literal", Wptr); end if; if Source (Scan_Ptr) /= ''' then @@ -1590,7 +1659,6 @@ package body Scng is -- apostrophe instead since this gives better error recovery elsif Source (Scan_Ptr + 1) /= ''' then - if Prev_Token = Tok_Range then Token := Tok_Apostrophe; return; @@ -1722,7 +1790,6 @@ package body Scng is Token := Tok_Vertical_Bar; return; end if; - end Exclamation_Case; -- Plus @@ -1750,6 +1817,7 @@ package body Scng is when 'a' .. 'z' => Name_Len := 1; + Underline_Found := False; Name_Buffer (1) := Source (Scan_Ptr); Accumulate_Checksum (Name_Buffer (1)); Scan_Ptr := Scan_Ptr + 1; @@ -1759,6 +1827,7 @@ package body Scng is when 'A' .. 'Z' => Name_Len := 1; + Underline_Found := False; Name_Buffer (1) := Character'Val (Character'Pos (Source (Scan_Ptr)) + 32); Accumulate_Checksum (Name_Buffer (1)); @@ -1780,6 +1849,7 @@ package body Scng is Name_Len := 1; Name_Buffer (1) := '_'; Scan_Ptr := Scan_Ptr + 1; + Underline_Found := False; goto Scan_Identifier; -- Space (not possible, because we scanned past blanks) @@ -1791,23 +1861,21 @@ package body Scng is when Upper_Half_Character => - -- Wide character case. Note that Scan_Identifier will issue - -- an appropriate message if wide characters are not allowed - -- in identifiers. + -- Wide character case if Upper_Half_Encoding then - Name_Len := 0; - goto Scan_Identifier; + goto Scan_Wide_Character; -- Otherwise we have OK Latin-1 character else -- Upper half characters may possibly be identifier letters - -- but can never be digits, so Identifier_Char can be used - -- to test for a valid start of identifier character. + -- but can never be digits, so Identifier_Char can be used to + -- test for a valid start of identifier character. if Identifier_Char (Source (Scan_Ptr)) then Name_Len := 0; + Underline_Found := False; goto Scan_Identifier; else Error_Illegal_Character; @@ -1819,13 +1887,14 @@ package body Scng is -- ESC character, possible start of identifier if wide characters -- using ESC encoding are allowed in identifiers, which we can -- tell by looking at the Identifier_Char flag for ESC, which is - -- only true if these conditions are met. + -- only true if these conditions are met. In Ada 2005 mode, may + -- also be valid UTF_32 space or line terminator character. if Identifier_Char (ESC) then Name_Len := 0; - goto Scan_Identifier; + goto Scan_Wide_Character; else - Error_Illegal_Wide_Character; + Error_Illegal_Character; end if; -- Invalid control characters @@ -1839,6 +1908,7 @@ package body Scng is -- Invalid graphic characters when '#' | '$' | '?' | '@' | '`' | '\' | '^' | '~' => + -- If Set_Special_Character has been called for this character, -- set Scans.Special_Character and return a Special token. @@ -1849,7 +1919,7 @@ package body Scng is Scan_Ptr := Scan_Ptr + 1; return; - -- otherwise, this is an illegal character + -- Otherwise, this is an illegal character else Error_Illegal_Character; @@ -1865,95 +1935,177 @@ package body Scng is end loop; - -- Identifier scanning routine. On entry, some initial characters - -- of the identifier may have already been stored in Name_Buffer. - -- If so, Name_Len has the number of characters stored. otherwise - -- Name_Len is set to zero on entry. + -- Wide_Character scanning routine. On entry we have encountered the + -- initial character of a wide character sequence. - <<Scan_Identifier>> + <<Scan_Wide_Character>> - -- This loop scans as fast as possible past lower half letters - -- and digits, which we expect to be the most common characters. + declare + Code : Char_Code; + Err : Boolean; - loop - if Source (Scan_Ptr) in 'a' .. 'z' - or else Source (Scan_Ptr) in '0' .. '9' - then - Name_Buffer (Name_Len + 1) := Source (Scan_Ptr); - Accumulate_Checksum (Source (Scan_Ptr)); + begin + Wptr := Scan_Ptr; + Scan_Wide (Source, Scan_Ptr, Code, Err); - elsif Source (Scan_Ptr) in 'A' .. 'Z' then - Name_Buffer (Name_Len + 1) := - Character'Val (Character'Pos (Source (Scan_Ptr)) + 32); - Accumulate_Checksum (Name_Buffer (Name_Len + 1)); - else - exit; - end if; + -- If bad wide character, signal error and continue scan - -- Open out the loop a couple of times for speed + if Err then + Error_Illegal_Wide_Character; + goto Scan_Next_Character; - if Source (Scan_Ptr + 1) in 'a' .. 'z' - or else Source (Scan_Ptr + 1) in '0' .. '9' - then - Name_Buffer (Name_Len + 2) := Source (Scan_Ptr + 1); - Accumulate_Checksum (Source (Scan_Ptr + 1)); + -- If OK letter, reset scan ptr and go scan identifier + + elsif Is_UTF_32_Letter (Code) then + Scan_Ptr := Wptr; + Name_Len := 0; + Underline_Found := False; + goto Scan_Identifier; - elsif Source (Scan_Ptr + 1) in 'A' .. 'Z' then - Name_Buffer (Name_Len + 2) := - Character'Val (Character'Pos (Source (Scan_Ptr + 1)) + 32); - Accumulate_Checksum (Name_Buffer (Name_Len + 2)); + -- If OK wide space, ignore and keep scanning (we do not include + -- any ignored spaces in checksum) + + elsif Is_UTF_32_Space (Code) then + goto Scan_Next_Character; + + -- If OK wide line terminator, terminate current line + + elsif Is_UTF_32_Line_Terminator (Code) then + Scan_Ptr := Wptr; + goto Scan_Line_Terminator; + + -- Punctuation is an error (at start of identifier) + + elsif Is_UTF_32_Punctuation (Code) then + Error_Msg + ("identifier cannot start with punctuation", Wptr); + Scan_Ptr := Wptr; + Name_Len := 0; + Underline_Found := False; + goto Scan_Identifier; + + -- Mark character is an error (at start of identifer) + + elsif Is_UTF_32_Mark (Code) then + Error_Msg + ("identifier cannot start with mark character", Wptr); + Scan_Ptr := Wptr; + Name_Len := 0; + Underline_Found := False; + goto Scan_Identifier; + + -- Other format character is an error (at start of identifer) + + elsif Is_UTF_32_Other (Code) then + Error_Msg + ("identifier cannot start with other format character", Wptr); + Scan_Ptr := Wptr; + Name_Len := 0; + Underline_Found := False; + goto Scan_Identifier; + + -- Extended digit character is an error. Could be bad start of + -- identifier or bad literal. Not worth doing too much to try to + -- distinguish these cases, but we will do a little bit. + + elsif Is_UTF_32_Digit (Code) then + Error_Msg + ("identifier cannot start with digit character", Wptr); + Scan_Ptr := Wptr; + Name_Len := 0; + Underline_Found := False; + goto Scan_Identifier; + + -- All other wide characters are illegal here else - Scan_Ptr := Scan_Ptr + 1; - Name_Len := Name_Len + 1; - exit; + Error_Illegal_Wide_Character; + goto Scan_Next_Character; end if; + end; - if Source (Scan_Ptr + 2) in 'a' .. 'z' - or else Source (Scan_Ptr + 2) in '0' .. '9' - then - Name_Buffer (Name_Len + 3) := Source (Scan_Ptr + 2); - Accumulate_Checksum (Source (Scan_Ptr + 2)); + -- Routine to scan line terminator. On entry Scan_Ptr points to a + -- character which is one of FF,LR,CR,VT, or one of the wide characters + -- that is treated as a line termiantor. - elsif Source (Scan_Ptr + 2) in 'A' .. 'Z' then - Name_Buffer (Name_Len + 3) := - Character'Val (Character'Pos (Source (Scan_Ptr + 2)) + 32); - Accumulate_Checksum (Name_Buffer (Name_Len + 3)); - else - Scan_Ptr := Scan_Ptr + 2; - Name_Len := Name_Len + 2; - exit; + <<Scan_Line_Terminator>> + + -- Check line too long + + Check_End_Of_Line; + + -- Set Token_Ptr, if End_Of_Line is a token, for the case when it is + -- a physical line. + + if End_Of_Line_Is_Token then + Token_Ptr := Scan_Ptr; + end if; + + declare + Physical : Boolean; + + begin + Skip_Line_Terminators (Scan_Ptr, Physical); + + -- If we are at start of physical line, update scan pointers to + -- reflect the start of the new line. + + if Physical then + Current_Line_Start := Scan_Ptr; + Start_Column := Set_Start_Column; + First_Non_Blank_Location := Scan_Ptr; + + -- If End_Of_Line is a token, we return it as it is a + -- physical line. + + if End_Of_Line_Is_Token then + Token := Tok_End_Of_Line; + return; + end if; end if; + end; + + goto Scan_Next_Character; - if Source (Scan_Ptr + 3) in 'a' .. 'z' - or else Source (Scan_Ptr + 3) in '0' .. '9' + -- Identifier scanning routine. On entry, some initial characters of + -- the identifier may have already been stored in Name_Buffer. If so, + -- Name_Len has the number of characters stored. otherwise Name_Len is + -- set to zero on entry. Underline_Found is also set False on entry. + + <<Scan_Identifier>> + + -- This loop scans as fast as possible past lower half letters and + -- digits, which we expect to be the most common characters. + + loop + if Source (Scan_Ptr) in 'a' .. 'z' + or else Source (Scan_Ptr) in '0' .. '9' then - Name_Buffer (Name_Len + 4) := Source (Scan_Ptr + 3); - Accumulate_Checksum (Source (Scan_Ptr + 3)); + Name_Buffer (Name_Len + 1) := Source (Scan_Ptr); + Accumulate_Checksum (Source (Scan_Ptr)); - elsif Source (Scan_Ptr + 3) in 'A' .. 'Z' then - Name_Buffer (Name_Len + 4) := - Character'Val (Character'Pos (Source (Scan_Ptr + 3)) + 32); - Accumulate_Checksum (Name_Buffer (Name_Len + 4)); + elsif Source (Scan_Ptr) in 'A' .. 'Z' then + Name_Buffer (Name_Len + 1) := + Character'Val (Character'Pos (Source (Scan_Ptr)) + 32); + Accumulate_Checksum (Name_Buffer (Name_Len + 1)); else - Scan_Ptr := Scan_Ptr + 3; - Name_Len := Name_Len + 3; exit; end if; - Scan_Ptr := Scan_Ptr + 4; - Name_Len := Name_Len + 4; + Underline_Found := False; + Scan_Ptr := Scan_Ptr + 1; + Name_Len := Name_Len + 1; end loop; -- If we fall through, then we have encountered either an underline -- character, or an extended identifier character (i.e. one from the - -- upper half), or a wide character, or an identifier terminator. - -- The initial test speeds us up in the most common case where we - -- have an identifier terminator. Note that ESC is an identifier - -- character only if a wide character encoding method that uses - -- ESC encoding is active, so if we find an ESC character we know - -- that we have a wide character. + -- upper half), or a wide character, or an identifier terminator. The + -- initial test speeds us up in the most common case where we have + -- an identifier terminator. Note that ESC is an identifier character + -- only if a wide character encoding method that uses ESC encoding + -- is active, so if we find an ESC character we know that we have a + -- wide character. if Identifier_Char (Source (Scan_Ptr)) then @@ -1962,22 +2114,10 @@ package body Scng is if Source (Scan_Ptr) = '_' then Accumulate_Checksum ('_'); - -- Check error case of identifier ending with underscore - -- In this case we ignore the underscore and do not store it. - - if not Identifier_Char (Source (Scan_Ptr + 1)) then - Error_Msg_S ("identifier cannot end with underline"); - Scan_Ptr := Scan_Ptr + 1; - - -- Check error case of two underscores. In this case we do - -- not store the first underscore (we will store the second) - - elsif Source (Scan_Ptr + 1) = '_' then - Error_No_Double_Underline; - - -- Normal case of legal underscore - + if Underline_Found then + Error_No_Double_Underline; else + Underline_Found := True; Name_Len := Name_Len + 1; Name_Buffer (Name_Len) := '_'; end if; @@ -1994,6 +2134,7 @@ package body Scng is Store_Encoded_Character (Get_Char_Code (Fold_Lower (Source (Scan_Ptr)))); Scan_Ptr := Scan_Ptr + 1; + Underline_Found := False; goto Scan_Identifier; -- Left bracket not followed by a quote terminates an identifier. @@ -2014,12 +2155,12 @@ package body Scng is -- encoding into the name table entry for the identifier. declare - Sptr : constant Source_Ptr := Scan_Ptr; - Code : Char_Code; - Err : Boolean; - Chr : Character; + Code : Char_Code; + Err : Boolean; + Chr : Character; begin + Wptr := Scan_Ptr; Scan_Wide (Source, Scan_Ptr, Code, Err); -- If error, signal error @@ -2037,19 +2178,16 @@ package body Scng is Accumulate_Checksum (Chr); Store_Encoded_Character (Get_Char_Code (Fold_Lower (Chr))); + Underline_Found := False; - -- Character is not normal identifier character, store - -- it in encoded form. + -- Here if not a normal identifier character else - Accumulate_Checksum (Code); - Store_Encoded_Character (Code); - -- Make sure we are allowing wide characters in -- identifiers. Note that we allow wide character - -- notation for an OK identifier character. This - -- in particular allows bracket or other notation - -- to be used for upper half letters. + -- notation for an OK identifier character. This in + -- particular allows bracket or other notation to be + -- used for upper half letters. -- Wide characters are always allowed in Ada 2005 @@ -2057,32 +2195,110 @@ package body Scng is and then Ada_Version < Ada_05 then Error_Msg - ("wide character not allowed in identifier", Sptr); + ("wide character not allowed in identifier", Wptr); + end if; + + -- If OK letter, store it folding to upper case. Note + -- that we include the folded letter in the checksum. + + if Is_UTF_32_Letter (Code) then + Code := UTF_32_To_Upper_Case (Code); + Accumulate_Checksum (Code); + Store_Encoded_Character (Code); + Underline_Found := False; + + -- If OK extended digit or mark, then store it + + elsif Is_UTF_32_Digit (Code) + or else Is_UTF_32_Mark (Code) + then + Accumulate_Checksum (Code); + Store_Encoded_Character (Code); + Underline_Found := False; + + -- Wide punctuation is also stored, but counts as an + -- underline character for error checking purposes. + + elsif Is_UTF_32_Punctuation (Code) then + Accumulate_Checksum (Code); + + if Underline_Found then + declare + Cend : constant Source_Ptr := Scan_Ptr; + begin + Scan_Ptr := Wptr; + Error_No_Double_Underline; + Scan_Ptr := Cend; + end; + + else + Store_Encoded_Character (Code); + Underline_Found := True; + end if; + + -- Wide character in Unicode cateogory "Other, Format" + -- is accepted in an identifier, but is ignored and not + -- stored. It seems reasonable to exclude it from the + -- checksum. + + elsif Is_UTF_32_Other (Code) then + null; + + -- Wide character in category Separator,Space terminates + + elsif Is_UTF_32_Space (Code) then + goto Scan_Identifier_Complete; + + -- Any other wide character is not acceptable + + else + Error_Msg + ("invalid wide character in identifier", Wptr); end if; end if; - end; - goto Scan_Identifier; + goto Scan_Identifier; + end; end if; end if; - -- Scan of identifier is complete. The identifier is stored in - -- Name_Buffer, and Scan_Ptr points past the last character. + -- Scan of identifier is complete. The identifier is stored in + -- Name_Buffer, and Scan_Ptr points past the last character. + <<Scan_Identifier_Complete>> Token_Name := Name_Find; + -- Check for identifier ending with underline or punctuation char + + if Underline_Found then + Underline_Found := False; + + if Source (Scan_Ptr - 1) = '_' then + Error_Msg + ("identifier cannot end with underline", Scan_Ptr - 1); + else + Error_Msg + ("identifier cannot end with punctuation character", Wptr); + end if; + end if; + -- Here is where we check if it was a keyword if Get_Name_Table_Byte (Token_Name) /= 0 and then (Ada_Version >= Ada_95 or else Token_Name not in Ada_95_Reserved_Words) + and then (Ada_Version >= Ada_05 + or else Token_Name not in Ada_2005_Reserved_Words) then Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name)); - -- Deal with possible style check for non-lower case keyword, - -- but we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords - -- for this purpose if they appear as attribute designators. - -- Actually we only check the first character for speed. + -- Deal with possible style check for non-lower case keyword, but + -- we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords for + -- this purpose if they appear as attribute designators. Actually + -- we only check the first character for speed. + + -- Ada 2005 (AI-284): Do not apply the style check in case of + -- "pragma Interface" if Style_Check and then Source (Token_Ptr) <= 'Z' @@ -2092,14 +2308,18 @@ package body Scng is and then Token /= Tok_Delta and then Token /= Tok_Digits and then Token /= Tok_Range)) + and then (Token /= Tok_Interface + or else + (Token = Tok_Interface + and then Prev_Token /= Tok_Pragma)) then Style.Non_Lower_Case_Keyword; end if; - -- We must reset Token_Name since this is not an identifier - -- and if we leave Token_Name set, the parser gets confused - -- because it thinks it is dealing with an identifier instead - -- of the corresponding keyword. + -- We must reset Token_Name since this is not an identifier and + -- if we leave Token_Name set, the parser gets confused because + -- it thinks it is dealing with an identifier instead of the + -- corresponding keyword. Token_Name := No_Name; Accumulate_Token_Checksum; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 44c80e0910f..aa7cddff6a1 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -837,7 +837,10 @@ package body Sem_Aggr is C := Get_String_Char (Str, J); Set_Character_Literal_Name (C); - C_Node := Make_Character_Literal (P, Name_Find, C); + C_Node := + Make_Character_Literal (P, + Chars => Name_Find, + Char_Literal_Value => UI_From_CC (C)); Set_Etype (C_Node, Any_Character); Append_To (Exprs, C_Node); @@ -915,8 +918,10 @@ package body Sem_Aggr is if Number_Dimensions (Typ) = 1 and then (Root_Type (Component_Type (Typ)) = Standard_Character - or else - Root_Type (Component_Type (Typ)) = Standard_Wide_Character) + or else + Root_Type (Component_Type (Typ)) = Standard_Wide_Character + or else + Root_Type (Component_Type (Typ)) = Standard_Wide_Wide_Character) and then No (Component_Associations (N)) and then not Is_Limited_Composite (Typ) and then not Is_Private_Composite (Typ) @@ -939,7 +944,7 @@ package body Sem_Aggr is Expr := First (Expressions (N)); while Present (Expr) loop - Store_String_Char (Char_Literal_Value (Expr)); + Store_String_Char (UI_To_CC (Char_Literal_Value (Expr))); Next (Expr); end loop; @@ -1672,7 +1677,9 @@ package body Sem_Aggr is -- Ada 2005 (AI-231) - Check_Can_Never_Be_Null (N, Expression (Assoc)); + if Ada_Version >= Ada_05 then + Check_Can_Never_Be_Null (Etype (N), Expression (Assoc)); + end if; -- Ada 2005 (AI-287): In case of default initialized component -- we delay the resolution to the expansion phase @@ -1798,7 +1805,11 @@ package body Sem_Aggr is while Present (Expr) loop Nb_Elements := Nb_Elements + 1; - Check_Can_Never_Be_Null (N, Expr); -- Ada 2005 (AI-231) + -- Ada 2005 (AI-231) + + if Ada_Version >= Ada_05 then + Check_Can_Never_Be_Null (Etype (N), Expr); + end if; if not Resolve_Aggr_Expr (Expr, Single_Elmt => True) then return Failure; @@ -1810,8 +1821,12 @@ package body Sem_Aggr is if Others_Present then Assoc := Last (Component_Associations (N)); - Check_Can_Never_Be_Null - (N, Expression (Assoc)); -- Ada 2005 (AI-231) + -- Ada 2005 (AI-231) + + if Ada_Version >= Ada_05 then + Check_Can_Never_Be_Null + (Etype (N), Expression (Assoc)); + end if; -- Ada 2005 (AI-287): In case of default initialized component -- we delay the resolution to the expansion phase. @@ -2051,6 +2066,9 @@ package body Sem_Aggr is -- less which ancestor). It is not possible to determine the -- required components of the extension part. + -- This check implements AI-306, which in fact was motivated + -- by an ACT query to the ARG after this test was added. + Error_Msg_N ("ancestor part must be statically tagged", A); else Resolve_Record_Aggregate (N, Typ); @@ -2358,13 +2376,9 @@ package body Sem_Aggr is -- Ada 2005 (AI-231) if Ada_Version >= Ada_05 - and then Present (Expression (Assoc)) and then Nkind (Expression (Assoc)) = N_Null - and then Can_Never_Be_Null (Compon) then - Error_Msg_N - ("(Ada 2005) NULL not allowed in null-excluding " & - "components", Expression (Assoc)); + Check_Can_Never_Be_Null (Compon, Expression (Assoc)); end if; -- We need to duplicate the expression when several @@ -2679,13 +2693,8 @@ package body Sem_Aggr is -- Ada 2005 (AI-231) - if Ada_Version >= Ada_05 - and then Nkind (Positional_Expr) = N_Null - and then Can_Never_Be_Null (Discrim) - then - Error_Msg_N - ("(Ada 2005) NULL not allowed in null-excluding " & - "components", Positional_Expr); + if Ada_Version >= Ada_05 then + Check_Can_Never_Be_Null (Discrim, Positional_Expr); end if; Next (Positional_Expr); @@ -2921,13 +2930,8 @@ package body Sem_Aggr is -- Ada 2005 (AI-231) - if Ada_Version >= Ada_05 - and then Nkind (Positional_Expr) = N_Null - and then Can_Never_Be_Null (Component) - then - Error_Msg_N - ("(Ada 2005) NULL not allowed in null-excluding components", - Positional_Expr); + if Ada_Version >= Ada_05 then + Check_Can_Never_Be_Null (Component, Positional_Expr); end if; if Present (Get_Value (Component, Component_Associations (N))) then @@ -3081,12 +3085,17 @@ package body Sem_Aggr is procedure Check_Can_Never_Be_Null (N : Node_Id; Expr : Node_Id) is begin - if Ada_Version >= Ada_05 - and then Nkind (Expr) = N_Null - and then Can_Never_Be_Null (Etype (N)) + pragma Assert (Ada_Version >= Ada_05); + + if Nkind (Expr) = N_Null + and then Can_Never_Be_Null (N) then - Error_Msg_N - ("(Ada 2005) NULL not allowed in null-excluding components", Expr); + Apply_Compile_Time_Constraint_Error + (N => Expr, + Msg => "(Ada 2005) NULL not allowed in" + & " null-excluding components?", + Reason => CE_Null_Not_Allowed, + Rep => False); end if; end Check_Can_Never_Be_Null; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 553fb7138a1..8780f6b08f8 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -3458,6 +3458,22 @@ package body Sem_Attr is when Attribute_Storage_Unit => Standard_Attribute (Ttypes.System_Storage_Unit); + ----------------- + -- Stream_Size -- + ----------------- + + when Attribute_Stream_Size => + Check_E0; + Check_Type; + + if Is_Entity_Name (P) + and then Is_Elementary_Type (Entity (P)) + then + Set_Etype (N, Universal_Integer); + else + Error_Attr ("invalid prefix for % attribute", P); + end if; + ---------- -- Succ -- ---------- @@ -3801,6 +3817,19 @@ package body Sem_Attr is Validate_Non_Static_Attribute_Function_Call; end Wide_Image; + --------------------- + -- Wide_Wide_Image -- + --------------------- + + when Attribute_Wide_Wide_Image => Wide_Wide_Image : + begin + Check_Scalar_Type; + Set_Etype (N, Standard_Wide_Wide_String); + Check_E1; + Resolve (E1, P_Base_Type); + Validate_Non_Static_Attribute_Function_Call; + end Wide_Wide_Image; + ---------------- -- Wide_Value -- ---------------- @@ -3817,6 +3846,31 @@ package body Sem_Attr is Validate_Non_Static_Attribute_Function_Call; end Wide_Value; + --------------------- + -- Wide_Wide_Value -- + --------------------- + + when Attribute_Wide_Wide_Value => Wide_Wide_Value : + begin + Check_E1; + Check_Scalar_Type; + + -- Set Etype before resolving expression because expansion + -- of expression may require enclosing type. + + Set_Etype (N, P_Type); + Validate_Non_Static_Attribute_Function_Call; + end Wide_Wide_Value; + + --------------------- + -- Wide_Wide_Width -- + --------------------- + + when Attribute_Wide_Wide_Width => + Check_E0; + Check_Scalar_Type; + Set_Etype (N, Universal_Integer); + ---------------- -- Wide_Width -- ---------------- @@ -4919,12 +4973,12 @@ package body Sem_Attr is when Attribute_Enum_Rep => - -- For an enumeration type with a non-standard representation - -- use the Enumeration_Rep field of the proper constant. Note - -- that this would not work for types Character/Wide_Character, - -- since no real entities are created for the enumeration - -- literals, but that does not matter since these two types - -- do not have non-standard representations anyway. + -- For an enumeration type with a non-standard representation use + -- the Enumeration_Rep field of the proper constant. Note that this + -- will not work for types Character/Wide_[Wide-]Character, since no + -- real entities are created for the enumeration literals, but that + -- does not matter since these two types do not have non-standard + -- representations anyway. if Is_Enumeration_Type (P_Type) and then Has_Non_Standard_Rep (P_Type) @@ -5653,11 +5707,23 @@ package body Sem_Attr is -- Remainder -- --------------- - when Attribute_Remainder => - Fold_Ureal (N, - Eval_Fat.Remainder - (P_Root_Type, Expr_Value_R (E1), Expr_Value_R (E2)), - Static); + when Attribute_Remainder => Remainder : declare + X : constant Ureal := Expr_Value_R (E1); + Y : constant Ureal := Expr_Value_R (E2); + + begin + if UR_Is_Zero (Y) then + Apply_Compile_Time_Constraint_Error + (N, "division by zero in Remainder", + CE_Overflow_Check_Failed, + Warn => not Static); + + Check_Expressions; + return; + end if; + + Fold_Ureal (N, Eval_Fat.Remainder (P_Root_Type, X, Y), Static); + end Remainder; ----------- -- Round -- @@ -5832,7 +5898,7 @@ package body Sem_Attr is -- Size_Clause field for a subtype when Has_Size_Clause -- is False. Consider: - -- type x is range 1 .. 64; g + -- type x is range 1 .. 64; -- for x'size use 12; -- subtype y is x range 0 .. 3; @@ -5893,6 +5959,13 @@ package body Sem_Attr is Fold_Ureal (N, Small_Value (P_Type), True); end if; + ----------------- + -- Stream_Size -- + ----------------- + + when Attribute_Stream_Size => + null; + ---------- -- Succ -- ---------- @@ -6100,6 +6173,22 @@ package body Sem_Attr is when Attribute_Wide_Image => null; + --------------------- + -- Wide_Wide_Image -- + --------------------- + + -- Wide_Wide_Image is a scalar attribute but is never static, because it + -- is not a static function (having a non-scalar argument (RM 4.9(22)). + + when Attribute_Wide_Wide_Image => + null; + + --------------------- + -- Wide_Wide_Width -- + --------------------- + + -- Processing for Wide_Wide_Width is combined with Width + ---------------- -- Wide_Width -- ---------------- @@ -6110,9 +6199,11 @@ package body Sem_Attr is -- Width -- ----------- - -- This processing also handles the case of Wide_Width + -- This processing also handles the case of Wide_[Wide_]Width - when Attribute_Width | Attribute_Wide_Width => Width : + when Attribute_Width | + Attribute_Wide_Width | + Attribute_Wide_Wide_Width => Width : begin if Compile_Time_Known_Bounds (P_Type) then @@ -6193,10 +6284,11 @@ package body Sem_Attr is W := 0; -- Width for types derived from Standard.Character - -- and Standard.Wide_Character. + -- and Standard.Wide_[Wide_]Character. elsif R = Standard_Character - or else R = Standard_Wide_Character + or else R = Standard_Wide_Character + or else R = Standard_Wide_Wide_Character then W := 0; @@ -6207,6 +6299,8 @@ package body Sem_Attr is -- Assume all wide-character escape sequences are -- same length, so we can quit when we reach one. + -- Is this right for UTF-8? + if J > 255 then if Id = Attribute_Wide_Width then W := Int'Max (W, 3); @@ -6299,8 +6393,8 @@ package body Sem_Attr is Get_Decoded_Name_String (Chars (L)); Wt := Nat (Name_Len); - -- For Wide_Width, use encoded name, and then - -- adjust for the encoding. + -- For Wide_[Wide_]Width, use encoded name, and + -- then adjust for the encoding. else Get_Name_String (Chars (L)); @@ -6386,11 +6480,11 @@ package body Sem_Attr is Attribute_Value | Attribute_Wchar_T_Size | Attribute_Wide_Value | + Attribute_Wide_Wide_Value | Attribute_Word_Size | Attribute_Write => raise Program_Error; - end case; -- At the end of the case, one more check. If we did a static evaluation @@ -7348,6 +7442,9 @@ package body Sem_Attr is when Attribute_Wide_Value => Resolve (First (Expressions (N)), Standard_Wide_String); + when Attribute_Wide_Wide_Value => + Resolve (First (Expressions (N)), Standard_Wide_Wide_String); + when others => null; end case; end case; diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index b06ab1e2919..a113ac91e19 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1996-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- -- @@ -267,11 +267,12 @@ package body Sem_Case is C : Int; begin - -- For character, or wide character. If we are in 7-bit ASCII graphic + -- For character, or wide [wide] character. If 7-bit ASCII graphic -- range, then build and return appropriate character literal name if Rtp = Standard_Character or else Rtp = Standard_Wide_Character + or else Rtp = Standard_Wide_Wide_Character then C := UI_To_Int (Value); @@ -429,11 +430,13 @@ package body Sem_Case is if Root_Type (Choice_Type) = Standard_Character or else Root_Type (Choice_Type) = Standard_Wide_Character + or else + Root_Type (Choice_Type) = Standard_Wide_Wide_Character then Set_Character_Literal_Name (Char_Code (UI_To_Int (Value))); Lit := New_Node (N_Character_Literal, Loc); Set_Chars (Lit, Name_Find); - Set_Char_Literal_Value (Lit, Char_Code (UI_To_Int (Value))); + Set_Char_Literal_Value (Lit, Value); Set_Etype (Lit, Choice_Type); Set_Is_Static_Expression (Lit, True); return Lit; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 5d9e5caa34d..a9700fb1dcc 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -1692,14 +1692,26 @@ package body Sem_Ch10 is if Implementation_Unit_Warnings and then Current_Sem_Unit = Main_Unit - and then Implementation_Unit (Get_Source_Unit (U)) and then not Intunit and then not Implicit_With (N) + and then not GNAT_Mode then - Error_Msg_N ("& is an internal 'G'N'A'T unit?", Name (N)); - Error_Msg_N - ("\use of this unit is non-portable and version-dependent?", - Name (N)); + declare + U_Kind : constant Kind_Of_Unit := + Get_Kind_Of_Unit (Get_Source_Unit (U)); + + begin + if U_Kind = Implementation_Unit then + Error_Msg_N ("& is an internal 'G'N'A'T unit?", Name (N)); + Error_Msg_N + ("\use of this unit is non-portable " & + "and version-dependent?", + Name (N)); + + elsif U_Kind = Ada_05_Unit and then Ada_Version = Ada_95 then + Error_Msg_N ("& is an Ada 2005 unit?", Name (N)); + end if; + end; end if; end if; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 588ce993dfb..04e2f8d567b 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -51,6 +51,7 @@ with Sem_Ch7; use Sem_Ch7; with Sem_Ch8; use Sem_Ch8; with Sem_Ch10; use Sem_Ch10; with Sem_Ch13; use Sem_Ch13; +with Sem_Disp; use Sem_Disp; with Sem_Elab; use Sem_Elab; with Sem_Elim; use Sem_Elim; with Sem_Eval; use Sem_Eval; @@ -261,7 +262,11 @@ package body Sem_Ch12 is T : Entity_Id; Def : Node_Id); - -- All the following need comments??? + -- The following subprograms create abbreviated declarations for formal + -- scalar types. We introduce an anonymous base of the proper class for + -- each of them, and define the formals as constrained first subtypes of + -- their bases. The bounds are expressions that are non-static in the + -- generic. procedure Analyze_Formal_Decimal_Fixed_Point_Type (T : Entity_Id; Def : Node_Id); @@ -879,7 +884,7 @@ package body Sem_Ch12 is case Nkind (Formal) is when N_Formal_Subprogram_Declaration => - exit when Kind = N_Formal_Subprogram_Declaration + exit when Kind in N_Formal_Subprogram_Declaration and then Chars (Defining_Unit_Name (Specification (Formal))) = @@ -900,7 +905,7 @@ package body Sem_Ch12 is -- unrecognized pragmas. exit when - Kind /= N_Formal_Subprogram_Declaration + Kind not in N_Formal_Subprogram_Declaration and then Kind /= N_Subprogram_Declaration and then Kind /= N_Freeze_Entity and then Kind /= N_Null_Statement @@ -1038,7 +1043,7 @@ package body Sem_Ch12 is then Temp_Formal := First (Formals); while Present (Temp_Formal) loop - if Nkind (Temp_Formal) = + if Nkind (Temp_Formal) in N_Formal_Subprogram_Declaration and then Temp_Formal /= Formal and then @@ -1279,6 +1284,7 @@ package body Sem_Ch12 is Set_Delta_Value (T, Delta_Val); Set_Small_Value (T, Delta_Val); Set_Scalar_Range (T, Scalar_Range (Base)); + Set_Is_Constrained (T); Check_Restriction (No_Fixed_Point, Def); end Analyze_Formal_Decimal_Fixed_Point_Type; @@ -1357,12 +1363,17 @@ package body Sem_Ch12 is Lo : Node_Id; Hi : Node_Id; + Base : constant Entity_Id := + New_Internal_Entity + (E_Floating_Point_Type, Current_Scope, Sloc (Def), 'G'); begin - Enter_Name (T); - Set_Ekind (T, E_Enumeration_Type); - Set_Etype (T, T); - Init_Size (T, 8); - Init_Alignment (T); + Enter_Name (T); + Set_Ekind (T, E_Enumeration_Subtype); + Set_Etype (T, Base); + Init_Size (T, 8); + Init_Alignment (T); + Set_Is_Generic_Type (T); + Set_Is_Constrained (T); -- For semantic analysis, the bounds of the type must be set to some -- non-static value. The simplest is to create attribute nodes for @@ -1386,6 +1397,14 @@ package body Sem_Ch12 is Low_Bound => Lo, High_Bound => Hi)); + Set_Ekind (Base, E_Enumeration_Type); + Set_Etype (Base, Base); + Init_Size (Base, 8); + Init_Alignment (Base); + Set_Is_Generic_Type (Base); + Set_Scalar_Range (Base, Scalar_Range (T)); + Set_Parent (Base, Parent (Def)); + end Analyze_Formal_Discrete_Type; ---------------------------------- @@ -1404,12 +1423,13 @@ package body Sem_Ch12 is -- the generic itself. Enter_Name (T); - Set_Ekind (T, E_Floating_Point_Subtype); - Set_Etype (T, Base); - Set_Size_Info (T, (Standard_Float)); - Set_RM_Size (T, RM_Size (Standard_Float)); - Set_Digits_Value (T, Digits_Value (Standard_Float)); - Set_Scalar_Range (T, Scalar_Range (Standard_Float)); + Set_Ekind (T, E_Floating_Point_Subtype); + Set_Etype (T, Base); + Set_Size_Info (T, (Standard_Float)); + Set_RM_Size (T, RM_Size (Standard_Float)); + Set_Digits_Value (T, Digits_Value (Standard_Float)); + Set_Scalar_Range (T, Scalar_Range (Standard_Float)); + Set_Is_Constrained (T); Set_Is_Generic_Type (Base); Set_Etype (Base, Base); @@ -1562,6 +1582,7 @@ package body Sem_Ch12 is Make_Range (Loc, Low_Bound => Make_Real_Literal (Loc, Ureal_1), High_Bound => Make_Real_Literal (Loc, Ureal_1))); + Set_Is_Constrained (T); Set_Is_Generic_Type (Base); Set_Etype (Base, Base); @@ -1773,11 +1794,12 @@ package body Sem_Ch12 is begin Enter_Name (T); - Set_Ekind (T, E_Signed_Integer_Subtype); - Set_Etype (T, Base); - Set_Size_Info (T, Standard_Integer); - Set_RM_Size (T, RM_Size (Standard_Integer)); - Set_Scalar_Range (T, Scalar_Range (Standard_Integer)); + Set_Ekind (T, E_Signed_Integer_Subtype); + Set_Etype (T, Base); + Set_Size_Info (T, Standard_Integer); + Set_RM_Size (T, RM_Size (Standard_Integer)); + Set_Scalar_Range (T, Scalar_Range (Standard_Integer)); + Set_Is_Constrained (T); Set_Is_Generic_Type (Base); Set_Size_Info (Base, Standard_Integer); @@ -1811,6 +1833,25 @@ package body Sem_Ch12 is Set_Is_Formal_Subprogram (Nam); Set_Has_Completion (Nam); + if Nkind (N) = N_Formal_Abstract_Subprogram_Declaration then + Set_Is_Abstract (Nam); + Set_Is_Dispatching_Operation (Nam); + + declare + Ctrl_Type : constant Entity_Id := Find_Dispatching_Type (Nam); + + begin + if not Present (Ctrl_Type) then + Error_Msg_N + ("abstract formal subprogram must have a controlling type", + N); + + else + Check_Controlling_Formals (Ctrl_Type, Nam); + end if; + end; + end if; + -- Default name is resolved at the point of instantiation if Box_Present (N) then @@ -6966,10 +7007,12 @@ package body Sem_Ch12 is -- The generic instantiation freezes the actual. This can only be -- done once the actual is resolved, in the analysis of the renaming - -- declaration. To indicate that must be done, we set the corresponding - -- spec of the node to point to the formal subprogram entity. + -- declaration. To make the formal subprogram entity available, we set + -- Corresponding_Formal_Spec to point to the formal subprogram entity. + -- This is also needed in Analyze_Subprogram_Renaming for the processing + -- of formal abstract subprograms. - Set_Corresponding_Spec (Decl_Node, Analyzed_S); + Set_Corresponding_Formal_Spec (Decl_Node, Analyzed_S); -- We cannot analyze the renaming declaration, and thus find the -- actual, until the all the actuals are assembled in the instance. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index e620044b762..dbd1c7eef06 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1,12 +1,12 @@ ------------------------------------------------------------------------------ --- c -- +-- -- -- GNAT COMPILER COMPONENTS -- -- -- -- S E M _ C H 1 3 -- -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -301,7 +301,6 @@ package body Sem_Ch13 is then Error_Msg_N ("cannot specify attribute for subtype", Nam); return; - end if; -- Switch on particular attribute @@ -1364,6 +1363,45 @@ package body Sem_Ch13 is end if; end Storage_Pool; + ----------------- + -- Stream_Size -- + ----------------- + + when Attribute_Stream_Size => Stream_Size : declare + Size : constant Uint := Static_Integer (Expr); + + begin + if Has_Stream_Size_Clause (U_Ent) then + Error_Msg_N ("Stream_Size already given for &", Nam); + + elsif Is_Elementary_Type (U_Ent) then + if Size /= System_Storage_Unit + and then + Size /= System_Storage_Unit * 2 + and then + Size /= System_Storage_Unit * 4 + and then + Size /= System_Storage_Unit * 8 + then + Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit); + Error_Msg_N + ("stream size for elementary type must be a" + & " power of 2 and at least ^", N); + + elsif RM_Size (U_Ent) > Size then + Error_Msg_Uint_1 := RM_Size (U_Ent); + Error_Msg_N + ("stream size for elementary type must be a" + & " power of 2 and at least ^", N); + end if; + + Set_Has_Stream_Size_Clause (U_Ent); + + else + Error_Msg_N ("Stream_Size cannot be given for &", Nam); + end if; + end Stream_Size; + ---------------- -- Value_Size -- ---------------- @@ -1499,7 +1537,6 @@ package body Sem_Ch13 is when others => Error_Msg_N ("attribute& cannot be set with definition clause", N); - end case; -- The test for the type being frozen must be performed after @@ -1669,10 +1706,11 @@ package body Sem_Ch13 is Error_Msg_N ("duplicate enumeration rep clause ignored", N); return; - -- Don't allow rep clause if root type is standard [wide_]character + -- Don't allow rep clause for standard [wide_[wide_]]character elsif Root_Type (Enumtype) = Standard_Character or else Root_Type (Enumtype) = Standard_Wide_Character + or else Root_Type (Enumtype) = Standard_Wide_Wide_Character then Error_Msg_N ("enumeration rep clause not allowed for this type", N); return; diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb index 7015fbd2096..091d087c831 100644 --- a/gcc/ada/sem_ch2.adb +++ b/gcc/ada/sem_ch2.adb @@ -32,6 +32,7 @@ with Rident; use Rident; with Sem_Ch8; use Sem_Ch8; with Sinfo; use Sinfo; with Stand; use Stand; +with Uintp; use Uintp; package body Sem_Ch2 is @@ -51,7 +52,7 @@ package body Sem_Ch2 is Set_Is_Static_Expression (N); if Comes_From_Source (N) - and then not In_Character_Range (Char_Literal_Value (N)) + and then not In_Character_Range (UI_To_CC (Char_Literal_Value (N))) then Check_Restriction (No_Wide_Characters, N); end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 65a0ae94591..7ac6e268b2d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -1970,8 +1970,9 @@ package body Sem_Ch3 is Remove_Side_Effects (E); end if; - if T = Standard_Wide_Character + if T = Standard_Wide_Character or else T = Standard_Wide_Wide_Character or else Root_Type (T) = Standard_Wide_String + or else Root_Type (T) = Standard_Wide_Wide_String then Check_Restriction (No_Wide_Characters, Object_Definition (N)); end if; @@ -3705,6 +3706,7 @@ package body Sem_Ch3 is if Root_Type (Parent_Type) = Standard_Character or else Root_Type (Parent_Type) = Standard_Wide_Character + or else Root_Type (Parent_Type) = Standard_Wide_Wide_Character then Derived_Standard_Character (N, Parent_Type, Derived_Type); @@ -4122,10 +4124,12 @@ package body Sem_Ch3 is begin if Ekind (Parent_Type) in Record_Kind - or else (Ekind (Parent_Type) in Enumeration_Kind - and then Root_Type (Parent_Type) /= Standard_Character - and then Root_Type (Parent_Type) /= Standard_Wide_Character - and then not Is_Generic_Type (Root_Type (Parent_Type))) + or else + (Ekind (Parent_Type) in Enumeration_Kind + and then Root_Type (Parent_Type) /= Standard_Character + and then Root_Type (Parent_Type) /= Standard_Wide_Character + and then Root_Type (Parent_Type) /= Standard_Wide_Wide_Character + and then not Is_Generic_Type (Root_Type (Parent_Type))) then Full_N := New_Copy_Tree (N); Insert_After (N, Full_N); @@ -10192,7 +10196,9 @@ package body Sem_Ch3 is end if; if Typ = Standard_Wide_Character + or else Typ = Standard_Wide_Wide_Character or else Typ = Standard_Wide_String + or else Typ = Standard_Wide_Wide_String then Check_Restriction (No_Wide_Characters, S); end if; @@ -12707,6 +12713,12 @@ package body Sem_Ch3 is Rewrite (S, New_Copy_Tree (Subtype_Mark (S))); + -- Set Ekind of orphan itype, to prevent cascaded errors. + + if Present (Def_Id) then + Set_Ekind (Def_Id, Ekind (Any_Type)); + end if; + -- Make recursive call, having got rid of the bogus constraint return Process_Subtype (S, Related_Nod, Related_Id, Suffix); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 2a4cf9d7ef8..3f16dca9396 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -410,8 +410,10 @@ package body Sem_Ch5 is and then Can_Never_Be_Null (Entity (Lhs))) or else Can_Never_Be_Null (Etype (Lhs))) then - Error_Msg_N - ("(Ada 2005) NULL not allowed in null-excluding objects", Lhs); + Apply_Compile_Time_Constraint_Error + (N => Lhs, + Msg => "(Ada 2005) NULL not allowed in null-excluding objects?", + Reason => CE_Null_Not_Allowed); end if; if Is_Scalar_Type (T1) then diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index bc069fa4065..45a20158507 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -79,9 +79,14 @@ package body Sem_Ch6 is -- Local Subprograms -- ----------------------- + procedure Analyze_Return_Type (N : Node_Id); + -- Subsidiary to Process_Formals: analyze subtype mark in function + -- specification, in a context where the formals are visible and hide + -- outer homographs. + procedure Analyze_Generic_Subprogram_Body (N : Node_Id; Gen_Id : Entity_Id); - -- Analyze a generic subprogram body. N is the body to be analyzed, - -- and Gen_Id is the defining entity Id for the corresponding spec. + -- Analyze a generic subprogram body. N is the body to be analyzed, and + -- Gen_Id is the defining entity Id for the corresponding spec. procedure Build_Body_To_Inline (N : Node_Id; Subp : Entity_Id); -- If a subprogram has pragma Inline and inlining is active, use generic @@ -133,35 +138,34 @@ package body Sem_Ch6 is (HSS : Node_Id; Mode : Character; Err : out Boolean); - -- Called to check for missing return statements in a function body, - -- or for returns present in a procedure body which has No_Return set. - -- L is the handled statement sequence for the subprogram body. This - -- procedure checks all flow paths to make sure they either have a - -- return (Mode = 'F') or do not have a return (Mode = 'P'). The flag - -- Err is set if there are any control paths not explicitly terminated - -- by a return in the function case, and is True otherwise. + -- Called to check for missing return statements in a function body, or + -- for returns present in a procedure body which has No_Return set. L is + -- the handled statement sequence for the subprogram body. This procedure + -- checks all flow paths to make sure they either have return (Mode = 'F') + -- or do not have a return (Mode = 'P'). The flag Err is set if there are + -- any control paths not explicitly terminated by a return in the function + -- case, and is True otherwise. function Conforming_Types (T1 : Entity_Id; T2 : Entity_Id; Ctype : Conformance_Type; Get_Inst : Boolean := False) return Boolean; - -- Check that two formal parameter types conform, checking both - -- for equality of base types, and where required statically - -- matching subtypes, depending on the setting of Ctype. + -- Check that two formal parameter types conform, checking both for + -- equality of base types, and where required statically matching + -- subtypes, depending on the setting of Ctype. procedure Enter_Overloaded_Entity (S : Entity_Id); - -- This procedure makes S, a new overloaded entity, into the first - -- visible entity with that name. + -- This procedure makes S, a new overloaded entity, into the first visible + -- entity with that name. procedure Install_Entity (E : Entity_Id); -- Make single entity visible. Used for generic formals as well procedure Install_Formals (Id : Entity_Id); - -- On entry to a subprogram body, make the formals visible. Note - -- that simply placing the subprogram on the scope stack is not - -- sufficient: the formals must become the current entities for - -- their names. + -- On entry to a subprogram body, make the formals visible. Note that + -- simply placing the subprogram on the scope stack is not sufficient: + -- the formals must become the current entities for their names. function Is_Non_Overriding_Operation (Prev_E : Entity_Id; @@ -181,8 +185,8 @@ package body Sem_Ch6 is -- have no parameters, or those for which defaults exist for all parameters procedure Reference_Body_Formals (Spec : Entity_Id; Bod : Entity_Id); - -- If there is a separate spec for a subprogram or generic subprogram, - -- the formals of the body are treated as references to the corresponding + -- If there is a separate spec for a subprogram or generic subprogram, the + -- formals of the body are treated as references to the corresponding -- formals of the spec. This reference does not count as an actual use of -- the formal, in order to diagnose formals that are unused in the body. @@ -228,6 +232,18 @@ package body Sem_Ch6 is begin Analyze (P); + -- A call of the form A.B (X) may be an Ada05 call, which is rewritten + -- as B(A, X). If the rewriting is successful, the call has been + -- analyzed and we just return. + + if Nkind (P) = N_Selected_Component + and then Name (N) /= P + and then Is_Rewrite_Substitution (N) + and then Present (Etype (N)) + then + return; + end if; + -- If error analyzing name, then set Any_Type as result type and return if Etype (P) = Any_Type then @@ -265,9 +281,9 @@ package body Sem_Ch6 is Spec : Node_Id; begin - -- Copy body and disable expansion while analyzing the generic - -- For a stub, do not copy the stub (which would load the proper body), - -- this will be done when the proper body is analyzed. + -- Copy body and disable expansion while analyzing the generic For a + -- stub, do not copy the stub (which would load the proper body), this + -- will be done when the proper body is analyzed. if Nkind (N) /= N_Subprogram_Body_Stub then New_N := Copy_Generic_Node (N, Empty, Instantiating => False); @@ -379,10 +395,10 @@ package body Sem_Ch6 is return; end if; - -- If this is a compilation unit, it must be made visible - -- explicitly, because the compilation of the declaration, - -- unlike other library unit declarations, does not. If it - -- is not a unit, the following is redundant but harmless. + -- If this is a compilation unit, it must be made visible explicitly, + -- because the compilation of the declaration, unlike other library + -- unit declarations, does not. If it is not a unit, the following + -- is redundant but harmless. Set_Is_Immediately_Visible (Gen_Id); Reference_Body_Formals (Gen_Id, Body_Id); @@ -394,8 +410,8 @@ package body Sem_Ch6 is Save_Global_References (Original_Node (N)); - -- Prior to exiting the scope, include generic formals again - -- (if any are present) in the set of local entities. + -- Prior to exiting the scope, include generic formals again (if any + -- are present) in the set of local entities. if Present (First_Ent) then Set_First_Entity (Gen_Id, First_Ent); @@ -420,12 +436,12 @@ package body Sem_Ch6 is -- Analyze_Operator_Symbol -- ----------------------------- - -- An operator symbol such as "+" or "and" may appear in context where - -- the literal denotes an entity name, such as "+"(x, y) or in a - -- context when it is just a string, as in (conjunction = "or"). In - -- these cases the parser generates this node, and the semantics does - -- the disambiguation. Other such case are actuals in an instantiation, - -- the generic unit in an instantiation, and pragma arguments. + -- An operator symbol such as "+" or "and" may appear in context where the + -- literal denotes an entity name, such as "+"(x, y) or in context when it + -- is just a string, as in (conjunction = "or"). In these cases the parser + -- generates this node, and the semantics does the disambiguation. Other + -- such case are actuals in an instantiation, the generic unit in an + -- instantiation, and pragma arguments. procedure Analyze_Operator_Symbol (N : Node_Id) is Par : constant Node_Id := Parent (N); @@ -561,9 +577,9 @@ package body Sem_Ch6 is and then Present (Actuals) and then No (Next (First (Actuals))) then - -- Can be call to parameterless entry family. What appears to be - -- the sole argument is in fact the entry index. Rewrite prefix - -- of node accordingly. Source representation is unchanged by this + -- Can be call to parameterless entry family. What appears to be the + -- sole argument is in fact the entry index. Rewrite prefix of node + -- accordingly. Source representation is unchanged by this -- transformation. New_N := @@ -585,9 +601,9 @@ package body Sem_Ch6 is Error_Msg_N ("expect access to procedure in call", P); end if; - -- The name can be a selected component or an indexed component - -- that yields an access to subprogram. Such a prefix is legal if - -- the call has parameter associations. + -- The name can be a selected component or an indexed component that + -- yields an access to subprogram. Such a prefix is legal if the call + -- has parameter associations. elsif Is_Access_Type (Etype (P)) and then Ekind (Designated_Type (Etype (P))) = E_Subprogram_Type @@ -598,15 +614,14 @@ package body Sem_Ch6 is Error_Msg_N ("missing explicit dereference in call ", N); end if; - -- If not an access to subprogram, then the prefix must resolve to - -- the name of an entry, entry family, or protected operation. + -- If not an access to subprogram, then the prefix must resolve to the + -- name of an entry, entry family, or protected operation. - -- For the case of a simple entry call, P is a selected component - -- where the prefix is the task and the selector name is the entry. - -- A call to a protected procedure will have the same syntax. If - -- the protected object contains overloaded operations, the entity - -- may appear as a function, the context will select the operation - -- whose type is Void. + -- For the case of a simple entry call, P is a selected component where + -- the prefix is the task and the selector name is the entry. A call to + -- a protected procedure will have the same syntax. If the protected + -- object contains overloaded operations, the entity may appear as a + -- function, the context will select the operation whose type is Void. elsif Nkind (P) = N_Selected_Component and then (Ekind (Entity (Selector_Name (P))) = E_Entry @@ -622,9 +637,9 @@ package body Sem_Ch6 is and then Present (Actuals) and then No (Next (First (Actuals))) then - -- Can be call to parameterless entry family. What appears to be - -- the sole argument is in fact the entry index. Rewrite prefix - -- of node accordingly. Source representation is unchanged by this + -- Can be call to parameterless entry family. What appears to be the + -- sole argument is in fact the entry index. Rewrite prefix of node + -- accordingly. Source representation is unchanged by this -- transformation. New_N := @@ -720,9 +735,9 @@ package body Sem_Ch6 is Apply_Constraint_Check (Expr, R_Type); - -- ??? A real run-time accessibility check is needed - -- in cases involving dereferences of access parameters. - -- For now we just check the static cases. + -- ??? A real run-time accessibility check is needed in cases + -- involving dereferences of access parameters. For now we just + -- check the static cases. if Is_Return_By_Reference_Type (Etype (Scope_Id)) and then Object_Access_Level (Expr) @@ -766,6 +781,34 @@ package body Sem_Ch6 is Check_Unreachable_Code (N); end Analyze_Return_Statement; + ------------------------- + -- Analyze_Return_Type -- + ------------------------- + + procedure Analyze_Return_Type (N : Node_Id) is + Designator : constant Entity_Id := Defining_Entity (N); + Typ : Entity_Id := Empty; + + begin + if Subtype_Mark (N) /= Error then + Find_Type (Subtype_Mark (N)); + Typ := Entity (Subtype_Mark (N)); + Set_Etype (Designator, Typ); + + if Ekind (Typ) = E_Incomplete_Type + or else (Is_Class_Wide_Type (Typ) + and then + Ekind (Root_Type (Typ)) = E_Incomplete_Type) + then + Error_Msg_N + ("invalid use of incomplete type", Subtype_Mark (N)); + end if; + + else + Set_Etype (Designator, Any_Type); + end if; + end Analyze_Return_Type; + ----------------------------- -- Analyze_Subprogram_Body -- ----------------------------- @@ -831,13 +874,13 @@ package body Sem_Ch6 is Trace_Scope (N, Body_Id, " Analyze subprogram"); - -- Generic subprograms are handled separately. They always have - -- a generic specification. Determine whether current scope has - -- a previous declaration. + -- Generic subprograms are handled separately. They always have a + -- generic specification. Determine whether current scope has a + -- previous declaration. - -- If the subprogram body is defined within an instance of the - -- same name, the instance appears as a package renaming, and - -- will be hidden within the subprogram. + -- If the subprogram body is defined within an instance of the same + -- name, the instance appears as a package renaming, and will be hidden + -- within the subprogram. if Present (Prev_Id) and then not Is_Overloadable (Prev_Id) @@ -853,18 +896,18 @@ package body Sem_Ch6 is return; else - -- Previous entity conflicts with subprogram name. - -- Attempting to enter name will post error. + -- Previous entity conflicts with subprogram name. Attempting to + -- enter name will post error. Enter_Name (Body_Id); return; end if; - -- Non-generic case, find the subprogram declaration, if one was - -- seen, or enter new overloaded entity in the current scope. - -- If the current_entity is the body_id itself, the unit is being - -- analyzed as part of the context of one of its subunits. No need - -- to redo the analysis. + -- Non-generic case, find the subprogram declaration, if one was seen, + -- or enter new overloaded entity in the current scope. If the + -- Current_Entity is the Body_Id itself, the unit is being analyzed as + -- part of the context of one of its subunits. No need to redo the + -- analysis. elsif Prev_Id = Body_Id and then Has_Completion (Body_Id) @@ -885,13 +928,13 @@ package body Sem_Ch6 is return; end if; - -- A subprogram body should cause freezing of its own - -- declaration, but if there was no previous explicit - -- declaration, then the subprogram will get frozen too - -- late (there may be code within the body that depends - -- on the subprogram having been frozen, such as uses of - -- extra formals), so we force it to be frozen here. - -- Same holds if the body and the spec are compilation units. + -- A subprogram body should cause freezing of its own declaration, + -- but if there was no previous explicit declaration, then the + -- subprogram will get frozen too late (there may be code within + -- the body that depends on the subprogram having been frozen, + -- such as uses of extra formals), so we force it to be frozen + -- here. Same holds if the body and the spec are compilation + -- units. if No (Spec_Id) then Freeze_Before (N, Body_Id); @@ -904,18 +947,23 @@ package body Sem_Ch6 is end if; end if; - -- Do not inline any subprogram that contains nested subprograms, - -- since the backend inlining circuit seems to generate uninitialized + -- Do not inline any subprogram that contains nested subprograms, since + -- the backend inlining circuit seems to generate uninitialized -- references in this case. We know this happens in the case of front - -- end ZCX support, but it also appears it can happen in other cases - -- as well. The backend often rejects attempts to inline in the case - -- of nested procedures anyway, so little if anything is lost by this. + -- end ZCX support, but it also appears it can happen in other cases as + -- well. The backend often rejects attempts to inline in the case of + -- nested procedures anyway, so little if anything is lost by this. + -- Note that this is test is for the benefit of the back-end. There is + -- a separate test for front-end inlining that also rejects nested + -- subprograms. -- Do not do this test if errors have been detected, because in some -- error cases, this code blows up, and we don't need it anyway if -- there have been errors, since we won't get to the linker anyway. - if Serious_Errors_Detected = 0 then + if Comes_From_Source (Body_Id) + and then Serious_Errors_Detected = 0 + then P_Ent := Body_Id; loop P_Ent := Scope (P_Ent); @@ -952,9 +1000,9 @@ package body Sem_Ch6 is begin Formal := First_Formal (Body_Id); - -- The protected operation always has at least one formal, - -- namely the object itself, but it is only placed in the - -- parameter list if expansion is enabled. + -- The protected operation always has at least one formal, namely + -- the object itself, but it is only placed in the parameter list + -- if expansion is enabled. if Present (Formal) or else Expander_Active @@ -1006,9 +1054,9 @@ package body Sem_Ch6 is Spec_Id := Defining_Unit_Name (New_Spec); -- Indicate that the entity comes from source, to ensure that - -- cross-reference information is properly generated. - -- The body itself is rewritten during expansion, and the - -- body entity will not appear in calls to the operation. + -- cross-reference information is properly generated. The body + -- itself is rewritten during expansion, and the body entity will + -- not appear in calls to the operation. Set_Comes_From_Source (Spec_Id, True); Analyze (Decl); @@ -1211,9 +1259,9 @@ package body Sem_Ch6 is if Present (Spec_Id) then - -- If a parent unit is categorized, the context of a subunit - -- must conform to the categorization. Conversely, if a child - -- unit is categorized, the parents themselves must conform. + -- If a parent unit is categorized, the context of a subunit must + -- conform to the categorization. Conversely, if a child unit is + -- categorized, the parents themselves must conform. if Nkind (Parent (N)) = N_Subunit then Validate_Categorization_Dependency (N, Spec_Id); @@ -1274,11 +1322,11 @@ package body Sem_Ch6 is Check_Returns (HSS, 'P', Missing_Ret); end if; - -- Now we are going to check for variables that are never modified - -- in the body of the procedure. We omit these checks if the first - -- statement of the procedure raises an exception. In particular - -- this deals with the common idiom of a stubbed function, which - -- might appear as something like + -- Now we are going to check for variables that are never modified in + -- the body of the procedure. We omit these checks if the first + -- statement of the procedure raises an exception. In particular this + -- deals with the common idiom of a stubbed function, which might + -- appear as something like -- function F (A : Integer) return Some_Type; -- X : Some_Type; @@ -1288,16 +1336,16 @@ package body Sem_Ch6 is -- end F; -- Here the purpose of X is simply to satisfy the (annoying) - -- requirement in Ada that there be at least one return, and - -- we certainly do not want to go posting warnings on X that - -- it is not initialized! + -- requirement in Ada that there be at least one return, and we + -- certainly do not want to go posting warnings on X that it is not + -- initialized! declare Stm : Node_Id := First (Statements (HSS)); begin - -- Skip an initial label (for one thing this occurs when we - -- are in front end ZCX mode, but in any case it is irrelevant). + -- Skip an initial label (for one thing this occurs when we are in + -- front end ZCX mode, but in any case it is irrelevant). if Nkind (Stm) = N_Label then Next (Stm); @@ -1477,7 +1525,6 @@ package body Sem_Ch6 is function Analyze_Subprogram_Specification (N : Node_Id) return Entity_Id is Designator : constant Entity_Id := Defining_Entity (N); Formals : constant List_Id := Parameter_Specifications (N); - Typ : Entity_Id; begin Generate_Definition (Designator); @@ -1486,34 +1533,23 @@ package body Sem_Ch6 is Set_Ekind (Designator, E_Function); Set_Mechanism (Designator, Default_Mechanism); - if Subtype_Mark (N) /= Error then - Find_Type (Subtype_Mark (N)); - Typ := Entity (Subtype_Mark (N)); - Set_Etype (Designator, Typ); - - if Ekind (Typ) = E_Incomplete_Type - or else (Is_Class_Wide_Type (Typ) - and then - Ekind (Root_Type (Typ)) = E_Incomplete_Type) - then - Error_Msg_N - ("invalid use of incomplete type", Subtype_Mark (N)); - end if; - - else - Set_Etype (Designator, Any_Type); - end if; - else Set_Ekind (Designator, E_Procedure); Set_Etype (Designator, Standard_Void_Type); end if; + -- Introduce new scope for analysis of the formals and of the + -- return type. + + Set_Scope (Designator, Current_Scope); + if Present (Formals) then - Set_Scope (Designator, Current_Scope); New_Scope (Designator); Process_Formals (Formals, N); End_Scope; + + elsif Nkind (N) = N_Function_Specification then + Analyze_Return_Type (N); end if; if Nkind (N) = N_Function_Specification then @@ -1524,7 +1560,13 @@ package body Sem_Ch6 is May_Need_Actuals (Designator); if Is_Abstract (Etype (Designator)) - and then Nkind (Parent (N)) /= N_Abstract_Subprogram_Declaration + and then Nkind (Parent (N)) + /= N_Abstract_Subprogram_Declaration + and then (Nkind (Parent (N))) + /= N_Formal_Abstract_Subprogram_Declaration + and then (Nkind (Parent (N)) /= N_Subprogram_Renaming_Declaration + or else not Is_Entity_Name (Name (Parent (N))) + or else not Is_Abstract (Entity (Name (Parent (N))))) then Error_Msg_N ("function that returns abstract type must be abstract", N); @@ -1549,9 +1591,9 @@ package body Sem_Ch6 is -- Check for declarations that make inlining not worthwhile function Has_Excluded_Statement (Stats : List_Id) return Boolean; - -- Check for statements that make inlining not worthwhile: any - -- tasking statement, nested at any level. Keep track of total - -- number of elementary statements, as a measure of acceptable size. + -- Check for statements that make inlining not worthwhile: any tasking + -- statement, nested at any level. Keep track of total number of + -- elementary statements, as a measure of acceptable size. function Has_Pending_Instantiation return Boolean; -- If some enclosing body contains instantiations that appear before @@ -1563,8 +1605,8 @@ package body Sem_Ch6 is procedure Remove_Pragmas; -- A pragma Unreferenced that mentions a formal parameter has no -- meaning when the body is inlined and the formals are rewritten. - -- Remove it from body to inline. The analysis of the non-inlined - -- body will handle the pragma properly. + -- Remove it from body to inline. The analysis of the non-inlined body + -- will handle the pragma properly. function Uses_Secondary_Stack (Bod : Node_Id) return Boolean; -- If the body of the subprogram includes a call that returns an @@ -1579,14 +1621,17 @@ package body Sem_Ch6 is D : Node_Id; function Is_Unchecked_Conversion (D : Node_Id) return Boolean; - -- Nested subprograms make a given body ineligible for inlining, - -- but we make an exception for instantiations of unchecked - -- conversion. The body has not been analyzed yet, so we check - -- the name, and verify that the visible entity with that name is - -- the predefined unit. + -- Nested subprograms make a given body ineligible for inlining, but + -- we make an exception for instantiations of unchecked conversion. + -- The body has not been analyzed yet, so check the name, and verify + -- that the visible entity with that name is the predefined unit. + + ----------------------------- + -- Is_Unchecked_Conversion -- + ----------------------------- function Is_Unchecked_Conversion (D : Node_Id) return Boolean is - Id : constant Node_Id := Name (D); + Id : constant Node_Id := Name (D); Conv : Entity_Id; begin @@ -1681,7 +1726,6 @@ package body Sem_Ch6 is elsif Nkind (S) = N_Case_Statement then E := First (Alternatives (S)); - while Present (E) loop if Has_Excluded_Statement (Statements (E)) then return True; @@ -1697,7 +1741,6 @@ package body Sem_Ch6 is if Present (Elsif_Parts (S)) then E := First (Elsif_Parts (S)); - while Present (E) loop if Has_Excluded_Statement (Then_Statements (E)) then return True; @@ -1989,13 +2032,12 @@ package body Sem_Ch6 is New_Formal : Entity_Id; procedure Conformance_Error (Msg : String; N : Node_Id := New_Id); - -- Post error message for conformance error on given node. - -- Two messages are output. The first points to the previous - -- declaration with a general "no conformance" message. - -- The second is the detailed reason, supplied as Msg. The - -- parameter N provide information for a possible & insertion - -- in the message, and also provides the location for posting - -- the message in the absence of a specified Err_Loc location. + -- Post error message for conformance error on given node. Two messages + -- are output. The first points to the previous declaration with a + -- general "no conformance" message. The second is the detailed reason, + -- supplied as Msg. The parameter N provide information for a possible + -- & insertion in the message, and also provides the location for + -- posting the message in the absence of a specified Err_Loc location. ----------------------- -- Conformance_Error -- @@ -2043,8 +2085,8 @@ package body Sem_Ch6 is begin Conforms := True; - -- We need a special case for operators, since they don't - -- appear explicitly. + -- We need a special case for operators, since they don't appear + -- explicitly. if Ctype = Type_Conformant then if Ekind (New_Id) = E_Operator @@ -2171,8 +2213,8 @@ package body Sem_Ch6 is if Ctype = Fully_Conformant then - -- We have checked already that names match. - -- Check default expressions for in parameters + -- We have checked already that names match. Check default + -- expressions for in parameters if Parameter_Mode (Old_Formal) = E_In_Parameter then declare @@ -2183,11 +2225,11 @@ package body Sem_Ch6 is begin if NewD or OldD then - -- The old default value has been analyzed because - -- the current full declaration will have frozen - -- everything before. The new default values have not - -- been analyzed, so analyze them now before we check - -- for conformance. + -- The old default value has been analyzed because the + -- current full declaration will have frozen everything + -- before. The new default values have not been + -- analyzed, so analyze them now before we check for + -- conformance. if NewD then New_Scope (New_Id); @@ -2284,6 +2326,10 @@ package body Sem_Ch6 is -- If T is not yet frozen and needs a delayed freeze, then the -- subprogram itself must be delayed. + --------------------- + -- Possible_Freeze -- + --------------------- + procedure Possible_Freeze (T : Entity_Id) is begin if Has_Delayed_Freeze (T) @@ -2361,12 +2407,11 @@ package body Sem_Ch6 is New_Discr_Type : Entity_Id; procedure Conformance_Error (Msg : String; N : Node_Id); - -- Post error message for conformance error on given node. - -- Two messages are output. The first points to the previous - -- declaration with a general "no conformance" message. - -- The second is the detailed reason, supplied as Msg. The - -- parameter N provide information for a possible & insertion - -- in the message. + -- Post error message for conformance error on given node. Two messages + -- are output. The first points to the previous declaration with a + -- general "no conformance" message. The second is the detailed reason, + -- supplied as Msg. The parameter N provide information for a possible + -- & insertion in the message. ----------------------- -- Conformance_Error -- @@ -2386,9 +2431,9 @@ package body Sem_Ch6 is New_Discr_Id := Defining_Identifier (New_Discr); - -- The subtype mark of the discriminant on the full type - -- has not been analyzed so we do it here. For an access - -- discriminant a new type is created. + -- The subtype mark of the discriminant on the full type has not + -- been analyzed so we do it here. For an access discriminant a new + -- type is created. if Nkind (Discriminant_Type (New_Discr)) = N_Access_Definition then New_Discr_Type := @@ -2405,8 +2450,8 @@ package body Sem_Ch6 is Conformance_Error ("type of & does not match!", New_Discr_Id); return; else - -- Treat the new discriminant as an occurrence of the old - -- one, for navigation purposes, and fill in some semantic + -- Treat the new discriminant as an occurrence of the old one, + -- for navigation purposes, and fill in some semantic -- information, for completeness. Generate_Reference (Old_Discr, New_Discr_Id, 'r'); @@ -2434,8 +2479,8 @@ package body Sem_Ch6 is -- The old default value has been analyzed and expanded, -- because the current full declaration will have frozen - -- everything before. The new default values have not - -- been expanded, so expand now to check conformance. + -- everything before. The new default values have not been + -- expanded, so expand now to check conformance. if NewD then Analyze_Per_Use_Expression @@ -2927,6 +2972,10 @@ package body Sem_Ch6 is -- This is used to check if S1 > S2 in the sense required by this -- test, for example nameab < namec, but name2 < name10. + ----------------------------- + -- Subprogram_Name_Greater -- + ----------------------------- + function Subprogram_Name_Greater (S1, S2 : String) return Boolean is L1, L2 : Positive; N1, N2 : Natural; @@ -3019,7 +3068,6 @@ package body Sem_Ch6 is Err_Loc : Node_Id := Empty) is Result : Boolean; - begin Check_Conformance (New_Id, Old_Id, Subtype_Conformant, True, Result, Err_Loc); @@ -3035,7 +3083,6 @@ package body Sem_Ch6 is Err_Loc : Node_Id := Empty) is Result : Boolean; - begin Check_Conformance (New_Id, Old_Id, Type_Conformant, True, Result, Err_Loc); @@ -3101,9 +3148,9 @@ package body Sem_Ch6 is begin -- The context is an instance association for a formal - -- access-to-subprogram type; the formal parameter types - -- require mapping because they may denote other formal - -- parameters of the generic unit. + -- access-to-subprogram type; the formal parameter types require + -- mapping because they may denote other formal parameters of the + -- generic unit. if Get_Inst then Type_1 := Get_Instance_Of (T1); @@ -3196,21 +3243,21 @@ package body Sem_Ch6 is end if; -- The context is an instance association for a formal - -- access-to-subprogram type; formal access parameter - -- designated types require mapping because they may - -- denote other formal parameters of the generic unit. + -- access-to-subprogram type; formal access parameter designated + -- types require mapping because they may denote other formal + -- parameters of the generic unit. if Get_Inst then Desig_1 := Get_Instance_Of (Desig_1); Desig_2 := Get_Instance_Of (Desig_2); end if; - -- It is possible for a Class_Wide_Type to be introduced for - -- an incomplete type, in which case there is a separate class_ - -- wide type for the full view. The types conform if their - -- Etypes conform, i.e. one may be the full view of the other. - -- This can only happen in the context of an access parameter, - -- other uses of an incomplete Class_Wide_Type are illegal. + -- It is possible for a Class_Wide_Type to be introduced for an + -- incomplete type, in which case there is a separate class_ wide + -- type for the full view. The types conform if their Etypes + -- conform, i.e. one may be the full view of the other. This can + -- only happen in the context of an access parameter, other uses + -- of an incomplete Class_Wide_Type are illegal. if Is_Class_Wide_Type (Desig_1) and then Is_Class_Wide_Type (Desig_2) @@ -3252,9 +3299,9 @@ package body Sem_Ch6 is P_Formal : Entity_Id := Empty; function Add_Extra_Formal (Typ : Entity_Id) return Entity_Id; - -- Add an extra formal, associated with the current Formal. The - -- extra formal is added to the list of extra formals, and also - -- returned as the result. These formals are always of mode IN. + -- Add an extra formal, associated with the current Formal. The extra + -- formal is added to the list of extra formals, and also returned as + -- the result. These formals are always of mode IN. ---------------------- -- Add_Extra_Formal -- @@ -3273,9 +3320,9 @@ package body Sem_Ch6 is return Empty; end if; - -- A little optimization. Never generate an extra formal for - -- the _init operand of an initialization procedure, since it - -- could never be used. + -- A little optimization. Never generate an extra formal for the + -- _init operand of an initialization procedure, since it could + -- never be used. if Chars (Formal) = Name_uInit then return Empty; @@ -3296,9 +3343,9 @@ package body Sem_Ch6 is -- Start of processing for Create_Extra_Formals begin - -- If this is a derived subprogram then the subtypes of the - -- parent subprogram's formal parameters will be used to - -- to determine the need for extra formals. + -- If this is a derived subprogram then the subtypes of the parent + -- subprogram's formal parameters will be used to to determine the need + -- for extra formals. if Is_Overloadable (E) and then Present (Alias (E)) then P_Formal := First_Formal (Alias (E)); @@ -3311,9 +3358,9 @@ package body Sem_Ch6 is Next_Formal (Formal); end loop; - -- If Extra_formals where already created, don't do it again - -- This situation may arise for subprogram types created as part - -- of dispatching calls (see Expand_Dispatch_Call) + -- If Extra_formals where already created, don't do it again. This + -- situation may arise for subprogram types created as part of + -- dispatching calls (see Expand_Dispatching_Call) if Present (Last_Extra) and then Present (Extra_Formal (Last_Extra)) @@ -3381,10 +3428,9 @@ package body Sem_Ch6 is (not Present (P_Formal) or else Present (Extra_Accessibility (P_Formal))) then - -- Temporary kludge: for now we avoid creating the extra - -- formal for access parameters of protected operations - -- because of problem with the case of internal protected - -- calls. ??? + -- Temporary kludge: for now we avoid creating the extra formal + -- for access parameters of protected operations because of + -- problem with the case of internal protected calls. ??? if Nkind (Parent (Parent (Parent (E)))) /= N_Protected_Definition and then Nkind (Parent (Parent (Parent (E)))) /= N_Protected_Body @@ -3449,8 +3495,8 @@ package body Sem_Ch6 is if Debug_Flag_E then Write_Str ("New overloaded entity chain: "); Write_Name (Chars (S)); - E := S; + E := S; while Present (E) loop Write_Str (" "); Write_Int (Int (E)); E := Homonym (E); @@ -3710,8 +3756,8 @@ package body Sem_Ch6 is if Paren_Count (E1) /= Paren_Count (E2) then return False; - -- If same entities are referenced, then they are conformant - -- even if they have different forms (RM 8.3.1(19-20)). + -- If same entities are referenced, then they are conformant even if + -- they have different forms (RM 8.3.1(19-20)). elsif Is_Entity_Name (E1) and then Is_Entity_Name (E2) then if Present (Entity (E1)) then @@ -3987,8 +4033,8 @@ package body Sem_Ch6 is S2 : constant Node_Id := Original_Node (Given_S2); function Conforming_Bounds (B1, B2 : Node_Id) return Boolean; - -- Special-case for a bound given by a discriminant, which in the - -- body is replaced with the discriminal of the enclosing type. + -- Special-case for a bound given by a discriminant, which in the body + -- is replaced with the discriminal of the enclosing type. function Conforming_Ranges (R1, R2 : Node_Id) return Boolean; -- Check both bounds @@ -4081,15 +4127,15 @@ package body Sem_Ch6 is function Get_Generic_Parent_Type (F_Typ : Entity_Id) return Entity_Id; -- If F_Type is a derived type associated with a generic actual - -- subtype, then return its Generic_Parent_Type attribute, else - -- return Empty. + -- subtype, then return its Generic_Parent_Type attribute, else return + -- Empty. function Types_Correspond (P_Type : Entity_Id; N_Type : Entity_Id) return Boolean; - -- Returns true if and only if the types (or designated types - -- in the case of anonymous access types) are the same or N_Type - -- is derived directly or indirectly from P_Type. + -- Returns true if and only if the types (or designated types in the + -- case of anonymous access types) are the same or N_Type is derived + -- directly or indirectly from P_Type. ----------------------------- -- Get_Generic_Parent_Type -- @@ -4103,11 +4149,11 @@ package body Sem_Ch6 is if Is_Derived_Type (F_Typ) and then Nkind (Parent (F_Typ)) = N_Full_Type_Declaration then - -- The tree must be traversed to determine the parent - -- subtype in the generic unit, which unfortunately isn't - -- always available via semantic attributes. ??? - -- (Note: The use of Original_Node is needed for cases - -- where a full derived type has been rewritten.) + -- The tree must be traversed to determine the parent subtype in + -- the generic unit, which unfortunately isn't always available + -- via semantic attributes. ??? (Note: The use of Original_Node + -- is needed for cases where a full derived type has been + -- rewritten.) Indic := Subtype_Indication (Type_Definition (Original_Node (Parent (F_Typ)))); @@ -4165,10 +4211,10 @@ package body Sem_Ch6 is -- Start of processing for Is_Non_Overriding_Operation begin - -- In the case where both operations are implicit derived - -- subprograms then neither overrides the other. This can - -- only occur in certain obscure cases (e.g., derivation - -- from homographs created in a generic instantiation). + -- In the case where both operations are implicit derived subprograms + -- then neither overrides the other. This can only occur in certain + -- obscure cases (e.g., derivation from homographs created in a generic + -- instantiation). if Present (Alias (Prev_E)) and then Present (Alias (New_E)) then return True; @@ -4179,8 +4225,8 @@ package body Sem_Ch6 is and then Comes_From_Source (New_E) then -- We examine the formals and result subtype of the inherited - -- operation, to determine whether their type is derived from - -- (the instance of) a generic type. + -- operation, to determine whether their type is derived from (the + -- instance of) a generic type. Formal := First_Formal (Prev_E); @@ -4248,9 +4294,9 @@ package body Sem_Ch6 is Next_Entity (N_Formal); end loop; - -- Found a matching primitive operation belonging to - -- the formal ancestor type, so the new subprogram - -- is overriding. + -- Found a matching primitive operation belonging to the + -- formal ancestor type, so the new subprogram is + -- overriding. if not Present (P_Formal) and then not Present (N_Formal) @@ -4266,8 +4312,8 @@ package body Sem_Ch6 is Next_Elmt (Prim_Elt); end loop; - -- If no match found, then the new subprogram does - -- not override in the generic (nor in the instance). + -- If no match found, then the new subprogram does not + -- override in the generic (nor in the instance). return True; end; @@ -4379,7 +4425,6 @@ package body Sem_Ch6 is function Mode_Conformant (New_Id, Old_Id : Entity_Id) return Boolean is Result : Boolean; - begin Check_Conformance (New_Id, Old_Id, Mode_Conformant, False, Result); return Result; @@ -4406,7 +4451,7 @@ package body Sem_Ch6 is -- set when freezing entities, so we must examine the place of the -- declaration in the tree, and recognize wrapper packages as well. - procedure Maybe_Primitive_Operation (Overriding : Boolean := False); + procedure Maybe_Primitive_Operation (Is_Overriding : Boolean := False); -- If the subprogram being analyzed is a primitive operation of -- the type of one of its formals, set the corresponding flag. @@ -4442,7 +4487,7 @@ package body Sem_Ch6 is -- Maybe_Primitive_Operation -- ------------------------------- - procedure Maybe_Primitive_Operation (Overriding : Boolean := False) is + procedure Maybe_Primitive_Operation (Is_Overriding : Boolean := False) is Formal : Entity_Id; F_Typ : Entity_Id; B_Typ : Entity_Id; @@ -4473,7 +4518,7 @@ package body Sem_Ch6 is then if Is_Abstract (T) and then Is_Abstract (S) - and then (not Overriding or else not Is_Abstract (E)) + and then (not Is_Overriding or else not Is_Abstract (E)) then Error_Msg_N ("abstract subprograms must be visible " & "('R'M 3.9.3(10))!", S); @@ -4481,7 +4526,7 @@ package body Sem_Ch6 is elsif Ekind (S) = E_Function and then Is_Tagged_Type (T) and then T = Base_Type (Etype (S)) - and then not Overriding + and then not Is_Overriding then Error_Msg_N ("private function with tagged result must" @@ -4544,15 +4589,15 @@ package body Sem_Ch6 is if not Comes_From_Source (S) then null; - -- If the subprogram is at library level, it is not a - -- primitive operation. + -- If the subprogram is at library level, it is not primitive + -- operation. elsif Current_Scope = Standard_Standard then null; elsif (Ekind (Current_Scope) = E_Package and then not In_Package_Body (Current_Scope)) - or else Overriding + or else Is_Overriding then -- For function, check return type @@ -4628,9 +4673,9 @@ package body Sem_Ch6 is Check_Dispatching_Operation (S, Empty); -- If the subprogram is implicit it is hidden by the previous - -- declaration. However if it is dispatching, it must appear in - -- the dispatch table anyway, because it can be dispatched to - -- even if it cannot be called directly. + -- declaration. However if it is dispatching, it must appear in the + -- dispatch table anyway, because it can be dispatched to even if it + -- cannot be called directly. elsif Present (Alias (S)) and then not Comes_From_Source (S) @@ -4659,8 +4704,8 @@ package body Sem_Ch6 is -- E exists and is overloadable else - -- Loop through E and its homonyms to determine if any of them - -- is the candidate for overriding by S. + -- Loop through E and its homonyms to determine if any of them is + -- the candidate for overriding by S. while Present (E) loop @@ -4673,25 +4718,25 @@ package body Sem_Ch6 is elsif Type_Conformant (E, S) then - -- If the old and new entities have the same profile and - -- one is not the body of the other, then this is an error, - -- unless one of them is implicitly declared. + -- If the old and new entities have the same profile and one + -- is not the body of the other, then this is an error, unless + -- one of them is implicitly declared. -- There are some cases when both can be implicit, for example -- when both a literal and a function that overrides it are -- inherited in a derivation, or when an inhertited operation -- of a tagged full type overrides the ineherited operation of - -- a private extension. Ada 83 had a special rule for the - -- the literal case. In Ada95, the later implicit operation - -- hides the former, and the literal is always the former. - -- In the odd case where both are derived operations declared - -- at the same point, both operations should be declared, - -- and in that case we bypass the following test and proceed - -- to the next part (this can only occur for certain obscure - -- cases involving homographs in instances and can't occur for + -- a private extension. Ada 83 had a special rule for the the + -- literal case. In Ada95, the later implicit operation hides + -- the former, and the literal is always the former. In the + -- odd case where both are derived operations declared at the + -- same point, both operations should be declared, and in that + -- case we bypass the following test and proceed to the next + -- part (this can only occur for certain obscure cases + -- involving homographs in instances and can't occur for -- dispatching operations ???). Note that the following - -- condition is less than clear. For example, it's not at - -- all clear why there's a test for E_Entry here. ??? + -- condition is less than clear. For example, it's not at all + -- clear why there's a test for E_Entry here. ??? if Present (Alias (S)) and then (No (Alias (E)) @@ -4701,8 +4746,8 @@ package body Sem_Ch6 is (Ekind (E) = E_Entry or else Ekind (E) /= E_Enumeration_Literal) then - -- When an derived operation is overloaded it may be due - -- to the fact that the full view of a private extension + -- When an derived operation is overloaded it may be due to + -- the fact that the full view of a private extension -- re-inherits. It has to be dealt with. if Is_Package (Current_Scope) @@ -4799,17 +4844,17 @@ package body Sem_Ch6 is then -- For nondispatching derived operations that are -- overridden by a subprogram declared in the private - -- part of a package, we retain the derived subprogram - -- but mark it as not immediately visible. If the - -- derived operation was declared in the visible part - -- then this ensures that it will still be visible - -- outside the package with the proper signature - -- (calls from outside must also be directed to this - -- version rather than the overriding one, unlike the - -- dispatching case). Calls from inside the package - -- will still resolve to the overriding subprogram - -- since the derived one is marked as not visible - -- within the package. + -- part of a package, we retain the derived + -- subprogram but mark it as not immediately visible. + -- If the derived operation was declared in the + -- visible part then this ensures that it will still + -- be visible outside the package with the proper + -- signature (calls from outside must also be + -- directed to this version rather than the + -- overriding one, unlike the dispatching case). + -- Calls from inside the package will still resolve + -- to the overriding subprogram since the derived one + -- is marked as not visible within the package. -- If the private operation is dispatching, we achieve -- the overriding by keeping the implicit operation @@ -4868,9 +4913,9 @@ package body Sem_Ch6 is if Is_Dispatching_Operation (E) then - -- An overriding dispatching subprogram inherits - -- the convention of the overridden subprogram - -- (by AI-117). + -- An overriding dispatching subprogram inherits the + -- convention of the overridden subprogram (by + -- AI-117). Set_Convention (S, Convention (E)); @@ -4879,7 +4924,7 @@ package body Sem_Ch6 is Check_Dispatching_Operation (S, Empty); end if; - Maybe_Primitive_Operation (Overriding => True); + Maybe_Primitive_Operation (Is_Overriding => True); goto Check_Inequality; end; @@ -4932,10 +4977,10 @@ package body Sem_Ch6 is Enter_Overloaded_Entity (S); Maybe_Primitive_Operation; - -- If S is a derived operation for an untagged type then - -- by definition it's not a dispatching operation (even - -- if the parent operation was dispatching), so we don't - -- call Check_Dispatching_Operation in that case. + -- If S is a derived operation for an untagged type then by + -- definition it's not a dispatching operation (even if the parent + -- operation was dispatching), so we don't call + -- Check_Dispatching_Operation in that case. if not Present (Derived_Type) or else Is_Tagged_Type (Derived_Type) @@ -4944,11 +4989,10 @@ package body Sem_Ch6 is end if; end if; - -- If this is a user-defined equality operator that is not - -- a derived subprogram, create the corresponding inequality. - -- If the operation is dispatching, the expansion is done - -- elsewhere, and we do not create an explicit inequality - -- operation. + -- If this is a user-defined equality operator that is not a derived + -- subprogram, create the corresponding inequality. If the operation is + -- dispatching, the expansion is done elsewhere, and we do not create + -- an explicit inequality operation. <<Check_Inequality>> if Chars (S) = Name_Op_Eq @@ -4975,9 +5019,9 @@ package body Sem_Ch6 is Ptype : Entity_Id; function Is_Class_Wide_Default (D : Node_Id) return Boolean; - -- Check whether the default has a class-wide type. After analysis - -- the default has the type of the formal, so we must also check - -- explicitly for an access attribute. + -- Check whether the default has a class-wide type. After analysis the + -- default has the type of the formal, so we must also check explicitly + -- for an access attribute. --------------------------- -- Is_Class_Wide_Default -- @@ -5163,6 +5207,14 @@ package body Sem_Ch6 is Next (Param_Spec); end loop; + -- If this is the formal part of a function specification, analyze the + -- subtype mark in the context where the formals are visible but not + -- yet usable, and may hide outer homographs. + + if Nkind (Related_Nod) = N_Function_Specification then + Analyze_Return_Type (Related_Nod); + end if; + -- Now set the kind (mode) of each formal Param_Spec := First (T); @@ -5259,32 +5311,32 @@ package body Sem_Ch6 is if Is_Constrained (T) then AS_Needed := False; - -- If we have unknown discriminants, then we do not need an - -- actual subtype, or more accurately we cannot figure it out! - -- Note that all class-wide types have unknown discriminants. + -- If we have unknown discriminants, then we do not need an actual + -- subtype, or more accurately we cannot figure it out! Note that + -- all class-wide types have unknown discriminants. elsif Has_Unknown_Discriminants (T) then AS_Needed := False; - -- At this stage we have an unconstrained type that may need - -- an actual subtype. For sure the actual subtype is needed - -- if we have an unconstrained array type. + -- At this stage we have an unconstrained type that may need an + -- actual subtype. For sure the actual subtype is needed if we have + -- an unconstrained array type. elsif Is_Array_Type (T) then AS_Needed := True; -- The only other case which needs an actual subtype is an - -- unconstrained record type which is an IN parameter (we - -- cannot generate actual subtypes for the OUT or IN OUT case, - -- since an assignment can change the discriminant values. - -- However we exclude the case of initialization procedures, - -- since discriminants are handled very specially in this context, - -- see the section entitled "Handling of Discriminants" in Einfo. - -- We also exclude the case of Discrim_SO_Functions (functions - -- used in front end layout mode for size/offset values), since - -- in such functions only discriminants are referenced, and not - -- only are such subtypes not needed, but they cannot always - -- be generated, because of order of elaboration issues. + -- unconstrained record type which is an IN parameter (we cannot + -- generate actual subtypes for the OUT or IN OUT case, since an + -- assignment can change the discriminant values. However we exclude + -- the case of initialization procedures, since discriminants are + -- handled very specially in this context, see the section entitled + -- "Handling of Discriminants" in Einfo. We also exclude the case of + -- Discrim_SO_Functions (functions used in front end layout mode for + -- size/offset values), since in such functions only discriminants + -- are referenced, and not only are such subtypes not needed, but + -- they cannot always be generated, because of order of elaboration + -- issues. elsif Is_Record_Type (T) and then Ekind (Formal) = E_In_Parameter @@ -5323,9 +5375,9 @@ package body Sem_Ch6 is Prepend (Decl, Statements (Handled_Statement_Sequence (N))); Mark_Rewrite_Insertion (Decl); else - -- If the accept statement has no body, there will be - -- no reference to the actuals, so no need to compute - -- actual subtypes. + -- If the accept statement has no body, there will be no + -- reference to the actuals, so no need to compute actual + -- subtypes. return; end if; @@ -5336,8 +5388,8 @@ package body Sem_Ch6 is Mark_Rewrite_Insertion (Decl); end if; - -- The declaration uses the bounds of an existing object, - -- and therefore needs no constraint checks. + -- The declaration uses the bounds of an existing object, and + -- therefore needs no constraint checks. Analyze (Decl, Suppress => All_Checks); @@ -5397,8 +5449,8 @@ package body Sem_Ch6 is end if; -- Set Is_Known_Non_Null for access parameters since the language - -- guarantees that access parameters are always non-null. We also - -- set Can_Never_Be_Null, since there is no way to change the value. + -- guarantees that access parameters are always non-null. We also set + -- Can_Never_Be_Null, since there is no way to change the value. if Nkind (Parameter_Type (Spec)) = N_Access_Definition then @@ -5423,9 +5475,9 @@ package body Sem_Ch6 is procedure Set_Formal_Validity (Formal_Id : Entity_Id) is begin - -- If no validity checking, then we cannot assume anything about - -- the validity of parameters, since we do not know there is any - -- checking of the validity on the call side. + -- If no validity checking, then we cannot assume anything about the + -- validity of parameters, since we do not know there is any checking + -- of the validity on the call side. if not Validity_Checks_On then return; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 7c9e607becb..f5090e44441 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -49,6 +49,7 @@ with Sem_Ch3; use Sem_Ch3; with Sem_Ch4; use Sem_Ch4; with Sem_Ch6; use Sem_Ch6; with Sem_Ch12; use Sem_Ch12; +with Sem_Disp; use Sem_Disp; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; with Sem_Type; use Sem_Type; @@ -1170,8 +1171,7 @@ package body Sem_Ch8 is end if; -- Check whether this declaration corresponds to the instantiation - -- of a formal subprogram. This is indicated by the presence of a - -- Corresponding_Spec that is the instantiation declaration. + -- of a formal subprogram. -- If this is an instantiation, the corresponding actual is frozen -- and error messages can be made more precise. If this is a default @@ -1182,9 +1182,9 @@ package body Sem_Ch8 is -- is determined in Find_Renamed_Entity. If the entity is an operator, -- Find_Renamed_Entity applies additional visibility checks. - if Present (Corresponding_Spec (N)) then + if Present (Corresponding_Formal_Spec (N)) then Is_Actual := True; - Inst_Node := Unit_Declaration_Node (Corresponding_Spec (N)); + Inst_Node := Unit_Declaration_Node (Corresponding_Formal_Spec (N)); if Is_Entity_Name (Nam) and then Present (Entity (Nam)) @@ -1244,8 +1244,6 @@ package body Sem_Ch8 is New_S := Analyze_Subprogram_Specification (Spec); end if; - Set_Corresponding_Spec (N, Empty); - else -- Renamed entity must be analyzed first, to avoid being hidden by -- new name (which might be the same in a generic instance). @@ -1460,6 +1458,48 @@ package body Sem_Ch8 is Set_Has_Delayed_Freeze (New_S, False); end if; + -- If the renaming corresponds to an association for an abstract + -- formal subprogram, then various attributes must be set to + -- indicate that the renaming is an abstract dispatching operation + -- with a controlling type. + + if Is_Actual + and then Is_Abstract (Corresponding_Formal_Spec (N)) + then + -- Mark the renaming as abstract here, so Find_Dispatching_Type + -- see it as corresponding to a generic association for a + -- formal abstract subprogram + + Set_Is_Abstract (New_S); + + declare + New_S_Ctrl_Type : constant Entity_Id := + Find_Dispatching_Type (New_S); + Old_S_Ctrl_Type : constant Entity_Id := + Find_Dispatching_Type (Old_S); + + begin + if Old_S_Ctrl_Type /= New_S_Ctrl_Type then + Error_Msg_NE + ("actual must be dispatching subprogram for type&", + Nam, New_S_Ctrl_Type); + + else + Set_Is_Dispatching_Operation (New_S); + Check_Controlling_Formals (New_S_Ctrl_Type, New_S); + + -- In the case where the actual in the formal subprogram + -- is itself a formal abstract subprogram association, + -- there's no dispatch table component or position to + -- inherit. + + if Present (DTC_Entity (Old_S)) then + Set_DTC_Entity (New_S, DTC_Entity (Old_S)); + Set_DT_Position (New_S, DT_Position (Old_S)); + end if; + end if; + end; + end if; end if; if not Is_Actual @@ -1488,8 +1528,12 @@ package body Sem_Ch8 is Set_Has_Delayed_Freeze (New_S, False); Freeze_Before (N, New_S); + -- An abstract subprogram is only allowed as an actual in the case + -- where the formal subprogram is also abstract. + if (Ekind (Old_S) = E_Procedure or else Ekind (Old_S) = E_Function) and then Is_Abstract (Old_S) + and then not Is_Abstract (Corresponding_Formal_Spec (N)) then Error_Msg_N ("abstract subprogram not allowed as generic actual", Nam); @@ -1816,9 +1860,7 @@ package body Sem_Ch8 is Aname = Name_Val then if Nkind (N) = N_Subprogram_Renaming_Declaration - and then Present (Corresponding_Spec (N)) - and then Nkind (Unit_Declaration_Node (Corresponding_Spec (N))) = - N_Formal_Subprogram_Declaration + and then Present (Corresponding_Formal_Spec (N)) then Error_Msg_N ("generic actual cannot be attribute involving universal type", @@ -2752,6 +2794,7 @@ package body Sem_Ch8 is if Is_Enumeration_Type (Case_Typ) and then Case_Typ /= Standard_Character and then Case_Typ /= Standard_Wide_Character + and then Case_Typ /= Standard_Wide_Wide_Character then Lit := First_Literal (Case_Typ); Get_Name_String (Chars (Lit)); @@ -4494,7 +4537,8 @@ package body Sem_Ch8 is loop if Is_Character_Type (Id) and then (Root_Type (Id) = Standard_Character - or else Root_Type (Id) = Standard_Wide_Character) + or else Root_Type (Id) = Standard_Wide_Character + or else Root_Type (Id) = Standard_Wide_Wide_Character) and then Id = Base_Type (Id) then -- We replace the node with the literal itself, resolve as a @@ -5562,7 +5606,13 @@ package body Sem_Ch8 is -- instance is declared in the wrapper package but will not be -- hidden by a use-visible entity. + -- If Id is called Standard, the predefined package with the + -- same name is in the homonym chain. It has to be ignored + -- because it has no defined scope (being the only entity in + -- the system with this mandated behavior). + elsif not Is_Hidden (Id) + and then Present (Scope (Prev)) and then not Is_Wrapper_Package (Scope (Prev)) and then Scope_Depth (Scope (Prev)) < Scope_Depth (Current_Instance) diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 7ea68f85699..9f8521bb427 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -34,15 +34,18 @@ with Exp_Tss; use Exp_Tss; with Errout; use Errout; with Hostparm; use Hostparm; with Nlists; use Nlists; +with Nmake; use Nmake; with Opt; use Opt; with Output; use Output; with Sem; use Sem; with Sem_Ch6; use Sem_Ch6; with Sem_Eval; use Sem_Eval; +with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; with Snames; use Snames; with Stand; use Stand; with Sinfo; use Sinfo; +with Tbuild; use Tbuild; with Uintp; use Uintp; package body Sem_Disp is @@ -67,8 +70,11 @@ package body Sem_Disp is function Check_Controlling_Type (T : Entity_Id; Subp : Entity_Id) return Entity_Id; - -- T is the type of a formal parameter of subp. Returns the tagged - -- if the parameter can be a controlling argument, empty otherwise + -- T is the tagged type of a formal parameter or the result of Subp. + -- If the subprogram has a controlling parameter or result that matches + -- the type, then returns the tagged type of that parameter or result + -- (returning the designated tagged type in the case of an access + -- parameter); otherwise returns empty. ------------------------------- -- Add_Dispatching_Operation -- @@ -228,13 +234,20 @@ package body Sem_Disp is return Empty; -- The dispatching type and the primitive operation must be defined - -- in the same scope except for internal operations. + -- in the same scope, except in the case of internal operations and + -- formal abstract subprograms. - elsif (Scope (Subp) = Scope (Tagged_Type) - or else Is_Internal (Subp)) - and then - (not Is_Generic_Type (Tagged_Type) - or else not Comes_From_Source (Subp)) + elsif ((Scope (Subp) = Scope (Tagged_Type) or else Is_Internal (Subp)) + and then (not Is_Generic_Type (Tagged_Type) + or else not Comes_From_Source (Subp))) + or else + (Is_Formal_Subprogram (Subp) and then Is_Abstract (Subp)) + or else + (Nkind (Parent (Parent (Subp))) = N_Subprogram_Renaming_Declaration + and then + Present (Corresponding_Formal_Spec (Parent (Parent (Subp)))) + and then + Is_Abstract (Subp)) then return Tagged_Type; @@ -248,9 +261,14 @@ package body Sem_Disp is ---------------------------- procedure Check_Dispatching_Call (N : Node_Id) is - Actual : Node_Id; - Control : Node_Id := Empty; - Func : Entity_Id; + Actual : Node_Id; + Formal : Entity_Id; + Control : Node_Id := Empty; + Func : Entity_Id; + Subp_Entity : Entity_Id; + Loc : constant Source_Ptr := Sloc (N); + Indeterm_Ancestor_Call : Boolean := False; + Indeterm_Ctrl_Type : Entity_Id; procedure Check_Dispatching_Context; -- If the call is tag-indeterminate and the entity being called is @@ -262,21 +280,21 @@ package body Sem_Disp is ------------------------------- procedure Check_Dispatching_Context is - Func : constant Entity_Id := Entity (Name (N)); + Subp : constant Entity_Id := Entity (Name (N)); Par : Node_Id; begin - if Is_Abstract (Func) + if Is_Abstract (Subp) and then No (Controlling_Argument (N)) then - if Present (Alias (Func)) - and then not Is_Abstract (Alias (Func)) - and then No (DTC_Entity (Func)) + if Present (Alias (Subp)) + and then not Is_Abstract (Alias (Subp)) + and then No (DTC_Entity (Subp)) then -- Private overriding of inherited abstract operation, -- call is legal. - Set_Entity (Name (N), Alias (Func)); + Set_Entity (Name (N), Alias (Subp)); return; else @@ -289,7 +307,7 @@ package body Sem_Disp is Nkind (Par) = N_Assignment_Statement or else Nkind (Par) = N_Op_Eq or else Nkind (Par) = N_Op_Ne) - and then Is_Tagged_Type (Etype (Func)) + and then Is_Tagged_Type (Etype (Subp)) then return; @@ -299,8 +317,20 @@ package body Sem_Disp is Par := Parent (Par); else - Error_Msg_N - ("call to abstract function must be dispatching", N); + if Ekind (Subp) = E_Function then + Error_Msg_N + ("call to abstract function must be dispatching", N); + + -- This error can occur for a procedure in the case of a + -- call to an abstract formal procedure with a statically + -- tagged operand. + + else + Error_Msg_N + ("call to abstract procedure must be dispatching", + N); + end if; + return; end if; end loop; @@ -316,12 +346,53 @@ package body Sem_Disp is if Present (Parameter_Associations (N)) then Actual := First_Actual (N); + Subp_Entity := Entity (Name (N)); + Formal := First_Formal (Subp_Entity); + while Present (Actual) loop Control := Find_Controlling_Arg (Actual); exit when Present (Control); + + -- Check for the case where the actual is a tag-indeterminate call + -- whose result type is different than the tagged type associated + -- with the containing call, but is an ancestor of the type. + + if Is_Controlling_Formal (Formal) + and then Is_Tag_Indeterminate (Actual) + and then Base_Type (Etype (Actual)) /= Base_Type (Etype (Formal)) + and then Is_Ancestor (Etype (Actual), Etype (Formal)) + then + Indeterm_Ancestor_Call := True; + Indeterm_Ctrl_Type := Etype (Formal); + end if; + Next_Actual (Actual); + Next_Formal (Formal); end loop; + -- If the call doesn't have a controlling actual but does have + -- an indeterminate actual that requires dispatching treatment, + -- then an object is needed that will serve as the controlling + -- argument for a dispatching call on the indeterminate actual. + -- This can only occur in the unusual situation of a default + -- actual given by a tag-indeterminate call and where the type + -- of the call is an ancestor of the type associated with a + -- containing call to an inherited operation (see AI-239). + -- Rather than create an object of the tagged type, which would + -- be problematic for various reasons (default initialization, + -- discriminants), the tag of the containing call's associated + -- tagged type is directly used to control the dispatching. + + if not Present (Control) + and then Indeterm_Ancestor_Call + then + Control := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Indeterm_Ctrl_Type, Loc), + Attribute_Name => Name_Tag); + Analyze (Control); + end if; + if Present (Control) then -- Verify that no controlling arguments are statically tagged @@ -338,10 +409,10 @@ package body Sem_Disp is if Actual /= Control then if not Is_Controlling_Actual (Actual) then - null; -- can be anything + null; -- Can be anything elsif Is_Dynamically_Tagged (Actual) then - null; -- valid parameter + null; -- Valid parameter elsif Is_Tag_Indeterminate (Actual) then @@ -369,8 +440,8 @@ package body Sem_Disp is Set_Controlling_Argument (N, Control); else - -- The call is not dispatching, check that there isn't any - -- tag indeterminate abstract call left + -- The call is not dispatching, so check that there aren't any + -- tag-indeterminate abstract calls left. Actual := First_Actual (N); @@ -1159,7 +1230,7 @@ package body Sem_Disp is -- calls and would have to undo any expansion to an indirect call. if not Java_VM then - Expand_Dispatch_Call (Call_Node); + Expand_Dispatching_Call (Call_Node); end if; end Propagate_Tag; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 5416e969658..d0d536d68b6 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -1115,8 +1115,27 @@ package body Sem_Eval is if Is_Modular_Integer_Type (Ltype) then Result := Result mod Modulus (Ltype); + + -- For a signed integer type, check non-static overflow + + elsif (not Stat) and then Is_Signed_Integer_Type (Ltype) then + declare + BT : constant Entity_Id := Base_Type (Ltype); + Lo : constant Uint := Expr_Value (Type_Low_Bound (BT)); + Hi : constant Uint := Expr_Value (Type_High_Bound (BT)); + begin + if Result < Lo or else Result > Hi then + Apply_Compile_Time_Constraint_Error + (N, "value not in range of }?", + CE_Overflow_Check_Failed, + Ent => BT); + return; + end if; + end; end if; + -- If we get here we can fold the result + Fold_Uint (N, Result, Stat); end; @@ -1175,7 +1194,6 @@ package body Sem_Eval is procedure Eval_Character_Literal (N : Node_Id) is pragma Warnings (Off, N); - begin null; end Eval_Character_Literal; @@ -1259,7 +1277,8 @@ package body Sem_Eval is Test_Expression_Is_Foldable (N, Left, Right, Stat, Fold); if (C_Typ = Standard_Character - or else C_Typ = Standard_Wide_Character) + or else C_Typ = Standard_Wide_Character + or else C_Typ = Standard_Wide_Wide_Character) and then Fold then null; @@ -1268,7 +1287,7 @@ package body Sem_Eval is return; end if; - -- Compile time string concatenation. + -- Compile time string concatenation -- ??? Note that operands that are aggregates can be marked as -- static, so we should attempt at a later stage to fold @@ -1292,7 +1311,7 @@ package body Sem_Eval is Start_String (Strval (Left_Str)); else Start_String; - Store_String_Char (Char_Literal_Value (Left_Str)); + Store_String_Char (UI_To_CC (Char_Literal_Value (Left_Str))); Left_Len := 1; end if; @@ -1308,7 +1327,7 @@ package body Sem_Eval is end loop; end; else - Store_String_Char (Char_Literal_Value (Right_Str)); + Store_String_Char (UI_To_CC (Char_Literal_Value (Right_Str))); end if; Set_Is_Static_Expression (N, Stat); @@ -1402,7 +1421,7 @@ package body Sem_Eval is end if; end if; - -- Fall through if the name is not static. + -- Fall through if the name is not static Validate_Static_Object_Name (N); end Eval_Entity_Name; @@ -2500,7 +2519,7 @@ package body Sem_Eval is -- Start of processing for Eval_Type_Conversion begin - -- Cannot fold if target type is non-static or if semantic error. + -- Cannot fold if target type is non-static or if semantic error if not Is_Static_Subtype (Target_Type) then Check_Non_Static_Context (Operand); @@ -2528,7 +2547,7 @@ package body Sem_Eval is -- following type test, fixed-point counts as real unless the flag -- Conversion_OK is set, in which case it counts as integer. - -- Fold conversion, case of string type. The result is not static. + -- Fold conversion, case of string type. The result is not static if Is_String_Type (Target_Type) then Fold_Str (N, Strval (Get_String_Val (Operand)), False); @@ -2747,7 +2766,7 @@ package body Sem_Eval is -- their Pos value as usual which is the same as the Rep value. if No (Ent) then - return UI_From_Int (Int (Char_Literal_Value (N))); + return Char_Literal_Value (N); else return Enumeration_Rep (Ent); end if; @@ -2827,7 +2846,7 @@ package body Sem_Eval is -- their Pos value as usual. if No (Ent) then - Val := UI_From_Int (Int (Char_Literal_Value (N))); + Val := Char_Literal_Value (N); else Val := Enumeration_Pos (Ent); end if; @@ -3207,7 +3226,7 @@ package body Sem_Eval is Valr : Ureal; begin - -- Universal types have no range limits, so always in range. + -- Universal types have no range limits, so always in range if Typ = Universal_Integer or else Typ = Universal_Real then return True; @@ -3218,7 +3237,7 @@ package body Sem_Eval is elsif not Is_Scalar_Type (Typ) then return False; - -- Never in range unless we have a compile time known value. + -- Never in range unless we have a compile time known value elsif not Compile_Time_Known_Value (N) then return False; @@ -3388,7 +3407,7 @@ package body Sem_Eval is Valr : Ureal; begin - -- Universal types have no range limits, so always in range. + -- Universal types have no range limits, so always in range if Typ = Universal_Integer or else Typ = Universal_Real then return False; @@ -3477,7 +3496,7 @@ package body Sem_Eval is -- Is_Static_Subtype -- ----------------------- - -- Determines if Typ is a static subtype as defined in (RM 4.9(26)). + -- Determines if Typ is a static subtype as defined in (RM 4.9(26)) function Is_Static_Subtype (Typ : Entity_Id) return Boolean is Base_T : constant Entity_Id := Base_Type (Typ); @@ -3794,6 +3813,16 @@ package body Sem_Eval is or else Comes_From_Source (T2)) then return False; + + -- A generic scalar type does not statically match its base + -- type (AI-311). In this case we make sure that the formals, + -- which are first subtypes of their bases, are constrained. + + elsif Is_Generic_Type (T1) + and then Is_Generic_Type (T2) + and then (Is_Constrained (T1) /= Is_Constrained (T2)) + then + return False; end if; -- If there was an error in either range, then just assume @@ -3905,7 +3934,7 @@ package body Sem_Eval is return True; - -- A definite type does not match an indefinite or classwide type. + -- A definite type does not match an indefinite or classwide type elsif Has_Unknown_Discriminants (T1) /= Has_Unknown_Discriminants (T2) @@ -4085,7 +4114,7 @@ package body Sem_Eval is Fold := False; return; - -- Exclude expressions of a generic modular type, as above. + -- Exclude expressions of a generic modular type, as above elsif Is_Modular_Integer_Type (Etype (Op1)) and then Is_Generic_Type (Etype (Op1)) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 6ece74120d0..408024b3715 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -4306,14 +4306,32 @@ package body Sem_Prag is ------------ -- pragma Ada_05; + -- pragma Ada_05 (LOCAL_NAME); -- Note: this pragma also has some specific processing in Par.Prag - -- because we want to set the Ada 83 version mode during parsing. + -- because we want to set the Ada 2005 version mode during parsing. + + when Pragma_Ada_05 => declare + E_Id : Node_Id; - when Pragma_Ada_05 => + begin GNAT_Pragma; - Ada_Version := Ada_05; - Check_Arg_Count (0); + + if Arg_Count = 1 then + Check_Arg_Is_Local_Name (Arg1); + E_Id := Expression (Arg1); + + if Etype (E_Id) = Any_Type then + return; + end if; + + Set_Is_Ada_2005 (Entity (E_Id)); + + else + Ada_Version := Ada_05; + Check_Arg_Count (0); + end if; + end; ---------------------- -- All_Calls_Remote -- @@ -5623,7 +5641,19 @@ package body Sem_Prag is then Set_Elaborate_Present (Citem, True); Set_Unit_Name (Expression (Arg), Name (Citem)); - Set_Suppress_Elaboration_Warnings (Entity (Name (Citem))); + + -- With the pragma present, elaboration calls on + -- subprograms from the named unit need no further + -- checks, as long as the pragma appears in the current + -- compilation unit. If the pragma appears in some unit + -- in the context, there might still be a need for an + -- Elaborate_All_Desirable from the current compilation + -- to the the named unit, so we keep the check enabled. + + if In_Extended_Main_Source_Unit (N) then + Set_Suppress_Elaboration_Warnings + (Entity (Name (Citem))); + end if; exit Inner; end if; @@ -5708,7 +5738,15 @@ package body Sem_Prag is then Set_Elaborate_All_Present (Citem, True); Set_Unit_Name (Expression (Arg), Name (Citem)); - Set_Suppress_Elaboration_Warnings (Entity (Name (Citem))); + + -- Suppress warnings and elaboration checks on the named + -- unit if the pragma is in the current compilation, as + -- for pragma Elaborate. + + if In_Extended_Main_Source_Unit (N) then + Set_Suppress_Elaboration_Warnings + (Entity (Name (Citem))); + end if; exit Innr; end if; @@ -7935,21 +7973,63 @@ package body Sem_Prag is -- pragma Obsolescent [(static_string_EXPRESSION)]; when Pragma_Obsolescent => Obsolescent : declare + Subp : Node_Or_Entity_Id; + S : String_Id; + begin GNAT_Pragma; Check_At_Most_N_Arguments (1); Check_No_Identifiers; - if Arg_Count = 1 then - Check_Arg_Is_Static_Expression (Arg1, Standard_String); - end if; + -- Check OK placement - if No (Prev (N)) - or else (Nkind (Prev (N))) /= N_Subprogram_Declaration + -- First possibility is within a declarative region, where the + -- pragma immediately follows a subprogram declaration. + + if Present (Prev (N)) then + Subp := Prev (N); + + -- Second possibility, stand alone subprogram declaration with the + -- pragma immediately following the declaration. + + elsif No (Prev (N)) + and then Nkind (Parent (N)) = N_Compilation_Unit_Aux then + Subp := Unit (Parent (Parent (N))); + + -- Any other possibility is a misplacement + + else + Subp := Empty; + end if; + + -- Check correct placement + + if Nkind (Subp) /= N_Subprogram_Declaration then Error_Pragma ("pragma% misplaced, must immediately " & "follow subprogram spec"); + + -- If OK placement, set flag and acquire argument + + else + Subp := Defining_Entity (Subp); + Set_Is_Obsolescent (Subp); + + if Arg_Count = 1 then + Check_Arg_Is_Static_Expression (Arg1, Standard_String); + S := Strval (Expression (Arg1)); + + for J in 1 .. String_Length (S) loop + if not In_Character_Range (Get_String_Char (S, J)) then + Error_Pragma_Arg + ("pragma% argument does not allow wide characters", + Arg1); + end if; + end loop; + + Set_Obsolescent_Warning (Subp, Expression (Arg1)); + end if; end if; end Obsolescent; @@ -8023,13 +8103,6 @@ package body Sem_Prag is when Pragma_Optional_Overriding => Error_Msg_N ("pragma must appear immediately after subprogram", N); - ---------------- - -- Overriding -- - ---------------- - - when Pragma_Overriding => - Error_Msg_N ("pragma must appear immediately after subprogram", N); - ---------- -- Pack -- ---------- @@ -10325,7 +10398,6 @@ package body Sem_Prag is Pragma_Obsolescent => 0, Pragma_Optimize => -1, Pragma_Optional_Overriding => -1, - Pragma_Overriding => -1, Pragma_Pack => 0, Pragma_Page => -1, Pragma_Passive => -1, diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index b89f82b0097..af752663422 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -1449,7 +1449,8 @@ package body Sem_Res is Rewrite (N, Make_Character_Literal (Sloc (N), Chars => Name_Find, - Char_Literal_Value => Char_Code (Character'Pos ('A')))); + Char_Literal_Value => + UI_From_Int (Character'Pos ('A')))); Set_Etype (N, Any_Character); Set_Is_Static_Expression (N); @@ -2721,9 +2722,11 @@ package body Sem_Res is or else Can_Never_Be_Null (F_Typ)) then if Nkind (A) = N_Null then - Error_Msg_NE - ("(Ada 2005) not allowed for " & - "null-exclusion formal", A, F_Typ); + Apply_Compile_Time_Constraint_Error + (N => A, + Msg => "(Ada 2005) NULL not allowed in " + & "null-excluding formal?", + Reason => CE_Null_Not_Allowed); end if; end if; end if; @@ -2807,7 +2810,7 @@ package body Sem_Res is then Error_Msg_Node_2 := F_Typ; Error_Msg_NE - ("& is not a primitive operation of &!", A, Nam); + ("& is not a dispatching operation of &!", A, Nam); end if; elsif Is_Access_Type (A_Typ) @@ -2828,7 +2831,7 @@ package body Sem_Res is then Error_Msg_Node_2 := Designated_Type (F_Typ); Error_Msg_NE - ("& is not a primitive operation of &!", A, Nam); + ("& is not a dispatching operation of &!", A, Nam); end if; end if; @@ -3433,7 +3436,7 @@ package body Sem_Res is It : Interp; Norm_OK : Boolean; Scop : Entity_Id; - Decl : Node_Id; + W : Node_Id; begin -- The context imposes a unique interpretation with type Typ on @@ -3576,31 +3579,30 @@ package body Sem_Res is -- Check for call to obsolescent subprogram - if Warn_On_Obsolescent_Feature then - Decl := Parent (Parent (Nam)); + if Warn_On_Obsolescent_Feature + and then Is_Subprogram (Nam) + and then Is_Obsolescent (Nam) + then + Error_Msg_NE ("call to obsolescent subprogram&?", N, Nam); - if Nkind (Decl) = N_Subprogram_Declaration - and then Is_List_Member (Decl) - and then Nkind (Next (Decl)) = N_Pragma - then - declare - P : constant Node_Id := Next (Decl); + -- Output additional warning if present - begin - if Chars (P) = Name_Obsolescent then - Error_Msg_NE ("call to obsolescent subprogram&?", N, Nam); - - if Pragma_Argument_Associations (P) /= No_List then - Name_Buffer (1) := '|'; - Name_Buffer (2) := '?'; - Name_Len := 2; - Add_String_To_Name_Buffer - (Strval (Expression - (First (Pragma_Argument_Associations (P))))); - Error_Msg_N (Name_Buffer (1 .. Name_Len), N); - end if; - end if; - end; + W := Obsolescent_Warning (Nam); + + if Present (W) then + Name_Buffer (1) := '|'; + Name_Buffer (2) := '?'; + Name_Len := 2; + + -- Add characters to message, protecting all of them + + for J in 1 .. String_Length (Strval (W)) loop + Add_Char_To_Name_Buffer ('''); + Add_Char_To_Name_Buffer + (Get_Character (Get_String_Char (Strval (W), J))); + end loop; + + Error_Msg_N (Name_Buffer (1 .. Name_Len), N); end if; end if; @@ -3906,11 +3908,12 @@ package body Sem_Res is Set_Etype (N, B_Typ); Eval_Character_Literal (N); - -- Wide_Character literals must always be defined, since the set of - -- wide character literals is complete, i.e. if a character literal - -- is accepted by the parser, then it is OK for wide character. + -- Wide_Wide_Character literals must always be defined, since the set + -- of wide wide character literals is complete, i.e. if a character + -- literal is accepted by the parser, then it is OK for wide wide + -- character (out of range character literals are rejected). - if Root_Type (B_Typ) = Standard_Wide_Character then + if Root_Type (B_Typ) = Standard_Wide_Wide_Character then return; -- Always accept character literal for type Any_Character, which @@ -3924,10 +3927,24 @@ package body Sem_Res is -- the literal is in range elsif Root_Type (B_Typ) = Standard_Character then - if In_Character_Range (Char_Literal_Value (N)) then + if In_Character_Range (UI_To_CC (Char_Literal_Value (N))) then + return; + end if; + + -- For Standard.Wide_Character or a type derived from it, check + -- that the literal is in range + + elsif Root_Type (B_Typ) = Standard_Wide_Character then + if In_Wide_Character_Range (UI_To_CC (Char_Literal_Value (N))) then return; end if; + -- For Standard.Wide_Wide_Character or a type derived from it, we + -- know the literal is in range, since the parser checked! + + elsif Root_Type (B_Typ) = Standard_Wide_Wide_Character then + return; + -- If the entity is already set, this has already been resolved in -- a generic context, or comes from expansion. Nothing else to do. @@ -5823,10 +5840,11 @@ package body Sem_Res is Resolve (P, T); end if; - -- Deal with access type case + -- If prefix is an access type, the node will be transformed into + -- an explicit dereference during expansion. The type of the node + -- is the designated type of that of the prefix. if Is_Access_Type (Etype (P)) then - Apply_Access_Check (N); T := Designated_Type (Etype (P)); else T := Etype (P); @@ -5977,6 +5995,26 @@ package body Sem_Res is Apply_Access_Check (N); Array_Type := Designated_Type (Array_Type); + -- If the prefix is an access to an unconstrained array, we must + -- use the actual subtype of the object to perform the index checks. + -- The object denoted by the prefix is implicit in the node, so we + -- build an explicit representation for it in order to compute the + -- actual subtype. + + if not Is_Constrained (Array_Type) then + Remove_Side_Effects (Prefix (N)); + + declare + Obj : constant Node_Id := + Make_Explicit_Dereference (Sloc (N), + Prefix => New_Copy_Tree (Prefix (N))); + begin + Set_Etype (Obj, Array_Type); + Set_Parent (Obj, Parent (N)); + Array_Type := Get_Actual_Subtype (Obj); + end; + end if; + elsif Is_Entity_Name (Name) or else (Nkind (Name) = N_Function_Call and then not Is_Constrained (Etype (Name))) @@ -5989,7 +6027,7 @@ package body Sem_Res is Set_Etype (N, Array_Type); -- If the range is specified by a subtype mark, no resolution - -- is necessary. + -- is necessary. Else resolve the bounds, and apply needed checks. if not Is_Entity_Name (Drange) then Index := First_Index (Array_Type); @@ -6037,7 +6075,8 @@ package body Sem_Res is or else Nkind (Parent (N)) /= N_Op_Concat or else (N /= Left_Opnd (Parent (N)) and then N /= Right_Opnd (Parent (N))) - or else (Typ = Standard_Wide_String + or else ((Typ = Standard_Wide_String + or else Typ = Standard_Wide_Wide_String) and then Nkind (Original_Node (N)) /= N_String_Literal); -- If the resolving type is itself a string literal subtype, we @@ -6097,21 +6136,21 @@ package body Sem_Res is elsif Is_Bit_Packed_Array (Typ) then null; - -- Deal with cases of Wide_String and String + -- Deal with cases of Wide_Wide_String, Wide_String, and String else - -- For Standard.Wide_String, or any other type whose component - -- type is Standard.Wide_Character, we know that all the + -- For Standard.Wide_Wide_String, or any other type whose component + -- type is Standard.Wide_Wide_Character, we know that all the -- characters in the string must be acceptable, since the parser -- accepted the characters as valid character literals. - if R_Typ = Standard_Wide_Character then + if R_Typ = Standard_Wide_Wide_Character then null; -- For the case of Standard.String, or any other type whose -- component type is Standard.Character, we must make sure that -- there are no wide characters in the string, i.e. that it is - -- entirely composed of characters in range of type String. + -- entirely composed of characters in range of type Character. -- If the string literal is the result of a static concatenation, -- the test has already been performed on the components, and need @@ -6128,7 +6167,36 @@ package body Sem_Res is -- a token, right under the offending wide character. Error_Msg - ("literal out of range of type Character", + ("literal out of range of type Standard.Character", + Source_Ptr (Int (Loc) + J)); + return; + end if; + end loop; + + -- For the case of Standard.Wide_String, or any other type whose + -- component type is Standard.Wide_Character, we must make sure that + -- there are no wide characters in the string, i.e. that it is + -- entirely composed of characters in range of type Wide_Character. + + -- If the string literal is the result of a static concatenation, + -- the test has already been performed on the components, and need + -- not be repeated. + + elsif R_Typ = Standard_Wide_Character + and then Nkind (Original_Node (N)) /= N_Op_Concat + then + for J in 1 .. Strlen loop + if not In_Wide_Character_Range (Get_String_Char (Str, J)) then + + -- If we are out of range, post error. This is one of the + -- very few places that we place the flag in the middle of + -- a token, right under the offending wide character. + + -- This is not quite right, because characters in general + -- will take more than one character position ??? + + Error_Msg + ("literal out of range of type Standard.Wide_Character", Source_Ptr (Int (Loc) + J)); return; end if; @@ -6136,11 +6204,10 @@ package body Sem_Res is -- If the root type is not a standard character, then we will convert -- the string into an aggregate and will let the aggregate code do - -- the checking. + -- the checking. Standard Wide_Wide_Character is also OK here. else null; - end if; -- See if the component type of the array corresponding to the @@ -6150,8 +6217,9 @@ package body Sem_Res is -- the corresponding character aggregate and let the aggregate -- code do the checking. - if R_Typ = Standard_Wide_Character - or else R_Typ = Standard_Character + if R_Typ = Standard_Character + or else R_Typ = Standard_Wide_Character + or else R_Typ = Standard_Wide_Wide_Character then -- Check for the case of full range, where we are definitely OK @@ -6210,7 +6278,9 @@ package body Sem_Res is Set_Character_Literal_Name (C); Append_To (Lits, - Make_Character_Literal (P, Name_Find, C)); + Make_Character_Literal (P, + Chars => Name_Find, + Char_Literal_Value => UI_From_CC (C))); if In_Character_Range (C) then P := P + 1; @@ -6280,9 +6350,13 @@ package body Sem_Res is if Unique_Fixed_Point_Type (N) = Any_Type then return; -- expression is ambiguous. else + -- If nothing else, the available fixed type is Duration. + Set_Etype (Operand, Standard_Duration); end if; + -- Resolve the real operand with largest available precision. + if Etype (Right_Opnd (Operand)) = Universal_Real then Rop := New_Copy_Tree (Right_Opnd (Operand)); else @@ -6291,7 +6365,12 @@ package body Sem_Res is Resolve (Rop, Standard_Long_Long_Float); - if Realval (Rop) /= Ureal_0 + -- If the operand is a literal (it could be a non-static and + -- illegal exponentiation) check whether the use of Duration + -- is potentially inaccurate. + + if Nkind (Rop) = N_Real_Literal + and then Realval (Rop) /= Ureal_0 and then abs (Realval (Rop)) < Delta_Value (Standard_Duration) then Error_Msg_N ("universal real operand can only be interpreted?", diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index cc0cc6fd43b..5993fbb371c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -985,7 +985,7 @@ package body Sem_Util is if Is_Overloadable (Id) and then Nkind (Parent (Parent (Id))) - /= N_Formal_Subprogram_Declaration + not in N_Formal_Subprogram_Declaration then Is_Prim := False; @@ -2526,23 +2526,23 @@ package body Sem_Util is Loc : Source_Ptr) return Node_Id is Lit : Node_Id; - P : constant Nat := UI_To_Int (Pos); begin - -- In the case where the literal is either of type Wide_Character - -- or Character or of a type derived from them, there needs to be - -- some special handling since there is no explicit chain of - -- literals to search. Instead, an N_Character_Literal node is - -- created with the appropriate Char_Code and Chars fields. + -- In the case where the literal is of type Character, Wide_Character + -- or Wide_Wide_Character or of a type derived from them, there needs + -- to be some special handling since there is no explicit chain of + -- literals to search. Instead, an N_Character_Literal node is created + -- with the appropriate Char_Code and Chars fields. if Root_Type (T) = Standard_Character or else Root_Type (T) = Standard_Wide_Character + or else Root_Type (T) = Standard_Wide_Wide_Character then - Set_Character_Literal_Name (Char_Code (P)); + Set_Character_Literal_Name (UI_To_CC (Pos)); return Make_Character_Literal (Loc, - Chars => Name_Find, - Char_Literal_Value => Char_Code (P)); + Chars => Name_Find, + Char_Literal_Value => Pos); -- For all other cases, we have a complete table of literals, and -- we simply iterate through the chain of literal until the one @@ -2551,7 +2551,7 @@ package body Sem_Util is else Lit := First_Literal (Base_Type (T)); - for J in 1 .. P loop + for J in 1 .. UI_To_Int (Pos) loop Next_Literal (Lit); end loop; @@ -2565,7 +2565,6 @@ package body Sem_Util is function Get_Generic_Entity (N : Node_Id) return Entity_Id is Ent : constant Entity_Id := Entity (Name (N)); - begin if Present (Renamed_Object (Ent)) then return Renamed_Object (Ent); @@ -4591,6 +4590,18 @@ package body Sem_Util is begin if Is_Access_Type (Etype (P)) then return not Is_Access_Constant (Root_Type (Etype (P))); + + -- For the case of an indexed component whose prefix has a packed + -- array type, the prefix has been rewritten into a type conversion. + -- Determine variable-ness from the converted expression. + + elsif Nkind (P) = N_Type_Conversion + and then not Comes_From_Source (P) + and then Is_Array_Type (Etype (P)) + and then Is_Packed (Etype (P)) + then + return Is_Variable (Expression (P)); + else return Is_Variable (P); end if; @@ -6465,7 +6476,6 @@ package body Sem_Util is while Nkind (N) /= N_Abstract_Subprogram_Declaration and then Nkind (N) /= N_Formal_Package_Declaration - and then Nkind (N) /= N_Formal_Subprogram_Declaration and then Nkind (N) /= N_Function_Instantiation and then Nkind (N) /= N_Generic_Package_Declaration and then Nkind (N) /= N_Generic_Subprogram_Declaration @@ -6481,6 +6491,7 @@ package body Sem_Util is and then Nkind (N) /= N_Subprogram_Renaming_Declaration and then Nkind (N) /= N_Task_Body and then Nkind (N) /= N_Task_Type_Declaration + and then Nkind (N) not in N_Formal_Subprogram_Declaration and then Nkind (N) not in N_Generic_Renaming_Declaration loop N := Parent (N); diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 65ee94ef2c0..33f330143e5 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -315,7 +315,7 @@ package body Sinfo is pragma Assert (False or else NT (N).Nkind = N_Component_Association or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Formal_Subprogram_Declaration); + or else NT (N).Nkind in N_Formal_Subprogram_Declaration); return Flag15 (N); end Box_Present; @@ -328,11 +328,11 @@ package body Sinfo is end By_Ref; function Char_Literal_Value - (N : Node_Id) return Char_Code is + (N : Node_Id) return Uint is begin pragma Assert (False or else NT (N).Nkind = N_Character_Literal); - return Char_Code2 (N); + return Uint2 (N); end Char_Literal_Value; function Chars @@ -539,6 +539,14 @@ package body Sinfo is return Node5 (N); end Corresponding_Body; + function Corresponding_Formal_Spec + (N : Node_Id) return Node_Id is + begin + pragma Assert (False + or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); + return Node3 (N); + end Corresponding_Formal_Spec; + function Corresponding_Generic_Association (N : Node_Id) return Node_Id is begin @@ -620,7 +628,7 @@ package body Sinfo is (N : Node_Id) return Node_Id is begin pragma Assert (False - or else NT (N).Nkind = N_Formal_Subprogram_Declaration); + or else NT (N).Nkind in N_Formal_Subprogram_Declaration); return Node2 (N); end Default_Name; @@ -2288,14 +2296,14 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Abstract_Subprogram_Declaration - or else NT (N).Nkind = N_Formal_Subprogram_Declaration or else NT (N).Nkind = N_Generic_Package_Declaration or else NT (N).Nkind = N_Generic_Subprogram_Declaration or else NT (N).Nkind = N_Package_Declaration or else NT (N).Nkind = N_Subprogram_Body or else NT (N).Nkind = N_Subprogram_Body_Stub or else NT (N).Nkind = N_Subprogram_Declaration - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); + or else NT (N).Nkind = N_Subprogram_Renaming_Declaration + or else NT (N).Nkind in N_Formal_Subprogram_Declaration); return Node1 (N); end Specification; @@ -2809,7 +2817,7 @@ package body Sinfo is pragma Assert (False or else NT (N).Nkind = N_Component_Association or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Formal_Subprogram_Declaration); + or else NT (N).Nkind in N_Formal_Subprogram_Declaration); Set_Flag15 (N, Val); end Set_Box_Present; @@ -2822,11 +2830,11 @@ package body Sinfo is end Set_By_Ref; procedure Set_Char_Literal_Value - (N : Node_Id; Val : Char_Code) is + (N : Node_Id; Val : Uint) is begin pragma Assert (False or else NT (N).Nkind = N_Character_Literal); - Set_Char_Code2 (N, Val); + Set_Uint2 (N, Val); end Set_Char_Literal_Value; procedure Set_Chars @@ -3033,6 +3041,14 @@ package body Sinfo is Set_Node5 (N, Val); -- semantic field, no parent set end Set_Corresponding_Body; + procedure Set_Corresponding_Formal_Spec + (N : Node_Id; Val : Node_Id) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); + Set_Node3 (N, Val); -- semantic field, no parent set + end Set_Corresponding_Formal_Spec; + procedure Set_Corresponding_Generic_Association (N : Node_Id; Val : Node_Id) is begin @@ -3041,6 +3057,7 @@ package body Sinfo is or else NT (N).Nkind = N_Object_Renaming_Declaration); Set_Node5 (N, Val); -- semantic field, no parent set end Set_Corresponding_Generic_Association; + procedure Set_Corresponding_Integer_Value (N : Node_Id; Val : Uint) is begin @@ -3113,7 +3130,7 @@ package body Sinfo is (N : Node_Id; Val : Node_Id) is begin pragma Assert (False - or else NT (N).Nkind = N_Formal_Subprogram_Declaration); + or else NT (N).Nkind in N_Formal_Subprogram_Declaration); Set_Node2_With_Parent (N, Val); end Set_Default_Name; @@ -4772,14 +4789,14 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Abstract_Subprogram_Declaration - or else NT (N).Nkind = N_Formal_Subprogram_Declaration or else NT (N).Nkind = N_Generic_Package_Declaration or else NT (N).Nkind = N_Generic_Subprogram_Declaration or else NT (N).Nkind = N_Package_Declaration or else NT (N).Nkind = N_Subprogram_Body or else NT (N).Nkind = N_Subprogram_Body_Stub or else NT (N).Nkind = N_Subprogram_Declaration - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); + or else NT (N).Nkind = N_Subprogram_Renaming_Declaration + or else NT (N).Nkind in N_Formal_Subprogram_Declaration); Set_Node1_With_Parent (N, Val); end Set_Specification; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 7048cd48d02..bfbbdf838e2 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -650,7 +650,9 @@ package Sinfo is -- Procedure calls, the Controlling_Argument is one of the actuals. -- For a function that has a dispatching result, it is an entity in -- the context of the call that can provide a tag, or else it is the - -- tag of the root type of the class. + -- tag of the root type of the class. It can also specify a tag + -- directly rather than being a tagged object. The latter is needed + -- by the implementations of AI-239 and AI-260. -- Conversion_OK (Flag14-Sem) -- A flag set on type conversion nodes to indicate that the conversion @@ -670,6 +672,13 @@ package Sinfo is -- points to the defining entity for the corresponding body (NOT the -- node for the body itself). + -- Corresponding_Formal_Spec (Node3-Sem) + -- This field is set in subprogram renaming declarations, where it points + -- to the defining entity for a formal subprogram in the case where the + -- renaming corresponds to a generic formal subprogram association in an + -- instantiation. The field is Empty if the renaming does not correspond + -- to such a formal association. + -- Corresponding_Generic_Association (Node5-Sem) -- This field is defined for object declarations and object renaming -- declarations. It is set for the declarations within an instance that @@ -1666,6 +1675,12 @@ package Sinfo is -- using the standard literal format. Such literals are listed by -- Sprint using the notation [numerator / denominator]. + -- Note: the value of an integer literal node created by the front end + -- is never outside the range of values of the base type. However, it + -- can be the case that the value is outside the range of the + -- particular subtype. This happens in the case of integer overflows + -- with checks suppressed. + -- N_Integer_Literal -- Sloc points to literal -- Original_Entity (Node2-Sem) If not Empty, holds Named_Number that @@ -1709,7 +1724,7 @@ package Sinfo is -- N_Character_Literal -- Sloc points to literal -- Chars (Name1) contains the Name_Id for the identifier - -- Char_Literal_Value (Char_Code2) contains the literal value + -- Char_Literal_Value (Uint2) contains the literal value -- Entity (Node4-Sem) -- Associated_Node (Node4-Sem) -- Has_Private_View (Flag11-Sem) set in generic units. @@ -4382,6 +4397,7 @@ package Sinfo is -- Name (Node2) -- Parent_Spec (Node4-Sem) -- Corresponding_Spec (Node5-Sem) + -- Corresponding_Formal_Spec (Node3-Sem) -- From_Default (Flag6-Sem) ----------------------------------------- @@ -5679,9 +5695,33 @@ package Sinfo is ----------------------------------------- -- FORMAL_SUBPROGRAM_DECLARATION ::= + -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION + -- | FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION + + -------------------------------------------------- + -- 12.6 Formal Concrete Subprogram Declaration -- + -------------------------------------------------- + + -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION ::= -- with SUBPROGRAM_SPECIFICATION [is SUBPROGRAM_DEFAULT]; - -- N_Formal_Subprogram_Declaration + -- N_Formal_Concrete_Subprogram_Declaration + -- Sloc points to WITH + -- Specification (Node1) + -- Default_Name (Node2) (set to Empty if no subprogram default) + -- Box_Present (Flag15) + + -- Note: if no subprogram default is present, then Name is set + -- to Empty, and Box_Present is False. + + -------------------------------------------------- + -- 12.6 Formal Abstract Subprogram Declaration -- + -------------------------------------------------- + + -- FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION ::= + -- with SUBPROGRAM_SPECIFICATION is abstract [SUBPROGRAM_DEFAULT]; + + -- N_Formal_Abstract_Subprogram_Declaration -- Sloc points to WITH -- Specification (Node1) -- Default_Name (Node2) (set to Empty if no subprogram default) @@ -5697,8 +5737,9 @@ package Sinfo is -- SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <> -- There is no separate node in the tree for a subprogram default. - -- Instead the parent (N_Formal_Subprogram_Declaration) node contains - -- the default name or box indication, as needed. + -- Instead the parent (N_Formal_Concrete_Subprogram_Declaration + -- or N_Formal_Abstract_Subprogram_Declaration) node contains the + -- default name or box indication, as needed. ------------------------ -- 12.6 Default Name -- @@ -6720,6 +6761,8 @@ package Sinfo is N_Exception_Declaration, N_Exception_Handler, N_Floating_Point_Definition, + N_Formal_Abstract_Subprogram_Declaration, + N_Formal_Concrete_Subprogram_Declaration, N_Formal_Decimal_Fixed_Point_Definition, N_Formal_Derived_Type_Definition, N_Formal_Discrete_Type_Definition, @@ -6729,7 +6772,6 @@ package Sinfo is N_Formal_Package_Declaration, N_Formal_Private_Type_Definition, N_Formal_Signed_Integer_Type_Definition, - N_Formal_Subprogram_Declaration, N_Generic_Association, N_Handled_Sequence_Of_Statements, N_Index_Or_Discriminant_Constraint, @@ -6796,6 +6838,10 @@ package Sinfo is N_Defining_Character_Literal .. N_Defining_Operator_Symbol; + subtype N_Formal_Subprogram_Declaration is Node_Kind range + N_Formal_Abstract_Subprogram_Declaration .. + N_Formal_Concrete_Subprogram_Declaration; + subtype N_Generic_Declaration is Node_Kind range N_Generic_Package_Declaration .. N_Generic_Subprogram_Declaration; @@ -7005,7 +7051,7 @@ package Sinfo is (N : Node_Id) return Boolean; -- Flag15 function Char_Literal_Value - (N : Node_Id) return Char_Code; -- Char_Code2 + (N : Node_Id) return Uint; -- Uint2 function Chars (N : Node_Id) return Name_Id; -- Name1 @@ -7073,6 +7119,9 @@ package Sinfo is function Corresponding_Body (N : Node_Id) return Node_Id; -- Node5 + function Corresponding_Formal_Spec + (N : Node_Id) return Node_Id; -- Node3 + function Corresponding_Generic_Association (N : Node_Id) return Node_Id; -- Node5 @@ -7800,7 +7849,7 @@ package Sinfo is (N : Node_Id; Val : Boolean := True); -- Flag5 procedure Set_Char_Literal_Value - (N : Node_Id; Val : Char_Code); -- Char_Code2 + (N : Node_Id; Val : Uint); -- Uint2 procedure Set_Chars (N : Node_Id; Val : Name_Id); -- Name1 @@ -7868,6 +7917,9 @@ package Sinfo is procedure Set_Corresponding_Body (N : Node_Id; Val : Node_Id); -- Node5 + procedure Set_Corresponding_Formal_Spec + (N : Node_Id; Val : Node_Id); -- Node3 + procedure Set_Corresponding_Generic_Association (N : Node_Id; Val : Node_Id); -- Node5 @@ -8572,6 +8624,7 @@ package Sinfo is pragma Inline (Controlling_Argument); pragma Inline (Conversion_OK); pragma Inline (Corresponding_Body); + pragma Inline (Corresponding_Formal_Spec); pragma Inline (Corresponding_Generic_Association); pragma Inline (Corresponding_Integer_Value); pragma Inline (Corresponding_Spec); @@ -8834,6 +8887,7 @@ package Sinfo is pragma Inline (Set_Controlling_Argument); pragma Inline (Set_Conversion_OK); pragma Inline (Set_Corresponding_Body); + pragma Inline (Set_Corresponding_Formal_Spec); pragma Inline (Set_Corresponding_Generic_Association); pragma Inline (Set_Corresponding_Integer_Value); pragma Inline (Set_Corresponding_Spec); diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index f7fb3ced3e1..6eabba27599 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -34,12 +34,13 @@ pragma Style_Checks (All_Checks); -- Subprograms not all in alpha order -with Debug; use Debug; -with Namet; use Namet; -with Opt; use Opt; -with Output; use Output; -with Tree_IO; use Tree_IO; -with System; use System; +with Debug; use Debug; +with Namet; use Namet; +with Opt; use Opt; +with Output; use Output; +with Tree_IO; use Tree_IO; +with System; use System; +with Widechar; use Widechar; with System.Memory; @@ -644,53 +645,36 @@ package body Sinput is -- Skip_Line_Terminators -- --------------------------- - -- There are two distinct concepts of line terminator in GNAT - - -- A logical line terminator is what corresponds to the "end of a line" - -- as described in RM 2.2 (13). Any of the characters FF, LF, CR or VT - -- acts as an end of logical line in this sense, and it is essentially - -- irrelevant whether one or more appears in sequence (since if a - -- sequence of such characters is regarded as separate ends of line, - -- then the intervening logical lines are null in any case). - - -- A physical line terminator is a sequence of format effectors that - -- is treated as ending a physical line. Physical lines have no Ada - -- semantic significance, but they are significant for error reporting - -- purposes, since errors are identified by line and column location. - - -- In GNAT, a physical line is ended by any of the sequences LF, CR/LF, - -- CR or LF/CR. LF is used in typical Unix systems, CR/LF in DOS systems, - -- and CR alone in System 7. We don't know of any system using LF/CR, but - -- it seems reasonable to include this case for consistency. In addition, - -- we recognize any of these sequences in any of the operating systems, - -- for better behavior in treating foreign files (e.g. a Unix file with - -- LF terminators transferred to a DOS system). - procedure Skip_Line_Terminators (P : in out Source_Ptr; Physical : out Boolean) is - begin - pragma Assert (Source (P) in Line_Terminator); + Chr : constant Character := Source (P); - if Source (P) = CR then + begin + if Chr = CR then if Source (P + 1) = LF then P := P + 2; else P := P + 1; end if; - elsif Source (P) = LF then - if Source (P + 1) = CR then + elsif Chr = LF then + if Source (P) = CR then P := P + 2; else P := P + 1; end if; - else -- Source (P) = FF or else Source (P) = VT + elsif Chr = FF or else Chr = VT then P := P + 1; Physical := False; return; + + -- Otherwise we have a wide character + + else + Skip_Wide (Source, P); end if; -- Fall through in the physical line terminator case. First deal with diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index 53e8889b424..b47b4dc2f89 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 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,8 +37,32 @@ -- General Note: throughout the compiler, we use the term line or source -- line to refer to a physical line in the source, terminated by the end of --- physical line sequence. See Skip_Line_Terminators procedure for a full --- description of the difference between logical and physical lines. +-- physical line sequence. + +-- There are two distinct concepts of line terminator in GNAT + +-- A logical line terminator is what corresponds to the "end of a line" as +-- described in RM 2.2 (13). Any of the characters FF, LF, CR or VT or any +-- wide character that is a Line or Paragraph Separator acts as an end of +-- logical line in this sense, and it is essentially irrelevant whether one +-- or more appears in sequence (since if sequence of such characters is +-- regarded as separate ends of line, then the intervening logical lines +-- are null in any case). + +-- A physical line terminator is a sequence of format effectors that is +-- treated as ending a physical line. Physical lines have no Ada semantic +-- significance, but they are significant for error reporting purposes, +-- since errors are identified by line and column location. + +-- In GNAT, a physical line is ended by any of the sequences LF, CR/LF, CR or +-- LF/CR. LF is used in typical Unix systems, CR/LF in DOS systems, and CR +-- alone in System 7. We don't know of any system using LF/CR, but it seems +-- reasonable to include this case for consistency. In addition, we recognize +-- any of these sequences in any of the operating systems, for better +-- behavior in treating foreign files (e.g. a Unix file with LF terminators +-- transferred to a DOS system). Finally, wide character codes in cagtegories +-- Separator, Line and Separator, Paragraph are considered to be physical +-- line terminators. with Alloc; with Casing; use Casing; @@ -293,7 +317,7 @@ package Sinput is procedure Lock; -- Lock internal tables - Main_Source_File : Source_File_Index; + Main_Source_File : Source_File_Index := No_Source_File; -- This is set to the source file index of the main unit ----------------------------- @@ -531,16 +555,29 @@ package Sinput is procedure Skip_Line_Terminators (P : in out Source_Ptr; Physical : out Boolean); - -- On entry, Source (P) points to the line terminator character that - -- terminates a line. The result set in P is the location of the first - -- character of the following line (after skipping the sequence of line - -- terminator characters terminating the current line). In addition, if - -- the terminator sequence ends a physical line (the definition of what - -- constitutes a physical line is embodied in the implementation of this - -- function), and it is the first time this sequence is encountered, then - -- an entry is made in the lines table to record the location for further - -- use by functions such as Get_Line_Number. Physical is set to True if - -- the line terminator was the end of a physical line. + -- On entry, P points to a line terminator that has been encountered, + -- which is one of FF,LF,VT,CR or a wide character sequence whose value is + -- in category Separator,Line or Separator,Paragraph. The purpose of this + -- P points just past the character that was scanned. The purpose of this + -- routine is to distinguish physical and logical line endings. A physical + -- line ending is one of: + -- + -- CR on its own (MAC System 7) + -- LF on its own (Unix and unix-like systems) + -- CR/LF (DOS, Windows) + -- LF/CR (not used, but recognized in any case) + -- Wide character in Separator,Line or Separator,Paragraph category + -- + -- A logical line ending (that is not a physical line ending) is one of: + -- + -- VT on its own + -- FF on its own + -- + -- On return, P is bumped past the line ending sequence (one of the above + -- seven possibilities). Physical is set to True to indicate that a + -- physical end of line was encountered, in which case this routine also + -- makes sure that the lines table for the current source file has an + -- appropriate entry for the start of the new physical line. function Source_Offset (S : Source_Ptr) return Nat; -- Returns the zero-origin offset of the given source location from the diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index bdb73ce1595..c80da272b76 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -1,1042 +1,1049 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S N A M E S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2004, 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 2, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Namet; use Namet; -with Table; - -package body Snames is - - -- Table used to record convention identifiers - - type Convention_Id_Entry is record - Name : Name_Id; - Convention : Convention_Id; - end record; - - package Convention_Identifiers is new Table.Table ( - Table_Component_Type => Convention_Id_Entry, - Table_Index_Type => Int, - Table_Low_Bound => 1, - Table_Initial => 50, - Table_Increment => 200, - Table_Name => "Name_Convention_Identifiers"); - - -- Table of names to be set by Initialize. Each name is terminated by a - -- single #, and the end of the list is marked by a null entry, i.e. by - -- two # marks in succession. Note that the table does not include the - -- entries for a-z, since these are initialized by Namet itself. - - Preset_Names : constant String := - "_parent#" & - "_tag#" & - "off#" & - "space#" & - "time#" & - "_abort_signal#" & - "_alignment#" & - "_assign#" & - "_atcb#" & - "_chain#" & - "_clean#" & - "_controller#" & - "_entry_bodies#" & - "_expunge#" & - "_final_list#" & - "_idepth#" & - "_init#" & - "_local_final_list#" & - "_master#" & - "_object#" & - "_priority#" & - "_process_atsd#" & - "_secondary_stack#" & - "_service#" & - "_size#" & - "_stack#" & - "_tags#" & - "_task#" & - "_task_id#" & - "_task_info#" & - "_task_name#" & - "_trace_sp#" & - "initialize#" & - "adjust#" & - "finalize#" & - "next#" & - "prev#" & - "_typecode#" & - "_from_any#" & - "_to_any#" & - "allocate#" & - "deallocate#" & - "dereference#" & - "decimal_io#" & - "enumeration_io#" & - "fixed_io#" & - "float_io#" & - "integer_io#" & - "modular_io#" & - "a_textio#" & - "a_witeio#" & - "const#" & - "<error>#" & - "go#" & - "put#" & - "put_line#" & - "to#" & - "finalization#" & - "finalization_root#" & - "interfaces#" & - "standard#" & - "system#" & - "text_io#" & - "wide_text_io#" & - "no_dsa#" & - "garlic_dsa#" & - "polyorb_dsa#" & - "addr#" & - "async#" & - "get_active_partition_id#" & - "get_rci_package_receiver#" & - "get_rci_package_ref#" & - "origin#" & - "params#" & - "partition#" & - "partition_interface#" & - "ras#" & - "call#" & - "rci_name#" & - "receiver#" & - "result#" & - "rpc#" & - "subp_id#" & - "operation#" & - "argument#" & - "arg_modes#" & - "handler#" & - "target#" & - "req#" & - "obj_typecode#" & - "stub#" & - "Oabs#" & - "Oand#" & - "Omod#" & - "Onot#" & - "Oor#" & - "Orem#" & - "Oxor#" & - "Oeq#" & - "One#" & - "Olt#" & - "Ole#" & - "Ogt#" & - "Oge#" & - "Oadd#" & - "Osubtract#" & - "Oconcat#" & - "Omultiply#" & - "Odivide#" & - "Oexpon#" & - "ada_83#" & - "ada_95#" & - "ada_05#" & - "c_pass_by_copy#" & - "compile_time_warning#" & - "component_alignment#" & - "convention_identifier#" & - "detect_blocking#" & - "discard_names#" & - "elaboration_checks#" & - "eliminate#" & - "explicit_overriding#" & - "extend_system#" & - "extensions_allowed#" & - "external_name_casing#" & - "float_representation#" & - "initialize_scalars#" & - "interrupt_state#" & - "license#" & - "locking_policy#" & - "long_float#" & - "no_run_time#" & - "no_strict_aliasing#" & - "normalize_scalars#" & - "polling#" & - "persistent_data#" & - "persistent_object#" & - "profile#" & - "profile_warnings#" & - "propagate_exceptions#" & - "queuing_policy#" & - "ravenscar#" & - "restricted_run_time#" & - "restrictions#" & - "restriction_warnings#" & - "reviewable#" & - "source_file_name#" & - "source_file_name_project#" & - "style_checks#" & - "suppress#" & - "suppress_exception_locations#" & - "task_dispatching_policy#" & - "universal_data#" & - "unsuppress#" & - "use_vads_size#" & - "validity_checks#" & - "warnings#" & - "abort_defer#" & - "all_calls_remote#" & - "annotate#" & - "assert#" & - "asynchronous#" & - "atomic#" & - "atomic_components#" & - "attach_handler#" & - "comment#" & - "common_object#" & - "complex_representation#" & - "controlled#" & - "convention#" & - "cpp_class#" & - "cpp_constructor#" & - "cpp_virtual#" & - "cpp_vtable#" & - "debug#" & - "elaborate#" & - "elaborate_all#" & - "elaborate_body#" & - "export#" & - "export_exception#" & - "export_function#" & - "export_object#" & - "export_procedure#" & - "export_value#" & - "export_valued_procedure#" & - "external#" & - "finalize_storage_only#" & - "ident#" & - "import#" & - "import_exception#" & - "import_function#" & - "import_object#" & - "import_procedure#" & - "import_valued_procedure#" & - "inline#" & - "inline_always#" & - "inline_generic#" & - "inspection_point#" & - "interface#" & - "interface_name#" & - "interrupt_handler#" & - "interrupt_priority#" & - "java_constructor#" & - "java_interface#" & - "keep_names#" & - "link_with#" & - "linker_alias#" & - "linker_options#" & - "linker_section#" & - "list#" & - "machine_attribute#" & - "main#" & - "main_storage#" & - "memory_size#" & - "no_return#" & - "obsolescent#" & - "optimize#" & - "optional_overriding#" & - "overriding#" & - "pack#" & - "page#" & - "passive#" & - "preelaborate#" & - "priority#" & - "psect_object#" & - "pure#" & - "pure_function#" & - "remote_call_interface#" & - "remote_types#" & - "share_generic#" & - "shared#" & - "shared_passive#" & - "source_reference#" & - "stream_convert#" & - "subtitle#" & - "suppress_all#" & - "suppress_debug_info#" & - "suppress_initialization#" & - "system_name#" & - "task_info#" & - "task_name#" & - "task_storage#" & - "thread_body#" & - "time_slice#" & - "title#" & - "unchecked_union#" & - "unimplemented_unit#" & - "unreferenced#" & - "unreserve_all_interrupts#" & - "volatile#" & - "volatile_components#" & - "weak_external#" & - "ada#" & - "assembler#" & - "cobol#" & - "cpp#" & - "fortran#" & - "intrinsic#" & - "java#" & - "stdcall#" & - "stubbed#" & - "asm#" & - "assembly#" & - "default#" & - "dll#" & - "win32#" & - "as_is#" & - "body_file_name#" & - "boolean_entry_barriers#" & - "casing#" & - "code#" & - "component#" & - "component_size_4#" & - "copy#" & - "d_float#" & - "descriptor#" & - "dot_replacement#" & - "dynamic#" & - "entity#" & - "external_name#" & - "first_optional_parameter#" & - "form#" & - "g_float#" & - "gcc#" & - "gnat#" & - "gpl#" & - "ieee_float#" & - "internal#" & - "link_name#" & - "lowercase#" & - "max_entry_queue_depth#" & - "max_entry_queue_length#" & - "max_size#" & - "mechanism#" & - "mixedcase#" & - "modified_gpl#" & - "name#" & - "nca#" & - "no#" & - "no_dependence#" & - "no_dynamic_attachment#" & - "no_dynamic_interrupts#" & - "no_requeue#" & - "no_requeue_statements#" & - "no_task_attributes#" & - "no_task_attributes_package#" & - "on#" & - "parameter_types#" & - "reference#" & - "restricted#" & - "result_mechanism#" & - "result_type#" & - "runtime#" & - "sb#" & - "secondary_stack_size#" & - "section#" & - "semaphore#" & - "simple_barriers#" & - "spec_file_name#" & - "static#" & - "stack_size#" & - "subunit_file_name#" & - "task_stack_size_default#" & - "task_type#" & - "time_slicing_enabled#" & - "top_guard#" & - "uba#" & - "ubs#" & - "ubsb#" & - "unit_name#" & - "unknown#" & - "unrestricted#" & - "uppercase#" & - "user#" & - "vax_float#" & - "vms#" & - "working_storage#" & - "abort_signal#" & - "access#" & - "address#" & - "address_size#" & - "aft#" & - "alignment#" & - "asm_input#" & - "asm_output#" & - "ast_entry#" & - "bit#" & - "bit_order#" & - "bit_position#" & - "body_version#" & - "callable#" & - "caller#" & - "code_address#" & - "component_size#" & - "compose#" & - "constrained#" & - "count#" & - "default_bit_order#" & - "definite#" & - "delta#" & - "denorm#" & - "digits#" & - "elaborated#" & - "emax#" & - "enum_rep#" & - "epsilon#" & - "exponent#" & - "external_tag#" & - "first#" & - "first_bit#" & - "fixed_value#" & - "fore#" & - "has_access_values#" & - "has_discriminants#" & - "identity#" & - "img#" & - "integer_value#" & - "large#" & - "last#" & - "last_bit#" & - "leading_part#" & - "length#" & - "machine_emax#" & - "machine_emin#" & - "machine_mantissa#" & - "machine_overflows#" & - "machine_radix#" & - "machine_rounds#" & - "machine_size#" & - "mantissa#" & - "max_size_in_storage_elements#" & - "maximum_alignment#" & - "mechanism_code#" & - "mod#" & - "model_emin#" & - "model_epsilon#" & - "model_mantissa#" & - "model_small#" & - "modulus#" & - "null_parameter#" & - "object_size#" & - "partition_id#" & - "passed_by_reference#" & - "pool_address#" & - "pos#" & - "position#" & - "range#" & - "range_length#" & - "round#" & - "safe_emax#" & - "safe_first#" & - "safe_large#" & - "safe_last#" & - "safe_small#" & - "scale#" & - "scaling#" & - "signed_zeros#" & - "size#" & - "small#" & - "storage_size#" & - "storage_unit#" & - "tag#" & - "target_name#" & - "terminated#" & - "to_address#" & - "type_class#" & - "uet_address#" & - "unbiased_rounding#" & - "unchecked_access#" & - "unconstrained_array#" & - "universal_literal_string#" & - "unrestricted_access#" & - "vads_size#" & - "val#" & - "valid#" & - "value_size#" & - "version#" & - "wchar_t_size#" & - "wide_width#" & - "width#" & - "word_size#" & - "adjacent#" & - "ceiling#" & - "copy_sign#" & - "floor#" & - "fraction#" & - "image#" & - "input#" & - "machine#" & - "max#" & - "min#" & - "model#" & - "pred#" & - "remainder#" & - "rounding#" & - "succ#" & - "truncation#" & - "value#" & - "wide_image#" & - "wide_value#" & - "output#" & - "read#" & - "write#" & - "elab_body#" & - "elab_spec#" & - "storage_pool#" & - "base#" & - "class#" & - "ceiling_locking#" & - "inheritance_locking#" & - "fifo_queuing#" & - "priority_queuing#" & - "fifo_within_priorities#" & - "access_check#" & - "accessibility_check#" & - "discriminant_check#" & - "division_check#" & - "elaboration_check#" & - "index_check#" & - "length_check#" & - "overflow_check#" & - "range_check#" & - "storage_check#" & - "tag_check#" & - "all_checks#" & - "abort#" & - "abs#" & - "accept#" & - "and#" & - "all#" & - "array#" & - "at#" & - "begin#" & - "body#" & - "case#" & - "constant#" & - "declare#" & - "delay#" & - "do#" & - "else#" & - "elsif#" & - "end#" & - "entry#" & - "exception#" & - "exit#" & - "for#" & - "function#" & - "generic#" & - "goto#" & - "if#" & - "in#" & - "is#" & - "limited#" & - "loop#" & - "new#" & - "not#" & - "null#" & - "of#" & - "or#" & - "others#" & - "out#" & - "package#" & - "pragma#" & - "private#" & - "procedure#" & - "raise#" & - "record#" & - "rem#" & - "renames#" & - "return#" & - "reverse#" & - "select#" & - "separate#" & - "subtype#" & - "task#" & - "terminate#" & - "then#" & - "type#" & - "use#" & - "when#" & - "while#" & - "with#" & - "xor#" & - "divide#" & - "enclosing_entity#" & - "exception_information#" & - "exception_message#" & - "exception_name#" & - "file#" & - "import_address#" & - "import_largest_value#" & - "import_value#" & - "is_negative#" & - "line#" & - "rotate_left#" & - "rotate_right#" & - "shift_left#" & - "shift_right#" & - "shift_right_arithmetic#" & - "source_location#" & - "unchecked_conversion#" & - "unchecked_deallocation#" & - "to_pointer#" & - "abstract#" & - "aliased#" & - "protected#" & - "until#" & - "requeue#" & - "tagged#" & - "raise_exception#" & - "ada_roots#" & - "binder#" & - "binder_driver#" & - "body_suffix#" & - "builder#" & - "compiler#" & - "compiler_driver#" & - "compiler_kind#" & - "compute_dependency#" & - "cross_reference#" & - "default_linker#" & - "default_switches#" & - "dependency_option#" & - "exec_dir#" & - "executable#" & - "executable_suffix#" & - "extends#" & - "externally_built#" & - "finder#" & - "global_configuration_pragmas#" & - "gnatls#" & - "gnatstub#" & - "implementation#" & - "implementation_exceptions#" & - "implementation_suffix#" & - "include_option#" & - "language_processing#" & - "languages#" & - "library_dir#" & - "library_auto_init#" & - "library_gcc#" & - "library_interface#" & - "library_kind#" & - "library_name#" & - "library_options#" & - "library_reference_symbol_file#" & - "library_src_dir#" & - "library_symbol_file#" & - "library_symbol_policy#" & - "library_version#" & - "linker#" & - "local_configuration_pragmas#" & - "locally_removed_files#" & - "metrics#" & - "naming#" & - "object_dir#" & - "pretty_printer#" & - "project#" & - "separate_suffix#" & - "source_dirs#" & - "source_files#" & - "source_list_file#" & - "spec#" & - "spec_suffix#" & - "specification#" & - "specification_exceptions#" & - "specification_suffix#" & - "switches#" & - "unaligned_valid#" & - "#"; - - --------------------- - -- Generated Names -- - --------------------- - - -- This section lists the various cases of generated names which are - -- built from existing names by adding unique leading and/or trailing - -- upper case letters. In some cases these names are built recursively, - -- in particular names built from types may be built from types which - -- themselves have generated names. In this list, xxx represents an - -- existing name to which identifying letters are prepended or appended, - -- and a trailing n represents a serial number in an external name that - -- has some semantic significance (e.g. the n'th index type of an array). - - -- xxxA access type for formal xxx in entry param record (Exp_Ch9) - -- xxxB tag table for tagged type xxx (Exp_Ch3) - -- xxxB task body procedure for task xxx (Exp_Ch9) - -- xxxD dispatch table for tagged type xxx (Exp_Ch3) - -- xxxD discriminal for discriminant xxx (Sem_Ch3) - -- xxxDn n'th discr check function for rec type xxx (Exp_Ch3) - -- xxxE elaboration boolean flag for task xxx (Exp_Ch9) - -- xxxE dispatch table pointer type for tagged type xxx (Exp_Ch3) - -- xxxE parameters for accept body for entry xxx (Exp_Ch9) - -- xxxFn n'th primitive of a tagged type (named xxx) (Exp_Ch3) - -- xxxJ tag table type index for tagged type xxx (Exp_Ch3) - -- xxxM master Id value for access type xxx (Exp_Ch3) - -- xxxP tag table pointer type for tagged type xxx (Exp_Ch3) - -- xxxP parameter record type for entry xxx (Exp_Ch9) - -- xxxPA access to parameter record type for entry xxx (Exp_Ch9) - -- xxxPn pointer type for n'th primitive of tagged type xxx (Exp_Ch3) - -- xxxR dispatch table pointer for tagged type xxx (Exp_Ch3) - -- xxxT tag table type for tagged type xxx (Exp_Ch3) - -- xxxT literal table for enumeration type xxx (Sem_Ch3) - -- xxxV type for task value record for task xxx (Exp_Ch9) - -- xxxX entry index constant (Exp_Ch9) - -- xxxY dispatch table type for tagged type xxx (Exp_Ch3) - -- xxxZ size variable for task xxx (Exp_Ch9) - - -- TSS names - - -- xxxDA deep adjust routine for type xxx (Exp_TSS) - -- xxxDF deep finalize routine for type xxx (Exp_TSS) - -- xxxDI deep initialize routine for type xxx (Exp_TSS) - -- xxxEQ composite equality routine for record type xxx (Exp_TSS) - -- xxxIP initialization procedure for type xxx (Exp_TSS) - -- xxxRA RAs type access routine for type xxx (Exp_TSS) - -- xxxRD RAs type dereference routine for type xxx (Exp_TSS) - -- xxxRP Rep to Pos conversion for enumeration type xxx (Exp_TSS) - -- xxxSA array/slice assignment for controlled comp. arrays (Exp_TSS) - -- xxxSI stream input attribute subprogram for type xxx (Exp_TSS) - -- xxxSO stream output attribute subprogram for type xxx (Exp_TSS) - -- xxxSR stream read attribute subprogram for type xxx (Exp_TSS) - -- xxxSW stream write attribute subprogram for type xxx (Exp_TSS) - - -- Implicit type names - - -- TxxxT type of literal table for enumeration type xxx (Sem_Ch3) - - -- (Note: this list is not complete or accurate ???) - - ---------------------- - -- Get_Attribute_Id -- - ---------------------- - - function Get_Attribute_Id (N : Name_Id) return Attribute_Id is - begin - return Attribute_Id'Val (N - First_Attribute_Name); - end Get_Attribute_Id; - - ------------------ - -- Get_Check_Id -- - ------------------ - - function Get_Check_Id (N : Name_Id) return Check_Id is - begin - return Check_Id'Val (N - First_Check_Name); - end Get_Check_Id; - - ----------------------- - -- Get_Convention_Id -- - ----------------------- - - function Get_Convention_Id (N : Name_Id) return Convention_Id is - begin - case N is - when Name_Ada => return Convention_Ada; - when Name_Assembler => return Convention_Assembler; - when Name_C => return Convention_C; - when Name_COBOL => return Convention_COBOL; - when Name_CPP => return Convention_CPP; - when Name_Fortran => return Convention_Fortran; - when Name_Intrinsic => return Convention_Intrinsic; - when Name_Java => return Convention_Java; - when Name_Stdcall => return Convention_Stdcall; - when Name_Stubbed => return Convention_Stubbed; - - -- If no direct match, then we must have a convention - -- identifier pragma that has specified this name. - - when others => - for J in 1 .. Convention_Identifiers.Last loop - if N = Convention_Identifiers.Table (J).Name then - return Convention_Identifiers.Table (J).Convention; - end if; - end loop; - - raise Program_Error; - end case; - end Get_Convention_Id; - - --------------------------- - -- Get_Locking_Policy_Id -- - --------------------------- - - function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id is - begin - return Locking_Policy_Id'Val (N - First_Locking_Policy_Name); - end Get_Locking_Policy_Id; - - ------------------- - -- Get_Pragma_Id -- - ------------------- - - function Get_Pragma_Id (N : Name_Id) return Pragma_Id is - begin - if N = Name_AST_Entry then - return Pragma_AST_Entry; - elsif N = Name_Storage_Size then - return Pragma_Storage_Size; - elsif N = Name_Storage_Unit then - return Pragma_Storage_Unit; - elsif N not in First_Pragma_Name .. Last_Pragma_Name then - return Unknown_Pragma; - else - return Pragma_Id'Val (N - First_Pragma_Name); - end if; - end Get_Pragma_Id; - - --------------------------- - -- Get_Queuing_Policy_Id -- - --------------------------- - - function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id is - begin - return Queuing_Policy_Id'Val (N - First_Queuing_Policy_Name); - end Get_Queuing_Policy_Id; - - ------------------------------------ - -- Get_Task_Dispatching_Policy_Id -- - ------------------------------------ - - function Get_Task_Dispatching_Policy_Id (N : Name_Id) - return Task_Dispatching_Policy_Id is - begin - return Task_Dispatching_Policy_Id'Val - (N - First_Task_Dispatching_Policy_Name); - end Get_Task_Dispatching_Policy_Id; - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize is - P_Index : Natural; - Discard_Name : Name_Id; - - begin - P_Index := Preset_Names'First; - - loop - Name_Len := 0; - - while Preset_Names (P_Index) /= '#' loop - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Preset_Names (P_Index); - P_Index := P_Index + 1; - end loop; - - -- We do the Name_Find call to enter the name into the table, but - -- we don't need to do anything with the result, since we already - -- initialized all the preset names to have the right value (we - -- are depending on the order of the names and Preset_Names). - - Discard_Name := Name_Find; - P_Index := P_Index + 1; - exit when Preset_Names (P_Index) = '#'; - end loop; - - -- Make sure that number of names in standard table is correct. If - -- this check fails, run utility program XSNAMES to construct a new - -- properly matching version of the body. - - pragma Assert (Discard_Name = Last_Predefined_Name); - - -- Initialize the convention identifiers table with the standard - -- set of synonyms that we recognize for conventions. - - Convention_Identifiers.Init; - - Convention_Identifiers.Append ((Name_Asm, Convention_Assembler)); - Convention_Identifiers.Append ((Name_Assembly, Convention_Assembler)); - - Convention_Identifiers.Append ((Name_Default, Convention_C)); - Convention_Identifiers.Append ((Name_External, Convention_C)); - - Convention_Identifiers.Append ((Name_DLL, Convention_Stdcall)); - Convention_Identifiers.Append ((Name_Win32, Convention_Stdcall)); - end Initialize; - - ----------------------- - -- Is_Attribute_Name -- - ----------------------- - - function Is_Attribute_Name (N : Name_Id) return Boolean is - begin - return N in First_Attribute_Name .. Last_Attribute_Name; - end Is_Attribute_Name; - - ------------------- - -- Is_Check_Name -- - ------------------- - - function Is_Check_Name (N : Name_Id) return Boolean is - begin - return N in First_Check_Name .. Last_Check_Name; - end Is_Check_Name; - - ------------------------ - -- Is_Convention_Name -- - ------------------------ - - function Is_Convention_Name (N : Name_Id) return Boolean is - begin - -- Check if this is one of the standard conventions - - if N in First_Convention_Name .. Last_Convention_Name - or else N = Name_C - then - return True; - - -- Otherwise check if it is in convention identifier table - - else - for J in 1 .. Convention_Identifiers.Last loop - if N = Convention_Identifiers.Table (J).Name then - return True; - end if; - end loop; - - return False; - end if; - end Is_Convention_Name; - - ------------------------------ - -- Is_Entity_Attribute_Name -- - ------------------------------ - - function Is_Entity_Attribute_Name (N : Name_Id) return Boolean is - begin - return N in First_Entity_Attribute_Name .. Last_Entity_Attribute_Name; - end Is_Entity_Attribute_Name; - - -------------------------------- - -- Is_Function_Attribute_Name -- - -------------------------------- - - function Is_Function_Attribute_Name (N : Name_Id) return Boolean is - begin - return N in - First_Renamable_Function_Attribute .. - Last_Renamable_Function_Attribute; - end Is_Function_Attribute_Name; - - ---------------------------- - -- Is_Locking_Policy_Name -- - ---------------------------- - - function Is_Locking_Policy_Name (N : Name_Id) return Boolean is - begin - return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name; - end Is_Locking_Policy_Name; - - ----------------------------- - -- Is_Operator_Symbol_Name -- - ----------------------------- - - function Is_Operator_Symbol_Name (N : Name_Id) return Boolean is - begin - return N in First_Operator_Name .. Last_Operator_Name; - end Is_Operator_Symbol_Name; - - -------------------- - -- Is_Pragma_Name -- - -------------------- - - function Is_Pragma_Name (N : Name_Id) return Boolean is - begin - return N in First_Pragma_Name .. Last_Pragma_Name - or else N = Name_AST_Entry - or else N = Name_Storage_Size - or else N = Name_Storage_Unit; - end Is_Pragma_Name; - - --------------------------------- - -- Is_Procedure_Attribute_Name -- - --------------------------------- - - function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean is - begin - return N in First_Procedure_Attribute .. Last_Procedure_Attribute; - end Is_Procedure_Attribute_Name; - - ---------------------------- - -- Is_Queuing_Policy_Name -- - ---------------------------- - - function Is_Queuing_Policy_Name (N : Name_Id) return Boolean is - begin - return N in First_Queuing_Policy_Name .. Last_Queuing_Policy_Name; - end Is_Queuing_Policy_Name; - - ------------------------------------- - -- Is_Task_Dispatching_Policy_Name -- - ------------------------------------- - - function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean is - begin - return N in First_Task_Dispatching_Policy_Name .. - Last_Task_Dispatching_Policy_Name; - end Is_Task_Dispatching_Policy_Name; - - ---------------------------- - -- Is_Type_Attribute_Name -- - ---------------------------- - - function Is_Type_Attribute_Name (N : Name_Id) return Boolean is - begin - return N in First_Type_Attribute_Name .. Last_Type_Attribute_Name; - end Is_Type_Attribute_Name; - - ---------------------------------- - -- Record_Convention_Identifier -- - ---------------------------------- - - procedure Record_Convention_Identifier - (Id : Name_Id; - Convention : Convention_Id) - is - begin - Convention_Identifiers.Append ((Id, Convention)); - end Record_Convention_Identifier; - -end Snames; +------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S N A M E S --
+-- --
+-- B o d y --
+-- --
+-- 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- --
+-- ware Foundation; either version 2, 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. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
+-- MA 02111-1307, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Namet; use Namet;
+with Table;
+
+package body Snames is
+
+ -- Table used to record convention identifiers
+
+ type Convention_Id_Entry is record
+ Name : Name_Id;
+ Convention : Convention_Id;
+ end record;
+
+ package Convention_Identifiers is new Table.Table (
+ Table_Component_Type => Convention_Id_Entry,
+ Table_Index_Type => Int,
+ Table_Low_Bound => 1,
+ Table_Initial => 50,
+ Table_Increment => 200,
+ Table_Name => "Name_Convention_Identifiers");
+
+ -- Table of names to be set by Initialize. Each name is terminated by a
+ -- single #, and the end of the list is marked by a null entry, i.e. by
+ -- two # marks in succession. Note that the table does not include the
+ -- entries for a-z, since these are initialized by Namet itself.
+
+ Preset_Names : constant String :=
+ "_parent#" &
+ "_tag#" &
+ "off#" &
+ "space#" &
+ "time#" &
+ "_abort_signal#" &
+ "_alignment#" &
+ "_assign#" &
+ "_atcb#" &
+ "_chain#" &
+ "_clean#" &
+ "_controller#" &
+ "_entry_bodies#" &
+ "_expunge#" &
+ "_final_list#" &
+ "_idepth#" &
+ "_init#" &
+ "_local_final_list#" &
+ "_master#" &
+ "_object#" &
+ "_priority#" &
+ "_process_atsd#" &
+ "_secondary_stack#" &
+ "_service#" &
+ "_size#" &
+ "_stack#" &
+ "_tags#" &
+ "_task#" &
+ "_task_id#" &
+ "_task_info#" &
+ "_task_name#" &
+ "_trace_sp#" &
+ "initialize#" &
+ "adjust#" &
+ "finalize#" &
+ "next#" &
+ "prev#" &
+ "_typecode#" &
+ "_from_any#" &
+ "_to_any#" &
+ "allocate#" &
+ "deallocate#" &
+ "dereference#" &
+ "decimal_io#" &
+ "enumeration_io#" &
+ "fixed_io#" &
+ "float_io#" &
+ "integer_io#" &
+ "modular_io#" &
+ "const#" &
+ "<error>#" &
+ "go#" &
+ "put#" &
+ "put_line#" &
+ "to#" &
+ "finalization#" &
+ "finalization_root#" &
+ "interfaces#" &
+ "standard#" &
+ "system#" &
+ "text_io#" &
+ "wide_text_io#" &
+ "wide_wide_text_io#" &
+ "no_dsa#" &
+ "garlic_dsa#" &
+ "polyorb_dsa#" &
+ "addr#" &
+ "async#" &
+ "get_active_partition_id#" &
+ "get_rci_package_receiver#" &
+ "get_rci_package_ref#" &
+ "origin#" &
+ "params#" &
+ "partition#" &
+ "partition_interface#" &
+ "ras#" &
+ "call#" &
+ "rci_name#" &
+ "receiver#" &
+ "result#" &
+ "rpc#" &
+ "subp_id#" &
+ "operation#" &
+ "argument#" &
+ "arg_modes#" &
+ "handler#" &
+ "target#" &
+ "req#" &
+ "obj_typecode#" &
+ "stub#" &
+ "Oabs#" &
+ "Oand#" &
+ "Omod#" &
+ "Onot#" &
+ "Oor#" &
+ "Orem#" &
+ "Oxor#" &
+ "Oeq#" &
+ "One#" &
+ "Olt#" &
+ "Ole#" &
+ "Ogt#" &
+ "Oge#" &
+ "Oadd#" &
+ "Osubtract#" &
+ "Oconcat#" &
+ "Omultiply#" &
+ "Odivide#" &
+ "Oexpon#" &
+ "ada_83#" &
+ "ada_95#" &
+ "ada_05#" &
+ "c_pass_by_copy#" &
+ "compile_time_warning#" &
+ "component_alignment#" &
+ "convention_identifier#" &
+ "detect_blocking#" &
+ "discard_names#" &
+ "elaboration_checks#" &
+ "eliminate#" &
+ "explicit_overriding#" &
+ "extend_system#" &
+ "extensions_allowed#" &
+ "external_name_casing#" &
+ "float_representation#" &
+ "initialize_scalars#" &
+ "interrupt_state#" &
+ "license#" &
+ "locking_policy#" &
+ "long_float#" &
+ "no_run_time#" &
+ "no_strict_aliasing#" &
+ "normalize_scalars#" &
+ "polling#" &
+ "persistent_data#" &
+ "persistent_object#" &
+ "profile#" &
+ "profile_warnings#" &
+ "propagate_exceptions#" &
+ "queuing_policy#" &
+ "ravenscar#" &
+ "restricted_run_time#" &
+ "restrictions#" &
+ "restriction_warnings#" &
+ "reviewable#" &
+ "source_file_name#" &
+ "source_file_name_project#" &
+ "style_checks#" &
+ "suppress#" &
+ "suppress_exception_locations#" &
+ "task_dispatching_policy#" &
+ "universal_data#" &
+ "unsuppress#" &
+ "use_vads_size#" &
+ "validity_checks#" &
+ "warnings#" &
+ "abort_defer#" &
+ "all_calls_remote#" &
+ "annotate#" &
+ "assert#" &
+ "asynchronous#" &
+ "atomic#" &
+ "atomic_components#" &
+ "attach_handler#" &
+ "comment#" &
+ "common_object#" &
+ "complex_representation#" &
+ "controlled#" &
+ "convention#" &
+ "cpp_class#" &
+ "cpp_constructor#" &
+ "cpp_virtual#" &
+ "cpp_vtable#" &
+ "debug#" &
+ "elaborate#" &
+ "elaborate_all#" &
+ "elaborate_body#" &
+ "export#" &
+ "export_exception#" &
+ "export_function#" &
+ "export_object#" &
+ "export_procedure#" &
+ "export_value#" &
+ "export_valued_procedure#" &
+ "external#" &
+ "finalize_storage_only#" &
+ "ident#" &
+ "import#" &
+ "import_exception#" &
+ "import_function#" &
+ "import_object#" &
+ "import_procedure#" &
+ "import_valued_procedure#" &
+ "inline#" &
+ "inline_always#" &
+ "inline_generic#" &
+ "inspection_point#" &
+ "interface_name#" &
+ "interrupt_handler#" &
+ "interrupt_priority#" &
+ "java_constructor#" &
+ "java_interface#" &
+ "keep_names#" &
+ "link_with#" &
+ "linker_alias#" &
+ "linker_options#" &
+ "linker_section#" &
+ "list#" &
+ "machine_attribute#" &
+ "main#" &
+ "main_storage#" &
+ "memory_size#" &
+ "no_return#" &
+ "obsolescent#" &
+ "optimize#" &
+ "optional_overriding#" &
+ "pack#" &
+ "page#" &
+ "passive#" &
+ "preelaborate#" &
+ "priority#" &
+ "psect_object#" &
+ "pure#" &
+ "pure_function#" &
+ "remote_call_interface#" &
+ "remote_types#" &
+ "share_generic#" &
+ "shared#" &
+ "shared_passive#" &
+ "source_reference#" &
+ "stream_convert#" &
+ "subtitle#" &
+ "suppress_all#" &
+ "suppress_debug_info#" &
+ "suppress_initialization#" &
+ "system_name#" &
+ "task_info#" &
+ "task_name#" &
+ "task_storage#" &
+ "thread_body#" &
+ "time_slice#" &
+ "title#" &
+ "unchecked_union#" &
+ "unimplemented_unit#" &
+ "unreferenced#" &
+ "unreserve_all_interrupts#" &
+ "volatile#" &
+ "volatile_components#" &
+ "weak_external#" &
+ "ada#" &
+ "assembler#" &
+ "cobol#" &
+ "cpp#" &
+ "fortran#" &
+ "intrinsic#" &
+ "java#" &
+ "stdcall#" &
+ "stubbed#" &
+ "asm#" &
+ "assembly#" &
+ "default#" &
+ "dll#" &
+ "win32#" &
+ "as_is#" &
+ "body_file_name#" &
+ "boolean_entry_barriers#" &
+ "casing#" &
+ "code#" &
+ "component#" &
+ "component_size_4#" &
+ "copy#" &
+ "d_float#" &
+ "descriptor#" &
+ "dot_replacement#" &
+ "dynamic#" &
+ "entity#" &
+ "external_name#" &
+ "first_optional_parameter#" &
+ "form#" &
+ "g_float#" &
+ "gcc#" &
+ "gnat#" &
+ "gpl#" &
+ "ieee_float#" &
+ "internal#" &
+ "link_name#" &
+ "lowercase#" &
+ "max_entry_queue_depth#" &
+ "max_entry_queue_length#" &
+ "max_size#" &
+ "mechanism#" &
+ "mixedcase#" &
+ "modified_gpl#" &
+ "name#" &
+ "nca#" &
+ "no#" &
+ "no_dependence#" &
+ "no_dynamic_attachment#" &
+ "no_dynamic_interrupts#" &
+ "no_requeue#" &
+ "no_requeue_statements#" &
+ "no_task_attributes#" &
+ "no_task_attributes_package#" &
+ "on#" &
+ "parameter_types#" &
+ "reference#" &
+ "restricted#" &
+ "result_mechanism#" &
+ "result_type#" &
+ "runtime#" &
+ "sb#" &
+ "secondary_stack_size#" &
+ "section#" &
+ "semaphore#" &
+ "simple_barriers#" &
+ "spec_file_name#" &
+ "static#" &
+ "stack_size#" &
+ "subunit_file_name#" &
+ "task_stack_size_default#" &
+ "task_type#" &
+ "time_slicing_enabled#" &
+ "top_guard#" &
+ "uba#" &
+ "ubs#" &
+ "ubsb#" &
+ "unit_name#" &
+ "unknown#" &
+ "unrestricted#" &
+ "uppercase#" &
+ "user#" &
+ "vax_float#" &
+ "vms#" &
+ "working_storage#" &
+ "abort_signal#" &
+ "access#" &
+ "address#" &
+ "address_size#" &
+ "aft#" &
+ "alignment#" &
+ "asm_input#" &
+ "asm_output#" &
+ "ast_entry#" &
+ "bit#" &
+ "bit_order#" &
+ "bit_position#" &
+ "body_version#" &
+ "callable#" &
+ "caller#" &
+ "code_address#" &
+ "component_size#" &
+ "compose#" &
+ "constrained#" &
+ "count#" &
+ "default_bit_order#" &
+ "definite#" &
+ "delta#" &
+ "denorm#" &
+ "digits#" &
+ "elaborated#" &
+ "emax#" &
+ "enum_rep#" &
+ "epsilon#" &
+ "exponent#" &
+ "external_tag#" &
+ "first#" &
+ "first_bit#" &
+ "fixed_value#" &
+ "fore#" &
+ "has_access_values#" &
+ "has_discriminants#" &
+ "identity#" &
+ "img#" &
+ "integer_value#" &
+ "large#" &
+ "last#" &
+ "last_bit#" &
+ "leading_part#" &
+ "length#" &
+ "machine_emax#" &
+ "machine_emin#" &
+ "machine_mantissa#" &
+ "machine_overflows#" &
+ "machine_radix#" &
+ "machine_rounds#" &
+ "machine_size#" &
+ "mantissa#" &
+ "max_size_in_storage_elements#" &
+ "maximum_alignment#" &
+ "mechanism_code#" &
+ "mod#" &
+ "model_emin#" &
+ "model_epsilon#" &
+ "model_mantissa#" &
+ "model_small#" &
+ "modulus#" &
+ "null_parameter#" &
+ "object_size#" &
+ "partition_id#" &
+ "passed_by_reference#" &
+ "pool_address#" &
+ "pos#" &
+ "position#" &
+ "range#" &
+ "range_length#" &
+ "round#" &
+ "safe_emax#" &
+ "safe_first#" &
+ "safe_large#" &
+ "safe_last#" &
+ "safe_small#" &
+ "scale#" &
+ "scaling#" &
+ "signed_zeros#" &
+ "size#" &
+ "small#" &
+ "storage_size#" &
+ "storage_unit#" &
+ "stream_size#" &
+ "tag#" &
+ "target_name#" &
+ "terminated#" &
+ "to_address#" &
+ "type_class#" &
+ "uet_address#" &
+ "unbiased_rounding#" &
+ "unchecked_access#" &
+ "unconstrained_array#" &
+ "universal_literal_string#" &
+ "unrestricted_access#" &
+ "vads_size#" &
+ "val#" &
+ "valid#" &
+ "value_size#" &
+ "version#" &
+ "wchar_t_size#" &
+ "wide_wide_width#" &
+ "wide_width#" &
+ "width#" &
+ "word_size#" &
+ "adjacent#" &
+ "ceiling#" &
+ "copy_sign#" &
+ "floor#" &
+ "fraction#" &
+ "image#" &
+ "input#" &
+ "machine#" &
+ "max#" &
+ "min#" &
+ "model#" &
+ "pred#" &
+ "remainder#" &
+ "rounding#" &
+ "succ#" &
+ "truncation#" &
+ "value#" &
+ "wide_image#" &
+ "wide_wide_image#" &
+ "wide_value#" &
+ "wide_wide_value#" &
+ "output#" &
+ "read#" &
+ "write#" &
+ "elab_body#" &
+ "elab_spec#" &
+ "storage_pool#" &
+ "base#" &
+ "class#" &
+ "ceiling_locking#" &
+ "inheritance_locking#" &
+ "fifo_queuing#" &
+ "priority_queuing#" &
+ "fifo_within_priorities#" &
+ "access_check#" &
+ "accessibility_check#" &
+ "discriminant_check#" &
+ "division_check#" &
+ "elaboration_check#" &
+ "index_check#" &
+ "length_check#" &
+ "overflow_check#" &
+ "range_check#" &
+ "storage_check#" &
+ "tag_check#" &
+ "all_checks#" &
+ "abort#" &
+ "abs#" &
+ "accept#" &
+ "and#" &
+ "all#" &
+ "array#" &
+ "at#" &
+ "begin#" &
+ "body#" &
+ "case#" &
+ "constant#" &
+ "declare#" &
+ "delay#" &
+ "do#" &
+ "else#" &
+ "elsif#" &
+ "end#" &
+ "entry#" &
+ "exception#" &
+ "exit#" &
+ "for#" &
+ "function#" &
+ "generic#" &
+ "goto#" &
+ "if#" &
+ "in#" &
+ "is#" &
+ "limited#" &
+ "loop#" &
+ "new#" &
+ "not#" &
+ "null#" &
+ "of#" &
+ "or#" &
+ "others#" &
+ "out#" &
+ "package#" &
+ "pragma#" &
+ "private#" &
+ "procedure#" &
+ "raise#" &
+ "record#" &
+ "rem#" &
+ "renames#" &
+ "return#" &
+ "reverse#" &
+ "select#" &
+ "separate#" &
+ "subtype#" &
+ "task#" &
+ "terminate#" &
+ "then#" &
+ "type#" &
+ "use#" &
+ "when#" &
+ "while#" &
+ "with#" &
+ "xor#" &
+ "divide#" &
+ "enclosing_entity#" &
+ "exception_information#" &
+ "exception_message#" &
+ "exception_name#" &
+ "file#" &
+ "import_address#" &
+ "import_largest_value#" &
+ "import_value#" &
+ "is_negative#" &
+ "line#" &
+ "rotate_left#" &
+ "rotate_right#" &
+ "shift_left#" &
+ "shift_right#" &
+ "shift_right_arithmetic#" &
+ "source_location#" &
+ "unchecked_conversion#" &
+ "unchecked_deallocation#" &
+ "to_pointer#" &
+ "abstract#" &
+ "aliased#" &
+ "protected#" &
+ "until#" &
+ "requeue#" &
+ "tagged#" &
+ "raise_exception#" &
+ "ada_roots#" &
+ "binder#" &
+ "binder_driver#" &
+ "body_suffix#" &
+ "builder#" &
+ "compiler#" &
+ "compiler_driver#" &
+ "compiler_kind#" &
+ "compute_dependency#" &
+ "cross_reference#" &
+ "default_linker#" &
+ "default_switches#" &
+ "dependency_option#" &
+ "exec_dir#" &
+ "executable#" &
+ "executable_suffix#" &
+ "extends#" &
+ "externally_built#" &
+ "finder#" &
+ "global_configuration_pragmas#" &
+ "gnatls#" &
+ "gnatstub#" &
+ "implementation#" &
+ "implementation_exceptions#" &
+ "implementation_suffix#" &
+ "include_option#" &
+ "language_processing#" &
+ "languages#" &
+ "library_dir#" &
+ "library_auto_init#" &
+ "library_gcc#" &
+ "library_interface#" &
+ "library_kind#" &
+ "library_name#" &
+ "library_options#" &
+ "library_reference_symbol_file#" &
+ "library_src_dir#" &
+ "library_symbol_file#" &
+ "library_symbol_policy#" &
+ "library_version#" &
+ "linker#" &
+ "local_configuration_pragmas#" &
+ "locally_removed_files#" &
+ "metrics#" &
+ "naming#" &
+ "object_dir#" &
+ "pretty_printer#" &
+ "project#" &
+ "separate_suffix#" &
+ "source_dirs#" &
+ "source_files#" &
+ "source_list_file#" &
+ "spec#" &
+ "spec_suffix#" &
+ "specification#" &
+ "specification_exceptions#" &
+ "specification_suffix#" &
+ "switches#" &
+ "unaligned_valid#" &
+ "interface#" &
+ "overriding#" &
+ "synchronized#" &
+ "#";
+
+ ---------------------
+ -- Generated Names --
+ ---------------------
+
+ -- This section lists the various cases of generated names which are
+ -- built from existing names by adding unique leading and/or trailing
+ -- upper case letters. In some cases these names are built recursively,
+ -- in particular names built from types may be built from types which
+ -- themselves have generated names. In this list, xxx represents an
+ -- existing name to which identifying letters are prepended or appended,
+ -- and a trailing n represents a serial number in an external name that
+ -- has some semantic significance (e.g. the n'th index type of an array).
+
+ -- xxxA access type for formal xxx in entry param record (Exp_Ch9)
+ -- xxxB tag table for tagged type xxx (Exp_Ch3)
+ -- xxxB task body procedure for task xxx (Exp_Ch9)
+ -- xxxD dispatch table for tagged type xxx (Exp_Ch3)
+ -- xxxD discriminal for discriminant xxx (Sem_Ch3)
+ -- xxxDn n'th discr check function for rec type xxx (Exp_Ch3)
+ -- xxxE elaboration boolean flag for task xxx (Exp_Ch9)
+ -- xxxE dispatch table pointer type for tagged type xxx (Exp_Ch3)
+ -- xxxE parameters for accept body for entry xxx (Exp_Ch9)
+ -- xxxFn n'th primitive of a tagged type (named xxx) (Exp_Ch3)
+ -- xxxJ tag table type index for tagged type xxx (Exp_Ch3)
+ -- xxxM master Id value for access type xxx (Exp_Ch3)
+ -- xxxP tag table pointer type for tagged type xxx (Exp_Ch3)
+ -- xxxP parameter record type for entry xxx (Exp_Ch9)
+ -- xxxPA access to parameter record type for entry xxx (Exp_Ch9)
+ -- xxxPn pointer type for n'th primitive of tagged type xxx (Exp_Ch3)
+ -- xxxR dispatch table pointer for tagged type xxx (Exp_Ch3)
+ -- xxxT tag table type for tagged type xxx (Exp_Ch3)
+ -- xxxT literal table for enumeration type xxx (Sem_Ch3)
+ -- xxxV type for task value record for task xxx (Exp_Ch9)
+ -- xxxX entry index constant (Exp_Ch9)
+ -- xxxY dispatch table type for tagged type xxx (Exp_Ch3)
+ -- xxxZ size variable for task xxx (Exp_Ch9)
+
+ -- TSS names
+
+ -- xxxDA deep adjust routine for type xxx (Exp_TSS)
+ -- xxxDF deep finalize routine for type xxx (Exp_TSS)
+ -- xxxDI deep initialize routine for type xxx (Exp_TSS)
+ -- xxxEQ composite equality routine for record type xxx (Exp_TSS)
+ -- xxxIP initialization procedure for type xxx (Exp_TSS)
+ -- xxxRA RAs type access routine for type xxx (Exp_TSS)
+ -- xxxRD RAs type dereference routine for type xxx (Exp_TSS)
+ -- xxxRP Rep to Pos conversion for enumeration type xxx (Exp_TSS)
+ -- xxxSA array/slice assignment for controlled comp. arrays (Exp_TSS)
+ -- xxxSI stream input attribute subprogram for type xxx (Exp_TSS)
+ -- xxxSO stream output attribute subprogram for type xxx (Exp_TSS)
+ -- xxxSR stream read attribute subprogram for type xxx (Exp_TSS)
+ -- xxxSW stream write attribute subprogram for type xxx (Exp_TSS)
+
+ -- Implicit type names
+
+ -- TxxxT type of literal table for enumeration type xxx (Sem_Ch3)
+
+ -- (Note: this list is not complete or accurate ???)
+
+ ----------------------
+ -- Get_Attribute_Id --
+ ----------------------
+
+ function Get_Attribute_Id (N : Name_Id) return Attribute_Id is
+ begin
+ return Attribute_Id'Val (N - First_Attribute_Name);
+ end Get_Attribute_Id;
+
+ ------------------
+ -- Get_Check_Id --
+ ------------------
+
+ function Get_Check_Id (N : Name_Id) return Check_Id is
+ begin
+ return Check_Id'Val (N - First_Check_Name);
+ end Get_Check_Id;
+
+ -----------------------
+ -- Get_Convention_Id --
+ -----------------------
+
+ function Get_Convention_Id (N : Name_Id) return Convention_Id is
+ begin
+ case N is
+ when Name_Ada => return Convention_Ada;
+ when Name_Assembler => return Convention_Assembler;
+ when Name_C => return Convention_C;
+ when Name_COBOL => return Convention_COBOL;
+ when Name_CPP => return Convention_CPP;
+ when Name_Fortran => return Convention_Fortran;
+ when Name_Intrinsic => return Convention_Intrinsic;
+ when Name_Java => return Convention_Java;
+ when Name_Stdcall => return Convention_Stdcall;
+ when Name_Stubbed => return Convention_Stubbed;
+
+ -- If no direct match, then we must have a convention
+ -- identifier pragma that has specified this name.
+
+ when others =>
+ for J in 1 .. Convention_Identifiers.Last loop
+ if N = Convention_Identifiers.Table (J).Name then
+ return Convention_Identifiers.Table (J).Convention;
+ end if;
+ end loop;
+
+ raise Program_Error;
+ end case;
+ end Get_Convention_Id;
+
+ ---------------------------
+ -- Get_Locking_Policy_Id --
+ ---------------------------
+
+ function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id is
+ begin
+ return Locking_Policy_Id'Val (N - First_Locking_Policy_Name);
+ end Get_Locking_Policy_Id;
+
+ -------------------
+ -- Get_Pragma_Id --
+ -------------------
+
+ function Get_Pragma_Id (N : Name_Id) return Pragma_Id is
+ begin
+ if N = Name_AST_Entry then
+ return Pragma_AST_Entry;
+ elsif N = Name_Interface then
+ return Pragma_Interface;
+ elsif N = Name_Storage_Size then
+ return Pragma_Storage_Size;
+ elsif N = Name_Storage_Unit then
+ return Pragma_Storage_Unit;
+ elsif N not in First_Pragma_Name .. Last_Pragma_Name then
+ return Unknown_Pragma;
+ else
+ return Pragma_Id'Val (N - First_Pragma_Name);
+ end if;
+ end Get_Pragma_Id;
+
+ ---------------------------
+ -- Get_Queuing_Policy_Id --
+ ---------------------------
+
+ function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id is
+ begin
+ return Queuing_Policy_Id'Val (N - First_Queuing_Policy_Name);
+ end Get_Queuing_Policy_Id;
+
+ ------------------------------------
+ -- Get_Task_Dispatching_Policy_Id --
+ ------------------------------------
+
+ function Get_Task_Dispatching_Policy_Id (N : Name_Id)
+ return Task_Dispatching_Policy_Id is
+ begin
+ return Task_Dispatching_Policy_Id'Val
+ (N - First_Task_Dispatching_Policy_Name);
+ end Get_Task_Dispatching_Policy_Id;
+
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize is
+ P_Index : Natural;
+ Discard_Name : Name_Id;
+
+ begin
+ P_Index := Preset_Names'First;
+
+ loop
+ Name_Len := 0;
+
+ while Preset_Names (P_Index) /= '#' loop
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := Preset_Names (P_Index);
+ P_Index := P_Index + 1;
+ end loop;
+
+ -- We do the Name_Find call to enter the name into the table, but
+ -- we don't need to do anything with the result, since we already
+ -- initialized all the preset names to have the right value (we
+ -- are depending on the order of the names and Preset_Names).
+
+ Discard_Name := Name_Find;
+ P_Index := P_Index + 1;
+ exit when Preset_Names (P_Index) = '#';
+ end loop;
+
+ -- Make sure that number of names in standard table is correct. If
+ -- this check fails, run utility program XSNAMES to construct a new
+ -- properly matching version of the body.
+
+ pragma Assert (Discard_Name = Last_Predefined_Name);
+
+ -- Initialize the convention identifiers table with the standard
+ -- set of synonyms that we recognize for conventions.
+
+ Convention_Identifiers.Init;
+
+ Convention_Identifiers.Append ((Name_Asm, Convention_Assembler));
+ Convention_Identifiers.Append ((Name_Assembly, Convention_Assembler));
+
+ Convention_Identifiers.Append ((Name_Default, Convention_C));
+ Convention_Identifiers.Append ((Name_External, Convention_C));
+
+ Convention_Identifiers.Append ((Name_DLL, Convention_Stdcall));
+ Convention_Identifiers.Append ((Name_Win32, Convention_Stdcall));
+ end Initialize;
+
+ -----------------------
+ -- Is_Attribute_Name --
+ -----------------------
+
+ function Is_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Attribute_Name .. Last_Attribute_Name;
+ end Is_Attribute_Name;
+
+ -------------------
+ -- Is_Check_Name --
+ -------------------
+
+ function Is_Check_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Check_Name .. Last_Check_Name;
+ end Is_Check_Name;
+
+ ------------------------
+ -- Is_Convention_Name --
+ ------------------------
+
+ function Is_Convention_Name (N : Name_Id) return Boolean is
+ begin
+ -- Check if this is one of the standard conventions
+
+ if N in First_Convention_Name .. Last_Convention_Name
+ or else N = Name_C
+ then
+ return True;
+
+ -- Otherwise check if it is in convention identifier table
+
+ else
+ for J in 1 .. Convention_Identifiers.Last loop
+ if N = Convention_Identifiers.Table (J).Name then
+ return True;
+ end if;
+ end loop;
+
+ return False;
+ end if;
+ end Is_Convention_Name;
+
+ ------------------------------
+ -- Is_Entity_Attribute_Name --
+ ------------------------------
+
+ function Is_Entity_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Entity_Attribute_Name .. Last_Entity_Attribute_Name;
+ end Is_Entity_Attribute_Name;
+
+ --------------------------------
+ -- Is_Function_Attribute_Name --
+ --------------------------------
+
+ function Is_Function_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in
+ First_Renamable_Function_Attribute ..
+ Last_Renamable_Function_Attribute;
+ end Is_Function_Attribute_Name;
+
+ ----------------------------
+ -- Is_Locking_Policy_Name --
+ ----------------------------
+
+ function Is_Locking_Policy_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name;
+ end Is_Locking_Policy_Name;
+
+ -----------------------------
+ -- Is_Operator_Symbol_Name --
+ -----------------------------
+
+ function Is_Operator_Symbol_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Operator_Name .. Last_Operator_Name;
+ end Is_Operator_Symbol_Name;
+
+ --------------------
+ -- Is_Pragma_Name --
+ --------------------
+
+ function Is_Pragma_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Pragma_Name .. Last_Pragma_Name
+ or else N = Name_AST_Entry
+ or else N = Name_Interface
+ or else N = Name_Storage_Size
+ or else N = Name_Storage_Unit;
+ end Is_Pragma_Name;
+
+ ---------------------------------
+ -- Is_Procedure_Attribute_Name --
+ ---------------------------------
+
+ function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Procedure_Attribute .. Last_Procedure_Attribute;
+ end Is_Procedure_Attribute_Name;
+
+ ----------------------------
+ -- Is_Queuing_Policy_Name --
+ ----------------------------
+
+ function Is_Queuing_Policy_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Queuing_Policy_Name .. Last_Queuing_Policy_Name;
+ end Is_Queuing_Policy_Name;
+
+ -------------------------------------
+ -- Is_Task_Dispatching_Policy_Name --
+ -------------------------------------
+
+ function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Task_Dispatching_Policy_Name ..
+ Last_Task_Dispatching_Policy_Name;
+ end Is_Task_Dispatching_Policy_Name;
+
+ ----------------------------
+ -- Is_Type_Attribute_Name --
+ ----------------------------
+
+ function Is_Type_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Type_Attribute_Name .. Last_Type_Attribute_Name;
+ end Is_Type_Attribute_Name;
+
+ ----------------------------------
+ -- Record_Convention_Identifier --
+ ----------------------------------
+
+ procedure Record_Convention_Identifier
+ (Id : Name_Id;
+ Convention : Convention_Id)
+ is
+ begin
+ Convention_Identifiers.Append ((Id, Convention));
+ end Record_Convention_Identifier;
+
+end Snames;
diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index 5d4800752d3..85c2f467cf0 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -1,1485 +1,1496 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S N A M E S -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2004, 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 2, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Types; use Types; - -package Snames is - --- This package contains definitions of standard names (i.e. entries in the --- Names table) that are used throughout the GNAT compiler). It also contains --- the definitions of some enumeration types whose definitions are tied to --- the order of these preset names. - --- WARNING: There is a C file, a-snames.h which duplicates some of the --- definitions in this file and must be kept properly synchronized. - - ------------------ - -- Preset Names -- - ------------------ - - -- The following are preset entries in the names table, which are - -- entered at the start of every compilation for easy access. Note - -- that the order of initialization of these names in the body must - -- be coordinated with the order of names in this table. - - -- Note: a name may not appear more than once in the following list. - -- If additional pragmas or attributes are introduced which might - -- otherwise cause a duplicate, then list it only once in this table, - -- and adjust the definition of the functions for testing for pragma - -- names and attribute names, and returning their ID values. Of course - -- everything is simpler if no such duplications occur! - - -- First we have the one character names used to optimize the lookup - -- process for one character identifiers (to avoid the hashing in this - -- case) There are a full 256 of these, but only the entries for lower - -- case and upper case letters have identifiers - - -- The lower case letter entries are used for one character identifiers - -- appearing in the source, for example in pragma Interface (C). - - Name_A : constant Name_Id := First_Name_Id + Character'Pos ('a'); - Name_B : constant Name_Id := First_Name_Id + Character'Pos ('b'); - Name_C : constant Name_Id := First_Name_Id + Character'Pos ('c'); - Name_D : constant Name_Id := First_Name_Id + Character'Pos ('d'); - Name_E : constant Name_Id := First_Name_Id + Character'Pos ('e'); - Name_F : constant Name_Id := First_Name_Id + Character'Pos ('f'); - Name_G : constant Name_Id := First_Name_Id + Character'Pos ('g'); - Name_H : constant Name_Id := First_Name_Id + Character'Pos ('h'); - Name_I : constant Name_Id := First_Name_Id + Character'Pos ('i'); - Name_J : constant Name_Id := First_Name_Id + Character'Pos ('j'); - Name_K : constant Name_Id := First_Name_Id + Character'Pos ('k'); - Name_L : constant Name_Id := First_Name_Id + Character'Pos ('l'); - Name_M : constant Name_Id := First_Name_Id + Character'Pos ('m'); - Name_N : constant Name_Id := First_Name_Id + Character'Pos ('n'); - Name_O : constant Name_Id := First_Name_Id + Character'Pos ('o'); - Name_P : constant Name_Id := First_Name_Id + Character'Pos ('p'); - Name_Q : constant Name_Id := First_Name_Id + Character'Pos ('q'); - Name_R : constant Name_Id := First_Name_Id + Character'Pos ('r'); - Name_S : constant Name_Id := First_Name_Id + Character'Pos ('s'); - Name_T : constant Name_Id := First_Name_Id + Character'Pos ('t'); - Name_U : constant Name_Id := First_Name_Id + Character'Pos ('u'); - Name_V : constant Name_Id := First_Name_Id + Character'Pos ('v'); - Name_W : constant Name_Id := First_Name_Id + Character'Pos ('w'); - Name_X : constant Name_Id := First_Name_Id + Character'Pos ('x'); - Name_Y : constant Name_Id := First_Name_Id + Character'Pos ('y'); - Name_Z : constant Name_Id := First_Name_Id + Character'Pos ('z'); - - -- The upper case letter entries are used by expander code for local - -- variables that do not require unique names (e.g. formal parameter - -- names in constructed procedures) - - Name_uA : constant Name_Id := First_Name_Id + Character'Pos ('A'); - Name_uB : constant Name_Id := First_Name_Id + Character'Pos ('B'); - Name_uC : constant Name_Id := First_Name_Id + Character'Pos ('C'); - Name_uD : constant Name_Id := First_Name_Id + Character'Pos ('D'); - Name_uE : constant Name_Id := First_Name_Id + Character'Pos ('E'); - Name_uF : constant Name_Id := First_Name_Id + Character'Pos ('F'); - Name_uG : constant Name_Id := First_Name_Id + Character'Pos ('G'); - Name_uH : constant Name_Id := First_Name_Id + Character'Pos ('H'); - Name_uI : constant Name_Id := First_Name_Id + Character'Pos ('I'); - Name_uJ : constant Name_Id := First_Name_Id + Character'Pos ('J'); - Name_uK : constant Name_Id := First_Name_Id + Character'Pos ('K'); - Name_uL : constant Name_Id := First_Name_Id + Character'Pos ('L'); - Name_uM : constant Name_Id := First_Name_Id + Character'Pos ('M'); - Name_uN : constant Name_Id := First_Name_Id + Character'Pos ('N'); - Name_uO : constant Name_Id := First_Name_Id + Character'Pos ('O'); - Name_uP : constant Name_Id := First_Name_Id + Character'Pos ('P'); - Name_uQ : constant Name_Id := First_Name_Id + Character'Pos ('Q'); - Name_uR : constant Name_Id := First_Name_Id + Character'Pos ('R'); - Name_uS : constant Name_Id := First_Name_Id + Character'Pos ('S'); - Name_uT : constant Name_Id := First_Name_Id + Character'Pos ('T'); - Name_uU : constant Name_Id := First_Name_Id + Character'Pos ('U'); - Name_uV : constant Name_Id := First_Name_Id + Character'Pos ('V'); - Name_uW : constant Name_Id := First_Name_Id + Character'Pos ('W'); - Name_uX : constant Name_Id := First_Name_Id + Character'Pos ('X'); - Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y'); - Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z'); - - -- Note: the following table is read by the utility program XSNAMES and - -- its format should not be changed without coordinating with this program. - - N : constant Name_Id := First_Name_Id + 256; - -- Synonym used in standard name definitions - - -- Some names that are used by gigi, and whose definitions are reflected - -- in the C header file a-snames.h. They are placed at the start so that - -- the need to modify a-snames.h is minimized. - - Name_uParent : constant Name_Id := N + 000; - Name_uTag : constant Name_Id := N + 001; - Name_Off : constant Name_Id := N + 002; - Name_Space : constant Name_Id := N + 003; - Name_Time : constant Name_Id := N + 004; - - -- Some special names used by the expander. Note that the lower case u's - -- at the start of these names get translated to extra underscores. These - -- names are only referenced internally by expander generated code. - - Name_uAbort_Signal : constant Name_Id := N + 005; - Name_uAlignment : constant Name_Id := N + 006; - Name_uAssign : constant Name_Id := N + 007; - Name_uATCB : constant Name_Id := N + 008; - Name_uChain : constant Name_Id := N + 009; - Name_uClean : constant Name_Id := N + 010; - Name_uController : constant Name_Id := N + 011; - Name_uEntry_Bodies : constant Name_Id := N + 012; - Name_uExpunge : constant Name_Id := N + 013; - Name_uFinal_List : constant Name_Id := N + 014; - Name_uIdepth : constant Name_Id := N + 015; - Name_uInit : constant Name_Id := N + 016; - Name_uLocal_Final_List : constant Name_Id := N + 017; - Name_uMaster : constant Name_Id := N + 018; - Name_uObject : constant Name_Id := N + 019; - Name_uPriority : constant Name_Id := N + 020; - Name_uProcess_ATSD : constant Name_Id := N + 021; - Name_uSecondary_Stack : constant Name_Id := N + 022; - Name_uService : constant Name_Id := N + 023; - Name_uSize : constant Name_Id := N + 024; - Name_uStack : constant Name_Id := N + 025; - Name_uTags : constant Name_Id := N + 026; - Name_uTask : constant Name_Id := N + 027; - Name_uTask_Id : constant Name_Id := N + 028; - Name_uTask_Info : constant Name_Id := N + 029; - Name_uTask_Name : constant Name_Id := N + 030; - Name_uTrace_Sp : constant Name_Id := N + 031; - - -- Names of routines in Ada.Finalization, needed by expander - - Name_Initialize : constant Name_Id := N + 032; - Name_Adjust : constant Name_Id := N + 033; - Name_Finalize : constant Name_Id := N + 034; - - -- Names of fields declared in System.Finalization_Implementation, - -- needed by the expander when generating code for finalization. - - Name_Next : constant Name_Id := N + 035; - Name_Prev : constant Name_Id := N + 036; - - -- Names of TSS routines for implementation of DSA over PolyORB - - Name_uTypeCode : constant Name_Id := N + 037; - Name_uFrom_Any : constant Name_Id := N + 038; - Name_uTo_Any : constant Name_Id := N + 039; - - -- Names of allocation routines, also needed by expander - - Name_Allocate : constant Name_Id := N + 040; - Name_Deallocate : constant Name_Id := N + 041; - Name_Dereference : constant Name_Id := N + 042; - - -- Names of Text_IO generic subpackages (see Rtsfind.Text_IO_Kludge) - - First_Text_IO_Package : constant Name_Id := N + 043; - Name_Decimal_IO : constant Name_Id := N + 043; - Name_Enumeration_IO : constant Name_Id := N + 044; - Name_Fixed_IO : constant Name_Id := N + 045; - Name_Float_IO : constant Name_Id := N + 046; - Name_Integer_IO : constant Name_Id := N + 047; - Name_Modular_IO : constant Name_Id := N + 048; - Last_Text_IO_Package : constant Name_Id := N + 048; - - subtype Text_IO_Package_Name is Name_Id - range First_Text_IO_Package .. Last_Text_IO_Package; - - -- Names of files in library for Ada.Text_IO and Ada.Wide_Text_IO - - Name_a_textio : constant Name_Id := N + 049; - Name_a_witeio : constant Name_Id := N + 050; - - -- Some miscellaneous names used for error detection/recovery - - Name_Const : constant Name_Id := N + 051; - Name_Error : constant Name_Id := N + 052; - Name_Go : constant Name_Id := N + 053; - Name_Put : constant Name_Id := N + 054; - Name_Put_Line : constant Name_Id := N + 055; - Name_To : constant Name_Id := N + 056; - - -- Names for packages that are treated specially by the compiler - - Name_Finalization : constant Name_Id := N + 057; - Name_Finalization_Root : constant Name_Id := N + 058; - Name_Interfaces : constant Name_Id := N + 059; - Name_Standard : constant Name_Id := N + 060; - Name_System : constant Name_Id := N + 061; - Name_Text_IO : constant Name_Id := N + 062; - Name_Wide_Text_IO : constant Name_Id := N + 063; - - -- Names of implementations of the distributed systems annex - - First_PCS_Name : constant Name_Id := N + 064; - Name_No_DSA : constant Name_Id := N + 064; - Name_GARLIC_DSA : constant Name_Id := N + 065; - Name_PolyORB_DSA : constant Name_Id := N + 066; - Last_PCS_Name : constant Name_Id := N + 066; - - subtype PCS_Names is Name_Id - range First_PCS_Name .. Last_PCS_Name; - - -- Names of identifiers used in expanding distribution stubs - - Name_Addr : constant Name_Id := N + 067; - Name_Async : constant Name_Id := N + 068; - Name_Get_Active_Partition_ID : constant Name_Id := N + 069; - Name_Get_RCI_Package_Receiver : constant Name_Id := N + 070; - Name_Get_RCI_Package_Ref : constant Name_Id := N + 071; - Name_Origin : constant Name_Id := N + 072; - Name_Params : constant Name_Id := N + 073; - Name_Partition : constant Name_Id := N + 074; - Name_Partition_Interface : constant Name_Id := N + 075; - Name_Ras : constant Name_Id := N + 076; - Name_Call : constant Name_Id := N + 077; - Name_RCI_Name : constant Name_Id := N + 078; - Name_Receiver : constant Name_Id := N + 079; - Name_Result : constant Name_Id := N + 080; - Name_Rpc : constant Name_Id := N + 081; - Name_Subp_Id : constant Name_Id := N + 082; - Name_Operation : constant Name_Id := N + 083; - Name_Argument : constant Name_Id := N + 084; - Name_Arg_Modes : constant Name_Id := N + 085; - Name_Handler : constant Name_Id := N + 086; - Name_Target : constant Name_Id := N + 087; - Name_Req : constant Name_Id := N + 088; - Name_Obj_TypeCode : constant Name_Id := N + 089; - Name_Stub : constant Name_Id := N + 090; - - -- Operator Symbol entries. The actual names have an upper case O at - -- the start in place of the Op_ prefix (e.g. the actual name that - -- corresponds to Name_Op_Abs is "Oabs". - - First_Operator_Name : constant Name_Id := N + 091; - Name_Op_Abs : constant Name_Id := N + 091; -- "abs" - Name_Op_And : constant Name_Id := N + 092; -- "and" - Name_Op_Mod : constant Name_Id := N + 093; -- "mod" - Name_Op_Not : constant Name_Id := N + 094; -- "not" - Name_Op_Or : constant Name_Id := N + 095; -- "or" - Name_Op_Rem : constant Name_Id := N + 096; -- "rem" - Name_Op_Xor : constant Name_Id := N + 097; -- "xor" - Name_Op_Eq : constant Name_Id := N + 098; -- "=" - Name_Op_Ne : constant Name_Id := N + 099; -- "/=" - Name_Op_Lt : constant Name_Id := N + 100; -- "<" - Name_Op_Le : constant Name_Id := N + 101; -- "<=" - Name_Op_Gt : constant Name_Id := N + 102; -- ">" - Name_Op_Ge : constant Name_Id := N + 103; -- ">=" - Name_Op_Add : constant Name_Id := N + 104; -- "+" - Name_Op_Subtract : constant Name_Id := N + 105; -- "-" - Name_Op_Concat : constant Name_Id := N + 106; -- "&" - Name_Op_Multiply : constant Name_Id := N + 107; -- "*" - Name_Op_Divide : constant Name_Id := N + 108; -- "/" - Name_Op_Expon : constant Name_Id := N + 109; -- "**" - Last_Operator_Name : constant Name_Id := N + 109; - - -- Names for all pragmas recognized by GNAT. The entries with the comment - -- "Ada 83" are pragmas that are defined in Ada 83, but not in Ada 95. - -- These pragmas are fully implemented in both Ada 83 and Ada 95 modes - -- in GNAT. - - -- The entries marked GNAT are pragmas that are defined by GNAT - -- and implemented in both Ada 83 and Ada 95 modes. Full descriptions - -- of these implementation dependent pragmas may be found in the - -- appropriate section in unit Sem_Prag in file sem-prag.adb. - - -- The entries marked Ada05 are technically implementation dependent - -- pragmas, but they correspond to standard proposals for Ada 2005. - - -- The entries marked VMS are VMS specific pragmas that are recognized - -- only in OpenVMS versions of GNAT. They are ignored in other versions - -- with an appropriate warning. - - -- The entries marked AAMP are AAMP specific pragmas that are recognized - -- only in GNAT for the AAMP. They are ignored in other versions with - -- appropriate warnings. - - First_Pragma_Name : constant Name_Id := N + 110; - - -- Configuration pragmas are grouped at start - - Name_Ada_83 : constant Name_Id := N + 110; -- GNAT - Name_Ada_95 : constant Name_Id := N + 111; -- GNAT - Name_Ada_05 : constant Name_Id := N + 112; -- GNAT - Name_C_Pass_By_Copy : constant Name_Id := N + 113; -- GNAT - Name_Compile_Time_Warning : constant Name_Id := N + 114; -- GNAT - Name_Component_Alignment : constant Name_Id := N + 115; -- GNAT - Name_Convention_Identifier : constant Name_Id := N + 116; -- GNAT - Name_Detect_Blocking : constant Name_Id := N + 117; -- Ada05 - Name_Discard_Names : constant Name_Id := N + 118; - Name_Elaboration_Checks : constant Name_Id := N + 119; -- GNAT - Name_Eliminate : constant Name_Id := N + 120; -- GNAT - Name_Explicit_Overriding : constant Name_Id := N + 121; - Name_Extend_System : constant Name_Id := N + 122; -- GNAT - Name_Extensions_Allowed : constant Name_Id := N + 123; -- GNAT - Name_External_Name_Casing : constant Name_Id := N + 124; -- GNAT - Name_Float_Representation : constant Name_Id := N + 125; -- GNAT - Name_Initialize_Scalars : constant Name_Id := N + 126; -- GNAT - Name_Interrupt_State : constant Name_Id := N + 127; -- GNAT - Name_License : constant Name_Id := N + 128; -- GNAT - Name_Locking_Policy : constant Name_Id := N + 129; - Name_Long_Float : constant Name_Id := N + 130; -- VMS - Name_No_Run_Time : constant Name_Id := N + 131; -- GNAT - Name_No_Strict_Aliasing : constant Name_Id := N + 132; -- GNAT - Name_Normalize_Scalars : constant Name_Id := N + 133; - Name_Polling : constant Name_Id := N + 134; -- GNAT - Name_Persistent_Data : constant Name_Id := N + 135; -- GNAT - Name_Persistent_Object : constant Name_Id := N + 136; -- GNAT - Name_Profile : constant Name_Id := N + 137; -- Ada05 - Name_Profile_Warnings : constant Name_Id := N + 138; -- GNAT - Name_Propagate_Exceptions : constant Name_Id := N + 139; -- GNAT - Name_Queuing_Policy : constant Name_Id := N + 140; - Name_Ravenscar : constant Name_Id := N + 141; - Name_Restricted_Run_Time : constant Name_Id := N + 142; - Name_Restrictions : constant Name_Id := N + 143; - Name_Restriction_Warnings : constant Name_Id := N + 144; -- GNAT - Name_Reviewable : constant Name_Id := N + 145; - Name_Source_File_Name : constant Name_Id := N + 146; -- GNAT - Name_Source_File_Name_Project : constant Name_Id := N + 147; -- GNAT - Name_Style_Checks : constant Name_Id := N + 148; -- GNAT - Name_Suppress : constant Name_Id := N + 149; - Name_Suppress_Exception_Locations : constant Name_Id := N + 150; -- GNAT - Name_Task_Dispatching_Policy : constant Name_Id := N + 151; - Name_Universal_Data : constant Name_Id := N + 152; -- AAMP - Name_Unsuppress : constant Name_Id := N + 153; -- GNAT - Name_Use_VADS_Size : constant Name_Id := N + 154; -- GNAT - Name_Validity_Checks : constant Name_Id := N + 155; -- GNAT - Name_Warnings : constant Name_Id := N + 156; -- GNAT - Last_Configuration_Pragma_Name : constant Name_Id := N + 156; - - -- Remaining pragma names - - Name_Abort_Defer : constant Name_Id := N + 157; -- GNAT - Name_All_Calls_Remote : constant Name_Id := N + 158; - Name_Annotate : constant Name_Id := N + 159; -- GNAT - - -- Note: AST_Entry is not in this list because its name matches the - -- name of the corresponding attribute. However, it is included in the - -- definition of the type Attribute_Id, and the functions Get_Pragma_Id - -- and Check_Pragma_Id correctly recognize and process Name_AST_Entry. - -- AST_Entry is a VMS specific pragma. - - Name_Assert : constant Name_Id := N + 160; -- GNAT - Name_Asynchronous : constant Name_Id := N + 161; - Name_Atomic : constant Name_Id := N + 162; - Name_Atomic_Components : constant Name_Id := N + 163; - Name_Attach_Handler : constant Name_Id := N + 164; - Name_Comment : constant Name_Id := N + 165; -- GNAT - Name_Common_Object : constant Name_Id := N + 166; -- GNAT - Name_Complex_Representation : constant Name_Id := N + 167; -- GNAT - Name_Controlled : constant Name_Id := N + 168; - Name_Convention : constant Name_Id := N + 169; - Name_CPP_Class : constant Name_Id := N + 170; -- GNAT - Name_CPP_Constructor : constant Name_Id := N + 171; -- GNAT - Name_CPP_Virtual : constant Name_Id := N + 172; -- GNAT - Name_CPP_Vtable : constant Name_Id := N + 173; -- GNAT - Name_Debug : constant Name_Id := N + 174; -- GNAT - Name_Elaborate : constant Name_Id := N + 175; -- Ada 83 - Name_Elaborate_All : constant Name_Id := N + 176; - Name_Elaborate_Body : constant Name_Id := N + 177; - Name_Export : constant Name_Id := N + 178; - Name_Export_Exception : constant Name_Id := N + 179; -- VMS - Name_Export_Function : constant Name_Id := N + 180; -- GNAT - Name_Export_Object : constant Name_Id := N + 181; -- GNAT - Name_Export_Procedure : constant Name_Id := N + 182; -- GNAT - Name_Export_Value : constant Name_Id := N + 183; -- GNAT - Name_Export_Valued_Procedure : constant Name_Id := N + 184; -- GNAT - Name_External : constant Name_Id := N + 185; -- GNAT - Name_Finalize_Storage_Only : constant Name_Id := N + 186; -- GNAT - Name_Ident : constant Name_Id := N + 187; -- VMS - Name_Import : constant Name_Id := N + 188; - Name_Import_Exception : constant Name_Id := N + 189; -- VMS - Name_Import_Function : constant Name_Id := N + 190; -- GNAT - Name_Import_Object : constant Name_Id := N + 191; -- GNAT - Name_Import_Procedure : constant Name_Id := N + 192; -- GNAT - Name_Import_Valued_Procedure : constant Name_Id := N + 193; -- GNAT - Name_Inline : constant Name_Id := N + 194; - Name_Inline_Always : constant Name_Id := N + 195; -- GNAT - Name_Inline_Generic : constant Name_Id := N + 196; -- GNAT - Name_Inspection_Point : constant Name_Id := N + 197; - Name_Interface : constant Name_Id := N + 198; -- Ada 83 - Name_Interface_Name : constant Name_Id := N + 199; -- GNAT - Name_Interrupt_Handler : constant Name_Id := N + 200; - Name_Interrupt_Priority : constant Name_Id := N + 201; - Name_Java_Constructor : constant Name_Id := N + 202; -- GNAT - Name_Java_Interface : constant Name_Id := N + 203; -- GNAT - Name_Keep_Names : constant Name_Id := N + 204; -- GNAT - Name_Link_With : constant Name_Id := N + 205; -- GNAT - Name_Linker_Alias : constant Name_Id := N + 206; -- GNAT - Name_Linker_Options : constant Name_Id := N + 207; - Name_Linker_Section : constant Name_Id := N + 208; -- GNAT - Name_List : constant Name_Id := N + 209; - Name_Machine_Attribute : constant Name_Id := N + 210; -- GNAT - Name_Main : constant Name_Id := N + 211; -- GNAT - Name_Main_Storage : constant Name_Id := N + 212; -- GNAT - Name_Memory_Size : constant Name_Id := N + 213; -- Ada 83 - Name_No_Return : constant Name_Id := N + 214; -- GNAT - Name_Obsolescent : constant Name_Id := N + 215; -- GNAT - Name_Optimize : constant Name_Id := N + 216; - Name_Optional_Overriding : constant Name_Id := N + 217; - Name_Overriding : constant Name_Id := N + 218; - Name_Pack : constant Name_Id := N + 219; - Name_Page : constant Name_Id := N + 220; - Name_Passive : constant Name_Id := N + 221; -- GNAT - Name_Preelaborate : constant Name_Id := N + 222; - Name_Priority : constant Name_Id := N + 223; - Name_Psect_Object : constant Name_Id := N + 224; -- VMS - Name_Pure : constant Name_Id := N + 225; - Name_Pure_Function : constant Name_Id := N + 226; -- GNAT - Name_Remote_Call_Interface : constant Name_Id := N + 227; - Name_Remote_Types : constant Name_Id := N + 228; - Name_Share_Generic : constant Name_Id := N + 229; -- GNAT - Name_Shared : constant Name_Id := N + 230; -- Ada 83 - Name_Shared_Passive : constant Name_Id := N + 231; - - -- Note: Storage_Size is not in this list because its name matches the - -- name of the corresponding attribute. However, it is included in the - -- definition of the type Attribute_Id, and the functions Get_Pragma_Id - -- and Check_Pragma_Id correctly recognize and process Name_Storage_Size. - - -- Note: Storage_Unit is also omitted from the list because of a clash - -- with an attribute name, and is treated similarly. - - Name_Source_Reference : constant Name_Id := N + 232; -- GNAT - Name_Stream_Convert : constant Name_Id := N + 233; -- GNAT - Name_Subtitle : constant Name_Id := N + 234; -- GNAT - Name_Suppress_All : constant Name_Id := N + 235; -- GNAT - Name_Suppress_Debug_Info : constant Name_Id := N + 236; -- GNAT - Name_Suppress_Initialization : constant Name_Id := N + 237; -- GNAT - Name_System_Name : constant Name_Id := N + 238; -- Ada 83 - Name_Task_Info : constant Name_Id := N + 239; -- GNAT - Name_Task_Name : constant Name_Id := N + 240; -- GNAT - Name_Task_Storage : constant Name_Id := N + 241; -- VMS - Name_Thread_Body : constant Name_Id := N + 242; -- GNAT - Name_Time_Slice : constant Name_Id := N + 243; -- GNAT - Name_Title : constant Name_Id := N + 244; -- GNAT - Name_Unchecked_Union : constant Name_Id := N + 245; -- GNAT - Name_Unimplemented_Unit : constant Name_Id := N + 246; -- GNAT - Name_Unreferenced : constant Name_Id := N + 247; -- GNAT - Name_Unreserve_All_Interrupts : constant Name_Id := N + 248; -- GNAT - Name_Volatile : constant Name_Id := N + 249; - Name_Volatile_Components : constant Name_Id := N + 250; - Name_Weak_External : constant Name_Id := N + 251; -- GNAT - Last_Pragma_Name : constant Name_Id := N + 251; - - -- Language convention names for pragma Convention/Export/Import/Interface - -- Note that Name_C is not included in this list, since it was already - -- declared earlier in the context of one-character identifier names - -- (where the order is critical to the fast look up process). - - -- Note: there are no convention names corresponding to the conventions - -- Entry and Protected, this is because these conventions cannot be - -- specified by a pragma. - - First_Convention_Name : constant Name_Id := N + 252; - Name_Ada : constant Name_Id := N + 252; - Name_Assembler : constant Name_Id := N + 253; - Name_COBOL : constant Name_Id := N + 254; - Name_CPP : constant Name_Id := N + 255; - Name_Fortran : constant Name_Id := N + 256; - Name_Intrinsic : constant Name_Id := N + 257; - Name_Java : constant Name_Id := N + 258; - Name_Stdcall : constant Name_Id := N + 259; - Name_Stubbed : constant Name_Id := N + 260; - Last_Convention_Name : constant Name_Id := N + 260; - - -- The following names are preset as synonyms for Assembler - - Name_Asm : constant Name_Id := N + 261; - Name_Assembly : constant Name_Id := N + 262; - - -- The following names are preset as synonyms for C - - Name_Default : constant Name_Id := N + 263; - -- Name_Exernal (previously defined as pragma) - - -- The following names are present as synonyms for Stdcall - - Name_DLL : constant Name_Id := N + 264; - Name_Win32 : constant Name_Id := N + 265; - - -- Other special names used in processing pragmas - - Name_As_Is : constant Name_Id := N + 266; - Name_Body_File_Name : constant Name_Id := N + 267; - Name_Boolean_Entry_Barriers : constant Name_Id := N + 268; - Name_Casing : constant Name_Id := N + 269; - Name_Code : constant Name_Id := N + 270; - Name_Component : constant Name_Id := N + 271; - Name_Component_Size_4 : constant Name_Id := N + 272; - Name_Copy : constant Name_Id := N + 273; - Name_D_Float : constant Name_Id := N + 274; - Name_Descriptor : constant Name_Id := N + 275; - Name_Dot_Replacement : constant Name_Id := N + 276; - Name_Dynamic : constant Name_Id := N + 277; - Name_Entity : constant Name_Id := N + 278; - Name_External_Name : constant Name_Id := N + 279; - Name_First_Optional_Parameter : constant Name_Id := N + 280; - Name_Form : constant Name_Id := N + 281; - Name_G_Float : constant Name_Id := N + 282; - Name_Gcc : constant Name_Id := N + 283; - Name_Gnat : constant Name_Id := N + 284; - Name_GPL : constant Name_Id := N + 285; - Name_IEEE_Float : constant Name_Id := N + 286; - Name_Internal : constant Name_Id := N + 287; - Name_Link_Name : constant Name_Id := N + 288; - Name_Lowercase : constant Name_Id := N + 289; - Name_Max_Entry_Queue_Depth : constant Name_Id := N + 290; - Name_Max_Entry_Queue_Length : constant Name_Id := N + 291; - Name_Max_Size : constant Name_Id := N + 292; - Name_Mechanism : constant Name_Id := N + 293; - Name_Mixedcase : constant Name_Id := N + 294; - Name_Modified_GPL : constant Name_Id := N + 295; - Name_Name : constant Name_Id := N + 296; - Name_NCA : constant Name_Id := N + 297; - Name_No : constant Name_Id := N + 298; - Name_No_Dependence : constant Name_Id := N + 299; - Name_No_Dynamic_Attachment : constant Name_Id := N + 300; - Name_No_Dynamic_Interrupts : constant Name_Id := N + 301; - Name_No_Requeue : constant Name_Id := N + 302; - Name_No_Requeue_Statements : constant Name_Id := N + 303; - Name_No_Task_Attributes : constant Name_Id := N + 304; - Name_No_Task_Attributes_Package : constant Name_Id := N + 305; - Name_On : constant Name_Id := N + 306; - Name_Parameter_Types : constant Name_Id := N + 307; - Name_Reference : constant Name_Id := N + 308; - Name_Restricted : constant Name_Id := N + 309; - Name_Result_Mechanism : constant Name_Id := N + 310; - Name_Result_Type : constant Name_Id := N + 311; - Name_Runtime : constant Name_Id := N + 312; - Name_SB : constant Name_Id := N + 313; - Name_Secondary_Stack_Size : constant Name_Id := N + 314; - Name_Section : constant Name_Id := N + 315; - Name_Semaphore : constant Name_Id := N + 316; - Name_Simple_Barriers : constant Name_Id := N + 317; - Name_Spec_File_Name : constant Name_Id := N + 318; - Name_Static : constant Name_Id := N + 319; - Name_Stack_Size : constant Name_Id := N + 320; - Name_Subunit_File_Name : constant Name_Id := N + 321; - Name_Task_Stack_Size_Default : constant Name_Id := N + 322; - Name_Task_Type : constant Name_Id := N + 323; - Name_Time_Slicing_Enabled : constant Name_Id := N + 324; - Name_Top_Guard : constant Name_Id := N + 325; - Name_UBA : constant Name_Id := N + 326; - Name_UBS : constant Name_Id := N + 327; - Name_UBSB : constant Name_Id := N + 328; - Name_Unit_Name : constant Name_Id := N + 329; - Name_Unknown : constant Name_Id := N + 330; - Name_Unrestricted : constant Name_Id := N + 331; - Name_Uppercase : constant Name_Id := N + 332; - Name_User : constant Name_Id := N + 333; - Name_VAX_Float : constant Name_Id := N + 334; - Name_VMS : constant Name_Id := N + 335; - Name_Working_Storage : constant Name_Id := N + 336; - - -- Names of recognized attributes. The entries with the comment "Ada 83" - -- are attributes that are defined in Ada 83, but not in Ada 95. These - -- attributes are implemented in both Ada 83 and Ada 95 modes in GNAT. - - -- The entries marked GNAT are attributes that are defined by GNAT - -- and implemented in both Ada 83 and Ada 95 modes. Full descriptions - -- of these implementation dependent attributes may be found in the - -- appropriate section in package Sem_Attr in file sem-attr.ads. - - -- The entries marked VMS are recognized only in OpenVMS implementations - -- of GNAT, and are treated as illegal in all other contexts. - - First_Attribute_Name : constant Name_Id := N + 337; - Name_Abort_Signal : constant Name_Id := N + 337; -- GNAT - Name_Access : constant Name_Id := N + 338; - Name_Address : constant Name_Id := N + 339; - Name_Address_Size : constant Name_Id := N + 340; -- GNAT - Name_Aft : constant Name_Id := N + 341; - Name_Alignment : constant Name_Id := N + 342; - Name_Asm_Input : constant Name_Id := N + 343; -- GNAT - Name_Asm_Output : constant Name_Id := N + 344; -- GNAT - Name_AST_Entry : constant Name_Id := N + 345; -- VMS - Name_Bit : constant Name_Id := N + 346; -- GNAT - Name_Bit_Order : constant Name_Id := N + 347; - Name_Bit_Position : constant Name_Id := N + 348; -- GNAT - Name_Body_Version : constant Name_Id := N + 349; - Name_Callable : constant Name_Id := N + 350; - Name_Caller : constant Name_Id := N + 351; - Name_Code_Address : constant Name_Id := N + 352; -- GNAT - Name_Component_Size : constant Name_Id := N + 353; - Name_Compose : constant Name_Id := N + 354; - Name_Constrained : constant Name_Id := N + 355; - Name_Count : constant Name_Id := N + 356; - Name_Default_Bit_Order : constant Name_Id := N + 357; -- GNAT - Name_Definite : constant Name_Id := N + 358; - Name_Delta : constant Name_Id := N + 359; - Name_Denorm : constant Name_Id := N + 360; - Name_Digits : constant Name_Id := N + 361; - Name_Elaborated : constant Name_Id := N + 362; -- GNAT - Name_Emax : constant Name_Id := N + 363; -- Ada 83 - Name_Enum_Rep : constant Name_Id := N + 364; -- GNAT - Name_Epsilon : constant Name_Id := N + 365; -- Ada 83 - Name_Exponent : constant Name_Id := N + 366; - Name_External_Tag : constant Name_Id := N + 367; - Name_First : constant Name_Id := N + 368; - Name_First_Bit : constant Name_Id := N + 369; - Name_Fixed_Value : constant Name_Id := N + 370; -- GNAT - Name_Fore : constant Name_Id := N + 371; - Name_Has_Access_Values : constant Name_Id := N + 372; -- GNAT - Name_Has_Discriminants : constant Name_Id := N + 373; -- GNAT - Name_Identity : constant Name_Id := N + 374; - Name_Img : constant Name_Id := N + 375; -- GNAT - Name_Integer_Value : constant Name_Id := N + 376; -- GNAT - Name_Large : constant Name_Id := N + 377; -- Ada 83 - Name_Last : constant Name_Id := N + 378; - Name_Last_Bit : constant Name_Id := N + 379; - Name_Leading_Part : constant Name_Id := N + 380; - Name_Length : constant Name_Id := N + 381; - Name_Machine_Emax : constant Name_Id := N + 382; - Name_Machine_Emin : constant Name_Id := N + 383; - Name_Machine_Mantissa : constant Name_Id := N + 384; - Name_Machine_Overflows : constant Name_Id := N + 385; - Name_Machine_Radix : constant Name_Id := N + 386; - Name_Machine_Rounds : constant Name_Id := N + 387; - Name_Machine_Size : constant Name_Id := N + 388; -- GNAT - Name_Mantissa : constant Name_Id := N + 389; -- Ada 83 - Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 390; - Name_Maximum_Alignment : constant Name_Id := N + 391; -- GNAT - Name_Mechanism_Code : constant Name_Id := N + 392; -- GNAT - Name_Mod : constant Name_Id := N + 393; - Name_Model_Emin : constant Name_Id := N + 394; - Name_Model_Epsilon : constant Name_Id := N + 395; - Name_Model_Mantissa : constant Name_Id := N + 396; - Name_Model_Small : constant Name_Id := N + 397; - Name_Modulus : constant Name_Id := N + 398; - Name_Null_Parameter : constant Name_Id := N + 399; -- GNAT - Name_Object_Size : constant Name_Id := N + 400; -- GNAT - Name_Partition_ID : constant Name_Id := N + 401; - Name_Passed_By_Reference : constant Name_Id := N + 402; -- GNAT - Name_Pool_Address : constant Name_Id := N + 403; - Name_Pos : constant Name_Id := N + 404; - Name_Position : constant Name_Id := N + 405; - Name_Range : constant Name_Id := N + 406; - Name_Range_Length : constant Name_Id := N + 407; -- GNAT - Name_Round : constant Name_Id := N + 408; - Name_Safe_Emax : constant Name_Id := N + 409; -- Ada 83 - Name_Safe_First : constant Name_Id := N + 410; - Name_Safe_Large : constant Name_Id := N + 411; -- Ada 83 - Name_Safe_Last : constant Name_Id := N + 412; - Name_Safe_Small : constant Name_Id := N + 413; -- Ada 83 - Name_Scale : constant Name_Id := N + 414; - Name_Scaling : constant Name_Id := N + 415; - Name_Signed_Zeros : constant Name_Id := N + 416; - Name_Size : constant Name_Id := N + 417; - Name_Small : constant Name_Id := N + 418; - Name_Storage_Size : constant Name_Id := N + 419; - Name_Storage_Unit : constant Name_Id := N + 420; -- GNAT - Name_Tag : constant Name_Id := N + 421; - Name_Target_Name : constant Name_Id := N + 422; -- GNAT - Name_Terminated : constant Name_Id := N + 423; - Name_To_Address : constant Name_Id := N + 424; -- GNAT - Name_Type_Class : constant Name_Id := N + 425; -- GNAT - Name_UET_Address : constant Name_Id := N + 426; -- GNAT - Name_Unbiased_Rounding : constant Name_Id := N + 427; - Name_Unchecked_Access : constant Name_Id := N + 428; - Name_Unconstrained_Array : constant Name_Id := N + 429; - Name_Universal_Literal_String : constant Name_Id := N + 430; -- GNAT - Name_Unrestricted_Access : constant Name_Id := N + 431; -- GNAT - Name_VADS_Size : constant Name_Id := N + 432; -- GNAT - Name_Val : constant Name_Id := N + 433; - Name_Valid : constant Name_Id := N + 434; - Name_Value_Size : constant Name_Id := N + 435; -- GNAT - Name_Version : constant Name_Id := N + 436; - Name_Wchar_T_Size : constant Name_Id := N + 437; -- GNAT - Name_Wide_Width : constant Name_Id := N + 438; - Name_Width : constant Name_Id := N + 439; - Name_Word_Size : constant Name_Id := N + 440; -- GNAT - - -- Attributes that designate attributes returning renamable functions, - -- i.e. functions that return other than a universal value and that - -- have non-universal arguments. - - First_Renamable_Function_Attribute : constant Name_Id := N + 441; - Name_Adjacent : constant Name_Id := N + 441; - Name_Ceiling : constant Name_Id := N + 442; - Name_Copy_Sign : constant Name_Id := N + 443; - Name_Floor : constant Name_Id := N + 444; - Name_Fraction : constant Name_Id := N + 445; - Name_Image : constant Name_Id := N + 446; - Name_Input : constant Name_Id := N + 447; - Name_Machine : constant Name_Id := N + 448; - Name_Max : constant Name_Id := N + 449; - Name_Min : constant Name_Id := N + 450; - Name_Model : constant Name_Id := N + 451; - Name_Pred : constant Name_Id := N + 452; - Name_Remainder : constant Name_Id := N + 453; - Name_Rounding : constant Name_Id := N + 454; - Name_Succ : constant Name_Id := N + 455; - Name_Truncation : constant Name_Id := N + 456; - Name_Value : constant Name_Id := N + 457; - Name_Wide_Image : constant Name_Id := N + 458; - Name_Wide_Value : constant Name_Id := N + 459; - Last_Renamable_Function_Attribute : constant Name_Id := N + 459; - - -- Attributes that designate procedures - - First_Procedure_Attribute : constant Name_Id := N + 460; - Name_Output : constant Name_Id := N + 460; - Name_Read : constant Name_Id := N + 461; - Name_Write : constant Name_Id := N + 462; - Last_Procedure_Attribute : constant Name_Id := N + 462; - - -- Remaining attributes are ones that return entities - - First_Entity_Attribute_Name : constant Name_Id := N + 463; - Name_Elab_Body : constant Name_Id := N + 463; -- GNAT - Name_Elab_Spec : constant Name_Id := N + 464; -- GNAT - Name_Storage_Pool : constant Name_Id := N + 465; - - -- These attributes are the ones that return types - - First_Type_Attribute_Name : constant Name_Id := N + 466; - Name_Base : constant Name_Id := N + 466; - Name_Class : constant Name_Id := N + 467; - Last_Type_Attribute_Name : constant Name_Id := N + 467; - Last_Entity_Attribute_Name : constant Name_Id := N + 467; - Last_Attribute_Name : constant Name_Id := N + 467; - - -- Names of recognized locking policy identifiers - - -- Note: policies are identified by the first character of the - -- name (e.g. C for Ceiling_Locking). If new policy names are added, - -- the first character must be distinct. - - First_Locking_Policy_Name : constant Name_Id := N + 468; - Name_Ceiling_Locking : constant Name_Id := N + 468; - Name_Inheritance_Locking : constant Name_Id := N + 469; - Last_Locking_Policy_Name : constant Name_Id := N + 469; - - -- Names of recognized queuing policy identifiers. - - -- Note: policies are identified by the first character of the - -- name (e.g. F for FIFO_Queuing). If new policy names are added, - -- the first character must be distinct. - - First_Queuing_Policy_Name : constant Name_Id := N + 470; - Name_FIFO_Queuing : constant Name_Id := N + 470; - Name_Priority_Queuing : constant Name_Id := N + 471; - Last_Queuing_Policy_Name : constant Name_Id := N + 471; - - -- Names of recognized task dispatching policy identifiers - - -- Note: policies are identified by the first character of the - -- name (e.g. F for FIFO_WIthinn_Priorities). If new policy names - -- are added, the first character must be distinct. - - First_Task_Dispatching_Policy_Name : constant Name_Id := N + 472; - Name_FIFO_Within_Priorities : constant Name_Id := N + 472; - Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 472; - - -- Names of recognized checks for pragma Suppress - - First_Check_Name : constant Name_Id := N + 473; - Name_Access_Check : constant Name_Id := N + 473; - Name_Accessibility_Check : constant Name_Id := N + 474; - Name_Discriminant_Check : constant Name_Id := N + 475; - Name_Division_Check : constant Name_Id := N + 476; - Name_Elaboration_Check : constant Name_Id := N + 477; - Name_Index_Check : constant Name_Id := N + 478; - Name_Length_Check : constant Name_Id := N + 479; - Name_Overflow_Check : constant Name_Id := N + 480; - Name_Range_Check : constant Name_Id := N + 481; - Name_Storage_Check : constant Name_Id := N + 482; - Name_Tag_Check : constant Name_Id := N + 483; - Name_All_Checks : constant Name_Id := N + 484; - Last_Check_Name : constant Name_Id := N + 484; - - -- Names corresponding to reserved keywords, excluding those already - -- declared in the attribute list (Access, Delta, Digits, Mod, Range). - - Name_Abort : constant Name_Id := N + 485; - Name_Abs : constant Name_Id := N + 486; - Name_Accept : constant Name_Id := N + 487; - Name_And : constant Name_Id := N + 488; - Name_All : constant Name_Id := N + 489; - Name_Array : constant Name_Id := N + 490; - Name_At : constant Name_Id := N + 491; - Name_Begin : constant Name_Id := N + 492; - Name_Body : constant Name_Id := N + 493; - Name_Case : constant Name_Id := N + 494; - Name_Constant : constant Name_Id := N + 495; - Name_Declare : constant Name_Id := N + 496; - Name_Delay : constant Name_Id := N + 497; - Name_Do : constant Name_Id := N + 498; - Name_Else : constant Name_Id := N + 499; - Name_Elsif : constant Name_Id := N + 500; - Name_End : constant Name_Id := N + 501; - Name_Entry : constant Name_Id := N + 502; - Name_Exception : constant Name_Id := N + 503; - Name_Exit : constant Name_Id := N + 504; - Name_For : constant Name_Id := N + 505; - Name_Function : constant Name_Id := N + 506; - Name_Generic : constant Name_Id := N + 507; - Name_Goto : constant Name_Id := N + 508; - Name_If : constant Name_Id := N + 509; - Name_In : constant Name_Id := N + 510; - Name_Is : constant Name_Id := N + 511; - Name_Limited : constant Name_Id := N + 512; - Name_Loop : constant Name_Id := N + 513; - Name_New : constant Name_Id := N + 514; - Name_Not : constant Name_Id := N + 515; - Name_Null : constant Name_Id := N + 516; - Name_Of : constant Name_Id := N + 517; - Name_Or : constant Name_Id := N + 518; - Name_Others : constant Name_Id := N + 519; - Name_Out : constant Name_Id := N + 520; - Name_Package : constant Name_Id := N + 521; - Name_Pragma : constant Name_Id := N + 522; - Name_Private : constant Name_Id := N + 523; - Name_Procedure : constant Name_Id := N + 524; - Name_Raise : constant Name_Id := N + 525; - Name_Record : constant Name_Id := N + 526; - Name_Rem : constant Name_Id := N + 527; - Name_Renames : constant Name_Id := N + 528; - Name_Return : constant Name_Id := N + 529; - Name_Reverse : constant Name_Id := N + 530; - Name_Select : constant Name_Id := N + 531; - Name_Separate : constant Name_Id := N + 532; - Name_Subtype : constant Name_Id := N + 533; - Name_Task : constant Name_Id := N + 534; - Name_Terminate : constant Name_Id := N + 535; - Name_Then : constant Name_Id := N + 536; - Name_Type : constant Name_Id := N + 537; - Name_Use : constant Name_Id := N + 538; - Name_When : constant Name_Id := N + 539; - Name_While : constant Name_Id := N + 540; - Name_With : constant Name_Id := N + 541; - Name_Xor : constant Name_Id := N + 542; - - -- Names of intrinsic subprograms - - -- Note: Asm is missing from this list, since Asm is a legitimate - -- convention name. So is To_Adress, which is a GNAT attribute. - - First_Intrinsic_Name : constant Name_Id := N + 543; - Name_Divide : constant Name_Id := N + 543; - Name_Enclosing_Entity : constant Name_Id := N + 544; - Name_Exception_Information : constant Name_Id := N + 545; - Name_Exception_Message : constant Name_Id := N + 546; - Name_Exception_Name : constant Name_Id := N + 547; - Name_File : constant Name_Id := N + 548; - Name_Import_Address : constant Name_Id := N + 549; - Name_Import_Largest_Value : constant Name_Id := N + 550; - Name_Import_Value : constant Name_Id := N + 551; - Name_Is_Negative : constant Name_Id := N + 552; - Name_Line : constant Name_Id := N + 553; - Name_Rotate_Left : constant Name_Id := N + 554; - Name_Rotate_Right : constant Name_Id := N + 555; - Name_Shift_Left : constant Name_Id := N + 556; - Name_Shift_Right : constant Name_Id := N + 557; - Name_Shift_Right_Arithmetic : constant Name_Id := N + 558; - Name_Source_Location : constant Name_Id := N + 559; - Name_Unchecked_Conversion : constant Name_Id := N + 560; - Name_Unchecked_Deallocation : constant Name_Id := N + 561; - Name_To_Pointer : constant Name_Id := N + 562; - Last_Intrinsic_Name : constant Name_Id := N + 562; - - -- Reserved words used only in Ada 95 - - First_95_Reserved_Word : constant Name_Id := N + 563; - Name_Abstract : constant Name_Id := N + 563; - Name_Aliased : constant Name_Id := N + 564; - Name_Protected : constant Name_Id := N + 565; - Name_Until : constant Name_Id := N + 566; - Name_Requeue : constant Name_Id := N + 567; - Name_Tagged : constant Name_Id := N + 568; - Last_95_Reserved_Word : constant Name_Id := N + 568; - - subtype Ada_95_Reserved_Words is - Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word; - - -- Miscellaneous names used in semantic checking - - Name_Raise_Exception : constant Name_Id := N + 569; - - -- Additional reserved words and identifiers used in GNAT Project Files - -- Note that Name_External is already previously declared - - Name_Ada_Roots : constant Name_Id := N + 570; - Name_Binder : constant Name_Id := N + 571; - Name_Binder_Driver : constant Name_Id := N + 572; - Name_Body_Suffix : constant Name_Id := N + 573; - Name_Builder : constant Name_Id := N + 574; - Name_Compiler : constant Name_Id := N + 575; - Name_Compiler_Driver : constant Name_Id := N + 576; - Name_Compiler_Kind : constant Name_Id := N + 577; - Name_Compute_Dependency : constant Name_Id := N + 578; - Name_Cross_Reference : constant Name_Id := N + 579; - Name_Default_Linker : constant Name_Id := N + 580; - Name_Default_Switches : constant Name_Id := N + 581; - Name_Dependency_Option : constant Name_Id := N + 582; - Name_Exec_Dir : constant Name_Id := N + 583; - Name_Executable : constant Name_Id := N + 584; - Name_Executable_Suffix : constant Name_Id := N + 585; - Name_Extends : constant Name_Id := N + 586; - Name_Externally_Built : constant Name_Id := N + 587; - Name_Finder : constant Name_Id := N + 588; - Name_Global_Configuration_Pragmas : constant Name_Id := N + 589; - Name_Gnatls : constant Name_Id := N + 590; - Name_Gnatstub : constant Name_Id := N + 591; - Name_Implementation : constant Name_Id := N + 592; - Name_Implementation_Exceptions : constant Name_Id := N + 593; - Name_Implementation_Suffix : constant Name_Id := N + 594; - Name_Include_Option : constant Name_Id := N + 595; - Name_Language_Processing : constant Name_Id := N + 596; - Name_Languages : constant Name_Id := N + 597; - Name_Library_Dir : constant Name_Id := N + 598; - Name_Library_Auto_Init : constant Name_Id := N + 599; - Name_Library_GCC : constant Name_Id := N + 600; - Name_Library_Interface : constant Name_Id := N + 601; - Name_Library_Kind : constant Name_Id := N + 602; - Name_Library_Name : constant Name_Id := N + 603; - Name_Library_Options : constant Name_Id := N + 604; - Name_Library_Reference_Symbol_File : constant Name_Id := N + 605; - Name_Library_Src_Dir : constant Name_Id := N + 606; - Name_Library_Symbol_File : constant Name_Id := N + 607; - Name_Library_Symbol_Policy : constant Name_Id := N + 608; - Name_Library_Version : constant Name_Id := N + 609; - Name_Linker : constant Name_Id := N + 610; - Name_Local_Configuration_Pragmas : constant Name_Id := N + 611; - Name_Locally_Removed_Files : constant Name_Id := N + 612; - Name_Metrics : constant Name_Id := N + 613; - Name_Naming : constant Name_Id := N + 614; - Name_Object_Dir : constant Name_Id := N + 615; - Name_Pretty_Printer : constant Name_Id := N + 616; - Name_Project : constant Name_Id := N + 617; - Name_Separate_Suffix : constant Name_Id := N + 618; - Name_Source_Dirs : constant Name_Id := N + 619; - Name_Source_Files : constant Name_Id := N + 620; - Name_Source_List_File : constant Name_Id := N + 621; - Name_Spec : constant Name_Id := N + 622; - Name_Spec_Suffix : constant Name_Id := N + 623; - Name_Specification : constant Name_Id := N + 624; - Name_Specification_Exceptions : constant Name_Id := N + 625; - Name_Specification_Suffix : constant Name_Id := N + 626; - Name_Switches : constant Name_Id := N + 627; - - -- Other miscellaneous names used in front end - - Name_Unaligned_Valid : constant Name_Id := N + 628; - - -- Mark last defined name for consistency check in Snames body - - Last_Predefined_Name : constant Name_Id := N + 628; - - subtype Any_Operator_Name is Name_Id range - First_Operator_Name .. Last_Operator_Name; - - ------------------------------ - -- Attribute ID Definitions -- - ------------------------------ - - type Attribute_Id is ( - Attribute_Abort_Signal, - Attribute_Access, - Attribute_Address, - Attribute_Address_Size, - Attribute_Aft, - Attribute_Alignment, - Attribute_Asm_Input, - Attribute_Asm_Output, - Attribute_AST_Entry, - Attribute_Bit, - Attribute_Bit_Order, - Attribute_Bit_Position, - Attribute_Body_Version, - Attribute_Callable, - Attribute_Caller, - Attribute_Code_Address, - Attribute_Component_Size, - Attribute_Compose, - Attribute_Constrained, - Attribute_Count, - Attribute_Default_Bit_Order, - Attribute_Definite, - Attribute_Delta, - Attribute_Denorm, - Attribute_Digits, - Attribute_Elaborated, - Attribute_Emax, - Attribute_Enum_Rep, - Attribute_Epsilon, - Attribute_Exponent, - Attribute_External_Tag, - Attribute_First, - Attribute_First_Bit, - Attribute_Fixed_Value, - Attribute_Fore, - Attribute_Has_Access_Values, - Attribute_Has_Discriminants, - Attribute_Identity, - Attribute_Img, - Attribute_Integer_Value, - Attribute_Large, - Attribute_Last, - Attribute_Last_Bit, - Attribute_Leading_Part, - Attribute_Length, - Attribute_Machine_Emax, - Attribute_Machine_Emin, - Attribute_Machine_Mantissa, - Attribute_Machine_Overflows, - Attribute_Machine_Radix, - Attribute_Machine_Rounds, - Attribute_Machine_Size, - Attribute_Mantissa, - Attribute_Max_Size_In_Storage_Elements, - Attribute_Maximum_Alignment, - Attribute_Mechanism_Code, - Attribute_Mod, - Attribute_Model_Emin, - Attribute_Model_Epsilon, - Attribute_Model_Mantissa, - Attribute_Model_Small, - Attribute_Modulus, - Attribute_Null_Parameter, - Attribute_Object_Size, - Attribute_Partition_ID, - Attribute_Passed_By_Reference, - Attribute_Pool_Address, - Attribute_Pos, - Attribute_Position, - Attribute_Range, - Attribute_Range_Length, - Attribute_Round, - Attribute_Safe_Emax, - Attribute_Safe_First, - Attribute_Safe_Large, - Attribute_Safe_Last, - Attribute_Safe_Small, - Attribute_Scale, - Attribute_Scaling, - Attribute_Signed_Zeros, - Attribute_Size, - Attribute_Small, - Attribute_Storage_Size, - Attribute_Storage_Unit, - Attribute_Tag, - Attribute_Target_Name, - Attribute_Terminated, - Attribute_To_Address, - Attribute_Type_Class, - Attribute_UET_Address, - Attribute_Unbiased_Rounding, - Attribute_Unchecked_Access, - Attribute_Unconstrained_Array, - Attribute_Universal_Literal_String, - Attribute_Unrestricted_Access, - Attribute_VADS_Size, - Attribute_Val, - Attribute_Valid, - Attribute_Value_Size, - Attribute_Version, - Attribute_Wchar_T_Size, - Attribute_Wide_Width, - Attribute_Width, - Attribute_Word_Size, - - -- Attributes designating renamable functions - - Attribute_Adjacent, - Attribute_Ceiling, - Attribute_Copy_Sign, - Attribute_Floor, - Attribute_Fraction, - Attribute_Image, - Attribute_Input, - Attribute_Machine, - Attribute_Max, - Attribute_Min, - Attribute_Model, - Attribute_Pred, - Attribute_Remainder, - Attribute_Rounding, - Attribute_Succ, - Attribute_Truncation, - Attribute_Value, - Attribute_Wide_Image, - Attribute_Wide_Value, - - -- Attributes designating procedures - - Attribute_Output, - Attribute_Read, - Attribute_Write, - - -- Entity attributes (includes type attributes) - - Attribute_Elab_Body, - Attribute_Elab_Spec, - Attribute_Storage_Pool, - - -- Type attributes - - Attribute_Base, - Attribute_Class); - - ------------------------------------ - -- Convention Name ID Definitions -- - ------------------------------------ - - type Convention_Id is ( - - -- The conventions that are defined by the RM come first - - Convention_Ada, - Convention_Intrinsic, - Convention_Entry, - Convention_Protected, - - -- The remaining conventions are foreign language conventions - - Convention_Assembler, -- also Asm, Assembly - Convention_C, -- also Default, External - Convention_COBOL, - Convention_CPP, - Convention_Fortran, - Convention_Java, - Convention_Stdcall, -- also DLL, Win32 - Convention_Stubbed); - - -- Note: Convention C_Pass_By_Copy is allowed only for record - -- types (where it is treated like C except that the appropriate - -- flag is set in the record type). Recognizion of this convention - -- is specially handled in Sem_Prag. - - for Convention_Id'Size use 8; - -- Plenty of space for expansion - - subtype Foreign_Convention is - Convention_Id range Convention_Assembler .. Convention_Stdcall; - - ----------------------------------- - -- Locking Policy ID Definitions -- - ----------------------------------- - - type Locking_Policy_Id is ( - Locking_Policy_Inheritance_Locking, - Locking_Policy_Ceiling_Locking); - - --------------------------- - -- Pragma ID Definitions -- - --------------------------- - - type Pragma_Id is ( - - -- Configuration pragmas - - Pragma_Ada_83, - Pragma_Ada_95, - Pragma_Ada_05, - Pragma_C_Pass_By_Copy, - Pragma_Compile_Time_Warning, - Pragma_Component_Alignment, - Pragma_Convention_Identifier, - Pragma_Detect_Blocking, - Pragma_Discard_Names, - Pragma_Elaboration_Checks, - Pragma_Eliminate, - Pragma_Explicit_Overriding, - Pragma_Extend_System, - Pragma_Extensions_Allowed, - Pragma_External_Name_Casing, - Pragma_Float_Representation, - Pragma_Initialize_Scalars, - Pragma_Interrupt_State, - Pragma_License, - Pragma_Locking_Policy, - Pragma_Long_Float, - Pragma_No_Run_Time, - Pragma_No_Strict_Aliasing, - Pragma_Normalize_Scalars, - Pragma_Polling, - Pragma_Persistent_Data, - Pragma_Persistent_Object, - Pragma_Profile, - Pragma_Profile_Warnings, - Pragma_Propagate_Exceptions, - Pragma_Queuing_Policy, - Pragma_Ravenscar, - Pragma_Restricted_Run_Time, - Pragma_Restrictions, - Pragma_Restriction_Warnings, - Pragma_Reviewable, - Pragma_Source_File_Name, - Pragma_Source_File_Name_Project, - Pragma_Style_Checks, - Pragma_Suppress, - Pragma_Suppress_Exception_Locations, - Pragma_Task_Dispatching_Policy, - Pragma_Universal_Data, - Pragma_Unsuppress, - Pragma_Use_VADS_Size, - Pragma_Validity_Checks, - Pragma_Warnings, - - -- Remaining (non-configuration) pragmas - - Pragma_Abort_Defer, - Pragma_All_Calls_Remote, - Pragma_Annotate, - Pragma_Assert, - Pragma_Asynchronous, - Pragma_Atomic, - Pragma_Atomic_Components, - Pragma_Attach_Handler, - Pragma_Comment, - Pragma_Common_Object, - Pragma_Complex_Representation, - Pragma_Controlled, - Pragma_Convention, - Pragma_CPP_Class, - Pragma_CPP_Constructor, - Pragma_CPP_Virtual, - Pragma_CPP_Vtable, - Pragma_Debug, - Pragma_Elaborate, - Pragma_Elaborate_All, - Pragma_Elaborate_Body, - Pragma_Export, - Pragma_Export_Exception, - Pragma_Export_Function, - Pragma_Export_Object, - Pragma_Export_Procedure, - Pragma_Export_Value, - Pragma_Export_Valued_Procedure, - Pragma_External, - Pragma_Finalize_Storage_Only, - Pragma_Ident, - Pragma_Import, - Pragma_Import_Exception, - Pragma_Import_Function, - Pragma_Import_Object, - Pragma_Import_Procedure, - Pragma_Import_Valued_Procedure, - Pragma_Inline, - Pragma_Inline_Always, - Pragma_Inline_Generic, - Pragma_Inspection_Point, - Pragma_Interface, - Pragma_Interface_Name, - Pragma_Interrupt_Handler, - Pragma_Interrupt_Priority, - Pragma_Java_Constructor, - Pragma_Java_Interface, - Pragma_Keep_Names, - Pragma_Link_With, - Pragma_Linker_Alias, - Pragma_Linker_Options, - Pragma_Linker_Section, - Pragma_List, - Pragma_Machine_Attribute, - Pragma_Main, - Pragma_Main_Storage, - Pragma_Memory_Size, - Pragma_No_Return, - Pragma_Obsolescent, - Pragma_Optimize, - Pragma_Optional_Overriding, - Pragma_Overriding, - Pragma_Pack, - Pragma_Page, - Pragma_Passive, - Pragma_Preelaborate, - Pragma_Priority, - Pragma_Psect_Object, - Pragma_Pure, - Pragma_Pure_Function, - Pragma_Remote_Call_Interface, - Pragma_Remote_Types, - Pragma_Share_Generic, - Pragma_Shared, - Pragma_Shared_Passive, - Pragma_Source_Reference, - Pragma_Stream_Convert, - Pragma_Subtitle, - Pragma_Suppress_All, - Pragma_Suppress_Debug_Info, - Pragma_Suppress_Initialization, - Pragma_System_Name, - Pragma_Task_Info, - Pragma_Task_Name, - Pragma_Task_Storage, - Pragma_Thread_Body, - Pragma_Time_Slice, - Pragma_Title, - Pragma_Unchecked_Union, - Pragma_Unimplemented_Unit, - Pragma_Unreferenced, - Pragma_Unreserve_All_Interrupts, - Pragma_Volatile, - Pragma_Volatile_Components, - Pragma_Weak_External, - - -- The following pragmas are on their own, out of order, because of - -- the special processing required to deal with the fact that their - -- names match existing attribute names. - - Pragma_AST_Entry, - Pragma_Storage_Size, - Pragma_Storage_Unit, - - -- The value to represent an unknown or unrecognized pragma - - Unknown_Pragma); - - ----------------------------------- - -- Queuing Policy ID definitions -- - ----------------------------------- - - type Queuing_Policy_Id is ( - Queuing_Policy_FIFO_Queuing, - Queuing_Policy_Priority_Queuing); - - -------------------------------------------- - -- Task Dispatching Policy ID definitions -- - -------------------------------------------- - - type Task_Dispatching_Policy_Id is ( - Task_Dispatching_FIFO_Within_Priorities); - -- Id values used to identify task dispatching policies - - ----------------- - -- Subprograms -- - ----------------- - - procedure Initialize; - -- Called to initialize the preset names in the names table. - - function Is_Attribute_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized attribute - - function Is_Entity_Attribute_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized entity attribute, - -- i.e. an attribute reference that returns an entity. - - function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized attribute that - -- designates a procedure (and can therefore appear as a statement). - - function Is_Function_Attribute_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized attribute - -- that designates a renameable function, and can therefore appear in - -- a renaming statement. Note that not all attributes designating - -- functions are renamable, in particular, thos returning a universal - -- value cannot be renamed. - - function Is_Type_Attribute_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized type attribute, - -- i.e. an attribute reference that returns a type - - function Is_Check_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized suppress check - -- as required by pragma Suppress. - - function Is_Convention_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of one of the recognized - -- language conventions, as required by pragma Convention, Import, - -- Export, Interface. Returns True if so. Also returns True for a - -- name that has been specified by a Convention_Identifier pragma. - -- If neither case holds, returns False. - - function Is_Locking_Policy_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized locking policy - - function Is_Operator_Symbol_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of an operator symbol - - function Is_Pragma_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized pragma. Note - -- that pragmas AST_Entry, Storage_Size, and Storage_Unit are recognized - -- as pragmas by this function even though their names are separate from - -- the other pragma names. - - function Is_Queuing_Policy_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized queuing policy - - function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized task - -- dispatching policy. - - function Get_Attribute_Id (N : Name_Id) return Attribute_Id; - -- Returns Id of attribute corresponding to given name. It is an error to - -- call this function with a name that is not the name of a attribute. - - function Get_Convention_Id (N : Name_Id) return Convention_Id; - -- Returns Id of language convention corresponding to given name. It is an - -- to call this function with a name that is not the name of a convention, - -- or one previously given in a call to Record_Convention_Identifier. - - function Get_Check_Id (N : Name_Id) return Check_Id; - -- Returns Id of suppress check corresponding to given name. It is an error - -- to call this function with a name that is not the name of a check. - - function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id; - -- Returns Id of locking policy corresponding to given name. It is an error - -- to call this function with a name that is not the name of a check. - - function Get_Pragma_Id (N : Name_Id) return Pragma_Id; - -- Returns Id of pragma corresponding to given name. Returns Unknown_Pragma - -- if N is not a name of a known (Ada defined or GNAT-specific) pragma. - -- Note that the function also works correctly for names of pragmas that - -- are not in the main list of pragma Names (AST_Entry, Storage_Size, and - -- Storage_Unit (e.g. Name_Storage_Size returns Pragma_Storage_Size). - - function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id; - -- Returns Id of queuing policy corresponding to given name. It is an error - -- to call this function with a name that is not the name of a check. - - function Get_Task_Dispatching_Policy_Id - (N : Name_Id) - return Task_Dispatching_Policy_Id; - -- Returns Id of task dispatching policy corresponding to given name. - -- It is an error to call this function with a name that is not the - -- name of a check. - - procedure Record_Convention_Identifier - (Id : Name_Id; - Convention : Convention_Id); - -- A call to this procedure, resulting from an occurrence of a pragma - -- Convention_Identifier, records that from now on an occurrence of - -- Id will be recognized as a name for the specified convention. - -private - pragma Inline (Is_Attribute_Name); - pragma Inline (Is_Entity_Attribute_Name); - pragma Inline (Is_Type_Attribute_Name); - pragma Inline (Is_Check_Name); - pragma Inline (Is_Locking_Policy_Name); - pragma Inline (Is_Operator_Symbol_Name); - pragma Inline (Is_Queuing_Policy_Name); - pragma Inline (Is_Pragma_Name); - pragma Inline (Is_Task_Dispatching_Policy_Name); - -end Snames; +------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S N A M E S --
+-- --
+-- S p e c --
+-- --
+-- 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- --
+-- ware Foundation; either version 2, 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. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
+-- MA 02111-1307, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Types; use Types;
+
+package Snames is
+
+-- This package contains definitions of standard names (i.e. entries in the
+-- Names table) that are used throughout the GNAT compiler). It also contains
+-- the definitions of some enumeration types whose definitions are tied to
+-- the order of these preset names.
+
+-- WARNING: There is a C file, a-snames.h which duplicates some of the
+-- definitions in this file and must be kept properly synchronized.
+
+ ------------------
+ -- Preset Names --
+ ------------------
+
+ -- The following are preset entries in the names table, which are
+ -- entered at the start of every compilation for easy access. Note
+ -- that the order of initialization of these names in the body must
+ -- be coordinated with the order of names in this table.
+
+ -- Note: a name may not appear more than once in the following list.
+ -- If additional pragmas or attributes are introduced which might
+ -- otherwise cause a duplicate, then list it only once in this table,
+ -- and adjust the definition of the functions for testing for pragma
+ -- names and attribute names, and returning their ID values. Of course
+ -- everything is simpler if no such duplications occur!
+
+ -- First we have the one character names used to optimize the lookup
+ -- process for one character identifiers (to avoid the hashing in this
+ -- case) There are a full 256 of these, but only the entries for lower
+ -- case and upper case letters have identifiers
+
+ -- The lower case letter entries are used for one character identifiers
+ -- appearing in the source, for example in pragma Interface (C).
+
+ Name_A : constant Name_Id := First_Name_Id + Character'Pos ('a');
+ Name_B : constant Name_Id := First_Name_Id + Character'Pos ('b');
+ Name_C : constant Name_Id := First_Name_Id + Character'Pos ('c');
+ Name_D : constant Name_Id := First_Name_Id + Character'Pos ('d');
+ Name_E : constant Name_Id := First_Name_Id + Character'Pos ('e');
+ Name_F : constant Name_Id := First_Name_Id + Character'Pos ('f');
+ Name_G : constant Name_Id := First_Name_Id + Character'Pos ('g');
+ Name_H : constant Name_Id := First_Name_Id + Character'Pos ('h');
+ Name_I : constant Name_Id := First_Name_Id + Character'Pos ('i');
+ Name_J : constant Name_Id := First_Name_Id + Character'Pos ('j');
+ Name_K : constant Name_Id := First_Name_Id + Character'Pos ('k');
+ Name_L : constant Name_Id := First_Name_Id + Character'Pos ('l');
+ Name_M : constant Name_Id := First_Name_Id + Character'Pos ('m');
+ Name_N : constant Name_Id := First_Name_Id + Character'Pos ('n');
+ Name_O : constant Name_Id := First_Name_Id + Character'Pos ('o');
+ Name_P : constant Name_Id := First_Name_Id + Character'Pos ('p');
+ Name_Q : constant Name_Id := First_Name_Id + Character'Pos ('q');
+ Name_R : constant Name_Id := First_Name_Id + Character'Pos ('r');
+ Name_S : constant Name_Id := First_Name_Id + Character'Pos ('s');
+ Name_T : constant Name_Id := First_Name_Id + Character'Pos ('t');
+ Name_U : constant Name_Id := First_Name_Id + Character'Pos ('u');
+ Name_V : constant Name_Id := First_Name_Id + Character'Pos ('v');
+ Name_W : constant Name_Id := First_Name_Id + Character'Pos ('w');
+ Name_X : constant Name_Id := First_Name_Id + Character'Pos ('x');
+ Name_Y : constant Name_Id := First_Name_Id + Character'Pos ('y');
+ Name_Z : constant Name_Id := First_Name_Id + Character'Pos ('z');
+
+ -- The upper case letter entries are used by expander code for local
+ -- variables that do not require unique names (e.g. formal parameter
+ -- names in constructed procedures)
+
+ Name_uA : constant Name_Id := First_Name_Id + Character'Pos ('A');
+ Name_uB : constant Name_Id := First_Name_Id + Character'Pos ('B');
+ Name_uC : constant Name_Id := First_Name_Id + Character'Pos ('C');
+ Name_uD : constant Name_Id := First_Name_Id + Character'Pos ('D');
+ Name_uE : constant Name_Id := First_Name_Id + Character'Pos ('E');
+ Name_uF : constant Name_Id := First_Name_Id + Character'Pos ('F');
+ Name_uG : constant Name_Id := First_Name_Id + Character'Pos ('G');
+ Name_uH : constant Name_Id := First_Name_Id + Character'Pos ('H');
+ Name_uI : constant Name_Id := First_Name_Id + Character'Pos ('I');
+ Name_uJ : constant Name_Id := First_Name_Id + Character'Pos ('J');
+ Name_uK : constant Name_Id := First_Name_Id + Character'Pos ('K');
+ Name_uL : constant Name_Id := First_Name_Id + Character'Pos ('L');
+ Name_uM : constant Name_Id := First_Name_Id + Character'Pos ('M');
+ Name_uN : constant Name_Id := First_Name_Id + Character'Pos ('N');
+ Name_uO : constant Name_Id := First_Name_Id + Character'Pos ('O');
+ Name_uP : constant Name_Id := First_Name_Id + Character'Pos ('P');
+ Name_uQ : constant Name_Id := First_Name_Id + Character'Pos ('Q');
+ Name_uR : constant Name_Id := First_Name_Id + Character'Pos ('R');
+ Name_uS : constant Name_Id := First_Name_Id + Character'Pos ('S');
+ Name_uT : constant Name_Id := First_Name_Id + Character'Pos ('T');
+ Name_uU : constant Name_Id := First_Name_Id + Character'Pos ('U');
+ Name_uV : constant Name_Id := First_Name_Id + Character'Pos ('V');
+ Name_uW : constant Name_Id := First_Name_Id + Character'Pos ('W');
+ Name_uX : constant Name_Id := First_Name_Id + Character'Pos ('X');
+ Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y');
+ Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z');
+
+ -- Note: the following table is read by the utility program XSNAMES and
+ -- its format should not be changed without coordinating with this program.
+
+ N : constant Name_Id := First_Name_Id + 256;
+ -- Synonym used in standard name definitions
+
+ -- Some names that are used by gigi, and whose definitions are reflected
+ -- in the C header file a-snames.h. They are placed at the start so that
+ -- the need to modify a-snames.h is minimized.
+
+ Name_uParent : constant Name_Id := N + 000;
+ Name_uTag : constant Name_Id := N + 001;
+ Name_Off : constant Name_Id := N + 002;
+ Name_Space : constant Name_Id := N + 003;
+ Name_Time : constant Name_Id := N + 004;
+
+ -- Some special names used by the expander. Note that the lower case u's
+ -- at the start of these names get translated to extra underscores. These
+ -- names are only referenced internally by expander generated code.
+
+ Name_uAbort_Signal : constant Name_Id := N + 005;
+ Name_uAlignment : constant Name_Id := N + 006;
+ Name_uAssign : constant Name_Id := N + 007;
+ Name_uATCB : constant Name_Id := N + 008;
+ Name_uChain : constant Name_Id := N + 009;
+ Name_uClean : constant Name_Id := N + 010;
+ Name_uController : constant Name_Id := N + 011;
+ Name_uEntry_Bodies : constant Name_Id := N + 012;
+ Name_uExpunge : constant Name_Id := N + 013;
+ Name_uFinal_List : constant Name_Id := N + 014;
+ Name_uIdepth : constant Name_Id := N + 015;
+ Name_uInit : constant Name_Id := N + 016;
+ Name_uLocal_Final_List : constant Name_Id := N + 017;
+ Name_uMaster : constant Name_Id := N + 018;
+ Name_uObject : constant Name_Id := N + 019;
+ Name_uPriority : constant Name_Id := N + 020;
+ Name_uProcess_ATSD : constant Name_Id := N + 021;
+ Name_uSecondary_Stack : constant Name_Id := N + 022;
+ Name_uService : constant Name_Id := N + 023;
+ Name_uSize : constant Name_Id := N + 024;
+ Name_uStack : constant Name_Id := N + 025;
+ Name_uTags : constant Name_Id := N + 026;
+ Name_uTask : constant Name_Id := N + 027;
+ Name_uTask_Id : constant Name_Id := N + 028;
+ Name_uTask_Info : constant Name_Id := N + 029;
+ Name_uTask_Name : constant Name_Id := N + 030;
+ Name_uTrace_Sp : constant Name_Id := N + 031;
+
+ -- Names of routines in Ada.Finalization, needed by expander
+
+ Name_Initialize : constant Name_Id := N + 032;
+ Name_Adjust : constant Name_Id := N + 033;
+ Name_Finalize : constant Name_Id := N + 034;
+
+ -- Names of fields declared in System.Finalization_Implementation,
+ -- needed by the expander when generating code for finalization.
+
+ Name_Next : constant Name_Id := N + 035;
+ Name_Prev : constant Name_Id := N + 036;
+
+ -- Names of TSS routines for implementation of DSA over PolyORB
+
+ Name_uTypeCode : constant Name_Id := N + 037;
+ Name_uFrom_Any : constant Name_Id := N + 038;
+ Name_uTo_Any : constant Name_Id := N + 039;
+
+ -- Names of allocation routines, also needed by expander
+
+ Name_Allocate : constant Name_Id := N + 040;
+ Name_Deallocate : constant Name_Id := N + 041;
+ Name_Dereference : constant Name_Id := N + 042;
+
+ -- Names of Text_IO generic subpackages (see Rtsfind.Text_IO_Kludge)
+
+ First_Text_IO_Package : constant Name_Id := N + 043;
+ Name_Decimal_IO : constant Name_Id := N + 043;
+ Name_Enumeration_IO : constant Name_Id := N + 044;
+ Name_Fixed_IO : constant Name_Id := N + 045;
+ Name_Float_IO : constant Name_Id := N + 046;
+ Name_Integer_IO : constant Name_Id := N + 047;
+ Name_Modular_IO : constant Name_Id := N + 048;
+ Last_Text_IO_Package : constant Name_Id := N + 048;
+
+ subtype Text_IO_Package_Name is Name_Id
+ range First_Text_IO_Package .. Last_Text_IO_Package;
+
+ -- Some miscellaneous names used for error detection/recovery
+
+ Name_Const : constant Name_Id := N + 049;
+ Name_Error : constant Name_Id := N + 050;
+ Name_Go : constant Name_Id := N + 051;
+ Name_Put : constant Name_Id := N + 052;
+ Name_Put_Line : constant Name_Id := N + 053;
+ Name_To : constant Name_Id := N + 054;
+
+ -- Names for packages that are treated specially by the compiler
+
+ Name_Finalization : constant Name_Id := N + 055;
+ Name_Finalization_Root : constant Name_Id := N + 056;
+ Name_Interfaces : constant Name_Id := N + 057;
+ Name_Standard : constant Name_Id := N + 058;
+ Name_System : constant Name_Id := N + 059;
+ Name_Text_IO : constant Name_Id := N + 060;
+ Name_Wide_Text_IO : constant Name_Id := N + 061;
+ Name_Wide_Wide_Text_IO : constant Name_Id := N + 062;
+
+ -- Names of implementations of the distributed systems annex
+
+ First_PCS_Name : constant Name_Id := N + 063;
+ Name_No_DSA : constant Name_Id := N + 063;
+ Name_GARLIC_DSA : constant Name_Id := N + 064;
+ Name_PolyORB_DSA : constant Name_Id := N + 065;
+ Last_PCS_Name : constant Name_Id := N + 065;
+
+ subtype PCS_Names is Name_Id
+ range First_PCS_Name .. Last_PCS_Name;
+
+ -- Names of identifiers used in expanding distribution stubs
+
+ Name_Addr : constant Name_Id := N + 066;
+ Name_Async : constant Name_Id := N + 067;
+ Name_Get_Active_Partition_ID : constant Name_Id := N + 068;
+ Name_Get_RCI_Package_Receiver : constant Name_Id := N + 069;
+ Name_Get_RCI_Package_Ref : constant Name_Id := N + 070;
+ Name_Origin : constant Name_Id := N + 071;
+ Name_Params : constant Name_Id := N + 072;
+ Name_Partition : constant Name_Id := N + 073;
+ Name_Partition_Interface : constant Name_Id := N + 074;
+ Name_Ras : constant Name_Id := N + 075;
+ Name_Call : constant Name_Id := N + 076;
+ Name_RCI_Name : constant Name_Id := N + 077;
+ Name_Receiver : constant Name_Id := N + 078;
+ Name_Result : constant Name_Id := N + 079;
+ Name_Rpc : constant Name_Id := N + 080;
+ Name_Subp_Id : constant Name_Id := N + 081;
+ Name_Operation : constant Name_Id := N + 082;
+ Name_Argument : constant Name_Id := N + 083;
+ Name_Arg_Modes : constant Name_Id := N + 084;
+ Name_Handler : constant Name_Id := N + 085;
+ Name_Target : constant Name_Id := N + 086;
+ Name_Req : constant Name_Id := N + 087;
+ Name_Obj_TypeCode : constant Name_Id := N + 088;
+ Name_Stub : constant Name_Id := N + 089;
+
+ -- Operator Symbol entries. The actual names have an upper case O at
+ -- the start in place of the Op_ prefix (e.g. the actual name that
+ -- corresponds to Name_Op_Abs is "Oabs".
+
+ First_Operator_Name : constant Name_Id := N + 090;
+ Name_Op_Abs : constant Name_Id := N + 090; -- "abs"
+ Name_Op_And : constant Name_Id := N + 091; -- "and"
+ Name_Op_Mod : constant Name_Id := N + 092; -- "mod"
+ Name_Op_Not : constant Name_Id := N + 093; -- "not"
+ Name_Op_Or : constant Name_Id := N + 094; -- "or"
+ Name_Op_Rem : constant Name_Id := N + 095; -- "rem"
+ Name_Op_Xor : constant Name_Id := N + 096; -- "xor"
+ Name_Op_Eq : constant Name_Id := N + 097; -- "="
+ Name_Op_Ne : constant Name_Id := N + 098; -- "/="
+ Name_Op_Lt : constant Name_Id := N + 099; -- "<"
+ Name_Op_Le : constant Name_Id := N + 100; -- "<="
+ Name_Op_Gt : constant Name_Id := N + 101; -- ">"
+ Name_Op_Ge : constant Name_Id := N + 102; -- ">="
+ Name_Op_Add : constant Name_Id := N + 103; -- "+"
+ Name_Op_Subtract : constant Name_Id := N + 104; -- "-"
+ Name_Op_Concat : constant Name_Id := N + 105; -- "&"
+ Name_Op_Multiply : constant Name_Id := N + 106; -- "*"
+ Name_Op_Divide : constant Name_Id := N + 107; -- "/"
+ Name_Op_Expon : constant Name_Id := N + 108; -- "**"
+ Last_Operator_Name : constant Name_Id := N + 108;
+
+ -- Names for all pragmas recognized by GNAT. The entries with the comment
+ -- "Ada 83" are pragmas that are defined in Ada 83, but not in Ada 95.
+ -- These pragmas are fully implemented in both Ada 83 and Ada 95 modes
+ -- in GNAT.
+
+ -- The entries marked GNAT are pragmas that are defined by GNAT
+ -- and implemented in both Ada 83 and Ada 95 modes. Full descriptions
+ -- of these implementation dependent pragmas may be found in the
+ -- appropriate section in unit Sem_Prag in file sem-prag.adb.
+
+ -- The entries marked Ada05 are technically implementation dependent
+ -- pragmas, but they correspond to standard proposals for Ada 2005.
+
+ -- The entries marked VMS are VMS specific pragmas that are recognized
+ -- only in OpenVMS versions of GNAT. They are ignored in other versions
+ -- with an appropriate warning.
+
+ -- The entries marked AAMP are AAMP specific pragmas that are recognized
+ -- only in GNAT for the AAMP. They are ignored in other versions with
+ -- appropriate warnings.
+
+ First_Pragma_Name : constant Name_Id := N + 109;
+
+ -- Configuration pragmas are grouped at start
+
+ Name_Ada_83 : constant Name_Id := N + 109; -- GNAT
+ Name_Ada_95 : constant Name_Id := N + 110; -- GNAT
+ Name_Ada_05 : constant Name_Id := N + 111; -- GNAT
+ Name_C_Pass_By_Copy : constant Name_Id := N + 112; -- GNAT
+ Name_Compile_Time_Warning : constant Name_Id := N + 113; -- GNAT
+ Name_Component_Alignment : constant Name_Id := N + 114; -- GNAT
+ Name_Convention_Identifier : constant Name_Id := N + 115; -- GNAT
+ Name_Detect_Blocking : constant Name_Id := N + 116; -- Ada05
+ Name_Discard_Names : constant Name_Id := N + 117;
+ Name_Elaboration_Checks : constant Name_Id := N + 118; -- GNAT
+ Name_Eliminate : constant Name_Id := N + 119; -- GNAT
+ Name_Explicit_Overriding : constant Name_Id := N + 120;
+ Name_Extend_System : constant Name_Id := N + 121; -- GNAT
+ Name_Extensions_Allowed : constant Name_Id := N + 122; -- GNAT
+ Name_External_Name_Casing : constant Name_Id := N + 123; -- GNAT
+ Name_Float_Representation : constant Name_Id := N + 124; -- GNAT
+ Name_Initialize_Scalars : constant Name_Id := N + 125; -- GNAT
+ Name_Interrupt_State : constant Name_Id := N + 126; -- GNAT
+ Name_License : constant Name_Id := N + 127; -- GNAT
+ Name_Locking_Policy : constant Name_Id := N + 128;
+ Name_Long_Float : constant Name_Id := N + 129; -- VMS
+ Name_No_Run_Time : constant Name_Id := N + 130; -- GNAT
+ Name_No_Strict_Aliasing : constant Name_Id := N + 131; -- GNAT
+ Name_Normalize_Scalars : constant Name_Id := N + 132;
+ Name_Polling : constant Name_Id := N + 133; -- GNAT
+ Name_Persistent_Data : constant Name_Id := N + 134; -- GNAT
+ Name_Persistent_Object : constant Name_Id := N + 135; -- GNAT
+ Name_Profile : constant Name_Id := N + 136; -- Ada05
+ Name_Profile_Warnings : constant Name_Id := N + 137; -- GNAT
+ Name_Propagate_Exceptions : constant Name_Id := N + 138; -- GNAT
+ Name_Queuing_Policy : constant Name_Id := N + 139;
+ Name_Ravenscar : constant Name_Id := N + 140;
+ Name_Restricted_Run_Time : constant Name_Id := N + 141;
+ Name_Restrictions : constant Name_Id := N + 142;
+ Name_Restriction_Warnings : constant Name_Id := N + 143; -- GNAT
+ Name_Reviewable : constant Name_Id := N + 144;
+ Name_Source_File_Name : constant Name_Id := N + 145; -- GNAT
+ Name_Source_File_Name_Project : constant Name_Id := N + 146; -- GNAT
+ Name_Style_Checks : constant Name_Id := N + 147; -- GNAT
+ Name_Suppress : constant Name_Id := N + 148;
+ Name_Suppress_Exception_Locations : constant Name_Id := N + 149; -- GNAT
+ Name_Task_Dispatching_Policy : constant Name_Id := N + 150;
+ Name_Universal_Data : constant Name_Id := N + 151; -- AAMP
+ Name_Unsuppress : constant Name_Id := N + 152; -- GNAT
+ Name_Use_VADS_Size : constant Name_Id := N + 153; -- GNAT
+ Name_Validity_Checks : constant Name_Id := N + 154; -- GNAT
+ Name_Warnings : constant Name_Id := N + 155; -- GNAT
+ Last_Configuration_Pragma_Name : constant Name_Id := N + 155;
+
+ -- Remaining pragma names
+
+ Name_Abort_Defer : constant Name_Id := N + 156; -- GNAT
+ Name_All_Calls_Remote : constant Name_Id := N + 157;
+ Name_Annotate : constant Name_Id := N + 158; -- GNAT
+
+ -- Note: AST_Entry is not in this list because its name matches the
+ -- name of the corresponding attribute. However, it is included in the
+ -- definition of the type Attribute_Id, and the functions Get_Pragma_Id
+ -- and Check_Pragma_Id correctly recognize and process Name_AST_Entry.
+ -- AST_Entry is a VMS specific pragma.
+
+ Name_Assert : constant Name_Id := N + 159; -- GNAT
+ Name_Asynchronous : constant Name_Id := N + 160;
+ Name_Atomic : constant Name_Id := N + 161;
+ Name_Atomic_Components : constant Name_Id := N + 162;
+ Name_Attach_Handler : constant Name_Id := N + 163;
+ Name_Comment : constant Name_Id := N + 164; -- GNAT
+ Name_Common_Object : constant Name_Id := N + 165; -- GNAT
+ Name_Complex_Representation : constant Name_Id := N + 166; -- GNAT
+ Name_Controlled : constant Name_Id := N + 167;
+ Name_Convention : constant Name_Id := N + 168;
+ Name_CPP_Class : constant Name_Id := N + 169; -- GNAT
+ Name_CPP_Constructor : constant Name_Id := N + 170; -- GNAT
+ Name_CPP_Virtual : constant Name_Id := N + 171; -- GNAT
+ Name_CPP_Vtable : constant Name_Id := N + 172; -- GNAT
+ Name_Debug : constant Name_Id := N + 173; -- GNAT
+ Name_Elaborate : constant Name_Id := N + 174; -- Ada 83
+ Name_Elaborate_All : constant Name_Id := N + 175;
+ Name_Elaborate_Body : constant Name_Id := N + 176;
+ Name_Export : constant Name_Id := N + 177;
+ Name_Export_Exception : constant Name_Id := N + 178; -- VMS
+ Name_Export_Function : constant Name_Id := N + 179; -- GNAT
+ Name_Export_Object : constant Name_Id := N + 180; -- GNAT
+ Name_Export_Procedure : constant Name_Id := N + 181; -- GNAT
+ Name_Export_Value : constant Name_Id := N + 182; -- GNAT
+ Name_Export_Valued_Procedure : constant Name_Id := N + 183; -- GNAT
+ Name_External : constant Name_Id := N + 184; -- GNAT
+ Name_Finalize_Storage_Only : constant Name_Id := N + 185; -- GNAT
+ Name_Ident : constant Name_Id := N + 186; -- VMS
+ Name_Import : constant Name_Id := N + 187;
+ Name_Import_Exception : constant Name_Id := N + 188; -- VMS
+ Name_Import_Function : constant Name_Id := N + 189; -- GNAT
+ Name_Import_Object : constant Name_Id := N + 190; -- GNAT
+ Name_Import_Procedure : constant Name_Id := N + 191; -- GNAT
+ Name_Import_Valued_Procedure : constant Name_Id := N + 192; -- GNAT
+ Name_Inline : constant Name_Id := N + 193;
+ Name_Inline_Always : constant Name_Id := N + 194; -- GNAT
+ Name_Inline_Generic : constant Name_Id := N + 195; -- GNAT
+ Name_Inspection_Point : constant Name_Id := N + 196;
+ Name_Interface_Name : constant Name_Id := N + 197; -- GNAT
+ Name_Interrupt_Handler : constant Name_Id := N + 198;
+ Name_Interrupt_Priority : constant Name_Id := N + 199;
+ Name_Java_Constructor : constant Name_Id := N + 200; -- GNAT
+ Name_Java_Interface : constant Name_Id := N + 201; -- GNAT
+ Name_Keep_Names : constant Name_Id := N + 202; -- GNAT
+ Name_Link_With : constant Name_Id := N + 203; -- GNAT
+ Name_Linker_Alias : constant Name_Id := N + 204; -- GNAT
+ Name_Linker_Options : constant Name_Id := N + 205;
+ Name_Linker_Section : constant Name_Id := N + 206; -- GNAT
+ Name_List : constant Name_Id := N + 207;
+ Name_Machine_Attribute : constant Name_Id := N + 208; -- GNAT
+ Name_Main : constant Name_Id := N + 209; -- GNAT
+ Name_Main_Storage : constant Name_Id := N + 210; -- GNAT
+ Name_Memory_Size : constant Name_Id := N + 211; -- Ada 83
+ Name_No_Return : constant Name_Id := N + 212; -- GNAT
+ Name_Obsolescent : constant Name_Id := N + 213; -- GNAT
+ Name_Optimize : constant Name_Id := N + 214;
+ Name_Optional_Overriding : constant Name_Id := N + 215;
+ Name_Pack : constant Name_Id := N + 216;
+ Name_Page : constant Name_Id := N + 217;
+ Name_Passive : constant Name_Id := N + 218; -- GNAT
+ Name_Preelaborate : constant Name_Id := N + 219;
+ Name_Priority : constant Name_Id := N + 220;
+ Name_Psect_Object : constant Name_Id := N + 221; -- VMS
+ Name_Pure : constant Name_Id := N + 222;
+ Name_Pure_Function : constant Name_Id := N + 223; -- GNAT
+ Name_Remote_Call_Interface : constant Name_Id := N + 224;
+ Name_Remote_Types : constant Name_Id := N + 225;
+ Name_Share_Generic : constant Name_Id := N + 226; -- GNAT
+ Name_Shared : constant Name_Id := N + 227; -- Ada 83
+ Name_Shared_Passive : constant Name_Id := N + 228;
+
+ -- Note: Storage_Size is not in this list because its name matches the
+ -- name of the corresponding attribute. However, it is included in the
+ -- definition of the type Attribute_Id, and the functions Get_Pragma_Id
+ -- and Check_Pragma_Id correctly recognize and process Name_Storage_Size.
+
+ -- Note: Storage_Unit is also omitted from the list because of a clash
+ -- with an attribute name, and is treated similarly.
+
+ Name_Source_Reference : constant Name_Id := N + 229; -- GNAT
+ Name_Stream_Convert : constant Name_Id := N + 230; -- GNAT
+ Name_Subtitle : constant Name_Id := N + 231; -- GNAT
+ Name_Suppress_All : constant Name_Id := N + 232; -- GNAT
+ Name_Suppress_Debug_Info : constant Name_Id := N + 233; -- GNAT
+ Name_Suppress_Initialization : constant Name_Id := N + 234; -- GNAT
+ Name_System_Name : constant Name_Id := N + 235; -- Ada 83
+ Name_Task_Info : constant Name_Id := N + 236; -- GNAT
+ Name_Task_Name : constant Name_Id := N + 237; -- GNAT
+ Name_Task_Storage : constant Name_Id := N + 238; -- VMS
+ Name_Thread_Body : constant Name_Id := N + 239; -- GNAT
+ Name_Time_Slice : constant Name_Id := N + 240; -- GNAT
+ Name_Title : constant Name_Id := N + 241; -- GNAT
+ Name_Unchecked_Union : constant Name_Id := N + 242; -- GNAT
+ Name_Unimplemented_Unit : constant Name_Id := N + 243; -- GNAT
+ Name_Unreferenced : constant Name_Id := N + 244; -- GNAT
+ Name_Unreserve_All_Interrupts : constant Name_Id := N + 245; -- GNAT
+ Name_Volatile : constant Name_Id := N + 246;
+ Name_Volatile_Components : constant Name_Id := N + 247;
+ Name_Weak_External : constant Name_Id := N + 248; -- GNAT
+ Last_Pragma_Name : constant Name_Id := N + 248;
+
+ -- Language convention names for pragma Convention/Export/Import/Interface
+ -- Note that Name_C is not included in this list, since it was already
+ -- declared earlier in the context of one-character identifier names
+ -- (where the order is critical to the fast look up process).
+
+ -- Note: there are no convention names corresponding to the conventions
+ -- Entry and Protected, this is because these conventions cannot be
+ -- specified by a pragma.
+
+ First_Convention_Name : constant Name_Id := N + 249;
+ Name_Ada : constant Name_Id := N + 249;
+ Name_Assembler : constant Name_Id := N + 250;
+ Name_COBOL : constant Name_Id := N + 251;
+ Name_CPP : constant Name_Id := N + 252;
+ Name_Fortran : constant Name_Id := N + 253;
+ Name_Intrinsic : constant Name_Id := N + 254;
+ Name_Java : constant Name_Id := N + 255;
+ Name_Stdcall : constant Name_Id := N + 256;
+ Name_Stubbed : constant Name_Id := N + 257;
+ Last_Convention_Name : constant Name_Id := N + 257;
+
+ -- The following names are preset as synonyms for Assembler
+
+ Name_Asm : constant Name_Id := N + 258;
+ Name_Assembly : constant Name_Id := N + 259;
+
+ -- The following names are preset as synonyms for C
+
+ Name_Default : constant Name_Id := N + 260;
+ -- Name_Exernal (previously defined as pragma)
+
+ -- The following names are present as synonyms for Stdcall
+
+ Name_DLL : constant Name_Id := N + 261;
+ Name_Win32 : constant Name_Id := N + 262;
+
+ -- Other special names used in processing pragmas
+
+ Name_As_Is : constant Name_Id := N + 263;
+ Name_Body_File_Name : constant Name_Id := N + 264;
+ Name_Boolean_Entry_Barriers : constant Name_Id := N + 265;
+ Name_Casing : constant Name_Id := N + 266;
+ Name_Code : constant Name_Id := N + 267;
+ Name_Component : constant Name_Id := N + 268;
+ Name_Component_Size_4 : constant Name_Id := N + 269;
+ Name_Copy : constant Name_Id := N + 270;
+ Name_D_Float : constant Name_Id := N + 271;
+ Name_Descriptor : constant Name_Id := N + 272;
+ Name_Dot_Replacement : constant Name_Id := N + 273;
+ Name_Dynamic : constant Name_Id := N + 274;
+ Name_Entity : constant Name_Id := N + 275;
+ Name_External_Name : constant Name_Id := N + 276;
+ Name_First_Optional_Parameter : constant Name_Id := N + 277;
+ Name_Form : constant Name_Id := N + 278;
+ Name_G_Float : constant Name_Id := N + 279;
+ Name_Gcc : constant Name_Id := N + 280;
+ Name_Gnat : constant Name_Id := N + 281;
+ Name_GPL : constant Name_Id := N + 282;
+ Name_IEEE_Float : constant Name_Id := N + 283;
+ Name_Internal : constant Name_Id := N + 284;
+ Name_Link_Name : constant Name_Id := N + 285;
+ Name_Lowercase : constant Name_Id := N + 286;
+ Name_Max_Entry_Queue_Depth : constant Name_Id := N + 287;
+ Name_Max_Entry_Queue_Length : constant Name_Id := N + 288;
+ Name_Max_Size : constant Name_Id := N + 289;
+ Name_Mechanism : constant Name_Id := N + 290;
+ Name_Mixedcase : constant Name_Id := N + 291;
+ Name_Modified_GPL : constant Name_Id := N + 292;
+ Name_Name : constant Name_Id := N + 293;
+ Name_NCA : constant Name_Id := N + 294;
+ Name_No : constant Name_Id := N + 295;
+ Name_No_Dependence : constant Name_Id := N + 296;
+ Name_No_Dynamic_Attachment : constant Name_Id := N + 297;
+ Name_No_Dynamic_Interrupts : constant Name_Id := N + 298;
+ Name_No_Requeue : constant Name_Id := N + 299;
+ Name_No_Requeue_Statements : constant Name_Id := N + 300;
+ Name_No_Task_Attributes : constant Name_Id := N + 301;
+ Name_No_Task_Attributes_Package : constant Name_Id := N + 302;
+ Name_On : constant Name_Id := N + 303;
+ Name_Parameter_Types : constant Name_Id := N + 304;
+ Name_Reference : constant Name_Id := N + 305;
+ Name_Restricted : constant Name_Id := N + 306;
+ Name_Result_Mechanism : constant Name_Id := N + 307;
+ Name_Result_Type : constant Name_Id := N + 308;
+ Name_Runtime : constant Name_Id := N + 309;
+ Name_SB : constant Name_Id := N + 310;
+ Name_Secondary_Stack_Size : constant Name_Id := N + 311;
+ Name_Section : constant Name_Id := N + 312;
+ Name_Semaphore : constant Name_Id := N + 313;
+ Name_Simple_Barriers : constant Name_Id := N + 314;
+ Name_Spec_File_Name : constant Name_Id := N + 315;
+ Name_Static : constant Name_Id := N + 316;
+ Name_Stack_Size : constant Name_Id := N + 317;
+ Name_Subunit_File_Name : constant Name_Id := N + 318;
+ Name_Task_Stack_Size_Default : constant Name_Id := N + 319;
+ Name_Task_Type : constant Name_Id := N + 320;
+ Name_Time_Slicing_Enabled : constant Name_Id := N + 321;
+ Name_Top_Guard : constant Name_Id := N + 322;
+ Name_UBA : constant Name_Id := N + 323;
+ Name_UBS : constant Name_Id := N + 324;
+ Name_UBSB : constant Name_Id := N + 325;
+ Name_Unit_Name : constant Name_Id := N + 326;
+ Name_Unknown : constant Name_Id := N + 327;
+ Name_Unrestricted : constant Name_Id := N + 328;
+ Name_Uppercase : constant Name_Id := N + 329;
+ Name_User : constant Name_Id := N + 330;
+ Name_VAX_Float : constant Name_Id := N + 331;
+ Name_VMS : constant Name_Id := N + 332;
+ Name_Working_Storage : constant Name_Id := N + 333;
+
+ -- Names of recognized attributes. The entries with the comment "Ada 83"
+ -- are attributes that are defined in Ada 83, but not in Ada 95. These
+ -- attributes are implemented in both Ada 83 and Ada 95 modes in GNAT.
+
+ -- The entries marked GNAT are attributes that are defined by GNAT
+ -- and implemented in both Ada 83 and Ada 95 modes. Full descriptions
+ -- of these implementation dependent attributes may be found in the
+ -- appropriate section in package Sem_Attr in file sem-attr.ads.
+
+ -- The entries marked VMS are recognized only in OpenVMS implementations
+ -- of GNAT, and are treated as illegal in all other contexts.
+
+ First_Attribute_Name : constant Name_Id := N + 334;
+ Name_Abort_Signal : constant Name_Id := N + 334; -- GNAT
+ Name_Access : constant Name_Id := N + 335;
+ Name_Address : constant Name_Id := N + 336;
+ Name_Address_Size : constant Name_Id := N + 337; -- GNAT
+ Name_Aft : constant Name_Id := N + 338;
+ Name_Alignment : constant Name_Id := N + 339;
+ Name_Asm_Input : constant Name_Id := N + 340; -- GNAT
+ Name_Asm_Output : constant Name_Id := N + 341; -- GNAT
+ Name_AST_Entry : constant Name_Id := N + 342; -- VMS
+ Name_Bit : constant Name_Id := N + 343; -- GNAT
+ Name_Bit_Order : constant Name_Id := N + 344;
+ Name_Bit_Position : constant Name_Id := N + 345; -- GNAT
+ Name_Body_Version : constant Name_Id := N + 346;
+ Name_Callable : constant Name_Id := N + 347;
+ Name_Caller : constant Name_Id := N + 348;
+ Name_Code_Address : constant Name_Id := N + 349; -- GNAT
+ Name_Component_Size : constant Name_Id := N + 350;
+ Name_Compose : constant Name_Id := N + 351;
+ Name_Constrained : constant Name_Id := N + 352;
+ Name_Count : constant Name_Id := N + 353;
+ Name_Default_Bit_Order : constant Name_Id := N + 354; -- GNAT
+ Name_Definite : constant Name_Id := N + 355;
+ Name_Delta : constant Name_Id := N + 356;
+ Name_Denorm : constant Name_Id := N + 357;
+ Name_Digits : constant Name_Id := N + 358;
+ Name_Elaborated : constant Name_Id := N + 359; -- GNAT
+ Name_Emax : constant Name_Id := N + 360; -- Ada 83
+ Name_Enum_Rep : constant Name_Id := N + 361; -- GNAT
+ Name_Epsilon : constant Name_Id := N + 362; -- Ada 83
+ Name_Exponent : constant Name_Id := N + 363;
+ Name_External_Tag : constant Name_Id := N + 364;
+ Name_First : constant Name_Id := N + 365;
+ Name_First_Bit : constant Name_Id := N + 366;
+ Name_Fixed_Value : constant Name_Id := N + 367; -- GNAT
+ Name_Fore : constant Name_Id := N + 368;
+ Name_Has_Access_Values : constant Name_Id := N + 369; -- GNAT
+ Name_Has_Discriminants : constant Name_Id := N + 370; -- GNAT
+ Name_Identity : constant Name_Id := N + 371;
+ Name_Img : constant Name_Id := N + 372; -- GNAT
+ Name_Integer_Value : constant Name_Id := N + 373; -- GNAT
+ Name_Large : constant Name_Id := N + 374; -- Ada 83
+ Name_Last : constant Name_Id := N + 375;
+ Name_Last_Bit : constant Name_Id := N + 376;
+ Name_Leading_Part : constant Name_Id := N + 377;
+ Name_Length : constant Name_Id := N + 378;
+ Name_Machine_Emax : constant Name_Id := N + 379;
+ Name_Machine_Emin : constant Name_Id := N + 380;
+ Name_Machine_Mantissa : constant Name_Id := N + 381;
+ Name_Machine_Overflows : constant Name_Id := N + 382;
+ Name_Machine_Radix : constant Name_Id := N + 383;
+ Name_Machine_Rounds : constant Name_Id := N + 384;
+ Name_Machine_Size : constant Name_Id := N + 385; -- GNAT
+ Name_Mantissa : constant Name_Id := N + 386; -- Ada 83
+ Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 387;
+ Name_Maximum_Alignment : constant Name_Id := N + 388; -- GNAT
+ Name_Mechanism_Code : constant Name_Id := N + 389; -- GNAT
+ Name_Mod : constant Name_Id := N + 390;
+ Name_Model_Emin : constant Name_Id := N + 391;
+ Name_Model_Epsilon : constant Name_Id := N + 392;
+ Name_Model_Mantissa : constant Name_Id := N + 393;
+ Name_Model_Small : constant Name_Id := N + 394;
+ Name_Modulus : constant Name_Id := N + 395;
+ Name_Null_Parameter : constant Name_Id := N + 396; -- GNAT
+ Name_Object_Size : constant Name_Id := N + 397; -- GNAT
+ Name_Partition_ID : constant Name_Id := N + 398;
+ Name_Passed_By_Reference : constant Name_Id := N + 399; -- GNAT
+ Name_Pool_Address : constant Name_Id := N + 400;
+ Name_Pos : constant Name_Id := N + 401;
+ Name_Position : constant Name_Id := N + 402;
+ Name_Range : constant Name_Id := N + 403;
+ Name_Range_Length : constant Name_Id := N + 404; -- GNAT
+ Name_Round : constant Name_Id := N + 405;
+ Name_Safe_Emax : constant Name_Id := N + 406; -- Ada 83
+ Name_Safe_First : constant Name_Id := N + 407;
+ Name_Safe_Large : constant Name_Id := N + 408; -- Ada 83
+ Name_Safe_Last : constant Name_Id := N + 409;
+ Name_Safe_Small : constant Name_Id := N + 410; -- Ada 83
+ Name_Scale : constant Name_Id := N + 411;
+ Name_Scaling : constant Name_Id := N + 412;
+ Name_Signed_Zeros : constant Name_Id := N + 413;
+ Name_Size : constant Name_Id := N + 414;
+ Name_Small : constant Name_Id := N + 415;
+ Name_Storage_Size : constant Name_Id := N + 416;
+ Name_Storage_Unit : constant Name_Id := N + 417; -- GNAT
+ Name_Stream_Size : constant Name_Id := N + 418; -- Ada 05
+ Name_Tag : constant Name_Id := N + 419;
+ Name_Target_Name : constant Name_Id := N + 420; -- GNAT
+ Name_Terminated : constant Name_Id := N + 421;
+ Name_To_Address : constant Name_Id := N + 422; -- GNAT
+ Name_Type_Class : constant Name_Id := N + 423; -- GNAT
+ Name_UET_Address : constant Name_Id := N + 424; -- GNAT
+ Name_Unbiased_Rounding : constant Name_Id := N + 425;
+ Name_Unchecked_Access : constant Name_Id := N + 426;
+ Name_Unconstrained_Array : constant Name_Id := N + 427;
+ Name_Universal_Literal_String : constant Name_Id := N + 428; -- GNAT
+ Name_Unrestricted_Access : constant Name_Id := N + 429; -- GNAT
+ Name_VADS_Size : constant Name_Id := N + 430; -- GNAT
+ Name_Val : constant Name_Id := N + 431;
+ Name_Valid : constant Name_Id := N + 432;
+ Name_Value_Size : constant Name_Id := N + 433; -- GNAT
+ Name_Version : constant Name_Id := N + 434;
+ Name_Wchar_T_Size : constant Name_Id := N + 435; -- GNAT
+ Name_Wide_Wide_Width : constant Name_Id := N + 436; -- Ada 05
+ Name_Wide_Width : constant Name_Id := N + 437;
+ Name_Width : constant Name_Id := N + 438;
+ Name_Word_Size : constant Name_Id := N + 439; -- GNAT
+
+ -- Attributes that designate attributes returning renamable functions,
+ -- i.e. functions that return other than a universal value and that
+ -- have non-universal arguments.
+
+ First_Renamable_Function_Attribute : constant Name_Id := N + 440;
+ Name_Adjacent : constant Name_Id := N + 440;
+ Name_Ceiling : constant Name_Id := N + 441;
+ Name_Copy_Sign : constant Name_Id := N + 442;
+ Name_Floor : constant Name_Id := N + 443;
+ Name_Fraction : constant Name_Id := N + 444;
+ Name_Image : constant Name_Id := N + 445;
+ Name_Input : constant Name_Id := N + 446;
+ Name_Machine : constant Name_Id := N + 447;
+ Name_Max : constant Name_Id := N + 448;
+ Name_Min : constant Name_Id := N + 449;
+ Name_Model : constant Name_Id := N + 450;
+ Name_Pred : constant Name_Id := N + 451;
+ Name_Remainder : constant Name_Id := N + 452;
+ Name_Rounding : constant Name_Id := N + 453;
+ Name_Succ : constant Name_Id := N + 454;
+ Name_Truncation : constant Name_Id := N + 455;
+ Name_Value : constant Name_Id := N + 456;
+ Name_Wide_Image : constant Name_Id := N + 457;
+ Name_Wide_Wide_Image : constant Name_Id := N + 458;
+ Name_Wide_Value : constant Name_Id := N + 459;
+ Name_Wide_Wide_Value : constant Name_Id := N + 460;
+ Last_Renamable_Function_Attribute : constant Name_Id := N + 460;
+
+ -- Attributes that designate procedures
+
+ First_Procedure_Attribute : constant Name_Id := N + 461;
+ Name_Output : constant Name_Id := N + 461;
+ Name_Read : constant Name_Id := N + 462;
+ Name_Write : constant Name_Id := N + 463;
+ Last_Procedure_Attribute : constant Name_Id := N + 463;
+
+ -- Remaining attributes are ones that return entities
+
+ First_Entity_Attribute_Name : constant Name_Id := N + 464;
+ Name_Elab_Body : constant Name_Id := N + 464; -- GNAT
+ Name_Elab_Spec : constant Name_Id := N + 465; -- GNAT
+ Name_Storage_Pool : constant Name_Id := N + 466;
+
+ -- These attributes are the ones that return types
+
+ First_Type_Attribute_Name : constant Name_Id := N + 467;
+ Name_Base : constant Name_Id := N + 467;
+ Name_Class : constant Name_Id := N + 468;
+ Last_Type_Attribute_Name : constant Name_Id := N + 468;
+ Last_Entity_Attribute_Name : constant Name_Id := N + 468;
+ Last_Attribute_Name : constant Name_Id := N + 468;
+
+ -- Names of recognized locking policy identifiers
+
+ -- Note: policies are identified by the first character of the
+ -- name (e.g. C for Ceiling_Locking). If new policy names are added,
+ -- the first character must be distinct.
+
+ First_Locking_Policy_Name : constant Name_Id := N + 469;
+ Name_Ceiling_Locking : constant Name_Id := N + 469;
+ Name_Inheritance_Locking : constant Name_Id := N + 470;
+ Last_Locking_Policy_Name : constant Name_Id := N + 470;
+
+ -- Names of recognized queuing policy identifiers.
+
+ -- Note: policies are identified by the first character of the
+ -- name (e.g. F for FIFO_Queuing). If new policy names are added,
+ -- the first character must be distinct.
+
+ First_Queuing_Policy_Name : constant Name_Id := N + 471;
+ Name_FIFO_Queuing : constant Name_Id := N + 471;
+ Name_Priority_Queuing : constant Name_Id := N + 472;
+ Last_Queuing_Policy_Name : constant Name_Id := N + 472;
+
+ -- Names of recognized task dispatching policy identifiers
+
+ -- Note: policies are identified by the first character of the
+ -- name (e.g. F for FIFO_WIthinn_Priorities). If new policy names
+ -- are added, the first character must be distinct.
+
+ First_Task_Dispatching_Policy_Name : constant Name_Id := N + 473;
+ Name_FIFO_Within_Priorities : constant Name_Id := N + 473;
+ Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 473;
+
+ -- Names of recognized checks for pragma Suppress
+
+ First_Check_Name : constant Name_Id := N + 474;
+ Name_Access_Check : constant Name_Id := N + 474;
+ Name_Accessibility_Check : constant Name_Id := N + 475;
+ Name_Discriminant_Check : constant Name_Id := N + 476;
+ Name_Division_Check : constant Name_Id := N + 477;
+ Name_Elaboration_Check : constant Name_Id := N + 478;
+ Name_Index_Check : constant Name_Id := N + 479;
+ Name_Length_Check : constant Name_Id := N + 480;
+ Name_Overflow_Check : constant Name_Id := N + 481;
+ Name_Range_Check : constant Name_Id := N + 482;
+ Name_Storage_Check : constant Name_Id := N + 483;
+ Name_Tag_Check : constant Name_Id := N + 484;
+ Name_All_Checks : constant Name_Id := N + 485;
+ Last_Check_Name : constant Name_Id := N + 485;
+
+ -- Names corresponding to reserved keywords, excluding those already
+ -- declared in the attribute list (Access, Delta, Digits, Mod, Range).
+
+ Name_Abort : constant Name_Id := N + 486;
+ Name_Abs : constant Name_Id := N + 487;
+ Name_Accept : constant Name_Id := N + 488;
+ Name_And : constant Name_Id := N + 489;
+ Name_All : constant Name_Id := N + 490;
+ Name_Array : constant Name_Id := N + 491;
+ Name_At : constant Name_Id := N + 492;
+ Name_Begin : constant Name_Id := N + 493;
+ Name_Body : constant Name_Id := N + 494;
+ Name_Case : constant Name_Id := N + 495;
+ Name_Constant : constant Name_Id := N + 496;
+ Name_Declare : constant Name_Id := N + 497;
+ Name_Delay : constant Name_Id := N + 498;
+ Name_Do : constant Name_Id := N + 499;
+ Name_Else : constant Name_Id := N + 500;
+ Name_Elsif : constant Name_Id := N + 501;
+ Name_End : constant Name_Id := N + 502;
+ Name_Entry : constant Name_Id := N + 503;
+ Name_Exception : constant Name_Id := N + 504;
+ Name_Exit : constant Name_Id := N + 505;
+ Name_For : constant Name_Id := N + 506;
+ Name_Function : constant Name_Id := N + 507;
+ Name_Generic : constant Name_Id := N + 508;
+ Name_Goto : constant Name_Id := N + 509;
+ Name_If : constant Name_Id := N + 510;
+ Name_In : constant Name_Id := N + 511;
+ Name_Is : constant Name_Id := N + 512;
+ Name_Limited : constant Name_Id := N + 513;
+ Name_Loop : constant Name_Id := N + 514;
+ Name_New : constant Name_Id := N + 515;
+ Name_Not : constant Name_Id := N + 516;
+ Name_Null : constant Name_Id := N + 517;
+ Name_Of : constant Name_Id := N + 518;
+ Name_Or : constant Name_Id := N + 519;
+ Name_Others : constant Name_Id := N + 520;
+ Name_Out : constant Name_Id := N + 521;
+ Name_Package : constant Name_Id := N + 522;
+ Name_Pragma : constant Name_Id := N + 523;
+ Name_Private : constant Name_Id := N + 524;
+ Name_Procedure : constant Name_Id := N + 525;
+ Name_Raise : constant Name_Id := N + 526;
+ Name_Record : constant Name_Id := N + 527;
+ Name_Rem : constant Name_Id := N + 528;
+ Name_Renames : constant Name_Id := N + 529;
+ Name_Return : constant Name_Id := N + 530;
+ Name_Reverse : constant Name_Id := N + 531;
+ Name_Select : constant Name_Id := N + 532;
+ Name_Separate : constant Name_Id := N + 533;
+ Name_Subtype : constant Name_Id := N + 534;
+ Name_Task : constant Name_Id := N + 535;
+ Name_Terminate : constant Name_Id := N + 536;
+ Name_Then : constant Name_Id := N + 537;
+ Name_Type : constant Name_Id := N + 538;
+ Name_Use : constant Name_Id := N + 539;
+ Name_When : constant Name_Id := N + 540;
+ Name_While : constant Name_Id := N + 541;
+ Name_With : constant Name_Id := N + 542;
+ Name_Xor : constant Name_Id := N + 543;
+
+ -- Names of intrinsic subprograms
+
+ -- Note: Asm is missing from this list, since Asm is a legitimate
+ -- convention name. So is To_Adress, which is a GNAT attribute.
+
+ First_Intrinsic_Name : constant Name_Id := N + 544;
+ Name_Divide : constant Name_Id := N + 544;
+ Name_Enclosing_Entity : constant Name_Id := N + 545;
+ Name_Exception_Information : constant Name_Id := N + 546;
+ Name_Exception_Message : constant Name_Id := N + 547;
+ Name_Exception_Name : constant Name_Id := N + 548;
+ Name_File : constant Name_Id := N + 549;
+ Name_Import_Address : constant Name_Id := N + 550;
+ Name_Import_Largest_Value : constant Name_Id := N + 551;
+ Name_Import_Value : constant Name_Id := N + 552;
+ Name_Is_Negative : constant Name_Id := N + 553;
+ Name_Line : constant Name_Id := N + 554;
+ Name_Rotate_Left : constant Name_Id := N + 555;
+ Name_Rotate_Right : constant Name_Id := N + 556;
+ Name_Shift_Left : constant Name_Id := N + 557;
+ Name_Shift_Right : constant Name_Id := N + 558;
+ Name_Shift_Right_Arithmetic : constant Name_Id := N + 559;
+ Name_Source_Location : constant Name_Id := N + 560;
+ Name_Unchecked_Conversion : constant Name_Id := N + 561;
+ Name_Unchecked_Deallocation : constant Name_Id := N + 562;
+ Name_To_Pointer : constant Name_Id := N + 563;
+ Last_Intrinsic_Name : constant Name_Id := N + 563;
+
+ -- Reserved words used only in Ada 95
+
+ First_95_Reserved_Word : constant Name_Id := N + 564;
+ Name_Abstract : constant Name_Id := N + 564;
+ Name_Aliased : constant Name_Id := N + 565;
+ Name_Protected : constant Name_Id := N + 566;
+ Name_Until : constant Name_Id := N + 567;
+ Name_Requeue : constant Name_Id := N + 568;
+ Name_Tagged : constant Name_Id := N + 569;
+ Last_95_Reserved_Word : constant Name_Id := N + 569;
+
+ subtype Ada_95_Reserved_Words is
+ Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word;
+
+ -- Miscellaneous names used in semantic checking
+
+ Name_Raise_Exception : constant Name_Id := N + 570;
+
+ -- Additional reserved words and identifiers used in GNAT Project Files
+ -- Note that Name_External is already previously declared
+
+ Name_Ada_Roots : constant Name_Id := N + 571;
+ Name_Binder : constant Name_Id := N + 572;
+ Name_Binder_Driver : constant Name_Id := N + 573;
+ Name_Body_Suffix : constant Name_Id := N + 574;
+ Name_Builder : constant Name_Id := N + 575;
+ Name_Compiler : constant Name_Id := N + 576;
+ Name_Compiler_Driver : constant Name_Id := N + 577;
+ Name_Compiler_Kind : constant Name_Id := N + 578;
+ Name_Compute_Dependency : constant Name_Id := N + 579;
+ Name_Cross_Reference : constant Name_Id := N + 580;
+ Name_Default_Linker : constant Name_Id := N + 581;
+ Name_Default_Switches : constant Name_Id := N + 582;
+ Name_Dependency_Option : constant Name_Id := N + 583;
+ Name_Exec_Dir : constant Name_Id := N + 584;
+ Name_Executable : constant Name_Id := N + 585;
+ Name_Executable_Suffix : constant Name_Id := N + 586;
+ Name_Extends : constant Name_Id := N + 587;
+ Name_Externally_Built : constant Name_Id := N + 588;
+ Name_Finder : constant Name_Id := N + 589;
+ Name_Global_Configuration_Pragmas : constant Name_Id := N + 590;
+ Name_Gnatls : constant Name_Id := N + 591;
+ Name_Gnatstub : constant Name_Id := N + 592;
+ Name_Implementation : constant Name_Id := N + 593;
+ Name_Implementation_Exceptions : constant Name_Id := N + 594;
+ Name_Implementation_Suffix : constant Name_Id := N + 595;
+ Name_Include_Option : constant Name_Id := N + 596;
+ Name_Language_Processing : constant Name_Id := N + 597;
+ Name_Languages : constant Name_Id := N + 598;
+ Name_Library_Dir : constant Name_Id := N + 599;
+ Name_Library_Auto_Init : constant Name_Id := N + 600;
+ Name_Library_GCC : constant Name_Id := N + 601;
+ Name_Library_Interface : constant Name_Id := N + 602;
+ Name_Library_Kind : constant Name_Id := N + 603;
+ Name_Library_Name : constant Name_Id := N + 604;
+ Name_Library_Options : constant Name_Id := N + 605;
+ Name_Library_Reference_Symbol_File : constant Name_Id := N + 606;
+ Name_Library_Src_Dir : constant Name_Id := N + 607;
+ Name_Library_Symbol_File : constant Name_Id := N + 608;
+ Name_Library_Symbol_Policy : constant Name_Id := N + 609;
+ Name_Library_Version : constant Name_Id := N + 610;
+ Name_Linker : constant Name_Id := N + 611;
+ Name_Local_Configuration_Pragmas : constant Name_Id := N + 612;
+ Name_Locally_Removed_Files : constant Name_Id := N + 613;
+ Name_Metrics : constant Name_Id := N + 614;
+ Name_Naming : constant Name_Id := N + 615;
+ Name_Object_Dir : constant Name_Id := N + 616;
+ Name_Pretty_Printer : constant Name_Id := N + 617;
+ Name_Project : constant Name_Id := N + 618;
+ Name_Separate_Suffix : constant Name_Id := N + 619;
+ Name_Source_Dirs : constant Name_Id := N + 620;
+ Name_Source_Files : constant Name_Id := N + 621;
+ Name_Source_List_File : constant Name_Id := N + 622;
+ Name_Spec : constant Name_Id := N + 623;
+ Name_Spec_Suffix : constant Name_Id := N + 624;
+ Name_Specification : constant Name_Id := N + 625;
+ Name_Specification_Exceptions : constant Name_Id := N + 626;
+ Name_Specification_Suffix : constant Name_Id := N + 627;
+ Name_Switches : constant Name_Id := N + 628;
+
+ -- Other miscellaneous names used in front end
+
+ Name_Unaligned_Valid : constant Name_Id := N + 629;
+
+ -- ----------------------------------------------------------------
+ First_2005_Reserved_Word : constant Name_Id := N + 630;
+ Name_Interface : constant Name_Id := N + 630;
+ Name_Overriding : constant Name_Id := N + 631;
+ Name_Synchronized : constant Name_Id := N + 632;
+ Last_2005_Reserved_Word : constant Name_Id := N + 632;
+
+ subtype Ada_2005_Reserved_Words is
+ Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
+
+ -- Mark last defined name for consistency check in Snames body
+
+ Last_Predefined_Name : constant Name_Id := N + 632;
+
+ subtype Any_Operator_Name is Name_Id range
+ First_Operator_Name .. Last_Operator_Name;
+
+ ------------------------------
+ -- Attribute ID Definitions --
+ ------------------------------
+
+ type Attribute_Id is (
+ Attribute_Abort_Signal,
+ Attribute_Access,
+ Attribute_Address,
+ Attribute_Address_Size,
+ Attribute_Aft,
+ Attribute_Alignment,
+ Attribute_Asm_Input,
+ Attribute_Asm_Output,
+ Attribute_AST_Entry,
+ Attribute_Bit,
+ Attribute_Bit_Order,
+ Attribute_Bit_Position,
+ Attribute_Body_Version,
+ Attribute_Callable,
+ Attribute_Caller,
+ Attribute_Code_Address,
+ Attribute_Component_Size,
+ Attribute_Compose,
+ Attribute_Constrained,
+ Attribute_Count,
+ Attribute_Default_Bit_Order,
+ Attribute_Definite,
+ Attribute_Delta,
+ Attribute_Denorm,
+ Attribute_Digits,
+ Attribute_Elaborated,
+ Attribute_Emax,
+ Attribute_Enum_Rep,
+ Attribute_Epsilon,
+ Attribute_Exponent,
+ Attribute_External_Tag,
+ Attribute_First,
+ Attribute_First_Bit,
+ Attribute_Fixed_Value,
+ Attribute_Fore,
+ Attribute_Has_Access_Values,
+ Attribute_Has_Discriminants,
+ Attribute_Identity,
+ Attribute_Img,
+ Attribute_Integer_Value,
+ Attribute_Large,
+ Attribute_Last,
+ Attribute_Last_Bit,
+ Attribute_Leading_Part,
+ Attribute_Length,
+ Attribute_Machine_Emax,
+ Attribute_Machine_Emin,
+ Attribute_Machine_Mantissa,
+ Attribute_Machine_Overflows,
+ Attribute_Machine_Radix,
+ Attribute_Machine_Rounds,
+ Attribute_Machine_Size,
+ Attribute_Mantissa,
+ Attribute_Max_Size_In_Storage_Elements,
+ Attribute_Maximum_Alignment,
+ Attribute_Mechanism_Code,
+ Attribute_Mod,
+ Attribute_Model_Emin,
+ Attribute_Model_Epsilon,
+ Attribute_Model_Mantissa,
+ Attribute_Model_Small,
+ Attribute_Modulus,
+ Attribute_Null_Parameter,
+ Attribute_Object_Size,
+ Attribute_Partition_ID,
+ Attribute_Passed_By_Reference,
+ Attribute_Pool_Address,
+ Attribute_Pos,
+ Attribute_Position,
+ Attribute_Range,
+ Attribute_Range_Length,
+ Attribute_Round,
+ Attribute_Safe_Emax,
+ Attribute_Safe_First,
+ Attribute_Safe_Large,
+ Attribute_Safe_Last,
+ Attribute_Safe_Small,
+ Attribute_Scale,
+ Attribute_Scaling,
+ Attribute_Signed_Zeros,
+ Attribute_Size,
+ Attribute_Small,
+ Attribute_Storage_Size,
+ Attribute_Storage_Unit,
+ Attribute_Stream_Size,
+ Attribute_Tag,
+ Attribute_Target_Name,
+ Attribute_Terminated,
+ Attribute_To_Address,
+ Attribute_Type_Class,
+ Attribute_UET_Address,
+ Attribute_Unbiased_Rounding,
+ Attribute_Unchecked_Access,
+ Attribute_Unconstrained_Array,
+ Attribute_Universal_Literal_String,
+ Attribute_Unrestricted_Access,
+ Attribute_VADS_Size,
+ Attribute_Val,
+ Attribute_Valid,
+ Attribute_Value_Size,
+ Attribute_Version,
+ Attribute_Wchar_T_Size,
+ Attribute_Wide_Wide_Width,
+ Attribute_Wide_Width,
+ Attribute_Width,
+ Attribute_Word_Size,
+
+ -- Attributes designating renamable functions
+
+ Attribute_Adjacent,
+ Attribute_Ceiling,
+ Attribute_Copy_Sign,
+ Attribute_Floor,
+ Attribute_Fraction,
+ Attribute_Image,
+ Attribute_Input,
+ Attribute_Machine,
+ Attribute_Max,
+ Attribute_Min,
+ Attribute_Model,
+ Attribute_Pred,
+ Attribute_Remainder,
+ Attribute_Rounding,
+ Attribute_Succ,
+ Attribute_Truncation,
+ Attribute_Value,
+ Attribute_Wide_Image,
+ Attribute_Wide_Wide_Image,
+ Attribute_Wide_Value,
+ Attribute_Wide_Wide_Value,
+
+ -- Attributes designating procedures
+
+ Attribute_Output,
+ Attribute_Read,
+ Attribute_Write,
+
+ -- Entity attributes (includes type attributes)
+
+ Attribute_Elab_Body,
+ Attribute_Elab_Spec,
+ Attribute_Storage_Pool,
+
+ -- Type attributes
+
+ Attribute_Base,
+ Attribute_Class);
+
+ ------------------------------------
+ -- Convention Name ID Definitions --
+ ------------------------------------
+
+ type Convention_Id is (
+
+ -- The conventions that are defined by the RM come first
+
+ Convention_Ada,
+ Convention_Intrinsic,
+ Convention_Entry,
+ Convention_Protected,
+
+ -- The remaining conventions are foreign language conventions
+
+ Convention_Assembler, -- also Asm, Assembly
+ Convention_C, -- also Default, External
+ Convention_COBOL,
+ Convention_CPP,
+ Convention_Fortran,
+ Convention_Java,
+ Convention_Stdcall, -- also DLL, Win32
+ Convention_Stubbed);
+
+ -- Note: Convention C_Pass_By_Copy is allowed only for record
+ -- types (where it is treated like C except that the appropriate
+ -- flag is set in the record type). Recognizion of this convention
+ -- is specially handled in Sem_Prag.
+
+ for Convention_Id'Size use 8;
+ -- Plenty of space for expansion
+
+ subtype Foreign_Convention is
+ Convention_Id range Convention_Assembler .. Convention_Stdcall;
+
+ -----------------------------------
+ -- Locking Policy ID Definitions --
+ -----------------------------------
+
+ type Locking_Policy_Id is (
+ Locking_Policy_Inheritance_Locking,
+ Locking_Policy_Ceiling_Locking);
+
+ ---------------------------
+ -- Pragma ID Definitions --
+ ---------------------------
+
+ type Pragma_Id is (
+
+ -- Configuration pragmas
+
+ Pragma_Ada_83,
+ Pragma_Ada_95,
+ Pragma_Ada_05,
+ Pragma_C_Pass_By_Copy,
+ Pragma_Compile_Time_Warning,
+ Pragma_Component_Alignment,
+ Pragma_Convention_Identifier,
+ Pragma_Detect_Blocking,
+ Pragma_Discard_Names,
+ Pragma_Elaboration_Checks,
+ Pragma_Eliminate,
+ Pragma_Explicit_Overriding,
+ Pragma_Extend_System,
+ Pragma_Extensions_Allowed,
+ Pragma_External_Name_Casing,
+ Pragma_Float_Representation,
+ Pragma_Initialize_Scalars,
+ Pragma_Interrupt_State,
+ Pragma_License,
+ Pragma_Locking_Policy,
+ Pragma_Long_Float,
+ Pragma_No_Run_Time,
+ Pragma_No_Strict_Aliasing,
+ Pragma_Normalize_Scalars,
+ Pragma_Polling,
+ Pragma_Persistent_Data,
+ Pragma_Persistent_Object,
+ Pragma_Profile,
+ Pragma_Profile_Warnings,
+ Pragma_Propagate_Exceptions,
+ Pragma_Queuing_Policy,
+ Pragma_Ravenscar,
+ Pragma_Restricted_Run_Time,
+ Pragma_Restrictions,
+ Pragma_Restriction_Warnings,
+ Pragma_Reviewable,
+ Pragma_Source_File_Name,
+ Pragma_Source_File_Name_Project,
+ Pragma_Style_Checks,
+ Pragma_Suppress,
+ Pragma_Suppress_Exception_Locations,
+ Pragma_Task_Dispatching_Policy,
+ Pragma_Universal_Data,
+ Pragma_Unsuppress,
+ Pragma_Use_VADS_Size,
+ Pragma_Validity_Checks,
+ Pragma_Warnings,
+
+ -- Remaining (non-configuration) pragmas
+
+ Pragma_Abort_Defer,
+ Pragma_All_Calls_Remote,
+ Pragma_Annotate,
+ Pragma_Assert,
+ Pragma_Asynchronous,
+ Pragma_Atomic,
+ Pragma_Atomic_Components,
+ Pragma_Attach_Handler,
+ Pragma_Comment,
+ Pragma_Common_Object,
+ Pragma_Complex_Representation,
+ Pragma_Controlled,
+ Pragma_Convention,
+ Pragma_CPP_Class,
+ Pragma_CPP_Constructor,
+ Pragma_CPP_Virtual,
+ Pragma_CPP_Vtable,
+ Pragma_Debug,
+ Pragma_Elaborate,
+ Pragma_Elaborate_All,
+ Pragma_Elaborate_Body,
+ Pragma_Export,
+ Pragma_Export_Exception,
+ Pragma_Export_Function,
+ Pragma_Export_Object,
+ Pragma_Export_Procedure,
+ Pragma_Export_Value,
+ Pragma_Export_Valued_Procedure,
+ Pragma_External,
+ Pragma_Finalize_Storage_Only,
+ Pragma_Ident,
+ Pragma_Import,
+ Pragma_Import_Exception,
+ Pragma_Import_Function,
+ Pragma_Import_Object,
+ Pragma_Import_Procedure,
+ Pragma_Import_Valued_Procedure,
+ Pragma_Inline,
+ Pragma_Inline_Always,
+ Pragma_Inline_Generic,
+ Pragma_Inspection_Point,
+ Pragma_Interface_Name,
+ Pragma_Interrupt_Handler,
+ Pragma_Interrupt_Priority,
+ Pragma_Java_Constructor,
+ Pragma_Java_Interface,
+ Pragma_Keep_Names,
+ Pragma_Link_With,
+ Pragma_Linker_Alias,
+ Pragma_Linker_Options,
+ Pragma_Linker_Section,
+ Pragma_List,
+ Pragma_Machine_Attribute,
+ Pragma_Main,
+ Pragma_Main_Storage,
+ Pragma_Memory_Size,
+ Pragma_No_Return,
+ Pragma_Obsolescent,
+ Pragma_Optimize,
+ Pragma_Optional_Overriding,
+ Pragma_Pack,
+ Pragma_Page,
+ Pragma_Passive,
+ Pragma_Preelaborate,
+ Pragma_Priority,
+ Pragma_Psect_Object,
+ Pragma_Pure,
+ Pragma_Pure_Function,
+ Pragma_Remote_Call_Interface,
+ Pragma_Remote_Types,
+ Pragma_Share_Generic,
+ Pragma_Shared,
+ Pragma_Shared_Passive,
+ Pragma_Source_Reference,
+ Pragma_Stream_Convert,
+ Pragma_Subtitle,
+ Pragma_Suppress_All,
+ Pragma_Suppress_Debug_Info,
+ Pragma_Suppress_Initialization,
+ Pragma_System_Name,
+ Pragma_Task_Info,
+ Pragma_Task_Name,
+ Pragma_Task_Storage,
+ Pragma_Thread_Body,
+ Pragma_Time_Slice,
+ Pragma_Title,
+ Pragma_Unchecked_Union,
+ Pragma_Unimplemented_Unit,
+ Pragma_Unreferenced,
+ Pragma_Unreserve_All_Interrupts,
+ Pragma_Volatile,
+ Pragma_Volatile_Components,
+ Pragma_Weak_External,
+
+ -- The following pragmas are on their own, out of order, because of
+ -- the special processing required to deal with the fact that their
+ -- names match existing attribute names.
+
+ Pragma_AST_Entry,
+ Pragma_Interface,
+ Pragma_Storage_Size,
+ Pragma_Storage_Unit,
+
+ -- The value to represent an unknown or unrecognized pragma
+
+ Unknown_Pragma);
+
+ -----------------------------------
+ -- Queuing Policy ID definitions --
+ -----------------------------------
+
+ type Queuing_Policy_Id is (
+ Queuing_Policy_FIFO_Queuing,
+ Queuing_Policy_Priority_Queuing);
+
+ --------------------------------------------
+ -- Task Dispatching Policy ID definitions --
+ --------------------------------------------
+
+ type Task_Dispatching_Policy_Id is (
+ Task_Dispatching_FIFO_Within_Priorities);
+ -- Id values used to identify task dispatching policies
+
+ -----------------
+ -- Subprograms --
+ -----------------
+
+ procedure Initialize;
+ -- Called to initialize the preset names in the names table.
+
+ function Is_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized attribute
+
+ function Is_Entity_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized entity attribute,
+ -- i.e. an attribute reference that returns an entity.
+
+ function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized attribute that
+ -- designates a procedure (and can therefore appear as a statement).
+
+ function Is_Function_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized attribute
+ -- that designates a renameable function, and can therefore appear in
+ -- a renaming statement. Note that not all attributes designating
+ -- functions are renamable, in particular, thos returning a universal
+ -- value cannot be renamed.
+
+ function Is_Type_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized type attribute,
+ -- i.e. an attribute reference that returns a type
+
+ function Is_Check_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized suppress check
+ -- as required by pragma Suppress.
+
+ function Is_Convention_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of one of the recognized
+ -- language conventions, as required by pragma Convention, Import,
+ -- Export, Interface. Returns True if so. Also returns True for a
+ -- name that has been specified by a Convention_Identifier pragma.
+ -- If neither case holds, returns False.
+
+ function Is_Locking_Policy_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized locking policy
+
+ function Is_Operator_Symbol_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of an operator symbol
+
+ function Is_Pragma_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized pragma. Note
+ -- that pragmas AST_Entry, Storage_Size, and Storage_Unit are recognized
+ -- as pragmas by this function even though their names are separate from
+ -- the other pragma names.
+
+ function Is_Queuing_Policy_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized queuing policy
+
+ function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized task
+ -- dispatching policy.
+
+ function Get_Attribute_Id (N : Name_Id) return Attribute_Id;
+ -- Returns Id of attribute corresponding to given name. It is an error to
+ -- call this function with a name that is not the name of a attribute.
+
+ function Get_Convention_Id (N : Name_Id) return Convention_Id;
+ -- Returns Id of language convention corresponding to given name. It is an
+ -- to call this function with a name that is not the name of a convention,
+ -- or one previously given in a call to Record_Convention_Identifier.
+
+ function Get_Check_Id (N : Name_Id) return Check_Id;
+ -- Returns Id of suppress check corresponding to given name. It is an error
+ -- to call this function with a name that is not the name of a check.
+
+ function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id;
+ -- Returns Id of locking policy corresponding to given name. It is an error
+ -- to call this function with a name that is not the name of a check.
+
+ function Get_Pragma_Id (N : Name_Id) return Pragma_Id;
+ -- Returns Id of pragma corresponding to given name. Returns Unknown_Pragma
+ -- if N is not a name of a known (Ada defined or GNAT-specific) pragma.
+ -- Note that the function also works correctly for names of pragmas that
+ -- are not in the main list of pragma Names (AST_Entry, Storage_Size, and
+ -- Storage_Unit (e.g. Name_Storage_Size returns Pragma_Storage_Size).
+
+ function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id;
+ -- Returns Id of queuing policy corresponding to given name. It is an error
+ -- to call this function with a name that is not the name of a check.
+
+ function Get_Task_Dispatching_Policy_Id
+ (N : Name_Id)
+ return Task_Dispatching_Policy_Id;
+ -- Returns Id of task dispatching policy corresponding to given name.
+ -- It is an error to call this function with a name that is not the
+ -- name of a check.
+
+ procedure Record_Convention_Identifier
+ (Id : Name_Id;
+ Convention : Convention_Id);
+ -- A call to this procedure, resulting from an occurrence of a pragma
+ -- Convention_Identifier, records that from now on an occurrence of
+ -- Id will be recognized as a name for the specified convention.
+
+private
+ pragma Inline (Is_Attribute_Name);
+ pragma Inline (Is_Entity_Attribute_Name);
+ pragma Inline (Is_Type_Attribute_Name);
+ pragma Inline (Is_Check_Name);
+ pragma Inline (Is_Locking_Policy_Name);
+ pragma Inline (Is_Operator_Symbol_Name);
+ pragma Inline (Is_Queuing_Policy_Name);
+ pragma Inline (Is_Pragma_Name);
+ pragma Inline (Is_Task_Dispatching_Policy_Name);
+
+end Snames;
diff --git a/gcc/ada/snames.h b/gcc/ada/snames.h index 18cb4edc31a..e7ecb5d8d35 100644 --- a/gcc/ada/snames.h +++ b/gcc/ada/snames.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2004 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- * @@ -129,57 +129,61 @@ extern unsigned char Get_Attribute_Id (int); #define Attr_Small 81 #define Attr_Storage_Size 82 #define Attr_Storage_Unit 83 -#define Attr_Tag 84 -#define Attr_Target_Name 85 -#define Attr_Terminated 86 -#define Attr_To_Address 87 -#define Attr_Type_Class 88 -#define Attr_UET_Address 89 -#define Attr_Unbiased_Rounding 90 -#define Attr_Unchecked_Access 91 -#define Attr_Unconstrained_Array 92 -#define Attr_Universal_Literal_String 93 -#define Attr_Unrestricted_Access 94 -#define Attr_VADS_Size 95 -#define Attr_Val 96 -#define Attr_Valid 97 -#define Attr_Value_Size 98 -#define Attr_Version 99 -#define Attr_Wide_Character_Size 100 -#define Attr_Wide_Width 101 -#define Attr_Width 102 -#define Attr_Word_Size 103 +#define Attr_Stream_Size 84 +#define Attr_Tag 85 +#define Attr_Target_Name 86 +#define Attr_Terminated 87 +#define Attr_To_Address 88 +#define Attr_Type_Class 89 +#define Attr_UET_Address 90 +#define Attr_Unbiased_Rounding 91 +#define Attr_Unchecked_Access 92 +#define Attr_Unconstrained_Array 93 +#define Attr_Universal_Literal_String 94 +#define Attr_Unrestricted_Access 95 +#define Attr_VADS_Size 96 +#define Attr_Val 97 +#define Attr_Valid 98 +#define Attr_Value_Size 99 +#define Attr_Version 100 +#define Attr_Wchar_T_Size 101 +#define Attr_Wide_Wide_Width 102 +#define Attr_Wide_Width 103 +#define Attr_Width 104 +#define Attr_Word_Size 105 -#define Attr_Adjacent 104 -#define Attr_Ceiling 105 -#define Attr_Copy_Sign 106 -#define Attr_Floor 107 -#define Attr_Fraction 108 -#define Attr_Image 109 -#define Attr_Input 110 -#define Attr_Machine 111 -#define Attr_Max 112 -#define Attr_Min 113 -#define Attr_Model 114 -#define Attr_Pred 115 -#define Attr_Remainder 116 -#define Attr_Rounding 117 -#define Attr_Succ 118 -#define Attr_Truncation 119 -#define Attr_Value 120 -#define Attr_Wide_Image 121 -#define Attr_Wide_Value 122 +#define Attr_Adjacent 106 +#define Attr_Ceiling 107 +#define Attr_Copy_Sign 108 +#define Attr_Floor 109 +#define Attr_Fraction 110 +#define Attr_Image 111 +#define Attr_Input 112 +#define Attr_Machine 113 +#define Attr_Max 114 +#define Attr_Min 115 +#define Attr_Model 116 +#define Attr_Pred 117 +#define Attr_Remainder 118 +#define Attr_Rounding 119 +#define Attr_Succ 120 +#define Attr_Truncation 121 +#define Attr_Value 122 +#define Attr_Wide_Image 123 +#define Attr_Wide_Wide_Image 124 +#define Attr_Wide_Value 125 +#define Attr_Wide_Wide_Value 126 -#define Attr_Output 123 -#define Attr_Read 124 -#define Attr_Write 125 +#define Attr_Output 127 +#define Attr_Read 128 +#define Attr_Write 129 -#define Attr_Elab_Body 126 -#define Attr_Elab_Spec 127 -#define Attr_Storage_Pool 128 +#define Attr_Elab_Body 130 +#define Attr_Elab_Spec 131 +#define Attr_Storage_Pool 132 -#define Attr_Base 129 -#define Attr_Class 130 +#define Attr_Base 133 +#define Attr_Class 134 /* Define the function to check if a Name_Id value is a valid pragma */ @@ -289,66 +293,65 @@ extern unsigned char Get_Pragma_Id (int); #define Pragma_Inline_Always 85 #define Pragma_Inline_Generic 86 #define Pragma_Inspection_Point 87 -#define Pragma_Interface 88 -#define Pragma_Interface_Name 89 -#define Pragma_Interrupt_Handler 90 -#define Pragma_Interrupt_Priority 91 -#define Pragma_Java_Constructor 92 -#define Pragma_Java_Interface 93 -#define Pragma_Keep_Names 94 -#define Pragma_Link_With 95 -#define Pragma_Linker_Alias 96 -#define Pragma_Linker_Options 97 -#define Pragma_Linker_Section 98 -#define Pragma_List 99 -#define Pragma_Machine_Attribute 100 -#define Pragma_Main 101 -#define Pragma_Main_Storage 102 -#define Pragma_Memory_Size 103 -#define Pragma_No_Return 104 -#define Pragma_Obsolescent 105 -#define Pragma_Optimize 106 -#define Pragma_Optional_Overriding 107 -#define Pragma_Overriding 108 -#define Pragma_Pack 109 -#define Pragma_Page 110 -#define Pragma_Passive 111 -#define Pragma_Preelaborate 112 -#define Pragma_Priority 113 -#define Pragma_Psect_Object 114 -#define Pragma_Pure 115 -#define Pragma_Pure_Function 116 -#define Pragma_Remote_Call_Interface 117 -#define Pragma_Remote_Types 118 -#define Pragma_Share_Generic 119 -#define Pragma_Shared 120 -#define Pragma_Shared_Passive 121 -#define Pragma_Source_Reference 122 -#define Pragma_Stream_Convert 123 -#define Pragma_Subtitle 124 -#define Pragma_Suppress_All 125 -#define Pragma_Suppress_Debug_Info 126 -#define Pragma_Suppress_Initialization 127 -#define Pragma_System_Name 128 -#define Pragma_Task_Info 129 -#define Pragma_Task_Name 130 -#define Pragma_Task_Storage 131 -#define Pragma_Thread_Body 132 -#define Pragma_Time_Slice 133 -#define Pragma_Title 134 -#define Pragma_Unchecked_Union 135 -#define Pragma_Unimplemented_Unit 136 -#define Pragma_Unreferenced 137 -#define Pragma_Unreserve_All_Interrupts 138 -#define Pragma_Volatile 139 -#define Pragma_Volatile_Components 140 -#define Pragma_Weak_External 141 +#define Pragma_Interface_Name 88 +#define Pragma_Interrupt_Handler 89 +#define Pragma_Interrupt_Priority 90 +#define Pragma_Java_Constructor 91 +#define Pragma_Java_Interface 92 +#define Pragma_Keep_Names 93 +#define Pragma_Link_With 94 +#define Pragma_Linker_Alias 95 +#define Pragma_Linker_Options 96 +#define Pragma_Linker_Section 97 +#define Pragma_List 98 +#define Pragma_Machine_Attribute 99 +#define Pragma_Main 100 +#define Pragma_Main_Storage 101 +#define Pragma_Memory_Size 102 +#define Pragma_No_Return 103 +#define Pragma_Obsolescent 104 +#define Pragma_Optimize 105 +#define Pragma_Optional_Overriding 106 +#define Pragma_Pack 107 +#define Pragma_Page 108 +#define Pragma_Passive 109 +#define Pragma_Preelaborate 110 +#define Pragma_Priority 111 +#define Pragma_Psect_Object 112 +#define Pragma_Pure 113 +#define Pragma_Pure_Function 114 +#define Pragma_Remote_Call_Interface 115 +#define Pragma_Remote_Types 116 +#define Pragma_Share_Generic 117 +#define Pragma_Shared 118 +#define Pragma_Shared_Passive 119 +#define Pragma_Source_Reference 120 +#define Pragma_Stream_Convert 121 +#define Pragma_Subtitle 122 +#define Pragma_Suppress_All 123 +#define Pragma_Suppress_Debug_Info 124 +#define Pragma_Suppress_Initialization 125 +#define Pragma_System_Name 126 +#define Pragma_Task_Info 127 +#define Pragma_Task_Name 128 +#define Pragma_Task_Storage 129 +#define Pragma_Thread_Body 130 +#define Pragma_Time_Slice 131 +#define Pragma_Title 132 +#define Pragma_Unchecked_Union 133 +#define Pragma_Unimplemented_Unit 134 +#define Pragma_Unreferenced 135 +#define Pragma_Unreserve_All_Interrupts 136 +#define Pragma_Volatile 137 +#define Pragma_Volatile_Components 138 +#define Pragma_Weak_External 139 /* The following are deliberately out of alphabetical order, see Snames */ -#define Pragma_AST_Entry 142 -#define Pragma_Storage_Size 143 -#define Pragma_Storage_Unit 144 +#define Pragma_AST_Entry 140 +#define Pragma_Interface 141 +#define Pragma_Storage_Size 142 +#define Pragma_Storage_Unit 143 /* Define the numeric values for the conventions. */ diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 0d814441c49..24998600727 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -938,7 +938,7 @@ package body Sprint is end if; Write_Char_Sloc ('''); - Write_Char_Code (Char_Literal_Value (Node)); + Write_Char_Code (UI_To_CC (Char_Literal_Value (Node))); Write_Char ('''); when N_Code_Statement => @@ -1363,6 +1363,34 @@ package body Sprint is Write_Str_With_Col_Check (" with private"); end if; + when N_Formal_Abstract_Subprogram_Declaration => + Write_Indent_Str_Sloc ("with "); + Sprint_Node (Specification (Node)); + + Write_Str_With_Col_Check (" is abstract"); + + if Box_Present (Node) then + Write_Str_With_Col_Check (" <>"); + elsif Present (Default_Name (Node)) then + Write_Str_With_Col_Check (" "); + Sprint_Node (Default_Name (Node)); + end if; + + Write_Char (';'); + + when N_Formal_Concrete_Subprogram_Declaration => + Write_Indent_Str_Sloc ("with "); + Sprint_Node (Specification (Node)); + + if Box_Present (Node) then + Write_Str_With_Col_Check (" is <>"); + elsif Present (Default_Name (Node)) then + Write_Str_With_Col_Check (" is "); + Sprint_Node (Default_Name (Node)); + end if; + + Write_Char (';'); + when N_Formal_Discrete_Type_Definition => Write_Str_With_Col_Check_Sloc ("<>"); @@ -1424,19 +1452,6 @@ package body Sprint is when N_Formal_Signed_Integer_Type_Definition => Write_Str_With_Col_Check_Sloc ("range <>"); - when N_Formal_Subprogram_Declaration => - Write_Indent_Str_Sloc ("with "); - Sprint_Node (Specification (Node)); - - if Box_Present (Node) then - Write_Str_With_Col_Check (" is <>"); - elsif Present (Default_Name (Node)) then - Write_Str_With_Col_Check (" is "); - Sprint_Node (Default_Name (Node)); - end if; - - Write_Char (';'); - when N_Formal_Type_Declaration => Write_Indent_Str_Sloc ("type "); Write_Id (Defining_Identifier (Node)); diff --git a/gcc/ada/stand.ads b/gcc/ada/stand.ads index 0970a06a6ee..9c7d6e82d45 100644 --- a/gcc/ada/stand.ads +++ b/gcc/ada/stand.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -59,8 +59,10 @@ package Stand is S_Boolean, S_Character, S_Wide_Character, + S_Wide_Wide_Character, S_String, S_Wide_String, + S_Wide_Wide_String, S_Duration, S_Short_Short_Integer, @@ -92,12 +94,13 @@ package Stand is S_Storage_Error, S_Tasking_Error, - -- Binary Operators declared in package Standard. + -- Binary Operators declared in package Standard S_Op_Add, S_Op_And, S_Op_Concat, S_Op_Concatw, + S_Op_Concatww, S_Op_Divide, S_Op_Eq, S_Op_Expon, @@ -250,8 +253,10 @@ package Stand is Standard_ASCII : Entity_Id renames SE (S_ASCII); Standard_Character : Entity_Id renames SE (S_Character); Standard_Wide_Character : Entity_Id renames SE (S_Wide_Character); + Standard_Wide_Wide_Character : Entity_Id renames SE (S_Wide_Wide_Character); Standard_String : Entity_Id renames SE (S_String); Standard_Wide_String : Entity_Id renames SE (S_Wide_String); + Standard_Wide_Wide_String : Entity_Id renames SE (S_Wide_Wide_String); Standard_Boolean : Entity_Id renames SE (S_Boolean); Standard_False : Entity_Id renames SE (S_False); @@ -283,6 +288,7 @@ package Stand is Standard_Op_And : Entity_Id renames SE (S_Op_And); Standard_Op_Concat : Entity_Id renames SE (S_Op_Concat); Standard_Op_Concatw : Entity_Id renames SE (S_Op_Concatw); + Standard_Op_Concatww : Entity_Id renames SE (S_Op_Concatww); Standard_Op_Divide : Entity_Id renames SE (S_Op_Divide); Standard_Op_Eq : Entity_Id renames SE (S_Op_Eq); Standard_Op_Expon : Entity_Id renames SE (S_Op_Expon); diff --git a/gcc/ada/stringt.adb b/gcc/ada/stringt.adb index 5f6fd969cba..5727080ceaf 100644 --- a/gcc/ada/stringt.adb +++ b/gcc/ada/stringt.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- -- @@ -355,19 +355,19 @@ package body Stringt is procedure Write_Char_Code (Code : Char_Code) is - procedure Write_Hex_Byte (J : Natural); - -- Write single hex digit + procedure Write_Hex_Byte (J : Char_Code); + -- Write single hex byte (value in range 0 .. 255) as two digits -------------------- -- Write_Hex_Byte -- -------------------- - procedure Write_Hex_Byte (J : Natural) is - Hexd : constant String := "0123456789abcdef"; - + procedure Write_Hex_Byte (J : Char_Code) is + Hexd : constant array (Char_Code range 0 .. 15) of Character := + "0123456789abcdef"; begin - Write_Char (Hexd (J / 16 + 1)); - Write_Char (Hexd (J mod 16 + 1)); + Write_Char (Hexd (J / 16)); + Write_Char (Hexd (J mod 16)); end Write_Hex_Byte; -- Start of processing for Write_Char_Code @@ -380,11 +380,19 @@ package body Stringt is Write_Char ('['); Write_Char ('"'); + if Code > 16#FF_FFFF# then + Write_Hex_Byte (Code / 2 ** 24); + end if; + + if Code > 16#FFFF# then + Write_Hex_Byte ((Code / 2 ** 16) mod 256); + end if; + if Code > 16#FF# then - Write_Hex_Byte (Natural (Code / 256)); + Write_Hex_Byte ((Code / 256) mod 256); end if; - Write_Hex_Byte (Natural (Code mod 256)); + Write_Hex_Byte (Code mod 256); Write_Char ('"'); Write_Char (']'); end if; diff --git a/gcc/ada/stringt.ads b/gcc/ada/stringt.ads index 6a6291a5829..d6ab3893579 100644 --- a/gcc/ada/stringt.ads +++ b/gcc/ada/stringt.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -154,8 +154,8 @@ package Stringt is -- ASCII graphics (except for double quote) are output literally. -- The double quote appears as two successive double quotes. -- All other codes, are output as described for Write_Char_Code. For - -- example, the string created by folding "A" & ASCII.LF & "Hello" will - -- print as "A["0a"]Hello". A No_String value prints simply as "no string" + -- example, the string created by folding "A" & ASCII.HT & "Hello" will + -- print as "A["09"]Hello". A No_String value prints simply as "no string" -- without surrounding quote marks. private diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb index 8cf9cf4fdbe..5c2f525d924 100644 --- a/gcc/ada/switch-b.adb +++ b/gcc/ada/switch-b.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -350,6 +350,12 @@ package body Switch.B is All_Sources := False; Check_Source_Files := False; + -- Processing for X switch + + when 'X' => + Ptr := Ptr + 1; + Scan_Pos (Switch_Chars, Max, Ptr, Default_Exit_Status); + -- Processing for z switch when 'z' => diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index 94aa9dc8926..7446359e90e 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2004, 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- * @@ -250,7 +250,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name, /* Set the current function to be the elaboration procedure and gimplify what we have. */ current_function_decl = info->elab_proc; - gimplify_body (&gnu_body, info->elab_proc, false); + gimplify_body (&gnu_body, info->elab_proc, true); /* We should have a BIND_EXPR, but it may or may not have any statements in it. If it doesn't have any, we have nothing to do. */ @@ -2549,7 +2549,8 @@ gnat_to_gnu (Node_Id gnat_node) else gnu_result = force_fit_type - (build_int_cst (gnu_result_type, Char_Literal_Value (gnat_node)), + (build_int_cst + (gnu_result_type, UI_To_CC (Char_Literal_Value (gnat_node))), false, false, false); break; @@ -2747,7 +2748,7 @@ gnat_to_gnu (Node_Id gnat_node) case N_Object_Renaming_Declaration: gnat_temp = Defining_Entity (gnat_node); - /* Don't do anything if this renaming is handled by the front end. or if + /* Don't do anything if this renaming is handled by the front end or if we are just annotating types and this object has a composite or task type, don't elaborate it. We return the result in case it has any SAVE_EXPRs in it that need to be evaluated here. */ @@ -3023,11 +3024,8 @@ gnat_to_gnu (Node_Id gnat_node) if (Null_Record_Present (gnat_node)) gnu_result = gnat_build_constructor (gnu_aggr_type, NULL_TREE); - else if (TREE_CODE (gnu_aggr_type) == RECORD_TYPE) - gnu_result - = assoc_to_constructor (First (Component_Associations (gnat_node)), - gnu_aggr_type); - else if (TREE_CODE (gnu_aggr_type) == UNION_TYPE) + else if (TREE_CODE (gnu_aggr_type) == UNION_TYPE + && TYPE_UNCHECKED_UNION_P (gnu_aggr_type)) { /* The first element is the discrimant, which we ignore. The next is the field we're building. Convert the expression @@ -3041,6 +3039,11 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result = convert (gnu_field_type, gnat_to_gnu (Expression (gnat_assoc))); } + else if (TREE_CODE (gnu_aggr_type) == RECORD_TYPE + || TREE_CODE (gnu_aggr_type) == UNION_TYPE) + gnu_result + = assoc_to_constructor (First (Component_Associations (gnat_node)), + gnu_aggr_type); else if (TREE_CODE (gnu_aggr_type) == ARRAY_TYPE) gnu_result = pos_to_constructor (First (Expressions (gnat_node)), gnu_aggr_type, @@ -3542,7 +3545,6 @@ gnat_to_gnu (Node_Id gnat_node) && Nkind (Expression (gnat_node)) == N_Function_Call) gnu_ret_val = call_to_gnu (Expression (gnat_node), &gnu_result_type, gnu_lhs); - else { gnu_ret_val = gnat_to_gnu (Expression (gnat_node)); diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 2c52b5c98cc..3ed7fcc4351 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -628,19 +628,6 @@ package body Treepr is Write_Int (Int (Val)); Write_Char (')'); - elsif Val in Char_Code_Range then - Write_Str ("Character code = "); - - declare - C : constant Char_Code := Char_Code (Val - Char_Code_Bias); - - begin - Write_Int (Int (C)); - Write_Str (" ('"); - Write_Char_Code (C); - Write_Str ("')"); - end; - else Print_Str ("****** Incorrect value = "); Print_Int (Int (Val)); diff --git a/gcc/ada/ttypes.ads b/gcc/ada/ttypes.ads index 2d31034e503..1be56738290 100644 --- a/gcc/ada/ttypes.ads +++ b/gcc/ada/ttypes.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2003 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- -- @@ -142,11 +142,8 @@ package Ttypes is Standard_Character_Size : constant Pos := Get_Char_Size; Standard_Wide_Character_Size : constant Pos := 16; - -- The Standard.Wide_Character type is special in the sense that - -- it is not defined in terms of its corresponding C type (wchar_t). - -- Unfortunately this makes the representation of Wide_Character - -- incompatible with the C wchar_t type. - -- ??? This is required by the RM or backward compatibility + Standard_Wide_Wide_Character_Size : constant Pos := 32; + -- Standard wide character sizes. -- Note: there is no specific control over the representation of -- enumeration types. The convention used is that if an enumeration diff --git a/gcc/ada/types.adb b/gcc/ada/types.adb index 69b019ed086..9334c311a65 100644 --- a/gcc/ada/types.adb +++ b/gcc/ada/types.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2001 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- -- @@ -153,6 +153,16 @@ package body Types is end Get_Hex_String; ------------------------ + -- Get_Wide_Character -- + ------------------------ + + function Get_Wide_Character (C : Char_Code) return Wide_Character is + begin + pragma Assert (C <= 65535); + return Wide_Character'Val (C); + end Get_Wide_Character; + + ------------------------ -- In_Character_Range -- ------------------------ @@ -161,6 +171,15 @@ package body Types is return (C <= 255); end In_Character_Range; + ----------------------------- + -- In_Wide_Character_Range -- + ----------------------------- + + function In_Wide_Character_Range (C : Char_Code) return Boolean is + begin + return (C <= 65535); + end In_Wide_Character_Range; + --------------------- -- Make_Time_Stamp -- --------------------- diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 75a2acbc16d..3d649baa8ae 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -106,6 +106,10 @@ pragma Preelaborate (Types); subtype Line_Terminator is Character range ASCII.LF .. ASCII.CR; -- Line terminator characters (LF, VT, FF, CR) + -- This definition is dubious now that we have two more wide character + -- sequences that constitute a line terminator. Every reference to + -- this subtype needs checking to make sure the wide character case + -- is handled appropriately. subtype Upper_Half_Character is Character range Character'Val (16#80#) .. Character'Val (16#FF#); @@ -234,7 +238,6 @@ pragma Preelaborate (Types); -- Strings (type String_Id) -- Universal integers (type Uint) -- Universal reals (type Ureal) - -- Character codes (type Char_Code stored with a bias) -- In most contexts, the strongly typed interface determines which of -- these types is present. However, there are some situations (involving @@ -325,10 +328,6 @@ pragma Preelaborate (Types); -- The range of Uint values is very large, since a substantial part -- of this range is used to store direct values, see Uintp for details. - Char_Code_Bias : constant := 2_100_000_000; - -- A bias value added to character code values stored in the tree which - -- ensures that they have different values from any of the above types. - -- The following subtype definitions are used to provide convenient names -- for membership tests on Int values to see what data type range they -- lie in. Such tests appear only in the lowest level packages. @@ -357,9 +356,6 @@ pragma Preelaborate (Types); subtype Ureal_Range is Union_Id range Ureal_Low_Bound .. Ureal_High_Bound; - subtype Char_Code_Range is Union_Id - range Char_Code_Bias .. Char_Code_Bias + 2**16 - 1; - ----------------------------- -- Types for Namet Package -- ----------------------------- @@ -525,16 +521,19 @@ pragma Preelaborate (Types); -- The type Char is used for character data internally in the compiler, -- but character codes in the source are represented by the Char_Code -- type. Each character literal in the source is interpreted as being one - -- of the 2**16 possible Wide_Character codes, and a unique integer value - -- is assigned, corresponding to the POS value in the Wide_Character type. - -- String literals are similarly interpreted as a sequence of such codes. + -- of the 16#8000_0000 possible Wide_Wide_Character codes, and a unique + -- Integer Value is assigned, corresponding to the UTF_32 value, which + -- also correspondds to the POS value in the Wide_Wide_Character type, + -- and also corresponds to the POS value in the Wide_Character and + -- Character types for values that are in appropriate range. String + -- literals are similarly interpreted as a sequence of such codes. - -- Note: when character code values are stored in the tree, they are stored - -- by adding a bias value (Char_Code_Bias) that results in values that can - -- be distinguished from other types of values stored in the tree. + type Char_Code_Base is mod 2 ** 32; + for Char_Code_Base'Size use 32; - type Char_Code is mod 2 ** 16; - for Char_Code'Size use 16; + subtype Char_Code is Char_Code_Base range 0 .. 16#7FFF_FFFF#; + for Char_Code'Value_Size use 32; + for Char_Code'Object_Size use 32; function Get_Char_Code (C : Character) return Char_Code; pragma Inline (Get_Char_Code); @@ -548,11 +547,21 @@ pragma Preelaborate (Types); -- Determines if the given character code is in range of type Character, -- and if so, returns True. If not, returns False. + function In_Wide_Character_Range (C : Char_Code) return Boolean; + pragma Inline (In_Wide_Character_Range); + -- Determines if the given character code is in range of the type + -- Wide_Character, and if so, returns True. If not, returns False. + function Get_Character (C : Char_Code) return Character; pragma Inline (Get_Character); - -- For a character C that is in character range (see above function), this + -- For a character C that is in Character range (see above function), this -- function returns the corresponding Character value. It is an error to - -- call Get_Character if C is not in character range + -- call Get_Character if C is not in C haracter range + + function Get_Wide_Character (C : Char_Code) return Wide_Character; + -- For a character C that is in Wide_Character range (see above function), + -- this function returns the corresponding Wide_Character value. It is an + -- error to call Get_Wide_Character if C is not in Wide_Character range. --------------------------------------- -- Types used for Library Management -- @@ -768,6 +777,7 @@ pragma Preelaborate (Types); CE_Index_Check_Failed, CE_Invalid_Data, CE_Length_Check_Failed, + CE_Null_Not_Allowed, CE_Overflow_Check_Failed, CE_Partition_Check_Failed, CE_Range_Check_Failed, diff --git a/gcc/ada/types.h b/gcc/ada/types.h index b4c4eb4419f..04d4a7e24d9 100644 --- a/gcc/ada/types.h +++ b/gcc/ada/types.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2004, 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- * @@ -161,8 +161,6 @@ typedef int Union_Id; #define Uint_Table_Start 2000000000 #define Uint_High_Bound 2099999999 -#define Char_Code_Bias 2100000000 - SUBTYPE (List_Range, Int, List_Low_Bound, List_High_Bound) SUBTYPE (Node_Range, Int, Node_Low_Bound, Node_High_Bound) SUBTYPE (Elist_Range, Int, Elist_Low_Bound, Elist_High_Bound) @@ -171,7 +169,6 @@ SUBTYPE (Names_Range, Int, Names_Low_Bound, Names_High_Bound) SUBTYPE (Strings_Range, Int, Strings_Low_Bound, Strings_High_Bound) SUBTYPE (Uint_Range, Int, Uint_Low_Bound, Uint_High_Bound) SUBTYPE (Ureal_Range, Int, Ureal_Low_Bound, Ureal_High_Bound) -SUBTYPE (Char_Code_Range, Int, Char_Code_Bias, (Char_Code_Bias + 65535)) /* Types for Names_Table Package: */ @@ -286,8 +283,8 @@ typedef Int Ureal; /* Character Code Type: */ -/* Character code value, intended to be 16 bits. */ -typedef short Char_Code; +/* Character code value, intended to be 32 bits. */ +typedef unsigned Char_Code; /* Types Used for Library Management: */ @@ -341,27 +338,28 @@ typedef Int Mechanism_Type; #define CE_Index_Check_Failed 5 #define CE_Invalid_Data 6 #define CE_Length_Check_Failed 7 -#define CE_Overflow_Check_Failed 8 -#define CE_Partition_Check_Failed 9 -#define CE_Range_Check_Failed 10 -#define CE_Tag_Check_Failed 11 -#define PE_Access_Before_Elaboration 12 -#define PE_Accessibility_Check_Failed 13 -#define PE_All_Guards_Closed 14 -#define PE_Duplicated_Entry_Address 15 -#define PE_Explicit_Raise 16 -#define PE_Finalize_Raised_Exception 17 -#define PE_Misaligned_Address_Value 18 -#define PE_Missing_Return 19 -#define PE_Overlaid_Controlled_Object 20 -#define PE_Potentially_Blocking_Operation 21 -#define PE_Stubbed_Subprogram_Called 22 -#define PE_Unchecked_Union_Restriction 23 -#define PE_Illegal_RACW_E_4_18 24 -#define SE_Empty_Storage_Pool 25 -#define SE_Explicit_Raise 26 -#define SE_Infinite_Recursion 27 -#define SE_Object_Too_Large 28 -#define SE_Restriction_Violation 29 - -#define LAST_REASON_CODE 29 +#define CE_Null_Not_Allowed 8 +#define CE_Overflow_Check_Failed 9 +#define CE_Partition_Check_Failed 10 +#define CE_Range_Check_Failed 11 +#define CE_Tag_Check_Failed 12 +#define PE_Access_Before_Elaboration 13 +#define PE_Accessibility_Check_Failed 14 +#define PE_All_Guards_Closed 15 +#define PE_Duplicated_Entry_Address 16 +#define PE_Explicit_Raise 17 +#define PE_Finalize_Raised_Exception 18 +#define PE_Misaligned_Address_Value 19 +#define PE_Missing_Return 20 +#define PE_Overlaid_Controlled_Object 21 +#define PE_Potentially_Blocking_Operation 22 +#define PE_Stubbed_Subprogram_Called 23 +#define PE_Unchecked_Union_Restriction 24 +#define PE_Illegal_RACW_E_4_18 25 +#define SE_Empty_Storage_Pool 26 +#define SE_Explicit_Raise 27 +#define SE_Infinite_Recursion 28 +#define SE_Object_Too_Large 29 +#define SE_Restriction_Violation 30 + +#define LAST_REASON_CODE 30 diff --git a/gcc/ada/uintp.adb b/gcc/ada/uintp.adb index 7b4e7139640..10b2b1367d9 100644 --- a/gcc/ada/uintp.adb +++ b/gcc/ada/uintp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 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- -- @@ -1559,6 +1559,15 @@ package body Uintp is end; end UI_Expon; + ---------------- + -- UI_From_CC -- + ---------------- + + function UI_From_CC (Input : Char_Code) return Uint is + begin + return UI_From_Dint (Dint (Input)); + end UI_From_CC; + ------------------ -- UI_From_Dint -- ------------------ @@ -2384,6 +2393,39 @@ package body Uintp is end if; end UI_Sub; + -------------- + -- UI_To_CC -- + -------------- + + function UI_To_CC (Input : Uint) return Char_Code is + begin + if Direct (Input) then + return Char_Code (Direct_Val (Input)); + + -- Case of input is more than one digit + + else + declare + In_Length : constant Int := N_Digits (Input); + In_Vec : UI_Vector (1 .. In_Length); + Ret_CC : Char_Code; + + begin + Init_Operand (Input, In_Vec); + + -- We assume value is positive + + Ret_CC := 0; + for Idx in In_Vec'Range loop + Ret_CC := Ret_CC * Char_Code (Base) + + Char_Code (abs In_Vec (Idx)); + end loop; + + return Ret_CC; + end; + end if; + end UI_To_CC; + ---------------- -- UI_To_Int -- ---------------- diff --git a/gcc/ada/uintp.ads b/gcc/ada/uintp.ads index f1babd179de..97206ade7d7 100644 --- a/gcc/ada/uintp.ads +++ b/gcc/ada/uintp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004, 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- -- @@ -222,14 +222,21 @@ package Uintp is -- Returns difference of two integer values function UI_From_Dint (Input : Dint) return Uint; - -- Converts Dint value to universal integer form. + -- Converts Dint value to universal integer form function UI_From_Int (Input : Int) return Uint; - -- Converts Int value to universal integer form. + -- Converts Int value to universal integer form + + function UI_From_CC (Input : Char_Code) return Uint; + -- Converts Char_Code value to universal integer form function UI_To_Int (Input : Uint) return Int; - -- Converts universal integer value to Int. Fatal error - -- if value is not in appropriate range. + -- Converts universal integer value to Int. Fatal error if value is not in + -- appropriate range. + + function UI_To_CC (Input : Uint) return Char_Code; + -- Converts universal integer value to Char_Code. Fatal error if value is + -- not in Char_Code range. function Num_Bits (Input : Uint) return Nat; -- Approximate number of binary bits in given universal integer. diff --git a/gcc/ada/uintp.h b/gcc/ada/uintp.h index 35f5c9f8bc8..b055a9ed012 100644 --- a/gcc/ada/uintp.h +++ b/gcc/ada/uintp.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * 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- * @@ -39,6 +39,10 @@ struct Uint_Entry #define UI_Is_In_Int_Range uintp__ui_is_in_int_range extern Boolean UI_Is_In_Int_Range (Uint); +/* Obtain Char_Code value from Uint input. Value must be in range. */ +#define UI_To_CC uintp__ui_to_cc +extern Char_Code UI_To_CC (Uint); + /* Obtain Int value from Uint input. This will abort if the result is out of range. */ #define UI_To_Int uintp__ui_to_int @@ -48,6 +52,10 @@ extern Int UI_To_Int (Uint); #define UI_From_Int uintp__ui_from_int extern Uint UI_From_Int (int); +/* Convert a Char_Code into a Uint. */ +#define UI_From_CC uintp__ui_from_cc +extern Uint UI_From_CC (Char_Code); + /* Similarly, but return a GCC INTEGER_CST. Overflow is tested by the constant-folding used to build the node. TYPE is the GCC type of the resulting node. */ diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index 0dbd0f19a32..2b028bbe2a5 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1996-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1996-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- -- @@ -498,6 +498,21 @@ package VMS_Data is -- current unit. This is useful for code audit purposes, and also may be -- used to improve code generation in some cases. + S_Bind_Return : aliased constant S := "/RETURN_CODES=" & + "POSIX " & + "!-X1 " & + "VMS " & + "-X1"; + -- /RETURN_CODES=POSIX (D) + -- /RETURN_CODES=VMS + -- + -- Specifies the style of default exit code returned. Must be used in + -- conjunction with and match the Link qualifer with same name. + -- + -- POSIX (D) Return Posix success (0) by default. + -- + -- VMS Return VMS success (1) by default. + S_Bind_RTS : aliased constant S := "/RUNTIME_SYSTEM=|" & "--RTS=|"; -- /RUNTIME_SYSTEM=xxx @@ -636,6 +651,7 @@ package VMS_Data is S_Bind_Report 'Access, S_Bind_ReportX 'Access, S_Bind_Restr 'Access, + S_Bind_Return 'Access, S_Bind_RTS 'Access, S_Bind_Search 'Access, S_Bind_Shared 'Access, @@ -3368,7 +3384,8 @@ package VMS_Data is -- /RETURN_CODES=VMS -- -- Specifies the style of codes returned by - -- Ada.Command_Line.Set_Exit_Status. + -- Ada.Command_Line.Set_Exit_Status. Must be used in conjunction with + -- and match the Bind qualifer with the same name. -- -- POSIX (D) Return Posix compatible exit codes. -- @@ -4473,7 +4490,7 @@ package VMS_Data is S_Pretty_Align : aliased constant S := "/ALIGN=" & "DEFAULT " & - "-A1234 " & + "-A12345 " & "OFF " & "-A0 " & "COLONS " & @@ -4483,7 +4500,9 @@ package VMS_Data is "STATEMENTS " & "-A3 " & "ARROWS " & - "-A4"; + "-A4 " & + "COMPONENT_CLAUSES " & + "-A5"; -- /ALIGN[=align-option, align-option, ...] -- -- Set alignments. By default, all alignments (colons in declarations, @@ -4492,11 +4511,14 @@ package VMS_Data is -- -- align-option may be one of the following: -- - -- OFF (D) Set all alignments to OFF - -- COLONS Set alignments of colons in declarations to ON - -- DECLARATIONS Set alignments of initialisations in declarations to ON - -- STATEMENTS Set alignments of assignments statements to ON - -- ARROWS Set alignments of arrow delimiters to ON. + -- OFF (D) Set all alignments to OFF + -- COLONS Set alignments of colons in declarations to ON + -- DECLARATIONS Set alignments of initialisations in declarations + -- to ON + -- STATEMENTS Set alignments of assignments statements to ON + -- ARROWS Set alignments of arrow delimiters to ON. + -- COMPONENT_CLAUSES Set alignments of AT keywords in component + -- clauses ON -- -- Specifying one of the ON options without first specifying the OFF -- option has no effect, because by default all alignments are set to ON. diff --git a/gcc/ada/widechar.adb b/gcc/ada/widechar.adb index 89514359e53..72cfb4ab63b 100644 --- a/gcc/ada/widechar.adb +++ b/gcc/ada/widechar.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- -- @@ -42,14 +42,1550 @@ with System.WCh_Con; use System.WCh_Con; package body Widechar is + pragma Style_Checks (Off); + -- Allow long lines in this unit + + ----------------------------------------------- + -- Tables for UTF_32 Categorization Routines -- + ----------------------------------------------- + + -- Note these tables are derived from those given in AI-285. For details + -- see //www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs/AI-00285.TXT?rev=1.22. + + type UTF_32_Range is record + Lo : Char_Code; + Hi : Char_Code; + end record; + + type UTF_32_Ranges is array (Positive range <>) of UTF_32_Range; + + -- The following array includes all characters considered digits, i.e. + -- all characters from the Unicode table with categories: + + -- Number, Decimal Digit (Nd) + + UTF_32_Digits : constant UTF_32_Ranges := ( + (16#00030#, 16#00039#), -- DIGIT ZERO .. DIGIT NINE + (16#00660#, 16#00669#), -- ARABIC-INDIC DIGIT ZERO .. ARABIC-INDIC DIGIT NINE + (16#006F0#, 16#006F9#), -- EXTENDED ARABIC-INDIC DIGIT ZERO .. EXTENDED ARABIC-INDIC DIGIT NINE + (16#00966#, 16#0096F#), -- DEVANAGARI DIGIT ZERO .. DEVANAGARI DIGIT NINE + (16#009E6#, 16#009EF#), -- BENGALI DIGIT ZERO .. BENGALI DIGIT NINE + (16#00A66#, 16#00A6F#), -- GURMUKHI DIGIT ZERO .. GURMUKHI DIGIT NINE + (16#00AE6#, 16#00AEF#), -- GUJARATI DIGIT ZERO .. GUJARATI DIGIT NINE + (16#00B66#, 16#00B6F#), -- ORIYA DIGIT ZERO .. ORIYA DIGIT NINE + (16#00BE7#, 16#00BEF#), -- TAMIL DIGIT ONE .. TAMIL DIGIT NINE + (16#00C66#, 16#00C6F#), -- TELUGU DIGIT ZERO .. TELUGU DIGIT NINE + (16#00CE6#, 16#00CEF#), -- KANNADA DIGIT ZERO .. KANNADA DIGIT NINE + (16#00D66#, 16#00D6F#), -- MALAYALAM DIGIT ZERO .. MALAYALAM DIGIT NINE + (16#00E50#, 16#00E59#), -- THAI DIGIT ZERO .. THAI DIGIT NINE + (16#00ED0#, 16#00ED9#), -- LAO DIGIT ZERO .. LAO DIGIT NINE + (16#00F20#, 16#00F29#), -- TIBETAN DIGIT ZERO .. TIBETAN DIGIT NINE + (16#01040#, 16#01049#), -- MYANMAR DIGIT ZERO .. MYANMAR DIGIT NINE + (16#01369#, 16#01371#), -- ETHIOPIC DIGIT ONE .. ETHIOPIC DIGIT NINE + (16#017E0#, 16#017E9#), -- KHMER DIGIT ZERO .. KHMER DIGIT NINE + (16#01810#, 16#01819#), -- MONGOLIAN DIGIT ZERO .. MONGOLIAN DIGIT NINE + (16#01946#, 16#0194F#), -- LIMBU DIGIT ZERO .. LIMBU DIGIT NINE + (16#0FF10#, 16#0FF19#), -- FULLWIDTH DIGIT ZERO .. FULLWIDTH DIGIT NINE + (16#104A0#, 16#104A9#), -- OSMANYA DIGIT ZERO .. OSMANYA DIGIT NINE + (16#1D7CE#, 16#1D7FF#)); -- MATHEMATICAL BOLD DIGIT ZERO .. MATHEMATICAL MONOSPACE DIGIT NINE + + -- The following table includes all characters considered letters, i.e. + -- all characters from the Unicode table with categories: + + -- Letter, Uppercase (Lu) + -- Letter, Lowercase (Ll) + -- Letter, Titlecase (Lt) + -- Letter, Modifier (Lm) + -- Letter, Other (Lo) + -- Number, Letter (Nl) + + UTF_32_Letters : constant UTF_32_Ranges := ( + (16#00041#, 16#0005A#), -- LATIN CAPITAL LETTER A .. LATIN CAPITAL LETTER Z + (16#00061#, 16#0007A#), -- LATIN SMALL LETTER A .. LATIN SMALL LETTER Z + (16#000AA#, 16#000AA#), -- FEMININE ORDINAL INDICATOR .. FEMININE ORDINAL INDICATOR + (16#000B5#, 16#000B5#), -- MICRO SIGN .. MICRO SIGN + (16#000BA#, 16#000BA#), -- MASCULINE ORDINAL INDICATOR .. MASCULINE ORDINAL INDICATOR + (16#000C0#, 16#000D6#), -- LATIN CAPITAL LETTER A WITH GRAVE .. LATIN CAPITAL LETTER O WITH DIAERESIS + (16#000D8#, 16#000F6#), -- LATIN CAPITAL LETTER O WITH STROKE .. LATIN SMALL LETTER O WITH DIAERESIS + (16#000F8#, 16#00236#), -- LATIN SMALL LETTER O WITH STROKE .. LATIN SMALL LETTER T WITH CURL + (16#00250#, 16#002C1#), -- LATIN SMALL LETTER TURNED A .. MODIFIER LETTER REVERSED GLOTTAL STOP + (16#002C6#, 16#002D1#), -- MODIFIER LETTER CIRCUMFLEX ACCENT .. MODIFIER LETTER HALF TRIANGULAR COLON + (16#002E0#, 16#002E4#), -- MODIFIER LETTER SMALL GAMMA .. MODIFIER LETTER SMALL REVERSED GLOTTAL STOP + (16#002EE#, 16#002EE#), -- MODIFIER LETTER DOUBLE APOSTROPHE .. MODIFIER LETTER DOUBLE APOSTROPHE + (16#0037A#, 16#0037A#), -- GREEK YPOGEGRAMMENI .. GREEK YPOGEGRAMMENI + (16#00386#, 16#00386#), -- GREEK CAPITAL LETTER ALPHA WITH TONOS .. GREEK CAPITAL LETTER ALPHA WITH TONOS + (16#00388#, 16#0038A#), -- GREEK CAPITAL LETTER EPSILON WITH TONOS .. GREEK CAPITAL LETTER IOTA WITH TONOS + (16#0038C#, 16#0038C#), -- GREEK CAPITAL LETTER OMICRON WITH TONOS .. GREEK CAPITAL LETTER OMICRON WITH TONOS + (16#0038E#, 16#003A1#), -- GREEK CAPITAL LETTER UPSILON WITH TONOS .. GREEK CAPITAL LETTER RHO + (16#003A3#, 16#003CE#), -- GREEK CAPITAL LETTER SIGMA .. GREEK SMALL LETTER OMEGA WITH TONOS + (16#003D0#, 16#003F5#), -- GREEK BETA SYMBOL .. GREEK LUNATE EPSILON SYMBOL + (16#003F7#, 16#003FB#), -- GREEK CAPITAL LETTER SHO .. GREEK SMALL LETTER SAN + (16#00400#, 16#00481#), -- CYRILLIC CAPITAL LETTER IE WITH GRAVE .. CYRILLIC SMALL LETTER KOPPA + (16#0048A#, 16#004CE#), -- CYRILLIC CAPITAL LETTER SHORT I WITH TAIL .. CYRILLIC SMALL LETTER EM WITH TAIL + (16#004D0#, 16#004F5#), -- CYRILLIC CAPITAL LETTER A WITH BREVE .. CYRILLIC SMALL LETTER CHE WITH DIAERESIS + (16#004F8#, 16#004F9#), -- CYRILLIC CAPITAL LETTER YERU WITH DIAERESIS .. CYRILLIC SMALL LETTER YERU WITH DIAERESIS + (16#00500#, 16#0050F#), -- CYRILLIC CAPITAL LETTER KOMI DE .. CYRILLIC SMALL LETTER KOMI TJE + (16#00531#, 16#00556#), -- ARMENIAN CAPITAL LETTER AYB .. ARMENIAN CAPITAL LETTER FEH + (16#00559#, 16#00559#), -- ARMENIAN MODIFIER LETTER LEFT HALF RING .. ARMENIAN MODIFIER LETTER LEFT HALF RING + (16#00561#, 16#00587#), -- ARMENIAN SMALL LETTER AYB .. ARMENIAN SMALL LIGATURE ECH YIWN + (16#005D0#, 16#005EA#), -- HEBREW LETTER ALEF .. HEBREW LETTER TAV + (16#005F0#, 16#005F2#), -- HEBREW LIGATURE YIDDISH DOUBLE VAV .. HEBREW LIGATURE YIDDISH DOUBLE YOD + (16#00621#, 16#0063A#), -- ARABIC LETTER HAMZA .. ARABIC LETTER GHAIN + (16#00640#, 16#0064A#), -- ARABIC TATWEEL .. ARABIC LETTER YEH + (16#0066E#, 16#0066F#), -- ARABIC LETTER DOTLESS BEH .. ARABIC LETTER DOTLESS QAF + (16#00671#, 16#006D3#), -- ARABIC LETTER ALEF WASLA .. ARABIC LETTER YEH BARREE WITH HAMZA ABOVE + (16#006D5#, 16#006D5#), -- ARABIC LETTER AE .. ARABIC LETTER AE + (16#006E5#, 16#006E6#), -- ARABIC SMALL WAW .. ARABIC SMALL YEH + (16#006EE#, 16#006EF#), -- ARABIC LETTER DAL WITH INVERTED V .. ARABIC LETTER REH WITH INVERTED V + (16#006FA#, 16#006FC#), -- ARABIC LETTER SHEEN WITH DOT BELOW .. ARABIC LETTER GHAIN WITH DOT BELOW + (16#006FF#, 16#006FF#), -- ARABIC LETTER HEH WITH INVERTED V .. ARABIC LETTER HEH WITH INVERTED V + (16#00710#, 16#00710#), -- SYRIAC LETTER ALAPH .. SYRIAC LETTER ALAPH + (16#00712#, 16#0072F#), -- SYRIAC LETTER BETH .. SYRIAC LETTER PERSIAN DHALATH + (16#0074D#, 16#0074F#), -- SYRIAC LETTER SOGDIAN ZHAIN .. SYRIAC LETTER SOGDIAN FE + (16#00780#, 16#007A5#), -- THAANA LETTER HAA .. THAANA LETTER WAAVU + (16#007B1#, 16#007B1#), -- THAANA LETTER NAA .. THAANA LETTER NAA + (16#00904#, 16#00939#), -- DEVANAGARI LETTER SHORT A .. DEVANAGARI LETTER HA + (16#0093D#, 16#0093D#), -- DEVANAGARI SIGN AVAGRAHA .. DEVANAGARI SIGN AVAGRAHA + (16#00950#, 16#00950#), -- DEVANAGARI OM .. DEVANAGARI OM + (16#00958#, 16#00961#), -- DEVANAGARI LETTER QA .. DEVANAGARI LETTER VOCALIC LL + (16#00985#, 16#0098C#), -- BENGALI LETTER A .. BENGALI LETTER VOCALIC L + (16#0098F#, 16#00990#), -- BENGALI LETTER E .. BENGALI LETTER AI + (16#00993#, 16#009A8#), -- BENGALI LETTER O .. BENGALI LETTER NA + (16#009AA#, 16#009B0#), -- BENGALI LETTER PA .. BENGALI LETTER RA + (16#009B2#, 16#009B2#), -- BENGALI LETTER LA .. BENGALI LETTER LA + (16#009B6#, 16#009B9#), -- BENGALI LETTER SHA .. BENGALI LETTER HA + (16#009BD#, 16#009BD#), -- BENGALI SIGN AVAGRAHA .. BENGALI SIGN AVAGRAHA + (16#009DC#, 16#009DD#), -- BENGALI LETTER RRA .. BENGALI LETTER RHA + (16#009DF#, 16#009E1#), -- BENGALI LETTER YYA .. BENGALI LETTER VOCALIC LL + (16#009F0#, 16#009F1#), -- BENGALI LETTER RA WITH MIDDLE DIAGONAL .. BENGALI LETTER RA WITH LOWER DIAGONAL + (16#00A05#, 16#00A0A#), -- GURMUKHI LETTER A .. GURMUKHI LETTER UU + (16#00A0F#, 16#00A10#), -- GURMUKHI LETTER EE .. GURMUKHI LETTER AI + (16#00A13#, 16#00A28#), -- GURMUKHI LETTER OO .. GURMUKHI LETTER NA + (16#00A2A#, 16#00A30#), -- GURMUKHI LETTER PA .. GURMUKHI LETTER RA + (16#00A32#, 16#00A33#), -- GURMUKHI LETTER LA .. GURMUKHI LETTER LLA + (16#00A35#, 16#00A36#), -- GURMUKHI LETTER VA .. GURMUKHI LETTER SHA + (16#00A38#, 16#00A39#), -- GURMUKHI LETTER SA .. GURMUKHI LETTER HA + (16#00A59#, 16#00A5C#), -- GURMUKHI LETTER KHHA .. GURMUKHI LETTER RRA + (16#00A5E#, 16#00A5E#), -- GURMUKHI LETTER FA .. GURMUKHI LETTER FA + (16#00A72#, 16#00A74#), -- GURMUKHI IRI .. GURMUKHI EK ONKAR + (16#00A85#, 16#00A8D#), -- GUJARATI LETTER A .. GUJARATI VOWEL CANDRA E + (16#00A8F#, 16#00A91#), -- GUJARATI LETTER E .. GUJARATI VOWEL CANDRA O + (16#00A93#, 16#00AA8#), -- GUJARATI LETTER O .. GUJARATI LETTER NA + (16#00AAA#, 16#00AB0#), -- GUJARATI LETTER PA .. GUJARATI LETTER RA + (16#00AB2#, 16#00AB3#), -- GUJARATI LETTER LA .. GUJARATI LETTER LLA + (16#00AB5#, 16#00AB9#), -- GUJARATI LETTER VA .. GUJARATI LETTER HA + (16#00ABD#, 16#00ABD#), -- GUJARATI SIGN AVAGRAHA .. GUJARATI SIGN AVAGRAHA + (16#00AD0#, 16#00AD0#), -- GUJARATI OM .. GUJARATI OM + (16#00AE0#, 16#00AE1#), -- GUJARATI LETTER VOCALIC RR .. GUJARATI LETTER VOCALIC LL + (16#00B05#, 16#00B0C#), -- ORIYA LETTER A .. ORIYA LETTER VOCALIC L + (16#00B0F#, 16#00B10#), -- ORIYA LETTER E .. ORIYA LETTER AI + (16#00B13#, 16#00B28#), -- ORIYA LETTER O .. ORIYA LETTER NA + (16#00B2A#, 16#00B30#), -- ORIYA LETTER PA .. ORIYA LETTER RA + (16#00B32#, 16#00B33#), -- ORIYA LETTER LA .. ORIYA LETTER LLA + (16#00B35#, 16#00B39#), -- ORIYA LETTER VA .. ORIYA LETTER HA + (16#00B3D#, 16#00B3D#), -- ORIYA SIGN AVAGRAHA .. ORIYA SIGN AVAGRAHA + (16#00B5C#, 16#00B5D#), -- ORIYA LETTER RRA .. ORIYA LETTER RHA + (16#00B5F#, 16#00B61#), -- ORIYA LETTER YYA .. ORIYA LETTER VOCALIC LL + (16#00B71#, 16#00B71#), -- ORIYA LETTER WA .. ORIYA LETTER WA + (16#00B83#, 16#00B83#), -- TAMIL SIGN VISARGA .. TAMIL SIGN VISARGA + (16#00B85#, 16#00B8A#), -- TAMIL LETTER A .. TAMIL LETTER UU + (16#00B8E#, 16#00B90#), -- TAMIL LETTER E .. TAMIL LETTER AI + (16#00B92#, 16#00B95#), -- TAMIL LETTER O .. TAMIL LETTER KA + (16#00B99#, 16#00B9A#), -- TAMIL LETTER NGA .. TAMIL LETTER CA + (16#00B9C#, 16#00B9C#), -- TAMIL LETTER JA .. TAMIL LETTER JA + (16#00B9E#, 16#00B9F#), -- TAMIL LETTER NYA .. TAMIL LETTER TTA + (16#00BA3#, 16#00BA4#), -- TAMIL LETTER NNA .. TAMIL LETTER TA + (16#00BA8#, 16#00BAA#), -- TAMIL LETTER NA .. TAMIL LETTER PA + (16#00BAE#, 16#00BB5#), -- TAMIL LETTER MA .. TAMIL LETTER VA + (16#00BB7#, 16#00BB9#), -- TAMIL LETTER SSA .. TAMIL LETTER HA + (16#00C05#, 16#00C0C#), -- TELUGU LETTER A .. TELUGU LETTER VOCALIC L + (16#00C0E#, 16#00C10#), -- TELUGU LETTER E .. TELUGU LETTER AI + (16#00C12#, 16#00C28#), -- TELUGU LETTER O .. TELUGU LETTER NA + (16#00C2A#, 16#00C33#), -- TELUGU LETTER PA .. TELUGU LETTER LLA + (16#00C35#, 16#00C39#), -- TELUGU LETTER VA .. TELUGU LETTER HA + (16#00C60#, 16#00C61#), -- TELUGU LETTER VOCALIC RR .. TELUGU LETTER VOCALIC LL + (16#00C85#, 16#00C8C#), -- KANNADA LETTER A .. KANNADA LETTER VOCALIC L + (16#00C8E#, 16#00C90#), -- KANNADA LETTER E .. KANNADA LETTER AI + (16#00C92#, 16#00CA8#), -- KANNADA LETTER O .. KANNADA LETTER NA + (16#00CAA#, 16#00CB3#), -- KANNADA LETTER PA .. KANNADA LETTER LLA + (16#00CB5#, 16#00CB9#), -- KANNADA LETTER VA .. KANNADA LETTER HA + (16#00CBD#, 16#00CBD#), -- KANNADA SIGN AVAGRAHA .. KANNADA SIGN AVAGRAHA + (16#00CDE#, 16#00CDE#), -- KANNADA LETTER FA .. KANNADA LETTER FA + (16#00CE0#, 16#00CE1#), -- KANNADA LETTER VOCALIC RR .. KANNADA LETTER VOCALIC LL + (16#00D05#, 16#00D0C#), -- MALAYALAM LETTER A .. MALAYALAM LETTER VOCALIC L + (16#00D0E#, 16#00D10#), -- MALAYALAM LETTER E .. MALAYALAM LETTER AI + (16#00D12#, 16#00D28#), -- MALAYALAM LETTER O .. MALAYALAM LETTER NA + (16#00D2A#, 16#00D39#), -- MALAYALAM LETTER PA .. MALAYALAM LETTER HA + (16#00D60#, 16#00D61#), -- MALAYALAM LETTER VOCALIC RR .. MALAYALAM LETTER VOCALIC LL + (16#00D85#, 16#00D96#), -- SINHALA LETTER AYANNA .. SINHALA LETTER AUYANNA + (16#00D9A#, 16#00DB1#), -- SINHALA LETTER ALPAPRAANA KAYANNA .. SINHALA LETTER DANTAJA NAYANNA + (16#00DB3#, 16#00DBB#), -- SINHALA LETTER SANYAKA DAYANNA .. SINHALA LETTER RAYANNA + (16#00DBD#, 16#00DBD#), -- SINHALA LETTER DANTAJA LAYANNA .. SINHALA LETTER DANTAJA LAYANNA + (16#00DC0#, 16#00DC6#), -- SINHALA LETTER VAYANNA .. SINHALA LETTER FAYANNA + (16#00E01#, 16#00E30#), -- THAI CHARACTER KO KAI .. THAI CHARACTER SARA A + (16#00E32#, 16#00E33#), -- THAI CHARACTER SARA AA .. THAI CHARACTER SARA AM + (16#00E40#, 16#00E46#), -- THAI CHARACTER SARA E .. THAI CHARACTER MAIYAMOK + (16#00E81#, 16#00E82#), -- LAO LETTER KO .. LAO LETTER KHO SUNG + (16#00E84#, 16#00E84#), -- LAO LETTER KHO TAM .. LAO LETTER KHO TAM + (16#00E87#, 16#00E88#), -- LAO LETTER NGO .. LAO LETTER CO + (16#00E8A#, 16#00E8A#), -- LAO LETTER SO TAM .. LAO LETTER SO TAM + (16#00E8D#, 16#00E8D#), -- LAO LETTER NYO .. LAO LETTER NYO + (16#00E94#, 16#00E97#), -- LAO LETTER DO .. LAO LETTER THO TAM + (16#00E99#, 16#00E9F#), -- LAO LETTER NO .. LAO LETTER FO SUNG + (16#00EA1#, 16#00EA3#), -- LAO LETTER MO .. LAO LETTER LO LING + (16#00EA5#, 16#00EA5#), -- LAO LETTER LO LOOT .. LAO LETTER LO LOOT + (16#00EA7#, 16#00EA7#), -- LAO LETTER WO .. LAO LETTER WO + (16#00EAA#, 16#00EAB#), -- LAO LETTER SO SUNG .. LAO LETTER HO SUNG + (16#00EAD#, 16#00EB0#), -- LAO LETTER O .. LAO VOWEL SIGN A + (16#00EB2#, 16#00EB3#), -- LAO VOWEL SIGN AA .. LAO VOWEL SIGN AM + (16#00EBD#, 16#00EBD#), -- LAO SEMIVOWEL SIGN NYO .. LAO SEMIVOWEL SIGN NYO + (16#00EC0#, 16#00EC4#), -- LAO VOWEL SIGN E .. LAO VOWEL SIGN AI + (16#00EC6#, 16#00EC6#), -- LAO KO LA .. LAO KO LA + (16#00EDC#, 16#00EDD#), -- LAO HO NO .. LAO HO MO + (16#00F00#, 16#00F00#), -- TIBETAN SYLLABLE OM .. TIBETAN SYLLABLE OM + (16#00F40#, 16#00F47#), -- TIBETAN LETTER KA .. TIBETAN LETTER JA + (16#00F49#, 16#00F6A#), -- TIBETAN LETTER NYA .. TIBETAN LETTER FIXED-FORM RA + (16#00F88#, 16#00F8B#), -- TIBETAN SIGN LCE TSA CAN .. TIBETAN SIGN GRU MED RGYINGS + (16#01000#, 16#01021#), -- MYANMAR LETTER KA .. MYANMAR LETTER A + (16#01023#, 16#01027#), -- MYANMAR LETTER I .. MYANMAR LETTER E + (16#01029#, 16#0102A#), -- MYANMAR LETTER O .. MYANMAR LETTER AU + (16#01050#, 16#01055#), -- MYANMAR LETTER SHA .. MYANMAR LETTER VOCALIC LL + (16#010A0#, 16#010C5#), -- GEORGIAN CAPITAL LETTER AN .. GEORGIAN CAPITAL LETTER HOE + (16#010D0#, 16#010F8#), -- GEORGIAN LETTER AN .. GEORGIAN LETTER ELIFI + (16#01100#, 16#01159#), -- HANGUL CHOSEONG KIYEOK .. HANGUL CHOSEONG YEORINHIEUH + (16#0115F#, 16#011A2#), -- HANGUL CHOSEONG FILLER .. HANGUL JUNGSEONG SSANGARAEA + (16#011A8#, 16#011F9#), -- HANGUL JONGSEONG KIYEOK .. HANGUL JONGSEONG YEORINHIEUH + (16#01200#, 16#01206#), -- ETHIOPIC SYLLABLE HA .. ETHIOPIC SYLLABLE HO + (16#01208#, 16#01246#), -- ETHIOPIC SYLLABLE LA .. ETHIOPIC SYLLABLE QO + (16#01248#, 16#01248#), -- ETHIOPIC SYLLABLE QWA .. ETHIOPIC SYLLABLE QWA + (16#0124A#, 16#0124D#), -- ETHIOPIC SYLLABLE QWI .. ETHIOPIC SYLLABLE QWE + (16#01250#, 16#01256#), -- ETHIOPIC SYLLABLE QHA .. ETHIOPIC SYLLABLE QHO + (16#01258#, 16#01258#), -- ETHIOPIC SYLLABLE QHWA .. ETHIOPIC SYLLABLE QHWA + (16#0125A#, 16#0125D#), -- ETHIOPIC SYLLABLE QHWI .. ETHIOPIC SYLLABLE QHWE + (16#01260#, 16#01286#), -- ETHIOPIC SYLLABLE BA .. ETHIOPIC SYLLABLE XO + (16#01288#, 16#01288#), -- ETHIOPIC SYLLABLE XWA .. ETHIOPIC SYLLABLE XWA + (16#0128A#, 16#0128D#), -- ETHIOPIC SYLLABLE XWI .. ETHIOPIC SYLLABLE XWE + (16#01290#, 16#012AE#), -- ETHIOPIC SYLLABLE NA .. ETHIOPIC SYLLABLE KO + (16#012B0#, 16#012B0#), -- ETHIOPIC SYLLABLE KWA .. ETHIOPIC SYLLABLE KWA + (16#012B2#, 16#012B5#), -- ETHIOPIC SYLLABLE KWI .. ETHIOPIC SYLLABLE KWE + (16#012B8#, 16#012BE#), -- ETHIOPIC SYLLABLE KXA .. ETHIOPIC SYLLABLE KXO + (16#012C0#, 16#012C0#), -- ETHIOPIC SYLLABLE KXWA .. ETHIOPIC SYLLABLE KXWA + (16#012C2#, 16#012C5#), -- ETHIOPIC SYLLABLE KXWI .. ETHIOPIC SYLLABLE KXWE + (16#012C8#, 16#012CE#), -- ETHIOPIC SYLLABLE WA .. ETHIOPIC SYLLABLE WO + (16#012D0#, 16#012D6#), -- ETHIOPIC SYLLABLE PHARYNGEAL A .. ETHIOPIC SYLLABLE PHARYNGEAL O + (16#012D8#, 16#012EE#), -- ETHIOPIC SYLLABLE ZA .. ETHIOPIC SYLLABLE YO + (16#012F0#, 16#0130E#), -- ETHIOPIC SYLLABLE DA .. ETHIOPIC SYLLABLE GO + (16#01310#, 16#01310#), -- ETHIOPIC SYLLABLE GWA .. ETHIOPIC SYLLABLE GWA + (16#01312#, 16#01315#), -- ETHIOPIC SYLLABLE GWI .. ETHIOPIC SYLLABLE GWE + (16#01318#, 16#0131E#), -- ETHIOPIC SYLLABLE GGA .. ETHIOPIC SYLLABLE GGO + (16#01320#, 16#01346#), -- ETHIOPIC SYLLABLE THA .. ETHIOPIC SYLLABLE TZO + (16#01348#, 16#0135A#), -- ETHIOPIC SYLLABLE FA .. ETHIOPIC SYLLABLE FYA + (16#013A0#, 16#013F4#), -- CHEROKEE LETTER A .. CHEROKEE LETTER YV + (16#01401#, 16#0166C#), -- CANADIAN SYLLABICS E .. CANADIAN SYLLABICS CARRIER TTSA + (16#0166F#, 16#01676#), -- CANADIAN SYLLABICS QAI .. CANADIAN SYLLABICS NNGAA + (16#01681#, 16#0169A#), -- OGHAM LETTER BEITH .. OGHAM LETTER PEITH + (16#016A0#, 16#016EA#), -- RUNIC LETTER FEHU FEOH FE F .. RUNIC LETTER X + (16#016EE#, 16#016F0#), -- RUNIC ARLAUG SYMBOL .. RUNIC BELGTHOR SYMBOL + (16#01700#, 16#0170C#), -- TAGALOG LETTER A .. TAGALOG LETTER YA + (16#0170E#, 16#01711#), -- TAGALOG LETTER LA .. TAGALOG LETTER HA + (16#01720#, 16#01731#), -- HANUNOO LETTER A .. HANUNOO LETTER HA + (16#01740#, 16#01751#), -- BUHID LETTER A .. BUHID LETTER HA + (16#01760#, 16#0176C#), -- TAGBANWA LETTER A .. TAGBANWA LETTER YA + (16#0176E#, 16#01770#), -- TAGBANWA LETTER LA .. TAGBANWA LETTER SA + (16#01780#, 16#017B3#), -- KHMER LETTER KA .. KHMER INDEPENDENT VOWEL QAU + (16#017D7#, 16#017D7#), -- KHMER SIGN LEK TOO .. KHMER SIGN LEK TOO + (16#017DC#, 16#017DC#), -- KHMER SIGN AVAKRAHASANYA .. KHMER SIGN AVAKRAHASANYA + (16#01820#, 16#01877#), -- MONGOLIAN LETTER A .. MONGOLIAN LETTER MANCHU ZHA + (16#01880#, 16#018A8#), -- MONGOLIAN LETTER ALI GALI ANUSVARA ONE .. MONGOLIAN LETTER MANCHU ALI GALI BHA + (16#01900#, 16#0191C#), -- LIMBU VOWEL-CARRIER LETTER .. LIMBU LETTER HA + (16#01950#, 16#0196D#), -- TAI LE LETTER KA .. TAI LE LETTER AI + (16#01970#, 16#01974#), -- TAI LE LETTER TONE-2 .. TAI LE LETTER TONE-6 + (16#01D00#, 16#01D6B#), -- LATIN LETTER SMALL CAPITAL A .. LATIN SMALL LETTER UE + (16#01E00#, 16#01E9B#), -- LATIN CAPITAL LETTER A WITH RING BELOW .. LATIN SMALL LETTER LONG S WITH DOT ABOVE + (16#01EA0#, 16#01EF9#), -- LATIN CAPITAL LETTER A WITH DOT BELOW .. LATIN SMALL LETTER Y WITH TILDE + (16#01F00#, 16#01F15#), -- GREEK SMALL LETTER ALPHA WITH PSILI .. GREEK SMALL LETTER EPSILON WITH DASIA AND OXIA + (16#01F18#, 16#01F1D#), -- GREEK CAPITAL LETTER EPSILON WITH PSILI .. GREEK CAPITAL LETTER EPSILON WITH DASIA AND OXIA + (16#01F20#, 16#01F45#), -- GREEK SMALL LETTER ETA WITH PSILI .. GREEK SMALL LETTER OMICRON WITH DASIA AND OXIA + (16#01F48#, 16#01F4D#), -- GREEK CAPITAL LETTER OMICRON WITH PSILI .. GREEK CAPITAL LETTER OMICRON WITH DASIA AND OXIA + (16#01F50#, 16#01F57#), -- GREEK SMALL LETTER UPSILON WITH PSILI .. GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI + (16#01F59#, 16#01F59#), -- GREEK CAPITAL LETTER UPSILON WITH DASIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA + (16#01F5B#, 16#01F5B#), -- GREEK CAPITAL LETTER UPSILON WITH DASIA AND VARIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA AND VARIA + (16#01F5D#, 16#01F5D#), -- GREEK CAPITAL LETTER UPSILON WITH DASIA AND OXIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA AND OXIA + (16#01F5F#, 16#01F7D#), -- GREEK CAPITAL LETTER UPSILON WITH DASIA AND PERISPOMENI .. GREEK SMALL LETTER OMEGA WITH OXIA + (16#01F80#, 16#01FB4#), -- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI + (16#01FB6#, 16#01FBC#), -- GREEK SMALL LETTER ALPHA WITH PERISPOMENI .. GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI + (16#01FBE#, 16#01FBE#), -- GREEK PROSGEGRAMMENI .. GREEK PROSGEGRAMMENI + (16#01FC2#, 16#01FC4#), -- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI + (16#01FC6#, 16#01FCC#), -- GREEK SMALL LETTER ETA WITH PERISPOMENI .. GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI + (16#01FD0#, 16#01FD3#), -- GREEK SMALL LETTER IOTA WITH VRACHY .. GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA + (16#01FD6#, 16#01FDB#), -- GREEK SMALL LETTER IOTA WITH PERISPOMENI .. GREEK CAPITAL LETTER IOTA WITH OXIA + (16#01FE0#, 16#01FEC#), -- GREEK SMALL LETTER UPSILON WITH VRACHY .. GREEK CAPITAL LETTER RHO WITH DASIA + (16#01FF2#, 16#01FF4#), -- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI + (16#01FF6#, 16#01FFC#), -- GREEK SMALL LETTER OMEGA WITH PERISPOMENI .. GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI + (16#02071#, 16#02071#), -- SUPERSCRIPT LATIN SMALL LETTER I .. SUPERSCRIPT LATIN SMALL LETTER I + (16#0207F#, 16#0207F#), -- SUPERSCRIPT LATIN SMALL LETTER N .. SUPERSCRIPT LATIN SMALL LETTER N + (16#02102#, 16#02102#), -- DOUBLE-STRUCK CAPITAL C .. DOUBLE-STRUCK CAPITAL C + (16#02107#, 16#02107#), -- EULER CONSTANT .. EULER CONSTANT + (16#0210A#, 16#02113#), -- SCRIPT SMALL G .. SCRIPT SMALL L + (16#02115#, 16#02115#), -- DOUBLE-STRUCK CAPITAL N .. DOUBLE-STRUCK CAPITAL N + (16#02119#, 16#0211D#), -- DOUBLE-STRUCK CAPITAL P .. DOUBLE-STRUCK CAPITAL R + (16#02124#, 16#02124#), -- DOUBLE-STRUCK CAPITAL Z .. DOUBLE-STRUCK CAPITAL Z + (16#02126#, 16#02126#), -- OHM SIGN .. OHM SIGN + (16#02128#, 16#02128#), -- BLACK-LETTER CAPITAL Z .. BLACK-LETTER CAPITAL Z + (16#0212A#, 16#0212D#), -- KELVIN SIGN .. BLACK-LETTER CAPITAL C + (16#0212F#, 16#02131#), -- SCRIPT SMALL E .. SCRIPT CAPITAL F + (16#02133#, 16#02139#), -- SCRIPT CAPITAL M .. INFORMATION SOURCE + (16#0213D#, 16#0213F#), -- DOUBLE-STRUCK SMALL GAMMA .. DOUBLE-STRUCK CAPITAL PI + (16#02145#, 16#02149#), -- DOUBLE-STRUCK ITALIC CAPITAL D .. DOUBLE-STRUCK ITALIC SMALL J + (16#02160#, 16#02183#), -- ROMAN NUMERAL ONE .. ROMAN NUMERAL REVERSED ONE HUNDRED + (16#03005#, 16#03007#), -- IDEOGRAPHIC ITERATION MARK .. IDEOGRAPHIC NUMBER ZERO + (16#03021#, 16#03029#), -- HANGZHOU NUMERAL ONE .. HANGZHOU NUMERAL NINE + (16#03031#, 16#03035#), -- VERTICAL KANA REPEAT MARK .. VERTICAL KANA REPEAT MARK LOWER HALF + (16#03038#, 16#0303C#), -- HANGZHOU NUMERAL TEN .. MASU MARK + (16#03041#, 16#03096#), -- HIRAGANA LETTER SMALL A .. HIRAGANA LETTER SMALL KE + (16#0309D#, 16#0309F#), -- HIRAGANA ITERATION MARK .. HIRAGANA DIGRAPH YORI + (16#030A1#, 16#030FA#), -- KATAKANA LETTER SMALL A .. KATAKANA LETTER VO + (16#030FC#, 16#030FF#), -- KATAKANA-HIRAGANA PROLONGED SOUND MARK .. KATAKANA DIGRAPH KOTO + (16#03105#, 16#0312C#), -- BOPOMOFO LETTER B .. BOPOMOFO LETTER GN + (16#03131#, 16#0318E#), -- HANGUL LETTER KIYEOK .. HANGUL LETTER ARAEAE + (16#031A0#, 16#031B7#), -- BOPOMOFO LETTER BU .. BOPOMOFO FINAL LETTER H + (16#031F0#, 16#031FF#), -- KATAKANA LETTER SMALL KU .. KATAKANA LETTER SMALL RO + (16#03400#, 16#04DB5#), -- <CJK Ideograph Extension A, First> .. <CJK Ideograph Extension A, Last> + (16#04E00#, 16#09FA5#), -- <CJK Ideograph, First> .. <CJK Ideograph, Last> + (16#0A000#, 16#0A48C#), -- YI SYLLABLE IT .. YI SYLLABLE YYR + (16#0AC00#, 16#0D7A3#), -- <Hangul Syllable, First> .. <Hangul Syllable, Last> + (16#0F900#, 16#0FA2D#), -- CJK COMPATIBILITY IDEOGRAPH-F900 .. CJK COMPATIBILITY IDEOGRAPH-FA2D + (16#0FA30#, 16#0FA6A#), -- CJK COMPATIBILITY IDEOGRAPH-FA30 .. CJK COMPATIBILITY IDEOGRAPH-FA6A + (16#0FB00#, 16#0FB06#), -- LATIN SMALL LIGATURE FF .. LATIN SMALL LIGATURE ST + (16#0FB13#, 16#0FB17#), -- ARMENIAN SMALL LIGATURE MEN NOW .. ARMENIAN SMALL LIGATURE MEN XEH + (16#0FB1D#, 16#0FB1D#), -- HEBREW LETTER YOD WITH HIRIQ .. HEBREW LETTER YOD WITH HIRIQ + (16#0FB1F#, 16#0FB28#), -- HEBREW LIGATURE YIDDISH YOD YOD PATAH .. HEBREW LETTER WIDE TAV + (16#0FB2A#, 16#0FB36#), -- HEBREW LETTER SHIN WITH SHIN DOT .. HEBREW LETTER ZAYIN WITH DAGESH + (16#0FB38#, 16#0FB3C#), -- HEBREW LETTER TET WITH DAGESH .. HEBREW LETTER LAMED WITH DAGESH + (16#0FB3E#, 16#0FB3E#), -- HEBREW LETTER MEM WITH DAGESH .. HEBREW LETTER MEM WITH DAGESH + (16#0FB40#, 16#0FB41#), -- HEBREW LETTER NUN WITH DAGESH .. HEBREW LETTER SAMEKH WITH DAGESH + (16#0FB43#, 16#0FB44#), -- HEBREW LETTER FINAL PE WITH DAGESH .. HEBREW LETTER PE WITH DAGESH + (16#0FB46#, 16#0FBB1#), -- HEBREW LETTER TSADI WITH DAGESH .. ARABIC LETTER YEH BARREE WITH HAMZA ABOVE FINAL FORM + (16#0FBD3#, 16#0FD3D#), -- ARABIC LETTER NG ISOLATED FORM .. ARABIC LIGATURE ALEF WITH FATHATAN ISOLATED FORM + (16#0FD50#, 16#0FD8F#), -- ARABIC LIGATURE TEH WITH JEEM WITH MEEM INITIAL FORM .. ARABIC LIGATURE MEEM WITH KHAH WITH MEEM INITIAL FORM + (16#0FD92#, 16#0FDC7#), -- ARABIC LIGATURE MEEM WITH JEEM WITH KHAH INITIAL FORM .. ARABIC LIGATURE NOON WITH JEEM WITH YEH FINAL FORM + (16#0FDF0#, 16#0FDFB#), -- ARABIC LIGATURE SALLA USED AS KORANIC STOP SIGN ISOLATED FORM .. ARABIC LIGATURE JALLAJALALOUHOU + (16#0FE70#, 16#0FE74#), -- ARABIC FATHATAN ISOLATED FORM .. ARABIC KASRATAN ISOLATED FORM + (16#0FE76#, 16#0FEFC#), -- ARABIC FATHA ISOLATED FORM .. ARABIC LIGATURE LAM WITH ALEF FINAL FORM + (16#0FF21#, 16#0FF3A#), -- FULLWIDTH LATIN CAPITAL LETTER A .. FULLWIDTH LATIN CAPITAL LETTER Z + (16#0FF41#, 16#0FF5A#), -- FULLWIDTH LATIN SMALL LETTER A .. FULLWIDTH LATIN SMALL LETTER Z + (16#0FF66#, 16#0FFBE#), -- HALFWIDTH KATAKANA LETTER WO .. HALFWIDTH HANGUL LETTER HIEUH + (16#0FFC2#, 16#0FFC7#), -- HALFWIDTH HANGUL LETTER A .. HALFWIDTH HANGUL LETTER E + (16#0FFCA#, 16#0FFCF#), -- HALFWIDTH HANGUL LETTER YEO .. HALFWIDTH HANGUL LETTER OE + (16#0FFD2#, 16#0FFD7#), -- HALFWIDTH HANGUL LETTER YO .. HALFWIDTH HANGUL LETTER YU + (16#0FFDA#, 16#0FFDC#), -- HALFWIDTH HANGUL LETTER EU .. HALFWIDTH HANGUL LETTER I + (16#10000#, 16#1000B#), -- LINEAR B SYLLABLE B008 A .. LINEAR B SYLLABLE B046 JE + (16#1000D#, 16#10026#), -- LINEAR B SYLLABLE B036 JO .. LINEAR B SYLLABLE B032 QO + (16#10028#, 16#1003A#), -- LINEAR B SYLLABLE B060 RA .. LINEAR B SYLLABLE B042 WO + (16#1003C#, 16#1003D#), -- LINEAR B SYLLABLE B017 ZA .. LINEAR B SYLLABLE B074 ZE + (16#1003F#, 16#1004D#), -- LINEAR B SYLLABLE B020 ZO .. LINEAR B SYLLABLE B091 TWO + (16#10050#, 16#1005D#), -- LINEAR B SYMBOL B018 .. LINEAR B SYMBOL B089 + (16#10080#, 16#100FA#), -- LINEAR B IDEOGRAM B100 MAN .. LINEAR B IDEOGRAM VESSEL B305 + (16#10300#, 16#1031E#), -- OLD ITALIC LETTER A .. OLD ITALIC LETTER UU + (16#10330#, 16#1034A#), -- GOTHIC LETTER AHSA .. GOTHIC LETTER NINE HUNDRED + (16#10380#, 16#1039D#), -- UGARITIC LETTER ALPA .. UGARITIC LETTER SSU + (16#10400#, 16#1049D#), -- DESERET CAPITAL LETTER LONG I .. OSMANYA LETTER OO + (16#10800#, 16#10805#), -- CYPRIOT SYLLABLE A .. CYPRIOT SYLLABLE JA + (16#10808#, 16#10808#), -- CYPRIOT SYLLABLE JO .. CYPRIOT SYLLABLE JO + (16#1080A#, 16#10835#), -- CYPRIOT SYLLABLE KA .. CYPRIOT SYLLABLE WO + (16#10837#, 16#10838#), -- CYPRIOT SYLLABLE XA .. CYPRIOT SYLLABLE XE + (16#1083C#, 16#1083C#), -- CYPRIOT SYLLABLE ZA .. CYPRIOT SYLLABLE ZA + (16#1083F#, 16#1083F#), -- CYPRIOT SYLLABLE ZO .. CYPRIOT SYLLABLE ZO + (16#1D400#, 16#1D454#), -- MATHEMATICAL BOLD CAPITAL A .. MATHEMATICAL ITALIC SMALL G + (16#1D456#, 16#1D49C#), -- MATHEMATICAL ITALIC SMALL I .. MATHEMATICAL SCRIPT CAPITAL A + (16#1D49E#, 16#1D49F#), -- MATHEMATICAL SCRIPT CAPITAL C .. MATHEMATICAL SCRIPT CAPITAL D + (16#1D4A2#, 16#1D4A2#), -- MATHEMATICAL SCRIPT CAPITAL G .. MATHEMATICAL SCRIPT CAPITAL G + (16#1D4A5#, 16#1D4A6#), -- MATHEMATICAL SCRIPT CAPITAL J .. MATHEMATICAL SCRIPT CAPITAL K + (16#1D4A9#, 16#1D4AC#), -- MATHEMATICAL SCRIPT CAPITAL N .. MATHEMATICAL SCRIPT CAPITAL Q + (16#1D4AE#, 16#1D4B9#), -- MATHEMATICAL SCRIPT CAPITAL S .. MATHEMATICAL SCRIPT SMALL D + (16#1D4BB#, 16#1D4BB#), -- MATHEMATICAL SCRIPT SMALL F .. MATHEMATICAL SCRIPT SMALL F + (16#1D4BD#, 16#1D4C3#), -- MATHEMATICAL SCRIPT SMALL H .. MATHEMATICAL SCRIPT SMALL N + (16#1D4C5#, 16#1D505#), -- MATHEMATICAL SCRIPT SMALL P .. MATHEMATICAL FRAKTUR CAPITAL B + (16#1D507#, 16#1D50A#), -- MATHEMATICAL FRAKTUR CAPITAL D .. MATHEMATICAL FRAKTUR CAPITAL G + (16#1D50D#, 16#1D514#), -- MATHEMATICAL FRAKTUR CAPITAL J .. MATHEMATICAL FRAKTUR CAPITAL Q + (16#1D516#, 16#1D51C#), -- MATHEMATICAL FRAKTUR CAPITAL S .. MATHEMATICAL FRAKTUR CAPITAL Y + (16#1D51E#, 16#1D539#), -- MATHEMATICAL FRAKTUR SMALL A .. MATHEMATICAL DOUBLE-STRUCK CAPITAL B + (16#1D53B#, 16#1D53E#), -- MATHEMATICAL DOUBLE-STRUCK CAPITAL D .. MATHEMATICAL DOUBLE-STRUCK CAPITAL G + (16#1D540#, 16#1D544#), -- MATHEMATICAL DOUBLE-STRUCK CAPITAL I .. MATHEMATICAL DOUBLE-STRUCK CAPITAL M + (16#1D546#, 16#1D546#), -- MATHEMATICAL DOUBLE-STRUCK CAPITAL O .. MATHEMATICAL DOUBLE-STRUCK CAPITAL O + (16#1D54A#, 16#1D550#), -- MATHEMATICAL DOUBLE-STRUCK CAPITAL S .. MATHEMATICAL DOUBLE-STRUCK CAPITAL Y + (16#1D552#, 16#1D6A3#), -- MATHEMATICAL DOUBLE-STRUCK SMALL A .. MATHEMATICAL MONOSPACE SMALL Z + (16#1D6A8#, 16#1D6C0#), -- MATHEMATICAL BOLD CAPITAL ALPHA .. MATHEMATICAL BOLD CAPITAL OMEGA + (16#1D6C2#, 16#1D6DA#), -- MATHEMATICAL BOLD SMALL ALPHA .. MATHEMATICAL BOLD SMALL OMEGA + (16#1D6DC#, 16#1D6FA#), -- MATHEMATICAL BOLD EPSILON SYMBOL .. MATHEMATICAL ITALIC CAPITAL OMEGA + (16#1D6FC#, 16#1D714#), -- MATHEMATICAL ITALIC SMALL ALPHA .. MATHEMATICAL ITALIC SMALL OMEGA + (16#1D716#, 16#1D734#), -- MATHEMATICAL ITALIC EPSILON SYMBOL .. MATHEMATICAL BOLD ITALIC CAPITAL OMEGA + (16#1D736#, 16#1D74E#), -- MATHEMATICAL BOLD ITALIC SMALL ALPHA .. MATHEMATICAL BOLD ITALIC SMALL OMEGA + (16#1D750#, 16#1D76E#), -- MATHEMATICAL BOLD ITALIC EPSILON SYMBOL .. MATHEMATICAL SANS-SERIF BOLD CAPITAL OMEGA + (16#1D770#, 16#1D788#), -- MATHEMATICAL SANS-SERIF BOLD SMALL ALPHA .. MATHEMATICAL SANS-SERIF BOLD SMALL OMEGA + (16#1D78A#, 16#1D7A8#), -- MATHEMATICAL SANS-SERIF BOLD EPSILON SYMBOL .. MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL OMEGA + (16#1D7AA#, 16#1D7C2#), -- MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL ALPHA .. MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL OMEGA + (16#1D7C4#, 16#1D7C9#), -- MATHEMATICAL SANS-SERIF BOLD ITALIC EPSILON SYMBOL .. MATHEMATICAL SANS-SERIF BOLD ITALIC PI SYMBOL + (16#20000#, 16#2A6D6#), -- <CJK Ideograph Extension B, First> .. <CJK Ideograph Extension B, Last> + (16#2F800#, 16#2FA1D#)); -- CJK COMPATIBILITY IDEOGRAPH-2F800 .. CJK COMPATIBILITY IDEOGRAPH-2FA1D + + -- The following table includes all characters considered spaces, i.e. + -- all characters from the Unicode table with categories: + + -- Separator, Space (Zs) + + UTF_32_Spaces : constant UTF_32_Ranges := ( + (16#00020#, 16#00020#), -- SPACE .. SPACE + (16#000A0#, 16#000A0#), -- NO-BREAK SPACE .. NO-BREAK SPACE + (16#01680#, 16#01680#), -- OGHAM SPACE MARK .. OGHAM SPACE MARK + (16#0180E#, 16#0180E#), -- MONGOLIAN VOWEL SEPARATOR .. MONGOLIAN VOWEL SEPARATOR + (16#02000#, 16#0200B#), -- EN QUAD .. ZERO WIDTH SPACE + (16#0202F#, 16#0202F#), -- NARROW NO-BREAK SPACE .. NARROW NO-BREAK SPACE + (16#0205F#, 16#0205F#), -- MEDIUM MATHEMATICAL SPACE .. MEDIUM MATHEMATICAL SPACE + (16#03000#, 16#03000#)); -- IDEOGRAPHIC SPACE .. IDEOGRAPHIC SPACE + + -- The following table includes all characters considered punctuation, + -- i.e. all characters from the Unicode table with categories: + + -- Punctuation, Connector (Pc) + + UTF_32_Punctuation : constant UTF_32_Ranges := ( + (16#0005F#, 16#0005F#), -- LOW LINE .. LOW LINE + (16#0203F#, 16#02040#), -- UNDERTIE .. CHARACTER TIE + (16#02054#, 16#02054#), -- INVERTED UNDERTIE .. INVERTED UNDERTIE + (16#030FB#, 16#030FB#), -- KATAKANA MIDDLE DOT .. KATAKANA MIDDLE DOT + (16#0FE33#, 16#0FE34#), -- PRESENTATION FORM FOR VERTICAL LOW LINE .. PRESENTATION FORM FOR VERTICAL WAVY LOW LINE + (16#0FE4D#, 16#0FE4F#), -- DASHED LOW LINE .. WAVY LOW LINE + (16#0FF3F#, 16#0FF3F#), -- FULLWIDTH LOW LINE .. FULLWIDTH LOW LINE + (16#0FF65#, 16#0FF65#)); -- HALFWIDTH KATAKANA MIDDLE DOT .. HALFWIDTH KATAKANA MIDDLE DOT + + -- The following table includes all characters considered as other format, + -- i.e. all characters from the Unicode table with categories: + + -- Other, Format (Cf) + + UTF_32_Other_Format : constant UTF_32_Ranges := ( + (16#000AD#, 16#000AD#), -- SOFT HYPHEN .. SOFT HYPHEN + (16#00600#, 16#00603#), -- ARABIC NUMBER SIGN .. ARABIC SIGN SAFHA + (16#006DD#, 16#006DD#), -- ARABIC END OF AYAH .. ARABIC END OF AYAH + + (16#0070F#, 16#0070F#), -- SYRIAC ABBREVIATION MARK .. SYRIAC ABBREVIATION MARK + (16#017B4#, 16#017B5#), -- KHMER VOWEL INHERENT AQ .. KHMER VOWEL INHERENT AA + (16#0200C#, 16#0200F#), -- ZERO WIDTH NON-JOINER .. RIGHT-TO-LEFT MARK + (16#0202A#, 16#0202E#), -- LEFT-TO-RIGHT EMBEDDING .. RIGHT-TO-LEFT OVERRIDE + (16#02060#, 16#02063#), -- WORD JOINER .. INVISIBLE SEPARATOR + (16#0206A#, 16#0206F#), -- INHIBIT SYMMETRIC SWAPPING .. NOMINAL DIGIT SHAPES + (16#0FEFF#, 16#0FEFF#), -- ZERO WIDTH NO-BREAK SPACE .. ZERO WIDTH NO-BREAK SPACE + (16#0FFF9#, 16#0FFFB#), -- INTERLINEAR ANNOTATION ANCHOR .. INTERLINEAR ANNOTATION TERMINATOR + (16#1D173#, 16#1D17A#), -- MUSICAL SYMBOL BEGIN BEAM .. MUSICAL SYMBOL END PHRASE + (16#E0001#, 16#E0001#), -- LANGUAGE TAG .. LANGUAGE TAG + (16#E0020#, 16#E007F#)); -- TAG SPACE .. CANCEL TAG + + -- The following table includes all characters considered marks i.e. + -- all characters from the Unicode table with categories: + + -- Mark, Nonspacing (Mn) + -- Mark, Spacing Combining (Mc) + + UTF_32_Marks : constant UTF_32_Ranges := ( + (16#00300#, 16#00357#), -- COMBINING GRAVE ACCENT .. COMBINING RIGHT HALF RING ABOVE + (16#0035D#, 16#0036F#), -- COMBINING DOUBLE BREVE .. COMBINING LATIN SMALL LETTER X + (16#00483#, 16#00486#), -- COMBINING CYRILLIC TITLO .. COMBINING CYRILLIC PSILI PNEUMATA + (16#00591#, 16#005A1#), -- HEBREW ACCENT ETNAHTA .. HEBREW ACCENT PAZER + (16#005A3#, 16#005B9#), -- HEBREW ACCENT MUNAH .. HEBREW POINT HOLAM + (16#005BB#, 16#005BD#), -- HEBREW POINT QUBUTS .. HEBREW POINT METEG + (16#005BF#, 16#005BF#), -- HEBREW POINT RAFE .. HEBREW POINT RAFE + (16#005C1#, 16#005C2#), -- HEBREW POINT SHIN DOT .. HEBREW POINT SIN DOT + (16#005C4#, 16#005C4#), -- HEBREW MARK UPPER DOT .. HEBREW MARK UPPER DOT + (16#00610#, 16#00615#), -- ARABIC SIGN SALLALLAHOU ALAYHE WASSALLAM .. ARABIC SMALL HIGH TAH + (16#0064B#, 16#00658#), -- ARABIC FATHATAN .. ARABIC MARK NOON GHUNNA + (16#00670#, 16#00670#), -- ARABIC LETTER SUPERSCRIPT ALEF .. ARABIC LETTER SUPERSCRIPT ALEF + (16#006D6#, 16#006DC#), -- ARABIC SMALL HIGH LIGATURE SAD WITH LAM WITH ALEF MAKSURA .. ARABIC SMALL HIGH SEEN + (16#006DF#, 16#006E4#), -- ARABIC SMALL HIGH ROUNDED ZERO .. ARABIC SMALL HIGH MADDA + (16#006E7#, 16#006E8#), -- ARABIC SMALL HIGH YEH .. ARABIC SMALL HIGH NOON + (16#006EA#, 16#006ED#), -- ARABIC EMPTY CENTRE LOW STOP .. ARABIC SMALL LOW MEEM + (16#00711#, 16#00711#), -- SYRIAC LETTER SUPERSCRIPT ALAPH .. SYRIAC LETTER SUPERSCRIPT ALAPH + (16#00730#, 16#0074A#), -- SYRIAC PTHAHA ABOVE .. SYRIAC BARREKH + (16#007A6#, 16#007B0#), -- THAANA ABAFILI .. THAANA SUKUN + (16#00901#, 16#00903#), -- DEVANAGARI SIGN CANDRABINDU .. DEVANAGARI SIGN VISARGA + (16#0093C#, 16#0093C#), -- DEVANAGARI SIGN NUKTA .. DEVANAGARI SIGN NUKTA + (16#0093E#, 16#0094D#), -- DEVANAGARI VOWEL SIGN AA .. DEVANAGARI SIGN VIRAMA + (16#00951#, 16#00954#), -- DEVANAGARI STRESS SIGN UDATTA .. DEVANAGARI ACUTE ACCENT + (16#00962#, 16#00963#), -- DEVANAGARI VOWEL SIGN VOCALIC L .. DEVANAGARI VOWEL SIGN VOCALIC LL + (16#00981#, 16#00983#), -- BENGALI SIGN CANDRABINDU .. BENGALI SIGN VISARGA + (16#009BC#, 16#009BC#), -- BENGALI SIGN NUKTA .. BENGALI SIGN NUKTA + (16#009BE#, 16#009C4#), -- BENGALI VOWEL SIGN AA .. BENGALI VOWEL SIGN VOCALIC RR + (16#009C7#, 16#009C8#), -- BENGALI VOWEL SIGN E .. BENGALI VOWEL SIGN AI + (16#009CB#, 16#009CD#), -- BENGALI VOWEL SIGN O .. BENGALI SIGN VIRAMA + (16#009D7#, 16#009D7#), -- BENGALI AU LENGTH MARK .. BENGALI AU LENGTH MARK + (16#009E2#, 16#009E3#), -- BENGALI VOWEL SIGN VOCALIC L .. BENGALI VOWEL SIGN VOCALIC LL + (16#00A01#, 16#00A03#), -- GURMUKHI SIGN ADAK BINDI .. GURMUKHI SIGN VISARGA + (16#00A3C#, 16#00A3C#), -- GURMUKHI SIGN NUKTA .. GURMUKHI SIGN NUKTA + (16#00A3E#, 16#00A42#), -- GURMUKHI VOWEL SIGN AA .. GURMUKHI VOWEL SIGN UU + (16#00A47#, 16#00A48#), -- GURMUKHI VOWEL SIGN EE .. GURMUKHI VOWEL SIGN AI + (16#00A4B#, 16#00A4D#), -- GURMUKHI VOWEL SIGN OO .. GURMUKHI SIGN VIRAMA + (16#00A70#, 16#00A71#), -- GURMUKHI TIPPI .. GURMUKHI ADDAK + (16#00A81#, 16#00A83#), -- GUJARATI SIGN CANDRABINDU .. GUJARATI SIGN VISARGA + (16#00ABC#, 16#00ABC#), -- GUJARATI SIGN NUKTA .. GUJARATI SIGN NUKTA + (16#00ABE#, 16#00AC5#), -- GUJARATI VOWEL SIGN AA .. GUJARATI VOWEL SIGN CANDRA E + (16#00AC7#, 16#00AC9#), -- GUJARATI VOWEL SIGN E .. GUJARATI VOWEL SIGN CANDRA O + (16#00ACB#, 16#00ACD#), -- GUJARATI VOWEL SIGN O .. GUJARATI SIGN VIRAMA + (16#00AE2#, 16#00AE3#), -- GUJARATI VOWEL SIGN VOCALIC L .. GUJARATI VOWEL SIGN VOCALIC LL + (16#00B01#, 16#00B03#), -- ORIYA SIGN CANDRABINDU .. ORIYA SIGN VISARGA + (16#00B3C#, 16#00B3C#), -- ORIYA SIGN NUKTA .. ORIYA SIGN NUKTA + (16#00B3E#, 16#00B43#), -- ORIYA VOWEL SIGN AA .. ORIYA VOWEL SIGN VOCALIC R + (16#00B47#, 16#00B48#), -- ORIYA VOWEL SIGN E .. ORIYA VOWEL SIGN AI + (16#00B4B#, 16#00B4D#), -- ORIYA VOWEL SIGN O .. ORIYA SIGN VIRAMA + (16#00B56#, 16#00B57#), -- ORIYA AI LENGTH MARK .. ORIYA AU LENGTH MARK + (16#00B82#, 16#00B82#), -- TAMIL SIGN ANUSVARA .. TAMIL SIGN ANUSVARA + (16#00BBE#, 16#00BC2#), -- TAMIL VOWEL SIGN AA .. TAMIL VOWEL SIGN UU + (16#00BC6#, 16#00BC8#), -- TAMIL VOWEL SIGN E .. TAMIL VOWEL SIGN AI + (16#00BCA#, 16#00BCD#), -- TAMIL VOWEL SIGN O .. TAMIL SIGN VIRAMA + (16#00BD7#, 16#00BD7#), -- TAMIL AU LENGTH MARK .. TAMIL AU LENGTH MARK + (16#00C01#, 16#00C03#), -- TELUGU SIGN CANDRABINDU .. TELUGU SIGN VISARGA + (16#00C3E#, 16#00C44#), -- TELUGU VOWEL SIGN AA .. TELUGU VOWEL SIGN VOCALIC RR + (16#00C46#, 16#00C48#), -- TELUGU VOWEL SIGN E .. TELUGU VOWEL SIGN AI + (16#00C4A#, 16#00C4D#), -- TELUGU VOWEL SIGN O .. TELUGU SIGN VIRAMA + (16#00C55#, 16#00C56#), -- TELUGU LENGTH MARK .. TELUGU AI LENGTH MARK + (16#00C82#, 16#00C83#), -- KANNADA SIGN ANUSVARA .. KANNADA SIGN VISARGA + (16#00CBC#, 16#00CBC#), -- KANNADA SIGN NUKTA .. KANNADA SIGN NUKTA + (16#00CBE#, 16#00CC4#), -- KANNADA VOWEL SIGN AA .. KANNADA VOWEL SIGN VOCALIC RR + (16#00CC6#, 16#00CC8#), -- KANNADA VOWEL SIGN E .. KANNADA VOWEL SIGN AI + (16#00CCA#, 16#00CCD#), -- KANNADA VOWEL SIGN O .. KANNADA SIGN VIRAMA + (16#00CD5#, 16#00CD6#), -- KANNADA LENGTH MARK .. KANNADA AI LENGTH MARK + (16#00D02#, 16#00D03#), -- MALAYALAM SIGN ANUSVARA .. MALAYALAM SIGN VISARGA + (16#00D3E#, 16#00D43#), -- MALAYALAM VOWEL SIGN AA .. MALAYALAM VOWEL SIGN VOCALIC R + (16#00D46#, 16#00D48#), -- MALAYALAM VOWEL SIGN E .. MALAYALAM VOWEL SIGN AI + (16#00D4A#, 16#00D4D#), -- MALAYALAM VOWEL SIGN O .. MALAYALAM SIGN VIRAMA + (16#00D57#, 16#00D57#), -- MALAYALAM AU LENGTH MARK .. MALAYALAM AU LENGTH MARK + (16#00D82#, 16#00D83#), -- SINHALA SIGN ANUSVARAYA .. SINHALA SIGN VISARGAYA + (16#00DCA#, 16#00DCA#), -- SINHALA SIGN AL-LAKUNA .. SINHALA SIGN AL-LAKUNA + (16#00DCF#, 16#00DD4#), -- SINHALA VOWEL SIGN AELA-PILLA .. SINHALA VOWEL SIGN KETTI PAA-PILLA + (16#00DD6#, 16#00DD6#), -- SINHALA VOWEL SIGN DIGA PAA-PILLA .. SINHALA VOWEL SIGN DIGA PAA-PILLA + (16#00DD8#, 16#00DDF#), -- SINHALA VOWEL SIGN GAETTA-PILLA .. SINHALA VOWEL SIGN GAYANUKITTA + (16#00DF2#, 16#00DF3#), -- SINHALA VOWEL SIGN DIGA GAETTA-PILLA .. SINHALA VOWEL SIGN DIGA GAYANUKITTA + (16#00E31#, 16#00E31#), -- THAI CHARACTER MAI HAN-AKAT .. THAI CHARACTER MAI HAN-AKAT + (16#00E34#, 16#00E3A#), -- THAI CHARACTER SARA I .. THAI CHARACTER PHINTHU + (16#00E47#, 16#00E4E#), -- THAI CHARACTER MAITAIKHU .. THAI CHARACTER YAMAKKAN + (16#00EB1#, 16#00EB1#), -- LAO VOWEL SIGN MAI KAN .. LAO VOWEL SIGN MAI KAN + (16#00EB4#, 16#00EB9#), -- LAO VOWEL SIGN I .. LAO VOWEL SIGN UU + (16#00EBB#, 16#00EBC#), -- LAO VOWEL SIGN MAI KON .. LAO SEMIVOWEL SIGN LO + (16#00EC8#, 16#00ECD#), -- LAO TONE MAI EK .. LAO NIGGAHITA + (16#00F18#, 16#00F19#), -- TIBETAN ASTROLOGICAL SIGN -KHYUD PA .. TIBETAN ASTROLOGICAL SIGN SDONG TSHUGS + (16#00F35#, 16#00F35#), -- TIBETAN MARK NGAS BZUNG NYI ZLA .. TIBETAN MARK NGAS BZUNG NYI ZLA + (16#00F37#, 16#00F37#), -- TIBETAN MARK NGAS BZUNG SGOR RTAGS .. TIBETAN MARK NGAS BZUNG SGOR RTAGS + (16#00F39#, 16#00F39#), -- TIBETAN MARK TSA -PHRU .. TIBETAN MARK TSA -PHRU + (16#00F3E#, 16#00F3F#), -- TIBETAN SIGN YAR TSHES .. TIBETAN SIGN MAR TSHES + (16#00F71#, 16#00F84#), -- TIBETAN VOWEL SIGN AA .. TIBETAN MARK HALANTA + (16#00F86#, 16#00F87#), -- TIBETAN SIGN LCI RTAGS .. TIBETAN SIGN YANG RTAGS + (16#00F90#, 16#00F97#), -- TIBETAN SUBJOINED LETTER KA .. TIBETAN SUBJOINED LETTER JA + (16#00F99#, 16#00FBC#), -- TIBETAN SUBJOINED LETTER NYA .. TIBETAN SUBJOINED LETTER FIXED-FORM RA + (16#00FC6#, 16#00FC6#), -- TIBETAN SYMBOL PADMA GDAN .. TIBETAN SYMBOL PADMA GDAN + (16#0102C#, 16#01032#), -- MYANMAR VOWEL SIGN AA .. MYANMAR VOWEL SIGN AI + (16#01036#, 16#01039#), -- MYANMAR SIGN ANUSVARA .. MYANMAR SIGN VIRAMA + (16#01056#, 16#01059#), -- MYANMAR VOWEL SIGN VOCALIC R .. MYANMAR VOWEL SIGN VOCALIC LL + (16#01712#, 16#01714#), -- TAGALOG VOWEL SIGN I .. TAGALOG SIGN VIRAMA + (16#01732#, 16#01734#), -- HANUNOO VOWEL SIGN I .. HANUNOO SIGN PAMUDPOD + (16#01752#, 16#01753#), -- BUHID VOWEL SIGN I .. BUHID VOWEL SIGN U + (16#01772#, 16#01773#), -- TAGBANWA VOWEL SIGN I .. TAGBANWA VOWEL SIGN U + (16#017B6#, 16#017D3#), -- KHMER VOWEL SIGN AA .. KHMER SIGN BATHAMASAT + (16#017DD#, 16#017DD#), -- KHMER SIGN ATTHACAN .. KHMER SIGN ATTHACAN + (16#0180B#, 16#0180D#), -- MONGOLIAN FREE VARIATION SELECTOR ONE .. MONGOLIAN FREE VARIATION SELECTOR THREE + (16#018A9#, 16#018A9#), -- MONGOLIAN LETTER ALI GALI DAGALGA .. MONGOLIAN LETTER ALI GALI DAGALGA + (16#01920#, 16#0192B#), -- LIMBU VOWEL SIGN A .. LIMBU SUBJOINED LETTER WA + (16#01930#, 16#0193B#), -- LIMBU SMALL LETTER KA .. LIMBU SIGN SA-I + (16#020D0#, 16#020DC#), -- COMBINING LEFT HARPOON ABOVE .. COMBINING FOUR DOTS ABOVE + (16#020E1#, 16#020E1#), -- COMBINING LEFT RIGHT ARROW ABOVE .. COMBINING LEFT RIGHT ARROW ABOVE + (16#020E5#, 16#020EA#), -- COMBINING REVERSE SOLIDUS OVERLAY .. COMBINING LEFTWARDS ARROW OVERLAY + (16#0302A#, 16#0302F#), -- IDEOGRAPHIC LEVEL TONE MARK .. HANGUL DOUBLE DOT TONE MARK + (16#03099#, 16#0309A#), -- COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK .. COMBINING KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK + (16#0FB1E#, 16#0FB1E#), -- HEBREW POINT JUDEO-SPANISH VARIKA .. HEBREW POINT JUDEO-SPANISH VARIKA + (16#0FE00#, 16#0FE0F#), -- VARIATION SELECTOR-1 .. VARIATION SELECTOR-16 + (16#0FE20#, 16#0FE23#), -- COMBINING LIGATURE LEFT HALF .. COMBINING DOUBLE TILDE RIGHT HALF + (16#1D165#, 16#1D169#), -- MUSICAL SYMBOL COMBINING STEM .. MUSICAL SYMBOL COMBINING TREMOLO-3 + (16#1D16D#, 16#1D172#), -- MUSICAL SYMBOL COMBINING AUGMENTATION DOT .. MUSICAL SYMBOL COMBINING FLAG-5 + (16#1D17B#, 16#1D182#), -- MUSICAL SYMBOL COMBINING ACCENT .. MUSICAL SYMBOL COMBINING LOURE + (16#1D185#, 16#1D18B#), -- MUSICAL SYMBOL COMBINING DOIT .. MUSICAL SYMBOL COMBINING TRIPLE TONGUE + (16#1D1AA#, 16#1D1AD#), -- MUSICAL SYMBOL COMBINING DOWN BOW .. MUSICAL SYMBOL COMBINING SNAP PIZZICATO + (16#E0100#, 16#E01EF#)); -- VARIATION SELECTOR-17 .. VARIATION SELECTOR-256 + + -- The following table includes all characters considered non-graphic, + -- i.e. all characters from the Unicode table with categories: + + -- Other, Control (Cc) + -- Other, Private Use (Co) + -- Other, Surrogate (Cs) + -- Other, Format (Cf) + -- Separator, Line (Zl) + -- Separator, Paragraph (Zp) + + -- In addition, the characters FFFE and FFFF are excluded. Note that the + -- defined Ada category of format effector is subsumed by the above set + -- of Unicode categories. + + UTF_32_Non_Graphic : constant UTF_32_Ranges := ( + (16#00000#, 16#0001F#), -- <control> .. <control> + (16#0007F#, 16#0009F#), -- <control> .. <control> + (16#000AD#, 16#000AD#), -- SOFT HYPHEN .. SOFT HYPHEN + (16#00600#, 16#00603#), -- ARABIC NUMBER SIGN .. ARABIC SIGN SAFHA + (16#006DD#, 16#006DD#), -- ARABIC END OF AYAH .. ARABIC END OF AYAH + (16#0070F#, 16#0070F#), -- SYRIAC ABBREVIATION MARK .. SYRIAC ABBREVIATION MARK + (16#017B4#, 16#017B5#), -- KHMER VOWEL INHERENT AQ .. KHMER VOWEL INHERENT AA + (16#0200C#, 16#0200F#), -- ZERO WIDTH NON-JOINER .. RIGHT-TO-LEFT MARK + (16#02028#, 16#0202E#), -- LINE SEPARATOR .. RIGHT-TO-LEFT OVERRIDE + (16#02060#, 16#02063#), -- WORD JOINER .. INVISIBLE SEPARATOR + (16#0206A#, 16#0206F#), -- INHIBIT SYMMETRIC SWAPPING .. NOMINAL DIGIT SHAPES + (16#0D800#, 16#0F8FF#), -- <Non Private Use High Surrogate, First> .. <Private Use, Last> + (16#0FEFF#, 16#0FEFF#), -- ZERO WIDTH NO-BREAK SPACE .. ZERO WIDTH NO-BREAK SPACE + (16#0FFF9#, 16#0FFFB#), -- INTERLINEAR ANNOTATION ANCHOR .. INTERLINEAR ANNOTATION TERMINATOR + (16#0FFFE#, 16#0FFFF#), -- excluded code positions + (16#1D173#, 16#1D17A#), -- MUSICAL SYMBOL BEGIN BEAM .. MUSICAL SYMBOL END PHRASE + (16#E0001#, 16#E0001#), -- LANGUAGE TAG .. LANGUAGE TAG + (16#E0020#, 16#E007F#), -- TAG SPACE .. CANCEL TAG + (16#F0000#, 16#FFFFD#), -- <Plane 15 Private Use, First> .. <Plane 15 Private Use, Last> + (16#100000#, 16#10FFFD#)); -- <Plane 16 Private Use, First> .. <Plane 16 Private Use, Last> + + -- The following two tables define the mapping to upper case. The first + -- table gives the ranges of lower case letters. The corresponding entry + -- in Uppercase_Adjust shows the amount to be added (or subtracted) from + -- the code value to get the corresponding upper case letter. + + -- Note that this folding is not reversible, for example lower case + -- dotless i folds to normal upper case I, and that cannot be reversed. + + Lower_Case_Letters : constant UTF_32_Ranges := ( + (16#00061#, 16#0007A#), -- LATIN SMALL LETTER A .. LATIN SMALL LETTER Z + (16#000B5#, 16#000B5#), -- MICRO SIGN .. MICRO SIGN + (16#000E0#, 16#000F6#), -- LATIN SMALL LETTER A WITH GRAVE .. LATIN SMALL LETTER O WITH DIAERESIS + (16#000F8#, 16#000FE#), -- LATIN SMALL LETTER O WITH STROKE .. LATIN SMALL LETTER THORN + (16#000FF#, 16#000FF#), -- LATIN SMALL LETTER Y WITH DIAERESIS .. LATIN SMALL LETTER Y WITH DIAERESIS + (16#00101#, 16#00101#), -- LATIN SMALL LETTER A WITH MACRON .. LATIN SMALL LETTER A WITH MACRON + (16#00103#, 16#00103#), -- LATIN SMALL LETTER A WITH BREVE .. LATIN SMALL LETTER A WITH BREVE + (16#00105#, 16#00105#), -- LATIN SMALL LETTER A WITH OGONEK .. LATIN SMALL LETTER A WITH OGONEK + (16#00107#, 16#00107#), -- LATIN SMALL LETTER C WITH ACUTE .. LATIN SMALL LETTER C WITH ACUTE + (16#00109#, 16#00109#), -- LATIN SMALL LETTER C WITH CIRCUMFLEX .. LATIN SMALL LETTER C WITH CIRCUMFLEX + (16#0010B#, 16#0010B#), -- LATIN SMALL LETTER C WITH DOT ABOVE .. LATIN SMALL LETTER C WITH DOT ABOVE + (16#0010D#, 16#0010D#), -- LATIN SMALL LETTER C WITH CARON .. LATIN SMALL LETTER C WITH CARON + (16#0010F#, 16#0010F#), -- LATIN SMALL LETTER D WITH CARON .. LATIN SMALL LETTER D WITH CARON + (16#00111#, 16#00111#), -- LATIN SMALL LETTER D WITH STROKE .. LATIN SMALL LETTER D WITH STROKE + (16#00113#, 16#00113#), -- LATIN SMALL LETTER E WITH MACRON .. LATIN SMALL LETTER E WITH MACRON + (16#00115#, 16#00115#), -- LATIN SMALL LETTER E WITH BREVE .. LATIN SMALL LETTER E WITH BREVE + (16#00117#, 16#00117#), -- LATIN SMALL LETTER E WITH DOT ABOVE .. LATIN SMALL LETTER E WITH DOT ABOVE + (16#00119#, 16#00119#), -- LATIN SMALL LETTER E WITH OGONEK .. LATIN SMALL LETTER E WITH OGONEK + (16#0011B#, 16#0011B#), -- LATIN SMALL LETTER E WITH CARON .. LATIN SMALL LETTER E WITH CARON + (16#0011D#, 16#0011D#), -- LATIN SMALL LETTER G WITH CIRCUMFLEX .. LATIN SMALL LETTER G WITH CIRCUMFLEX + (16#0011F#, 16#0011F#), -- LATIN SMALL LETTER G WITH BREVE .. LATIN SMALL LETTER G WITH BREVE + (16#00121#, 16#00121#), -- LATIN SMALL LETTER G WITH DOT ABOVE .. LATIN SMALL LETTER G WITH DOT ABOVE + (16#00123#, 16#00123#), -- LATIN SMALL LETTER G WITH CEDILLA .. LATIN SMALL LETTER G WITH CEDILLA + (16#00125#, 16#00125#), -- LATIN SMALL LETTER H WITH CIRCUMFLEX .. LATIN SMALL LETTER H WITH CIRCUMFLEX + (16#00127#, 16#00127#), -- LATIN SMALL LETTER H WITH STROKE .. LATIN SMALL LETTER H WITH STROKE + (16#00129#, 16#00129#), -- LATIN SMALL LETTER I WITH TILDE .. LATIN SMALL LETTER I WITH TILDE + (16#0012B#, 16#0012B#), -- LATIN SMALL LETTER I WITH MACRON .. LATIN SMALL LETTER I WITH MACRON + (16#0012D#, 16#0012D#), -- LATIN SMALL LETTER I WITH BREVE .. LATIN SMALL LETTER I WITH BREVE + (16#0012F#, 16#0012F#), -- LATIN SMALL LETTER I WITH OGONEK .. LATIN SMALL LETTER I WITH OGONEK + (16#00131#, 16#00131#), -- LATIN SMALL LETTER DOTLESS I .. LATIN SMALL LETTER DOTLESS I + (16#00133#, 16#00133#), -- LATIN SMALL LIGATURE IJ .. LATIN SMALL LIGATURE IJ + (16#00135#, 16#00135#), -- LATIN SMALL LETTER J WITH CIRCUMFLEX .. LATIN SMALL LETTER J WITH CIRCUMFLEX + (16#00137#, 16#00137#), -- LATIN SMALL LETTER K WITH CEDILLA .. LATIN SMALL LETTER K WITH CEDILLA + (16#0013A#, 16#0013A#), -- LATIN SMALL LETTER L WITH ACUTE .. LATIN SMALL LETTER L WITH ACUTE + (16#0013C#, 16#0013C#), -- LATIN SMALL LETTER L WITH CEDILLA .. LATIN SMALL LETTER L WITH CEDILLA + (16#0013E#, 16#0013E#), -- LATIN SMALL LETTER L WITH CARON .. LATIN SMALL LETTER L WITH CARON + (16#00140#, 16#00140#), -- LATIN SMALL LETTER L WITH MIDDLE DOT .. LATIN SMALL LETTER L WITH MIDDLE DOT + (16#00142#, 16#00142#), -- LATIN SMALL LETTER L WITH STROKE .. LATIN SMALL LETTER L WITH STROKE + (16#00144#, 16#00144#), -- LATIN SMALL LETTER N WITH ACUTE .. LATIN SMALL LETTER N WITH ACUTE + (16#00146#, 16#00146#), -- LATIN SMALL LETTER N WITH CEDILLA .. LATIN SMALL LETTER N WITH CEDILLA + (16#00148#, 16#00148#), -- LATIN SMALL LETTER N WITH CARON .. LATIN SMALL LETTER N WITH CARON + (16#0014B#, 16#0014B#), -- LATIN SMALL LETTER ENG .. LATIN SMALL LETTER ENG + (16#0014D#, 16#0014D#), -- LATIN SMALL LETTER O WITH MACRON .. LATIN SMALL LETTER O WITH MACRON + (16#0014F#, 16#0014F#), -- LATIN SMALL LETTER O WITH BREVE .. LATIN SMALL LETTER O WITH BREVE + (16#00151#, 16#00151#), -- LATIN SMALL LETTER O WITH DOUBLE ACUTE .. LATIN SMALL LETTER O WITH DOUBLE ACUTE + (16#00153#, 16#00153#), -- LATIN SMALL LIGATURE OE .. LATIN SMALL LIGATURE OE + (16#00155#, 16#00155#), -- LATIN SMALL LETTER R WITH ACUTE .. LATIN SMALL LETTER R WITH ACUTE + (16#00157#, 16#00157#), -- LATIN SMALL LETTER R WITH CEDILLA .. LATIN SMALL LETTER R WITH CEDILLA + (16#00159#, 16#00159#), -- LATIN SMALL LETTER R WITH CARON .. LATIN SMALL LETTER R WITH CARON + (16#0015B#, 16#0015B#), -- LATIN SMALL LETTER S WITH ACUTE .. LATIN SMALL LETTER S WITH ACUTE + (16#0015D#, 16#0015D#), -- LATIN SMALL LETTER S WITH CIRCUMFLEX .. LATIN SMALL LETTER S WITH CIRCUMFLEX + (16#0015F#, 16#0015F#), -- LATIN SMALL LETTER S WITH CEDILLA .. LATIN SMALL LETTER S WITH CEDILLA + (16#00161#, 16#00161#), -- LATIN SMALL LETTER S WITH CARON .. LATIN SMALL LETTER S WITH CARON + (16#00163#, 16#00163#), -- LATIN SMALL LETTER T WITH CEDILLA .. LATIN SMALL LETTER T WITH CEDILLA + (16#00165#, 16#00165#), -- LATIN SMALL LETTER T WITH CARON .. LATIN SMALL LETTER T WITH CARON + (16#00167#, 16#00167#), -- LATIN SMALL LETTER T WITH STROKE .. LATIN SMALL LETTER T WITH STROKE + (16#00169#, 16#00169#), -- LATIN SMALL LETTER U WITH TILDE .. LATIN SMALL LETTER U WITH TILDE + (16#0016B#, 16#0016B#), -- LATIN SMALL LETTER U WITH MACRON .. LATIN SMALL LETTER U WITH MACRON + (16#0016D#, 16#0016D#), -- LATIN SMALL LETTER U WITH BREVE .. LATIN SMALL LETTER U WITH BREVE + (16#0016F#, 16#0016F#), -- LATIN SMALL LETTER U WITH RING ABOVE .. LATIN SMALL LETTER U WITH RING ABOVE + (16#00171#, 16#00171#), -- LATIN SMALL LETTER U WITH DOUBLE ACUTE .. LATIN SMALL LETTER U WITH DOUBLE ACUTE + (16#00173#, 16#00173#), -- LATIN SMALL LETTER U WITH OGONEK .. LATIN SMALL LETTER U WITH OGONEK + (16#00175#, 16#00175#), -- LATIN SMALL LETTER W WITH CIRCUMFLEX .. LATIN SMALL LETTER W WITH CIRCUMFLEX + (16#00177#, 16#00177#), -- LATIN SMALL LETTER Y WITH CIRCUMFLEX .. LATIN SMALL LETTER Y WITH CIRCUMFLEX + (16#0017A#, 16#0017A#), -- LATIN SMALL LETTER Z WITH ACUTE .. LATIN SMALL LETTER Z WITH ACUTE + (16#0017C#, 16#0017C#), -- LATIN SMALL LETTER Z WITH DOT ABOVE .. LATIN SMALL LETTER Z WITH DOT ABOVE + (16#0017E#, 16#0017E#), -- LATIN SMALL LETTER Z WITH CARON .. LATIN SMALL LETTER Z WITH CARON + (16#0017F#, 16#0017F#), -- LATIN SMALL LETTER LONG S .. LATIN SMALL LETTER LONG S + (16#00183#, 16#00183#), -- LATIN SMALL LETTER B WITH TOPBAR .. LATIN SMALL LETTER B WITH TOPBAR + (16#00185#, 16#00185#), -- LATIN SMALL LETTER TONE SIX .. LATIN SMALL LETTER TONE SIX + (16#00188#, 16#00188#), -- LATIN SMALL LETTER C WITH HOOK .. LATIN SMALL LETTER C WITH HOOK + (16#0018C#, 16#0018C#), -- LATIN SMALL LETTER D WITH TOPBAR .. LATIN SMALL LETTER D WITH TOPBAR + (16#00192#, 16#00192#), -- LATIN SMALL LETTER F WITH HOOK .. LATIN SMALL LETTER F WITH HOOK + (16#00195#, 16#00195#), -- LATIN SMALL LETTER HV .. LATIN SMALL LETTER HV + (16#00199#, 16#00199#), -- LATIN SMALL LETTER K WITH HOOK .. LATIN SMALL LETTER K WITH HOOK + (16#0019E#, 16#0019E#), -- LATIN SMALL LETTER N WITH LONG RIGHT LEG .. LATIN SMALL LETTER N WITH LONG RIGHT LEG + (16#001A1#, 16#001A1#), -- LATIN SMALL LETTER O WITH HORN .. LATIN SMALL LETTER O WITH HORN + (16#001A3#, 16#001A3#), -- LATIN SMALL LETTER OI .. LATIN SMALL LETTER OI + (16#001A5#, 16#001A5#), -- LATIN SMALL LETTER P WITH HOOK .. LATIN SMALL LETTER P WITH HOOK + (16#001A8#, 16#001A8#), -- LATIN SMALL LETTER TONE TWO .. LATIN SMALL LETTER TONE TWO + (16#001AD#, 16#001AD#), -- LATIN SMALL LETTER T WITH HOOK .. LATIN SMALL LETTER T WITH HOOK + (16#001B0#, 16#001B0#), -- LATIN SMALL LETTER U WITH HORN .. LATIN SMALL LETTER U WITH HORN + (16#001B4#, 16#001B4#), -- LATIN SMALL LETTER Y WITH HOOK .. LATIN SMALL LETTER Y WITH HOOK + (16#001B6#, 16#001B6#), -- LATIN SMALL LETTER Z WITH STROKE .. LATIN SMALL LETTER Z WITH STROKE + (16#001B9#, 16#001B9#), -- LATIN SMALL LETTER EZH REVERSED .. LATIN SMALL LETTER EZH REVERSED + (16#001BD#, 16#001BD#), -- LATIN SMALL LETTER TONE FIVE .. LATIN SMALL LETTER TONE FIVE + (16#001BF#, 16#001BF#), -- LATIN LETTER WYNN .. LATIN LETTER WYNN + (16#001C5#, 16#001C5#), -- LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON + (16#001C6#, 16#001C6#), -- LATIN SMALL LETTER DZ WITH CARON .. LATIN SMALL LETTER DZ WITH CARON + (16#001C8#, 16#001C8#), -- LATIN CAPITAL LETTER L WITH SMALL LETTER J .. LATIN CAPITAL LETTER L WITH SMALL LETTER J + (16#001C9#, 16#001C9#), -- LATIN SMALL LETTER LJ .. LATIN SMALL LETTER LJ + (16#001CB#, 16#001CB#), -- LATIN CAPITAL LETTER N WITH SMALL LETTER J .. LATIN CAPITAL LETTER N WITH SMALL LETTER J + (16#001CC#, 16#001CC#), -- LATIN SMALL LETTER NJ .. LATIN SMALL LETTER NJ + (16#001CE#, 16#001CE#), -- LATIN SMALL LETTER A WITH CARON .. LATIN SMALL LETTER A WITH CARON + (16#001D0#, 16#001D0#), -- LATIN SMALL LETTER I WITH CARON .. LATIN SMALL LETTER I WITH CARON + (16#001D2#, 16#001D2#), -- LATIN SMALL LETTER O WITH CARON .. LATIN SMALL LETTER O WITH CARON + (16#001D4#, 16#001D4#), -- LATIN SMALL LETTER U WITH CARON .. LATIN SMALL LETTER U WITH CARON + (16#001D6#, 16#001D6#), -- LATIN SMALL LETTER U WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER U WITH DIAERESIS AND MACRON + (16#001D8#, 16#001D8#), -- LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE + (16#001DA#, 16#001DA#), -- LATIN SMALL LETTER U WITH DIAERESIS AND CARON .. LATIN SMALL LETTER U WITH DIAERESIS AND CARON + (16#001DC#, 16#001DC#), -- LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE .. LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE + (16#001DD#, 16#001DD#), -- LATIN SMALL LETTER TURNED E .. LATIN SMALL LETTER TURNED E + (16#001DF#, 16#001DF#), -- LATIN SMALL LETTER A WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER A WITH DIAERESIS AND MACRON + (16#001E1#, 16#001E1#), -- LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON + (16#001E3#, 16#001E3#), -- LATIN SMALL LETTER AE WITH MACRON .. LATIN SMALL LETTER AE WITH MACRON + (16#001E5#, 16#001E5#), -- LATIN SMALL LETTER G WITH STROKE .. LATIN SMALL LETTER G WITH STROKE + (16#001E7#, 16#001E7#), -- LATIN SMALL LETTER G WITH CARON .. LATIN SMALL LETTER G WITH CARON + (16#001E9#, 16#001E9#), -- LATIN SMALL LETTER K WITH CARON .. LATIN SMALL LETTER K WITH CARON + (16#001EB#, 16#001EB#), -- LATIN SMALL LETTER O WITH OGONEK .. LATIN SMALL LETTER O WITH OGONEK + (16#001ED#, 16#001ED#), -- LATIN SMALL LETTER O WITH OGONEK AND MACRON .. LATIN SMALL LETTER O WITH OGONEK AND MACRON + (16#001EF#, 16#001EF#), -- LATIN SMALL LETTER EZH WITH CARON .. LATIN SMALL LETTER EZH WITH CARON + (16#001F2#, 16#001F2#), -- LATIN CAPITAL LETTER D WITH SMALL LETTER Z .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z + (16#001F3#, 16#001F3#), -- LATIN SMALL LETTER DZ .. LATIN SMALL LETTER DZ + (16#001F5#, 16#001F5#), -- LATIN SMALL LETTER G WITH ACUTE .. LATIN SMALL LETTER G WITH ACUTE + (16#001F9#, 16#001F9#), -- LATIN SMALL LETTER N WITH GRAVE .. LATIN SMALL LETTER N WITH GRAVE + (16#001FB#, 16#001FB#), -- LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE .. LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE + (16#001FD#, 16#001FD#), -- LATIN SMALL LETTER AE WITH ACUTE .. LATIN SMALL LETTER AE WITH ACUTE + (16#001FF#, 16#001FF#), -- LATIN SMALL LETTER O WITH STROKE AND ACUTE .. LATIN SMALL LETTER O WITH STROKE AND ACUTE + (16#00201#, 16#00201#), -- LATIN SMALL LETTER A WITH DOUBLE GRAVE .. LATIN SMALL LETTER A WITH DOUBLE GRAVE + (16#00203#, 16#00203#), -- LATIN SMALL LETTER A WITH INVERTED BREVE .. LATIN SMALL LETTER A WITH INVERTED BREVE + (16#00205#, 16#00205#), -- LATIN SMALL LETTER E WITH DOUBLE GRAVE .. LATIN SMALL LETTER E WITH DOUBLE GRAVE + (16#00207#, 16#00207#), -- LATIN SMALL LETTER E WITH INVERTED BREVE .. LATIN SMALL LETTER E WITH INVERTED BREVE + (16#00209#, 16#00209#), -- LATIN SMALL LETTER I WITH DOUBLE GRAVE .. LATIN SMALL LETTER I WITH DOUBLE GRAVE + (16#0020B#, 16#0020B#), -- LATIN SMALL LETTER I WITH INVERTED BREVE .. LATIN SMALL LETTER I WITH INVERTED BREVE + (16#0020D#, 16#0020D#), -- LATIN SMALL LETTER O WITH DOUBLE GRAVE .. LATIN SMALL LETTER O WITH DOUBLE GRAVE + (16#0020F#, 16#0020F#), -- LATIN SMALL LETTER O WITH INVERTED BREVE .. LATIN SMALL LETTER O WITH INVERTED BREVE + (16#00211#, 16#00211#), -- LATIN SMALL LETTER R WITH DOUBLE GRAVE .. LATIN SMALL LETTER R WITH DOUBLE GRAVE + (16#00213#, 16#00213#), -- LATIN SMALL LETTER R WITH INVERTED BREVE .. LATIN SMALL LETTER R WITH INVERTED BREVE + (16#00215#, 16#00215#), -- LATIN SMALL LETTER U WITH DOUBLE GRAVE .. LATIN SMALL LETTER U WITH DOUBLE GRAVE + (16#00217#, 16#00217#), -- LATIN SMALL LETTER U WITH INVERTED BREVE .. LATIN SMALL LETTER U WITH INVERTED BREVE + (16#00219#, 16#00219#), -- LATIN SMALL LETTER S WITH COMMA BELOW .. LATIN SMALL LETTER S WITH COMMA BELOW + (16#0021B#, 16#0021B#), -- LATIN SMALL LETTER T WITH COMMA BELOW .. LATIN SMALL LETTER T WITH COMMA BELOW + (16#0021D#, 16#0021D#), -- LATIN SMALL LETTER YOGH .. LATIN SMALL LETTER YOGH + (16#0021F#, 16#0021F#), -- LATIN SMALL LETTER H WITH CARON .. LATIN SMALL LETTER H WITH CARON + (16#00223#, 16#00223#), -- LATIN SMALL LETTER OU .. LATIN SMALL LETTER OU + (16#00225#, 16#00225#), -- LATIN SMALL LETTER Z WITH HOOK .. LATIN SMALL LETTER Z WITH HOOK + (16#00227#, 16#00227#), -- LATIN SMALL LETTER A WITH DOT ABOVE .. LATIN SMALL LETTER A WITH DOT ABOVE + (16#00229#, 16#00229#), -- LATIN SMALL LETTER E WITH CEDILLA .. LATIN SMALL LETTER E WITH CEDILLA + (16#0022B#, 16#0022B#), -- LATIN SMALL LETTER O WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER O WITH DIAERESIS AND MACRON + (16#0022D#, 16#0022D#), -- LATIN SMALL LETTER O WITH TILDE AND MACRON .. LATIN SMALL LETTER O WITH TILDE AND MACRON + (16#0022F#, 16#0022F#), -- LATIN SMALL LETTER O WITH DOT ABOVE .. LATIN SMALL LETTER O WITH DOT ABOVE + (16#00231#, 16#00231#), -- LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON + (16#00233#, 16#00233#), -- LATIN SMALL LETTER Y WITH MACRON .. LATIN SMALL LETTER Y WITH MACRON + (16#00253#, 16#00253#), -- LATIN SMALL LETTER B WITH HOOK .. LATIN SMALL LETTER B WITH HOOK + (16#00254#, 16#00254#), -- LATIN SMALL LETTER OPEN O .. LATIN SMALL LETTER OPEN O + (16#00256#, 16#00257#), -- LATIN SMALL LETTER D WITH TAIL .. LATIN SMALL LETTER D WITH HOOK + (16#00259#, 16#00259#), -- LATIN SMALL LETTER SCHWA .. LATIN SMALL LETTER SCHWA + (16#0025B#, 16#0025B#), -- LATIN SMALL LETTER OPEN E .. LATIN SMALL LETTER OPEN E + (16#00260#, 16#00260#), -- LATIN SMALL LETTER G WITH HOOK .. LATIN SMALL LETTER G WITH HOOK + (16#00263#, 16#00263#), -- LATIN SMALL LETTER GAMMA .. LATIN SMALL LETTER GAMMA + (16#00268#, 16#00268#), -- LATIN SMALL LETTER I WITH STROKE .. LATIN SMALL LETTER I WITH STROKE + (16#00269#, 16#00269#), -- LATIN SMALL LETTER IOTA .. LATIN SMALL LETTER IOTA + (16#0026F#, 16#0026F#), -- LATIN SMALL LETTER TURNED M .. LATIN SMALL LETTER TURNED M + (16#00272#, 16#00272#), -- LATIN SMALL LETTER N WITH LEFT HOOK .. LATIN SMALL LETTER N WITH LEFT HOOK + (16#00275#, 16#00275#), -- LATIN SMALL LETTER BARRED O .. LATIN SMALL LETTER BARRED O + (16#00280#, 16#00280#), -- LATIN LETTER SMALL CAPITAL R .. LATIN LETTER SMALL CAPITAL R + (16#00283#, 16#00283#), -- LATIN SMALL LETTER ESH .. LATIN SMALL LETTER ESH + (16#00288#, 16#00288#), -- LATIN SMALL LETTER T WITH RETROFLEX HOOK .. LATIN SMALL LETTER T WITH RETROFLEX HOOK + (16#0028A#, 16#0028B#), -- LATIN SMALL LETTER UPSILON .. LATIN SMALL LETTER V WITH HOOK + (16#00292#, 16#00292#), -- LATIN SMALL LETTER EZH .. LATIN SMALL LETTER EZH + (16#003AC#, 16#003AC#), -- GREEK SMALL LETTER ALPHA WITH TONOS .. GREEK SMALL LETTER ALPHA WITH TONOS + (16#003AD#, 16#003AF#), -- GREEK SMALL LETTER EPSILON WITH TONOS .. GREEK SMALL LETTER IOTA WITH TONOS + (16#003B1#, 16#003C1#), -- GREEK SMALL LETTER ALPHA .. GREEK SMALL LETTER RHO + (16#003C2#, 16#003C2#), -- GREEK SMALL LETTER FINAL SIGMA .. GREEK SMALL LETTER FINAL SIGMA + (16#003C3#, 16#003CB#), -- GREEK SMALL LETTER SIGMA .. GREEK SMALL LETTER UPSILON WITH DIALYTIKA + (16#003CC#, 16#003CC#), -- GREEK SMALL LETTER OMICRON WITH TONOS .. GREEK SMALL LETTER OMICRON WITH TONOS + (16#003CD#, 16#003CE#), -- GREEK SMALL LETTER UPSILON WITH TONOS .. GREEK SMALL LETTER OMEGA WITH TONOS + (16#003D0#, 16#003D0#), -- GREEK BETA SYMBOL .. GREEK BETA SYMBOL + (16#003D1#, 16#003D1#), -- GREEK THETA SYMBOL .. GREEK THETA SYMBOL + (16#003D5#, 16#003D5#), -- GREEK PHI SYMBOL .. GREEK PHI SYMBOL + (16#003D6#, 16#003D6#), -- GREEK PI SYMBOL .. GREEK PI SYMBOL + (16#003D9#, 16#003D9#), -- GREEK SMALL LETTER ARCHAIC KOPPA .. GREEK SMALL LETTER ARCHAIC KOPPA + (16#003DB#, 16#003DB#), -- GREEK SMALL LETTER STIGMA .. GREEK SMALL LETTER STIGMA + (16#003DD#, 16#003DD#), -- GREEK SMALL LETTER DIGAMMA .. GREEK SMALL LETTER DIGAMMA + (16#003DF#, 16#003DF#), -- GREEK SMALL LETTER KOPPA .. GREEK SMALL LETTER KOPPA + (16#003E1#, 16#003E1#), -- GREEK SMALL LETTER SAMPI .. GREEK SMALL LETTER SAMPI + (16#003E3#, 16#003E3#), -- COPTIC SMALL LETTER SHEI .. COPTIC SMALL LETTER SHEI + (16#003E5#, 16#003E5#), -- COPTIC SMALL LETTER FEI .. COPTIC SMALL LETTER FEI + (16#003E7#, 16#003E7#), -- COPTIC SMALL LETTER KHEI .. COPTIC SMALL LETTER KHEI + (16#003E9#, 16#003E9#), -- COPTIC SMALL LETTER HORI .. COPTIC SMALL LETTER HORI + (16#003EB#, 16#003EB#), -- COPTIC SMALL LETTER GANGIA .. COPTIC SMALL LETTER GANGIA + (16#003ED#, 16#003ED#), -- COPTIC SMALL LETTER SHIMA .. COPTIC SMALL LETTER SHIMA + (16#003EF#, 16#003EF#), -- COPTIC SMALL LETTER DEI .. COPTIC SMALL LETTER DEI + (16#003F0#, 16#003F0#), -- GREEK KAPPA SYMBOL .. GREEK KAPPA SYMBOL + (16#003F1#, 16#003F1#), -- GREEK RHO SYMBOL .. GREEK RHO SYMBOL + (16#003F2#, 16#003F2#), -- GREEK LUNATE SIGMA SYMBOL .. GREEK LUNATE SIGMA SYMBOL + (16#003F5#, 16#003F5#), -- GREEK LUNATE EPSILON SYMBOL .. GREEK LUNATE EPSILON SYMBOL + (16#00430#, 16#0044F#), -- CYRILLIC SMALL LETTER A .. CYRILLIC SMALL LETTER YA + (16#00450#, 16#0045F#), -- CYRILLIC SMALL LETTER IE WITH GRAVE .. CYRILLIC SMALL LETTER DZHE + (16#00461#, 16#00461#), -- CYRILLIC SMALL LETTER OMEGA .. CYRILLIC SMALL LETTER OMEGA + (16#00463#, 16#00463#), -- CYRILLIC SMALL LETTER YAT .. CYRILLIC SMALL LETTER YAT + (16#00465#, 16#00465#), -- CYRILLIC SMALL LETTER IOTIFIED E .. CYRILLIC SMALL LETTER IOTIFIED E + (16#00467#, 16#00467#), -- CYRILLIC SMALL LETTER LITTLE YUS .. CYRILLIC SMALL LETTER LITTLE YUS + (16#00469#, 16#00469#), -- CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS .. CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS + (16#0046B#, 16#0046B#), -- CYRILLIC SMALL LETTER BIG YUS .. CYRILLIC SMALL LETTER BIG YUS + (16#0046D#, 16#0046D#), -- CYRILLIC SMALL LETTER IOTIFIED BIG YUS .. CYRILLIC SMALL LETTER IOTIFIED BIG YUS + (16#0046F#, 16#0046F#), -- CYRILLIC SMALL LETTER KSI .. CYRILLIC SMALL LETTER KSI + (16#00471#, 16#00471#), -- CYRILLIC SMALL LETTER PSI .. CYRILLIC SMALL LETTER PSI + (16#00473#, 16#00473#), -- CYRILLIC SMALL LETTER FITA .. CYRILLIC SMALL LETTER FITA + (16#00475#, 16#00475#), -- CYRILLIC SMALL LETTER IZHITSA .. CYRILLIC SMALL LETTER IZHITSA + (16#00477#, 16#00477#), -- CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT .. CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT + (16#00479#, 16#00479#), -- CYRILLIC SMALL LETTER UK .. CYRILLIC SMALL LETTER UK + (16#0047B#, 16#0047B#), -- CYRILLIC SMALL LETTER ROUND OMEGA .. CYRILLIC SMALL LETTER ROUND OMEGA + (16#0047D#, 16#0047D#), -- CYRILLIC SMALL LETTER OMEGA WITH TITLO .. CYRILLIC SMALL LETTER OMEGA WITH TITLO + (16#0047F#, 16#0047F#), -- CYRILLIC SMALL LETTER OT .. CYRILLIC SMALL LETTER OT + (16#00481#, 16#00481#), -- CYRILLIC SMALL LETTER KOPPA .. CYRILLIC SMALL LETTER KOPPA + (16#0048B#, 16#0048B#), -- CYRILLIC SMALL LETTER SHORT I WITH TAIL .. CYRILLIC SMALL LETTER SHORT I WITH TAIL + (16#0048D#, 16#0048D#), -- CYRILLIC SMALL LETTER SEMISOFT SIGN .. CYRILLIC SMALL LETTER SEMISOFT SIGN + (16#0048F#, 16#0048F#), -- CYRILLIC SMALL LETTER ER WITH TICK .. CYRILLIC SMALL LETTER ER WITH TICK + (16#00491#, 16#00491#), -- CYRILLIC SMALL LETTER GHE WITH UPTURN .. CYRILLIC SMALL LETTER GHE WITH UPTURN + (16#00493#, 16#00493#), -- CYRILLIC SMALL LETTER GHE WITH STROKE .. CYRILLIC SMALL LETTER GHE WITH STROKE + (16#00495#, 16#00495#), -- CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK + (16#00497#, 16#00497#), -- CYRILLIC SMALL LETTER ZHE WITH DESCENDER .. CYRILLIC SMALL LETTER ZHE WITH DESCENDER + (16#00499#, 16#00499#), -- CYRILLIC SMALL LETTER ZE WITH DESCENDER .. CYRILLIC SMALL LETTER ZE WITH DESCENDER + (16#0049B#, 16#0049B#), -- CYRILLIC SMALL LETTER KA WITH DESCENDER .. CYRILLIC SMALL LETTER KA WITH DESCENDER + (16#0049D#, 16#0049D#), -- CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE + (16#0049F#, 16#0049F#), -- CYRILLIC SMALL LETTER KA WITH STROKE .. CYRILLIC SMALL LETTER KA WITH STROKE + (16#004A1#, 16#004A1#), -- CYRILLIC SMALL LETTER BASHKIR KA .. CYRILLIC SMALL LETTER BASHKIR KA + (16#004A3#, 16#004A3#), -- CYRILLIC SMALL LETTER EN WITH DESCENDER .. CYRILLIC SMALL LETTER EN WITH DESCENDER + (16#004A5#, 16#004A5#), -- CYRILLIC SMALL LIGATURE EN GHE .. CYRILLIC SMALL LIGATURE EN GHE + (16#004A7#, 16#004A7#), -- CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK + (16#004A9#, 16#004A9#), -- CYRILLIC SMALL LETTER ABKHASIAN HA .. CYRILLIC SMALL LETTER ABKHASIAN HA + (16#004AB#, 16#004AB#), -- CYRILLIC SMALL LETTER ES WITH DESCENDER .. CYRILLIC SMALL LETTER ES WITH DESCENDER + (16#004AD#, 16#004AD#), -- CYRILLIC SMALL LETTER TE WITH DESCENDER .. CYRILLIC SMALL LETTER TE WITH DESCENDER + (16#004AF#, 16#004AF#), -- CYRILLIC SMALL LETTER STRAIGHT U .. CYRILLIC SMALL LETTER STRAIGHT U + (16#004B1#, 16#004B1#), -- CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE .. CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE + (16#004B3#, 16#004B3#), -- CYRILLIC SMALL LETTER HA WITH DESCENDER .. CYRILLIC SMALL LETTER HA WITH DESCENDER + (16#004B5#, 16#004B5#), -- CYRILLIC SMALL LIGATURE TE TSE .. CYRILLIC SMALL LIGATURE TE TSE + (16#004B7#, 16#004B7#), -- CYRILLIC SMALL LETTER CHE WITH DESCENDER .. CYRILLIC SMALL LETTER CHE WITH DESCENDER + (16#004B9#, 16#004B9#), -- CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE + (16#004BB#, 16#004BB#), -- CYRILLIC SMALL LETTER SHHA .. CYRILLIC SMALL LETTER SHHA + (16#004BD#, 16#004BD#), -- CYRILLIC SMALL LETTER ABKHASIAN CHE .. CYRILLIC SMALL LETTER ABKHASIAN CHE + (16#004BF#, 16#004BF#), -- CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER .. CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER + (16#004C2#, 16#004C2#), -- CYRILLIC SMALL LETTER ZHE WITH BREVE .. CYRILLIC SMALL LETTER ZHE WITH BREVE + (16#004C4#, 16#004C4#), -- CYRILLIC SMALL LETTER KA WITH HOOK .. CYRILLIC SMALL LETTER KA WITH HOOK + (16#004C6#, 16#004C6#), -- CYRILLIC SMALL LETTER EL WITH TAIL .. CYRILLIC SMALL LETTER EL WITH TAIL + (16#004C8#, 16#004C8#), -- CYRILLIC SMALL LETTER EN WITH HOOK .. CYRILLIC SMALL LETTER EN WITH HOOK + (16#004CA#, 16#004CA#), -- CYRILLIC SMALL LETTER EN WITH TAIL .. CYRILLIC SMALL LETTER EN WITH TAIL + (16#004CC#, 16#004CC#), -- CYRILLIC SMALL LETTER KHAKASSIAN CHE .. CYRILLIC SMALL LETTER KHAKASSIAN CHE + (16#004CE#, 16#004CE#), -- CYRILLIC SMALL LETTER EM WITH TAIL .. CYRILLIC SMALL LETTER EM WITH TAIL + (16#004D1#, 16#004D1#), -- CYRILLIC SMALL LETTER A WITH BREVE .. CYRILLIC SMALL LETTER A WITH BREVE + (16#004D3#, 16#004D3#), -- CYRILLIC SMALL LETTER A WITH DIAERESIS .. CYRILLIC SMALL LETTER A WITH DIAERESIS + (16#004D5#, 16#004D5#), -- CYRILLIC SMALL LIGATURE A IE .. CYRILLIC SMALL LIGATURE A IE + (16#004D7#, 16#004D7#), -- CYRILLIC SMALL LETTER IE WITH BREVE .. CYRILLIC SMALL LETTER IE WITH BREVE + (16#004D9#, 16#004D9#), -- CYRILLIC SMALL LETTER SCHWA .. CYRILLIC SMALL LETTER SCHWA + (16#004DB#, 16#004DB#), -- CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS .. CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS + (16#004DD#, 16#004DD#), -- CYRILLIC SMALL LETTER ZHE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZHE WITH DIAERESIS + (16#004DF#, 16#004DF#), -- CYRILLIC SMALL LETTER ZE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZE WITH DIAERESIS + (16#004E1#, 16#004E1#), -- CYRILLIC SMALL LETTER ABKHASIAN DZE .. CYRILLIC SMALL LETTER ABKHASIAN DZE + (16#004E3#, 16#004E3#), -- CYRILLIC SMALL LETTER I WITH MACRON .. CYRILLIC SMALL LETTER I WITH MACRON + (16#004E5#, 16#004E5#), -- CYRILLIC SMALL LETTER I WITH DIAERESIS .. CYRILLIC SMALL LETTER I WITH DIAERESIS + (16#004E7#, 16#004E7#), -- CYRILLIC SMALL LETTER O WITH DIAERESIS .. CYRILLIC SMALL LETTER O WITH DIAERESIS + (16#004E9#, 16#004E9#), -- CYRILLIC SMALL LETTER BARRED O .. CYRILLIC SMALL LETTER BARRED O + (16#004EB#, 16#004EB#), -- CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS .. CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS + (16#004ED#, 16#004ED#), -- CYRILLIC SMALL LETTER E WITH DIAERESIS .. CYRILLIC SMALL LETTER E WITH DIAERESIS + (16#004EF#, 16#004EF#), -- CYRILLIC SMALL LETTER U WITH MACRON .. CYRILLIC SMALL LETTER U WITH MACRON + (16#004F1#, 16#004F1#), -- CYRILLIC SMALL LETTER U WITH DIAERESIS .. CYRILLIC SMALL LETTER U WITH DIAERESIS + (16#004F3#, 16#004F3#), -- CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE .. CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE + (16#004F5#, 16#004F5#), -- CYRILLIC SMALL LETTER CHE WITH DIAERESIS .. CYRILLIC SMALL LETTER CHE WITH DIAERESIS + (16#004F9#, 16#004F9#), -- CYRILLIC SMALL LETTER YERU WITH DIAERESIS .. CYRILLIC SMALL LETTER YERU WITH DIAERESIS + (16#00501#, 16#00501#), -- CYRILLIC SMALL LETTER KOMI DE .. CYRILLIC SMALL LETTER KOMI DE + (16#00503#, 16#00503#), -- CYRILLIC SMALL LETTER KOMI DJE .. CYRILLIC SMALL LETTER KOMI DJE + (16#00505#, 16#00505#), -- CYRILLIC SMALL LETTER KOMI ZJE .. CYRILLIC SMALL LETTER KOMI ZJE + (16#00507#, 16#00507#), -- CYRILLIC SMALL LETTER KOMI DZJE .. CYRILLIC SMALL LETTER KOMI DZJE + (16#00509#, 16#00509#), -- CYRILLIC SMALL LETTER KOMI LJE .. CYRILLIC SMALL LETTER KOMI LJE + (16#0050B#, 16#0050B#), -- CYRILLIC SMALL LETTER KOMI NJE .. CYRILLIC SMALL LETTER KOMI NJE + (16#0050D#, 16#0050D#), -- CYRILLIC SMALL LETTER KOMI SJE .. CYRILLIC SMALL LETTER KOMI SJE + (16#0050F#, 16#0050F#), -- CYRILLIC SMALL LETTER KOMI TJE .. CYRILLIC SMALL LETTER KOMI TJE + (16#00561#, 16#00586#), -- ARMENIAN SMALL LETTER AYB .. ARMENIAN SMALL LETTER FEH + (16#01E01#, 16#01E01#), -- LATIN SMALL LETTER A WITH RING BELOW .. LATIN SMALL LETTER A WITH RING BELOW + (16#01E03#, 16#01E03#), -- LATIN SMALL LETTER B WITH DOT ABOVE .. LATIN SMALL LETTER B WITH DOT ABOVE + (16#01E05#, 16#01E05#), -- LATIN SMALL LETTER B WITH DOT BELOW .. LATIN SMALL LETTER B WITH DOT BELOW + (16#01E07#, 16#01E07#), -- LATIN SMALL LETTER B WITH LINE BELOW .. LATIN SMALL LETTER B WITH LINE BELOW + (16#01E09#, 16#01E09#), -- LATIN SMALL LETTER C WITH CEDILLA AND ACUTE .. LATIN SMALL LETTER C WITH CEDILLA AND ACUTE + (16#01E0B#, 16#01E0B#), -- LATIN SMALL LETTER D WITH DOT ABOVE .. LATIN SMALL LETTER D WITH DOT ABOVE + (16#01E0D#, 16#01E0D#), -- LATIN SMALL LETTER D WITH DOT BELOW .. LATIN SMALL LETTER D WITH DOT BELOW + (16#01E0F#, 16#01E0F#), -- LATIN SMALL LETTER D WITH LINE BELOW .. LATIN SMALL LETTER D WITH LINE BELOW + (16#01E11#, 16#01E11#), -- LATIN SMALL LETTER D WITH CEDILLA .. LATIN SMALL LETTER D WITH CEDILLA + (16#01E13#, 16#01E13#), -- LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW + (16#01E15#, 16#01E15#), -- LATIN SMALL LETTER E WITH MACRON AND GRAVE .. LATIN SMALL LETTER E WITH MACRON AND GRAVE + (16#01E17#, 16#01E17#), -- LATIN SMALL LETTER E WITH MACRON AND ACUTE .. LATIN SMALL LETTER E WITH MACRON AND ACUTE + (16#01E19#, 16#01E19#), -- LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW + (16#01E1B#, 16#01E1B#), -- LATIN SMALL LETTER E WITH TILDE BELOW .. LATIN SMALL LETTER E WITH TILDE BELOW + (16#01E1D#, 16#01E1D#), -- LATIN SMALL LETTER E WITH CEDILLA AND BREVE .. LATIN SMALL LETTER E WITH CEDILLA AND BREVE + (16#01E1F#, 16#01E1F#), -- LATIN SMALL LETTER F WITH DOT ABOVE .. LATIN SMALL LETTER F WITH DOT ABOVE + (16#01E21#, 16#01E21#), -- LATIN SMALL LETTER G WITH MACRON .. LATIN SMALL LETTER G WITH MACRON + (16#01E23#, 16#01E23#), -- LATIN SMALL LETTER H WITH DOT ABOVE .. LATIN SMALL LETTER H WITH DOT ABOVE + (16#01E25#, 16#01E25#), -- LATIN SMALL LETTER H WITH DOT BELOW .. LATIN SMALL LETTER H WITH DOT BELOW + (16#01E27#, 16#01E27#), -- LATIN SMALL LETTER H WITH DIAERESIS .. LATIN SMALL LETTER H WITH DIAERESIS + (16#01E29#, 16#01E29#), -- LATIN SMALL LETTER H WITH CEDILLA .. LATIN SMALL LETTER H WITH CEDILLA + (16#01E2B#, 16#01E2B#), -- LATIN SMALL LETTER H WITH BREVE BELOW .. LATIN SMALL LETTER H WITH BREVE BELOW + (16#01E2D#, 16#01E2D#), -- LATIN SMALL LETTER I WITH TILDE BELOW .. LATIN SMALL LETTER I WITH TILDE BELOW + (16#01E2F#, 16#01E2F#), -- LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE + (16#01E31#, 16#01E31#), -- LATIN SMALL LETTER K WITH ACUTE .. LATIN SMALL LETTER K WITH ACUTE + (16#01E33#, 16#01E33#), -- LATIN SMALL LETTER K WITH DOT BELOW .. LATIN SMALL LETTER K WITH DOT BELOW + (16#01E35#, 16#01E35#), -- LATIN SMALL LETTER K WITH LINE BELOW .. LATIN SMALL LETTER K WITH LINE BELOW + (16#01E37#, 16#01E37#), -- LATIN SMALL LETTER L WITH DOT BELOW .. LATIN SMALL LETTER L WITH DOT BELOW + (16#01E39#, 16#01E39#), -- LATIN SMALL LETTER L WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER L WITH DOT BELOW AND MACRON + (16#01E3B#, 16#01E3B#), -- LATIN SMALL LETTER L WITH LINE BELOW .. LATIN SMALL LETTER L WITH LINE BELOW + (16#01E3D#, 16#01E3D#), -- LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW + (16#01E3F#, 16#01E3F#), -- LATIN SMALL LETTER M WITH ACUTE .. LATIN SMALL LETTER M WITH ACUTE + (16#01E41#, 16#01E41#), -- LATIN SMALL LETTER M WITH DOT ABOVE .. LATIN SMALL LETTER M WITH DOT ABOVE + (16#01E43#, 16#01E43#), -- LATIN SMALL LETTER M WITH DOT BELOW .. LATIN SMALL LETTER M WITH DOT BELOW + (16#01E45#, 16#01E45#), -- LATIN SMALL LETTER N WITH DOT ABOVE .. LATIN SMALL LETTER N WITH DOT ABOVE + (16#01E47#, 16#01E47#), -- LATIN SMALL LETTER N WITH DOT BELOW .. LATIN SMALL LETTER N WITH DOT BELOW + (16#01E49#, 16#01E49#), -- LATIN SMALL LETTER N WITH LINE BELOW .. LATIN SMALL LETTER N WITH LINE BELOW + (16#01E4B#, 16#01E4B#), -- LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW + (16#01E4D#, 16#01E4D#), -- LATIN SMALL LETTER O WITH TILDE AND ACUTE .. LATIN SMALL LETTER O WITH TILDE AND ACUTE + (16#01E4F#, 16#01E4F#), -- LATIN SMALL LETTER O WITH TILDE AND DIAERESIS .. LATIN SMALL LETTER O WITH TILDE AND DIAERESIS + (16#01E51#, 16#01E51#), -- LATIN SMALL LETTER O WITH MACRON AND GRAVE .. LATIN SMALL LETTER O WITH MACRON AND GRAVE + (16#01E53#, 16#01E53#), -- LATIN SMALL LETTER O WITH MACRON AND ACUTE .. LATIN SMALL LETTER O WITH MACRON AND ACUTE + (16#01E55#, 16#01E55#), -- LATIN SMALL LETTER P WITH ACUTE .. LATIN SMALL LETTER P WITH ACUTE + (16#01E57#, 16#01E57#), -- LATIN SMALL LETTER P WITH DOT ABOVE .. LATIN SMALL LETTER P WITH DOT ABOVE + (16#01E59#, 16#01E59#), -- LATIN SMALL LETTER R WITH DOT ABOVE .. LATIN SMALL LETTER R WITH DOT ABOVE + (16#01E5B#, 16#01E5B#), -- LATIN SMALL LETTER R WITH DOT BELOW .. LATIN SMALL LETTER R WITH DOT BELOW + (16#01E5D#, 16#01E5D#), -- LATIN SMALL LETTER R WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER R WITH DOT BELOW AND MACRON + (16#01E5F#, 16#01E5F#), -- LATIN SMALL LETTER R WITH LINE BELOW .. LATIN SMALL LETTER R WITH LINE BELOW + (16#01E61#, 16#01E61#), -- LATIN SMALL LETTER S WITH DOT ABOVE .. LATIN SMALL LETTER S WITH DOT ABOVE + (16#01E63#, 16#01E63#), -- LATIN SMALL LETTER S WITH DOT BELOW .. LATIN SMALL LETTER S WITH DOT BELOW + (16#01E65#, 16#01E65#), -- LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE .. LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE + (16#01E67#, 16#01E67#), -- LATIN SMALL LETTER S WITH CARON AND DOT ABOVE .. LATIN SMALL LETTER S WITH CARON AND DOT ABOVE + (16#01E69#, 16#01E69#), -- LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE .. LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE + (16#01E6B#, 16#01E6B#), -- LATIN SMALL LETTER T WITH DOT ABOVE .. LATIN SMALL LETTER T WITH DOT ABOVE + (16#01E6D#, 16#01E6D#), -- LATIN SMALL LETTER T WITH DOT BELOW .. LATIN SMALL LETTER T WITH DOT BELOW + (16#01E6F#, 16#01E6F#), -- LATIN SMALL LETTER T WITH LINE BELOW .. LATIN SMALL LETTER T WITH LINE BELOW + (16#01E71#, 16#01E71#), -- LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW + (16#01E73#, 16#01E73#), -- LATIN SMALL LETTER U WITH DIAERESIS BELOW .. LATIN SMALL LETTER U WITH DIAERESIS BELOW + (16#01E75#, 16#01E75#), -- LATIN SMALL LETTER U WITH TILDE BELOW .. LATIN SMALL LETTER U WITH TILDE BELOW + (16#01E77#, 16#01E77#), -- LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW + (16#01E79#, 16#01E79#), -- LATIN SMALL LETTER U WITH TILDE AND ACUTE .. LATIN SMALL LETTER U WITH TILDE AND ACUTE + (16#01E7B#, 16#01E7B#), -- LATIN SMALL LETTER U WITH MACRON AND DIAERESIS .. LATIN SMALL LETTER U WITH MACRON AND DIAERESIS + (16#01E7D#, 16#01E7D#), -- LATIN SMALL LETTER V WITH TILDE .. LATIN SMALL LETTER V WITH TILDE + (16#01E7F#, 16#01E7F#), -- LATIN SMALL LETTER V WITH DOT BELOW .. LATIN SMALL LETTER V WITH DOT BELOW + (16#01E81#, 16#01E81#), -- LATIN SMALL LETTER W WITH GRAVE .. LATIN SMALL LETTER W WITH GRAVE + (16#01E83#, 16#01E83#), -- LATIN SMALL LETTER W WITH ACUTE .. LATIN SMALL LETTER W WITH ACUTE + (16#01E85#, 16#01E85#), -- LATIN SMALL LETTER W WITH DIAERESIS .. LATIN SMALL LETTER W WITH DIAERESIS + (16#01E87#, 16#01E87#), -- LATIN SMALL LETTER W WITH DOT ABOVE .. LATIN SMALL LETTER W WITH DOT ABOVE + (16#01E89#, 16#01E89#), -- LATIN SMALL LETTER W WITH DOT BELOW .. LATIN SMALL LETTER W WITH DOT BELOW + (16#01E8B#, 16#01E8B#), -- LATIN SMALL LETTER X WITH DOT ABOVE .. LATIN SMALL LETTER X WITH DOT ABOVE + (16#01E8D#, 16#01E8D#), -- LATIN SMALL LETTER X WITH DIAERESIS .. LATIN SMALL LETTER X WITH DIAERESIS + (16#01E8F#, 16#01E8F#), -- LATIN SMALL LETTER Y WITH DOT ABOVE .. LATIN SMALL LETTER Y WITH DOT ABOVE + (16#01E91#, 16#01E91#), -- LATIN SMALL LETTER Z WITH CIRCUMFLEX .. LATIN SMALL LETTER Z WITH CIRCUMFLEX + (16#01E93#, 16#01E93#), -- LATIN SMALL LETTER Z WITH DOT BELOW .. LATIN SMALL LETTER Z WITH DOT BELOW + (16#01E95#, 16#01E95#), -- LATIN SMALL LETTER Z WITH LINE BELOW .. LATIN SMALL LETTER Z WITH LINE BELOW + (16#01E9B#, 16#01E9B#), -- LATIN SMALL LETTER LONG S WITH DOT ABOVE .. LATIN SMALL LETTER LONG S WITH DOT ABOVE + (16#01EA1#, 16#01EA1#), -- LATIN SMALL LETTER A WITH DOT BELOW .. LATIN SMALL LETTER A WITH DOT BELOW + (16#01EA3#, 16#01EA3#), -- LATIN SMALL LETTER A WITH HOOK ABOVE .. LATIN SMALL LETTER A WITH HOOK ABOVE + (16#01EA5#, 16#01EA5#), -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE + (16#01EA7#, 16#01EA7#), -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE + (16#01EA9#, 16#01EA9#), -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE + (16#01EAB#, 16#01EAB#), -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE + (16#01EAD#, 16#01EAD#), -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW + (16#01EAF#, 16#01EAF#), -- LATIN SMALL LETTER A WITH BREVE AND ACUTE .. LATIN SMALL LETTER A WITH BREVE AND ACUTE + (16#01EB1#, 16#01EB1#), -- LATIN SMALL LETTER A WITH BREVE AND GRAVE .. LATIN SMALL LETTER A WITH BREVE AND GRAVE + (16#01EB3#, 16#01EB3#), -- LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE .. LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE + (16#01EB5#, 16#01EB5#), -- LATIN SMALL LETTER A WITH BREVE AND TILDE .. LATIN SMALL LETTER A WITH BREVE AND TILDE + (16#01EB7#, 16#01EB7#), -- LATIN SMALL LETTER A WITH BREVE AND DOT BELOW .. LATIN SMALL LETTER A WITH BREVE AND DOT BELOW + (16#01EB9#, 16#01EB9#), -- LATIN SMALL LETTER E WITH DOT BELOW .. LATIN SMALL LETTER E WITH DOT BELOW + (16#01EBB#, 16#01EBB#), -- LATIN SMALL LETTER E WITH HOOK ABOVE .. LATIN SMALL LETTER E WITH HOOK ABOVE + (16#01EBD#, 16#01EBD#), -- LATIN SMALL LETTER E WITH TILDE .. LATIN SMALL LETTER E WITH TILDE + (16#01EBF#, 16#01EBF#), -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE + (16#01EC1#, 16#01EC1#), -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE + (16#01EC3#, 16#01EC3#), -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE + (16#01EC5#, 16#01EC5#), -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE + (16#01EC7#, 16#01EC7#), -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW + (16#01EC9#, 16#01EC9#), -- LATIN SMALL LETTER I WITH HOOK ABOVE .. LATIN SMALL LETTER I WITH HOOK ABOVE + (16#01ECB#, 16#01ECB#), -- LATIN SMALL LETTER I WITH DOT BELOW .. LATIN SMALL LETTER I WITH DOT BELOW + (16#01ECD#, 16#01ECD#), -- LATIN SMALL LETTER O WITH DOT BELOW .. LATIN SMALL LETTER O WITH DOT BELOW + (16#01ECF#, 16#01ECF#), -- LATIN SMALL LETTER O WITH HOOK ABOVE .. LATIN SMALL LETTER O WITH HOOK ABOVE + (16#01ED1#, 16#01ED1#), -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE + (16#01ED3#, 16#01ED3#), -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE + (16#01ED5#, 16#01ED5#), -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE + (16#01ED7#, 16#01ED7#), -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE + (16#01ED9#, 16#01ED9#), -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW + (16#01EDB#, 16#01EDB#), -- LATIN SMALL LETTER O WITH HORN AND ACUTE .. LATIN SMALL LETTER O WITH HORN AND ACUTE + (16#01EDD#, 16#01EDD#), -- LATIN SMALL LETTER O WITH HORN AND GRAVE .. LATIN SMALL LETTER O WITH HORN AND GRAVE + (16#01EDF#, 16#01EDF#), -- LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE + (16#01EE1#, 16#01EE1#), -- LATIN SMALL LETTER O WITH HORN AND TILDE .. LATIN SMALL LETTER O WITH HORN AND TILDE + (16#01EE3#, 16#01EE3#), -- LATIN SMALL LETTER O WITH HORN AND DOT BELOW .. LATIN SMALL LETTER O WITH HORN AND DOT BELOW + (16#01EE5#, 16#01EE5#), -- LATIN SMALL LETTER U WITH DOT BELOW .. LATIN SMALL LETTER U WITH DOT BELOW + (16#01EE7#, 16#01EE7#), -- LATIN SMALL LETTER U WITH HOOK ABOVE .. LATIN SMALL LETTER U WITH HOOK ABOVE + (16#01EE9#, 16#01EE9#), -- LATIN SMALL LETTER U WITH HORN AND ACUTE .. LATIN SMALL LETTER U WITH HORN AND ACUTE + (16#01EEB#, 16#01EEB#), -- LATIN SMALL LETTER U WITH HORN AND GRAVE .. LATIN SMALL LETTER U WITH HORN AND GRAVE + (16#01EED#, 16#01EED#), -- LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE + (16#01EEF#, 16#01EEF#), -- LATIN SMALL LETTER U WITH HORN AND TILDE .. LATIN SMALL LETTER U WITH HORN AND TILDE + (16#01EF1#, 16#01EF1#), -- LATIN SMALL LETTER U WITH HORN AND DOT BELOW .. LATIN SMALL LETTER U WITH HORN AND DOT BELOW + (16#01EF3#, 16#01EF3#), -- LATIN SMALL LETTER Y WITH GRAVE .. LATIN SMALL LETTER Y WITH GRAVE + (16#01EF5#, 16#01EF5#), -- LATIN SMALL LETTER Y WITH DOT BELOW .. LATIN SMALL LETTER Y WITH DOT BELOW + (16#01EF7#, 16#01EF7#), -- LATIN SMALL LETTER Y WITH HOOK ABOVE .. LATIN SMALL LETTER Y WITH HOOK ABOVE + (16#01EF9#, 16#01EF9#), -- LATIN SMALL LETTER Y WITH TILDE .. LATIN SMALL LETTER Y WITH TILDE + (16#01F00#, 16#01F07#), -- GREEK SMALL LETTER ALPHA WITH PSILI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI + (16#01F10#, 16#01F15#), -- GREEK SMALL LETTER EPSILON WITH PSILI .. GREEK SMALL LETTER EPSILON WITH DASIA AND OXIA + (16#01F20#, 16#01F27#), -- GREEK SMALL LETTER ETA WITH PSILI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI + (16#01F30#, 16#01F37#), -- GREEK SMALL LETTER IOTA WITH PSILI .. GREEK SMALL LETTER IOTA WITH DASIA AND PERISPOMENI + (16#01F40#, 16#01F45#), -- GREEK SMALL LETTER OMICRON WITH PSILI .. GREEK SMALL LETTER OMICRON WITH DASIA AND OXIA + (16#01F51#, 16#01F51#), -- GREEK SMALL LETTER UPSILON WITH DASIA .. GREEK SMALL LETTER UPSILON WITH DASIA + (16#01F53#, 16#01F53#), -- GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA .. GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA + (16#01F55#, 16#01F55#), -- GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA .. GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA + (16#01F57#, 16#01F57#), -- GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI .. GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI + (16#01F60#, 16#01F67#), -- GREEK SMALL LETTER OMEGA WITH PSILI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI + (16#01F70#, 16#01F71#), -- GREEK SMALL LETTER ALPHA WITH VARIA .. GREEK SMALL LETTER ALPHA WITH OXIA + (16#01F72#, 16#01F75#), -- GREEK SMALL LETTER EPSILON WITH VARIA .. GREEK SMALL LETTER ETA WITH OXIA + (16#01F76#, 16#01F77#), -- GREEK SMALL LETTER IOTA WITH VARIA .. GREEK SMALL LETTER IOTA WITH OXIA + (16#01F78#, 16#01F79#), -- GREEK SMALL LETTER OMICRON WITH VARIA .. GREEK SMALL LETTER OMICRON WITH OXIA + (16#01F7A#, 16#01F7B#), -- GREEK SMALL LETTER UPSILON WITH VARIA .. GREEK SMALL LETTER UPSILON WITH OXIA + (16#01F7C#, 16#01F7D#), -- GREEK SMALL LETTER OMEGA WITH VARIA .. GREEK SMALL LETTER OMEGA WITH OXIA + (16#01F80#, 16#01F87#), -- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI + (16#01F90#, 16#01F97#), -- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI + (16#01FA0#, 16#01FA7#), -- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI + (16#01FB0#, 16#01FB1#), -- GREEK SMALL LETTER ALPHA WITH VRACHY .. GREEK SMALL LETTER ALPHA WITH MACRON + (16#01FB3#, 16#01FB3#), -- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI + (16#01FBE#, 16#01FBE#), -- GREEK PROSGEGRAMMENI .. GREEK PROSGEGRAMMENI + (16#01FC3#, 16#01FC3#), -- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI + (16#01FD0#, 16#01FD1#), -- GREEK SMALL LETTER IOTA WITH VRACHY .. GREEK SMALL LETTER IOTA WITH MACRON + (16#01FE0#, 16#01FE1#), -- GREEK SMALL LETTER UPSILON WITH VRACHY .. GREEK SMALL LETTER UPSILON WITH MACRON + (16#01FE5#, 16#01FE5#), -- GREEK SMALL LETTER RHO WITH DASIA .. GREEK SMALL LETTER RHO WITH DASIA + (16#01FF3#, 16#01FF3#), -- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI + (16#0FF41#, 16#0FF5A#), -- FULLWIDTH LATIN SMALL LETTER A .. FULLWIDTH LATIN SMALL LETTER Z + (16#10428#, 16#1044D#)); -- DESERET SMALL LETTER LONG I .. DESERET SMALL LETTER ENG + + Upper_Case_Adjust : constant array + (Lower_Case_Letters'Range) of Char_Code'Base := ( + -32, -- LATIN SMALL LETTER A .. LATIN SMALL LETTER Z + 743, -- MICRO SIGN .. MICRO SIGN + -32, -- LATIN SMALL LETTER A WITH GRAVE .. LATIN SMALL LETTER O WITH DIAERESIS + -32, -- LATIN SMALL LETTER O WITH STROKE .. LATIN SMALL LETTER THORN + 121, -- LATIN SMALL LETTER Y WITH DIAERESIS .. LATIN SMALL LETTER Y WITH DIAERESIS + -1, -- LATIN SMALL LETTER A WITH MACRON .. LATIN SMALL LETTER A WITH MACRON + -1, -- LATIN SMALL LETTER A WITH BREVE .. LATIN SMALL LETTER A WITH BREVE + -1, -- LATIN SMALL LETTER A WITH OGONEK .. LATIN SMALL LETTER A WITH OGONEK + -1, -- LATIN SMALL LETTER C WITH ACUTE .. LATIN SMALL LETTER C WITH ACUTE + -1, -- LATIN SMALL LETTER C WITH CIRCUMFLEX .. LATIN SMALL LETTER C WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER C WITH DOT ABOVE .. LATIN SMALL LETTER C WITH DOT ABOVE + -1, -- LATIN SMALL LETTER C WITH CARON .. LATIN SMALL LETTER C WITH CARON + -1, -- LATIN SMALL LETTER D WITH CARON .. LATIN SMALL LETTER D WITH CARON + -1, -- LATIN SMALL LETTER D WITH STROKE .. LATIN SMALL LETTER D WITH STROKE + -1, -- LATIN SMALL LETTER E WITH MACRON .. LATIN SMALL LETTER E WITH MACRON + -1, -- LATIN SMALL LETTER E WITH BREVE .. LATIN SMALL LETTER E WITH BREVE + -1, -- LATIN SMALL LETTER E WITH DOT ABOVE .. LATIN SMALL LETTER E WITH DOT ABOVE + -1, -- LATIN SMALL LETTER E WITH OGONEK .. LATIN SMALL LETTER E WITH OGONEK + -1, -- LATIN SMALL LETTER E WITH CARON .. LATIN SMALL LETTER E WITH CARON + -1, -- LATIN SMALL LETTER G WITH CIRCUMFLEX .. LATIN SMALL LETTER G WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER G WITH BREVE .. LATIN SMALL LETTER G WITH BREVE + -1, -- LATIN SMALL LETTER G WITH DOT ABOVE .. LATIN SMALL LETTER G WITH DOT ABOVE + -1, -- LATIN SMALL LETTER G WITH CEDILLA .. LATIN SMALL LETTER G WITH CEDILLA + -1, -- LATIN SMALL LETTER H WITH CIRCUMFLEX .. LATIN SMALL LETTER H WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER H WITH STROKE .. LATIN SMALL LETTER H WITH STROKE + -1, -- LATIN SMALL LETTER I WITH TILDE .. LATIN SMALL LETTER I WITH TILDE + -1, -- LATIN SMALL LETTER I WITH MACRON .. LATIN SMALL LETTER I WITH MACRON + -1, -- LATIN SMALL LETTER I WITH BREVE .. LATIN SMALL LETTER I WITH BREVE + -1, -- LATIN SMALL LETTER I WITH OGONEK .. LATIN SMALL LETTER I WITH OGONEK + -232, -- LATIN SMALL LETTER DOTLESS I .. LATIN SMALL LETTER DOTLESS I + -1, -- LATIN SMALL LIGATURE IJ .. LATIN SMALL LIGATURE IJ + -1, -- LATIN SMALL LETTER J WITH CIRCUMFLEX .. LATIN SMALL LETTER J WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER K WITH CEDILLA .. LATIN SMALL LETTER K WITH CEDILLA + -1, -- LATIN SMALL LETTER L WITH ACUTE .. LATIN SMALL LETTER L WITH ACUTE + -1, -- LATIN SMALL LETTER L WITH CEDILLA .. LATIN SMALL LETTER L WITH CEDILLA + -1, -- LATIN SMALL LETTER L WITH CARON .. LATIN SMALL LETTER L WITH CARON + -1, -- LATIN SMALL LETTER L WITH MIDDLE DOT .. LATIN SMALL LETTER L WITH MIDDLE DOT + -1, -- LATIN SMALL LETTER L WITH STROKE .. LATIN SMALL LETTER L WITH STROKE + -1, -- LATIN SMALL LETTER N WITH ACUTE .. LATIN SMALL LETTER N WITH ACUTE + -1, -- LATIN SMALL LETTER N WITH CEDILLA .. LATIN SMALL LETTER N WITH CEDILLA + -1, -- LATIN SMALL LETTER N WITH CARON .. LATIN SMALL LETTER N WITH CARON + -1, -- LATIN SMALL LETTER ENG .. LATIN SMALL LETTER ENG + -1, -- LATIN SMALL LETTER O WITH MACRON .. LATIN SMALL LETTER O WITH MACRON + -1, -- LATIN SMALL LETTER O WITH BREVE .. LATIN SMALL LETTER O WITH BREVE + -1, -- LATIN SMALL LETTER O WITH DOUBLE ACUTE .. LATIN SMALL LETTER O WITH DOUBLE ACUTE + -1, -- LATIN SMALL LIGATURE OE .. LATIN SMALL LIGATURE OE + -1, -- LATIN SMALL LETTER R WITH ACUTE .. LATIN SMALL LETTER R WITH ACUTE + -1, -- LATIN SMALL LETTER R WITH CEDILLA .. LATIN SMALL LETTER R WITH CEDILLA + -1, -- LATIN SMALL LETTER R WITH CARON .. LATIN SMALL LETTER R WITH CARON + -1, -- LATIN SMALL LETTER S WITH ACUTE .. LATIN SMALL LETTER S WITH ACUTE + -1, -- LATIN SMALL LETTER S WITH CIRCUMFLEX .. LATIN SMALL LETTER S WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER S WITH CEDILLA .. LATIN SMALL LETTER S WITH CEDILLA + -1, -- LATIN SMALL LETTER S WITH CARON .. LATIN SMALL LETTER S WITH CARON + -1, -- LATIN SMALL LETTER T WITH CEDILLA .. LATIN SMALL LETTER T WITH CEDILLA + -1, -- LATIN SMALL LETTER T WITH CARON .. LATIN SMALL LETTER T WITH CARON + -1, -- LATIN SMALL LETTER T WITH STROKE .. LATIN SMALL LETTER T WITH STROKE + -1, -- LATIN SMALL LETTER U WITH TILDE .. LATIN SMALL LETTER U WITH TILDE + -1, -- LATIN SMALL LETTER U WITH MACRON .. LATIN SMALL LETTER U WITH MACRON + -1, -- LATIN SMALL LETTER U WITH BREVE .. LATIN SMALL LETTER U WITH BREVE + -1, -- LATIN SMALL LETTER U WITH RING ABOVE .. LATIN SMALL LETTER U WITH RING ABOVE + -1, -- LATIN SMALL LETTER U WITH DOUBLE ACUTE .. LATIN SMALL LETTER U WITH DOUBLE ACUTE + -1, -- LATIN SMALL LETTER U WITH OGONEK .. LATIN SMALL LETTER U WITH OGONEK + -1, -- LATIN SMALL LETTER W WITH CIRCUMFLEX .. LATIN SMALL LETTER W WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER Y WITH CIRCUMFLEX .. LATIN SMALL LETTER Y WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER Z WITH ACUTE .. LATIN SMALL LETTER Z WITH ACUTE + -1, -- LATIN SMALL LETTER Z WITH DOT ABOVE .. LATIN SMALL LETTER Z WITH DOT ABOVE + -1, -- LATIN SMALL LETTER Z WITH CARON .. LATIN SMALL LETTER Z WITH CARON + -300, -- LATIN SMALL LETTER LONG S .. LATIN SMALL LETTER LONG S + -1, -- LATIN SMALL LETTER B WITH TOPBAR .. LATIN SMALL LETTER B WITH TOPBAR + -1, -- LATIN SMALL LETTER TONE SIX .. LATIN SMALL LETTER TONE SIX + -1, -- LATIN SMALL LETTER C WITH HOOK .. LATIN SMALL LETTER C WITH HOOK + -1, -- LATIN SMALL LETTER D WITH TOPBAR .. LATIN SMALL LETTER D WITH TOPBAR + -1, -- LATIN SMALL LETTER F WITH HOOK .. LATIN SMALL LETTER F WITH HOOK + 97, -- LATIN SMALL LETTER HV .. LATIN SMALL LETTER HV + -1, -- LATIN SMALL LETTER K WITH HOOK .. LATIN SMALL LETTER K WITH HOOK + 130, -- LATIN SMALL LETTER N WITH LONG RIGHT LEG .. LATIN SMALL LETTER N WITH LONG RIGHT LEG + -1, -- LATIN SMALL LETTER O WITH HORN .. LATIN SMALL LETTER O WITH HORN + -1, -- LATIN SMALL LETTER OI .. LATIN SMALL LETTER OI + -1, -- LATIN SMALL LETTER P WITH HOOK .. LATIN SMALL LETTER P WITH HOOK + -1, -- LATIN SMALL LETTER TONE TWO .. LATIN SMALL LETTER TONE TWO + -1, -- LATIN SMALL LETTER T WITH HOOK .. LATIN SMALL LETTER T WITH HOOK + -1, -- LATIN SMALL LETTER U WITH HORN .. LATIN SMALL LETTER U WITH HORN + -1, -- LATIN SMALL LETTER Y WITH HOOK .. LATIN SMALL LETTER Y WITH HOOK + -1, -- LATIN SMALL LETTER Z WITH STROKE .. LATIN SMALL LETTER Z WITH STROKE + -1, -- LATIN SMALL LETTER EZH REVERSED .. LATIN SMALL LETTER EZH REVERSED + -1, -- LATIN SMALL LETTER TONE FIVE .. LATIN SMALL LETTER TONE FIVE + 56, -- LATIN LETTER WYNN .. LATIN LETTER WYNN + -1, -- LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON + -2, -- LATIN SMALL LETTER DZ WITH CARON .. LATIN SMALL LETTER DZ WITH CARON + -1, -- LATIN CAPITAL LETTER L WITH SMALL LETTER J .. LATIN CAPITAL LETTER L WITH SMALL LETTER J + -2, -- LATIN SMALL LETTER LJ .. LATIN SMALL LETTER LJ + -1, -- LATIN CAPITAL LETTER N WITH SMALL LETTER J .. LATIN CAPITAL LETTER N WITH SMALL LETTER J + -2, -- LATIN SMALL LETTER NJ .. LATIN SMALL LETTER NJ + -1, -- LATIN SMALL LETTER A WITH CARON .. LATIN SMALL LETTER A WITH CARON + -1, -- LATIN SMALL LETTER I WITH CARON .. LATIN SMALL LETTER I WITH CARON + -1, -- LATIN SMALL LETTER O WITH CARON .. LATIN SMALL LETTER O WITH CARON + -1, -- LATIN SMALL LETTER U WITH CARON .. LATIN SMALL LETTER U WITH CARON + -1, -- LATIN SMALL LETTER U WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER U WITH DIAERESIS AND MACRON + -1, -- LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE + -1, -- LATIN SMALL LETTER U WITH DIAERESIS AND CARON .. LATIN SMALL LETTER U WITH DIAERESIS AND CARON + -1, -- LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE .. LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE + -79, -- LATIN SMALL LETTER TURNED E .. LATIN SMALL LETTER TURNED E + -1, -- LATIN SMALL LETTER A WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER A WITH DIAERESIS AND MACRON + -1, -- LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON + -1, -- LATIN SMALL LETTER AE WITH MACRON .. LATIN SMALL LETTER AE WITH MACRON + -1, -- LATIN SMALL LETTER G WITH STROKE .. LATIN SMALL LETTER G WITH STROKE + -1, -- LATIN SMALL LETTER G WITH CARON .. LATIN SMALL LETTER G WITH CARON + -1, -- LATIN SMALL LETTER K WITH CARON .. LATIN SMALL LETTER K WITH CARON + -1, -- LATIN SMALL LETTER O WITH OGONEK .. LATIN SMALL LETTER O WITH OGONEK + -1, -- LATIN SMALL LETTER O WITH OGONEK AND MACRON .. LATIN SMALL LETTER O WITH OGONEK AND MACRON + -1, -- LATIN SMALL LETTER EZH WITH CARON .. LATIN SMALL LETTER EZH WITH CARON + -1, -- LATIN CAPITAL LETTER D WITH SMALL LETTER Z .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z + -2, -- LATIN SMALL LETTER DZ .. LATIN SMALL LETTER DZ + -1, -- LATIN SMALL LETTER G WITH ACUTE .. LATIN SMALL LETTER G WITH ACUTE + -1, -- LATIN SMALL LETTER N WITH GRAVE .. LATIN SMALL LETTER N WITH GRAVE + -1, -- LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE .. LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE + -1, -- LATIN SMALL LETTER AE WITH ACUTE .. LATIN SMALL LETTER AE WITH ACUTE + -1, -- LATIN SMALL LETTER O WITH STROKE AND ACUTE .. LATIN SMALL LETTER O WITH STROKE AND ACUTE + -1, -- LATIN SMALL LETTER A WITH DOUBLE GRAVE .. LATIN SMALL LETTER A WITH DOUBLE GRAVE + -1, -- LATIN SMALL LETTER A WITH INVERTED BREVE .. LATIN SMALL LETTER A WITH INVERTED BREVE + -1, -- LATIN SMALL LETTER E WITH DOUBLE GRAVE .. LATIN SMALL LETTER E WITH DOUBLE GRAVE + -1, -- LATIN SMALL LETTER E WITH INVERTED BREVE .. LATIN SMALL LETTER E WITH INVERTED BREVE + -1, -- LATIN SMALL LETTER I WITH DOUBLE GRAVE .. LATIN SMALL LETTER I WITH DOUBLE GRAVE + -1, -- LATIN SMALL LETTER I WITH INVERTED BREVE .. LATIN SMALL LETTER I WITH INVERTED BREVE + -1, -- LATIN SMALL LETTER O WITH DOUBLE GRAVE .. LATIN SMALL LETTER O WITH DOUBLE GRAVE + -1, -- LATIN SMALL LETTER O WITH INVERTED BREVE .. LATIN SMALL LETTER O WITH INVERTED BREVE + -1, -- LATIN SMALL LETTER R WITH DOUBLE GRAVE .. LATIN SMALL LETTER R WITH DOUBLE GRAVE + -1, -- LATIN SMALL LETTER R WITH INVERTED BREVE .. LATIN SMALL LETTER R WITH INVERTED BREVE + -1, -- LATIN SMALL LETTER U WITH DOUBLE GRAVE .. LATIN SMALL LETTER U WITH DOUBLE GRAVE + -1, -- LATIN SMALL LETTER U WITH INVERTED BREVE .. LATIN SMALL LETTER U WITH INVERTED BREVE + -1, -- LATIN SMALL LETTER S WITH COMMA BELOW .. LATIN SMALL LETTER S WITH COMMA BELOW + -1, -- LATIN SMALL LETTER T WITH COMMA BELOW .. LATIN SMALL LETTER T WITH COMMA BELOW + -1, -- LATIN SMALL LETTER YOGH .. LATIN SMALL LETTER YOGH + -1, -- LATIN SMALL LETTER H WITH CARON .. LATIN SMALL LETTER H WITH CARON + -1, -- LATIN SMALL LETTER OU .. LATIN SMALL LETTER OU + -1, -- LATIN SMALL LETTER Z WITH HOOK .. LATIN SMALL LETTER Z WITH HOOK + -1, -- LATIN SMALL LETTER A WITH DOT ABOVE .. LATIN SMALL LETTER A WITH DOT ABOVE + -1, -- LATIN SMALL LETTER E WITH CEDILLA .. LATIN SMALL LETTER E WITH CEDILLA + -1, -- LATIN SMALL LETTER O WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER O WITH DIAERESIS AND MACRON + -1, -- LATIN SMALL LETTER O WITH TILDE AND MACRON .. LATIN SMALL LETTER O WITH TILDE AND MACRON + -1, -- LATIN SMALL LETTER O WITH DOT ABOVE .. LATIN SMALL LETTER O WITH DOT ABOVE + -1, -- LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON + -1, -- LATIN SMALL LETTER Y WITH MACRON .. LATIN SMALL LETTER Y WITH MACRON + -210, -- LATIN SMALL LETTER B WITH HOOK .. LATIN SMALL LETTER B WITH HOOK + -206, -- LATIN SMALL LETTER OPEN O .. LATIN SMALL LETTER OPEN O + -205, -- LATIN SMALL LETTER D WITH TAIL .. LATIN SMALL LETTER D WITH HOOK + -202, -- LATIN SMALL LETTER SCHWA .. LATIN SMALL LETTER SCHWA + -203, -- LATIN SMALL LETTER OPEN E .. LATIN SMALL LETTER OPEN E + -205, -- LATIN SMALL LETTER G WITH HOOK .. LATIN SMALL LETTER G WITH HOOK + -207, -- LATIN SMALL LETTER GAMMA .. LATIN SMALL LETTER GAMMA + -209, -- LATIN SMALL LETTER I WITH STROKE .. LATIN SMALL LETTER I WITH STROKE + -211, -- LATIN SMALL LETTER IOTA .. LATIN SMALL LETTER IOTA + -211, -- LATIN SMALL LETTER TURNED M .. LATIN SMALL LETTER TURNED M + -213, -- LATIN SMALL LETTER N WITH LEFT HOOK .. LATIN SMALL LETTER N WITH LEFT HOOK + -214, -- LATIN SMALL LETTER BARRED O .. LATIN SMALL LETTER BARRED O + -218, -- LATIN LETTER SMALL CAPITAL R .. LATIN LETTER SMALL CAPITAL R + -218, -- LATIN SMALL LETTER ESH .. LATIN SMALL LETTER ESH + -218, -- LATIN SMALL LETTER T WITH RETROFLEX HOOK .. LATIN SMALL LETTER T WITH RETROFLEX HOOK + -217, -- LATIN SMALL LETTER UPSILON .. LATIN SMALL LETTER V WITH HOOK + -219, -- LATIN SMALL LETTER EZH .. LATIN SMALL LETTER EZH + -38, -- GREEK SMALL LETTER ALPHA WITH TONOS .. GREEK SMALL LETTER ALPHA WITH TONOS + -37, -- GREEK SMALL LETTER EPSILON WITH TONOS .. GREEK SMALL LETTER IOTA WITH TONOS + -32, -- GREEK SMALL LETTER ALPHA .. GREEK SMALL LETTER RHO + -31, -- GREEK SMALL LETTER FINAL SIGMA .. GREEK SMALL LETTER FINAL SIGMA + -32, -- GREEK SMALL LETTER SIGMA .. GREEK SMALL LETTER UPSILON WITH DIALYTIKA + -64, -- GREEK SMALL LETTER OMICRON WITH TONOS .. GREEK SMALL LETTER OMICRON WITH TONOS + -63, -- GREEK SMALL LETTER UPSILON WITH TONOS .. GREEK SMALL LETTER OMEGA WITH TONOS + -62, -- GREEK BETA SYMBOL .. GREEK BETA SYMBOL + -57, -- GREEK THETA SYMBOL .. GREEK THETA SYMBOL + -47, -- GREEK PHI SYMBOL .. GREEK PHI SYMBOL + -54, -- GREEK PI SYMBOL .. GREEK PI SYMBOL + -1, -- GREEK SMALL LETTER ARCHAIC KOPPA .. GREEK SMALL LETTER ARCHAIC KOPPA + -1, -- GREEK SMALL LETTER STIGMA .. GREEK SMALL LETTER STIGMA + -1, -- GREEK SMALL LETTER DIGAMMA .. GREEK SMALL LETTER DIGAMMA + -1, -- GREEK SMALL LETTER KOPPA .. GREEK SMALL LETTER KOPPA + -1, -- GREEK SMALL LETTER SAMPI .. GREEK SMALL LETTER SAMPI + -1, -- COPTIC SMALL LETTER SHEI .. COPTIC SMALL LETTER SHEI + -1, -- COPTIC SMALL LETTER FEI .. COPTIC SMALL LETTER FEI + -1, -- COPTIC SMALL LETTER KHEI .. COPTIC SMALL LETTER KHEI + -1, -- COPTIC SMALL LETTER HORI .. COPTIC SMALL LETTER HORI + -1, -- COPTIC SMALL LETTER GANGIA .. COPTIC SMALL LETTER GANGIA + -1, -- COPTIC SMALL LETTER SHIMA .. COPTIC SMALL LETTER SHIMA + -1, -- COPTIC SMALL LETTER DEI .. COPTIC SMALL LETTER DEI + -86, -- GREEK KAPPA SYMBOL .. GREEK KAPPA SYMBOL + -80, -- GREEK RHO SYMBOL .. GREEK RHO SYMBOL + -79, -- GREEK LUNATE SIGMA SYMBOL .. GREEK LUNATE SIGMA SYMBOL + -96, -- GREEK LUNATE EPSILON SYMBOL .. GREEK LUNATE EPSILON SYMBOL + -32, -- CYRILLIC SMALL LETTER A .. CYRILLIC SMALL LETTER YA + -80, -- CYRILLIC SMALL LETTER IE WITH GRAVE .. CYRILLIC SMALL LETTER DZHE + -1, -- CYRILLIC SMALL LETTER OMEGA .. CYRILLIC SMALL LETTER OMEGA + -1, -- CYRILLIC SMALL LETTER YAT .. CYRILLIC SMALL LETTER YAT + -1, -- CYRILLIC SMALL LETTER IOTIFIED E .. CYRILLIC SMALL LETTER IOTIFIED E + -1, -- CYRILLIC SMALL LETTER LITTLE YUS .. CYRILLIC SMALL LETTER LITTLE YUS + -1, -- CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS .. CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS + -1, -- CYRILLIC SMALL LETTER BIG YUS .. CYRILLIC SMALL LETTER BIG YUS + -1, -- CYRILLIC SMALL LETTER IOTIFIED BIG YUS .. CYRILLIC SMALL LETTER IOTIFIED BIG YUS + -1, -- CYRILLIC SMALL LETTER KSI .. CYRILLIC SMALL LETTER KSI + -1, -- CYRILLIC SMALL LETTER PSI .. CYRILLIC SMALL LETTER PSI + -1, -- CYRILLIC SMALL LETTER FITA .. CYRILLIC SMALL LETTER FITA + -1, -- CYRILLIC SMALL LETTER IZHITSA .. CYRILLIC SMALL LETTER IZHITSA + -1, -- CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT .. CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT + -1, -- CYRILLIC SMALL LETTER UK .. CYRILLIC SMALL LETTER UK + -1, -- CYRILLIC SMALL LETTER ROUND OMEGA .. CYRILLIC SMALL LETTER ROUND OMEGA + -1, -- CYRILLIC SMALL LETTER OMEGA WITH TITLO .. CYRILLIC SMALL LETTER OMEGA WITH TITLO + -1, -- CYRILLIC SMALL LETTER OT .. CYRILLIC SMALL LETTER OT + -1, -- CYRILLIC SMALL LETTER KOPPA .. CYRILLIC SMALL LETTER KOPPA + -1, -- CYRILLIC SMALL LETTER SHORT I WITH TAIL .. CYRILLIC SMALL LETTER SHORT I WITH TAIL + -1, -- CYRILLIC SMALL LETTER SEMISOFT SIGN .. CYRILLIC SMALL LETTER SEMISOFT SIGN + -1, -- CYRILLIC SMALL LETTER ER WITH TICK .. CYRILLIC SMALL LETTER ER WITH TICK + -1, -- CYRILLIC SMALL LETTER GHE WITH UPTURN .. CYRILLIC SMALL LETTER GHE WITH UPTURN + -1, -- CYRILLIC SMALL LETTER GHE WITH STROKE .. CYRILLIC SMALL LETTER GHE WITH STROKE + -1, -- CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK + -1, -- CYRILLIC SMALL LETTER ZHE WITH DESCENDER .. CYRILLIC SMALL LETTER ZHE WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER ZE WITH DESCENDER .. CYRILLIC SMALL LETTER ZE WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER KA WITH DESCENDER .. CYRILLIC SMALL LETTER KA WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE + -1, -- CYRILLIC SMALL LETTER KA WITH STROKE .. CYRILLIC SMALL LETTER KA WITH STROKE + -1, -- CYRILLIC SMALL LETTER BASHKIR KA .. CYRILLIC SMALL LETTER BASHKIR KA + -1, -- CYRILLIC SMALL LETTER EN WITH DESCENDER .. CYRILLIC SMALL LETTER EN WITH DESCENDER + -1, -- CYRILLIC SMALL LIGATURE EN GHE .. CYRILLIC SMALL LIGATURE EN GHE + -1, -- CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK + -1, -- CYRILLIC SMALL LETTER ABKHASIAN HA .. CYRILLIC SMALL LETTER ABKHASIAN HA + -1, -- CYRILLIC SMALL LETTER ES WITH DESCENDER .. CYRILLIC SMALL LETTER ES WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER TE WITH DESCENDER .. CYRILLIC SMALL LETTER TE WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER STRAIGHT U .. CYRILLIC SMALL LETTER STRAIGHT U + -1, -- CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE .. CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE + -1, -- CYRILLIC SMALL LETTER HA WITH DESCENDER .. CYRILLIC SMALL LETTER HA WITH DESCENDER + -1, -- CYRILLIC SMALL LIGATURE TE TSE .. CYRILLIC SMALL LIGATURE TE TSE + -1, -- CYRILLIC SMALL LETTER CHE WITH DESCENDER .. CYRILLIC SMALL LETTER CHE WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE + -1, -- CYRILLIC SMALL LETTER SHHA .. CYRILLIC SMALL LETTER SHHA + -1, -- CYRILLIC SMALL LETTER ABKHASIAN CHE .. CYRILLIC SMALL LETTER ABKHASIAN CHE + -1, -- CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER .. CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER + -1, -- CYRILLIC SMALL LETTER ZHE WITH BREVE .. CYRILLIC SMALL LETTER ZHE WITH BREVE + -1, -- CYRILLIC SMALL LETTER KA WITH HOOK .. CYRILLIC SMALL LETTER KA WITH HOOK + -1, -- CYRILLIC SMALL LETTER EL WITH TAIL .. CYRILLIC SMALL LETTER EL WITH TAIL + -1, -- CYRILLIC SMALL LETTER EN WITH HOOK .. CYRILLIC SMALL LETTER EN WITH HOOK + -1, -- CYRILLIC SMALL LETTER EN WITH TAIL .. CYRILLIC SMALL LETTER EN WITH TAIL + -1, -- CYRILLIC SMALL LETTER KHAKASSIAN CHE .. CYRILLIC SMALL LETTER KHAKASSIAN CHE + -1, -- CYRILLIC SMALL LETTER EM WITH TAIL .. CYRILLIC SMALL LETTER EM WITH TAIL + -1, -- CYRILLIC SMALL LETTER A WITH BREVE .. CYRILLIC SMALL LETTER A WITH BREVE + -1, -- CYRILLIC SMALL LETTER A WITH DIAERESIS .. CYRILLIC SMALL LETTER A WITH DIAERESIS + -1, -- CYRILLIC SMALL LIGATURE A IE .. CYRILLIC SMALL LIGATURE A IE + -1, -- CYRILLIC SMALL LETTER IE WITH BREVE .. CYRILLIC SMALL LETTER IE WITH BREVE + -1, -- CYRILLIC SMALL LETTER SCHWA .. CYRILLIC SMALL LETTER SCHWA + -1, -- CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS .. CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER ZHE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZHE WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER ZE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZE WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER ABKHASIAN DZE .. CYRILLIC SMALL LETTER ABKHASIAN DZE + -1, -- CYRILLIC SMALL LETTER I WITH MACRON .. CYRILLIC SMALL LETTER I WITH MACRON + -1, -- CYRILLIC SMALL LETTER I WITH DIAERESIS .. CYRILLIC SMALL LETTER I WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER O WITH DIAERESIS .. CYRILLIC SMALL LETTER O WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER BARRED O .. CYRILLIC SMALL LETTER BARRED O + -1, -- CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS .. CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER E WITH DIAERESIS .. CYRILLIC SMALL LETTER E WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER U WITH MACRON .. CYRILLIC SMALL LETTER U WITH MACRON + -1, -- CYRILLIC SMALL LETTER U WITH DIAERESIS .. CYRILLIC SMALL LETTER U WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE .. CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE + -1, -- CYRILLIC SMALL LETTER CHE WITH DIAERESIS .. CYRILLIC SMALL LETTER CHE WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER YERU WITH DIAERESIS .. CYRILLIC SMALL LETTER YERU WITH DIAERESIS + -1, -- CYRILLIC SMALL LETTER KOMI DE .. CYRILLIC SMALL LETTER KOMI DE + -1, -- CYRILLIC SMALL LETTER KOMI DJE .. CYRILLIC SMALL LETTER KOMI DJE + -1, -- CYRILLIC SMALL LETTER KOMI ZJE .. CYRILLIC SMALL LETTER KOMI ZJE + -1, -- CYRILLIC SMALL LETTER KOMI DZJE .. CYRILLIC SMALL LETTER KOMI DZJE + -1, -- CYRILLIC SMALL LETTER KOMI LJE .. CYRILLIC SMALL LETTER KOMI LJE + -1, -- CYRILLIC SMALL LETTER KOMI NJE .. CYRILLIC SMALL LETTER KOMI NJE + -1, -- CYRILLIC SMALL LETTER KOMI SJE .. CYRILLIC SMALL LETTER KOMI SJE + -1, -- CYRILLIC SMALL LETTER KOMI TJE .. CYRILLIC SMALL LETTER KOMI TJE + -48, -- ARMENIAN SMALL LETTER AYB .. ARMENIAN SMALL LETTER FEH + -1, -- LATIN SMALL LETTER A WITH RING BELOW .. LATIN SMALL LETTER A WITH RING BELOW + -1, -- LATIN SMALL LETTER B WITH DOT ABOVE .. LATIN SMALL LETTER B WITH DOT ABOVE + -1, -- LATIN SMALL LETTER B WITH DOT BELOW .. LATIN SMALL LETTER B WITH DOT BELOW + -1, -- LATIN SMALL LETTER B WITH LINE BELOW .. LATIN SMALL LETTER B WITH LINE BELOW + -1, -- LATIN SMALL LETTER C WITH CEDILLA AND ACUTE .. LATIN SMALL LETTER C WITH CEDILLA AND ACUTE + -1, -- LATIN SMALL LETTER D WITH DOT ABOVE .. LATIN SMALL LETTER D WITH DOT ABOVE + -1, -- LATIN SMALL LETTER D WITH DOT BELOW .. LATIN SMALL LETTER D WITH DOT BELOW + -1, -- LATIN SMALL LETTER D WITH LINE BELOW .. LATIN SMALL LETTER D WITH LINE BELOW + -1, -- LATIN SMALL LETTER D WITH CEDILLA .. LATIN SMALL LETTER D WITH CEDILLA + -1, -- LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW + -1, -- LATIN SMALL LETTER E WITH MACRON AND GRAVE .. LATIN SMALL LETTER E WITH MACRON AND GRAVE + -1, -- LATIN SMALL LETTER E WITH MACRON AND ACUTE .. LATIN SMALL LETTER E WITH MACRON AND ACUTE + -1, -- LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW + -1, -- LATIN SMALL LETTER E WITH TILDE BELOW .. LATIN SMALL LETTER E WITH TILDE BELOW + -1, -- LATIN SMALL LETTER E WITH CEDILLA AND BREVE .. LATIN SMALL LETTER E WITH CEDILLA AND BREVE + -1, -- LATIN SMALL LETTER F WITH DOT ABOVE .. LATIN SMALL LETTER F WITH DOT ABOVE + -1, -- LATIN SMALL LETTER G WITH MACRON .. LATIN SMALL LETTER G WITH MACRON + -1, -- LATIN SMALL LETTER H WITH DOT ABOVE .. LATIN SMALL LETTER H WITH DOT ABOVE + -1, -- LATIN SMALL LETTER H WITH DOT BELOW .. LATIN SMALL LETTER H WITH DOT BELOW + -1, -- LATIN SMALL LETTER H WITH DIAERESIS .. LATIN SMALL LETTER H WITH DIAERESIS + -1, -- LATIN SMALL LETTER H WITH CEDILLA .. LATIN SMALL LETTER H WITH CEDILLA + -1, -- LATIN SMALL LETTER H WITH BREVE BELOW .. LATIN SMALL LETTER H WITH BREVE BELOW + -1, -- LATIN SMALL LETTER I WITH TILDE BELOW .. LATIN SMALL LETTER I WITH TILDE BELOW + -1, -- LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE + -1, -- LATIN SMALL LETTER K WITH ACUTE .. LATIN SMALL LETTER K WITH ACUTE + -1, -- LATIN SMALL LETTER K WITH DOT BELOW .. LATIN SMALL LETTER K WITH DOT BELOW + -1, -- LATIN SMALL LETTER K WITH LINE BELOW .. LATIN SMALL LETTER K WITH LINE BELOW + -1, -- LATIN SMALL LETTER L WITH DOT BELOW .. LATIN SMALL LETTER L WITH DOT BELOW + -1, -- LATIN SMALL LETTER L WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER L WITH DOT BELOW AND MACRON + -1, -- LATIN SMALL LETTER L WITH LINE BELOW .. LATIN SMALL LETTER L WITH LINE BELOW + -1, -- LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW + -1, -- LATIN SMALL LETTER M WITH ACUTE .. LATIN SMALL LETTER M WITH ACUTE + -1, -- LATIN SMALL LETTER M WITH DOT ABOVE .. LATIN SMALL LETTER M WITH DOT ABOVE + -1, -- LATIN SMALL LETTER M WITH DOT BELOW .. LATIN SMALL LETTER M WITH DOT BELOW + -1, -- LATIN SMALL LETTER N WITH DOT ABOVE .. LATIN SMALL LETTER N WITH DOT ABOVE + -1, -- LATIN SMALL LETTER N WITH DOT BELOW .. LATIN SMALL LETTER N WITH DOT BELOW + -1, -- LATIN SMALL LETTER N WITH LINE BELOW .. LATIN SMALL LETTER N WITH LINE BELOW + -1, -- LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW + -1, -- LATIN SMALL LETTER O WITH TILDE AND ACUTE .. LATIN SMALL LETTER O WITH TILDE AND ACUTE + -1, -- LATIN SMALL LETTER O WITH TILDE AND DIAERESIS .. LATIN SMALL LETTER O WITH TILDE AND DIAERESIS + -1, -- LATIN SMALL LETTER O WITH MACRON AND GRAVE .. LATIN SMALL LETTER O WITH MACRON AND GRAVE + -1, -- LATIN SMALL LETTER O WITH MACRON AND ACUTE .. LATIN SMALL LETTER O WITH MACRON AND ACUTE + -1, -- LATIN SMALL LETTER P WITH ACUTE .. LATIN SMALL LETTER P WITH ACUTE + -1, -- LATIN SMALL LETTER P WITH DOT ABOVE .. LATIN SMALL LETTER P WITH DOT ABOVE + -1, -- LATIN SMALL LETTER R WITH DOT ABOVE .. LATIN SMALL LETTER R WITH DOT ABOVE + -1, -- LATIN SMALL LETTER R WITH DOT BELOW .. LATIN SMALL LETTER R WITH DOT BELOW + -1, -- LATIN SMALL LETTER R WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER R WITH DOT BELOW AND MACRON + -1, -- LATIN SMALL LETTER R WITH LINE BELOW .. LATIN SMALL LETTER R WITH LINE BELOW + -1, -- LATIN SMALL LETTER S WITH DOT ABOVE .. LATIN SMALL LETTER S WITH DOT ABOVE + -1, -- LATIN SMALL LETTER S WITH DOT BELOW .. LATIN SMALL LETTER S WITH DOT BELOW + -1, -- LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE .. LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE + -1, -- LATIN SMALL LETTER S WITH CARON AND DOT ABOVE .. LATIN SMALL LETTER S WITH CARON AND DOT ABOVE + -1, -- LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE .. LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE + -1, -- LATIN SMALL LETTER T WITH DOT ABOVE .. LATIN SMALL LETTER T WITH DOT ABOVE + -1, -- LATIN SMALL LETTER T WITH DOT BELOW .. LATIN SMALL LETTER T WITH DOT BELOW + -1, -- LATIN SMALL LETTER T WITH LINE BELOW .. LATIN SMALL LETTER T WITH LINE BELOW + -1, -- LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW + -1, -- LATIN SMALL LETTER U WITH DIAERESIS BELOW .. LATIN SMALL LETTER U WITH DIAERESIS BELOW + -1, -- LATIN SMALL LETTER U WITH TILDE BELOW .. LATIN SMALL LETTER U WITH TILDE BELOW + -1, -- LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW + -1, -- LATIN SMALL LETTER U WITH TILDE AND ACUTE .. LATIN SMALL LETTER U WITH TILDE AND ACUTE + -1, -- LATIN SMALL LETTER U WITH MACRON AND DIAERESIS .. LATIN SMALL LETTER U WITH MACRON AND DIAERESIS + -1, -- LATIN SMALL LETTER V WITH TILDE .. LATIN SMALL LETTER V WITH TILDE + -1, -- LATIN SMALL LETTER V WITH DOT BELOW .. LATIN SMALL LETTER V WITH DOT BELOW + -1, -- LATIN SMALL LETTER W WITH GRAVE .. LATIN SMALL LETTER W WITH GRAVE + -1, -- LATIN SMALL LETTER W WITH ACUTE .. LATIN SMALL LETTER W WITH ACUTE + -1, -- LATIN SMALL LETTER W WITH DIAERESIS .. LATIN SMALL LETTER W WITH DIAERESIS + -1, -- LATIN SMALL LETTER W WITH DOT ABOVE .. LATIN SMALL LETTER W WITH DOT ABOVE + -1, -- LATIN SMALL LETTER W WITH DOT BELOW .. LATIN SMALL LETTER W WITH DOT BELOW + -1, -- LATIN SMALL LETTER X WITH DOT ABOVE .. LATIN SMALL LETTER X WITH DOT ABOVE + -1, -- LATIN SMALL LETTER X WITH DIAERESIS .. LATIN SMALL LETTER X WITH DIAERESIS + -1, -- LATIN SMALL LETTER Y WITH DOT ABOVE .. LATIN SMALL LETTER Y WITH DOT ABOVE + -1, -- LATIN SMALL LETTER Z WITH CIRCUMFLEX .. LATIN SMALL LETTER Z WITH CIRCUMFLEX + -1, -- LATIN SMALL LETTER Z WITH DOT BELOW .. LATIN SMALL LETTER Z WITH DOT BELOW + -1, -- LATIN SMALL LETTER Z WITH LINE BELOW .. LATIN SMALL LETTER Z WITH LINE BELOW + -59, -- LATIN SMALL LETTER LONG S WITH DOT ABOVE .. LATIN SMALL LETTER LONG S WITH DOT ABOVE + -1, -- LATIN SMALL LETTER A WITH DOT BELOW .. LATIN SMALL LETTER A WITH DOT BELOW + -1, -- LATIN SMALL LETTER A WITH HOOK ABOVE .. LATIN SMALL LETTER A WITH HOOK ABOVE + -1, -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE + -1, -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE + -1, -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE + -1, -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE + -1, -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW + -1, -- LATIN SMALL LETTER A WITH BREVE AND ACUTE .. LATIN SMALL LETTER A WITH BREVE AND ACUTE + -1, -- LATIN SMALL LETTER A WITH BREVE AND GRAVE .. LATIN SMALL LETTER A WITH BREVE AND GRAVE + -1, -- LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE .. LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE + -1, -- LATIN SMALL LETTER A WITH BREVE AND TILDE .. LATIN SMALL LETTER A WITH BREVE AND TILDE + -1, -- LATIN SMALL LETTER A WITH BREVE AND DOT BELOW .. LATIN SMALL LETTER A WITH BREVE AND DOT BELOW + -1, -- LATIN SMALL LETTER E WITH DOT BELOW .. LATIN SMALL LETTER E WITH DOT BELOW + -1, -- LATIN SMALL LETTER E WITH HOOK ABOVE .. LATIN SMALL LETTER E WITH HOOK ABOVE + -1, -- LATIN SMALL LETTER E WITH TILDE .. LATIN SMALL LETTER E WITH TILDE + -1, -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE + -1, -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE + -1, -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE + -1, -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE + -1, -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW + -1, -- LATIN SMALL LETTER I WITH HOOK ABOVE .. LATIN SMALL LETTER I WITH HOOK ABOVE + -1, -- LATIN SMALL LETTER I WITH DOT BELOW .. LATIN SMALL LETTER I WITH DOT BELOW + -1, -- LATIN SMALL LETTER O WITH DOT BELOW .. LATIN SMALL LETTER O WITH DOT BELOW + -1, -- LATIN SMALL LETTER O WITH HOOK ABOVE .. LATIN SMALL LETTER O WITH HOOK ABOVE + -1, -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE + -1, -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE + -1, -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE + -1, -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE + -1, -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW + -1, -- LATIN SMALL LETTER O WITH HORN AND ACUTE .. LATIN SMALL LETTER O WITH HORN AND ACUTE + -1, -- LATIN SMALL LETTER O WITH HORN AND GRAVE .. LATIN SMALL LETTER O WITH HORN AND GRAVE + -1, -- LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE + -1, -- LATIN SMALL LETTER O WITH HORN AND TILDE .. LATIN SMALL LETTER O WITH HORN AND TILDE + -1, -- LATIN SMALL LETTER O WITH HORN AND DOT BELOW .. LATIN SMALL LETTER O WITH HORN AND DOT BELOW + -1, -- LATIN SMALL LETTER U WITH DOT BELOW .. LATIN SMALL LETTER U WITH DOT BELOW + -1, -- LATIN SMALL LETTER U WITH HOOK ABOVE .. LATIN SMALL LETTER U WITH HOOK ABOVE + -1, -- LATIN SMALL LETTER U WITH HORN AND ACUTE .. LATIN SMALL LETTER U WITH HORN AND ACUTE + -1, -- LATIN SMALL LETTER U WITH HORN AND GRAVE .. LATIN SMALL LETTER U WITH HORN AND GRAVE + -1, -- LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE + -1, -- LATIN SMALL LETTER U WITH HORN AND TILDE .. LATIN SMALL LETTER U WITH HORN AND TILDE + -1, -- LATIN SMALL LETTER U WITH HORN AND DOT BELOW .. LATIN SMALL LETTER U WITH HORN AND DOT BELOW + -1, -- LATIN SMALL LETTER Y WITH GRAVE .. LATIN SMALL LETTER Y WITH GRAVE + -1, -- LATIN SMALL LETTER Y WITH DOT BELOW .. LATIN SMALL LETTER Y WITH DOT BELOW + -1, -- LATIN SMALL LETTER Y WITH HOOK ABOVE .. LATIN SMALL LETTER Y WITH HOOK ABOVE + -1, -- LATIN SMALL LETTER Y WITH TILDE .. LATIN SMALL LETTER Y WITH TILDE + 8, -- GREEK SMALL LETTER ALPHA WITH PSILI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI + 8, -- GREEK SMALL LETTER EPSILON WITH PSILI .. GREEK SMALL LETTER EPSILON WITH DASIA AND OXIA + 8, -- GREEK SMALL LETTER ETA WITH PSILI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI + 8, -- GREEK SMALL LETTER IOTA WITH PSILI .. GREEK SMALL LETTER IOTA WITH DASIA AND PERISPOMENI + 8, -- GREEK SMALL LETTER OMICRON WITH PSILI .. GREEK SMALL LETTER OMICRON WITH DASIA AND OXIA + 8, -- GREEK SMALL LETTER UPSILON WITH DASIA .. GREEK SMALL LETTER UPSILON WITH DASIA + 8, -- GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA .. GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA + 8, -- GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA .. GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA + 8, -- GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI .. GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI + 8, -- GREEK SMALL LETTER OMEGA WITH PSILI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI + 74, -- GREEK SMALL LETTER ALPHA WITH VARIA .. GREEK SMALL LETTER ALPHA WITH OXIA + 86, -- GREEK SMALL LETTER EPSILON WITH VARIA .. GREEK SMALL LETTER ETA WITH OXIA + 100, -- GREEK SMALL LETTER IOTA WITH VARIA .. GREEK SMALL LETTER IOTA WITH OXIA + 128, -- GREEK SMALL LETTER OMICRON WITH VARIA .. GREEK SMALL LETTER OMICRON WITH OXIA + 112, -- GREEK SMALL LETTER UPSILON WITH VARIA .. GREEK SMALL LETTER UPSILON WITH OXIA + 126, -- GREEK SMALL LETTER OMEGA WITH VARIA .. GREEK SMALL LETTER OMEGA WITH OXIA + 8, -- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI + 8, -- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI + 8, -- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI + 8, -- GREEK SMALL LETTER ALPHA WITH VRACHY .. GREEK SMALL LETTER ALPHA WITH MACRON + 9, -- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI + -7205, -- GREEK PROSGEGRAMMENI .. GREEK PROSGEGRAMMENI + 9, -- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI + 8, -- GREEK SMALL LETTER IOTA WITH VRACHY .. GREEK SMALL LETTER IOTA WITH MACRON + 8, -- GREEK SMALL LETTER UPSILON WITH VRACHY .. GREEK SMALL LETTER UPSILON WITH MACRON + 7, -- GREEK SMALL LETTER RHO WITH DASIA .. GREEK SMALL LETTER RHO WITH DASIA + 9, -- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI + -32, -- FULLWIDTH LATIN SMALL LETTER A .. FULLWIDTH LATIN SMALL LETTER Z + -40); -- DESERET SMALL LETTER LONG I .. DESERET SMALL LETTER ENG + + ----------------------- + -- Local Subprograms -- + ----------------------- + + function Range_Search (U : Char_Code; R : UTF_32_Ranges) return Natural; + -- Searches the given ranges (which must be in ascending order by Lo value) + -- and returns the index of the matching range in R if U matches one of the + -- ranges. If U matches none of the ranges, returns zero. + + --------------------- + -- Is_UTF_32_Digit -- + --------------------- + + function Is_UTF_32_Digit (U : Char_Code) return Boolean is + begin + return Range_Search (U, UTF_32_Digits) /= 0; + end Is_UTF_32_Digit; + + ---------------------- + -- Is_UTF_32_Letter -- + ---------------------- + + function Is_UTF_32_Letter (U : Char_Code) return Boolean is + begin + return Range_Search (U, UTF_32_Letters) /= 0; + end Is_UTF_32_Letter; + + ------------------------------- + -- Is_UTF_32_Line_Terminator -- + ------------------------------- + + function Is_UTF_32_Line_Terminator (U : Char_Code) return Boolean is + begin + return U in 10 .. 13 -- Ascii.LF Ascii.VT Ascii.FF Ascii.CR + or else U = 16#02028# -- LINE SEPARATOR + or else U = 16#02029#; -- PARAGRAPH SEPARATOR + end Is_UTF_32_Line_Terminator; + + -------------------- + -- Is_UTF_32_Mark -- + -------------------- + + function Is_UTF_32_Mark (U : Char_Code) return Boolean is + begin + return Range_Search (U, UTF_32_Marks) /= 0; + end Is_UTF_32_Mark; + + --------------------------- + -- Is_UTF_32_Non_Graphic -- + --------------------------- + + function Is_UTF_32_Non_Graphic (U : Char_Code) return Boolean is + begin + return Range_Search (U, UTF_32_Non_Graphic) /= 0; + end Is_UTF_32_Non_Graphic; + + --------------------- + -- Is_UTF_32_Other -- + --------------------- + + function Is_UTF_32_Other (U : Char_Code) return Boolean is + begin + return Range_Search (U, UTF_32_Other_Format) /= 0; + end Is_UTF_32_Other; + + --------------------------- + -- Is_UTF_32_Punctuation -- + --------------------------- + + function Is_UTF_32_Punctuation (U : Char_Code) return Boolean is + begin + return Range_Search (U, UTF_32_Punctuation) /= 0; + end Is_UTF_32_Punctuation; + + --------------------- + -- Is_UTF_32_Space -- + --------------------- + + function Is_UTF_32_Space (U : Char_Code) return Boolean is + begin + return Range_Search (U, UTF_32_Spaces) /= 0; + end Is_UTF_32_Space; + --------------------------- -- Is_Start_Of_Wide_Char -- --------------------------- function Is_Start_Of_Wide_Char - (S : Source_Buffer_Ptr; - P : Source_Ptr) - return Boolean + (S : Source_Buffer_Ptr; + P : Source_Ptr) return Boolean is begin case Wide_Character_Encoding_Method is @@ -79,6 +1615,42 @@ package body Widechar is return WC_Longest_Sequence; end Length_Wide; + ------------------ + -- Range_Search -- + ------------------ + + function Range_Search (U : Char_Code; R : UTF_32_Ranges) return Natural is + Lo : Integer; + Hi : Integer; + Mid : Integer; + + begin + Lo := R'First; + Hi := R'Last; + + loop + Mid := (Lo + Hi) / 2; + + if U < R (Mid).Lo then + Hi := Mid - 1; + + if Hi < Lo then + return 0; + end if; + + elsif R (Mid).Hi < U then + Lo := Mid + 1; + + if Hi < Lo then + return 0; + end if; + + else + return Mid; + end if; + end loop; + end Range_Search; + --------------- -- Scan_Wide -- --------------- @@ -92,17 +1664,22 @@ package body Widechar is function In_Char return Character; -- Function to obtain characters of wide character escape sequence + ------------- + -- In_Char -- + ------------- + function In_Char return Character is begin P := P + 1; return S (P - 1); end In_Char; - function WC_In is new Char_Sequence_To_Wide_Char (In_Char); + function WC_In is new Char_Sequence_To_UTF_32 (In_Char); + + -- Start of processingf for Scan_Wide begin - C := Char_Code (Wide_Character'Pos - (WC_In (In_Char, Wide_Character_Encoding_Method))); + C := Char_Code (WC_In (In_Char, Wide_Character_Encoding_Method)); Err := False; exception @@ -124,16 +1701,22 @@ package body Widechar is procedure Out_Char (C : Character); -- Procedure to store one character of wide character sequence + -------------- + -- Out_Char -- + -------------- + procedure Out_Char (C : Character) is begin P := P + 1; S (P) := C; end Out_Char; - procedure WC_Out is new Wide_Char_To_Char_Sequence (Out_Char); + procedure WC_Out is new UTF_32_To_Char_Sequence (Out_Char); + + -- Start of processing for Set_Wide begin - WC_Out (Wide_Character'Val (C), Wide_Character_Encoding_Method); + WC_Out (UTF_32_Code (C), Wide_Character_Encoding_Method); end Set_Wide; --------------- @@ -144,19 +1727,68 @@ package body Widechar is function Skip_Char return Character; -- Function to skip one character of wide character escape sequence + --------------- + -- Skip_Char -- + --------------- + function Skip_Char return Character is begin P := P + 1; return S (P - 1); end Skip_Char; - function WC_Skip is new Char_Sequence_To_Wide_Char (Skip_Char); + function WC_Skip is new Char_Sequence_To_UTF_32 (Skip_Char); - Discard : Wide_Character; + Discard : UTF_32_Code; pragma Warnings (Off, Discard); + -- Start of processing for Skip_Wide + begin Discard := WC_Skip (Skip_Char, Wide_Character_Encoding_Method); end Skip_Wide; + --------------- + -- Skip_Wide -- + --------------- + + procedure Skip_Wide (S : Source_Buffer_Ptr; P : in out Source_Ptr) is + function Skip_Char return Character; + -- Function to skip one character of wide character escape sequence + + --------------- + -- Skip_Char -- + --------------- + + function Skip_Char return Character is + begin + P := P + 1; + return S (P - 1); + end Skip_Char; + + function WC_Skip is new Char_Sequence_To_UTF_32 (Skip_Char); + + Discard : UTF_32_Code; + pragma Warnings (Off, Discard); + + -- Start of processing for Skip_Wide + + begin + Discard := WC_Skip (Skip_Char, Wide_Character_Encoding_Method); + end Skip_Wide; + + -------------------------- + -- UTF_32_To_Upper_Case -- + -------------------------- + + function UTF_32_To_Upper_Case (U : Char_Code) return Char_Code is + Index : constant Integer := Range_Search (U, Lower_Case_Letters); + begin + if Index = 0 then + return U; + else + return U + Upper_Case_Adjust (Index); + end if; + end UTF_32_To_Upper_Case; + end Widechar; diff --git a/gcc/ada/widechar.ads b/gcc/ada/widechar.ads index 5126d4c758a..f70fb72d680 100644 --- a/gcc/ada/widechar.ads +++ b/gcc/ada/widechar.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-1998 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- -- @@ -31,7 +31,10 @@ -- -- ------------------------------------------------------------------------------ --- Subprograms for manipulation of wide character sequences +-- Subprograms for manipulation of wide character sequences. Note that in +-- this package, wide character and wide wide character are not distinguished +-- since this package is basically concerned with syntactic notions, and it +-- deals with Char_Code values, rather than values of actual Ada types. with Types; use Types; @@ -40,7 +43,8 @@ package Widechar is function Length_Wide return Nat; -- Returns the maximum length in characters for the escape sequence that -- is used to encode wide character literals outside the ASCII range. Used - -- only in the implementation of the attribute Width for Wide_Character. + -- only in the implementation of the attribute Width for Wide_Character + -- and Wide_Wide_Character. procedure Scan_Wide (S : Source_Buffer_Ptr; @@ -76,10 +80,88 @@ package Widechar is -- checking is done, since this is only used on escape sequences generated -- by Set_Wide, which are known to be correct. + procedure Skip_Wide (S : Source_Buffer_Ptr; P : in out Source_Ptr); + -- Similar to the above procedure, but operates on a source buffer + -- instead of a string, with P being a Source_Ptr referencing the + -- contents of the source buffer. + function Is_Start_Of_Wide_Char - (S : Source_Buffer_Ptr; - P : Source_Ptr) - return Boolean; + (S : Source_Buffer_Ptr; + P : Source_Ptr) return Boolean; -- Determines if S (P) is the start of a wide character sequence + function Is_UTF_32_Letter (U : Char_Code) return Boolean; + pragma Inline (Is_UTF_32_Letter); + -- Returns true iff U is a letter that can be used to start an identifier. + -- This means that it is in one of the following categories: + -- Letter, Uppercase (Lu) + -- Letter, Lowercase (Ll) + -- Letter, Titlecase (Lt) + -- Letter, Modifier (Lm) + -- Letter, Other (Lo) + -- Number, Letter (Nl) + + function Is_UTF_32_Digit (U : Char_Code) return Boolean; + pragma Inline (Is_UTF_32_Digit); + -- Returns true iff U is a digit that can be used to extend an identifer, + -- which means it is in one of the following categories: + -- Number, Decimal_Digit (Nd) + + function Is_UTF_32_Line_Terminator (U : Char_Code) return Boolean; + pragma Inline (Is_UTF_32_Line_Terminator); + -- Returns true iff U is an allowed line terminator for source programs, + -- which means it is in one of the following categories: + -- Separator, Line (Zl) + -- Separator, Paragraph (Zp) + -- or that it is a conventional line terminator (CR, LF, VT, FF) + + function Is_UTF_32_Mark (U : Char_Code) return Boolean; + pragma Inline (Is_UTF_32_Mark); + -- Returns true iff U is a mark character which can be used to extend + -- an identifier. This means it is in one of the following categories: + -- Mark, Non-Spacing (Mn) + -- Mark, Spacing Combining (Mc) + + function Is_UTF_32_Other (U : Char_Code) return Boolean; + pragma Inline (Is_UTF_32_Other); + -- Returns true iff U is an other format character, which means that it + -- can be used to extend an identifier, but is ignored for the purposes of + -- matching of identiers. This means that it is in one of the following + -- categories: + -- Other, Format (Cf) + + function Is_UTF_32_Punctuation (U : Char_Code) return Boolean; + pragma Inline (Is_UTF_32_Punctuation); + -- Returns true iff U is a punctuation character that can be used to + -- separate pices of an identifier. This means that it is in one of the + -- following categories: + -- Punctuation, Connector (Pc) + + function Is_UTF_32_Space (U : Char_Code) return Boolean; + pragma Inline (Is_UTF_32_Space); + -- Returns true iff U is considered a space to be ignored, which means + -- that it is in one of the following categories: + -- Separator, Space (Zs) + + function Is_UTF_32_Non_Graphic (U : Char_Code) return Boolean; + pragma Inline (Is_UTF_32_Non_Graphic); + -- Returns true iff U is considered to be a non-graphic character, + -- which means that it is in one of the following categories: + -- Other, Control (Cc) + -- Other, Private Use (Co) + -- Other, Surrogate (Cs) + -- Other, Format (Cf) + -- Separator, Line (Zl) + -- Separator, Paragraph (Zp) + -- + -- Note that the Ada category format effector is subsumed by the above + -- list of Unicode categories. + + function UTF_32_To_Upper_Case (U : Char_Code) return Char_Code; + pragma Inline (UTF_32_To_Upper_Case); + -- If U represents a lower case letter, returns the corresponding upper + -- case letter, otherwise U is returned unchanged. The folding is locale + -- independent as defined by documents referenced in the note in section + -- 1 of ISO/IEC 10646:2003 + end Widechar; |