//! @file rts.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
//!
//! Runtime support.

#include <vif.h>
#include <execinfo.h>

static struct timeval start_time;

void _vif_backtr (int_4 signal) 
{
  void *array[10];
  (void) signal;
  fprintf (stderr, "\n** exception  ** f%d: signal %s: generating stack dump\n", 3601, sigabbrev_np (signal));
  size_t size = backtrace(array, 10);
  backtrace_symbols_fd(array, size, STDERR_FILENO);
  exit (EXIT_FAILURE);
}

void *f_malloc (size_t size)
{
  void *p = malloc (size);
  if (p == NULL) {
    OVERFLOW (3602, "f_malloc");
  }
  memset (p, 0, size);
  return p;
}

void *f_realloc (void *q, size_t size)
{
  void *p = realloc (q, size);
  if (p == NULL) {
    OVERFLOW (3603, "f_realloc");
  }
  return p;
}

char *f_stralloc (char *text)
{
  if (text == NO_TEXT) {
    return NO_TEXT;
  } else {
    int_4 len = strlen (text) + 1;
    char *new = (char *) f_malloc (len);
    if (new == NO_TEXT) {
      OVERFLOW (3604, "f_stralloc");
    }
    return strcpy (new, text);
  }
}

char *f_strallocat (char *text, char *add)
{
  if (text == NO_TEXT) {
    return f_stralloc (add);
  } else {
    int_4 len = strlen (text) + strlen (add) + 1;
    char *new = (char *) f_malloc (len);
    if (new == NO_TEXT) {
      OVERFLOW (3605, "f_strallocat");
    }
    return strcat (strcpy (new, text), add);
  }
}

char *_strlower (char *s)
{
// We use a circular buffer for collateral calls.
#define BUFS 10
  static int_4 buf = 0;
  static RECORD zb[BUFS];
  if (buf == BUFS) {
    buf = 0;
  }
  char *z = (char *) &zb[buf++];
  strncpy (z, s, RECLN);
  for (int_4 k = 0; k < (int_4) strlen (z); k++) {
    z[k] = tolower (z[k]);
  }
  return z;
#undef BUFS
}

char *_strupper (char *s)
{
// We use a circular buffer for collateral calls.
#define BUFS 10
  static int_4 buf = 0;
  static RECORD zb[BUFS];
  if (buf == BUFS) {
    buf = 0;
  }
  char *z = (char *) &zb[buf++];
  strncpy (z, s, RECLN);
  for (int_4 k = 0; k < (int_4) strlen (z); k++) {
    z[k] = toupper (z[k]);
  }
  return z;
#undef BUFS
}

void RTE (const char *where, const char *text)
{
  fflush (stdout);
  fprintf (stderr, "runtime error");
  if (where != NO_TEXT) {
    fprintf (stderr, ": %s", where);
  }
  if (text != NO_TEXT) {
    fprintf (stderr, ": %s", text);
  }
  if ((where != NO_TEXT || text != NO_TEXT) && errno != 0) {
    fprintf (stderr, ": %s", strerror (errno));
  }
  fprintf (stderr, "\n");
  fflush (stderr);
  _vif_exit ();
  exit (EXIT_FAILURE);
}

void RTW (const char *where, const char *text)
{
  if (where != NO_TEXT) {
    fprintf (stderr, "%s: ", where);
  }
  if (errno == 0) {
    fprintf (stderr, "runtime warning: %s.\n", text);
  } else {
    fprintf (stderr, "runtime warning: %s: %s.\n", text, strerror (errno));
  }
}

void _vif_init (void)
{
  gettimeofday (&start_time, (struct timezone *) NULL);
  // signal (SIGSEGV, _vif_backtr);
  for (int_4 k = 0; k < MAX_FILES; k++) {
    _ffile[k] = (FTNFILE) {
      .unit = NO_FILE,
      .name = NO_TEXT,
      .form = NO_TEXT,
      .action = NO_TEXT,
      .disp = NO_TEXT,
      .vers = 0,
      .buff = NO_TEXT,
      .buff_init = FALSE,
      .buff_pos = 0,
      .buff_len = 0,
      .record = 1,
      .in_stream = FALSE
    };
  }
}

void _vif_exit (void)
{
  for (int_4 k = 0; k < MAX_FILES; k++) {
    if (_ffile[k].unit == NO_FILE) {
      ;
    } else if (_ffile[k].unit == stdin) {
      ;
    } else if (_ffile[k].unit == stdout) {
      ;
    } else if (_ffile[k].unit == stderr) {
      ;
    } else {
      _fclose (k);
    }
  }
}

real_8 _seconds (void)
{
  struct timeval t;
  gettimeofday (&t, (struct timezone *) NULL);
  t.tv_sec -= start_time.tv_sec;
  return (real_8) t.tv_sec + 1e-6 * (real_8) t.tv_usec;
}

void _cputim (real_8 *s)
{
  static real_8 start_cpu_time = 0;
  real_8 hand = _seconds ();
  if (start_cpu_time < 0) {
    start_cpu_time = hand;
  }
  *s = hand - start_cpu_time;
}

void _cputyd (int_4 *i)
{
// Conform University of Nijmegen URC runtime library.
// In a resolution of 100 us.
  static real_8 start_cpu_time = 0;
  real_8 hand = _seconds ();
  if (start_cpu_time < 0) {
    start_cpu_time = hand;
  }
  *i = (int_4) (10000 * (hand - start_cpu_time));
}

void _vif_freq (CALLS *c)
{
  for (int_4 k = 0; c[k].name != NO_TEXT; k++) {
    printf ("%s %ld\n", c[k].name, c[k].calls);
  }
}

char *__strtok_r (char *s, const char *delim, char **save_ptr)
{
// Based on code from the GNU C library.
  char *end;
  if (s == NO_TEXT) {
    s = *save_ptr;
  }
  if (*s == '\0') {
    *save_ptr = s;
    return NO_TEXT;
  }
// Scan leading delimiters.
  s += strspn (s, delim);
  if (*s == '\0') {
    *save_ptr = s;
    return NO_TEXT;
  }
// Find the end of the token.
  end = s + strcspn (s, delim);
  if (*end == '\0') {
    *save_ptr = end;
    return s;
  }
// Terminate the token and make *SAVE_PTR point_4 past it.
  *end = '\0';
  *save_ptr = end + 1;
  return s;
}

// CHARACTER*n

int_4 _srecordf (char *s, const char *format, ...)
{
  size_t N = RECLN;
  va_list ap;
  va_start (ap, format);
  int_4 vsnprintf (char *, size_t, const char *, va_list);
// Print in new string, just in case 's' is also an argument!
  int_4 M = N + 16; // A bit longer so we trap too long prints.
  char *t = f_malloc (M);
  int_4 Np = vsnprintf (t, M, format, ap);
  va_end (ap);
  if (Np >= N) {
    free (t);
    RECORD str;
    sprintf (str, "_srecordf prints %d characters", Np);
    OVERFLOW (3606, str);
  } else {
    strcpy (s, t);
    free (t);
  }
  return Np;
}

int_4 _sys (char *s, char *cmd, char *dep, const char *format, ...)
{
  char *t = NO_TEXT;
  int_4 Np = 0;
  size_t N = RECLN;
  if (format != NO_TEXT) {
    va_list ap;
    va_start (ap, format);
    int_4 vsnprintf (char *, size_t, const char *, va_list);
    // Print in new string, just in case 's' is also an argument!
    int_4 M = N + 16; // A bit longer so we trap too long prints.
    t = f_malloc (M);
    Np = vsnprintf (t, M, format, ap);
    va_end (ap);
  }
  if (Np >= N) {
    free (t);
    RECORD str;
    sprintf (str, "_sys prints %d characters", Np);
    OVERFLOW (3607, str);
  } else {
    NEW_RECORD (protect);
    if (t == NO_TEXT) {
      if (dep == NO_TEXT) {
        _srecordf (protect, "command -v %s > /dev/null && %s", cmd, cmd);
      } else {
        _srecordf (protect, "command -v %s > /dev/null && command -v %s > /dev/null && %s", cmd, dep, cmd);
      }
    } else {
      if (dep == NO_TEXT) {
        _srecordf (protect, "command -v %s > /dev/null && %s %s", cmd, cmd, t);
      } else {
        _srecordf (protect, "command -v %s > /dev/null && command -v %s > /dev/null && %s %s", cmd, dep, cmd, t);
      }
      free (t);
    }
    return system (protect);
  }
  return EXIT_FAILURE;
}

void _srand48 (int_4 *seed)
{
  srand48 (*seed);  
}

real_8 _drand48 (void)
{
  return drand48 ();
}
