2003-12-26 Guilhem Lavaux <guilhem@kaffe.org>
[official-gcc.git] / gcc / ada / gnatbl.c
blob82284286676b4b85e8ddf9bdcaeb53a6cf1936ca
1 /****************************************************************************
2 * *
3 * GNAT COMPILER TOOLS *
4 * *
5 * G N A T B L *
6 * *
7 * C Implementation File *
8 * *
9 * Copyright (C) 1992-2003 Free Software Foundation, Inc. *
10 * *
11 * GNAT is free software; you can redistribute it and/or modify it under *
12 * terms of the GNU General Public License as published by the Free Soft- *
13 * ware Foundation; either version 2, or (at your option) any later ver- *
14 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
15 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
16 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
17 * for more details. You should have received a copy of the GNU General *
18 * Public License distributed with GNAT; see file COPYING. If not, write *
19 * to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, *
20 * MA 02111-1307, USA. *
21 * *
22 * GNAT was originally developed by the GNAT team at New York University. *
23 * Extensive contributions were provided by Ada Core Technologies Inc. *
24 * *
25 ****************************************************************************/
27 #include "config.h"
28 #include "system.h"
30 #if defined (__EMX__) || defined (MSDOS)
31 #include <process.h>
32 #endif
33 #include "adaint.h"
35 #ifdef VMS
36 #ifdef exit
37 #undef exit
38 #endif
39 #define exit __posix_exit
40 #endif
42 /* These can be set by command line arguments */
43 char *binder_path = 0;
44 char *linker_path = 0;
45 char *exec_file_name = 0;
46 char *ali_file_name = 0;
47 #define BIND_ARG_MAX 512
48 char *bind_args[BIND_ARG_MAX];
49 int bind_arg_index = -1;
50 #ifdef MSDOS
51 char *coff2exe_path = 0;
52 char *coff2exe_args[] = {(char *) 0, (char *) 0};
53 char *del_command = 0;
54 #endif
55 int verbose = 0;
56 int o_present = 0;
57 int g_present = 0;
59 int link_arg_max = -1;
60 char **link_args = (char **) 0;
61 int link_arg_index = -1;
63 char *gcc_B_arg = 0;
65 #ifndef DIR_SEPARATOR
66 #if defined (__EMX__)
67 #define DIR_SEPARATOR '\\'
68 #else
69 #define DIR_SEPARATOR '/'
70 #endif
71 #endif
73 static int linkonly = 0;
75 static void addarg (char *);
76 static void process_args (int *, char *[]);
78 static void
79 addarg (char *str)
81 int i;
83 if (++link_arg_index >= link_arg_max)
85 char **new_link_args
86 = (char **) xcalloc (link_arg_max + 1000, sizeof (char *));
88 for (i = 0; i <= link_arg_max; i++)
89 new_link_args[i] = link_args[i];
91 if (link_args)
92 free (link_args);
94 link_arg_max += 1000;
95 link_args = new_link_args;
98 link_args[link_arg_index] = str;
101 static void
102 process_args (int *p_argc, char *argv[])
104 int i, j;
106 for (i = 1; i < *p_argc; i++)
108 /* -I is passed on to gnatbind */
109 if (! strncmp( argv[i], "-I", 2))
111 bind_arg_index += 1;
112 if (bind_arg_index >= BIND_ARG_MAX)
114 fprintf (stderr, "Too many arguments to gnatbind\n");
115 exit (-1);
118 bind_args[bind_arg_index] = argv[i];
121 /* -B is passed on to gcc */
122 if (! strncmp (argv[i], "-B", 2))
123 gcc_B_arg = argv[i];
125 /* -v turns on verbose option here and is passed on to gcc */
127 if (! strcmp (argv[i], "-v"))
128 verbose = 1;
130 if (! strcmp (argv[i], "-o"))
132 o_present = 1;
133 exec_file_name = argv[i + 1];
136 if (! strcmp (argv[i], "-g"))
137 g_present = 1;
139 if (! strcmp (argv[i], "-gnatbind"))
141 /* Explicit naming of binder. Grab the value then remove the
142 two arguments from the argument list. */
143 if ( i + 1 >= *p_argc )
145 fprintf (stderr, "Missing argument for -gnatbind\n");
146 exit (1);
149 binder_path = __gnat_locate_exec (argv[i + 1], (char *) ".");
150 if (!binder_path)
152 fprintf (stderr, "Could not locate binder: %s\n", argv[i + 1]);
153 exit (1);
156 for (j = i + 2; j < *p_argc; j++)
157 argv[j - 2] = argv[j];
159 (*p_argc) -= 2;
160 i--;
163 else if (! strcmp (argv[i], "-linkonly"))
165 /* Don't call the binder. Set the flag and then remove the
166 argument from the argument list. */
167 linkonly = 1;
168 for (j = i + 1; j < *p_argc; j++)
169 argv[j - 1] = argv[j];
171 *p_argc -= 1;
172 i--;
175 else if (! strcmp (argv[i], "-gnatlink"))
177 /* Explicit naming of binder. Grab the value then remove the
178 two arguments from the argument list. */
179 if (i + 1 >= *p_argc)
181 fprintf (stderr, "Missing argument for -gnatlink\n");
182 exit (1);
185 linker_path = __gnat_locate_exec (argv[i + 1], (char *) ".");
186 if (!linker_path)
188 fprintf (stderr, "Could not locate linker: %s\n", argv[i + 1]);
189 exit (1);
192 for (j = i + 2; j < *p_argc; j++)
193 argv[j - 2] = argv[j];
194 *p_argc -= 2;
195 i--;
199 extern int main (int, char **);
202 main (int argc, char **argv)
204 int i, j;
205 int done_an_ali = 0;
206 int retcode;
207 #ifdef VMS
208 /* Warning: getenv only retrieves the first directory in VAXC$PATH */
209 char *pathval =
210 xstrdup (__gnat_to_canonical_dir_spec (getenv ("VAXC$PATH"), 0));
211 #else
212 char *pathval = getenv ("PATH");
213 #endif
214 char *spawn_args[5];
215 int spawn_index = 0;
217 #if defined (__EMX__) || defined(MSDOS)
218 char *tmppathval = malloc (strlen (pathval) + 3);
219 strcpy (tmppathval, ".;");
220 pathval = strcat (tmppathval, pathval);
221 #endif
223 process_args (&argc , argv);
225 if (argc == 1)
227 fprintf
228 (stdout,
229 "Usage: %s 'name'.ali\n", argv[0]);
230 fprintf
231 (stdout,
232 " [-o exec_name] -- by default it is 'name'\n");
233 fprintf
234 (stdout,
235 " [-v] -- verbose mode\n");
236 fprintf
237 (stdout,
238 " [-linkonly] -- doesn't call binder\n");
239 fprintf
240 (stdout,
241 " [-gnatbind name] -- full name for gnatbind\n");
242 fprintf
243 (stdout,
244 " [-gnatlink name] -- full name for linker (gcc)\n");
245 fprintf
246 (stdout,
247 " [list of objects] -- non Ada binaries\n");
248 fprintf
249 (stdout,
250 " [linker options] -- other options for linker\n");
251 exit (1);
254 if (!binder_path && !linkonly)
255 binder_path = __gnat_locate_exec ((char *) "gnatbind", pathval);
257 if (!binder_path && !linkonly)
259 fprintf (stderr, "Couldn't locate gnatbind\n");
260 exit (1);
263 if (!linker_path)
264 linker_path = __gnat_locate_exec ((char *) "gnatlink", pathval);
265 if (!linker_path)
267 fprintf (stderr, "Couldn't locate gnatlink\n");
268 exit (1);
271 #ifdef MSDOS
272 coff2exe_path = __gnat_locate_regular_file ("coff2exe.bat", pathval);
273 if (!coff2exe_path)
275 fprintf (stderr, "Couldn't locate %s\n", "coff2exe.bat");
276 exit (1);
278 else
279 coff2exe_args[0] = coff2exe_path;
280 #endif
282 addarg (linker_path);
284 for (i = 1; i < argc; i++)
286 int arg_len = strlen (argv[i]);
288 if (arg_len > 4 && ! strcmp (&argv[i][arg_len - 4], ".ali"))
290 if (done_an_ali)
292 fprintf (stderr,
293 "Sorry - cannot handle more than one ALI file\n");
294 exit (1);
297 done_an_ali = 1;
299 if (__gnat_is_regular_file (argv[i]))
301 ali_file_name = argv[i];
302 if (!linkonly)
304 /* Run gnatbind */
305 spawn_index = 0;
306 spawn_args[spawn_index++] = binder_path;
307 spawn_args[spawn_index++] = ali_file_name;
308 for (j = 0 ; j <= bind_arg_index ; j++ )
309 spawn_args[spawn_index++] = bind_args[j];
310 spawn_args[spawn_index] = 0;
312 if (verbose)
314 int i;
315 for (i = 0; i < 2; i++)
316 printf ("%s ", spawn_args[i]);
318 putchar ('\n');
321 retcode = __gnat_portable_spawn (spawn_args);
322 if (retcode != 0)
323 exit (retcode);
326 else
327 addarg (argv[i]);
329 #ifdef MSDOS
330 else if (!strcmp (argv[i], "-o"))
332 addarg (argv[i]);
333 if (i < argc)
334 i++;
337 char *ptr = strstr (argv[i], ".exe");
339 arg_len = strlen (argv[i]);
340 coff2exe_args[1] = malloc (arg_len + 1);
341 strcpy (coff2exe_args[1], argv[i]);
342 if (ptr != NULL && strlen (ptr) == 4)
343 coff2exe_args[1][arg_len-4] = 0;
345 addarg (coff2exe_args[1]);
348 #endif
349 else
350 addarg (argv[i]);
353 if (! done_an_ali)
355 fprintf (stderr, "No \".ali\" file specified\n");
356 exit (1);
359 addarg (ali_file_name);
360 addarg (NULL);
362 if (verbose)
364 int i;
366 for (i = 0; i < link_arg_index; i++)
367 printf ("%s ", link_args[i]);
369 putchar ('\n');
372 retcode = __gnat_portable_spawn (link_args);
373 if (retcode != 0)
374 exit (retcode);
376 #ifdef MSDOS
377 retcode = __gnat_portable_spawn (coff2exe_args);
378 if (retcode != 0)
379 exit (retcode);
381 if (!g_present)
383 del_command = malloc (strlen (coff2exe_args[1]) + 5);
384 sprintf (del_command, "del %s", coff2exe_args[1]);
385 retcode = system (del_command);
387 #endif
389 exit(0);