[gimp] Applied changes based on official version of TinyScheme (CVS commits dated

[Kevin Cozens <kcozens src gnome org>]

commit 21cebda8a95fc36a0738ed9a0e3e9d4c5baf7ea3
Author: Kevin Cozens <kcozens cvs gnome org>
Date:   Fri Aug 7 23:56:40 2009 -0400

    Applied changes based on official version of TinyScheme (CVS commits dated
    2008/01/22 04:18). Fix for the load bug.

 plug-ins/script-fu/tinyscheme/scheme-private.h |    2 +
 plug-ins/script-fu/tinyscheme/scheme.c         |  107 ++++++++++++++++--------
 2 files changed, 74 insertions(+), 35 deletions(-)
---
diff --git a/plug-ins/script-fu/tinyscheme/scheme-private.h b/plug-ins/script-fu/tinyscheme/scheme-private.h
index 89ba365..3e0d85a 100644
--- a/plug-ins/script-fu/tinyscheme/scheme-private.h
+++ b/plug-ins/script-fu/tinyscheme/scheme-private.h
@@ -57,6 +57,8 @@ func_dealloc free;
 /* return code */
 int retcode;
 int tracing;
+int top_EOF;  /* Have we seen EOF at top level? */
+
 
 #define CELL_SEGSIZE    25000 /* # of cells in one segment */
 #define CELL_NSEGMENT   50    /* # of segments for cells */
diff --git a/plug-ins/script-fu/tinyscheme/scheme.c b/plug-ins/script-fu/tinyscheme/scheme.c
index 26dc30f..6a26a3f 100644
--- a/plug-ins/script-fu/tinyscheme/scheme.c
+++ b/plug-ins/script-fu/tinyscheme/scheme.c
@@ -396,7 +396,7 @@ static gunichar inchar(scheme *sc);
 static void backchar(scheme *sc, gunichar c);
 static char *readstr_upto(scheme *sc, char *delim);
 static pointer readstrexp(scheme *sc);
-static INLINE void skipspace(scheme *sc);
+static INLINE int skipspace(scheme *sc);
 static int token(scheme *sc);
 static void printslashstring(scheme *sc, char *s, int len);
 static void atom2str(scheme *sc, pointer l, int f, char **pp, int *plen);
@@ -1425,8 +1425,11 @@ static int file_push(scheme *sc, const char *fname) {
 }
 
 static void file_pop(scheme *sc) {
- sc->nesting=sc->nesting_stack[sc->file_i];
- if(sc->file_i!=0) {
+ if(sc->file_i==0)
+   { sc->top_EOF = 1; }
+ else
+   {
+   sc->nesting=sc->nesting_stack[sc->file_i];
    port_close(sc,sc->loadport,port_input);
    sc->file_i--;
    sc->loadport->_object._port=sc->load_stack+sc->file_i;
@@ -1640,7 +1643,7 @@ static gunichar basic_inchar(port *pt) {
 static gunichar inchar(scheme *sc) {
   gunichar c;
   port *pt;
- again:
+
   pt = sc->inport->_object._port;
   if(pt->kind&port_file)
   {
@@ -1651,14 +1654,10 @@ static gunichar inchar(scheme *sc) {
   }
   else
     c = basic_inchar(pt);
-  if(c == EOF && sc->inport == sc->loadport && sc->file_i != 0) {
+  if(c == EOF && sc->inport == sc->loadport) {
     file_pop(sc);
-    if(sc->nesting!=0) {
-      return EOF;
-    } else {
-      return '\n';
-    }
-    goto again;
+    return EOF;
+    /* NOTREACHED */
   }
   return c;
 }
@@ -1904,19 +1903,25 @@ static INLINE int is_one_of(char *s, gunichar c) {
 }
 
 /* skip white characters */
-static INLINE void skipspace(scheme *sc) {
+static INLINE int skipspace(scheme *sc) {
      gunichar c;
-     while (g_unichar_isspace(c=inchar(sc)))
-          ;
+     do
+       { c=inchar(sc); }
+     while (g_unichar_isspace(c));
+
      if(c!=EOF) {
           backchar(sc,c);
+          return 1;
      }
+     else
+       { return EOF; }
 }
 
 /* get token */
 static int token(scheme *sc) {
      gunichar c;
-     skipspace(sc);
+     c = skipspace(sc);
+     if(c == EOF) { return (TOK_EOF); }
      switch (c=inchar(sc)) {
      case EOF:
           return (TOK_EOF);
@@ -1938,7 +1943,10 @@ static int token(scheme *sc) {
      case ';':
           while ((c=inchar(sc)) != '\n' && c!=EOF)
             ;
-          return (token(sc));
+       if(c == EOF)
+         { return (TOK_EOF); }
+       else
+         { return (token(sc));}
      case '"':
           return (TOK_DQUOTE);
      case '_':
@@ -1962,7 +1970,10 @@ static int token(scheme *sc) {
           } else if(c == '!') {
                while ((c=inchar(sc)) != '\n' && c!=EOF)
                    ;
-               return (token(sc));
+           if(c == EOF)
+             { return (TOK_EOF); }
+           else
+             { return (token(sc));}
           } else {
                backchar(sc,c);
                if(is_one_of(" tfodxb\\",c)) {
@@ -2573,24 +2584,43 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
                Error_1(sc,"unable to open", car(sc->args));
           }
           else
-            { s_retbool(1); }
+          {
+            sc->args = mk_integer(sc,sc->file_i);
+            s_goto(sc,OP_T0LVL);
+          }
 
      case OP_T0LVL: /* top level */
-          if(file_interactive(sc)) {
-               putstr(sc,"\n");
-          }
-          sc->nesting=0;
-          dump_stack_reset(sc);
-          sc->envir = sc->global_env;
-          sc->save_inport=sc->inport;
-          sc->inport = sc->loadport;
-          s_save(sc,OP_T0LVL, sc->NIL, sc->NIL);
-          s_save(sc,OP_VALUEPRINT, sc->NIL, sc->NIL);
-          s_save(sc,OP_T1LVL, sc->NIL, sc->NIL);
-          if (file_interactive(sc)) {
-              putstr(sc,prompt);
-          }
-          s_goto(sc,OP_READ_INTERNAL);
+       if(file_interactive(sc))
+         {
+           sc->envir = sc->global_env;
+           dump_stack_reset(sc);
+           putstr(sc,"\n");
+           putstr(sc,prompt);
+           s_save(sc,OP_T0LVL, mk_integer(sc,sc->file_i), sc->NIL);
+         }
+       else
+         {
+           /* Each load of any file gets its own top-level loop that
+              ends when the file has been read.  We detect that by
+              monitoring sc->file_i. */
+           pointer depth = sc->args;
+           if(is_integer(depth) && ivalue(depth) == sc->file_i)
+             {
+               s_save(sc,OP_T0LVL, depth, sc->NIL);
+             }
+           else
+             {
+               s_return(sc,sc->value);
+               /* NOTREACHED */
+             }
+         }
+
+       sc->nesting=0;
+       sc->save_inport=sc->inport;
+       sc->inport = sc->loadport;
+       s_save(sc,OP_VALUEPRINT, sc->NIL, sc->NIL);
+       s_save(sc,OP_T1LVL, sc->NIL, sc->NIL);
+       s_goto(sc,OP_READ_INTERNAL);
 
      case OP_T1LVL: /* top level */
           sc->code = sc->value;
@@ -2600,7 +2630,8 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
      case OP_READ_INTERNAL:       /* internal read */
           sc->tok = token(sc);
           if(sc->tok==TOK_EOF) {
-               if(sc->inport==sc->loadport) {
+               if(sc->top_EOF)
+               {
                     sc->args=sc->NIL;
                     s_goto(sc,OP_QUIT);
                } else {
@@ -4083,7 +4114,8 @@ static pointer opexe_5(scheme *sc, enum scheme_opcodes op) {
      case OP_RDSEXPR:
           switch (sc->tok) {
           case TOK_EOF:
-               if(sc->inport==sc->loadport) {
+               if(sc->top_EOF)
+               {
                     sc->args=sc->NIL;
                     s_goto(sc,OP_QUIT);
                } else {
@@ -4709,6 +4741,7 @@ int scheme_init_custom_alloc(scheme *sc, func_alloc malloc, func_dealloc free) {
   sc->loadport=sc->NIL;
   sc->nesting=0;
   sc->interactive_repl=0;
+  sc->top_EOF = 0;
   sc->print_output=0;
 
   if (alloc_cellseg(sc,FIRST_CELLSEGS) != FIRST_CELLSEGS) {
@@ -4842,6 +4875,8 @@ void scheme_load_file(scheme *sc, FILE *fin) {
     sc->interactive_repl=1;
   }
   sc->inport=sc->loadport;
+  sc->top_EOF = 0;
+  sc->args = mk_integer(sc,sc->file_i);
   Eval_Cycle(sc, OP_T0LVL);
   typeflag(sc->loadport)=T_ATOM;
   if(sc->retcode==0) {
@@ -4861,6 +4896,8 @@ void scheme_load_string(scheme *sc, const char *cmd) {
   sc->retcode=0;
   sc->interactive_repl=0;
   sc->inport=sc->loadport;
+  sc->top_EOF = 0;
+  sc->args = mk_integer(sc,sc->file_i);
   Eval_Cycle(sc, OP_T0LVL);
   typeflag(sc->loadport)=T_ATOM;
   if(sc->retcode==0) {