vif.c
1 //! @file vif.c
2 //! @author J. Marcel van der Veer
3 //
4 //! @section Copyright
5 //
6 // This file is part of VIF - vintage FORTRAN compiler.
7 // Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
8 //
9 //! @section License
10 //
11 // This program is free software; you can redistribute it and/or modify it
12 // under the terms of the GNU General Public License as published by the
13 // Free Software Foundation; either version 3 of the License, or
14 // (at your option) any later version.
15 //
16 // This program is distributed in the hope that it will be useful, but
17 // WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 // or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 // more details. You should have received a copy of the GNU General Public
20 // License along with this program. If not, see <http://www.gnu.org/licenses/>.
21
22 //! @section Synopsis
23 //!
24 //! VIF driver.
25
26 #include <vif.h>
27
28 int_4 MAX_FTN_LINES;
29 FTN_LINE *source, *files;
30
31 int_4 MAX_C_SRC;
32 C_SRC *object;
33
34 IDENT globals[MAX_IDENTS];
35 IDENT locals[MAX_IDENTS];
36 char *commons[MAX_COMMONS];
37 IMPLICIT implic[26];
38 LBL labels[MAX_LABELS];
39
40 int_4 strlens[MAX_STRLENS];
41
42 int_4 curlin = 1, curcol = START_OF_LINE;
43 int_4 curret, preret;
44 int_4 end_statements;
45 int_4 func;
46 int_4 indent = 0;
47 int_4 line = 0;
48 int_4 ncommons = 2; // 0 means local, 1 external
49 int_4 n_c_src = 0;
50 int_4 nfiles = 0;
51 int_4 nftnlines = 1;
52 int_4 nglobals = 0;
53 int_4 nglobtmps = 0;
54 int_4 nlabels = 0;
55 int_4 nlocals = 0;
56 int_4 nloctmps = 0;
57 int_4 optimise = 0;
58 int_4 page = 0;
59 int_4 pcalls = 0;
60 int_4 pnprocs = -1, nprocs = 0;
61 int_4 prelin, precol;
62
63 logical_4 abend = FALSE;
64 logical_4 compile_only = FALSE;
65 logical_4 f4_do_loops = FALSE;
66 logical_4 frequency = FALSE;
67 logical_4 gcc_ftn_lines = TRUE;
68 logical_4 hollerith = FALSE;
69 logical_4 implicit_r8 = FALSE;
70 logical_4 keep = FALSE;
71 logical_4 load_go_erase = FALSE;
72 logical_4 load_go = FALSE;
73 logical_4 new_libnam = FALSE;
74 logical_4 new_object = FALSE;
75 logical_4 no_warnings = FALSE;
76 logical_4 pretty = FALSE;
77 logical_4 quiet_mode = FALSE;
78 logical_4 renum = FALSE;
79 logical_4 syntax_only = FALSE;
80 logical_4 trace = FALSE;
81 logical_4 use_strcasecmp = FALSE;
82
83 RECORD hdate;
84 RECORD hmodule, hsection;
85 RECORD libnam, modnam, procnam;
86 RECORD object_name;
87 RECORD oflags;
88 RECORD prelex, curlex, retnam;
89 RECORD program, block;
90 RECORD stat_start;
91
92 logical_4 reserved (char *lex)
93 {
94 static char *words[] = {
95 "accept", "assign", "automatic", "backspace", "call", "character",
96 "close", "common", "complex", "continue", "decode", "dimension", "data",
97 "do", "double", "else", "elseif", "encode", "end", "enddo", "endfile",
98 "endif", "entry", "external", "format", "function", "go", "goto",
99 "if", "implicit", "integer", "intrinsic", "logical", "open",
100 "pause", "precision", "print", "program", "punch", "read", "real",
101 "repeat", "return", "rewind", "save", "subroutine", "stop", "then",
102 "to", "until", "while", "write", NO_TEXT
103 };
104 //
105 for (char **sym = words; *sym != NO_TEXT; sym++) {
106 if (EQUAL (*sym, lex)) {
107 return TRUE;
108 }
109 }
110 return FALSE;
111 }
112
113 logical_4 is_int4 (char *s, int_4 *val)
114 {
115 // Is 's' an integer denotation, and what is its value?
116 char *end;
117 int_4 k = strtol (s, &end, 10);
118 int_4 rc = (end != NO_TEXT && end[0] == '\0');
119 if (val != NO_REF_INTEGER && rc) {
120 *val = k;
121 }
122 return rc;
123 }
124
125 char *date (void)
126 {
127 time_t t;
128 struct tm *info;
129 t = time ((time_t *) NULL);
130 info = localtime (&t);
131 strftime (hdate, RECLN, "%a %d-%b-%Y %H:%M:%S", info);
132 return hdate;
133 }
134
135 char *tod (void)
136 {
137 static RECORD str;
138 time_t t;
139 struct tm *info;
140 t = time ((time_t *) NULL);
141 info = localtime (&t);
142 strftime (str, RECLN, "%H:%M:%S", info);
143 return str;
144 }
145
146 void prelude (int_4 argc, char **argv, char *project)
147 {
148 {
149 NEW_RECORD (usr);
150 if (getlogin_r (usr, RECLN) == 0) {
151 code (0, HEADER, newpage (usr, basename (project)));
152 } else {
153 code (0, HEADER, newpage (VERSION, project));
154 }
155 code (0, HEADER, "\n");
156 if (getlogin_r (usr, RECLN) == 0) {
157 banner (0, BANNER, _strupper (usr));
158 code (0, BANNER, "\n");
159 }
160 banner (0, BANNER, _strupper (basename (project)));
161 code (0, BANNER, "\n");
162 }
163 code (0, CONSTANTS, newpage ("global-scope", "definitions"));
164 NEW_RECORD (str);
165 code (0, CONSTANTS, "/*\nGenerated by VIF - experimental VIntage Fortran compiler.\n");
166 _srecordf (str, "VIF release %s\n*/\n\n", VERSION);
167 code (0, CONSTANTS, str);
168
169 code (0, CONSTANTS, "#include <vif.h>\n");
170 code (0, CONSTANTS, "\n");
171 code (0, CONSTANTS, "static int_4 _km1 = -1, _k0 = 0, _k1 = 1;\n");
172 code (0, CONSTANTS, "\n");
173 code (0, COMMON, "\n");
174 code (0, MESSAGES, newpage ("global-scope", "diagnostics"));
175 code (0, JCL, newpage ("global-scope", "job-control"));
176 code (0, TYPEDEF, newpage ("global-scope", "typedefs"));
177 code (0, TYPEDEF, "static FORMAT *__fmt_a = NULL;\n");
178 code (0, PROTOTYPE, newpage ("global-scope", "prototypes"));
179 code (0, FREQ, newpage ("global-scope", "frequency-table"));
180 code (0, FREQ, "#define __ncalls ");
181 pcalls = code (0, FREQ, NO_TEXT);
182 code (0, FREQ, "\n");
183 code (0, FREQ, "static CALLS __calls[__ncalls] = {\n");
184 }
185
186 void postlude (void)
187 {
188 NEW_RECORD (str);
189 code (0, PROTOTYPE, "\n");
190 code (0, FREQ, " {NULL , 0}\n");
191 _srecordf (str, "%d", nprocs + 1);
192 patch (pcalls, str);
193 code (0, FREQ, "};\n");
194 // Write the common blocks.
195 if (ncommons > EXTERN) {
196 code (0, COMMON, newpage ("global-scope", "common-blocks"));
197 code_common ();
198 }
199 // Define character array types encountered.
200 for (int k = 0, len = 2; k < MAX_STRLENS; k++, len *= 2) {
201 if (strlens[k]) {
202 _srecordf (str, "typedef char char_%d[%d];\n", len - 1, len);
203 code (0, TYPEDEF, str);
204 }
205 }
206 // Add an entry procedure.
207 if (! compile_only) {
208 nprocs++;
209 code (nprocs, BODY, newpage ("global-scope", "entry-point"));
210 code (nprocs, BODY, "// Global entry point.\n");
211 code (nprocs, BODY, "int_4 main (int_4 argc, char **argv)\n");
212 code (nprocs, BODY, "{\n");
213 code (nprocs, BODY, "_vif_init ();\n");
214 code (nprocs, BODY, "_ffile[0] = NEW_FTN_FILE (NULL, form_formatted, action_readwrite, 0);\n");
215 for (int k = 0; k < MAX_FILES; k++) {
216 if (_ffile[k].in_stream) {
217 _srecordf (str, "_ffile[%d].in_stream = TRUE;\n", k);
218 code (nprocs, BODY, str);
219 _srecordf (str, "_ffile[%d].action = action_read;\n", k);
220 code (nprocs, BODY, str);
221 _srecordf (str, "_ffile[%d].buff = _ffile[%d].rewind = f_stralloc (%s);\n", k, k, _ffile[k].name);
222 code (nprocs, BODY, str);
223 }
224 }
225 // SYSIN
226 if (! (_ffile[STDF_IN].in_stream || _ffile[STDF_IN].redirect)) {
227 _srecordf (str, "_ffile[%d] = NEW_FTN_FILE (stdin, form_formatted, action_read, MAX_LRECL);\n", STDF_IN);
228 code (nprocs, BODY, str);
229 _srecordf (str, "_ffile[%d].buff = (char *) f_malloc (MAX_LRECL + 1);\n", STDF_IN);
230 code (nprocs, BODY, str);
231 }
232 //SYSOUT
233 if (_ffile[STDF_OUT].in_stream) {
234 ERROR (3401, "standard output", "JCL in-stream is read only");
235 } else if (! _ffile[STDF_OUT].redirect) {
236 _srecordf (str, "_ffile[%d] = NEW_FTN_FILE (stdout, form_formatted, action_write, 0);\n", STDF_OUT);
237 code (nprocs, BODY, str);
238 }
239 //SYSPUNCH
240 #if STDF_OUT != STDF_PUN
241 if (_ffile[STDF_PUN].in_stream) {
242 ERROR (3402, "standard punch", "JCL in-stream is read only");
243 } else if (! _ffile[STDF_PUN].redirect) {
244 _srecordf (str, "_ffile[%d] = NEW_FTN_FILE (stdout, form_formatted, action_write, 0);\n", STDF_PUN);
245 code (nprocs, BODY, str);
246 }
247 #endif
248 // SYSERR
249 if (_ffile[STDF_ERR].in_stream) {
250 ERROR (3403, "standard error", "JCL in-stream is read only");
251 } else if (! _ffile[STDF_ERR].redirect) {
252 _srecordf (str, "_ffile[%d] = NEW_FTN_FILE (stdout, form_formatted, action_write, 0);\n", STDF_ERR);
253 code (nprocs, BODY, str);
254 }
255 //
256 if (strlen (block) > 0) {
257 NEW_RECORD (call);
258 _srecordf (call, "%s (); // Block data.\n", block);
259 code (nprocs, BODY, call);
260 }
261 if (strlen (program) > 0) {
262 NEW_RECORD (call);
263 _srecordf (call, "%s (); // Fortran entry point.\n", program);
264 code (nprocs, BODY, call);
265 }
266 if (frequency) {
267 code (nprocs, BODY, "_vif_freq (__calls);");
268 }
269 code (nprocs, BODY, "_vif_exit ();\n");
270 code (nprocs, BODY, "return EXIT_SUCCESS;\n");
271 code (nprocs, BODY, "}\n");
272 }
273 }
274
275 static void usage (void)
276 {
277 printf ("Usage: %s [-O][-f][-g][-k][-p][-v] file [, file, ...]\n", PACKAGE);
278 printf ("\n");
279 printf (" -c : Compile as a library.\n");
280 printf (" -d : FORTRAN IV style do loops.\n");
281 printf (" -f : Generate a call frequency table.\n");
282 printf (" -g : Execute upon successful compilation.\n");
283 printf (" -k : Backend compiler reports diagnostics at object code line.\n");
284 printf (" -l : Generate a verbose listing file.\n");
285 printf (" -o name: sets name for object file to `name.c' and for executable to `name'.\n");
286 printf (" -p : Keep the generated code upon successful compilation in pdf format.\n");
287 printf (" -q : Quiet mode.\n");
288 printf (" -r : Renumber FORTRAN source code.\n");
289 printf (" -s : Check syntax only.\n");
290 printf (" -t : Trace mode.\n");
291 printf (" -v : Print the version and exit.\n");
292 printf (" -w : Suppress warning diagnostics.\n");
293 printf (" -W : Set default REAL length to 8 and default COMPLEX length to 16.\n");
294 printf (" -O0 : Do not optimize the object code.\n");
295 printf (" -O : Optimize the object code.\n");
296 printf (" -O1 : Optimize the object code.\n");
297 printf (" -O2 : Optimize the object code.\n");
298 printf (" -O3 : Optimize the object code.\n");
299 printf (" -Of : Optimize the object code.\n");
300 }
301
302 void version (void)
303 {
304 printf ("VIF %s - experimental VIntage Fortran compiler.\n", VERSION);
305 printf ("Copyright 2020-2025 J.M. van der Veer.\n\n");
306 printf ("Backend compiler : %s\n", BACKEND);
307 printf ("Install directory: %s\n\n", LOCDIR);
308 printf ("This is free software covered by the GNU General Public License.\n");
309 printf ("There is ABSOLUTELY NO WARRANTY for VIF;\n");
310 printf ("not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n");
311 printf ("See the GNU General Public License for more details.\n");
312 }
313
314 #define OPTION(s) EQUAL (opt, (s))
315
316 void option (char *opt)
317 {
318 if (OPTION ("--frequency")) {
319 frequency = TRUE;
320 } else if (OPTION ("--go")) {
321 load_go = TRUE;
322 } else if (OPTION ("--keep")) {
323 keep = TRUE;
324 } else if (OPTION ("--lib")) {
325 new_libnam = TRUE;
326 } else if (OPTION ("--pdf")) {
327 keep = TRUE;
328 pretty = TRUE;
329 } else if (OPTION ("--f4-do-loops")) {
330 f4_do_loops = TRUE;
331 } else if (OPTION ("--renumber")) {
332 renum = TRUE;
333 } else if (OPTION ("--hollerith")) {
334 hollerith = TRUE;
335 } else if (OPTION ("--license")) {
336 version ();
337 exit (EXIT_SUCCESS);
338 } else if (OPTION ("--version")) {
339 version ();
340 exit (EXIT_SUCCESS);
341 } else if (opt[1] == '-' && opt[2] == '\0') {
342 return;
343 } else for (int_4 k = 1; opt[k] != '\0'; k++) {
344 if (opt[k] == 'O') {
345 optimise = 0;
346 if (opt[k + 1] == '0') {
347 _srecordf(oflags, "%s", "-O0 -ggdb");
348 k++;
349 } else if (opt[k + 1] == '1') {
350 _srecordf(oflags, "%s", "-O1");
351 optimise = 1;
352 k++;
353 } else if (opt[k + 1] == '2') {
354 _srecordf(oflags, "%s", "-O2");
355 optimise = 2;
356 k++;
357 } else if (opt[k + 1] == '3') {
358 _srecordf(oflags, "%s", "-funroll-all-loops -O3");
359 optimise = 3;
360 k++;
361 } else if (opt[k + 1] == 'f') {
362 _srecordf(oflags, "%s", "-Ofast");
363 optimise = 4;
364 k++;
365 } else {
366 _srecordf(oflags, "%s", "-O");
367 optimise = 1;
368 }
369 } else if (opt[k] == 'c') {
370 compile_only = TRUE;
371 } else if (opt[k] == 'd') {
372 f4_do_loops = TRUE;
373 } else if (opt[k] == 'f') {
374 frequency = TRUE;
375 } else if (opt[k] == 'g') {
376 load_go = TRUE;
377 } else if (opt[k] == 'k') {
378 gcc_ftn_lines = FALSE;
379 } else if (opt[k] == 'l') {
380 keep = TRUE;
381 } else if (opt[k] == 'o') {
382 new_object = TRUE;
383 } else if (opt[k] == 'p') {
384 keep = TRUE;
385 pretty = TRUE;
386 } else if (opt[k] == 'q') {
387 quiet_mode = TRUE;
388 } else if (opt[k] == 'r') {
389 renum = TRUE;
390 } else if (opt[k] == 's') {
391 syntax_only = TRUE;
392 } else if (opt[k] == 't') {
393 trace = TRUE;
394 } else if (opt[k] == 'u') {
395 use_strcasecmp = TRUE;
396 } else if (opt[k] == 'v') {
397 version ();
398 exit (EXIT_SUCCESS);
399 } else if (opt[k] == 'w') {
400 no_warnings = TRUE;
401 } else if (opt[k] == 'W') {
402 implicit_r8 = TRUE;
403 } else if (opt[k] == 'x') {
404 load_go = TRUE;
405 load_go_erase = TRUE;
406 } else {
407 usage ();
408 exit (EXIT_FAILURE);
409 }
410 }
411 }
412
413 #undef OPTION
414
415 static void post_edit (char *c_file)
416 {
417 NEW_RECORD (cmd);
418 NEW_RECORD (tmp);
419 _srecordf (tmp, "%s~", c_file);
420 _sys (cmd, "sed", NO_TEXT, "-i '/^\\/\\//d' %s", c_file);
421 _sys (cmd, "sed", NO_TEXT, "-i 's/^\\f//' %s", c_file);
422 // _sys (cmd, "sed", NO_TEXT, "-i '/^# line /d' %s", c_file);
423 _sys (cmd, "sed", NO_TEXT, "-i '/^[[:space:]]*$/d' %s", c_file);
424 if (nerrors == 0) {
425 _sys (cmd, "indent", NO_TEXT, "%s -l500 -br -ce -cdw -nfca -npsl -nut -i2 -nbad -cs -pcs -sob", c_file);
426 _sys (cmd, "sed", NO_TEXT, "-i 's/\\(\\.[0-9][0-9]*\\) q/\\1q/' %s", c_file);
427 // _sys (cmd, "fold", NO_TEXT, "-w 100 -s %s > %s", c_file, tmp);
428 _sys (cmd, "mv", NO_TEXT, "%s %s", tmp, c_file);
429 }
430 _sys (cmd, "rm", NO_TEXT, "-f %s", tmp);
431 }
432
433 int_4 main (int_4 argc, char **argv)
434 {
435 int_4 rc = EXIT_SUCCESS, start = 1;
436 NEW_RECORD (c_file);
437 NEW_RECORD (lst_file);
438 NEW_RECORD (cmd);
439 //
440 MAX_FTN_LINES = INCREMENT;
441 MAX_C_SRC = INCREMENT;
442 source = (FTN_LINE *) f_malloc (MAX_FTN_LINES * sizeof (FTN_LINE));
443 object = (C_SRC *) f_malloc (MAX_C_SRC * sizeof (C_SRC));
444 files = (FTN_LINE *) f_malloc (MAX_SOURCE_FILES * sizeof (FTN_LINE));
445 memset (_ffile, 0, sizeof (_ffile));
446 // Options
447 f4_do_loops = FALSE;
448 new_libnam = FALSE;
449 new_object = FALSE;
450 oflags[0] = '\0';
451 RECCLR (libnam);
452 RECCLR (object_name);
453 while (argv[start] != NO_TEXT && argv[start][0] == '-') {
454 option (argv[start]);
455 start++;
456 if (new_libnam) {
457 new_libnam = FALSE;
458 if (strlen (libnam) == 0 && argv[start] != NO_TEXT) {
459 RECCPY (libnam, argv[start]);
460 start++;
461 } else {
462 usage ();
463 exit (EXIT_FAILURE);
464 }
465 } else if (new_object) {
466 new_object = FALSE;
467 if (strlen (object_name) == 0 && argv[start] != NO_TEXT) {
468 RECCPY (object_name, argv[start]);
469 start++;
470 } else {
471 usage ();
472 exit (EXIT_FAILURE);
473 }
474 }
475 }
476 if (argv[start] == NO_TEXT) {
477 usage ();
478 exit (EXIT_FAILURE);
479 }
480 RECCLR (program);
481 RECCLR (block);
482 RECCLR (curlex);
483 RECCLR (prelex);
484 for (int_4 k = 0; k < MAX_STRLENS; k++) {
485 strlens[k] = FALSE;
486 }
487 date ();
488 RECCPY (hmodule, "global-scope");
489 RECCPY (hsection, "global-section");
490 // Import all sources.
491 NEW_RECORD (argv_start);
492 _srecordf (argv_start, argv[start]);
493 for (int k = start; k < argc; k++) {
494 get_source (f_stralloc (argv[k]), 0);
495 }
496 // Name for project derives from first source file.
497 if (strlen (libnam) == 0) {
498 if (new_object) {
499 RECCPY (libnam, object_name);
500 } else {
501 RECCPY (libnam, argv_start);
502 }
503 for (int k = (int_4) strlen (libnam); k >= 0; k--) {
504 if (libnam[k] == '.') {
505 libnam[k] = '\0';
506 break;
507 }
508 }
509 }
510 // Fill in what we know at the start.
511 prelude (argc, argv, libnam);
512 // Compile all subprograms.
513 nmodules = 0;
514 curlin = 1;
515 curcol = START_OF_LINE;
516 jcllin = 0;
517 scan_modules ();
518 curlin = 1;
519 curcol = START_OF_LINE;
520 macro_nest = 0;
521 lhs_factor = FALSE;
522 subprograms ();
523 // Fill in what we know afterwards, and write C source.
524 postlude ();
525 // Remove stale files.
526 RECCLR (c_file);
527 _srecordf (c_file, "%s.c", libnam);
528 _srecordf (lst_file, "%s.l", libnam);
529 //
530 write_object (c_file);
531 // Compile intermediate code.
532 if (syntax_only) {
533 NEW_RECORD (str);
534 _srecordf (str, "** linker ** no object file generated");
535 diagnostic (0, str);
536 if (nerrors == 0) {
537 rc = EXIT_SUCCESS;
538 } else {
539 rc = EXIT_FAILURE;
540 }
541 } else if (renum) {
542 NEW_RECORD (str);
543 if (nerrors == 0) {
544 int_4 Nf = 0;
545 // Renumber source files.
546 for (int k = start; k < argc; k++, Nf++) {
547 relabel (f_stralloc (argv[k]));
548 }
549 if (Nf == 1) {
550 _srecordf (str, "** statistics ** 1 fortran file renumbered");
551 } else {
552 _srecordf (str, "** statistics ** %d fortran files renumbered", Nf);
553 rc = EXIT_SUCCESS;
554 }
555 } else {
556 _srecordf (str, "** statistics ** no fortran files renumbered");
557 rc = EXIT_FAILURE;
558 }
559 diagnostic (0, str);
560 } else if (nerrors != 0) {
561 NEW_RECORD (str);
562 nerrors++;
563 _srecordf (str, "** linker ** no object file generated");
564 diagnostic (0, str);
565 rc = EXIT_FAILURE;
566 } else {
567 NEW_RECORD (str);
568 if (compile_only) {
569 if (optimise > 0) {
570 rc = _sys (cmd, BACKEND, NO_TEXT, "%s %s -c %s.c -o %s.o", oflags, CFLAGS, libnam, libnam);
571 } else {
572 rc = _sys (cmd, BACKEND, NO_TEXT, "-O0 -ggdb %s -c %s.c -o %s.o", CFLAGS, libnam, libnam);
573 }
574 } else {
575 if (optimise > 0) {
576 #if defined (BOOTSTRAP)
577 rc = _sys (cmd, BACKEND, NO_TEXT, "%s %s %s.c -o %s %s", oflags, CFLAGS, libnam, libnam, LD_FLAGS);
578 #else
579 rc = _sys (cmd, BACKEND, NO_TEXT, "%s %s %s.c -o %s -L%s %s", oflags, CFLAGS, libnam, libnam, LOCDIR, LD_FLAGS);
580 #endif
581 } else {
582 #if defined (BOOTSTRAP)
583 rc = _sys (cmd, BACKEND, NO_TEXT, "-O0 -ggdb %s %s.c -o %s %s", CFLAGS, libnam, libnam, LD_FLAGS);
584 #else
585 rc = _sys (cmd, BACKEND, NO_TEXT, "-O0 -ggdb %s %s.c -o %s -L%s %s", CFLAGS, libnam, libnam, LOCDIR, LD_FLAGS);
586 #endif
587 }
588 }
589 if (rc == EXIT_SUCCESS) {
590 struct stat s;
591 if (compile_only) {
592 NEW_RECORD (obj);
593 _srecordf (obj, "%s.o", libnam);
594 stat (obj, &s);
595 } else {
596 stat (libnam, &s);
597 }
598 _srecordf (str, "** linker ** object size %ld bytes", s.st_size);
599 diagnostic (0, str);
600 } else {
601 nerrors++;
602 _srecordf (str, "** linker ** no object file generated");
603 diagnostic (0, str);
604 rc = EXIT_FAILURE;
605 }
606 _sys (cmd, "cp", NO_TEXT, "%s %s", c_file, lst_file);
607 }
608 // Wrap it up
609 {
610 NEW_RECORD (str);
611 NEW_RECORD (sub);
612 NEW_RECORD (err);
613 NEW_RECORD (war);
614 // if (nprocs > 0 && ! compile_only) {
615 // nprocs--; // discount 'main'
616 // }
617 if (nprocs == 0) {
618 _srecordf (sub, "no subprograms");
619 } else if (nprocs == 1) {
620 _srecordf (sub, "1 subprogram");
621 } else {
622 _srecordf (sub, "%d subprograms", nprocs);
623 }
624 if (nerrors == 0) {
625 _srecordf (err, "no errors");
626 } else if (nerrors == 1) {
627 _srecordf (err, "1 error");
628 } else {
629 _srecordf (err, "%d errors", nerrors);
630 }
631 if (nwarns == 0) {
632 _srecordf (war, "no warnings");
633 } else if (nwarns == 1) {
634 _srecordf (war, "1 warning");
635 } else {
636 _srecordf (war, "%d warnings", nwarns);
637 }
638 _srecordf (str, "** statistics ** %s, %s, %s", sub, err, war);
639 diagnostic (0, str);
640 }
641 // Execution.
642 if (!renum && load_go && nerrors == 0 && ! syntax_only) {
643 fprintf (stderr, "** execution **\n");
644 NEW_RECORD (exec);
645 if (libnam[0] == '/') {
646 _srecordf (exec, "%s", libnam);
647 } else {
648 _srecordf (exec, "./%s", libnam);
649 }
650 rc = _sys (cmd, exec, NO_TEXT, NO_TEXT);
651 if (load_go_erase) {
652 _sys (cmd, "rm", NO_TEXT, "-f ./%s", exec);
653 }
654 }
655 // Write C source again with post-compile information.
656 remove (c_file);
657 write_object (c_file);
658 _sys (cmd, "cp", NO_TEXT, "%s %s", c_file, lst_file);
659 post_edit (c_file);
660 // Pretty listing file as PDF.
661 if (keep && pretty) {
662 NEW_RECORD (tmp);
663 _srecordf (tmp, "./.vif_pdf");
664 _sys (cmd, "enscript", "ps2pdf", "--quiet --font=Courier-Bold@9 -l -H1 -r --margins=25:25:40:40 -p - %s > %s", c_file, tmp);
665 _sys (cmd, "ps2pdf", "enscript", "%s %s.pdf", tmp, libnam);
666 _sys (cmd, "rm", NO_TEXT, "-f %s", tmp);
667 }
668 if (!keep) {
669 _sys (cmd, "rm", NO_TEXT, "-f %s.s", libnam);
670 }
671 // Exeunt.
672 exit (rc);
673 }
|
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|
