/*
     libscheme	
     Copyright (C) 1994 Brent Benson

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

     This program is distributed in the hope that it will be useful,
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     GNU General Public License for more details.

     You should have received a copy of the GNU General Public License
     along with this program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/

#include "empire.h"
#include "scheme.h"
#include <stdio.h>

/* globals */
jmp_buf scheme_error_buf;

/* locals */
static Scheme_Object *error (int argc, Scheme_Object *argv[]);

void
scheme_init_error (Scheme_Env *env)
{
  scheme_add_global ("error", scheme_make_prim (error), env);
}

void
scheme_signal_error (char *msg, ...)
{
  va_list args;
  va_start (args, msg);
  if (xIsUp) {
      vsprintf(messageStr, msg, args);
      showMessageLine();
  } else {
      /* fprintf (stderr, "error: "); */
      vfprintf (stderr, msg, args);
      fprintf (stderr, "\n");
  }
  va_end (args);
  longjmp (scheme_error_buf, 1);
}

static Scheme_Object *
error (int argc, Scheme_Object *argv[])
{
  int i;

  SCHEME_ASSERT ((argc > 0), "error: wrong number of args");
  SCHEME_ASSERT (SCHEME_STRINGP (argv[0]), "error: first arg must be a string");
  fprintf (stderr, "error: %s:", argv[0]);
  for ( i=1; i<argc ; ++i )
    {
      scheme_write (stderr, argv[i]);
    }
  fprintf (stderr, "\n");
  longjmp (scheme_error_buf, 1);
}

void 
scheme_default_handler (void)
{
  if (setjmp (scheme_error_buf))
    {
      abort ();
    }
}
