===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/stackmachine.c,v
retrieving revision 1.27
retrieving revision 1.44
diff -u -p -r1.27 -r1.44
--- OpenXM/src/kan96xx/Kan/stackmachine.c	2004/09/16 23:53:44	1.27
+++ OpenXM/src/kan96xx/Kan/stackmachine.c	2020/10/06 11:33:47	1.44
@@ -1,7 +1,9 @@
-/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.26 2004/09/16 02:22:03 takayama Exp $ */
+/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.43 2018/09/07 00:15:44 takayama Exp $ */
 /*   stackmachin.c */
 
 #include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
 #include "datatype.h"
 #include "stackm.h"
 #include "extern.h"
@@ -9,7 +11,18 @@
 #include "kclass.h"
 #include <signal.h>
 #include <sys/types.h>
+#include <unistd.h>
+#include "mysig.h"
 
+/* The msys2 seems to make a buffer overflow of  EnvOfStackmachine[].
+The code
+[(x) ring_of_differential_operators 11] define_ring
+( Dx*(x+Dx) ) /ff set
+causes the segfault because Mp_zero is borken. Is it a bug of msys2?
+Anyway, the following definition seems to be a workaround. 2015.09
+Singnals do not work properly on msys2. (gcc -dM -E ... to see macros defs)
+See stackm.h
+*/
 
 /* #define OPERAND_STACK_SIZE  2000 */
 #define OPERAND_STACK_SIZE 30000 
@@ -52,7 +65,7 @@ struct context *CurrentContextp = &StandardContext;
 struct context *PrimitiveContextp = &StandardContext;
 
 
-static struct object ObjTmp; /* for poor compiler */
+static struct object ObjTmp = OINIT; /* for poor compiler */
 
 int Calling_ctrlC_hook = 0;
 
@@ -69,12 +82,14 @@ int GotoP = 0;
 static char *SMacros =
 #include "smacro.h"
 
-static isInteger(char *);
-static strToInteger(char *);
-static power(int s,int i);
+static int isInteger(char *);
+static int strToInteger(char *);
+static int power(int s,int i);
 static void pstack(void);
 static struct object executableStringToExecutableArray(char *str);
+static int isThereExecutableArrayOnStack(int n);
 
+
 extern int SerialCurrent;
 extern int QuoteMode;
 
@@ -86,6 +101,10 @@ int OXlockSaved = 0;
 char *UD_str;
 int  UD_attr;
 
+struct object *MsgStackTraceInArrayp = NULL;
+char *MsgStackTrace = NULL;
+char *MsgSourceTrace = NULL;
+
 struct object * newObject() 
 {
   struct object *r;
@@ -94,13 +113,14 @@ struct object * newObject() 
   r->tag = 0;
   (r->lc).ival = 0;
   (r->rc).ival = 0;
+  r->attr = NULL;
   return(r);
 }
 
 struct object newObjectArray(size) 
      int size;
 {
-  struct object rob;
+  struct object rob = OINIT;
   struct object *op;
   if (size < 0) return(NullObject);
   if (size > 0) {
@@ -115,7 +135,7 @@ struct object newObjectArray(size) 
   return(rob);
 }
 
-isNullObject(obj)
+int isNullObject(obj)
      struct object obj;
 {
   if (obj.tag == 0) return(1);
@@ -322,7 +342,7 @@ int putPrimitiveFunction(str,number)
      char *str;
      int number;
 {
-  struct object ob;
+  struct object ob = OINIT;
   ob.tag = Soperator;
   ob.lc.ival = number;
   return(putSystemDictionary(str,ob));
@@ -383,7 +403,7 @@ void hashInitialize(struct dictionary *dic)
   }
 }
 
-static isInteger(str)
+static int isInteger(str)
      char *str;
 {
   int i;
@@ -404,7 +424,7 @@ static isInteger(str)
   return(1);
 }
 
-static strToInteger(str)
+static int strToInteger(str)
      char *str;
 {
   int i;
@@ -425,7 +445,7 @@ static strToInteger(str)
   return(r);
 }
 
-static power(s,i)
+static int power(s,i)
      int s;
      int i;
 {
@@ -464,11 +484,37 @@ struct object peek(k)
   }
 }
 
+static int isThereExecutableArray(struct object ob) {
+  int n,i;
+  struct object otmp = OINIT;
+  if (ob.tag == SexecutableArray) return(1);
+  if (ob.tag == Sarray) {
+    n = getoaSize(ob);
+    for (i=0; i<n; i++) {
+      otmp = getoa(ob,i);
+      if (isThereExecutableArray(otmp)) return(1);
+    }
+    return(0);
+  }
+  /* Class and list is not checked, since there is no parser
+     to directory translte these objects. */
+  return(0);
+}
+static int isThereExecutableArrayOnStack(int n) {
+  int i;
+  struct object ob = OINIT;
+  for (i=0; i<n; i++) {
+    if (Osp-i-1 < 0) return(0);
+    ob = peek(i);
+    if (isThereExecutableArray(ob)) return(1); 
+  }
+  return(0);
+}
 
 struct object newOperandStack(int size)
 {
   struct operandStack *os ;
-  struct object ob;
+  struct object ob = OINIT;
   os = (struct operandStack *)sGC_malloc(sizeof(struct operandStack));
   if (os == (void *)NULL) errorStackmachine("No more memory.");
   if (size <= 0) errorStackmachine("Size of stack must be more than 1.");
@@ -549,7 +595,7 @@ void KsetContext(struct object contextObj)  {
 
 
 struct object getSuperContext(struct object contextObj) {
-  struct object rob;
+  struct object rob = OINIT;
   struct context *cp;
   if (contextObj.tag != Sclass) {
     errorStackmachine("Usage:supercontext");
@@ -615,7 +661,7 @@ int isLiteral(str)
 
 void printOperandStack() {
   int i;
-  struct object ob;
+  struct object ob = OINIT;
   int vs;
   vs = VerboseStack; VerboseStack = 2;
   for (i=Osp-1; i>=0; i--) {
@@ -628,7 +674,7 @@ void printOperandStack() {
 
     
 
-static initSystemDictionary()
+static int initSystemDictionary()
 {
   StandardStack.ostack = StandardStackA;
   StandardStack.sp = StandardStackP;
@@ -651,7 +697,7 @@ struct object showSystemDictionary(int f) {
   int maxl;
   char format[1000];
   int nl;
-  struct object rob;
+  struct object rob = OINIT;
   rob = NullObject;
   if (f != 0) {
     rob = newObjectArray(Sdp);
@@ -724,7 +770,7 @@ static struct object executableStringToExecutableArray
      char *s;
 {
   struct tokens *tokenArray;
-  struct object ob;
+  struct object ob = OINIT;
   int i;
   int size;
   tokenArray = decomposeToTokens(s,&size);
@@ -743,7 +789,7 @@ static struct object executableStringToExecutableArray
 /****************  stack machine **************************/
 void scanner() {
   struct tokens token;
-  struct object ob;
+  struct object ob = OINIT;
   extern int Quiet;
   extern void ctrlC();
   int tmp, status;
@@ -753,20 +799,21 @@ void scanner() {
   extern int InSendmsg2;
   int infixOn = 0;
   struct tokens infixToken;
+  extern int RestrictedMode, RestrictedMode_saved;
   getokenSM(INIT);
   initSystemDictionary();
 
 #if defined(__CYGWIN__)
-  if (sigsetjmp(EnvOfStackMachine,1)) {
+  if (MYSIGSETJMP(EnvOfStackMachine,1)) {
 #else
-  if (setjmp(EnvOfStackMachine)) {
+  if (MYSETJMP(EnvOfStackMachine)) {
 #endif
     /* do nothing in the case of error */
     fprintf(stderr,"An error or interrupt in reading macros, files and command strings.\n");
     exit(10);
   } else {  }
-  if (signal(SIGINT,SIG_IGN) != SIG_IGN) {
-    signal(SIGINT,ctrlC);
+  if (mysignal(SIGINT,SIG_IGN) != SIG_IGN) {
+    mysignal(SIGINT,ctrlC);
   }
   
   /* setup quiet mode or not */
@@ -821,9 +868,9 @@ void scanner() {
   
   for (;;) {
 #if defined(__CYGWIN__)
-    if (jval=sigsetjmp(EnvOfStackMachine,1)) {
+    if (jval=MYSIGSETJMP(EnvOfStackMachine,1)) {
 #else
-    if (jval=setjmp(EnvOfStackMachine)) {
+    if (jval=MYSETJMP(EnvOfStackMachine)) {
 #endif
       /* ***  The following does not work properly.  ****
          if (jval == 2) {
@@ -836,8 +883,9 @@ void scanner() {
         fprintf(Fstack,"\nscanner> ");
       }
       if (!Calling_ctrlC_hook) { /* to avoid recursive call of ctrlC-hook. */
-        Calling_ctrlC_hook = 1;
+        Calling_ctrlC_hook = 1; RestrictedMode = 0;
         KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
+        RestrictedMode = RestrictedMode_saved;
       }
       Calling_ctrlC_hook = 0;  
       KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook? */
@@ -868,9 +916,11 @@ void ctrlC(sig)
   extern int SGClock;
   extern int UserCtrlC;
   extern int OXlock;
+  extern int RestrictedMode, RestrictedMode_saved;
 
-  signal(sig,SIG_IGN);
+  mysignal(sig,SIG_IGN);
   /* see 133p */
+  RestrictedMode = RestrictedMode_saved;
   cancelAlarm();
   if (sig == SIGALRM) {
     fprintf(stderr,"ctrlC by SIGALRM\n");
@@ -879,7 +929,7 @@ void ctrlC(sig)
   if (SGClock) {
     UserCtrlC = 1;
     fprintf(stderr,"ctrl-c is locked because of gc.\n");
-    signal(sig,ctrlC);  if (sig == SIGALRM) alarm((unsigned int)10);
+    mysignal(sig,ctrlC);  if (sig == SIGALRM) alarm((unsigned int)10);
     return;
   }
   if (OXlock) {
@@ -888,11 +938,11 @@ void ctrlC(sig)
     if (UserCtrlC > 3) {
       fprintf(stderr,"OK. You are eager to cancel the computation.\n");
       fprintf(stderr,"You should close the ox communication cannel.\n");
-      signal(SIGINT,ctrlC);
+      mysignal(SIGINT,ctrlC);
       unlockCtrlCForOx();
     }
     fprintf(stderr,"ctrl-c is locked because of ox lock %d.\n",UserCtrlC);
-    signal(sig,ctrlC);  if (sig == SIGALRM) alarm((unsigned int)10);
+    mysignal(sig,ctrlC);  if (sig == SIGALRM) alarm((unsigned int)10);
     return;
   }
   if (ErrorMessageMode != 1) {
@@ -914,18 +964,18 @@ void ctrlC(sig)
     It SOMETIMES makes core dump.
   */
   getokenSM(INIT); /* It might fix the bug above. 1992/11/14 */
-  signal(SIGINT,ctrlC);
+  mysignal(SIGINT,ctrlC);
 #if defined(__CYGWIN__)
-  siglongjmp(EnvOfStackMachine,2);
+  MYSIGLONGJMP(EnvOfStackMachine,2);
 #else
-  longjmp(EnvOfStackMachine,2); /* returns 2 for ctrl-C */
+  MYLONGJMP(EnvOfStackMachine,2); /* returns 2 for ctrl-C */
 #endif
 }
 
 int executeToken(token)
      struct tokens token;
 {      
-  struct object ob;
+  struct object ob = OINIT;
   int primitive;
   int size;
   int status;
@@ -933,7 +983,10 @@ int executeToken(token)
   extern int WarningMessageMode;
   extern int Strict;
   extern int InSendmsg2;
+  extern int RestrictedMode, RestrictedMode_saved;
+  int localRestrictedMode_saved;
 
+  localRestrictedMode_saved = 0;
   if (GotoP) { /* for goto */
     if (token.kind == ID && isLiteral(token.token)) {
       if (strcmp(&((token.token)[1]),GotoLabel) == 0) {
@@ -987,7 +1040,23 @@ int executeToken(token)
       if (ob.tag >= 0) {
         /* there is a definition in the user dictionary */
         if (ob.tag == SexecutableArray) {
+          if (RestrictedMode) {
+            if (UD_attr & ATTR_EXPORT) {
+              localRestrictedMode_saved = RestrictedMode; RestrictedMode = 0;
+              if (isThereExecutableArrayOnStack(5)) {
+				int i;
+                for (i=0; i<5; i++) { (void) Kpop(); }
+                errorStackmachine("Executable array is on the argument stack (restricted mode). They are automatically removed.\n");
+			  }
+            }else{
+              tracePushName(token.token);
+              errorStackmachine("You cannot execute this function in restricted mode.\n");
+            }
+          }
+
           status = executeExecutableArray(ob,token.token,0);
+
+          if (localRestrictedMode_saved) RestrictedMode = localRestrictedMode_saved;
           if ((status & STATUS_BREAK) || (status < 0)) return status;
         }else {
           Kpush(ob);
@@ -1008,21 +1077,24 @@ int executeToken(token)
             return(0); /* normal exit.*/
           }
 		}
-        if (WarningMessageMode == 1 || WarningMessageMode == 2) {
+        {    
           char tmpc[1024];
           if (strlen(token.token) < 900) {
-            sprintf(tmpc,"\n%%Warning: The identifier <<%s>> is not in the system dictionary\n%%   nor in the user dictionaries. Push NullObject.\n",token.token);
-          }else {strcpy(tmpc,"Warning: identifier is not in the dictionaries.");}
-          pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));
+            sprintf(tmpc,"\n>>Warning: The identifier <<%s>> is not in the system dictionary\n>>   nor in the user dictionaries. Push NullObject.\n",token.token);
+          }else {strcpy(tmpc,"\n>>Warning: identifier is not in the dictionaries.\n");}  
+          /* do not use %% in a string. tmpc will be used as  fprintf(stderr,tmpc); */
+          if (WarningMessageMode == 1 || WarningMessageMode == 2) {
+            pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));
+          }
+          if (WarningMessageMode != 1) {
+            fprintf(Fstack,"%s",tmpc);
+            /*fprintf(Fstack,"(%d,%d)\n",h0,h1);*/
+          }
+          if (Strict) {
+            errorStackmachine(tmpc);
+          }
+          Kpush(NullObject); 
         }
-        if (WarningMessageMode != 1) {
-          fprintf(Fstack,"\n%%Warning: The identifier <<%s>> is not in the system dictionary\n%%   nor in the user dictionaries. Push NullObject.\n",token.token);
-          /*fprintf(Fstack,"(%d,%d)\n",h0,h1);*/
-        }
-        if (Strict) {
-          errorStackmachine("Warning: identifier is not in the dictionaries");
-        }
-        Kpush(NullObject); 
       }
     }
   } else if (token.kind == EXECUTABLE_STRING) {
@@ -1047,15 +1119,18 @@ int executeToken(token)
 
       
 
-errorStackmachine(str)
-     char *str;
+void errorStackmachine(char *str)
 {
   int i,j,k;
   static char *u="Usage:";
   char message0[1024];
   char *message;
   extern int ErrorMessageMode;
+  extern int RestrictedMode, RestrictedMode_saved;
+  RestrictedMode = RestrictedMode_saved;
   cancelAlarm();
+  MsgStackTrace = NULL;
+  MsgSourceTrace = NULL;
   if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
     pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));
   }
@@ -1086,10 +1161,12 @@ errorStackmachine(str)
       }
     }else {
       fprintf(stderr,"ERROR(sm): ");
-      fprintf(stderr,str);
+      fprintf(stderr,"%s",str);
     }
     fprintf(stderr,"\n");
-    (void) traceShowStack(); 
+	MsgStackTraceInArrayp = traceNameStackToArrayp();
+    MsgStackTrace = traceShowStack(); 
+    MsgSourceTrace = traceShowScannerBuf();
   }
   traceClearStack();
   if (GotoP) {
@@ -1099,11 +1176,10 @@ errorStackmachine(str)
   stdOperandStack(); contextControl(CCRESTORE);
   getokenSM(INIT); /* It might fix the bug. 1996/3/10 */
   /* fprintf(stderr,"Now, Long jump!\n"); */
-  longjmp(EnvOfStackMachine,1);
+  MYLONGJMP(EnvOfStackMachine,1);
 }
 
-warningStackmachine(str)
-     char *str;
+int warningStackmachine(char *str)
 {
   extern int WarningMessageMode;
   extern int Strict;
@@ -1111,8 +1187,8 @@ warningStackmachine(str)
     pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));
   }
   if (WarningMessageMode != 1) {
-    fprintf(stderr,"WARNING(sm): ");
-    fprintf(stderr,str);
+    fprintf(stderr,"%s","WARNING(sm): ");
+    fprintf(stderr,"%s",str);
   }
   if (Strict) errorStackmachine(" ");
   return(0);
@@ -1123,11 +1199,11 @@ warningStackmachine(str)
 /* NOTE:  If you call this function and an error occured,
    you have to reset the jump buffer by setjmp(EnvOfStackMachine).
    cf. kxx/memo1.txt, kxx/stdserver00.c 1998, 2/6 */
-KSexecuteString(s)
+int KSexecuteString(s)
      char *s;
 {
   struct tokens token;
-  struct object ob;
+  struct object ob = OINIT;
   int tmp;
   extern int CatchCtrlC;
   int jval;
@@ -1137,22 +1213,23 @@ KSexecuteString(s)
   jmp_buf saved_EnvOfStackMachine;
   void (*sigfunc)();
   int localCatchCtrlC ;
+  extern int RestrictedMode, RestrictedMode_saved;
 
   localCatchCtrlC = CatchCtrlC;
   /* If CatchCtrlC is rewrited in this program,
      we crash. So, we use localCatchCtrlC. */
 
   if (localCatchCtrlC) {
-    sigfunc = signal(SIGINT,SIG_IGN);
-    signal(SIGINT,ctrlC);
+    sigfunc = mysignal(SIGINT,SIG_IGN);
+    mysignal(SIGINT,ctrlC);
   }
 
   if (KSPushEnvMode) {
     *saved_EnvOfStackMachine = *EnvOfStackMachine;
 #if defined(__CYGWIN__)
-    if (jval = sigsetjmp(EnvOfStackMachine,1)) {
+    if (jval = MYSIGSETJMP(EnvOfStackMachine,1)) {
 #else
-    if (jval = setjmp(EnvOfStackMachine)) {
+    if (jval = MYSETJMP(EnvOfStackMachine)) {
 #endif
       *EnvOfStackMachine = *saved_EnvOfStackMachine;
       if (jval == 2) {
@@ -1161,21 +1238,23 @@ KSexecuteString(s)
         }
       }
       recursive--;
-      if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
+      if (localCatchCtrlC) { mysignal(SIGINT, sigfunc); }
       if (!Calling_ctrlC_hook) {
-        Calling_ctrlC_hook = 1;
+        Calling_ctrlC_hook = 1; RestrictedMode = 0;
         KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
+        RestrictedMode_saved;
       }
       Calling_ctrlC_hook = 0;
       KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/
+      /* fprintf(stderr,"result code=-1 for %s\n",s); */
       return(-1);
     }else{ }
   }else{
     if (recursive == 0) {
 #if defined(__CYGWIN__)
-      if (jval=sigsetjmp(EnvOfStackMachine,1)) { 
+      if (jval=MYSIGSETJMP(EnvOfStackMachine,1)) { 
 #else
-      if (jval=setjmp(EnvOfStackMachine)) { 
+      if (jval=MYSETJMP(EnvOfStackMachine)) { 
 #endif
         if (jval == 2) {
           if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
@@ -1183,14 +1262,16 @@ KSexecuteString(s)
           }
         }
         recursive = 0;
-        if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
+        if (localCatchCtrlC) { mysignal(SIGINT, sigfunc); }
         if (!Calling_ctrlC_hook) {
-          Calling_ctrlC_hook = 1;
+          Calling_ctrlC_hook = 1; RestrictedMode = 0;
           KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
+          RestrictedMode = RestrictedMode_saved;
         }
         Calling_ctrlC_hook = 0;
         Calling_ctrlC_hook = 0;
 		KSexecuteString(" (Computation is interrupted.) ");
+		/* fprintf(stderr,"result code=-1 for %s\n",s);*/
         return(-1);
       }else { }
     }
@@ -1209,14 +1290,14 @@ KSexecuteString(s)
   executePrimitive(ob);
   recursive--;
   if (KSPushEnvMode) *EnvOfStackMachine = *saved_EnvOfStackMachine;
-  if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
+  if (localCatchCtrlC) { mysignal(SIGINT, sigfunc); }
   return(0);
 }
 
-KSdefineMacros() {
+int KSdefineMacros() {
   struct tokens token;
   int tmp;
-  struct object ob;
+  struct object ob = OINIT;
 
   if (StandardMacros && (strlen(SMacros))) {
     token.kind = EXECUTABLE_STRING; token.tflag = 0;
@@ -1234,10 +1315,15 @@ KSdefineMacros() {
 
 }
 
+void KSstart_quiet() {
+  extern int Quiet;
+  Quiet=1;
+  KSstart();
+}
 void KSstart() {
   struct tokens token;
   int tmp;
-  struct object ob;
+  struct object ob = OINIT;
   extern int Quiet;
 
   stackmachine_init(); KinitKan();
@@ -1246,7 +1332,7 @@ void KSstart() {
   /* The following line may cause a core dump, if you do not setjmp properly
      after calling KSstart().*/
   /*
-    if (setjmp(EnvOfStackMachine)) {
+    if (MYSETJMP(EnvOfStackMachine)) {
     fprintf(stderr,"KSstart(): An error or interrupt in reading macros, files and command strings.\n");
     exit(10);
     } else {  }  */
@@ -1285,13 +1371,13 @@ void KSpush(ob)
   Kpush(ob);
 }
 
-struct object KSpeek(k) {
+struct object KSpeek(int k) {
   return(peek(k));
 }
 
 char *KSstringPop() {
   /* pop a string */
-  struct object rob;
+  struct object rob = OINIT;
   rob = Kpop();
   if (rob.tag == Sdollar) {
     return(rob.lc.str);
@@ -1331,6 +1417,10 @@ char *KSpopBinary(int *size) {
   return((char *)NULL);
 }
 
+struct object KSnewObjectArray(int k) {
+   return newObjectArray(k);
+}
+
 int pushErrorStack(struct object obj)
 {
   if (CurrentOperandStack == &ErrorStack) {
@@ -1361,8 +1451,8 @@ struct object popErrorStack(void) {
 }
 
 char *popErrorStackByString(void) {
-  struct object obj;
-  struct object eobj;
+  struct object obj = OINIT;
+  struct object eobj = OINIT;
   eobj = popErrorStack();
   if (ectag(eobj) != CLASSNAME_ERROR_PACKET) {
     return(NULL);
@@ -1391,7 +1481,7 @@ int KScheckErrorStack(void)
 
 struct object KnewErrorPacket(int serial,int no,char *message)
 {
-  struct object obj;
+  struct object obj = OINIT;
   struct object *myop;
   char *s;
   /* Set extended tag. */
@@ -1413,7 +1503,7 @@ struct object KnewErrorPacket(int serial,int no,char *
 
 struct object KnewErrorPacketObj(struct object ob1)
 {
-  struct object obj;
+  struct object obj = OINIT;
   struct object *myop;
   char *s;
   /* Set extended tag. */
@@ -1512,8 +1602,8 @@ int KSstackPointer() {
 }
 
 struct object KSdupErrors() {
-  struct object rob;
-  struct object ob;
+  struct object rob = OINIT;
+  struct object ob = OINIT;
   int i;
   int n;
   int m;
@@ -1540,7 +1630,7 @@ struct object KSdupErrors() {
 
 void cancelAlarm() {
   alarm((unsigned int) 0);
-  signal(SIGALRM,SIG_DFL);
+  mysignal(SIGALRM,SIG_DFL);
 }
 
 /* back-trace */
@@ -1569,6 +1659,17 @@ void traceClearStack(void) {
 char *tracePopName(void) {
   if (TraceNameStackp <= 0) return (char *) NULL;
   return TraceNameStack[--TraceNameStackp];
+}
+struct object *traceNameStackToArrayp(void) {
+  int n,i;
+  struct object *op;
+  op = sGC_malloc(sizeof(struct object));
+  n = TraceNameStackp; if (n < 0) n = 0;
+  *op = newObjectArray(n);
+  for (i=0; i<n; i++) {
+	putoa((*op),i, KpoString(TraceNameStack[i]));
+  }
+  return op;
 }
 #define TRACE_MSG_SIZE 320
 char *traceShowStack(void) {