gimp r26937 - in trunk: . plug-ins/script-fu/tinyscheme

[kcozens svn gnome org]

Author: kcozens
Date: Fri Sep 12 17:30:28 2008
New Revision: 26937
URL: http://svn.gnome.org/viewvc/gimp?rev=26937&view=rev

Log:
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.


Modified:
   trunk/ChangeLog
   trunk/plug-ins/script-fu/tinyscheme/scheme.c
   trunk/plug-ins/script-fu/tinyscheme/scheme.h

Modified: trunk/plug-ins/script-fu/tinyscheme/scheme.c
==============================================================================
--- trunk/plug-ins/script-fu/tinyscheme/scheme.c	(original)
+++ trunk/plug-ins/script-fu/tinyscheme/scheme.c	Fri Sep 12 17:30:28 2008
@@ -377,7 +377,6 @@
 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 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 pointer mk_vector(scheme *sc, int len);
 static pointer mk_atom(scheme *sc, char *q);
@@ -407,8 +406,9 @@
 static pointer reverse(scheme *sc, pointer a);
 static pointer reverse_in_place(scheme *sc, pointer term, pointer list);
 static pointer append(scheme *sc, pointer a, pointer b);
-static int list_length(scheme *sc, pointer a);
-static int eqv(pointer a, pointer b);
+int list_length(scheme *sc, pointer a);
+int eqv(pointer a, pointer b);
+
 static INLINE void dump_stack_mark(scheme *);
 static pointer opexe_0(scheme *sc, enum scheme_opcodes op);
 static pointer opexe_1(scheme *sc, enum scheme_opcodes op);
@@ -422,9 +422,6 @@
 static int syntaxnum(pointer p);
 static void assign_proc(scheme *sc, enum scheme_opcodes, char *name);
 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_rvalue(n)       (!n.is_fixnum?(n).value.rvalue:(double)(n).value.ivalue)
@@ -1018,7 +1015,7 @@
      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);
 
      strvalue(x) = store_string(sc,len,0,fill);
@@ -2111,7 +2108,7 @@
 }
 
 /* equivalence of atoms */
-static int eqv(pointer a, pointer b) {
+int eqv(pointer a, pointer b) {
      if (is_string(a)) {
           if (is_string(b))
                return (strvalue(a) == strvalue(b));
@@ -3535,7 +3532,7 @@
     }
 }
 
-static int list_length(scheme *sc, pointer a) {
+int list_length(scheme *sc, pointer a) {
     int i=0;
     pointer slow, fast;
 
@@ -4743,27 +4740,38 @@
 }
 
 #if !STANDALONE
-void scheme_apply0(scheme *sc, const char *procname) {
-     pointer carx=mk_symbol(sc,procname);
-     pointer cdrx=sc->NIL;
-
-     s_save(sc,OP_QUIT,sc->NIL,sc->NIL);
-     sc->envir = sc->global_env;
-     sc->code = cons(sc,carx,cdrx);
-     sc->interactive_repl=0;
-     sc->retcode=0;
-     Eval_Cycle(sc,OP_EVAL);
-     }
-
-void scheme_call(scheme *sc, pointer func, pointer args) {
-   s_save(sc,OP_QUIT,sc->NIL,sc->NIL);
-   sc->envir = sc->global_env;
-   sc->args = args;
-   sc->code = func;
-   sc->interactive_repl =0;
-   sc->retcode = 0;
-   Eval_Cycle(sc, OP_APPLY);
+pointer scheme_apply0(scheme *sc, const char *procname)
+{ return scheme_eval(sc, cons(sc,mk_symbol(sc,procname),sc->NIL)); }
+
+/* "func" and "args" are assumed to be already eval'ed. */
+pointer scheme_call(scheme *sc, pointer func, pointer args)
+{
+  int old_repl = sc->interactive_repl;
+  sc->interactive_repl = 0;
+  s_save(sc,OP_QUIT,sc->NIL,sc->NIL);
+  sc->envir = sc->global_env;
+  sc->args = args;
+  sc->code = func;
+  sc->retcode = 0;
+  Eval_Cycle(sc, OP_APPLY);
+  sc->interactive_repl = old_repl;
+  return sc->value;
 }
+
+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
 
 /* ========== Main ========== */

Modified: trunk/plug-ins/script-fu/tinyscheme/scheme.h
==============================================================================
--- trunk/plug-ins/script-fu/tinyscheme/scheme.h	(original)
+++ trunk/plug-ins/script-fu/tinyscheme/scheme.h	Fri Sep 12 17:30:28 2008
@@ -141,8 +141,9 @@
 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_string(scheme *sc, const char *cmd);
-void scheme_apply0(scheme *sc, const char *procname);
-SCHEME_EXPORT pointer scheme_apply1(scheme *sc, const char *procname, pointer);
+SCHEME_EXPORT pointer scheme_apply0(scheme *sc, const char *procname);
+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);
 SCHEME_EXPORT void scheme_define(scheme *sc, pointer env, pointer symbol, pointer value);
 
@@ -155,10 +156,14 @@
 pointer gensym(scheme *sc);
 pointer mk_string(scheme *sc, const char *str);
 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_foreign_func(scheme *sc, foreign_func f);
 void    putcharacter(scheme *sc, gunichar c);
 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 pointer foreign_error (scheme *sc, const char *s, pointer a);