// THIS IS AN EARLY WORK-IN-PROGRESS VERSION OF THE PERMS FOR THE NEW IMP TO C TRANSPILER.
// IT IS SUFFICIENT FOR COMPILING EDWIN4, BUT PLEASE DO NOT USE FOR OTHER PURPOSES.



// WARNING: imp's WRITE clashed with the linux library, so I've started to add _imp_ in front of all imp procedures :-(
// Alternatively I could wrap *all* imp prims in #define's.  But that opens up a larger can of worms...
// For now some calls are available as both macros and procedures, as I haven't made up my mind yet!
// Note the interaction with case canonicalisation.  Need to keep level 0 stuff in upper case.

// trapping overflow: -ffpe-trap -ftrapv

// https://gcc.gnu.org/onlinedocs/gcc/Code-Gen-Options.html#Code-Gen-Options

/*

useful for detecting if compiled with -g ? :

-frecord-gcc-switches
This switch causes the command line used to invoke the compiler to be recorded into the object file that is being created. This switch is only implemented on some targets and the exact format of the recording is target and binary file format dependent, but it usually takes the form of a section containing ASCII text. This switch is related to the -fverbose-asm switch, but that switch only records information in the assembler output file as comments, so it never reaches the object file. See also -grecord-gcc-switches for another way of storing compiler options into the object file.

-fsanitize=undefined
GCC recently (version 4.9) gained Undefined Behavior Sanitizer (ubsan), a run-time checker for the C and C++ languages. In order to check your program with ubsan, compile and link the program with -fsanitize=undefined option. Such instrumented binaries have to be executed; if ubsan detects any problem, it outputs a "runtime error:" message, and in most cases continues executing the program. There is a possibility of  making these diagnostic messages abort -- just use the option -fno-sanitize-recover.

At present, ubsan can offer a handful kinds of checking. The simplest is probably the integer division by zero sanitization: if a division by zero occurs, or INT_MIN / -1 for signed types, a run-time error is issued. Floating-point type division by zero is off by default, but can be turned on with the -fsanitize=float-divide-by-zero command-line option.

Even a conversion of a floating-point value to an integer value can overflow. Such a case is not diagnosed by default, but can be enabled specifically with the -fsanitize=float-cast-overflow option.

https://developers.redhat.com/blog/2018/03/21/compiler-and-linker-flags-gcc

Note: C/linux signals will not raise Imp signals unless we explicitly trap C signals and raise them ourselves. Two different mechanisms.

 */

#include <stdio.h>
#include <string.h>
#include <error.h>
#include <errno.h>
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <errno.h>
#include <time.h>

#include "perms.h"

#undef on_event
#undef return
#undef _imp_enter
#undef _imp_leave
#undef EVENT

int _imp_control  = 0; //  %control and command-line flags.
int _imp_diagnose = 0; // %diagnose and command-line flags.

/////////////////////////////////////////////////////////////////////////////////// TRACE

static int nest = 0;
static int fn[1024], site[1024]; // by having a 'count' variable as well, we could compress repeated calls
                                 // to any procedure (but not alternating calls)
static int cygtrace = 0;
// https://codingrelic.geekhold.com/2010/09/gcc-function-instrumentation.html
__attribute__((no_instrument_function)) void __cyg_profile_func_enter(void *this_fn, void *call_site) {
  int i;
  if (cygtrace) for (i = 0; i < nest; i++) fprintf(stderr, "  ");
  fn[nest] = (int)this_fn; site[nest] = (int)call_site;
  nest = (nest+1)&1023; // wrap on infinite recursion.  We'll still get the message... (quick hack)
  if (cygtrace) fprintf(stderr, "> %x %x\n", (int)this_fn, (int)call_site);
}

__attribute__((no_instrument_function)) void __cyg_profile_func_exit(void *this_fn, void *call_site){
  int i;
  nest -= 1;
  if (cygtrace) {
    for (i = 0; i < nest; i++) fprintf(stderr, "  ");
    fprintf(stderr, "< %x %x\n", (int)this_fn, (int)call_site);
  }
}

__attribute__((no_instrument_function)) void pmt(void) {
  int last = nest;
  while (nest --> 0) {
    fprintf(stderr, "#%d Called from offset 0x%x in procedure starting at 0x%x\n", last-nest, site[nest], fn[nest]);
  }
  fprintf(stderr, "\nFor more detailed information, re-build from source using --trace (partial backtrace) or --gdb (full backtrace)\n");
}

eventfm EVENT; // global

_imp_on_event_handler *global_handler = NULL; // only declared and installed in an onevent block!

// This is a tracing facility that can be turned on at run time either with a --trace command-line
// option, or %control in a source file.  As well as following the execution path of the code,
// we can use the trace stack to produce a backtrace if the lower-level backtrace library is
// not available or we don't want to allow GDB to produce a post-mortem backtrace.

static int imp_trace_level = 0;
#define MAX_TRACE_DEPTH 100
char *file_stack[MAX_TRACE_DEPTH];
char *funcname_stack[MAX_TRACE_DEPTH];
int line_stack[MAX_TRACE_DEPTH];

int _imp_trace_exit(int line, char *file, char *funcname) {
  imp_trace_level -= 1;
  //if (imp_trace_level < MAX_TRACE_DEPTH) {
  //line = line_stack[imp_trace_level];
  //funcname = funcname_stack[imp_trace_level];
  //}
  if (_imp_control & _IMP_CONTROL_TRACE) {
    int i = 0;
    while (i++ < imp_trace_level) fputc(' ', stderr);
    fprintf(stderr, "< %s at %s:%d (entered at line %d)\n", funcname, file, line, line_stack[imp_trace_level]);
  }
  return 0; // do not change from 0.
}

int _imp_trace_enter(int line, char *file, char *funcname) {

  if (_imp_control & _IMP_CONTROL_TRACE) {
    int i = 0;
    while (i++ < imp_trace_level) fputc(' ', stderr);
    fprintf(stderr, "> %s at %s:%d\n", funcname, file, line);
  }
  
  if (imp_trace_level < MAX_TRACE_DEPTH) {
    funcname_stack[imp_trace_level] = funcname;
    file_stack[imp_trace_level] = file;
    line_stack[imp_trace_level] = line;
  }
  imp_trace_level++; // we keep track of greater depths, we just can't print the full backtrace if asked
  
#ifdef NEVER // runaway recursion
  if (imp_trace_level == MAX_TRACE_DEPTH) {
    fprintf(stderr, "\nSEARCH HERE\n");
    do {
      imp_trace_exit(line,file,funcname);
    } while (imp_trace_level != 0);
    exit(0);
  }
#endif
  
  return 0;
}

void _imp_trace_backtrace(int n, int line, char *file, char *funcname) {
  int cur_level, max_level = imp_trace_level;

  fflush(stdout);
  fflush(stderr);
  fprintf(stderr, "\n\n*** MONITOR");
  if (n) fprintf(stderr, " %0d", n);
  fprintf(stderr, " ENTERED FROM IMP PROC/FN/MAP %s at %s:%d\n\n", funcname, file, line);

  if (max_level >= MAX_TRACE_DEPTH) {
    fprintf(stderr, "*** %d levels skipped\n", max_level - MAX_TRACE_DEPTH + 1);
    max_level = MAX_TRACE_DEPTH;
  }

  cur_level = max_level;
  do {
    cur_level -= 1;
    char *funcname = funcname_stack[cur_level];
    char *file = file_stack[cur_level];
    int line = line_stack[cur_level];
    if (funcname == NULL && file == NULL) {
      pmt();
      break;
    }
    fprintf(stderr, "%s at %s:%d\n", funcname, file, line);
  } while (cur_level > 0);

  fflush(stderr);
}

/////////////////////////////////////////////////////////////////////////////////// IMP SIGNALS

/*
    IMP SIGNALS (%on %event and %fault) are implemented using C's "longjump" mechanism.
    They may not behave identically to traditional Imp signals in all respects, but the
    behaviour is close enough in all but extreme pathological cases which I do not believe
    are encountered in any pre-existing Imp programs from the archive.

    C Signals may be used independently of Imp signals, allowing implementation of Unix
    style interfaces with the same semantics as C implementations.  However a module is
    provided which maps certain C signals to Imp signals if desired.  This allows us to
    catch errors such as accessing through a NULL pointer, or dividing by zero.

    Imp's unassigned variable checking and array bound checking can also be had at the
    expense of a significant runtime overhead and less readable C code.

    The readability of C code is a trade-off between the facilities desired and accuracy
    of the translation.  Command-line options allow for more idiomatic C (such as using
    C strings) and will warn in cases where 100% compatibility cannot be maintained.
 */

// this worked OK for %on %event but is problematic with %fault
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(EVENT.FILE,EVENT.LINE, EVENT.MESSAGE, EVENT.EVENT, EVENT.SUBEVENT, EVENT.EXTRA); // not claimed - pass it up the chain ...
  return 0;
}

int _imp_caught_fault(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);
  return (mask&(1<<event)) != 0;
}

void _signal_event(char *file, int line, _imp_string message, int event, int subevent, int extra) { // ints last in case we switch to stdargs
  _imp_on_event_handler *handler = global_handler;
  if (global_handler == NULL) {
    fprintf(stderr, "\n\n*** MONITOR ENTERED FROM IMP\n\n");
    if (message.cstr.s[0] == '\0') {
      fprintf(stderr, "%%signal %d,%d,%d at %s:%d\n", event, subevent, extra, file, line);
    } else {
      fprintf(stderr, "%%signal %d,%d,%d \"%s\" at %s:%d\n", event, subevent, extra, message.cstr.s, 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
  EVENT.EVENT = event;
  EVENT.SUBEVENT = subevent;
  EVENT.EXTRA = extra;
  EVENT.LINE = line;
  EVENT.MESSAGE = message;
  longjmp(handler->env, 1);
}

/////////////////////////////////////////////////////////////////////////////////// IMP STRINGS

int _imp_resolve(_imp_string s, _imp_string *left, _imp_string match, _imp_string *right) {
  return FALSE;
}

_imp_string _imp_join(_imp_string left, _imp_string right) {
  char temps[256];
  snprintf(temps, 255, "%s%s", _imp_cstr_safe(&left), _imp_cstr_safe(&right));
  return _imp_c2istr(temps);
}

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!
  }
}

/////////////////////////////////////////////////////////////////////////////////// I/O

// rest of PERMs

typedef struct _imp_filedata {
  int streamno;
  FILE *f;
  char *fname;
} _imp_filedata;

int     _imp_INSTREAM = 0,  _imp_OUTSTREAM = 0;
FILE    *INFILE = NULL,     *OUTFILE = NULL;
FILE    *_imp_INFILE,       *_imp_OUTFILE;
static _imp_filedata _imp_infile[256];
static _imp_filedata _imp_outfile[256];

static int _imp_files_initialised = 0; // Can initialise in main() now that we control it! And remove this overhead.

static void _imp_init_files(void) {
  if (_imp_files_initialised == 0) {
    int i;
    for (i = 0; i < 256; i++) {
      _imp_infile[i].f = NULL;
      _imp_infile[i].fname = "<null>";
      _imp_infile[i].streamno = i;
      _imp_outfile[i].f = NULL;
      _imp_outfile[i].fname = "<null>";
      _imp_outfile[i].streamno = i;
    }
    _imp_infile[0].f = fopen("/dev/tty", "r");
    _imp_infile[0].fname = "<console>";

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

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

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

    _imp_INSTREAM = 1; _imp_OUTSTREAM = 1;
    _imp_INFILE  = INFILE  = _imp_infile[_imp_INSTREAM].f;
    _imp_OUTFILE = OUTFILE = _imp_outfile[_imp_OUTSTREAM].f;
    _imp_files_initialised = 1;
    /*fprintf(stderr, "init: OUTFILE = %p\n", OUTFILE);*/
  }
}

//////////////////////////////////////////////////////////////////////////// PRIMS

double                   FLOAT(double N) { }
_imp_address             _imp_ADDR(void *P) { }
char                    *_imp_BYTE(_imp_address N) { }
char                    *_imp_BYTEINTEGER(_imp_address N) { }
short                   *_imp_SHORT(_imp_address N) { }
short int               *_imp_SHORTINTEGER(_imp_address N) { }
int                     *_imp_INTEGER(_imp_address N) { }
long                    *_imp_LONG(_imp_address N) { }
long int                *_imp_LONGINTEGER(_imp_address N) { }
long long               *_imp_LONGLONG(_imp_address N) { }
long long int           *_imp_LONGLONGINTEGER(_imp_address N) { }
float                   *_imp_REAL(_imp_address N) { }
double                  *_imp_LONGREAL(_imp_address N) { }
long double             *_imp_LONGLONGREAL(_imp_address N) { }
_imp_string             *_imp_STRING(_imp_address N) { }
void                    *_imp_RECORD(_imp_address N) { }
// These are Imp %maps hence address, not value.
// The #define equivalents however perform the indirection for you,
// to make the generated C look more readable.
char                    *_imp_LENGTH(_imp_string *S) { }
char                    *_imp_CHARNO(_imp_string *S, int N) { }

_imp_string              _imp_TOSTRING(int C) { _imp_string tmp = { {C} }; return tmp; }
_imp_string              SUBSTRING(_imp_string S, int FROM, int TO) { }   // also FROMSTRING ?
_imp_string              TRIM(_imp_string S, int MAX) { }

int                      _imp_TYPEOF(void *N) { }
int                      _imp_SIZEOF(void *N) { }

/////////////////////////////////////////////////////////////////////////////////// PERMS

double                   _imp_ARCSIN(double ANGLE) { return asin(ANGLE); }
double                   _imp_ARCCOS(double ANGLE) { return acos(ANGLE); }
double                   _imp_ARCTAN(double X, double Y) { return atan2(X, Y); }
double                   _imp_ARCTAN1(double ANGLE) { return atan(ANGLE); }
double                   _imp_SIN(double ANGLE) { return sin(ANGLE); }
double                   _imp_COS(double ANGLE) { return cos(ANGLE); }
double                   _imp_TAN(double ANGLE) { return tan(ANGLE); }

int                      IMOD(int I) { return I < 0 ? -I : I; } // %signal if MIN INT?
double                   MOD(double R) { return R < 0 ? -R : R; }
int                      REM(int P, int Q) { return /* P % Q ? */ P - ((int)(P/Q)*Q); }
double                   _imp_SQRT(double NUM) {
  return sqrt(NUM);
}
int                      ISQRT(int NUM) {
  return (int)round(sqrt(NUM));
}
int                      MULDIV(int A, int B, int C) { return (int)(((long long)A * (long long)B) / (long long)C); }

long int                 _imp_IEXP(int NUM, int POWER) { }
double                   _imp_REXP(double NUM, double POWER) { return pow(NUM, POWER); }

double                   LOG(double X) { }

/*
  Also in math.h ... ( need to link -lm ):

       double floor(double x);
       float floorf(float x);
       long double floorl(long double x);

       double trunc(double x);
       float truncf(float x);
       long double truncl(long double x);

       double round(double x);
       float roundf(float x);
       long double roundl(long double x);

       long int lround(double x);
       long int lroundf(float x);
       long int lroundl(long double x);

       long long int llround(double x);
       long long int llroundf(float x);
       long long int llroundl(long double x);

       double nearbyint(double x);
       float nearbyintf(float x);
       long double nearbyintl(long double x);

       double rint(double x);
       float rintf(float x);
       long double rintl(long double x);

       long int lrint(double x);
       long int lrintf(float x);
       long int lrintl(long double x);

       long long int llrint(double x);
       long long int llrintf(float x);
       long long int llrintl(long double x);

       double ceil(double x);
       float ceilf(float x);
       long double ceill(long double x);

 */

int                      INTPT(double R) {
  /* rounds *towards minus infinity* */
  assert(floor(R) <= R);
  return (int)floor(R);
}
int                      INT(double R) {
  return INTPT(R+0.5);
}
long int                 LINTPT(double R) {
  /* rounds *towards minus infinity* */
  assert(floor(R) <= R);
  return (long int)floor(R);
}
long int                 LINT(double R) {
  return LINTPT(R+0.5);
}
int                      TRUNC(double R) {
  // rounds *towards 0*
  return (int)trunc(R);
}
int                      ROUND(double R) {
  if (R < 0.0) {
    return TRUNC(R-0.5);
  } else {
    return TRUNC(R+0.5);
  }
}
double                   FRACTION(double R) {
  return R-TRUNC(R);
}
double                   FRACPT(double R) {
  return R-INTPT(R);
}

long long int            LENGTHENI(int i) {
  return (long long)i;
}

void                     PROMPT(_imp_string S) {
  _imp_init_files();
  /* requires that:
     1) outstream is TTY
     2) instream is same TTY
     3) There is no type-ahead detectable by the OS.
     If all those are true, output the prompt string to the TTY and flush output.
  */
}

int                      ENDOFINPUT(void) { }

void                     READSYMBOL(int *P) { // int * or char *? Hamish uses a %name which may be a better choice.
  _imp_init_files();
  int sym = -1;
  sym = fgetc(INFILE);
  if (sym < 0) _imp_signal(9,0,_imp_INSTREAM,_imp_str_literal("End of file")); // if signals not enabled, drop through
  *P = sym;
}
int                      NEXTSYMBOL(void) {
  _imp_init_files();
  int sym = -1;
  sym = fgetc(INFILE);
  if (sym < 0) _imp_signal(9,0,_imp_INSTREAM,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
  ungetc(sym, INFILE);
  return sym;
}
void                     SKIPSYMBOL(void) {
  _imp_init_files();
  int sym = -1;
  sym = fgetc(INFILE);
  if (sym < 0) _imp_signal(9,0,_imp_INSTREAM,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
}
void                     PRINTSYMBOL(char SYM) {
  _imp_init_files();
  int rc = fputc(SYM, OUTFILE);
  if (rc == EOF)  _imp_signal(9,1,_imp_OUTSTREAM,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
}
void                     READCH(int *P) {
  _imp_init_files();
  int sym = -1;
  sym = fgetc(INFILE);
  if (sym < 0) _imp_signal(9,0,_imp_INSTREAM,_imp_str_literal("End of file")); // if signals not enabled, drop through
  *P = sym;
}
int                      NEXTCH(void) {
  _imp_init_files();
  int sym = -1;
  sym = fgetc(INFILE);
  if (sym < 0) _imp_signal(9,0,_imp_INSTREAM,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
  ungetc(sym, INFILE);
  return sym;
}
void                     PRINTCH(char SYM) {
  _imp_init_files();
  int rc = fputc(SYM, OUTFILE);
  if (rc == EOF)  _imp_signal(9,1,_imp_OUTSTREAM,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
}

void                     SPACE(void) {
  _imp_init_files();
  int rc = fputc(' ', OUTFILE);
  if (rc == EOF)  _imp_signal(9,1,_imp_OUTSTREAM,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
}
void                     SPACES(int N) {
  _imp_init_files();
  int rc = -1;
  while (N-- > 0) {
    rc = fputc(' ', OUTFILE);
    if (rc == EOF) {
      _imp_signal(9,1,_imp_OUTSTREAM,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
      break;
    }
  }
}
void                     NEWPAGE(void) {
  _imp_init_files();
  int rc = fputc('\f', OUTFILE);
  if (rc == EOF)  _imp_signal(9,1,_imp_OUTSTREAM,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
}
void                     NEWLINE(void) {
  _imp_init_files();
  int rc = fputc('\n', OUTFILE);
  if (rc == EOF)  _imp_signal(9,1,_imp_OUTSTREAM,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
}
void                     NEWLINES(int N) {
  _imp_init_files();
  int rc = -1;
  while (N-- > 0) {
    rc = fputc('\n', OUTFILE);
    if (rc == EOF) {
      _imp_signal(9,1,_imp_OUTSTREAM,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
      break;
    }
  }
}

void                     PRINTSTRING(_imp_string S) {
  _imp_init_files();
  fprintf(OUTFILE, "%s", _imp_cstr_safe(&S));
}

void                     READ_name(void *PTR, int PTR_typeof) {
  // READ: A perm/prim hybrid. The prim part is that a second parameter must be passed when a %name is in the parameter list.
  // fortunately there is no such thing as a simple generic %name variable, otherwise it would have to be implemented as a struct.
  _imp_init_files();
  /*
           0 - unknown type
           1 - integer
           2 - real
           3 - string
           4 - record
           5 - byte integer
           6 - short integer
           7 - long integer
           8 - long real
           9 - array
          10 - label
   */
  switch (PTR_typeof) {
  case 1:
    *(int *)PTR = fgetc(INFILE);
    break;

  case 2:
    *(float *)PTR = fgetc(INFILE);
    break;
        
  case 5:
    *(char *)PTR = fgetc(INFILE);
    break;
    
  case 6:
    *(short int *)PTR = fgetc(INFILE);
    break;
    
  case 7:
    *(long int *)PTR = fgetc(INFILE);
    break;
    
  case 8:
    *(double *)PTR = fgetc(INFILE);
    break;
#ifdef NEVER    
  case ?:
    *(long long int *)PTR = fgetc(INFILE);
    break;
    
  case ?:
    *(long double *)PTR = fgetc(INFILE);
    break;
    
  case ?:
    // C style string.  Not initially supported.
    _imp_signal(1, 0, 0, _imp_str_literal("READ() of C-style strings not supported in perms.c"));
    // Need to find an appropriate signal number.
    break;
    
  case ?:
#endif
    
  default: ;
#ifdef NEVER
    {
      char *cstring[256];
      // I need to check what READ(string) does in Imp.  I *think* it is the next block
      // of text with leading spaces and newlines skipped, up to the first space or newline.
      *(_imp_string *)PTR = _imp_str_literal("*READ ERROR*");
    }
#endif
  }
}

void                     _imp_WRITE(int V, int P) {
  _imp_init_files();
  /*fprintf(stderr, "write: OUTFILE = %p\n", OUTFILE);*/
  fprintf(OUTFILE, "%*d", P, V);
}

void                     PRINT(double R, int BEFORE, int AFTER) {
  _imp_init_files();
  //char format[256];
  //sprintf(format, "%%-%0d.%0df", TOTAL, AFTER);
  fprintf(OUTFILE, "%*.*f", BEFORE+AFTER, AFTER, R);
}

void                     PRINTFLOATING(double R, int BEFORE, int AFTER) {
  _imp_init_files();
  //char format[256];
  //sprintf(format, "%%-%0d.%0df", TOTAL, AFTER);
  fprintf(OUTFILE, "%*.*f", BEFORE+AFTER, AFTER, R);
}

void                     PRINTFL(double R, int PLACES) {
  _imp_init_files();
  fprintf(OUTFILE, "%.*f", PLACES, R);
}

void                     READITEM(_imp_string *S) { _imp_init_files(); }
_imp_string              NEXTITEM(void) { _imp_init_files(); }

void                     READSTRING(_imp_string *S) { _imp_init_files(); }
void                     READTEXT(_imp_string *STR, int DELIM) { // Read into a string up to but not including DELIM
  int S;
  int N;
  _imp_init_files(); 
  N = 0;
  for (;;) {
    READSYMBOL(&S);
    if (S == DELIM) break;
    N = N + 1;
    if (N > 255) _imp_signal(6, 1, 0, _imp_str_literal("String capacity exceeded"));
    STR->charno[N] = S;
  }
  STR->length = N;
}

void                     READLINE(_imp_string *S) { _imp_init_files(); }

int                      INSTREAM(void)      { _imp_init_files(); return _imp_INSTREAM; }
int                      OUTSTREAM(void)     { _imp_init_files(); return _imp_OUTSTREAM; }

int                      INPUTSTREAM(void)   { _imp_init_files(); return _imp_INSTREAM; }
int                      OUTPUTSTREAM(void)  { _imp_init_files(); return _imp_OUTSTREAM; }
_imp_string              INPUTNAME(void)     { _imp_init_files(); return _imp_c2istr(_imp_infile[_imp_INSTREAM].fname); }
_imp_string              OUTPUTNAME(void)    { _imp_init_files(); return _imp_c2istr(_imp_outfile[_imp_OUTSTREAM].fname); }
_imp_string              INFILENAME(void)    { _imp_init_files(); return _imp_c2istr(_imp_infile[_imp_INSTREAM].fname); }
_imp_string              OUTFILENAME(void)   { _imp_init_files(); return _imp_c2istr(_imp_outfile[_imp_OUTSTREAM].fname); }

void                     SELECTINPUT(int N)  { _imp_init_files(); if (N < 0) return; _imp_INSTREAM = N; _imp_INFILE = INFILE = _imp_infile[N].f;
                                               /*fprintf(stderr, "selectinput(%d): INFILE = %p\n", N, INFILE);*/ }
void                     SELECTOUTPUT(int N) { _imp_init_files(); if (N < 0) return; _imp_OUTSTREAM = N; _imp_OUTFILE = OUTFILE = _imp_outfile[N].f;
                                               /*fprintf(stderr, "selectoutput(%d): OUTFILE = %p\n", N, OUTFILE);*/ }

void                     OPENINPUT(int N, _imp_string FD) {
  _imp_init_files();
  FILE *f;
  f = fopen(_imp_cstr_safe(&FD), "r");
  //fprintf(stderr, "OPEN: '%s' -> %p\n", _imp_cstr_safe(&FD), f);
  if (f == NULL) {
    //fprintf(stderr, "      %p == NULL???\n", f);
    _imp_signal(9,0,N,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
  }
  _imp_infile[N].f = f;
  //fprintf(stderr, "      %p != NULL???\n", f);
}
void                     OPENOUTPUT(int N, _imp_string FD) {
  _imp_init_files();
  FILE *f;
  f = fopen(_imp_cstr_safe(&FD), "w");
  if (f == NULL) _imp_signal(9,1,N,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
  _imp_outfile[N].f = f;
}
void                     OPENBINARYINPUT(int N, _imp_string FD) {
  _imp_init_files();
  FILE *f;
  f = fopen(_imp_cstr_safe(&FD), "rb");
  if (f == NULL) _imp_signal(9,0,N,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
  _imp_infile[N].f = f;
}
void                     OPENBINARYOUTPUT(int N, _imp_string FD) {
  _imp_init_files();
  FILE *f;
  f = fopen(_imp_cstr_safe(&FD), "wb");
  if (f == NULL) _imp_signal(9,1,N,_imp_c2istr(strerror(errno))); // if signals not enabled, drop through
  _imp_outfile[N].f = f;
}
void                     DEFINEINPUT(int I, _imp_string SPEC) { _imp_init_files(); }
void                     DEFINEOUTPUT(int I, _imp_string SPEC) { _imp_init_files(); }

// throw away any pending input or output.
void                     ABANDONINPUT(void) { _imp_init_files(); }
void                     ABANDONOUTPUT(void) { _imp_init_files(); }

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

void                     CLOSEOUTPUT(void) {
  _imp_init_files();
  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 = OUTFILE = NULL;
  if (rc != 0) _imp_signal(9,1,_imp_OUTSTREAM,_imp_c2istr(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                     RESETINPUT(void) { _imp_init_files(); } // I think this is an fseek to 0L with SEEK_SET
void                     RESETOUTPUT(void) { _imp_init_files(); }

void                     COMPLETEINPUT(void) { _imp_init_files(); } // I think this is a fflush()
void                     COMPLETEOUTPUT(void) { _imp_init_files(); }

void                     INPUTPOSITION(void) { _imp_init_files(); } // ftell
void                     OUTPUTPOSITION(void) { _imp_init_files(); }
void                     POSITIONINPUT(int P) { _imp_init_files(); } // fseek
void                     POSITIONOUTPUT(int P) { _imp_init_files(); }

void                     SETINPUT(int P) {
  _imp_init_files();
  fseek (INFILE, P, SEEK_SET);
}

void                     SETOUTPUT(int P) {
  _imp_init_files();
  fseek (OUTFILE, P, SEEK_SET);
}

_imp_string              _imp_TIME(void) {
  _imp_string temp;
  time_t rawtime;
  struct tm *ptm;
  
  if ((rawtime=time(NULL)) == -1)        { _imp_signal(0,0,0, _imp_str_literal("time() failed")); exit(EXIT_FAILURE); }
  if ((ptm=localtime(&rawtime)) == NULL) { _imp_signal(0,0,0, _imp_str_literal("localtime() failed")); exit(EXIT_FAILURE); }
  strftime(_imp_cstr_raw(&temp), 255, "%T", ptm);
  temp.length = strlen(_imp_cstr_raw(&temp));
  return temp;
}

_imp_string              _imp_DATE(void) {
  _imp_string temp;
  time_t rawtime;
  struct tm *ptm;

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

static char _imp_command_line[256] = { '\0' };
_imp_string              CLIPARAM(void) {
  return _imp_c2istr(_imp_command_line);
}

_imp_string              ITOS(int I, int Places) {
  char temps[256];
  sprintf(temps, "%*d", Places, I);
  return _imp_c2istr(temps);
}

int                      CPUTIME(void) { return clock(); } // Seconds * CLOCKS_PER_SEC

int                      EVENT_(void)       { return EVENT.EVENT; }
int                      SUBEVENT(void)     { return EVENT.SUBEVENT; }
int                      EVENTINFO(void)    { return EVENT.EXTRA; }
_imp_string              EVENTMESSAGE(void) { return EVENT.MESSAGE; } // though should be an _imp_string struct...

_imp_string              SSFMESSAGE(void)   { return _imp_c2istr(strerror(errno)); } // though should be an _imp_string struct...

void fault (const char *format, ...) /* Does not return */
{
  va_list args;
  int retval;
  fprintf(stderr, "\n* ");
  va_start (args, format);
  retval = vfprintf (stderr, format, args);
  va_end (args);
  fprintf(stderr, "\n");
  exit(0);
}

void warn (const char *format, ...) /* Returns */
{
  va_list args;
  int retval;
  fprintf(stderr, "\n? ");
  va_start (args, format);
  retval = vfprintf (stderr, format, args);
  va_end (args);
  fprintf(stderr, "\n");
}

extern int _imp_mainep(int argc, char **argv);
#include <unistd.h> // execve
int main(int argc, char *origargv[], char *envp[]) {

  _imp_init_files(); // Initialise Imp I/O streams.

  // The 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 as 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 - I think not needed but I
  // should do some experiments to see what it supports.  gdb is the only one that prints out the
  // local variables in a backtrace.
  
  // we have to copy argv because it is supposed to be in write-protected memory
  char *argv[argc+1]; // be careful not to declare anything at this level that would clutter the backtrace
  if ((argc >= 1) && (strcmp(origargv[argc-1], "--restarting-under-gdb")) != 0) { // initial invocation
    // the "--restarting-under-gdb" option is how the copy running under gdb knows
    // not to start another gdb process.
    int n;
    if ((argc > 1) && (strcmp(origargv[1], "--gdb") == 0)) {
      // running Imp program with --gdb as fist parameter allows ^C ^Z ^\ all to break in to debugger.
      char *gdb_interactive [] = {
        "/usr/bin/gdb", "-q", "-nx", "-nh", "-return-child-result",
        "-ex", "run",
        "-ex", "bt full",
        "--args"
      };
      int i;
      n = sizeof gdb_interactive / sizeof gdb_interactive[0];
      char *gdbargv[n+argc+2];
      for (i = 0; i < n; i++) gdbargv[i] = gdb_interactive[i];
      for (i = n; i < n+argc; i++) gdbargv[i] = origargv[i-n+1]; // skip --gdb
      gdbargv[n] = origargv[0];
      gdbargv[n+argc-1] = "--restarting-under-gdb";
      gdbargv[n+argc] = NULL;
      //fprintf(stderr, "RESTART1: "); i = 0; while (gdbargv[i] != NULL) fprintf(stderr, "%s ", gdbargv[i++]);fprintf(stderr, "\n"); 
      execve("/usr/bin/gdb", gdbargv, envp);
    } else if ((argc > 1) && ((strcmp(origargv[1], "--nogdb") == 0) || (strcmp(origargv[1], "--no-gdb") == 0))) {
      // Invoking --nogdb runs with no gdb involvement at all.
      // "--nogdb" is removed from the argv that the user sees.
      int i;
      argv[0] = origargv[0];
      for (i = 1; i <= argc; i++) argv[i] = origargv[i+1];
      argc -= 1;  // skip --no-gdb
      //fprintf(stderr, "RESTART2: "); i = 0; while (argv[i] != NULL) fprintf(stderr, "%s ", argv[i++]);fprintf(stderr, "\n"); 
    } else {
      // by default Imp programs will run with backtrace enabled via gcc, on a crash, ^C, ^Z, or ^\.
      char *gdb [] = {
        "/usr/bin/gdb", "-q", "-batch", "-nx", "-nh", "-return-child-result",
        "-ex", "run",
        "-ex", "bt full",
        "--args"
      };
      int i;
      n = sizeof gdb / sizeof gdb[0];
      char *batchargv[n+argc+2];
      for (i = 0; i < n; i++) batchargv[i] = gdb[i];
      for (i = 0; i < argc; i++) batchargv[n+i] = origargv[i];
      batchargv[n+argc] = "--restarting-under-gdb";
      batchargv[n+argc+1] = NULL;
      //fprintf(stderr, "RESTART3: "); i = 0; while (batchargv[i] != NULL) fprintf(stderr, "%s ", batchargv[i++]);fprintf(stderr, "\n"); 
      execve("/usr/bin/gdb", batchargv, envp);
    }
    // Drop through if gdb fails to start
  } else { // patch up argc/argv while avoiding any local declarations that would end up in backtrace.
      int i;
      for (i = 0; i < argc; i++) argv[i] = origargv[i];
      //{int i;fprintf(stderr, "BEFORE%0d:", argc); for (i = 0; i < argc; i++) fprintf(stderr, "%s ", argv[i]);fprintf(stderr, "\n");}
      argv[argc-1] = NULL;
      argc -= 1;  // remove --restarting-under-gdb from what the user program sees
      //{int i;fprintf(stderr, "AFTER%0d:", argc); for (i = 0; i < argc; i++) fprintf(stderr, "%s ", argv[i]);fprintf(stderr, "\n");}
  }

  if ((argv[1] != NULL) && (strcmp(argv[1], "--trace") == 0)) {
    int i;
    _imp_control |= _IMP_CONTROL_TRACE;
    for (i = 2; i <= argc; i++) argv[i-1] = argv[i];
    argc -= 1;
    fprintf(stderr, "*** IMP TRACE FACILITY STARTED\n\n");
  }
  //{ int i = 0; while (argv[i]) { fprintf(stderr, "\"%s\" ", argv[i]); i += 1 ;  }; fprintf(stderr, "\n"); }
  // We are now running under gdb if required and if supported.

  {int i; // create 'cli param' the hard way.
    _imp_command_line[0] = '\0';
    for (i = 1; i < argc; i++) {
      if (strlen(argv[i]) + strlen(_imp_command_line) < 254) strcat(_imp_command_line, argv[i]);
      if (i < argc-1) {
        if (1 + strlen(_imp_command_line) < 254) strcat(_imp_command_line, " ");
      }
    }
  }
  
  //{int i;fprintf(stderr, "ARGV%0d:", argc); for (i = 0; i < argc; i++) fprintf(stderr, "%s ", argv[i]);fprintf(stderr, "\n");}
  return _imp_mainep(argc, argv); // Invoke user program (%begin/%endofprogram)  (Oops - forgot envp)
}
