===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/primitive.c,v
retrieving revision 1.1.1.1
retrieving revision 1.26
diff -u -p -r1.1.1.1 -r1.26
--- OpenXM/src/kan96xx/Kan/primitive.c	1999/10/08 02:12:02	1.1.1.1
+++ OpenXM/src/kan96xx/Kan/primitive.c	2020/10/06 11:33:46	1.26
@@ -1,17 +1,26 @@
+/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.25 2018/09/07 00:15:44 takayama Exp $ */
 /*   primitive.c */
 /*  The functions in this module were in stackmachine.c */
 
 #include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <signal.h>
+#include <time.h>
+#include <unistd.h>
 #include "datatype.h"
 #include "stackm.h"
 #include "extern.h"
+#include "extern2.h"
 #include "gradedset.h"
 #include "kclass.h"
 #include <sys/types.h>
 #include <sys/times.h>
+#include "mysig.h"
 
 int PrintDollar = 1;         /* flag for printObject() */
 int PrintComma  = 1;         /* flag for printObject() */
+int InSendmsg2 = 0;
 #define OB_ARRAY_MAX   (AGLIMIT+100)
 
 extern int GotoP;
@@ -22,20 +31,24 @@ extern int ClassTypes[];   /* kclass.c */
 extern struct context *PrimitiveContextp;
 extern struct context *CurrentContextp;
 extern struct dictionary *SystemDictionary;
+extern int QuoteMode;
 
 static char *operatorType(int i);
 
 static char *operatorType(type)
-int type;
+     int type;
 { int i;
-  for (i=0; i<Sdp; i++) {
-    if (type == (SystemDictionary[i]).obj.lc.ival) {
-      return((SystemDictionary[i]).key);
-    }
-  }
-  return("Unknown operator");
+ for (i=0; i<Sdp; i++) {
+   if (type == (SystemDictionary[i]).obj.lc.ival) {
+     return((SystemDictionary[i]).key);
+   }
+ }
+ return("Unknown operator");
 }
 
+#define evalEA(ob1) if (ob1.tag == SexecutableArray) {\
+	  executeExecutableArray(ob1,(char *)NULL,0); ob1 = Kpop();}
+
 /****** primitive functions *****************************************
   the values must be greater than 1. 0 is used for special purposes.*/
 #define Sadd              1
@@ -119,12 +132,14 @@ int type;
 #define Ssupmsg2 98
 #define Scclass 99
 #define Scoeff2 100
+#define Stlimit 101
+#define Soxshell 102
 /***********************************************/
 void printObject(ob,nl,fp) 
-struct object ob;
-int nl;
-FILE *fp;
-/* print the object on the top of the stack. */
+     struct object ob;
+     int nl;
+     FILE *fp;
+     /* print the object on the top of the stack. */
 {
 
   int size;
@@ -191,6 +206,9 @@ FILE *fp;
     case Sdouble:
       fprintf(fp,"<double> ");
       break;
+    case SbyteArray:
+      fprintf(fp,"<byteArray> ");
+      break;
     default:
       fprintf(fp,"<Unknown object tag. %d >",ob.tag);
       break;
@@ -225,20 +243,20 @@ FILE *fp;
     for (i=0; i<size; i++) {
       switch ((ta[i]).kind) {
       case ID:
-	fprintf(fp,"<<ID>>%s ",(ta[i]).token);
-	break;
+        fprintf(fp,"<<ID>>%s ",(ta[i]).token);
+        break;
       case EXECUTABLE_STRING:
-	fprintf(fp,"<<EXECUTABLE_STRING>>{%s} ",(ta[i]).token);
-	break;
+        fprintf(fp,"<<EXECUTABLE_STRING>>{%s} ",(ta[i]).token);
+        break;
       case EXECUTABLE_ARRAY:
-	printObject((ta[i]).object,nl,fp);
-	break;
+        printObject((ta[i]).object,nl,fp);
+        break;
       case DOLLAR:
-	fprintf(fp,"<<STRING(DOLLAR)>>%s ",(ta[i]).token);
-	break;
+        fprintf(fp,"<<STRING(DOLLAR)>>%s ",(ta[i]).token);
+        break;
       default:
-	fprintf(fp,"Unknown token type\n");
-	break;
+        fprintf(fp,"Unknown token type\n");
+        break;
       }
     }
     fprintf(fp," }");
@@ -265,7 +283,7 @@ FILE *fp;
     printObjectList(&ob);
     break;
   case Sfile:
-    fprintf(fp,"Name=%s, FILE *=%x ",ob.lc.str,(int) ob.rc.file);
+    fprintf(fp,"Name=%s, FILE *=%p ",ob.lc.str,ob.rc.file);
     break;
   case Sring:
     fprintf(fp,"Ring."); KshowRing(KopRingp(ob));
@@ -285,6 +303,9 @@ FILE *fp;
   case Sdouble:
     fprintf(fp,"%f",KopDouble(ob));
     break;
+  case SbyteArray:
+    printObject(byteArrayToArray(ob),nl,fp); /* Todo: I should save memory.*/
+    break;
   default:
     fprintf(fp,"[Unknown object tag.]");
     break;
@@ -293,14 +314,15 @@ FILE *fp;
 }
   
 void printObjectArray(ob,nl,fp)
-struct object ob;
-int nl;
-FILE *fp;
+     struct object ob;
+     int nl;
+     FILE *fp;
 {
   int size;
   int i;
+  extern char *LeftBracket, *RightBracket;
   size = ob.lc.ival;
-  fprintf(fp,"[  ");
+  fprintf(fp,"%s  ",LeftBracket);
   for (i=0; i<size; i++) {
     if (PrintComma && (i != 0)) {
       fprintf(fp," , ");
@@ -309,7 +331,7 @@ FILE *fp;
     }
     printObject((ob.rc.op)[i],0,fp);
   }
-  fprintf(fp," ] ");
+  fprintf(fp," %s ",RightBracket);
   if (nl) fprintf(fp,"\n");
 }
 
@@ -370,6 +392,8 @@ void  KdefinePrimitiveFunctions() {
   putPrimitiveFunction("system",Ssystem);
   putPrimitiveFunction("system_variable",Ssystem_variable);
   putPrimitiveFunction("test",Stest);
+  putPrimitiveFunction("tlimit",Stlimit);
+  putPrimitiveFunction("oxshell",Soxshell);
   putPrimitiveFunction("map",Smap);
   putPrimitiveFunction("to_records",Sto_records);
   putPrimitiveFunction("Usage",Susage);
@@ -402,40 +426,58 @@ void  KdefinePrimitiveFunctions() {
 }
 
 int executePrimitive(ob) 
-struct object ob;
+     struct object ob;
 {
-  struct object ob1;
-  struct object ob2;
-  struct object ob3;
-  struct object ob4;
-  struct object ob5;
-  struct object rob;
+  struct object ob1 = OINIT;
+  struct object ob2 = OINIT;
+  struct object ob3 = OINIT;
+  struct object ob4 = OINIT;
+  struct object ob5 = OINIT;
+  struct object rob = OINIT;
   struct object obArray[OB_ARRAY_MAX];
   struct object obArray2[OB_ARRAY_MAX];
   int size;
   int i,j,k,n;
   int status;
+  int infixOn;
+  struct tokens infixToken;
   struct tokens *tokenArray;
   struct tokens token;
   FILE *fp;
   char *fname;
   int rank;
-  struct object oMat;
+  struct object oMat = OINIT;
   static int timerStart = 1;
   static struct tms before, after;
   static time_t before_real, after_real;
-  struct object oInput;
+  struct object oInput = OINIT;
   char *str;
   int ccflag = 0;
   extern int KeepInput;
   extern int History;
   extern struct ring *CurrentRingp;
-  extern TimerOn;
+  extern int TimerOn;
+  extern int SecureMode;
+  extern int RestrictedMode;
 
+  infixOn = 0;
+
   if (DebugStack >= 2) {
     fprintf(Fstack,"In execute %d\n",ob.lc.ival); printOperandStack();
   }
 
+  if (RestrictedMode) {
+    switch(ob.lc.ival) {
+    case SleftBrace:
+    case SrightBrace:
+    case Sexec:
+      break;
+    default:
+      fprintf(stderr,"primitive No = %d : ", ob.lc.ival);
+      errorStackmachine("You cannot use this primitive in the RestrictedMode.\n");
+    }
+  }
+
   if (GotoP) return(0);
   switch (ob.lc.ival) {
     /* Postscript primitives :stack */
@@ -468,25 +510,30 @@ struct object ob;
       ob2 = peek(i+k);
       switch(ob2.tag) {
       case Sdollar: /* copy by value */
-	str = (char *)sGC_malloc(strlen(ob2.lc.str)+3);
-	if (str == (char *)NULL) errorStackmachine("No memory (copy)");
-	strcpy(str,ob2.lc.str);
-	Kpush(KpoString(str));
-	break;
+        str = (char *)sGC_malloc(strlen(ob2.lc.str)+3);
+        if (str == (char *)NULL) errorStackmachine("No memory (copy)");
+        strcpy(str,ob2.lc.str);
+        Kpush(KpoString(str));
+        break;
       case Spoly:
-	errorStackmachine("no pCopy (copy)");
-	break;
+        errorStackmachine("no pCopy (copy)");
+        break;
       case Sarray:
-	n = ob2.lc.ival;
-	ob3 = newObjectArray(n);
-	for (j=0; j<n; j++) {
-	  putoa(ob3,j,getoa(ob2,j));
-	}
-	Kpush(ob3);
-	break;
+        n = ob2.lc.ival;
+        ob3 = newObjectArray(n);
+        for (j=0; j<n; j++) {
+          putoa(ob3,j,getoa(ob2,j));
+        }
+        Kpush(ob3);
+        break;
+      case SbyteArray:
+        n = getByteArraySize(ob2);
+        ob3 = newByteArray(n,ob2);
+        Kpush(ob3);
+        break;
       default:
-	Kpush(ob2);
-	break;
+        Kpush(ob2);
+        break;
       }
       k++;
     }
@@ -508,9 +555,9 @@ struct object ob;
     }
     for (i=0; i<n; i++) {
       if (i < OB_ARRAY_MAX) {
-	obArray[i] = Kpop();
+        obArray[i] = Kpop();
       }else{
-	errorStackmachine("exceeded OB_ARRAY_MAX (roll)\n");
+        errorStackmachine("exceeded OB_ARRAY_MAX (roll)\n");
       }
     }
     for (i=0; i<n; i++) {
@@ -526,31 +573,36 @@ struct object ob;
 
     /* Postscript primitives :arithmetic */
   case Sadd:
-    ob1 = Kpop();
+    ob1 = Kpop();  
     ob2 = Kpop();
+    evalEA(ob1); evalEA(ob2);
     rob = KooAdd(ob1,ob2);
     Kpush(rob);
     break;
   case Ssub:
     ob2 = Kpop();
     ob1 = Kpop();
+    evalEA(ob1); evalEA(ob2);
     rob = KooSub(ob1,ob2);
     Kpush(rob);
     break;
   case Smult:
     ob2 = Kpop();
     ob1 = Kpop();
+    evalEA(ob1); evalEA(ob2);
     rob = KooMult(ob1,ob2);
     Kpush(rob);
     break;
   case Sidiv:
     ob2 = Kpop(); ob1 = Kpop();
+    evalEA(ob1); evalEA(ob2);
     rob = KooDiv(ob1,ob2);
     Kpush(rob);
     break;
 
   case Sdiv:
     ob2 = Kpop(); ob1 = Kpop();
+    evalEA(ob1); evalEA(ob2);
     rob = KooDiv2(ob1,ob2);
     Kpush(rob);
     break;
@@ -566,14 +618,14 @@ struct object ob;
     ob1 = peek(size);
     while (!(Osp-size-1 < 0)) { /* while the stack is not underflow */
       if (ob1.tag == SleftBraceTag) {
-	rob = newObjectArray(size);
-	for (i=0; i<size; i++) {
-	  (rob.rc.op)[i] = peek(size-1-i);
-	}
-	for (i=0; i<size+1; i++) {
-	  Kpop();
-	}
-	break;
+        rob = newObjectArray(size);
+        for (i=0; i<size; i++) {
+          (rob.rc.op)[i] = peek(size-1-i);
+        }
+        for (i=0; i<size+1; i++) {
+          Kpop();
+        }
+        break;
       }
       size++;
       ob1 = peek(size);
@@ -586,21 +638,7 @@ struct object ob;
     /* ob2               ob1 get     */
     ob1 = Kpop();
     ob2 = Kpop();
-    switch(ob2.tag) {
-    case Sarray: break;
-    default: errorStackmachine("Usage:get");
-    }
-    switch(ob1.tag) {
-    case Sinteger: break;
-    default: errorStackmachine("Usage:get");
-    }
-    i =ob1.lc.ival;
-    size = getoaSize(ob2);
-    if ((0 <= i) && (i<size)) {
-      Kpush(getoa(ob2,i));
-    }else{
-      errorStackmachine("Index is out of bound. (get)\n");
-    }
+    Kpush(Kget(ob2,ob1));
     break;
 
   case Sput:
@@ -609,30 +647,43 @@ struct object ob;
     /* Or;  [[a_00 ....] [a_10 ....] ....] [1 0] any put. MultiIndex. */
     ob1 = Kpop(); ob2 = Kpop(); ob3 = Kpop();
     switch(ob2.tag) {
+    case SuniversalNumber:
+      ob2 = Kto_int32(ob2); /* do not break and go to Sinteger */ 
     case Sinteger: 
       switch(ob3.tag) {
       case Sarray:
-	i = ob2.lc.ival;
-	size = getoaSize(ob3);
-	if ((0 <= i) && (i<size)) {
-	  getoa(ob3,i) = ob1;
-	}else{
-	  errorStackmachine("Index is out of bound. (put)\n");
-	}
-	break;
+        i = ob2.lc.ival;
+        size = getoaSize(ob3);
+        if ((0 <= i) && (i<size)) {
+          getoa(ob3,i) = ob1;
+        }else{
+          errorStackmachine("Index is out of bound. (put)\n");
+        }
+        break;
       case Sdollar:
-	i = ob2.lc.ival;
-	size = strlen(ob3.lc.str);
-	if ((0 <= i) && (i<size)) {
-	  if (ob1.tag == Sdollar) {
-	    (ob3.lc.str)[i] = (ob1.lc.str)[0];
-	  }else{
-	    (ob3.lc.str)[i] = ob1.lc.ival;
-	  }
-	}else{
-	  errorStackmachine("Index is out of bound. (put)\n");
-	}
-	break;
+        i = ob2.lc.ival;
+        size = strlen(ob3.lc.str);
+        if ((0 <= i) && (i<size)) {
+          if (ob1.tag == Sdollar) {
+            (ob3.lc.str)[i] = (ob1.lc.str)[0];
+          }else{
+            (ob3.lc.str)[i] = ob1.lc.ival;
+          }
+        }else{
+          errorStackmachine("Index is out of bound. (put)\n");
+        }
+        break;
+      case SbyteArray:
+        i = ob2.lc.ival;
+        size = getByteArraySize(ob3);
+        if ((0 <= i) && (i<size)) {
+		  if (ob1.tag != Sinteger) ob1 = Kto_int32(ob1);
+          if (ob1.tag != Sinteger) errorStackmachine("One can put only integer.\n");
+          KopByteArray(ob3)[i] = KopInteger(ob1);
+        }else{
+          errorStackmachine("Index is out of bound. (put)\n");
+        }
+        break;
       default: errorStackmachine("Usage:put");
       }
       break;
@@ -640,22 +691,23 @@ struct object ob;
       ob5 = ob3;
       n = getoaSize(ob2);
       for (i=0; i<n; i++) {
-	if (ob5.tag != Sarray)
-	  errorStackmachine("Object pointed by the multi-index is not array (put)\n");
-	ob4 = getoa(ob2,i);
-	if (ob4.tag != Sinteger)
-	  errorStackmachine("Index has to be an integer. (put)\n");
-	k = ob4.lc.ival;
-	size = getoaSize(ob5);
-	if ((0 <= k) && (k<size)) {
-	  if (i == n-1) {
-	    getoa(ob5,k) = ob1;
-	  }else{
-	    ob5 = getoa(ob5,k);
-	  }
-	}else{
-	  errorStackmachine("Index is out of bound for the multi-index. (put)\n");
-	}
+        if (ob5.tag != Sarray)
+          errorStackmachine("Object pointed by the multi-index is not array (put)\n");
+        ob4 = getoa(ob2,i);
+        if (ob4.tag == SuniversalNumber) ob4 = Kto_int32(ob4);
+        if (ob4.tag != Sinteger)
+          errorStackmachine("Index has to be an integer. (put)\n");
+        k = ob4.lc.ival;
+        size = getoaSize(ob5);
+        if ((0 <= k) && (k<size)) {
+          if (i == n-1) {
+            getoa(ob5,k) = ob1;
+          }else{
+            ob5 = getoa(ob5,k);
+          }
+        }else{
+          errorStackmachine("Index is out of bound for the multi-index. (put)\n");
+        }
       }
       break;
     default: errorStackmachine("Usage:put");
@@ -703,6 +755,9 @@ struct object ob;
     case Spoly:
       Kpush(KpoInteger(KpolyLength(KopPOLY(ob1))));
       break;
+    case SbyteArray:
+      Kpush(KpoInteger(getByteArraySize(ob1)));
+      break;
     default: errorStackmachine("Usage:length");
     }
     break;
@@ -744,20 +799,11 @@ struct object ob;
       errorStackmachine("Usage:loop");
       break;
     }
-    tokenArray = ob1.lc.tokenArray;
-    size = ob1.rc.ival;
-    i = 0;
     while (1) {
-      token = tokenArray[i];
-      /***printf("[token %d]%s\n",i,token.token);*/
-      i++;
-      if (i >= size) {
-	i=0;
-      }
-      status = executeToken(token);
-      if (status || GotoP) break;
+      status = executeExecutableArray(ob1,(char *)NULL,1);
+      if ((status & STATUS_BREAK) || GotoP) break;
       /* here, do not return 1. Do not propagate exit signal outside of the
-	 loop. */
+         loop. */
     }
     break;
 
@@ -789,32 +835,24 @@ struct object ob;
       inc = ob3.lc.ival;
       if (inc > 0) {
         /*
-	if (lim < i) errorStackmachine("The initial value must not be greater than limit value (for).\n"); 
+          if (lim < i) errorStackmachine("The initial value must not be greater than limit value (for).\n"); 
         */
-	for ( ; i<=lim; i += inc) {
-	  Kpush(KpoInteger(i));
-	  tokenArray = ob1.lc.tokenArray;
-	  size = ob1.rc.ival;
-	  for (j=0; j<size; j++) {
-	    status = executeToken(tokenArray[j]);
-	    if (status || GotoP) goto xyz;
-	  }
-	}
+        for ( ; i<=lim; i += inc) {
+          Kpush(KpoInteger(i));
+          status = executeExecutableArray(ob1,(char *)NULL,1);
+          if ((status & STATUS_BREAK) || GotoP) goto xyz;
+		}
       }else{
         /*
-	if (lim > i) errorStackmachine("The initial value must not be less than limit value (for).\n");
+          if (lim > i) errorStackmachine("The initial value must not be less than limit value (for).\n");
         */
-	for ( ; i>=lim; i += inc) {
-	  Kpush(KpoInteger(i));
-	  tokenArray = ob1.lc.tokenArray;
-	  size = ob1.rc.ival;
-	  for (j=0; j<size; j++) {
-	    status = executeToken(tokenArray[j]);
-	    if (status || GotoP) goto xyz;
-	  }
-	}
+        for ( ; i>=lim; i += inc) {
+          Kpush(KpoInteger(i));
+          status = executeExecutableArray(ob1,(char *)NULL,1);
+          if ((status & STATUS_BREAK) || GotoP) goto xyz;
+        }
       }
-      xyz:  ;
+    xyz:  ;
     }
     break;
 
@@ -833,44 +871,40 @@ struct object ob;
       break;
     }
     { int osize,size;
-      int i,j;
-      osize = getoaSize(ob1);
+    int i,j;
+    osize = getoaSize(ob1);
 
-      /*KSexecuteString("[");*/
-      rob.tag = SleftBraceTag;
-      Kpush(rob);
+    /*KSexecuteString("[");*/
+    rob.tag = SleftBraceTag;
+    Kpush(rob);
 
-      for (i=0; i<osize; i++) {
-	Kpush(getoa(ob1,i));
-	tokenArray = ob2.lc.tokenArray;
-	size = ob2.rc.ival;
-	for (j=0; j<size; j++) {
-	  status = executeToken(tokenArray[j]);
-	  if (status) goto foor;
-	}
-      }
+    for (i=0; i<osize; i++) {
+      Kpush(getoa(ob1,i));
+      status = executeExecutableArray(ob2,(char *)NULL,0);
+      if (status & STATUS_BREAK) goto foor;
+    }
     foor: ;
-      /*KSexecuteString("]");*/
-      {
-	size = 0;
-	ob1 = peek(size);
-	while (!(Osp-size-1 < 0)) { /* while the stack is not underflow */
-	  if (ob1.tag == SleftBraceTag) {
-	    rob = newObjectArray(size);
-	    for (i=0; i<size; i++) {
-	      (rob.rc.op)[i] = peek(size-1-i);
-	    }
-	    for (i=0; i<size+1; i++) {
-	      Kpop();
-	    }
-	    break;
-	  }
-	  size++;
-	  ob1 = peek(size);
-	}
-	Kpush(rob);
+    /*KSexecuteString("]");*/
+    {
+      size = 0;
+      ob1 = peek(size);
+      while (!(Osp-size-1 < 0)) { /* while the stack is not underflow */
+        if (ob1.tag == SleftBraceTag) {
+          rob = newObjectArray(size);
+          for (i=0; i<size; i++) {
+            (rob.rc.op)[i] = peek(size-1-i);
+          }
+          for (i=0; i<size+1; i++) {
+            Kpop();
+          }
+          break;
+        }
+        size++;
+        ob1 = peek(size);
       }
+      Kpush(rob);
     }
+    }
     break;
 
 
@@ -896,14 +930,9 @@ struct object ob;
       ob1 = ob2;
     }
     /* execute ob1 */
-    tokenArray = ob1.lc.tokenArray;
-    size = ob1.rc.ival;
-    for (i=0; i<size; i++) {
-      token = tokenArray[i];
-      status = executeToken(token);
-      if (status != 0) return(status);
-    }
-    
+    status = executeExecutableArray(ob1,(char *)NULL,0);
+    if (status & STATUS_BREAK) return(status);
+
     break;
 
   case Sexec:
@@ -913,17 +942,10 @@ struct object ob;
     case SexecutableArray: break;
     default: errorStackmachine("Usage:exec");
     }
-    tokenArray = ob1.lc.tokenArray;
-    size = ob1.rc.ival;
-    for (i=0; i<size; i++) {
-      token = tokenArray[i];
-      /***printf("[token %d]%s\n",i,token.token);*/
-      status = executeToken(token);
-      if (status != 0) break;
-    }
+	status = executeExecutableArray(ob1,(char *)NULL,0);
     break;
 
-   /* Postscript primitives :dictionary */    
+    /* Postscript primitives :dictionary */    
   case Sdef:
     ob2 = Kpop();
     ob1 = Kpop();
@@ -935,20 +957,20 @@ struct object ob;
       break;
     }
     k=putUserDictionary(ob1.lc.str,(ob1.rc.op->lc).ival,
-			(ob1.rc.op->rc).ival,ob2,
-			CurrentContextp->userDictionary);
+                        (ob1.rc.op->rc).ival,ob2,
+                        CurrentContextp->userDictionary);
     if (k < 0) {
       str = (char *)sGC_malloc(sizeof(char)*(strlen(ob1.lc.str) + 256));
       if (str == (char *)NULL) {
-	errorStackmachine("No memory.\n");
+        errorStackmachine("No memory.\n");
       }
       if (k == -PROTECT) {
-	sprintf(str,"You rewrited the protected symbol %s.\n",ob1.lc.str);
-	/*  cf. [(chattr) num sym] extension */
-	warningStackmachine(str);
+        sprintf(str,"You rewrited the protected symbol %s.\n",ob1.lc.str);
+        /*  cf. [(chattr) num sym] extension */
+        warningStackmachine(str);
       } else if (k == -ABSOLUTE_PROTECT) {
-	sprintf(str,"You cannot rewrite the protected symbol %s.\n",ob1.lc.str);
-	errorStackmachine(str);
+        sprintf(str,"You cannot rewrite the protected symbol %s.\n",ob1.lc.str);
+        errorStackmachine(str);
       } else errorStackmachine("Unknown return value of putUserDictioanry\n");
     }
     break;
@@ -960,9 +982,9 @@ struct object ob;
     default: errorStackmachine("Usage:load");
     }
     ob1 =  findUserDictionary(ob1.lc.str,
-			     (ob1.rc.op->lc).ival,
-			     (ob1.rc.op->rc).ival,
-			      CurrentContextp);
+                              (ob1.rc.op->lc).ival,
+                              (ob1.rc.op->rc).ival,
+                              CurrentContextp);
     if (ob1.tag == -1) Kpush(NullObject);
     else Kpush(ob1);
     
@@ -976,19 +998,19 @@ struct object ob;
     default: errorStackmachine("Usage:set");
     }
     k= putUserDictionary(ob1.lc.str,(ob1.rc.op->lc).ival,
-			 (ob1.rc.op->rc).ival,ob2,
-			 CurrentContextp->userDictionary);
+                         (ob1.rc.op->rc).ival,ob2,
+                         CurrentContextp->userDictionary);
     if (k < 0) {
       str = (char *)sGC_malloc(sizeof(char)*(strlen(ob1.lc.str) + 256));
       if (str == (char *)NULL) {
-	errorStackmachine("No memory.\n");
+        errorStackmachine("No memory.\n");
       }
       if (k == -PROTECT) {
-	sprintf(str,"You rewrited the protected symbol %s. \n",ob1.lc.str);
-	warningStackmachine(str);
+        sprintf(str,"You rewrited the protected symbol %s. \n",ob1.lc.str);
+        warningStackmachine(str);
       } else if (k == -ABSOLUTE_PROTECT) {
-	sprintf(str,"You cannot rewrite the protected symbol %s.\n",ob1.lc.str);
-	errorStackmachine(str);
+        sprintf(str,"You cannot rewrite the protected symbol %s.\n",ob1.lc.str);
+        errorStackmachine(str);
       } else errorStackmachine("Unknown return value of putUserDictioanry\n");
     }
     break;
@@ -1012,9 +1034,9 @@ struct object ob;
     switch(ob2.tag) {
     case Sdollar:
       if (ob1.tag != Sclass) {
-	rob = KdataConversion(ob1,ob2.lc.str);
+        rob = KdataConversion(ob1,ob2.lc.str);
       }else{
-	rob = KclassDataConversion(ob1,ob2);
+        rob = KclassDataConversion(ob1,ob2);
       }
       break;
     case Sarray:
@@ -1044,9 +1066,10 @@ struct object ob;
     break;
 
   case Sfileopen: /* filename  mode   file  descripter */
-              /* ob2       ob1  */
+    /* ob2       ob1  */
     ob1 = Kpop();
     ob2 = Kpop();
+    if (SecureMode) errorStackmachine("Security violation: you cannot open a file.");
     switch(ob1.tag) {
     case Sdollar: break;
     default: errorStackmachine("Usage:file");
@@ -1059,22 +1082,22 @@ struct object ob;
     rob = NullObject;
     if (ob2.tag == Sdollar) {
       if (strcmp(ob2.lc.str,"%stdin") == 0) {
-	rob.tag = Sfile; rob.lc.str="%stdin"; rob.rc.file = stdin;
+        rob.tag = Sfile; rob.lc.str="%stdin"; rob.rc.file = stdin;
       }else if (strcmp(ob2.lc.str,"%stdout") == 0) {
-	rob.tag = Sfile; rob.lc.str="%stdout"; rob.rc.file = stdout;
+        rob.tag = Sfile; rob.lc.str="%stdout"; rob.rc.file = stdout;
       }else if (strcmp(ob2.lc.str,"%stderr") == 0) {
-	rob.tag = Sfile; rob.lc.str="%stderr"; rob.rc.file = stderr;
+        rob.tag = Sfile; rob.lc.str="%stderr"; rob.rc.file = stderr;
       }else if ( (rob.rc.file = fopen(ob2.lc.str,ob1.lc.str)) != (FILE *)NULL) {
-	rob.tag = Sfile; rob.lc.str = ob2.lc.str;
+        rob.tag = Sfile; rob.lc.str = ob2.lc.str;
       }else {
-	errorStackmachine("I cannot open the file."); 
+        errorStackmachine("I cannot open the file."); 
       }
     }else {
       rob.rc.file = fdopen(ob2.lc.ival,ob1.lc.str);
       if ( rob.rc.file != (FILE *)NULL) {
-	rob.tag = Sfile; rob.lc.ival = ob2.lc.ival;
+        rob.tag = Sfile; rob.lc.ival = ob2.lc.ival;
       }else{
-	errorStackmachine("I cannot fdopen the given fd.");
+        errorStackmachine("I cannot fdopen the given fd.");
       }
     }
 
@@ -1111,7 +1134,7 @@ struct object ob;
     break;
 
   case Spushfile: /* filename pushfile  string */
-                  /* ob2       */
+    /* ob2       */
     ob2 = Kpop();
     switch(ob2.tag) {
     case Sdollar: break;
@@ -1128,35 +1151,35 @@ struct object ob;
       ob1.tag = Sfile; ob1.lc.str = ob2.lc.str;
     }else {
       if (ob1.rc.file == (FILE *)NULL) {
-	char fname2[1024];
-      	strcpy(fname2,getLOAD_SM1_PATH());
-	strcat(fname2,ob2.lc.str);
-	ob1.rc.file = fopen(fname2,"r");
-	if (ob1.rc.file == (FILE *)NULL) {
-	  strcpy(fname2,LOAD_SM1_PATH);
-	  strcat(fname2,ob2.lc.str);
-	  ob1.rc.file = fopen(fname2,"r");
-	  if (ob1.rc.file == (FILE *)NULL) {
-	    fprintf(stderr,"Warning: Cannot open the file <<%s>> for loading in the current directory nor the library directories %s and %s.\n",ob2.lc.str,getLOAD_SM1_PATH(),LOAD_SM1_PATH);
-	    errorStackmachine("I cannot open the file.");
-	  }
-	}
+        char fname2[1024];
+        strcpy(fname2,getLOAD_SM1_PATH());
+        strcat(fname2,ob2.lc.str);
+        ob1.rc.file = fopen(fname2,"r");
+        if (ob1.rc.file == (FILE *)NULL) {
+          strcpy(fname2,LOAD_SM1_PATH);
+          strcat(fname2,ob2.lc.str);
+          ob1.rc.file = fopen(fname2,"r");
+          if (ob1.rc.file == (FILE *)NULL) {
+            fprintf(stderr,"Warning: Cannot open the file <<%s>> for loading in the current directory nor the library directories %s and %s.\n",ob2.lc.str,getLOAD_SM1_PATH(),LOAD_SM1_PATH);
+            errorStackmachine("I cannot open the file.");
+          }
+        }
       }
     }
 
     /* read the strings
-    */
+     */
     n = 256; j=0;
     rob.tag = Sdollar; rob.lc.str = (char *) sGC_malloc(sizeof(char)*n);
     if (rob.lc.str == (char *)NULL) errorStackmachine("No more memory.");
     while ((i = fgetc(ob1.rc.file)) != EOF) {
       if (j >= n-1) {
-	n = 2*n;
-	if (n <= 0) errorStackmachine("Too large file to put on the stack.");
+        n = 2*n;
+        if (n <= 0) errorStackmachine("Too large file to put on the stack.");
         str = (char *)sGC_malloc(sizeof(char)*n);
-	if (str == (char *)NULL) errorStackmachine("No more memory.");
-	for (k=0; k< n/2; k++) str[k] = (rob.lc.str)[k];
-	rob.lc.str = str;
+        if (str == (char *)NULL) errorStackmachine("No more memory.");
+        for (k=0; k< n/2; k++) str[k] = (rob.lc.str)[k];
+        rob.lc.str = str;
       }
       (rob.lc.str)[j] = i; (rob.lc.str)[j+1] = '\0';
       j++;
@@ -1179,7 +1202,8 @@ struct object ob;
     case Sstring: break;
     default: errorStackmachine("Usage:system");
     }
-    system( ob1.lc.str );
+    if (SecureMode) errorStackmachine("Security violation.");
+    {int rr; rr=system( ob1.lc.str );}
     break;
 
   case Scat_n:
@@ -1194,7 +1218,7 @@ struct object ob;
       ob2 = peek(i);
       switch(ob2.tag) {
       case Sdollar: break;
-      default:	errorStackmachine("Usage:cat_n");
+      default:  errorStackmachine("Usage:cat_n");
       }
       k += strlen(ob2.lc.str);
     }
@@ -1227,12 +1251,12 @@ struct object ob;
       times(&after);
       after_real = time(&after_real);
       if (TimerOn) {
-	printf("User time: %f seconds, System time: %f seconds, Real time: %d s\n",
-	       ((double)(after.tms_utime - before.tms_utime)) /100.0,
-	       ((double)(after.tms_stime - before.tms_stime)) /100.0,
-	       (int) (after_real-before_real));
-	/* In cases of Solaris and Linux, the unit of tms_utime seems to
-	   be given 0.01 seconds. */
+        printf("User time: %f seconds, System time: %f seconds, Real time: %d s\n",
+               ((double)(after.tms_utime - before.tms_utime)) /100.0,
+               ((double)(after.tms_stime - before.tms_stime)) /100.0,
+               (int) (after_real-before_real));
+        /* In cases of Solaris and Linux, the unit of tms_utime seems to
+           be given 0.01 seconds. */
 
       }
       timerStart = 1; TimerOn = 0;
@@ -1275,6 +1299,7 @@ struct object ob;
     KsetOrderByObjArray(ob1);
     break;
   case Sset_up_ring:
+	KresetDegreeShift();
     ob5 = Kpop(); ob4=Kpop(); ob3=Kpop(); ob2=Kpop(); ob1=Kpop();
     KsetUpRing(ob1,ob2,ob3,ob4,ob5);
     break;
@@ -1352,8 +1377,17 @@ struct object ob;
     if (ob2.tag != Sarray) {
       Kpush(Khead(ob2));
     }else{
-      ob1 = Kpop();
-      Kpush(oInitW(ob1,ob2));
+      if (getoaSize(ob2) > 0) {
+        if (getoa(ob2,getoaSize(ob2)-1).tag == Spoly) {
+          Kpush(oInitW(ob2,newObjectArray(0)));
+        }else{
+          ob1 = Kpop();
+          Kpush(oInitW(ob1,ob2));
+        }
+      }else{
+        ob1 = Kpop();
+        Kpush(oInitW(ob1,ob2));
+      }
     }
     break;
 
@@ -1412,10 +1446,10 @@ struct object ob;
     switch (ob1.tag) {
     case Sclass:
       if (ClassTypes[ob1.lc.ival] == CLASS_OBJ) {
-	Kpush(*(ob1.rc.op));
+        Kpush(*(ob1.rc.op));
       }else{
-	warningStackmachine("<<obj rc >> works only for a class object with CLASS_OBJ attribute.\n");
-	Kpush(ob1);
+        warningStackmachine("<<obj rc >> works only for a class object with CLASS_OBJ attribute.\n");
+        Kpush(ob1);
       }
       break;
     default:
@@ -1430,7 +1464,7 @@ struct object ob;
     switch(ob1.tag) {
     case Sclass:
       if (ob2.tag == Sdollar) {
-	Kpush(KnewContext(ob1,KopString(ob2)));
+        Kpush(KnewContext(ob1,KopString(ob2)));
       }else  errorStackmachine("Usage:newcontext");
       break;
     default:
@@ -1475,11 +1509,11 @@ struct object ob;
     ccflag = 0;
     if (ob2.tag == Sarray ) {
       if (getoaSize(ob2) >= 1) {
-	ob3 = getoa(ob2,0);
-	if (ectag(ob3) == CLASSNAME_CONTEXT) {
-	  contextControl(CCPUSH); ccflag = 1; /* push the current context. */
-	  CurrentContextp = (struct context *)ecbody(ob3);
-	}
+        ob3 = getoa(ob2,0);
+        if (ectag(ob3) == CLASSNAME_CONTEXT) {
+          contextControl(CCPUSH); ccflag = 1; /* push the current context. */
+          CurrentContextp = (struct context *)ecbody(ob3);
+        }
       }
     }
     if (!ccflag) {
@@ -1488,17 +1522,12 @@ struct object ob;
     }
     /* normal exec. */ 
     Kpush(ob2);
-    tokenArray = ob1.lc.tokenArray;
-    size = ob1.rc.ival;
-    for (i=0; i<size; i++) {
-      token = tokenArray[i];
-      status = executeToken(token);
-      if (status != 0) break;
-    }
+    status = executeExecutableArray(ob1,(char *)NULL,0);
+
     if (ccflag) {
       contextControl(CCPOP); ccflag = 0; /* recover the Current context. */
     }
-    
+
     break;
   case Ssendmsg2:
     /* ob2 ob4 { .........} sendmsg2 */
@@ -1513,20 +1542,20 @@ struct object ob;
     ccflag = 0;
     if (ob2.tag == Sarray ) {
       if (getoaSize(ob2) >= 1) {
-	ob3 = getoa(ob2,0);
-	if (ectag(ob3) == CLASSNAME_CONTEXT) {
-	  contextControl(CCPUSH); ccflag = 1; /* push the current context. */
-	  CurrentContextp = (struct context *)ecbody(ob3);
-	}
+        ob3 = getoa(ob2,0);
+        if (ectag(ob3) == CLASSNAME_CONTEXT) {
+          contextControl(CCPUSH); ccflag = 1; /* push the current context. */
+          CurrentContextp = (struct context *)ecbody(ob3);
+        }
       }
     }
     if (!ccflag && ob4.tag == Sarray) {
       if (getoaSize(ob4) >= 1) {
-	ob3 = getoa(ob4,0);
-	if (ectag(ob3) == CLASSNAME_CONTEXT) {
-	  contextControl(CCPUSH); ccflag = 1; /* push the current context. */
-	  CurrentContextp = (struct context *)ecbody(ob3);
-	}
+        ob3 = getoa(ob4,0);
+        if (ectag(ob3) == CLASSNAME_CONTEXT) {
+          contextControl(CCPUSH); ccflag = 1; /* push the current context. */
+          CurrentContextp = (struct context *)ecbody(ob3);
+        }
       }
     }
     if (!ccflag) {
@@ -1535,12 +1564,57 @@ struct object ob;
     }
     /* normal exec. */ 
     Kpush(ob2); Kpush(ob4);
+
+    /* We cannot use executeExecutableArray(ob1,(char *)NULL) because of
+       the quote mode. Think about it later. */
     tokenArray = ob1.lc.tokenArray;
     size = ob1.rc.ival;
     for (i=0; i<size; i++) {
       token = tokenArray[i];
+      InSendmsg2 = 1;
       status = executeToken(token);
-      if (status != 0) break;
+      InSendmsg2 = 0;
+
+      if (status & STATUS_INFIX) {
+		if (status & DO_QUOTE) errorStackmachine("infix op with DO_QUOTE\n");
+        if (i == size-1) errorStackmachine("infix operator at the end(sendmsg2).\n");
+        infixOn = 1; infixToken = tokenArray[i];
+        infixToken.tflag |= NO_DELAY; continue;
+      }else if (infixOn) {
+        infixOn = 0; status = executeToken(infixToken);
+        if (status & STATUS_BREAK) break;
+      }
+
+      if (QuoteMode && (status & DO_QUOTE)) {
+        /* generate tree object, for kan/k0 */
+        struct object qob = OINIT;
+        struct object qattr = OINIT;
+        struct object qattr2 = OINIT;
+        if (i==0) { Kpop(); Kpop();}
+        qob = newObjectArray(3);
+        qattr = newObjectArray(1);
+        qattr2 = newObjectArray(2);
+		/* Set the node name of the tree. */
+        if (token.kind == ID) {
+          putoa(qob,0,KpoString(token.token));
+        }else{
+          putoa(qob,0,KpoString("unknown"));
+        }
+        /* Set the attibute list; class=className */
+        if (ob2.tag == Sdollar) {
+          putoa(qattr2,0,KpoString("cd"));
+          putoa(qattr2,1,ob2);
+        }else{
+          putoa(qattr2,0,KpoString("class"));
+          putoa(qattr2,1,KpoString(CurrentContextp->contextName));
+        }
+        putoa(qattr,0,qattr2);
+        putoa(qob,1,qattr);
+        putoa(qob,2,ob4);  /* Argument */
+        qob = KpoTree(qob);
+        Kpush(qob);
+      } else if (status & STATUS_BREAK) break;
+
     }
     if (ccflag) {
       contextControl(CCPOP); ccflag = 0;
@@ -1560,14 +1634,7 @@ struct object ob;
     contextControl(CCPUSH); ccflag = 1;
     CurrentContextp = PrimitiveContextp;
     /* normal exec. */ 
-    tokenArray = ob1.lc.tokenArray;
-    size = ob1.rc.ival;
-    for (i=0; i<size; i++) {
-      token = tokenArray[i];
-      status = executeToken(token);
-      if (status != 0) break;
-    }
-
+    status = executeExecutableArray(ob1,(char *)NULL,0);
     contextControl(CCPOP); /* recover the Current context. */
     break;
 
@@ -1584,26 +1651,26 @@ struct object ob;
     ccflag = 0;
     if (ob2.tag == Sarray ) {
       if (getoaSize(ob2) >= 1) {
-	ob3 = getoa(ob2,0);
-	if (ectag(ob3) == CLASSNAME_CONTEXT) {
-	  if (((struct context *)ecbody(ob3))->super == NULL) {
-	    errorStackmachine("supmsg2: SuperClass is NIL.");
-	  }
-	  contextControl(CCPUSH); ccflag = 1; /* push the current context. */
-	  CurrentContextp = ((struct context *)ecbody(ob3))->super;
-	}
+        ob3 = getoa(ob2,0);
+        if (ectag(ob3) == CLASSNAME_CONTEXT) {
+          if (((struct context *)ecbody(ob3))->super == NULL) {
+            errorStackmachine("supmsg2: SuperClass is NIL.");
+          }
+          contextControl(CCPUSH); ccflag = 1; /* push the current context. */
+          CurrentContextp = ((struct context *)ecbody(ob3))->super;
+        }
       }
     }
     if (!ccflag && (ob4.tag == Sarray) ) {
       if (getoaSize(ob4) >= 1) {
-	ob3 = getoa(ob4,0);
-	if (ectag(ob3) == CLASSNAME_CONTEXT) {
-	  if (((struct context *)ecbody(ob3))->super == NULL) {
-	    errorStackmachine("supmsg2: SuperClass is NIL.");
-	  }
-	  contextControl(CCPUSH); ccflag = 1; /* push the current context. */
-	  CurrentContextp = ((struct context *)ecbody(ob3))->super;
-	}
+        ob3 = getoa(ob4,0);
+        if (ectag(ob3) == CLASSNAME_CONTEXT) {
+          if (((struct context *)ecbody(ob3))->super == NULL) {
+            errorStackmachine("supmsg2: SuperClass is NIL.");
+          }
+          contextControl(CCPUSH); ccflag = 1; /* push the current context. */
+          CurrentContextp = ((struct context *)ecbody(ob3))->super;
+        }
       }
     }
     if (!ccflag) {
@@ -1612,13 +1679,7 @@ struct object ob;
     }
     /* normal exec. */ 
     Kpush(ob2); Kpush(ob4);
-    tokenArray = ob1.lc.tokenArray;
-    size = ob1.rc.ival;
-    for (i=0; i<size; i++) {
-      token = tokenArray[i];
-      status = executeToken(token);
-      if (status != 0) break;
-    }
+    status = executeExecutableArray(ob1,(char *)NULL,0);
     if (ccflag) {
       contextControl(CCPOP); ccflag = 0; /* recover the Current context. */
     }
@@ -1631,7 +1692,7 @@ struct object ob;
       /* compose error message */
       ob = Kpop();
       str = (char *) sGC_malloc(sizeof(char)*(strlen("error operator : ")+
-					      strlen(KopString(ob1))+ 10));
+                                              strlen(KopString(ob1))+ 10));
       if (str == NULL) errorStackmachine("No more memory.");
       strcpy(str,"error operator : ");
       strcat(str,KopString(ob1));
@@ -1659,13 +1720,51 @@ struct object ob;
     ob1 = Kpop();
     Kpush(hilberto(ob1,ob2));
     /*
-    {
-    ob1 = Kpop();
-    Kpush(test(ob1));
+      {
+      ob1 = Kpop();
+      Kpush(test(ob1));
 
-    }
+      }
     */
     break;
+
+  case Soxshell:
+    ob1 = Kpop();
+    Kpush(KoxShell(ob1));
+    break;
+
+  case Stlimit:
+    /* {   } time tlimit */
+    ob2 = Kpop();
+    ob1 = Kpop();
+    switch(ob2.tag) {
+	case Sinteger: break;
+	default: errorStackmachine("Usage:tlimit"); break;
+	}
+    switch(ob1.tag) {
+    case SexecutableArray: break;
+    default:
+      errorStackmachine("Usage:tlimit");
+      break;
+    }
+	n = ob2.lc.ival;
+	if (n > 0) {
+	  mysignal(SIGALRM,ctrlC); alarm((unsigned int) n);
+      status = executeExecutableArray(ob1,(char *)NULL,0);
+	  cancelAlarm();
+	}else{
+      before_real = time(&before_real);
+      times(&before);
+      status = executeExecutableArray(ob1,(char *)NULL,0);
+      times(&after);
+      after_real = time(&after_real);
+	  ob1 = newObjectArray(3);
+	  putoa(ob1,0,KpoInteger((int) after.tms_utime - before.tms_utime));
+	  putoa(ob1,1,KpoInteger((int) after.tms_stime - before.tms_stime));
+	  putoa(ob1,2,KpoInteger((int) (after_real-before_real)));
+	  Kpush(ob1);
+    }
+	break;
     
     
   default: