still no goodmig_err

3 files changed, 107 insertions, 49 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 7b025ac..456c164 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -735,7 +735,7 @@ Tcl_CreateInterp(void)
 #endif
     iPtr->pendingObjDataPtr = NULL;
     iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
-    iPtr->deferredCallbacks = 0;
+    iPtr->deferredCallbacks = NULL;
 
     /*
      * Create the core commands. Do it here, rather than calling
@@ -4347,6 +4347,7 @@ TclNRRunCallbacks(
 	POP_CB(interp, cbPtr);
 	procPtr = cbPtr->procPtr;
 	result = procPtr(cbPtr->data, interp, result);
+        FREE_CB(cbPtr);
     }
     return result;
 }
@@ -8274,6 +8275,9 @@ Tcl_NRCmdSwap(
  * FIXME NRE!
  */
 
+//#define PR(x) fprint(stdout, x)
+#define PR(x)
+
 void
 TclDeferCallback(
     Tcl_Interp *interp,
@@ -8282,37 +8286,55 @@ TclDeferCallback(
     ClientData data2, ClientData data3)
 {
     Interp *iPtr = (Interp *) interp;
+    NRE_callback *cbPtr;
     
     TclNRAddCallback(interp, postProcPtr, data0, data1,
             data2, data3);
-    iPtr->deferredCallbacks++;
+    cbPtr = TOP_CB(interp);
+    cbPtr->nextPtr = iPtr->deferredCallbacks;
+    iPtr->deferredCallbacks = cbPtr;    
 }
 
 static void
 SpliceDeferred(
     Tcl_Interp *interp)
 {
+    PR("CALLED SpliceDeferred\n");
+    return;
+    /* STUPID: optimize a bit */
 #if 0
     Interp *iPtr = (Interp *) interp;
-    NRE_callback *bottomPtr = iPtr->deferredCallbacks;
-    NRE_callback saved, *runPtr;
+    int deferred = iPtr->deferredCallbacks;
+    NRE_callback *tosPtr = TOP_CB(interp), *runPtr;
 
-    if (bottomPtr) {
-        saved = *TOP_CB(interp);
-        
-        topPtr = TOP_CB(interp);
-        runPtr
+    if (deferred) {
+        NRE_callback *tmp;
+        int i;
 
-            Swap de a uno .OJO!! Si bajo y encuentro NRStackBottom, saltar!
+        tmp = ckalloc(deferred*sizeof(NRE_callback));
         
-        while 
+        i = deferred;
+        while (i--) {
+            POP_CB(interp, runPtr);
+            tmp[i] = *runPtr;
+        }
+
+        ALLOC_CB(interp, runPtr);
+        *runPtr = *tosPtr;
+
+        i = deferred;
+        for (i=0; i < deferred; i++) {
+            ALLOC_CB(interp, runPtr);
+            *runPtr = tmp[i];
+        }
+        ckfree(tmp);
+        iPtr->deferredCallbacks = 0;
     }
-    iPtr->deferredCallbacks = 0;
 #endif
 }
 
-static int
-NRStackBottom(
+int
+TclNRStackBottom(
     ClientData data[],
     Tcl_Interp *interp,
     int result)
@@ -8322,11 +8344,11 @@ NRStackBottom(
     NRE_stack *this = eePtr->NRStack;
     NRE_stack *prev = data[0];
 
- #if 0
+    PR("CALLED TclNRStackBottom\n");
+    
     if (!prev) {
         Tcl_Panic("Reached the NRE-stack bottom, should not happen!");
     }
-#endif
     
     /*
      * Go back to the previous stack.
@@ -8336,8 +8358,8 @@ NRStackBottom(
     eePtr->callbackPtr = &prev->items[NRE_STACK_SIZE-1];
     
     /*
-     * Keep this stack in reserve. If this one had a successor, free it: we
-     * always keep just one in reserve. 
+     * Keep this stack in reserve. If this one had a successor, free that one:
+     * we always keep just one in reserve. 
      */
     
     if (this->next) {
@@ -8349,15 +8371,16 @@ NRStackBottom(
 }
 
 NRE_callback *
-TclGetCallback(
+TclNewCallback(
     Tcl_Interp *interp)
 {
     Interp *iPtr = (Interp *) interp;
     ExecEnv *eePtr = iPtr->execEnvPtr;
     NRE_callback *cbPtr = eePtr->callbackPtr;
     NRE_stack *this = eePtr->NRStack;
-
+#if NEW
     if (!this || (cbPtr == &this->items[NRE_STACK_SIZE-1])) {
+        PR("ALLOC\n");
         if (this && this->next) {
             eePtr->NRStack = this->next;
         } else {
@@ -8366,13 +8389,33 @@ TclGetCallback(
         }
         eePtr->callbackPtr = &eePtr->NRStack->items[-1];
 
-        if (this) {
-            TclNRAddCallback(interp, NRStackBottom, this, NULL, NULL, NULL);
-        }
+        TclNRAddCallback(interp, TclNRStackBottom, this, NULL, NULL, NULL);
+    } else {
+        PR("PUSH\n");
     }
-    return ++eePtr->callbackPtr;
+    cbPtr++;
+    cbPtr->nextPtr = eePtr->callbackPtr;
+    eePtr->callbackPtr = cbPtr;
+#endif
+    return eePtr->callbackPtr;
+}
+
+NRE_callback *
+TclPopCallback(
+    Tcl_Interp *interp)
+{
+    Interp *iPtr = (Interp *) interp;
+    ExecEnv *eePtr = iPtr->execEnvPtr;
+    NRE_callback *cbPtr = eePtr->callbackPtr, *tmp;
+    NRE_stack *this = eePtr->NRStack;
+    int depth = cbPtr - &this->items[1];
+
+    PR("POP\n");
+    --eePtr->callbackPtr;
+    return cbPtr;
 }
 
+/* ***************************************** */
 void
 TclSetTailcall(
     Tcl_Interp *interp,
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index dd436f9..96d2d62 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -892,7 +892,8 @@ TclCreateExecEnv(
 
     /* Initialize the NRE stack */
 
-    eePtr->callbackPtr = TclGetCallback(interp);
+    ((Interp *) interp)->execEnvPtr = eePtr;
+    eePtr->callbackPtr = TclNewCallback(interp);
     eePtr->callbackPtr--;
     return eePtr;
 }
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1fbfe5b..7300f95 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2138,7 +2138,7 @@ typedef struct Interp {
 				 * tclOOInt.h and tclOO.c for real definition
 				 * and setup. */
 
-    int deferredCallbacks;      /* Callbacks that are set previous to a call
+    struct NRE_callback *deferredCallbacks;      /* Callbacks that are set previous to a call
 				 * to some Eval function but that actually
 				 * belong to the command that is about to be
 				 * called - i.e., they should be run *before*
@@ -4790,17 +4790,6 @@ typedef struct NRE_callback {
     struct NRE_callback *nextPtr;
 } NRE_callback;
 
-#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)
-
-#define NRE_STACK_SIZE 100
-
-typedef struct NRE_stack {
-    NRE_callback items[NRE_STACK_SIZE];
-    struct NRE_stack *next;
-} NRE_stack;
-
-MODULE_SCOPE NRE_callback *TclGetCallback(Tcl_Interp *interp);
-
 /*
  * Inline versions of Tcl_NRAddCallback and friends
  */
@@ -4821,25 +4810,50 @@ MODULE_SCOPE NRE_callback *TclGetCallback(Tcl_Interp *interp);
 	cbPtr->data[3] = (ClientData)(data3);				\
     } while (0)
 
+#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)
+
+#define NRE_STACK_SIZE 100
+
+MODULE_SCOPE NRE_callback *TclNewCallback(Tcl_Interp *interp);
+MODULE_SCOPE NRE_callback *TclPopCallback(Tcl_Interp *interp);
+MODULE_SCOPE Tcl_NRPostProc TclNRStackBottom;
+
+#define NEW 0
+
+#if NEW
 #define POP_CB(interp, cbPtr)                      \
-    (cbPtr) = TOP_CB(interp)--
+    (cbPtr) = TclPopCallback(interp)
 
 #define ALLOC_CB(interp, cbPtr)			\
-    (cbPtr) = TclGetCallback(interp)
+    (cbPtr) = TclNewCallback(interp)
 
-#if 0
-    do {								\
-            NRE_stack *this = ((Interp *)interp)->execEnvPtr->NRStack;	\
-	    NRE_callback *new = TOP_CB(interp);				\
-	    if (new != this->items[NRE_STACK_SIZE-1]) {			\
-	        new++;							\
-	    } else {							\
-	        new = TclGetCallback(interp); /* allocstack! */		\
-	    }								\
-	    (cbPtr) = TOP_CB(interp) = new;				\
+#define FREE_CB(cbPtr)
+
+#else /* OLD */
+
+#define POP_CB(interp, cbPtr)			\
+    do {\
+	(cbPtr) = TOP_CB(interp);		\
+	TOP_CB(interp) = (cbPtr)->nextPtr;	\
     } while (0)
+
+
+#define ALLOC_CB(interp, cbPtr)		\
+    do {				\
+	(cbPtr) = (NRE_callback *)ckalloc(sizeof(Tcl_Obj));	\
+	(cbPtr)->nextPtr = TOP_CB(interp);			\
+	TOP_CB(interp) = (cbPtr);				\
+    } while (0)
+
+#define FREE_CB(cbPtr)			\
+    ckfree(cbPtr)
 #endif
 
+typedef struct NRE_stack {
+    struct NRE_callback items[NRE_STACK_SIZE];
+    struct NRE_stack *next;
+} NRE_stack;
+
 
 #if NRE_ENABLE_ASSERTS
 #define NRE_ASSERT(expr) assert((expr))