//! @file vif.c
//! @author J. Marcel van der Veer
//
//! @section Copyright
//
// This file is part of VIF - vintage FORTRAN compiler.
// Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
//
//! @section License
//
// This program is free software; you can redistribute it and/or modify it 
// under the terms of the GNU General Public License as published by the 
// Free Software Foundation; either version 3 of the License, or 
// (at your option) any later version.
//
// This program is distributed in the hope that it will be useful, but 
// WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
// or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
// more details. You should have received a copy of the GNU General Public 
// License along with this program. If not, see <http://www.gnu.org/licenses/>.

//! @section Synopsis
//!
//! VIF driver.

#include <vif.h>

int_4 MAX_FTN_LINES;
FTN_LINE *source, *files;

int_4 MAX_C_SRC;
C_SRC *object;

IDENT globals[MAX_IDENTS];
IDENT locals[MAX_IDENTS];
char *commons[MAX_COMMONS];
IMPLICIT implic[26];
LBL labels[MAX_LABELS];

int_4 strlens[MAX_STRLENS];

int_4 curlin = 1, curcol = START_OF_LINE;
int_4 curret, preret;
int_4 end_statements;
int_4 func;
int_4 indent = 0;
int_4 line = 0;
int_4 ncommons = 2;               // 0 means local, 1 external
int_4 n_c_src = 0;
int_4 nfiles = 0;
int_4 nftnlines = 1;
int_4 nglobals = 0;
int_4 nglobtmps = 0;
int_4 nlabels = 0;
int_4 nlocals = 0;
int_4 nloctmps = 0;
int_4 optimise = 0; 
int_4 page = 0;
int_4 pcalls = 0;
int_4 pnprocs = -1, nprocs = 0;
int_4 prelin, precol;

logical_4 abend = FALSE;
logical_4 compile_only = FALSE;
logical_4 f4_do_loops = FALSE;
logical_4 frequency = FALSE;
logical_4 gcc_ftn_lines = TRUE;
logical_4 hollerith = FALSE;
logical_4 implicit_r8 = FALSE;
logical_4 keep = FALSE;
logical_4 load_go_erase = FALSE;
logical_4 load_go = FALSE;
logical_4 new_libnam = FALSE;
logical_4 new_object = FALSE;
logical_4 no_warnings = FALSE;
logical_4 pretty = FALSE;
logical_4 quiet_mode = FALSE;
logical_4 renum = FALSE;
logical_4 tidy = FALSE;
logical_4 syntax_only = FALSE;
logical_4 trace = FALSE;
logical_4 use_strcasecmp = FALSE;

RECORD hdate;
RECORD hmodule, hsection;
RECORD libnam, modnam, procnam;
RECORD object_name;
RECORD oflags;
RECORD prelex, curlex, retnam;
RECORD program, block;
RECORD stat_start;

logical_4 reserved (char *lex)
{
  static char *words[] = {
    "accept", "assign", "automatic", "backspace", "call", "character",
    "close", "common", "complex", "continue", "decode", "dimension", "data", 
    "do", "double", "else", "elseif", "encode", "end", "enddo", "endfile", 
    "endif", "entry", "external", "format", "function", "go", "goto",
    "if", "implicit", "integer", "intrinsic", "logical", "open",
    "pause", "precision", "print", "program", "punch", "read", "real",
    "repeat", "return", "rewind", "save", "subroutine", "stop", "then",
    "to", "until", "while", "write", NO_TEXT
  };
  for (char **sym = words; *sym != NO_TEXT; sym++) {
    if (EQUAL (*sym, lex)) {
      return TRUE;
    }
  }
  return FALSE;
}

logical_4 is_int4 (char *s, int_4 *val)
{
// Is 's' an integer denotation, and what is its value?
  char *end;
  int_4 k = strtol (s, &end, 10);
  int_4 rc = (end != NO_TEXT && end[0] == '\0');
  if (val != NO_REF_INTEGER && rc) {
    *val = k;
  }
  return rc;
}

char *date (void)
{
  time_t t;
  struct tm *info;
  t = time ((time_t *) NULL);
  info = localtime (&t);
  strftime (hdate, RECLN, "%a %d-%b-%Y %H:%M:%S", info);
  return hdate;
}

char *date_fn (void)
{
  time_t t;
  struct tm *info;
  t = time ((time_t *) NULL);
  info = localtime (&t);
  strftime (hdate, RECLN, "%Y-%m-%d-%H-%M-%S", info);
  return hdate;
}

char *tod (void)
{
  static RECORD str;
  time_t t;
  struct tm *info;
  t = time ((time_t *) NULL);
  info = localtime (&t);
  strftime (str, RECLN, "%H:%M:%S", info);
  return str;
}

void prelude (int_4 argc, char **argv, char *project)
{
  {
    NEW_RECORD (usr);
    if (getlogin_r (usr, RECLN) == 0) {
      code (0, HEADER, newpage (usr, basename (project)));
    } else {
      code (0, HEADER, newpage (VERSION, project));
    }
    code (0, HEADER, "\n");
    if (getlogin_r (usr, RECLN) == 0) {
      banner (0, BANNER, _strupper (usr));
      code (0, BANNER, "\n");
    }
    banner (0, BANNER, _strupper (basename (project)));
    code (0, BANNER, "\n");
  }
  code (0, CONSTANTS, newpage ("global-scope", "definitions"));
  NEW_RECORD (str);
  code (0, CONSTANTS, "/*\nGenerated by VIF - experimental VIntage Fortran compiler.\n");
  _srecordf (str, "VIF release %s\n*/\n\n", VERSION);
  code (0, CONSTANTS, str);

  code (0, CONSTANTS, "#include <vif.h>\n");
  code (0, CONSTANTS, "\n");
  code (0, CONSTANTS, "static int_4 _km1 = -1, _k0 = 0, _k1 = 1;\n");
  code (0, CONSTANTS, "\n");
  code (0, COMMON, "\n");
  code (0, MESSAGES, newpage ("global-scope", "diagnostics"));
  code (0, JCL, newpage ("global-scope", "job-control"));
  code (0, TYPEDEF, newpage ("global-scope", "typedefs"));
  code (0, TYPEDEF, "static FORMAT *__fmt_a = NULL;\n");
  code (0, PROTOTYPE, newpage ("global-scope", "prototypes"));
  code (0, FREQ, newpage ("global-scope", "frequency-table"));
  code (0, FREQ, "#define __ncalls ");
  pcalls = code (0, FREQ, NO_TEXT);
  code (0, FREQ, "\n");
  code (0, FREQ, "static CALLS __calls[__ncalls] = {\n");
}

void postlude (void)
{
  NEW_RECORD (str);
  code (0, PROTOTYPE, "\n");
  code (0, FREQ, "  {NULL , 0}\n");
  _srecordf (str, "%d", nprocs + 1);
  patch (pcalls, str);
  code (0, FREQ, "};\n");
// Write the common blocks.
  if (ncommons > EXTERN) {
    code (0, COMMON, newpage ("global-scope", "common-blocks"));
    code_common ();
  }
// Define character array types encountered.
  for (int k = 0, len = 2; k < MAX_STRLENS; k++, len *= 2) {
    if (strlens[k]) {
      _srecordf (str, "typedef char char_%d[%d];\n", len - 1, len);
      code (0, TYPEDEF, str);
    }
  }
// Add an entry procedure.
  if (! compile_only) {
    nprocs++;
    code (nprocs, BODY, newpage ("global-scope", "entry-point"));
    code (nprocs, BODY, "// Global entry point.\n");
    code (nprocs, BODY, "int_4 main (int_4 argc, char **argv)\n");
    code (nprocs, BODY, "{\n");
    code (nprocs, BODY, "_vif_init ();\n");
    code (nprocs, BODY, "_ffile[0] = NEW_FTN_FILE (NULL, form_formatted, action_readwrite, 0);\n");
    for (int k = 0; k < MAX_FILES; k++) {
      if (_ffile[k].in_stream) {
        _srecordf (str, "_ffile[%d].in_stream = TRUE;\n", k);
        code (nprocs, BODY, str);
        _srecordf (str, "_ffile[%d].action = action_read;\n", k);
        code (nprocs, BODY, str);
        _srecordf (str, "_ffile[%d].buff = _ffile[%d].rewind = f_stralloc (%s);\n", k, k, _ffile[k].name);
        code (nprocs, BODY, str);
      }
    }
// SYSIN
    if (! (_ffile[STDF_IN].in_stream || _ffile[STDF_IN].redirect)) {
      _srecordf (str, "_ffile[%d] = NEW_FTN_FILE (stdin, form_formatted, action_read, MAX_LRECL);\n", STDF_IN);
      code (nprocs, BODY, str);
      _srecordf (str, "_ffile[%d].buff = (char *) f_malloc (MAX_LRECL + 1);\n", STDF_IN);
      code (nprocs, BODY, str);
    }
//SYSOUT
    if (_ffile[STDF_OUT].in_stream) {
      ERROR (3501, "standard output", "JCL in-stream is read only");
    } else if (! _ffile[STDF_OUT].redirect) {
      _srecordf (str, "_ffile[%d] = NEW_FTN_FILE (stdout, form_formatted, action_write, 0);\n", STDF_OUT);
      code (nprocs, BODY, str);
    }
//SYSPUNCH
#if STDF_OUT != STDF_PUN
    if (_ffile[STDF_PUN].in_stream) {
      ERROR (3502, "standard punch", "JCL in-stream is read only");
    } else if (! _ffile[STDF_PUN].redirect) {
      _srecordf (str, "_ffile[%d] = NEW_FTN_FILE (stdout, form_formatted, action_write, 0);\n", STDF_PUN);
      code (nprocs, BODY, str);
    }
#endif
// SYSERR
    if (_ffile[STDF_ERR].in_stream) {
      ERROR (3503, "standard error", "JCL in-stream is read only");
    } else if (! _ffile[STDF_ERR].redirect) {
      _srecordf (str, "_ffile[%d] = NEW_FTN_FILE (stdout, form_formatted, action_write, 0);\n", STDF_ERR);
      code (nprocs, BODY, str);
    }
//
    if (strlen (block) > 0) {
      NEW_RECORD (call);
      _srecordf (call, "%s (); // Block data.\n", block);
      code (nprocs, BODY, call);
    }
    if (strlen (program) > 0) {
      NEW_RECORD (call);
      _srecordf (call, "%s (); // Fortran entry point.\n", program);
      code (nprocs, BODY, call);
    }
    if (frequency) {
      code (nprocs, BODY, "_vif_freq (__calls);");
    }
    code (nprocs, BODY, "_vif_exit ();\n");
    code (nprocs, BODY, "return EXIT_SUCCESS;\n");
    code (nprocs, BODY, "}\n");
  }
}

static void usage (void)
{
  printf ("Usage: %s [-O][-f][-g][-k][-p][-v] file [, file, ...]\n", PACKAGE);
  printf ("\n");
  printf ("  -c     : Compile as a library.\n");
  printf ("  -d     : FORTRAN IV style do loops.\n");
  printf ("  -f     : Generate a call frequency table.\n");
  printf ("  -g     : Execute upon successful compilation.\n");
  printf ("  -k     : Backend compiler reports diagnostics at object code line.\n");
  printf ("  -l     : Generate a verbose listing file.\n");
  printf ("  -o name: sets name for object file to `name.c' and for executable to `name'.\n");
  printf ("  -p     : Keep the generated code upon successful compilation in pdf format.\n");
  printf ("  -q     : Quiet mode.\n");
  printf ("  -r     : Renumber FORTRAN source code.\n");
  printf ("  -s     : Check syntax only.\n");
  printf ("  -t     : Trace mode.\n");
  printf ("  -v     : Print the version and exit.\n");
  printf ("  -w     : Suppress warning diagnostics.\n");
  printf ("  -x     : Execute upon successful compilation and erase executable.\n");
  printf ("  -y     : Renumber FORTRAN source code and apply upper stropping.\n");
  printf ("  -z     : Set default REAL length to 8 and default COMPLEX length to 16.\n");
  printf ("  -O0    : Do not optimize the object code.\n");
  printf ("  -O     : Optimize the object code.\n");
  printf ("  -O1    : Optimize the object code.\n");
  printf ("  -O2    : Optimize the object code.\n");
  printf ("  -O3    : Optimize the object code.\n");
  printf ("  -Of    : Optimize the object code.\n");
}

void version (void)
{
  printf ("VIF %s - experimental VIntage Fortran compiler.\n", VERSION);
  printf ("Copyright 2020-2025 J.M. van der Veer.\n\n");
  printf ("Backend compiler : %s\n", BACKEND);
  printf ("Install directory: %s\n\n", LOCDIR);
  printf ("This is free software covered by the GNU General Public License.\n");
  printf ("There is ABSOLUTELY NO WARRANTY for VIF;\n");
  printf ("not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n");
  printf ("See the GNU General Public License for more details.\n");
}

#define OPTION(s) EQUAL (opt, (s))

void option (char *opt)
{
  if (OPTION ("--frequency")) {
    frequency = TRUE;
  } else if (OPTION ("--go")) {
    load_go = TRUE;
  } else if (OPTION ("--keep")) {
    keep = TRUE;
  } else if (OPTION ("--lib")) {
    new_libnam = TRUE;
  } else if (OPTION ("--pdf")) {
    keep = TRUE;
    pretty = TRUE;
  } else if (OPTION ("--f4-do-loops")) {
    f4_do_loops = TRUE;
  } else if (OPTION ("--renumber")) {
    renum = TRUE;
  } else if (OPTION ("--tidy")) {
    renum = TRUE;
    tidy = TRUE;
  } else if (OPTION ("--hollerith")) {
    hollerith = TRUE;
  } else if (OPTION ("--license")) {
    version ();
    exit (EXIT_SUCCESS);
  } else if (OPTION ("--version")) {
    version ();
    exit (EXIT_SUCCESS);
  } else if (opt[1] == '-' && opt[2] == '\0') {
    return;
  } else for (int_4 k = 1; opt[k] != '\0'; k++) {
    if (opt[k] == 'O') {
      optimise = 0;
      if (opt[k + 1] == '0') {
        _srecordf(oflags, "%s", "-O0 -ggdb");
        k++;
      } else if (opt[k + 1] == '1') {
        _srecordf(oflags, "%s", "-O1");
        optimise = 1;
        k++;
      } else if (opt[k + 1] == '2') {
        _srecordf(oflags, "%s", "-O2");
        optimise = 2;
        k++;
      } else if (opt[k + 1] == '3') {
        _srecordf(oflags, "%s", "-funroll-all-loops -O3");
        optimise = 3;
        k++;
      } else if (opt[k + 1] == 'f') {
        _srecordf(oflags, "%s", "-Ofast");
        optimise = 4;
        k++;
      } else {
        _srecordf(oflags, "%s", "-O");
        optimise = 1;
      }
    } else if (opt[k] == 'c') {
      compile_only = TRUE;
    } else if (opt[k] == 'd') {
      f4_do_loops = TRUE;
    } else if (opt[k] == 'f') {
      frequency = TRUE;
    } else if (opt[k] == 'g') {
      load_go = TRUE;
    } else if (opt[k] == 'k') {
      gcc_ftn_lines = FALSE;
    } else if (opt[k] == 'l') {
      keep = TRUE;
    } else if (opt[k] == 'o') {
      new_object = TRUE;
    } else if (opt[k] == 'p') {
      keep = TRUE;
      pretty = TRUE;
    } else if (opt[k] == 'q') {
      quiet_mode = TRUE;
    } else if (opt[k] == 'r') {
      renum = TRUE;
    } else if (opt[k] == 's') {
      syntax_only = TRUE;
    } else if (opt[k] == 't') {
      trace = TRUE;
    } else if (opt[k] == 'u') {
      use_strcasecmp = TRUE;
    } else if (opt[k] == 'v') {
      version ();
      exit (EXIT_SUCCESS);
    } else if (opt[k] == 'w') {
      no_warnings = TRUE;
    } else if (opt[k] == 'x') {
      load_go = TRUE;
      load_go_erase = TRUE;
    } else if (opt[k] == 'y') {
      renum = TRUE;
      tidy = TRUE;
    } else if (opt[k] == 'z') {
      implicit_r8 = TRUE;
    } else {
      usage ();
      exit (EXIT_FAILURE);
    }
  }
}

#undef OPTION

static void post_edit (char *c_file)
{
  NEW_RECORD (cmd);
  NEW_RECORD (tmp);
  _srecordf (tmp, "%s~", c_file);
  _sys (cmd, "sed", NO_TEXT, "-i '/^\\/\\//d' %s", c_file);
  _sys (cmd, "sed", NO_TEXT, "-i 's/^\\f//' %s", c_file);
  // _sys (cmd, "sed", NO_TEXT, "-i '/^# line /d' %s", c_file);
  _sys (cmd, "sed", NO_TEXT, "-i '/^[[:space:]]*$/d' %s", c_file);
  if (nerrors == 0) {
    _sys (cmd, "indent", NO_TEXT, "%s -l500 -br -ce -cdw -nfca -npsl -nut -i2 -nbad -cs -pcs -sob", c_file);
    _sys (cmd, "sed", NO_TEXT, "-i 's/\\(\\.[0-9][0-9]*\\) q/\\1q/' %s", c_file);
    // _sys (cmd, "fold", NO_TEXT, "-w 100 -s %s > %s", c_file, tmp);
    _sys (cmd, "mv", NO_TEXT, "%s %s", tmp, c_file);
    _sys (cmd, "sed", NO_TEXT, "-i 's/^}$/}\\n/' %s", c_file);
    _sys (cmd, "sed", NO_TEXT, "-i 's/^};$/};\\n/' %s", c_file);
  }
  _sys (cmd, "rm", NO_TEXT, "-f %s", tmp);
}

int_4 main (int_4 argc, char **argv)
{
  int_4 rc = EXIT_SUCCESS, start = 1;
  NEW_RECORD (c_file);
  NEW_RECORD (f_file);
  NEW_RECORD (lst_file);
  NEW_RECORD (cmd);
//
  MAX_FTN_LINES = INCREMENT;
  MAX_C_SRC = INCREMENT;
  source = (FTN_LINE *) f_malloc (MAX_FTN_LINES * sizeof (FTN_LINE));
  object = (C_SRC *) f_malloc (MAX_C_SRC * sizeof (C_SRC));
  files = (FTN_LINE *) f_malloc (MAX_SOURCE_FILES * sizeof (FTN_LINE));
  memset (_ffile, 0, sizeof (_ffile));
// Options
  f4_do_loops = FALSE;
  new_libnam = FALSE;
  new_object = FALSE;
  oflags[0] = '\0';
  RECCLR (libnam);
  RECCLR (object_name);
  while (argv[start] != NO_TEXT && argv[start][0] == '-') {
    option (argv[start]);
    start++;
    if (new_libnam) {
      new_libnam = FALSE;
      if (strlen (libnam) == 0 && argv[start] != NO_TEXT) {
        RECCPY (libnam, argv[start]);
        start++;
      } else {
        usage ();
        exit (EXIT_FAILURE);
      }
    } else if (new_object) {
      new_object = FALSE;
      if (strlen (object_name) == 0 && argv[start] != NO_TEXT) {
        RECCPY (object_name, argv[start]);
        start++;
      } else {
        usage ();
        exit (EXIT_FAILURE);
      }
    }
  }
  if (argv[start] == NO_TEXT) {
    usage ();
    exit (EXIT_FAILURE);
  }
  RECCLR (program);
  RECCLR (block);
  RECCLR (curlex);
  RECCLR (prelex);
  for (int_4 k = 0; k < MAX_STRLENS; k++) {
    strlens[k] = FALSE;
  }
  date ();
  RECCPY (hmodule, "global-scope");
  RECCPY (hsection, "global-section");
// Import all sources.
  NEW_RECORD (argv_start);
  _srecordf (argv_start, argv[start]);
  for (int k = start; k < argc; k++) {
    get_source (f_stralloc (argv[k]), 0);
  }
// Name for project derives from first source file.
  if (strlen (libnam) == 0) {
    if (new_object) {
      RECCPY (libnam, object_name);
    } else {
      RECCPY (libnam, argv_start);
    }
    for (int k = (int_4) strlen (libnam); k >= 0; k--) {
      if (libnam[k] == '.') {
        libnam[k] = '\0';
        break;
      }
    }
  }
// Fill in what we know at the start.
  prelude (argc, argv, libnam);
// Compile all subprograms.
  nmodules = 0;
  curlin = 1; 
  curcol = START_OF_LINE;
  jcllin = 0;
  scan_modules ();
  curlin = 1; 
  curcol = START_OF_LINE;
  macro_nest = 0;
  lhs_factor = FALSE;
  subprograms ();
// Fill in what we know afterwards, and write C source.
  postlude ();
// Remove stale files.
  RECCLR (c_file);
  _srecordf (c_file, "%s.c", libnam);
  _srecordf (f_file, "%s.f~", libnam);
  _srecordf (lst_file, "%s.l", libnam);
//
  write_object (c_file);
// Compile intermediate code.
  if (syntax_only) {
    NEW_RECORD (str);
    _srecordf (str, "** linker     ** no object file generated");
    diagnostic (0, str);
    if (nerrors == 0) {
      rc = EXIT_SUCCESS;
    } else {
      rc = EXIT_FAILURE;
    }
  } else if (nerrors != 0) {
    NEW_RECORD (str);
    nerrors++;
    _srecordf (str, "** linker     ** no object file generated");
    diagnostic (0, str);
    rc = EXIT_FAILURE;
  } else {
    NEW_RECORD (str);
    if (compile_only) {
      if (optimise > 0) {
        rc = _sys (cmd, BACKEND, NO_TEXT, "%s %s -c %s.c -o %s.o", oflags, CFLAGS, libnam, libnam);
      } else {
        rc = _sys (cmd, BACKEND, NO_TEXT, "-O0 -ggdb %s -c %s.c -o %s.o", CFLAGS, libnam, libnam);
      }
    } else {
      if (optimise > 0) {
#if defined (BOOTSTRAP)
        rc = _sys (cmd, BACKEND, NO_TEXT, "%s %s %s.c -o %s %s", oflags, CFLAGS, libnam, libnam, LD_FLAGS);
#else
        rc = _sys (cmd, BACKEND, NO_TEXT, "%s %s %s.c -o %s -L%s %s", oflags, CFLAGS, libnam, libnam, LOCDIR, LD_FLAGS);
#endif
      } else {
#if defined (BOOTSTRAP)
        rc = _sys (cmd, BACKEND, NO_TEXT, "-O0 -ggdb %s %s.c -o %s %s", CFLAGS, libnam, libnam, LD_FLAGS);
#else
        rc = _sys (cmd, BACKEND, NO_TEXT, "-O0 -ggdb %s %s.c -o %s -L%s %s", CFLAGS, libnam, libnam, LOCDIR, LD_FLAGS);
#endif
      }
    }
    if (rc == EXIT_SUCCESS) {
      struct stat s;
      if (compile_only) {
        NEW_RECORD (obj);
        _srecordf (obj, "%s.o", libnam);
        stat (obj, &s);
      } else {
        stat (libnam, &s);
      }
      _srecordf (str, "** linker     ** object size %ld bytes", s.st_size);
      diagnostic (0, str);
    } else {
      nerrors++;
      _srecordf (str, "** linker     ** no object file generated");
      diagnostic (0, str);
      rc = EXIT_FAILURE;
    }
    _sys (cmd, "cp", NO_TEXT, "%s %s", c_file, lst_file);
  }
// Wrap it up
  {
    NEW_RECORD (str);
    NEW_RECORD (sub);
    NEW_RECORD (err);
    NEW_RECORD (war);
    // if (nprocs > 0 && ! compile_only) {
    //   nprocs--; // discount 'main'
    // }
    if (nprocs == 0) {
      _srecordf (sub, "no subprograms");
    } else if (nprocs == 1) {
      _srecordf (sub, "1 subprogram");
    } else {
      _srecordf (sub, "%d subprograms", nprocs);
    }
    if (nerrors == 0) {
      _srecordf (err, "no errors");
    } else if (nerrors == 1) {
      _srecordf (err, "1 error");
    } else {
      _srecordf (err, "%d errors", nerrors);
    }
    if (nwarns == 0) {
      _srecordf (war, "no warnings");
    } else if (nwarns == 1) {
      _srecordf (war, "1 warning");
    } else {
      _srecordf (war, "%d warnings", nwarns);
    }
    _srecordf (str, "** statistics ** %s, %s, %s", sub, err, war);
    diagnostic (0, str);
  }
// Execution.
  if (!renum && load_go && nerrors == 0 && ! syntax_only) {
    fprintf (stderr, "** execution  **\n");
    NEW_RECORD (exec);
    if (libnam[0] == '/') {
      _srecordf (exec, "%s | tee %s.%s.%s", libnam, libnam, date_fn (), PACKAGE);
    } else {
      _srecordf (exec, "./%s | tee %s.%s.%s", libnam, libnam, date_fn (), PACKAGE);
    }
    rc = _sys (cmd, exec, NO_TEXT, NO_TEXT);
    if (load_go_erase) {
      _sys (cmd, "rm", NO_TEXT, "-f ./%s", exec);
    }
  }
// Write C source again with post-compile information.
  remove (c_file);
  write_object (c_file);
  _sys (cmd, "cp", NO_TEXT, "%s %s", c_file, lst_file);
  post_edit (c_file);
// Write tidied fortran file.
  if (renum) {
    write_tidy (f_file);
  }
// Pretty listing file as PDF.
  if (keep && pretty) {
    NEW_RECORD (tmp);
    _srecordf (tmp, "./.vif_pdf");
    _sys (cmd, "enscript", "ps2pdf", "--quiet --font=Courier-Bold@9 -l -H1 -r --margins=25:25:40:40 -p - %s > %s", c_file, tmp);
    _sys (cmd, "ps2pdf", "enscript", "%s %s.pdf", tmp, libnam);
    _sys (cmd, "rm", NO_TEXT, "-f %s", tmp);
  }
  if (!keep) {
    _sys (cmd, "rm", NO_TEXT, "-f %s.s", libnam);
  }
// Exeunt.
  exit (rc);
}
