?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Daily bump.
[official-gcc.git] / gcc / ada / gnatcmd.adb
blobc65cb3c0acce9b1953ba2154d939309ef1090d8b
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G N A T C M D --
6 -- --
7 -- B o d y --
8 -- --
9 -- $Revision: 1.8 $
10 -- --
11 -- Copyright (C) 1996-2001 Free Software Foundation, Inc. --
12 -- --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
23 -- --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 -- --
27 ------------------------------------------------------------------------------
28
29 with Ada.Characters.Handling; use Ada.Characters.Handling;
30 with Ada.Command_Line; use Ada.Command_Line;
31 with Ada.Text_IO; use Ada.Text_IO;
32
33 with Osint; use Osint;
34 with Sdefault; use Sdefault;
35 with Hostparm; use Hostparm;
36 -- Used to determine if we are in VMS or not for error message purposes
37
38 with Gnatvsn;
39 with GNAT.OS_Lib; use GNAT.OS_Lib;
40
41 with Table;
42
43 procedure GNATCmd is
44 pragma Ident (Gnatvsn.Gnat_Version_String);
45
46 ------------------
47 -- SWITCH TABLE --
48 ------------------
49
50 -- The switch tables contain an entry for each switch recognized by the
51 -- command processor. The syntax of entries is as follows:
52
53 -- SWITCH_STRING ::= "/ command-qualifier-name TRANSLATION"
54
55 -- TRANSLATION ::=
56 -- DIRECT_TRANSLATION
57 -- | DIRECTORIES_TRANSLATION
58 -- | FILE_TRANSLATION
59 -- | NUMERIC_TRANSLATION
60 -- | STRING_TRANSLATION
61 -- | OPTIONS_TRANSLATION
62 -- | COMMANDS_TRANSLATION
63 -- | ALPHANUMPLUS_TRANSLATION
64 -- | OTHER_TRANSLATION
65
66 -- DIRECT_TRANSLATION ::= space UNIX_SWITCHES
67 -- DIRECTORIES_TRANSLATION ::= =* UNIX_SWITCH *
68 -- DIRECTORY_TRANSLATION ::= =% UNIX_SWITCH %
69 -- FILE_TRANSLATION ::= =@ UNIX_SWITCH @
70 -- NUMERIC_TRANSLATION ::= =# UNIX_SWITCH # | # number #
71 -- STRING_TRANSLATION ::= =" UNIX_SWITCH "
72 -- OPTIONS_TRANSLATION ::= =OPTION {space OPTION}
73 -- COMMANDS_TRANSLATION ::= =? ARGS space command-name
74 -- ALPHANUMPLUS_TRANSLATION ::= =| UNIX_SWITCH |
75
76 -- UNIX_SWITCHES ::= UNIX_SWITCH {, UNIX_SWITCH}
77
78 -- UNIX_SWITCH ::= unix-switch-string | !unix-switch-string | `string'
79
80 -- OPTION ::= option-name space UNIX_SWITCHES
81
82 -- ARGS ::= -cargs | -bargs | -largs
83
84 -- Here command-qual is the name of the switch recognized by the GNATCmd.
85 -- This is always given in upper case in the templates, although in the
86 -- actual commands, either upper or lower case is allowed.
87
88 -- The unix-switch-string always starts with a minus, and has no commas
89 -- or spaces in it. Case is significant in the unix switch string. If a
90 -- unix switch string is preceded by the not sign (!) it means that the
91 -- effect of the corresponding command qualifer is to remove any previous
92 -- occurrence of the given switch in the command line.
93
94 -- The DIRECTORIES_TRANSLATION format is used where a list of directories
95 -- is given. This possible corresponding formats recognized by GNATCmd are
96 -- as shown by the following example for the case of PATH
97
98 -- PATH=direc
99 -- PATH=(direc,direc,direc,direc)
100
101 -- When more than one directory is present for the DIRECTORIES case, then
102 -- multiple instances of the corresponding unix switch are generated,
103 -- with the file name being substituted for the occurrence of *.
104
105 -- The FILE_TRANSLATION format is similar except that only a single
106 -- file is allowed, not a list of files, and only one unix switch is
107 -- generated as a result.
108
109 -- The NUMERIC_TRANSLATION format is similar to the FILE_TRANSLATION case
110 -- except that the parameter is a decimal integer in the range 0 to 999.
111
112 -- For the OPTIONS_TRANSLATION case, GNATCmd similarly permits one or
113 -- more options to appear (although only in some cases does the use of
114 -- multiple options make logical sense). For example, taking the
115 -- case of ERRORS for GCC, the following are all allowed:
116
117 -- /ERRORS=BRIEF
118 -- /ERRORS=(FULL,VERBOSE)
119 -- /ERRORS=(BRIEF IMMEDIATE)
120
121 -- If no option is provided (e.g. just /ERRORS is written), then the
122 -- first option in the list is the default option. For /ERRORS this
123 -- is NORMAL, so /ERRORS with no option is equivalent to /ERRORS=NORMAL.
124
125 -- The COMMANDS_TRANSLATION case is only used for gnatmake, to correspond
126 -- to the use of -cargs, -bargs and -largs (the ARGS string as indicated
127 -- is one of these three possibilities). The name given by COMMAND is the
128 -- corresponding command name to be used to interprete the switches to be
129 -- passed on. Switches of this type set modes, e.g. /COMPILER_QUALIFIERS
130 -- sets the mode so that all subsequent switches, up to another switch
131 -- with COMMANDS_TRANSLATION apply to the corresponding commands issued
132 -- by the make utility. For example
133
134 -- /COMPILER_QUALIFIERS /LIST /BINDER_QUALIFIERS /MAIN
135 -- /COMPILER_QUALIFIERS /NOLIST /COMPILE_CHECKS=SYNTAX
136
137 -- Clearly these switches must come at the end of the list of switches
138 -- since all subsequent switches apply to an issued command.
139
140 -- For the DIRECT_TRANSLATION case, an implicit additional entry is
141 -- created by prepending NO to the name of the qualifer, and then
142 -- inverting the sense of the UNIX_SWITCHES string. For example,
143 -- given the entry:
144
145 -- "/LIST -gnatl"
146
147 -- An implicit entry is created:
148
149 -- "/NOLIST !-gnatl"
150
151 -- In the case where, a ! is already present, inverting the sense of the
152 -- switch means removing it.
153
154 subtype S is String;
155 -- A synonym to shorten the table
156
157 type String_Ptr is access constant String;
158 -- String pointer type used throughout
159
160 type Switches is array (Natural range <>) of String_Ptr;
161 -- Type used for array of swtiches
162
163 type Switches_Ptr is access constant Switches;
164
165 --------------------------------
166 -- Switches for project files --
167 --------------------------------
168
169 S_Ext_Ref : aliased constant S := "/EXTERNAL_REFERENCE=" & '"' &
170 "-X" & '"';
171
172 S_Project_File : aliased constant S := "/PROJECT_FILE=*" &
173 "-P*";
174 S_Project_Verb : aliased constant S := "/PROJECT_FILE_VERBOSITY=" &
175 "DEFAULT " &
176 "-vP0 " &
177 "MEDIUM " &
178 "-vP1 " &
179 "HIGH " &
180 "-vP2";
181
182 ----------------------------
183 -- Switches for GNAT BIND --
184 ----------------------------
185
186 S_Bind_Bind : aliased constant S := "/BIND_FILE=" &
187 "ADA " &
188 "-A " &
189 "C " &
190 "-C";
191
192 S_Bind_Build : aliased constant S := "/BUILD_LIBRARY=|" &
193 "-L|";
194
195 S_Bind_Current : aliased constant S := "/CURRENT_DIRECTORY " &
196 "!-I-";
197
198 S_Bind_Debug : aliased constant S := "/DEBUG=" &
199 "TRACEBACK " &
200 "-g2 " &
201 "ALL " &
202 "-g3 " &
203 "NONE " &
204 "-g0 " &
205 "SYMBOLS " &
206 "-g1 " &
207 "NOSYMBOLS " &
208 "!-g1 " &
209 "LINK " &
210 "-g3 " &
211 "NOTRACEBACK " &
212 "!-g2";
213
214 S_Bind_DebugX : aliased constant S := "/NODEBUG " &
215 "!-g";
216
217 S_Bind_Elab : aliased constant S := "/ELABORATION_DEPENDENCIES " &
218 "-e";
219
220 S_Bind_Error : aliased constant S := "/ERROR_LIMIT=#" &
221 "-m#";
222
223 S_Bind_Library : aliased constant S := "/LIBRARY_SEARCH=*" &
224 "-aO*";
225
226 S_Bind_Linker : aliased constant S := "/LINKER_OPTION_LIST " &
227 "-K";
228
229 S_Bind_Main : aliased constant S := "/MAIN " &
230 "!-n";
231
232 S_Bind_Nostinc : aliased constant S := "/NOSTD_INCLUDES " &
233 "-nostdinc";
234
235 S_Bind_Nostlib : aliased constant S := "/NOSTD_LIBRARIES " &
236 "-nostdlib";
237
238 S_Bind_Object : aliased constant S := "/OBJECT_LIST " &
239 "-O";
240
241 S_Bind_Order : aliased constant S := "/ORDER_OF_ELABORATION " &
242 "-l";
243
244 S_Bind_Output : aliased constant S := "/OUTPUT=@" &
245 "-o@";
246
247 S_Bind_OutputX : aliased constant S := "/NOOUTPUT " &
248 "-c";
249
250 S_Bind_Pess : aliased constant S := "/PESSIMISTIC_ELABORATION " &
251 "-p";
252
253 S_Bind_Read : aliased constant S := "/READ_SOURCES=" &
254 "ALL " &
255 "-s " &
256 "NONE " &
257 "-x " &
258 "AVAILABLE " &
259 "!-x,!-s";
260
261 S_Bind_ReadX : aliased constant S := "/NOREAD_SOURCES " &
262 "-x";
263
264 S_Bind_Rename : aliased constant S := "/RENAME_MAIN " &
265 "-r";
266
267 S_Bind_Report : aliased constant S := "/REPORT_ERRORS=" &
268 "VERBOSE " &
269 "-v " &
270 "BRIEF " &
271 "-b " &
272 "DEFAULT " &
273 "!-b,!-v";
274
275 S_Bind_ReportX : aliased constant S := "/NOREPORT_ERRORS " &
276 "!-b,!-v";
277
278 S_Bind_Search : aliased constant S := "/SEARCH=*" &
279 "-I*";
280
281 S_Bind_Shared : aliased constant S := "/SHARED " &
282 "-shared";
283
284 S_Bind_Source : aliased constant S := "/SOURCE_SEARCH=*" &
285 "-aI*";
286
287 S_Bind_Time : aliased constant S := "/TIME_STAMP_CHECK " &
288 "!-t";
289
290 S_Bind_Verbose : aliased constant S := "/VERBOSE " &
291 "-v";
292
293 S_Bind_Warn : aliased constant S := "/WARNINGS=" &
294 "NORMAL " &
295 "!-ws,!-we " &
296 "SUPPRESS " &
297 "-ws " &
298 "ERROR " &
299 "-we";
300
301 S_Bind_WarnX : aliased constant S := "/NOWARNINGS " &
302 "-ws";
303
304 Bind_Switches : aliased constant Switches := (
305 S_Bind_Bind 'Access,
306 S_Bind_Build 'Access,
307 S_Bind_Current 'Access,
308 S_Bind_Debug 'Access,
309 S_Bind_DebugX 'Access,
310 S_Bind_Elab 'Access,
311 S_Bind_Error 'Access,
312 S_Ext_Ref 'Access,
313 S_Bind_Library 'Access,
314 S_Bind_Linker 'Access,
315 S_Bind_Main 'Access,
316 S_Bind_Nostinc 'Access,
317 S_Bind_Nostlib 'Access,
318 S_Bind_Object 'Access,
319 S_Bind_Order 'Access,
320 S_Bind_Output 'Access,
321 S_Bind_OutputX 'Access,
322 S_Bind_Pess 'Access,
323 S_Project_File 'Access,
324 S_Project_Verb 'Access,
325 S_Bind_Read 'Access,
326 S_Bind_ReadX 'Access,
327 S_Bind_Rename 'Access,
328 S_Bind_Report 'Access,
329 S_Bind_ReportX 'Access,
330 S_Bind_Search 'Access,
331 S_Bind_Shared 'Access,
332 S_Bind_Source 'Access,
333 S_Bind_Time 'Access,
334 S_Bind_Verbose 'Access,
335 S_Bind_Warn 'Access,
336 S_Bind_WarnX 'Access);
337
338 ----------------------------
339 -- Switches for GNAT CHOP --
340 ----------------------------
341
342 S_Chop_Comp : aliased constant S := "/COMPILATION " &
343 "-c";
344
345 S_Chop_File : aliased constant S := "/FILE_NAME_MAX_LENGTH=#" &
346 "-k#";
347
348 S_Chop_Help : aliased constant S := "/HELP " &
349 "-h";
350
351 S_Chop_Over : aliased constant S := "/OVERWRITE " &
352 "-w";
353
354 S_Chop_Pres : aliased constant S := "/PRESERVE " &
355 "-p";
356
357 S_Chop_Quiet : aliased constant S := "/QUIET " &
358 "-q";
359
360 S_Chop_Ref : aliased constant S := "/REFERENCE " &
361 "-r";
362
363 S_Chop_Verb : aliased constant S := "/VERBOSE " &
364 "-v";
365
366 Chop_Switches : aliased constant Switches := (
367 S_Chop_Comp 'Access,
368 S_Chop_File 'Access,
369 S_Chop_Help 'Access,
370 S_Chop_Over 'Access,
371 S_Chop_Pres 'Access,
372 S_Chop_Quiet 'Access,
373 S_Chop_Ref 'Access,
374 S_Chop_Verb 'Access);
375
376 -------------------------------
377 -- Switches for GNAT COMPILE --
378 -------------------------------
379
380 S_GCC_Ada_83 : aliased constant S := "/83 " &
381 "-gnat83";
382
383 S_GCC_Ada_95 : aliased constant S := "/95 " &
384 "!-gnat83";
385
386 S_GCC_Asm : aliased constant S := "/ASM " &
387 "-S,!-c";
388
389 S_GCC_Checks : aliased constant S := "/CHECKS=" &
390 "FULL " &
391 "-gnato,!-gnatE,!-gnatp " &
392 "OVERFLOW " &
393 "-gnato " &
394 "ELABORATION " &
395 "-gnatE " &
396 "ASSERTIONS " &
397 "-gnata " &
398 "DEFAULT " &
399 "!-gnato,!-gnatp " &
400 "SUPPRESS_ALL " &
401 "-gnatp";
402
403 S_GCC_ChecksX : aliased constant S := "/NOCHECKS " &
404 "-gnatp,!-gnato,!-gnatE";
405
406 S_GCC_Compres : aliased constant S := "/COMPRESS_NAMES " &
407 "-gnatC";
408
409 S_GCC_Current : aliased constant S := "/CURRENT_DIRECTORY " &
410 "!-I-";
411
412 S_GCC_Debug : aliased constant S := "/DEBUG=" &
413 "SYMBOLS " &
414 "-g2 " &
415 "NOSYMBOLS " &
416 "!-g2 " &
417 "TRACEBACK " &
418 "-g1 " &
419 "ALL " &
420 "-g3 " &
421 "NONE " &
422 "-g0 " &
423 "NOTRACEBACK " &
424 "-g0";
425
426 S_GCC_DebugX : aliased constant S := "/NODEBUG " &
427 "!-g";
428
429 S_GCC_Dist : aliased constant S := "/DISTRIBUTION_STUBS=" &
430 "RECEIVER " &
431 "-gnatzr " &
432 "CALLER " &
433 "-gnatzc";
434
435 S_GCC_DistX : aliased constant S := "/NODISTRIBUTION_STUBS " &
436 "!-gnatzr,!-gnatzc";
437
438 S_GCC_Error : aliased constant S := "/ERROR_LIMIT=#" &
439 "-gnatm#";
440
441 S_GCC_ErrorX : aliased constant S := "/NOERROR_LIMIT " &
442 "-gnatm999";
443
444 S_GCC_Expand : aliased constant S := "/EXPAND_SOURCE " &
445 "-gnatG";
446
447 S_GCC_Extend : aliased constant S := "/EXTENSIONS_ALLOWED " &
448 "-gnatX";
449
450 S_GCC_File : aliased constant S := "/FILE_NAME_MAX_LENGTH=#" &
451 "-gnatk#";
452
453 S_GCC_Force : aliased constant S := "/FORCE_ALI " &
454 "-gnatQ";
455
456 S_GCC_Ident : aliased constant S := "/IDENTIFIER_CHARACTER_SET=" &
457 "DEFAULT " &
458 "-gnati1 " &
459 "1 " &
460 "-gnati1 " &
461 "2 " &
462 "-gnati2 " &
463 "3 " &
464 "-gnati3 " &
465 "4 " &
466 "-gnati4 " &
467 "5 " &
468 "-gnati5 " &
469 "PC " &
470 "-gnatip " &
471 "PC850 " &
472 "-gnati8 " &
473 "FULL_UPPER " &
474 "-gnatif " &
475 "NO_UPPER " &
476 "-gnatin " &
477 "WIDE " &
478 "-gnatiw";
479
480 S_GCC_IdentX : aliased constant S := "/NOIDENTIFIER_CHARACTER_SET " &
481 "-gnati1";
482
483 S_GCC_Inline : aliased constant S := "/INLINE=" &
484 "PRAGMA " &
485 "-gnatn " &
486 "SUPPRESS " &
487 "-fno-inline";
488
489 S_GCC_InlineX : aliased constant S := "/NOINLINE " &
490 "!-gnatn";
491
492 S_GCC_List : aliased constant S := "/LIST " &
493 "-gnatl";
494
495 S_GCC_Noload : aliased constant S := "/NOLOAD " &
496 "-gnatc";
497
498 S_GCC_Nostinc : aliased constant S := "/NOSTD_INCLUDES " &
499 "-nostdinc";
500
501 S_GCC_Opt : aliased constant S := "/OPTIMIZE=" &
502 "ALL " &
503 "-O2,!-O0,!-O1,!-O3 " &
504 "NONE " &
505 "-O0,!-O1,!-O2,!-O3 " &
506 "SOME " &
507 "-O1,!-O0,!-O2,!-O3 " &
508 "DEVELOPMENT " &
509 "-O1,!-O0,!-O2,!-O3 " &
510 "UNROLL_LOOPS " &
511 "-funroll-loops " &
512 "INLINING " &
513 "-O3,!-O0,!-O1,!-O2";
514
515 S_GCC_OptX : aliased constant S := "/NOOPTIMIZE " &
516 "-O0,!-O1,!-O2,!-O3";
517
518 S_GCC_Report : aliased constant S := "/REPORT_ERRORS=" &
519 "VERBOSE " &
520 "-gnatv " &
521 "BRIEF " &
522 "-gnatb " &
523 "FULL " &
524 "-gnatf " &
525 "IMMEDIATE " &
526 "-gnate " &
527 "DEFAULT " &
528 "!-gnatb,!-gnatv";
529
530 S_GCC_ReportX : aliased constant S := "/NOREPORT_ERRORS " &
531 "!-gnatb,!-gnatv";
532
533 S_GCC_Repinfo : aliased constant S := "/REPRESENTATION_INFO=" &
534 "ARRAYS " &
535 "-gnatR1 " &
536 "NONE " &
537 "-gnatR0 " &
538 "OBJECTS " &
539 "-gnatR2 " &
540 "SYMBOLIC " &
541 "-gnatR3 " &
542 "DEFAULT " &
543 "-gnatR";
544
545 S_GCC_RepinfX : aliased constant S := "/NOREPRESENTATION_INFO " &
546 "!-gnatR";
547
548 S_GCC_Search : aliased constant S := "/SEARCH=*" &
549 "-I*";
550
551 S_GCC_Style : aliased constant S := "/STYLE_CHECKS=" &
552 "ALL_BUILTIN " &
553 "-gnaty " &
554 "1 " &
555 "-gnaty1 " &
556 "2 " &
557 "-gnaty2 " &
558 "3 " &
559 "-gnaty3 " &
560 "4 " &
561 "-gnaty4 " &
562 "5 " &
563 "-gnaty5 " &
564 "6 " &
565 "-gnaty6 " &
566 "7 " &
567 "-gnaty7 " &
568 "8 " &
569 "-gnaty8 " &
570 "9 " &
571 "-gnaty9 " &
572 "ATTRIBUTE " &
573 "-gnatya " &
574 "BLANKS " &
575 "-gnatyb " &
576 "COMMENTS " &
577 "-gnatyc " &
578 "END " &
579 "-gnatye " &
580 "VTABS " &
581 "-gnatyf " &
582 "GNAT " &
583 "-gnatg " &
584 "HTABS " &
585 "-gnatyh " &
586 "IF_THEN " &
587 "-gnatyi " &
588 "KEYWORD " &
589 "-gnatyk " &
590 "LAYOUT " &
591 "-gnatyl " &
592 "LINE_LENGTH " &
593 "-gnatym " &
594 "STANDARD_CASING " &
595 "-gnatyn " &
596 "ORDERED_SUBPROGRAMS " &
597 "-gnatyo " &
598 "NONE " &
599 "!-gnatg,!-gnatr " &
600 "PRAGMA " &
601 "-gnatyp " &
602 "REFERENCES " &
603 "-gnatr " &
604 "SPECS " &
605 "-gnatys " &
606 "TOKEN " &
607 "-gnatyt ";
608
609 S_GCC_StyleX : aliased constant S := "/NOSTYLE_CHECKS " &
610 "!-gnatg,!-gnatr";
611
612 S_GCC_Syntax : aliased constant S := "/SYNTAX_ONLY " &
613 "-gnats";
614
615 S_GCC_Trace : aliased constant S := "/TRACE_UNITS " &
616 "-gnatdc";
617
618 S_GCC_Tree : aliased constant S := "/TREE_OUTPUT " &
619 "-gnatt";
620
621 S_GCC_Trys : aliased constant S := "/TRY_SEMANTICS " &
622 "-gnatq";
623
624 S_GCC_Units : aliased constant S := "/UNITS_LIST " &
625 "-gnatu";
626
627 S_GCC_Unique : aliased constant S := "/UNIQUE_ERROR_TAG " &
628 "-gnatU";
629
630 S_GCC_Upcase : aliased constant S := "/UPPERCASE_EXTERNALS " &
631 "-gnatF";
632
633 S_GCC_Valid : aliased constant S := "/VALIDITY_CHECKING=" &
634 "DEFAULT " &
635 "-gnatVd " &
636 "NODEFAULT " &
637 "-gnatVD " &
638 "COPIES " &
639 "-gnatVc " &
640 "NOCOPIES " &
641 "-gnatVC " &
642 "FLOATS " &
643 "-gnatVf " &
644 "NOFLOATS " &
645 "-gnatVF " &
646 "IN_PARAMS " &
647 "-gnatVi " &
648 "NOIN_PARAMS " &
649 "-gnatVI " &
650 "MOD_PARAMS " &
651 "-gnatVm " &
652 "NOMOD_PARAMS " &
653 "-gnatVM " &
654 "OPERANDS " &
655 "-gnatVo " &
656 "NOOPERANDS " &
657 "-gnatVO " &
658 "RETURNS " &
659 "-gnatVr " &
660 "NORETURNS " &
661 "-gnatVR " &
662 "SUBSCRIPTS " &
663 "-gnatVs " &
664 "NOSUBSCRIPTS " &
665 "-gnatVS " &
666 "TESTS " &
667 "-gnatVt " &
668 "NOTESTS " &
669 "-gnatVT " &
670 "ALL " &
671 "-gnatVa " &
672 "NONE " &
673 "-gnatVn";
674
675 S_GCC_Verbose : aliased constant S := "/VERBOSE " &
676 "-v";
677
678 S_GCC_Warn : aliased constant S := "/WARNINGS=" &
679 "DEFAULT " &
680 "!-gnatws,!-gnatwe " &
681 "ALL_GCC " &
682 "-Wall " &
683 "CONDITIONALS " &
684 "-gnatwc " &
685 "NOCONDITIONALS " &
686 "-gnatwC " &
687 "ELABORATION " &
688 "-gnatwl " &
689 "NOELABORATION " &
690 "-gnatwL " &
691 "ERRORS " &
692 "-gnatwe " &
693 "HIDING " &
694 "-gnatwh " &
695 "NOHIDING " &
696 "-gnatwH " &
697 "IMPLEMENTATION " &
698 "-gnatwi " &
699 "NOIMPLEMENTATION " &
700 "-gnatwI " &
701 "OPTIONAL " &
702 "-gnatwa " &
703 "NOOPTIONAL " &
704 "-gnatwA " &
705 "OVERLAYS " &
706 "-gnatwo " &
707 "NOOVERLAYS " &
708 "-gnatwO " &
709 "REDUNDANT " &
710 "-gnatwr " &
711 "NOREDUNDANT " &
712 "-gnatwR " &
713 "SUPPRESS " &
714 "-gnatws " &
715 "UNINITIALIZED " &
716 "-Wuninitialized " &
717 "UNUSED " &
718 "-gnatwu " &
719 "NOUNUSED " &
720 "-gnatwU";
721
722 S_GCC_WarnX : aliased constant S := "/NOWARNINGS " &
723 "-gnatws";
724
725 S_GCC_Wide : aliased constant S := "/WIDE_CHARACTER_ENCODING=" &
726 "BRACKETS " &
727 "-gnatWb " &
728 "NONE " &
729 "-gnatWn " &
730 "HEX " &
731 "-gnatWh " &
732 "UPPER " &
733 "-gnatWu " &
734 "SHIFT_JIS " &
735 "-gnatWs " &
736 "UTF8 " &
737 "-gnatW8 " &
738 "EUC " &
739 "-gnatWe";
740
741 S_GCC_WideX : aliased constant S := "/NOWIDE_CHARACTER_ENCODING " &
742 "-gnatWn";
743
744 S_GCC_Xdebug : aliased constant S := "/XDEBUG " &
745 "-gnatD";
746
747 S_GCC_Xref : aliased constant S := "/XREF=" &
748 "GENERATE " &
749 "!-gnatx " &
750 "SUPPRESS " &
751 "-gnatx";
752
753 GCC_Switches : aliased constant Switches := (
754 S_GCC_Ada_83 'Access,
755 S_GCC_Ada_95 'Access,
756 S_GCC_Asm 'Access,
757 S_GCC_Checks 'Access,
758 S_GCC_ChecksX 'Access,
759 S_GCC_Compres 'Access,
760 S_GCC_Current 'Access,
761 S_GCC_Debug 'Access,
762 S_GCC_DebugX 'Access,
763 S_GCC_Dist 'Access,
764 S_GCC_DistX 'Access,
765 S_GCC_Error 'Access,
766 S_GCC_ErrorX 'Access,
767 S_GCC_Expand 'Access,
768 S_GCC_Extend 'Access,
769 S_GCC_File 'Access,
770 S_GCC_Force 'Access,
771 S_GCC_Ident 'Access,
772 S_GCC_IdentX 'Access,
773 S_GCC_Inline 'Access,
774 S_GCC_InlineX 'Access,
775 S_GCC_List 'Access,
776 S_GCC_Noload 'Access,
777 S_GCC_Nostinc 'Access,
778 S_GCC_Opt 'Access,
779 S_GCC_OptX 'Access,
780 S_GCC_Report 'Access,
781 S_GCC_ReportX 'Access,
782 S_GCC_Repinfo 'Access,
783 S_GCC_RepinfX 'Access,
784 S_GCC_Search 'Access,
785 S_GCC_Style 'Access,
786 S_GCC_StyleX 'Access,
787 S_GCC_Syntax 'Access,
788 S_GCC_Trace 'Access,
789 S_GCC_Tree 'Access,
790 S_GCC_Trys 'Access,
791 S_GCC_Units 'Access,
792 S_GCC_Unique 'Access,
793 S_GCC_Upcase 'Access,
794 S_GCC_Valid 'Access,
795 S_GCC_Verbose 'Access,
796 S_GCC_Warn 'Access,
797 S_GCC_WarnX 'Access,
798 S_GCC_Wide 'Access,
799 S_GCC_WideX 'Access,
800 S_GCC_Xdebug 'Access,
801 S_GCC_Xref 'Access);
802
803 ----------------------------
804 -- Switches for GNAT ELIM --
805 ----------------------------
806
807 S_Elim_All : aliased constant S := "/ALL " &
808 "-a";
809
810 S_Elim_Miss : aliased constant S := "/MISSED " &
811 "-m";
812
813 S_Elim_Verb : aliased constant S := "/VERBOSE " &
814 "-v";
815
816 Elim_Switches : aliased constant Switches := (
817 S_Elim_All 'Access,
818 S_Elim_Miss 'Access,
819 S_Elim_Verb 'Access);
820
821 ----------------------------
822 -- Switches for GNAT FIND --
823 ----------------------------
824
825 S_Find_All : aliased constant S := "/ALL_FILES " &
826 "-a";
827
828 S_Find_Expr : aliased constant S := "/EXPRESSIONS " &
829 "-e";
830
831 S_Find_Full : aliased constant S := "/FULL_PATHNAME " &
832 "-f";
833
834 S_Find_Ignore : aliased constant S := "/IGNORE_LOCALS " &
835 "-g";
836
837 S_Find_Object : aliased constant S := "/OBJECT_SEARCH=*" &
838 "-aO*";
839
840 S_Find_Print : aliased constant S := "/PRINT_LINES " &
841 "-s";
842
843 S_Find_Project : aliased constant S := "/PROJECT=@" &
844 "-p@";
845
846 S_Find_Ref : aliased constant S := "/REFERENCES " &
847 "-r";
848
849 S_Find_Search : aliased constant S := "/SEARCH=*" &
850 "-I*";
851
852 S_Find_Source : aliased constant S := "/SOURCE_SEARCH=*" &
853 "-aI*";
854
855 Find_Switches : aliased constant Switches := (
856 S_Find_All 'Access,
857 S_Find_Expr 'Access,
858 S_Ext_Ref 'Access,
859 S_Find_Full 'Access,
860 S_Find_Ignore 'Access,
861 S_Find_Object 'Access,
862 S_Find_Print 'Access,
863 S_Find_Project 'Access,
864 S_Project_File 'Access,
865 S_Project_Verb 'Access,
866 S_Find_Ref 'Access,
867 S_Find_Search 'Access,
868 S_Find_Source 'Access);
869
870 ------------------------------
871 -- Switches for GNAT KRUNCH --
872 ------------------------------
873
874 S_Krunch_Count : aliased constant S := "/COUNT=#" &
875 "`#";
876
877 Krunch_Switches : aliased constant Switches := (1 .. 1 =>
878 S_Krunch_Count 'Access);
879
880 -------------------------------
881 -- Switches for GNAT LIBRARY --
882 -------------------------------
883
884 S_Lbr_Config : aliased constant S := "/CONFIG=@" &
885 "--config=@";
886
887 S_Lbr_Create : aliased constant S := "/CREATE=%" &
888 "--create=%";
889
890 S_Lbr_Delete : aliased constant S := "/DELETE=%" &
891 "--delete=%";
892
893 S_Lbr_Set : aliased constant S := "/SET=%" &
894 "--set=%";
895
896 Lbr_Switches : aliased constant Switches := (
897 S_Lbr_Config 'Access,
898 S_Lbr_Create 'Access,
899 S_Lbr_Delete 'Access,
900 S_Lbr_Set 'Access);
901
902 ----------------------------
903 -- Switches for GNAT LINK --
904 ----------------------------
905
906 S_Link_Bind : aliased constant S := "/BIND_FILE=" &
907 "ADA " &
908 "-A " &
909 "C " &
910 "-C";
911
912 S_Link_Debug : aliased constant S := "/DEBUG=" &
913 "ALL " &
914 "-g3 " &
915 "NONE " &
916 "-g0 " &
917 "TRACEBACK " &
918 "-g1 " &
919 "NOTRACEBACK " &
920 "-g0";
921
922 S_Link_Execut : aliased constant S := "/EXECUTABLE=@" &
923 "-o@";
924
925 S_Link_Ident : aliased constant S := "/IDENTIFICATION=" & '"' &
926 "--for-linker=IDENT=" &
927 '"';
928
929 S_Link_Nocomp : aliased constant S := "/NOCOMPILE " &
930 "-n";
931
932 S_Link_Nofiles : aliased constant S := "/NOSTART_FILES " &
933 "-nostartfiles";
934
935 S_Link_Noinhib : aliased constant S := "/NOINHIBIT-EXEC " &
936 "--for-linker=--noinhibit-exec";
937
938 S_Link_Static : aliased constant S := "/STATIC " &
939 "--for-linker=-static";
940
941 S_Link_Verb : aliased constant S := "/VERBOSE " &
942 "-v";
943
944 S_Link_ZZZZZ : aliased constant S := "/<other> " &
945 "--for-linker=";
946
947 Link_Switches : aliased constant Switches := (
948 S_Link_Bind 'Access,
949 S_Link_Debug 'Access,
950 S_Link_Execut 'Access,
951 S_Ext_Ref 'Access,
952 S_Link_Ident 'Access,
953 S_Link_Nocomp 'Access,
954 S_Link_Nofiles 'Access,
955 S_Link_Noinhib 'Access,
956 S_Project_File 'Access,
957 S_Project_Verb 'Access,
958 S_Link_Static 'Access,
959 S_Link_Verb 'Access,
960 S_Link_ZZZZZ 'Access);
961
962 ----------------------------
963 -- Switches for GNAT LIST --
964 ----------------------------
965
966 S_List_All : aliased constant S := "/ALL_UNITS " &
967 "-a";
968
969 S_List_Current : aliased constant S := "/CURRENT_DIRECTORY " &
970 "!-I-";
971
972 S_List_Depend : aliased constant S := "/DEPENDENCIES " &
973 "-d";
974
975 S_List_Nostinc : aliased constant S := "/NOSTD_INCLUDES " &
976 "-nostdinc";
977
978 S_List_Object : aliased constant S := "/OBJECT_SEARCH=*" &
979 "-aO*";
980
981 S_List_Output : aliased constant S := "/OUTPUT=" &
982 "SOURCES " &
983 "-s " &
984 "OBJECTS " &
985 "-o " &
986 "UNITS " &
987 "-u " &
988 "OPTIONS " &
989 "-h " &
990 "VERBOSE " &
991 "-v ";
992
993 S_List_Search : aliased constant S := "/SEARCH=*" &
994 "-I*";
995
996 S_List_Source : aliased constant S := "/SOURCE_SEARCH=*" &
997 "-aI*";
998
999 List_Switches : aliased constant Switches := (
1000 S_List_All 'Access,
1001 S_List_Current 'Access,
1002 S_List_Depend 'Access,
1003 S_Ext_Ref 'Access,
1004 S_List_Nostinc 'Access,
1005 S_List_Object 'Access,
1006 S_List_Output 'Access,
1007 S_Project_File 'Access,
1008 S_Project_Verb 'Access,
1009 S_List_Search 'Access,
1010 S_List_Source 'Access);
1011
1012 ----------------------------
1013 -- Switches for GNAT MAKE --
1014 ----------------------------
1015
1016 S_Make_Actions : aliased constant S := "/ACTIONS=" &
1017 "COMPILE " &
1018 "-c " &
1019 "BIND " &
1020 "-b " &
1021 "LINK " &
1022 "-l ";
1023
1024 S_Make_All : aliased constant S := "/ALL_FILES " &
1025 "-a";
1026
1027 S_Make_Bind : aliased constant S := "/BINDER_QUALIFIERS=?" &
1028 "-bargs BIND";
1029
1030 S_Make_Comp : aliased constant S := "/COMPILER_QUALIFIERS=?" &
1031 "-cargs COMPILE";
1032
1033 S_Make_Cond : aliased constant S := "/CONDITIONAL_SOURCE_SEARCH=*" &
1034 "-A*";
1035
1036 S_Make_Cont : aliased constant S := "/CONTINUE_ON_ERROR " &
1037 "-k";
1038
1039 S_Make_Current : aliased constant S := "/CURRENT_DIRECTORY " &
1040 "!-I-";
1041
1042 S_Make_Dep : aliased constant S := "/DEPENDENCIES_LIST " &
1043 "-M";
1044
1045 S_Make_Doobj : aliased constant S := "/DO_OBJECT_CHECK " &
1046 "-n";
1047
1048 S_Make_Execut : aliased constant S := "/EXECUTABLE=@" &
1049 "-o@";
1050
1051 S_Make_Force : aliased constant S := "/FORCE_COMPILE " &
1052 "-f";
1053
1054 S_Make_Inplace : aliased constant S := "/IN_PLACE " &
1055 "-i";
1056
1057 S_Make_Library : aliased constant S := "/LIBRARY_SEARCH=*" &
1058 "-L*";
1059
1060 S_Make_Link : aliased constant S := "/LINKER_QUALIFIERS=?" &
1061 "-largs LINK";
1062
1063 S_Make_Minimal : aliased constant S := "/MINIMAL_RECOMPILATION " &
1064 "-m";
1065
1066 S_Make_Nolink : aliased constant S := "/NOLINK " &
1067 "-c";
1068
1069 S_Make_Nostinc : aliased constant S := "/NOSTD_INCLUDES " &
1070 "-nostdinc";
1071
1072 S_Make_Nostlib : aliased constant S := "/NOSTD_LIBRARIES " &
1073 "-nostdlib";
1074
1075 S_Make_Object : aliased constant S := "/OBJECT_SEARCH=*" &
1076 "-aO*";
1077
1078 S_Make_Proc : aliased constant S := "/PROCESSES=#" &
1079 "-j#";
1080
1081 S_Make_Nojobs : aliased constant S := "/NOPROCESSES " &
1082 "-j1";
1083
1084 S_Make_Quiet : aliased constant S := "/QUIET " &
1085 "-q";
1086
1087 S_Make_Reason : aliased constant S := "/REASONS " &
1088 "-v";
1089
1090 S_Make_Search : aliased constant S := "/SEARCH=*" &
1091 "-I*";
1092
1093 S_Make_Skip : aliased constant S := "/SKIP_MISSING=*" &
1094 "-aL*";
1095
1096 S_Make_Source : aliased constant S := "/SOURCE_SEARCH=*" &
1097 "-aI*";
1098
1099 S_Make_Verbose : aliased constant S := "/VERBOSE " &
1100 "-v";
1101
1102 Make_Switches : aliased constant Switches := (
1103 S_Make_Actions 'Access,
1104 S_Make_All 'Access,
1105 S_Make_Bind 'Access,
1106 S_Make_Comp 'Access,
1107 S_Make_Cond 'Access,
1108 S_Make_Cont 'Access,
1109 S_Make_Current 'Access,
1110 S_Make_Dep 'Access,
1111 S_Make_Doobj 'Access,
1112 S_Make_Execut 'Access,
1113 S_Ext_Ref 'Access,
1114 S_Make_Force 'Access,
1115 S_Make_Inplace 'Access,
1116 S_Make_Library 'Access,
1117 S_Make_Link 'Access,
1118 S_Make_Minimal 'Access,
1119 S_Make_Nolink 'Access,
1120 S_Make_Nostinc 'Access,
1121 S_Make_Nostlib 'Access,
1122 S_Make_Object 'Access,
1123 S_Make_Proc 'Access,
1124 S_Project_File 'Access,
1125 S_Project_Verb 'Access,
1126 S_Make_Nojobs 'Access,
1127 S_Make_Quiet 'Access,
1128 S_Make_Reason 'Access,
1129 S_Make_Search 'Access,
1130 S_Make_Skip 'Access,
1131 S_Make_Source 'Access,
1132 S_Make_Verbose 'Access);
1133
1134 ----------------------------------
1135 -- Switches for GNAT PREPROCESS --
1136 ----------------------------------
1137
1138 S_Prep_Blank : aliased constant S := "/BLANK_LINES " &
1139 "-b";
1140
1141 S_Prep_Com : aliased constant S := "/COMMENTS " &
1142 "-c";
1143
1144 S_Prep_Ref : aliased constant S := "/REFERENCE " &
1145 "-r";
1146
1147 S_Prep_Remove : aliased constant S := "/REMOVE " &
1148 "!-b,!-c";
1149
1150 S_Prep_Symbols : aliased constant S := "/SYMBOLS " &
1151 "-s";
1152
1153 S_Prep_Undef : aliased constant S := "/UNDEFINED " &
1154 "-u";
1155
1156 S_Prep_Verbose : aliased constant S := "/VERBOSE " &
1157 "-v";
1158
1159 S_Prep_Version : aliased constant S := "/VERSION " &
1160 "-v";
1161
1162 Prep_Switches : aliased constant Switches := (
1163 S_Prep_Blank 'Access,
1164 S_Prep_Com 'Access,
1165 S_Prep_Ref 'Access,
1166 S_Prep_Remove 'Access,
1167 S_Prep_Symbols 'Access,
1168 S_Prep_Undef 'Access,
1169 S_Prep_Verbose 'Access,
1170 S_Prep_Version 'Access);
1171
1172 ------------------------------
1173 -- Switches for GNAT SHARED --
1174 ------------------------------
1175
1176 S_Shared_Debug : aliased constant S := "/DEBUG=" &
1177 "ALL " &
1178 "-g3 " &
1179 "NONE " &
1180 "-g0 " &
1181 "TRACEBACK " &
1182 "-g1 " &
1183 "NOTRACEBACK " &
1184 "-g0";
1185
1186 S_Shared_Image : aliased constant S := "/IMAGE=@" &
1187 "-o@";
1188
1189 S_Shared_Ident : aliased constant S := "/IDENTIFICATION=" & '"' &
1190 "--for-linker=IDENT=" &
1191 '"';
1192
1193 S_Shared_Nofiles : aliased constant S := "/NOSTART_FILES " &
1194 "-nostartfiles";
1195
1196 S_Shared_Noinhib : aliased constant S := "/NOINHIBIT-IMAGE " &
1197 "--for-linker=--noinhibit-exec";
1198
1199 S_Shared_Verb : aliased constant S := "/VERBOSE " &
1200 "-v";
1201
1202 S_Shared_ZZZZZ : aliased constant S := "/<other> " &
1203 "--for-linker=";
1204
1205 Shared_Switches : aliased constant Switches := (
1206 S_Shared_Debug 'Access,
1207 S_Shared_Image 'Access,
1208 S_Shared_Ident 'Access,
1209 S_Shared_Nofiles 'Access,
1210 S_Shared_Noinhib 'Access,
1211 S_Shared_Verb 'Access,
1212 S_Shared_ZZZZZ 'Access);
1213
1214 --------------------------------
1215 -- Switches for GNAT STANDARD --
1216 --------------------------------
1217
1218 Standard_Switches : aliased constant Switches := (1 .. 0 => null);
1219
1220 ----------------------------
1221 -- Switches for GNAT STUB --
1222 ----------------------------
1223
1224 S_Stub_Current : aliased constant S := "/CURRENT_DIRECTORY " &
1225 "!-I-";
1226
1227 S_Stub_Full : aliased constant S := "/FULL " &
1228 "-f";
1229
1230 S_Stub_Header : aliased constant S := "/HEADER=" &
1231 "GENERAL " &
1232 "-hg " &
1233 "SPEC " &
1234 "-hs";
1235
1236 S_Stub_Indent : aliased constant S := "/INDENTATION=#" &
1237 "-i#";
1238
1239 S_Stub_Length : aliased constant S := "/LINE_LENGTH=#" &
1240 "-l#";
1241
1242 S_Stub_Quiet : aliased constant S := "/QUIET " &
1243 "-q";
1244
1245 S_Stub_Search : aliased constant S := "/SEARCH=*" &
1246 "-I*";
1247
1248 S_Stub_Tree : aliased constant S := "/TREE_FILE=" &
1249 "OVERWRITE " &
1250 "-t " &
1251 "SAVE " &
1252 "-k " &
1253 "REUSE " &
1254 "-r";
1255
1256 S_Stub_Verbose : aliased constant S := "/VERBOSE " &
1257 "-v";
1258
1259 Stub_Switches : aliased constant Switches := (
1260 S_Stub_Current 'Access,
1261 S_Stub_Full 'Access,
1262 S_Stub_Header 'Access,
1263 S_Stub_Indent 'Access,
1264 S_Stub_Length 'Access,
1265 S_Stub_Quiet 'Access,
1266 S_Stub_Search 'Access,
1267 S_Stub_Tree 'Access,
1268 S_Stub_Verbose 'Access);
1269
1270 ------------------------------
1271 -- Switches for GNAT SYSTEM --
1272 ------------------------------
1273
1274 System_Switches : aliased constant Switches := (1 .. 0 => null);
1275
1276 ----------------------------
1277 -- Switches for GNAT XREF --
1278 ----------------------------
1279
1280 S_Xref_All : aliased constant S := "/ALL_FILES " &
1281 "-a";
1282
1283 S_Xref_Full : aliased constant S := "/FULL_PATHNAME " &
1284 "-f";
1285
1286 S_Xref_Global : aliased constant S := "/IGNORE_LOCALS " &
1287 "-g";
1288
1289 S_Xref_Object : aliased constant S := "/OBJECT_SEARCH=*" &
1290 "-aO*";
1291
1292 S_Xref_Project : aliased constant S := "/PROJECT=@" &
1293 "-p@";
1294
1295 S_Xref_Search : aliased constant S := "/SEARCH=*" &
1296 "-I*";
1297
1298 S_Xref_Source : aliased constant S := "/SOURCE_SEARCH=*" &
1299 "-aI*";
1300
1301 S_Xref_Output : aliased constant S := "/UNUSED " &
1302 "-u";
1303
1304 Xref_Switches : aliased constant Switches := (
1305 S_Xref_All 'Access,
1306 S_Ext_Ref 'Access,
1307 S_Xref_Full 'Access,
1308 S_Xref_Global 'Access,
1309 S_Xref_Object 'Access,
1310 S_Xref_Project 'Access,
1311 S_Project_File 'Access,
1312 S_Project_Verb 'Access,
1313 S_Xref_Search 'Access,
1314 S_Xref_Source 'Access,
1315 S_Xref_Output 'Access);
1316
1317 -------------------
1318 -- COMMAND TABLE --
1319 -------------------
1320
1321 -- The command table contains an entry for each command recognized by
1322 -- GNATCmd. The entries are represented by an array of records.
1323
1324 type Parameter_Type is
1325 -- A parameter is defined as a whitespace bounded string, not begining
1326 -- with a slash. (But see note under FILES_OR_WILDCARD).
1327 (File,
1328 -- A required file or directory parameter.
1329
1330 Optional_File,
1331 -- An optional file or directory parameter.
1332
1333 Other_As_Is,
1334 -- A parameter that's passed through as is (not canonicalized)
1335
1336 Unlimited_Files,
1337 -- An unlimited number of writespace separate file or directory
1338 -- parameters including wildcard specifications.
1339
1340 Files_Or_Wildcard);
1341 -- A comma separated list of files and/or wildcard file specifications.
1342 -- A comma preceded by or followed by whitespace is considered as a
1343 -- single comma character w/o whitespace.
1344
1345 type Parameter_Array is array (Natural range <>) of Parameter_Type;
1346 type Parameter_Ref is access all Parameter_Array;
1347
1348 type Command_Entry is record
1349 Cname : String_Ptr;
1350 -- Command name for GNAT xxx command
1351
1352 Usage : String_Ptr;
1353 -- A usage string, used for error messages
1354
1355 Unixcmd : String_Ptr;
1356 -- Corresponding Unix command
1357
1358 Switches : Switches_Ptr;
1359 -- Pointer to array of switch strings
1360
1361 Params : Parameter_Ref;
1362 -- Describes the allowable types of parameters.
1363 -- Params (1) is the type of the first parameter, etc.
1364 -- An empty parameter array means this command takes no parameters.
1365
1366 Defext : String (1 .. 3);
1367 -- Default extension. If non-blank, then this extension is supplied by
1368 -- default as the extension for any file parameter which does not have
1369 -- an extension already.
1370 end record;
1371
1372 -------------------------
1373 -- INTERNAL STRUCTURES --
1374 -------------------------
1375
1376 -- The switches and commands are defined by strings in the previous
1377 -- section so that they are easy to modify, but internally, they are
1378 -- kept in a more conveniently accessible form described in this
1379 -- section.
1380
1381 -- Commands, command qualifers and options have a similar common format
1382 -- so that searching for matching names can be done in a common manner.
1383
1384 type Item_Id is (Id_Command, Id_Switch, Id_Option);
1385
1386 type Translation_Type is
1387 (
1388 T_Direct,
1389 -- A qualifier with no options.
1390 -- Example: GNAT MAKE /VERBOSE
1391
1392 T_Directories,
1393 -- A qualifier followed by a list of directories
1394 -- Example: GNAT COMPILE /SEARCH=([], [.FOO], [.BAR])
1395
1396 T_Directory,
1397 -- A qualifier followed by one directory
1398 -- Example: GNAT LIBRARY /SET=[.VAXFLOATLIB]
1399
1400 T_File,
1401 -- A quailifier followed by a filename
1402 -- Example: GNAT LINK /EXECUTABLE=FOO.EXE
1403
1404 T_Numeric,
1405 -- A qualifier followed by a numeric value.
1406 -- Example: GNAT CHOP /FILE_NAME_MAX_LENGTH=39
1407
1408 T_String,
1409 -- A qualifier followed by a quoted string. Only used by
1410 -- /IDENTIFICATION qualfier.
1411 -- Example: GNAT LINK /IDENTIFICATION="3.14a1 version"
1412
1413 T_Options,
1414 -- A qualifier followed by a list of options.
1415 -- Example: GNAT COMPILE /REPRESENTATION_INFO=(ARRAYS,OBJECTS)
1416
1417 T_Commands,
1418 -- A qualifier followed by a list. Only used for
1419 -- MAKE /COMPILER_QUALIFIERS /BINDER_QUALIFIERS /LINKER_QUALIFIERS
1420 -- (gnatmake -cargs -bargs -largs )
1421 -- Example: GNAT MAKE ... /LINKER_QUALIFIERS /VERBOSE FOOBAR.OBJ
1422
1423 T_Other,
1424 -- A qualifier passed directly to the linker. Only used
1425 -- for LINK and SHARED if no other match is found.
1426 -- Example: GNAT LINK FOO.ALI /SYSSHR
1427
1428 T_Alphanumplus
1429 -- A qualifier followed by a legal linker symbol prefix. Only used
1430 -- for BIND /BUILD_LIBRARY (gnatbind -Lxyz).
1431 -- Example: GNAT BIND /BUILD_LIBRARY=foobar
1432 );
1433
1434 type Item (Id : Item_Id);
1435 type Item_Ptr is access all Item;
1436
1437 type Item (Id : Item_Id) is record
1438 Name : String_Ptr;
1439 -- Name of the command, switch (with slash) or option
1440
1441 Next : Item_Ptr;
1442 -- Pointer to next item on list, always has the same Id value
1443
1444 Unix_String : String_Ptr;
1445 -- Corresponding Unix string. For a command, this is the unix command
1446 -- name and possible default switches. For a switch or option it is
1447 -- the unix switch string.
1448
1449 case Id is
1450
1451 when Id_Command =>
1452
1453 Switches : Item_Ptr;
1454 -- Pointer to list of switch items for the command, linked
1455 -- through the Next fields with null terminating the list.
1456
1457 Usage : String_Ptr;
1458 -- Usage information, used only for errors and the default
1459 -- list of commands output.
1460
1461 Params : Parameter_Ref;
1462 -- Array of parameters
1463
1464 Defext : String (1 .. 3);
1465 -- Default extension. If non-blank, then this extension is
1466 -- supplied by default as the extension for any file parameter
1467 -- which does not have an extension already.
1468
1469 when Id_Switch =>
1470
1471 Translation : Translation_Type;
1472 -- Type of switch translation. For all cases, except Options,
1473 -- this is the only field needed, since the Unix translation
1474 -- is found in Unix_String.
1475
1476 Options : Item_Ptr;
1477 -- For the Options case, this field is set to point to a list
1478 -- of options item (for this case Unix_String is null in the
1479 -- main switch item). The end of the list is marked by null.
1480
1481 when Id_Option =>
1482
1483 null;
1484 -- No special fields needed, since Name and Unix_String are
1485 -- sufficient to completely described an option.
1486
1487 end case;
1488 end record;
1489
1490 subtype Command_Item is Item (Id_Command);
1491 subtype Switch_Item is Item (Id_Switch);
1492 subtype Option_Item is Item (Id_Option);
1493
1494 ----------------------------------
1495 -- Declarations for GNATCMD use --
1496 ----------------------------------
1497
1498 Commands : Item_Ptr;
1499 -- Pointer to head of list of command items, one for each command, with
1500 -- the end of the list marked by a null pointer.
1501
1502 Last_Command : Item_Ptr;
1503 -- Pointer to last item in Commands list
1504
1505 Normal_Exit : exception;
1506 -- Raise this exception for normal program termination
1507
1508 Error_Exit : exception;
1509 -- Raise this exception if error detected
1510
1511 Errors : Natural := 0;
1512 -- Count errors detected
1513
1514 Command : Item_Ptr;
1515 -- Pointer to command item for current command
1516
1517 Make_Commands_Active : Item_Ptr := null;
1518 -- Set to point to Command entry for COMPILE, BIND, or LINK as appropriate
1519 -- if a COMMANDS_TRANSLATION switch has been encountered while processing
1520 -- a MAKE Command.
1521
1522 My_Exit_Status : Exit_Status := Success;
1523
1524 package Buffer is new Table.Table (
1525 Table_Component_Type => Character,
1526 Table_Index_Type => Integer,
1527 Table_Low_Bound => 1,
1528 Table_Initial => 4096,
1529 Table_Increment => 2,
1530 Table_Name => "Buffer");
1531
1532 Param_Count : Natural := 0;
1533 -- Number of parameter arguments so far
1534
1535 Arg_Num : Natural;
1536 -- Argument number
1537
1538 Display_Command : Boolean := False;
1539 -- Set true if /? switch causes display of generated command
1540
1541 -----------------------
1542 -- Local Subprograms --
1543 -----------------------
1544
1545 function Init_Object_Dirs return String_Ptr;
1546
1547 function Invert_Sense (S : String) return String_Ptr;
1548 -- Given a unix switch string S, computes the inverse (adding or
1549 -- removing ! characters as required), and returns a pointer to
1550 -- the allocated result on the heap.
1551
1552 function Is_Extensionless (F : String) return Boolean;
1553 -- Returns true if the filename has no extension.
1554
1555 function Match (S1, S2 : String) return Boolean;
1556 -- Determines whether S1 and S2 match. This is a case insensitive match.
1557
1558 function Match_Prefix (S1, S2 : String) return Boolean;
1559 -- Determines whether S1 matches a prefix of S2. This is also a case
1560 -- insensitive match (for example Match ("AB","abc") is True).
1561
1562 function Matching_Name
1563 (S : String;
1564 Itm : Item_Ptr;
1565 Quiet : Boolean := False)
1566 return Item_Ptr;
1567 -- Determines if the item list headed by Itm and threaded through the
1568 -- Next fields (with null marking the end of the list), contains an
1569 -- entry that uniquely matches the given string. The match is case
1570 -- insensitive and permits unique abbreviation. If the match succeeds,
1571 -- then a pointer to the matching item is returned. Otherwise, an
1572 -- appropriate error message is written. Note that the discriminant
1573 -- of Itm is used to determine the appropriate form of this message.
1574 -- Quiet is normally False as shown, if it is set to True, then no
1575 -- error message is generated in a not found situation (null is still
1576 -- returned to indicate the not-found situation).
1577
1578 function OK_Alphanumerplus (S : String) return Boolean;
1579 -- Checks that S is a string of alphanumeric characters,
1580 -- returning True if all alphanumeric characters,
1581 -- False if empty or a non-alphanumeric character is present.
1582
1583 function OK_Integer (S : String) return Boolean;
1584 -- Checks that S is a string of digits, returning True if all digits,
1585 -- False if empty or a non-digit is present.
1586
1587 procedure Place (C : Character);
1588 -- Place a single character in the buffer, updating Ptr
1589
1590 procedure Place (S : String);
1591 -- Place a string character in the buffer, updating Ptr
1592
1593 procedure Place_Lower (S : String);
1594 -- Place string in buffer, forcing letters to lower case, updating Ptr
1595
1596 procedure Place_Unix_Switches (S : String_Ptr);
1597 -- Given a unix switch string, place corresponding switches in Buffer,
1598 -- updating Ptr appropriatelly. Note that in the case of use of ! the
1599 -- result may be to remove a previously placed switch.
1600
1601 procedure Validate_Command_Or_Option (N : String_Ptr);
1602 -- Check that N is a valid command or option name, i.e. that it is of the
1603 -- form of an Ada identifier with upper case letters and underscores.
1604
1605 procedure Validate_Unix_Switch (S : String_Ptr);
1606 -- Check that S is a valid switch string as described in the syntax for
1607 -- the switch table item UNIX_SWITCH or else begins with a backquote.
1608
1609 ----------------------
1610 -- Init_Object_Dirs --
1611 ----------------------
1612
1613 function Init_Object_Dirs return String_Ptr is
1614 Object_Dirs : Integer;
1615 Object_Dir : array (Integer range 1 .. 256) of String_Access;
1616 Object_Dir_Name : String_Access;
1617
1618 begin
1619 Object_Dirs := 0;
1620 Object_Dir_Name := String_Access (Object_Dir_Default_Name);
1621 Get_Next_Dir_In_Path_Init (Object_Dir_Name);
1622
1623 loop
1624 declare
1625 Dir : String_Access := String_Access
1626 (Get_Next_Dir_In_Path (Object_Dir_Name));
1627 begin
1628 exit when Dir = null;
1629 Object_Dirs := Object_Dirs + 1;
1630 Object_Dir (Object_Dirs)
1631 := String_Access (Normalize_Directory_Name (Dir.all));
1632 end;
1633 end loop;
1634
1635 for Dirs in 1 .. Object_Dirs loop
1636 Buffer.Increment_Last;
1637 Buffer.Table (Buffer.Last) := '-';
1638 Buffer.Increment_Last;
1639 Buffer.Table (Buffer.Last) := 'L';
1640 Object_Dir_Name := new String'(
1641 To_Canonical_Dir_Spec
1642 (To_Host_Dir_Spec (Object_Dir (Dirs).all, True).all, True).all);
1643
1644 for J in Object_Dir_Name'Range loop
1645 Buffer.Increment_Last;
1646 Buffer.Table (Buffer.Last) := Object_Dir_Name (J);
1647 end loop;
1648
1649 Buffer.Increment_Last;
1650 Buffer.Table (Buffer.Last) := ' ';
1651 end loop;
1652
1653 Buffer.Increment_Last;
1654 Buffer.Table (Buffer.Last) := '-';
1655 Buffer.Increment_Last;
1656 Buffer.Table (Buffer.Last) := 'l';
1657 Buffer.Increment_Last;
1658 Buffer.Table (Buffer.Last) := 'g';
1659 Buffer.Increment_Last;
1660 Buffer.Table (Buffer.Last) := 'n';
1661 Buffer.Increment_Last;
1662 Buffer.Table (Buffer.Last) := 'a';
1663 Buffer.Increment_Last;
1664 Buffer.Table (Buffer.Last) := 't';
1665
1666 if Hostparm.OpenVMS then
1667 Buffer.Increment_Last;
1668 Buffer.Table (Buffer.Last) := ' ';
1669 Buffer.Increment_Last;
1670 Buffer.Table (Buffer.Last) := '-';
1671 Buffer.Increment_Last;
1672 Buffer.Table (Buffer.Last) := 'l';
1673 Buffer.Increment_Last;
1674 Buffer.Table (Buffer.Last) := 'd';
1675 Buffer.Increment_Last;
1676 Buffer.Table (Buffer.Last) := 'e';
1677 Buffer.Increment_Last;
1678 Buffer.Table (Buffer.Last) := 'c';
1679 Buffer.Increment_Last;
1680 Buffer.Table (Buffer.Last) := 'g';
1681 Buffer.Increment_Last;
1682 Buffer.Table (Buffer.Last) := 'n';
1683 Buffer.Increment_Last;
1684 Buffer.Table (Buffer.Last) := 'a';
1685 Buffer.Increment_Last;
1686 Buffer.Table (Buffer.Last) := 't';
1687 end if;
1688
1689 return new String'(String (Buffer.Table (1 .. Buffer.Last)));
1690 end Init_Object_Dirs;
1691
1692 ------------------
1693 -- Invert_Sense --
1694 ------------------
1695
1696 function Invert_Sense (S : String) return String_Ptr is
1697 Sinv : String (1 .. S'Length * 2);
1698 -- Result (for sure long enough)
1699
1700 Sinvp : Natural := 0;
1701 -- Pointer to output string
1702
1703 begin
1704 for Sp in S'Range loop
1705 if Sp = S'First or else S (Sp - 1) = ',' then
1706 if S (Sp) = '!' then
1707 null;
1708 else
1709 Sinv (Sinvp + 1) := '!';
1710 Sinv (Sinvp + 2) := S (Sp);
1711 Sinvp := Sinvp + 2;
1712 end if;
1713
1714 else
1715 Sinv (Sinvp + 1) := S (Sp);
1716 Sinvp := Sinvp + 1;
1717 end if;
1718 end loop;
1719
1720 return new String'(Sinv (1 .. Sinvp));
1721 end Invert_Sense;
1722
1723 ----------------------
1724 -- Is_Extensionless --
1725 ----------------------
1726
1727 function Is_Extensionless (F : String) return Boolean is
1728 begin
1729 for J in reverse F'Range loop
1730 if F (J) = '.' then
1731 return False;
1732 elsif F (J) = '/' or else F (J) = ']' or else F (J) = ':' then
1733 return True;
1734 end if;
1735 end loop;
1736
1737 return True;
1738 end Is_Extensionless;
1739
1740 -----------
1741 -- Match --
1742 -----------
1743
1744 function Match (S1, S2 : String) return Boolean is
1745 Dif : constant Integer := S2'First - S1'First;
1746
1747 begin
1748
1749 if S1'Length /= S2'Length then
1750 return False;
1751
1752 else
1753 for J in S1'Range loop
1754 if To_Lower (S1 (J)) /= To_Lower (S2 (J + Dif)) then
1755 return False;
1756 end if;
1757 end loop;
1758
1759 return True;
1760 end if;
1761 end Match;
1762
1763 ------------------
1764 -- Match_Prefix --
1765 ------------------
1766
1767 function Match_Prefix (S1, S2 : String) return Boolean is
1768 begin
1769 if S1'Length > S2'Length then
1770 return False;
1771 else
1772 return Match (S1, S2 (S2'First .. S2'First + S1'Length - 1));
1773 end if;
1774 end Match_Prefix;
1775
1776 -------------------
1777 -- Matching_Name --
1778 -------------------
1779
1780 function Matching_Name
1781 (S : String;
1782 Itm : Item_Ptr;
1783 Quiet : Boolean := False)
1784 return Item_Ptr
1785 is
1786 P1, P2 : Item_Ptr;
1787
1788 procedure Err;
1789 -- Little procedure to output command/qualifier/option as appropriate
1790 -- and bump error count.
1791
1792 procedure Err is
1793 begin
1794 if Quiet then
1795 return;
1796 end if;
1797
1798 Errors := Errors + 1;
1799
1800 if Itm /= null then
1801 case Itm.Id is
1802 when Id_Command =>
1803 Put (Standard_Error, "command");
1804
1805 when Id_Switch =>
1806 if OpenVMS then
1807 Put (Standard_Error, "qualifier");
1808 else
1809 Put (Standard_Error, "switch");
1810 end if;
1811
1812 when Id_Option =>
1813 Put (Standard_Error, "option");
1814
1815 end case;
1816 else
1817 Put (Standard_Error, "input");
1818
1819 end if;
1820
1821 Put (Standard_Error, ": ");
1822 Put (Standard_Error, S);
1823
1824 end Err;
1825
1826 -- Start of processing for Matching_Name
1827
1828 begin
1829 -- If exact match, that's the one we want
1830
1831 P1 := Itm;
1832 while P1 /= null loop
1833 if Match (S, P1.Name.all) then
1834 return P1;
1835 else
1836 P1 := P1.Next;
1837 end if;
1838 end loop;
1839
1840 -- Now check for prefix matches
1841
1842 P1 := Itm;
1843 while P1 /= null loop
1844 if P1.Name.all = "/<other>" then
1845 return P1;
1846
1847 elsif not Match_Prefix (S, P1.Name.all) then
1848 P1 := P1.Next;
1849
1850 else
1851 -- Here we have found one matching prefix, so see if there is
1852 -- another one (which is an ambiguity)
1853
1854 P2 := P1.Next;
1855 while P2 /= null loop
1856 if Match_Prefix (S, P2.Name.all) then
1857 if not Quiet then
1858 Put (Standard_Error, "ambiguous ");
1859 Err;
1860 Put (Standard_Error, " (matches ");
1861 Put (Standard_Error, P1.Name.all);
1862
1863 while P2 /= null loop
1864 if Match_Prefix (S, P2.Name.all) then
1865 Put (Standard_Error, ',');
1866 Put (Standard_Error, P2.Name.all);
1867 end if;
1868
1869 P2 := P2.Next;
1870 end loop;
1871
1872 Put_Line (Standard_Error, ")");
1873 end if;
1874
1875 return null;
1876 end if;
1877
1878 P2 := P2.Next;
1879 end loop;
1880
1881 -- If we fall through that loop, then there was only one match
1882
1883 return P1;
1884 end if;
1885 end loop;
1886
1887 -- If we fall through outer loop, there was no match
1888
1889 if not Quiet then
1890 Put (Standard_Error, "unrecognized ");
1891 Err;
1892 New_Line (Standard_Error);
1893 end if;
1894
1895 return null;
1896 end Matching_Name;
1897
1898 -----------------------
1899 -- OK_Alphanumerplus --
1900 -----------------------
1901
1902 function OK_Alphanumerplus (S : String) return Boolean is
1903 begin
1904 if S'Length = 0 then
1905 return False;
1906
1907 else
1908 for J in S'Range loop
1909 if not (Is_Alphanumeric (S (J)) or else
1910 S (J) = '_' or else S (J) = '$')
1911 then
1912 return False;
1913 end if;
1914 end loop;
1915
1916 return True;
1917 end if;
1918 end OK_Alphanumerplus;
1919
1920 ----------------
1921 -- OK_Integer --
1922 ----------------
1923
1924 function OK_Integer (S : String) return Boolean is
1925 begin
1926 if S'Length = 0 then
1927 return False;
1928
1929 else
1930 for J in S'Range loop
1931 if not Is_Digit (S (J)) then
1932 return False;
1933 end if;
1934 end loop;
1935
1936 return True;
1937 end if;
1938 end OK_Integer;
1939
1940 -----------
1941 -- Place --
1942 -----------
1943
1944 procedure Place (C : Character) is
1945 begin
1946 Buffer.Increment_Last;
1947 Buffer.Table (Buffer.Last) := C;
1948 end Place;
1949
1950 procedure Place (S : String) is
1951 begin
1952 for J in S'Range loop
1953 Place (S (J));
1954 end loop;
1955 end Place;
1956
1957 -----------------
1958 -- Place_Lower --
1959 -----------------
1960
1961 procedure Place_Lower (S : String) is
1962 begin
1963 for J in S'Range loop
1964 Place (To_Lower (S (J)));
1965 end loop;
1966 end Place_Lower;
1967
1968 -------------------------
1969 -- Place_Unix_Switches --
1970 -------------------------
1971
1972 procedure Place_Unix_Switches (S : String_Ptr) is
1973 P1, P2, P3 : Natural;
1974 Remove : Boolean;
1975 Slen : Natural;
1976
1977 begin
1978 P1 := S'First;
1979 while P1 <= S'Last loop
1980 if S (P1) = '!' then
1981 P1 := P1 + 1;
1982 Remove := True;
1983 else
1984 Remove := False;
1985 end if;
1986
1987 P2 := P1;
1988 pragma Assert (S (P1) = '-' or else S (P1) = '`');
1989
1990 while P2 < S'Last and then S (P2 + 1) /= ',' loop
1991 P2 := P2 + 1;
1992 end loop;
1993
1994 -- Switch is now in S (P1 .. P2)
1995
1996 Slen := P2 - P1 + 1;
1997
1998 if Remove then
1999 P3 := 2;
2000 while P3 <= Buffer.Last - Slen loop
2001 if Buffer.Table (P3) = ' '
2002 and then String (Buffer.Table (P3 + 1 .. P3 + Slen))
2003 = S (P1 .. P2)
2004 and then (P3 + Slen = Buffer.Last
2005 or else
2006 Buffer.Table (P3 + Slen + 1) = ' ')
2007 then
2008 Buffer.Table (P3 .. Buffer.Last - Slen - 1) :=
2009 Buffer.Table (P3 + Slen + 1 .. Buffer.Last);
2010 Buffer.Set_Last (Buffer.Last - Slen - 1);
2011
2012 else
2013 P3 := P3 + 1;
2014 end if;
2015 end loop;
2016
2017 else
2018 Place (' ');
2019
2020 if S (P1) = '`' then
2021 P1 := P1 + 1;
2022 end if;
2023
2024 Place (S (P1 .. P2));
2025 end if;
2026
2027 P1 := P2 + 2;
2028 end loop;
2029 end Place_Unix_Switches;
2030
2031 --------------------------------
2032 -- Validate_Command_Or_Option --
2033 --------------------------------
2034
2035 procedure Validate_Command_Or_Option (N : String_Ptr) is
2036 begin
2037 pragma Assert (N'Length > 0);
2038
2039 for J in N'Range loop
2040 if N (J) = '_' then
2041 pragma Assert (N (J - 1) /= '_');
2042 null;
2043 else
2044 pragma Assert (Is_Upper (N (J)) or else Is_Digit (N (J)));
2045 null;
2046 end if;
2047 end loop;
2048 end Validate_Command_Or_Option;
2049
2050 --------------------------
2051 -- Validate_Unix_Switch --
2052 --------------------------
2053
2054 procedure Validate_Unix_Switch (S : String_Ptr) is
2055 begin
2056 if S (S'First) = '`' then
2057 return;
2058 end if;
2059
2060 pragma Assert (S (S'First) = '-' or else S (S'First) = '!');
2061
2062 for J in S'First + 1 .. S'Last loop
2063 pragma Assert (S (J) /= ' ');
2064
2065 if S (J) = '!' then
2066 pragma Assert (S (J - 1) = ',' and then S (J + 1) = '-');
2067 null;
2068 end if;
2069 end loop;
2070 end Validate_Unix_Switch;
2071
2072 ----------------------
2073 -- List of Commands --
2074 ----------------------
2075
2076 -- Note that we put this after all the local bodies to avoid
2077 -- some access before elaboration problems.
2078
2079 Command_List : array (Natural range <>) of Command_Entry := (
2080
2081 (Cname => new S'("BIND"),
2082 Usage => new S'("GNAT BIND file[.ali] /qualifiers"),
2083 Unixcmd => new S'("gnatbind"),
2084 Switches => Bind_Switches'Access,
2085 Params => new Parameter_Array'(1 => File),
2086 Defext => "ali"),
2087
2088 (Cname => new S'("CHOP"),
2089 Usage => new S'("GNAT CHOP file [directory] /qualifiers"),
2090 Unixcmd => new S'("gnatchop"),
2091 Switches => Chop_Switches'Access,
2092 Params => new Parameter_Array'(1 => File, 2 => Optional_File),
2093 Defext => " "),
2094
2095 (Cname => new S'("COMPILE"),
2096 Usage => new S'("GNAT COMPILE filespec[,...] /qualifiers"),
2097 Unixcmd => new S'("gcc -c -x ada"),
2098 Switches => GCC_Switches'Access,
2099 Params => new Parameter_Array'(1 => Files_Or_Wildcard),
2100 Defext => " "),
2101
2102 (Cname => new S'("ELIM"),
2103 Usage => new S'("GNAT ELIM name /qualifiers"),
2104 Unixcmd => new S'("gnatelim"),
2105 Switches => Elim_Switches'Access,
2106 Params => new Parameter_Array'(1 => Other_As_Is),
2107 Defext => "ali"),
2108
2109 (Cname => new S'("FIND"),
2110 Usage => new S'("GNAT FIND pattern[:sourcefile[:line[:column]]]" &
2111 " filespec[,...] /qualifiers"),
2112 Unixcmd => new S'("gnatfind"),
2113 Switches => Find_Switches'Access,
2114 Params => new Parameter_Array'(1 => Other_As_Is,
2115 2 => Files_Or_Wildcard),
2116 Defext => "ali"),
2117
2118 (Cname => new S'("KRUNCH"),
2119 Usage => new S'("GNAT KRUNCH file [/COUNT=nnn]"),
2120 Unixcmd => new S'("gnatkr"),
2121 Switches => Krunch_Switches'Access,
2122 Params => new Parameter_Array'(1 => File),
2123 Defext => " "),
2124
2125 (Cname => new S'("LIBRARY"),
2126 Usage => new S'("GNAT LIBRARY /[CREATE | SET | DELETE]=directory"
2127 & " [/CONFIG=file]"),
2128 Unixcmd => new S'("gnatlbr"),
2129 Switches => Lbr_Switches'Access,
2130 Params => new Parameter_Array'(1 .. 0 => File),
2131 Defext => " "),
2132
2133 (Cname => new S'("LINK"),
2134 Usage => new S'("GNAT LINK file[.ali]"
2135 & " [extra obj_&_lib_&_exe_&_opt files]"
2136 & " /qualifiers"),
2137 Unixcmd => new S'("gnatlink"),
2138 Switches => Link_Switches'Access,
2139 Params => new Parameter_Array'(1 => Unlimited_Files),
2140 Defext => "ali"),
2141
2142 (Cname => new S'("LIST"),
2143 Usage => new S'("GNAT LIST /qualifiers object_or_ali_file"),
2144 Unixcmd => new S'("gnatls"),
2145 Switches => List_Switches'Access,
2146 Params => new Parameter_Array'(1 => File),
2147 Defext => "ali"),
2148
2149 (Cname => new S'("MAKE"),
2150 Usage =>
2151 new S'("GNAT MAKE file /qualifiers (includes COMPILE /qualifiers)"),
2152 Unixcmd => new S'("gnatmake"),
2153 Switches => Make_Switches'Access,
2154 Params => new Parameter_Array'(1 => File),
2155 Defext => " "),
2156
2157 (Cname => new S'("PREPROCESS"),
2158 Usage => new S'("GNAT PREPROCESS ifile ofile dfile /qualifiers"),
2159 Unixcmd => new S'("gnatprep"),
2160 Switches => Prep_Switches'Access,
2161 Params => new Parameter_Array'(1 .. 3 => File),
2162 Defext => " "),
2163
2164 (Cname => new S'("SHARED"),
2165 Usage => new S'("GNAT SHARED [obj_&_lib_&_exe_&_opt files]"
2166 & " /qualifiers"),
2167 Unixcmd => new S'("gcc -shared " & Init_Object_Dirs.all),
2168 Switches => Shared_Switches'Access,
2169 Params => new Parameter_Array'(1 => Unlimited_Files),
2170 Defext => " "),
2171
2172 (Cname => new S'("STANDARD"),
2173 Usage => new S'("GNAT STANDARD"),
2174 Unixcmd => new S'("gnatpsta"),
2175 Switches => Standard_Switches'Access,
2176 Params => new Parameter_Array'(1 .. 0 => File),
2177 Defext => " "),
2178
2179 (Cname => new S'("STUB"),
2180 Usage => new S'("GNAT STUB file [directory] /qualifiers"),
2181 Unixcmd => new S'("gnatstub"),
2182 Switches => Stub_Switches'Access,
2183 Params => new Parameter_Array'(1 => File, 2 => Optional_File),
2184 Defext => " "),
2185
2186 (Cname => new S'("SYSTEM"),
2187 Usage => new S'("GNAT SYSTEM"),
2188 Unixcmd => new S'("gnatpsys"),
2189 Switches => System_Switches'Access,
2190 Params => new Parameter_Array'(1 .. 0 => File),
2191 Defext => " "),
2192
2193 (Cname => new S'("XREF"),
2194 Usage => new S'("GNAT XREF filespec[,...] /qualifiers"),
2195 Unixcmd => new S'("gnatxref"),
2196 Switches => Xref_Switches'Access,
2197 Params => new Parameter_Array'(1 => Files_Or_Wildcard),
2198 Defext => "ali")
2199 );
2200
2201 -------------------------------------
2202 -- Start of processing for GNATCmd --
2203 -------------------------------------
2204
2205 begin
2206 Buffer.Init;
2207
2208 -- First we must preprocess the string form of the command and options
2209 -- list into the internal form that we use.
2210
2211 for C in Command_List'Range loop
2212
2213 declare
2214 Command : Item_Ptr := new Command_Item;
2215
2216 Last_Switch : Item_Ptr;
2217 -- Last switch in list
2218
2219 begin
2220 -- Link new command item into list of commands
2221
2222 if Last_Command = null then
2223 Commands := Command;
2224 else
2225 Last_Command.Next := Command;
2226 end if;
2227
2228 Last_Command := Command;
2229
2230 -- Fill in fields of new command item
2231
2232 Command.Name := Command_List (C).Cname;
2233 Command.Usage := Command_List (C).Usage;
2234 Command.Unix_String := Command_List (C).Unixcmd;
2235 Command.Params := Command_List (C).Params;
2236 Command.Defext := Command_List (C).Defext;
2237
2238 Validate_Command_Or_Option (Command.Name);
2239
2240 -- Process the switch list
2241
2242 for S in Command_List (C).Switches'Range loop
2243 declare
2244 SS : constant String_Ptr := Command_List (C).Switches (S);
2245
2246 P : Natural := SS'First;
2247 Sw : Item_Ptr := new Switch_Item;
2248
2249 Last_Opt : Item_Ptr;
2250 -- Pointer to last option
2251
2252 begin
2253 -- Link new switch item into list of switches
2254
2255 if Last_Switch = null then
2256 Command.Switches := Sw;
2257 else
2258 Last_Switch.Next := Sw;
2259 end if;
2260
2261 Last_Switch := Sw;
2262
2263 -- Process switch string, first get name
2264
2265 while SS (P) /= ' ' and SS (P) /= '=' loop
2266 P := P + 1;
2267 end loop;
2268
2269 Sw.Name := new String'(SS (SS'First .. P - 1));
2270
2271 -- Direct translation case
2272
2273 if SS (P) = ' ' then
2274 Sw.Translation := T_Direct;
2275 Sw.Unix_String := new String'(SS (P + 1 .. SS'Last));
2276 Validate_Unix_Switch (Sw.Unix_String);
2277
2278 if SS (P - 1) = '>' then
2279 Sw.Translation := T_Other;
2280
2281 elsif SS (P + 1) = '`' then
2282 null;
2283
2284 -- Create the inverted case (/NO ..)
2285
2286 elsif SS (SS'First + 1 .. SS'First + 2) /= "NO" then
2287 Sw := new Switch_Item;
2288 Last_Switch.Next := Sw;
2289 Last_Switch := Sw;
2290
2291 Sw.Name :=
2292 new String'("/NO" & SS (SS'First + 1 .. P - 1));
2293 Sw.Translation := T_Direct;
2294 Sw.Unix_String := Invert_Sense (SS (P + 1 .. SS'Last));
2295 Validate_Unix_Switch (Sw.Unix_String);
2296 end if;
2297
2298 -- Directories translation case
2299
2300 elsif SS (P + 1) = '*' then
2301 pragma Assert (SS (SS'Last) = '*');
2302 Sw.Translation := T_Directories;
2303 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2304 Validate_Unix_Switch (Sw.Unix_String);
2305
2306 -- Directory translation case
2307
2308 elsif SS (P + 1) = '%' then
2309 pragma Assert (SS (SS'Last) = '%');
2310 Sw.Translation := T_Directory;
2311 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2312 Validate_Unix_Switch (Sw.Unix_String);
2313
2314 -- File translation case
2315
2316 elsif SS (P + 1) = '@' then
2317 pragma Assert (SS (SS'Last) = '@');
2318 Sw.Translation := T_File;
2319 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2320 Validate_Unix_Switch (Sw.Unix_String);
2321
2322 -- Numeric translation case
2323
2324 elsif SS (P + 1) = '#' then
2325 pragma Assert (SS (SS'Last) = '#');
2326 Sw.Translation := T_Numeric;
2327 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2328 Validate_Unix_Switch (Sw.Unix_String);
2329
2330 -- Alphanumerplus translation case
2331
2332 elsif SS (P + 1) = '|' then
2333 pragma Assert (SS (SS'Last) = '|');
2334 Sw.Translation := T_Alphanumplus;
2335 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2336 Validate_Unix_Switch (Sw.Unix_String);
2337
2338 -- String translation case
2339
2340 elsif SS (P + 1) = '"' then
2341 pragma Assert (SS (SS'Last) = '"');
2342 Sw.Translation := T_String;
2343 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2344 Validate_Unix_Switch (Sw.Unix_String);
2345
2346 -- Commands translation case
2347
2348 elsif SS (P + 1) = '?' then
2349 Sw.Translation := T_Commands;
2350 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last));
2351
2352 -- Options translation case
2353
2354 else
2355 Sw.Translation := T_Options;
2356 Sw.Unix_String := new String'("");
2357
2358 P := P + 1; -- bump past =
2359 while P <= SS'Last loop
2360 declare
2361 Opt : Item_Ptr := new Option_Item;
2362 Q : Natural;
2363
2364 begin
2365 -- Link new option item into options list
2366
2367 if Last_Opt = null then
2368 Sw.Options := Opt;
2369 else
2370 Last_Opt.Next := Opt;
2371 end if;
2372
2373 Last_Opt := Opt;
2374
2375 -- Fill in fields of new option item
2376
2377 Q := P;
2378 while SS (Q) /= ' ' loop
2379 Q := Q + 1;
2380 end loop;
2381
2382 Opt.Name := new String'(SS (P .. Q - 1));
2383 Validate_Command_Or_Option (Opt.Name);
2384
2385 P := Q + 1;
2386 Q := P;
2387
2388 while Q <= SS'Last and then SS (Q) /= ' ' loop
2389 Q := Q + 1;
2390 end loop;
2391
2392 Opt.Unix_String := new String'(SS (P .. Q - 1));
2393 Validate_Unix_Switch (Opt.Unix_String);
2394 P := Q + 1;
2395 end;
2396 end loop;
2397 end if;
2398 end;
2399 end loop;
2400 end;
2401 end loop;
2402
2403 -- If no parameters, give complete list of commands
2404
2405 if Argument_Count = 0 then
2406 Put_Line ("List of available commands");
2407 New_Line;
2408
2409 while Commands /= null loop
2410 Put (Commands.Usage.all);
2411 Set_Col (53);
2412 Put_Line (Commands.Unix_String.all);
2413 Commands := Commands.Next;
2414 end loop;
2415
2416 raise Normal_Exit;
2417 end if;
2418
2419 Arg_Num := 1;
2420
2421 loop
2422 exit when Arg_Num > Argument_Count;
2423
2424 declare
2425 Argv : String_Access;
2426 Arg_Idx : Integer;
2427
2428 function Get_Arg_End
2429 (Argv : String;
2430 Arg_Idx : Integer)
2431 return Integer;
2432 -- Begins looking at Arg_Idx + 1 and returns the index of the
2433 -- last character before a slash or else the index of the last
2434 -- character in the string Argv.
2435
2436 function Get_Arg_End
2437 (Argv : String;
2438 Arg_Idx : Integer)
2439 return Integer
2440 is
2441 begin
2442 for J in Arg_Idx + 1 .. Argv'Last loop
2443 if Argv (J) = '/' then
2444 return J - 1;
2445 end if;
2446 end loop;
2447
2448 return Argv'Last;
2449 end Get_Arg_End;
2450
2451 begin
2452 Argv := new String'(Argument (Arg_Num));
2453 Arg_Idx := Argv'First;
2454
2455 <<Tryagain_After_Coalesce>>
2456 loop
2457 declare
2458 Next_Arg_Idx : Integer;
2459 Arg : String_Access;
2460
2461 begin
2462 Next_Arg_Idx := Get_Arg_End (Argv.all, Arg_Idx);
2463 Arg := new String'(Argv (Arg_Idx .. Next_Arg_Idx));
2464
2465 -- The first one must be a command name
2466
2467 if Arg_Num = 1 and then Arg_Idx = Argv'First then
2468
2469 Command := Matching_Name (Arg.all, Commands);
2470
2471 if Command = null then
2472 raise Error_Exit;
2473 end if;
2474
2475 -- Give usage information if only command given
2476
2477 if Argument_Count = 1 and then Next_Arg_Idx = Argv'Last
2478 and then
2479 not (Command.Name.all = "SYSTEM"
2480 or else Command.Name.all = "STANDARD")
2481 then
2482 Put_Line ("List of available qualifiers and options");
2483 New_Line;
2484
2485 Put (Command.Usage.all);
2486 Set_Col (53);
2487 Put_Line (Command.Unix_String.all);
2488
2489 declare
2490 Sw : Item_Ptr := Command.Switches;
2491
2492 begin
2493 while Sw /= null loop
2494 Put (" ");
2495 Put (Sw.Name.all);
2496
2497 case Sw.Translation is
2498
2499 when T_Other =>
2500 Set_Col (53);
2501 Put_Line (Sw.Unix_String.all & "/<other>");
2502
2503 when T_Direct =>
2504 Set_Col (53);
2505 Put_Line (Sw.Unix_String.all);
2506
2507 when T_Directories =>
2508 Put ("=(direc,direc,..direc)");
2509 Set_Col (53);
2510 Put (Sw.Unix_String.all);
2511 Put (" direc ");
2512 Put (Sw.Unix_String.all);
2513 Put_Line (" direc ...");
2514
2515 when T_Directory =>
2516 Put ("=directory");
2517 Set_Col (53);
2518 Put (Sw.Unix_String.all);
2519
2520 if Sw.Unix_String (Sw.Unix_String'Last)
2521 /= '='
2522 then
2523 Put (' ');
2524 end if;
2525
2526 Put_Line ("directory ");
2527
2528 when T_File =>
2529 Put ("=file");
2530 Set_Col (53);
2531 Put (Sw.Unix_String.all);
2532
2533 if Sw.Unix_String (Sw.Unix_String'Last)
2534 /= '='
2535 then
2536 Put (' ');
2537 end if;
2538
2539 Put_Line ("file ");
2540
2541 when T_Numeric =>
2542 Put ("=nnn");
2543 Set_Col (53);
2544
2545 if Sw.Unix_String (Sw.Unix_String'First)
2546 = '`'
2547 then
2548 Put (Sw.Unix_String
2549 (Sw.Unix_String'First + 1
2550 .. Sw.Unix_String'Last));
2551 else
2552 Put (Sw.Unix_String.all);
2553 end if;
2554
2555 Put_Line ("nnn");
2556
2557 when T_Alphanumplus =>
2558 Put ("=xyz");
2559 Set_Col (53);
2560
2561 if Sw.Unix_String (Sw.Unix_String'First)
2562 = '`'
2563 then
2564 Put (Sw.Unix_String
2565 (Sw.Unix_String'First + 1
2566 .. Sw.Unix_String'Last));
2567 else
2568 Put (Sw.Unix_String.all);
2569 end if;
2570
2571 Put_Line ("xyz");
2572
2573 when T_String =>
2574 Put ("=");
2575 Put ('"');
2576 Put ("<string>");
2577 Put ('"');
2578 Set_Col (53);
2579
2580 Put (Sw.Unix_String.all);
2581
2582 if Sw.Unix_String (Sw.Unix_String'Last)
2583 /= '='
2584 then
2585 Put (' ');
2586 end if;
2587
2588 Put ("<string>");
2589 New_Line;
2590
2591 when T_Commands =>
2592 Put (" (switches for ");
2593 Put (Sw.Unix_String (
2594 Sw.Unix_String'First + 7
2595 .. Sw.Unix_String'Last));
2596 Put (')');
2597 Set_Col (53);
2598 Put (Sw.Unix_String (
2599 Sw.Unix_String'First
2600 .. Sw.Unix_String'First + 5));
2601 Put_Line (" switches");
2602
2603 when T_Options =>
2604 declare
2605 Opt : Item_Ptr := Sw.Options;
2606
2607 begin
2608 Put_Line ("=(option,option..)");
2609
2610 while Opt /= null loop
2611 Put (" ");
2612 Put (Opt.Name.all);
2613
2614 if Opt = Sw.Options then
2615 Put (" (D)");
2616 end if;
2617
2618 Set_Col (53);
2619 Put_Line (Opt.Unix_String.all);
2620 Opt := Opt.Next;
2621 end loop;
2622 end;
2623
2624 end case;
2625
2626 Sw := Sw.Next;
2627 end loop;
2628 end;
2629
2630 raise Normal_Exit;
2631 end if;
2632
2633 Place (Command.Unix_String.all);
2634
2635 -- Special handling for internal debugging switch /?
2636
2637 elsif Arg.all = "/?" then
2638 Display_Command := True;
2639
2640 -- Copy -switch unchanged
2641
2642 elsif Arg (Arg'First) = '-' then
2643 Place (' ');
2644 Place (Arg.all);
2645
2646 -- Copy quoted switch with quotes stripped
2647
2648 elsif Arg (Arg'First) = '"' then
2649 if Arg (Arg'Last) /= '"' then
2650 Put (Standard_Error, "misquoted argument: ");
2651 Put_Line (Standard_Error, Arg.all);
2652 Errors := Errors + 1;
2653
2654 else
2655 Put (Arg (Arg'First + 1 .. Arg'Last - 1));
2656 end if;
2657
2658 -- Parameter Argument
2659
2660 elsif Arg (Arg'First) /= '/'
2661 and then Make_Commands_Active = null
2662 then
2663 Param_Count := Param_Count + 1;
2664
2665 if Param_Count <= Command.Params'Length then
2666
2667 case Command.Params (Param_Count) is
2668
2669 when File | Optional_File =>
2670 declare
2671 Normal_File : String_Access
2672 := To_Canonical_File_Spec (Arg.all);
2673 begin
2674 Place (' ');
2675 Place_Lower (Normal_File.all);
2676
2677 if Is_Extensionless (Normal_File.all)
2678 and then Command.Defext /= " "
2679 then
2680 Place ('.');
2681 Place (Command.Defext);
2682 end if;
2683 end;
2684
2685 when Unlimited_Files =>
2686 declare
2687 Normal_File : String_Access
2688 := To_Canonical_File_Spec (Arg.all);
2689
2690 File_Is_Wild : Boolean := False;
2691 File_List : String_Access_List_Access;
2692 begin
2693 for I in Arg'Range loop
2694 if Arg (I) = '*'
2695 or else Arg (I) = '%'
2696 then
2697 File_Is_Wild := True;
2698 end if;
2699 end loop;
2700
2701 if File_Is_Wild then
2702 File_List := To_Canonical_File_List
2703 (Arg.all, False);
2704
2705 for I in File_List.all'Range loop
2706 Place (' ');
2707 Place_Lower (File_List.all (I).all);
2708 end loop;
2709 else
2710 Place (' ');
2711 Place_Lower (Normal_File.all);
2712
2713 if Is_Extensionless (Normal_File.all)
2714 and then Command.Defext /= " "
2715 then
2716 Place ('.');
2717 Place (Command.Defext);
2718 end if;
2719 end if;
2720
2721 Param_Count := Param_Count - 1;
2722 end;
2723
2724 when Other_As_Is =>
2725 Place (' ');
2726 Place (Arg.all);
2727
2728 when Files_Or_Wildcard =>
2729
2730 -- Remove spaces from a comma separated list
2731 -- of file names and adjust control variables
2732 -- accordingly.
2733
2734 while Arg_Num < Argument_Count and then
2735 (Argv (Argv'Last) = ',' xor
2736 Argument (Arg_Num + 1)
2737 (Argument (Arg_Num + 1)'First) = ',')
2738 loop
2739 Argv := new String'(Argv.all
2740 & Argument (Arg_Num + 1));
2741 Arg_Num := Arg_Num + 1;
2742 Arg_Idx := Argv'First;
2743 Next_Arg_Idx := Get_Arg_End (Argv.all, Arg_Idx);
2744 Arg :=
2745 new String'(Argv (Arg_Idx .. Next_Arg_Idx));
2746 end loop;
2747
2748 -- Parse the comma separated list of VMS filenames
2749 -- and place them on the command line as space
2750 -- separated Unix style filenames. Lower case and
2751 -- add default extension as appropriate.
2752
2753 declare
2754 Arg1_Idx : Integer := Arg'First;
2755
2756 function Get_Arg1_End
2757 (Arg : String; Arg_Idx : Integer)
2758 return Integer;
2759 -- Begins looking at Arg_Idx + 1 and
2760 -- returns the index of the last character
2761 -- before a comma or else the index of the
2762 -- last character in the string Arg.
2763
2764 function Get_Arg1_End
2765 (Arg : String; Arg_Idx : Integer)
2766 return Integer
2767 is
2768 begin
2769 for I in Arg_Idx + 1 .. Arg'Last loop
2770 if Arg (I) = ',' then
2771 return I - 1;
2772 end if;
2773 end loop;
2774
2775 return Arg'Last;
2776 end Get_Arg1_End;
2777
2778 begin
2779 loop
2780 declare
2781 Next_Arg1_Idx : Integer
2782 := Get_Arg1_End (Arg.all, Arg1_Idx);
2783
2784 Arg1 : String
2785 := Arg (Arg1_Idx .. Next_Arg1_Idx);
2786
2787 Normal_File : String_Access
2788 := To_Canonical_File_Spec (Arg1);
2789
2790 begin
2791 Place (' ');
2792 Place_Lower (Normal_File.all);
2793
2794 if Is_Extensionless (Normal_File.all)
2795 and then Command.Defext /= " "
2796 then
2797 Place ('.');
2798 Place (Command.Defext);
2799 end if;
2800
2801 Arg1_Idx := Next_Arg1_Idx + 1;
2802 end;
2803
2804 exit when Arg1_Idx > Arg'Last;
2805
2806 -- Don't allow two or more commas in a row
2807
2808 if Arg (Arg1_Idx) = ',' then
2809 Arg1_Idx := Arg1_Idx + 1;
2810 if Arg1_Idx > Arg'Last or else
2811 Arg (Arg1_Idx) = ','
2812 then
2813 Put_Line (Standard_Error,
2814 "Malformed Parameter: " & Arg.all);
2815 Put (Standard_Error, "usage: ");
2816 Put_Line (Standard_Error,
2817 Command.Usage.all);
2818 raise Error_Exit;
2819 end if;
2820 end if;
2821
2822 end loop;
2823 end;
2824 end case;
2825 end if;
2826
2827 -- Qualifier argument
2828
2829 else
2830 declare
2831 Sw : Item_Ptr;
2832 SwP : Natural;
2833 P2 : Natural;
2834 Endp : Natural := 0; -- avoid warning!
2835 Opt : Item_Ptr;
2836
2837 begin
2838 SwP := Arg'First;
2839 while SwP < Arg'Last and then Arg (SwP + 1) /= '=' loop
2840 SwP := SwP + 1;
2841 end loop;
2842
2843 -- At this point, the switch name is in
2844 -- Arg (Arg'First..SwP) and if that is not the whole
2845 -- switch, then there is an equal sign at
2846 -- Arg (SwP + 1) and the rest of Arg is what comes
2847 -- after the equal sign.
2848
2849 -- If make commands are active, see if we have another
2850 -- COMMANDS_TRANSLATION switch belonging to gnatmake.
2851
2852 if Make_Commands_Active /= null then
2853 Sw :=
2854 Matching_Name
2855 (Arg (Arg'First .. SwP),
2856 Command.Switches,
2857 Quiet => True);
2858
2859 if Sw /= null and then Sw.Translation = T_Commands then
2860 null;
2861
2862 else
2863 Sw :=
2864 Matching_Name
2865 (Arg (Arg'First .. SwP),
2866 Make_Commands_Active.Switches,
2867 Quiet => False);
2868 end if;
2869
2870 -- For case of GNAT MAKE or CHOP, if we cannot find the
2871 -- switch, then see if it is a recognized compiler switch
2872 -- instead, and if so process the compiler switch.
2873
2874 elsif Command.Name.all = "MAKE"
2875 or else Command.Name.all = "CHOP" then
2876 Sw :=
2877 Matching_Name
2878 (Arg (Arg'First .. SwP),
2879 Command.Switches,
2880 Quiet => True);
2881
2882 if Sw = null then
2883 Sw :=
2884 Matching_Name
2885 (Arg (Arg'First .. SwP),
2886 Matching_Name ("COMPILE", Commands).Switches,
2887 Quiet => False);
2888 end if;
2889
2890 -- For all other cases, just search the relevant command
2891
2892 else
2893 Sw :=
2894 Matching_Name
2895 (Arg (Arg'First .. SwP),
2896 Command.Switches,
2897 Quiet => False);
2898 end if;
2899
2900 if Sw /= null then
2901 case Sw.Translation is
2902
2903 when T_Direct =>
2904 Place_Unix_Switches (Sw.Unix_String);
2905 if Arg (SwP + 1) = '=' then
2906 Put (Standard_Error,
2907 "qualifier options ignored: ");
2908 Put_Line (Standard_Error, Arg.all);
2909 end if;
2910
2911 when T_Directories =>
2912 if SwP + 1 > Arg'Last then
2913 Put (Standard_Error,
2914 "missing directories for: ");
2915 Put_Line (Standard_Error, Arg.all);
2916 Errors := Errors + 1;
2917
2918 elsif Arg (SwP + 2) /= '(' then
2919 SwP := SwP + 2;
2920 Endp := Arg'Last;
2921
2922 elsif Arg (Arg'Last) /= ')' then
2923
2924 -- Remove spaces from a comma separated list
2925 -- of file names and adjust control
2926 -- variables accordingly.
2927
2928 if Arg_Num < Argument_Count and then
2929 (Argv (Argv'Last) = ',' xor
2930 Argument (Arg_Num + 1)
2931 (Argument (Arg_Num + 1)'First) = ',')
2932 then
2933 Argv := new String'(Argv.all
2934 & Argument (Arg_Num + 1));
2935 Arg_Num := Arg_Num + 1;
2936 Arg_Idx := Argv'First;
2937 Next_Arg_Idx
2938 := Get_Arg_End (Argv.all, Arg_Idx);
2939 Arg := new String'
2940 (Argv (Arg_Idx .. Next_Arg_Idx));
2941 goto Tryagain_After_Coalesce;
2942 end if;
2943
2944 Put (Standard_Error,
2945 "incorrectly parenthesized " &
2946 "or malformed argument: ");
2947 Put_Line (Standard_Error, Arg.all);
2948 Errors := Errors + 1;
2949
2950 else
2951 SwP := SwP + 3;
2952 Endp := Arg'Last - 1;
2953 end if;
2954
2955 while SwP <= Endp loop
2956 declare
2957 Dir_Is_Wild : Boolean := False;
2958 Dir_Maybe_Is_Wild : Boolean := False;
2959 Dir_List : String_Access_List_Access;
2960 begin
2961 P2 := SwP;
2962
2963 while P2 < Endp
2964 and then Arg (P2 + 1) /= ','
2965 loop
2966
2967 -- A wildcard directory spec on VMS
2968 -- will contain either * or % or ...
2969
2970 if Arg (P2) = '*' then
2971 Dir_Is_Wild := True;
2972
2973 elsif Arg (P2) = '%' then
2974 Dir_Is_Wild := True;
2975
2976 elsif Dir_Maybe_Is_Wild
2977 and then Arg (P2) = '.'
2978 and then Arg (P2 + 1) = '.'
2979 then
2980 Dir_Is_Wild := True;
2981 Dir_Maybe_Is_Wild := False;
2982
2983 elsif Dir_Maybe_Is_Wild then
2984 Dir_Maybe_Is_Wild := False;
2985
2986 elsif Arg (P2) = '.'
2987 and then Arg (P2 + 1) = '.'
2988 then
2989 Dir_Maybe_Is_Wild := True;
2990
2991 end if;
2992
2993 P2 := P2 + 1;
2994 end loop;
2995
2996 if (Dir_Is_Wild) then
2997 Dir_List := To_Canonical_File_List
2998 (Arg (SwP .. P2), True);
2999
3000 for I in Dir_List.all'Range loop
3001 Place_Unix_Switches (Sw.Unix_String);
3002 Place_Lower (Dir_List.all (I).all);
3003 end loop;
3004 else
3005 Place_Unix_Switches (Sw.Unix_String);
3006 Place_Lower (To_Canonical_Dir_Spec
3007 (Arg (SwP .. P2), False).all);
3008 end if;
3009
3010 SwP := P2 + 2;
3011 end;
3012 end loop;
3013
3014 when T_Directory =>
3015 if SwP + 1 > Arg'Last then
3016 Put (Standard_Error,
3017 "missing directory for: ");
3018 Put_Line (Standard_Error, Arg.all);
3019 Errors := Errors + 1;
3020
3021 else
3022 Place_Unix_Switches (Sw.Unix_String);
3023
3024 -- Some switches end in "=". No space here
3025
3026 if Sw.Unix_String
3027 (Sw.Unix_String'Last) /= '='
3028 then
3029 Place (' ');
3030 end if;
3031
3032 Place_Lower (To_Canonical_Dir_Spec
3033 (Arg (SwP + 2 .. Arg'Last), False).all);
3034 end if;
3035
3036 when T_File =>
3037 if SwP + 1 > Arg'Last then
3038 Put (Standard_Error, "missing file for: ");
3039 Put_Line (Standard_Error, Arg.all);
3040 Errors := Errors + 1;
3041
3042 else
3043 Place_Unix_Switches (Sw.Unix_String);
3044
3045 -- Some switches end in "=". No space here
3046
3047 if Sw.Unix_String
3048 (Sw.Unix_String'Last) /= '='
3049 then
3050 Place (' ');
3051 end if;
3052
3053 Place_Lower (To_Canonical_File_Spec
3054 (Arg (SwP + 2 .. Arg'Last)).all);
3055 end if;
3056
3057 when T_Numeric =>
3058 if OK_Integer (Arg (SwP + 2 .. Arg'Last)) then
3059 Place_Unix_Switches (Sw.Unix_String);
3060 Place (Arg (SwP + 2 .. Arg'Last));
3061
3062 else
3063 Put (Standard_Error, "argument for ");
3064 Put (Standard_Error, Sw.Name.all);
3065 Put_Line (Standard_Error, " must be numeric");
3066 Errors := Errors + 1;
3067 end if;
3068
3069 when T_Alphanumplus =>
3070 if
3071 OK_Alphanumerplus (Arg (SwP + 2 .. Arg'Last))
3072 then
3073 Place_Unix_Switches (Sw.Unix_String);
3074 Place (Arg (SwP + 2 .. Arg'Last));
3075
3076 else
3077 Put (Standard_Error, "argument for ");
3078 Put (Standard_Error, Sw.Name.all);
3079 Put_Line (Standard_Error,
3080 " must be alphanumeric");
3081 Errors := Errors + 1;
3082 end if;
3083
3084 when T_String =>
3085
3086 -- A String value must be extended to the
3087 -- end of the Argv, otherwise strings like
3088 -- "foo/bar" get split at the slash.
3089 --
3090 -- The begining and ending of the string
3091 -- are flagged with embedded nulls which
3092 -- are removed when building the Spawn
3093 -- call. Nulls are use because they won't
3094 -- show up in a /? output. Quotes aren't
3095 -- used because that would make it difficult
3096 -- to embed them.
3097
3098 Place_Unix_Switches (Sw.Unix_String);
3099 if Next_Arg_Idx /= Argv'Last then
3100 Next_Arg_Idx := Argv'Last;
3101 Arg := new String'
3102 (Argv (Arg_Idx .. Next_Arg_Idx));
3103
3104 SwP := Arg'First;
3105 while SwP < Arg'Last and then
3106 Arg (SwP + 1) /= '=' loop
3107 SwP := SwP + 1;
3108 end loop;
3109 end if;
3110 Place (ASCII.NUL);
3111 Place (Arg (SwP + 2 .. Arg'Last));
3112 Place (ASCII.NUL);
3113
3114 when T_Commands =>
3115
3116 -- Output -largs/-bargs/-cargs
3117
3118 Place (' ');
3119 Place (Sw.Unix_String
3120 (Sw.Unix_String'First ..
3121 Sw.Unix_String'First + 5));
3122
3123 -- Set source of new commands, also setting this
3124 -- non-null indicates that we are in the special
3125 -- commands mode for processing the -xargs case.
3126
3127 Make_Commands_Active :=
3128 Matching_Name
3129 (Sw.Unix_String
3130 (Sw.Unix_String'First + 7 ..
3131 Sw.Unix_String'Last),
3132 Commands);
3133
3134 when T_Options =>
3135 if SwP + 1 > Arg'Last then
3136 Place_Unix_Switches (Sw.Options.Unix_String);
3137 SwP := Endp + 1;
3138
3139 elsif Arg (SwP + 2) /= '(' then
3140 SwP := SwP + 2;
3141 Endp := Arg'Last;
3142
3143 elsif Arg (Arg'Last) /= ')' then
3144 Put (Standard_Error,
3145 "incorrectly parenthesized argument: ");
3146 Put_Line (Standard_Error, Arg.all);
3147 Errors := Errors + 1;
3148 SwP := Endp + 1;
3149
3150 else
3151 SwP := SwP + 3;
3152 Endp := Arg'Last - 1;
3153 end if;
3154
3155 while SwP <= Endp loop
3156 P2 := SwP;
3157
3158 while P2 < Endp
3159 and then Arg (P2 + 1) /= ','
3160 loop
3161 P2 := P2 + 1;
3162 end loop;
3163
3164 -- Option name is in Arg (SwP .. P2)
3165
3166 Opt := Matching_Name (Arg (SwP .. P2),
3167 Sw.Options);
3168
3169 if Opt /= null then
3170 Place_Unix_Switches (Opt.Unix_String);
3171 end if;
3172
3173 SwP := P2 + 2;
3174 end loop;
3175
3176 when T_Other =>
3177 Place_Unix_Switches
3178 (new String'(Sw.Unix_String.all & Arg.all));
3179
3180 end case;
3181 end if;
3182 end;
3183 end if;
3184
3185 Arg_Idx := Next_Arg_Idx + 1;
3186 end;
3187
3188 exit when Arg_Idx > Argv'Last;
3189
3190 end loop;
3191 end;
3192
3193 Arg_Num := Arg_Num + 1;
3194 end loop;
3195
3196 if Display_Command then
3197 Put (Standard_Error, "generated command -->");
3198 Put (Standard_Error, String (Buffer.Table (1 .. Buffer.Last)));
3199 Put (Standard_Error, "<--");
3200 New_Line (Standard_Error);
3201 raise Normal_Exit;
3202 end if;
3203
3204 -- Gross error checking that the number of parameters is correct.
3205 -- Not applicable to Unlimited_Files parameters.
3206
3207 if not ((Param_Count = Command.Params'Length - 1 and then
3208 Command.Params (Param_Count + 1) = Unlimited_Files)
3209 or else (Param_Count <= Command.Params'Length))
3210 then
3211 Put_Line (Standard_Error,
3212 "Parameter count of "
3213 & Integer'Image (Param_Count)
3214 & " not equal to expected "
3215 & Integer'Image (Command.Params'Length));
3216 Put (Standard_Error, "usage: ");
3217 Put_Line (Standard_Error, Command.Usage.all);
3218 Errors := Errors + 1;
3219 end if;
3220
3221 if Errors > 0 then
3222 raise Error_Exit;
3223 else
3224 -- Prepare arguments for a call to spawn, filtering out
3225 -- embedded nulls place there to delineate strings.
3226
3227 declare
3228 Pname_Ptr : Natural;
3229 Args : Argument_List (1 .. 500);
3230 Nargs : Natural;
3231 P1, P2 : Natural;
3232 Exec_Path : String_Access;
3233 Inside_Nul : Boolean := False;
3234 Arg : String (1 .. 1024);
3235 Arg_Ctr : Natural;
3236
3237 begin
3238 Pname_Ptr := 1;
3239
3240 while Pname_Ptr < Buffer.Last
3241 and then Buffer.Table (Pname_Ptr + 1) /= ' '
3242 loop
3243 Pname_Ptr := Pname_Ptr + 1;
3244 end loop;
3245
3246 P1 := Pname_Ptr + 2;
3247 Arg_Ctr := 1;
3248 Arg (Arg_Ctr) := Buffer.Table (P1);
3249
3250 Nargs := 0;
3251 while P1 <= Buffer.Last loop
3252
3253 if Buffer.Table (P1) = ASCII.NUL then
3254 if Inside_Nul then
3255 Inside_Nul := False;
3256 else
3257 Inside_Nul := True;
3258 end if;
3259 end if;
3260
3261 if Buffer.Table (P1) = ' ' and then not Inside_Nul then
3262 P1 := P1 + 1;
3263 Arg_Ctr := Arg_Ctr + 1;
3264 Arg (Arg_Ctr) := Buffer.Table (P1);
3265
3266 else
3267 Nargs := Nargs + 1;
3268 P2 := P1;
3269
3270 while P2 < Buffer.Last
3271 and then (Buffer.Table (P2 + 1) /= ' ' or else
3272 Inside_Nul)
3273 loop
3274 P2 := P2 + 1;
3275 Arg_Ctr := Arg_Ctr + 1;
3276 Arg (Arg_Ctr) := Buffer.Table (P2);
3277 if Buffer.Table (P2) = ASCII.NUL then
3278 Arg_Ctr := Arg_Ctr - 1;
3279 if Inside_Nul then
3280 Inside_Nul := False;
3281 else
3282 Inside_Nul := True;
3283 end if;
3284 end if;
3285 end loop;
3286
3287 Args (Nargs) := new String'(String (Arg (1 .. Arg_Ctr)));
3288 P1 := P2 + 2;
3289 Arg_Ctr := 1;
3290 Arg (Arg_Ctr) := Buffer.Table (P1);
3291 end if;
3292 end loop;
3293
3294 Exec_Path := Locate_Exec_On_Path
3295 (String (Buffer.Table (1 .. Pname_Ptr)));
3296
3297 if Exec_Path = null then
3298 Put_Line (Standard_Error,
3299 "Couldn't locate "
3300 & String (Buffer.Table (1 .. Pname_Ptr)));
3301 raise Error_Exit;
3302 end if;
3303
3304 My_Exit_Status
3305 := Exit_Status (Spawn (Exec_Path.all, Args (1 .. Nargs)));
3306
3307 end;
3308
3309 raise Normal_Exit;
3310 end if;
3311
3312 exception
3313 when Error_Exit =>
3314 Set_Exit_Status (Failure);
3315
3316 when Normal_Exit =>
3317 Set_Exit_Status (My_Exit_Status);
3318
3319 end GNATCmd;
Mirror of the offical gcc git repository hosted at gcc.gnu.org