/* Scheme In One Defun, but in C this time.

 *                   COPYRIGHT (c) 1988-1994 BY                             *
 *        PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS.       *
 *        See the source file SLIB.C for more information.                  *

 $Id: siod.h,v 1.3 1999/09/23 23:42:37 yosh Exp $

 */
#ifndef __SIOD_H__
#define __SIOD_H__

#include <stdio.h>

struct obj
  {
    short gc_mark;
    short type;
    union
      {
	struct
	  {
	    struct obj *car;
	    struct obj *cdr;
	  }
	cons;
	struct
	  {
	    int data;
	  }
	flonum;
	struct
	  {
	    char *pname;
	    struct obj *vcell;
	  }
	symbol;
	struct
	  {
	    char *name;
	    struct obj *(*f) (void);
	  }
	subr0;
	struct
	  {
	    char *name;
	    struct obj *(*f) (struct obj *);
	  }
	subr1;
	struct
	  {
	    char *name;
	    struct obj *(*f) (struct obj *, struct obj *);
	  }
	subr2;
	struct
	  {
	    char *name;
	    struct obj *(*f) (struct obj *, struct obj *, struct obj *);
	  }
	subr3;
	struct
	  {
	    char *name;
	    struct obj *(*f) (struct obj *, struct obj *, struct obj *,
			      struct obj *);
	  }
	subr4;
	struct
	  {
	    char *name;
	    struct obj *(*f) (struct obj *, struct obj *, struct obj *,
			      struct obj *, struct obj *);
	  }
	subr5;
	struct
	  {
	    char *name;
	    struct obj *(*f) (struct obj **, struct obj **);
	  }
	subrm;
	struct
	  {
	    char *name;
	    struct obj *(*f) (void *,...);
	  }
	subr;
	struct
	  {
	    struct obj *env;
	    struct obj *code;
	  }
	closure;
	struct
	  {
	    long dim;
	    char *data;
	  }
	string;
	struct
	  {
	    FILE *f;
	    char *name;
	  }
	c_file;
      }
    storage_as;
  };

#define CAR(x) ((*x).storage_as.cons.car)
#define CDR(x) ((*x).storage_as.cons.cdr)
#define PNAME(x) ((*x).storage_as.symbol.pname)
#define VCELL(x) ((*x).storage_as.symbol.vcell)
#define SUBR0(x) (*((*x).storage_as.subr0.f))
#define SUBR1(x) (*((*x).storage_as.subr1.f))
#define SUBR2(x) (*((*x).storage_as.subr2.f))
#define SUBR3(x) (*((*x).storage_as.subr3.f))
#define SUBR4(x) (*((*x).storage_as.subr4.f))
#define SUBR5(x) (*((*x).storage_as.subr5.f))
#define SUBRM(x) (*((*x).storage_as.subrm.f))
#define SUBRF(x) (*((*x).storage_as.subr.f))
#define FLONM(x) ((*x).storage_as.flonum.data)

#define NIL ((struct obj *) 0)
#define EQ(x,y) ((x) == (y))
#define NEQ(x,y) ((x) != (y))
#define NULLP(x) EQ(x,NIL)
#define NNULLP(x) NEQ(x,NIL)

#define TYPE(x) (((x) == NIL) ? 0 : ((*(x)).type))

#define TYPEP(x,y) (TYPE(x) == (y))
#define NTYPEP(x,y) (TYPE(x) != (y))

#define tc_nil    0
#define tc_cons   1
#define tc_flonum 2
#define tc_symbol 3
#define tc_subr_0 4
#define tc_subr_1 5
#define tc_subr_2 6
#define tc_subr_3 7
#define tc_lsubr  8
#define tc_fsubr  9
#define tc_msubr  10
#define tc_closure 11
#define tc_free_cell 12
#define tc_string       13
/*#define tc_double_array 14*/
/*#define tc_long_array   15*/
/*#define tc_lisp_array   16*/
#define tc_c_file       17
/*#define tc_byte_array   18*/
#define tc_subr_4 19
#define tc_subr_5 20
#define tc_subr_2n 21
#define tc_user_min 50
#define tc_user_max 100

#define tc_table_dim 100

typedef struct obj *LISP;
typedef LISP (*SUBR_FUNC) (void);

#define CONSP(x)   TYPEP(x,tc_cons)
#define FLONUMP(x) TYPEP(x,tc_flonum)
#define SYMBOLP(x) TYPEP(x,tc_symbol)

#define NCONSP(x)   NTYPEP(x,tc_cons)
#define NFLONUMP(x) NTYPEP(x,tc_flonum)
#define NSYMBOLP(x) NTYPEP(x,tc_symbol)

#define TKBUFFERN 5120

struct repl_hooks
  {
    void (*repl_puts) (char *);
      LISP (*repl_read) (void);
      LISP (*repl_eval) (LISP);
    void (*repl_print) (LISP);
  };

void siod_init (int argc, char **argv, int warnflag, FILE *);
void siod_quit (void);

long repl_driver (long want_init, struct repl_hooks *);
void set_repl_hooks (void (*puts_f) (char *),
		     LISP (*read_f) (void),
		     LISP (*eval_f) (LISP),
		     void (*print_f) (LISP));
LISP my_err (char *message, LISP x);
char *get_c_string (LISP x);
char *get_c_string_dim (LISP x, long *);
char *try_get_c_string (LISP x);
long get_c_long (LISP x);

LISP cons (LISP x, LISP y);
LISP consp (LISP x);
LISP car (LISP x);
LISP cdr (LISP x);
LISP setcar (LISP cell, LISP value);
LISP flocons (double x);
LISP numberp (LISP x);
LISP eql (LISP x, LISP y);
LISP symcons (char *pname, LISP vcell);
LISP symbolp (LISP x);
LISP symbol_boundp (LISP x, LISP env);
LISP symbol_value (LISP x, LISP env);
LISP rintern (char *name);
LISP subrcons (long type, char *name, SUBR_FUNC f);
LISP closure (LISP env, LISP code);
void gc_protect (LISP * location);
void gc_protect_n (LISP * location, long n);
void gc_protect_sym (LISP * location, char *st);
void gc_unprotect (LISP * location);

void init_subr (char *name, long type, SUBR_FUNC fcn);
void init_subr_0 (char *name, LISP (*fcn) (void));
void init_subr_1 (char *name, LISP (*fcn) (LISP));
void init_subr_2 (char *name, LISP (*fcn) (LISP, LISP));
void init_subr_2n (char *name, LISP (*fcn) (LISP, LISP));
void init_subr_3 (char *name, LISP (*fcn) (LISP, LISP, LISP));
void init_subr_4 (char *name, LISP (*fcn) (LISP, LISP, LISP, LISP));
void init_subr_5 (char *name, LISP (*fcn) (LISP, LISP, LISP, LISP, LISP));
void init_lsubr (char *name, LISP (*fcn) (LISP));
void init_fsubr (char *name, LISP (*fcn) (LISP, LISP));
void init_msubr (char *name, LISP (*fcn) (LISP *, LISP *));

LISP delq (LISP elem, LISP l);
void set_eval_hooks (long type, LISP (*fcn) (LISP, LISP *, LISP *));
LISP leval (LISP x, LISP env);
LISP symbolconc (LISP args);
LISP lprin1f (LISP exp, FILE * f);
LISP lprint (LISP exp, LISP);
LISP lread (LISP);
LISP lreadtk (char *, long j);
LISP lreadf (FILE * f);
LISP vload (char *fname, long cflag, long rflag);
LISP require (LISP fname);
LISP nullp (LISP x);
LISP strcons (long length, char *data);
LISP string_length (LISP string);
LISP string_trim (LISP);
LISP string_trim_left (LISP);
LISP string_trim_right (LISP);
//LISP copy_list_slib (LISP);
LISP href (LISP, LISP);
LISP hset (LISP, LISP, LISP);
LISP equal (LISP, LISP);
void set_fatal_exit_hook (void (*fcn) (void));
LISP intern (LISP x);
void init_trace (void);
long repl_c_string (char *, long want_init, long want_print);
LISP nreverse (LISP);
LISP number2string (LISP, LISP, LISP, LISP);
LISP string2number (LISP, LISP);
LISP siod_verbose (LISP);
int siod_verbose_check (int);
LISP cadr (LISP);
LISP caar (LISP);
LISP cddr (LISP);
LISP caaar (LISP);
LISP caadr (LISP);
LISP cadar (LISP);
LISP caddr (LISP);
LISP cdaar (LISP);
LISP cdadr (LISP);
LISP cddar (LISP);
LISP cdddr (LISP);
void chk_string (LISP, char **, long *);
LISP a_true_value (void);
LISP lapply (LISP fcn, LISP args);
LISP mallocl (void *lplace, long size);
void put_st (char *st);
LISP listn (long n,...);
char *must_malloc (unsigned long size);
FILE *get_c_file (LISP p, FILE * deflt);
char *last_c_errmsg (int);
LISP llast_c_errmsg (int);
void c_provide(char *);

#define SAFE_STRCPY(_to,_from) safe_strcpy((_to),sizeof(_to),(_from))
#define SAFE_STRCAT(_to,_from) safe_strcat((_to),sizeof(_to),(_from))
#define SAFE_STRLEN(_buff) safe_strlen((_buff),sizeof(_buff))

char *safe_strcpy (char *s1, size_t size1, const char *s2);
char *safe_strcat (char *s1, size_t size1, const char *s2);

size_t safe_strlen (const char *s, size_t size);
LISP funcall1 (LISP, LISP);
LISP funcall2 (LISP, LISP, LISP);
LISP apply1 (LISP, LISP, LISP);
LISP lgetc (LISP p);
LISP lungetc (LISP i, LISP p);
LISP lputc (LISP c, LISP p);
LISP lputs (LISP str, LISP p);

extern LISP sym_t;

extern long siod_verbose_level;
extern char *siod_lib;

struct gc_protected
  {
    LISP *location;
    long length;
    struct gc_protected *next;
  };

#ifdef THINK_C
extern int ipoll_counter;
void full_interrupt_poll (int *counter);
#define INTERRUPT_CHECK() if (--ipoll_counter < 0) full_interrupt_poll(&ipoll_counter)
#else
#define INTERRUPT_CHECK()
#endif

long no_interrupt (long n);
void fput_st (FILE * f, char *st);
void put_st (char *st);
void gc_for_newcell (void);
void gc_ms_stats_start (void);
void gc_ms_stats_end (void);

void init_subrs_a (void);

#endif /* __SIOD_H__ */