/*
 * SCHEME.H - header file supporting Scheme system
 *
 * Source Version: 4.0
 * Software Release #92-0043
 *
 */

#ifndef PCK_SCHEME

#include "cpyright.h"

#define PCK_SCHEME

/* #define SCHEME_DEBUG */

#ifndef CODE
#define CODE     "SCHEME 4.0"
#endif

/* Think C compiler defines THINK_C; CodeWarrior defines __MWERKS__ */

#ifdef THINK_C

# define LARGE
# include "score.h"
# include "pml.h"
# include "pgs.h"
# include "ppc.h"

#else

# ifdef __MWERKS__

#  define LARGE
#  include "score.h"
#  include "pml.h"
#  include "pgs.h"
#  include "ppc.h"

# else

#  include <score.h>
#  include <pml.h>

#  ifdef UNIX
#   define LARGE
#  endif

#  ifdef LARGE
#   include <ppc.h>
#  endif

# endif

#endif

#define SS_OBJECT_I    23             /* follows SC_USER_I in scstd.h */

#define CONS           24
#define VARIABLE       25
#define PROC_OBJ       26
#define BOOLEAN        27
#define IN_PORT        28
#define OUT_PORT       29
#define EOF_OBJ        30
#define NULL_OBJ       31
#define VECTOR         32
#define CHAR_OBJ       33

#ifdef LARGE
#define HASH_ELEMENT   34
#define HASH_TABLE     35
#define PROCESS_OBJ    36
#define ERR_OBJ        37
#else
#define ERR_OBJ        34
#endif

#define NUM_DISP ERR_OBJ - SC_CHAR_I + 1

#define SS_MACRO     'm'
#define SS_ESC_PROC  'n'
#define SS_BEGIN     'o'
#define SS_EE_MACRO  'p'
#define SS_UE_MACRO  'q'
#define SS_UR_MACRO  'r'
#define SS_DEFINE    's'
#define SS_SET       't'
#define SS_COND      'u'
#define SS_IF        'v'
#define SS_AND       'w'
#define SS_OR        'x'
#define SS_PROC      'y'
#define SS_PR_PROC   'z'

#define SELF_EV   '\001'
#define VAR_EV    '\002'
#define PROC_EV   '\003'

#define STDIN_ONLY -1
#define ALL        -2

#define SS_PRINT_ERR_MSG (*SS_print_err_msg_hook)

/*--------------------------------------------------------------------------*/

/*                         STRUCT's and TYPEDEF's                           */

/*--------------------------------------------------------------------------*/

/* Generic object definition */

struct s_object
   {char *print_name;            /* specific members */
    byte *val;

    char eval_type;              /* generic members */
    void (*print)();
    void (*release)();};

typedef struct s_object object;

FUNCTION_POINTER(object, (*PFObject));
FUNCTION_POINTER(object, *(*PFPObject));

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

struct s_SS_input_port
   {FILE *str;
    char buffer[MAXLINE];
    char *ptr;};

typedef struct s_SS_input_port input_port;

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

struct s_SS_output_port
   {FILE *str;};

typedef struct s_SS_output_port output_port;

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

struct s_SS_cons
   {object *car;
    object *cdr;};

typedef struct s_SS_cons cons;

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

struct s_SS_variable
   {char *name;
    object *value;};

typedef struct s_SS_variable variable;

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

struct s_SS_boolean
   {char *name;
    int value;};

typedef struct s_SS_boolean boolean;

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

struct s_SS_string
   {int length;
    char *string;};

typedef struct s_SS_string string;

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

struct s_SS_continuation
   {jmp_buf cont;
    object *signal;};

typedef struct s_SS_continuation continuation;

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

struct s_SS_err_continuation
   {jmp_buf cont;
    int stack_ptr;
    int cont_ptr;
    object *signal;};

typedef struct s_SS_err_continuation err_continuation;

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* ESCAPE PROCEDURE - used to implement call-with-current-continuation */

struct s_SS_esc_proc
   {int cont;
    int stck;
    int err;
    int type;};

typedef struct s_SS_esc_proc Esc_procedure;

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/*  C PROCEDURE - primitive procedure or special form (written in C) */

struct s_SS_C_proc
   {PFPObject handler;
    PFPObject proc;};

typedef struct s_SS_C_proc C_procedure;

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* COMPOUND PROCEDURE - Scheme level procedure (written in Scheme) */
struct s_SS_S_proc
   {char type;
    object *proc;};

typedef struct s_SS_S_proc S_procedure;

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

struct s_SS_proc
   {char type;
    char *name;
    char *doc;
    short int trace;
    object *proc;};

typedef struct s_SS_proc procedure;

/*--------------------------------------------------------------------------*/

#ifdef LARGE

/*--------------------------------------------------------------------------*/

/*  Vector definition */
struct s_SS_vect
   {int length;
    object **vect;};

typedef struct s_SS_vect vector;

/*--------------------------------------------------------------------------*/

#endif

/*--------------------------------------------------------------------------*/

/*                            PROCEDURAL MACROS                             */

/*--------------------------------------------------------------------------*/

#define SS_GET(typ, obj)        ((typ *) SS_OBJECT(obj))
#define SS_PP(fun, member)      ((procedure *) SS_OBJECT(fun))->member

/* OBJECT ACCESSORS */

#define SS_INQUIRE_OBJECT(x)      ((object *) SC_def_lookup((x), SS_symtab))
#define SS_OBJECT_GC(x)           SC_ref_count(x)
#define SS_UNCOLLECT(x)           SC_permanent(x)
#define SS_OBJECT_TYPE(x)         SC_arrtype(x, -1)
#define SS_OBJECT_NAME(x)         ((x)->print_name)
#define SS_OBJECT(x)              ((x)->val)
#define SS_OBJECT_ETYPE(x)        ((x)->eval_type)
#define SS_OBJECT_PRINT(x, strm)  (*((x)->print))(x, strm)
#define SS_OBJECT_FREE(x)         (*((x)->release))(x)

/* NUMBER ACCESSORS */

#define SS_INTEGER_VALUE(x)    *((long *)      ((x)->val))
#define SS_FLOAT_VALUE(x)      *((double *)    ((x)->val))

/* INPUT_PORT/OUTPUT_PORT ACCESSORS */

#define SS_OUTSTREAM(x)         (((output_port *) (x)->val)->str)
#define SS_INSTREAM(x)          (((input_port *) (x)->val)->str)
#define SS_BUFFER(x)            (((input_port *) (x)->val)->buffer)
#define SS_PTR(x)               (((input_port *) (x)->val)->ptr)

/* CONS ACCESSORS */

#define SS_CAR_MACRO(x)         (((cons *) (x)->val)->car)
#define SS_CDR_MACRO(x)         (((cons *) (x)->val)->cdr)

/* VARIABLE ACCESSORS */

#define SS_VARIABLE_NAME(x)     (((variable *)  ((x)->val))->name)
#define SS_VARIABLE_VALUE(x)    (((variable *)  ((x)->val))->value)

/* BOOLEAN ACCESSORS */

#define SS_BOOLEAN_NAME(x)      (((boolean *)   ((x)->val))->name)
#define SS_BOOLEAN_VALUE(x)     (((boolean *)   ((x)->val))->value)

/* STRING ACCESSORS */

#define SS_STRING_TEXT(x)       (((string *)    ((x)->val))->string)
#define SS_STRING_LENGTH(x)     (((string *)    ((x)->val))->length)

/* PROCEDURE ACCESSORS */

#define SS_PROCEDURE_TYPE(x)    (((procedure *) ((x)->val))->type)
#define SS_PROCEDURE_NAME(x)    (((procedure *) ((x)->val))->name)
#define SS_PROCEDURE_DOC(x)     (((procedure *) ((x)->val))->doc)
#define SS_PROCEDURE_TRACEDP(x) (((procedure *) ((x)->val))->trace)
#define SS_PROCEDURE_PROC(x)    (((procedure *) ((x)->val))->proc)

/* C PROCEDURE ACCESSORS */

#define SS_C_PROCEDURE_HANDLER_PTR(x)                                        \
   (((C_procedure *) SS_PROCEDURE_PROC(x))->handler)
#define SS_C_PROCEDURE_HANDLER(x)                                            \
   (*SS_C_PROCEDURE_HANDLER_PTR(x))
#define SS_C_PROCEDURE_FUNCTION_PTR(x)                                       \
   (((C_procedure *) SS_PROCEDURE_PROC(x))->proc)
#define SS_C_PROCEDURE_FUNCTION(x)                                           \
   (*SS_C_PROCEDURE_FUNCTION_PTR(x))

/* COMPOUND PROCEDURE ACCESSORS */

#define SS_COMPOUND_PROCEDURE_TYPE(x)                                        \
   (((S_procedure *) SS_PROCEDURE_PROC(x))->type)
#define SS_COMPOUND_PROCEDURE_FUNCTION(x)                                    \
   (((S_procedure *) SS_PROCEDURE_PROC(x))->proc)

/* ESCAPE PROCEDURE ACCESSORS */

#define SS_ESCAPE_CONTINUATION(x)                                           \
   (((Esc_procedure *) SS_PROCEDURE_PROC(x))->cont)
#define SS_ESCAPE_STACK(x)                                                  \
   (((Esc_procedure *) SS_PROCEDURE_PROC(x))->stck)
#define SS_ESCAPE_ERROR(x)                                                  \
   (((Esc_procedure *) SS_PROCEDURE_PROC(x))->err)
#define SS_ESCAPE_TYPE(x)                                                   \
   (((Esc_procedure *) SS_PROCEDURE_PROC(x))->type)

#ifdef LARGE

/* VECTOR ACCESSORS */

#define SS_VECTOR_LENGTH(x)  (((vector *) (x)->val)->length)
#define SS_VECTOR_ARRAY(x)   (((vector *) (x)->val)->vect)

/* CHARACTER ACCESSOR */

#define SS_CHARACTER_VALUE(x) *((int *) (x)->val)

/* PROCESS ACCESSORS */

#define SS_PROCESS_VALUE(x)     ((PROCESS *) (x)->val)
#define SS_PROCESS_STATUS(x)   (((PROCESS *) (x)->val)->status)

#endif

/*--------------------------------------------------------------------------*/

/*                              LIST MACROS                                 */

/*--------------------------------------------------------------------------*/

/* SS_END_CONS - macro version of the endcons functionality */

#define SS_end_cons(first, ths, nxt)                                        \
    {object *x;                                                             \
     x = nxt;                                                               \
     if (SS_nullobjp(first))                                                \
        {first = SS_mk_cons(x, SS_null);                                    \
         ths = first;}                                                      \
     else                                                                   \
        {_SS_setcdr(ths, SS_mk_cons(x, SS_null));                           \
         ths = SS_cdr(ths);};}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_END_CONS_MACRO - macro version of the endcons functionality
 *                   - mark the first element on the list
 *                   - treat both first and this as registers
 *                   - this distinguishes this macro from SS_end_cons
 */

#define SS_end_cons_macro(first, ths, nxt)                                  \
    {object *x;                                                             \
     x = nxt;                                                               \
     if (SS_nullobjp(first))                                                \
        {first = SS_mk_cons(x, SS_null);                                    \
         SS_MARK(first);                                                    \
         SS_Assign(ths, first);}                                            \
     else                                                                   \
        {_SS_setcdr(ths, SS_mk_cons(x, SS_null));                           \
         SS_Assign(ths, SS_cdr(ths));};}

/*--------------------------------------------------------------------------*/

/*                           MACRO PREDICATES                               */

/*--------------------------------------------------------------------------*/

/* SS_INTEGERP - return TRUE if the object is of type INTEGER 
 *             - return FALSE otherwise
 */

#define SS_integerp(obj) (SC_arrtype(obj, -1) == SC_INTEGER_I)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_FLOATP - return TRUE if the object is of type FLOAT 
 *           - return FALSE otherwise
 */

#define SS_floatp(obj) (SC_arrtype(obj, -1) == SC_FLOAT_I)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_STRINGP - return TRUE if the object is of type STRING 
 *            - return FALSE otherwise
 */

#define SS_stringp(obj) (SC_arrtype(obj, -1) == SC_STRING_I)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_CONSP - return TRUE if the object is of type CONS 
 *          - return FALSE otherwise
 */

#define SS_consp(obj) (SC_arrtype(obj, -1) == CONS)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_VARIABLEP - return TRUE if the object is of type VARIABLE
 *              - return FALSE otherwise
 */

#define SS_variablep(obj) (SC_arrtype(obj, -1) == VARIABLE)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_INPORTP - return TRUE if the object is of type IN_PORT
 *            - return FALSE otherwise
 */

#define SS_inportp(obj) (SC_arrtype(obj, -1) == IN_PORT)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_OUTPORTP - return TRUE if the object is of type OUT_PORT
 *             - return FALSE otherwise
 */

#define SS_outportp(obj) (SC_arrtype(obj, -1) == OUT_PORT)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_EOFOBJP - return TRUE if the object is of type EOF_OBJ
 *            - return FALSE otherwise
 */

#define SS_eofobjp(obj) (SC_arrtype(obj, -1) == EOF_OBJ)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_NULLOBJP - return TRUE if the object is of type NULL_OBJ
 *             - return FALSE otherwise
 */

#define SS_nullobjp(obj) (SC_arrtype(obj, -1) == NULL_OBJ)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_PROCEDUREP - return TRUE if the object is of type PROC_OBJ
 *               - return FALSE otherwise
 */

#define SS_procedurep(obj) (SC_arrtype(obj, -1) == PROC_OBJ)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_BOOLEANP - return TRUE if the object is of type BOOLEAN
 *             - return FALSE otherwise
 */

#define SS_booleanp(obj) (SC_arrtype(obj, -1) == BOOLEAN)

/*--------------------------------------------------------------------------*/

#ifdef LARGE

/*--------------------------------------------------------------------------*/

/* SS_HASH_TABLE - return TRUE if the object is of type HASH_TABLE
 *               - return FALSE otherwise
 */

#define SS_hash_tablep(obj) (SC_arrtype(obj, -1) == HASH_TABLE)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_HASH_ELEMENT - return TRUE if the object is of type HASH_ELEMENT
 *                 - return FALSE otherwise
 */

#define SS_hash_elementp(obj) (SC_arrtype(obj, -1) == HASH_ELEMENT)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_CHAROBJP - return TRUE if the object is of type CHAR_OBJ
 *             - return FALSE otherwise
 */

#define SS_charobjp(obj) (SC_arrtype(obj, -1) == CHAR_OBJ)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_VECTORP - return TRUE if the object is of type VECTOR
 *            - return FALSE otherwise
 */

#define SS_vectorp(obj) (SC_arrtype(obj, -1) == VECTOR)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_PROCESSP - return TRUE if the object is of type PROCESS_OBJ
 *             - return FALSE otherwise
 */

#define SS_processp(obj) (SC_arrtype(obj, -1) == PROCESS_OBJ)

/*--------------------------------------------------------------------------*/

#endif

/*--------------------------------------------------------------------------*/

/*                        MEMORY MANAGEMENT MACROS                          */

/*--------------------------------------------------------------------------*/

/* SS_GC - garbage collection, incremental
 *       - each object has number of pointers to itself (except #t, #f, etc)
 *       - when the number of pointers is 1 then garbage collection means
 *       - freeing the space associated with the object
 *       - when the number is greater than 1 garbage collection means
 *       - decrementing the number of pointers to itself
 */

#define SS_GC SS_gc

#if 0
#ifdef SCHEME_DEBUG

#define SS_GC(obj)                                                           \
   {object *x;                                                               \
    x = obj;                                                                 \
    if ((x->val == NULL) || (x->eval_type == 0))                             \
       SS_error("FREED OBJECT - SS_GC", SS_null);                            \
    if (x != NULL)                                                           \
       {if ((SS_OBJECT_GC(x) != 1) || (x->val == NULL))                      \
           {SFREE(x);}                                                       \
        else                                                                 \
           x->release(x);};}

#else

#define SS_GC(obj)                                                           \
   {object *x;                                                               \
    x = obj;                                                                 \
    if (x != NULL)                                                           \
       {if ((SS_OBJECT_GC(x) != 1) || (x->val == NULL))                      \
           {SFREE(x);}                                                       \
        else                                                                 \
           x->release(x);};}

#endif
#endif

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_MARK - increment the reference count of the object */

#define SS_MARK(x)  SC_mark(x, 1)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_ASSIGN - do C level variable assignment with GC
 *           - SS_MARK before GC so that cdr'ing down lists works right
 *           - use temporary so that args are eval'd once only
 */

#ifdef SCHEME_DEBUG

#define SS_Assign(obj, nval)                                                 \
    {object *x;                                                              \
     x = nval;                                                               \
     if ((x->val == NULL) || (x->eval_type == 0))                            \
        SS_error("FREED OBJECT - SS_ASSIGN", SS_null);                       \
     SS_MARK(x);                                                             \
     SS_GC(obj);                                                             \
     obj = x;}

#else

#define SS_Assign(obj, val)                                                  \
    {object *x;                                                              \
     x = val;                                                                \
     SS_MARK(x);                                                             \
     SS_GC(obj);                                                             \
     obj = x;}

#endif

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_SET_CONT - set up a new continuation, execute the jumps
 *             - and release the continuation on return
 */

#define SS_set_cont(to_go, to_return)                                        \
    SS_nsetc++;                                                              \
    if (setjmp(SS_continue[++SS_cont_ptr].cont))                             \
       {SS_end_trace();                                                      \
        SS_cont_ptr--;                                                       \
        SS_ngoc++;                                                           \
        SS_jump(to_return);}                                                 \
    else                                                                     \
       {SS_jump(to_go);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_GO_CONT - go (longjmp) to the current continuation */

#define SS_go_cont longjmp(SS_continue[SS_cont_ptr].cont, TRUE)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_SAVE - save the object on the Scheme stack */

#ifdef SCHEME_DEBUG

#define SS_Save(obj)                                                         \
   {object *x;                                                               \
    x = obj;                                                                 \
    if ((x->val == NULL) || (x->eval_type == 0))                             \
       SS_error("FREED OBJECT - SS_SAVE", SS_null);                          \
    SS_nsave++;                                                              \
    SS_MARK(x);                                                              \
    SC_REMEMBER_DYNAMIC(object *, x, SS_stack);                              \
    SS_stack_ptr = (SC_N_DYNAMIC(SS_stack)) - 1;}

#else

#define SS_Save(obj)                                                         \
   {SS_nsave++;                                                              \
    SS_MARK(obj);                                                            \
    SC_REMEMBER_DYNAMIC(object *, obj, SS_stack);                            \
    SS_stack_ptr = (SC_N_DYNAMIC(SS_stack)) - 1;}

#endif

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_RESTORE - pop an object off the stack and release the stacken */

#ifdef SCHEME_DEBUG

#define SS_Restore(x)                                                        \
   {SS_nrestore++;                                                           \
    SS_GC(x);                                                                \
    x = SC_GET_NTH_DYNAMIC(object *, SS_stack, SS_stack_ptr);                \
    SS_stack_ptr--;                                                          \
    SS_stack.n--;                                                            \
    if ((x->val == NULL) || (x->eval_type == 0))                             \
       SS_error("FREED OBJECT - SS_RESTORE", SS_null);}                       

#else

#define SS_Restore(x)                                                        \
   {SS_nrestore++;                                                           \
    SS_GC(x);                                                                \
    x = SC_GET_NTH_DYNAMIC(object *, SS_stack, SS_stack_ptr);                \
    SS_stack_ptr--;                                                          \
    SS_stack.n--;}

#endif

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_JUMP - can't bring myself to say goto */

#define SS_jump(x)  goto x

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_TRACEDP - returns the trace field in the procedure struct */

#define SS_tracedp(x) (SS_GET(procedure, x)->trace)

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SS_INT_VAL - return TRUE if the number has an integer value */

#define SS_int_val(x) (floor(x) == ceil(x))

#ifdef __cplusplus
extern "C" {
#endif

/*--------------------------------------------------------------------------*/

/*                          VARIABLE DECLARATIONS                           */

/*--------------------------------------------------------------------------*/

extern continuation
 *SS_continue;

extern err_continuation
 *SS_err_continue;

extern HASHTAB
 *SS_symtab;

extern object
 *SS_indev,
 *SS_outdev,
 *SS_histdev,
 *SS_scheme_symtab,
 *SS_quoteproc,
 *SS_quasiproc,
 *SS_unqproc,
 *SS_unqspproc,
 *SS_setproc,
 *SS_null,
 *SS_eof,
 *SS_t,
 *SS_f,
 *SS_else,
 *SS_This,
 *SS_Val,
 *SS_Unev,
 *SS_Exn,
 *SS_Argl,
 *SS_Fun,
 *SS_Env,
 *SS_Global_Env,
 *SS_err_state,
 **SS_err_stack,
 *SS_rdobj,
 *SS_evobj;

extern SC_dynamic_array
 SS_stack;

extern char
 *SS_OBJECT_S,
 *SS_POBJECT_S,
 SS_prompt[],
 SS_ans_prompt[];

extern PFInt
 SS_post_print_hook,
 SS_pr_ch_in;

extern PFVoid
 SS_post_read_hook,
 SS_post_eval_hook,
 SS_pr_ch_out,
 SS_pr_ch_un,
 SS_print_err_msg_hook,
 SS_arg_hook;

extern PFPObject
 SS_call_arg_hook;

extern int
 SS_interactive,
 SS_lines_page,
 SS_hist_flag,
 SS_print_flag,
 SS_stat_flag,
 SS_nsave,
 SS_nrestore,
 SS_nsetc,
 SS_ngoc,
 SS_stack_size,
 SS_stack_mask,
 SS_stack_ptr,
 SS_cont_ptr,
 SS_err_cont_ptr,
 SS_errlev;

/*--------------------------------------------------------------------------*/

/*                          FUNCTION DECLARATIONS                           */

/*--------------------------------------------------------------------------*/


/* SHENVR.C declarations */

extern object
 SC_DECLARE(*SS_defp, (object *vr)),
 SC_DECLARE(*SS_lk_var_val, (object *vr, object *penv)),
 SC_DECLARE(*SS_bind_env, (object *vr, object *penv)),
 SC_DECLARE(*SS_xtnd_env, 
            (object *vrs, object *vls, object *base)),
 SC_DECLARE(*SS_mk_frame, (object *vrs, object *vls));

extern void
 SC_DECLARE(SS_save_registers, (int vp)),
 SC_DECLARE(SS_restore_registers, (int vp)),
 SC_DECLARE(SS_set_var, (object *vr, object *vl, object *penv)),
 SC_DECLARE(SS_def_var, (object *vr, object *vl, object *penv));


/* SHEVAL.C declarations */

extern void
 SC_DECLARE(_SS_eval, (byte));

extern object
 SC_DECLARE(*SS_exp_eval, (object *obj)),
 SC_DECLARE(*SS_eval, (object *obj)),
 SC_DECLARE(*SS_Ident, (object *obj)),
 SC_DECLARE(*SS_zargs, (PFPObject pr, object *argl)),
 SC_DECLARE(*SS_sargs, (PFPObject pr, object *argl)),
 SC_DECLARE(*SS_nargs, (PFPObject pr, object *argl)),
 SC_DECLARE(*SS_znargs, (PFPObject pr, object *argl)),
 SC_DECLARE(*SS_params, (object *fun)),
 SC_DECLARE(*SS_proc_body, (object *fun)),
 SC_DECLARE(*SS_proc_env, (object *fun)),
 SC_DECLARE(*SS_do_bindings, (object *pp, object *argp));

extern int
 SC_DECLARE(SS_true, (object *obj));


/* SHINT.C declarations */

extern object
 SC_DECLARE(*SS_define_constant, (int n, ...)),
 SC_DECLARE(*SS_make_list, (int first, ...)),
 SC_DECLARE(*SS_call_scheme, (char *func, ...));

extern int
 SC_DECLARE(SS_args, (object *s, ...)),
 SC_DECLARE(SS_run, (char *s)),
 SC_DECLARE(SS_load_scm, (char *name));

extern void
 SC_DECLARE(SS_var_value, 
            (char *s, int type, byte *vr, int flag));

extern byte
 SC_DECLARE(*SS_var_reference, (char *s));


/* SHLARG.C declarations */

#ifdef LARGE

extern void
 SC_DECLARE(SS_inst_lrg, (byte));

extern object
 SC_DECLARE(*SS_charp, (object *obj)),
 SC_DECLARE(*SS_vectp, (object *obj)),
 SC_DECLARE(*SS_mkvect, (object *arg)),
 SC_DECLARE(*SS_vector, (object *argl)),
 SC_DECLARE(*SS_vctlen, (object *arg)),
 SC_DECLARE(*SS_vctref, (object *argl)),
 SC_DECLARE(*SS_vctset, (object *argl)),
 SC_DECLARE(*SS_vctlst, (object *arg)),
 SC_DECLARE(*SS_lstvct, (object *arg)),
 SC_DECLARE(*SS_hash_install, (object *argl)),
 SC_DECLARE(*SS_hash_lookup, (object *argl)),
 SC_DECLARE(*SS_hash_remove, (object *argl)),
 SC_DECLARE(*SS_hash_dump, (object *argl)),
 SC_DECLARE(*SS_hash_info, (object *arg)),
 SC_DECLARE(*SS_make_hash_table, (object *arg)),
 SC_DECLARE(*SS_mk_hash_table, (HASHTAB *tb)),
 SC_DECLARE(*SS_mk_hash_element, (hashel *hp)),
 SC_DECLARE(*SS_hashtabp, (object *arg)),
 SC_DECLARE(*SS_hashelp, (object *arg)),
 SC_DECLARE(*SS_define_global, (object *argl));

#endif


/* SHMM.C declarations */

extern object
 SC_DECLARE(*SS_mk_proc_object, (procedure *pp)),
 SC_DECLARE(*SS_mk_procedure, (object *lam_exp, object *penv)),
 SC_DECLARE(*SS_mk_esc_proc, 
            (int cont, int stck, int err, int type)),
 SC_DECLARE(*SS_mk_variable, (char *n, object *v)),
 SC_DECLARE(*SS_mk_string, (char *s)),
 SC_DECLARE(*SS_mk_inport, (FILE *str)),
 SC_DECLARE(*SS_mk_outport, (FILE *str)),
 SC_DECLARE(*SS_mk_integer, (long i)),
 SC_DECLARE(*SS_mk_float, (double d)),
 SC_DECLARE(*SS_mk_boolean, (char *s, int v)),
 SC_DECLARE(*SS_mk_cons, (object *ca, object *cd)),
 SC_DECLARE(*SS_mk_object, 
            (byte *np, int type, int ev_type, char *pname)),
 SC_DECLARE(*SS_mk_char, (int i)),
 SC_DECLARE(*SS_mk_vector, (int l)),
 SC_DECLARE(*SS_pr_obj_map, (byte));

extern void
 SC_DECLARE(SS_install,
         (char *pname, char *pdoc,
          PFPObject phand, PFPObject pproc, int ptype)),
 SC_DECLARE(SS_rl_object, (object *obj)),
 SC_DECLARE(SS_gc, (object *obj));


/* SHPRM1.C declarations */

extern object
 SC_DECLARE(*SS_newsym, (object *obj)),
 SC_DECLARE(*SS_quote, (object *obj)),
 SC_DECLARE(*SS_Unquote, (object *x)),
 SC_DECLARE(*SS_Splice,
         (object *ncns, object *item, object *lst, object *tcns)),
 SC_DECLARE(*_SS_quasiq, (object *obj, int nest_level)),
 SC_DECLARE(*SS_quasiq, (object *obj)),
 SC_DECLARE(*SS_unquote, (object *obj)),
 SC_DECLARE(*SS_unq_spl, (object *obj)),
 SC_DECLARE(*SS_lambda, (object *argl)),
 SC_DECLARE(*SS_let, (object *let)),
 SC_DECLARE(*SS_letstr, (object *letr)),
 SC_DECLARE(*SS_lst_map, (object *argl, int *Ex_flag)),
 SC_DECLARE(*SS_map, (object *obj)),
 SC_DECLARE(*SS_foreach, (object *obj)),
 SC_DECLARE(*SS_not, (object *obj)),
 SC_DECLARE(*SS_list, (object *argl)),
 SC_DECLARE(*SS_trace, (object *argl)),
 SC_DECLARE(*SS_untrace, (object *argl)),
 SC_DECLARE(*SS_catch, (object *obj)),
 SC_DECLARE(*SS_catch_err, (object *argl)),
 SC_DECLARE(*SS_time, (byte));

extern void
 SC_DECLARE(SS_bgn_trace, (object *pfun, object *pargl)),
 SC_DECLARE(SS_end_trace, (byte));

extern int
 SC_DECLARE(SS_pre_cont, (byte)),
 SC_DECLARE(SS_post_cont, (byte));


/* SHPRM2.C declarations */

extern void
 SC_DECLARE(SS_install_math, (byte));

extern object
 SC_DECLARE(*SS_unary_flt, (PFPObject pr, object *argl)),
 SC_DECLARE(*SS_unary_fix, (PFPObject pr, object *argl)),
 SC_DECLARE(*SS_binary_fix, (PFPObject pr, object *argl)),
 SC_DECLARE(*SS_binary_flt, (PFPObject pr, object *argl)),
 SC_DECLARE(*SS_un_comp, (PFPObject pr, object *argl)),
 SC_DECLARE(*SS_bin_comp, (PFPObject pr, object *argl));


/* SHPRM3.C declarations */

extern object
 SC_DECLARE(*_SS_endcons, (object *list, object *obj)),
 SC_DECLARE(*SS_cons, (object *argl)),
 SC_DECLARE(*_SS_setcar, (object *pair, object *car)),
 SC_DECLARE(*_SS_setcdr, (object *pair, object *cdr)),
 SC_DECLARE(*SS_setcar, (object *argl)),
 SC_DECLARE(*SS_setcdr, (object *argl)),
 SC_DECLARE(*SS_car, (object *obj)),
 SC_DECLARE(*SS_cdr, (object *obj)),
 SC_DECLARE(*SS_caar, (object *obj)),
 SC_DECLARE(*SS_cadr, (object *obj)),
 SC_DECLARE(*SS_cdar, (object *obj)),
 SC_DECLARE(*SS_cddr, (object *obj)),
 SC_DECLARE(*SS_caaar, (object *obj)),
 SC_DECLARE(*SS_caadr, (object *obj)),
 SC_DECLARE(*SS_cadar, (object *obj)),
 SC_DECLARE(*SS_caddr, (object *obj)),
 SC_DECLARE(*SS_cdaar, (object *obj)),
 SC_DECLARE(*SS_cdadr, (object *obj)),
 SC_DECLARE(*SS_cddar, (object *obj)),
 SC_DECLARE(*SS_cdddr, (object *obj)),
 SC_DECLARE(*SS_lst_ref, (object *argl)),
 SC_DECLARE(*SS_lst_tail, (object *argl)),
 SC_DECLARE(*_SS_lst_tail, (object *lst, int n)),
 SC_DECLARE(*SS_last, (object *obj)),
 SC_DECLARE(*SS_reverse, (object *obj)),
 SC_DECLARE(*SS_append, (object *obj)),
 SC_DECLARE(*_SS_append, (object *lst1, object *lst2)),
 SC_DECLARE(*SS_length, (object *obj)),
 SC_DECLARE(*SS_numberp, (object *obj)),
 SC_DECLARE(*SS_intp, (object *obj)),
 SC_DECLARE(*SS_realp, (object *obj)),
 SC_DECLARE(*SS_strp, (object *obj)),
 SC_DECLARE(*SS_varp, (object *obj)),
 SC_DECLARE(*SS_boolp, (object *obj)),
 SC_DECLARE(*SS_pair, (object *obj)),
 SC_DECLARE(*SS_filep, (object *argl)),
 SC_DECLARE(*SS_ascii_filep, (object *obj)),
 SC_DECLARE(*SS_procp, (object *obj)),
 SC_DECLARE(*SS_eofp, (object *obj)),
 SC_DECLARE(*SS_nullp, (object *obj)),
 SC_DECLARE(*SS_eq, (object *obj)),
 SC_DECLARE(*SS_eqv, (object *obj)),
 SC_DECLARE(*SS_equal, (object *obj)),
 SC_DECLARE(*_SS_memp, (PFInt pred, object *obj, object *lst)),
 SC_DECLARE(*SS_memq, (object *argl)),
 SC_DECLARE(*SS_memv, (object *argl)),
 SC_DECLARE(*SS_member, (object *argl)),
 SC_DECLARE(*_SS_assp, (PFInt pred, object *obj, object *lst)),
 SC_DECLARE(*SS_assq, (object *argl)),
 SC_DECLARE(*SS_assv, (object *argl)),
 SC_DECLARE(*SS_assoc, (object *argl));

extern int
 SC_DECLARE(_SS_filep, (object *obj, char *dtype)),
 SC_DECLARE(_SS_length, (object *obj)),
 SC_DECLARE(_SS_numberp, (object *obj)),
 SC_DECLARE(_SS_eqv, (object *o1, object *o2)),
 SC_DECLARE(_SS_equal, (object *o1, object *o2)),
 SC_DECLARE(_SS_eq, (object *o1, object *o2));


/* SHPRNT.C declarations */

extern void
 SC_DECLARE(SS_wr_lst, (object *obj, object *strm)),
 SC_DECLARE(SS_wr_proc, (object *obj, object *strm)),
 SC_DECLARE(SS_wr_atm, (object *obj, object *strm));

extern object
 SC_DECLARE(*_SS_print,
         (object *obj, char *begin, char *end, object *strm)),
 SC_DECLARE(*SS_write, (object *obj)),
 SC_DECLARE(*SS_display, (object *obj)),
 SC_DECLARE(*SS_fprintf, (object *argl)),
 SC_DECLARE(*SS_sprintf, (object *argl)),
 SC_DECLARE(*SS_print_toggle, (byte)),
 SC_DECLARE(*SS_stats_toggle, (byte)),
 SC_DECLARE(*SS_trans_on, (object *obj)),
 SC_DECLARE(*SS_trans_off, (byte)),
 SC_DECLARE(*SS_opn_out, (object *obj)),
 SC_DECLARE(*SS_cls_out, (object *obj)),
 SC_DECLARE(*SS_oportp, (object *obj)),
 SC_DECLARE(*SS_banner, (object *obj)),
 SC_DECLARE(*SS_describe, (object *obj)),
 SC_DECLARE(*SS_apropos, (object *obj)),

#ifdef LARGE
 SC_DECLARE(*SS_call_of, (object *argl)),
 SC_DECLARE(*SS_curr_op, (byte)),
 SC_DECLARE(*SS_wr_chr, (object *argl)),
#endif

 SC_DECLARE(*SS_newline, (object *strm));

extern int
 SC_DECLARE(SS_prim_des, (object *strm, object *obj)),
 SC_DECLARE(SS_prim_apr, (FILE *str, char *s, HASHTAB *tab));

#ifdef LARGE

/* SHPROC.C declarations */

extern void
 SC_DECLARE(SS_inst_proc, (byte));

#endif


/* SHREAD.C declarations */

extern object
 SC_DECLARE(*_SS_pr_read, (object *str)),
 SC_DECLARE(*_SS_read, (object *str)),
 SC_DECLARE(*SS_read, (object *obj)),
 SC_DECLARE(*SS_opn_in, (object *obj)),
 SC_DECLARE(*SS_cls_in, (object *obj)),
 SC_DECLARE(*SS_iportp, (object *obj)),
 SC_DECLARE(*SS_rd_lst, (object *str)),

#ifdef LARGE
 SC_DECLARE(*SS_call_if, (object *argl)),
 SC_DECLARE(*SS_curr_ip, (byte)),
 SC_DECLARE(*SS_strprt, (object *arg)),
 SC_DECLARE(*SS_rd_line, (object *str)),
 SC_DECLARE(*SS_rd_vct, (object *str)),
#endif

 SC_DECLARE(*SS_rd_chr, (object *arg)),
 SC_DECLARE(*SS_rd_atm, (object *str)),
 SC_DECLARE(*SS_rd_str, (object *str)),
 SC_DECLARE(*SS_gread, (object *obj)),
 SC_DECLARE(*SS_load, (object *argl));

extern void
 SC_DECLARE(SS_clr_strm, (object *str));


/* SHSTRG.C declarations */

#ifdef LARGE

extern object
 SC_DECLARE(*SS_strcmp, (object *argl, PFInt func)),
 SC_DECLARE(*SS_streq, (object *argl)),
 SC_DECLARE(*SS_strge, (object *argl)),
 SC_DECLARE(*SS_strgt, (object *argl)),
 SC_DECLARE(*SS_strle, (object *argl)),
 SC_DECLARE(*SS_strlt, (object *argl)),
 SC_DECLARE(*SS_strlen, (object *str)),
 SC_DECLARE(*SS_strref, (object *argl)),
 SC_DECLARE(*SS_strsub, (object *argl)),
 SC_DECLARE(*SS_strapp, (object *argl)),
 SC_DECLARE(*SS_strlst, (object *str)),
 SC_DECLARE(*SS_lststr, (object *argl)),
 SC_DECLARE(*SS_chreq, (object *argl)),
 SC_DECLARE(*SS_chrge, (object *argl)),
 SC_DECLARE(*SS_chrgt, (object *argl)),
 SC_DECLARE(*SS_chrle, (object *argl)),
 SC_DECLARE(*SS_chrlt, (object *argl)),
 SC_DECLARE(*SS_chrint, (object *chr)),
 SC_DECLARE(*SS_intchr, (object *obj)),
 SC_DECLARE(*SS_symstr, (object *arg)),
 SC_DECLARE(*SS_strsym, (object *str)),
 SC_DECLARE(*SS_upcase, (object *str)),
 SC_DECLARE(*SS_dncase, (object *str));

extern int
 SC_DECLARE(_SS_streq, (char *s1, char *s2)),
 SC_DECLARE(_SS_strge, (char *s1, char *s2)),
 SC_DECLARE(_SS_strgt, (char *s1, char *s2)),
 SC_DECLARE(_SS_strle, (char *s1, char *s2)),
 SC_DECLARE(_SS_strlt, (char *s1, char *s2));

#endif


/* SHTLEV.C declarations */

extern object
 SC_DECLARE(*SS_quit, (object *arg)),
 SC_DECLARE(*SS_system, (object *obj)),
 SC_DECLARE(*SS_pop_err, (int n, int flag)),
 SC_DECLARE(*SS_break, (byte)),
 SC_DECLARE(*SS_reset, (byte)),
 SC_DECLARE(*SS_retlev, (object *argl));

extern int
 SC_DECLARE(SS_err_catch, (PFInt func, PFInt errf));

extern void
 SC_DECLARE(SS_inst_prm, (byte)),
 SC_DECLARE(SS_repl, (byte)),
 SC_DECLARE(SS_end_scheme, (int val)),
 SC_DECLARE(SS_init_scheme, (char *Code, char *Vers)),
 SC_DECLARE(SS_init_path, (byte)),
 SC_DECLARE(SS_inst_const, (byte)),
 SC_DECLARE(SS_init_stack, (byte)),
 SC_DECLARE(SS_init_cont, (byte)),
 SC_DECLARE(SS_interrupt_handler, (int sig)),
 SC_DECLARE(SS_push_err, (int flag, int type)),
 SC_DECLARE(SS_error, (char *s, object *obj)),
 SC_DECLARE(_SS_restore_state, (object *esc_proc)),
 SC_DECLARE(_SS_print_err_msg, (FILE *str, char *s, object *obj)),
 SC_DECLARE(_SS_print_err_msg_a, 
            (FILE *str, char *s, object *obj));


/* SHTTY.C declarations */

extern int
 SC_DECLARE(SS_printf, (FILE *fp, char *fmt, ...)),
 SC_DECLARE(SS_get_ch, (object *str, int ign_ws));

extern void
 SC_DECLARE(SS_unget_ch, (int c, object *str)),
 SC_DECLARE(SS_put_ch, (int c, object *str));

extern char
 SC_DECLARE(*SS_get_string, (object *obj));


/* SHVAR.C declarations */

extern object
 SC_DECLARE(*SS_install_cf,
         (char *name, char *document, PFPObject handler, ...)),
 SC_DECLARE(*SS_install_cv, (char *name, byte *pval, int type)),
 SC_DECLARE(*SS_acc_REAL, (byte *vr, object *argl)),
 SC_DECLARE(*SS_acc_int, (byte *vr, object *argl)),
 SC_DECLARE(*SS_acc_long, (byte *vr, object *argl)),
 SC_DECLARE(*SS_acc_char, (byte *vr, object *argl)),
 SC_DECLARE(*SS_acc_string, (byte *vr, object *argl)),
 SC_DECLARE(*SS_acc_ptr, (byte *vr, object *argl)),
 SC_DECLARE(*SS_acc_var, (byte *vr, object *argl, int otype));

#ifdef __cplusplus
}
#endif

#endif