1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1996-2002 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
33 with Namet; use Namet;
35 with Osint; use Osint;
39 with Prj.Ext; use Prj.Ext;
41 with Prj.Util; use Prj.Util;
42 with Sdefault; use Sdefault;
43 with Snames; use Snames;
44 with Stringt; use Stringt;
46 with Types; use Types;
47 with Hostparm; use Hostparm;
48 -- Used to determine if we are in VMS or not for error message purposes
50 with Ada.Characters.Handling; use Ada.Characters.Handling;
51 with Ada.Command_Line; use Ada.Command_Line;
52 with Ada.Text_IO; use Ada.Text_IO;
55 with GNAT.OS_Lib; use GNAT.OS_Lib;
60 pragma Ident (Gnatvsn.Gnat_Version_String);
62 Ada_Include_Path : constant String := "ADA_INCLUDE_PATH";
63 Ada_Objects_Path : constant String := "ADA_OBJECTS_PATH";
65 Project_File : String_Access;
66 Project : Prj.Project_Id;
67 Current_Verbosity : Prj.Verbosity := Prj.Default;
68 Tool_Package_Name : Name_Id := No_Name;
70 -- This flag indicates a switch -p (for gnatxref and gnatfind) for
71 -- an old fashioned project file. -p cannot be used in conjonction
74 Old_Project_File_Used : Boolean := False;
76 -- A table to keep the switches on the command line
78 package Last_Switches is new Table.Table
79 (Table_Component_Type => String_Access,
80 Table_Index_Type => Integer,
83 Table_Increment => 100,
84 Table_Name => "Gnatcmd.Last_Switches");
86 -- A table to keep the switches from the project file
88 package First_Switches is new Table.Table
89 (Table_Component_Type => String_Access,
90 Table_Index_Type => Integer,
93 Table_Increment => 100,
94 Table_Name => "Gnatcmd.First_Switches");
100 -- The switch tables contain an entry for each switch recognized by the
101 -- command processor. The syntax of entries is as follows:
103 -- SWITCH_STRING ::= "/ command-qualifier-name TRANSLATION"
106 -- DIRECT_TRANSLATION
107 -- | DIRECTORIES_TRANSLATION
108 -- | FILE_TRANSLATION
109 -- | NO_SPACE_FILE_TRANSL
110 -- | NUMERIC_TRANSLATION
111 -- | STRING_TRANSLATION
112 -- | OPTIONS_TRANSLATION
113 -- | COMMANDS_TRANSLATION
114 -- | ALPHANUMPLUS_TRANSLATION
115 -- | OTHER_TRANSLATION
117 -- DIRECT_TRANSLATION ::= space UNIX_SWITCHES
118 -- DIRECTORIES_TRANSLATION ::= =* UNIX_SWITCH *
119 -- DIRECTORY_TRANSLATION ::= =% UNIX_SWITCH %
120 -- FILE_TRANSLATION ::= =@ UNIX_SWITCH @
121 -- NO_SPACE_FILE_TRANSL ::= =< UNIX_SWITCH >
122 -- NUMERIC_TRANSLATION ::= =# UNIX_SWITCH # | # number #
123 -- STRING_TRANSLATION ::= =" UNIX_SWITCH "
124 -- OPTIONS_TRANSLATION ::= =OPTION {space OPTION}
125 -- COMMANDS_TRANSLATION ::= =? ARGS space command-name
126 -- ALPHANUMPLUS_TRANSLATION ::= =| UNIX_SWITCH |
128 -- UNIX_SWITCHES ::= UNIX_SWITCH {, UNIX_SWITCH}
130 -- UNIX_SWITCH ::= unix-switch-string | !unix-switch-string | `string'
132 -- OPTION ::= option-name space UNIX_SWITCHES
134 -- ARGS ::= -cargs | -bargs | -largs
136 -- Here command-qual is the name of the switch recognized by the GNATCmd.
137 -- This is always given in upper case in the templates, although in the
138 -- actual commands, either upper or lower case is allowed.
140 -- The unix-switch-string always starts with a minus, and has no commas
141 -- or spaces in it. Case is significant in the unix switch string. If a
142 -- unix switch string is preceded by the not sign (!) it means that the
143 -- effect of the corresponding command qualifer is to remove any previous
144 -- occurrence of the given switch in the command line.
146 -- The DIRECTORIES_TRANSLATION format is used where a list of directories
147 -- is given. This possible corresponding formats recognized by GNATCmd are
148 -- as shown by the following example for the case of PATH
151 -- PATH=(direc,direc,direc,direc)
153 -- When more than one directory is present for the DIRECTORIES case, then
154 -- multiple instances of the corresponding unix switch are generated,
155 -- with the file name being substituted for the occurrence of *.
157 -- The FILE_TRANSLATION format is similar except that only a single
158 -- file is allowed, not a list of files, and only one unix switch is
159 -- generated as a result.
161 -- the NO_SPACE_FILE_TRANSL is similar to FILE_TRANSLATION, except that
162 -- no space is inserted between the switch and the file name.
164 -- The NUMERIC_TRANSLATION format is similar to the FILE_TRANSLATION case
165 -- except that the parameter is a decimal integer in the range 0 to 999.
167 -- For the OPTIONS_TRANSLATION case, GNATCmd similarly permits one or
168 -- more options to appear (although only in some cases does the use of
169 -- multiple options make logical sense). For example, taking the
170 -- case of ERRORS for GCC, the following are all allowed:
173 -- /ERRORS=(FULL,VERBOSE)
174 -- /ERRORS=(BRIEF IMMEDIATE)
176 -- If no option is provided (e.g. just /ERRORS is written), then the
177 -- first option in the list is the default option. For /ERRORS this
178 -- is NORMAL, so /ERRORS with no option is equivalent to /ERRORS=NORMAL.
180 -- The COMMANDS_TRANSLATION case is only used for gnatmake, to correspond
181 -- to the use of -cargs, -bargs and -largs (the ARGS string as indicated
182 -- is one of these three possibilities). The name given by COMMAND is the
183 -- corresponding command name to be used to interprete the switches to be
184 -- passed on. Switches of this type set modes, e.g. /COMPILER_QUALIFIERS
185 -- sets the mode so that all subsequent switches, up to another switch
186 -- with COMMANDS_TRANSLATION apply to the corresponding commands issued
187 -- by the make utility. For example
189 -- /COMPILER_QUALIFIERS /LIST /BINDER_QUALIFIERS /MAIN
190 -- /COMPILER_QUALIFIERS /NOLIST /COMPILE_CHECKS=SYNTAX
192 -- Clearly these switches must come at the end of the list of switches
193 -- since all subsequent switches apply to an issued command.
195 -- For the DIRECT_TRANSLATION case, an implicit additional entry is
196 -- created by prepending NO to the name of the qualifer, and then
197 -- inverting the sense of the UNIX_SWITCHES string. For example,
202 -- An implicit entry is created:
206 -- In the case where, a ! is already present, inverting the sense of the
207 -- switch means removing it.
210 -- A synonym to shorten the table
212 type String_Ptr is access constant String;
213 -- String pointer type used throughout
215 type Switches is array (Natural range <>) of String_Ptr;
216 -- Type used for array of swtiches
218 type Switches_Ptr is access constant Switches;
220 --------------------------------
221 -- Switches for project files --
222 --------------------------------
224 S_Ext_Ref : aliased constant S := "/EXTERNAL_REFERENCE=" & '"' &
227 S_Project_File : aliased constant S := "/PROJECT_FILE=<" &
229 S_Project_Verb : aliased constant S := "/PROJECT_FILE_VERBOSITY=" &
237 ----------------------------
238 -- Switches for GNAT BIND --
239 ----------------------------
241 S_Bind_Bind : aliased constant S := "/BIND_FILE=" &
247 S_Bind_Build : aliased constant S := "/BUILD_LIBRARY=|" &
250 S_Bind_Current : aliased constant S := "/CURRENT_DIRECTORY " &
253 S_Bind_Debug : aliased constant S := "/DEBUG=" &
269 S_Bind_DebugX : aliased constant S := "/NODEBUG " &
272 S_Bind_Elab : aliased constant S := "/ELABORATION_DEPENDENCIES " &
275 S_Bind_Error : aliased constant S := "/ERROR_LIMIT=#" &
278 S_Bind_Help : aliased constant S := "/HELP " &
281 S_Bind_Init : aliased constant S := "/INITIALIZE_SCALARS=" &
289 S_Bind_Library : aliased constant S := "/LIBRARY_SEARCH=*" &
292 S_Bind_Linker : aliased constant S := "/LINKER_OPTION_LIST " &
295 S_Bind_List : aliased constant S := "/LIST_RESTRICTIONS " &
298 S_Bind_Main : aliased constant S := "/MAIN " &
301 S_Bind_Nostinc : aliased constant S := "/NOSTD_INCLUDES " &
304 S_Bind_Nostlib : aliased constant S := "/NOSTD_LIBRARIES " &
307 S_Bind_No_Time : aliased constant S := "/NO_TIME_STAMP_CHECK " &
310 S_Bind_Object : aliased constant S := "/OBJECT_LIST " &
313 S_Bind_Order : aliased constant S := "/ORDER_OF_ELABORATION " &
316 S_Bind_Output : aliased constant S := "/OUTPUT=@" &
319 S_Bind_OutputX : aliased constant S := "/NOOUTPUT " &
322 S_Bind_Pess : aliased constant S := "/PESSIMISTIC_ELABORATION " &
325 S_Bind_Read : aliased constant S := "/READ_SOURCES=" &
333 S_Bind_ReadX : aliased constant S := "/NOREAD_SOURCES " &
336 S_Bind_Rename : aliased constant S := "/RENAME_MAIN=<" &
339 S_Bind_Report : aliased constant S := "/REPORT_ERRORS=" &
347 S_Bind_ReportX : aliased constant S := "/NOREPORT_ERRORS " &
350 S_Bind_Restr : aliased constant S := "/RESTRICTION_LIST " &
353 S_Bind_RTS : aliased constant S := "/RUNTIME_SYSTEM=|" &
356 S_Bind_Search : aliased constant S := "/SEARCH=*" &
359 S_Bind_Shared : aliased constant S := "/SHARED " &
362 S_Bind_Slice : aliased constant S := "/TIME_SLICE=#" &
365 S_Bind_Source : aliased constant S := "/SOURCE_SEARCH=*" &
368 S_Bind_Time : aliased constant S := "/TIME_STAMP_CHECK " &
371 S_Bind_Verbose : aliased constant S := "/VERBOSE " &
374 S_Bind_Warn : aliased constant S := "/WARNINGS=" &
382 S_Bind_WarnX : aliased constant S := "/NOWARNINGS " &
385 Bind_Switches : aliased constant Switches :=
386 (S_Bind_Bind 'Access,
387 S_Bind_Build 'Access,
388 S_Bind_Current 'Access,
389 S_Bind_Debug 'Access,
390 S_Bind_DebugX 'Access,
392 S_Bind_Error 'Access,
396 S_Bind_Library 'Access,
397 S_Bind_Linker 'Access,
400 S_Bind_Nostinc 'Access,
401 S_Bind_Nostlib 'Access,
402 S_Bind_No_Time 'Access,
403 S_Bind_Object 'Access,
404 S_Bind_Order 'Access,
405 S_Bind_Output 'Access,
406 S_Bind_OutputX 'Access,
408 S_Project_File 'Access,
409 S_Project_Verb 'Access,
411 S_Bind_ReadX 'Access,
412 S_Bind_Rename 'Access,
413 S_Bind_Report 'Access,
414 S_Bind_ReportX 'Access,
415 S_Bind_Restr 'Access,
417 S_Bind_Search 'Access,
418 S_Bind_Shared 'Access,
419 S_Bind_Slice 'Access,
420 S_Bind_Source 'Access,
422 S_Bind_Verbose 'Access,
424 S_Bind_WarnX 'Access);
426 ----------------------------
427 -- Switches for GNAT CHOP --
428 ----------------------------
430 S_Chop_Comp : aliased constant S := "/COMPILATION " &
433 S_Chop_File : aliased constant S := "/FILE_NAME_MAX_LENGTH=#" &
436 S_Chop_Help : aliased constant S := "/HELP " &
439 S_Chop_Over : aliased constant S := "/OVERWRITE " &
442 S_Chop_Pres : aliased constant S := "/PRESERVE " &
445 S_Chop_Quiet : aliased constant S := "/QUIET " &
448 S_Chop_Ref : aliased constant S := "/REFERENCE " &
451 S_Chop_Verb : aliased constant S := "/VERBOSE " &
454 Chop_Switches : aliased constant Switches :=
455 (S_Chop_Comp 'Access,
460 S_Chop_Quiet 'Access,
462 S_Chop_Verb 'Access);
464 -------------------------------
465 -- Switches for GNAT COMPILE --
466 -------------------------------
468 S_GCC_Ada_83 : aliased constant S := "/83 " &
471 S_GCC_Ada_95 : aliased constant S := "/95 " &
474 S_GCC_Asm : aliased constant S := "/ASM " &
477 S_GCC_Checks : aliased constant S := "/CHECKS=" &
479 "-gnato,!-gnatE,!-gnatp " &
491 S_GCC_ChecksX : aliased constant S := "/NOCHECKS " &
492 "-gnatp,!-gnato,!-gnatE";
494 S_GCC_Compres : aliased constant S := "/COMPRESS_NAMES " &
497 S_GCC_Config : aliased constant S := "/CONFIGURATION_PRAGMAS_FILE=<" &
500 S_GCC_Current : aliased constant S := "/CURRENT_DIRECTORY " &
503 S_GCC_Debug : aliased constant S := "/DEBUG=" &
517 S_GCC_DebugX : aliased constant S := "/NODEBUG " &
520 S_GCC_Dist : aliased constant S := "/DISTRIBUTION_STUBS=" &
526 S_GCC_DistX : aliased constant S := "/NODISTRIBUTION_STUBS " &
529 S_GCC_Error : aliased constant S := "/ERROR_LIMIT=#" &
532 S_GCC_ErrorX : aliased constant S := "/NOERROR_LIMIT " &
535 S_GCC_Expand : aliased constant S := "/EXPAND_SOURCE " &
538 S_GCC_Extend : aliased constant S := "/EXTENSIONS_ALLOWED " &
541 S_GCC_File : aliased constant S := "/FILE_NAME_MAX_LENGTH=#" &
544 S_GCC_Force : aliased constant S := "/FORCE_ALI " &
547 S_GCC_Help : aliased constant S := "/HELP " &
550 S_GCC_Ident : aliased constant S := "/IDENTIFIER_CHARACTER_SET=" &
574 S_GCC_IdentX : aliased constant S := "/NOIDENTIFIER_CHARACTER_SET " &
577 S_GCC_Immed : aliased constant S := "/IMMEDIATE_ERRORS " &
580 S_GCC_Inline : aliased constant S := "/INLINE=" &
588 S_GCC_InlineX : aliased constant S := "/NOINLINE " &
591 S_GCC_Jumps : aliased constant S := "/LONGJMP_SETJMP " &
594 S_GCC_Length : aliased constant S := "/MAX_LINE_LENGTH=#" &
597 S_GCC_List : aliased constant S := "/LIST " &
600 S_GCC_Noadc : aliased constant S := "/NO_GNAT_ADC " &
603 S_GCC_Noload : aliased constant S := "/NOLOAD " &
606 S_GCC_Nostinc : aliased constant S := "/NOSTD_INCLUDES " &
609 S_GCC_Opt : aliased constant S := "/OPTIMIZE=" &
611 "-O2,!-O0,!-O1,!-O3 " &
613 "-O0,!-O1,!-O2,!-O3 " &
615 "-O1,!-O0,!-O2,!-O3 " &
617 "-O1,!-O0,!-O2,!-O3 " &
621 "-O3,!-O0,!-O1,!-O2";
623 S_GCC_OptX : aliased constant S := "/NOOPTIMIZE " &
624 "-O0,!-O1,!-O2,!-O3";
626 S_GCC_Polling : aliased constant S := "/POLLING " &
629 S_GCC_Report : aliased constant S := "/REPORT_ERRORS=" &
641 S_GCC_ReportX : aliased constant S := "/NOREPORT_ERRORS " &
644 S_GCC_Repinfo : aliased constant S := "/REPRESENTATION_INFO=" &
656 S_GCC_RepinfX : aliased constant S := "/NOREPRESENTATION_INFO " &
659 S_GCC_Search : aliased constant S := "/SEARCH=*" &
662 S_GCC_Style : aliased constant S := "/STYLE_CHECKS=" &
707 "ORDERED_SUBPROGRAMS " &
713 "RM_COLUMN_LAYOUT " &
720 S_GCC_StyleX : aliased constant S := "/NOSTYLE_CHECKS " &
723 S_GCC_Syntax : aliased constant S := "/SYNTAX_ONLY " &
726 S_GCC_Trace : aliased constant S := "/TRACE_UNITS " &
729 S_GCC_Tree : aliased constant S := "/TREE_OUTPUT " &
732 S_GCC_Trys : aliased constant S := "/TRY_SEMANTICS " &
735 S_GCC_Units : aliased constant S := "/UNITS_LIST " &
738 S_GCC_Unique : aliased constant S := "/UNIQUE_ERROR_TAG " &
741 S_GCC_Upcase : aliased constant S := "/UPPERCASE_EXTERNALS " &
744 S_GCC_Valid : aliased constant S := "/VALIDITY_CHECKING=" &
786 S_GCC_Verbose : aliased constant S := "/VERBOSE " &
789 S_GCC_Warn : aliased constant S := "/WARNINGS=" &
791 "!-gnatws,!-gnatwe " &
796 "NOBIASED_ROUNDING " &
802 "IMPLICIT_DEREFERENCE " &
804 "NO_IMPLICIT_DEREFERENCE " &
818 "NOIMPLEMENTATION " &
820 "INEFFECTIVE_INLINE " &
822 "NOINEFFECTIVE_INLINE " &
840 "UNREFERENCED_FORMALS " &
842 "NOUNREFERENCED_FORMALS " &
849 S_GCC_WarnX : aliased constant S := "/NOWARNINGS " &
852 S_GCC_Wide : aliased constant S := "/WIDE_CHARACTER_ENCODING=" &
868 S_GCC_WideX : aliased constant S := "/NOWIDE_CHARACTER_ENCODING " &
871 S_GCC_Xdebug : aliased constant S := "/XDEBUG " &
874 S_GCC_Xref : aliased constant S := "/XREF=" &
880 GCC_Switches : aliased constant Switches :=
881 (S_GCC_Ada_83 'Access,
882 S_GCC_Ada_95 'Access,
884 S_GCC_Checks 'Access,
885 S_GCC_ChecksX 'Access,
886 S_GCC_Compres 'Access,
887 S_GCC_Config 'Access,
888 S_GCC_Current 'Access,
890 S_GCC_DebugX 'Access,
894 S_GCC_ErrorX 'Access,
895 S_GCC_Expand 'Access,
896 S_GCC_Extend 'Access,
902 S_GCC_IdentX 'Access,
904 S_GCC_Inline 'Access,
905 S_GCC_InlineX 'Access,
907 S_GCC_Length 'Access,
910 S_GCC_Noload 'Access,
911 S_GCC_Nostinc 'Access,
914 S_GCC_Polling 'Access,
915 S_Project_File'Access,
916 S_Project_Verb'Access,
917 S_GCC_Report 'Access,
918 S_GCC_ReportX 'Access,
919 S_GCC_Repinfo 'Access,
920 S_GCC_RepinfX 'Access,
921 S_GCC_Search 'Access,
923 S_GCC_StyleX 'Access,
924 S_GCC_Syntax 'Access,
929 S_GCC_Unique 'Access,
930 S_GCC_Upcase 'Access,
932 S_GCC_Verbose 'Access,
937 S_GCC_Xdebug 'Access,
940 ----------------------------
941 -- Switches for GNAT ELIM --
942 ----------------------------
944 S_Elim_All : aliased constant S := "/ALL " &
947 S_Elim_Bind : aliased constant S := "/BIND_FILE=<" &
950 S_Elim_Miss : aliased constant S := "/MISSED " &
953 S_Elim_Quiet : aliased constant S := "/QUIET " &
956 S_Elim_Tree : aliased constant S := "/TREE_DIRS=*" &
959 S_Elim_Verb : aliased constant S := "/VERBOSE " &
962 Elim_Switches : aliased constant Switches :=
966 S_Elim_Quiet 'Access,
968 S_Elim_Verb 'Access);
970 ----------------------------
971 -- Switches for GNAT FIND --
972 ----------------------------
974 S_Find_All : aliased constant S := "/ALL_FILES " &
977 S_Find_Deriv : aliased constant S := "/DERIVED_TYPE_INFORMATION " &
980 S_Find_Expr : aliased constant S := "/EXPRESSIONS " &
983 S_Find_Full : aliased constant S := "/FULL_PATHNAME " &
986 S_Find_Ignore : aliased constant S := "/IGNORE_LOCALS " &
989 S_Find_Nostinc : aliased constant S := "/NOSTD_INCLUDES " &
992 S_Find_Nostlib : aliased constant S := "/NOSTD_LIBRARIES " &
995 S_Find_Object : aliased constant S := "/OBJECT_SEARCH=*" &
998 S_Find_Print : aliased constant S := "/PRINT_LINES " &
1001 S_Find_Project : aliased constant S := "/PROJECT=@" &
1004 S_Find_Ref : aliased constant S := "/REFERENCES " &
1007 S_Find_Search : aliased constant S := "/SEARCH=*" &
1010 S_Find_Source : aliased constant S := "/SOURCE_SEARCH=*" &
1013 S_Find_Types : aliased constant S := "/TYPE_HIERARCHY " &
1016 Find_Switches : aliased constant Switches :=
1017 (S_Find_All 'Access,
1018 S_Find_Deriv 'Access,
1019 S_Find_Expr 'Access,
1021 S_Find_Full 'Access,
1022 S_Find_Ignore 'Access,
1023 S_Find_Nostinc 'Access,
1024 S_Find_Nostlib 'Access,
1025 S_Find_Object 'Access,
1026 S_Find_Print 'Access,
1027 S_Find_Project 'Access,
1028 S_Project_File 'Access,
1029 S_Project_Verb 'Access,
1031 S_Find_Search 'Access,
1032 S_Find_Source 'Access,
1033 S_Find_Types 'Access);
1035 ------------------------------
1036 -- Switches for GNAT KRUNCH --
1037 ------------------------------
1039 S_Krunch_Count : aliased constant S := "/COUNT=#" &
1042 Krunch_Switches : aliased constant Switches :=
1043 (1 .. 1 => S_Krunch_Count 'Access);
1045 -------------------------------
1046 -- Switches for GNAT LIBRARY --
1047 -------------------------------
1049 S_Lbr_Config : aliased constant S := "/CONFIG=@" &
1052 S_Lbr_Create : aliased constant S := "/CREATE=%" &
1055 S_Lbr_Delete : aliased constant S := "/DELETE=%" &
1058 S_Lbr_Set : aliased constant S := "/SET=%" &
1061 Lbr_Switches : aliased constant Switches :=
1062 (S_Lbr_Config 'Access,
1063 S_Lbr_Create 'Access,
1064 S_Lbr_Delete 'Access,
1067 ----------------------------
1068 -- Switches for GNAT LINK --
1069 ----------------------------
1071 S_Link_Bind : aliased constant S := "/BIND_FILE=" &
1077 S_Link_Debug : aliased constant S := "/DEBUG=" &
1087 S_Link_Execut : aliased constant S := "/EXECUTABLE=@" &
1090 S_Link_Force : aliased constant S := "/FORCE_OBJECT_FILE_LIST " &
1093 S_Link_Ident : aliased constant S := "/IDENTIFICATION=" & '"' &
1094 "--for-linker=IDENT=" &
1097 S_Link_Nocomp : aliased constant S := "/NOCOMPILE " &
1100 S_Link_Nofiles : aliased constant S := "/NOSTART_FILES " &
1103 S_Link_Noinhib : aliased constant S := "/NOINHIBIT-EXEC " &
1104 "--for-linker=--noinhibit-exec";
1106 S_Link_Static : aliased constant S := "/STATIC " &
1107 "--for-linker=-static";
1109 S_Link_Verb : aliased constant S := "/VERBOSE " &
1112 S_Link_ZZZZZ : aliased constant S := "/<other> " &
1115 Link_Switches : aliased constant Switches :=
1116 (S_Link_Bind 'Access,
1117 S_Link_Debug 'Access,
1118 S_Link_Execut 'Access,
1120 S_Link_Force 'Access,
1121 S_Link_Ident 'Access,
1122 S_Link_Nocomp 'Access,
1123 S_Link_Nofiles 'Access,
1124 S_Link_Noinhib 'Access,
1125 S_Project_File 'Access,
1126 S_Project_Verb 'Access,
1127 S_Link_Static 'Access,
1128 S_Link_Verb 'Access,
1129 S_Link_ZZZZZ 'Access);
1131 ----------------------------
1132 -- Switches for GNAT LIST --
1133 ----------------------------
1135 S_List_All : aliased constant S := "/ALL_UNITS " &
1138 S_List_Current : aliased constant S := "/CURRENT_DIRECTORY " &
1141 S_List_Nostinc : aliased constant S := "/NOSTD_INCLUDES " &
1144 S_List_Object : aliased constant S := "/OBJECT_SEARCH=*" &
1147 S_List_Output : aliased constant S := "/OUTPUT=" &
1161 S_List_Search : aliased constant S := "/SEARCH=*" &
1164 S_List_Source : aliased constant S := "/SOURCE_SEARCH=*" &
1167 List_Switches : aliased constant Switches :=
1168 (S_List_All 'Access,
1169 S_List_Current 'Access,
1171 S_List_Nostinc 'Access,
1172 S_List_Object 'Access,
1173 S_List_Output 'Access,
1174 S_Project_File 'Access,
1175 S_Project_Verb 'Access,
1176 S_List_Search 'Access,
1177 S_List_Source 'Access);
1179 ----------------------------
1180 -- Switches for GNAT MAKE --
1181 ----------------------------
1183 S_Make_Actions : aliased constant S := "/ACTIONS=" &
1191 S_Make_All : aliased constant S := "/ALL_FILES " &
1194 S_Make_Bind : aliased constant S := "/BINDER_QUALIFIERS=?" &
1197 S_Make_Comp : aliased constant S := "/COMPILER_QUALIFIERS=?" &
1200 S_Make_Cond : aliased constant S := "/CONDITIONAL_SOURCE_SEARCH=*" &
1203 S_Make_Cont : aliased constant S := "/CONTINUE_ON_ERROR " &
1206 S_Make_Current : aliased constant S := "/CURRENT_DIRECTORY " &
1209 S_Make_Dep : aliased constant S := "/DEPENDENCIES_LIST " &
1212 S_Make_Doobj : aliased constant S := "/DO_OBJECT_CHECK " &
1215 S_Make_Execut : aliased constant S := "/EXECUTABLE=@" &
1218 S_Make_Force : aliased constant S := "/FORCE_COMPILE " &
1221 S_Make_Inplace : aliased constant S := "/IN_PLACE " &
1224 S_Make_Library : aliased constant S := "/LIBRARY_SEARCH=*" &
1227 S_Make_Link : aliased constant S := "/LINKER_QUALIFIERS=?" &
1230 S_Make_Mapping : aliased constant S := "/MAPPING " &
1233 S_Make_Minimal : aliased constant S := "/MINIMAL_RECOMPILATION " &
1236 S_Make_Nolink : aliased constant S := "/NOLINK " &
1239 S_Make_Nomain : aliased constant S := "/NOMAIN " &
1242 S_Make_Nostinc : aliased constant S := "/NOSTD_INCLUDES " &
1245 S_Make_Nostlib : aliased constant S := "/NOSTD_LIBRARIES " &
1248 S_Make_Object : aliased constant S := "/OBJECT_SEARCH=*" &
1251 S_Make_Proc : aliased constant S := "/PROCESSES=#" &
1254 S_Make_Nojobs : aliased constant S := "/NOPROCESSES " &
1257 S_Make_Quiet : aliased constant S := "/QUIET " &
1260 S_Make_Reason : aliased constant S := "/REASONS " &
1263 S_Make_RTS : aliased constant S := "/RUNTIME_SYSTEM=|" &
1266 S_Make_Search : aliased constant S := "/SEARCH=*" &
1269 S_Make_Skip : aliased constant S := "/SKIP_MISSING=*" &
1272 S_Make_Source : aliased constant S := "/SOURCE_SEARCH=*" &
1275 S_Make_Switch : aliased constant S := "/SWITCH_CHECK " &
1278 S_Make_Unique : aliased constant S := "/UNIQUE " &
1281 S_Make_Verbose : aliased constant S := "/VERBOSE " &
1284 Make_Switches : aliased constant Switches :=
1285 (S_Make_Actions 'Access,
1287 S_Make_Bind 'Access,
1288 S_Make_Comp 'Access,
1289 S_Make_Cond 'Access,
1290 S_Make_Cont 'Access,
1291 S_Make_Current 'Access,
1293 S_Make_Doobj 'Access,
1294 S_Make_Execut 'Access,
1296 S_Make_Force 'Access,
1297 S_Make_Inplace 'Access,
1298 S_Make_Library 'Access,
1299 S_Make_Link 'Access,
1300 S_Make_Mapping 'Access,
1301 S_Make_Minimal 'Access,
1302 S_Make_Nolink 'Access,
1303 S_Make_Nomain 'Access,
1304 S_Make_Nostinc 'Access,
1305 S_Make_Nostlib 'Access,
1306 S_Make_Object 'Access,
1307 S_Make_Proc 'Access,
1308 S_Project_File 'Access,
1309 S_Project_Verb 'Access,
1310 S_Make_Nojobs 'Access,
1311 S_Make_Quiet 'Access,
1312 S_Make_Reason 'Access,
1314 S_Make_Search 'Access,
1315 S_Make_Skip 'Access,
1316 S_Make_Source 'Access,
1317 S_Make_Switch 'Access,
1318 S_Make_Unique 'Access,
1319 S_Make_Verbose 'Access);
1321 ----------------------------
1322 -- Switches for GNAT Name --
1323 ----------------------------
1325 S_Name_Conf : aliased constant S := "/CONFIG_FILE=<" &
1328 S_Name_Dirs : aliased constant S := "/SOURCE_DIRS=*" &
1331 S_Name_Dfile : aliased constant S := "/DIRS_FILE=<" &
1334 S_Name_Help : aliased constant S := "/HELP" &
1337 S_Name_Proj : aliased constant S := "/PROJECT_FILE=<" &
1340 S_Name_Verbose : aliased constant S := "/VERBOSE" &
1343 Name_Switches : aliased constant Switches :=
1344 (S_Name_Conf 'Access,
1345 S_Name_Dirs 'Access,
1346 S_Name_Dfile 'Access,
1347 S_Name_Help 'Access,
1348 S_Name_Proj 'Access,
1349 S_Name_Verbose 'Access);
1351 ----------------------------------
1352 -- Switches for GNAT PREPROCESS --
1353 ----------------------------------
1355 S_Prep_Assoc : aliased constant S := "/ASSOCIATE=" & '"' &
1358 S_Prep_Blank : aliased constant S := "/BLANK_LINES " &
1361 S_Prep_Com : aliased constant S := "/COMMENTS " &
1364 S_Prep_Ref : aliased constant S := "/REFERENCE " &
1367 S_Prep_Remove : aliased constant S := "/REMOVE " &
1370 S_Prep_Symbols : aliased constant S := "/SYMBOLS " &
1373 S_Prep_Undef : aliased constant S := "/UNDEFINED " &
1376 Prep_Switches : aliased constant Switches :=
1377 (S_Prep_Assoc 'Access,
1378 S_Prep_Blank 'Access,
1381 S_Prep_Remove 'Access,
1382 S_Prep_Symbols 'Access,
1383 S_Prep_Undef 'Access);
1385 ------------------------------
1386 -- Switches for GNAT SHARED --
1387 ------------------------------
1389 S_Shared_Debug : aliased constant S := "/DEBUG=" &
1399 S_Shared_Image : aliased constant S := "/IMAGE=@" &
1402 S_Shared_Ident : aliased constant S := "/IDENTIFICATION=" & '"' &
1403 "--for-linker=IDENT=" &
1406 S_Shared_Nofiles : aliased constant S := "/NOSTART_FILES " &
1409 S_Shared_Noinhib : aliased constant S := "/NOINHIBIT-IMAGE " &
1410 "--for-linker=--noinhibit-exec";
1412 S_Shared_Verb : aliased constant S := "/VERBOSE " &
1415 S_Shared_ZZZZZ : aliased constant S := "/<other> " &
1418 Shared_Switches : aliased constant Switches :=
1419 (S_Shared_Debug 'Access,
1420 S_Shared_Image 'Access,
1421 S_Shared_Ident 'Access,
1422 S_Shared_Nofiles 'Access,
1423 S_Shared_Noinhib 'Access,
1424 S_Shared_Verb 'Access,
1425 S_Shared_ZZZZZ 'Access);
1427 --------------------------------
1428 -- Switches for GNAT STANDARD --
1429 --------------------------------
1431 Standard_Switches : aliased constant Switches := (1 .. 0 => null);
1433 ----------------------------
1434 -- Switches for GNAT STUB --
1435 ----------------------------
1437 S_Stub_Current : aliased constant S := "/CURRENT_DIRECTORY " &
1440 S_Stub_Full : aliased constant S := "/FULL " &
1443 S_Stub_Header : aliased constant S := "/HEADER=" &
1449 S_Stub_Indent : aliased constant S := "/INDENTATION=#" &
1452 S_Stub_Length : aliased constant S := "/LINE_LENGTH=#" &
1455 S_Stub_Quiet : aliased constant S := "/QUIET " &
1458 S_Stub_Search : aliased constant S := "/SEARCH=*" &
1461 S_Stub_Tree : aliased constant S := "/TREE_FILE=" &
1469 S_Stub_Verbose : aliased constant S := "/VERBOSE " &
1472 Stub_Switches : aliased constant Switches :=
1473 (S_Stub_Current 'Access,
1474 S_Stub_Full 'Access,
1475 S_Stub_Header 'Access,
1476 S_Stub_Indent 'Access,
1477 S_Stub_Length 'Access,
1478 S_Stub_Quiet 'Access,
1479 S_Stub_Search 'Access,
1480 S_Stub_Tree 'Access,
1481 S_Stub_Verbose 'Access);
1483 ----------------------------
1484 -- Switches for GNAT XREF --
1485 ----------------------------
1487 S_Xref_All : aliased constant S := "/ALL_FILES " &
1490 S_Xref_Deriv : aliased constant S := "/DERIVED_TYPES " &
1493 S_Xref_Full : aliased constant S := "/FULL_PATHNAME " &
1496 S_Xref_Global : aliased constant S := "/IGNORE_LOCALS " &
1499 S_Xref_Nostinc : aliased constant S := "/NOSTD_INCLUDES " &
1502 S_Xref_Nostlib : aliased constant S := "/NOSTD_LIBRARIES " &
1505 S_Xref_Object : aliased constant S := "/OBJECT_SEARCH=*" &
1508 S_Xref_Project : aliased constant S := "/PROJECT=@" &
1511 S_Xref_Search : aliased constant S := "/SEARCH=*" &
1514 S_Xref_Source : aliased constant S := "/SOURCE_SEARCH=*" &
1517 S_Xref_Output : aliased constant S := "/UNUSED " &
1520 S_Xref_Tags : aliased constant S := "/TAGS " &
1523 Xref_Switches : aliased constant Switches :=
1524 (S_Xref_All 'Access,
1525 S_Xref_Deriv 'Access,
1527 S_Xref_Full 'Access,
1528 S_Xref_Global 'Access,
1529 S_Xref_Nostinc 'Access,
1530 S_Xref_Nostlib 'Access,
1531 S_Xref_Object 'Access,
1532 S_Xref_Project 'Access,
1533 S_Project_File 'Access,
1534 S_Project_Verb 'Access,
1535 S_Xref_Search 'Access,
1536 S_Xref_Source 'Access,
1537 S_Xref_Output 'Access,
1538 S_Xref_Tags 'Access);
1544 -- The command table contains an entry for each command recognized by
1545 -- GNATCmd. The entries are represented by an array of records.
1547 type Parameter_Type is
1548 -- A parameter is defined as a whitespace bounded string, not begining
1549 -- with a slash. (But see note under FILES_OR_WILDCARD).
1551 -- A required file or directory parameter.
1554 -- An optional file or directory parameter.
1557 -- A parameter that's passed through as is (not canonicalized)
1560 -- An unlimited number of whitespace separate file or directory
1561 -- parameters including wildcard specifications.
1564 -- Un unlimited number of whitespace separated paameters that are
1565 -- passed through as is (not canonicalized).
1568 -- A comma separated list of files and/or wildcard file specifications.
1569 -- A comma preceded by or followed by whitespace is considered as a
1570 -- single comma character w/o whitespace.
1572 type Parameter_Array is array (Natural range <>) of Parameter_Type;
1573 type Parameter_Ref is access all Parameter_Array;
1575 type Command_Type is
1576 (Bind, Chop, Compile, Elim, Find, Krunch, Library, Link, List,
1577 Make, Name, Preprocess, Shared, Standard, Stub, Xref, Undefined);
1579 type Alternate_Command is (Comp, Ls, Kr, Prep, Psta);
1580 -- Alternate command libel for non VMS system
1582 Corresponding_To : constant array (Alternate_Command) of Command_Type :=
1588 -- Mapping of alternate commands to commands
1590 subtype Real_Command_Type is Command_Type range Bind .. Xref;
1592 type Command_Entry is record
1594 -- Command name for GNAT xxx command
1597 -- A usage string, used for error messages
1599 Unixcmd : String_Ptr;
1600 -- Corresponding Unix command
1602 Unixsws : Argument_List_Access;
1603 -- Switches for the Unix command
1606 -- When True, the command can only be used on VMS
1608 Switches : Switches_Ptr;
1609 -- Pointer to array of switch strings
1611 Params : Parameter_Ref;
1612 -- Describes the allowable types of parameters.
1613 -- Params (1) is the type of the first parameter, etc.
1614 -- An empty parameter array means this command takes no parameters.
1616 Defext : String (1 .. 3);
1617 -- Default extension. If non-blank, then this extension is supplied by
1618 -- default as the extension for any file parameter which does not have
1619 -- an extension already.
1622 -------------------------
1623 -- INTERNAL STRUCTURES --
1624 -------------------------
1626 -- The switches and commands are defined by strings in the previous
1627 -- section so that they are easy to modify, but internally, they are
1628 -- kept in a more conveniently accessible form described in this
1631 -- Commands, command qualifers and options have a similar common format
1632 -- so that searching for matching names can be done in a common manner.
1634 type Item_Id is (Id_Command, Id_Switch, Id_Option);
1636 type Translation_Type is
1639 -- A qualifier with no options.
1640 -- Example: GNAT MAKE /VERBOSE
1643 -- A qualifier followed by a list of directories
1644 -- Example: GNAT COMPILE /SEARCH=([], [.FOO], [.BAR])
1647 -- A qualifier followed by one directory
1648 -- Example: GNAT LIBRARY /SET=[.VAXFLOATLIB]
1651 -- A qualifier followed by a filename
1652 -- Example: GNAT LINK /EXECUTABLE=FOO.EXE
1655 -- A qualifier followed by a filename
1656 -- Example: GNAT MAKE /PROJECT_FILE=PRJ.GPR
1659 -- A qualifier followed by a numeric value.
1660 -- Example: GNAT CHOP /FILE_NAME_MAX_LENGTH=39
1663 -- A qualifier followed by a quoted string. Only used by
1664 -- /IDENTIFICATION qualfier.
1665 -- Example: GNAT LINK /IDENTIFICATION="3.14a1 version"
1668 -- A qualifier followed by a list of options.
1669 -- Example: GNAT COMPILE /REPRESENTATION_INFO=(ARRAYS,OBJECTS)
1672 -- A qualifier followed by a list. Only used for
1673 -- MAKE /COMPILER_QUALIFIERS /BINDER_QUALIFIERS /LINKER_QUALIFIERS
1674 -- (gnatmake -cargs -bargs -largs )
1675 -- Example: GNAT MAKE ... /LINKER_QUALIFIERS /VERBOSE FOOBAR.OBJ
1678 -- A qualifier passed directly to the linker. Only used
1679 -- for LINK and SHARED if no other match is found.
1680 -- Example: GNAT LINK FOO.ALI /SYSSHR
1683 -- A qualifier followed by a legal linker symbol prefix. Only used
1684 -- for BIND /BUILD_LIBRARY (gnatbind -Lxyz).
1685 -- Example: GNAT BIND /BUILD_LIBRARY=foobar
1688 type Item (Id : Item_Id);
1689 type Item_Ptr is access all Item;
1691 type Item (Id : Item_Id) is record
1693 -- Name of the command, switch (with slash) or option
1696 -- Pointer to next item on list, always has the same Id value
1698 Command : Command_Type := Undefined;
1700 Unix_String : String_Ptr := null;
1701 -- Corresponding Unix string. For a command, this is the unix command
1702 -- name and possible default switches. For a switch or option it is
1703 -- the unix switch string.
1709 Switches : Item_Ptr;
1710 -- Pointer to list of switch items for the command, linked
1711 -- through the Next fields with null terminating the list.
1714 -- Usage information, used only for errors and the default
1715 -- list of commands output.
1717 Params : Parameter_Ref;
1718 -- Array of parameters
1720 Defext : String (1 .. 3);
1721 -- Default extension. If non-blank, then this extension is
1722 -- supplied by default as the extension for any file parameter
1723 -- which does not have an extension already.
1727 Translation : Translation_Type;
1728 -- Type of switch translation. For all cases, except Options,
1729 -- this is the only field needed, since the Unix translation
1730 -- is found in Unix_String.
1733 -- For the Options case, this field is set to point to a list
1734 -- of options item (for this case Unix_String is null in the
1735 -- main switch item). The end of the list is marked by null.
1740 -- No special fields needed, since Name and Unix_String are
1741 -- sufficient to completely described an option.
1746 subtype Command_Item is Item (Id_Command);
1747 subtype Switch_Item is Item (Id_Switch);
1748 subtype Option_Item is Item (Id_Option);
1750 ----------------------------------
1751 -- Declarations for GNATCMD use --
1752 ----------------------------------
1754 Commands : Item_Ptr;
1755 -- Pointer to head of list of command items, one for each command, with
1756 -- the end of the list marked by a null pointer.
1758 Last_Command : Item_Ptr;
1759 -- Pointer to last item in Commands list
1761 Normal_Exit : exception;
1762 -- Raise this exception for normal program termination
1764 Error_Exit : exception;
1765 -- Raise this exception if error detected
1767 Errors : Natural := 0;
1768 -- Count errors detected
1770 Command_Arg : Positive := 1;
1773 -- Pointer to command item for current command
1775 Make_Commands_Active : Item_Ptr := null;
1776 -- Set to point to Command entry for COMPILE, BIND, or LINK as appropriate
1777 -- if a COMMANDS_TRANSLATION switch has been encountered while processing
1780 My_Exit_Status : Exit_Status := Success;
1782 package Buffer is new Table.Table
1783 (Table_Component_Type => Character,
1784 Table_Index_Type => Integer,
1785 Table_Low_Bound => 1,
1786 Table_Initial => 4096,
1787 Table_Increment => 2,
1788 Table_Name => "Buffer");
1790 Param_Count : Natural := 0;
1791 -- Number of parameter arguments so far
1796 Display_Command : Boolean := False;
1797 -- Set true if /? switch causes display of generated command (on VMS)
1799 The_Command : Command_Type;
1802 -----------------------
1803 -- Local Subprograms --
1804 -----------------------
1806 function Index (Char : Character; Str : String) return Natural;
1807 -- Returns the first occurrence of Char in Str.
1808 -- Returns 0 if Char is not in Str.
1810 function Init_Object_Dirs return Argument_List;
1812 function Invert_Sense (S : String) return String_Ptr;
1813 -- Given a unix switch string S, computes the inverse (adding or
1814 -- removing ! characters as required), and returns a pointer to
1815 -- the allocated result on the heap.
1817 function Is_Extensionless (F : String) return Boolean;
1818 -- Returns true if the filename has no extension.
1820 function Match (S1, S2 : String) return Boolean;
1821 -- Determines whether S1 and S2 match. This is a case insensitive match.
1823 function Match_Prefix (S1, S2 : String) return Boolean;
1824 -- Determines whether S1 matches a prefix of S2. This is also a case
1825 -- insensitive match (for example Match ("AB","abc") is True).
1827 function Matching_Name
1830 Quiet : Boolean := False)
1832 -- Determines if the item list headed by Itm and threaded through the
1833 -- Next fields (with null marking the end of the list), contains an
1834 -- entry that uniquely matches the given string. The match is case
1835 -- insensitive and permits unique abbreviation. If the match succeeds,
1836 -- then a pointer to the matching item is returned. Otherwise, an
1837 -- appropriate error message is written. Note that the discriminant
1838 -- of Itm is used to determine the appropriate form of this message.
1839 -- Quiet is normally False as shown, if it is set to True, then no
1840 -- error message is generated in a not found situation (null is still
1841 -- returned to indicate the not-found situation).
1843 procedure Non_VMS_Usage;
1844 -- Display usage for platforms other than VMS
1846 function OK_Alphanumerplus (S : String) return Boolean;
1847 -- Checks that S is a string of alphanumeric characters,
1848 -- returning True if all alphanumeric characters,
1849 -- False if empty or a non-alphanumeric character is present.
1851 function OK_Integer (S : String) return Boolean;
1852 -- Checks that S is a string of digits, returning True if all digits,
1853 -- False if empty or a non-digit is present.
1855 procedure Output_Version;
1856 -- Output the version of this program
1858 procedure Place (C : Character);
1859 -- Place a single character in the buffer, updating Ptr
1861 procedure Place (S : String);
1862 -- Place a string character in the buffer, updating Ptr
1864 procedure Place_Lower (S : String);
1865 -- Place string in buffer, forcing letters to lower case, updating Ptr
1867 procedure Place_Unix_Switches (S : String_Ptr);
1868 -- Given a unix switch string, place corresponding switches in Buffer,
1869 -- updating Ptr appropriatelly. Note that in the case of use of ! the
1870 -- result may be to remove a previously placed switch.
1872 procedure Set_Library_For
1873 (Project : Project_Id;
1874 There_Are_Libraries : in out Boolean);
1875 -- If Project is a library project, add the correct
1876 -- -L and -l switches to the linker invocation.
1878 procedure Set_Libraries is
1879 new For_Every_Project_Imported (Boolean, Set_Library_For);
1880 -- Add the -L and -l switches to the linker for all
1881 -- of the library projects.
1883 procedure Validate_Command_Or_Option (N : String_Ptr);
1884 -- Check that N is a valid command or option name, i.e. that it is of the
1885 -- form of an Ada identifier with upper case letters and underscores.
1887 procedure Validate_Unix_Switch (S : String_Ptr);
1888 -- Check that S is a valid switch string as described in the syntax for
1889 -- the switch table item UNIX_SWITCH or else begins with a backquote.
1891 procedure VMS_Conversion (The_Command : out Command_Type);
1892 -- Converts VMS command line to equivalent Unix command line
1898 function Index (Char : Character; Str : String) return Natural is
1900 for Index in Str'Range loop
1901 if Str (Index) = Char then
1909 ----------------------
1910 -- Init_Object_Dirs --
1911 ----------------------
1913 function Init_Object_Dirs return Argument_List is
1914 Object_Dirs : Integer;
1915 Object_Dir : Argument_List (1 .. 256);
1916 Object_Dir_Name : String_Access;
1920 Object_Dir_Name := String_Access (Object_Dir_Default_Name);
1921 Get_Next_Dir_In_Path_Init (Object_Dir_Name);
1925 Dir : String_Access := String_Access
1926 (Get_Next_Dir_In_Path (Object_Dir_Name));
1928 exit when Dir = null;
1929 Object_Dirs := Object_Dirs + 1;
1930 Object_Dir (Object_Dirs) :=
1932 To_Canonical_Dir_Spec
1934 (Normalize_Directory_Name (Dir.all).all,
1935 True).all, True).all);
1939 Object_Dirs := Object_Dirs + 1;
1940 Object_Dir (Object_Dirs) := new String'("-lgnat");
1942 if Hostparm.OpenVMS then
1943 Object_Dirs := Object_Dirs + 1;
1944 Object_Dir (Object_Dirs) := new String'("-ldecgnat");
1947 return Object_Dir (1 .. Object_Dirs);
1948 end Init_Object_Dirs;
1954 function Invert_Sense (S : String) return String_Ptr is
1955 Sinv : String (1 .. S'Length * 2);
1956 -- Result (for sure long enough)
1958 Sinvp : Natural := 0;
1959 -- Pointer to output string
1962 for Sp in S'Range loop
1963 if Sp = S'First or else S (Sp - 1) = ',' then
1964 if S (Sp) = '!' then
1967 Sinv (Sinvp + 1) := '!';
1968 Sinv (Sinvp + 2) := S (Sp);
1973 Sinv (Sinvp + 1) := S (Sp);
1978 return new String'(Sinv (1 .. Sinvp));
1981 ----------------------
1982 -- Is_Extensionless --
1983 ----------------------
1985 function Is_Extensionless (F : String) return Boolean is
1987 for J in reverse F'Range loop
1990 elsif F (J) = '/' or else F (J) = ']' or else F (J) = ':' then
1996 end Is_Extensionless;
2002 function Match (S1, S2 : String) return Boolean is
2003 Dif : constant Integer := S2'First - S1'First;
2007 if S1'Length /= S2'Length then
2011 for J in S1'Range loop
2012 if To_Lower (S1 (J)) /= To_Lower (S2 (J + Dif)) then
2025 function Match_Prefix (S1, S2 : String) return Boolean is
2027 if S1'Length > S2'Length then
2030 return Match (S1, S2 (S2'First .. S2'First + S1'Length - 1));
2038 function Matching_Name
2041 Quiet : Boolean := False)
2047 -- Little procedure to output command/qualifier/option as appropriate
2048 -- and bump error count.
2060 Errors := Errors + 1;
2065 Put (Standard_Error, "command");
2069 Put (Standard_Error, "qualifier");
2071 Put (Standard_Error, "switch");
2075 Put (Standard_Error, "option");
2079 Put (Standard_Error, "input");
2083 Put (Standard_Error, ": ");
2084 Put (Standard_Error, S);
2087 -- Start of processing for Matching_Name
2090 -- If exact match, that's the one we want
2093 while P1 /= null loop
2094 if Match (S, P1.Name.all) then
2101 -- Now check for prefix matches
2104 while P1 /= null loop
2105 if P1.Name.all = "/<other>" then
2108 elsif not Match_Prefix (S, P1.Name.all) then
2112 -- Here we have found one matching prefix, so see if there is
2113 -- another one (which is an ambiguity)
2116 while P2 /= null loop
2117 if Match_Prefix (S, P2.Name.all) then
2119 Put (Standard_Error, "ambiguous ");
2121 Put (Standard_Error, " (matches ");
2122 Put (Standard_Error, P1.Name.all);
2124 while P2 /= null loop
2125 if Match_Prefix (S, P2.Name.all) then
2126 Put (Standard_Error, ',');
2127 Put (Standard_Error, P2.Name.all);
2133 Put_Line (Standard_Error, ")");
2142 -- If we fall through that loop, then there was only one match
2148 -- If we fall through outer loop, there was no match
2151 Put (Standard_Error, "unrecognized ");
2153 New_Line (Standard_Error);
2159 -----------------------
2160 -- OK_Alphanumerplus --
2161 -----------------------
2163 function OK_Alphanumerplus (S : String) return Boolean is
2165 if S'Length = 0 then
2169 for J in S'Range loop
2170 if not (Is_Alphanumeric (S (J)) or else
2171 S (J) = '_' or else S (J) = '$')
2179 end OK_Alphanumerplus;
2185 function OK_Integer (S : String) return Boolean is
2187 if S'Length = 0 then
2191 for J in S'Range loop
2192 if not Is_Digit (S (J)) then
2201 --------------------
2202 -- Output_Version --
2203 --------------------
2205 procedure Output_Version is
2208 Put (Gnatvsn.Gnat_Version_String);
2209 Put_Line (" Copyright 1996-2002 Free Software Foundation, Inc.");
2216 procedure Place (C : Character) is
2218 Buffer.Increment_Last;
2219 Buffer.Table (Buffer.Last) := C;
2221 -- Do not put a space as the first character in the buffer
2222 if C = ' ' and then Buffer.Last = 1 then
2223 Buffer.Decrement_Last;
2227 procedure Place (S : String) is
2229 for J in S'Range loop
2238 procedure Place_Lower (S : String) is
2240 for J in S'Range loop
2241 Place (To_Lower (S (J)));
2245 -------------------------
2246 -- Place_Unix_Switches --
2247 -------------------------
2249 procedure Place_Unix_Switches (S : String_Ptr) is
2250 P1, P2, P3 : Natural;
2256 while P1 <= S'Last loop
2257 if S (P1) = '!' then
2265 pragma Assert (S (P1) = '-' or else S (P1) = '`');
2267 while P2 < S'Last and then S (P2 + 1) /= ',' loop
2271 -- Switch is now in S (P1 .. P2)
2273 Slen := P2 - P1 + 1;
2277 while P3 <= Buffer.Last - Slen loop
2278 if Buffer.Table (P3) = ' '
2279 and then String (Buffer.Table (P3 + 1 .. P3 + Slen)) =
2281 and then (P3 + Slen = Buffer.Last
2283 Buffer.Table (P3 + Slen + 1) = ' ')
2285 Buffer.Table (P3 .. Buffer.Last - Slen - 1) :=
2286 Buffer.Table (P3 + Slen + 1 .. Buffer.Last);
2287 Buffer.Set_Last (Buffer.Last - Slen - 1);
2297 if S (P1) = '`' then
2301 Place (S (P1 .. P2));
2306 end Place_Unix_Switches;
2308 ---------------------
2309 -- Set_Library_For --
2310 ---------------------
2312 procedure Set_Library_For
2313 (Project : Project_Id;
2314 There_Are_Libraries : in out Boolean)
2317 -- Case of library project
2319 if Projects.Table (Project).Library then
2320 There_Are_Libraries := True;
2322 -- Add the -L switch
2324 Last_Switches.Increment_Last;
2325 Last_Switches.Table (Last_Switches.Last) :=
2328 (Projects.Table (Project).Library_Dir));
2330 -- Add the -l switch
2332 Last_Switches.Increment_Last;
2333 Last_Switches.Table (Last_Switches.Last) :=
2336 (Projects.Table (Project).Library_Name));
2338 -- Add the Wl,-rpath switch if library non static
2340 if Projects.Table (Project).Library_Kind /= Static then
2342 Option : constant String_Access :=
2343 MLib.Tgt.Linker_Library_Path_Option
2345 (Projects.Table (Project).Library_Dir));
2348 if Option /= null then
2349 Last_Switches.Increment_Last;
2350 Last_Switches.Table (Last_Switches.Last) :=
2359 end Set_Library_For;
2361 --------------------------------
2362 -- Validate_Command_Or_Option --
2363 --------------------------------
2365 procedure Validate_Command_Or_Option (N : String_Ptr) is
2367 pragma Assert (N'Length > 0);
2369 for J in N'Range loop
2371 pragma Assert (N (J - 1) /= '_');
2374 pragma Assert (Is_Upper (N (J)) or else Is_Digit (N (J)));
2378 end Validate_Command_Or_Option;
2380 --------------------------
2381 -- Validate_Unix_Switch --
2382 --------------------------
2384 procedure Validate_Unix_Switch (S : String_Ptr) is
2386 if S (S'First) = '`' then
2390 pragma Assert (S (S'First) = '-' or else S (S'First) = '!');
2392 for J in S'First + 1 .. S'Last loop
2393 pragma Assert (S (J) /= ' ');
2396 pragma Assert (S (J - 1) = ',' and then S (J + 1) = '-');
2400 end Validate_Unix_Switch;
2402 ----------------------
2403 -- List of Commands --
2404 ----------------------
2406 -- Note that we put this after all the local bodies (except Non_VMS_Usage
2407 -- and VMS_Conversion that use Command_List) to avoid some access before
2408 -- elaboration problems.
2410 Command_List : constant array (Real_Command_Type) of Command_Entry :=
2412 (Cname => new S'("BIND"),
2413 Usage => new S'("GNAT BIND file[.ali] /qualifiers"),
2415 Unixcmd => new S'("gnatbind"),
2417 Switches => Bind_Switches'Access,
2418 Params => new Parameter_Array'(1 => File),
2422 (Cname => new S'("CHOP"),
2423 Usage => new S'("GNAT CHOP file [directory] /qualifiers"),
2425 Unixcmd => new S'("gnatchop"),
2427 Switches => Chop_Switches'Access,
2428 Params => new Parameter_Array'(1 => File, 2 => Optional_File),
2432 (Cname => new S'("COMPILE"),
2433 Usage => new S'("GNAT COMPILE filespec[,...] /qualifiers"),
2435 Unixcmd => new S'("gnatmake"),
2436 Unixsws => new Argument_List' (1 => new String'("-f"),
2437 2 => new String'("-u"),
2438 3 => new String'("-c")),
2439 Switches => GCC_Switches'Access,
2440 Params => new Parameter_Array'(1 => Files_Or_Wildcard),
2444 (Cname => new S'("ELIM"),
2445 Usage => new S'("GNAT ELIM name /qualifiers"),
2447 Unixcmd => new S'("gnatelim"),
2449 Switches => Elim_Switches'Access,
2450 Params => new Parameter_Array'(1 => Other_As_Is),
2454 (Cname => new S'("FIND"),
2455 Usage => new S'("GNAT FIND pattern[:sourcefile[:line"
2456 & "[:column]]] filespec[,...] /qualifiers"),
2458 Unixcmd => new S'("gnatfind"),
2460 Switches => Find_Switches'Access,
2461 Params => new Parameter_Array'(1 => Other_As_Is,
2462 2 => Files_Or_Wildcard),
2466 (Cname => new S'("KRUNCH"),
2467 Usage => new S'("GNAT KRUNCH file [/COUNT=nnn]"),
2469 Unixcmd => new S'("gnatkr"),
2471 Switches => Krunch_Switches'Access,
2472 Params => new Parameter_Array'(1 => File),
2476 (Cname => new S'("LIBRARY"),
2477 Usage => new S'("GNAT LIBRARY /[CREATE | SET | DELETE]"
2478 & "=directory [/CONFIG=file]"),
2480 Unixcmd => new S'("gnatlbr"),
2482 Switches => Lbr_Switches'Access,
2483 Params => new Parameter_Array'(1 .. 0 => File),
2487 (Cname => new S'("LINK"),
2488 Usage => new S'("GNAT LINK file[.ali]"
2489 & " [extra obj_&_lib_&_exe_&_opt files]"
2492 Unixcmd => new S'("gnatlink"),
2494 Switches => Link_Switches'Access,
2495 Params => new Parameter_Array'(1 => Unlimited_Files),
2499 (Cname => new S'("LIST"),
2500 Usage => new S'("GNAT LIST /qualifiers object_or_ali_file"),
2502 Unixcmd => new S'("gnatls"),
2504 Switches => List_Switches'Access,
2505 Params => new Parameter_Array'(1 => File),
2509 (Cname => new S'("MAKE"),
2510 Usage => new S'("GNAT MAKE file /qualifiers (includes "
2511 & "COMPILE /qualifiers)"),
2513 Unixcmd => new S'("gnatmake"),
2515 Switches => Make_Switches'Access,
2516 Params => new Parameter_Array'(1 => File),
2520 (Cname => new S'("NAME"),
2521 Usage => new S'("GNAT NAME /qualifiers naming-pattern "
2522 & "[naming-patterns]"),
2524 Unixcmd => new S'("gnatname"),
2526 Switches => Name_Switches'Access,
2527 Params => new Parameter_Array'(1 => Unlimited_As_Is),
2531 (Cname => new S'("PREPROCESS"),
2532 Usage => new S'("GNAT PREPROCESS ifile ofile dfile /qualifiers"),
2534 Unixcmd => new S'("gnatprep"),
2536 Switches => Prep_Switches'Access,
2537 Params => new Parameter_Array'(1 .. 3 => File),
2541 (Cname => new S'("SHARED"),
2542 Usage => new S'("GNAT SHARED [obj_&_lib_&_exe_&_opt"
2543 & "files] /qualifiers"),
2545 Unixcmd => new S'("gcc"),
2546 Unixsws => new Argument_List'(new String'("-shared")
2547 & Init_Object_Dirs),
2548 Switches => Shared_Switches'Access,
2549 Params => new Parameter_Array'(1 => Unlimited_Files),
2553 (Cname => new S'("STANDARD"),
2554 Usage => new S'("GNAT STANDARD"),
2556 Unixcmd => new S'("gnatpsta"),
2558 Switches => Standard_Switches'Access,
2559 Params => new Parameter_Array'(1 .. 0 => File),
2563 (Cname => new S'("STUB"),
2564 Usage => new S'("GNAT STUB file [directory]/qualifiers"),
2566 Unixcmd => new S'("gnatstub"),
2568 Switches => Stub_Switches'Access,
2569 Params => new Parameter_Array'(1 => File, 2 => Optional_File),
2573 (Cname => new S'("XREF"),
2574 Usage => new S'("GNAT XREF filespec[,...] /qualifiers"),
2576 Unixcmd => new S'("gnatxref"),
2578 Switches => Xref_Switches'Access,
2579 Params => new Parameter_Array'(1 => Files_Or_Wildcard),
2587 procedure Non_VMS_Usage is
2591 Put_Line ("List of available commands");
2594 for C in Command_List'Range loop
2595 if not Command_List (C).VMS_Only then
2596 Put ("GNAT " & Command_List (C).Cname.all);
2598 Put (Command_List (C).Unixcmd.all);
2601 Sws : Argument_List_Access renames Command_List (C).Unixsws;
2604 for J in Sws'Range loop
2616 Put_Line ("Commands FIND, LIST and XREF accept project file " &
2617 "switches -vPx, -Pprj and -Xnam=val");
2621 --------------------
2622 -- VMS_Conversion --
2623 --------------------
2625 procedure VMS_Conversion (The_Command : out Command_Type) is
2629 -- First we must preprocess the string form of the command and options
2630 -- list into the internal form that we use.
2632 for C in Real_Command_Type loop
2635 Command : Item_Ptr := new Command_Item;
2637 Last_Switch : Item_Ptr;
2638 -- Last switch in list
2641 -- Link new command item into list of commands
2643 if Last_Command = null then
2644 Commands := Command;
2646 Last_Command.Next := Command;
2649 Last_Command := Command;
2651 -- Fill in fields of new command item
2653 Command.Name := Command_List (C).Cname;
2654 Command.Usage := Command_List (C).Usage;
2655 Command.Command := C;
2657 if Command_List (C).Unixsws = null then
2658 Command.Unix_String := Command_List (C).Unixcmd;
2661 Cmd : String (1 .. 5_000);
2662 Last : Natural := 0;
2663 Sws : Argument_List_Access := Command_List (C).Unixsws;
2666 Cmd (1 .. Command_List (C).Unixcmd'Length) :=
2667 Command_List (C).Unixcmd.all;
2668 Last := Command_List (C).Unixcmd'Length;
2670 for J in Sws'Range loop
2673 Cmd (Last + 1 .. Last + Sws (J)'Length) :=
2675 Last := Last + Sws (J)'Length;
2678 Command.Unix_String := new String'(Cmd (1 .. Last));
2682 Command.Params := Command_List (C).Params;
2683 Command.Defext := Command_List (C).Defext;
2685 Validate_Command_Or_Option (Command.Name);
2687 -- Process the switch list
2689 for S in Command_List (C).Switches'Range loop
2691 SS : constant String_Ptr := Command_List (C).Switches (S);
2693 P : Natural := SS'First;
2694 Sw : Item_Ptr := new Switch_Item;
2696 Last_Opt : Item_Ptr;
2697 -- Pointer to last option
2700 -- Link new switch item into list of switches
2702 if Last_Switch = null then
2703 Command.Switches := Sw;
2705 Last_Switch.Next := Sw;
2710 -- Process switch string, first get name
2712 while SS (P) /= ' ' and SS (P) /= '=' loop
2716 Sw.Name := new String'(SS (SS'First .. P - 1));
2718 -- Direct translation case
2720 if SS (P) = ' ' then
2721 Sw.Translation := T_Direct;
2722 Sw.Unix_String := new String'(SS (P + 1 .. SS'Last));
2723 Validate_Unix_Switch (Sw.Unix_String);
2725 if SS (P - 1) = '>' then
2726 Sw.Translation := T_Other;
2728 elsif SS (P + 1) = '`' then
2731 -- Create the inverted case (/NO ..)
2733 elsif SS (SS'First + 1 .. SS'First + 2) /= "NO" then
2734 Sw := new Switch_Item;
2735 Last_Switch.Next := Sw;
2739 new String'("/NO" & SS (SS'First + 1 .. P - 1));
2740 Sw.Translation := T_Direct;
2741 Sw.Unix_String := Invert_Sense (SS (P + 1 .. SS'Last));
2742 Validate_Unix_Switch (Sw.Unix_String);
2745 -- Directories translation case
2747 elsif SS (P + 1) = '*' then
2748 pragma Assert (SS (SS'Last) = '*');
2749 Sw.Translation := T_Directories;
2750 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2751 Validate_Unix_Switch (Sw.Unix_String);
2753 -- Directory translation case
2755 elsif SS (P + 1) = '%' then
2756 pragma Assert (SS (SS'Last) = '%');
2757 Sw.Translation := T_Directory;
2758 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2759 Validate_Unix_Switch (Sw.Unix_String);
2761 -- File translation case
2763 elsif SS (P + 1) = '@' then
2764 pragma Assert (SS (SS'Last) = '@');
2765 Sw.Translation := T_File;
2766 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2767 Validate_Unix_Switch (Sw.Unix_String);
2769 -- No space file translation case
2771 elsif SS (P + 1) = '<' then
2772 pragma Assert (SS (SS'Last) = '>');
2773 Sw.Translation := T_No_Space_File;
2774 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2775 Validate_Unix_Switch (Sw.Unix_String);
2777 -- Numeric translation case
2779 elsif SS (P + 1) = '#' then
2780 pragma Assert (SS (SS'Last) = '#');
2781 Sw.Translation := T_Numeric;
2782 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2783 Validate_Unix_Switch (Sw.Unix_String);
2785 -- Alphanumerplus translation case
2787 elsif SS (P + 1) = '|' then
2788 pragma Assert (SS (SS'Last) = '|');
2789 Sw.Translation := T_Alphanumplus;
2790 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2791 Validate_Unix_Switch (Sw.Unix_String);
2793 -- String translation case
2795 elsif SS (P + 1) = '"' then
2796 pragma Assert (SS (SS'Last) = '"');
2797 Sw.Translation := T_String;
2798 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2799 Validate_Unix_Switch (Sw.Unix_String);
2801 -- Commands translation case
2803 elsif SS (P + 1) = '?' then
2804 Sw.Translation := T_Commands;
2805 Sw.Unix_String := new String'(SS (P + 2 .. SS'Last));
2807 -- Options translation case
2810 Sw.Translation := T_Options;
2811 Sw.Unix_String := new String'("");
2813 P := P + 1; -- bump past =
2814 while P <= SS'Last loop
2816 Opt : Item_Ptr := new Option_Item;
2820 -- Link new option item into options list
2822 if Last_Opt = null then
2825 Last_Opt.Next := Opt;
2830 -- Fill in fields of new option item
2833 while SS (Q) /= ' ' loop
2837 Opt.Name := new String'(SS (P .. Q - 1));
2838 Validate_Command_Or_Option (Opt.Name);
2843 while Q <= SS'Last and then SS (Q) /= ' ' loop
2847 Opt.Unix_String := new String'(SS (P .. Q - 1));
2848 Validate_Unix_Switch (Opt.Unix_String);
2858 -- If no parameters, give complete list of commands
2860 if Argument_Count = 0 then
2863 Put_Line ("List of available commands");
2866 while Commands /= null loop
2867 Put (Commands.Usage.all);
2869 Put_Line (Commands.Unix_String.all);
2870 Commands := Commands.Next;
2878 -- Loop through arguments
2880 while Arg_Num <= Argument_Count loop
2882 Process_Argument : declare
2883 Argv : String_Access;
2886 function Get_Arg_End
2890 -- Begins looking at Arg_Idx + 1 and returns the index of the
2891 -- last character before a slash or else the index of the last
2892 -- character in the string Argv.
2898 function Get_Arg_End
2904 for J in Arg_Idx + 1 .. Argv'Last loop
2905 if Argv (J) = '/' then
2913 -- Start of processing for Process_Argument
2916 Argv := new String'(Argument (Arg_Num));
2917 Arg_Idx := Argv'First;
2919 <<Tryagain_After_Coalesce>>
2922 Next_Arg_Idx : Integer;
2923 Arg : String_Access;
2926 Next_Arg_Idx := Get_Arg_End (Argv.all, Arg_Idx);
2927 Arg := new String'(Argv (Arg_Idx .. Next_Arg_Idx));
2929 -- The first one must be a command name
2931 if Arg_Num = 1 and then Arg_Idx = Argv'First then
2933 Command := Matching_Name (Arg.all, Commands);
2935 if Command = null then
2939 The_Command := Command.Command;
2941 -- Give usage information if only command given
2943 if Argument_Count = 1 and then Next_Arg_Idx = Argv'Last
2944 and then Command.Command /= Standard
2949 ("List of available qualifiers and options");
2952 Put (Command.Usage.all);
2954 Put_Line (Command.Unix_String.all);
2957 Sw : Item_Ptr := Command.Switches;
2960 while Sw /= null loop
2964 case Sw.Translation is
2968 Put_Line (Sw.Unix_String.all &
2973 Put_Line (Sw.Unix_String.all);
2975 when T_Directories =>
2976 Put ("=(direc,direc,..direc)");
2978 Put (Sw.Unix_String.all);
2980 Put (Sw.Unix_String.all);
2981 Put_Line (" direc ...");
2986 Put (Sw.Unix_String.all);
2988 if Sw.Unix_String (Sw.Unix_String'Last)
2994 Put_Line ("directory ");
2996 when T_File | T_No_Space_File =>
2999 Put (Sw.Unix_String.all);
3001 if Sw.Translation = T_File
3002 and then Sw.Unix_String
3003 (Sw.Unix_String'Last)
3015 if Sw.Unix_String (Sw.Unix_String'First)
3019 (Sw.Unix_String'First + 1
3020 .. Sw.Unix_String'Last));
3022 Put (Sw.Unix_String.all);
3027 when T_Alphanumplus =>
3031 if Sw.Unix_String (Sw.Unix_String'First)
3035 (Sw.Unix_String'First + 1
3036 .. Sw.Unix_String'Last));
3038 Put (Sw.Unix_String.all);
3050 Put (Sw.Unix_String.all);
3052 if Sw.Unix_String (Sw.Unix_String'Last)
3062 Put (" (switches for ");
3064 (Sw.Unix_String'First + 7
3065 .. Sw.Unix_String'Last));
3069 (Sw.Unix_String'First
3070 .. Sw.Unix_String'First + 5));
3071 Put_Line (" switches");
3075 Opt : Item_Ptr := Sw.Options;
3078 Put_Line ("=(option,option..)");
3080 while Opt /= null loop
3084 if Opt = Sw.Options then
3089 Put_Line (Opt.Unix_String.all);
3103 -- Place (Command.Unix_String.all);
3105 -- Special handling for internal debugging switch /?
3107 elsif Arg.all = "/?" then
3108 Display_Command := True;
3110 -- Copy -switch unchanged
3112 elsif Arg (Arg'First) = '-' then
3116 -- Copy quoted switch with quotes stripped
3118 elsif Arg (Arg'First) = '"' then
3119 if Arg (Arg'Last) /= '"' then
3120 Put (Standard_Error, "misquoted argument: ");
3121 Put_Line (Standard_Error, Arg.all);
3122 Errors := Errors + 1;
3126 Place (Arg (Arg'First + 1 .. Arg'Last - 1));
3129 -- Parameter Argument
3131 elsif Arg (Arg'First) /= '/'
3132 and then Make_Commands_Active = null
3134 Param_Count := Param_Count + 1;
3136 if Param_Count <= Command.Params'Length then
3138 case Command.Params (Param_Count) is
3140 when File | Optional_File =>
3142 Normal_File : String_Access
3143 := To_Canonical_File_Spec (Arg.all);
3146 Place_Lower (Normal_File.all);
3148 if Is_Extensionless (Normal_File.all)
3149 and then Command.Defext /= " "
3152 Place (Command.Defext);
3156 when Unlimited_Files =>
3158 Normal_File : String_Access
3159 := To_Canonical_File_Spec (Arg.all);
3161 File_Is_Wild : Boolean := False;
3162 File_List : String_Access_List_Access;
3164 for I in Arg'Range loop
3166 or else Arg (I) = '%'
3168 File_Is_Wild := True;
3172 if File_Is_Wild then
3173 File_List := To_Canonical_File_List
3176 for I in File_List.all'Range loop
3178 Place_Lower (File_List.all (I).all);
3182 Place_Lower (Normal_File.all);
3184 if Is_Extensionless (Normal_File.all)
3185 and then Command.Defext /= " "
3188 Place (Command.Defext);
3192 Param_Count := Param_Count - 1;
3199 when Unlimited_As_Is =>
3202 Param_Count := Param_Count - 1;
3204 when Files_Or_Wildcard =>
3206 -- Remove spaces from a comma separated list
3207 -- of file names and adjust control variables
3210 while Arg_Num < Argument_Count and then
3211 (Argv (Argv'Last) = ',' xor
3212 Argument (Arg_Num + 1)
3213 (Argument (Arg_Num + 1)'First) = ',')
3216 (Argv.all & Argument (Arg_Num + 1));
3217 Arg_Num := Arg_Num + 1;
3218 Arg_Idx := Argv'First;
3220 Get_Arg_End (Argv.all, Arg_Idx);
3222 (Argv (Arg_Idx .. Next_Arg_Idx));
3225 -- Parse the comma separated list of VMS
3226 -- filenames and place them on the command
3227 -- line as space separated Unix style
3228 -- filenames. Lower case and add default
3229 -- extension as appropriate.
3232 Arg1_Idx : Integer := Arg'First;
3234 function Get_Arg1_End
3235 (Arg : String; Arg_Idx : Integer)
3237 -- Begins looking at Arg_Idx + 1 and
3238 -- returns the index of the last character
3239 -- before a comma or else the index of the
3240 -- last character in the string Arg.
3242 function Get_Arg1_End
3243 (Arg : String; Arg_Idx : Integer)
3247 for I in Arg_Idx + 1 .. Arg'Last loop
3248 if Arg (I) = ',' then
3259 Next_Arg1_Idx : Integer :=
3260 Get_Arg1_End (Arg.all, Arg1_Idx);
3263 Arg (Arg1_Idx .. Next_Arg1_Idx);
3265 Normal_File : String_Access :=
3266 To_Canonical_File_Spec (Arg1);
3270 Place_Lower (Normal_File.all);
3272 if Is_Extensionless (Normal_File.all)
3273 and then Command.Defext /= " "
3276 Place (Command.Defext);
3279 Arg1_Idx := Next_Arg1_Idx + 1;
3282 exit when Arg1_Idx > Arg'Last;
3284 -- Don't allow two or more commas in
3287 if Arg (Arg1_Idx) = ',' then
3288 Arg1_Idx := Arg1_Idx + 1;
3289 if Arg1_Idx > Arg'Last or else
3290 Arg (Arg1_Idx) = ','
3294 "Malformed Parameter: " &
3296 Put (Standard_Error, "usage: ");
3297 Put_Line (Standard_Error,
3308 -- Qualifier argument
3315 Endp : Natural := 0; -- avoid warning!
3320 while SwP < Arg'Last
3321 and then Arg (SwP + 1) /= '='
3326 -- At this point, the switch name is in
3327 -- Arg (Arg'First..SwP) and if that is not the
3328 -- whole switch, then there is an equal sign at
3329 -- Arg (SwP + 1) and the rest of Arg is what comes
3330 -- after the equal sign.
3332 -- If make commands are active, see if we have
3333 -- another COMMANDS_TRANSLATION switch belonging
3336 if Make_Commands_Active /= null then
3339 (Arg (Arg'First .. SwP),
3344 and then Sw.Translation = T_Commands
3351 (Arg (Arg'First .. SwP),
3352 Make_Commands_Active.Switches,
3356 -- For case of GNAT MAKE or CHOP, if we cannot
3357 -- find the switch, then see if it is a
3358 -- recognized compiler switch instead, and if
3359 -- so process the compiler switch.
3361 elsif Command.Name.all = "MAKE"
3362 or else Command.Name.all = "CHOP" then
3365 (Arg (Arg'First .. SwP),
3372 (Arg (Arg'First .. SwP),
3374 ("COMPILE", Commands).Switches,
3378 -- For all other cases, just search the relevant
3384 (Arg (Arg'First .. SwP),
3390 case Sw.Translation is
3393 Place_Unix_Switches (Sw.Unix_String);
3395 and then Arg (SwP + 1) = '='
3397 Put (Standard_Error,
3398 "qualifier options ignored: ");
3399 Put_Line (Standard_Error, Arg.all);
3402 when T_Directories =>
3403 if SwP + 1 > Arg'Last then
3404 Put (Standard_Error,
3405 "missing directories for: ");
3406 Put_Line (Standard_Error, Arg.all);
3407 Errors := Errors + 1;
3409 elsif Arg (SwP + 2) /= '(' then
3413 elsif Arg (Arg'Last) /= ')' then
3415 -- Remove spaces from a comma separated
3416 -- list of file names and adjust
3417 -- control variables accordingly.
3419 if Arg_Num < Argument_Count and then
3420 (Argv (Argv'Last) = ',' xor
3421 Argument (Arg_Num + 1)
3422 (Argument (Arg_Num + 1)'First) = ',')
3425 new String'(Argv.all
3428 Arg_Num := Arg_Num + 1;
3429 Arg_Idx := Argv'First;
3431 := Get_Arg_End (Argv.all, Arg_Idx);
3433 (Argv (Arg_Idx .. Next_Arg_Idx));
3434 goto Tryagain_After_Coalesce;
3437 Put (Standard_Error,
3438 "incorrectly parenthesized " &
3439 "or malformed argument: ");
3440 Put_Line (Standard_Error, Arg.all);
3441 Errors := Errors + 1;
3445 Endp := Arg'Last - 1;
3448 while SwP <= Endp loop
3450 Dir_Is_Wild : Boolean := False;
3451 Dir_Maybe_Is_Wild : Boolean := False;
3452 Dir_List : String_Access_List_Access;
3457 and then Arg (P2 + 1) /= ','
3460 -- A wildcard directory spec on
3461 -- VMS will contain either * or
3464 if Arg (P2) = '*' then
3465 Dir_Is_Wild := True;
3467 elsif Arg (P2) = '%' then
3468 Dir_Is_Wild := True;
3470 elsif Dir_Maybe_Is_Wild
3471 and then Arg (P2) = '.'
3472 and then Arg (P2 + 1) = '.'
3474 Dir_Is_Wild := True;
3475 Dir_Maybe_Is_Wild := False;
3477 elsif Dir_Maybe_Is_Wild then
3478 Dir_Maybe_Is_Wild := False;
3480 elsif Arg (P2) = '.'
3481 and then Arg (P2 + 1) = '.'
3483 Dir_Maybe_Is_Wild := True;
3490 if (Dir_Is_Wild) then
3491 Dir_List := To_Canonical_File_List
3492 (Arg (SwP .. P2), True);
3494 for I in Dir_List.all'Range loop
3498 (Dir_List.all (I).all);
3504 (To_Canonical_Dir_Spec
3505 (Arg (SwP .. P2), False).all);
3513 if SwP + 1 > Arg'Last then
3514 Put (Standard_Error,
3515 "missing directory for: ");
3516 Put_Line (Standard_Error, Arg.all);
3517 Errors := Errors + 1;
3520 Place_Unix_Switches (Sw.Unix_String);
3522 -- Some switches end in "=". No space
3526 (Sw.Unix_String'Last) /= '='
3532 (To_Canonical_Dir_Spec
3533 (Arg (SwP + 2 .. Arg'Last),
3537 when T_File | T_No_Space_File =>
3538 if SwP + 1 > Arg'Last then
3539 Put (Standard_Error,
3540 "missing file for: ");
3541 Put_Line (Standard_Error, Arg.all);
3542 Errors := Errors + 1;
3545 Place_Unix_Switches (Sw.Unix_String);
3547 -- Some switches end in "=". No space
3550 if Sw.Translation = T_File
3551 and then Sw.Unix_String
3552 (Sw.Unix_String'Last) /= '='
3558 (To_Canonical_File_Spec
3559 (Arg (SwP + 2 .. Arg'Last)).all);
3564 OK_Integer (Arg (SwP + 2 .. Arg'Last))
3566 Place_Unix_Switches (Sw.Unix_String);
3567 Place (Arg (SwP + 2 .. Arg'Last));
3570 Put (Standard_Error, "argument for ");
3571 Put (Standard_Error, Sw.Name.all);
3573 (Standard_Error, " must be numeric");
3574 Errors := Errors + 1;
3577 when T_Alphanumplus =>
3580 (Arg (SwP + 2 .. Arg'Last))
3582 Place_Unix_Switches (Sw.Unix_String);
3583 Place (Arg (SwP + 2 .. Arg'Last));
3586 Put (Standard_Error, "argument for ");
3587 Put (Standard_Error, Sw.Name.all);
3588 Put_Line (Standard_Error,
3589 " must be alphanumeric");
3590 Errors := Errors + 1;
3595 -- A String value must be extended to the
3596 -- end of the Argv, otherwise strings like
3597 -- "foo/bar" get split at the slash.
3599 -- The begining and ending of the string
3600 -- are flagged with embedded nulls which
3601 -- are removed when building the Spawn
3602 -- call. Nulls are use because they won't
3603 -- show up in a /? output. Quotes aren't
3604 -- used because that would make it
3605 -- difficult to embed them.
3607 Place_Unix_Switches (Sw.Unix_String);
3608 if Next_Arg_Idx /= Argv'Last then
3609 Next_Arg_Idx := Argv'Last;
3611 (Argv (Arg_Idx .. Next_Arg_Idx));
3614 while SwP < Arg'Last and then
3615 Arg (SwP + 1) /= '=' loop
3620 Place (Arg (SwP + 2 .. Arg'Last));
3625 -- Output -largs/-bargs/-cargs
3628 Place (Sw.Unix_String
3629 (Sw.Unix_String'First ..
3630 Sw.Unix_String'First + 5));
3632 -- Set source of new commands, also
3633 -- setting this non-null indicates that
3634 -- we are in the special commands mode
3635 -- for processing the -xargs case.
3637 Make_Commands_Active :=
3640 (Sw.Unix_String'First + 7 ..
3641 Sw.Unix_String'Last),
3645 if SwP + 1 > Arg'Last then
3647 (Sw.Options.Unix_String);
3650 elsif Arg (SwP + 2) /= '(' then
3654 elsif Arg (Arg'Last) /= ')' then
3657 "incorrectly parenthesized " &
3659 Put_Line (Standard_Error, Arg.all);
3660 Errors := Errors + 1;
3665 Endp := Arg'Last - 1;
3668 while SwP <= Endp loop
3672 and then Arg (P2 + 1) /= ','
3677 -- Option name is in Arg (SwP .. P2)
3679 Opt := Matching_Name (Arg (SwP .. P2),
3692 (new String'(Sw.Unix_String.all &
3700 Arg_Idx := Next_Arg_Idx + 1;
3703 exit when Arg_Idx > Argv'Last;
3706 end Process_Argument;
3708 Arg_Num := Arg_Num + 1;
3711 if Display_Command then
3712 Put (Standard_Error, "generated command -->");
3713 Put (Standard_Error, Command_List (The_Command).Unixcmd.all);
3715 if Command_List (The_Command).Unixsws /= null then
3716 for J in Command_List (The_Command).Unixsws'Range loop
3717 Put (Standard_Error, " ");
3718 Put (Standard_Error,
3719 Command_List (The_Command).Unixsws (J).all);
3723 Put (Standard_Error, " ");
3724 Put (Standard_Error, String (Buffer.Table (1 .. Buffer.Last)));
3725 Put (Standard_Error, "<--");
3726 New_Line (Standard_Error);
3730 -- Gross error checking that the number of parameters is correct.
3731 -- Not applicable to Unlimited_Files parameters.
3733 if (Param_Count = Command.Params'Length - 1
3734 and then Command.Params (Param_Count + 1) = Unlimited_Files)
3735 or else Param_Count <= Command.Params'Length
3740 Put_Line (Standard_Error,
3741 "Parameter count of "
3742 & Integer'Image (Param_Count)
3743 & " not equal to expected "
3744 & Integer'Image (Command.Params'Length));
3745 Put (Standard_Error, "usage: ");
3746 Put_Line (Standard_Error, Command.Usage.all);
3747 Errors := Errors + 1;
3753 -- Prepare arguments for a call to spawn, filtering out
3754 -- embedded nulls place there to delineate strings.
3758 Inside_Nul : Boolean := False;
3759 Arg : String (1 .. 1024);
3765 while P1 <= Buffer.Last and then Buffer.Table (P1) = ' ' loop
3770 Arg (Arg_Ctr) := Buffer.Table (P1);
3772 while P1 <= Buffer.Last loop
3774 if Buffer.Table (P1) = ASCII.NUL then
3776 Inside_Nul := False;
3782 if Buffer.Table (P1) = ' ' and then not Inside_Nul then
3784 Arg_Ctr := Arg_Ctr + 1;
3785 Arg (Arg_Ctr) := Buffer.Table (P1);
3788 Last_Switches.Increment_Last;
3791 while P2 < Buffer.Last
3792 and then (Buffer.Table (P2 + 1) /= ' ' or else
3796 Arg_Ctr := Arg_Ctr + 1;
3797 Arg (Arg_Ctr) := Buffer.Table (P2);
3798 if Buffer.Table (P2) = ASCII.NUL then
3799 Arg_Ctr := Arg_Ctr - 1;
3801 Inside_Nul := False;
3808 Last_Switches.Table (Last_Switches.Last) :=
3809 new String'(String (Arg (1 .. Arg_Ctr)));
3812 Arg (Arg_Ctr) := Buffer.Table (P1);
3819 -------------------------------------
3820 -- Start of processing for GNATCmd --
3821 -------------------------------------
3834 Last_Switches.Set_Last (0);
3836 First_Switches.Init;
3837 First_Switches.Set_Last (0);
3839 -- If on VMS, or if VMS emulation is on, convert VMS style /qualifiers,
3840 -- filenames and pathnames to Unix style.
3843 or else To_Lower (Getenv ("EMULATE_VMS").all) = "true"
3845 VMS_Conversion (The_Command);
3847 -- If not on VMS, scan the command line directly
3850 if Argument_Count = 0 then
3855 if Argument_Count > 1 and then Argument (1) = "-v" then
3856 Opt.Verbose_Mode := True;
3860 The_Command := Real_Command_Type'Value (Argument (Command_Arg));
3862 if Command_List (The_Command).VMS_Only then
3864 Fail ("Command """ & Command_List (The_Command).Cname.all &
3865 """ can only be used on VMS");
3868 when Constraint_Error =>
3870 -- Check if it is an alternate command
3872 Alternate : Alternate_Command;
3875 Alternate := Alternate_Command'Value
3876 (Argument (Command_Arg));
3877 The_Command := Corresponding_To (Alternate);
3880 when Constraint_Error =>
3882 Fail ("Unknown command: " & Argument (Command_Arg));
3886 for Arg in Command_Arg + 1 .. Argument_Count loop
3887 Last_Switches.Increment_Last;
3888 Last_Switches.Table (Last_Switches.Last) :=
3889 new String'(Argument (Arg));
3895 Program : constant String :=
3896 Program_Name (Command_List (The_Command).Unixcmd.all).all;
3898 Exec_Path : String_Access;
3901 -- Locate the executable for the command
3903 Exec_Path := Locate_Exec_On_Path (Program);
3905 if Exec_Path = null then
3906 Put_Line (Standard_Error, "Couldn't locate " & Program);
3910 -- If there are switches for the executable, put them as first switches
3912 if Command_List (The_Command).Unixsws /= null then
3913 for J in Command_List (The_Command).Unixsws'Range loop
3914 First_Switches.Increment_Last;
3915 First_Switches.Table (First_Switches.Last) :=
3916 Command_List (The_Command).Unixsws (J);
3920 -- For BIND, FIND, LINK, LIST and XREF, look for project file related
3923 if The_Command = Bind
3924 or else The_Command = Find
3925 or else The_Command = Link
3926 or else The_Command = List
3927 or else The_Command = Xref
3931 Tool_Package_Name := Name_Binder;
3933 Tool_Package_Name := Name_Finder;
3935 Tool_Package_Name := Name_Linker;
3937 Tool_Package_Name := Name_Gnatls;
3939 Tool_Package_Name := Name_Cross_Reference;
3945 Arg_Num : Positive := 1;
3946 Argv : String_Access;
3948 procedure Remove_Switch (Num : Positive);
3949 -- Remove a project related switch from table Last_Switches
3955 procedure Remove_Switch (Num : Positive) is
3957 Last_Switches.Table (Num .. Last_Switches.Last - 1) :=
3958 Last_Switches.Table (Num + 1 .. Last_Switches.Last);
3959 Last_Switches.Decrement_Last;
3962 -- Start of processing for ??? (need block name here)
3965 while Arg_Num <= Last_Switches.Last loop
3966 Argv := Last_Switches.Table (Arg_Num);
3968 if Argv (Argv'First) = '-' then
3969 if Argv'Length = 1 then
3970 Fail ("switch character cannot be followed by a blank");
3973 -- The two style project files (-p and -P) cannot be used
3976 if (The_Command = Find or else The_Command = Xref)
3977 and then Argv (2) = 'p'
3979 Old_Project_File_Used := True;
3980 if Project_File /= null then
3981 Fail ("-P and -p cannot be used together");
3985 -- -vPx Specify verbosity while parsing project files
3988 and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
3990 case Argv (Argv'Last) is
3992 Current_Verbosity := Prj.Default;
3994 Current_Verbosity := Prj.Medium;
3996 Current_Verbosity := Prj.High;
3998 Fail ("Invalid switch: " & Argv.all);
4001 Remove_Switch (Arg_Num);
4003 -- -Pproject_file Specify project file to be used
4005 elsif Argv'Length >= 3
4006 and then Argv (Argv'First + 1) = 'P'
4009 -- Only one -P switch can be used
4011 if Project_File /= null then
4013 ": second project file forbidden (first is """ &
4014 Project_File.all & """)");
4016 -- The two style project files (-p and -P) cannot be
4019 elsif Old_Project_File_Used then
4020 Fail ("-p and -P cannot be used together");
4024 new String'(Argv (Argv'First + 2 .. Argv'Last));
4027 Remove_Switch (Arg_Num);
4029 -- -Xexternal=value Specify an external reference to be
4030 -- used in project files
4032 elsif Argv'Length >= 5
4033 and then Argv (Argv'First + 1) = 'X'
4036 Equal_Pos : constant Natural :=
4037 Index ('=', Argv (Argv'First + 2 .. Argv'Last));
4039 if Equal_Pos >= Argv'First + 3 and then
4040 Equal_Pos /= Argv'Last then
4041 Add (External_Name =>
4042 Argv (Argv'First + 2 .. Equal_Pos - 1),
4043 Value => Argv (Equal_Pos + 1 .. Argv'Last));
4046 " is not a valid external assignment.");
4050 Remove_Switch (Arg_Num);
4053 Arg_Num := Arg_Num + 1;
4057 Arg_Num := Arg_Num + 1;
4063 -- If there is a project file specified, parse it, get the switches
4064 -- for the tool and setup PATH environment variables.
4066 if Project_File /= null then
4067 Prj.Pars.Set_Verbosity (To => Current_Verbosity);
4070 (Project => Project,
4071 Project_File_Name => Project_File.all);
4073 if Project = Prj.No_Project then
4074 Fail ("""" & Project_File.all & """ processing failed");
4077 -- Check if a package with the name of the tool is in the project
4078 -- file and if there is one, get the switches, if any, and scan them.
4081 Data : Prj.Project_Data := Prj.Projects.Table (Project);
4082 Pkg : Prj.Package_Id :=
4084 (Name => Tool_Package_Name,
4085 In_Packages => Data.Decl.Packages);
4087 Element : Package_Element;
4089 Default_Switches_Array : Array_Element_Id;
4091 The_Switches : Prj.Variable_Value;
4092 Current : Prj.String_List_Id;
4093 The_String : String_Element;
4096 if Pkg /= No_Package then
4097 Element := Packages.Table (Pkg);
4099 -- Packages Gnatls has a single attribute Switches, that is
4100 -- not an associative array.
4102 if The_Command = List then
4105 (Variable_Name => Snames.Name_Switches,
4106 In_Variables => Element.Decl.Attributes);
4108 -- Packages Binder (for gnatbind), Cross_Reference (for
4109 -- gnatxref), Linker (for gnatlink) and Finder
4110 -- (for gnatfind) have an attributed Default_Switches,
4111 -- an associative array, indexed by the name of the
4112 -- programming language.
4114 Default_Switches_Array :=
4116 (Name => Name_Default_Switches,
4117 In_Arrays => Packages.Table (Pkg).Decl.Arrays);
4118 The_Switches := Prj.Util.Value_Of
4120 In_Array => Default_Switches_Array);
4124 -- If there are switches specified in the package of the
4125 -- project file corresponding to the tool, scan them.
4127 case The_Switches.Kind is
4128 when Prj.Undefined =>
4132 if String_Length (The_Switches.Value) > 0 then
4133 String_To_Name_Buffer (The_Switches.Value);
4134 First_Switches.Increment_Last;
4135 First_Switches.Table (First_Switches.Last) :=
4136 new String'(Name_Buffer (1 .. Name_Len));
4140 Current := The_Switches.Values;
4141 while Current /= Prj.Nil_String loop
4142 The_String := String_Elements.Table (Current);
4144 if String_Length (The_String.Value) > 0 then
4145 String_To_Name_Buffer (The_String.Value);
4146 First_Switches.Increment_Last;
4147 First_Switches.Table (First_Switches.Last) :=
4148 new String'(Name_Buffer (1 .. Name_Len));
4151 Current := The_String.Next;
4157 -- Set up the environment variables ADA_INCLUDE_PATH and
4158 -- ADA_OBJECTS_PATH.
4161 (Name => Ada_Include_Path,
4162 Value => Prj.Env.Ada_Include_Path (Project).all);
4164 (Name => Ada_Objects_Path,
4165 Value => Prj.Env.Ada_Objects_Path
4166 (Project, Including_Libraries => False).all);
4168 if The_Command = Bind or else The_Command = Link then
4171 (Projects.Table (Project).Object_Directory));
4174 if The_Command = Link then
4176 -- Add the default search directories, to be able to find
4177 -- libgnat in call to MLib.Utl.Lib_Directory.
4179 Add_Default_Search_Dirs;
4182 There_Are_Libraries : Boolean := False;
4185 -- Check if there are library project files
4187 if MLib.Tgt.Libraries_Are_Supported then
4188 Set_Libraries (Project, There_Are_Libraries);
4191 -- If there are, add the necessary additional switches
4193 if There_Are_Libraries then
4195 -- Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>
4197 Last_Switches.Increment_Last;
4198 Last_Switches.Table (Last_Switches.Last) :=
4199 new String'("-L" & MLib.Utl.Lib_Directory);
4200 Last_Switches.Increment_Last;
4201 Last_Switches.Table (Last_Switches.Last) :=
4202 new String'("-lgnarl");
4203 Last_Switches.Increment_Last;
4204 Last_Switches.Table (Last_Switches.Last) :=
4205 new String'("-lgnat");
4208 Option : constant String_Access :=
4209 MLib.Tgt.Linker_Library_Path_Option
4210 (MLib.Utl.Lib_Directory);
4213 if Option /= null then
4214 Last_Switches.Increment_Last;
4215 Last_Switches.Table (Last_Switches.Last) :=
4224 -- Gather all the arguments and invoke the executable
4227 The_Args : Argument_List
4228 (1 .. First_Switches.Last + Last_Switches.Last);
4229 Arg_Num : Natural := 0;
4231 for J in 1 .. First_Switches.Last loop
4232 Arg_Num := Arg_Num + 1;
4233 The_Args (Arg_Num) := First_Switches.Table (J);
4236 for J in 1 .. Last_Switches.Last loop
4237 Arg_Num := Arg_Num + 1;
4238 The_Args (Arg_Num) := Last_Switches.Table (J);
4241 if Opt.Verbose_Mode then
4242 Output.Write_Str (Exec_Path.all);
4244 for Arg in The_Args'Range loop
4245 Output.Write_Char (' ');
4246 Output.Write_Str (The_Args (Arg).all);
4253 := Exit_Status (Spawn (Exec_Path.all, The_Args));
4260 Set_Exit_Status (Failure);
4263 Set_Exit_Status (My_Exit_Status);
OSDN Git Service
