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

version 1.3, 2000/02/24 12:33:47 version 1.4, 2001/05/04 01:06:25
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.3 2000/02/24 12:33:47 takayama Exp $ */
 /*   primitive.c */  /*   primitive.c */
 /*  The functions in this module were in stackmachine.c */  /*  The functions in this module were in stackmachine.c */
   
Line 27  extern struct dictionary *SystemDictionary;
Line 27  extern struct dictionary *SystemDictionary;
 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 122  int type;
Line 122  int type;
 #define Scoeff2 100  #define Scoeff2 100
 /***********************************************/  /***********************************************/
 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 226  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 294  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 404  void  KdefinePrimitiveFunctions() {
Line 404  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 471  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 511  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 569  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 615  struct object ob;
Line 615  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 643  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 755  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 792  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 836  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 926  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 938  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 963  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 979  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 1015  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 1047  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 1063  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 1115  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 1132  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 1183  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 1199  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 1232  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 1417  struct object ob;
Line 1417  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 1435  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 1480  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 1518  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 1589  struct object ob;
Line 1589  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 1636  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 1664  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;
   
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>