From 008f6fd3f92a521324ba4fd26bd17aad0f7cbef5 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 21 Jun 2010 15:26:24 +0200 Subject: [PATCH] [multiple changes] 2010-06-21 Pascal Obry * prj-nmsc.adb (Search_Directories): Use the non-translated directory path to open it. 2010-06-21 Javier Miranda * exp_cg.adb (Write_Call_Info): Fill the component sourcename using the external name. 2010-06-21 Ed Schonberg * exp_ch4.adb (Expand_Concatenate): If an object declaration is created to hold the result, indicate that the target of the declaration does not need an initialization, to prevent spurious errors when Initialize_Scalars is enabled. 2010-06-21 Ed Schonberg * a-tifiio.adb (Put): In the procedure that performs I/O on a String, Fore is not bound by line length. The Fore parameter of the internal procedure that performs the operation is an integer. 2010-06-21 Thomas Quinot * sem_res.adb, checks.adb: Minor reformatting. 2010-06-21 Emmanuel Briot * s-regpat.adb (Next_Instruction, Get_Next_Offset): Removed, merged into Get_Next. (Insert_Operator_Before): New subprogram, avoids duplicated code (Compile): Avoid doing two compilations when the pattern matcher ends up being small. From-SVN: r161074 --- gcc/ada/ChangeLog | 35 +++++++ gcc/ada/a-tifiio.adb | 12 ++- gcc/ada/checks.adb | 2 +- gcc/ada/exp_cg.adb | 4 +- gcc/ada/exp_ch4.adb | 3 + gcc/ada/prj-nmsc.adb | 26 +++-- gcc/ada/s-regpat.adb | 241 +++++++++++++++++-------------------------- gcc/ada/sem_res.adb | 2 +- 8 files changed, 162 insertions(+), 163 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a79fef6beeb..71627b22ca4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,38 @@ +2010-06-21 Pascal Obry + + * prj-nmsc.adb (Search_Directories): Use the non-translated directory + path to open it. + +2010-06-21 Javier Miranda + + * exp_cg.adb (Write_Call_Info): Fill the component sourcename using the + external name. + +2010-06-21 Ed Schonberg + + * exp_ch4.adb (Expand_Concatenate): If an object declaration is created + to hold the result, indicate that the target of the declaration does + not need an initialization, to prevent spurious errors when + Initialize_Scalars is enabled. + +2010-06-21 Ed Schonberg + + * a-tifiio.adb (Put): In the procedure that performs I/O on a String, + Fore is not bound by line length. The Fore parameter of the internal + procedure that performs the operation is an integer. + +2010-06-21 Thomas Quinot + + * sem_res.adb, checks.adb: Minor reformatting. + +2010-06-21 Emmanuel Briot + + * s-regpat.adb (Next_Instruction, Get_Next_Offset): Removed, merged + into Get_Next. + (Insert_Operator_Before): New subprogram, avoids duplicated code + (Compile): Avoid doing two compilations when the pattern matcher ends + up being small. + 2010-06-21 Emmanuel Briot * s-regpat.adb: Improve debug traces diff --git a/gcc/ada/a-tifiio.adb b/gcc/ada/a-tifiio.adb index 73ebc006251..28267ad85fc 100644 --- a/gcc/ada/a-tifiio.adb +++ b/gcc/ada/a-tifiio.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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,10 +301,14 @@ package body Ada.Text_IO.Fixed_IO is (To : out String; Last : out Natural; Item : Num; - Fore : Field; + Fore : Integer; Aft : Field; Exp : Field); -- Actual output function, used internally by all other Put routines + -- The formal Fore is an Integer, not a Field, because the routine is + -- also called from the version of Put that performs I/O to a string, + -- where the starting position depends on the size of the String, and + -- bears no relation to the bounds of Field. --------- -- Get -- @@ -392,7 +396,7 @@ package body Ada.Text_IO.Fixed_IO is Last : Natural; begin - if Fore - Boolean'Pos (Item < 0.0) < 1 or else Fore > Field'Last then + if Fore - Boolean'Pos (Item < 0.0) < 1 then raise Layout_Error; end if; @@ -407,7 +411,7 @@ package body Ada.Text_IO.Fixed_IO is (To : out String; Last : out Natural; Item : Num; - Fore : Field; + Fore : Integer; Aft : Field; Exp : Field) is diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 6e39661213f..0f18fbc5823 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6477,7 +6477,7 @@ package body Checks is -- current discriminal, which is the renaming within -- the task body. - Disc := First_Discriminant (Tsk); + Disc := First_Discriminant (Tsk); while Present (Disc) loop if Chars (Disc) = Chars (Entity (Bound)) then Set_Scope (Discriminal (Disc), Tsk); diff --git a/gcc/ada/exp_cg.adb b/gcc/ada/exp_cg.adb index f307e98619e..fcfbb263ac3 100644 --- a/gcc/ada/exp_cg.adb +++ b/gcc/ada/exp_cg.adb @@ -28,6 +28,7 @@ with Debug; use Debug; with Einfo; use Einfo; with Elists; use Elists; with Exp_Disp; use Exp_Disp; +with Exp_Dbug; use Exp_Dbug; with Exp_Tss; use Exp_Tss; with Lib; use Lib; with Namet; use Namet; @@ -392,7 +393,8 @@ package body Exp_CG is Write_Str ("edge: { sourcename: "); Write_Char ('"'); - Write_Name (Chars (Defining_Entity (P))); + Get_External_Name (Defining_Entity (P), Has_Suffix => False); + Write_Str (Name_Buffer (1 .. Name_Len)); if Nkind (P) = N_Package_Declaration then Write_Str ("___elabs"); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index bf35c42ae52..c19024aa44b 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -2827,8 +2827,11 @@ package body Exp_Ch4 is Insert_Actions (Cnode, Actions, Suppress => All_Checks); -- Now we construct an array object with appropriate bounds + -- The target is marked as internal, to prevent useless initialization + -- when Initialize_Scalars is enabled. Ent := Make_Temporary (Loc, 'S'); + Set_Is_Internal (Ent); -- If the bound is statically known to be out of range, we do not want -- to abort, we want a warning and a runtime constraint error. Note that diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 74a256d6986..9e114f6ae8d 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -4788,8 +4788,8 @@ package body Prj.Nmsc is --------------------- procedure Get_Directories - (Project : Project_Id; - Data : in out Tree_Processing_Data) + (Project : Project_Id; + Data : in out Tree_Processing_Data) is package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable (Header_Num => Header_Num, @@ -6839,12 +6839,18 @@ package body Prj.Nmsc is declare -- We use Element.Value, not Display_Value, because we want -- the symbolic links to be resolved when appropriate. - Source_Directory : constant String := - Get_Name_String (Element.Value) - & Directory_Separator; - Dir_Last : constant Natural := - Compute_Directory_Last - (Source_Directory); + Source_Directory : constant String := + Get_Name_String (Element.Value) + & Directory_Separator; + Dir_Last : constant Natural := + Compute_Directory_Last + (Source_Directory); + -- The Display_Source_Directory is to be able to open an + -- UTF-8 encoded directory on Windows. + Display_Source_Directory : constant String := + Get_Name_String + (Element.Display_Value) + & Directory_Separator; begin if Current_Verbosity = High then @@ -6856,7 +6862,7 @@ package body Prj.Nmsc is -- We look to every entry in the source directory - Open (Dir, Source_Directory); + Open (Dir, Display_Source_Directory); loop Read (Dir, Name, Last); @@ -6871,7 +6877,7 @@ package body Prj.Nmsc is if not Opt.Follow_Links_For_Files or else Is_Regular_File - (Source_Directory & Name (1 .. Last)) + (Display_Source_Directory & Name (1 .. Last)) then if Current_Verbosity = High then Write_Str (" Checking "); diff --git a/gcc/ada/s-regpat.adb b/gcc/ada/s-regpat.adb index 0a0ace5cee5..517256aff77 100755 --- a/gcc/ada/s-regpat.adb +++ b/gcc/ada/s-regpat.adb @@ -50,13 +50,6 @@ package body System.Regpat is Debug : constant Boolean := False; -- Set to True to activate debug traces - MAGIC : constant Character := Character'Val (10#0234#); - -- The first byte of the regexp internal "program" is actually - -- this magic number; the start node begins in the second byte. - -- - -- This is used to make sure that a regular expression was correctly - -- compiled. - ---------------------------- -- Implementation details -- ---------------------------- @@ -79,21 +72,19 @@ package body System.Regpat is -- You can see the exact byte-compiled version by using the Dump -- subprogram. However, here are a few examples: - -- (a|b): 1 : MAGIC - -- 2 : BRANCH (next at 10) - -- 5 : EXACT (next at 18) operand=a - -- 10 : BRANCH (next at 18) - -- 13 : EXACT (next at 18) operand=b - -- 18 : EOP (next at 0) + -- (a|b): 1 : BRANCH (next at 9) + -- 4 : EXACT (next at 17) operand=a + -- 9 : BRANCH (next at 17) + -- 12 : EXACT (next at 17) operand=b + -- 17 : EOP (next at 0) -- - -- (ab)*: 1 : MAGIC - -- 2 : CURLYX (next at 26) { 0, 32767} - -- 9 : OPEN 1 (next at 13) - -- 13 : EXACT (next at 19) operand=ab - -- 19 : CLOSE 1 (next at 23) - -- 23 : WHILEM (next at 0) - -- 26 : NOTHING (next at 29) - -- 29 : EOP (next at 0) + -- (ab)*: 1 : CURLYX (next at 25) { 0, 32767} + -- 8 : OPEN 1 (next at 12) + -- 12 : EXACT (next at 18) operand=ab + -- 18 : CLOSE 1 (next at 22) + -- 22 : WHILEM (next at 0) + -- 25 : NOTHING (next at 28) + -- 28 : EOP (next at 0) -- The opcodes are: @@ -282,11 +273,6 @@ package body System.Regpat is Op : out Character_Class); -- Return a pointer to the string argument of the node at P - function Get_Next_Offset - (Program : Program_Data; - IP : Pointer) return Pointer; - -- Get the offset field of a node. Used by Get_Next - function Get_Next (Program : Program_Data; IP : Pointer) return Pointer; @@ -306,7 +292,6 @@ package body System.Regpat is pragma Inline (Is_Alnum); pragma Inline (Is_White_Space); pragma Inline (Get_Next); - pragma Inline (Get_Next_Offset); pragma Inline (Operand); pragma Inline (Read_Natural); pragma Inline (String_Length); @@ -389,7 +374,6 @@ package body System.Regpat is PM : Pattern_Matcher renames Matcher; Program : Program_Data renames PM.Program; - Emit_Code : constant Boolean := PM.Size > 0; Emit_Ptr : Pointer := Program_First; Parse_Pos : Natural := Expression'First; -- Input-scan pointer @@ -456,6 +440,17 @@ package body System.Regpat is -- This applies to PLUS and STAR. -- If Minmod is True, then the operator is non-greedy. + function Insert_Operator_Before + (Op : Opcode; + Operand : Pointer; + Greedy : Boolean; + Opsize : Pointer) return Pointer; + -- Insert an operator before Operand (and move the latter forward in the + -- program). Opsize is the size needed to represent the operator. + -- This returns the position at which the operator was + -- inserted, and moves Emit_Ptr after the new position of the + -- operand. + procedure Insert_Curly_Operator (Op : Opcode; Min : Natural; @@ -471,9 +466,6 @@ package body System.Regpat is procedure Link_Operand_Tail (P, Val : Pointer); -- Link_Tail on operand of first argument; noop if operand-less - function Next_Instruction (P : Pointer) return Pointer; - -- Dig the "next" pointer out of a node - procedure Fail (M : String); pragma No_Return (Fail); -- Fail with a diagnostic message, if possible @@ -533,7 +525,7 @@ package body System.Regpat is procedure Emit (B : Character) is begin - if Emit_Code then + if Emit_Ptr <= PM.Size then Program (Emit_Ptr) := B; end if; @@ -551,7 +543,7 @@ package body System.Regpat is (Character_Class, Program31); begin - if Emit_Code then + if Emit_Ptr + 31 <= PM.Size then Program (Emit_Ptr .. Emit_Ptr + 31) := Convert (Bitmap); end if; @@ -564,7 +556,7 @@ package body System.Regpat is procedure Emit_Natural (IP : Pointer; N : Natural) is begin - if Emit_Code then + if IP + 1 <= PM.Size then Program (IP + 1) := Character'Val (N / 256); Program (IP) := Character'Val (N mod 256); end if; @@ -578,7 +570,7 @@ package body System.Regpat is Result : constant Pointer := Emit_Ptr; begin - if Emit_Code then + if Emit_Ptr + 2 <= PM.Size then Program (Emit_Ptr) := Character'Val (Opcode'Pos (Op)); Program (Emit_Ptr + 1) := ASCII.NUL; Program (Emit_Ptr + 2) := ASCII.NUL; @@ -659,12 +651,29 @@ package body System.Regpat is Operand : Pointer; Greedy : Boolean := True) is - Dest : constant Pointer := Emit_Ptr; Old : Pointer; - Size : Pointer := 7; + begin + Old := Insert_Operator_Before (Op, Operand, Greedy, Opsize => 7); + Emit_Natural (Old + 3, Min); + Emit_Natural (Old + 5, Max); + end Insert_Curly_Operator; + + ---------------------------- + -- Insert_Operator_Before -- + ---------------------------- + + function Insert_Operator_Before + (Op : Opcode; + Operand : Pointer; + Greedy : Boolean; + Opsize : Pointer) return Pointer + is + Dest : constant Pointer := Emit_Ptr; + Old : Pointer; + Size : Pointer := Opsize; begin - -- If the operand is not greedy, insert an extra operand before it + -- If not greedy, we have to emit another opcode first if not Greedy then Size := Size + 3; @@ -673,7 +682,7 @@ package body System.Regpat is -- Move the operand in the byte-compilation, so that we can insert -- the operator before it. - if Emit_Code then + if Emit_Ptr + Size <= PM.Size then Program (Operand + Size .. Emit_Ptr + Size) := Program (Operand .. Emit_Ptr); end if; @@ -689,11 +698,9 @@ package body System.Regpat is end if; Old := Emit_Node (Op); - Emit_Natural (Old + 3, Min); - Emit_Natural (Old + 5, Max); - Emit_Ptr := Dest + Size; - end Insert_Curly_Operator; + return Old; + end Insert_Operator_Before; --------------------- -- Insert_Operator -- @@ -704,40 +711,10 @@ package body System.Regpat is Operand : Pointer; Greedy : Boolean := True) is - Dest : constant Pointer := Emit_Ptr; - Old : Pointer; - Size : Pointer := 3; - Discard : Pointer; pragma Warnings (Off, Discard); - begin - -- If not greedy, we have to emit another opcode first - - if not Greedy then - Size := Size + 3; - end if; - - -- Move the operand in the byte-compilation, so that we can insert - -- the operator before it. - - if Emit_Code then - Program (Operand + Size .. Emit_Ptr + Size) := - Program (Operand .. Emit_Ptr); - end if; - - -- Insert the operator at the position previously occupied by the - -- operand. - - Emit_Ptr := Operand; - - if not Greedy then - Old := Emit_Node (MINMOD); - Link_Tail (Old, Old + 3); - end if; - - Discard := Emit_Node (Op); - Emit_Ptr := Dest + Size; + Discard := Insert_Operator_Before (Op, Operand, Greedy, Opsize => 3); end Insert_Operator; ----------------------- @@ -804,7 +781,7 @@ package body System.Regpat is procedure Link_Operand_Tail (P, Val : Pointer) is begin - if Emit_Code and then Program (P) = BRANCH then + if Program (P) = BRANCH then Link_Tail (Operand (P), Val); end if; end Link_Operand_Tail; @@ -819,7 +796,7 @@ package body System.Regpat is Offset : Pointer; begin - if not Emit_Code then + if Emit_Ptr > PM.Size then return; end if; @@ -827,8 +804,8 @@ package body System.Regpat is Scan := P; loop - Temp := Next_Instruction (Scan); - exit when Temp = 0; + Temp := Get_Next (Program, Scan); + exit when Temp = Scan; Scan := Temp; end loop; @@ -837,27 +814,6 @@ package body System.Regpat is Emit_Natural (Scan + 1, Natural (Offset)); end Link_Tail; - ---------------------- - -- Next_Instruction -- - ---------------------- - - function Next_Instruction (P : Pointer) return Pointer is - Offset : Pointer; - - begin - if not Emit_Code then - return 0; - end if; - - Offset := Get_Next_Offset (Program, P); - - if Offset = 0 then - return 0; - end if; - - return P + Offset; - end Next_Instruction; - ----------- -- Parse -- ----------- @@ -873,7 +829,7 @@ package body System.Regpat is IP : out Pointer) is E : String renames Expression; - Br : Pointer; + Br, Br2 : Pointer; Ender : Pointer; Par_No : Natural; New_Flags : Expression_Flags; @@ -964,9 +920,10 @@ package body System.Regpat is Br := IP; loop - exit when Br = 0; Link_Operand_Tail (Br, Ender); - Br := Next_Instruction (Br); + Br2 := Get_Next (Program, Br); + exit when Br2 = Br; + Br := Br2; end loop; end if; @@ -1665,7 +1622,7 @@ package body System.Regpat is Parse_Pos := Start_Pos; end if; - if Emit_Code then + if Length_Ptr <= PM.Size then Program (Length_Ptr) := Character'Val (Emit_Ptr - Length_Ptr - 2); end if; @@ -2007,7 +1964,6 @@ package body System.Regpat is -- Start of processing for Compile begin - Emit (MAGIC); Parse (False, Expr_Flags, Result); if Result = 0 then @@ -2019,7 +1975,7 @@ package body System.Regpat is -- Do we want to actually compile the expression, or simply get the -- code size ??? - if Emit_Code then + if Emit_Ptr <= PM.Size then Optimize (PM); end if; @@ -2030,19 +1986,37 @@ package body System.Regpat is (Expression : String; Flags : Regexp_Flags := No_Flags) return Pattern_Matcher is + -- Assume the compiled regexp will fit in 1000 chars. If it does not + -- we will have to compile a second time once the correct size is + -- known. If it fits, we save a significant amount of time by avoiding + -- the second compilation. + Dummy : Pattern_Matcher (1000); Size : Program_Size; - Dummy : Pattern_Matcher (0); - pragma Unreferenced (Dummy); begin Compile (Dummy, Expression, Size, Flags); - declare - Result : Pattern_Matcher (Size); - begin - Compile (Result, Expression, Size, Flags); - return Result; - end; + if Size <= Dummy.Size then + return Pattern_Matcher' + (Size => Size, + First => Dummy.First, + Anchored => Dummy.Anchored, + Must_Have => Dummy.Must_Have, + Must_Have_Length => Dummy.Must_Have_Length, + Paren_Count => Dummy.Paren_Count, + Flags => Dummy.Flags, + Program => Dummy.Program + (Dummy.Program'First .. Dummy.Program'First + Size - 1)); + else + -- We have to recompile now that we know the size + -- ??? Can we use Ada05's return construct ? + declare + Result : Pattern_Matcher (Size); + begin + Compile (Result, Expression, Size, Flags); + return Result; + end; + end if; end Compile; procedure Compile @@ -2051,9 +2025,11 @@ package body System.Regpat is Flags : Regexp_Flags := No_Flags) is Size : Program_Size; - pragma Unreferenced (Size); begin Compile (Matcher, Expression, Size, Flags); + if Size > Matcher.Size then + raise Expression_Error with "Pattern_Matcher is too small"; + end if; end Compile; -------------------- @@ -2101,7 +2077,7 @@ package body System.Regpat is begin while Index < Till loop Op := Opcode'Val (Character'Pos ((Program (Index)))); - Next := Index + Get_Next_Offset (Program, Index); + Next := Get_Next (Program, Index); if Do_Print then declare @@ -2254,14 +2230,11 @@ package body System.Regpat is procedure Dump (Self : Pattern_Matcher) is Program : Program_Data renames Self.Program; - Index : Pointer := Program'First + 1; + Index : Pointer := Program'First; -- Start of processing for Dump begin - pragma Assert (Self.Program (Program_First) = MAGIC, - "Corrupted Pattern_Matcher"); - Put_Line ("Must start with (Self.First) = " & Character'Image (Self.First)); @@ -2277,7 +2250,6 @@ package body System.Regpat is Put_Line (" Multiple_Lines mode"); end if; - Put_Line (" 1:MAGIC"); Dump_Until (Program, Index, Self.Program'Last + 1, 0); end Dump; @@ -2300,27 +2272,10 @@ package body System.Regpat is -------------- function Get_Next (Program : Program_Data; IP : Pointer) return Pointer is - Offset : constant Pointer := Get_Next_Offset (Program, IP); begin - if Offset = 0 then - return 0; - else - return IP + Offset; - end if; + return IP + Pointer (Read_Natural (Program, IP + 1)); end Get_Next; - --------------------- - -- Get_Next_Offset -- - --------------------- - - function Get_Next_Offset - (Program : Program_Data; - IP : Pointer) return Pointer - is - begin - return Pointer (Read_Natural (Program, IP + 1)); - end Get_Next_Offset; - -------------- -- Is_Alnum -- -------------- @@ -3366,7 +3321,7 @@ package body System.Regpat is Last_Paren := 0; Matches_Full := (others => No_Match); - if Match (Program_First + 1) then + if Match (Program_First) then Matches_Full (0) := (Pos, Input_Pos - 1); return True; end if; @@ -3384,12 +3339,6 @@ package body System.Regpat is return; end if; - -- Check validity of program - - pragma Assert - (Program (Program_First) = MAGIC, - "Corrupted Pattern_Matcher"); - -- If there is a "must appear" string, look for it if Self.Must_Have_Length > 0 then @@ -3618,7 +3567,7 @@ package body System.Regpat is Self.Must_Have := Program'Last + 1; Self.Must_Have_Length := 0; - Scan := Program_First + 1; -- First instruction (can be anything) + Scan := Program_First; -- First instruction (can be anything) if Program (Scan) = EXACT then Self.First := Program (String_Operand (Scan)); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 0e81df1cdb4..86ee044c40d 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5906,7 +5906,7 @@ package body Sem_Res is -- to the discriminant of the same name in the target task. If the -- entry name is the target of a requeue statement and the entry is -- in the current protected object, the bound to be used is the - -- discriminal of the object (see apply_range_checks for details of + -- discriminal of the object (see Apply_Range_Checks for details of -- the transformation). ----------------------------- -- 2.30.2