/* Copyright (C) 1991-99 Free Software Foundation, Inc.

   This file is part of GNU Pascal Library.

   RTS initialization. Interrupt handlers.

The GNU Pascal Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.

The GNU Pascal Library 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
Library General Public License for more details.

You should have received a copy of the GNU Library General Public
License along with the GNU Pascal Library; see the file COPYING.LIB.  If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA.  */

#include "rts.h"
#include <sys/stat.h>
#include "fdr.h"
#include <locale.h>

#if defined (_WIN32) && !defined (CYGWIN32)
#include <process.h>
#endif

#define SIGTOMASK(n) (1<<((n) - 1))
#define NASSOC 32

int     _p_signal    = 0; /* Use _p_sigcause if this signal appears */
int     _p_sigcause  = 0; /* Number of error message to give if _p_signal */
int     _p_debug     = 0;
int     _p_warn      = 0; /* if nonzero output runtime warnings */
int     _p_argc      = 1;
int     _p_pid       = - 1;
char    *_p_argv_dummy [] = { "GPC program", NULL }, *_p_envp0_dummy = NULL;
char    **_p_argv = _p_argv_dummy, **_p_envp = &_p_envp0_dummy;

/* Set to 1 if you want to use the EOLN hack by default.
 *
 * If 0: EOLN will validate the file buffer if tst_UND
 *
 * If 1, when EOLN is tested when all of the following TRUE
 *       1) tst_UND
 *       2) tst_EMPTY (nothing has been read after reset)
 *       3) tst_TXT
 *       4) tst_TTY
 *       5) tst_LGET
 *
 *       If these are TRUE, then the EOLN test return TRUE.
 *
 *       If the EOLN is *not tested* it is FALSE. This is
 *       to make the program with 'if eoln then readln;' in the
 *       very beginning work, they skip the eoln when they test
 *       it, if you don't test, you don't have to skip it.
 */
int _p_eoln_reset_hack = 0;

/* 1 if direct access routines should work only for direct access files. */
int _p_force_direct_files = 0;

/* Program standard input, output and error */
struct Fdr
  _p_stdin  = { 0, 0, 0, 0, 0, 0, 0, "uninitialized Input", 0, 0, FiNOP, 0, 0, 0, 0,
                0, 0, 0, 0, 0, 0, 0, 0, 0 },
  _p_stdout = { 0, 0, 0, 0, 0, 0, 0, "uninitialized Output", 0, 0, FiNOP, 0, 0, 0, 0,
                0, 0, 0, 0, 0, 0, 0, 0, 0 },
  _p_stderr = { 0, 0, 0, 0, 0, 0, 0, "uninitialized StdErr", 0, 0, FiNOP, 0, 0, 0, 0,
                0, 0, 0, 0, 0, 0, 0, 0, 0 };

FILE *_p_current_stdin = NULL;

/* FDR list head pointers.
   Add an FDR to the list when reset/rewritten, remove it on close.
   List is needeed to flush buffered output to terminal
    1) when program crashes, dump everything before giving error message
    2) when something is read from terminal opened as a TEXT file
       (need to flush output from other TTY files before get)
*/
FDR LastFdr  = NULL;
FDR FirstFdr = NULL;

#ifdef BSD_RTS
static void     _p_handler();
static int      sigvecn();
#endif

extern char     *optarg;
extern int       optind;
extern int       opterr;

assoc _p_assoc_dummy = { NULL, NULL };
assoc *_p_assoc = &_p_assoc_dummy;

void *
_p_default_malloc (size)
     size_t size;
{
  void *ptr = malloc ((size_t) size);
  if (!ptr)
    _p_error_integer (853, (long int) size); /* out of heap when allocating %d bytes */
  return ptr;
}

void
_p_init_heap ()
{
  static int init_heap_done = 0;
  if (init_heap_done) return;
  init_heap_done++;
#if 0
  malloc_init (0, _p_heap_warning);
#endif
  _p_heap_init ();
}

void
_p_init_env (envp)
char **envp;
{
  if (envp) _p_envp = envp;
}

void
_p_init_arguments (argc,argv)
int argc;
char **argv;
{
  int    c;
  int    eflag = 0;
  char  *p;
  int    skip_args = 0;
  int    noskip = 0;
  assoc *ap;
  FILE  *StdFile = 0;    /* -i option strings written here, and given as */
                         /* standard input for user program */

  static int args_done = 0;
  if (args_done || !argv) return;
  args_done++;

  _p_pid = getpid ();

  _p_init_heap ();

  _p_assoc = (assoc*) _p_malloc (NASSOC * sizeof (assoc));
  ap = _p_assoc;
  ap->int_name = NULL;

  /* Simple options for the run time system from command line
   * Since the normal use of the command line is pass args to
   * the user program, passing args to the runtime system
   * is made somewhat complicated:
   * First arg has to be:
   *
   * -Grts
   *
   * Other flags that the rts recognizes (if the first
   * arg is -Grts are output with '-h' option) (see below).
   *
   * --              : indicates end of rts parameters.
   */

  opterr = 0;
  if (argc > 1 && _p_strcmp (argv[1], "-Grts") == 0)
    while ((c = getopt (argc,argv, "edwfsNhi:a:G:")) != EOF)
      {
        skip_args++;
        switch (c)
          {
            case 'G':
              if (skip_args != 1 || _p_strcmp (optarg, "rts"))
                {
                  /* Arg is not for us, so get out */
                  optind--;
                  goto wilderness;
                }
              break;

            case 's':
              noskip++;
              break;

            case 'e':
              _p_eoln_reset_hack = !_p_eoln_reset_hack;
              D(1, fprintf(stderr,"Special EOLN handling after reset turned %s\n",
                           _p_eoln_reset_hack ? "ON" : "OFF"));
              break;

            case 'f':
              _p_force_direct_files = !_p_force_direct_files;
              D(1, fprintf(stderr,"Forcing direct access files: %s\n",
                           _p_force_direct_files ? "ON" : "OFF"));
              break;

            case 'N':
              _p_no_constructors++;
              break;

            case 'i':
              if (!StdFile)
                {
                  char *name = _p_get_temp_file_name_cstring ();

                  D(1, fprintf(stderr,"Opening file `%s' for -i options\n", name));
                  if (!(StdFile = fopen(name, "w+")))
                    {
                      _p_warning ("Can't open option file for writing (-i)");
                      _p_dispose (name);
                      continue;
                    }
                  D(1, fprintf(stderr,"stdin will read from file `%s'\n", name));
                  unlink (name);
                  _p_dispose (name);
                }

              D(1,fprintf(stderr,"-i option line: `%s'\n", optarg));
              fputs(optarg, StdFile);
              fputs("\n", StdFile);
              break;

            case 'd':
              _p_debug++;
              break;

            case 'w':
              _p_warn++;
              break;

            case 'a':
              if ((p = strchr (optarg, ':'))) /* Assignment */
                {
                  *p++ = '\0';
                  if (ap >= &_p_assoc[NASSOC - 1])
                    _p_warning ("Too many associated file names (-a)");
                  else
                    {
                      ap->int_name = optarg;
                      ap->ext_name = p;
                      D(1,fprintf(stderr,"Associated file: `%s' -> `%s'\n",
                                  ap->int_name, ap->ext_name));
                      ap++;
                      ap->int_name = NULL;
                    }
                }
              break;

            case 'h':
              eflag++;
              break;

            default:
              optind--;
              goto wilderness;
          }
      }
  wilderness:;

  if (eflag)
    {
      fprintf (stderr, "Allowed Gnu Pascal program command line options for run time system:\n"
                       " -h : Give this help text and exit(1)\n"
                       " -d : Debug flag (one or more) Internal RTS reports\n"
                       " -w : Give runtime warning messages\n"
                       " -e : toggle EOLN handling right after reset for TTY\n"
                       " -f : toggle forcing direct access files\n"
                       " -s : Let the program see RTS command line arguments\n"
                       " -i : Each option makes one line to standard input\n"
                       " -a : Associate file names. -a Pascal_File:External_Name\n"
                       " -N : don't run the module initializer code (DEBUG)\n"
                       " -- : Rest of the args are not for the run time system\n");
      exit (1);
    }

  _p_argc = argc;
  _p_argv = argv;

  /* Make run time system args invisible to the program
   *
   * I am not certain that you want this.
   * If you don't, give the '-s' parameter.
   */
  if (skip_args && !noskip)
    {
      int i;
      int valid = optind;

      for (i = 1; i <= _p_argc - optind; i++) /* leave arg 0 as it is */
        _p_argv [i] = _p_argv [valid++];

      _p_argc -= optind - 1;
    }

  if (StdFile)
    {
      /* Rewind the -i ARG file */
      rewind(StdFile);

      /* Use this for standard input */
      _p_current_stdin = StdFile;
    }
}

void
_p_init_locale ()
{
  setlocale (LC_ALL, "");
}

void _p_init_signals ()
{
#ifdef BSD_RTS
  static int signals_done = 0;
  if (signals_done) return;
  signals_done++;
  sigvecn(SIGTOMASK(SIGHUP)
         |SIGTOMASK(SIGINT)
      /* |SIGTOMASK(SIGQUIT) */
         |SIGTOMASK(SIGILL)
         |SIGTOMASK(SIGTRAP)
         |SIGTOMASK(SIGIOT)
         |SIGTOMASK(SIGEMT)
         |SIGTOMASK(SIGFPE)
         |SIGTOMASK(SIGBUS)
         |SIGTOMASK(SIGSEGV)
         |SIGTOMASK(SIGSYS)
         |SIGTOMASK(SIGPIPE)
         |SIGTOMASK(SIGTERM)
         |SIGTOMASK(SIGXCPU)
         |SIGTOMASK(SIGXFSZ),_p_handler);
#endif
}

void
_p_initialize_std_files ()
{
  static int init_std_files_done = 0;
  if (init_std_files_done) return;
  init_std_files_done++;

  /* Open standard output */
  _p_initfdr (&_p_stdout, "Output", 8, STD_FILE_FLAGS);
  _p_rewrite (&_p_stdout, NULL, 0);

  /* Open standard input */
  _p_initfdr (&_p_stdin, "Input", 8, STD_FILE_FLAGS);
  _p_reset   (&_p_stdin, NULL, 0);

  /* Open standard error */
  _p_initfdr (&_p_stderr, "StdErr", 8, STD_FILE_FLAGS);
  _p_rewrite (&_p_stderr, NULL, 0);
}

void
_p_init_std_files ()
{
  /* Initialize standard input, output and error */
  _p_initialize_std_files ();
  _p_check_inoutres ();
}

void
_p_init_files_atexit ()
{
  static int files_atexit_done = 0;
  if (files_atexit_done) return;
  files_atexit_done++;
  atexit (_p_done_files);
}

void
_p_initialize (argc,argv,envp)
int argc;
char **argv;
char **envp;
{
  _p_init_heap ();
  _p_init_env (envp);
  _p_init_arguments (argc,argv);
  _p_init_locale ();
  _p_init_signals ();
  _p_init_std_files ();
  _p_init_files_atexit ();
  _p_run_constructors (); /* Run possible pascal module initializers */
}

/* One time routine that restores the
 * original standard input if we are not reading from there now.
 *
 * -i ARG uses this.
 */
int
_p_restore_stdin (File)
FDR File;
{
  if (!_p_current_stdin)
    return 0;

  _p_current_stdin = NULL;
  File->PrivateData = m_FILNUM (File) = stdin;

  return 1;
}

void
_p_exit (n)
int n;
{
  exit (n);
}

void
_p_done_files ()
{
  FDR scan, next;
  _p_fflush(FALSE);
  /* clean up all open files */
  for (scan = FirstFdr; scan; )
    {
      next = m_NXTFDR (scan); /* m_NXTFDR (scan) will be destroyed by _p_donefdr () */
      if (scan != &_p_stdin && scan != &_p_stdout && scan != &_p_stderr) /* @@ This is a kludge because of the wrong order of executing finalizers */
        _p_donefdr (scan);
      scan = next;
    }
}

void
_p_fflush(only_ttys)
Boolean only_ttys;  /* TRUE if flushing only terminals */
{
  FDR scan;

  /* DON't flush stdin; SunOS starts to behave strangely :-) */
  fflush(stdout);
  fflush(stderr);

  /* flush buffers to synchronize output messages */
  for (scan = FirstFdr; scan; scan = m_NXTFDR(scan))
    {
      if (m_STATUS(scan) & FiWRI && (!only_ttys || tst_TTY(scan)))
        {
          _p_flush(scan);
          D(3, fprintf(stderr, "Flushed output file `%s'\n",m_NAM(scan)));
        }
    }
}

#ifdef BSD_RTS
static void
clear_junk()
{
  _p_fflush(FALSE);
}

int
sigvecn(sigs,handler)
int     sigs;
void    (*handler)();
{
  register int    i;
  int     omask;
  struct sigvec   sv,osv;
  int     error = 0;

  omask = sigsetmask(-1);

  sv.sv_handler = (void *)handler;
  sv.sv_mask = sigs;
  sv.sv_onstack = 0;

  for (i=0;i<32;i++)
    if (sigs >> (i - 1) & 1)
      if (sigvec(i,&sv,&osv)) error++;
  sigsetmask(omask);
  return(error);
}

struct sig_expl
{
  int   sig,how,code,gpcn;
  char *expl;
} expls[] =
{
  {SIGHUP,  ABORT, NONE,             UND, "hangup"},
  {SIGINT,  ABORT, NONE,             FAST, "interrupt"},
  {SIGQUIT, ABORT, NONE,             UND, "quit"},
#ifdef vax
  {SIGILL,  ABORT, ILL_RESAD_FAULT,  UND, "reserved adressing"},
  {SIGILL,  ABORT, ILL_PRIVIN_FAULT, UND, "privileged instruction"},
  {SIGILL,  ABORT, ILL_RESOP_FAULT,  385, "reserved operand"},
#else
  {SIGILL,  ABORT, NONE,             UND, "illegal instruction"},
#endif
  {SIGTRAP, ABORT, NONE,             UND, "trap"},
  {SIGIOT,  ABORT, NONE,             UND, "iot"},
  {SIGEMT,  ABORT, NONE,             UND, "emt"},
#ifdef vax
  {SIGFPE,  ABORT, FPE_INTOVF_TRAP,  713, "integer overflow trap"},
  {SIGFPE,  ABORT, FPE_INTDIV_TRAP,  712, "integer divide by zero trap"},
  {SIGFPE,  ABORT, FPE_FLTOVF_TRAP,  715, "floating overflow trap"},
  {SIGFPE,  ABORT, FPE_FLTDIV_TRAP,  711, "floating divide by zero trap"},
  {SIGFPE, REPORT, FPE_FLTUND_TRAP,  716, "floating underflow trap"},
  {SIGFPE,  ABORT, FPE_DECOVF_TRAP,  UND, "decimal overflow"},
  {SIGFPE,  ABORT, FPE_SUBRNG_TRAP,  UND, "subscript"},
  {SIGFPE,  ABORT, FPE_FLTOVF_FAULT, 715, "floating overflow fault"},
  {SIGFPE,  ABORT, FPE_FLTDIV_FAULT, 711, "floating divide by zero fault"},
  {SIGFPE, REPORT, FPE_FLTUND_FAULT, 716, "floating underflow fault"},
#else
  {SIGFPE,  ABORT, NONE,             UND, "floating point trap"},
#endif
  {SIGKILL, ABORT, NONE,             UND, "kill"},
  {SIGBUS,  ABORT, NONE,             UND, "bus error"},
  {SIGSEGV, ABORT, NONE,             UND, "memory fault"},
  {SIGSYS,  ABORT, NONE,             UND, "bad system call"},
  {SIGPIPE, ABORT, NONE,             UND, "broken pipe"},
  {SIGALRM, ABORT, NONE,             UND, "alarm"},
  {SIGTERM, ABORT, NONE,             UND, "termination"},
  {SIGURG,  ABORT, NONE,             UND, "urgent"},
  {-1,      ABORT, NONE,             0,   0}
};

static void
_p_handler(sig,code,scp)
int               sig, code;
struct sigcontext *scp;
{
  struct sig_expl *p;
  int Warning;
  char *msg;

  for (p = expls; p->sig >= 0; p++)
    if (p->sig == sig && p->code == code)
      break;
  if (p->sig < 0) p = 0;
#if 0
  if (p && p->how == IGNORE)
    return;
#endif
  Warning = p && p->how == REPORT;
  D(1, fprintf(stderr, "_p_handler: Warning= %d\n", Warning));
  if (_p_signal == sig)
    {
      msg = _p_errmsg (_p_sigcause); /* Preset message number */
      _p_signal = 0;
    }
  else
    msg = (p ? ((msg = _p_errmsg(p->gpcn))?msg:p->expl) : 0); /* Try to give something out */
  _p_prmessage(msg, (p ? p->gpcn : UND), Warning);
  if (Warning) return;
  fprintf(stderr, (p && p->gpcn >= UND) ? "Exiting (with core dump)\n" : "Exiting\n");
  clear_junk();
  _cleanup(); /* In libc -> flsbuf.c */
  sigvecn(SIGTOMASK(SIGILL),SIG_DFL);
  if (p && p->gpcn >= UND)
    {
      sigsetmask(0);
      kill(getpid(), SIGILL);
    }
  exit(1);
}
#endif /* BSD_RTS */
