[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.12

version 1.3, 2000/02/24 12:33:47 version 1.12, 2004/09/11 01:00:42
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.11 2003/12/05 23:14:14 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 <signal.h>
 #include "datatype.h"  #include "datatype.h"
 #include "stackm.h"  #include "stackm.h"
 #include "extern.h"  #include "extern.h"
Line 13 
Line 14 
   
 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 25  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");
 }  }
   
 /****** primitive functions *****************************************  /****** primitive functions *****************************************
Line 120  int type;
Line 123  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 226  FILE *fp;
Line 231  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 294  FILE *fp;
Line 299  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 377  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 411  void  KdefinePrimitiveFunctions() {
 }  }
   
 int executePrimitive(ob)  int executePrimitive(ob)
 struct object ob;       struct object ob;
 {  {
   struct object ob1;    struct object ob1;
   struct object ob2;    struct object ob2;
Line 471  struct object ob;
Line 478  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;
       default:        default:
         Kpush(ob2);          Kpush(ob2);
         break;          break;
       }        }
       k++;        k++;
     }      }
Line 511  struct object ob;
Line 518  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 569  struct object ob;
Line 576  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 596  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 615  struct object ob;
Line 608  struct object ob;
     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;
       default: errorStackmachine("Usage:put");        default: errorStackmachine("Usage:put");
       }        }
       break;        break;
Line 643  struct object ob;
Line 636  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 != Sinteger)
           errorStackmachine("Index has to be an integer. (put)\n");            errorStackmachine("Index has to be an integer. (put)\n");
         k = ob4.lc.ival;          k = ob4.lc.ival;
         size = getoaSize(ob5);          size = getoaSize(ob5);
         if ((0 <= k) && (k<size)) {          if ((0 <= k) && (k<size)) {
           if (i == n-1) {            if (i == n-1) {
             getoa(ob5,k) = ob1;              getoa(ob5,k) = ob1;
           }else{            }else{
             ob5 = getoa(ob5,k);              ob5 = getoa(ob5,k);
           }            }
         }else{          }else{
           errorStackmachine("Index is out of bound for the multi-index. (put)\n");            errorStackmachine("Index is out of bound for the multi-index. (put)\n");
         }          }
       }        }
       break;        break;
     default: errorStackmachine("Usage:put");      default: errorStackmachine("Usage:put");
Line 755  struct object ob;
Line 748  struct object ob;
       /***printf("[token %d]%s\n",i,token.token);*/        /***printf("[token %d]%s\n",i,token.token);*/
       i++;        i++;
       if (i >= size) {        if (i >= size) {
         i=0;          i=0;
       }        }
       status = executeToken(token);        status = executeToken(token);
       if (status || GotoP) break;        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 785  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;            tokenArray = ob1.lc.tokenArray;
           size = ob1.rc.ival;            size = ob1.rc.ival;
           for (j=0; j<size; j++) {            for (j=0; j<size; j++) {
             status = executeToken(tokenArray[j]);              status = executeToken(tokenArray[j]);
             if (status || GotoP) goto xyz;              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;            tokenArray = ob1.lc.tokenArray;
           size = ob1.rc.ival;            size = ob1.rc.ival;
           for (j=0; j<size; j++) {            for (j=0; j<size; j++) {
             status = executeToken(tokenArray[j]);              status = executeToken(tokenArray[j]);
             if (status || GotoP) goto xyz;              if (status || GotoP) goto xyz;
           }            }
         }          }
       }        }
       xyz:  ;      xyz:  ;
     }      }
     break;      break;
   
Line 836  struct object ob;
Line 829  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;        tokenArray = ob2.lc.tokenArray;
         size = ob2.rc.ival;        size = ob2.rc.ival;
         for (j=0; j<size; j++) {        for (j=0; j<size; j++) {
           status = executeToken(tokenArray[j]);          status = executeToken(tokenArray[j]);
           if (status) goto foor;          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 926  struct object ob;
Line 919  struct object ob;
     }      }
     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 931  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 956  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 972  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 1008  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 1040  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 1056  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 1108  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 1125  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 1176  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 1192  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 1225  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 1273  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 1351  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 1420  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 1438  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 1483  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 1518  struct object ob;
Line 1521  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 1544  struct object ob;
Line 1547  struct object ob;
     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 (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 */
           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 != 0) break;
     }      }
     if (ccflag) {      if (ccflag) {
       contextControl(CCPOP); ccflag = 0;        contextControl(CCPOP); ccflag = 0;
Line 1589  struct object ob;
Line 1622  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 1636  struct object ob;
Line 1669  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 1697  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;
       }
       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:    default:
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.12
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>