static char *rcs_version = "perms.c V$Revision: 1.33 $";
#define IN_PERMS_C 1
#define _GNU_SOURCE // for some gnu extensions in system header files.

#include "perms.h"

#include <limits.h> // PATH_MAX for valgrind code
#include <time.h> // strftime
#include <signal.h>

int     _imp_InStream = 0,  _imp_OutStream = 0;
FILE    *_imp_INFILE,       *_imp_OUTFILE;

_imp_filedata _imp_infile[256];
_imp_filedata _imp_outfile[256];

_imp_string   _imp_promptstr;

// At the moment, the C generated by i77 includes assignments to _imp_current_line and _imp_current_file
// at the start of the code corresponding to each Imp source line.  (We're relying on a compiler option
// to reduce the overhead of multiple copies of the same string.)  This is similar to C's __LINE__ and
// __FILE__, but is being added explicitly by the icode to C translator for reasons which may no longer
// be valid.

int _imp_current_line;
char *_imp_current_file = "";

int _imp_diagnose;  // %diagnose 0xnnnnnn and command-line option flags.

static int opt_info = 0;

//const double PI = 3.141592653589793238462;
//const _imp_string1 _imp_SNL = {.charno = {1, '\n'} };

const _imp_string1 _imp_emptystring = { .length = 0 };
static char *_imp_Progname = "<imp main program>"; // get from argv[0]

// TO DO: I do not currently remove event handlers from the chain of handlers
// when the scope of an event block is exited.  This will eventually lead to
// problems!  In imptoc, the return and the end of a block caused something
// like this to happen:
// #define nreturn do {if (global_handler && handler_at_this_level) global_handler = global_handler->parent_handler; TRACEOUT(); return;} while(0)

eventfm _imp_Event; // global
_imp_on_event_handler *global_handler = NULL;

static void _imp_init_files(void) {
  int i;

  // inpos, outpos, lastchar and nextchar will require a lot of work
  // to implement properly.  Current code is much of a placeholder.
  
  for (i = 0; i < 256; i++) {
    _imp_infile[i].f = NULL;
    _imp_infile[i].fname = _imp_str_literal("<null>");
    _imp_infile[i].streamno = i;
    _imp_infile[i].lastchar = '\n';
    _imp_infile[i].nextchar = -1;
    _imp_infile[i].inpos = 0;
    _imp_outfile[i].f = NULL;
    _imp_outfile[i].fname = _imp_str_literal("<null>");
    _imp_outfile[i].streamno = i;
    _imp_outfile[i].lastchar = '\n';
    _imp_outfile[i].nextchar = -1;
    _imp_outfile[i].outpos = 0;
  }
  _imp_infile[0].f = fopen("/dev/tty", "r");
  _imp_infile[0].fname = _imp_str_literal("<console>");

  _imp_outfile[0].f = fopen("/dev/tty", "w"); // or could use stderr
  _imp_outfile[0].fname = _imp_str_literal("<console>");

  _imp_infile[0].inpos = 0;

  _imp_infile[1].f = stdin;
  _imp_infile[1].fname = _imp_str_literal("<stdin>");

  _imp_outfile[1].f = stdout;
  _imp_outfile[1].fname = _imp_str_literal("<stdout>");

  _imp_outfile[1].outpos = 0;

  // Default currently set to stdin and stdout.
  // This is not the same as selctinput(0) and selectoutput(0) which is /dev/tty
  // which are needed for interactive prompting.  Do an explicit selectinput(0)
  // in your code if it is meant to be an interactive program.

  _imp_INFILE  = _imp_infile[_imp_InStream=1].f;
  _imp_OUTFILE = _imp_outfile[_imp_OutStream=1].f;

  _imp_promptstr = _imp_str_literal("Data: ");
}


// A system() analog that behaves like sprintf, to make it easier
// to access the output of a system command from C.
// This is an initial simple version, but ideally it should be
// expanded to allow stdargs formatting of the command string.
int sysnprintf(char *out, int maxlen, char *command) {
  FILE *pipe;
  pipe = popen(command, "r");
  for (int i = 0; i < maxlen-1; i++) {
    int c = fgetc(pipe);
    if (c == EOF) { out[i] = '\0'; pclose(pipe); return i; }
    out[i] = c;
  }
  return 0;
}


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include <fcntl.h>
#include <ctype.h>

static int running_under_debugger(void) {
  int fd = open("/proc/self/status", O_RDONLY);
  if (fd == -1) return 0;

  char buf[4096];
  ssize_t n = read(fd, buf, sizeof(buf) - 1);
  close(fd);
  if (n <= 0) return 0;

  buf[n] = '\0';

  const char *tag = "TracerPid:";
  char *p = strstr(buf, tag);
  if (!p) return 0;

  p += strlen(tag);
  while (*p && isspace((unsigned char)*p)) p++;
  /* Non-zero TracerPid => some debugger (gdb, lldb, etc.) */
  return (*p && *p != '0');
}


#ifdef VALGRIND_AVAILABLE
#include <valgrind/valgrind.h>   /* for RUNNING_ON_VALGRIND */

/*
 * Put this at the very start of main(), before you do anything else.
 *
 * int main(int argc, char **argv) {
 *     restart_under_valgrind_if_needed(argc, argv);
 *     ...
 * }
 */

void restart_under_valgrind_if_needed(int argc, char **argv)
{
    // This rather hacky code causes Imp programs to run automatically under Valgrind (unless you ask for --no-valgrind)
    // but sometimes you want to run explicitly under gdb instead, so for those cases we will check to see if a debugger
    // is attached and if so, will avoid valgrind altogether.
  
    if (running_under_debugger()) return;
    
#ifdef PARM_OPT
    return;  // Only invoke valgrind if checks are requested, i.e. -O was not given.
#endif
  
    // even if compiled for valgrind support, don't invoke it if the first command-line option was --nv:
    
    if ((argc > 1) && ((strcmp(argv[1], "--nv")==0) || (strcmp(argv[1], "-nv")==0) || (strcmp(argv[1], "--no-valgrind")==0))) {
      for (int i = 1; i <= argc; i++) {
        argv[i] = argv[i+1]; // will include terminal NULL of argv[argc]
      }
      return;
    }
    
    if ((argc > 1) && (strcmp(argv[1], "--info")==0)) {
      for (int i = 1; i <= argc; i++) {
        argv[i] = argv[i+1]; // will include terminal NULL of argv[argc]
      }
      argc -= 1;
      opt_info = 1;
    }
    
    if ((RUNNING_ON_VALGRIND) || getenv("RUN_UNDER_VALGRIND_DONE")) {
      /* already under Valgrind? Let's not get into an infinite loop of valgrinds! */
      return;
    }
    setenv("RUN_UNDER_VALGRIND_DONE", "1", 1);

    /* Build new argv: [valgrind, options..., original_argv[0..]] */

    // TO DO:  As well as checking that valgrind is available, we need to
    // check that the version is >= valgrind-3.14 which is the first version
    // that supports the --exit-on-first-error= option, necessary to make the
    // output look like what Imp users expect.

    const char *vg;
    char version[1024] = { 0 };
    // hunt around a little to find a suitable version.  Written mainly for my home system
    // but might work for others too...
    sysnprintf(version, 1024, "valgrind --version");
    if ((strncmp(version, "valgrind-", strlen("valgrind-")) == 0) && (strncmp(version, "valgrind-3.13", strlen("valgrind-3.13")) > 0)) {
      // Good version!
      vg = "valgrind";
    } else {
      version[0] = '\0';
      sysnprintf(version, 1024, "/snap/bin/valgrind --version");
      if (strncmp(version, "valgrind-", strlen("valgrind-")) == 0) {
        // we do have a snap version
        vg = "/snap/bin/valgrind";
      } else {
        // no snap version.  If there was a version in the path we already know it's too old
        sysnprintf(version, 1024, "valgrind --version");
        if (strncmp(version, "valgrind-", strlen("valgrind-")) == 0) {
          fprintf(stderr, "? Warning: We need to use a valgrind version of 3.14 or later.  You have %s.\n", version);
          fprintf(stderr, "           A newer version might be installable with: sudo snap install valgrind --classic\n");
          fprintf(stderr, "           (snap can be installed with: sudo apt install snapd )\n");
          fprintf(stderr, "           Since valgrind is not available we will run without checks.\n");
        } else {
          fprintf(stderr, "? Warning: you do not have valgrind installed.  Running without checks.\n");
        }
        return;
      }
    }
    
    /* Some options that help with the reporting */
    const char *vg_args_fixed[] = {
        "--track-origins=yes",
        "--leak-check=full",
        // "--show-leak-kinds=all", // changed to tidy up some of the valgrind messages...
        "--show-leak-kinds=none",
        "--exit-on-first-error=yes",
        "-q",
          "--error-exitcode=1", // this one is kind of critical to be available...
        NULL
    };

    /* Count fixed options. */
    int vg_fixed_count = 0; while (vg_args_fixed[vg_fixed_count] != NULL) vg_fixed_count++;

    /* New argv size: valgrind + fixed + original argc + NULL */
    int new_argc = 1 + vg_fixed_count + argc;
    char **new_argv = calloc((size_t)new_argc + 1, sizeof(char *));
    if (!new_argv) {
        perror("calloc");
        exit(1);
    }

    int idx = 0;
    new_argv[idx++] = (char *)vg;            /* argv[0] = valgrind path */

    if (opt_info) fprintf(stderr, "! Executing %s ", (char *)vg);
    for (int i = 0; i < vg_fixed_count; i++) {
        new_argv[idx] = (char *)vg_args_fixed[i];
        if (opt_info) fprintf(stderr, " %s", new_argv[idx]);
        idx += 1;
    }

    /* Append original argv[0..argc-1] */
    for (int i = 0; i < argc; i++) {
        new_argv[idx] = argv[i];
        if (opt_info) fprintf(stderr, " %s", new_argv[idx]);
        idx += 1;
    }

    new_argv[idx] = NULL;
    if (opt_info) fprintf(stderr, "\n");

    /* Replace current process image with valgrind + our program. */
    // Was it an absolute or relative invocation?
    if (*vg == '/' || *vg == '.') {
      // absolute
      execv(vg, new_argv);
    } else {
      // so use the $PATH
      execvp(vg, new_argv);
    }

    /* If execv returns, it's an error. */
    fprintf(stderr, "%s: %s - %s\n", _imp_Progname, strerror(errno), vg);
    //perror("execv valgrind");
    exit(1);
}

#else

void restart_under_valgrind_if_needed(int argc, char **argv) {
  // apparently we've been told that valgrind was not available.
  // Maybe use gdb for similar effect if it's available?
  // Meanwhile a belt&braces check...
  char vg[512] = {'\0'};
  int rc = sysnprintf(vg, sizeof(vg), "which valgrind");
  if ((rc == 0) && (strlen(vg) > 3)) {
    fprintf(stderr, "! NOTICE: valgrind may be available on this system.  Try adding -DVALGRIND_AVAILABLE to the compilation of this file.\n");
  }
}
static const int RUNNING_ON_VALGRIND = 0;

#endif

#include <execinfo.h>  // backtrace, backtrace_symbols_fd
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <string.h>
#include <limits.h>

// This is doing a lightweight backtrace the hard way.  It can
// probably be replaced by using libbacktrace
void _imp_generic_backtrace(void) {
  
  if (!RUNNING_ON_VALGRIND) {
    fprintf(stderr, "BACKTRACE NOT AVAILABLE\n\n");
    exit(1);
  }

  // Get exe path
  char exe_path[PATH_MAX];
  ssize_t len = readlink("/proc/self/exe", exe_path, sizeof(exe_path) - 1);
  if (len == -1) {
    fprintf(stderr, "backtrace: readlink failed\n\n");
    exit(1);
  }
  exe_path[len] = '\0';

  // Capture backtrace
  void *trace[32];
  int n_ips = backtrace(trace, 32);
  if (n_ips <= 1) {  // Skip this frame
    fprintf(stderr, "backtrace failed\n\n");
    exit(1);
  }

  // Declare linker symbols (GNU ld provides these)
  extern char __executable_start[], etext[];
  
  for (int i = 1; i < n_ips; i++) {  // Skip IMP_SIGNAL frame
    
    uintptr_t ip = (uintptr_t)trace[i];
    if (ip < (uintptr_t)__executable_start || ip > (uintptr_t)etext) continue;
    
    //uintptr_t ip = (uintptr_t)trace[i];
    //if (ip < 0x8048000 || ip > 0x8050000) continue;  // App range (adjust)
    
    char cmd[PATH_MAX+512];
    snprintf(cmd, sizeof(cmd), "addr2line -e %s -iC -f -p %p 2>&1  | grep -v \"addr2line: Dwarf Error: Can't find .debug_ranges section.\"", exe_path, trace[i]);

    FILE *pipe = popen(cmd, "r");
    if (pipe) {
      char linebuf[512];
      int first_time = 1;
      if (fgets(linebuf, sizeof(linebuf), pipe)) {
        linebuf[strcspn(linebuf, "\n")] = 0;
        //fprintf(stderr, "DEBUG: \"%s\"\n", linebuf);
        // After a bit of experimentation it transpires that unwinding the call stack only works
        // reliable when the procedures are standard C-style top-level calls - when we have
        // nested procedure declarations in the Imp style, some of the hierarchy gets lost...
        if (strncmp(linebuf, "_signal_event ", strlen("_signal_event ")) == 0) {
        } else if (strncmp(linebuf, "_start ", strlen("_start ")) == 0) {
        } else if (strncmp(linebuf, "_imp_", strlen("_imp_")) == 0) {
        } else {
          fprintf(stderr, "    Entered from ");
          char *p = strstr(linebuf, " at ??:?");
          if (p) *p = '\0'; 
          fprintf(stderr, "%s", linebuf);
          if (p && first_time) {
            if (_imp_current_file != 0/*NULL*/ && _imp_current_line != 0) {
              fprintf(stderr, " in %s line %d", _imp_current_file, _imp_current_line);
            }
          }
          first_time = 0;
          fprintf(stderr, "\n");
        }
      }
      pclose(pipe);
    }
  }
}

void _imp_fallback_signal_handler(int eventno, int subevent, int extra, char *message) {
  fprintf(stderr, "\n* Monitor entered from IMP - %%signal %d,%d,%d  %s\n", eventno, subevent, extra, message);
#ifdef NEVER // This works in an imp source so let's translate it to C and use it as the last-ditch handler...
  /*
    newline
      %if event_event = 14 %and event_subevent = 1 %start
                          ! These are generated outside of the Imp77 environment, such as by Valgrind or GCC's Undefined Behaviour detection (ubsan).
    %if event_info = 4 %start
      ! SIGILL
      print string("Linux Signal SIGILL trapped at ")
      print string(event file)
      print string(" line")
      write(event line, 0)
      print string(" - this was probably raised by ubsan (gcc -fsanitize-trap=undefined)")
      newline
    %else %if event_info = 8
      ! SIGFPE
      print string("Linux Signal SIGFPE trapped at ")
      print string(event file)
      print string(" line")
      write(event line, 0)
      print string(" - this is a floating point error (such as divide by zero)")
      newline
    %else %if event_info = 8
      ! SIGSEGV
      print string("Linux Signal SIGSEGV trapped at ")
      print string(event file)
      print string(" line")
      write(event line, 0)
      print string(" - this may be from a NULL pointer or accessing past the end of an array")
      newline
    %else
      ! unknown
      print string("Linux Signal "); write(event_info, 0); print string(" trapped."); newlines(2)
    %finish
  %else
    print string("Imp77 %signal ")
    write(event_event,0); print string(", ")
    write(event_subevent,0); print string(", ")
    write(event_info,0)
    print string(" raised in ")
    print string(event file)
    print string(" line")
    write(event line, 0)
    newline
  %finish
  print string(event message)
  %stop
   */
#endif
  // This is what's called when there is no %onevent block left to catch an Imp77 event.
  _imp_generic_backtrace(); // trying to use valgrind backtrace but it doesn't appear to work.  Old gdb scheme may work better. 
  exit(1);
}

#ifdef FALLBACK_TRACE_MECHANISM
// trace entry and exit from procedures as a debugging aid.  Not used much.
// Backtrace could use this info too if saved on a stack but better to use
// proper system backtrace if available.  Still to do: add a command-line
// option to invoke runtime tracing.  There is code in the old imptoc-perms.c
// file for runtime tracing and a poor man's backtrace based on this mechanism
// but the current i2c does not insert these calls anywhere.  The fallback
// code for backtracing in _imp_trace_backtrace has not been implemented in
// i2c yet, but _imp_generic_backtrace which depends on the code having been
// restarted under valgrind is available and is currently the mechanism of
// choice for backtracing, although valgrind is not guaranteed to be available,
// either because it is not installed on the user's system or because the imp
// file has been compiled with optimisations enabled which preclude runtime
// checks and running under valgrind.  

// There are actually multiple backtrace options potentially possible; another
// is to reinvoke the executable under gdb rather than valgrind, and have a
// gdb script be executed on a failure, invoking gdb's "bt" command, such as by:
// "/usr/bin/gdb", "-q", "-nx", "-nh", "-return-child-result", "-ex", "run",
// "-ex", "bt full", "--args" followed by the program's initial arguments.


// (However only way to detect if a running program was compiled with -g (which
//  would enable a proper backtrace is to actually examine itself to see if it
//  contains a symbol table with debugging, such by:
//          objdump --syms $argv[0] | fgrep .debug_info && echo YES
//  Unless we have a symbol table there's not much point in invoking via gdb -
//  better to fall back to explicit entry/exit tracing if present, or implicit
//  cyg_ version if present, and then back to gdb with no symbol tables only if
// those are not available.

// There's *also* a 'libbacktrace' at ~/src/imp77/hacks/libbacktrace on my home
// linux - I don't think it will be needed but I should do some experiments to see
// what it supports.  gdb is the only option I'm aware of that prints out the local
// variables in a backtrace.

// Another option is the cygwin trace/profile code '__cyg_profile_func_enter' etc
// ( https://codingrelic.geekhold.com/2010/09/gcc-function-instrumentation.html ),
// then there is the sneaky code in https://justine.lol/ftrace/ which relies on
// rewriting the executable at runtime to patch some pre-inserted NOP instructions
// with tracing code! (But only if you're using the Cosmopolitan C Compiler suite
// for multi-system fat binaries on 64 bit hosts)

// There are also other profiling support options potentially available which I
// haven't even considered yet.  I would just like to point out that the early Imp
// compilers on EMAS were quite well integrated with debuggers and profiler support
// (eg vagrens), so none of these options are out of character with an original
// implementation!

static int _imp_trace_depth = 0;
int _imp_trace_enter(int line, char *file, char *funcname) {
  for (int i = _imp_trace_depth; i > 0; i--) fputc(' ', stderr);
  fprintf(stderr, "\"%s\", %d: > %s\n", file, line, funcname);
  _imp_trace_depth += 1;
  return 0; // I've forgotten how the return value of these is used
}

int _imp_trace_exit(int line, char *file, char *funcname) {
  _imp_trace_depth -= 1;
  for (int i = _imp_trace_depth; i > 0; i--) fputc(' ', stderr);
  fprintf(stderr, "\"%s\", %d: < %s\n", file, line, funcname);
  return 0; // I've forgotten how the return value of these is used
}
#endif

void _imp_monitor(int n, int line, char *file, const char *funcname) {
  if (n <= 0) {
    char *fun;
    if (file == NULL) file = "<unknown file>";
    if (funcname == NULL) fun = "<unknown function>"; else fun = (char *)funcname;
    fprintf(stderr, "\n* %%MONITOR entered from IMP in %s at %s:%d\n", *funcname == '\0' ? "block" : fun, file, line);
  } else {
    fprintf(stderr, "\n* %%MONITOR %d entered from IMP in %s at %s:%d\n", n, *funcname == '\0' ? "block" : funcname, file, line);
  }
  _imp_generic_backtrace(); // sometimes fails, I really should add a fallback method...
}

// imptoc translated the begin/endofprogram block into _imp_mainep and
// called _imp_mainep from a main in perms.c.  This time around we're letting
// the main program be C's main() and we're initialising the imp world via a
// call to _imp_initialise below.  It's not clear if either way is better.

// as an extension to Imp77 on linux, I'm supplying a perm call to argc and argv
// which will eventually pick up the arguments passed here.  Note that these will
// be functions, not arrays or maps, so cannot be written to.  This is deliberate.

static int _imp_global_argc = 0;
static char **_imp_global_argv = NULL;

int _imp_ARGC(void) {
  return _imp_global_argc;
}

_imp_string _imp_ARGV(int n) {
  // Add test that we've initialised, and range checking, here
  if (n > _imp_global_argc) {
    fprintf(stderr, "* MONITOR ENTERED FROM IMP - ARRAY BOUND ERROR: argv[%d] (argc = %d)\n", n, _imp_global_argc);
    // or signal.  (later)
    _imp_generic_backtrace();
    exit(1);
  }
  if (n == _imp_global_argc) {
    return _imp_str_literal("");
  } else return _imp_c2istr(_imp_global_argv[n]);
}

_imp_string *_imp_strcat(_imp_string *left, _imp_string right) {
  /*TO DO*/
  int llen = *_imp_LENGTH(left);
  int rlen = *_imp_LENGTH(&right);
  int moved = 0;
  for (;;) {
    if (moved == rlen) break;
    moved += 1;
    left->charno[llen+moved] = right.charno[moved];
    *_imp_LENGTH(left) += 1;
  }
  return left;
}

void _imp_initialise(int argc, char **argv) {
  _imp_Progname = argv[0];
  _imp_global_argc = argc;
  _imp_global_argv = argv;
  restart_under_valgrind_if_needed(argc, argv);
  _imp_init_files(); // Initialise Imp I/O streams.
}

void _imp_issue_prompt(void) {

  // Unfortunately for prompts to work properly, every I/O operation has to
  // keep track of 'lastchar' (and incidentally, also 'outpos')
  // So doing that at the imp library level is not idea, but it'll
  // have to do for now.

  // Note prompting does not work if selected streams are both stream 1,
  // even if that does by coincidence happen to be the console.  At least for now.
  // If I do check the interactivity of stdin and stdout, I should only do it
  // at the point of defining the stream, with a lightweight check at the
  // point of selecting the stream, and a trivial check of that result at
  // the point of outputting a prompt!
  
  if (_imp_OutStream == 0
      && _imp_outfile[0].lastchar == '\n'
      && _imp_InStream == 0
      && _imp_infile[0].lastchar == '\n') {
    
    _imp_PRINTSTRING(_imp_promptstr); fflush(_imp_OUTFILE);
    
    if (*_imp_LENGTH(&_imp_promptstr) > 0) {
      _imp_outfile[_imp_OutStream].lastchar
        = *_imp_CHARNO(&_imp_promptstr, *_imp_LENGTH(&_imp_promptstr)-1);
    }
  }
}

// external not static inline in perms.h
int _imp_resolve(_imp_string s, _imp_string *left, _imp_string match, _imp_string *right) {
  char *matches;
  int matchstart;
  matches = (char *)memmem(s.cstr.s, s.length, match.cstr.s, match.length);
  if (matches) {
    matchstart = matches-s.cstr.s;
    if (left) {
      strncpy(left->cstr.s, s.cstr.s, matchstart);
      //left->cstr.s[matchstart] = '\0';
      left->length = matchstart;
    }
    if (right) {
      strncpy(right->cstr.s,
              s.cstr.s+matchstart+strlen(match.cstr.s),
              strlen(s.cstr.s+matchstart+strlen(match.cstr.s))+1);//<--needs length fix
      right->length = strlen(right->cstr.s);//<--needs length fix
    }
    return 1/*True*/;
  } else {
    // Did not contain match string.  Do not update left or right.
    return 0/*False*/;
  }
}

// this one is implemented as a static inline in perms.h

//_imp_string _imp_join(_imp_string left, _imp_string right) {
//  fprintf(stderr, "* _imp_join not yet implemented.\n");
//  exit(1);
//}

int _imp_strcmp(_imp_string left, _imp_string right) {
  int comp, i = 1;
  for (;;) {
    comp = right.charno[i] - left.charno[i];
    if (comp != 0) return comp;
    if (i == left.length && i == right.length) return comp;
    if (i == left.length) return -1;
    if (i == right.length) return 1;
    i += 1;
    if (i == 256) return 1;//ERROR!
  }
}

eventfm _imp_Event; // global

_imp_on_event_handler *global_handler; // only declared and installed in an onevent block!
int handler_at_this_level = 0;

void sig_handler(int signo) {
  // Convert C signal (eg SIGILL caused by valgrind detecting a runtime error) to an Imp77 signal using longjmp.
  _signal_event(_imp_c2istr(_imp_current_file), _imp_current_line, _imp_c2istr(strsignal(signo)), 14, 1, signo);
  // I believed there is a special longjmp for using in signal handlers.  Need to look it up.
}

void _signal_event(_imp_string file, int line, _imp_string message, int event, int subevent, int extra) {
  _imp_on_event_handler *handler = global_handler;
  if (global_handler == NULL) {
    //_imp_fallback_signal_handler(event, subevent,  extra, "");
    fprintf(stderr, "\n\n*** MONITOR ENTERED FROM IMP\n\n");
    if (message.length == 0) {
      fprintf(stderr, "%%signal %d,%d,%d at %s:%d\n", event, subevent, extra, _imp_i2cstr(&file), line);
    } else {
      fprintf(stderr, "%%signal %d,%d,%d \"%s\" at %s:%d\n", event, subevent, extra, _imp_i2cstr(&message), _imp_i2cstr(&file), line);
    }
    // I now have some C backtrace code that works with gcc (uses dwarf tables)
    // so can add that here soon.  Unfortunately I have a suspicion that by the time
    // we've unwound the longjmp chain back to the NULL at the top, the backtrace
    // no longer has anything useful to print.  But I'll try it just in case I'm wrong.
    //
    // Alternatively we can use an explicit call stack inserted by the compiler if
    // available, and at a last resort, use GDB's "backtrace full" command.
    raise(SIGABRT);
    exit(1);
  }
  global_handler = global_handler->parent_handler; // unwind for subsequent calls
  _imp_Event.EVENT = event;
  _imp_Event.SUB/*EVENT*/ = subevent;
  _imp_Event.INFO/*EXTRA*/ = extra;
  _imp_Event.MESSAGE = _imp_strdup(message); // probably should make a copy of this in case the original disappears
  _imp_Event.LINE = line;
  _imp_Event.FILE = _imp_strdup(file);
  longjmp(handler->env, 1);
}

int _imp_caught_on_event(int event, int bitpos, ...) {
  va_list ap;
  int i;
  int mask = 0;
  va_start(ap, bitpos);
  for (i = bitpos; i >= 0; i = va_arg(ap, int)) mask |= 1<<i;
  va_end(ap);
  if ((mask&(1<<event)) != 0) return 1;
  // only print this if a certain level of debug is enabled.
  if (_imp_diagnose & _IMP_DIAG_SIGNALS) fprintf(stderr, "Event %d was not trapped by this handler.  Passing the event back up the chain.\n", event);
  _signal_event(*_imp_Event.FILE,_imp_Event.LINE, *_imp_Event.MESSAGE, _imp_Event.EVENT, _imp_Event.SUB/*EVENT*/, _imp_Event.INFO/*EXTRA*/); // not claimed - pass it up the chain ...
  return 0;
}

//int           eventmask(int bitpos, ...);

int _imp_caught_fault(int event, int bitpos, ...) {
  // does not signal. just returns true/false
  va_list ap;
  int i;
  int mask = 0;
  va_start(ap, bitpos);
  for (i = bitpos; i >= 0; i = va_arg(ap, int)) mask |= 1<<i;
  va_end(ap);
  return (mask&(1<<event)) != 0;
}

//void _imp_fault(const char *format, ...) {
//  // calls generated by the compiler. Not for users.
//}

//void _imp_warn(const char *format, ...) {
//}

static inline void check_instream(const char *fn) {
  if (   _imp_InStream < 0
      || _imp_InStream >= 256
      || _imp_INFILE == NULL
      || _imp_infile[_imp_InStream].f == NULL) {
    fprintf(stderr, "Invalid INSTREAM(%d)", _imp_InStream);
    if ((0 <= _imp_InStream) && (_imp_InStream <= 255)) fprintf(stderr, "=%p",  _imp_infile[_imp_InStream].f);
    fprintf(stderr, " was accessed by %s from %s:%d\n", fn, _imp_current_file, _imp_current_line);
    exit(1); // TO DO: signal.
  }
}

void _imp_readbyte(unsigned char *dest) {
  int num;
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  int rc = fscanf(_imp_INFILE, "%d", &num);
  // if (rc != 1) _imp_signal(3,1,0,"");
  // first do a range check for 0:255 (or possibly -128:127 or even -128:255)
  *dest = num;
  (void)rc;
}

void _imp_readshort(short int *dest) {
  int num;
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  int rc = fscanf(_imp_INFILE, "%hd", dest);
  // if (rc != 1) _imp_signal(3,1,0,"");
  // first do a range check for 0x8000 to 0x7FFF
  (void)rc;
}

void _imp_readint(int *dest) {
  int num;
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  int rc = fscanf(_imp_INFILE, "%d", dest);
  // if (rc != 1) _imp_signal(3,1,0,"");
  // first do a range check for 0x80000000 to 0x7FFFFFFF
  (void)rc;
}

void _imp_readlong(long long int *dest) {
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  int rc = fscanf(_imp_INFILE, "%lld", dest);
  // if (rc != 1) _imp_signal(3,1,0,"");
  (void)rc;
}

void _imp_readfloat(float *dest) {
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  int rc = fscanf(_imp_INFILE, "%f", dest);
  // if (rc != 1) _imp_signal(3,1,0,"");
  // possible warning for loss of precision?
  (void)rc;
}

void _imp_readdouble(double *dest) {
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  int rc = fscanf(_imp_INFILE, "%lf", dest);
  // if (rc != 1) _imp_signal(3,1,0,"");
  (void)rc;
}

void _imp_readsymbol(int *P) {
  int ch;
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  //fprintf(stderr, "READSYMBOL at %p\n", P);
  ch = fgetc(_imp_INFILE);
  if (ch == EOF) _imp_signal(9, 2, _imp_InStream, strerror(errno));
  *P = ch;
}

void _imp_readch(int *P) {
  int ch;
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  ch = fgetc(_imp_INFILE);
  if (ch == EOF) _imp_signal(9, 2, _imp_InStream, strerror(errno));
  *P = ch;
}

int _imp_nextsymbol(void) {
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  int ch = fgetc(_imp_INFILE);
  if (ch == EOF) _imp_signal(9, 2, _imp_InStream, strerror(errno));
  ungetc(ch, _imp_INFILE);
  return ch;
}

int _imp_nextch(void) {
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  int ch = fgetc(_imp_INFILE);
  if (ch == EOF) _imp_signal(9, 2, _imp_InStream, strerror(errno));
  ungetc(ch, _imp_INFILE);
  return ch;
}

void _imp_skipsymbol(void) {
  int ch;
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  ch = fgetc(_imp_INFILE);
  if (ch == EOF) _imp_signal(9, 2, _imp_InStream, strerror(errno));
}

void _imp_printsymbol(char SYM) {
  if (_imp_OUTFILE == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(1);
  }
  fputc(SYM, _imp_OUTFILE);
  if (_imp_OutStream == 0) fflush(_imp_OUTFILE);
}

void _imp_printch(char SYM) {
  if (_imp_OUTFILE == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(1);
  }
  fputc(SYM, _imp_OUTFILE);
  if (_imp_OutStream == 0) fflush(_imp_OUTFILE);
}

void _imp_printstring(_imp_string S) {
  fprintf(stderr, "void _imp_printstring(_imp_string S)\n");
  // fprintf(_imp_OUTFILE, "%*s", S.length, S.cstr.s);
  if (_imp_OUTFILE == NULL) { fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream); exit(1); }
  for (int i = 1; i <= S.length; i++) fputc(S.charno[i], _imp_OUTFILE);
  if (_imp_OutStream == 0) fflush(_imp_OUTFILE);
}

void _imp_write(int V, int P) {
  fprintf(stderr, "void _imp_write(int V, int P)\n");
  if (_imp_OUTFILE == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(1);
  }
  fprintf(_imp_OUTFILE, P < 0 ? "%*d" : " %*d", P, V);
  if (_imp_OutStream == 0) fflush(_imp_OUTFILE);
} // or swap.
// IMPORTANT: See https://gtoal.com/imp77/reference-manual/IO-LIBRARY-EXPERIMENTS.{imp,txt}

void _imp_readitem(_imp_string *S) {
  // tostring(readsymbol)
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  fprintf(stderr, "* READITEM not implemented\n");
  exit(1);
}

void _imp_readstring(_imp_string *S) {
  // quoted string
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  fprintf(stderr, "* READSTRING not implemented\n");
  exit(1);
}

void _imp_readtext(_imp_string *S, int DELIM) {
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  fprintf(stderr, "* READTEXT not implemented\n");
  exit(1);
}

_imp_string _imp_nextitem(void) {
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  return _imp_TOSTRING(_imp_nextsymbol());
}

void _imp_readline(_imp_string *S) {
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  S->length = 0;
  for (;;) {
    int ch;
    ch = fgetc(_imp_INFILE);
    if (ch == EOF) _imp_signal(9, 1, 0, "EM CHAR IN STMNT - DISASTER");
    if (ch == '\n') break;
    S->length += 1;
    S->charno[S->length] = ch&255;
  }
  S->charno[S->length+1] = '\0'; // strictly not correct but helpful anyway.
}

int _imp_instream(void) {
  check_instream(__PRETTY_FUNCTION__);
  return _imp_InStream;
}

int _imp_outstream(void) {
  return _imp_OutStream;
}

int _imp_inputstream(void) {
  check_instream(__PRETTY_FUNCTION__);
  return _imp_InStream;
}

int _imp_outputstream(void) {
  return _imp_OutStream;
}

_imp_string _imp_inputname(void) {
  check_instream(__PRETTY_FUNCTION__);
  return _imp_infile[_imp_InStream].fname;
}

_imp_string _imp_outputname(void) {
  return _imp_outfile[_imp_OutStream].fname;
}

_imp_string _imp_infilename(void) {
  check_instream(__PRETTY_FUNCTION__);
  return _imp_infile[_imp_InStream].fname;
}

_imp_string _imp_outfilename(void) {
  return _imp_outfile[_imp_OutStream].fname;
}

void _imp_selectinput(int N) {
  _imp_INFILE  = _imp_infile[_imp_InStream = N].f;
  check_instream(__PRETTY_FUNCTION__);
}

void _imp_selectoutput(int N) {
  _imp_OUTFILE = _imp_outfile[_imp_OutStream = N].f;
  if (_imp_OUTFILE == NULL) {
    // Need to signal!  Will fall back to stream 0 for now
    fprintf(stderr, "SELECT OUTPUT(%d): Stream is not open.\n", N);
    _imp_OUTFILE = _imp_outfile[_imp_OutStream = 0].f;
  }
}

void _imp_openinput(int N, _imp_string FD) {
  FILE *f;
  // Should we warn if there is already a stream open on this channel? (probably)
  // should openinput also do a select input on it?
//fprintf(stderr, "perms: openinput(%d,%s)\n", N, _imp_i2cstr(&FD));
  f = fopen(_imp_i2cstr(&FD), "r");
  if (f == NULL) {
    _imp_signal(9,3,N,_imp_i2cstr(&FD)/*strerror(errno)*/); // if signals not enabled, drop through
  }
  _imp_infile[N].f = f;
  _imp_infile[N].fname = FD;
  _imp_infile[N].streamno = N;
  _imp_infile[N].lastchar = '\n';
  _imp_infile[N].nextchar = -1;
  _imp_infile[N].inpos = 0;
}

void _imp_openbinaryinput(int N, _imp_string FD) {
  FILE *f;
//fprintf(stderr, "perms: openbinaryinput(%d,%s)\n", N, _imp_i2cstr(&FD));
  f = fopen(_imp_i2cstr(&FD), "rb");
  if (f == NULL) {
    _imp_signal(9,3,N,strerror(errno)); // if signals not enabled, drop through
  }
  _imp_infile[N].f = f;
  _imp_infile[N].fname = FD;
  _imp_infile[N].streamno = N;
  _imp_infile[N].lastchar = '\n';
  _imp_infile[N].nextchar = -1;
  _imp_infile[N].inpos = 0;
}

void _imp_openoutput(int N, _imp_string FD) {
  FILE *f;
//fprintf(stderr, "perms: openoutput(%d,%s)\n", N, _imp_i2cstr(&FD));
  f = fopen(_imp_i2cstr(&FD), "w");
  if (f == NULL) {
    _imp_signal(9,3,N,strerror(errno)); // if signals not enabled, drop through
  }
  _imp_outfile[N].f = f;
  _imp_outfile[N].fname = FD;
  _imp_outfile[N].streamno = N;
  _imp_outfile[N].lastchar = '\n';
  _imp_outfile[N].outpos = 0;
}

void _imp_openbinaryoutput(int N, _imp_string FD) {
  FILE *f;
//fprintf(stderr, "perms: openbinaryoutput(%d,%s)\n", N, _imp_i2cstr(&FD));
  f = fopen(_imp_i2cstr(&FD), "wb");
  if (f == NULL) {
    _imp_signal(9,3,N,strerror(errno)); // if signals not enabled, drop through
  }
  _imp_outfile[N].f = f;
  _imp_outfile[N].fname = FD;
  _imp_outfile[N].streamno = N;
  _imp_outfile[N].lastchar = '\n';
  _imp_outfile[N].outpos = 0;
}

void _imp_defineinput(int I, _imp_string SPEC) {
  // not an openinput I think but setting up the filename/stream correspondence for a later openinput
  fprintf(stderr, "* DEFINEINPUT not implemented\n");
  exit(1);
}

void _imp_defineoutput(int I, _imp_string SPEC) {
  // not an openoutput I think but setting up the filename/stream correspondence for a later openoutput
  fprintf(stderr, "* DEFINEOUTPUT not implemented\n");
  exit(1);
}

void _imp_closestream(int Stream) { /* EMAS call.  Ambiguous since it could be input or output. */
  int rc;

  // this call is problematic if the same stream number is open for both input and output.
  // In that case we assume input and try closing that, but if it wasn't we try output.

  if (_imp_infile[Stream].f != NULL) {
    rc = fclose(_imp_infile[Stream].f); // aka INFILE
    if (rc == 0) {
      if (Stream == _imp_InStream) {
        if (Stream != 0) {
          _imp_InStream = -1;
          _imp_infile[Stream].f = NULL;
         _imp_selectinput(0);
        }
      }
      return;
    } else _imp_signal(9, 2, Stream, strerror(errno));
  } else if (_imp_outfile[Stream].f != NULL) {
    // Wasn't input so we'll try output.  This is 'an expedient hack'.
    // And example of this call is in the EMAS "gammon.imp" program
    rc = fclose(_imp_outfile[Stream].f); // aka OUTFILE
    if (rc == 0) {
      if (Stream == _imp_OutStream) {
        if (Stream != 0) {
          _imp_OutStream = -1;
          _imp_outfile[Stream].f = NULL;
          _imp_selectoutput(0);
        }
      }
    } else _imp_signal(9, 2, Stream, strerror(errno));
  } else {
    // signal that stream <Stream> is not open and therefore cannot be closed
  }
}

void _imp_closeinput(void) {
  int rc;
  // TO DO: check validity of _imp_InStream
  check_instream(__PRETTY_FUNCTION__);
  rc = fclose(_imp_infile[_imp_InStream].f); // aka INFILE
  _imp_infile[_imp_InStream].f = _imp_INFILE = NULL;
  if (rc != 0) _imp_signal(9, 2, _imp_InStream, strerror(errno));
  // if signals not enabled, drop through
  _imp_InStream = -1;
}

void _imp_closeoutput(void) {
  int rc;
  // TO DO: check validity of _imp_OutStream
  rc = fclose(_imp_outfile[_imp_OutStream].f); // aka OUTFILE
  _imp_outfile[_imp_OutStream].f = _imp_OUTFILE = NULL;
  if (rc != 0) _imp_signal(9, 2, _imp_OutStream, strerror(errno));
  // if signals not enabled, drop through...
  _imp_OutStream = -1;
  // or should we default to stream 0 on closing any other stream?
  // While disallowing closing of stream 0?
  // also do OUTFILE = NULL; or OUTFILE = stderr; ?
}

void _imp_abandoninput(void) {
  // throw away any unread typeahead if interactive.  Not sure what if an ordinary file. probably just close?
  fprintf(stderr, "* ABANDONINPUT not implemented\n");
  exit(1);
} // ABANDON INPUT and OUTPUT not yet added to perms.h

void _imp_abandonoutput(void) {
  // discard any as-yet unprinted output buffer
  fprintf(stderr, "* ABANDONOUTPUT not implemented\n");
  exit(1);
}

void _imp_resetinput(void) {
  check_instream(__PRETTY_FUNCTION__);
  fseek(_imp_infile[_imp_InStream].f, 0L, SEEK_SET);
}
// *Is* there a RESET OUTPUT?

void _imp_inputposition(void) {    // ftell
  fprintf(stderr, "*** ERROR: Empty version of %s called!\n", __PRETTY_FUNCTION__);
}

void _imp_outputposition(void) {
  fprintf(stderr, "*** ERROR: Empty version of %s called!\n", __PRETTY_FUNCTION__);
}

void _imp_setinput(int P) {
  check_instream(__PRETTY_FUNCTION__);
  fseek (_imp_INFILE, P, SEEK_SET);
}
void _imp_setoutput(int P) {
  fseek (_imp_OUTFILE, P, SEEK_SET);
}

void _imp_positioninput(int P) {     // fseek
  check_instream(__PRETTY_FUNCTION__);
  _imp_setinput(P);
}
void _imp_positionoutput(int P) {
  _imp_setoutput(P);
}

void _imp_space(void) {
  if (_imp_OUTFILE == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(1);
  }
  fprintf(_imp_OUTFILE, " ");
  if (_imp_OutStream == 0) fflush(_imp_OUTFILE);
}

void _imp_spaces(int N) {
  if (_imp_OUTFILE == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(1);
  }
  while (N --> 0) fprintf(_imp_OUTFILE, " ");
  if (_imp_OutStream == 0) fflush(_imp_OUTFILE);
}

void _imp_newpage(void) {
  if (_imp_OUTFILE == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(1);
  }
  fprintf(_imp_OUTFILE, "\f");
  if (_imp_OutStream == 0) fflush(_imp_OUTFILE);
}

void _imp_newline(void) {
  if (_imp_OUTFILE == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(1);
  }
  fprintf(_imp_OUTFILE, "\n");
  if (_imp_OutStream == 0) fflush(_imp_OUTFILE);
}

void _imp_newlines(int N) {
  if (_imp_OUTFILE == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(1);
  }
  while (N --> 0) fprintf(_imp_OUTFILE, "\n");
  if (_imp_OutStream == 0) fflush(_imp_OUTFILE);
}

void _imp_print(double R, int BEFORE, int AFTER) {
  // IMPORTANT: See https://gtoal.com/imp77/reference-manual/IO-LIBRARY-EXPERIMENTS.{imp,txt}
  if (_imp_OUTFILE == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(1);
  }
  fprintf(_imp_OUTFILE, "%*.*f", BEFORE+AFTER, AFTER, R);
  if (_imp_OutStream == 0) fflush(_imp_OUTFILE);
}

void _imp_printfloating(double R, int BEFORE, int AFTER) {
  // TO DO          // IMPORTANT: See https://gtoal.com/imp77/reference-manual/IO-LIBRARY-EXPERIMENTS.{imp,txt}
  if (_imp_OUTFILE == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(1);
  }
  fprintf(_imp_OUTFILE, "%*.*f", BEFORE+AFTER, AFTER, R);
  if (_imp_OutStream == 0) fflush(_imp_OUTFILE);
}

void _imp_printfl(double R, int PLACES) {
  // IMPORTANT: See https://gtoal.com/imp77/reference-manual/IO-LIBRARY-EXPERIMENTS.{imp,txt}
  if (_imp_OUTFILE == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(1);
  }
  fprintf(_imp_OUTFILE, "%*f", PLACES, R);
  if (_imp_OutStream == 0) fflush(_imp_OUTFILE);
}

void _imp_printfhex(double R) {
  if (_imp_OUTFILE == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(1);
  }
  fprintf(_imp_OUTFILE, "%A", R);
  if (_imp_OutStream == 0) fflush(_imp_OUTFILE);
}

_imp_string _imp_substring(_imp_string S, int FROM, int TO) {
    int GET;
    int PUT;
    _imp_string TEMP;
    if (FROM < 0) goto L_0002;
    if (FROM <= *_imp_LENGTH(&S)) goto L_0003;
  L_0002:
    _imp_signal(6, 2, FROM, "substring: from is past end of string");
  L_0003:
    if (TO < 0) goto L_0004;
    if (TO <= *_imp_LENGTH(&S)) goto L_0005;
  L_0004:
    _imp_signal(6, 2, TO, "substring: to is past end of string");
  L_0005:
    if (FROM <= TO) goto L_0006;
    _imp_signal(5, 3, 0, "substring inside-out");
  L_0006:
    *_imp_LENGTH(&TEMP) = (TO - FROM) + 1;
    PUT = 1;
    GET = FROM;
  L_0007:
    if (GET > TO) goto L_0008;
    *_imp_CHARNO(&TEMP, PUT) = *_imp_CHARNO(&S, GET);
    PUT = PUT + 1;
    GET = GET + 1;
    goto L_0007;
  L_0008:
    return TEMP;
    ;
}
_imp_string _imp_fromstring(_imp_string S, int FROM, int TO) { return _imp_substring(S, FROM, TO); }
_imp_string _imp_trim(_imp_string S, int MAX) {
  if (MAX >= 0) goto L_0002;
  _imp_signal(6, 2, MAX, "");
  L_0002:
  if ( /*%map*/ * _imp_LENGTH( &S) <= MAX) goto L_0003;
  /*%map*/ *_imp_LENGTH( &S) = MAX;
L_0003:
  return S;
}

_imp_string _imp_time(void) {
  char temp[256];
  time_t rawtime;
  struct tm *ptm;
  
  if ((rawtime=time(NULL)) == -1)        { _imp_signal(10,0,0, "time() failed"); exit(EXIT_FAILURE); }
  if ((ptm=localtime(&rawtime)) == NULL) { _imp_signal(10,0,0, "localtime() failed"); exit(EXIT_FAILURE); }
  strftime(temp, 255, "%T", ptm);
  return _imp_c2istr(temp);
}

_imp_string _imp_date(void) {
  char temp[256];
  time_t rawtime;
  struct tm *ptm;

  if ((rawtime=time(NULL)) == -1)        { _imp_signal(10,0,0, "time() failed"); exit(EXIT_FAILURE); }
  if ((ptm=localtime(&rawtime)) == NULL) { _imp_signal(10,0,0, "localtime() failed"); exit(EXIT_FAILURE); }
  strftime(temp, 255, "%D", ptm);
  return _imp_c2istr(temp);
}

// Currently returning microseconds. I think the original was miliseconds.
// This is just temporary to get me through the Dhrystone benchmark...
int _imp_cputime(void) {
  return (int)(((long long int)clock() * 1000000LL)/(long long int)CLOCKS_PER_SEC);
}

_imp_string _imp_cliparam(void) {
#ifdef IMP_SOURCE
  %external %string (255) %fn  CLI PARAM %alias "_imp_cliparam"
    %string (255) result = ""
    %integer p
    %for p = 1, 1, getargcount-1 %cycle
      %if length(result)+length(getarg(p)) > 255 %start
        %result = result.substring(getarg(p),1,255-length(result))
        ! Silently truncate, or %signal an overflow event?
      %finish
      result <- result.getarg(p)
      result <- result." " %if p < getargcount-1 %and length(result) <= 254
    %repeat
    %result = result
  %end
                                                          
#endif
  _imp_string tmp;
  *_imp_LENGTH(&tmp) = 0;
  if (_imp_ARGC() >= 2) {
    _imp_strcpy(&tmp, _imp_ARGV(1));
  }
  for (int arg = 2; arg < _imp_ARGC(); arg++) {
    _imp_string each;
    _imp_strcpy(&each, _imp_ARGV(arg));
    if (*_imp_LENGTH(&tmp)+1+*_imp_LENGTH(&each) < 255) {
      _imp_strcat(&tmp, _imp_str_literal(" "));
      _imp_strcat(&tmp, each);
    } else break;
  }
  return tmp;
}

// Awkward name clash between different Imp versions. In one, EVENT is a record;
// in another, EVENT is an integerfn returning what the other calls EVENT_EVENT
// I've renamed that version "EVENT NO" rather than "EVENT", with "EVENT" being
// the record of type "EVENT FM".

int _imp_subevent(void) {
  return _imp_Event.SUB/*EVENT*/;
}

int _imp_eventinfo(void) {
  return _imp_Event.INFO/*EXTRA*/;
}

_imp_string _imp_eventmessage(void) {
  return *_imp_Event.MESSAGE;
}

_imp_string _imp_itos(int V, int P) { // stolen from IMP.  Should replace with a native C version
  _imp_string temp;
  if (P >= 0) {
    // adds a single space
    sprintf(temp.cstr.s, " %*d", P, V);
  } else {
    sprintf(temp.cstr.s, "%*d", -P, V);
  }
  temp.length = strlen(temp.cstr.s);
  return temp;
#ifdef NEVER

int VV;
int Q;
int POS;
                                                                //      6    %byteintegerarray store(0:127)
unsigned char STORE[(127)-(0)+1];
                                                                //      7    
                                                                //      8    vv = v;  vv = -vv %if vv > 0
VV = V;
if (VV <= 0) goto L_0002;
VV = (-(VV));
L_0002:
                                                                //      9    pos = 127
POS = 127;
                                                                //     10    %while vv <= -10 %cycle
L_0003:
if (VV > (-(10))) goto L_0004;
                                                                //     11      q = vv//10
Q = (int)(VV) / (int)(10);
                                                                //     12      store(pos) = q*10-vv+'0';  pos = pos-1
STORE[POS] = (Q * 10) - VV + 48;
POS = POS - 1;
                                                                //     13      vv = q
VV = Q;
                                                                //     14    %repeat
goto L_0003;
L_0004:
                                                                //     15    store(pos) = '0'-vv
STORE[POS] = 48 - VV;
                                                                //     16    %if p <= 0 %start
if (P > 0) goto L_0006;
                                                                //     17      p = 128+p
P = 128 + P;
                                                                //     18    %else
goto L_0007;
L_0006:
                                                                //     19      p = 128-p
P = 128 - P;
                                                                //     20      p = pos %if p > pos
if (P <= POS) goto L_0008;
P = POS;
L_0008:
                                                                //     21      p = p-1
P = P - 1;
                                                                //     22    %finish
L_0007:
                                                                //     23    pos = pos-1 %and store(pos) = '-' %if v < 0
if (V >= 0) goto L_0009;
POS = POS - 1;
STORE[POS] = 45;
L_0009:
                                                                //     24    %while pos > p %and pos > 1 %cycle
L_000a:
if (POS <= P) goto L_000b;
if (POS <= 1) goto L_000b;
                                                                //     25      pos = pos-1;  store(pos) = ' '
POS = POS - 1;
STORE[POS] = 32;
                                                                //     26    %repeat
goto L_000a;
L_000b:
                                                                //     27    pos = pos-1;  store(pos) = 127-pos
POS = POS - 1;
STORE[POS] = 127 - POS;
                                                                //     28    %result = string(addr(store(pos)))
return  /*%map*/ * _imp_STRING(_imp_ADDR(&STORE[POS])); // not sure why gcc wrongly says STORE is uninitialised :-(
#endif
}

#ifndef PARM_OPT
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h> // for readlink

static void __attribute__ ((noinline)) _imp_report_unass_error(char *vs) {

  // This could eventually be moved to the default signal handler, but for
  // now we'll skip raising a signal and report it directly.  No use yet of
  // libbacktrace, but just reporting the line and file is going to be
  // pretty helpful.
  
  void *caller_addr = __builtin_return_address(1);
  char exe_path[1024];
  char addr_str[32];
  FILE *pipe;
  char func_line[512] = { '\0' };
  char loc_line[256];
  ssize_t len;
  char cmd[2048];

  // or could use global imp_argv[0] below:
  if ((len = readlink("/proc/self/exe", exe_path, sizeof(exe_path)-1)) == -1) { perror("readlink"); exit(1); }
  exe_path[len] = '\0';

  sprintf(addr_str, "0x%lx", (unsigned long)caller_addr);

  snprintf(cmd, sizeof(cmd), "addr2line -e %s -f %s 2>&1 | grep -v \"addr2line: Dwarf Error: Can't find .debug_ranges section.\"", exe_path, addr_str);
  if (!(pipe = popen(cmd, "r"))) { perror("popen"); exit(1); }

  char *rc=fgets(func_line, sizeof(func_line), pipe);(void)rc;
  if (fgets(loc_line, sizeof(loc_line), pipe)) {
    loc_line[strcspn(loc_line, "\n")] = 0;
    fprintf(stderr, "\n* Monitor entered from IMP - UNASSIGNED VARIABLE %s\n", vs);
  }
  pclose(pipe);

  _imp_generic_backtrace();
  
  exit(1);
}

static void __attribute__ ((noinline)) _imp_report_divide_by_zero_error(char *vs) {

  // This could eventually be moved to the default signal handler, but for
  // now we'll skip raising a signal and report it directly.  No use yet of
  // libbacktrace, but just reporting the line and file is going to be
  // pretty helpful.
  
  void *caller_addr = __builtin_return_address(1);
  char exe_path[1024];
  char addr_str[32];
  FILE *pipe;
  char func_line[512] = { '\0' };
  char loc_line[256];
  ssize_t len;
  char cmd[2048];

  // or could use global imp_argv[0] below:
  if ((len = readlink("/proc/self/exe", exe_path, sizeof(exe_path)-1)) == -1) { perror("readlink"); exit(1); }
  exe_path[len] = '\0';

  sprintf(addr_str, "0x%lx", (unsigned long)caller_addr);

  snprintf(cmd, sizeof(cmd), "addr2line -e %s -f %s 2>&1 | grep -v \"addr2line: Dwarf Error: Can't find .debug_ranges section.\"", exe_path, addr_str);
  if (!(pipe = popen(cmd, "r"))) { perror("popen"); exit(1); }

  char *rc=fgets(func_line, sizeof(func_line), pipe);(void)rc;
  if (fgets(loc_line, sizeof(loc_line), pipe)) {
    loc_line[strcspn(loc_line, "\n")] = 0;
    fprintf(stderr, "\n* Monitor entered from IMP - division by 0:  divisor was %s\n", vs);
  }
  pclose(pipe);

  _imp_generic_backtrace();
  
  exit(1);
}

void _imp_report_range_error(int ix, int low, int high, char *arrayname) {

  // This could eventually be moved to the default signal handler, but for
  // now we'll skip raising a signal and report it directly.  No use yet of
  // libbacktrace, but just reporting the line and file is going to be
  // pretty helpful.
  
  void *caller_addr = __builtin_return_address(1);
  char exe_path[1024];
  char addr_str[32];
  FILE *pipe;
  char func_line[512] = { '\0' };
  char loc_line[256];
  ssize_t len;
  char cmd[2048];

  // or could use global imp_argv[0] below:
  if ((len = readlink("/proc/self/exe", exe_path, sizeof(exe_path)-1)) == -1) { perror("readlink"); exit(1); }
  exe_path[len] = '\0';

  sprintf(addr_str, "0x%lx", (unsigned long)caller_addr);

  snprintf(cmd, sizeof(cmd), "addr2line -e %s -f %s 2>&1 | grep -v \"addr2line: Dwarf Error: Can't find .debug_ranges section.\"", exe_path, addr_str);
  if (!(pipe = popen(cmd, "r"))) { perror("popen"); exit(1); }

  char *rc=fgets(func_line, sizeof(func_line), pipe);(void)rc;
  if (fgets(loc_line, sizeof(loc_line), pipe)) {
    loc_line[strcspn(loc_line, "\n")] = 0;
    fprintf(stderr, "\n* Monitor entered from IMP - index %d out of range for array %s(%d:%d)\n", ix, arrayname, low, high);
  }
  pclose(pipe);

  _imp_generic_backtrace();
  
  exit(1);  
}

// Calls to these procedures are inserted in the user program so the call itself should be kept short!
// I.e. minimise unnecessary extra parameters and runtime overhead.  Can be made inline for a marginal
// speed gain at the expense of a marginal size loss.  If inlined, these have to be in perms.h not perms.c
int __attribute__ ((noinline)) _imp_rcheck1d(int ix, int low, int high, char *arrayname) {
  if (ix < low || ix > high) _imp_report_range_error(ix, low, high, arrayname);
  return ix;
}

#ifdef NEVER // An earlier version of imptoc used this very similar code...:
int __attribute__ ((noinline)) _C(int x, char *name, int lower, int upper, char *filename, int line) {
  if ((x < lower) || (x > upper)) {
    fprintf(stderr, "* Array bounds exceeded in %s at line %d: %s(%d) is outside %s[%d:%d]\n",
            filename,  line,
            name, x,          name, lower, upper);
    exit(4);
  }
  //fprintf(stderr, "\"%s\", Line %d: %s[%d]\n", filename, line, name, x);
  return x;
}
#endif

// Ideally we need separate tests for int and long long int.
// short and byte should not be tested for unassigned.

int __attribute__ ((noinline)) _imp_ucheck_int(int v, char *vs) {
  int unass; // trying to be a little bit portable rather than hard-coding 0xfefefefe
             // but this does risk checking against some random value (which might turn
             // out to be '0' if not compiled with -ftrivial-auto-var-init=pattern )
  if (v == unass) _imp_report_unass_error(vs); // i2c users should ignore an unassigned warning on this line.  Trust me, it's OK to ignore.
  return v;
}

// and also ought to have tests for float and double, except in imp everything
// is calculated at double and truncated when writing result to a float.

double __attribute__ ((noinline)) _imp_urcheck_double(double v, char *vs) {
  // binary representations of float and double are 0xFEFEFEFE and 0xFEFEFEFEFEFEFEFE
  if ((v == -0X1.FDFDFCP+126) || (v == -0X1.EFEFEFEFEFEFEP+1008)) _imp_report_unass_error(vs);
  return v;
}

int __attribute__ ((noinline)) _imp_zcheck_int(int v, char *vs) {
  if (v == 0) _imp_report_divide_by_zero_error(vs);
  return v;
}

int __attribute__ ((noinline)) _imp_zcheck_double(double v, char *vs) {
  if (v == 0.0) _imp_report_divide_by_zero_error(vs);
  return v;
}





// because this is inserted into machine generated code,
// we know that 'v' will always be an atom, not an expression:
#ifdef NEVER
// range:
#define _R(ix, low, high, vs) _imp_rcheck1d(ix, low, high, vs)
//#define _U(v) _imp_ucheck_int(v, #v)
// unassigned int:
#define _U(v) ((typeof(v))_imp_ucheck_int(v, #v))
// unassigned real:
#define _UR(v) ((typeof(v))_imp_urcheck_int(v, #v))
// strings may need special handling.  (We do have the related int unassigned_string() in perms.h)
#endif // NEVER

#else

#ifdef NEVER
#define _R(ix, low, high, vs) (ix)
#define _U(v) (v)
#define _UR(v) (v)
#endif // NEVER

#endif