Loading...
Searching...
No Matches
siod_defs.h
/* 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. *
*/
/*************************************************************************/
/* Author : Alan W Black */
/* Date : March 1999 */
/*-----------------------------------------------------------------------*/
/* */
/* Struct and macro definitions for SIOD */
/* */
/*=======================================================================*/
#ifndef __EST_SIOD_DEFS_H__
#define __EST_SIOD_DEFS_H__
/* This states the default heap size is effective unset */
/* The size if no heap is specified by a command argument, the */
/* value of the environment variable SIODHEAPSIZE will be used */
/* otherwise ACTUAL_DEFAULT_HEAP_SIZE is used. This is *not* */
/* documented because environment variables can cause so many */
/* problems I'd like to discourage this use unless absolutely */
/* necessary. */
#define DEFAULT_HEAP_SIZE -1
#define ACTUAL_DEFAULT_HEAP_SIZE 210000
struct obj
{union {struct {struct obj * car;
struct obj * cdr;} cons;
struct {double data;} flonum;
struct {const char *pname;
struct obj * vcell;} symbol;
struct {const char *name;
struct obj * (*f)(void);} subr0;
struct {const char *name;
struct obj * (*f)(struct obj *);} subr1;
struct {const char *name;
struct obj * (*f)(struct obj *, struct obj *);} subr2;
struct {const char *name;
struct obj * (*f)(struct obj *, struct obj *, struct obj *);
} subr3;
struct {const char *name;
struct obj * (*f)(struct obj *, struct obj *,
struct obj *, struct obj *);
} subr4;
struct {const char *name;
struct obj * (*f)(struct obj **, struct obj **);} subrm;
struct {const char *name;
struct obj * (*f)(void *,...);} subr;
struct {struct obj *env;
struct obj *code;} closure;
struct {long dim;
long *data;} long_array;
struct {long dim;
double *data;} double_array;
struct {long dim;
char *data;} string;
struct {long dim;
struct obj **data;} lisp_array;
struct {FILE *f;
char *name;} c_file;
struct {EST_Val *v;} val;
struct {void *p;} user;
}
storage_as;
char *pname; // This is currently only used by FLONM
short gc_mark;
short type;
};
#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 SUBRM(x) (*((*x).storage_as.subrm.f))
#define SUBRF(x) (*((*x).storage_as.subr.f))
#define FLONM(x) ((*x).storage_as.flonum.data)
#define FLONMPNAME(x) ((*x).pname)
#define USERVAL(x) ((*x).storage_as.user.p)
#define UNTYPEDVAL(x) ((*x).storage_as.user.p)
#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_untyped 18
#define tc_subr_4 19
#define tc_sys_1 31
#define tc_sys_2 32
#define tc_sys_3 33
#define tc_sys_4 34
#define tc_sys_5 35
// older method for adding application specific types
#define tc_application_1 41
#define tc_application_2 42
#define tc_application_3 43
#define tc_application_4 44
#define tc_application_5 45
#define tc_application_6 46
#define tc_application_7 47
// Application specific types may be added using siod_register_user_type()
// Will increment from tc_first_user_type to tc_table_dim
#define tc_first_user_type 50
#define tc_table_dim 100
#define FO_fetch 127
#define FO_store 126
#define FO_list 125
#define FO_listd 124
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 STRINGP(x) TYPEP(x,tc_string)
#define NCONSP(x) NTYPEP(x,tc_cons)
#define NFLONUMP(x) NTYPEP(x,tc_flonum)
#define NSYMBOLP(x) NTYPEP(x,tc_symbol)
// Not for the purists, but I find these more readable than the equivalent
// code inline.
#define CAR1(x) CAR(x)
#define CDR1(x) CDR(x)
#define CAR2(x) CAR(CDR1(x))
#define CDR2(x) CDR(CDR1(x))
#define CAR3(x) CAR(CDR2(x))
#define CDR3(x) CDR(CDR2(x))
#define CAR4(x) CAR(CDR3(x))
#define CDR4(x) CDR(CDR3(x))
#define CAR5(x) CAR(CDR4(x))
#define CDR5(x) CDR(CDR4(x))
#define LISTP(x) (NULLP(x) || CONSP(x))
#define LIST1P(x) (CONSP(x) && NULLP(CDR(x)))
#define LIST2P(x) (CONSP(x) && CONSP(CDR1(x)) && NULLP(CDR2(x)))
#define LIST3P(x) (CONSP(x) && CONSP(CDR1(x)) && CONSP(CDR2(x)) && NULLP(CDR3(x)))
#define LIST4P(x) (CONSP(x) && CONSP(CDR1(x)) && CONSP(CDR2(x)) && CONSP(CDR3(x)) && NULLP(CDR4(x)))
#define LIST5P(x) (CONSP(x) && CONSP(CDR1(x)) && CONSP(CDR2(x)) && CONSP(CDR3(x)) && CONSP(CDR4(x)) && NULLP(CDR5(x)))
#define MKPTR(x) (siod_make_ptr((void *)x))
struct gen_readio
{int (*getc_fcn)(char *);
void (*ungetc_fcn)(int, char *);
char *cb_argument;};
#define GETC_FCN(x) (*((*x).getc_fcn))((*x).cb_argument)
#define UNGETC_FCN(c,x) (*((*x).ungetc_fcn))(c,(*x).cb_argument)
struct repl_hooks
{void (*repl_puts)(char *);
LISP (*repl_read)(void);
LISP (*repl_eval)(LISP);
void (*repl_print)(LISP);};
/* Macro for defining new class as values public functions */
#define SIOD_REGISTER_CLASS_DCLS(NAME,CLASS) \
class CLASS *NAME(LISP x); \
int NAME##_p(LISP x); \
EST_Val est_val(const class CLASS *v); \
LISP siod(const class CLASS *v);
/* Macro for defining new class as siod */
#define SIOD_REGISTER_CLASS(NAME,CLASS) \
class CLASS *NAME(LISP x) \
{ \
return NAME(val(x)); \
} \
\
int NAME##_p(LISP x) \
{ \
if (val_p(x) && \
(val_type_##NAME == val(x).type())) \
return TRUE; \
else \
return FALSE; \
} \
\
LISP siod(const class CLASS *v) \
{ \
if (v == 0) \
return NIL; \
else \
return siod(est_val(v)); \
} \
/* Macro for defining typedefed something as values public functions */
#define SIOD_REGISTER_TYPE_DCLS(NAME,CLASS) \
CLASS *NAME(LISP x); \
int NAME##_p(LISP x); \
EST_Val est_val(const CLASS *v); \
LISP siod(const CLASS *v);
/* Macro for defining new class as siod */
#define SIOD_REGISTER_TYPE(NAME,CLASS) \
CLASS *NAME(LISP x) \
{ \
return NAME(val(x)); \
} \
\
int NAME##_p(LISP x) \
{ \
if (val_p(x) && \
(val_type_##NAME == val(x).type())) \
return TRUE; \
else \
return FALSE; \
} \
\
LISP siod(const CLASS *v) \
{ \
if (v == 0) \
return NIL; \
else \
return siod(est_val(v)); \
} \
/* Macro for defining function ptr as siod */
#define SIOD_REGISTER_FUNCPTR(NAME,CLASS) \
CLASS NAME(LISP x) \
{ \
return NAME(val(x)); \
} \
\
int NAME##_p(LISP x) \
{ \
if (val_p(x) && \
(val_type_##NAME == val(x).type())) \
return TRUE; \
else \
return FALSE; \
} \
\
LISP siod(const CLASS v) \
{ \
if (v == 0) \
return NIL; \
else \
return siod(est_val(v)); \
} \
#endif
EST_Val
Definition EST_Val.h:70
gen_readio
Definition siod_defs.h:184
obj
Definition siod_defs.h:31
repl_hooks
Definition siod_defs.h:192