diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e63452a5e93..b1be626e1a5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2014-07-16 Vincent Celier + + * make.adb: Do not read gnat.adc when gnatmake is invoked + with -gnatA. + +2014-07-16 Pascal Obry + + * gnat_rm.texi, impunit.adb, g-rewdat.adb, g-rewdat.ads: Initial + implementation of GNAT.Rewrite_Data. + 2014-07-16 Vincent Celier * gnatls.adb (Normalize): New function. diff --git a/gcc/ada/g-rewdat.adb b/gcc/ada/g-rewdat.adb new file mode 100644 index 00000000000..846ff9dcee8 --- /dev/null +++ b/gcc/ada/g-rewdat.adb @@ -0,0 +1,253 @@ +----------------------------------------------------------------------------- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . R E W R I T E _ D A T A -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2014, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Ada.Unchecked_Conversion; + +package body GNAT.Rewrite_Data is + + use Ada; + + subtype SEO is Stream_Element_Offset; + + procedure Do_Output + (B : in out Buffer; + Data : Stream_Element_Array; + Output : not null access procedure (Data : Stream_Element_Array)); + -- Do the actual output, this ensures that we properly send the data + -- through linked rewrite buffers if any. + + ------------ + -- Create -- + ------------ + + function Create + (Pattern, Value : String; + Size : Stream_Element_Offset := 1_024) return Buffer + is + + subtype SP is String (1 .. Pattern'Length); + subtype SEAP is Stream_Element_Array (1 .. Pattern'Length); + + subtype SV is String (1 .. Value'Length); + subtype SEAV is Stream_Element_Array (1 .. Value'Length); + + function To_SEAP is new Unchecked_Conversion (SP, SEAP); + function To_SEAV is new Unchecked_Conversion (SV, SEAV); + + begin + -- Return result (can't be smaller than pattern + + return B : Buffer + (SEO'Max (Size, SEO (Pattern'Length)), + SEO (Pattern'Length), + SEO (Value'Length)) + do + B.Pattern := To_SEAP (Pattern); + B.Value := To_SEAV (Value); + B.Pos_C := 0; + B.Pos_B := 0; + end return; + end Create; + + --------------- + -- Do_Output -- + --------------- + + procedure Do_Output + (B : in out Buffer; + Data : Stream_Element_Array; + Output : not null access procedure (Data : Stream_Element_Array)) + is + begin + if B.Next = null then + Output (Data); + else + Write (B.Next.all, Data, Output); + end if; + end Do_Output; + + ----------- + -- Flush -- + ----------- + + procedure Flush + (B : in out Buffer; + Output : not null access procedure (Data : Stream_Element_Array)) + is + begin + -- Flush output buffer + + if B.Pos_B > 0 then + Do_Output (B, B.Buffer (1 .. B.Pos_B), Output); + end if; + + -- Flush current buffer + + if B.Pos_C > 0 then + Do_Output (B, B.Current (1 .. B.Pos_C), Output); + end if; + + -- Flush linked buffer if any + + if B.Next /= null then + Flush (B.Next.all, Output); + end if; + + Reset (B); + end Flush; + + ---------- + -- Link -- + ---------- + + procedure Link (From : in out Buffer; To : Buffer_Ref) is + begin + From.Next := To; + end Link; + + ----------- + -- Reset -- + ----------- + + procedure Reset (B : in out Buffer) is + begin + B.Pos_B := 0; + B.Pos_C := 0; + + if B.Next /= null then + Reset (B.Next.all); + end if; + end Reset; + + ------------- + -- Rewrite -- + ------------- + + procedure Rewrite + (B : in out Buffer; + Input : not null access procedure + (Buffer : out Stream_Element_Array; + Last : out Stream_Element_Offset); + Output : not null access procedure (Data : Stream_Element_Array)) + is + Buffer : Stream_Element_Array (1 .. B.Size); + Last : Stream_Element_Offset; + + begin + Rewrite_All : loop + Input (Buffer, Last); + exit Rewrite_All when Last = 0; + Write (B, Buffer (1 .. Last), Output); + end loop Rewrite_All; + + Flush (B, Output); + end Rewrite; + + ---------- + -- Size -- + ---------- + + function Size (B : Buffer) return Natural is + begin + return Natural (B.Pos_B + B.Pos_C); + end Size; + + ----------- + -- Write -- + ----------- + + procedure Write + (B : in out Buffer; + Data : Stream_Element_Array; + Output : not null access procedure (Data : Stream_Element_Array)) + is + procedure Need_Space (Size : Stream_Element_Offset); + pragma Inline (Need_Space); + + ---------------- + -- Need_Space -- + ---------------- + + procedure Need_Space (Size : Stream_Element_Offset) is + begin + if B.Pos_B + Size > B.Size then + Do_Output (B, B.Buffer (1 .. B.Pos_B), Output); + B.Pos_B := 0; + end if; + end Need_Space; + + -- Start of processing for Write + + begin + if B.Size_Pattern = 0 then + Do_Output (B, Data, Output); + + else + for K in Data'Range loop + if Data (K) = B.Pattern (B.Pos_C + 1) then + + -- Store possible start of a match + + B.Pos_C := B.Pos_C + 1; + B.Current (B.Pos_C) := Data (K); + + else + -- Not part of pattern, if a start of a match was found, + -- remove it. + + if B.Pos_C /= 0 then + Need_Space (B.Pos_C); + + B.Buffer (B.Pos_B + 1 .. B.Pos_B + B.Pos_C) := + B.Current (1 .. B.Pos_C); + B.Pos_B := B.Pos_B + B.Pos_C; + B.Pos_C := 0; + end if; + + Need_Space (1); + B.Pos_B := B.Pos_B + 1; + B.Buffer (B.Pos_B) := Data (K); + end if; + + if B.Pos_C = B.Size_Pattern then + + -- The pattern is found + + Need_Space (B.Size_Value); + + B.Buffer (B.Pos_B + 1 .. B.Pos_B + B.Size_Value) := B.Value; + B.Pos_C := 0; + B.Pos_B := B.Pos_B + B.Size_Value; + end if; + end loop; + end if; + end Write; + +end GNAT.Rewrite_Data; diff --git a/gcc/ada/g-rewdat.ads b/gcc/ada/g-rewdat.ads new file mode 100644 index 00000000000..4fc8afd6461 --- /dev/null +++ b/gcc/ada/g-rewdat.ads @@ -0,0 +1,151 @@ +------------------------------------------------------------------------------ +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . R E W R I T E _ D A T A -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2014, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package can be used to rewrite data on the fly. All occurences of a +-- string (named pattern) will be replaced by another string. + +-- It is not necessary to load all data in memory and so this package can be +-- used for large data chunks like disk files for example. The pattern is +-- a standard string and not a regular expression. + +-- There is no dynamic allocation in the implementation. + +-- Example, to replace all occurences of "Gnat" with "GNAT": + +-- Rewriter : Buffer := Create (Pattern => "Gnat", Value => "GNAT"); + +-- The output procedure that will receive the rewritten data: + +-- procedure Do (Data : Stream_Element_Array) is +-- begin +-- +-- end Do; + +-- Then: + +-- Write (Rewriter, "Let's talk about Gnat compiler", Do'Access); +-- Write (Rewriter, "Gnat is an Ada compiler", Do'Access); +-- Flush (Rewriter, Do'Access); + +-- Another possible usage is to specify a method to get the input data: + +-- procedure Get +-- (Buffer : out Stream_Element_Array; +-- Last : out Stream_Element_Offset) +-- is +-- begin +-- +-- Last := ... +-- Buffer := ... +-- end Get; + +-- Then we can rewrite the whole file with: + +-- Rewrite (Rewriter, Input => Get'Access, Output => Do'Access); + +with Ada.Streams; use Ada.Streams; + +package GNAT.Rewrite_Data is + + type Buffer (<>) is limited private; + type Buffer_Ref is access all Buffer; + + function Create + (Pattern, Value : String; + Size : Stream_Element_Offset := 1_024) return Buffer; + -- Create a rewriter buffer. Pattern is the string to be rewriten as Value. + -- Size represent the size of the internal buffer used to store the data + -- reeady to be output. A larger buffer may improve the performance as the + -- Output routine (see Write, Rewrite below) will be called only when this + -- buffer is full. Note that Size cannot be lower than Pattern'Length, if + -- this is the case then Size value is set to Pattern'Length. + + function Size (B : Buffer) return Natural; + -- Returns the current size of the buffer (count of Stream_Array_Element) + + procedure Flush + (B : in out Buffer; + Output : not null access procedure (Data : Stream_Element_Array)); + -- Call Output for all remaining data in the buffer. The buffer is + -- reset and ready for another use after this call. + + procedure Reset (B : in out Buffer); + pragma Inline (Reset); + -- Clear all data in buffer, B is ready for another use. Note that this is + -- not needed after a Flush. Note: all data remaining in Buffer is lost. + + procedure Write + (B : in out Buffer; + Data : Stream_Element_Array; + Output : not null access procedure (Data : Stream_Element_Array)); + -- Write Data into the buffer, call Output for any prepared data. Flush + -- must be called when the last piece of Data as been sent in the Buffer. + + procedure Rewrite + (B : in out Buffer; + Input : not null access procedure + (Buffer : out Stream_Element_Array; + Last : out Stream_Element_Offset); + Output : not null access procedure (Data : Stream_Element_Array)); + -- Read data from Input, rewrite it and then call Output. When there is + -- no more data to be read from Input Last must be set to 0. Before leaving + -- this routine call Flush above to send all remaining data to Output. + + procedure Link (From : in out Buffer; To : Buffer_Ref); + -- Link two rewrite buffers, that is all data sent to From buffer will be + -- rewritten and then passed to the To rewrite buffer. + +private + + type Buffer + (Size, Size_Pattern, Size_Value : Stream_Element_Offset) is + limited record + Buffer : Stream_Element_Array (1 .. Size); + -- Fully prepared/rewritten data waiting to be output + + Current : Stream_Element_Array (1 .. Size_Pattern); + -- Current data checked, this buffer contains every piece of data + -- starting with the pattern. It means that at any point: + -- Current (1 .. Pos_C) = Pattern (1 .. Pos_C). + + Pattern : Stream_Element_Array (1 .. Size_Pattern); + -- The pattern to look for + + Value : Stream_Element_Array (1 .. Size_Value); + -- The value the pattern is replaced by + + Pos_C : Stream_Element_Offset; -- last valid element in Current + Pos_B : Stream_Element_Offset; -- last valid element in Buffer + + Next : Buffer_Ref; + -- A link to another rewriter if any + end record; + +end GNAT.Rewrite_Data; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index ee3abf6b73f..70b4c25c04a 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -594,6 +594,7 @@ The GNAT Library * GNAT.Regexp (g-regexp.ads):: * GNAT.Registry (g-regist.ads):: * GNAT.Regpat (g-regpat.ads):: +* GNAT.Rewrite_Data (g-rewdat.ads):: * GNAT.Secondary_Stack_Info (g-sestin.ads):: * GNAT.Semaphores (g-semaph.ads):: * GNAT.Serial_Communications (g-sercom.ads):: @@ -18464,6 +18465,7 @@ of GNAT, and will generate a warning message. * GNAT.Regexp (g-regexp.ads):: * GNAT.Registry (g-regist.ads):: * GNAT.Regpat (g-regpat.ads):: +* GNAT.Rewrite_Data (g-rewdat.ads):: * GNAT.Secondary_Stack_Info (g-sestin.ads):: * GNAT.Semaphores (g-semaph.ads):: * GNAT.Serial_Communications (g-sercom.ads):: @@ -19563,6 +19565,17 @@ A complete implementation of Unix-style regular expression matching, copied from the original V7 style regular expression library written in C by Henry Spencer (and binary compatible with this C library). +@node GNAT.Rewrite_Data (g-rewdat.ads) +@section @code{GNAT.Rewrite_Data} (@file{g-rewdat.ads}) +@cindex @code{GNAT.Rewrite_Data} (@file{g-rewdat.ads}) +@cindex Rewrite data + +@noindent +A unit to rewrite on-the-fly string occurrences in a stream of +data. The implementation has a very minimum memory footprint as the +full content to be processed is not loaded into memory. This makes +this implementation usable for large files or socket streams. + @node GNAT.Secondary_Stack_Info (g-sestin.ads) @section @code{GNAT.Secondary_Stack_Info} (@file{g-sestin.ads}) @cindex @code{GNAT.Secondary_Stack_Info} (@file{g-sestin.ads}) diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index de0cb0b2d15..ae7a5e29d97 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -291,6 +291,7 @@ package body Impunit is ("g-regexp", F), -- GNAT.Regexp ("g-regist", F), -- GNAT.Registry ("g-regpat", F), -- GNAT.Regpat + ("g-rewdat", F), -- GNAT.Rewrite_Data ("g-semaph", F), -- GNAT.Semaphores ("g-sercom", F), -- GNAT.Serial_Communications ("g-sestin", F), -- GNAT.Secondary_Stack_Info diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 74be6988cfa..ebd2bfd9a52 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -6671,13 +6671,15 @@ package body Make is Fname.UF.Initialize; - begin - Fname.SF.Read_Source_File_Name_Pragmas; + if Config_File then + begin + Fname.SF.Read_Source_File_Name_Pragmas; - exception - when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC => - Make_Failed (Exception_Message (Err)); - end; + exception + when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC => + Make_Failed (Exception_Message (Err)); + end; + end if; end if; -- Make sure no project object directory is recorded @@ -7907,6 +7909,12 @@ package body Make is Do_Link_Step := False; end if; + -- If -gnatA is specified, make sure that gnat.adc is never read + + elsif Argv'Length >= 6 and then Argv (2 .. 6) = "gnatA" then + Add_Switch (Argv, Compiler, And_Save => And_Save); + Opt.Config_File := False; + elsif Argv (2 .. Argv'Last) = "nostdlib" then -- Pass -nstdlib to gnatbind and gnatlink