[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.3 and 1.23

version 1.3, 2000/01/21 01:08:12 version 1.23, 2004/09/12 01:53:11
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.2 2000/01/16 07:55:41 takayama Exp $ */  /* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.22 2004/09/12 01:32:08 takayama Exp $ */
 /*   stackmachin.c */  /*   stackmachin.c */
   
 #include <stdio.h>  #include <stdio.h>
Line 14 
Line 14 
 /* #define OPERAND_STACK_SIZE  2000 */  /* #define OPERAND_STACK_SIZE  2000 */
 #define OPERAND_STACK_SIZE 30000  #define OPERAND_STACK_SIZE 30000
 #define SYSTEM_DICTIONARY_SIZE 200  #define SYSTEM_DICTIONARY_SIZE 200
 #define USER_DICTIONARY_SIZE   1223  /* #define USER_DICTIONARY_SIZE   1223, 3581, 27449 */
   #define USER_DICTIONARY_SIZE  59359
 /* The value of USER_DICTIONARY_SIZE must be prime number, because of hashing  /* The value of USER_DICTIONARY_SIZE must be prime number, because of hashing
    method */     method */
 #define ARGV_WORK_MAX  (AGLIMIT+100)  #define ARGV_WORK_MAX  (AGLIMIT+100)
Line 53  struct context *PrimitiveContextp = &StandardContext;
Line 54  struct context *PrimitiveContextp = &StandardContext;
   
 static struct object ObjTmp; /* for poor compiler */  static struct object ObjTmp; /* for poor compiler */
   
   int Calling_ctrlC_hook = 0;
   
 int StandardMacros = 1;  int StandardMacros = 1;
 int StartAFile = 0;  int StartAFile = 0;
 char *StartFile;  char *StartFile;
Line 73  static void pstack(void);
Line 76  static void pstack(void);
 static struct object executableStringToExecutableArray(char *str);  static struct object executableStringToExecutableArray(char *str);
   
 extern int SerialCurrent;  extern int SerialCurrent;
   extern int QuoteMode;
   
 int SGClock = 0;  int SGClock = 0;
 int UserCtrlC = 0;  int UserCtrlC = 0;
 int OXlock = 0;  int OXlock = 0;
 int OXlockSaved = 0;  int OXlockSaved = 0;
   
   char *UD_str;
   int  UD_attr;
   
 struct object * newObject()  struct object * newObject()
 {  {
   struct object *r;    struct object *r;
Line 91  struct object * newObject() 
Line 98  struct object * newObject() 
 }  }
   
 struct object newObjectArray(size)  struct object newObjectArray(size)
 int size;       int size;
 {  {
   struct object rob;    struct object rob;
   struct object *op;    struct object *op;
Line 109  int size;
Line 116  int size;
 }  }
   
 isNullObject(obj)  isNullObject(obj)
 struct object obj;       struct object obj;
 {  {
   if (obj.tag == 0) return(1);    if (obj.tag == 0) return(1);
   else return(0);    else return(0);
 }  }
   
 int putSystemDictionary(str,ob)  int putSystemDictionary(str,ob)
 char *str;   /* key */       char *str;   /* key */
 struct object ob; /* value */       struct object ob; /* value */
 {  {
   int i;    int i;
   int j;    int j;
Line 127  struct object ob; /* value */
Line 134  struct object ob; /* value */
     /*printf("Add %d %s\n",i,str);*/      /*printf("Add %d %s\n",i,str);*/
     if (strcmp(str,(SystemDictionary[i]).key) > 0) {      if (strcmp(str,(SystemDictionary[i]).key) > 0) {
       for (j=Sdp-1; j>=i+1; j--) {        for (j=Sdp-1; j>=i+1; j--) {
         (SystemDictionary[j+1]).key = (SystemDictionary[j]).key;          (SystemDictionary[j+1]).key = (SystemDictionary[j]).key;
         (SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;          (SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;
       }        }
       (SystemDictionary[i+1]).key = str;        (SystemDictionary[i+1]).key = str;
       (SystemDictionary[i+1]).obj = ob;        (SystemDictionary[i+1]).obj = ob;
Line 168  int findSystemDictionary(str)   
Line 175  int findSystemDictionary(str)   
       return(0);        return(0);
     } else if (first == last) {      } else if (first == last) {
       if (strcmp(str,(SystemDictionary[first]).key) == 0) {        if (strcmp(str,(SystemDictionary[first]).key) == 0) {
         return((SystemDictionary[first]).obj.lc.ival);          return((SystemDictionary[first]).obj.lc.ival);
       }else {        }else {
         return(0);          return(0);
       }        }
     } else if (last - first == 1) { /* This case is necessary */      } else if (last - first == 1) { /* This case is necessary */
       if (strcmp(str,(SystemDictionary[first]).key) == 0) {        if (strcmp(str,(SystemDictionary[first]).key) == 0) {
         return((SystemDictionary[first]).obj.lc.ival);          return((SystemDictionary[first]).obj.lc.ival);
       }else if (strcmp(str,(SystemDictionary[last]).key) == 0) {        }else if (strcmp(str,(SystemDictionary[last]).key) == 0) {
         return((SystemDictionary[last]).obj.lc.ival);          return((SystemDictionary[last]).obj.lc.ival);
       }else return(0);        }else return(0);
     }      }
   
Line 193  int findSystemDictionary(str)   
Line 200  int findSystemDictionary(str)   
 }  }
   
 int putUserDictionary(str,h0,h1,ob,dic)  int putUserDictionary(str,h0,h1,ob,dic)
 char *str;   /* key */       char *str;   /* key */
 int h0,h1;   /* Hash values of the key */       int h0,h1;   /* Hash values of the key */
 struct object ob; /* value */       struct object ob; /* value */
 struct dictionary *dic;       struct dictionary *dic;
 {  {
   int x,r;    int x,r;
   extern int Strict2;    extern int Strict2;
Line 214  struct dictionary *dic;
Line 221  struct dictionary *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 222  struct dictionary *dic;
Line 229  struct dictionary *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 241  struct object KputUserDictionary(char *str,struct obje
Line 248  struct object KputUserDictionary(char *str,struct obje
 }  }
   
 struct object findUserDictionary(str,h0,h1,cp)  struct object findUserDictionary(str,h0,h1,cp)
 /* returns NoObject, if there is no item. */       /* returns NoObject, if there is no item. */
 char *str;    /* key */       char *str;    /* key */
 int h0,h1;    /* The hashing values of the key. */       int h0,h1;    /* The hashing values of the key. */
 struct context *cp;       struct context *cp;
            /* Set char *UD_str, int UD_attr (attributes) */
 {  {
   int x;    int x;
   struct dictionary *dic;    struct dictionary *dic;
     extern char *UD_str;
     extern int UD_attr;
     UD_str = NULL; UD_attr = -1;
   dic = cp->userDictionary;    dic = cp->userDictionary;
   x = h0;    x = h0;
   while (1) {    while (1) {
     if ((dic[x]).key == EMPTY) { break; }      if ((dic[x]).key == EMPTY) { break; }
     if (strcmp((dic[x]).key,str) == 0) {      if (strcmp((dic[x]).key,str) == 0) {
             UD_str = (dic[x]).key; UD_attr = (dic[x]).attr;
       return( (dic[x]).obj );        return( (dic[x]).obj );
     }      }
     x = (x+h1) % USER_DICTIONARY_SIZE;      x = (x+h1) % USER_DICTIONARY_SIZE;
Line 270  struct object KfindUserDictionary(char *str) {
Line 282  struct object KfindUserDictionary(char *str) {
 }  }
   
 int putUserDictionary2(str,h0,h1,attr,dic)  int putUserDictionary2(str,h0,h1,attr,dic)
 char *str;   /* key */       char *str;   /* key */
 int h0,h1;   /* Hash values of the key */       int h0,h1;   /* Hash values of the key */
 int attr;    /* attribute field */       int attr;    /* attribute field */
 struct dictionary *dic;       struct dictionary *dic;
 {  {
   int x;    int x;
   int i;    int i;
Line 301  struct dictionary *dic;
Line 313  struct dictionary *dic;
   
   
 int putPrimitiveFunction(str,number)  int putPrimitiveFunction(str,number)
 char *str;       char *str;
 int number;       int number;
 {  {
   struct object ob;    struct object ob;
   ob.tag = Soperator;    ob.tag = Soperator;
Line 311  int number;
Line 323  int number;
 }  }
   
 struct tokens lookupTokens(t)  struct tokens lookupTokens(t)
 struct tokens t;       struct tokens t;
 {  {
   struct object *left;    struct object *left;
   struct object *right;    struct object *right;
Line 327  struct tokens t;
Line 339  struct tokens t;
 }  }
   
 struct object lookupLiteralString(s)  struct object lookupLiteralString(s)
 char *s; /* s must be a literal string */       char *s; /* s must be a literal string */
 {  {
   struct object ob;    struct object ob;
   ob.tag = Slist;    ob.tag = Slist;
Line 341  char *s; /* s must be a literal string */
Line 353  char *s; /* s must be a literal string */
   
   
 int hash0(str)  int hash0(str)
 char *str;       char *str;
 {  {
   int h=0;    int h=0;
   while (*str != '\0') {    while (*str != '\0') {
     h = ((h*128)+(*str)) % USER_DICTIONARY_SIZE;      h = ((h*128)+((unsigned char)(*str))) % USER_DICTIONARY_SIZE;
     str++;      str++;
   }    }
   return(h);    return(h);
 }  }
   
 int hash1(str)  int hash1(str)
 char *str;       char *str;
 {  {
   return(8-(str[0]%8));    return(8-((unsigned char)(str[0])%8));
 }  }
   
 void hashInitialize(struct dictionary *dic)  void hashInitialize(struct dictionary *dic)
Line 366  void hashInitialize(struct dictionary *dic)
Line 378  void hashInitialize(struct dictionary *dic)
 }  }
   
 static isInteger(str)  static isInteger(str)
 char *str;       char *str;
 {  {
   int i;    int i;
   int n;    int n;
Line 387  char *str;
Line 399  char *str;
 }  }
   
 static strToInteger(str)  static strToInteger(str)
 char *str;       char *str;
 {  {
   int i;    int i;
   int n;    int n;
Line 408  char *str;
Line 420  char *str;
 }  }
   
 static power(s,i)  static power(s,i)
 int s;       int s;
 int i;       int i;
 {  {
   if (i == 0) return 1;    if (i == 0) return 1;
   else return( s*power(s,i-1) );    else return( s*power(s,i-1) );
 }  }
   
 int Kpush(ob)  int Kpush(ob)
 struct object ob;       struct object ob;
 {  {
   OperandStack[Osp++] = ob;    OperandStack[Osp++] = ob;
   if (Osp >= OspMax) {    if (Osp >= OspMax) {
Line 437  struct object Kpop()
Line 449  struct object Kpop()
 }  }
   
 struct object peek(k)  struct object peek(k)
 int k;       int k;
 {  {
   if ((Osp-k-1) < 0) {    if ((Osp-k-1) < 0) {
     return( NullObject );      return( NullObject );
Line 586  void contextControl(actionOfContextControl ctl) {
Line 598  void contextControl(actionOfContextControl ctl) {
   
   
 int isLiteral(str)  int isLiteral(str)
 char *str;       char *str;
 {  {
   if (strlen(str) <2) return(0);    if (strlen(str) <2) return(0);
   else {    else {
Line 611  void printOperandStack() {
Line 623  void printOperandStack() {
   
   
 static initSystemDictionary()  static initSystemDictionary()
  {  {
   StandardStack.ostack = StandardStackA;    StandardStack.ostack = StandardStackA;
   StandardStack.sp = StandardStackP;    StandardStack.sp = StandardStackP;
   StandardStack.size = OPERAND_STACK_SIZE;    StandardStack.size = OPERAND_STACK_SIZE;
Line 626  static initSystemDictionary()
Line 638  static initSystemDictionary()
   
   KdefinePrimitiveFunctions();    KdefinePrimitiveFunctions();
   
  }  }
   
 struct object showSystemDictionary(int f) {  struct object showSystemDictionary(int f) {
   int i;    int i;
Line 677  int showUserDictionary() 
Line 689  int showUserDictionary() 
   for (i=0; i<USER_DICTIONARY_SIZE; i++) {    for (i=0; i<USER_DICTIONARY_SIZE; i++) {
     if ((dic[i]).key != EMPTY) {      if ((dic[i]).key != EMPTY) {
       if (strlen((dic[i]).key) >maxl)        if (strlen((dic[i]).key) >maxl)
         maxl = strlen((dic[i]).key);          maxl = strlen((dic[i]).key);
     }      }
   }    }
   maxl += 3;    maxl += 3;
Line 688  int showUserDictionary() 
Line 700  int showUserDictionary() 
     if ((dic[i]).key != EMPTY) {      if ((dic[i]).key != EMPTY) {
       fprintf(Fstack,format,(dic[i]).key);        fprintf(Fstack,format,(dic[i]).key);
       /*{ char *sss; int ii,h0,h1;        /*{ char *sss; int ii,h0,h1;
         sss = dic[i].key;          sss = dic[i].key;
         h0 = dic[i].h0;          h0 = dic[i].h0;
         h1 = dic[i].h1;          h1 = dic[i].h1;
         for (ii=0; ii<strlen(sss); ii++) fprintf(Fstack,"%x ",sss[ii]);          for (ii=0; ii<strlen(sss); ii++) fprintf(Fstack,"%x ",sss[ii]);
         fprintf(Fstack,": h0=%d, h1=%d, %d\n",h0,h1,i);          fprintf(Fstack,": h0=%d, h1=%d, %d\n",h0,h1,i);
       }*/          }*/
       if (j % nl == nl-1) fprintf(Fstack,"\n");        if (j % nl == nl-1) fprintf(Fstack,"\n");
       j++;        j++;
     }      }
Line 703  int showUserDictionary() 
Line 715  int showUserDictionary() 
   
   
 static struct object executableStringToExecutableArray(s)  static struct object executableStringToExecutableArray(s)
 char *s;       char *s;
 {  {
   struct tokens *tokenArray;    struct tokens *tokenArray;
   struct object ob;    struct object ob;
Line 717  char *s;
Line 729  char *s;
     if ( ((ob.lc.tokenArray)[i]).kind == EXECUTABLE_STRING) {      if ( ((ob.lc.tokenArray)[i]).kind == EXECUTABLE_STRING) {
       ((ob.lc.tokenArray)[i]).kind = EXECUTABLE_ARRAY;        ((ob.lc.tokenArray)[i]).kind = EXECUTABLE_ARRAY;
       ((ob.lc.tokenArray)[i]).object =        ((ob.lc.tokenArray)[i]).object =
         executableStringToExecutableArray(((ob.lc.tokenArray)[i]).token);          executableStringToExecutableArray(((ob.lc.tokenArray)[i]).token);
     }      }
   }    }
   return(ob);    return(ob);
Line 728  void scanner() {
Line 740  void scanner() {
   struct object ob;    struct object ob;
   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;
     int infixOn = 0;
     struct tokens infixToken;
   getokenSM(INIT);    getokenSM(INIT);
   initSystemDictionary();    initSystemDictionary();
   
   #if defined(__CYGWIN__)
     if (sigsetjmp(EnvOfStackMachine,1)) {
   #else
   if (setjmp(EnvOfStackMachine)) {    if (setjmp(EnvOfStackMachine)) {
   #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);
Line 745  void scanner() {
Line 764  void scanner() {
   }    }
   
   /* 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 766  void scanner() {
Line 785  void scanner() {
   if (StartAFile) {    if (StartAFile) {
     tmp2 = StartFile;      tmp2 = StartFile;
     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);
     ob.tag = Soperator;      ob.tag = Soperator;
     ob.lc.ival = tmp;      ob.lc.ival = tmp;
     executePrimitive(ob);       /* exec */      executePrimitive(ob);   /* exec */
   }    }
   
   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);
     ob.tag = Soperator;      ob.tag = Soperator;
     ob.lc.ival = tmp;      ob.lc.ival = tmp;
     executePrimitive(ob);       /* exec */      executePrimitive(ob);   /* exec */
   }    }
   
   
   for (;;) {    for (;;) {
   #if defined(__CYGWIN__)
       if (jval=sigsetjmp(EnvOfStackMachine,1)) {
   #else
     if (jval=setjmp(EnvOfStackMachine)) {      if (jval=setjmp(EnvOfStackMachine)) {
   #endif
       /* ***  The following does not work properly.  ****        /* ***  The following does not work properly.  ****
       if (jval == 2) {           if (jval == 2) {
         if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {           if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
           pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));           pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
         }           }
       }           }
       **** */           **** */
       if (DebugStack >= 1) {        if (DebugStack >= 1) {
         fprintf(Fstack,"\nscanner> ");          fprintf(Fstack,"\nscanner> ");
       }        }
       KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */        if (!Calling_ctrlC_hook) { /* to avoid recursive call of ctrlC-hook. */
           continue ;          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;
         infixOn = 0;
         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;
       }
   }    }
 }  }
   
   
 void ctrlC(sig)  void ctrlC(sig)
 int sig;       int sig;
 {  {
   extern void ctrlC();    extern void ctrlC();
   extern int ErrorMessageMode;    extern int ErrorMessageMode;
   extern int SGClock;    extern int SGClock;
   extern int UserCtrlC;    extern int UserCtrlC;
   extern int OXlock;    extern int OXlock;
   
   signal(sig,SIG_IGN);    signal(sig,SIG_IGN);
   /* see 133p */    /* see 133p */
     cancelAlarm();
     if (sig == SIGALRM) {
       fprintf(stderr,"ctrlC by SIGALRM\n");
     }
   
   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(SIGINT,ctrlC);      signal(sig,ctrlC);  if (sig == SIGALRM) alarm((unsigned int)10);
     return;      return;
   }    }
   if (OXlock) {    if (OXlock) {
Line 845  int sig;
Line 886  int sig;
       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(SIGINT,ctrlC);      signal(sig,ctrlC);  if (sig == SIGALRM) alarm((unsigned int)10);
     return;      return;
   }    }
   if (ErrorMessageMode != 1) {    if (ErrorMessageMode != 1) {
       (void *) traceShowStack();
     fprintf(Fstack,"User interruption by ctrl-C. We are in the top-level.\n");      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");      fprintf(Fstack,"Type in quit in order to exit sm1.\n");
   }    }
     traceClearStack();
   if (GotoP) {    if (GotoP) {
     fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);      fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
     GotoP = 0;      GotoP = 0;
Line 866  int sig;
Line 909  int sig;
   */    */
   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);    signal(SIGINT,ctrlC);
   #if defined(__CYGWIN__)
     siglongjmp(EnvOfStackMachine,2);
   #else
   longjmp(EnvOfStackMachine,2); /* returns 2 for ctrl-C */    longjmp(EnvOfStackMachine,2); /* returns 2 for ctrl-C */
   #endif
 }  }
   
 int executeToken(token)  int executeToken(token)
 struct tokens token;       struct tokens token;
 {  {
   struct object ob;    struct object ob;
   int primitive;    int primitive;
Line 878  struct tokens token;
Line 925  struct tokens token;
   int status;    int status;
   struct tokens *tokenArray;    struct tokens *tokenArray;
   int i,h0,h1;    int i,h0,h1;
     int infixOn;
     struct tokens infixToken;
   extern int WarningMessageMode;    extern int WarningMessageMode;
   extern int Strict;    extern int Strict;
     extern int InSendmsg2;
   
     infixOn = 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) {
         GotoP = 0;          GotoP = 0;
         return(0); /* normal exit */          return(0); /* normal exit */
       }        }
     }      }
     return(0);  /* normal exit */      return(0);  /* normal exit */
Line 907  struct tokens token;
Line 958  struct tokens token;
       strcpy(ob.lc.str, &((token.token)[1]));        strcpy(ob.lc.str, &((token.token)[1]));
   
       if (token.object.tag != Slist) {        if (token.object.tag != Slist) {
         fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);          fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
         token.object = lookupLiteralString(token.token);          token.object = lookupLiteralString(token.token);
       }        }
       ob.rc.op = token.object.lc.op;        ob.rc.op = token.object.lc.op;
       Kpush(ob);        Kpush(ob);
Line 919  struct tokens token;
Line 970  struct tokens token;
       Kpush(ob);        Kpush(ob);
     } else {      } else {
       if (token.object.tag != Slist) {        if (token.object.tag != Slist) {
         fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);          fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
         token = lookupTokens(token);          token = lookupTokens(token);
       }        }
       h0 = ((token.object.lc.op)->lc).ival;        h0 = ((token.object.lc.op)->lc).ival;
       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)) {
             tracePopName(); 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) {
           tokenArray = ob.lc.tokenArray;            tracePushName(token.token);
           size = ob.rc.ival;            tokenArray = ob.lc.tokenArray;
           for (i=0; i<size; i++) {            size = ob.rc.ival;
             status = executeToken(tokenArray[i]);            for (i=0; i<size; i++) {
             if (status != 0) return(status);              status = executeToken(tokenArray[i]);
           }              if ((status & STATUS_BREAK) || (status < 0)) {
         }else {                tracePopName(); return(status);
           Kpush(ob);                          }
         }  
               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)) {
                   tracePopName(); return(status);
                 }
               }
             }
             tracePopName();
           }else {
             Kpush(ob);
           }
       } else if (primitive) {        } else if (primitive) {
         /* system operator */          tracePushName(token.token);
         ob.tag = Soperator;          /* system operator */
         ob.lc.ival = primitive;          ob.tag = Soperator;
         return(executePrimitive(ob));          ob.lc.ival = primitive;
           status = executePrimitive(ob);
           tracePopName();
           return(status);
       } else {        } else {
         if (WarningMessageMode == 1 || WarningMessageMode == 2) {          if (QuoteMode) {
           char tmpc[1024];            if (InSendmsg2) return(DO_QUOTE);
           if (strlen(token.token) < 900) {            else {
             sprintf(tmpc,"\n%%Warning: The identifier <<%s>> is not in the system dictionary\n%%   nor in the user dictionaries. Push NullObject.\n",token.token);              Kpush(KpoString(token.token));
           }else {strcpy(tmpc,"Warning: identifier is not in the dictionaries.");}              return(0); /* normal exit.*/
           pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));            }
         }                  }
         if (WarningMessageMode != 1) {          if (WarningMessageMode == 1 || WarningMessageMode == 2) {
           fprintf(Fstack,"\n%%Warning: The identifier <<%s>> is not in the system dictionary\n%%   nor in the user dictionaries. Push NullObject.\n",token.token);            char tmpc[1024];
         /*fprintf(Fstack,"(%d,%d)\n",h0,h1);*/            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);
         if (Strict) {            }else {strcpy(tmpc,"Warning: identifier is not in the dictionaries.");}
           errorStackmachine("Warning: identifier is not in the dictionaries");            pushErrorStack(KnewErrorPacket(SerialCurrent,-1,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 984  struct tokens token;
Line 1067  struct tokens token;
   
   
 errorStackmachine(str)  errorStackmachine(str)
 char *str;       char *str;
 {  {
   int i,j,k;    int i,j,k;
   static char *u="Usage:";    static char *u="Usage:";
   char message0[1024];    char message0[1024];
   char *message;    char *message;
   extern int ErrorMessageMode;    extern int ErrorMessageMode;
     cancelAlarm();
   if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {    if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
     pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));      pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));
   }    }
Line 1004  char *str;
Line 1088  char *str;
     if (i==6) {      if (i==6) {
       fprintf(stderr,"ERROR(sm): \n");        fprintf(stderr,"ERROR(sm): \n");
       while (str[i] != '\0' && str[i] != ' ') {        while (str[i] != '\0' && str[i] != ' ') {
         i++;          i++;
       }        }
       if (str[i] == ' ') {        if (str[i] == ' ') {
         fprintf(stderr,"  %s\n",&(str[i+1]));          fprintf(stderr,"  %s\n",&(str[i+1]));
         k = 0;          k = 0;
         if (i-6 > 1022) message = (char *)sGC_malloc(sizeof(char)*i);          if (i-6 > 1022) message = (char *)sGC_malloc(sizeof(char)*i);
         for (j=6; j<i ; j++) {          for (j=6; j<i ; j++) {
           message[k] = str[j];            message[k] = str[j];
           message[k+1] = '\0';            message[k+1] = '\0';
           k++;            k++;
         }          }
         Kusage2(stderr,message);          Kusage2(stderr,message);
       }else{        }else{
         Kusage2(stderr,&(str[6]));          Kusage2(stderr,&(str[6]));
       }        }
     }else {      }else {
       fprintf(stderr,"ERROR(sm): ");        fprintf(stderr,"ERROR(sm): ");
       fprintf(stderr,str);        fprintf(stderr,str);
     }      }
     fprintf(stderr,"\n");      fprintf(stderr,"\n");
       (void) traceShowStack();
   }    }
     traceClearStack();
   if (GotoP) {    if (GotoP) {
     fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);      fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
     GotoP = 0;      GotoP = 0;
Line 1036  char *str;
Line 1122  char *str;
 }  }
   
 warningStackmachine(str)  warningStackmachine(str)
 char *str;       char *str;
 {  {
   extern int WarningMessageMode;    extern int WarningMessageMode;
   extern int Strict;    extern int Strict;
Line 1057  char *str;
Line 1143  char *str;
    you have to reset the jump buffer by setjmp(EnvOfStackMachine).     you have to reset the jump buffer by setjmp(EnvOfStackMachine).
    cf. kxx/memo1.txt, kxx/stdserver00.c 1998, 2/6 */     cf. kxx/memo1.txt, kxx/stdserver00.c 1998, 2/6 */
 KSexecuteString(s)  KSexecuteString(s)
 char *s;       char *s;
 {  {
   struct tokens token;    struct tokens token;
   struct object ob;    struct object ob;
Line 1082  char *s;
Line 1168  char *s;
   
   if (KSPushEnvMode) {    if (KSPushEnvMode) {
     *saved_EnvOfStackMachine = *EnvOfStackMachine;      *saved_EnvOfStackMachine = *EnvOfStackMachine;
   #if defined(__CYGWIN__)
       if (jval = sigsetjmp(EnvOfStackMachine,1)) {
   #else
     if (jval = setjmp(EnvOfStackMachine)) {      if (jval = setjmp(EnvOfStackMachine)) {
   #endif
       *EnvOfStackMachine = *saved_EnvOfStackMachine;        *EnvOfStackMachine = *saved_EnvOfStackMachine;
       if (jval == 2) {        if (jval == 2) {
         if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {          if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
           pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));            pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
         }          }
       }        }
       recursive--;        recursive--;
       if (localCatchCtrlC) { signal(SIGINT, sigfunc); }        if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
         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);        return(-1);
     }else{ }      }else{ }
   }else{    }else{
     if (recursive == 0) {      if (recursive == 0) {
   #if defined(__CYGWIN__)
         if (jval=sigsetjmp(EnvOfStackMachine,1)) {
   #else
       if (jval=setjmp(EnvOfStackMachine)) {        if (jval=setjmp(EnvOfStackMachine)) {
         if (jval == 2) {  #endif
           if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {          if (jval == 2) {
             pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));            if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
           }              pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
         }            }
         recursive = 0;          }
         if (localCatchCtrlC) { signal(SIGINT, sigfunc); }          recursive = 0;
         return(-1);          if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
           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 { }        }else { }
     }      }
   }    }
   
   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 1131  KSdefineMacros() {
Line 1238  KSdefineMacros() {
   struct object ob;    struct object ob;
   
   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);
     ob.tag = Soperator;      ob.tag = Soperator;
     ob.lc.ival = tmp;      ob.lc.ival = tmp;
     executePrimitive(ob);       /* exec */      executePrimitive(ob);   /* exec */
   }    }
   return(0);    return(0);
   
Line 1158  void KSstart() {
Line 1265  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 (setjmp(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 1192  struct object KSpop() {
Line 1299  struct object KSpop() {
 }  }
   
 void KSpush(ob)  void KSpush(ob)
 struct object ob;       struct object ob;
 {  {
   Kpush(ob);    Kpush(ob);
 }  }
   
   struct object KSpeek(k) {
     return(peek(k));
   }
   
 char *KSstringPop() {  char *KSstringPop() {
   /* pop a string */    /* pop a string */
   struct object rob;    struct object rob;
Line 1445  struct object KSdupErrors() {
Line 1556  struct object KSdupErrors() {
   }    }
   return(rob);    return(rob);
 }  }
   
   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;
   }
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.23
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>