Experimental verison of JIM_EVAL retcode in order to implement

what RHS proposed in the Wiki for tail recursion:

return -code eval [list proc $a $b ...]

I'm not sure I'll take this, but it needs to be inside for some
time in order to experiment and evaluate it I guess.

3 files changed, 28 insertions, 7 deletions

diff --git a/ChangeLog b/ChangeLog
index 4989276..82f42ce 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2005-04-09 10:23  antirez
+
+	* ChangeLog, TODO, jim.c: TODO updated, spurious free changed into
+	  Jim_Free().
+
 2005-04-08 16:07  patthoyts
 
 	* jim-win32.c: Do not add cursorinfo if build target cannot cope.
diff --git a/jim.c b/jim.c
index 4a35597..9a41576 100644
--- a/jim.c
+++ b/jim.c
@@ -2,7 +2,7 @@
  * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
  * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
  *
- * $Id: jim.c,v 1.153 2005/04/09 08:23:40 antirez Exp $
+ * $Id: jim.c,v 1.154 2005/04/09 12:57:49 antirez Exp $
  *
  * Licensed under the Apache License, Version 2.0 (the "License");
  * you may not use this file except in compliance with the License.
@@ -3990,6 +3990,7 @@ Jim_Interp *Jim_CreateInterp(void)
     i->lastCollectTime = time(NULL);
     i->freeFramesList = NULL;
     i->prngState = NULL;
+    i->evalRetcodeFlag = 0;
 
     /* Note that we can create objects only after the
      * interpreter liveList and freeList pointers are
@@ -5662,6 +5663,8 @@ int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
         returnCode = JIM_BREAK;
     else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
         returnCode = JIM_CONTINUE;
+    else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
+        returnCode = JIM_EVAL;
     else {
         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
         Jim_AppendStrings(interp, Jim_GetResult(interp),
@@ -8081,6 +8084,7 @@ int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
     j = 0; /* on normal termination, the argv array is already
           Jim_DecrRefCount-ed. */
 err:
+    /* Handle errors. */
     if (retcode == JIM_ERR && !interp->errorFlag) {
         interp->errorFlag = 1;
         JimSetErrorFileName(interp, script->fileName);
@@ -8168,12 +8172,21 @@ int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
     } else {
         JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
     }
-
-    /* Handle the return code */
+    /* Handle the JIM_RETURN return code */
     if (retcode == JIM_RETURN) {
-        int returnCode = interp->returnCode;
+        retcode = interp->returnCode;
         interp->returnCode = JIM_OK;
-        return returnCode;
+    }
+    /* Handle the JIM_EVAL return code */
+    if (retcode == JIM_EVAL && !interp->evalRetcodeFlag) {
+        interp->evalRetcodeFlag = 1;
+        while (retcode == JIM_EVAL) {
+            Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
+            Jim_IncrRefCount(resultScriptObjPtr);
+            retcode = Jim_EvalObj(interp, resultScriptObjPtr);
+            Jim_DecrRefCount(interp, resultScriptObjPtr);
+        }
+        interp->evalRetcodeFlag = 0;
     }
     return retcode;
 }
@@ -11451,7 +11464,7 @@ int Jim_InteractivePrompt(Jim_Interp *interp)
     printf("Welcome to Jim version %d.%d, "
            "Copyright (c) 2005 Salvatore Sanfilippo\n",
            JIM_VERSION / 100, JIM_VERSION % 100);
-    printf("CVS ID: $Id: jim.c,v 1.153 2005/04/09 08:23:40 antirez Exp $\n");
+    printf("CVS ID: $Id: jim.c,v 1.154 2005/04/09 12:57:49 antirez Exp $\n");
     Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
     while (1) {
         char buf[1024];
diff --git a/jim.h b/jim.h
index 5240f6a..d939406 100644
--- a/jim.h
+++ b/jim.h
@@ -2,7 +2,7 @@
  * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
  * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
  *
- * $Id: jim.h,v 1.70 2005/04/06 10:14:09 patthoyts Exp $
+ * $Id: jim.h,v 1.71 2005/04/09 12:57:49 antirez Exp $
  *
  * Licensed under the Apache License, Version 2.0 (the "License");
  * you may not use this file except in compliance with the License.
@@ -116,6 +116,7 @@ extern "C" {
 #define JIM_RETURN 2
 #define JIM_BREAK 3
 #define JIM_CONTINUE 4
+#define JIM_EVAL 5
 #define JIM_MAX_NESTING_DEPTH 10000 /* default max nesting depth */
 
 /* Some function get an integer argument with flags to change
@@ -467,6 +468,8 @@ typedef struct Jim_Interp {
     Jim_Obj *stackTrace; /* Stack trace object. */
     Jim_Obj *unknown; /* Unknown command cache */
     int errorFlag; /* Set if an error occurred during execution. */
+    int evalRetcodeFlag; /* True if the current script is executed as result
+                            of a JIM_EVAL retcode. */
     void *cmdPrivData; /* Used to pass the private data pointer to
                   a command. It is set to what the user specified
                   via Jim_CreateCommand(). */