===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/primitive.c,v
retrieving revision 1.1
retrieving revision 1.8
diff -u -p -r1.1 -r1.8
--- OpenXM/src/kan96xx/Kan/primitive.c	1999/10/08 02:12:02	1.1
+++ OpenXM/src/kan96xx/Kan/primitive.c	2003/11/20 09:20:36	1.8
@@ -1,7 +1,9 @@
+/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.7 2003/08/24 05:19:43 takayama Exp $ */
 /*   primitive.c */
 /*  The functions in this module were in stackmachine.c */
 
 #include <stdio.h>
+#include <signal.h>
 #include "datatype.h"
 #include "stackm.h"
 #include "extern.h"
@@ -22,18 +24,19 @@ 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");
 }
 
 /****** primitive functions *****************************************
@@ -119,12 +122,13 @@ int type;
 #define Ssupmsg2 98
 #define Scclass 99
 #define Scoeff2 100
+#define Stlimit 101
 /***********************************************/
 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;
@@ -225,20 +229,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," }");
@@ -293,14 +297,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 +314,7 @@ FILE *fp;
     }
     printObject((ob.rc.op)[i],0,fp);
   }
-  fprintf(fp," ] ");
+  fprintf(fp," %s ",RightBracket);
   if (nl) fprintf(fp,"\n");
 }
 
@@ -370,6 +375,7 @@ void  KdefinePrimitiveFunctions() {
   putPrimitiveFunction("system",Ssystem);
   putPrimitiveFunction("system_variable",Ssystem_variable);
   putPrimitiveFunction("test",Stest);
+  putPrimitiveFunction("tlimit",Stlimit);
   putPrimitiveFunction("map",Smap);
   putPrimitiveFunction("to_records",Sto_records);
   putPrimitiveFunction("Usage",Susage);
@@ -402,7 +408,7 @@ void  KdefinePrimitiveFunctions() {
 }
 
 int executePrimitive(ob) 
-struct object ob;
+     struct object ob;
 {
   struct object ob1;
   struct object ob2;
@@ -431,6 +437,7 @@ struct object ob;
   extern int History;
   extern struct ring *CurrentRingp;
   extern TimerOn;
+  extern SecureMode;
 
   if (DebugStack >= 2) {
     fprintf(Fstack,"In execute %d\n",ob.lc.ival); printOperandStack();
@@ -468,25 +475,25 @@ 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;
       default:
-	Kpush(ob2);
-	break;
+        Kpush(ob2);
+        break;
       }
       k++;
     }
@@ -508,9 +515,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++) {
@@ -566,14 +573,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);
@@ -612,27 +619,27 @@ struct object ob;
     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;
       default: errorStackmachine("Usage:put");
       }
       break;
@@ -640,22 +647,22 @@ 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 != 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");
@@ -752,12 +759,12 @@ struct object ob;
       /***printf("[token %d]%s\n",i,token.token);*/
       i++;
       if (i >= size) {
-	i=0;
+        i=0;
       }
       status = executeToken(token);
       if (status || GotoP) break;
       /* here, do not return 1. Do not propagate exit signal outside of the
-	 loop. */
+         loop. */
     }
     break;
 
@@ -789,32 +796,32 @@ 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));
+          tokenArray = ob1.lc.tokenArray;
+          size = ob1.rc.ival;
+          for (j=0; j<size; j++) {
+            status = executeToken(tokenArray[j]);
+            if (status || 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));
+          tokenArray = ob1.lc.tokenArray;
+          size = ob1.rc.ival;
+          for (j=0; j<size; j++) {
+            status = executeToken(tokenArray[j]);
+            if (status || GotoP) goto xyz;
+          }
+        }
       }
-      xyz:  ;
+    xyz:  ;
     }
     break;
 
@@ -833,44 +840,44 @@ 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));
+      tokenArray = ob2.lc.tokenArray;
+      size = ob2.rc.ival;
+      for (j=0; j<size; j++) {
+        status = executeToken(tokenArray[j]);
+        if (status) 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;
 
 
@@ -923,7 +930,7 @@ struct object ob;
     }
     break;
 
-   /* Postscript primitives :dictionary */    
+    /* Postscript primitives :dictionary */    
   case Sdef:
     ob2 = Kpop();
     ob1 = Kpop();
@@ -935,20 +942,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 +967,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 +983,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 +1019,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 +1051,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 +1067,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 +1119,7 @@ struct object ob;
     break;
 
   case Spushfile: /* filename pushfile  string */
-                  /* ob2       */
+    /* ob2       */
     ob2 = Kpop();
     switch(ob2.tag) {
     case Sdollar: break;
@@ -1128,35 +1136,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,6 +1187,7 @@ struct object ob;
     case Sstring: break;
     default: errorStackmachine("Usage:system");
     }
+    if (SecureMode) errorStackmachine("Security violation.");
     system( ob1.lc.str );
     break;
 
@@ -1194,7 +1203,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 +1236,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 +1284,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 +1362,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 +1431,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 +1449,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 +1494,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) {
@@ -1513,20 +1532,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) {
@@ -1540,7 +1559,34 @@ struct object ob;
     for (i=0; i<size; i++) {
       token = tokenArray[i];
       status = executeToken(token);
-      if (status != 0) break;
+      if (QuoteMode && (status==DO_QUOTE)) {
+        /* generate tree object, for kan/k0 */
+        struct object qob;
+        struct object qattr;
+        struct object qattr2;
+        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 */
+        putoa(qattr2,0,KpoString("class"));
+        if (ob2.tag == Sdollar) {
+          putoa(qattr2,1,ob2);
+        }else{
+          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 != 0) break;
     }
     if (ccflag) {
       contextControl(CCPOP); ccflag = 0;
@@ -1584,26 +1630,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) {
@@ -1631,7 +1677,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 +1705,55 @@ struct object ob;
     ob1 = Kpop();
     Kpush(hilberto(ob1,ob2));
     /*
-    {
-    ob1 = Kpop();
-    Kpush(test(ob1));
+      {
+      ob1 = Kpop();
+      Kpush(test(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;
+    }
+    tokenArray = ob1.lc.tokenArray;
+    size = ob1.rc.ival;
+	n = ob2.lc.ival;
+    i = 0;
+	if (n > 0) {
+	  signal(SIGALRM,ctrlC); alarm((unsigned int) n);
+	  for (i=0; i<size; i++) {
+		token = tokenArray[i];
+		status = executeToken(token);
+	  }
+	  cancelAlarm();
+	}else{
+      before_real = time(&before_real);
+      times(&before);
+	  for (i=0; i<size; i++) {
+		token = tokenArray[i];
+		status = executeToken(token);
+	  }
+      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: