===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/stackmachine.c,v
retrieving revision 1.16
retrieving revision 1.30
diff -u -p -r1.16 -r1.30
--- OpenXM/src/kan96xx/Kan/stackmachine.c	2004/09/05 00:51:17	1.16
+++ OpenXM/src/kan96xx/Kan/stackmachine.c	2005/06/09 04:47:16	1.30
@@ -1,4 +1,4 @@
-/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.15 2004/09/04 11:25:58 takayama Exp $ */
+/* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.29 2004/09/19 00:47:47 takayama Exp $ */
 /*   stackmachin.c */
 
 #include <stdio.h>
@@ -74,6 +74,7 @@ static strToInteger(char *);
 static 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;
@@ -83,6 +84,9 @@ int UserCtrlC = 0;
 int OXlock = 0;
 int OXlockSaved = 0;
 
+char *UD_str;
+int  UD_attr;
+
 struct object * newObject() 
 {
   struct object *r;
@@ -91,6 +95,7 @@ struct object * newObject() 
   r->tag = 0;
   (r->lc).ival = 0;
   (r->rc).ival = 0;
+  r->attr = NULL;
   return(r);
 }
 
@@ -218,7 +223,7 @@ int putUserDictionary(str,h0,h1,ob,dic)
   }
   r = x;
   if (Strict2) {
-    switch((dic[x]).attr) {
+    switch(((dic[x]).attr) & (PROTECT | ABSOLUTE_PROTECT)) {
     case PROTECT:
       r = -PROTECT;   /* Protected, but we rewrite it. */
       break;
@@ -226,7 +231,7 @@ int putUserDictionary(str,h0,h1,ob,dic)
       r = -ABSOLUTE_PROTECT;  /* Protected and we do not rewrite it. */
       return(r);
     default:
-      (dic[x]).attr = 0;
+      /* (dic[x]).attr = 0; */ /* It is not necesarry, I think. */
       break;
     }
   }
@@ -249,14 +254,19 @@ struct object findUserDictionary(str,h0,h1,cp)   
      char *str;    /* key */
      int h0,h1;    /* The hashing values of the key. */
      struct context *cp;
+	 /* Set char *UD_str, int UD_attr (attributes) */
 {
   int x;
   struct dictionary *dic;
+  extern char *UD_str;
+  extern int UD_attr;
+  UD_str = NULL; UD_attr = -1;
   dic = cp->userDictionary;
   x = h0;
   while (1) {
     if ((dic[x]).key == EMPTY) { break; }
     if (strcmp((dic[x]).key,str) == 0) {
+	  UD_str = (dic[x]).key; UD_attr = (dic[x]).attr;
       return( (dic[x]).obj );
     }
     x = (x+h1) % USER_DICTIONARY_SIZE;
@@ -287,6 +297,12 @@ int putUserDictionary2(str,h0,h1,attr,dic)
     }
     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;
   if (str[0] == '\0') {
     errorKan1("%s\n","putUserDictionary2(): You are defining a value with the null key.");
@@ -349,7 +365,7 @@ int hash0(str)
 {
   int h=0;
   while (*str != '\0') {
-    h = ((h*128)+(*str)) % USER_DICTIONARY_SIZE;
+    h = ((h*128)+((unsigned char)(*str))) % USER_DICTIONARY_SIZE;
     str++;
   }
   return(h);
@@ -358,7 +374,7 @@ int hash0(str)
 int hash1(str)
      char *str;
 {
-  return(8-(str[0]%8));
+  return(8-((unsigned char)(str[0])%8));
 }
 
 void hashInitialize(struct dictionary *dic)
@@ -450,6 +466,32 @@ struct object peek(k)
   }
 }
 
+static int isThereExecutableArray(struct object ob) {
+  int n,i;
+  struct object otmp;
+  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;
+  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)
 {
@@ -732,11 +774,14 @@ void scanner() {
   struct object ob;
   extern int Quiet;
   extern void ctrlC();
-  int tmp;
+  int tmp, status;
   char *tmp2;
   extern int ErrorMessageMode;
   int jval;
   extern int InSendmsg2;
+  int infixOn = 0;
+  struct tokens infixToken;
+  extern int RestrictedMode, RestrictedMode_saved;
   getokenSM(INIT);
   initSystemDictionary();
 
@@ -754,14 +799,14 @@ void scanner() {
   }
   
   /* setup quiet mode or not */
-  token.kind = EXECUTABLE_STRING;
+  token.kind = EXECUTABLE_STRING; token.tflag = 0;
   if (Quiet) {
     token.token = " /@@@.quiet 1 def ";
   }else {
     token.token = " /@@@.quiet 0 def ";
   }
   executeToken(token); /* execute startup commands */
-  token.kind = ID;
+  token.kind = ID; token.tflag = 0;
   token.token = "exec";
   token = lookupTokens(token); /* set hashing values */
   tmp = findSystemDictionary(token.token);
@@ -777,10 +822,10 @@ void scanner() {
     StartFile = (char *)sGC_malloc(sizeof(char)*(strlen(StartFile)+
                                                  40));
     sprintf(StartFile,"$%s$ run\n",tmp2);
-    token.kind = EXECUTABLE_STRING;
+    token.kind = EXECUTABLE_STRING; token.tflag = 0;
     token.token = StartFile;
     executeToken(token);    /* execute startup commands */
-    token.kind = ID;
+    token.kind = ID; token.tflag = 0;
     token.token = "exec";
     token = lookupTokens(token); /* set hashing values */
     tmp = findSystemDictionary(token.token);
@@ -790,10 +835,10 @@ void scanner() {
   }
   
   if (StartAString) {
-    token.kind = EXECUTABLE_STRING;
+    token.kind = EXECUTABLE_STRING;  token.tflag = 0;
     token.token = StartString;
     executeToken(token);    /* execute startup commands */
-    token.kind = ID;
+    token.kind = ID; token.tflag = 0;
     token.token = "exec";
     token = lookupTokens(token); /* set hashing values */
     tmp = findSystemDictionary(token.token);
@@ -820,18 +865,27 @@ 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? */
       InSendmsg2 = 0;
+      infixOn = 0;
       continue ;
     } else {  }
     if (DebugStack >= 1) { printOperandStack(); }
-    token = getokenSM(GET);
-    if ((tmp=executeToken(token)) < 0) break;
-    /***if (tmp == 1) fprintf(stderr," --- exit --- \n");*/
+    token = getokenSM(GET); 
+    if ((status=executeToken(token)) < 0) break;
+    /***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;
+    }
   }
 }
 
@@ -844,9 +898,11 @@ void ctrlC(sig)
   extern int SGClock;
   extern int UserCtrlC;
   extern int OXlock;
+  extern int RestrictedMode, RestrictedMode_saved;
 
   signal(sig,SIG_IGN);
   /* see 133p */
+  RestrictedMode = RestrictedMode_saved;
   cancelAlarm();
   if (sig == SIGALRM) {
     fprintf(stderr,"ctrlC by SIGALRM\n");
@@ -905,12 +961,14 @@ int executeToken(token)
   int primitive;
   int size;
   int status;
-  struct tokens *tokenArray;
   int i,h0,h1;
   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) {
@@ -956,19 +1014,32 @@ int executeToken(token)
       h1 = ((token.object.lc.op)->rc).ival;
       ob=findUserDictionary(token.token,h0,h1,CurrentContextp);
       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) {
         /* there is a definition in the user dictionary */
         if (ob.tag == SexecutableArray) {
-          tracePushName(token.token);
-          tokenArray = ob.lc.tokenArray;
-          size = ob.rc.ival;
-          for (i=0; i<size; i++) {
-            status = executeToken(tokenArray[i]);
-            if (status != 0) {
-              return(status);
-			}
+          if (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");
+            }
           }
-          tracePopName();
+
+          status = executeExecutableArray(ob,token.token,0);
+
+          if (localRestrictedMode_saved) RestrictedMode = localRestrictedMode_saved;
+          if ((status & STATUS_BREAK) || (status < 0)) return status;
         }else {
           Kpush(ob);
         }
@@ -978,7 +1049,7 @@ int executeToken(token)
         ob.tag = Soperator;
         ob.lc.ival = primitive;
         status = executePrimitive(ob);
-        if (status == 0) tracePopName(); 
+        tracePopName(); 
         return(status);
       } else {
         if (QuoteMode) {
@@ -1035,6 +1106,8 @@ errorStackmachine(str)
   char message0[1024];
   char *message;
   extern int ErrorMessageMode;
+  extern int RestrictedMode, RestrictedMode_saved;
+  RestrictedMode = RestrictedMode_saved;
   cancelAlarm();
   if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
     pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));
@@ -1117,6 +1190,7 @@ KSexecuteString(s)
   jmp_buf saved_EnvOfStackMachine;
   void (*sigfunc)();
   int localCatchCtrlC ;
+  extern int RestrictedMode, RestrictedMode_saved;
 
   localCatchCtrlC = CatchCtrlC;
   /* If CatchCtrlC is rewrited in this program,
@@ -1143,8 +1217,9 @@ KSexecuteString(s)
       recursive--;
       if (localCatchCtrlC) { signal(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?*/
@@ -1165,8 +1240,9 @@ KSexecuteString(s)
         recursive = 0;
         if (localCatchCtrlC) { signal(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;
@@ -1178,9 +1254,9 @@ KSexecuteString(s)
 
   recursive++;
   token.token = s;
-  token.kind = EXECUTABLE_STRING;
+  token.kind = EXECUTABLE_STRING; token.tflag = 0;
   executeToken(token);
-  token.kind = ID;
+  token.kind = ID; token.tflag = 0;
   token.token = "exec";
   token = lookupTokens(token); /* no use */
   tmp = findSystemDictionary(token.token);
@@ -1199,10 +1275,10 @@ KSdefineMacros() {
   struct object ob;
 
   if (StandardMacros && (strlen(SMacros))) {
-    token.kind = EXECUTABLE_STRING;
+    token.kind = EXECUTABLE_STRING; token.tflag = 0;
     token.token = SMacros;
     executeToken(token);    /* execute startup commands */
-    token.kind = ID;
+    token.kind = ID; token.tflag = 0;
     token.token = "exec";
     token = lookupTokens(token); /* no use */
     tmp = findSystemDictionary(token.token);
@@ -1232,14 +1308,14 @@ void KSstart() {
     } else {  }  */
 
   /* setup quiet mode or not */
-  token.kind = EXECUTABLE_STRING;
+  token.kind = EXECUTABLE_STRING; token.tflag = 0;
   if (Quiet) {
     token.token = " /@@@.quiet 1 def ";
   }else {
     token.token = " /@@@.quiet 0 def ";
   }
   executeToken(token); /* execute startup commands */
-  token.kind = ID;
+  token.kind = ID; token.tflag = 0;
   token.token = "exec";
   token = lookupTokens(token); /* set hashing values */
   tmp = findSystemDictionary(token.token);
@@ -1566,8 +1642,8 @@ char *traceShowStack(void) {
     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); */
+    }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); */
       strcpy(&(s[p])," ...");
       break;
     }
@@ -1576,4 +1652,46 @@ char *traceShowStack(void) {
   } while (t != (char *)NULL);
   fprintf(stderr,"%s\n",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 */
 }