URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [a-clrefi.adb] - Blame information for rev 297

Go to most recent revision | Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT RUN-TIME COMPONENTS                         --
--                                                                          --
--       A D A . C O M M A N D _ L I N E . R E S P O N S E _ F I L E        --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2007-2009, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
pragma Compiler_Unit;
 
with Ada.Unchecked_Deallocation;
 
with System.OS_Lib; use System.OS_Lib;
 
package body Ada.Command_Line.Response_File is
 
   type File_Rec;
   type File_Ptr is access File_Rec;
   type File_Rec is record
      Name : String_Access;
      Next : File_Ptr;
      Prev : File_Ptr;
   end record;
   --  To build a stack of response file names
 
   procedure Free is new Ada.Unchecked_Deallocation (File_Rec, File_Ptr);
 
   type Argument_List_Access is access Argument_List;
   procedure Free is new Ada.Unchecked_Deallocation
     (Argument_List, Argument_List_Access);
   --  Free only the allocated Argument_List, not allocated String components
 
   --------------------
   -- Arguments_From --
   --------------------
 
   function Arguments_From
     (Response_File_Name        : String;
      Recursive                 : Boolean := False;
      Ignore_Non_Existing_Files : Boolean := False)
      return Argument_List
   is
      First_File : File_Ptr := null;
      Last_File  : File_Ptr := null;
      --  The stack of response files
 
      Arguments  : Argument_List_Access := new Argument_List (1 .. 4);
      Last_Arg   : Natural := 0;
 
      procedure Add_Argument (Arg : String);
      --  Add argument Arg to argument list Arguments, increasing Arguments
      --  if necessary.
 
      procedure Recurse (File_Name : String);
      --  Get the arguments from the file and call itself recursively if one of
      --  the argument starts with character '@'.
 
      ------------------
      -- Add_Argument --
      ------------------
 
      procedure Add_Argument (Arg : String) is
      begin
         if Last_Arg = Arguments'Last then
            declare
               New_Arguments : constant Argument_List_Access :=
                                 new Argument_List (1 .. Arguments'Last * 2);
            begin
               New_Arguments (Arguments'Range) := Arguments.all;
               Arguments.all := (others => null);
               Free (Arguments);
               Arguments := New_Arguments;
            end;
         end if;
 
         Last_Arg := Last_Arg + 1;
         Arguments (Last_Arg) := new String'(Arg);
      end Add_Argument;
 
      -------------
      -- Recurse --
      -------------
 
      procedure Recurse (File_Name : String) is
         FD : File_Descriptor;
 
         Buffer_Size : constant := 1500;
         Buffer : String (1 .. Buffer_Size);
 
         Buffer_Length : Natural;
 
         Buffer_Cursor : Natural;
 
         End_Of_File_Reached : Boolean;
 
         Line : String (1 .. Max_Line_Length + 1);
         Last : Natural;
 
         First_Char : Positive;
         --  Index of the first character of an argument in Line
 
         Last_Char : Natural;
         --  Index of the last character of an argument in Line
 
         In_String : Boolean;
         --  True when inside a quoted string
 
         Arg : Positive;
 
         function End_Of_File return Boolean;
         --  True when the end of the response file has been reached
 
         procedure Get_Buffer;
         --  Read one buffer from the response file
 
         procedure Get_Line;
         --  Get one line from the response file
 
         -----------------
         -- End_Of_File --
         -----------------
 
         function End_Of_File return Boolean is
         begin
            return End_Of_File_Reached and then Buffer_Cursor > Buffer_Length;
         end End_Of_File;
 
         ----------------
         -- Get_Buffer --
         ----------------
 
         procedure Get_Buffer is
         begin
            Buffer_Length := Read (FD, Buffer (1)'Address, Buffer'Length);
            End_Of_File_Reached := Buffer_Length < Buffer'Length;
            Buffer_Cursor := 1;
         end Get_Buffer;
 
         --------------
         -- Get_Line --
         --------------
 
         procedure Get_Line is
            Ch : Character;
 
         begin
            Last := 0;
 
            if End_Of_File then
               return;
            end if;
 
            loop
               Ch := Buffer (Buffer_Cursor);
 
               exit when Ch = ASCII.CR or else
                         Ch = ASCII.LF or else
                         Ch = ASCII.FF;
 
               Last := Last + 1;
               Line (Last) := Ch;
 
               if Last = Line'Last then
                  return;
               end if;
 
               Buffer_Cursor := Buffer_Cursor + 1;
 
               if Buffer_Cursor > Buffer_Length then
                  Get_Buffer;
 
                  if End_Of_File then
                     return;
                  end if;
               end if;
            end loop;
 
            loop
               Ch := Buffer (Buffer_Cursor);
 
               exit when Ch /= ASCII.HT and then
                         Ch /= ASCII.LF and then
                         Ch /= ASCII.FF;
 
               Buffer_Cursor := Buffer_Cursor + 1;
 
               if Buffer_Cursor > Buffer_Length then
                  Get_Buffer;
 
                  if End_Of_File then
                     return;
                  end if;
               end if;
            end loop;
         end Get_Line;
 
      --  Start or Recurse
 
      begin
         Last_Arg := 0;
 
         --  Open the response file. If not found, fail or report a warning,
         --  depending on the value of Ignore_Non_Existing_Files.
 
         FD := Open_Read (File_Name, Text);
 
         if FD = Invalid_FD then
            if Ignore_Non_Existing_Files then
               return;
            else
               raise File_Does_Not_Exist;
            end if;
         end if;
 
         --  Put the response file name on the stack
 
         if First_File = null then
            First_File :=
              new File_Rec'
                (Name => new String'(File_Name),
                 Next => null,
                 Prev => null);
            Last_File  := First_File;
 
         else
            declare
               Current : File_Ptr := First_File;
 
            begin
               loop
                  if Current.Name.all = File_Name then
                     raise Circularity_Detected;
                  end if;
 
                  Current := Current.Next;
                  exit when Current = null;
               end loop;
 
               Last_File.Next :=
                 new File_Rec'
                   (Name => new String'(File_Name),
                    Next => null,
                    Prev => Last_File);
               Last_File := Last_File.Next;
            end;
         end if;
 
         End_Of_File_Reached := False;
         Get_Buffer;
 
         --  Read the response file line by line
 
         Line_Loop :
         while not End_Of_File loop
            Get_Line;
 
            if Last = Line'Last then
               raise Line_Too_Long;
            end if;
 
            First_Char := 1;
 
            --  Get each argument on the line
 
            Arg_Loop :
            loop
               --  First, skip any white space
 
               while First_Char <= Last loop
                  exit when Line (First_Char) /= ' ' and then
                            Line (First_Char) /= ASCII.HT;
                  First_Char := First_Char + 1;
               end loop;
 
               exit Arg_Loop when First_Char > Last;
 
               Last_Char := First_Char;
               In_String := False;
 
               --  Get the character one by one
 
               Character_Loop :
               while Last_Char <= Last loop
 
                  --  Inside a string, check only for '"'
 
                  if In_String then
                     if Line (Last_Char) = '"' then
 
                        --  Remove the '"'
 
                        Line (Last_Char .. Last - 1) :=
                          Line (Last_Char + 1 .. Last);
                        Last := Last - 1;
 
                        --  End of string is end of argument
 
                        if Last_Char > Last or else
                          Line (Last_Char) = ' ' or else
                          Line (Last_Char) = ASCII.HT
                        then
                           In_String := False;
 
                           Last_Char := Last_Char - 1;
                           exit Character_Loop;
 
                        else
                           --  If there are two consecutive '"', the quoted
                           --  string is not closed
 
                           In_String := Line (Last_Char) = '"';
 
                           if In_String then
                              Last_Char := Last_Char + 1;
                           end if;
                        end if;
 
                     else
                        Last_Char := Last_Char + 1;
                     end if;
 
                  elsif Last_Char = Last then
 
                     --  An opening '"' at the end of the line is an error
 
                     if Line (Last) = '"' then
                        raise No_Closing_Quote;
 
                     else
                        --  The argument ends with the line
 
                        exit Character_Loop;
                     end if;
 
                  elsif Line (Last_Char) = '"' then
 
                     --  Entering a quoted string: remove the '"'
 
                     In_String := True;
                     Line (Last_Char .. Last - 1) :=
                       Line (Last_Char + 1 .. Last);
                     Last := Last - 1;
 
                  else
                     --  Outside quoted strings, white space ends the argument
 
                     exit Character_Loop
                          when Line (Last_Char + 1) = ' ' or else
                               Line (Last_Char + 1) = ASCII.HT;
 
                     Last_Char := Last_Char + 1;
                  end if;
               end loop Character_Loop;
 
               --  It is an error to not close a quoted string before the end
               --  of the line.
 
               if In_String then
                  raise No_Closing_Quote;
               end if;
 
               --  Add the argument to the list
 
               declare
                  Arg : String (1 .. Last_Char - First_Char + 1);
               begin
                  Arg := Line (First_Char .. Last_Char);
                  Add_Argument (Arg);
               end;
 
               --  Next argument, if line is not finished
 
               First_Char := Last_Char + 1;
            end loop Arg_Loop;
         end loop Line_Loop;
 
         Close (FD);
 
         --  If Recursive is True, check for any argument starting with '@'
 
         if Recursive then
            Arg := 1;
            while Arg <= Last_Arg loop
 
               if Arguments (Arg)'Length > 0 and then
                  Arguments (Arg) (1) = '@'
               then
                  --  Ignore argument "@" with no file name
 
                  if Arguments (Arg)'Length = 1 then
                     Arguments (Arg .. Last_Arg - 1) :=
                       Arguments (Arg + 1 .. Last_Arg);
                     Last_Arg := Last_Arg - 1;
 
                  else
                     --  Save the current arguments and get those in the new
                     --  response file.
 
                     declare
                        Inc_File_Name     : constant String :=
                                              Arguments (Arg)
                                              (2 .. Arguments (Arg)'Last);
                        Current_Arguments : constant Argument_List :=
                                              Arguments (1 .. Last_Arg);
                     begin
                        Recurse (Inc_File_Name);
 
                        --  Insert the new arguments where the new response
                        --  file was imported.
 
                        declare
                           New_Arguments : constant Argument_List :=
                                             Arguments (1 .. Last_Arg);
                           New_Last_Arg  : constant Positive :=
                                             Current_Arguments'Length +
                                             New_Arguments'Length - 1;
 
                        begin
                           --  Grow Arguments if it is not large enough
 
                           if Arguments'Last < New_Last_Arg then
                              Last_Arg := Arguments'Last;
                              Free (Arguments);
 
                              while Last_Arg < New_Last_Arg loop
                                 Last_Arg := Last_Arg * 2;
                              end loop;
 
                              Arguments := new Argument_List (1 .. Last_Arg);
                           end if;
 
                           Last_Arg := New_Last_Arg;
 
                           Arguments (1 .. Last_Arg) :=
                             Current_Arguments (1 .. Arg - 1) &
                           New_Arguments &
                           Current_Arguments
                             (Arg + 1 .. Current_Arguments'Last);
 
                           Arg := Arg + New_Arguments'Length;
                        end;
                     end;
                  end if;
 
               else
                  Arg := Arg + 1;
               end if;
            end loop;
         end if;
 
         --  Remove the response file name from the stack
 
         if First_File = Last_File then
            System.Strings.Free (First_File.Name);
            Free (First_File);
            First_File := null;
            Last_File := null;
 
         else
            System.Strings.Free (Last_File.Name);
            Last_File := Last_File.Prev;
            Free (Last_File.Next);
         end if;
 
      exception
         when others =>
            Close (FD);
 
            raise;
      end Recurse;
 
   --  Start of Arguments_From
 
   begin
      --  The job is done by procedure Recurse
 
      Recurse (Response_File_Name);
 
      --  Free Arguments before returning the result
 
      declare
         Result : constant Argument_List := Arguments (1 .. Last_Arg);
      begin
         Free (Arguments);
         return Result;
      end;
 
   exception
      when others =>
 
         --  When an exception occurs, deallocate everything
 
         Free (Arguments);
 
         while First_File /= null loop
            Last_File := First_File.Next;
            System.Strings.Free (First_File.Name);
            Free (First_File);
            First_File := Last_File;
         end loop;
 
         raise;
   end Arguments_From;
 
end Ada.Command_Line.Response_File;

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [a-clrefi.adb] - Blame information for rev 297

Line No.	Rev	Author	Line
1	281	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT RUN-TIME COMPONENTS --`
4			`-- --`
5			`-- A D A . C O M M A N D _ L I N E . R E S P O N S E _ F I L E --`
6			`-- --`
7			`-- B o d y --`
8			`-- --`
9			`-- Copyright (C) 2007-2009, Free Software Foundation, Inc. --`
10			`-- --`
11			`-- GNAT is free software; you can redistribute it and/or modify it under --`
12			`-- terms of the GNU General Public License as published by the Free Soft- --`
13			`-- ware Foundation; either version 3, or (at your option) any later ver- --`
14			`-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --`
15			`-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --`
16			`-- or FITNESS FOR A PARTICULAR PURPOSE. --`
17			`-- --`
18			`-- As a special exception under Section 7 of GPL version 3, you are granted --`
19			`-- additional permissions described in the GCC Runtime Library Exception, --`
20			`-- version 3.1, as published by the Free Software Foundation. --`
21			`-- --`
22			`-- You should have received a copy of the GNU General Public License and --`
23			`-- a copy of the GCC Runtime Library Exception along with this program; --`
24			`-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --`
25			`-- <http://www.gnu.org/licenses/>. --`
26			`-- --`
27			`-- GNAT was originally developed by the GNAT team at New York University. --`
28			`-- Extensive contributions were provided by Ada Core Technologies Inc. --`
29			`-- --`
30			`------------------------------------------------------------------------------`
31
32			`pragma Compiler_Unit;`
33
34			`with Ada.Unchecked_Deallocation;`
35
36			`with System.OS_Lib; use System.OS_Lib;`
37
38			`package body Ada.Command_Line.Response_File is`
39
40			`type File_Rec;`
41			`type File_Ptr is access File_Rec;`
42			`type File_Rec is record`
43			`Name : String_Access;`
44			`Next : File_Ptr;`
45			`Prev : File_Ptr;`
46			`end record;`
47			`-- To build a stack of response file names`
48
49			`procedure Free is new Ada.Unchecked_Deallocation (File_Rec, File_Ptr);`
50
51			`type Argument_List_Access is access Argument_List;`
52			`procedure Free is new Ada.Unchecked_Deallocation`
53			`(Argument_List, Argument_List_Access);`
54			`-- Free only the allocated Argument_List, not allocated String components`
55
56			`--------------------`
57			`-- Arguments_From --`
58			`--------------------`
59
60			`function Arguments_From`
61			`(Response_File_Name : String;`
62			`Recursive : Boolean := False;`
63			`Ignore_Non_Existing_Files : Boolean := False)`
64			`return Argument_List`
65			`is`
66			`First_File : File_Ptr := null;`
67			`Last_File : File_Ptr := null;`
68			`-- The stack of response files`
69
70			`Arguments : Argument_List_Access := new Argument_List (1 .. 4);`
71			`Last_Arg : Natural := 0;`
72
73			`procedure Add_Argument (Arg : String);`
74			`-- Add argument Arg to argument list Arguments, increasing Arguments`
75			`-- if necessary.`
76
77			`procedure Recurse (File_Name : String);`
78			`-- Get the arguments from the file and call itself recursively if one of`
79			`-- the argument starts with character '@'.`
80
81			`------------------`
82			`-- Add_Argument --`
83			`------------------`
84
85			`procedure Add_Argument (Arg : String) is`
86			`begin`
87			`if Last_Arg = Arguments'Last then`
88			`declare`
89			`New_Arguments : constant Argument_List_Access :=`
90			`new Argument_List (1 .. Arguments'Last * 2);`
91			`begin`
92			`New_Arguments (Arguments'Range) := Arguments.all;`
93			`Arguments.all := (others => null);`
94			`Free (Arguments);`
95			`Arguments := New_Arguments;`
96			`end;`
97			`end if;`
98
99			`Last_Arg := Last_Arg + 1;`
100			`Arguments (Last_Arg) := new String'(Arg);`
101			`end Add_Argument;`
102
103			`-------------`
104			`-- Recurse --`
105			`-------------`
106
107			`procedure Recurse (File_Name : String) is`
108			`FD : File_Descriptor;`
109
110			`Buffer_Size : constant := 1500;`
111			`Buffer : String (1 .. Buffer_Size);`
112
113			`Buffer_Length : Natural;`
114
115			`Buffer_Cursor : Natural;`
116
117			`End_Of_File_Reached : Boolean;`
118
119			`Line : String (1 .. Max_Line_Length + 1);`
120			`Last : Natural;`
121
122			`First_Char : Positive;`
123			`-- Index of the first character of an argument in Line`
124
125			`Last_Char : Natural;`
126			`-- Index of the last character of an argument in Line`
127
128			`In_String : Boolean;`
129			`-- True when inside a quoted string`
130
131			`Arg : Positive;`
132
133			`function End_Of_File return Boolean;`
134			`-- True when the end of the response file has been reached`
135
136			`procedure Get_Buffer;`
137			`-- Read one buffer from the response file`
138
139			`procedure Get_Line;`
140			`-- Get one line from the response file`
141
142			`-----------------`
143			`-- End_Of_File --`
144			`-----------------`
145
146			`function End_Of_File return Boolean is`
147			`begin`
148			`return End_Of_File_Reached and then Buffer_Cursor > Buffer_Length;`
149			`end End_Of_File;`
150
151			`----------------`
152			`-- Get_Buffer --`
153			`----------------`
154
155			`procedure Get_Buffer is`
156			`begin`
157			`Buffer_Length := Read (FD, Buffer (1)'Address, Buffer'Length);`
158			`End_Of_File_Reached := Buffer_Length < Buffer'Length;`
159			`Buffer_Cursor := 1;`
160			`end Get_Buffer;`
161
162			`--------------`
163			`-- Get_Line --`
164			`--------------`
165
166			`procedure Get_Line is`
167			`Ch : Character;`
168
169			`begin`
170			`Last := 0;`
171
172			`if End_Of_File then`
173			`return;`
174			`end if;`
175
176			`loop`
177			`Ch := Buffer (Buffer_Cursor);`
178
179			`exit when Ch = ASCII.CR or else`
180			`Ch = ASCII.LF or else`
181			`Ch = ASCII.FF;`
182
183			`Last := Last + 1;`
184			`Line (Last) := Ch;`
185
186			`if Last = Line'Last then`
187			`return;`
188			`end if;`
189
190			`Buffer_Cursor := Buffer_Cursor + 1;`
191
192			`if Buffer_Cursor > Buffer_Length then`
193			`Get_Buffer;`
194
195			`if End_Of_File then`
196			`return;`
197			`end if;`
198			`end if;`
199			`end loop;`
200
201			`loop`
202			`Ch := Buffer (Buffer_Cursor);`
203
204			`exit when Ch /= ASCII.HT and then`
205			`Ch /= ASCII.LF and then`
206			`Ch /= ASCII.FF;`
207
208			`Buffer_Cursor := Buffer_Cursor + 1;`
209
210			`if Buffer_Cursor > Buffer_Length then`
211			`Get_Buffer;`
212
213			`if End_Of_File then`
214			`return;`
215			`end if;`
216			`end if;`
217			`end loop;`
218			`end Get_Line;`
219
220			`-- Start or Recurse`
221
222			`begin`
223			`Last_Arg := 0;`
224
225			`-- Open the response file. If not found, fail or report a warning,`
226			`-- depending on the value of Ignore_Non_Existing_Files.`
227
228			`FD := Open_Read (File_Name, Text);`
229
230			`if FD = Invalid_FD then`
231			`if Ignore_Non_Existing_Files then`
232			`return;`
233			`else`
234			`raise File_Does_Not_Exist;`
235			`end if;`
236			`end if;`
237
238			`-- Put the response file name on the stack`
239
240			`if First_File = null then`
241			`First_File :=`
242			`new File_Rec'`
243			`(Name => new String'(File_Name),`
244			`Next => null,`
245			`Prev => null);`
246			`Last_File := First_File;`
247
248			`else`
249			`declare`
250			`Current : File_Ptr := First_File;`
251
252			`begin`
253			`loop`
254			`if Current.Name.all = File_Name then`
255			`raise Circularity_Detected;`
256			`end if;`
257
258			`Current := Current.Next;`
259			`exit when Current = null;`
260			`end loop;`
261
262			`Last_File.Next :=`
263			`new File_Rec'`
264			`(Name => new String'(File_Name),`
265			`Next => null,`
266			`Prev => Last_File);`
267			`Last_File := Last_File.Next;`
268			`end;`
269			`end if;`
270
271			`End_Of_File_Reached := False;`
272			`Get_Buffer;`
273
274			`-- Read the response file line by line`
275
276			`Line_Loop :`
277			`while not End_Of_File loop`
278			`Get_Line;`
279
280			`if Last = Line'Last then`
281			`raise Line_Too_Long;`
282			`end if;`
283
284			`First_Char := 1;`
285
286			`-- Get each argument on the line`
287
288			`Arg_Loop :`
289			`loop`
290			`-- First, skip any white space`
291
292			`while First_Char <= Last loop`
293			`exit when Line (First_Char) /= ' ' and then`
294			`Line (First_Char) /= ASCII.HT;`
295			`First_Char := First_Char + 1;`
296			`end loop;`
297
298			`exit Arg_Loop when First_Char > Last;`
299
300			`Last_Char := First_Char;`
301			`In_String := False;`
302
303			`-- Get the character one by one`
304
305			`Character_Loop :`
306			`while Last_Char <= Last loop`
307
308			`-- Inside a string, check only for '"'`
309
310			`if In_String then`
311			`if Line (Last_Char) = '"' then`
312
313			`-- Remove the '"'`
314
315			`Line (Last_Char .. Last - 1) :=`
316			`Line (Last_Char + 1 .. Last);`
317			`Last := Last - 1;`
318
319			`-- End of string is end of argument`
320
321			`if Last_Char > Last or else`
322			`Line (Last_Char) = ' ' or else`
323			`Line (Last_Char) = ASCII.HT`
324			`then`
325			`In_String := False;`
326
327			`Last_Char := Last_Char - 1;`
328			`exit Character_Loop;`
329
330			`else`
331			`-- If there are two consecutive '"', the quoted`
332			`-- string is not closed`
333
334			`In_String := Line (Last_Char) = '"';`
335
336			`if In_String then`
337			`Last_Char := Last_Char + 1;`
338			`end if;`
339			`end if;`
340
341			`else`
342			`Last_Char := Last_Char + 1;`
343			`end if;`
344
345			`elsif Last_Char = Last then`
346
347			`-- An opening '"' at the end of the line is an error`
348
349			`if Line (Last) = '"' then`
350			`raise No_Closing_Quote;`
351
352			`else`
353			`-- The argument ends with the line`
354
355			`exit Character_Loop;`
356			`end if;`
357
358			`elsif Line (Last_Char) = '"' then`
359
360			`-- Entering a quoted string: remove the '"'`
361
362			`In_String := True;`
363			`Line (Last_Char .. Last - 1) :=`
364			`Line (Last_Char + 1 .. Last);`
365			`Last := Last - 1;`
366
367			`else`
368			`-- Outside quoted strings, white space ends the argument`
369
370			`exit Character_Loop`
371			`when Line (Last_Char + 1) = ' ' or else`
372			`Line (Last_Char + 1) = ASCII.HT;`
373
374			`Last_Char := Last_Char + 1;`
375			`end if;`
376			`end loop Character_Loop;`
377
378			`-- It is an error to not close a quoted string before the end`
379			`-- of the line.`
380
381			`if In_String then`
382			`raise No_Closing_Quote;`
383			`end if;`
384
385			`-- Add the argument to the list`
386
387			`declare`
388			`Arg : String (1 .. Last_Char - First_Char + 1);`
389			`begin`
390			`Arg := Line (First_Char .. Last_Char);`
391			`Add_Argument (Arg);`
392			`end;`
393
394			`-- Next argument, if line is not finished`
395
396			`First_Char := Last_Char + 1;`
397			`end loop Arg_Loop;`
398			`end loop Line_Loop;`
399
400			`Close (FD);`
401
402			`-- If Recursive is True, check for any argument starting with '@'`
403
404			`if Recursive then`
405			`Arg := 1;`
406			`while Arg <= Last_Arg loop`
407
408			`if Arguments (Arg)'Length > 0 and then`
409			`Arguments (Arg) (1) = '@'`
410			`then`
411			`-- Ignore argument "@" with no file name`
412
413			`if Arguments (Arg)'Length = 1 then`
414			`Arguments (Arg .. Last_Arg - 1) :=`
415			`Arguments (Arg + 1 .. Last_Arg);`
416			`Last_Arg := Last_Arg - 1;`
417
418			`else`
419			`-- Save the current arguments and get those in the new`
420			`-- response file.`
421
422			`declare`
423			`Inc_File_Name : constant String :=`
424			`Arguments (Arg)`
425			`(2 .. Arguments (Arg)'Last);`
426			`Current_Arguments : constant Argument_List :=`
427			`Arguments (1 .. Last_Arg);`
428			`begin`
429			`Recurse (Inc_File_Name);`
430
431			`-- Insert the new arguments where the new response`
432			`-- file was imported.`
433
434			`declare`
435			`New_Arguments : constant Argument_List :=`
436			`Arguments (1 .. Last_Arg);`
437			`New_Last_Arg : constant Positive :=`
438			`Current_Arguments'Length +`
439			`New_Arguments'Length - 1;`
440
441			`begin`
442			`-- Grow Arguments if it is not large enough`
443
444			`if Arguments'Last < New_Last_Arg then`
445			`Last_Arg := Arguments'Last;`
446			`Free (Arguments);`
447
448			`while Last_Arg < New_Last_Arg loop`
449			`Last_Arg := Last_Arg * 2;`
450			`end loop;`
451
452			`Arguments := new Argument_List (1 .. Last_Arg);`
453			`end if;`
454
455			`Last_Arg := New_Last_Arg;`
456
457			`Arguments (1 .. Last_Arg) :=`
458			`Current_Arguments (1 .. Arg - 1) &`
459			`New_Arguments &`
460			`Current_Arguments`
461			`(Arg + 1 .. Current_Arguments'Last);`
462
463			`Arg := Arg + New_Arguments'Length;`
464			`end;`
465			`end;`
466			`end if;`
467
468			`else`
469			`Arg := Arg + 1;`
470			`end if;`
471			`end loop;`
472			`end if;`
473
474			`-- Remove the response file name from the stack`
475
476			`if First_File = Last_File then`
477			`System.Strings.Free (First_File.Name);`
478			`Free (First_File);`
479			`First_File := null;`
480			`Last_File := null;`
481
482			`else`
483			`System.Strings.Free (Last_File.Name);`
484			`Last_File := Last_File.Prev;`
485			`Free (Last_File.Next);`
486			`end if;`
487
488			`exception`
489			`when others =>`
490			`Close (FD);`
491
492			`raise;`
493			`end Recurse;`
494
495			`-- Start of Arguments_From`
496
497			`begin`
498			`-- The job is done by procedure Recurse`
499
500			`Recurse (Response_File_Name);`
501
502			`-- Free Arguments before returning the result`
503
504			`declare`
505			`Result : constant Argument_List := Arguments (1 .. Last_Arg);`
506			`begin`
507			`Free (Arguments);`
508			`return Result;`
509			`end;`
510
511			`exception`
512			`when others =>`
513
514			`-- When an exception occurs, deallocate everything`
515
516			`Free (Arguments);`
517
518			`while First_File /= null loop`
519			`Last_File := First_File.Next;`
520			`System.Strings.Free (First_File.Name);`
521			`Free (First_File);`
522			`First_File := Last_File;`
523			`end loop;`
524
525			`raise;`
526			`end Arguments_From;`
527
528			`end Ada.Command_Line.Response_File;`