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

Diff for /OpenXM/src/kan96xx/Kan/primitive.c between version 1.3 and 1.21

version 1.3, 2000/02/24 12:33:47 version 1.21, 2005/07/03 11:08:54
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.2 1999/11/07 13:24:19 takayama Exp $ */  /* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.20 2005/06/16 05:07:23 takayama Exp $ */
 /*   primitive.c */  /*   primitive.c */
 /*  The functions in this module were in stackmachine.c */  /*  The functions in this module were in stackmachine.c */
   
 #include <stdio.h>  #include <stdio.h>
   #include <stdlib.h>
   #include <string.h>
   #include <signal.h>
 #include "datatype.h"  #include "datatype.h"
 #include "stackm.h"  #include "stackm.h"
 #include "extern.h"  #include "extern.h"
Line 13 
Line 16 
   
 int PrintDollar = 1;         /* flag for printObject() */  int PrintDollar = 1;         /* flag for printObject() */
 int PrintComma  = 1;         /* flag for printObject() */  int PrintComma  = 1;         /* flag for printObject() */
   int InSendmsg2 = 0;
 #define OB_ARRAY_MAX   (AGLIMIT+100)  #define OB_ARRAY_MAX   (AGLIMIT+100)
   
 extern int GotoP;  extern int GotoP;
Line 23  extern int ClassTypes[];   /* kclass.c */
Line 27  extern int ClassTypes[];   /* kclass.c */
 extern struct context *PrimitiveContextp;  extern struct context *PrimitiveContextp;
 extern struct context *CurrentContextp;  extern struct context *CurrentContextp;
 extern struct dictionary *SystemDictionary;  extern struct dictionary *SystemDictionary;
   extern int QuoteMode;
   
 static char *operatorType(int i);  static char *operatorType(int i);
   
 static char *operatorType(type)  static char *operatorType(type)
 int type;       int type;
 { int i;  { int i;
   for (i=0; i<Sdp; i++) {   for (i=0; i<Sdp; i++) {
     if (type == (SystemDictionary[i]).obj.lc.ival) {     if (type == (SystemDictionary[i]).obj.lc.ival) {
       return((SystemDictionary[i]).key);       return((SystemDictionary[i]).key);
     }     }
   }   }
   return("Unknown operator");   return("Unknown operator");
 }  }
   
   #define evalEA(ob1) if (ob1.tag == SexecutableArray) {\
             executeExecutableArray(ob1,(char *)NULL,0); ob1 = Kpop();}
   
 /****** primitive functions *****************************************  /****** primitive functions *****************************************
   the values must be greater than 1. 0 is used for special purposes.*/    the values must be greater than 1. 0 is used for special purposes.*/
 #define Sadd              1  #define Sadd              1
Line 120  int type;
Line 128  int type;
 #define Ssupmsg2 98  #define Ssupmsg2 98
 #define Scclass 99  #define Scclass 99
 #define Scoeff2 100  #define Scoeff2 100
   #define Stlimit 101
   #define Soxshell 102
 /***********************************************/  /***********************************************/
 void printObject(ob,nl,fp)  void printObject(ob,nl,fp)
 struct object ob;       struct object ob;
 int nl;       int nl;
 FILE *fp;       FILE *fp;
 /* print the object on the top of the stack. */       /* print the object on the top of the stack. */
 {  {
   
   int size;    int size;
Line 192  FILE *fp;
Line 202  FILE *fp;
     case Sdouble:      case Sdouble:
       fprintf(fp,"<double> ");        fprintf(fp,"<double> ");
       break;        break;
       case SbyteArray:
         fprintf(fp,"<byteArray> ");
         break;
     default:      default:
       fprintf(fp,"<Unknown object tag. %d >",ob.tag);        fprintf(fp,"<Unknown object tag. %d >",ob.tag);
       break;        break;
Line 226  FILE *fp;
Line 239  FILE *fp;
     for (i=0; i<size; i++) {      for (i=0; i<size; i++) {
       switch ((ta[i]).kind) {        switch ((ta[i]).kind) {
       case ID:        case ID:
         fprintf(fp,"<<ID>>%s ",(ta[i]).token);          fprintf(fp,"<<ID>>%s ",(ta[i]).token);
         break;          break;
       case EXECUTABLE_STRING:        case EXECUTABLE_STRING:
         fprintf(fp,"<<EXECUTABLE_STRING>>{%s} ",(ta[i]).token);          fprintf(fp,"<<EXECUTABLE_STRING>>{%s} ",(ta[i]).token);
         break;          break;
       case EXECUTABLE_ARRAY:        case EXECUTABLE_ARRAY:
         printObject((ta[i]).object,nl,fp);          printObject((ta[i]).object,nl,fp);
         break;          break;
       case DOLLAR:        case DOLLAR:
         fprintf(fp,"<<STRING(DOLLAR)>>%s ",(ta[i]).token);          fprintf(fp,"<<STRING(DOLLAR)>>%s ",(ta[i]).token);
         break;          break;
       default:        default:
         fprintf(fp,"Unknown token type\n");          fprintf(fp,"Unknown token type\n");
         break;          break;
       }        }
     }      }
     fprintf(fp," }");      fprintf(fp," }");
Line 286  FILE *fp;
Line 299  FILE *fp;
   case Sdouble:    case Sdouble:
     fprintf(fp,"%f",KopDouble(ob));      fprintf(fp,"%f",KopDouble(ob));
     break;      break;
     case SbyteArray:
       printObject(byteArrayToArray(ob),nl,fp); /* Todo: I should save memory.*/
       break;
   default:    default:
     fprintf(fp,"[Unknown object tag.]");      fprintf(fp,"[Unknown object tag.]");
     break;      break;
Line 294  FILE *fp;
Line 310  FILE *fp;
 }  }
   
 void printObjectArray(ob,nl,fp)  void printObjectArray(ob,nl,fp)
 struct object ob;       struct object ob;
 int nl;       int nl;
 FILE *fp;       FILE *fp;
 {  {
   int size;    int size;
   int i;    int i;
Line 372  void  KdefinePrimitiveFunctions() {
Line 388  void  KdefinePrimitiveFunctions() {
   putPrimitiveFunction("system",Ssystem);    putPrimitiveFunction("system",Ssystem);
   putPrimitiveFunction("system_variable",Ssystem_variable);    putPrimitiveFunction("system_variable",Ssystem_variable);
   putPrimitiveFunction("test",Stest);    putPrimitiveFunction("test",Stest);
     putPrimitiveFunction("tlimit",Stlimit);
     putPrimitiveFunction("oxshell",Soxshell);
   putPrimitiveFunction("map",Smap);    putPrimitiveFunction("map",Smap);
   putPrimitiveFunction("to_records",Sto_records);    putPrimitiveFunction("to_records",Sto_records);
   putPrimitiveFunction("Usage",Susage);    putPrimitiveFunction("Usage",Susage);
Line 404  void  KdefinePrimitiveFunctions() {
Line 422  void  KdefinePrimitiveFunctions() {
 }  }
   
 int executePrimitive(ob)  int executePrimitive(ob)
 struct object ob;       struct object ob;
 {  {
   struct object ob1;    struct object ob1 = OINIT;
   struct object ob2;    struct object ob2 = OINIT;
   struct object ob3;    struct object ob3 = OINIT;
   struct object ob4;    struct object ob4 = OINIT;
   struct object ob5;    struct object ob5 = OINIT;
   struct object rob;    struct object rob = OINIT;
   struct object obArray[OB_ARRAY_MAX];    struct object obArray[OB_ARRAY_MAX];
   struct object obArray2[OB_ARRAY_MAX];    struct object obArray2[OB_ARRAY_MAX];
   int size;    int size;
   int i,j,k,n;    int i,j,k,n;
   int status;    int status;
     int infixOn;
     struct tokens infixToken;
   struct tokens *tokenArray;    struct tokens *tokenArray;
   struct tokens token;    struct tokens token;
   FILE *fp;    FILE *fp;
   char *fname;    char *fname;
   int rank;    int rank;
   struct object oMat;    struct object oMat = OINIT;
   static int timerStart = 1;    static int timerStart = 1;
   static struct tms before, after;    static struct tms before, after;
   static time_t before_real, after_real;    static time_t before_real, after_real;
   struct object oInput;    struct object oInput = OINIT;
   char *str;    char *str;
   int ccflag = 0;    int ccflag = 0;
   extern int KeepInput;    extern int KeepInput;
Line 434  struct object ob;
Line 454  struct object ob;
   extern struct ring *CurrentRingp;    extern struct ring *CurrentRingp;
   extern TimerOn;    extern TimerOn;
   extern SecureMode;    extern SecureMode;
     extern int RestrictedMode;
   
     infixOn = 0;
   
   if (DebugStack >= 2) {    if (DebugStack >= 2) {
     fprintf(Fstack,"In execute %d\n",ob.lc.ival); printOperandStack();      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);    if (GotoP) return(0);
   switch (ob.lc.ival) {    switch (ob.lc.ival) {
     /* Postscript primitives :stack */      /* Postscript primitives :stack */
Line 471  struct object ob;
Line 506  struct object ob;
       ob2 = peek(i+k);        ob2 = peek(i+k);
       switch(ob2.tag) {        switch(ob2.tag) {
       case Sdollar: /* copy by value */        case Sdollar: /* copy by value */
         str = (char *)sGC_malloc(strlen(ob2.lc.str)+3);          str = (char *)sGC_malloc(strlen(ob2.lc.str)+3);
         if (str == (char *)NULL) errorStackmachine("No memory (copy)");          if (str == (char *)NULL) errorStackmachine("No memory (copy)");
         strcpy(str,ob2.lc.str);          strcpy(str,ob2.lc.str);
         Kpush(KpoString(str));          Kpush(KpoString(str));
         break;          break;
       case Spoly:        case Spoly:
         errorStackmachine("no pCopy (copy)");          errorStackmachine("no pCopy (copy)");
         break;          break;
       case Sarray:        case Sarray:
         n = ob2.lc.ival;          n = ob2.lc.ival;
         ob3 = newObjectArray(n);          ob3 = newObjectArray(n);
         for (j=0; j<n; j++) {          for (j=0; j<n; j++) {
           putoa(ob3,j,getoa(ob2,j));            putoa(ob3,j,getoa(ob2,j));
         }          }
         Kpush(ob3);          Kpush(ob3);
         break;          break;
         case SbyteArray:
           n = getByteArraySize(ob2);
           ob3 = newByteArray(n,ob2);
           Kpush(ob3);
           break;
       default:        default:
         Kpush(ob2);          Kpush(ob2);
         break;          break;
       }        }
       k++;        k++;
     }      }
Line 511  struct object ob;
Line 551  struct object ob;
     }      }
     for (i=0; i<n; i++) {      for (i=0; i<n; i++) {
       if (i < OB_ARRAY_MAX) {        if (i < OB_ARRAY_MAX) {
         obArray[i] = Kpop();          obArray[i] = Kpop();
       }else{        }else{
         errorStackmachine("exceeded OB_ARRAY_MAX (roll)\n");          errorStackmachine("exceeded OB_ARRAY_MAX (roll)\n");
       }        }
     }      }
     for (i=0; i<n; i++) {      for (i=0; i<n; i++) {
Line 529  struct object ob;
Line 569  struct object ob;
   
     /* Postscript primitives :arithmetic */      /* Postscript primitives :arithmetic */
   case Sadd:    case Sadd:
     ob1 = Kpop();      ob1 = Kpop();
     ob2 = Kpop();      ob2 = Kpop();
       evalEA(ob1); evalEA(ob2);
     rob = KooAdd(ob1,ob2);      rob = KooAdd(ob1,ob2);
     Kpush(rob);      Kpush(rob);
     break;      break;
   case Ssub:    case Ssub:
     ob2 = Kpop();      ob2 = Kpop();
     ob1 = Kpop();      ob1 = Kpop();
       evalEA(ob1); evalEA(ob2);
     rob = KooSub(ob1,ob2);      rob = KooSub(ob1,ob2);
     Kpush(rob);      Kpush(rob);
     break;      break;
   case Smult:    case Smult:
     ob2 = Kpop();      ob2 = Kpop();
     ob1 = Kpop();      ob1 = Kpop();
       evalEA(ob1); evalEA(ob2);
     rob = KooMult(ob1,ob2);      rob = KooMult(ob1,ob2);
     Kpush(rob);      Kpush(rob);
     break;      break;
   case Sidiv:    case Sidiv:
     ob2 = Kpop(); ob1 = Kpop();      ob2 = Kpop(); ob1 = Kpop();
       evalEA(ob1); evalEA(ob2);
     rob = KooDiv(ob1,ob2);      rob = KooDiv(ob1,ob2);
     Kpush(rob);      Kpush(rob);
     break;      break;
   
   case Sdiv:    case Sdiv:
     ob2 = Kpop(); ob1 = Kpop();      ob2 = Kpop(); ob1 = Kpop();
       evalEA(ob1); evalEA(ob2);
     rob = KooDiv2(ob1,ob2);      rob = KooDiv2(ob1,ob2);
     Kpush(rob);      Kpush(rob);
     break;      break;
Line 569  struct object ob;
Line 614  struct object ob;
     ob1 = peek(size);      ob1 = peek(size);
     while (!(Osp-size-1 < 0)) { /* while the stack is not underflow */      while (!(Osp-size-1 < 0)) { /* while the stack is not underflow */
       if (ob1.tag == SleftBraceTag) {        if (ob1.tag == SleftBraceTag) {
         rob = newObjectArray(size);          rob = newObjectArray(size);
         for (i=0; i<size; i++) {          for (i=0; i<size; i++) {
           (rob.rc.op)[i] = peek(size-1-i);            (rob.rc.op)[i] = peek(size-1-i);
         }          }
         for (i=0; i<size+1; i++) {          for (i=0; i<size+1; i++) {
           Kpop();            Kpop();
         }          }
         break;          break;
       }        }
       size++;        size++;
       ob1 = peek(size);        ob1 = peek(size);
Line 589  struct object ob;
Line 634  struct object ob;
     /* ob2               ob1 get     */      /* ob2               ob1 get     */
     ob1 = Kpop();      ob1 = Kpop();
     ob2 = Kpop();      ob2 = Kpop();
     switch(ob2.tag) {      Kpush(Kget(ob2,ob1));
     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");  
     }  
     break;      break;
   
   case Sput:    case Sput:
Line 612  struct object ob;
Line 643  struct object ob;
     /* Or;  [[a_00 ....] [a_10 ....] ....] [1 0] any put. MultiIndex. */      /* Or;  [[a_00 ....] [a_10 ....] ....] [1 0] any put. MultiIndex. */
     ob1 = Kpop(); ob2 = Kpop(); ob3 = Kpop();      ob1 = Kpop(); ob2 = Kpop(); ob3 = Kpop();
     switch(ob2.tag) {      switch(ob2.tag) {
       case SuniversalNumber:
         ob2 = Kto_int32(ob2); /* do not break and go to Sinteger */
     case Sinteger:      case Sinteger:
       switch(ob3.tag) {        switch(ob3.tag) {
       case Sarray:        case Sarray:
         i = ob2.lc.ival;          i = ob2.lc.ival;
         size = getoaSize(ob3);          size = getoaSize(ob3);
         if ((0 <= i) && (i<size)) {          if ((0 <= i) && (i<size)) {
           getoa(ob3,i) = ob1;            getoa(ob3,i) = ob1;
         }else{          }else{
           errorStackmachine("Index is out of bound. (put)\n");            errorStackmachine("Index is out of bound. (put)\n");
         }          }
         break;          break;
       case Sdollar:        case Sdollar:
         i = ob2.lc.ival;          i = ob2.lc.ival;
         size = strlen(ob3.lc.str);          size = strlen(ob3.lc.str);
         if ((0 <= i) && (i<size)) {          if ((0 <= i) && (i<size)) {
           if (ob1.tag == Sdollar) {            if (ob1.tag == Sdollar) {
             (ob3.lc.str)[i] = (ob1.lc.str)[0];              (ob3.lc.str)[i] = (ob1.lc.str)[0];
           }else{            }else{
             (ob3.lc.str)[i] = ob1.lc.ival;              (ob3.lc.str)[i] = ob1.lc.ival;
           }            }
         }else{          }else{
           errorStackmachine("Index is out of bound. (put)\n");            errorStackmachine("Index is out of bound. (put)\n");
         }          }
         break;          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");        default: errorStackmachine("Usage:put");
       }        }
       break;        break;
Line 643  struct object ob;
Line 687  struct object ob;
       ob5 = ob3;        ob5 = ob3;
       n = getoaSize(ob2);        n = getoaSize(ob2);
       for (i=0; i<n; i++) {        for (i=0; i<n; i++) {
         if (ob5.tag != Sarray)          if (ob5.tag != Sarray)
           errorStackmachine("Object pointed by the multi-index is not array (put)\n");            errorStackmachine("Object pointed by the multi-index is not array (put)\n");
         ob4 = getoa(ob2,i);          ob4 = getoa(ob2,i);
         if (ob4.tag != Sinteger)          if (ob4.tag == SuniversalNumber) ob4 = Kto_int32(ob4);
           errorStackmachine("Index has to be an integer. (put)\n");          if (ob4.tag != Sinteger)
         k = ob4.lc.ival;            errorStackmachine("Index has to be an integer. (put)\n");
         size = getoaSize(ob5);          k = ob4.lc.ival;
         if ((0 <= k) && (k<size)) {          size = getoaSize(ob5);
           if (i == n-1) {          if ((0 <= k) && (k<size)) {
             getoa(ob5,k) = ob1;            if (i == n-1) {
           }else{              getoa(ob5,k) = ob1;
             ob5 = getoa(ob5,k);            }else{
           }              ob5 = getoa(ob5,k);
         }else{            }
           errorStackmachine("Index is out of bound for the multi-index. (put)\n");          }else{
         }            errorStackmachine("Index is out of bound for the multi-index. (put)\n");
           }
       }        }
       break;        break;
     default: errorStackmachine("Usage:put");      default: errorStackmachine("Usage:put");
Line 706  struct object ob;
Line 751  struct object ob;
     case Spoly:      case Spoly:
       Kpush(KpoInteger(KpolyLength(KopPOLY(ob1))));        Kpush(KpoInteger(KpolyLength(KopPOLY(ob1))));
       break;        break;
       case SbyteArray:
         Kpush(KpoInteger(getByteArraySize(ob1)));
         break;
     default: errorStackmachine("Usage:length");      default: errorStackmachine("Usage:length");
     }      }
     break;      break;
Line 747  struct object ob;
Line 795  struct object ob;
       errorStackmachine("Usage:loop");        errorStackmachine("Usage:loop");
       break;        break;
     }      }
     tokenArray = ob1.lc.tokenArray;  
     size = ob1.rc.ival;  
     i = 0;  
     while (1) {      while (1) {
       token = tokenArray[i];        status = executeExecutableArray(ob1,(char *)NULL,1);
       /***printf("[token %d]%s\n",i,token.token);*/        if ((status & STATUS_BREAK) || GotoP) break;
       i++;  
       if (i >= size) {  
         i=0;  
       }  
       status = executeToken(token);  
       if (status || GotoP) break;  
       /* here, do not return 1. Do not propagate exit signal outside of the        /* here, do not return 1. Do not propagate exit signal outside of the
          loop. */           loop. */
     }      }
     break;      break;
   
Line 792  struct object ob;
Line 831  struct object ob;
       inc = ob3.lc.ival;        inc = ob3.lc.ival;
       if (inc > 0) {        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) {          for ( ; i<=lim; i += inc) {
           Kpush(KpoInteger(i));            Kpush(KpoInteger(i));
           tokenArray = ob1.lc.tokenArray;            status = executeExecutableArray(ob1,(char *)NULL,1);
           size = ob1.rc.ival;            if ((status & STATUS_BREAK) || GotoP) goto xyz;
           for (j=0; j<size; j++) {                  }
             status = executeToken(tokenArray[j]);  
             if (status || GotoP) goto xyz;  
           }  
         }  
       }else{        }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) {          for ( ; i>=lim; i += inc) {
           Kpush(KpoInteger(i));            Kpush(KpoInteger(i));
           tokenArray = ob1.lc.tokenArray;            status = executeExecutableArray(ob1,(char *)NULL,1);
           size = ob1.rc.ival;            if ((status & STATUS_BREAK) || GotoP) goto xyz;
           for (j=0; j<size; j++) {          }
             status = executeToken(tokenArray[j]);  
             if (status || GotoP) goto xyz;  
           }  
         }  
       }        }
       xyz:  ;      xyz:  ;
     }      }
     break;      break;
   
Line 836  struct object ob;
Line 867  struct object ob;
       break;        break;
     }      }
     { int osize,size;      { int osize,size;
       int i,j;      int i,j;
       osize = getoaSize(ob1);      osize = getoaSize(ob1);
   
       /*KSexecuteString("[");*/      /*KSexecuteString("[");*/
       rob.tag = SleftBraceTag;      rob.tag = SleftBraceTag;
       Kpush(rob);      Kpush(rob);
   
       for (i=0; i<osize; i++) {      for (i=0; i<osize; i++) {
         Kpush(getoa(ob1,i));        Kpush(getoa(ob1,i));
         tokenArray = ob2.lc.tokenArray;        status = executeExecutableArray(ob2,(char *)NULL,0);
         size = ob2.rc.ival;        if (status & STATUS_BREAK) goto foor;
         for (j=0; j<size; j++) {      }
           status = executeToken(tokenArray[j]);  
           if (status) goto foor;  
         }  
       }  
     foor: ;      foor: ;
       /*KSexecuteString("]");*/      /*KSexecuteString("]");*/
       {      {
         size = 0;        size = 0;
         ob1 = peek(size);        ob1 = peek(size);
         while (!(Osp-size-1 < 0)) { /* while the stack is not underflow */        while (!(Osp-size-1 < 0)) { /* while the stack is not underflow */
           if (ob1.tag == SleftBraceTag) {          if (ob1.tag == SleftBraceTag) {
             rob = newObjectArray(size);            rob = newObjectArray(size);
             for (i=0; i<size; i++) {            for (i=0; i<size; i++) {
               (rob.rc.op)[i] = peek(size-1-i);              (rob.rc.op)[i] = peek(size-1-i);
             }            }
             for (i=0; i<size+1; i++) {            for (i=0; i<size+1; i++) {
               Kpop();              Kpop();
             }            }
             break;            break;
           }          }
           size++;          size++;
           ob1 = peek(size);          ob1 = peek(size);
         }  
         Kpush(rob);  
       }        }
         Kpush(rob);
     }      }
       }
     break;      break;
   
   
Line 899  struct object ob;
Line 926  struct object ob;
       ob1 = ob2;        ob1 = ob2;
     }      }
     /* execute ob1 */      /* execute ob1 */
     tokenArray = ob1.lc.tokenArray;      status = executeExecutableArray(ob1,(char *)NULL,0);
     size = ob1.rc.ival;      if (status & STATUS_BREAK) return(status);
     for (i=0; i<size; i++) {  
       token = tokenArray[i];  
       status = executeToken(token);  
       if (status != 0) return(status);  
     }  
   
     break;      break;
   
   case Sexec:    case Sexec:
Line 916  struct object ob;
Line 938  struct object ob;
     case SexecutableArray: break;      case SexecutableArray: break;
     default: errorStackmachine("Usage:exec");      default: errorStackmachine("Usage:exec");
     }      }
     tokenArray = ob1.lc.tokenArray;          status = executeExecutableArray(ob1,(char *)NULL,0);
     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;  
     }  
     break;      break;
   
    /* Postscript primitives :dictionary */      /* Postscript primitives :dictionary */
   case Sdef:    case Sdef:
     ob2 = Kpop();      ob2 = Kpop();
     ob1 = Kpop();      ob1 = Kpop();
Line 938  struct object ob;
Line 953  struct object ob;
       break;        break;
     }      }
     k=putUserDictionary(ob1.lc.str,(ob1.rc.op->lc).ival,      k=putUserDictionary(ob1.lc.str,(ob1.rc.op->lc).ival,
                         (ob1.rc.op->rc).ival,ob2,                          (ob1.rc.op->rc).ival,ob2,
                         CurrentContextp->userDictionary);                          CurrentContextp->userDictionary);
     if (k < 0) {      if (k < 0) {
       str = (char *)sGC_malloc(sizeof(char)*(strlen(ob1.lc.str) + 256));        str = (char *)sGC_malloc(sizeof(char)*(strlen(ob1.lc.str) + 256));
       if (str == (char *)NULL) {        if (str == (char *)NULL) {
         errorStackmachine("No memory.\n");          errorStackmachine("No memory.\n");
       }        }
       if (k == -PROTECT) {        if (k == -PROTECT) {
         sprintf(str,"You rewrited the protected symbol %s.\n",ob1.lc.str);          sprintf(str,"You rewrited the protected symbol %s.\n",ob1.lc.str);
         /*  cf. [(chattr) num sym] extension */          /*  cf. [(chattr) num sym] extension */
         warningStackmachine(str);          warningStackmachine(str);
       } else if (k == -ABSOLUTE_PROTECT) {        } else if (k == -ABSOLUTE_PROTECT) {
         sprintf(str,"You cannot rewrite the protected symbol %s.\n",ob1.lc.str);          sprintf(str,"You cannot rewrite the protected symbol %s.\n",ob1.lc.str);
         errorStackmachine(str);          errorStackmachine(str);
       } else errorStackmachine("Unknown return value of putUserDictioanry\n");        } else errorStackmachine("Unknown return value of putUserDictioanry\n");
     }      }
     break;      break;
Line 963  struct object ob;
Line 978  struct object ob;
     default: errorStackmachine("Usage:load");      default: errorStackmachine("Usage:load");
     }      }
     ob1 =  findUserDictionary(ob1.lc.str,      ob1 =  findUserDictionary(ob1.lc.str,
                              (ob1.rc.op->lc).ival,                                (ob1.rc.op->lc).ival,
                              (ob1.rc.op->rc).ival,                                (ob1.rc.op->rc).ival,
                               CurrentContextp);                                CurrentContextp);
     if (ob1.tag == -1) Kpush(NullObject);      if (ob1.tag == -1) Kpush(NullObject);
     else Kpush(ob1);      else Kpush(ob1);
   
Line 979  struct object ob;
Line 994  struct object ob;
     default: errorStackmachine("Usage:set");      default: errorStackmachine("Usage:set");
     }      }
     k= putUserDictionary(ob1.lc.str,(ob1.rc.op->lc).ival,      k= putUserDictionary(ob1.lc.str,(ob1.rc.op->lc).ival,
                          (ob1.rc.op->rc).ival,ob2,                           (ob1.rc.op->rc).ival,ob2,
                          CurrentContextp->userDictionary);                           CurrentContextp->userDictionary);
     if (k < 0) {      if (k < 0) {
       str = (char *)sGC_malloc(sizeof(char)*(strlen(ob1.lc.str) + 256));        str = (char *)sGC_malloc(sizeof(char)*(strlen(ob1.lc.str) + 256));
       if (str == (char *)NULL) {        if (str == (char *)NULL) {
         errorStackmachine("No memory.\n");          errorStackmachine("No memory.\n");
       }        }
       if (k == -PROTECT) {        if (k == -PROTECT) {
         sprintf(str,"You rewrited the protected symbol %s. \n",ob1.lc.str);          sprintf(str,"You rewrited the protected symbol %s. \n",ob1.lc.str);
         warningStackmachine(str);          warningStackmachine(str);
       } else if (k == -ABSOLUTE_PROTECT) {        } else if (k == -ABSOLUTE_PROTECT) {
         sprintf(str,"You cannot rewrite the protected symbol %s.\n",ob1.lc.str);          sprintf(str,"You cannot rewrite the protected symbol %s.\n",ob1.lc.str);
         errorStackmachine(str);          errorStackmachine(str);
       } else errorStackmachine("Unknown return value of putUserDictioanry\n");        } else errorStackmachine("Unknown return value of putUserDictioanry\n");
     }      }
     break;      break;
Line 1015  struct object ob;
Line 1030  struct object ob;
     switch(ob2.tag) {      switch(ob2.tag) {
     case Sdollar:      case Sdollar:
       if (ob1.tag != Sclass) {        if (ob1.tag != Sclass) {
         rob = KdataConversion(ob1,ob2.lc.str);          rob = KdataConversion(ob1,ob2.lc.str);
       }else{        }else{
         rob = KclassDataConversion(ob1,ob2);          rob = KclassDataConversion(ob1,ob2);
       }        }
       break;        break;
     case Sarray:      case Sarray:
Line 1047  struct object ob;
Line 1062  struct object ob;
     break;      break;
   
   case Sfileopen: /* filename  mode   file  descripter */    case Sfileopen: /* filename  mode   file  descripter */
               /* ob2       ob1  */      /* ob2       ob1  */
     ob1 = Kpop();      ob1 = Kpop();
     ob2 = Kpop();      ob2 = Kpop();
         if (SecureMode) errorStackmachine("Security violation: you cannot open a file.");      if (SecureMode) errorStackmachine("Security violation: you cannot open a file.");
     switch(ob1.tag) {      switch(ob1.tag) {
     case Sdollar: break;      case Sdollar: break;
     default: errorStackmachine("Usage:file");      default: errorStackmachine("Usage:file");
Line 1063  struct object ob;
Line 1078  struct object ob;
     rob = NullObject;      rob = NullObject;
     if (ob2.tag == Sdollar) {      if (ob2.tag == Sdollar) {
       if (strcmp(ob2.lc.str,"%stdin") == 0) {        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) {        }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) {        }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) {        }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 {        }else {
         errorStackmachine("I cannot open the file.");          errorStackmachine("I cannot open the file.");
       }        }
     }else {      }else {
       rob.rc.file = fdopen(ob2.lc.ival,ob1.lc.str);        rob.rc.file = fdopen(ob2.lc.ival,ob1.lc.str);
       if ( rob.rc.file != (FILE *)NULL) {        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{        }else{
         errorStackmachine("I cannot fdopen the given fd.");          errorStackmachine("I cannot fdopen the given fd.");
       }        }
     }      }
   
Line 1115  struct object ob;
Line 1130  struct object ob;
     break;      break;
   
   case Spushfile: /* filename pushfile  string */    case Spushfile: /* filename pushfile  string */
                   /* ob2       */      /* ob2       */
     ob2 = Kpop();      ob2 = Kpop();
     switch(ob2.tag) {      switch(ob2.tag) {
     case Sdollar: break;      case Sdollar: break;
Line 1132  struct object ob;
Line 1147  struct object ob;
       ob1.tag = Sfile; ob1.lc.str = ob2.lc.str;        ob1.tag = Sfile; ob1.lc.str = ob2.lc.str;
     }else {      }else {
       if (ob1.rc.file == (FILE *)NULL) {        if (ob1.rc.file == (FILE *)NULL) {
         char fname2[1024];          char fname2[1024];
         strcpy(fname2,getLOAD_SM1_PATH());          strcpy(fname2,getLOAD_SM1_PATH());
         strcat(fname2,ob2.lc.str);          strcat(fname2,ob2.lc.str);
         ob1.rc.file = fopen(fname2,"r");          ob1.rc.file = fopen(fname2,"r");
         if (ob1.rc.file == (FILE *)NULL) {          if (ob1.rc.file == (FILE *)NULL) {
           strcpy(fname2,LOAD_SM1_PATH);            strcpy(fname2,LOAD_SM1_PATH);
           strcat(fname2,ob2.lc.str);            strcat(fname2,ob2.lc.str);
           ob1.rc.file = fopen(fname2,"r");            ob1.rc.file = fopen(fname2,"r");
           if (ob1.rc.file == (FILE *)NULL) {            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);              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.");              errorStackmachine("I cannot open the file.");
           }            }
         }          }
       }        }
     }      }
   
     /* read the strings      /* read the strings
     */       */
     n = 256; j=0;      n = 256; j=0;
     rob.tag = Sdollar; rob.lc.str = (char *) sGC_malloc(sizeof(char)*n);      rob.tag = Sdollar; rob.lc.str = (char *) sGC_malloc(sizeof(char)*n);
     if (rob.lc.str == (char *)NULL) errorStackmachine("No more memory.");      if (rob.lc.str == (char *)NULL) errorStackmachine("No more memory.");
     while ((i = fgetc(ob1.rc.file)) != EOF) {      while ((i = fgetc(ob1.rc.file)) != EOF) {
       if (j >= n-1) {        if (j >= n-1) {
         n = 2*n;          n = 2*n;
         if (n <= 0) errorStackmachine("Too large file to put on the stack.");          if (n <= 0) errorStackmachine("Too large file to put on the stack.");
         str = (char *)sGC_malloc(sizeof(char)*n);          str = (char *)sGC_malloc(sizeof(char)*n);
         if (str == (char *)NULL) errorStackmachine("No more memory.");          if (str == (char *)NULL) errorStackmachine("No more memory.");
         for (k=0; k< n/2; k++) str[k] = (rob.lc.str)[k];          for (k=0; k< n/2; k++) str[k] = (rob.lc.str)[k];
         rob.lc.str = str;          rob.lc.str = str;
       }        }
       (rob.lc.str)[j] = i; (rob.lc.str)[j+1] = '\0';        (rob.lc.str)[j] = i; (rob.lc.str)[j+1] = '\0';
       j++;        j++;
Line 1183  struct object ob;
Line 1198  struct object ob;
     case Sstring: break;      case Sstring: break;
     default: errorStackmachine("Usage:system");      default: errorStackmachine("Usage:system");
     }      }
         if (SecureMode) errorStackmachine("Security violation.");      if (SecureMode) errorStackmachine("Security violation.");
     system( ob1.lc.str );      system( ob1.lc.str );
     break;      break;
   
Line 1199  struct object ob;
Line 1214  struct object ob;
       ob2 = peek(i);        ob2 = peek(i);
       switch(ob2.tag) {        switch(ob2.tag) {
       case Sdollar: break;        case Sdollar: break;
       default:  errorStackmachine("Usage:cat_n");        default:  errorStackmachine("Usage:cat_n");
       }        }
       k += strlen(ob2.lc.str);        k += strlen(ob2.lc.str);
     }      }
Line 1232  struct object ob;
Line 1247  struct object ob;
       times(&after);        times(&after);
       after_real = time(&after_real);        after_real = time(&after_real);
       if (TimerOn) {        if (TimerOn) {
         printf("User time: %f seconds, System time: %f seconds, Real time: %d s\n",          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_utime - before.tms_utime)) /100.0,
                ((double)(after.tms_stime - before.tms_stime)) /100.0,                 ((double)(after.tms_stime - before.tms_stime)) /100.0,
                (int) (after_real-before_real));                 (int) (after_real-before_real));
         /* In cases of Solaris and Linux, the unit of tms_utime seems to          /* In cases of Solaris and Linux, the unit of tms_utime seems to
            be given 0.01 seconds. */             be given 0.01 seconds. */
   
       }        }
       timerStart = 1; TimerOn = 0;        timerStart = 1; TimerOn = 0;
Line 1280  struct object ob;
Line 1295  struct object ob;
     KsetOrderByObjArray(ob1);      KsetOrderByObjArray(ob1);
     break;      break;
   case Sset_up_ring:    case Sset_up_ring:
           KresetDegreeShift();
     ob5 = Kpop(); ob4=Kpop(); ob3=Kpop(); ob2=Kpop(); ob1=Kpop();      ob5 = Kpop(); ob4=Kpop(); ob3=Kpop(); ob2=Kpop(); ob1=Kpop();
     KsetUpRing(ob1,ob2,ob3,ob4,ob5);      KsetUpRing(ob1,ob2,ob3,ob4,ob5);
     break;      break;
Line 1357  struct object ob;
Line 1373  struct object ob;
     if (ob2.tag != Sarray) {      if (ob2.tag != Sarray) {
       Kpush(Khead(ob2));        Kpush(Khead(ob2));
     }else{      }else{
       ob1 = Kpop();        if (getoaSize(ob2) > 0) {
       Kpush(oInitW(ob1,ob2));          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;      break;
   
Line 1417  struct object ob;
Line 1442  struct object ob;
     switch (ob1.tag) {      switch (ob1.tag) {
     case Sclass:      case Sclass:
       if (ClassTypes[ob1.lc.ival] == CLASS_OBJ) {        if (ClassTypes[ob1.lc.ival] == CLASS_OBJ) {
         Kpush(*(ob1.rc.op));          Kpush(*(ob1.rc.op));
       }else{        }else{
         warningStackmachine("<<obj rc >> works only for a class object with CLASS_OBJ attribute.\n");          warningStackmachine("<<obj rc >> works only for a class object with CLASS_OBJ attribute.\n");
         Kpush(ob1);          Kpush(ob1);
       }        }
       break;        break;
     default:      default:
Line 1435  struct object ob;
Line 1460  struct object ob;
     switch(ob1.tag) {      switch(ob1.tag) {
     case Sclass:      case Sclass:
       if (ob2.tag == Sdollar) {        if (ob2.tag == Sdollar) {
         Kpush(KnewContext(ob1,KopString(ob2)));          Kpush(KnewContext(ob1,KopString(ob2)));
       }else  errorStackmachine("Usage:newcontext");        }else  errorStackmachine("Usage:newcontext");
       break;        break;
     default:      default:
Line 1480  struct object ob;
Line 1505  struct object ob;
     ccflag = 0;      ccflag = 0;
     if (ob2.tag == Sarray ) {      if (ob2.tag == Sarray ) {
       if (getoaSize(ob2) >= 1) {        if (getoaSize(ob2) >= 1) {
         ob3 = getoa(ob2,0);          ob3 = getoa(ob2,0);
         if (ectag(ob3) == CLASSNAME_CONTEXT) {          if (ectag(ob3) == CLASSNAME_CONTEXT) {
           contextControl(CCPUSH); ccflag = 1; /* push the current context. */            contextControl(CCPUSH); ccflag = 1; /* push the current context. */
           CurrentContextp = (struct context *)ecbody(ob3);            CurrentContextp = (struct context *)ecbody(ob3);
         }          }
       }        }
     }      }
     if (!ccflag) {      if (!ccflag) {
Line 1493  struct object ob;
Line 1518  struct object ob;
     }      }
     /* normal exec. */      /* normal exec. */
     Kpush(ob2);      Kpush(ob2);
     tokenArray = ob1.lc.tokenArray;      status = executeExecutableArray(ob1,(char *)NULL,0);
     size = ob1.rc.ival;  
     for (i=0; i<size; i++) {  
       token = tokenArray[i];  
       status = executeToken(token);  
       if (status != 0) break;  
     }  
     if (ccflag) {      if (ccflag) {
       contextControl(CCPOP); ccflag = 0; /* recover the Current context. */        contextControl(CCPOP); ccflag = 0; /* recover the Current context. */
     }      }
   
     break;      break;
   case Ssendmsg2:    case Ssendmsg2:
     /* ob2 ob4 { .........} sendmsg2 */      /* ob2 ob4 { .........} sendmsg2 */
Line 1518  struct object ob;
Line 1538  struct object ob;
     ccflag = 0;      ccflag = 0;
     if (ob2.tag == Sarray ) {      if (ob2.tag == Sarray ) {
       if (getoaSize(ob2) >= 1) {        if (getoaSize(ob2) >= 1) {
         ob3 = getoa(ob2,0);          ob3 = getoa(ob2,0);
         if (ectag(ob3) == CLASSNAME_CONTEXT) {          if (ectag(ob3) == CLASSNAME_CONTEXT) {
           contextControl(CCPUSH); ccflag = 1; /* push the current context. */            contextControl(CCPUSH); ccflag = 1; /* push the current context. */
           CurrentContextp = (struct context *)ecbody(ob3);            CurrentContextp = (struct context *)ecbody(ob3);
         }          }
       }        }
     }      }
     if (!ccflag && ob4.tag == Sarray) {      if (!ccflag && ob4.tag == Sarray) {
       if (getoaSize(ob4) >= 1) {        if (getoaSize(ob4) >= 1) {
         ob3 = getoa(ob4,0);          ob3 = getoa(ob4,0);
         if (ectag(ob3) == CLASSNAME_CONTEXT) {          if (ectag(ob3) == CLASSNAME_CONTEXT) {
           contextControl(CCPUSH); ccflag = 1; /* push the current context. */            contextControl(CCPUSH); ccflag = 1; /* push the current context. */
           CurrentContextp = (struct context *)ecbody(ob3);            CurrentContextp = (struct context *)ecbody(ob3);
         }          }
       }        }
     }      }
     if (!ccflag) {      if (!ccflag) {
Line 1540  struct object ob;
Line 1560  struct object ob;
     }      }
     /* normal exec. */      /* normal exec. */
     Kpush(ob2); Kpush(ob4);      Kpush(ob2); Kpush(ob4);
   
       /* We cannot use executeExecutableArray(ob1,(char *)NULL) because of
          the quote mode. Think about it later. */
     tokenArray = ob1.lc.tokenArray;      tokenArray = ob1.lc.tokenArray;
     size = ob1.rc.ival;      size = ob1.rc.ival;
     for (i=0; i<size; i++) {      for (i=0; i<size; i++) {
       token = tokenArray[i];        token = tokenArray[i];
         InSendmsg2 = 1;
       status = executeToken(token);        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) {      if (ccflag) {
       contextControl(CCPOP); ccflag = 0;        contextControl(CCPOP); ccflag = 0;
Line 1565  struct object ob;
Line 1630  struct object ob;
     contextControl(CCPUSH); ccflag = 1;      contextControl(CCPUSH); ccflag = 1;
     CurrentContextp = PrimitiveContextp;      CurrentContextp = PrimitiveContextp;
     /* normal exec. */      /* normal exec. */
     tokenArray = ob1.lc.tokenArray;      status = executeExecutableArray(ob1,(char *)NULL,0);
     size = ob1.rc.ival;  
     for (i=0; i<size; i++) {  
       token = tokenArray[i];  
       status = executeToken(token);  
       if (status != 0) break;  
     }  
   
     contextControl(CCPOP); /* recover the Current context. */      contextControl(CCPOP); /* recover the Current context. */
     break;      break;
   
Line 1589  struct object ob;
Line 1647  struct object ob;
     ccflag = 0;      ccflag = 0;
     if (ob2.tag == Sarray ) {      if (ob2.tag == Sarray ) {
       if (getoaSize(ob2) >= 1) {        if (getoaSize(ob2) >= 1) {
         ob3 = getoa(ob2,0);          ob3 = getoa(ob2,0);
         if (ectag(ob3) == CLASSNAME_CONTEXT) {          if (ectag(ob3) == CLASSNAME_CONTEXT) {
           if (((struct context *)ecbody(ob3))->super == NULL) {            if (((struct context *)ecbody(ob3))->super == NULL) {
             errorStackmachine("supmsg2: SuperClass is NIL.");              errorStackmachine("supmsg2: SuperClass is NIL.");
           }            }
           contextControl(CCPUSH); ccflag = 1; /* push the current context. */            contextControl(CCPUSH); ccflag = 1; /* push the current context. */
           CurrentContextp = ((struct context *)ecbody(ob3))->super;            CurrentContextp = ((struct context *)ecbody(ob3))->super;
         }          }
       }        }
     }      }
     if (!ccflag && (ob4.tag == Sarray) ) {      if (!ccflag && (ob4.tag == Sarray) ) {
       if (getoaSize(ob4) >= 1) {        if (getoaSize(ob4) >= 1) {
         ob3 = getoa(ob4,0);          ob3 = getoa(ob4,0);
         if (ectag(ob3) == CLASSNAME_CONTEXT) {          if (ectag(ob3) == CLASSNAME_CONTEXT) {
           if (((struct context *)ecbody(ob3))->super == NULL) {            if (((struct context *)ecbody(ob3))->super == NULL) {
             errorStackmachine("supmsg2: SuperClass is NIL.");              errorStackmachine("supmsg2: SuperClass is NIL.");
           }            }
           contextControl(CCPUSH); ccflag = 1; /* push the current context. */            contextControl(CCPUSH); ccflag = 1; /* push the current context. */
           CurrentContextp = ((struct context *)ecbody(ob3))->super;            CurrentContextp = ((struct context *)ecbody(ob3))->super;
         }          }
       }        }
     }      }
     if (!ccflag) {      if (!ccflag) {
Line 1617  struct object ob;
Line 1675  struct object ob;
     }      }
     /* normal exec. */      /* normal exec. */
     Kpush(ob2); Kpush(ob4);      Kpush(ob2); Kpush(ob4);
     tokenArray = ob1.lc.tokenArray;      status = executeExecutableArray(ob1,(char *)NULL,0);
     size = ob1.rc.ival;  
     for (i=0; i<size; i++) {  
       token = tokenArray[i];  
       status = executeToken(token);  
       if (status != 0) break;  
     }  
     if (ccflag) {      if (ccflag) {
       contextControl(CCPOP); ccflag = 0; /* recover the Current context. */        contextControl(CCPOP); ccflag = 0; /* recover the Current context. */
     }      }
Line 1636  struct object ob;
Line 1688  struct object ob;
       /* compose error message */        /* compose error message */
       ob = Kpop();        ob = Kpop();
       str = (char *) sGC_malloc(sizeof(char)*(strlen("error operator : ")+        str = (char *) sGC_malloc(sizeof(char)*(strlen("error operator : ")+
                                               strlen(KopString(ob1))+ 10));                                                strlen(KopString(ob1))+ 10));
       if (str == NULL) errorStackmachine("No more memory.");        if (str == NULL) errorStackmachine("No more memory.");
       strcpy(str,"error operator : ");        strcpy(str,"error operator : ");
       strcat(str,KopString(ob1));        strcat(str,KopString(ob1));
Line 1664  struct object ob;
Line 1716  struct object ob;
     ob1 = Kpop();      ob1 = Kpop();
     Kpush(hilberto(ob1,ob2));      Kpush(hilberto(ob1,ob2));
     /*      /*
     {        {
     ob1 = Kpop();        ob1 = Kpop();
     Kpush(test(ob1));        Kpush(test(ob1));
   
     }        }
     */      */
     break;      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) {
             signal(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:    default:
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.21
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>