#define _GNU_SOURCE         /* See feature_test_macros(7) */
#include <string.h>
#include <stdlib.h>
#include <time.h>
#include <stdio.h>
#include <stdarg.h>
#include <ctype.h>

#include "internal.h"
#include "internalfile.h"
#include "imptypes.h"
#include "visible.h"
#include "psignal.h"

// TO DO: %name structures still have to be filled in by the compiler.
// for now, these will return invalid results.
int _imp_typeof(_imp_Name *N) { return N->typeinfo; }
int _imp_sizeof(_imp_Name *N) { return N->sizeinfo; }

// These should be moved into a C file, not this header file...:
const _imp_string _imp_typedesc[32] = {
      _imp_str_literal(""),
      _imp_str_literal("integer"),
      _imp_str_literal("real"),
      _imp_str_literal("string"),
      _imp_str_literal("record"),
      _imp_str_literal("byte integer"),
      _imp_str_literal("short integer"),
      _imp_str_literal("long integer"),
      _imp_str_literal("long real"),
      _imp_str_literal("array"),
      _imp_str_literal("label"),
      _imp_str_literal("unknown"),
      _imp_str_literal("unknown"),
      _imp_str_literal("unknown"),
      _imp_str_literal("unknown"),
      _imp_str_literal("unknown"),
      _imp_str_literal("name"),
      _imp_str_literal("integername"),
      _imp_str_literal("real name"),
      _imp_str_literal("string name"),
      _imp_str_literal("record name"),
      _imp_str_literal("byte integer name"),
      _imp_str_literal("short integer name"),
      _imp_str_literal("long integer name"),
      _imp_str_literal("long real name"),
      _imp_str_literal("array name"),
      _imp_str_literal("label name"),
      _imp_str_literal("unknown name"),
      _imp_str_literal("unknown name"),
      _imp_str_literal("unknown name"),
      _imp_str_literal("unknown name"),
      _imp_str_literal("unknown name"),
};

extern char *_imp_current_file;
extern int _imp_current_line;

// All imp output must go through this code so that OUTPOS can be kept up to date.
// It's an overhead but one I can live with.  Note that we probably don't care
// about OUTPOS when we know it's a binary file that is being written to.

// I'm not yet handling INPOS for input files and I don't think I will need to,
// it's not a particularly useful function.  Unless it's needed in order to handle
// prompts correctly?)  The wrapping of printf won't work as well for scanf.

// (btw old IMP programs used EM CHAR as the end of file marker!  Then again,
//  they were all also 7-bit ISO.)

void _imp_putchar(int ch /*, FILE *f*/) {
  // really only on text mode files, not binary output...
  int rc;
  rc = fputc(ch, _imp_outfile[_imp_OutStream].f);
  if (rc != EOF) {
    _imp_outfile[_imp_OutStream].lastchar = ch;
    if (ch == '\n' || ch == '\r' || ch == '\f') {
      _imp_outfile[_imp_OutStream].outpos = 0;
    } else if (ch == '\b') {
      _imp_outfile[_imp_OutStream].outpos -= 1;
    } else if (ch == '\t') {
      _imp_outfile[_imp_OutStream].outpos = (_imp_outfile[_imp_OutStream].outpos + 8) & (~7)  ;// at least on linux
    } else {
      _imp_outfile[_imp_OutStream].outpos += 1;
    }
  }
}


// TO DO !!!!!

// Best Practices for va_list:  When intercepting variadic functions like vprintf,
// remember that va_list is a pointer-like object. If you need to read the arguments
// (e.g., to log them) and pass them to the real vprintf, you must first duplicate
// the argument list using va_copy and clean up with va_end to prevent memory corruption:

// https://stackoverflow.com/questions/10807310/platform-inconsistencies-with-vsprintf-and-va-list
// https://onlinedocs.microchip.com/oxy/GUID-07E1F2AB-C1A0-411C-966F-8738802C42B9-en-US-4/GUID-24E22499-EAEA-4FB2-A99D-739C4A28D618.html
// https://bumbershootsoft.wordpress.com/2022/07/24/custom-printf-wrapping-variadic-functions-in-c/

//va_list ap_copy;
//va_copy(ap_copy, ap);
// Now you can safely use ap_copy with va_arg() or similar,
// while ap goes to the original vprintf.
//va_end(ap_copy);


int _imp_printf(char *s, ...)
{
  /* Size the string by vfprint'ing it to /dev/null... */
  /* then malloc an appropriate area                   */
  char *APPROPRIATE_STRING;
  va_list ap;
  static FILE *nullfile = NULL;
  int string_length;

  if (nullfile == NULL) nullfile = fopen("/dev/null", "w");
  if (nullfile == NULL) {
    fprintf(stderr, "Major error - cannot open /dev/null\n");
    fflush(stderr);
    exit(EXIT_FAILURE);
  }
  va_start(ap, s);
  string_length = vfprintf(nullfile, s, ap);
  va_end(ap);
  /* fclose(nullfile); */
  APPROPRIATE_STRING = malloc(string_length+1);
  va_start(ap, s);
  vsprintf(APPROPRIATE_STRING, s, ap);
  va_end(ap);
  int len = 0;
  s = APPROPRIATE_STRING;
  for (;;) {
    if (*s == '\0') break;
    _imp_putchar(*s++ /*, _imp_OutFile*/); // This will handle outpos for us.
  }
  free(APPROPRIATE_STRING);
  return s-APPROPRIATE_STRING; // *should* be equal to string_length
}


_imp_string _imp_formatf(char *s, ...)
{
  /* Size the string by vfprint'ing it to /dev/null... */
  /* then malloc an appropriate area                   */
  _imp_string temp;
  char *APPROPRIATE_STRING;
  va_list ap;
  static FILE *nullfile = NULL;
  int string_length;

  if (nullfile == NULL) nullfile = fopen("/dev/null", "w");
  if (nullfile == NULL) {
    fprintf(stderr, "Major error - cannot open /dev/null\n");
    fflush(stderr);
    exit(EXIT_FAILURE);
  }
  va_start(ap, s);
  string_length = vfprintf(nullfile, s, ap);
  va_end(ap);
  /* fclose(nullfile); */
  APPROPRIATE_STRING = malloc(string_length+1);
  va_start(ap, s);
  vsprintf(APPROPRIATE_STRING, s, ap);
  va_end(ap);
  int len = 0;
  s = APPROPRIATE_STRING;
  for (;;) {
    if (*s == '\0') break;
    temp.charno[len] = *s;
    if (len == 255) break;
    len += 1; s += 1;
  }
  temp.charno[0] = len;
  free(APPROPRIATE_STRING);
  return temp;
}



int _imp_getchar(FILE *f) { // TO DO: fscanf etc
  int ch, next;
  _imp_infile[_imp_InStream].lastchar = ch = fgetc(f);
  _imp_infile[_imp_InStream].nextchar = -1;
  // TO DO: only if lastchar was not \n ?
  //_imp_infile[_imp_InStream].nextchar = next = fgetc(f); if (next != EOF) ungetc(next, f);
  if (ch == EOF) return EOF; 
  if (ch == '\n' || ch == '\r') {
    _imp_infile[_imp_InStream].inpos = 0;
  } else {
    _imp_infile[_imp_InStream].inpos += 1;
  }
  _imp_infile[_imp_InStream].nextchar = -1; // it is only set by 'nextsymbol' (and even there, currently not really needed as we don't use it on a read yet.)
  return ch;
}

unsigned char *_imp_length(_imp_string *str) {
  return &str->length;
}

unsigned char *_imp_charno(_imp_string *str, int pos) {
  return &str->charno[pos];
}

_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;
}

// 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(EXIT_FAILURE);
//}

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

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

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

int _imp_nextsymbol(void) {
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  int ch = _imp_getchar(_imp_InFile);
  if (ch == EOF) {
    _imp_signal(9, 2, _imp_InStream, strerror(errno));
    exit(EXIT_FAILURE);
  }
  ungetc(ch, _imp_InFile);
  _imp_infile[_imp_InStream].nextchar = ch;
  return ch;
}

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

void _imp_skipsymbol(void) {
  int ch;
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  ch = _imp_getchar(_imp_InFile);
  if (ch == EOF) {
    _imp_signal(9, 2, _imp_InStream, strerror(errno));
    exit(EXIT_FAILURE);
  }
}
      
void _imp_printsymbol(char SYM) {
  if (_imp_OutFile == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(EXIT_FAILURE);
  }
  _imp_putchar(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(EXIT_FAILURE);
  }
  _imp_putchar(SYM /*, _imp_OutFile*/);
  if (_imp_OutStream == 0) fflush(_imp_OutFile);
}

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

// experimenting with different ways to handle long integers:
void _imp_writeint(int V, int P) { // TO DO: longinteger
  if (_imp_OutFile == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(EXIT_FAILURE);
  }
  _imp_printf(P < 0 ? "%*d" : " %*d", P, V);
  if (_imp_OutStream == 0) fflush(_imp_OutFile);
} // or swap.

void _imp_writelong(long long int V, int P) { // TO DO: longinteger
  if (_imp_OutFile == NULL) {
    fprintf(stderr, "* OUTFILE (stream %d) is NULL\n", _imp_OutStream);
    exit(EXIT_FAILURE);
  }
  _imp_printf(P < 0 ? "%*lld" : " %*lld", 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_readstring(_imp_string *S) { // Read a quoted string.
  int sym, pos=0;
  // quoted string
  check_instream(__PRETTY_FUNCTION__);
  _imp_issue_prompt();
  for (;;) {
    _imp_readsymbol(&sym);
    if (sym == '"') break;
    if (!(sym == ' ' || sym == '\t' || sym == '\n' || sym == '\f')) {
      // signal that there was an unwanted symbol in the data -
      // only a quoted string or whitespace is allowed.
    }
  }
  *_imp_length(S) = 0;
  *_imp_charno(S,++pos) = sym;
  do {
    _imp_readsymbol(&sym);
    *_imp_charno(S,++pos) = sym;
  } while(sym != '"');
  *_imp_length(S) = pos;
}

void _imp_readtext(_imp_string *S, int DELIM) { // I'm not sure what this call is supposed to do.
  int sym, pos=0;
  check_instream(__PRETTY_FUNCTION__);          // I think I'll temporarily implement something like 'read word'...
  _imp_issue_prompt();
  for (;;) {
    _imp_readsymbol(&sym);
    if (!(sym == ' ' || sym == '\t' || sym == '\n' || sym == '\f')) {
      break;
    }
  }
  *_imp_length(S) = 0;
  *_imp_charno(S,++pos) = sym;
  for (;;) {
    sym = _imp_nextsymbol();
    if (sym == ' ' || sym == '\t' || sym == '\n' || sym == '\f') break;
    _imp_skipsymbol();
    *_imp_charno(S,++pos) = sym;
  }
  *_imp_length(S) = pos;
}

_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 = _imp_getchar(_imp_InFile);
    if (ch == EOF) {
      _imp_signal(9, 1, 0, "EM CHAR IN STMNT - DISASTER");
      exit(EXIT_FAILURE);
    }
    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
    exit(EXIT_FAILURE);
  }
  _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
    exit(EXIT_FAILURE);
  }
  _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
    exit(EXIT_FAILURE);
  }
  _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
    exit(EXIT_FAILURE);
  }
  _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;
}

// I think define input & output may have been like the EMAS "define" command-line command.
// I believe it sets up the stream association (and probably opens the file) but does not select
// the stream, leaving the current INSTREAM unchanged.  (Not 100% sure of that however)

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(EXIT_FAILURE);
}

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(EXIT_FAILURE);
}

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.

  // I think on EMAS it wasn't possible to have the same number applied to both an input
  // and an output stream. (Not sure about stream 0 however.  Was the TTY special under EMAS?)
  
  // NOTE that this does not affect the current output stream (unless it *is* the current output stream)
  // so you might see a sequence such as select output(0); close stream(60) in an EMAS program.

  // Should I block closing stream 0?
  
  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));
      exit(EXIT_FAILURE);
    }
  } 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));
      exit(EXIT_FAILURE);
    }
  } 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));
    exit(EXIT_FAILURE);
  }
  // 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));
    exit(EXIT_FAILURE);
  }
  // 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(EXIT_FAILURE);
}

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

void _imp_resetinput(void) {
  int rc;
  check_instream(__PRETTY_FUNCTION__);
  rc = fseek(_imp_infile[_imp_InStream].f, 0L, SEEK_SET);
  // check rc & signal if needed
}
// *Is* there a RESET OUTPUT?

int _imp_inputposition(void) {    // ftell
  check_instream(__PRETTY_FUNCTION__);
  return ftell(_imp_InFile);
}

int _imp_outputposition(void) {
  check_outstream(__PRETTY_FUNCTION__);
  return ftell(_imp_InFile);
}

void _imp_setinput(int P) {
  int rc;
  check_instream(__PRETTY_FUNCTION__);
  rc = fseek (_imp_InFile, P, SEEK_SET);
  // check rc & signal if needed
}
void _imp_setoutput(int P) {
  int rc;
  rc = fseek (_imp_OutFile, P, SEEK_SET);
  // check rc & signal if needed
}

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(EXIT_FAILURE);
  }
  _imp_printf(" ");
  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(EXIT_FAILURE);
  }
  while (N --> 0) _imp_printf(" ");
  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(EXIT_FAILURE);
  }
  _imp_printf("\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(EXIT_FAILURE);
  }
  _imp_printf("\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(EXIT_FAILURE);
  }
  while (N --> 0) _imp_printf("\n");
  if (_imp_OutStream == 0) fflush(_imp_OutFile);
}

// The formatting of print/printfl may not match any of the historical IMP implementations.

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(EXIT_FAILURE);
  }
  _imp_printf("%*.*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(EXIT_FAILURE);
  }
  _imp_printf("%*.*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(EXIT_FAILURE);
  }
  _imp_printf("%*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(EXIT_FAILURE);
  }
  _imp_printf("%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");
    exit(EXIT_FAILURE);
  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");
    exit(EXIT_FAILURE);
  L_0005:
    if (FROM <= TO) goto L_0006;
    _imp_signal(5, 3, 0, "substring inside-out");
    exit(EXIT_FAILURE);
  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); }

void _imp_tolower(_imp_string *S) {
  unsigned char *P;
  for (int I = 1; I < *_imp_LENGTH(S); I++) {
    P = _imp_CHARNO(S, I);
    if (isalpha(*P) && isupper(*P)) *P = tolower(*P);
  }
}

void _imp_toupper(_imp_string *S) {
  unsigned char *P;
  for (int I = 1; I < *_imp_LENGTH(S); I++) {
    P = _imp_CHARNO(S, I);
    if (isalpha(*P) && islower(*P)) *P = toupper(*P);
  }
}

_imp_string _imp_trim(_imp_string S, int MAX) {
  if (MAX < 0) { _imp_signal(6, 2, MAX, ""); exit(EXIT_FAILURE); }
  if (*_imp_LENGTH( &S) > MAX) *_imp_LENGTH( &S) = MAX;
  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) {
  _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;
}

_imp_string _imp_eventmessage(void) {
  //return _imp_c2istr(_imp_event.MESSAGE);
  return _imp_event.MESSAGE;
}

_imp_string _imp_itos(int V, int P) {
  _imp_string temp;
  if (P >= 0) {
    sprintf(temp.cstr.s, " %*d", P, V);    // adds a single space
  } else {
    sprintf(temp.cstr.s, "%*d", -P, V);
  }
  temp.length = strlen(temp.cstr.s);
  temp.cstr.s[temp.length] = '\0'; // Needs an extra byte if 255 char string contents.  This is a hack for safety during development.
  return temp; /* should return actual string data via stack.  Not a pointer to a local that no longer exists by the time we return to the caller */
}

int _imp_stoi(_imp_string S) {  // probably should invent an STOL as well for long integers
  // Create a local buffer (ensure it accommodates src_len + 1)
  int len, val;
  char buff[256]; 

  len = *_imp_length(&S);
  memcpy(buff, _imp_charno(&S,1), len);
  buff[len] = '\0';

  if (sscanf(buff, "%d", &val) == 1) return val;
  // TO DO: signal unexpected data in input
  fprintf(stderr, "STOI fails - invalid data \"%s\"\n", buff);
  exit(EXIT_FAILURE);
}

// extracted from previous perms.c - needs altering for new scheme...
#include <unistd.h> // for readlink
#include <execinfo.h>  // backtrace, backtrace_symbols_fd
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <string.h>
#include <limits.h>

// *** TO DO ***
// This was doing a lightweight backtrace the hard way.  It can now
// be replaced by using print_back_trace(void) from pbacktrace.[hc]

void _imp_generic_backtrace(void) {
  
  //if (!RUNNING_ON_VALGRIND) {
  //  fprintf(stderr, "BACKTRACE NOT AVAILABLE\n\n");
  //  exit(EXIT_FAILURE);
  //}

  // 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(EXIT_FAILURE);
  }
  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(EXIT_FAILURE);
  }

  // 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);
    }
  }
}

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(EXIT_FAILURE); }
  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(EXIT_FAILURE); }

  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(EXIT_FAILURE);
}

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(EXIT_FAILURE); }
  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(EXIT_FAILURE); }

  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(EXIT_FAILURE);
}

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(EXIT_FAILURE); }
  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(EXIT_FAILURE); }

  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(EXIT_FAILURE);  
}

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

// We're using GCC's unassing pattern (FEFEFEFE) rather than Imp's (80808080)

// 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 (unass == 0) unass = 0xfefefefe;
  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;
}

/* Software License Agreement
 * 
 *     Copyright(C) 1994-2019 David Lindauer, (LADSoft)
 * 
 *     This file is part of the Orange C Compiler package.
 * 
 *     The Orange C Compiler package 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.
 * 
 *     The Orange C Compiler package 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 Orange C.  If not, see <http://www.gnu.org/licenses/>.
 * 
 *     As a special exception, if other files instantiate templates or
 *     use macros or inline functions from this file, or you compile
 *     this file and link it with other works to produce a work based
 *     on this file, this file does not by itself cause the resulting
 *     work to be covered by the GNU General Public License. However
 *     the source code for this file must still be made available in
 *     accordance with section (3) of the GNU General Public License.
 *     
 *     This exception does not invalidate any other reasons why a work
 *     based on this file might be covered by the GNU General Public
 *     License.
 * 
 *     contact information:
 *         email: TouchStone222@runbox.com <David Lindauer>
 * 
 */

char *_c_itoa(int value, char *dest, int base) {
  // 0-9A-Za-z
  char buf2[256], *idest = dest;
  int ch, len = 0, pos = 0;
  if ((2 <= base) && (base <= ('9'-'0'+1) + ('Z'-'A'+1)*2)) {
    unsigned int t = value;
    if (value == 0) {
      *dest++ = '0';
    } else {
      if (value < 0) { *dest++ = '-'; t = -value; }
      while (t > 0) { buf2[len++] = t % base; t /= base; }
      while (--len >= 0) {
        ch = buf2[len];
        if ((0 <= ch) && (ch <= 9)) {
          *dest++ = ch+'0';
        } else if ( 'A'-'A' <= (ch-10) && (ch-10) <= 'Z'-'A') {
          *dest++ = (ch-10)+'A';
        } else {
          *dest++ = (ch-10-('Z'-'A')+1)+'a';
        }
      }
    }
    *dest = '\0';
  } else {
    // Invalid base
    strcpy(idest, "<ERROR>");
  }
  return idest;
}