#include <stdio.h>
#include <sys/param.h>
#include "guile.h"
#include "setjump.h"

void scm_init_guile ();
static char version_string[] = "GNU Guile, version ii";
static char *small_version_string = (version_string
				     + sizeof ("GNU Guile, version"));


/* {Object Id's}
 *
 * An id is a name for an object.  By this interface, ids are explicitly
 * allocated and freed.  Any object can have any number of ids.
 * while an id is allocated, it protects the object to which it belongs.
 */

static SCM * indirects = 0;
static int free_indirect;
static SCM n_indirects;  /* Used as a C integer type...not as an SCM object */

long
gscm_mk_objid (obj)
     SCM obj;
{
  if (indirects == 0)
    {
      DEFER_INTS;
      indirects = scm_mkarray (256, 0);
      if (!indirects)
	{
	  ALLOW_INTS;
	  return -1;
	}
      n_indirects = 256;
      {
	int x;
	for (x = 0; x < 256; ++x)
	  indirects[x] = MAKINUM (x + 1);
	free_indirect = 0;
	n_indirects = 256;
      }
      ALLOW_INTS;
    }

  if (free_indirect == n_indirects)
    {
      /* This sucks: */
      if ((2 * n_indirects) > MOST_POSITIVE_FIXNUM)
	return -1;
      {
	SCM * new_indirects;
	DEFER_INTS;
	new_indirects = scm_mkarray (2 * n_indirects, 0);
	if (!new_indirects)
	  return -1;
	scm_free_array (indirects);
	indirects = new_indirects;
	{
	  int x;
	  x = n_indirects;
	  n_indirects *= 2;
	  while (x < n_indirects)
	    indirects[x] = MAKINUM (x + 1);
	  bcopy (indirects, new_indirects, 2 * n_indirects);
	}
	ALLOW_INTS;
      }
    }
  {
    int id;
    id = free_indirect;
    free_indirect = INUM (indirects[id]);
    indirects[id] = obj;
    return id;
  }
}

SCM
gscm_id2obj (n)
     long n;
{
  return indirects[n];
}

void
gscm_free_id (n)
     long n;
{
  indirects[n] = free_indirect;
  free_indirect = n;
}

void
gscm_id_reassign (n, obj)
     long n;
     SCM obj;
{
  indirects[n] = obj;
}


static char s_gscm_id[] = "%%gscm-indirect";
SCM
gscm_id (n)
     SCM n;
{
  int cn;
  ASSERT (INUMP (n), n, ARG1, s_gscm_id);
  cn = INUM (n);
  ASSERT (!((cn >= n_indirects) || (cn < 0)), n, OUTOFRANGE, s_gscm_id);
  return indirects [n];
}



extern int scm_verbose;
int gscm_default_verbosity = 2;

static char s_dflt_verbosity[] = "gscm-default-verbosity";
SCM 
gscm_dflt_verbosity ()
{
  return MAKINUM (gscm_default_verbosity);
}


void
gscm_verbosity (n)
     int n;
{

  gscm_default_verbosity = n;
}

void
gscm_with_verbosity (n, fn, data)
     int n;
     void (*fn)P((void *));
     void * data;
{
  int oldv;
  oldv = scm_verbose;
  scm_verbose = n;
  fn (data);
  scm_verbose = oldv;
}


/* {Initialization}
 */


/* Normally the default heap size is used (indicated by
 * passing 0 to scm_init_scm).  But applications can override 
 * this if they need to.
 */

static int init_heap_size = 0;  /* in units of 1024 bytes. */
static char init_file_name[MAXPATHLEN];
static int init_file_processed = 0;


void
gscm_set_init_heap_size (x)
     int x;
{
  init_heap_size = x;
}

int
gscm_init_heap_size ()
{
  return init_heap_size;
}
static char s_alarm[] = "alarm";
extern SCM *scm_loc_tick_signal;

char *getenv ();
char * gscm_last_attempted_init_file = "<none>";

GSCM_status
gscm_init_from_fn (initfile, argc, argv, init_fn)
     char *initfile;
     int argc;
     char **argv;
     void (*init_fn) ();
{
  int i;

  /* Init all the built-in parts of SCM. */
  scm_init_scm (scm_verbose, init_heap_size);

  /* Save the argument list to be the return value of (program-arguments).
   */
  progargs = makfromstrs (argc, argv);

  scm_exitval = MAKINUM (EXIT_SUCCESS);
  scm_errjmp_bad = 0;
  errno = 0;
  scm_alrm_deferred = 0;
  scm_sig_deferred = 0;
  scm_ints_disabled = 1;

#ifdef SIGALRM
  scm_make_subr (s_alarm, tc7_subr_1, scm_l_alarm);
#ifndef AMIGA
  scm_make_subr ("pause", tc7_subr_0, scm_l_pause);
#endif
#endif

#ifndef AMIGA
  scm_make_subr ("sleep", tc7_subr_1, scm_l_sleep);
#endif

  scm_make_subr ("raise", tc7_subr_1, scm_l_raise);
  
#ifdef TICKS
  scm_loc_tick_signal = &CDR (scm_sysintern ("ticks-interrupt", SCM_UNDEFINED));
  scm_make_subr ("ticks", tc7_subr_1o, scm_lticks);
#endif
  scm_init_variable();
  scm_init_gsubr();
  scm_init_sc2();
  scm_init_record();
  scm_init_kw();
  init_fn ();	/* call initialization of extensions files */
#ifdef DLD
  init_dynl ();
#else
#ifdef SUN_DL
  init_dynl ();
#endif
#endif

  if (initfile == NULL)
    {
      initfile = getenv ("SCM_INIT_PATH");
      if (initfile == NULL)
	initfile = IMPLINIT;
    }

  if (initfile == NULL)
    {
      init_file_processed = 1;
      return GSCM_OK;
    }
  else
    {
      int verb;
      GSCM_status status;
      SCM answer;

      gscm_last_attempted_init_file = initfile;
      verb = scm_verbose;
      scm_verbose = -1;
      init_file_processed = 0;
      strncpy (init_file_name, initfile, MAXPATHLEN);
      status = gscm_seval_file (&answer, -1, initfile);
      if ((status == GSCM_OK) && (answer == BOOL_F))
	status = GSCM_ERROR_OPENING_INIT_FILE;
      scm_verbose = verb;
      return status;
    }
}

void
gscm_take_stdin ()
{
  if (isatty(fileno(stdin))) setbuf(stdin, 0); /* turn off stdin buffering */
  scm_take_stdin = 1;
}

void
gscm_verbose (n)
     int n;
{
  scm_verbose = n;
}




/* {Managing Top Levels}
 */

struct seval_str_frame
{
  GSCM_status status;
  SCM * answer;
  GSCM_top_level top;
  char * str;
};

static void
_seval_str_fn (vframe)
     void * vframe;
{
  struct seval_str_frame * frame;
  frame = (struct seval_str_frame *)vframe;
  frame->status = gscm_seval_str (frame->answer, frame->top, frame->str);
}


GSCM_status
gscm_create_top_level (answer)
     GSCM_top_level * answer;
{
  SCM it;
  GSCM_status stat;
  struct seval_str_frame frame;

  frame.str = "(gscm-create-top-level)";
  frame.top = -1;
  frame.answer = &it;
  gscm_with_verbosity (-1, _seval_str_fn, &frame);
  stat = frame.status;
  if (stat == GSCM_OK)
    *answer = (GSCM_top_level)gscm_mk_objid (it);
  return stat;
}

GSCM_status
gscm_destroy_top_level (it)
     GSCM_top_level it;
{
  char buf[300];
  GSCM_status stat;
  struct seval_str_frame frame;

  sprintf (buf, "(gscm-destroy-top-level (\%\%gscm-indirect %d))", it);
  frame.str = buf;
  frame.top = -1;
  frame.answer = 0;
  gscm_with_verbosity (-1, _seval_str_fn, &frame);
  stat = frame.status;
  return stat;
}


/* {Top Level Evaluation}
 * 
 * Top level evaluation has to establish a dynamic root context,
 * enable Scheme signal handlers, and catch global escapes (errors, quits,
 * aborts, restarts, and execs) from the interpreter.
 */

extern unsigned int scm_tick_count;
extern unsigned int scm_ticken;


/* {Printing Objects to Strings} 
 */

static GSCM_status
gscm_portprint_obj (port, obj)
     SCM port;
     SCM obj;
{
  scm_iprin1 (obj, port, 1);
  return GSCM_OK;
}

static GSCM_status
gscm_strprint_obj (answer, obj)
     SCM * answer;
     SCM obj;
{
  SCM str;
  SCM port;
  GSCM_status stat;
  str = scm_makstr (64, 0);
  port = scm_mkstrport (MAKINUM (0), str, OPN | WRTNG, "gscm_strprint_obj");
  stat = gscm_portprint_obj (port, obj);
  if (stat == GSCM_OK)
    *answer = str;
  else
    *answer = BOOL_F;
  return stat;
}

static GSCM_status
gscm_cstr (answer, obj)
     char ** answer;
     SCM obj;
{
  SCM sstr;
  GSCM_status stat;

  *answer = (char *)malloc (LENGTH (sstr));
  stat = GSCM_OK;
  if (!*answer)
    stat = GSCM_OUT_OF_MEM;
  else
    bcopy (CHARS (sstr), *answer, LENGTH (sstr));
  return stat;
}
     

/* {Invoking The Interpreter}
 */

#ifdef _UNICOS
typedef int setjmp_type;
#else
typedef long setjmp_type;
#endif

extern SCM *scm_loc_loadpath;
extern long scm_linum;

static GSCM_status
_eval_port (answer, toplvl, port, printp)
     SCM * answer;
     GSCM_top_level toplvl;
     SCM port;
     int printp;
{
  SCM saved_inp;
  GSCM_status status;
  setjmp_type i;
  static int deja_vu = 0;
  SCM ignored;

  if (deja_vu)
    return GSCM_ILLEGALLY_REENTERED;

  ++deja_vu;
  /* Take over signal handlers for all the interesting signals.
   */
  scm_init_signals ();


  /* Default return values:
   */
  if (!answer)
    answer = &ignored;
  status = GSCM_OK;
  *answer = BOOL_F;

  /* Perform evalutation under a new dynamic root.
   *
   */
  BASE (rootcont) = (STACKITEM *) & i;
  saved_inp = cur_inp;
  i = setjmp (JMPBUF (rootcont));
  cur_inp = saved_inp;
 drloop:
  switch ((int) i)
    {
    default:
      {
	char *name;
	name = scm_errmsgs[i - WNA].s_response;
	if (name)
	  {
	    SCM proc;
	    proc = CDR (scm_intern (name, (sizet) strlen (name)));
	    if (NIMP (proc))
	      scm_apply (proc, EOL, EOL);
	  }
	if ((i = scm_errmsgs[i - WNA].parent_err))
	  goto drloop;
	def_err_response ();
	goto leave;
      }

    case 0:
      scm_exitval = MAKINUM (EXIT_SUCCESS);
      scm_errjmp_bad = 0;
      errno = 0;
      scm_alrm_deferred = 0;
      scm_sig_deferred = 0;
      scm_ints_disabled = 0;

    case -2:
      scm_alrm_deferred = 0;
      scm_sig_deferred = 0;
      scm_errjmp_bad = 0;
      scm_ints_disabled = 0;
      /* need to close loading files here. */
      cur_inp = port;
      *scm_loc_loadpath = BOOL_F;

      {
	SCM top_env;
	top_env = (toplvl == -1
		   ? EOL
		   : gscm_id2obj (toplvl));
	*answer = scm_repl (nullstr, top_env);
      }
      cur_inp = saved_inp;
      if (printp)
	status = gscm_strprint_obj (answer, *answer);
      goto return_fixing_signals;

    case -1:
      status = GSCM_QUIT;
      goto leave;

    case -3:
      status = GSCM_RESTART;
      goto leave;
    }
 leave:
  scm_alrm_deferred = 0;
  scm_sig_deferred = 0;

 return_fixing_signals:
  scm_errjmp_bad = 1;
  scm_ints_disabled = 1;
  scm_restore_signals ();
#ifdef TICKS
  scm_ticken = 0;
#endif
  --deja_vu;
  return status;
}

static GSCM_status
seval_str (answer, toplvl, str)
     SCM *answer;
     GSCM_top_level toplvl;
     char * str;
{
  SCM scheme_str;
  SCM port;
  SCM oloadpath;
  long olninum;
  GSCM_status status;

  oloadpath = *scm_loc_loadpath;
  olninum = scm_linum;
  scheme_str = scm_makfromstr (str, strlen (str), 0);
  *scm_loc_loadpath = makfrom0str ("(no input file)");
  scm_linum = 1;
  port = scm_mkstrport (MAKINUM (0), scheme_str, OPN | RDNG, "gscm_seval_str");
  status = _eval_port (answer, toplvl, port, 0);
  scm_linum = olninum;
  *scm_loc_loadpath = oloadpath;
  return status;
}


extern STACKITEM * scm_stack_base;

GSCM_status
gscm_seval_str (answer, toplvl, str)
     SCM *answer;
     GSCM_top_level toplvl;
     char * str;
{
  STACKITEM i;
  GSCM_status status;
  scm_stack_base = &i;
  status = seval_str (answer, toplvl, str);
  scm_stack_base = 0;
  return status;
}

void
format_load_command (buf, file_name)
     char * buf;
     char *file_name;
{
  char quoted_name[MAXPATHLEN + 1];
  int source;
  int dest;

  for (source = dest = 0; file_name[source]; ++source)
    {
      if (file_name[source] == '"')
	quoted_name[dest++] = '\\';
      quoted_name[dest++] = file_name[source];
    }
  quoted_name[dest] = 0;
  sprintf (buf, "(try-load \"%s\")", quoted_name);
}

GSCM_status
gscm_seval_file (answer, toplvl, file_name)
     SCM *answer;
     GSCM_top_level toplvl;
     char * file_name;
{
  char command[MAXPATHLEN * 3];
  format_load_command (command, file_name);
  return gscm_seval_str (answer, toplvl, command);
}


static GSCM_status
eval_str (answer, toplvl, str)
     char ** answer;
     GSCM_top_level toplvl;
     char * str;
{
  SCM sanswer;
  SCM scheme_str;
  SCM port;
  GSCM_status status;
  SCM oloadpath;
  long olninum;

  oloadpath = *scm_loc_loadpath;
  olninum = scm_linum;
  scheme_str = scm_makfromstr (str, strlen (str), 0);
  *scm_loc_loadpath = makfrom0str ("(no input file)");
  scm_linum = 1;
  port = scm_mkstrport (MAKINUM(0), scheme_str, OPN | RDNG, "gscm_eval_str");
  status = _eval_port (&sanswer, toplvl, port, 1);
  if (answer)
    {
      if (status == GSCM_OK)
	status = gscm_cstr (answer, *answer);
      else
	*answer = 0;
    }
  scm_linum = olninum;
  *scm_loc_loadpath = oloadpath;
  return status;
}


GSCM_status
gscm_eval_str (answer, toplvl, str)
     char ** answer;
     GSCM_top_level toplvl;
     char * str;
{
  STACKITEM i;
  GSCM_status status;
  scm_stack_base = &i;
  status = eval_str (answer, toplvl, str);
  scm_stack_base = 0;
  return status;
}


GSCM_status
gscm_eval_file (answer, toplvl, file_name)
     char ** answer;
     GSCM_top_level toplvl;
     char * file_name;
{
  char command[MAXPATHLEN * 3];
  format_load_command (command, file_name);
  return gscm_eval_str (answer, toplvl, command);
}




/* {Error Messages}
 */


#ifdef __GNUC__
# define AT(X)  [X] =
#else
# define AT(X)
#endif 

static char * gscm_error_msgs[] =
{
  AT(GSCM_OK) "No error.",
  AT(GSCM_QUIT) "QUIT executed.",
  AT(GSCM_RESTART) "RESTART executed.",
  AT(GSCM_ILLEGALLY_REENTERED) "Gscm function was illegally reentered.",
  AT(GSCM_OUT_OF_MEM) "Out of memory.",
  AT(GSCM_ERROR_OPENING_FILE) "Error opening file.",
  AT(GSCM_ERROR_OPENING_INIT_FILE) "Error opening init file."
};

char *
gscm_error_msg (n)
     int n;
{
  if ((n < 0) || (n > (sizeof (gscm_error_msgs) / sizeof (char *))))
    return "Unrecognized error.";
  else
    return gscm_error_msgs[n];
}



/* {Defining New Procedures}
 */

void
gscm_define_procedure (name, fn, req, opt, varp, doc)
     char * name;
     SCM (*fn)();
     int req;
     int opt;
     int varp;
     char * doc;
{
  scm_make_gsubr (name, req, opt, varp, fn);
}


SCM
gscm_make_subr (fn, req, opt, varp, doc)
     SCM (*fn)();
     int req;
     int opt;
     int varp;
     char * doc;
{
  return scm_make_gsubr ("*anonymous*", req, opt, varp, fn);
}

#define CURRY_PROC(cclo) (VELTS(cclo)[1])
#define CURRY_ARG1(cclo) (VELTS(cclo)[2])
static SCM curry_apply_fn;

static SCM 
curry_apply (self, rest)
     SCM self;
     SCM rest;
{
  return scm_apply (CURRY_PROC (self),
		    scm_cons (CURRY_ARG1 (self), rest),
		    EOL);
}

SCM
gscm_curry (procedure, first_arg)
     SCM procedure;
     SCM first_arg;
{
  SCM answer;

  answer = scm_makcclo (curry_apply_fn, 3L);
  CURRY_ARG1(answer) = first_arg;
  CURRY_PROC(answer) = procedure;
  return answer;
}


/* extern gscm_2_double P((SCM)); */

int
gscm_2_char (c)
     SCM c;
{
  ASSERT (ICHRP (c), c, ARG1, "gscm_2_char");
  return ICHR (c);
}



void
gscm_2_str (out, len_out, objp)
     char ** out;
     int * len_out;
     SCM * objp;
{
  ASSERT (NIMP (*objp) && STRINGP (*objp), *objp, ARG3, "gscm_2_str");
  *out = CHARS (*objp);
  *len_out = LENGTH (*objp);
}


void
gscm_error (message, args)
     char * message;
     SCM args;
{
  SCM errfn;
  SCM str;

  errfn = CDR (scm_intern ("error", 5));
  str = makfrom0str (message);
  scm_apply (errfn, scm_cons (str, args), EOL);
}


#define GSCM_SET_SIZE(OBJ, SIZE)	(CAR(OBJ) = (((SIZE) << 16) | tc16_gscm_obj))
#define GSCM_SIZE(OBJ)		((CAR (OBJ) >> 16) & 0x7f)
#define GSCM_MEM(OBJ)		((struct gscm_type **)CDR(OBJ))
#define GSCM_UMEM(OBJ)		((char *)(1 + GSCM_MEM(OBJ)))
#define GSCM_UTYPE(OBJ)		(* GSCM_MEM(OBJ))

static SCM
mark_gscm (obj)
     SCM obj;
{
  if (!GC8MARKP (obj))
    {
      STACKITEM * start;
      sizet size;

      SETGC8MARK (obj);
      start = (STACKITEM *)GSCM_UMEM (obj);
      size = ((GSCM_SIZE (obj) - sizeof (void *)) / sizeof (*start));
      scm_mark_locations (start, size);
    }
  return BOOL_F;
}

static sizet
free_gscm (obj)
     SCM obj;
{
  struct gscm_type * type;

  type = GSCM_UTYPE (obj);
  if (type->die)
    type->die (obj);
  {
    int size;
    size = GSCM_SIZE (obj);
    scm_must_free ((char *)GSCM_MEM (obj));
    return size;
  }
}

static int
print_gscm (exp, port, writingp)
     SCM exp;
     SCM port;
     int writingp;
{
  struct gscm_type * type;

  type = GSCM_UTYPE (exp);
  if (   !type->print
      || !(type->print (exp, port, writingp)))
    {
      scm_lputs ("#<", port);
      scm_lputs (type->name ? type->name : "unknown", port);
      scm_lputc (' ', port);
      scm_intprint (exp, 16, port);
      scm_lputc ('>', port);
    }
  return 1;
}

static SCM
equal_gscm (a, b)
     SCM a;
     SCM b;
{
  struct gscm_type * type;

  if (a == b)
    return BOOL_T;

  type = GSCM_UTYPE (a);
  if (type != GSCM_UTYPE (b))
    return BOOL_F;

  if (type->equal)
    return (type->equal (a, b) ? BOOL_T: BOOL_F);
  else
    return BOOL_F;
}


static int tc16_gscm_obj;
static struct scm_smobfuns gscm_obj_smob
= { mark_gscm, free_gscm, print_gscm, equal_gscm };

SCM
gscm_alloc (type, size)
     struct gscm_type * type;
     int size;
{
  SCM answer;
  char * mem;
  
  size = 1 + ((size + sizeof (void *) - 1) / sizeof (void *));
  size *= sizeof (void *);

  NEWCELL (answer);
  DEFER_INTS;
  mem = (char *)scm_must_malloc (size, type->name);
  bzero (mem, size);
  CDR (answer) = (SCM)mem;
  GSCM_UTYPE (answer) = type;
  GSCM_SET_SIZE (answer, size);
  ALLOW_INTS;
  return answer;
}
     
char *
gscm_unwrap_obj (type, objp)
     struct gscm_type * type;
     SCM * objp;
{
  SCM obj;
  obj = *objp;
  ASSERT (   NIMP (obj)
	  && (TYP16 (obj) == tc16_gscm_obj)
	  && (type == GSCM_UTYPE (obj)),
	  obj, ARG2, "gscm_unwrap_obj");

  return GSCM_UMEM (obj);
}

struct gscm_type * 
gscm_get_type (objp)
     SCM * objp;
{
  SCM obj;
  obj = *objp;
  ASSERT (   NIMP (obj)
	  && (TYP16 (obj) == tc16_gscm_obj),
	  obj, ARG1, "gscm_unwrap_obj");

  return GSCM_UTYPE (obj);
}




void
scm_remember (ptr)
     SCM * ptr;
{}





static char s_procedure_properties[] = "procedure-properties";
SCM
gscm_proc_props (proc)
     SCM proc;
{
  ASSERT (scm_procedurep (proc), proc, ARG1, s_procedure_properties);
  if (!(NIMP (proc) && CLOSUREP (proc)))
    return EOL;
  return PROCPROPS (proc);
}

static char s_set_procedure_properties[] = "set-procedure-properties!";
SCM
gscm_set_proc_props (proc, new)
     SCM proc;
     SCM new;
{
  ASSERT (NIMP (proc) && CLOSUREP (proc), proc, ARG1, s_procedure_properties);
  PROCPROPS (proc) = new;
  return UNSPECIFIED;
}


static char s_procedure_assoc[] = "procedure-assoc";
gscm_proc_assoc (p, k)
     SCM p;
     SCM k;
{
  ASSERT (scm_procedurep (p), p, ARG1, s_procedure_properties);
  if (!(NIMP (p) && CLOSUREP (p)))
    return BOOL_F;
  return scm_assoc (k, PROCPROPS (p));
}

static char s_procedure_prop[] = "procedure-property";
gscm_proc_prop (p, k)
     SCM p;
     SCM k;
{
  SCM assoc;
  ASSERT (scm_procedurep (p), p, ARG1, s_procedure_properties);
  if (!(NIMP (p) && CLOSUREP (p)))
    return BOOL_F;
  assoc = scm_assoc (k, PROCPROPS (p));
  return (NIMP (assoc) ? CDR (assoc) : BOOL_F);
}

static char s_procedure_putprop[] = "set-procedure-property!";
gscm_proc_putprop (p, k, v)
     SCM p;
     SCM k;
     SCM v;
{
  SCM assoc;
  ASSERT (NIMP (p) && CLOSUREP (p), p, ARG1, s_procedure_properties);
  assoc = scm_assoc (k, PROCPROPS (p));
  if (NIMP (assoc))
    SETCDR (assoc, v);
  else
    PROCPROPS (p) = scm_acons (k, v, PROCPROPS (p));
  return UNSPECIFIED;
}





static SCM
impl_type ()
{
  return CDR (scm_intern0 ("GUILE"));
}

static SCM
impl_version ()
{
  return makfrom0str (small_version_string);
}




void
scm_init_guile ()
{
  curry_apply_fn = scm_make_gsubr (" curry-apply", 0, 0, 1, curry_apply);
  scm_make_gsubr (s_procedure_properties, 1, 0, 0, gscm_proc_props);
  scm_make_gsubr (s_set_procedure_properties, 2, 0, 0, gscm_set_proc_props);
  scm_make_gsubr (s_procedure_assoc, 2, 0, 0, gscm_proc_assoc);
  scm_make_gsubr (s_procedure_prop, 2, 0, 0, gscm_proc_prop);
  scm_make_gsubr (s_procedure_putprop, 3, 0, 0, gscm_proc_putprop);
  scm_make_gsubr (s_dflt_verbosity, 0, 0, 0, gscm_dflt_verbosity);
  scm_make_gsubr ("scheme-implementation-type", 0, 0, 0, impl_type);
  scm_make_gsubr ("scheme-implementation-version", 0, 0, 0, impl_version);
  tc16_gscm_obj = scm_newsmob (&gscm_obj_smob);
}

