callisto-debian/gimp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

plug-ins/script-fu/tinyscheme/scheme.c Applied changes froh official

Browse Source 
2008-09-12  Kevin Cozens  <kcozens@cvs.gnome.org>

	* plug-ins/script-fu/tinyscheme/scheme.c
	* plug-ins/script-fu/tinyscheme/scheme.h: Applied changes froh
	official version of TinyScheme which expose more of the internals.
	Part of making it more suitable for Scheme->C->Scheme calling.
	See SourceForge bug #1599947.

svn path=/trunk/; revision=26937
This commit is contained in:
Kevin Cozens
2008-09-12 17:30:28 +00:00
committed by Kevin Cozens
parent 69b6f2874b
commit e5c73a05b4
3 changed files with 51 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
ChangeLog
View File

@ -1,3 +1,11 @@
2008-09-12 Kevin Cozens <kcozens@cvs.gnome.org>
* plug-ins/script-fu/tinyscheme/scheme.c
* plug-ins/script-fu/tinyscheme/scheme.h: Applied changes froh
official version of TinyScheme which expose more of the internals.
Part of making it more suitable for Scheme->C->Scheme calling.
See SourceForge bug #1599947.
2008-09-12 Sven Neumann <sven@gimp.org> 2008-09-12 Sven Neumann <sven@gimp.org>
* plug-ins/common/guillotine.c: return the list of created images. * plug-ins/common/guillotine.c: return the list of created images.

64
plug-ins/script-fu/tinyscheme/scheme.c
View File

@ -377,7 +377,6 @@ static void finalize_cell(scheme *sc, pointer a);
static int count_consecutive_cells(pointer x, int needed); static int count_consecutive_cells(pointer x, int needed);
static pointer find_slot_in_env(scheme *sc, pointer env, pointer sym, int all); static pointer find_slot_in_env(scheme *sc, pointer env, pointer sym, int all);
static pointer mk_number(scheme *sc, num n); static pointer mk_number(scheme *sc, num n);
static pointer mk_empty_string(scheme *sc, int len, gunichar fill);
static char *store_string(scheme *sc, int len, const char *str, gunichar fill); static char *store_string(scheme *sc, int len, const char *str, gunichar fill);
static pointer mk_vector(scheme *sc, int len); static pointer mk_vector(scheme *sc, int len);
static pointer mk_atom(scheme *sc, char *q); static pointer mk_atom(scheme *sc, char *q);
@ -407,8 +406,9 @@ static pointer mk_continuation(scheme *sc, pointer d);
static pointer reverse(scheme *sc, pointer a); static pointer reverse(scheme *sc, pointer a);
static pointer reverse_in_place(scheme *sc, pointer term, pointer list); static pointer reverse_in_place(scheme *sc, pointer term, pointer list);
static pointer append(scheme *sc, pointer a, pointer b); static pointer append(scheme *sc, pointer a, pointer b);
static int list_length(scheme *sc, pointer a); int list_length(scheme *sc, pointer a);
static int eqv(pointer a, pointer b); int eqv(pointer a, pointer b);
static INLINE void dump_stack_mark(scheme *); static INLINE void dump_stack_mark(scheme *);
static pointer opexe_0(scheme *sc, enum scheme_opcodes op); static pointer opexe_0(scheme *sc, enum scheme_opcodes op);
static pointer opexe_1(scheme *sc, enum scheme_opcodes op); static pointer opexe_1(scheme *sc, enum scheme_opcodes op);
@ -422,9 +422,6 @@ static void assign_syntax(scheme *sc, char *name);
static int syntaxnum(pointer p); static int syntaxnum(pointer p);
static void assign_proc(scheme *sc, enum scheme_opcodes, char *name); static void assign_proc(scheme *sc, enum scheme_opcodes, char *name);
scheme *scheme_init_new(void); scheme *scheme_init_new(void);
#if !STANDALONE
void scheme_call(scheme *sc, pointer func, pointer args);
#endif
#define num_ivalue(n) (n.is_fixnum?(n).value.ivalue:(long)(n).value.rvalue) #define num_ivalue(n) (n.is_fixnum?(n).value.ivalue:(long)(n).value.rvalue)
#define num_rvalue(n) (!n.is_fixnum?(n).value.rvalue:(double)(n).value.ivalue) #define num_rvalue(n) (!n.is_fixnum?(n).value.rvalue:(double)(n).value.ivalue)
@ -1018,7 +1015,7 @@ INTERFACE pointer mk_counted_string(scheme *sc, const char *str, int len) {
return (x); return (x);
} }
static pointer mk_empty_string(scheme *sc, int len, gunichar fill) { INTERFACE pointer mk_empty_string(scheme *sc, int len, gunichar fill) {
pointer x = get_cell(sc, sc->NIL, sc->NIL); pointer x = get_cell(sc, sc->NIL, sc->NIL);
strvalue(x) = store_string(sc,len,0,fill); strvalue(x) = store_string(sc,len,0,fill);
@ -2111,7 +2108,7 @@ static pointer append(scheme *sc, pointer a, pointer b) {
} }
/* equivalence of atoms */ /* equivalence of atoms */
static int eqv(pointer a, pointer b) { int eqv(pointer a, pointer b) {
if (is_string(a)) { if (is_string(a)) {
if (is_string(b)) if (is_string(b))
return (strvalue(a) == strvalue(b)); return (strvalue(a) == strvalue(b));
@ -3535,7 +3532,7 @@ static int is_list(scheme *sc, pointer a) {
} }
} }
static int list_length(scheme *sc, pointer a) { int list_length(scheme *sc, pointer a) {
int i=0; int i=0;
pointer slow, fast; pointer slow, fast;
@ -4743,27 +4740,38 @@ void scheme_define(scheme *sc, pointer envir, pointer symbol, pointer value) {
} }
#if !STANDALONE #if !STANDALONE
void scheme_apply0(scheme *sc, const char *procname) { pointer scheme_apply0(scheme *sc, const char *procname)
pointer carx=mk_symbol(sc,procname); { return scheme_eval(sc, cons(sc,mk_symbol(sc,procname),sc->NIL)); }
pointer cdrx=sc->NIL;
s_save(sc,OP_QUIT,sc->NIL,sc->NIL); /* "func" and "args" are assumed to be already eval'ed. */
sc->envir = sc->global_env; pointer scheme_call(scheme *sc, pointer func, pointer args)
sc->code = cons(sc,carx,cdrx); {
sc->interactive_repl=0; int old_repl = sc->interactive_repl;
sc->retcode=0; sc->interactive_repl = 0;
Eval_Cycle(sc,OP_EVAL); s_save(sc,OP_QUIT,sc->NIL,sc->NIL);
} sc->envir = sc->global_env;
sc->args = args;
void scheme_call(scheme *sc, pointer func, pointer args) { sc->code = func;
s_save(sc,OP_QUIT,sc->NIL,sc->NIL); sc->retcode = 0;
sc->envir = sc->global_env; Eval_Cycle(sc, OP_APPLY);
sc->args = args; sc->interactive_repl = old_repl;
sc->code = func; return sc->value;
sc->interactive_repl =0;
sc->retcode = 0;
Eval_Cycle(sc, OP_APPLY);
} }
pointer scheme_eval(scheme *sc, pointer obj)
{
int old_repl = sc->interactive_repl;
sc->interactive_repl = 0;
s_save(sc,OP_QUIT,sc->NIL,sc->NIL);
sc->args = sc->NIL;
sc->code = obj;
sc->retcode = 0;
Eval_Cycle(sc, OP_EVAL);
sc->interactive_repl = old_repl;
return sc->value;
}
#endif #endif
/* ========== Main ========== */ /* ========== Main ========== */

9
plug-ins/script-fu/tinyscheme/scheme.h
View File

@ -141,8 +141,9 @@ SCHEME_EXPORT void scheme_set_output_port_file(scheme *sc, FILE *fin);
void scheme_set_output_port_string(scheme *sc, char *start, char *past_the_end); void scheme_set_output_port_string(scheme *sc, char *start, char *past_the_end);
SCHEME_EXPORT void scheme_load_file(scheme *sc, FILE *fin); SCHEME_EXPORT void scheme_load_file(scheme *sc, FILE *fin);
SCHEME_EXPORT void scheme_load_string(scheme *sc, const char *cmd); SCHEME_EXPORT void scheme_load_string(scheme *sc, const char *cmd);
void scheme_apply0(scheme *sc, const char *procname); SCHEME_EXPORT pointer scheme_apply0(scheme *sc, const char *procname);
SCHEME_EXPORT pointer scheme_apply1(scheme *sc, const char *procname, pointer); SCHEME_EXPORT pointer scheme_call(scheme *sc, pointer func, pointer args);
SCHEME_EXPORT pointer scheme_eval(scheme *sc, pointer obj);
void scheme_set_external_data(scheme *sc, void *p); void scheme_set_external_data(scheme *sc, void *p);
SCHEME_EXPORT void scheme_define(scheme *sc, pointer env, pointer symbol, pointer value); SCHEME_EXPORT void scheme_define(scheme *sc, pointer env, pointer symbol, pointer value);
@ -155,10 +156,14 @@ pointer mk_symbol(scheme *sc, const char *name);
pointer gensym(scheme *sc); pointer gensym(scheme *sc);
pointer mk_string(scheme *sc, const char *str); pointer mk_string(scheme *sc, const char *str);
pointer mk_counted_string(scheme *sc, const char *str, int len); pointer mk_counted_string(scheme *sc, const char *str, int len);
pointer mk_empty_string(scheme *sc, int len, gunichar fill);
pointer mk_character(scheme *sc, gunichar c); pointer mk_character(scheme *sc, gunichar c);
pointer mk_foreign_func(scheme *sc, foreign_func f); pointer mk_foreign_func(scheme *sc, foreign_func f);
void putcharacter(scheme *sc, gunichar c); void putcharacter(scheme *sc, gunichar c);
void putstr(scheme *sc, const char *s); void putstr(scheme *sc, const char *s);
int list_length(scheme *sc, pointer a);
int eqv(pointer a, pointer b);
SCHEME_EXPORT void set_safe_foreign (scheme *sc, pointer data); SCHEME_EXPORT void set_safe_foreign (scheme *sc, pointer data);
SCHEME_EXPORT pointer foreign_error (scheme *sc, const char *s, pointer a); SCHEME_EXPORT pointer foreign_error (scheme *sc, const char *s, pointer a);