/*
* Copyright (c) 1999
* Steven G. Kargl. All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*
* 1. Redistributions of source code must retain the above copyright notice,
* this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright notice,
* this list of conditions and the following disclaimer in the documentation
* and/or other materials provided with the distribution.
*
* This software is provided by Steven G. Kargl and contributors ``as is'' and
* any express or implied warranties, including, but not limited to, the implied
* warranties of merchantability and fitness for a particular purpose are
* disclaimed. In no event shall Steven G. Kargl or contributors be liable for
* any direct, indirect, incidental, special, exemplary, or consequential
* damages (including, but not limited to, procurement of substitute goods or
* services; loss of use, data, or profits; or business interruption) however
* caused and on any theory of liability, whether in contract, strict liability,
* or tort (including negligence or otherwise) arising in any way out of the
* use of this software, even if advised of the possibility of such damage.
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include "f77.h"
#include "pathnames.h"
#include "proto.h"
char **files = NULL; /* Array to hold file names */
char **pp_cmd = NULL; /* Array to hold preprocessor command */
char **f2c_cmd = NULL; /* Array to hold f2c command */
char **cc_cmd = NULL; /* Array to hold cc command */
char **libdirs = NULL; /* Array to hold directories for library search */
char **libs = NULL; /* Array to hold libraries for linking */
char *output_name = NULL; /* Argument to -o option */
char *tmpdir = NULL;
/*
* Indices to move through the associated array.
*/
int index_files = 0;
int index_f2c_cmd = 0;
int index_cc_cmd = 0;
int index_pp_cmd = 0;
int index_libdirs = 0;
int index_libs = 0;
flags_t flags = CLEAR;
int main(int argc, char *argv[]) {
char **objs;
char *s1, *s2, *s3;
int i, len;
if (argc == 1)
usage();
objs = NULL;
/*
* Allocate arrays of strings to store the parsed command line. We add 5
* to argc because we have a few things to set that do not appear on the
* command line. This might waste some space, but what the heck.
*/
argc += 5;
files = alloc_strings(argc);
objs = alloc_strings(argc);
f2c_cmd = alloc_strings(argc);
cc_cmd = alloc_strings(argc);
pp_cmd = alloc_strings(argc);
libdirs = alloc_strings(argc);
libs = alloc_strings(argc);
argc -= 5;
f2c_cmd[index_f2c_cmd++] = mkstring(F2C_COMMAND);
f2c_cmd[index_f2c_cmd++] = mkstring("-A");
cc_cmd[index_cc_cmd++] = mkstring(CC_COMMAND);
pp_cmd[index_pp_cmd++] = mkstring(PP_COMMAND);
#ifndef SUN_FPP
/* These are GNU cpp flags that need to be set. */
pp_cmd[index_pp_cmd++] = mkstring("-nostdinc");
pp_cmd[index_pp_cmd++] = mkstring("-P");
#endif
cmds(argc, argv);
if (flags & PREPROCESS_ONLY) {
/*
* Loop over the list of files and preprocess. Only files ending
* with .F will be preprocessed, all other files are ignored.
*/
for (i = 0; i < index_files; i++) {
len = strlen(files[i]);
if (files[i][len - 1] == 'F') {
if (index_files == 1 && output_name)
s2 = mkstring(output_name);
else {
s1 = extract_name(files[i]);
s2 = combine(s1, "f");
free(s1);
}
pp_cmd[index_pp_cmd] = files[i];
pp_cmd[index_pp_cmd + 1] = s2;
pp_cmd[index_pp_cmd + 2] = NULL;
if (flags & ECHO)
print_cmd(index_pp_cmd + 2, pp_cmd);
if (phase(PP_COMMAND, pp_cmd) != 0) {
fputs("f77: abnormal child return status: ", stderr);
fprintf(stderr, "%s\n", files[i]);
exit(1);
}
free(s2);
}
}
} else if (flags & COMPILE_ONLY) {
/*
* If the -T option has not been given, then tmpdir is not set.
* Try to get a temporary directory name. We also need to specify
* where the f2c.h header file lives. Add the -o option to the
* f2c command with the expectation that its argumwnt will be added
* within the loop.
*/
if (!tmpdir)
tmpdir = gettmpdir();
cc_cmd[index_cc_cmd++] = mkstring(F2C_INCLUDEDIR);
f2c_cmd[index_f2c_cmd] = mkstring("-o");
if (output_name && index_files > 1) {
fputs("Warning: multiple source files, -o ", stderr);
fprintf(stderr, "%s, and -c\n", output_name);
fputs(" option are incompatible.\n", stderr);
fputs("Warning: -o option ignored.\n", stderr);
}
for (i = 0; i < index_files; i++) {
len = strlen(files[i]);
switch (files[i][len - 1]) {
case 'F':
/* Preprocess: file.F --> tmpdir/F77XXXX.f */
s1 = gettmpname(tmpdir, ".f");
pp_cmd[index_pp_cmd] = files[i];
pp_cmd[index_pp_cmd + 1] = s1;
pp_cmd[index_pp_cmd + 2] = NULL;
if (flags & ECHO)
print_cmd(index_pp_cmd + 2, pp_cmd);
if (phase(PP_COMMAND, pp_cmd) !=0) {
fputs("f77: abnormal child return status: ", stderr);
fprintf(stderr, "%s\n", files[i]);
exit(1);
}
/* Convert: tmpdir/F77XXXX.f --> tmpdir/F77XXXX.c */
s2 = mkstring(s1);
len = strlen(s2) - 1;
s2[len] = 'c';
f2c_cmd[index_f2c_cmd + 1] = s2;
f2c_cmd[index_f2c_cmd + 2] = s1;
f2c_cmd[index_f2c_cmd + 3] = NULL;
if (flags & ECHO)
print_cmd(index_f2c_cmd + 3, f2c_cmd);
if (phase(F2C_COMMAND, f2c_cmd) !=0) {
fputs("f77: abnormal child return status: ", stderr);
fprintf(stderr, "%s\n", files[i]);
exit(1);
}
/*
* Delete the temporary file tmpdir/F77XXXX.f.
*/
unlink(s1);
/* Compile: tmpdir/F77XXXX.c --> file.o */
if (index_files == 1 && output_name)
s3 = mkstring(output_name);
else {
free(s1);
s1 = extract_name(files[i]);
s3 = combine(s1, "o");
}
cc_cmd[index_cc_cmd] = mkstring("-c");
cc_cmd[index_cc_cmd + 1] = mkstring("-o");
cc_cmd[index_cc_cmd + 2] = s3;
cc_cmd[index_cc_cmd + 3] = s2;
cc_cmd[index_cc_cmd + 4] = NULL;
if (flags & ECHO)
print_cmd(index_cc_cmd + 4, cc_cmd);
if (phase(CC_COMMAND, cc_cmd) !=0) {
fputs("f77: abnormal child return status: ", stderr);
fprintf(stderr, "%s\n", files[i]);
exit(1);
}
/*
* Delete the temporary file tmpdir/F77XXXX.c, and
* free memory from mkstring("-o") and mkstring("-c").
*/
unlink(s2);
free(cc_cmd[index_cc_cmd]);
free(cc_cmd[index_cc_cmd + 1]);
free(s1);
free(s2);
free(s3);
break;
case 'f':
/* Convert: file.f --> tmpdir/F77XXXX.c */
s1 = gettmpname(tmpdir, ".c");
f2c_cmd[index_f2c_cmd + 1] = s1;
f2c_cmd[index_f2c_cmd + 2] = files[i];
f2c_cmd[index_f2c_cmd + 3] = NULL;
if (flags & ECHO)
print_cmd(index_f2c_cmd + 3, f2c_cmd);
if (phase(F2C_COMMAND, f2c_cmd) !=0) {
fputs("f77: abnormal child return status: ", stderr);
fprintf(stderr, "%s\n", files[i]);
exit(1);
}
/* Compile: tmpdir/F77XXXX.c --> file.o */
if (index_files == 1 && output_name)
s3 = mkstring(output_name);
else {
s2 = extract_name(files[i]);
s3 = combine(s2, "o");
free(s2);
}
cc_cmd[index_cc_cmd] = mkstring("-c");
cc_cmd[index_cc_cmd + 1] = mkstring("-o");
cc_cmd[index_cc_cmd + 2] = s3;
cc_cmd[index_cc_cmd + 3] = s1;
cc_cmd[index_cc_cmd + 4] = NULL;
if (flags & ECHO)
print_cmd(index_cc_cmd + 4, cc_cmd);
if (phase(CC_COMMAND, cc_cmd) !=0) {
fputs("f77: abnormal child return status: ", stderr);
fprintf(stderr, "%s\n", files[i]);
exit(1);
}
/*
* Delete the temporary file tmpdir/F77XXXX.c, and
* free memory from mkstring("-o") and mkstring("-c").
*/
unlink(s1);
free(cc_cmd[index_cc_cmd]);
free(cc_cmd[index_cc_cmd + 1]);
free(s1);
free(s3);
break;
} /* End of switch */
} /* End of for loop */
} else { /* End of COMPILE_ONLY */
/*
* If the -T option has not been given, then tmpdir is not set.
* Try to get a temporary directory name. We also need to specify
* where the f2c.h header file lives.
*/
if (!tmpdir)
tmpdir = gettmpdir();
cc_cmd[index_cc_cmd++] = mkstring(F2C_INCLUDEDIR);
f2c_cmd[index_f2c_cmd] = mkstring("-o");
for (i = 0; i < index_files; i++) {
len = strlen(files[i]);
switch (files[i][len - 1]) {
case 'F':
/* Preprocess: file.F --> tmpdir/F77XXXX.f */
s1 = gettmpname(tmpdir, ".f");
pp_cmd[index_pp_cmd] = files[i];
pp_cmd[index_pp_cmd + 1] = s1;
pp_cmd[index_pp_cmd + 2] = NULL;
if (flags & ECHO)
print_cmd(index_pp_cmd + 2, pp_cmd);
if (phase(PP_COMMAND, pp_cmd) !=0) {
fputs("f77: abnormal child return status: ", stderr);
fprintf(stderr, "%s\n", files[i]);
exit(1);
}
/* Convert: tmpdir/F77XXXX.f --> tmpdir/F77XXXX.c */
s2 = mkstring(s1);
len = strlen(s2) - 1;
s2[len] = 'c';
f2c_cmd[index_f2c_cmd + 1] = s2;
f2c_cmd[index_f2c_cmd + 2] = s1;
f2c_cmd[index_f2c_cmd + 3] = NULL;
if (flags & ECHO)
print_cmd(index_f2c_cmd + 3, f2c_cmd);
if (phase(F2C_COMMAND, f2c_cmd) !=0) {
fputs("f77: abnormal child return status: ", stderr);
fprintf(stderr, "%s\n", files[i]);
exit(1);
}
/*
* Delete the temporary file tmpdir/F77XXXX.f.
*/
unlink(s1);
/* Compile: tmpdir/F77XXXX.c --> tmpdir/F77XXXX.o */
s1[len] = 'o';
cc_cmd[index_cc_cmd] = mkstring("-c");
cc_cmd[index_cc_cmd + 1] = mkstring("-o");
cc_cmd[index_cc_cmd + 2] = s1;
cc_cmd[index_cc_cmd + 3] = s2;
cc_cmd[index_cc_cmd + 4] = NULL;
if (flags & ECHO)
print_cmd(index_cc_cmd + 4, cc_cmd);
if (phase(CC_COMMAND, cc_cmd) !=0) {
fputs("f77: abnormal child return status: ", stderr);
fprintf(stderr, "%s\n", files[i]);
exit(1);
}
/*
* Delete the temporary file tmpdir/F77XXXX.c, and
* free memory from mkstring("-o") and mkstring("-c").
*/
unlink(s2);
free(cc_cmd[index_cc_cmd]);
free(cc_cmd[index_cc_cmd + 1]);
/* Set objs[i] to point at the .o file. */
objs[i] = s1;
free(s2);
break;
case 'f':
/* Convert: file.f --> tmpdir/F77XXXX.c */
s1 = gettmpname(tmpdir, ".c");
f2c_cmd[index_f2c_cmd + 1] = s1;
f2c_cmd[index_f2c_cmd + 2] = files[i];
f2c_cmd[index_f2c_cmd + 3] = NULL;
if (flags & ECHO)
print_cmd(index_f2c_cmd + 3, f2c_cmd);
if (phase(F2C_COMMAND, f2c_cmd) !=0) {
fputs("f77: abnormal child return status: ", stderr);
fprintf(stderr, "%s\n", files[i]);
exit(1);
}
/* Compile: tmpdir/F77XXXX.c --> tmpdir/F77XXXX.o */
s2 = mkstring(s1);
len = strlen(s2) - 1;
s2[len] = 'o';
cc_cmd[index_cc_cmd] = mkstring("-c");
cc_cmd[index_cc_cmd + 1] = mkstring("-o");
cc_cmd[index_cc_cmd + 2] = s2;
cc_cmd[index_cc_cmd + 3] = s1;
cc_cmd[index_cc_cmd + 4] = NULL;
if (flags & ECHO)
print_cmd(index_cc_cmd + 4, cc_cmd);
if (phase(CC_COMMAND, cc_cmd) !=0) {
fputs("f77: abnormal child return status: ", stderr);
fprintf(stderr, "%s\n", files[i]);
exit(1);
}
/*
* Delete the temporary file tmpdir/F77XXXX.c, and
* free memory from mkstring("-o") and mkstring("-c").
*/
unlink(s1);
free(cc_cmd[index_cc_cmd]);
free(cc_cmd[index_cc_cmd + 1]);
/* Set objs[i] to point at the .o */
objs[i] = s2;
free(s1);
break;
default:
/*
* We need to save names of .o or .a files given on the
* command. This will be useful for temporary file
* cleanup.
*/
objs[i] = files[i];
} /* End of switch */
} /* End of for loop */
/*
* Get ready to link the stuff. First, delete the need for
* the f2c.h location.
*/
index_cc_cmd--;
free(cc_cmd[index_cc_cmd]);
/* Add the name if given */
if (output_name) {
cc_cmd[index_cc_cmd++] = mkstring("-o");
cc_cmd[index_cc_cmd++] = output_name;
}
/* Add .o and .a files to command */
for (i = 0; i < index_files; i++)
cc_cmd[index_cc_cmd++] = objs[i];
/* Add any -Ldirs */
for (i = 0; i < index_libdirs; i++)
cc_cmd[index_cc_cmd++] = libdirs[i];
cc_cmd[index_cc_cmd++] = mkstring(F2C_LIBDIR);
/* Add any -llib */
for (i = 0; i < index_libs; i++)
cc_cmd[index_cc_cmd++] = libs[i];
cc_cmd[index_cc_cmd++] = mkstring("-lf2c");
cc_cmd[index_cc_cmd++] = mkstring("-lm");
cc_cmd[index_cc_cmd] = NULL;
if (flags & ECHO)
print_cmd(index_cc_cmd, cc_cmd);
if (phase(CC_COMMAND, cc_cmd) !=0) {
fputs("f77: abnormal child return status: ", stderr);
fprintf(stderr, "%s\n", files[i]);
exit(1);
}
/* Final step is to get rid f temporary .o files. */
for (i = 0; i < index_files; i++) {
if (strcmp(objs[i], files[i]) != 0)
unlink(objs[i]);
}
}
return 0;
}
syntax highlighted by Code2HTML, v. 0.9.1