OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [ada/] [vms_conv.adb] - Blame information for rev 826

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                            V M S _ C O N V                               --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1996-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.  See the GNU General Public License --
17
-- for  more details.  You should have  received  a copy of the GNU General --
18
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
19
-- http://www.gnu.org/licenses for a complete copy of the license.          --
20
--                                                                          --
21
-- GNAT was originally developed  by the GNAT team at  New York University. --
22
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23
--                                                                          --
24
------------------------------------------------------------------------------
25
 
26
with Gnatvsn;  use Gnatvsn;
27
with Hostparm;
28
with Opt;
29
with Osint;    use Osint;
30
with Targparm; use Targparm;
31
 
32
with Ada.Characters.Handling; use Ada.Characters.Handling;
33
with Ada.Command_Line;        use Ada.Command_Line;
34
with Ada.Text_IO;             use Ada.Text_IO;
35
 
36
package body VMS_Conv is
37
 
38
   -------------------------
39
   -- Internal Structures --
40
   -------------------------
41
 
42
   --  The switches and commands are defined by strings in the previous
43
   --  section so that they are easy to modify, but internally, they are
44
   --  kept in a more conveniently accessible form described in this
45
   --  section.
46
 
47
   --  Commands, command qualifiers and options have a similar common format
48
   --  so that searching for matching names can be done in a common manner.
49
 
50
   type Item_Id is (Id_Command, Id_Switch, Id_Option);
51
 
52
   type Translation_Type is
53
     (
54
      T_Direct,
55
      --  A qualifier with no options.
56
      --  Example: GNAT MAKE /VERBOSE
57
 
58
      T_Directories,
59
      --  A qualifier followed by a list of directories
60
      --  Example: GNAT COMPILE /SEARCH=([], [.FOO], [.BAR])
61
 
62
      T_Directory,
63
      --  A qualifier followed by one directory
64
      --  Example: GNAT LIBRARY /SET=[.VAXFLOATLIB]
65
 
66
      T_File,
67
      --  A qualifier followed by a filename
68
      --  Example: GNAT LINK /EXECUTABLE=FOO.EXE
69
 
70
      T_No_Space_File,
71
      --  A qualifier followed by a filename
72
      --  Example: GNAT MAKE /PROJECT_FILE=PRJ.GPR
73
 
74
      T_Numeric,
75
      --  A qualifier followed by a numeric value.
76
      --  Example: GNAT CHOP /FILE_NAME_MAX_LENGTH=39
77
 
78
      T_String,
79
      --  A qualifier followed by a quoted string. Only used by
80
      --  /IDENTIFICATION qualifier.
81
      --  Example: GNAT LINK /IDENTIFICATION="3.14a1 version"
82
 
83
      T_Options,
84
      --  A qualifier followed by a list of options.
85
      --  Example: GNAT COMPILE /REPRESENTATION_INFO=(ARRAYS,OBJECTS)
86
 
87
      T_Commands,
88
      --  A qualifier followed by a list. Only used for
89
      --  MAKE /COMPILER_QUALIFIERS /BINDER_QUALIFIERS /LINKER_QUALIFIERS
90
      --  (gnatmake -cargs -bargs -largs )
91
      --  Example: GNAT MAKE ... /LINKER_QUALIFIERS /VERBOSE FOOBAR.OBJ
92
 
93
      T_Other,
94
      --  A qualifier passed directly to the linker. Only used
95
      --  for LINK and SHARED if no other match is found.
96
      --  Example: GNAT LINK FOO.ALI /SYSSHR
97
 
98
      T_Alphanumplus
99
      --  A qualifier followed by a legal linker symbol prefix. Only used
100
      --  for BIND /BUILD_LIBRARY (gnatbind -Lxyz).
101
      --  Example: GNAT BIND /BUILD_LIBRARY=foobar
102
      );
103
 
104
   type Item (Id : Item_Id);
105
   type Item_Ptr is access all Item;
106
 
107
   type Item (Id : Item_Id) is record
108
      Name : String_Ptr;
109
      --  Name of the command, switch (with slash) or option
110
 
111
      Next : Item_Ptr;
112
      --  Pointer to next item on list, always has the same Id value
113
 
114
      Command : Command_Type := Undefined;
115
 
116
      Unix_String : String_Ptr := null;
117
      --  Corresponding Unix string. For a command, this is the unix command
118
      --  name and possible default switches. For a switch or option it is
119
      --  the unix switch string.
120
 
121
      case Id is
122
 
123
         when Id_Command =>
124
 
125
            Switches : Item_Ptr;
126
            --  Pointer to list of switch items for the command, linked
127
            --  through the Next fields with null terminating the list.
128
 
129
            Usage : String_Ptr;
130
            --  Usage information, used only for errors and the default
131
            --  list of commands output.
132
 
133
            Params : Parameter_Ref;
134
            --  Array of parameters
135
 
136
            Defext : String (1 .. 3);
137
            --  Default extension. If non-blank, then this extension is
138
            --  supplied by default as the extension for any file parameter
139
            --  which does not have an extension already.
140
 
141
         when Id_Switch =>
142
 
143
            Translation : Translation_Type;
144
            --  Type of switch translation. For all cases, except Options,
145
            --  this is the only field needed, since the Unix translation
146
            --  is found in Unix_String.
147
 
148
            Options : Item_Ptr;
149
            --  For the Options case, this field is set to point to a list
150
            --  of options item (for this case Unix_String is null in the
151
            --  main switch item). The end of the list is marked by null.
152
 
153
         when Id_Option =>
154
 
155
            null;
156
            --  No special fields needed, since Name and Unix_String are
157
            --  sufficient to completely described an option.
158
 
159
      end case;
160
   end record;
161
 
162
   subtype Command_Item is Item (Id_Command);
163
   subtype Switch_Item  is Item (Id_Switch);
164
   subtype Option_Item  is Item (Id_Option);
165
 
166
   Keep_Temps_Option : constant Item_Ptr :=
167
                         new Item'
168
                           (Id          => Id_Option,
169
                            Name        =>
170
                              new String'("/KEEP_TEMPORARY_FILES"),
171
                            Next        => null,
172
                            Command     => Undefined,
173
                            Unix_String => null);
174
 
175
   Param_Count : Natural := 0;
176
   --  Number of parameter arguments so far
177
 
178
   Arg_Num : Natural;
179
   --  Argument number
180
 
181
   Arg_File : Ada.Text_IO.File_Type;
182
   --  A file where arguments are read from
183
 
184
   Commands : Item_Ptr;
185
   --  Pointer to head of list of command items, one for each command, with
186
   --  the end of the list marked by a null pointer.
187
 
188
   Last_Command : Item_Ptr;
189
   --  Pointer to last item in Commands list
190
 
191
   Command : Item_Ptr;
192
   --  Pointer to command item for current command
193
 
194
   Make_Commands_Active : Item_Ptr := null;
195
   --  Set to point to Command entry for COMPILE, BIND, or LINK as appropriate
196
   --  if a COMMANDS_TRANSLATION switch has been encountered while processing
197
   --  a MAKE Command.
198
 
199
   Output_File_Expected : Boolean := False;
200
   --  True for GNAT LINK after -o switch, so that the ".ali" extension is
201
   --  not added to the executable file name.
202
 
203
   package Buffer is new Table.Table
204
     (Table_Component_Type => Character,
205
      Table_Index_Type     => Integer,
206
      Table_Low_Bound      => 1,
207
      Table_Initial        => 4096,
208
      Table_Increment      => 100,
209
      Table_Name           => "Buffer");
210
   --  Table to store the command to be used
211
 
212
   package Cargs_Buffer is new Table.Table
213
     (Table_Component_Type => Character,
214
      Table_Index_Type     => Integer,
215
      Table_Low_Bound      => 1,
216
      Table_Initial        => 4096,
217
      Table_Increment      => 100,
218
      Table_Name           => "Cargs_Buffer");
219
   --  Table to store the compiler switches for GNAT COMPILE
220
 
221
   Cargs : Boolean := False;
222
   --  When True, commands should go to Cargs_Buffer instead of Buffer table
223
 
224
   function Init_Object_Dirs return Argument_List;
225
   --  Get the list of the object directories
226
 
227
   function Invert_Sense (S : String) return VMS_Data.String_Ptr;
228
   --  Given a unix switch string S, computes the inverse (adding or
229
   --  removing ! characters as required), and returns a pointer to
230
   --  the allocated result on the heap.
231
 
232
   function Is_Extensionless (F : String) return Boolean;
233
   --  Returns true if the filename has no extension
234
 
235
   function Match (S1, S2 : String) return Boolean;
236
   --  Determines whether S1 and S2 match (this is a case insensitive match)
237
 
238
   function Match_Prefix (S1, S2 : String) return Boolean;
239
   --  Determines whether S1 matches a prefix of S2. This is also a case
240
   --  insensitive match (for example Match ("AB","abc") is True).
241
 
242
   function Matching_Name
243
     (S     : String;
244
      Itm   : Item_Ptr;
245
      Quiet : Boolean := False) return Item_Ptr;
246
   --  Determines if the item list headed by Itm and threaded through the
247
   --  Next fields (with null marking the end of the list), contains an
248
   --  entry that uniquely matches the given string. The match is case
249
   --  insensitive and permits unique abbreviation. If the match succeeds,
250
   --  then a pointer to the matching item is returned. Otherwise, an
251
   --  appropriate error message is written. Note that the discriminant
252
   --  of Itm is used to determine the appropriate form of this message.
253
   --  Quiet is normally False as shown, if it is set to True, then no
254
   --  error message is generated in a not found situation (null is still
255
   --  returned to indicate the not-found situation).
256
 
257
   function OK_Alphanumerplus (S : String) return Boolean;
258
   --  Checks that S is a string of alphanumeric characters,
259
   --  returning True if all alphanumeric characters,
260
   --  False if empty or a non-alphanumeric character is present.
261
 
262
   function OK_Integer (S : String) return Boolean;
263
   --  Checks that S is a string of digits, returning True if all digits,
264
   --  False if empty or a non-digit is present.
265
 
266
   procedure Place (C : Character);
267
   --  Place a single character in the buffer, updating Ptr
268
 
269
   procedure Place (S : String);
270
   --  Place a string character in the buffer, updating Ptr
271
 
272
   procedure Place_Lower (S : String);
273
   --  Place string in buffer, forcing letters to lower case, updating Ptr
274
 
275
   procedure Place_Unix_Switches (S : VMS_Data.String_Ptr);
276
   --  Given a unix switch string, place corresponding switches in Buffer,
277
   --  updating Ptr appropriately. Note that in the case of use of ! the
278
   --  result may be to remove a previously placed switch.
279
 
280
   procedure Preprocess_Command_Data;
281
   --  Preprocess the string form of the command and options list into the
282
   --  internal form.
283
 
284
   procedure Process_Argument (The_Command : in out Command_Type);
285
   --  Process one argument from the command line, or one line from
286
   --  from a command line file. For the first call, set The_Command.
287
 
288
   procedure Process_Buffer (S : String);
289
   --  Process the characters in the Buffer table or the Cargs_Buffer table
290
   --  to convert these into arguments.
291
 
292
   procedure Validate_Command_Or_Option (N : VMS_Data.String_Ptr);
293
   --  Check that N is a valid command or option name, i.e. that it is of the
294
   --  form of an Ada identifier with upper case letters and underscores.
295
 
296
   procedure Validate_Unix_Switch (S : VMS_Data.String_Ptr);
297
   --  Check that S is a valid switch string as described in the syntax for
298
   --  the switch table item UNIX_SWITCH or else begins with a backquote.
299
 
300
   ----------------------
301
   -- Init_Object_Dirs --
302
   ----------------------
303
 
304
   function Init_Object_Dirs return Argument_List is
305
      Object_Dirs     : Integer;
306
      Object_Dir      : Argument_List (1 .. 256);
307
      Object_Dir_Name : String_Access;
308
 
309
   begin
310
      Object_Dirs := 0;
311
      Object_Dir_Name := new String'(Object_Dir_Default_Prefix);
312
      Get_Next_Dir_In_Path_Init (Object_Dir_Name);
313
 
314
      loop
315
         declare
316
            Dir : constant String_Access :=
317
                    String_Access (Get_Next_Dir_In_Path (Object_Dir_Name));
318
         begin
319
            exit when Dir = null;
320
            Object_Dirs := Object_Dirs + 1;
321
            Object_Dir (Object_Dirs) :=
322
              new String'("-L" &
323
                          To_Canonical_Dir_Spec
324
                          (To_Host_Dir_Spec
325
                           (Normalize_Directory_Name (Dir.all).all,
326
                            True).all, True).all);
327
         end;
328
      end loop;
329
 
330
      Object_Dirs := Object_Dirs + 1;
331
      Object_Dir (Object_Dirs) := new String'("-lgnat");
332
 
333
      if OpenVMS_On_Target then
334
         Object_Dirs := Object_Dirs + 1;
335
         Object_Dir (Object_Dirs) := new String'("-ldecgnat");
336
      end if;
337
 
338
      return Object_Dir (1 .. Object_Dirs);
339
   end Init_Object_Dirs;
340
 
341
   ----------------
342
   -- Initialize --
343
   ----------------
344
 
345
   procedure Initialize is
346
   begin
347
      Command_List :=
348
        (Bind =>
349
           (Cname    => new S'("BIND"),
350
            Usage    => new S'("GNAT BIND file[.ali] /qualifiers"),
351
            VMS_Only => False,
352
            Unixcmd  => new S'("gnatbind"),
353
            Unixsws  => null,
354
            Switches => Bind_Switches'Access,
355
            Params   => new Parameter_Array'(1 => Unlimited_Files),
356
            Defext   => "ali"),
357
 
358
         Chop =>
359
           (Cname    => new S'("CHOP"),
360
            Usage    => new S'("GNAT CHOP file [directory] /qualifiers"),
361
            VMS_Only => False,
362
            Unixcmd  => new S'("gnatchop"),
363
            Unixsws  => null,
364
            Switches => Chop_Switches'Access,
365
            Params   => new Parameter_Array'(1 => File, 2 => Optional_File),
366
            Defext   => "   "),
367
 
368
         Clean =>
369
           (Cname    => new S'("CLEAN"),
370
            Usage    => new S'("GNAT CLEAN /qualifiers files"),
371
            VMS_Only => False,
372
            Unixcmd  => new S'("gnatclean"),
373
            Unixsws  => null,
374
            Switches => Clean_Switches'Access,
375
            Params   => new Parameter_Array'(1 => File),
376
            Defext   => "   "),
377
 
378
         Compile =>
379
           (Cname    => new S'("COMPILE"),
380
            Usage    => new S'("GNAT COMPILE filespec[,...] /qualifiers"),
381
            VMS_Only => False,
382
            Unixcmd  => new S'("gnatmake"),
383
            Unixsws  => new Argument_List'(1 => new String'("-f"),
384
                                           2 => new String'("-u"),
385
                                           3 => new String'("-c")),
386
            Switches => GCC_Switches'Access,
387
            Params   => new Parameter_Array'(1 => Files_Or_Wildcard),
388
            Defext   => "   "),
389
 
390
         Check =>
391
           (Cname    => new S'("CHECK"),
392
            Usage    => new S'("GNAT CHECK name /qualifiers"),
393
            VMS_Only => False,
394
            Unixcmd  => new S'("gnatcheck"),
395
            Unixsws  => null,
396
            Switches => Check_Switches'Access,
397
            Params   => new Parameter_Array'(1 => Unlimited_Files),
398
            Defext   => "   "),
399
 
400
         Sync =>
401
           (Cname    => new S'("SYNC"),
402
            Usage    => new S'("GNAT SYNC name /qualifiers"),
403
            VMS_Only => False,
404
            Unixcmd  => new S'("gnatsync"),
405
            Unixsws  => null,
406
            Switches => Sync_Switches'Access,
407
            Params   => new Parameter_Array'(1 => Unlimited_Files),
408
            Defext   => "   "),
409
 
410
         Elim =>
411
           (Cname    => new S'("ELIM"),
412
            Usage    => new S'("GNAT ELIM name /qualifiers"),
413
            VMS_Only => False,
414
            Unixcmd  => new S'("gnatelim"),
415
            Unixsws  => null,
416
            Switches => Elim_Switches'Access,
417
            Params   => new Parameter_Array'(1 => Other_As_Is),
418
            Defext   => "ali"),
419
 
420
         Find =>
421
           (Cname    => new S'("FIND"),
422
            Usage    => new S'("GNAT FIND pattern[:sourcefile[:line"
423
                               & "[:column]]] filespec[,...] /qualifiers"),
424
            VMS_Only => False,
425
            Unixcmd  => new S'("gnatfind"),
426
            Unixsws  => null,
427
            Switches => Find_Switches'Access,
428
            Params   => new Parameter_Array'(1 => Other_As_Is,
429
                                             2 => Files_Or_Wildcard),
430
            Defext   => "ali"),
431
 
432
         Krunch =>
433
           (Cname    => new S'("KRUNCH"),
434
            Usage    => new S'("GNAT KRUNCH file [/COUNT=nnn]"),
435
            VMS_Only => False,
436
            Unixcmd  => new S'("gnatkr"),
437
            Unixsws  => null,
438
            Switches => Krunch_Switches'Access,
439
            Params   => new Parameter_Array'(1 => File),
440
            Defext   => "   "),
441
 
442
         Link =>
443
           (Cname    => new S'("LINK"),
444
            Usage    => new S'("GNAT LINK file[.ali]"
445
                               & " [extra obj_&_lib_&_exe_&_opt files]"
446
                               & " /qualifiers"),
447
            VMS_Only => False,
448
            Unixcmd  => new S'("gnatlink"),
449
            Unixsws  => null,
450
            Switches => Link_Switches'Access,
451
            Params   => new Parameter_Array'(1 => Unlimited_Files),
452
            Defext   => "ali"),
453
 
454
         List =>
455
           (Cname    => new S'("LIST"),
456
            Usage    => new S'("GNAT LIST /qualifiers object_or_ali_file"),
457
            VMS_Only => False,
458
            Unixcmd  => new S'("gnatls"),
459
            Unixsws  => null,
460
            Switches => List_Switches'Access,
461
            Params   => new Parameter_Array'(1 => Unlimited_Files),
462
            Defext   => "ali"),
463
 
464
         Make =>
465
           (Cname    => new S'("MAKE"),
466
            Usage    => new S'("GNAT MAKE file(s) /qualifiers (includes "
467
                               & "COMPILE /qualifiers)"),
468
            VMS_Only => False,
469
            Unixcmd  => new S'("gnatmake"),
470
            Unixsws  => null,
471
            Switches => Make_Switches'Access,
472
            Params   => new Parameter_Array'(1 => Unlimited_Files),
473
            Defext   => "   "),
474
 
475
         Metric =>
476
           (Cname    => new S'("METRIC"),
477
            Usage    => new S'("GNAT METRIC /qualifiers source_file"),
478
            VMS_Only => False,
479
            Unixcmd  => new S'("gnatmetric"),
480
            Unixsws  => null,
481
            Switches => Metric_Switches'Access,
482
            Params   => new Parameter_Array'(1 => Unlimited_Files),
483
            Defext   => "   "),
484
 
485
         Name =>
486
           (Cname    => new S'("NAME"),
487
            Usage    => new S'("GNAT NAME /qualifiers naming-pattern "
488
                               & "[naming-patterns]"),
489
            VMS_Only => False,
490
            Unixcmd  => new S'("gnatname"),
491
            Unixsws  => null,
492
            Switches => Name_Switches'Access,
493
            Params   => new Parameter_Array'(1 => Unlimited_As_Is),
494
            Defext   => "   "),
495
 
496
         Preprocess =>
497
           (Cname    => new S'("PREPROCESS"),
498
            Usage    =>
499
              new S'("GNAT PREPROCESS ifile ofile dfile /qualifiers"),
500
            VMS_Only => False,
501
            Unixcmd  => new S'("gnatprep"),
502
            Unixsws  => null,
503
            Switches => Prep_Switches'Access,
504
            Params   => new Parameter_Array'(1 .. 3 => File),
505
            Defext   => "   "),
506
 
507
         Pretty =>
508
           (Cname    => new S'("PRETTY"),
509
            Usage    => new S'("GNAT PRETTY /qualifiers source_file"),
510
            VMS_Only => False,
511
            Unixcmd  => new S'("gnatpp"),
512
            Unixsws  => null,
513
            Switches => Pretty_Switches'Access,
514
            Params   => new Parameter_Array'(1 => Unlimited_Files),
515
            Defext   => "   "),
516
 
517
         Shared =>
518
           (Cname    => new S'("SHARED"),
519
            Usage    => new S'("GNAT SHARED [obj_&_lib_&_exe_&_opt"
520
                               & "files] /qualifiers"),
521
            VMS_Only => True,
522
            Unixcmd  => new S'("gcc"),
523
            Unixsws  =>
524
            new Argument_List'(new String'("-shared") & Init_Object_Dirs),
525
            Switches => Shared_Switches'Access,
526
            Params   => new Parameter_Array'(1 => Unlimited_Files),
527
            Defext   => "   "),
528
 
529
         Stack =>
530
           (Cname    => new S'("STACK"),
531
            Usage    => new S'("GNAT STACK /qualifiers ci_files"),
532
            VMS_Only => False,
533
            Unixcmd  => new S'("gnatstack"),
534
            Unixsws  => null,
535
            Switches => Stack_Switches'Access,
536
            Params   => new Parameter_Array'(1 => Unlimited_Files),
537
            Defext   => "ci" & ASCII.NUL),
538
 
539
         Stub =>
540
           (Cname    => new S'("STUB"),
541
            Usage    => new S'("GNAT STUB file [directory]/qualifiers"),
542
            VMS_Only => False,
543
            Unixcmd  => new S'("gnatstub"),
544
            Unixsws  => null,
545
            Switches => Stub_Switches'Access,
546
            Params   => new Parameter_Array'(1 => File, 2 => Optional_File),
547
            Defext   => "   "),
548
 
549
         Xref =>
550
           (Cname    => new S'("XREF"),
551
            Usage    => new S'("GNAT XREF filespec[,...] /qualifiers"),
552
            VMS_Only => False,
553
            Unixcmd  => new S'("gnatxref"),
554
            Unixsws  => null,
555
            Switches => Xref_Switches'Access,
556
            Params   => new Parameter_Array'(1 => Files_Or_Wildcard),
557
            Defext   => "ali")
558
        );
559
   end Initialize;
560
 
561
   ------------------
562
   -- Invert_Sense --
563
   ------------------
564
 
565
   function Invert_Sense (S : String) return VMS_Data.String_Ptr is
566
      Sinv : String (1 .. S'Length * 2);
567
      --  Result (for sure long enough)
568
 
569
      Sinvp : Natural := 0;
570
      --  Pointer to output string
571
 
572
   begin
573
      for Sp in S'Range loop
574
         if Sp = S'First or else S (Sp - 1) = ',' then
575
            if S (Sp) = '!' then
576
               null;
577
            else
578
               Sinv (Sinvp + 1) := '!';
579
               Sinv (Sinvp + 2) := S (Sp);
580
               Sinvp := Sinvp + 2;
581
            end if;
582
 
583
         else
584
            Sinv (Sinvp + 1) := S (Sp);
585
            Sinvp := Sinvp + 1;
586
         end if;
587
      end loop;
588
 
589
      return new String'(Sinv (1 .. Sinvp));
590
   end Invert_Sense;
591
 
592
   ----------------------
593
   -- Is_Extensionless --
594
   ----------------------
595
 
596
   function Is_Extensionless (F : String) return Boolean is
597
   begin
598
      for J in reverse F'Range loop
599
         if F (J) = '.' then
600
            return False;
601
         elsif F (J) = '/' or else F (J) = ']' or else F (J) = ':' then
602
            return True;
603
         end if;
604
      end loop;
605
 
606
      return True;
607
   end Is_Extensionless;
608
 
609
   -----------
610
   -- Match --
611
   -----------
612
 
613
   function Match (S1, S2 : String) return Boolean is
614
      Dif : constant Integer := S2'First - S1'First;
615
 
616
   begin
617
 
618
      if S1'Length /= S2'Length then
619
         return False;
620
 
621
      else
622
         for J in S1'Range loop
623
            if To_Lower (S1 (J)) /= To_Lower (S2 (J + Dif)) then
624
               return False;
625
            end if;
626
         end loop;
627
 
628
         return True;
629
      end if;
630
   end Match;
631
 
632
   ------------------
633
   -- Match_Prefix --
634
   ------------------
635
 
636
   function Match_Prefix (S1, S2 : String) return Boolean is
637
   begin
638
      if S1'Length > S2'Length then
639
         return False;
640
      else
641
         return Match (S1, S2 (S2'First .. S2'First + S1'Length - 1));
642
      end if;
643
   end Match_Prefix;
644
 
645
   -------------------
646
   -- Matching_Name --
647
   -------------------
648
 
649
   function Matching_Name
650
     (S     : String;
651
      Itm   : Item_Ptr;
652
      Quiet : Boolean := False) return Item_Ptr
653
   is
654
      P1, P2 : Item_Ptr;
655
 
656
      procedure Err;
657
      --  Little procedure to output command/qualifier/option as appropriate
658
      --  and bump error count.
659
 
660
      ---------
661
      -- Err --
662
      ---------
663
 
664
      procedure Err is
665
      begin
666
         if Quiet then
667
            return;
668
         end if;
669
 
670
         Errors := Errors + 1;
671
 
672
         if Itm /= null then
673
            case Itm.Id is
674
               when Id_Command =>
675
                  Put (Standard_Error, "command");
676
 
677
               when Id_Switch =>
678
                  if Hostparm.OpenVMS then
679
                     Put (Standard_Error, "qualifier");
680
                  else
681
                     Put (Standard_Error, "switch");
682
                  end if;
683
 
684
               when Id_Option =>
685
                  Put (Standard_Error, "option");
686
 
687
            end case;
688
         else
689
            Put (Standard_Error, "input");
690
 
691
         end if;
692
 
693
         Put (Standard_Error, ": ");
694
         Put (Standard_Error, S);
695
      end Err;
696
 
697
   --  Start of processing for Matching_Name
698
 
699
   begin
700
      --  If exact match, that's the one we want
701
 
702
      P1 := Itm;
703
      while P1 /= null loop
704
         if Match (S, P1.Name.all) then
705
            return P1;
706
         else
707
            P1 := P1.Next;
708
         end if;
709
      end loop;
710
 
711
      --  Now check for prefix matches
712
 
713
      P1 := Itm;
714
      while P1 /= null loop
715
         if P1.Name.all = "/<other>" then
716
            return P1;
717
 
718
         elsif not Match_Prefix (S, P1.Name.all) then
719
            P1 := P1.Next;
720
 
721
         else
722
            --  Here we have found one matching prefix, so see if there is
723
            --  another one (which is an ambiguity)
724
 
725
            P2 := P1.Next;
726
            while P2 /= null loop
727
               if Match_Prefix (S, P2.Name.all) then
728
                  if not Quiet then
729
                     Put (Standard_Error, "ambiguous ");
730
                     Err;
731
                     Put (Standard_Error, " (matches ");
732
                     Put (Standard_Error, P1.Name.all);
733
 
734
                     while P2 /= null loop
735
                        if Match_Prefix (S, P2.Name.all) then
736
                           Put (Standard_Error, ',');
737
                           Put (Standard_Error, P2.Name.all);
738
                        end if;
739
 
740
                        P2 := P2.Next;
741
                     end loop;
742
 
743
                     Put_Line (Standard_Error, ")");
744
                  end if;
745
 
746
                  return null;
747
               end if;
748
 
749
               P2 := P2.Next;
750
            end loop;
751
 
752
            --  If we fall through that loop, then there was only one match
753
 
754
            return P1;
755
         end if;
756
      end loop;
757
 
758
      --  If we fall through outer loop, there was no match
759
 
760
      if not Quiet then
761
         Put (Standard_Error, "unrecognized ");
762
         Err;
763
         New_Line (Standard_Error);
764
      end if;
765
 
766
      return null;
767
   end Matching_Name;
768
 
769
   -----------------------
770
   -- OK_Alphanumerplus --
771
   -----------------------
772
 
773
   function OK_Alphanumerplus (S : String) return Boolean is
774
   begin
775
      if S'Length = 0 then
776
         return False;
777
 
778
      else
779
         for J in S'Range loop
780
            if not (Is_Alphanumeric (S (J)) or else
781
                    S (J) = '_' or else S (J) = '$')
782
            then
783
               return False;
784
            end if;
785
         end loop;
786
 
787
         return True;
788
      end if;
789
   end OK_Alphanumerplus;
790
 
791
   ----------------
792
   -- OK_Integer --
793
   ----------------
794
 
795
   function OK_Integer (S : String) return Boolean is
796
   begin
797
      if S'Length = 0 then
798
         return False;
799
 
800
      else
801
         for J in S'Range loop
802
            if not Is_Digit (S (J)) then
803
               return False;
804
            end if;
805
         end loop;
806
 
807
         return True;
808
      end if;
809
   end OK_Integer;
810
 
811
   --------------------
812
   -- Output_Version --
813
   --------------------
814
 
815
   procedure Output_Version is
816
   begin
817
      if AAMP_On_Target then
818
         Put ("GNAAMP ");
819
      else
820
         Put ("GNAT ");
821
      end if;
822
 
823
      Put_Line (Gnatvsn.Gnat_Version_String);
824
      Put_Line ("Copyright 1996-" &
825
                Current_Year &
826
                ", Free Software Foundation, Inc.");
827
   end Output_Version;
828
 
829
   -----------
830
   -- Place --
831
   -----------
832
 
833
   procedure Place (C : Character) is
834
   begin
835
      if Cargs then
836
         Cargs_Buffer.Append (C);
837
      else
838
         Buffer.Append (C);
839
      end if;
840
   end Place;
841
 
842
   procedure Place (S : String) is
843
   begin
844
      for J in S'Range loop
845
         Place (S (J));
846
      end loop;
847
   end Place;
848
 
849
   -----------------
850
   -- Place_Lower --
851
   -----------------
852
 
853
   procedure Place_Lower (S : String) is
854
   begin
855
      for J in S'Range loop
856
         Place (To_Lower (S (J)));
857
      end loop;
858
   end Place_Lower;
859
 
860
   -------------------------
861
   -- Place_Unix_Switches --
862
   -------------------------
863
 
864
   procedure Place_Unix_Switches (S : VMS_Data.String_Ptr) is
865
      P1, P2, P3 : Natural;
866
      Remove     : Boolean;
867
      Slen, Sln2 : Natural;
868
      Wild_Card  : Boolean := False;
869
 
870
   begin
871
      P1 := S'First;
872
      while P1 <= S'Last loop
873
         if S (P1) = '!' then
874
            P1 := P1 + 1;
875
            Remove := True;
876
         else
877
            Remove := False;
878
         end if;
879
 
880
         P2 := P1;
881
         pragma Assert (S (P1) = '-' or else S (P1) = '`');
882
 
883
         while P2 < S'Last and then S (P2 + 1) /= ',' loop
884
            P2 := P2 + 1;
885
         end loop;
886
 
887
         --  Switch is now in S (P1 .. P2)
888
 
889
         Slen := P2 - P1 + 1;
890
 
891
         if Remove then
892
            Wild_Card := S (P2) = '*';
893
 
894
            if Wild_Card then
895
               Slen := Slen - 1;
896
               P2   := P2 - 1;
897
            end if;
898
 
899
            P3 := 1;
900
            while P3 <= Buffer.Last - Slen loop
901
               if Buffer.Table (P3) = ' '
902
                 and then String (Buffer.Table (P3 + 1 .. P3 + Slen)) =
903
                                                             S (P1 .. P2)
904
                 and then (Wild_Card
905
                             or else
906
                           P3 + Slen = Buffer.Last
907
                             or else
908
                           Buffer.Table (P3 + Slen + 1) = ' ')
909
               then
910
                  Sln2 := Slen;
911
 
912
                  if Wild_Card then
913
                     while P3 + Sln2 /= Buffer.Last
914
                       and then Buffer.Table (P3 + Sln2 + 1) /= ' '
915
                     loop
916
                        Sln2 := Sln2 + 1;
917
                     end loop;
918
                  end if;
919
 
920
                  Buffer.Table (P3 .. Buffer.Last - Sln2 - 1) :=
921
                    Buffer.Table (P3 + Sln2 + 1 .. Buffer.Last);
922
                  Buffer.Set_Last (Buffer.Last - Sln2 - 1);
923
 
924
               else
925
                  P3 := P3 + 1;
926
               end if;
927
            end loop;
928
 
929
            if Wild_Card then
930
               P2 := P2 + 1;
931
            end if;
932
 
933
         else
934
            pragma Assert (S (P2) /= '*');
935
            Place (' ');
936
 
937
            if S (P1) = '`' then
938
               P1 := P1 + 1;
939
            end if;
940
 
941
            Place (S (P1 .. P2));
942
         end if;
943
 
944
         P1 := P2 + 2;
945
      end loop;
946
   end Place_Unix_Switches;
947
 
948
   -----------------------------
949
   -- Preprocess_Command_Data --
950
   -----------------------------
951
 
952
   procedure Preprocess_Command_Data is
953
   begin
954
      for C in Real_Command_Type loop
955
         declare
956
            Command : constant Item_Ptr := new Command_Item;
957
 
958
            Last_Switch : Item_Ptr;
959
            --  Last switch in list
960
 
961
         begin
962
            --  Link new command item into list of commands
963
 
964
            if Last_Command = null then
965
               Commands := Command;
966
            else
967
               Last_Command.Next := Command;
968
            end if;
969
 
970
            Last_Command := Command;
971
 
972
            --  Fill in fields of new command item
973
 
974
            Command.Name    := Command_List (C).Cname;
975
            Command.Usage   := Command_List (C).Usage;
976
            Command.Command := C;
977
 
978
            if Command_List (C).Unixsws = null then
979
               Command.Unix_String := Command_List (C).Unixcmd;
980
            else
981
               declare
982
                  Cmd  : String (1 .. 5_000);
983
                  Last : Natural := 0;
984
                  Sws  : constant Argument_List_Access :=
985
                           Command_List (C).Unixsws;
986
 
987
               begin
988
                  Cmd (1 .. Command_List (C).Unixcmd'Length) :=
989
                    Command_List (C).Unixcmd.all;
990
                  Last := Command_List (C).Unixcmd'Length;
991
 
992
                  for J in Sws'Range loop
993
                     Last := Last + 1;
994
                     Cmd (Last) := ' ';
995
                     Cmd (Last + 1 .. Last + Sws (J)'Length) :=
996
                       Sws (J).all;
997
                     Last := Last + Sws (J)'Length;
998
                  end loop;
999
 
1000
                  Command.Unix_String := new String'(Cmd (1 .. Last));
1001
               end;
1002
            end if;
1003
 
1004
            Command.Params := Command_List (C).Params;
1005
            Command.Defext := Command_List (C).Defext;
1006
 
1007
            Validate_Command_Or_Option (Command.Name);
1008
 
1009
            --  Process the switch list
1010
 
1011
            for S in Command_List (C).Switches'Range loop
1012
               declare
1013
                  SS : constant VMS_Data.String_Ptr :=
1014
                         Command_List (C).Switches (S);
1015
                  P  : Natural := SS'First;
1016
                  Sw : Item_Ptr := new Switch_Item;
1017
 
1018
                  Last_Opt : Item_Ptr;
1019
                  --  Pointer to last option
1020
 
1021
               begin
1022
                  --  Link new switch item into list of switches
1023
 
1024
                  if Last_Switch = null then
1025
                     Command.Switches := Sw;
1026
                  else
1027
                     Last_Switch.Next := Sw;
1028
                  end if;
1029
 
1030
                  Last_Switch := Sw;
1031
 
1032
                  --  Process switch string, first get name
1033
 
1034
                  while SS (P) /= ' ' and then SS (P) /= '=' loop
1035
                     P := P + 1;
1036
                  end loop;
1037
 
1038
                  Sw.Name := new String'(SS (SS'First .. P - 1));
1039
 
1040
                  --  Direct translation case
1041
 
1042
                  if SS (P) = ' ' then
1043
                     Sw.Translation := T_Direct;
1044
                     Sw.Unix_String := new String'(SS (P + 1 .. SS'Last));
1045
                     Validate_Unix_Switch (Sw.Unix_String);
1046
 
1047
                     if SS (P - 1) = '>' then
1048
                        Sw.Translation := T_Other;
1049
 
1050
                     elsif SS (P + 1) = '`' then
1051
                        null;
1052
 
1053
                        --  Create the inverted case (/NO ..)
1054
 
1055
                     elsif SS (SS'First + 1 .. SS'First + 2) /= "NO" then
1056
                        Sw := new Switch_Item;
1057
                        Last_Switch.Next := Sw;
1058
                        Last_Switch := Sw;
1059
 
1060
                        Sw.Name :=
1061
                          new String'("/NO" & SS (SS'First + 1 .. P - 1));
1062
                        Sw.Translation := T_Direct;
1063
                        Sw.Unix_String := Invert_Sense (SS (P + 1 .. SS'Last));
1064
                        Validate_Unix_Switch (Sw.Unix_String);
1065
                     end if;
1066
 
1067
                  --  Directories translation case
1068
 
1069
                  elsif SS (P + 1) = '*' then
1070
                     pragma Assert (SS (SS'Last) = '*');
1071
                     Sw.Translation := T_Directories;
1072
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1073
                     Validate_Unix_Switch (Sw.Unix_String);
1074
 
1075
                  --  Directory translation case
1076
 
1077
                  elsif SS (P + 1) = '%' then
1078
                     pragma Assert (SS (SS'Last) = '%');
1079
                     Sw.Translation := T_Directory;
1080
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1081
                     Validate_Unix_Switch (Sw.Unix_String);
1082
 
1083
                  --  File translation case
1084
 
1085
                  elsif SS (P + 1) = '@' then
1086
                     pragma Assert (SS (SS'Last) = '@');
1087
                     Sw.Translation := T_File;
1088
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1089
                     Validate_Unix_Switch (Sw.Unix_String);
1090
 
1091
                  --  No space file translation case
1092
 
1093
                  elsif SS (P + 1) = '<' then
1094
                     pragma Assert (SS (SS'Last) = '>');
1095
                     Sw.Translation := T_No_Space_File;
1096
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1097
                     Validate_Unix_Switch (Sw.Unix_String);
1098
 
1099
                  --  Numeric translation case
1100
 
1101
                  elsif SS (P + 1) = '#' then
1102
                     pragma Assert (SS (SS'Last) = '#');
1103
                     Sw.Translation := T_Numeric;
1104
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1105
                     Validate_Unix_Switch (Sw.Unix_String);
1106
 
1107
                  --  Alphanumerplus translation case
1108
 
1109
                  elsif SS (P + 1) = '|' then
1110
                     pragma Assert (SS (SS'Last) = '|');
1111
                     Sw.Translation := T_Alphanumplus;
1112
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1113
                     Validate_Unix_Switch (Sw.Unix_String);
1114
 
1115
                  --  String translation case
1116
 
1117
                  elsif SS (P + 1) = '"' then
1118
                     pragma Assert (SS (SS'Last) = '"');
1119
                     Sw.Translation := T_String;
1120
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1121
                     Validate_Unix_Switch (Sw.Unix_String);
1122
 
1123
                  --  Commands translation case
1124
 
1125
                  elsif SS (P + 1) = '?' then
1126
                     Sw.Translation := T_Commands;
1127
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last));
1128
 
1129
                  --  Options translation case
1130
 
1131
                  else
1132
                     Sw.Translation := T_Options;
1133
                     Sw.Unix_String := new String'("");
1134
 
1135
                     P := P + 1; -- bump past =
1136
                     while P <= SS'Last loop
1137
                        declare
1138
                           Opt : constant Item_Ptr := new Option_Item;
1139
                           Q   : Natural;
1140
 
1141
                        begin
1142
                           --  Link new option item into options list
1143
 
1144
                           if Last_Opt = null then
1145
                              Sw.Options := Opt;
1146
                           else
1147
                              Last_Opt.Next := Opt;
1148
                           end if;
1149
 
1150
                           Last_Opt := Opt;
1151
 
1152
                           --  Fill in fields of new option item
1153
 
1154
                           Q := P;
1155
                           while SS (Q) /= ' ' loop
1156
                              Q := Q + 1;
1157
                           end loop;
1158
 
1159
                           Opt.Name := new String'(SS (P .. Q - 1));
1160
                           Validate_Command_Or_Option (Opt.Name);
1161
 
1162
                           P := Q + 1;
1163
                           Q := P;
1164
 
1165
                           while Q <= SS'Last and then SS (Q) /= ' ' loop
1166
                              Q := Q + 1;
1167
                           end loop;
1168
 
1169
                           Opt.Unix_String := new String'(SS (P .. Q - 1));
1170
                           Validate_Unix_Switch (Opt.Unix_String);
1171
                           P := Q + 1;
1172
                        end;
1173
                     end loop;
1174
                  end if;
1175
               end;
1176
            end loop;
1177
         end;
1178
      end loop;
1179
   end Preprocess_Command_Data;
1180
 
1181
   ----------------------
1182
   -- Process_Argument --
1183
   ----------------------
1184
 
1185
   procedure Process_Argument (The_Command : in out Command_Type) is
1186
      Argv    : String_Access;
1187
      Arg_Idx : Integer;
1188
 
1189
      function Get_Arg_End
1190
        (Argv    : String;
1191
         Arg_Idx : Integer) return Integer;
1192
      --  Begins looking at Arg_Idx + 1 and returns the index of the
1193
      --  last character before a slash or else the index of the last
1194
      --  character in the string Argv.
1195
 
1196
      -----------------
1197
      -- Get_Arg_End --
1198
      -----------------
1199
 
1200
      function Get_Arg_End
1201
        (Argv    : String;
1202
         Arg_Idx : Integer) return Integer
1203
      is
1204
      begin
1205
         for J in Arg_Idx + 1 .. Argv'Last loop
1206
            if Argv (J) = '/' then
1207
               return J - 1;
1208
            end if;
1209
         end loop;
1210
 
1211
         return Argv'Last;
1212
      end Get_Arg_End;
1213
 
1214
      --  Start of processing for Process_Argument
1215
 
1216
   begin
1217
      Cargs := False;
1218
 
1219
      --  If an argument file is open, read the next non empty line
1220
 
1221
      if Is_Open (Arg_File) then
1222
         declare
1223
            Line : String (1 .. 256);
1224
            Last : Natural;
1225
         begin
1226
            loop
1227
               Get_Line (Arg_File, Line, Last);
1228
               exit when Last /= 0 or else End_Of_File (Arg_File);
1229
            end loop;
1230
 
1231
            --  If the end of the argument file has been reached, close it
1232
 
1233
            if End_Of_File (Arg_File) then
1234
               Close (Arg_File);
1235
 
1236
               --  If the last line was empty, return after increasing Arg_Num
1237
               --  to go to the next argument on the comment line.
1238
 
1239
               if Last = 0 then
1240
                  Arg_Num := Arg_Num + 1;
1241
                  return;
1242
               end if;
1243
            end if;
1244
 
1245
            Argv := new String'(Line (1 .. Last));
1246
            Arg_Idx := 1;
1247
 
1248
            if Argv (1) = '@' then
1249
               Put_Line (Standard_Error, "argument file cannot contain @cmd");
1250
               raise Error_Exit;
1251
            end if;
1252
         end;
1253
 
1254
      else
1255
         --  No argument file is open, get the argument on the command line
1256
 
1257
         Argv := new String'(Argument (Arg_Num));
1258
         Arg_Idx := Argv'First;
1259
 
1260
         --  Check if this is the specification of an argument file
1261
 
1262
         if Argv (Arg_Idx) = '@' then
1263
            --  The first argument on the command line cannot be an argument
1264
            --  file.
1265
 
1266
            if Arg_Num = 1 then
1267
               Put_Line
1268
                 (Standard_Error,
1269
                  "Cannot specify argument line before command");
1270
               raise Error_Exit;
1271
            end if;
1272
 
1273
            --  Open the file, after conversion of the name to canonical form.
1274
            --  Fail if file is not found.
1275
 
1276
            declare
1277
               Canonical_File_Name : String_Access :=
1278
                 To_Canonical_File_Spec (Argv (Arg_Idx + 1 .. Argv'Last));
1279
            begin
1280
               Open (Arg_File, In_File, Canonical_File_Name.all);
1281
               Free (Canonical_File_Name);
1282
               return;
1283
 
1284
            exception
1285
               when others =>
1286
                  Put (Standard_Error, "Cannot open argument file """);
1287
                  Put (Standard_Error, Argv (Arg_Idx + 1 .. Argv'Last));
1288
                  Put_Line (Standard_Error, """");
1289
                  raise Error_Exit;
1290
            end;
1291
         end if;
1292
      end if;
1293
 
1294
      <<Tryagain_After_Coalesce>>
1295
      loop
1296
         declare
1297
            Next_Arg_Idx : Integer;
1298
            Arg          : String_Access;
1299
 
1300
         begin
1301
            Next_Arg_Idx := Get_Arg_End (Argv.all, Arg_Idx);
1302
            Arg := new String'(Argv (Arg_Idx .. Next_Arg_Idx));
1303
 
1304
            --  The first one must be a command name
1305
 
1306
            if Arg_Num = 1 and then Arg_Idx = Argv'First then
1307
               Command := Matching_Name (Arg.all, Commands);
1308
 
1309
               if Command = null then
1310
                  raise Error_Exit;
1311
               end if;
1312
 
1313
               The_Command := Command.Command;
1314
               Output_File_Expected := False;
1315
 
1316
               --  Give usage information if only command given
1317
 
1318
               if Argument_Count = 1
1319
                 and then Next_Arg_Idx = Argv'Last
1320
               then
1321
                  Output_Version;
1322
                  New_Line;
1323
                  Put_Line
1324
                    ("List of available qualifiers and options");
1325
                  New_Line;
1326
 
1327
                  Put (Command.Usage.all);
1328
                  Set_Col (53);
1329
                  Put_Line (Command.Unix_String.all);
1330
 
1331
                  declare
1332
                     Sw : Item_Ptr := Command.Switches;
1333
 
1334
                  begin
1335
                     while Sw /= null loop
1336
                        Put ("   ");
1337
                        Put (Sw.Name.all);
1338
 
1339
                        case Sw.Translation is
1340
 
1341
                           when T_Other =>
1342
                              Set_Col (53);
1343
                              Put_Line (Sw.Unix_String.all &
1344
                                        "/<other>");
1345
 
1346
                           when T_Direct =>
1347
                              Set_Col (53);
1348
                              Put_Line (Sw.Unix_String.all);
1349
 
1350
                           when T_Directories =>
1351
                              Put ("=(direc,direc,..direc)");
1352
                              Set_Col (53);
1353
                              Put (Sw.Unix_String.all);
1354
                              Put (" direc ");
1355
                              Put (Sw.Unix_String.all);
1356
                              Put_Line (" direc ...");
1357
 
1358
                           when T_Directory =>
1359
                              Put ("=directory");
1360
                              Set_Col (53);
1361
                              Put (Sw.Unix_String.all);
1362
 
1363
                              if Sw.Unix_String (Sw.Unix_String'Last)
1364
                              /= '='
1365
                              then
1366
                                 Put (' ');
1367
                              end if;
1368
 
1369
                              Put_Line ("directory ");
1370
 
1371
                           when T_File | T_No_Space_File =>
1372
                              Put ("=file");
1373
                              Set_Col (53);
1374
                              Put (Sw.Unix_String.all);
1375
 
1376
                              if Sw.Translation = T_File
1377
                                and then Sw.Unix_String
1378
                                  (Sw.Unix_String'Last) /= '='
1379
                              then
1380
                                 Put (' ');
1381
                              end if;
1382
 
1383
                              Put_Line ("file ");
1384
 
1385
                           when T_Numeric =>
1386
                              Put ("=nnn");
1387
                              Set_Col (53);
1388
 
1389
                              if Sw.Unix_String
1390
                                (Sw.Unix_String'First) = '`'
1391
                              then
1392
                                 Put (Sw.Unix_String
1393
                                        (Sw.Unix_String'First + 1
1394
                                         .. Sw.Unix_String'Last));
1395
                              else
1396
                                 Put (Sw.Unix_String.all);
1397
                              end if;
1398
 
1399
                              Put_Line ("nnn");
1400
 
1401
                           when T_Alphanumplus =>
1402
                              Put ("=xyz");
1403
                              Set_Col (53);
1404
 
1405
                              if Sw.Unix_String
1406
                                (Sw.Unix_String'First) = '`'
1407
                              then
1408
                                 Put (Sw.Unix_String
1409
                                        (Sw.Unix_String'First + 1
1410
                                         .. Sw.Unix_String'Last));
1411
                              else
1412
                                 Put (Sw.Unix_String.all);
1413
                              end if;
1414
 
1415
                              Put_Line ("xyz");
1416
 
1417
                           when T_String =>
1418
                              Put ("=");
1419
                              Put ('"');
1420
                              Put ("<string>");
1421
                              Put ('"');
1422
                              Set_Col (53);
1423
 
1424
                              Put (Sw.Unix_String.all);
1425
 
1426
                              if Sw.Unix_String
1427
                                (Sw.Unix_String'Last) /= '='
1428
                              then
1429
                                 Put (' ');
1430
                              end if;
1431
 
1432
                              Put ("<string>");
1433
                              New_Line;
1434
 
1435
                           when T_Commands =>
1436
                              Put (" (switches for ");
1437
                              Put (Sw.Unix_String
1438
                                     (Sw.Unix_String'First + 7
1439
                                      .. Sw.Unix_String'Last));
1440
                              Put (')');
1441
                              Set_Col (53);
1442
                              Put (Sw.Unix_String
1443
                                     (Sw.Unix_String'First
1444
                                      .. Sw.Unix_String'First + 5));
1445
                              Put_Line (" switches");
1446
 
1447
                           when T_Options =>
1448
                              declare
1449
                                 Opt : Item_Ptr := Sw.Options;
1450
 
1451
                              begin
1452
                                 Put_Line ("=(option,option..)");
1453
 
1454
                                 while Opt /= null loop
1455
                                    Put ("      ");
1456
                                    Put (Opt.Name.all);
1457
 
1458
                                    if Opt = Sw.Options then
1459
                                       Put (" (D)");
1460
                                    end if;
1461
 
1462
                                    Set_Col (53);
1463
                                    Put_Line (Opt.Unix_String.all);
1464
                                    Opt := Opt.Next;
1465
                                 end loop;
1466
                              end;
1467
 
1468
                        end case;
1469
 
1470
                        Sw := Sw.Next;
1471
                     end loop;
1472
                  end;
1473
 
1474
                  raise Normal_Exit;
1475
               end if;
1476
 
1477
            --  Special handling for internal debugging switch /?
1478
 
1479
            elsif Arg.all = "/?" then
1480
               Display_Command := True;
1481
               Output_File_Expected := False;
1482
 
1483
            --  Special handling of internal option /KEEP_TEMPORARY_FILES
1484
 
1485
            elsif Arg'Length >= 7
1486
              and then Matching_Name
1487
                         (Arg.all, Keep_Temps_Option, True) /= null
1488
            then
1489
               Opt.Keep_Temporary_Files := True;
1490
 
1491
            --  Copy -switch unchanged, as well as +rule
1492
 
1493
            elsif Arg (Arg'First) = '-' or else Arg (Arg'First) = '+' then
1494
               Place (' ');
1495
               Place (Arg.all);
1496
 
1497
               --  Set Output_File_Expected for the next argument
1498
 
1499
               Output_File_Expected :=
1500
                 Arg.all = "-o" and then The_Command = Link;
1501
 
1502
               --  Copy quoted switch with quotes stripped
1503
 
1504
            elsif Arg (Arg'First) = '"' then
1505
               if Arg (Arg'Last) /= '"' then
1506
                  Put (Standard_Error, "misquoted argument: ");
1507
                  Put_Line (Standard_Error, Arg.all);
1508
                  Errors := Errors + 1;
1509
 
1510
               else
1511
                  Place (' ');
1512
                  Place (Arg (Arg'First + 1 .. Arg'Last - 1));
1513
               end if;
1514
 
1515
               Output_File_Expected := False;
1516
 
1517
               --  Parameter Argument
1518
 
1519
            elsif Arg (Arg'First) /= '/'
1520
              and then Make_Commands_Active = null
1521
            then
1522
               Param_Count := Param_Count + 1;
1523
 
1524
               if Param_Count <= Command.Params'Length then
1525
 
1526
                  case Command.Params (Param_Count) is
1527
 
1528
                     when File | Optional_File =>
1529
                        declare
1530
                           Normal_File : constant String_Access :=
1531
                             To_Canonical_File_Spec
1532
                               (Arg.all);
1533
 
1534
                        begin
1535
                           Place (' ');
1536
                           Place_Lower (Normal_File.all);
1537
 
1538
                           if Is_Extensionless (Normal_File.all)
1539
                             and then Command.Defext /= "   "
1540
                           then
1541
                              Place ('.');
1542
                              Place (Command.Defext);
1543
                           end if;
1544
                        end;
1545
 
1546
                     when Unlimited_Files =>
1547
                        declare
1548
                           Normal_File : constant String_Access :=
1549
                             To_Canonical_File_Spec
1550
                               (Arg.all);
1551
 
1552
                           File_Is_Wild : Boolean := False;
1553
                           File_List    : String_Access_List_Access;
1554
 
1555
                        begin
1556
                           for J in Arg'Range loop
1557
                              if Arg (J) = '*'
1558
                                or else Arg (J) = '%'
1559
                              then
1560
                                 File_Is_Wild := True;
1561
                              end if;
1562
                           end loop;
1563
 
1564
                           if File_Is_Wild then
1565
                              File_List := To_Canonical_File_List
1566
                                (Arg.all, False);
1567
 
1568
                              for J in File_List.all'Range loop
1569
                                 Place (' ');
1570
                                 Place_Lower (File_List.all (J).all);
1571
                              end loop;
1572
 
1573
                           else
1574
                              Place (' ');
1575
                              Place_Lower (Normal_File.all);
1576
 
1577
                              --  Add extension if not present, except after
1578
                              --  switch -o.
1579
 
1580
                              if Is_Extensionless (Normal_File.all)
1581
                                and then Command.Defext /= "   "
1582
                                and then not Output_File_Expected
1583
                              then
1584
                                 Place ('.');
1585
                                 Place (Command.Defext);
1586
                              end if;
1587
                           end if;
1588
 
1589
                           Param_Count := Param_Count - 1;
1590
                        end;
1591
 
1592
                     when Other_As_Is =>
1593
                        Place (' ');
1594
                        Place (Arg.all);
1595
 
1596
                     when Unlimited_As_Is =>
1597
                        Place (' ');
1598
                        Place (Arg.all);
1599
                        Param_Count := Param_Count - 1;
1600
 
1601
                     when Files_Or_Wildcard =>
1602
 
1603
                        --  Remove spaces from a comma separated list
1604
                        --  of file names and adjust control variables
1605
                        --  accordingly.
1606
 
1607
                        while Arg_Num < Argument_Count and then
1608
                          (Argv (Argv'Last) = ',' xor
1609
                             Argument (Arg_Num + 1)
1610
                             (Argument (Arg_Num + 1)'First) = ',')
1611
                        loop
1612
                           Argv := new String'
1613
                             (Argv.all & Argument (Arg_Num + 1));
1614
                           Arg_Num := Arg_Num + 1;
1615
                           Arg_Idx := Argv'First;
1616
                           Next_Arg_Idx :=
1617
                             Get_Arg_End (Argv.all, Arg_Idx);
1618
                           Arg := new String'
1619
                             (Argv (Arg_Idx .. Next_Arg_Idx));
1620
                        end loop;
1621
 
1622
                        --  Parse the comma separated list of VMS
1623
                        --  filenames and place them on the command
1624
                        --  line as space separated Unix style
1625
                        --  filenames. Lower case and add default
1626
                        --  extension as appropriate.
1627
 
1628
                        declare
1629
                           Arg1_Idx : Integer := Arg'First;
1630
 
1631
                           function Get_Arg1_End
1632
                             (Arg     : String;
1633
                              Arg_Idx : Integer) return Integer;
1634
                           --  Begins looking at Arg_Idx + 1 and
1635
                           --  returns the index of the last character
1636
                           --  before a comma or else the index of the
1637
                           --  last character in the string Arg.
1638
 
1639
                           ------------------
1640
                           -- Get_Arg1_End --
1641
                           ------------------
1642
 
1643
                           function Get_Arg1_End
1644
                             (Arg     : String;
1645
                              Arg_Idx : Integer) return Integer
1646
                           is
1647
                           begin
1648
                              for J in Arg_Idx + 1 .. Arg'Last loop
1649
                                 if Arg (J) = ',' then
1650
                                    return J - 1;
1651
                                 end if;
1652
                              end loop;
1653
 
1654
                              return Arg'Last;
1655
                           end Get_Arg1_End;
1656
 
1657
                        begin
1658
                           loop
1659
                              declare
1660
                                 Next_Arg1_Idx :
1661
                                 constant Integer :=
1662
                                   Get_Arg1_End (Arg.all, Arg1_Idx);
1663
 
1664
                                 Arg1 :
1665
                                 constant String :=
1666
                                   Arg (Arg1_Idx .. Next_Arg1_Idx);
1667
 
1668
                                 Normal_File :
1669
                                 constant String_Access :=
1670
                                   To_Canonical_File_Spec (Arg1);
1671
 
1672
                              begin
1673
                                 Place (' ');
1674
                                 Place_Lower (Normal_File.all);
1675
 
1676
                                 if Is_Extensionless (Normal_File.all)
1677
                                   and then Command.Defext /= "   "
1678
                                 then
1679
                                    Place ('.');
1680
                                    Place (Command.Defext);
1681
                                 end if;
1682
 
1683
                                 Arg1_Idx := Next_Arg1_Idx + 1;
1684
                              end;
1685
 
1686
                              exit when Arg1_Idx > Arg'Last;
1687
 
1688
                              --  Don't allow two or more commas in
1689
                              --  a row
1690
 
1691
                              if Arg (Arg1_Idx) = ',' then
1692
                                 Arg1_Idx := Arg1_Idx + 1;
1693
                                 if Arg1_Idx > Arg'Last or else
1694
                                   Arg (Arg1_Idx) = ','
1695
                                 then
1696
                                    Put_Line
1697
                                      (Standard_Error,
1698
                                       "Malformed Parameter: " &
1699
                                       Arg.all);
1700
                                    Put (Standard_Error, "usage: ");
1701
                                    Put_Line (Standard_Error,
1702
                                              Command.Usage.all);
1703
                                    raise Error_Exit;
1704
                                 end if;
1705
                              end if;
1706
 
1707
                           end loop;
1708
                        end;
1709
                  end case;
1710
               end if;
1711
 
1712
               --  Reset Output_File_Expected, in case it was True
1713
 
1714
               Output_File_Expected := False;
1715
 
1716
               --  Qualifier argument
1717
 
1718
            else
1719
               Output_File_Expected := False;
1720
 
1721
               Cargs := Command.Name.all = "COMPILE";
1722
 
1723
               --  This code is too heavily nested, should be
1724
               --  separated out as separate subprogram ???
1725
 
1726
               declare
1727
                  Sw   : Item_Ptr;
1728
                  SwP  : Natural;
1729
                  P2   : Natural;
1730
                  Endp : Natural := 0; -- avoid warning!
1731
                  Opt  : Item_Ptr;
1732
 
1733
               begin
1734
                  SwP := Arg'First;
1735
                  while SwP < Arg'Last
1736
                    and then Arg (SwP + 1) /= '='
1737
                  loop
1738
                     SwP := SwP + 1;
1739
                  end loop;
1740
 
1741
                  --  At this point, the switch name is in
1742
                  --  Arg (Arg'First..SwP) and if that is not the
1743
                  --  whole switch, then there is an equal sign at
1744
                  --  Arg (SwP + 1) and the rest of Arg is what comes
1745
                  --  after the equal sign.
1746
 
1747
                  --  If make commands are active, see if we have
1748
                  --  another COMMANDS_TRANSLATION switch belonging
1749
                  --  to gnatmake.
1750
 
1751
                  if Make_Commands_Active /= null then
1752
                     Sw :=
1753
                       Matching_Name
1754
                         (Arg (Arg'First .. SwP),
1755
                          Command.Switches,
1756
                          Quiet => True);
1757
 
1758
                     if Sw /= null
1759
                       and then Sw.Translation = T_Commands
1760
                     then
1761
                        null;
1762
 
1763
                     else
1764
                        Sw :=
1765
                          Matching_Name
1766
                            (Arg (Arg'First .. SwP),
1767
                             Make_Commands_Active.Switches,
1768
                             Quiet => False);
1769
                     end if;
1770
 
1771
                     --  For case of GNAT MAKE or CHOP, if we cannot
1772
                     --  find the switch, then see if it is a
1773
                     --  recognized compiler switch instead, and if
1774
                     --  so process the compiler switch.
1775
 
1776
                  elsif Command.Name.all = "MAKE"
1777
                    or else Command.Name.all = "CHOP" then
1778
                     Sw :=
1779
                       Matching_Name
1780
                         (Arg (Arg'First .. SwP),
1781
                          Command.Switches,
1782
                          Quiet => True);
1783
 
1784
                     if Sw = null then
1785
                        Sw :=
1786
                          Matching_Name
1787
                            (Arg (Arg'First .. SwP),
1788
                             Matching_Name
1789
                               ("COMPILE", Commands).Switches,
1790
                             Quiet => False);
1791
                     end if;
1792
 
1793
                     --  For all other cases, just search the relevant
1794
                     --  command.
1795
 
1796
                  else
1797
                     Sw :=
1798
                       Matching_Name
1799
                         (Arg (Arg'First .. SwP),
1800
                          Command.Switches,
1801
                          Quiet => False);
1802
                  end if;
1803
 
1804
                  if Sw /= null then
1805
                     if Cargs
1806
                       and then Sw.Name /= null
1807
                       and then
1808
                         (Sw.Name.all = "/PROJECT_FILE"          or else
1809
                          Sw.Name.all = "/MESSAGES_PROJECT_FILE" or else
1810
                          Sw.Name.all = "/EXTERNAL_REFERENCE")
1811
                     then
1812
                        Cargs := False;
1813
                     end if;
1814
 
1815
                     case Sw.Translation is
1816
                        when T_Direct =>
1817
                           Place_Unix_Switches (Sw.Unix_String);
1818
                           if SwP < Arg'Last
1819
                             and then Arg (SwP + 1) = '='
1820
                           then
1821
                              Put (Standard_Error,
1822
                                   "qualifier options ignored: ");
1823
                              Put_Line (Standard_Error, Arg.all);
1824
                           end if;
1825
 
1826
                        when T_Directories =>
1827
                           if SwP + 1 > Arg'Last then
1828
                              Put (Standard_Error,
1829
                                   "missing directories for: ");
1830
                              Put_Line (Standard_Error, Arg.all);
1831
                              Errors := Errors + 1;
1832
 
1833
                           elsif Arg (SwP + 2) /= '(' then
1834
                              SwP := SwP + 2;
1835
                              Endp := Arg'Last;
1836
 
1837
                           elsif Arg (Arg'Last) /= ')' then
1838
 
1839
                              --  Remove spaces from a comma separated
1840
                              --  list of file names and adjust
1841
                              --  control variables accordingly.
1842
 
1843
                              if Arg_Num < Argument_Count and then
1844
                                (Argv (Argv'Last) = ',' xor
1845
                                   Argument (Arg_Num + 1)
1846
                                   (Argument (Arg_Num + 1)'First) = ',')
1847
                              then
1848
                                 Argv :=
1849
                                   new String'(Argv.all
1850
                                               & Argument
1851
                                                 (Arg_Num + 1));
1852
                                 Arg_Num := Arg_Num + 1;
1853
                                 Arg_Idx := Argv'First;
1854
                                 Next_Arg_Idx :=
1855
                                   Get_Arg_End (Argv.all, Arg_Idx);
1856
                                 Arg := new String'
1857
                                   (Argv (Arg_Idx .. Next_Arg_Idx));
1858
                                 goto Tryagain_After_Coalesce;
1859
                              end if;
1860
 
1861
                              Put (Standard_Error,
1862
                                   "incorrectly parenthesized " &
1863
                                   "or malformed argument: ");
1864
                              Put_Line (Standard_Error, Arg.all);
1865
                              Errors := Errors + 1;
1866
 
1867
                           else
1868
                              SwP := SwP + 3;
1869
                              Endp := Arg'Last - 1;
1870
                           end if;
1871
 
1872
                           while SwP <= Endp loop
1873
                              declare
1874
                                 Dir_Is_Wild       : Boolean := False;
1875
                                 Dir_Maybe_Is_Wild : Boolean := False;
1876
 
1877
                                 Dir_List : String_Access_List_Access;
1878
 
1879
                              begin
1880
                                 P2 := SwP;
1881
 
1882
                                 while P2 < Endp
1883
                                   and then Arg (P2 + 1) /= ','
1884
                                 loop
1885
                                    --  A wildcard directory spec on
1886
                                    --  VMS will contain either * or
1887
                                    --  % or ...
1888
 
1889
                                    if Arg (P2) = '*' then
1890
                                       Dir_Is_Wild := True;
1891
 
1892
                                    elsif Arg (P2) = '%' then
1893
                                       Dir_Is_Wild := True;
1894
 
1895
                                    elsif Dir_Maybe_Is_Wild
1896
                                      and then Arg (P2) = '.'
1897
                                      and then Arg (P2 + 1) = '.'
1898
                                    then
1899
                                       Dir_Is_Wild := True;
1900
                                       Dir_Maybe_Is_Wild := False;
1901
 
1902
                                    elsif Dir_Maybe_Is_Wild then
1903
                                       Dir_Maybe_Is_Wild := False;
1904
 
1905
                                    elsif Arg (P2) = '.'
1906
                                      and then Arg (P2 + 1) = '.'
1907
                                    then
1908
                                       Dir_Maybe_Is_Wild := True;
1909
 
1910
                                    end if;
1911
 
1912
                                    P2 := P2 + 1;
1913
                                 end loop;
1914
 
1915
                                 if Dir_Is_Wild then
1916
                                    Dir_List :=
1917
                                      To_Canonical_File_List
1918
                                        (Arg (SwP .. P2), True);
1919
 
1920
                                    for J in Dir_List.all'Range loop
1921
                                       Place_Unix_Switches
1922
                                         (Sw.Unix_String);
1923
                                       Place_Lower
1924
                                         (Dir_List.all (J).all);
1925
                                    end loop;
1926
 
1927
                                 else
1928
                                    Place_Unix_Switches
1929
                                      (Sw.Unix_String);
1930
                                    Place_Lower
1931
                                      (To_Canonical_Dir_Spec
1932
                                         (Arg (SwP .. P2), False).all);
1933
                                 end if;
1934
 
1935
                                 SwP := P2 + 2;
1936
                              end;
1937
                           end loop;
1938
 
1939
                        when T_Directory =>
1940
                           if SwP + 1 > Arg'Last then
1941
                              Put (Standard_Error,
1942
                                   "missing directory for: ");
1943
                              Put_Line (Standard_Error, Arg.all);
1944
                              Errors := Errors + 1;
1945
 
1946
                           else
1947
                              Place_Unix_Switches (Sw.Unix_String);
1948
 
1949
                              --  Some switches end in "=". No space
1950
                              --  here
1951
 
1952
                              if Sw.Unix_String
1953
                                (Sw.Unix_String'Last) /= '='
1954
                              then
1955
                                 Place (' ');
1956
                              end if;
1957
 
1958
                              Place_Lower
1959
                                (To_Canonical_Dir_Spec
1960
                                   (Arg (SwP + 2 .. Arg'Last),
1961
                                    False).all);
1962
                           end if;
1963
 
1964
                        when T_File | T_No_Space_File =>
1965
                           if SwP + 1 > Arg'Last then
1966
                              Put (Standard_Error,
1967
                                   "missing file for: ");
1968
                              Put_Line (Standard_Error, Arg.all);
1969
                              Errors := Errors + 1;
1970
 
1971
                           else
1972
                              Place_Unix_Switches (Sw.Unix_String);
1973
 
1974
                              --  Some switches end in "=". No space
1975
                              --  here.
1976
 
1977
                              if Sw.Translation = T_File
1978
                                and then Sw.Unix_String
1979
                                  (Sw.Unix_String'Last) /= '='
1980
                              then
1981
                                 Place (' ');
1982
                              end if;
1983
 
1984
                              Place_Lower
1985
                                (To_Canonical_File_Spec
1986
                                   (Arg (SwP + 2 .. Arg'Last)).all);
1987
                           end if;
1988
 
1989
                        when T_Numeric =>
1990
                           if OK_Integer (Arg (SwP + 2 .. Arg'Last)) then
1991
                              Place_Unix_Switches (Sw.Unix_String);
1992
                              Place (Arg (SwP + 2 .. Arg'Last));
1993
 
1994
                           else
1995
                              Put (Standard_Error, "argument for ");
1996
                              Put (Standard_Error, Sw.Name.all);
1997
                              Put_Line
1998
                                (Standard_Error, " must be numeric");
1999
                              Errors := Errors + 1;
2000
                           end if;
2001
 
2002
                        when T_Alphanumplus =>
2003
                           if OK_Alphanumerplus
2004
                             (Arg (SwP + 2 .. Arg'Last))
2005
                           then
2006
                              Place_Unix_Switches (Sw.Unix_String);
2007
                              Place (Arg (SwP + 2 .. Arg'Last));
2008
 
2009
                           else
2010
                              Put (Standard_Error, "argument for ");
2011
                              Put (Standard_Error, Sw.Name.all);
2012
                              Put_Line (Standard_Error,
2013
                                        " must be alphanumeric");
2014
                              Errors := Errors + 1;
2015
                           end if;
2016
 
2017
                        when T_String =>
2018
 
2019
                           --  A String value must be extended to the
2020
                           --  end of the Argv, otherwise strings like
2021
                           --  "foo/bar" get split at the slash.
2022
 
2023
                           --  The beginning and ending of the string
2024
                           --  are flagged with embedded nulls which
2025
                           --  are removed when building the Spawn
2026
                           --  call. Nulls are use because they won't
2027
                           --  show up in a /? output. Quotes aren't
2028
                           --  used because that would make it
2029
                           --  difficult to embed them.
2030
 
2031
                           Place_Unix_Switches (Sw.Unix_String);
2032
 
2033
                           if Next_Arg_Idx /= Argv'Last then
2034
                              Next_Arg_Idx := Argv'Last;
2035
                              Arg := new String'
2036
                                (Argv (Arg_Idx .. Next_Arg_Idx));
2037
 
2038
                              SwP := Arg'First;
2039
                              while SwP < Arg'Last and then
2040
                              Arg (SwP + 1) /= '=' loop
2041
                                 SwP := SwP + 1;
2042
                              end loop;
2043
                           end if;
2044
 
2045
                           Place (ASCII.NUL);
2046
                           Place (Arg (SwP + 2 .. Arg'Last));
2047
                           Place (ASCII.NUL);
2048
 
2049
                        when T_Commands =>
2050
 
2051
                           --  Output -largs/-bargs/-cargs
2052
 
2053
                           Place (' ');
2054
                           Place (Sw.Unix_String
2055
                                    (Sw.Unix_String'First ..
2056
                                       Sw.Unix_String'First + 5));
2057
 
2058
                           if Sw.Unix_String
2059
                             (Sw.Unix_String'First + 7 ..
2060
                                Sw.Unix_String'Last) = "MAKE"
2061
                           then
2062
                              Make_Commands_Active := null;
2063
 
2064
                           else
2065
                              --  Set source of new commands, also
2066
                              --  setting this non-null indicates that
2067
                              --  we are in the special commands mode
2068
                              --  for processing the -xargs case.
2069
 
2070
                              Make_Commands_Active :=
2071
                                Matching_Name
2072
                                  (Sw.Unix_String
2073
                                       (Sw.Unix_String'First + 7 ..
2074
                                            Sw.Unix_String'Last),
2075
                                   Commands);
2076
                           end if;
2077
 
2078
                        when T_Options =>
2079
                           if SwP + 1 > Arg'Last then
2080
                              Place_Unix_Switches
2081
                                (Sw.Options.Unix_String);
2082
                              SwP := Endp + 1;
2083
 
2084
                           elsif Arg (SwP + 2) /= '(' then
2085
                              SwP := SwP + 2;
2086
                              Endp := Arg'Last;
2087
 
2088
                           elsif Arg (Arg'Last) /= ')' then
2089
                              Put (Standard_Error,
2090
                                   "incorrectly parenthesized argument: ");
2091
                              Put_Line (Standard_Error, Arg.all);
2092
                              Errors := Errors + 1;
2093
                              SwP := Endp + 1;
2094
 
2095
                           else
2096
                              SwP := SwP + 3;
2097
                              Endp := Arg'Last - 1;
2098
                           end if;
2099
 
2100
                           while SwP <= Endp loop
2101
                              P2 := SwP;
2102
 
2103
                              while P2 < Endp
2104
                                and then Arg (P2 + 1) /= ','
2105
                              loop
2106
                                 P2 := P2 + 1;
2107
                              end loop;
2108
 
2109
                              --  Option name is in Arg (SwP .. P2)
2110
 
2111
                              Opt := Matching_Name (Arg (SwP .. P2),
2112
                                                    Sw.Options);
2113
 
2114
                              if Opt /= null then
2115
                                 Place_Unix_Switches
2116
                                   (Opt.Unix_String);
2117
                              end if;
2118
 
2119
                              SwP := P2 + 2;
2120
                           end loop;
2121
 
2122
                        when T_Other =>
2123
                           Place_Unix_Switches
2124
                             (new String'(Sw.Unix_String.all &
2125
                                          Arg.all));
2126
 
2127
                     end case;
2128
                  end if;
2129
               end;
2130
            end if;
2131
 
2132
            Arg_Idx := Next_Arg_Idx + 1;
2133
         end;
2134
 
2135
         exit when Arg_Idx > Argv'Last;
2136
 
2137
      end loop;
2138
 
2139
      if not Is_Open (Arg_File) then
2140
         Arg_Num := Arg_Num + 1;
2141
      end if;
2142
   end Process_Argument;
2143
 
2144
   --------------------
2145
   -- Process_Buffer --
2146
   --------------------
2147
 
2148
   procedure Process_Buffer (S : String) is
2149
      P1, P2     : Natural;
2150
      Inside_Nul : Boolean := False;
2151
      Arg        : String (1 .. 1024);
2152
      Arg_Ctr    : Natural;
2153
 
2154
   begin
2155
      P1 := 1;
2156
      while P1 <= S'Last and then S (P1) = ' ' loop
2157
         P1 := P1 + 1;
2158
      end loop;
2159
 
2160
      Arg_Ctr := 1;
2161
      Arg (Arg_Ctr) := S (P1);
2162
 
2163
      while P1 <= S'Last loop
2164
         if S (P1) = ASCII.NUL then
2165
            if Inside_Nul then
2166
               Inside_Nul := False;
2167
            else
2168
               Inside_Nul := True;
2169
            end if;
2170
         end if;
2171
 
2172
         if S (P1) = ' ' and then not Inside_Nul then
2173
            P1 := P1 + 1;
2174
            Arg_Ctr := Arg_Ctr + 1;
2175
            Arg (Arg_Ctr) := S (P1);
2176
 
2177
         else
2178
            Last_Switches.Increment_Last;
2179
            P2 := P1;
2180
 
2181
            while P2 < S'Last
2182
              and then (S (P2 + 1) /= ' ' or else
2183
                        Inside_Nul)
2184
            loop
2185
               P2 := P2 + 1;
2186
               Arg_Ctr := Arg_Ctr + 1;
2187
               Arg (Arg_Ctr) := S (P2);
2188
               if S (P2) = ASCII.NUL then
2189
                  Arg_Ctr := Arg_Ctr - 1;
2190
 
2191
                  if Inside_Nul then
2192
                     Inside_Nul := False;
2193
                  else
2194
                     Inside_Nul := True;
2195
                  end if;
2196
               end if;
2197
            end loop;
2198
 
2199
            Last_Switches.Table (Last_Switches.Last) :=
2200
              new String'(String (Arg (1 .. Arg_Ctr)));
2201
            P1 := P2 + 2;
2202
 
2203
            exit when P1 > S'Last;
2204
 
2205
            Arg_Ctr := 1;
2206
            Arg (Arg_Ctr) := S (P1);
2207
         end if;
2208
      end loop;
2209
   end Process_Buffer;
2210
 
2211
   --------------------------------
2212
   -- Validate_Command_Or_Option --
2213
   --------------------------------
2214
 
2215
   procedure Validate_Command_Or_Option (N : VMS_Data.String_Ptr) is
2216
   begin
2217
      pragma Assert (N'Length > 0);
2218
 
2219
      for J in N'Range loop
2220
         if N (J) = '_' then
2221
            pragma Assert (N (J - 1) /= '_');
2222
            null;
2223
         else
2224
            pragma Assert (Is_Upper (N (J)) or else Is_Digit (N (J)));
2225
            null;
2226
         end if;
2227
      end loop;
2228
   end Validate_Command_Or_Option;
2229
 
2230
   --------------------------
2231
   -- Validate_Unix_Switch --
2232
   --------------------------
2233
 
2234
   procedure Validate_Unix_Switch (S : VMS_Data.String_Ptr) is
2235
   begin
2236
      if S (S'First) = '`' then
2237
         return;
2238
      end if;
2239
 
2240
      pragma Assert (S (S'First) = '-' or else S (S'First) = '!');
2241
 
2242
      for J in S'First + 1 .. S'Last loop
2243
         pragma Assert (S (J) /= ' ');
2244
 
2245
         if S (J) = '!' then
2246
            pragma Assert (S (J - 1) = ',' and then S (J + 1) = '-');
2247
            null;
2248
         end if;
2249
      end loop;
2250
   end Validate_Unix_Switch;
2251
 
2252
   --------------------
2253
   -- VMS_Conversion --
2254
   --------------------
2255
 
2256
   procedure VMS_Conversion (The_Command : out Command_Type) is
2257
      Result     : Command_Type := Undefined;
2258
      Result_Set : Boolean      := False;
2259
 
2260
   begin
2261
      Buffer.Init;
2262
 
2263
      --  First we must preprocess the string form of the command and options
2264
      --  list into the internal form that we use.
2265
 
2266
      Preprocess_Command_Data;
2267
 
2268
      --  If no parameters, give complete list of commands
2269
 
2270
      if Argument_Count = 0 then
2271
         Output_Version;
2272
         New_Line;
2273
         Put_Line ("List of available commands");
2274
         New_Line;
2275
 
2276
         while Commands /= null loop
2277
            Put (Commands.Usage.all);
2278
            Set_Col (53);
2279
            Put_Line (Commands.Unix_String.all);
2280
            Commands := Commands.Next;
2281
         end loop;
2282
 
2283
         raise Normal_Exit;
2284
      end if;
2285
 
2286
      --  Loop through arguments
2287
 
2288
      Arg_Num := 1;
2289
      while Arg_Num <= Argument_Count loop
2290
         Process_Argument (Result);
2291
 
2292
         if not Result_Set then
2293
            The_Command := Result;
2294
            Result_Set := True;
2295
         end if;
2296
      end loop;
2297
 
2298
      --  Gross error checking that the number of parameters is correct.
2299
      --  Not applicable to Unlimited_Files parameters.
2300
 
2301
      if (Param_Count = Command.Params'Length - 1
2302
            and then Command.Params (Param_Count + 1) = Unlimited_Files)
2303
        or else Param_Count <= Command.Params'Length
2304
      then
2305
         null;
2306
 
2307
      else
2308
         Put_Line (Standard_Error,
2309
                   "Parameter count of "
2310
                   & Integer'Image (Param_Count)
2311
                   & " not equal to expected "
2312
                   & Integer'Image (Command.Params'Length));
2313
         Put (Standard_Error, "usage: ");
2314
         Put_Line (Standard_Error, Command.Usage.all);
2315
         Errors := Errors + 1;
2316
      end if;
2317
 
2318
      if Errors > 0 then
2319
         raise Error_Exit;
2320
      else
2321
         --  Prepare arguments for a call to spawn, filtering out
2322
         --  embedded nulls place there to delineate strings.
2323
 
2324
         Process_Buffer (String (Buffer.Table (1 .. Buffer.Last)));
2325
 
2326
         if Cargs_Buffer.Last > 1 then
2327
            Last_Switches.Append (new String'("-cargs"));
2328
            Process_Buffer
2329
              (String (Cargs_Buffer.Table (1 .. Cargs_Buffer.Last)));
2330
         end if;
2331
      end if;
2332
   end VMS_Conversion;
2333
 
2334
end VMS_Conv;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.