[BACK]Return to stackmachine.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Kan

Diff for /OpenXM/src/kan96xx/Kan/stackmachine.c between version 1.19 and 1.40

version 1.19, 2004/09/11 12:13:41 version 1.40, 2016/03/31 03:22:54
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.18 2004/09/05 08:08:41 takayama Exp $ */  /* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.39 2015/10/08 11:49:37 takayama Exp $ */
 /*   stackmachin.c */  /*   stackmachin.c */
   
 #include <stdio.h>  #include <stdio.h>
   #include <stdlib.h>
   #include <string.h>
 #include "datatype.h"  #include "datatype.h"
 #include "stackm.h"  #include "stackm.h"
 #include "extern.h"  #include "extern.h"
Line 9 
Line 11 
 #include "kclass.h"  #include "kclass.h"
 #include <signal.h>  #include <signal.h>
 #include <sys/types.h>  #include <sys/types.h>
   #include "../plugin/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  2000 */
 #define OPERAND_STACK_SIZE 30000  #define OPERAND_STACK_SIZE 30000
Line 52  struct context *CurrentContextp = &StandardContext;
Line 64  struct context *CurrentContextp = &StandardContext;
 struct context *PrimitiveContextp = &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;  int Calling_ctrlC_hook = 0;
   
Line 74  static strToInteger(char *);
Line 86  static strToInteger(char *);
 static power(int s,int i);  static power(int s,int i);
 static void pstack(void);  static void pstack(void);
 static struct object executableStringToExecutableArray(char *str);  static struct object executableStringToExecutableArray(char *str);
   static int isThereExecutableArrayOnStack(int n);
   
 extern int SerialCurrent;  extern int SerialCurrent;
 extern int QuoteMode;  extern int QuoteMode;
Line 86  int OXlockSaved = 0;
Line 99  int OXlockSaved = 0;
 char *UD_str;  char *UD_str;
 int  UD_attr;  int  UD_attr;
   
   struct object *MsgStackTraceInArrayp = NULL;
   char *MsgStackTrace = NULL;
   char *MsgSourceTrace = NULL;
   
 struct object * newObject()  struct object * newObject()
 {  {
   struct object *r;    struct object *r;
Line 94  struct object * newObject() 
Line 111  struct object * newObject() 
   r->tag = 0;    r->tag = 0;
   (r->lc).ival = 0;    (r->lc).ival = 0;
   (r->rc).ival = 0;    (r->rc).ival = 0;
     r->attr = NULL;
   return(r);    return(r);
 }  }
   
 struct object newObjectArray(size)  struct object newObjectArray(size)
      int size;       int size;
 {  {
   struct object rob;    struct object rob = OINIT;
   struct object *op;    struct object *op;
   if (size < 0) return(NullObject);    if (size < 0) return(NullObject);
   if (size > 0) {    if (size > 0) {
Line 221  int putUserDictionary(str,h0,h1,ob,dic)
Line 239  int putUserDictionary(str,h0,h1,ob,dic)
   }    }
   r = x;    r = x;
   if (Strict2) {    if (Strict2) {
     switch((dic[x]).attr) {      switch(((dic[x]).attr) & (PROTECT | ABSOLUTE_PROTECT)) {
     case PROTECT:      case PROTECT:
       r = -PROTECT;   /* Protected, but we rewrite it. */        r = -PROTECT;   /* Protected, but we rewrite it. */
       break;        break;
Line 229  int putUserDictionary(str,h0,h1,ob,dic)
Line 247  int putUserDictionary(str,h0,h1,ob,dic)
       r = -ABSOLUTE_PROTECT;  /* Protected and we do not rewrite it. */        r = -ABSOLUTE_PROTECT;  /* Protected and we do not rewrite it. */
       return(r);        return(r);
     default:      default:
       (dic[x]).attr = 0;        /* (dic[x]).attr = 0; */ /* It is not necesarry, I think. */
       break;        break;
     }      }
   }    }
Line 295  int putUserDictionary2(str,h0,h1,attr,dic)
Line 313  int putUserDictionary2(str,h0,h1,attr,dic)
     }      }
     return(0);      return(0);
   }    }
     if (OR_ATTR_FOR_ALL_WORDS & attr) {
       for (i=0; i<USER_DICTIONARY_SIZE; i++) {
         if ((dic[i]).key !=EMPTY) (dic[i]).attr |= attr&(~OR_ATTR_FOR_ALL_WORDS);
       }
       return(0);
     }
   x = h0;    x = h0;
   if (str[0] == '\0') {    if (str[0] == '\0') {
     errorKan1("%s\n","putUserDictionary2(): You are defining a value with the null key.");      errorKan1("%s\n","putUserDictionary2(): You are defining a value with the null key.");
Line 316  int putPrimitiveFunction(str,number)
Line 340  int putPrimitiveFunction(str,number)
      char *str;       char *str;
      int number;       int number;
 {  {
   struct object ob;    struct object ob = OINIT;
   ob.tag = Soperator;    ob.tag = Soperator;
   ob.lc.ival = number;    ob.lc.ival = number;
   return(putSystemDictionary(str,ob));    return(putSystemDictionary(str,ob));
Line 458  struct object peek(k)
Line 482  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 object newOperandStack(int size)
 {  {
   struct operandStack *os ;    struct operandStack *os ;
   struct object ob;    struct object ob = OINIT;
   os = (struct operandStack *)sGC_malloc(sizeof(struct operandStack));    os = (struct operandStack *)sGC_malloc(sizeof(struct operandStack));
   if (os == (void *)NULL) errorStackmachine("No more memory.");    if (os == (void *)NULL) errorStackmachine("No more memory.");
   if (size <= 0) errorStackmachine("Size of stack must be more than 1.");    if (size <= 0) errorStackmachine("Size of stack must be more than 1.");
Line 543  void KsetContext(struct object contextObj)  {
Line 593  void KsetContext(struct object contextObj)  {
   
   
 struct object getSuperContext(struct object contextObj) {  struct object getSuperContext(struct object contextObj) {
   struct object rob;    struct object rob = OINIT;
   struct context *cp;    struct context *cp;
   if (contextObj.tag != Sclass) {    if (contextObj.tag != Sclass) {
     errorStackmachine("Usage:supercontext");      errorStackmachine("Usage:supercontext");
Line 609  int isLiteral(str)
Line 659  int isLiteral(str)
   
 void printOperandStack() {  void printOperandStack() {
   int i;    int i;
   struct object ob;    struct object ob = OINIT;
   int vs;    int vs;
   vs = VerboseStack; VerboseStack = 2;    vs = VerboseStack; VerboseStack = 2;
   for (i=Osp-1; i>=0; i--) {    for (i=Osp-1; i>=0; i--) {
Line 645  struct object showSystemDictionary(int f) {
Line 695  struct object showSystemDictionary(int f) {
   int maxl;    int maxl;
   char format[1000];    char format[1000];
   int nl;    int nl;
   struct object rob;    struct object rob = OINIT;
   rob = NullObject;    rob = NullObject;
   if (f != 0) {    if (f != 0) {
     rob = newObjectArray(Sdp);      rob = newObjectArray(Sdp);
Line 718  static struct object executableStringToExecutableArray
Line 768  static struct object executableStringToExecutableArray
      char *s;       char *s;
 {  {
   struct tokens *tokenArray;    struct tokens *tokenArray;
   struct object ob;    struct object ob = OINIT;
   int i;    int i;
   int size;    int size;
   tokenArray = decomposeToTokens(s,&size);    tokenArray = decomposeToTokens(s,&size);
Line 737  static struct object executableStringToExecutableArray
Line 787  static struct object executableStringToExecutableArray
 /****************  stack machine **************************/  /****************  stack machine **************************/
 void scanner() {  void scanner() {
   struct tokens token;    struct tokens token;
   struct object ob;    struct object ob = OINIT;
   extern int Quiet;    extern int Quiet;
   extern void ctrlC();    extern void ctrlC();
   int tmp;    int tmp, status;
   char *tmp2;    char *tmp2;
   extern int ErrorMessageMode;    extern int ErrorMessageMode;
   int jval;    int jval;
   extern int InSendmsg2;    extern int InSendmsg2;
     int infixOn = 0;
     struct tokens infixToken;
     extern int RestrictedMode, RestrictedMode_saved;
   getokenSM(INIT);    getokenSM(INIT);
   initSystemDictionary();    initSystemDictionary();
   
 #if defined(__CYGWIN__)  #if defined(__CYGWIN__)
   if (sigsetjmp(EnvOfStackMachine,1)) {    if (MYSIGSETJMP(EnvOfStackMachine,1)) {
 #else  #else
   if (setjmp(EnvOfStackMachine)) {    if (MYSETJMP(EnvOfStackMachine)) {
 #endif  #endif
     /* do nothing in the case of error */      /* do nothing in the case of error */
     fprintf(stderr,"An error or interrupt in reading macros, files and command strings.\n");      fprintf(stderr,"An error or interrupt in reading macros, files and command strings.\n");
     exit(10);      exit(10);
   } else {  }    } else {  }
   if (signal(SIGINT,SIG_IGN) != SIG_IGN) {    if (mysignal(SIGINT,SIG_IGN) != SIG_IGN) {
     signal(SIGINT,ctrlC);      mysignal(SIGINT,ctrlC);
   }    }
   
   /* setup quiet mode or not */    /* setup quiet mode or not */
   token.kind = EXECUTABLE_STRING;    token.kind = EXECUTABLE_STRING; token.tflag = 0;
   if (Quiet) {    if (Quiet) {
     token.token = " /@@@.quiet 1 def ";      token.token = " /@@@.quiet 1 def ";
   }else {    }else {
     token.token = " /@@@.quiet 0 def ";      token.token = " /@@@.quiet 0 def ";
   }    }
   executeToken(token); /* execute startup commands */    executeToken(token); /* execute startup commands */
   token.kind = ID;    token.kind = ID; token.tflag = 0;
   token.token = "exec";    token.token = "exec";
   token = lookupTokens(token); /* set hashing values */    token = lookupTokens(token); /* set hashing values */
   tmp = findSystemDictionary(token.token);    tmp = findSystemDictionary(token.token);
Line 785  void scanner() {
Line 838  void scanner() {
     StartFile = (char *)sGC_malloc(sizeof(char)*(strlen(StartFile)+      StartFile = (char *)sGC_malloc(sizeof(char)*(strlen(StartFile)+
                                                  40));                                                   40));
     sprintf(StartFile,"$%s$ run\n",tmp2);      sprintf(StartFile,"$%s$ run\n",tmp2);
     token.kind = EXECUTABLE_STRING;      token.kind = EXECUTABLE_STRING; token.tflag = 0;
     token.token = StartFile;      token.token = StartFile;
     executeToken(token);    /* execute startup commands */      executeToken(token);    /* execute startup commands */
     token.kind = ID;      token.kind = ID; token.tflag = 0;
     token.token = "exec";      token.token = "exec";
     token = lookupTokens(token); /* set hashing values */      token = lookupTokens(token); /* set hashing values */
     tmp = findSystemDictionary(token.token);      tmp = findSystemDictionary(token.token);
Line 798  void scanner() {
Line 851  void scanner() {
   }    }
   
   if (StartAString) {    if (StartAString) {
     token.kind = EXECUTABLE_STRING;      token.kind = EXECUTABLE_STRING;  token.tflag = 0;
     token.token = StartString;      token.token = StartString;
     executeToken(token);    /* execute startup commands */      executeToken(token);    /* execute startup commands */
     token.kind = ID;      token.kind = ID; token.tflag = 0;
     token.token = "exec";      token.token = "exec";
     token = lookupTokens(token); /* set hashing values */      token = lookupTokens(token); /* set hashing values */
     tmp = findSystemDictionary(token.token);      tmp = findSystemDictionary(token.token);
Line 813  void scanner() {
Line 866  void scanner() {
   
   for (;;) {    for (;;) {
 #if defined(__CYGWIN__)  #if defined(__CYGWIN__)
     if (jval=sigsetjmp(EnvOfStackMachine,1)) {      if (jval=MYSIGSETJMP(EnvOfStackMachine,1)) {
 #else  #else
     if (jval=setjmp(EnvOfStackMachine)) {      if (jval=MYSETJMP(EnvOfStackMachine)) {
 #endif  #endif
       /* ***  The following does not work properly.  ****        /* ***  The following does not work properly.  ****
          if (jval == 2) {           if (jval == 2) {
Line 828  void scanner() {
Line 881  void scanner() {
         fprintf(Fstack,"\nscanner> ");          fprintf(Fstack,"\nscanner> ");
       }        }
       if (!Calling_ctrlC_hook) { /* to avoid recursive call of ctrlC-hook. */        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. */          KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
           RestrictedMode = RestrictedMode_saved;
       }        }
       Calling_ctrlC_hook = 0;        Calling_ctrlC_hook = 0;
       KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook? */        KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook? */
       InSendmsg2 = 0;        InSendmsg2 = 0;
         infixOn = 0;
       continue ;        continue ;
     } else {  }      } else {  }
     if (DebugStack >= 1) { printOperandStack(); }      if (DebugStack >= 1) { printOperandStack(); }
     token = getokenSM(GET);      token = getokenSM(GET);
     if ((tmp=executeToken(token)) < 0) break;      if ((status=executeToken(token)) < 0) break;
     /***if (tmp == 1) fprintf(stderr," --- exit --- \n");*/      /***if (status == 1) fprintf(stderr," --- exit --- \n");*/
       /* fprintf(stderr,"token.token=%s, status=%d, infixOn=%d\n",token.token,status,infixOn); */
       if (status & STATUS_INFIX) {
         infixOn = 1;  infixToken = token; infixToken.tflag |= NO_DELAY;
       }else if (infixOn) {
         infixOn = 0;
         if ((status=executeToken(infixToken)) < 0) break;
       }
   }    }
 }  }
   
Line 852  void ctrlC(sig)
Line 914  void ctrlC(sig)
   extern int SGClock;    extern int SGClock;
   extern int UserCtrlC;    extern int UserCtrlC;
   extern int OXlock;    extern int OXlock;
     extern int RestrictedMode, RestrictedMode_saved;
   
   signal(sig,SIG_IGN);    mysignal(sig,SIG_IGN);
   /* see 133p */    /* see 133p */
     RestrictedMode = RestrictedMode_saved;
   cancelAlarm();    cancelAlarm();
   if (sig == SIGALRM) {    if (sig == SIGALRM) {
     fprintf(stderr,"ctrlC by SIGALRM\n");      fprintf(stderr,"ctrlC by SIGALRM\n");
Line 863  void ctrlC(sig)
Line 927  void ctrlC(sig)
   if (SGClock) {    if (SGClock) {
     UserCtrlC = 1;      UserCtrlC = 1;
     fprintf(stderr,"ctrl-c is locked because of gc.\n");      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;      return;
   }    }
   if (OXlock) {    if (OXlock) {
Line 872  void ctrlC(sig)
Line 936  void ctrlC(sig)
     if (UserCtrlC > 3) {      if (UserCtrlC > 3) {
       fprintf(stderr,"OK. You are eager to cancel the computation.\n");        fprintf(stderr,"OK. You are eager to cancel the computation.\n");
       fprintf(stderr,"You should close the ox communication cannel.\n");        fprintf(stderr,"You should close the ox communication cannel.\n");
       signal(SIGINT,ctrlC);        mysignal(SIGINT,ctrlC);
       unlockCtrlCForOx();        unlockCtrlCForOx();
     }      }
     fprintf(stderr,"ctrl-c is locked because of ox lock %d.\n",UserCtrlC);      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;      return;
   }    }
   if (ErrorMessageMode != 1) {    if (ErrorMessageMode != 1) {
Line 898  void ctrlC(sig)
Line 962  void ctrlC(sig)
     It SOMETIMES makes core dump.      It SOMETIMES makes core dump.
   */    */
   getokenSM(INIT); /* It might fix the bug above. 1992/11/14 */    getokenSM(INIT); /* It might fix the bug above. 1992/11/14 */
   signal(SIGINT,ctrlC);    mysignal(SIGINT,ctrlC);
 #if defined(__CYGWIN__)  #if defined(__CYGWIN__)
   siglongjmp(EnvOfStackMachine,2);    MYSIGLONGJMP(EnvOfStackMachine,2);
 #else  #else
   longjmp(EnvOfStackMachine,2); /* returns 2 for ctrl-C */    MYLONGJMP(EnvOfStackMachine,2); /* returns 2 for ctrl-C */
 #endif  #endif
 }  }
   
 int executeToken(token)  int executeToken(token)
      struct tokens token;       struct tokens token;
 {  {
   struct object ob;    struct object ob = OINIT;
   int primitive;    int primitive;
   int size;    int size;
   int status;    int status;
   struct tokens *tokenArray;  
   int i,h0,h1;    int i,h0,h1;
   extern int WarningMessageMode;    extern int WarningMessageMode;
   extern int Strict;    extern int Strict;
   extern int InSendmsg2;    extern int InSendmsg2;
     extern int RestrictedMode, RestrictedMode_saved;
     int localRestrictedMode_saved;
   
     localRestrictedMode_saved = 0;
   if (GotoP) { /* for goto */    if (GotoP) { /* for goto */
     if (token.kind == ID && isLiteral(token.token)) {      if (token.kind == ID && isLiteral(token.token)) {
       if (strcmp(&((token.token)[1]),GotoLabel) == 0) {        if (strcmp(&((token.token)[1]),GotoLabel) == 0) {
Line 964  int executeToken(token)
Line 1030  int executeToken(token)
       h1 = ((token.object.lc.op)->rc).ival;        h1 = ((token.object.lc.op)->rc).ival;
       ob=findUserDictionary(token.token,h0,h1,CurrentContextp);        ob=findUserDictionary(token.token,h0,h1,CurrentContextp);
       primitive = ((token.object.rc.op)->lc).ival;        primitive = ((token.object.rc.op)->lc).ival;
         if (!(token.tflag & NO_DELAY)) {
           if ((ob.tag >= 0) && (UD_attr & ATTR_INFIX)) {
             return STATUS_INFIX;
           }
         }
       if (ob.tag >= 0) {        if (ob.tag >= 0) {
         /* there is a definition in the user dictionary */          /* there is a definition in the user dictionary */
         if (ob.tag == SexecutableArray) {          if (ob.tag == SexecutableArray) {
           tracePushName(token.token);            if (RestrictedMode) {
           tokenArray = ob.lc.tokenArray;              if (UD_attr & ATTR_EXPORT) {
           size = ob.rc.ival;                localRestrictedMode_saved = RestrictedMode; RestrictedMode = 0;
           for (i=0; i<size; i++) {                if (isThereExecutableArrayOnStack(5)) {
             status = executeToken(tokenArray[i]);                                  int i;
             if (status != 0) {                  for (i=0; i<5; i++) { (void) Kpop(); }
               tracePopName(); return(status);                  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");
               }
           }            }
           tracePopName();  
             status = executeExecutableArray(ob,token.token,0);
   
             if (localRestrictedMode_saved) RestrictedMode = localRestrictedMode_saved;
             if ((status & STATUS_BREAK) || (status < 0)) return status;
         }else {          }else {
           Kpush(ob);            Kpush(ob);
         }          }
Line 996  int executeToken(token)
Line 1075  int executeToken(token)
             return(0); /* normal exit.*/              return(0); /* normal exit.*/
           }            }
                 }                  }
         if (WarningMessageMode == 1 || WarningMessageMode == 2) {          {
           char tmpc[1024];            char tmpc[1024];
           if (strlen(token.token) < 900) {            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);              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.");}            }else {strcpy(tmpc,"\n>>Warning: identifier is not in the dictionaries.\n");}
           pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));            /* 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) {    } else if (token.kind == EXECUTABLE_STRING) {
Line 1043  errorStackmachine(str)
Line 1125  errorStackmachine(str)
   char message0[1024];    char message0[1024];
   char *message;    char *message;
   extern int ErrorMessageMode;    extern int ErrorMessageMode;
     extern int RestrictedMode, RestrictedMode_saved;
     RestrictedMode = RestrictedMode_saved;
   cancelAlarm();    cancelAlarm();
     MsgStackTrace = NULL;
     MsgSourceTrace = NULL;
   if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {    if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
     pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));      pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));
   }    }
Line 1077  errorStackmachine(str)
Line 1163  errorStackmachine(str)
       fprintf(stderr,str);        fprintf(stderr,str);
     }      }
     fprintf(stderr,"\n");      fprintf(stderr,"\n");
     (void) traceShowStack();          MsgStackTraceInArrayp = traceNameStackToArrayp();
       MsgStackTrace = traceShowStack();
       MsgSourceTrace = traceShowScannerBuf();
   }    }
   traceClearStack();    traceClearStack();
   if (GotoP) {    if (GotoP) {
Line 1087  errorStackmachine(str)
Line 1175  errorStackmachine(str)
   stdOperandStack(); contextControl(CCRESTORE);    stdOperandStack(); contextControl(CCRESTORE);
   getokenSM(INIT); /* It might fix the bug. 1996/3/10 */    getokenSM(INIT); /* It might fix the bug. 1996/3/10 */
   /* fprintf(stderr,"Now, Long jump!\n"); */    /* fprintf(stderr,"Now, Long jump!\n"); */
   longjmp(EnvOfStackMachine,1);    MYLONGJMP(EnvOfStackMachine,1);
 }  }
   
 warningStackmachine(str)  warningStackmachine(str)
Line 1115  KSexecuteString(s)
Line 1203  KSexecuteString(s)
      char *s;       char *s;
 {  {
   struct tokens token;    struct tokens token;
   struct object ob;    struct object ob = OINIT;
   int tmp;    int tmp;
   extern int CatchCtrlC;    extern int CatchCtrlC;
   int jval;    int jval;
Line 1125  KSexecuteString(s)
Line 1213  KSexecuteString(s)
   jmp_buf saved_EnvOfStackMachine;    jmp_buf saved_EnvOfStackMachine;
   void (*sigfunc)();    void (*sigfunc)();
   int localCatchCtrlC ;    int localCatchCtrlC ;
     extern int RestrictedMode, RestrictedMode_saved;
   
   localCatchCtrlC = CatchCtrlC;    localCatchCtrlC = CatchCtrlC;
   /* If CatchCtrlC is rewrited in this program,    /* If CatchCtrlC is rewrited in this program,
      we crash. So, we use localCatchCtrlC. */       we crash. So, we use localCatchCtrlC. */
   
   if (localCatchCtrlC) {    if (localCatchCtrlC) {
     sigfunc = signal(SIGINT,SIG_IGN);      sigfunc = mysignal(SIGINT,SIG_IGN);
     signal(SIGINT,ctrlC);      mysignal(SIGINT,ctrlC);
   }    }
   
   if (KSPushEnvMode) {    if (KSPushEnvMode) {
     *saved_EnvOfStackMachine = *EnvOfStackMachine;      *saved_EnvOfStackMachine = *EnvOfStackMachine;
 #if defined(__CYGWIN__)  #if defined(__CYGWIN__)
     if (jval = sigsetjmp(EnvOfStackMachine,1)) {      if (jval = MYSIGSETJMP(EnvOfStackMachine,1)) {
 #else  #else
     if (jval = setjmp(EnvOfStackMachine)) {      if (jval = MYSETJMP(EnvOfStackMachine)) {
 #endif  #endif
       *EnvOfStackMachine = *saved_EnvOfStackMachine;        *EnvOfStackMachine = *saved_EnvOfStackMachine;
       if (jval == 2) {        if (jval == 2) {
Line 1149  KSexecuteString(s)
Line 1238  KSexecuteString(s)
         }          }
       }        }
       recursive--;        recursive--;
       if (localCatchCtrlC) { signal(SIGINT, sigfunc); }        if (localCatchCtrlC) { mysignal(SIGINT, sigfunc); }
       if (!Calling_ctrlC_hook) {        if (!Calling_ctrlC_hook) {
         Calling_ctrlC_hook = 1;          Calling_ctrlC_hook = 1; RestrictedMode = 0;
         KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */          KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
           RestrictedMode_saved;
       }        }
       Calling_ctrlC_hook = 0;        Calling_ctrlC_hook = 0;
       KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/        KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/
Line 1161  KSexecuteString(s)
Line 1251  KSexecuteString(s)
   }else{    }else{
     if (recursive == 0) {      if (recursive == 0) {
 #if defined(__CYGWIN__)  #if defined(__CYGWIN__)
       if (jval=sigsetjmp(EnvOfStackMachine,1)) {        if (jval=MYSIGSETJMP(EnvOfStackMachine,1)) {
 #else  #else
       if (jval=setjmp(EnvOfStackMachine)) {        if (jval=MYSETJMP(EnvOfStackMachine)) {
 #endif  #endif
         if (jval == 2) {          if (jval == 2) {
           if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {            if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
Line 1171  KSexecuteString(s)
Line 1261  KSexecuteString(s)
           }            }
         }          }
         recursive = 0;          recursive = 0;
         if (localCatchCtrlC) { signal(SIGINT, sigfunc); }          if (localCatchCtrlC) { mysignal(SIGINT, sigfunc); }
         if (!Calling_ctrlC_hook) {          if (!Calling_ctrlC_hook) {
           Calling_ctrlC_hook = 1;            Calling_ctrlC_hook = 1; RestrictedMode = 0;
           KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */            KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
             RestrictedMode = RestrictedMode_saved;
         }          }
         Calling_ctrlC_hook = 0;          Calling_ctrlC_hook = 0;
         Calling_ctrlC_hook = 0;          Calling_ctrlC_hook = 0;
Line 1186  KSexecuteString(s)
Line 1277  KSexecuteString(s)
   
   recursive++;    recursive++;
   token.token = s;    token.token = s;
   token.kind = EXECUTABLE_STRING;    token.kind = EXECUTABLE_STRING; token.tflag = 0;
   executeToken(token);    executeToken(token);
   token.kind = ID;    token.kind = ID; token.tflag = 0;
   token.token = "exec";    token.token = "exec";
   token = lookupTokens(token); /* no use */    token = lookupTokens(token); /* no use */
   tmp = findSystemDictionary(token.token);    tmp = findSystemDictionary(token.token);
Line 1197  KSexecuteString(s)
Line 1288  KSexecuteString(s)
   executePrimitive(ob);    executePrimitive(ob);
   recursive--;    recursive--;
   if (KSPushEnvMode) *EnvOfStackMachine = *saved_EnvOfStackMachine;    if (KSPushEnvMode) *EnvOfStackMachine = *saved_EnvOfStackMachine;
   if (localCatchCtrlC) { signal(SIGINT, sigfunc); }    if (localCatchCtrlC) { mysignal(SIGINT, sigfunc); }
   return(0);    return(0);
 }  }
   
 KSdefineMacros() {  KSdefineMacros() {
   struct tokens token;    struct tokens token;
   int tmp;    int tmp;
   struct object ob;    struct object ob = OINIT;
   
   if (StandardMacros && (strlen(SMacros))) {    if (StandardMacros && (strlen(SMacros))) {
     token.kind = EXECUTABLE_STRING;      token.kind = EXECUTABLE_STRING; token.tflag = 0;
     token.token = SMacros;      token.token = SMacros;
     executeToken(token);    /* execute startup commands */      executeToken(token);    /* execute startup commands */
     token.kind = ID;      token.kind = ID; token.tflag = 0;
     token.token = "exec";      token.token = "exec";
     token = lookupTokens(token); /* no use */      token = lookupTokens(token); /* no use */
     tmp = findSystemDictionary(token.token);      tmp = findSystemDictionary(token.token);
Line 1225  KSdefineMacros() {
Line 1316  KSdefineMacros() {
 void KSstart() {  void KSstart() {
   struct tokens token;    struct tokens token;
   int tmp;    int tmp;
   struct object ob;    struct object ob = OINIT;
   extern int Quiet;    extern int Quiet;
   
   stackmachine_init(); KinitKan();    stackmachine_init(); KinitKan();
Line 1234  void KSstart() {
Line 1325  void KSstart() {
   /* The following line may cause a core dump, if you do not setjmp properly    /* The following line may cause a core dump, if you do not setjmp properly
      after calling KSstart().*/       after calling KSstart().*/
   /*    /*
     if (setjmp(EnvOfStackMachine)) {      if (MYSETJMP(EnvOfStackMachine)) {
     fprintf(stderr,"KSstart(): An error or interrupt in reading macros, files and command strings.\n");      fprintf(stderr,"KSstart(): An error or interrupt in reading macros, files and command strings.\n");
     exit(10);      exit(10);
     } else {  }  */      } else {  }  */
   
   /* setup quiet mode or not */    /* setup quiet mode or not */
   token.kind = EXECUTABLE_STRING;    token.kind = EXECUTABLE_STRING; token.tflag = 0;
   if (Quiet) {    if (Quiet) {
     token.token = " /@@@.quiet 1 def ";      token.token = " /@@@.quiet 1 def ";
   }else {    }else {
     token.token = " /@@@.quiet 0 def ";      token.token = " /@@@.quiet 0 def ";
   }    }
   executeToken(token); /* execute startup commands */    executeToken(token); /* execute startup commands */
   token.kind = ID;    token.kind = ID; token.tflag = 0;
   token.token = "exec";    token.token = "exec";
   token = lookupTokens(token); /* set hashing values */    token = lookupTokens(token); /* set hashing values */
   tmp = findSystemDictionary(token.token);    tmp = findSystemDictionary(token.token);
Line 1279  struct object KSpeek(k) {
Line 1370  struct object KSpeek(k) {
   
 char *KSstringPop() {  char *KSstringPop() {
   /* pop a string */    /* pop a string */
   struct object rob;    struct object rob = OINIT;
   rob = Kpop();    rob = Kpop();
   if (rob.tag == Sdollar) {    if (rob.tag == Sdollar) {
     return(rob.lc.str);      return(rob.lc.str);
Line 1319  char *KSpopBinary(int *size) {
Line 1410  char *KSpopBinary(int *size) {
   return((char *)NULL);    return((char *)NULL);
 }  }
   
   struct object KSnewObjectArray(int k) {
      return newObjectArray(k);
   }
   
 int pushErrorStack(struct object obj)  int pushErrorStack(struct object obj)
 {  {
   if (CurrentOperandStack == &ErrorStack) {    if (CurrentOperandStack == &ErrorStack) {
Line 1349  struct object popErrorStack(void) {
Line 1444  struct object popErrorStack(void) {
 }  }
   
 char *popErrorStackByString(void) {  char *popErrorStackByString(void) {
   struct object obj;    struct object obj = OINIT;
   struct object eobj;    struct object eobj = OINIT;
   eobj = popErrorStack();    eobj = popErrorStack();
   if (ectag(eobj) != CLASSNAME_ERROR_PACKET) {    if (ectag(eobj) != CLASSNAME_ERROR_PACKET) {
     return(NULL);      return(NULL);
Line 1379  int KScheckErrorStack(void)
Line 1474  int KScheckErrorStack(void)
   
 struct object KnewErrorPacket(int serial,int no,char *message)  struct object KnewErrorPacket(int serial,int no,char *message)
 {  {
   struct object obj;    struct object obj = OINIT;
   struct object *myop;    struct object *myop;
   char *s;    char *s;
   /* Set extended tag. */    /* Set extended tag. */
Line 1401  struct object KnewErrorPacket(int serial,int no,char *
Line 1496  struct object KnewErrorPacket(int serial,int no,char *
   
 struct object KnewErrorPacketObj(struct object ob1)  struct object KnewErrorPacketObj(struct object ob1)
 {  {
   struct object obj;    struct object obj = OINIT;
   struct object *myop;    struct object *myop;
   char *s;    char *s;
   /* Set extended tag. */    /* Set extended tag. */
Line 1500  int KSstackPointer() {
Line 1595  int KSstackPointer() {
 }  }
   
 struct object KSdupErrors() {  struct object KSdupErrors() {
   struct object rob;    struct object rob = OINIT;
   struct object ob;    struct object ob = OINIT;
   int i;    int i;
   int n;    int n;
   int m;    int m;
Line 1528  struct object KSdupErrors() {
Line 1623  struct object KSdupErrors() {
   
 void cancelAlarm() {  void cancelAlarm() {
   alarm((unsigned int) 0);    alarm((unsigned int) 0);
   signal(SIGALRM,SIG_DFL);    mysignal(SIGALRM,SIG_DFL);
 }  }
   
 /* back-trace */  /* back-trace */
Line 1558  char *tracePopName(void) {
Line 1653  char *tracePopName(void) {
   if (TraceNameStackp <= 0) return (char *) NULL;    if (TraceNameStackp <= 0) return (char *) NULL;
   return TraceNameStack[--TraceNameStackp];    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  #define TRACE_MSG_SIZE 320
 char *traceShowStack(void) {  char *traceShowStack(void) {
   char *s;    char *s;
Line 1574  char *traceShowStack(void) {
Line 1680  char *traceShowStack(void) {
     if (t == NULL) {      if (t == NULL) {
       s[p] = ';'; s[p+1] = 0;        s[p] = ';'; s[p+1] = 0;
       break;        break;
     }else if ((strlen(t) + p -10) > TRACE_MSG_SIZE) {      }else if ((strlen(t) + p) > (TRACE_MSG_SIZE-10)) {
           /*      fprintf(stderr,"p=%d, TraceNameStackp=%d, strlen(t)=%d, t=%s\n",p,TraceNameStackp,strlen(t),t); */            /* fprintf(stderr,"p=%d, TraceNameStackp=%d, strlen(t)=%d, t=%s\n",p,TraceNameStackp,strlen(t),t); */
       strcpy(&(s[p])," ...");        strcpy(&(s[p])," ...");
       break;        break;
     }      }
Line 1584  char *traceShowStack(void) {
Line 1690  char *traceShowStack(void) {
   } while (t != (char *)NULL);    } while (t != (char *)NULL);
   fprintf(stderr,"%s\n",s);    fprintf(stderr,"%s\n",s);
   return s;    return s;
   }
   
   /*
     if (fname != NULL) fname is pushed to the trace stack.
    */
   int executeExecutableArray(struct object ob,char *fname,int withGotoP) {
     struct tokens *tokenArray;
     int size,i;
     int status;
     int infixOn;
     struct tokens infixToken;
     extern int GotoP;
   
     infixOn = 0;
     if (ob.tag != SexecutableArray) errorStackmachine("Error (executeTokenArray): the argument is not a token array.");
   
     if (fname != NULL) tracePushName(fname);
     tokenArray = ob.lc.tokenArray;
     size = ob.rc.ival;
     for (i=0; i<size; i++) {
       status = executeToken(tokenArray[i]);
       if ((status & STATUS_BREAK) || (status < 0) || (withGotoP && GotoP)) {
         if (fname != NULL) tracePopName();
         return(status);
       }
   
       if (status & STATUS_INFIX) {
         if (i == size-1) errorStackmachine("Infix operator at the end of an executable array.");
         infixOn = 1; infixToken = tokenArray[i];
         infixToken.tflag |= NO_DELAY;
         continue;
       }else if (infixOn) {
         infixOn = 0;
         status = executeToken(infixToken);
         if ((status & STATUS_BREAK) || (status < 0) || (withGotoP && GotoP)) {
           if (fname != NULL) tracePopName();
           return(status);
         }
       }
     }
     if (fname != NULL) tracePopName();
     return(0); /* normal exit */
 }  }
Legend:
Removed from v.1.19  
changed lines
  Added in v.1.40
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>