===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/stackmachine.c,v
retrieving revision 1.11
retrieving revision 1.16
diff -u -p -r1.11 -r1.16
--- OpenXM/src/kan96xx/Kan/stackmachine.c	2002/11/04 11:08:59	1.11
+++ OpenXM/src/kan96xx/Kan/stackmachine.c	2004/09/05 00:51:17	1.16
@@ -1,4 +1,4 @@
-/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.10 2002/11/04 10:53:56 takayama Exp $ */
+/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.15 2004/09/04 11:25:58 takayama Exp $ */
 /*   stackmachin.c */
 
 #include <stdio.h>
@@ -54,6 +54,8 @@ struct context *PrimitiveContextp = &StandardContext;
 
 static struct object ObjTmp; /* for poor compiler */
 
+int Calling_ctrlC_hook = 0;
+
 int StandardMacros = 1;
 int StartAFile = 0;
 char *StartFile;
@@ -74,6 +76,7 @@ static void pstack(void);
 static struct object executableStringToExecutableArray(char *str);
 
 extern int SerialCurrent;
+extern int QuoteMode;
 
 int SGClock = 0;
 int UserCtrlC = 0;
@@ -733,6 +736,7 @@ void scanner() {
   char *tmp2;
   extern int ErrorMessageMode;
   int jval;
+  extern int InSendmsg2;
   getokenSM(INIT);
   initSystemDictionary();
 
@@ -815,8 +819,13 @@ void scanner() {
       if (DebugStack >= 1) {
         fprintf(Fstack,"\nscanner> ");
       }
-      KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
-      KSexecuteString(" (Computation is interrupted.) ");
+      if (!Calling_ctrlC_hook) { /* to avoid recursive call of ctrlC-hook. */
+        Calling_ctrlC_hook = 1;
+        KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
+      }
+      Calling_ctrlC_hook = 0;  
+      KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook? */
+      InSendmsg2 = 0;
       continue ;
     } else {  }
     if (DebugStack >= 1) { printOperandStack(); }
@@ -835,7 +844,7 @@ void ctrlC(sig)
   extern int SGClock;
   extern int UserCtrlC;
   extern int OXlock;
-  
+
   signal(sig,SIG_IGN);
   /* see 133p */
   cancelAlarm();
@@ -863,9 +872,11 @@ void ctrlC(sig)
     return;
   }
   if (ErrorMessageMode != 1) {
+    (void *) traceShowStack();
     fprintf(Fstack,"User interruption by ctrl-C. We are in the top-level.\n");
     fprintf(Fstack,"Type in quit in order to exit sm1.\n");
   }
+  traceClearStack();
   if (GotoP) {
     fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
     GotoP = 0;
@@ -898,6 +909,7 @@ int executeToken(token)
   int i,h0,h1;
   extern int WarningMessageMode;
   extern int Strict;
+  extern int InSendmsg2;
 
   if (GotoP) { /* for goto */
     if (token.kind == ID && isLiteral(token.token)) {
@@ -947,21 +959,35 @@ int executeToken(token)
       if (ob.tag >= 0) {
         /* there is a definition in the user dictionary */
         if (ob.tag == SexecutableArray) {
+          tracePushName(token.token);
           tokenArray = ob.lc.tokenArray;
           size = ob.rc.ival;
           for (i=0; i<size; i++) {
             status = executeToken(tokenArray[i]);
-            if (status != 0) return(status);
+            if (status != 0) {
+              return(status);
+			}
           }
+          tracePopName();
         }else {
           Kpush(ob);
         }
       } else if (primitive) { 
+        tracePushName(token.token);
         /* system operator */
         ob.tag = Soperator;
         ob.lc.ival = primitive;
-        return(executePrimitive(ob));
+        status = executePrimitive(ob);
+        if (status == 0) tracePopName(); 
+        return(status);
       } else {
+        if (QuoteMode) {
+          if (InSendmsg2) return(DO_QUOTE);
+          else {
+            Kpush(KpoString(token.token));
+            return(0); /* normal exit.*/
+          }
+		}
         if (WarningMessageMode == 1 || WarningMessageMode == 2) {
           char tmpc[1024];
           if (strlen(token.token) < 900) {
@@ -1043,7 +1069,9 @@ errorStackmachine(str)
       fprintf(stderr,str);
     }
     fprintf(stderr,"\n");
+    (void) traceShowStack(); 
   }
+  traceClearStack();
   if (GotoP) {
     fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
     GotoP = 0;
@@ -1114,8 +1142,12 @@ KSexecuteString(s)
       }
       recursive--;
       if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
-      KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
-      KSexecuteString(" (Computation is interrupted.) ");
+      if (!Calling_ctrlC_hook) {
+        Calling_ctrlC_hook = 1;
+        KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
+      }
+      Calling_ctrlC_hook = 0;
+      KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/
       return(-1);
     }else{ }
   }else{
@@ -1132,7 +1164,12 @@ KSexecuteString(s)
         }
         recursive = 0;
         if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
-		KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
+        if (!Calling_ctrlC_hook) {
+          Calling_ctrlC_hook = 1;
+          KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
+        }
+        Calling_ctrlC_hook = 0;
+        Calling_ctrlC_hook = 0;
 		KSexecuteString(" (Computation is interrupted.) ");
         return(-1);
       }else { }
@@ -1484,4 +1521,59 @@ struct object KSdupErrors() {
 void cancelAlarm() {
   alarm((unsigned int) 0);
   signal(SIGALRM,SIG_DFL);
+}
+
+/* back-trace */
+#define TraceNameStackSize 3000
+char *TraceNameStack[TraceNameStackSize];
+int TraceNameStackp = 0;
+void tracePushName(char *s) {
+  char *t;
+  /*
+  t = (char *)sGC_malloc(strlen(s)+1);
+  if (t == NULL) {
+    fprintf(stderr,"No more memory.\n"); return;
+  }
+  strcpy(t,s);
+  */
+  t = s;
+  TraceNameStack[TraceNameStackp++] = t;
+  if (TraceNameStackp >= TraceNameStackSize) {
+    fprintf(stderr,"Warning: TraceNameStack overflow. Clearing the stack.\n");
+    TraceNameStackp = 0;
+  }
+}
+void traceClearStack(void) {
+  TraceNameStackp = 0;
+}
+char *tracePopName(void) {
+  if (TraceNameStackp <= 0) return (char *) NULL;
+  return TraceNameStack[--TraceNameStackp];
+}
+#define TRACE_MSG_SIZE 320
+char *traceShowStack(void) {
+  char *s;
+  char *t;
+  int p;
+  s = (char *) sGC_malloc(TRACE_MSG_SIZE);
+  if (s == NULL) {
+    fprintf(stderr,"No more memory.\n"); return NULL;
+  }
+  sprintf(s,"Trace: ");
+  p = strlen(s);
+  do {
+    t = tracePopName();
+    if (t == NULL) {
+      s[p] = ';'; s[p+1] = 0;
+      break;
+    }else if ((strlen(t) + p -10) > TRACE_MSG_SIZE) {
+	  /*	  fprintf(stderr,"p=%d, TraceNameStackp=%d, strlen(t)=%d, t=%s\n",p,TraceNameStackp,strlen(t),t); */
+      strcpy(&(s[p])," ...");
+      break;
+    }
+    strcpy(&(s[p]),t); p += strlen(t);
+    strcpy(&(s[p]),"<-"); p += 2;
+  } while (t != (char *)NULL);
+  fprintf(stderr,"%s\n",s);
+  return s;
 }