mirror of https://github.com/GNOME/gimp.git
425 lines
10 KiB
C
425 lines
10 KiB
C
|
|
/* 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$
|
|
|
|
*/
|
|
#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
|
|
{
|
|
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;
|
|
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
|
|
|
|
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 process_cla (int argc, char **argv, int warnflag);
|
|
void print_welcome (void);
|
|
void print_hs_1 (void);
|
|
void 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 my_err (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 gc_unprotect (LISP * location);
|
|
|
|
void init_storage (void);
|
|
void 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, 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 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 init_trace (void);
|
|
long repl_c_string (char *, long want_sigint, long want_init, long want_print);
|
|
char *siod_version (void);
|
|
LISP nreverse (LISP);
|
|
LISP number2string (LISP, LISP, LISP, LISP);
|
|
LISP string2number (LISP, LISP);
|
|
LISP siod_verbose (LISP);
|
|
int 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);
|
|
|
|
|
|
#endif /* __SIOD_H__ */
|