| /* 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$ |
| |
| */ |
| |
| struct obj |
| {short gc_mark; |
| short type; |
| union {struct {struct obj * car; |
| struct obj * cdr;} cons; |
| struct {double 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; |
| long *data;} long_array; |
| struct {long dim; |
| double *data;} double_array; |
| struct {long dim; |
| char *data;} string; |
| struct {long dim; |
| unsigned char *data;} u_string; |
| struct {long dim; |
| signed char *data;} s_string; |
| struct {long dim; |
| struct obj **data;} lisp_array; |
| 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 FO_comment 35 |
| #define tc_user_min 50 |
| #define tc_user_max 100 |
| |
| #define FO_fetch 127 |
| #define FO_store 126 |
| #define FO_list 125 |
| #define FO_listd 124 |
| |
| #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 |
| |
| #ifndef WIN32 |
| #define __stdcall |
| #endif |
| |
| |
| struct gen_readio |
| {int (*getc_fcn)(void *); |
| void (*ungetc_fcn)(int,void *); |
| void *cb_argument;}; |
| |
| struct gen_printio |
| {int (*putc_fcn)(int,void *); |
| int (*puts_fcn)(char *,void *); |
| void *cb_argument;}; |
| |
| #define GETC_FCN(x) (*((*x).getc_fcn))((*x).cb_argument) |
| #define UNGETC_FCN(c,x) (*((*x).ungetc_fcn))(c,(*x).cb_argument) |
| #define PUTC_FCN(c,x) (*((*x).putc_fcn))(c,(*x).cb_argument) |
| #define PUTS_FCN(c,x) (*((*x).puts_fcn))(c,(*x).cb_argument) |
| |
| struct repl_hooks |
| {void (*repl_puts)(char *); |
| LISP (*repl_read)(void); |
| LISP (*repl_eval)(LISP); |
| void (*repl_print)(LISP);}; |
| |
| void __stdcall process_cla(int argc,char **argv,int warnflag); |
| void __stdcall print_welcome(void); |
| void __stdcall print_hs_1(void); |
| void __stdcall print_hs_2(void); |
| long no_interrupt(long n); |
| LISP get_eof_val(void); |
| long repl_driver(long want_sigint,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)); |
| long repl(struct repl_hooks *); |
| LISP err(const char *message, LISP x); |
| LISP errswitch(void); |
| 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); |
| double get_c_double(LISP x); |
| LISP lerr(LISP message, LISP x); |
| |
| LISP newcell(long type); |
| 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 setcdr(LISP cell, LISP value); |
| LISP flocons(double x); |
| LISP numberp(LISP x); |
| LISP plus(LISP x,LISP y); |
| LISP ltimes(LISP x,LISP y); |
| LISP difference(LISP x,LISP y); |
| LISP Quotient(LISP x,LISP y); |
| LISP greaterp(LISP x,LISP y); |
| LISP lessp(LISP x,LISP y); |
| LISP eq(LISP x,LISP y); |
| 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 cintern(char *name); |
| 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 __stdcall init_storage(void); |
| void __stdcall init_slibu(void); |
| |
| 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 assq(LISP x,LISP alist); |
| LISP delq(LISP elem,LISP l); |
| void set_gc_hooks(long type, |
| LISP (*rel)(LISP), |
| LISP (*mark)(LISP), |
| void (*scan)(LISP), |
| void (*free)(LISP), |
| long *kind); |
| LISP gc_relocate(LISP x); |
| LISP user_gc(LISP args); |
| LISP gc_status(LISP args); |
| void set_eval_hooks(long type,LISP (*fcn)(LISP, LISP *, LISP *)); |
| LISP leval(LISP x,LISP env); |
| LISP symbolconc(LISP args); |
| void set_print_hooks(long type,void (*fcn)(LISP, struct gen_printio *)); |
| LISP lprin1g(LISP exp,struct gen_printio *f); |
| LISP lprin1f(LISP exp,FILE *f); |
| LISP lprint(LISP exp,LISP); |
| LISP lread(LISP); |
| LISP lreadtk(char *,long j); |
| LISP lreadf(FILE *f); |
| void set_read_hooks(char *all_set,char *end_set, |
| LISP (*fcn1)(int, struct gen_readio *), |
| LISP (*fcn2)(char *,long, int *)); |
| LISP apropos(LISP); |
| LISP vload(char *fname,long cflag,long rflag); |
| LISP load(LISP fname,LISP cflag,LISP rflag); |
| LISP require(LISP fname); |
| LISP save_forms(LISP fname,LISP forms,LISP how); |
| LISP quit(void); |
| LISP nullp(LISP x); |
| LISP strcons(long length,const char *data); |
| LISP read_from_string(LISP x); |
| LISP aref1(LISP a,LISP i); |
| LISP aset1(LISP a,LISP i,LISP v); |
| LISP cons_array(LISP dim,LISP kind); |
| LISP arcons(long typecode,long n,long initp); |
| LISP string_append(LISP args); |
| LISP string_length(LISP string); |
| LISP string_search(LISP,LISP); |
| LISP substring(LISP,LISP,LISP); |
| LISP string_trim(LISP); |
| LISP string_trim_left(LISP); |
| LISP string_trim_right(LISP); |
| LISP string_upcase(LISP); |
| LISP string_downcase(LISP); |
| void __stdcall init_subrs(void); |
| LISP copy_list(LISP); |
| long c_sxhash(LISP,long); |
| LISP sxhash(LISP,LISP); |
| LISP href(LISP,LISP); |
| LISP hset(LISP,LISP,LISP); |
| LISP fast_print(LISP,LISP); |
| LISP fast_read(LISP); |
| LISP equal(LISP,LISP); |
| LISP assoc(LISP x,LISP alist); |
| LISP make_list(LISP x,LISP v); |
| void set_fatal_exit_hook(void (*fcn)(void)); |
| LISP parse_number(LISP x); |
| LISP intern(LISP x); |
| void __stdcall init_trace(void); |
| long __stdcall repl_c_string(char *,long want_sigint,long want_init,long want_print); |
| char * __stdcall siod_version(void); |
| LISP nreverse(LISP); |
| LISP number2string(LISP,LISP,LISP,LISP); |
| LISP string2number(LISP,LISP); |
| LISP siod_verbose(LISP); |
| int __stdcall siod_verbose_check(int); |
| LISP setvar(LISP,LISP,LISP); |
| long allocate_user_tc(void); |
| 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 gput_st(struct gen_printio *,char *); |
| void put_st(char *st); |
| LISP listn(long n, ...); |
| char *must_malloc(unsigned long size); |
| LISP lstrbreakup(LISP str,LISP lmarker); |
| LISP lstrunbreakup(LISP elems,LISP lmarker); |
| LISP nconc(LISP,LISP); |
| LISP poparg(LISP *,LISP); |
| FILE *get_c_file(LISP p,FILE *deflt); |
| char *last_c_errmsg(int); |
| LISP llast_c_errmsg(int); |
| |
| #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 memq(LISP x,LISP il); |
| LISP lstrbreakup(LISP,LISP); |
| LISP lstrbreakup(LISP,LISP); |
| LISP nth(LISP,LISP); |
| LISP butlast(LISP); |
| LISP last(LISP); |
| LISP readtl(struct gen_readio *f); |
| 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); |
| |
| int assemble_options(LISP, ...); |
| LISP ccall_catch(LISP tag,LISP (*fcn)(void *),void *); |
| LISP lref_default(LISP li,LISP x,LISP fcn); |
| |
| |
| LISP symalist(char *item,...); |
| |
| LISP encode_st_mode(LISP l); |
| LISP encode_open_flags(LISP l); |
| long nlength(LISP obj); |
| int __stdcall siod_main(int argc,char **argv, char **env); |
| void __stdcall siod_shuffle_args(int *pargc,char ***pargv); |
| void __stdcall siod_init(int argc,char **argv); |
| |