main.c

来自「把fortran语言编的程序转为c语言编的程序, 运行环境linux」· C语言 代码 · 共 675 行 · 第 1/2 页

				stl[i], ftn_types[st[i]]);
	if (p)
		nice_printf(outfile, "#endif\n\n");
	}

 static void
#ifdef KR_headers
commonprotos(outfile)
	register FILE *outfile;
#else
commonprotos(register FILE *outfile)
#endif
{
	register Extsym *e, *ee;
	register Argtypes *at;
	Atype *a, *ae;
	int k;
	extern int proc_protochanges;

	if (!outfile)
		return;
	for (e = extsymtab, ee = nextext; e < ee; e++)
		if (e->extstg == STGCOMMON && e->allextp)
			nice_printf(outfile, "/* comlen %s %ld */\n",
				e->cextname, e->maxleng);
	if (Castargs1 < 3)
		return;

	/* -Pr: special comments conveying current knowledge
	    of external references */

	k = proc_protochanges;
	for (e = extsymtab, ee = nextext; e < ee; e++)
		if (e->extstg == STGEXT
		&& e->cextname != e->fextname)	/* not a library function */
		    if (at = e->arginfo) {
			if ((!e->extinit || at->changes & 1)
				/* not defined here or
					changed since definition */
			&& at->nargs >= 0) {
				nice_printf(outfile, "/*:ref: %s %d %d",
					e->cextname, e->extype, at->nargs);
				a = at->atypes;
				for(ae = a + at->nargs; a < ae; a++)
					nice_printf(outfile, " %d", a->type);
				nice_printf(outfile, " */\n");
				if (at->changes & 1)
					k++;
				}
			}
		    else if (e->extype)
			/* typed external, never invoked */
			nice_printf(outfile, "/*:ref: %s %d :*/\n",
				e->cextname, e->extype);
	if (k) {
		nice_printf(outfile,
	"/* Rerunning f2c -P may change prototypes or declarations. */\n");
		if (nerr)
			return;
		if (protostatus)
			done(4);
		if (protofile != stdout) {
			fprintf(diagfile,
	"Rerunning \"f2c -P ... %s %s\" may change prototypes or declarations.\n",
				filename0, proto_fname);
			fflush(diagfile);
			}
		}
	}

 static int
#ifdef KR_headers
I_args(argc, a)
	int argc;
	char **a;
#else
I_args(int argc, char **a)
#endif
{
	char **a0, **a1, **ae, *s;

	ae = a + argc;
	a0 = a;
	for(a1 = ++a; a < ae; a++) {
		if (!(s = *a))
			break;
		if (*s == '-' && s[1] == 'I' && s[2]
		  && (s[3] || s[2] != '2' && s[2] != '4'))
			Iargs = mkchain(s+2, Iargs);
		else
			*a1++ = s;
		}
	Iargs = revchain(Iargs);
	*a1 = 0;
	return a1 - a0;
	}

 int retcode = 0;

 int
#ifdef KR_headers
main(argc, argv)
	int argc;
	char **argv;
#else
main(int argc, char **argv)
#endif
{
	int c2d, k;
	FILE *c_output;
	char *cdfilename;
	static char stderrbuf[BUFSIZ];
	extern char **dfltproc, *dflt1proc[];
	extern char link_msg[];

	diagfile = stderr;
	setbuf(stderr, stderrbuf);	/* arrange for fast error msgs */

	argc = I_args(argc, argv);	/* extract -I args */
	Max_ftn_files = argc - 1;
	ftn_files = (char **)ckalloc((argc+1)*sizeof(char *));

	parse_args (argc, argv, table, sizeof(table)/sizeof(arg_info),
		ftn_files, Max_ftn_files);
	if (keepsubs && checksubs) {
		warn("-C suppresses -s\n");
		keepsubs = 0;
		}
	if (!can_include && ext1comm == 2)
		ext1comm = 1;
	if (ext1comm && !extcomm)
		extcomm = 2;
	if (protostatus)
		Castargs = 3;
	Castargs1 = Castargs;
	if (!Ansi) {
		Castargs = 0;
		parens = "()";
		}
	else if (!Castargs)
		parens = Ansi == 1 ? "()" : "(...)";
	else
		dfltproc = dflt1proc;

	outbuf_adjust();
	set_externs();
	fileinit();
	read_Pfiles(ftn_files);

	for(k = 1; ftn_files[k]; k++)
		if (dofork())
			break;
	filename0 = file_name = ftn_files[current_ftn_file = k - 1];

	set_tmp_names();
	sigcatch(0);

	c_file   = opf(c_functions, textwrite);
	pass1_file=opf(p1_file, binwrite);
	initkey();
	if (file_name && *file_name) {
		cdfilename = coutput;
		if (debugflag != 1) {
			coutput = c_name(file_name,'c');
			cdfilename = copys(outbtail);
			if (Castargs1 >= 2)
				proto_fname = c_name(file_name,'P');
			}
		if (skipC)
			coutput = 0;
		else if (!(c_output = fopen(coutput, textwrite))) {
			file_name = coutput;
			coutput = 0;	/* don't delete read-only .c file */
			fatalstr("can't open %.86s", file_name);
			}

		if (Castargs1 >= 2
		&& !(protofile = fopen(proto_fname, textwrite)))
			fatalstr("Can't open %.84s\n", proto_fname);
		}
	else {
		file_name = "";
		cdfilename = "f2c_out.c";
		c_output = stdout;
		coutput = 0;
		if (Castargs1 >= 2) {
			protofile = stdout;
			if (!skipC)
				printf("#ifdef P_R_O_T_O_T_Y_P_E_S\n");
			}
		}

	if(inilex( copys(file_name) ))
		done(1);
	if (filename0) {
		fprintf(diagfile, "%s:\n", file_name);
		fflush(diagfile);
		}

	procinit();
	if(k = yyparse())
	{
		fprintf(diagfile, "Bad parse, return code %d\n", k);
		done(1);
	}

	commonprotos(protofile);
	if (protofile == stdout && !skipC)
		printf("#endif\n\n");

	if (nerr || skipC)
		goto C_skipped;


/* Write out the declarations which are global to this file */

	if ((c2d = comm2dcl()) == 1)
		nice_printf(c_output, "/*>>>'/dev/null'<<<*/\n\n\
/* Split this into several files by piping it through\n\n\
sed \"s/^\\/\\*>>>'\\(.*\\)'<<<\\*\\/\\$/cat >'\\1' <<'\\/*<<<\\1>>>*\\/'/\" | /bin/sh\n\
 */\n\
/*<<</dev/null>>>*/\n\
/*>>>'%s'<<<*/\n", cdfilename);
	if (gflag)
		nice_printf (c_output, "#line 1 \"%s\"\n", file_name);
	if (!skipversion) {
		nice_printf (c_output, "/* %s -- translated by f2c ", file_name);
		nice_printf (c_output, "(version %s).\n", F2C_version);
		nice_printf (c_output,
	"   You must link the resulting object file with the libraries:\n\
	%s   (in that order)\n*/\n\n", link_msg);
		}
	if (Ansi == 2)
		nice_printf(c_output,
			"#ifdef __cplusplus\nextern \"C\" {\n#endif\n");
	nice_printf (c_output, "%s#include \"f2c.h\"\n\n", def_i2);
	if (gflag)
		nice_printf (c_output, "#line 1 \"%s\"\n", file_name);
	if (Castargs && typedefs)
		write_typedefs(c_output);
	nice_printf (c_file, "\n");
	fclose (c_file);
	c_file = c_output;		/* HACK to get the next indenting
					   to work */
	wr_common_decls (c_output);
	if (blkdfile)
		list_init_data(&blkdfile, blkdfname, c_output);
	wr_globals (c_output);
	if ((c_file = fopen (c_functions, textread)) == (FILE *) NULL)
	    Fatal("main - couldn't reopen c_functions");
	ffilecopy (c_file, c_output);
	if (*main_alias) {
	    nice_printf (c_output, "/* Main program alias */ ");
	    nice_printf (c_output, "int %s () { MAIN__ ();%s }\n",
		    main_alias, Ansi ? " return 0;" : "");
	    }
	if (Ansi == 2)
		nice_printf(c_output,
			"#ifdef __cplusplus\n\t}\n#endif\n");
	if (c2d) {
		if (c2d == 1)
			fprintf(c_output, "/*<<<%s>>>*/\n", cdfilename);
		else
			fclose(c_output);
		def_commons(c_output);
		}
	if (c2d != 2)
		fclose (c_output);

 C_skipped:
	if(parstate != OUTSIDE)
		{
		warn("missing final end statement");
		endproc();
		}
	done(nerr ? 1 : 0);
	/* NOT REACHED */ return 0;
}


 FILEP
#ifdef KR_headers
opf(fn, mode)
	char *fn;
	char *mode;
#else
opf(char *fn, char *mode)
#endif
{
	FILEP fp;
	if( fp = fopen(fn, mode) )
		return(fp);

	fatalstr("cannot open intermediate file %s", fn);
	/* NOT REACHED */ return 0;
}


 void
#ifdef KR_headers
clf(p, what, quit)
	FILEP *p;
	char *what;
	int quit;
#else
clf(FILEP *p, char *what, int quit)
#endif
{
	if(p!=NULL && *p!=NULL && *p!=stdout)
	{
		if(ferror(*p)) {
			fprintf(stderr, "I/O error on %s\n", what);
			if (quit)
				done(3);
			retcode = 3;
			}
		fclose(*p);
	}
	*p = NULL;
}


 void
#ifdef KR_headers
done(k)
	int k;
#else
done(int k)
#endif
{
	clf(&initfile, "initfile", 0);
	clf(&c_file, "c_file", 0);
	clf(&pass1_file, "pass1_file", 0);
	Un_link_all(k);
	exit(k|retcode);
}