=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/primitive.c,v retrieving revision 1.1.1.1 retrieving revision 1.12 diff -u -p -r1.1.1.1 -r1.12 --- OpenXM/src/kan96xx/Kan/primitive.c 1999/10/08 02:12:02 1.1.1.1 +++ OpenXM/src/kan96xx/Kan/primitive.c 2004/09/11 01:00:42 1.12 @@ -1,7 +1,9 @@ +/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.11 2003/12/05 23:14:14 takayama Exp $ */ /* primitive.c */ /* The functions in this module were in stackmachine.c */ #include +#include #include "datatype.h" #include "stackm.h" #include "extern.h" @@ -12,6 +14,7 @@ int PrintDollar = 1; /* flag for printObject() */ int PrintComma = 1; /* flag for printObject() */ +int InSendmsg2 = 0; #define OB_ARRAY_MAX (AGLIMIT+100) extern int GotoP; @@ -22,18 +25,19 @@ extern int ClassTypes[]; /* kclass.c */ extern struct context *PrimitiveContextp; extern struct context *CurrentContextp; extern struct dictionary *SystemDictionary; +extern int QuoteMode; static char *operatorType(int i); static char *operatorType(type) -int type; + int type; { int i; - for (i=0; i>%s ",(ta[i]).token); - break; + fprintf(fp,"<>%s ",(ta[i]).token); + break; case EXECUTABLE_STRING: - fprintf(fp,"<>{%s} ",(ta[i]).token); - break; + fprintf(fp,"<>{%s} ",(ta[i]).token); + break; case EXECUTABLE_ARRAY: - printObject((ta[i]).object,nl,fp); - break; + printObject((ta[i]).object,nl,fp); + break; case DOLLAR: - fprintf(fp,"<>%s ",(ta[i]).token); - break; + fprintf(fp,"<>%s ",(ta[i]).token); + break; default: - fprintf(fp,"Unknown token type\n"); - break; + fprintf(fp,"Unknown token type\n"); + break; } } fprintf(fp," }"); @@ -293,14 +299,15 @@ FILE *fp; } void printObjectArray(ob,nl,fp) -struct object ob; -int nl; -FILE *fp; + struct object ob; + int nl; + FILE *fp; { int size; int i; + extern char *LeftBracket, *RightBracket; size = ob.lc.ival; - fprintf(fp,"[ "); + fprintf(fp,"%s ",LeftBracket); for (i=0; i= 2) { fprintf(Fstack,"In execute %d\n",ob.lc.ival); printOperandStack(); @@ -468,25 +478,25 @@ struct object ob; ob2 = peek(i+k); switch(ob2.tag) { case Sdollar: /* copy by value */ - str = (char *)sGC_malloc(strlen(ob2.lc.str)+3); - if (str == (char *)NULL) errorStackmachine("No memory (copy)"); - strcpy(str,ob2.lc.str); - Kpush(KpoString(str)); - break; + str = (char *)sGC_malloc(strlen(ob2.lc.str)+3); + if (str == (char *)NULL) errorStackmachine("No memory (copy)"); + strcpy(str,ob2.lc.str); + Kpush(KpoString(str)); + break; case Spoly: - errorStackmachine("no pCopy (copy)"); - break; + errorStackmachine("no pCopy (copy)"); + break; case Sarray: - n = ob2.lc.ival; - ob3 = newObjectArray(n); - for (j=0; j= size) { - i=0; + i=0; } status = executeToken(token); if (status || GotoP) break; /* here, do not return 1. Do not propagate exit signal outside of the - loop. */ + loop. */ } break; @@ -789,32 +785,32 @@ struct object ob; inc = ob3.lc.ival; if (inc > 0) { /* - if (lim < i) errorStackmachine("The initial value must not be greater than limit value (for).\n"); + if (lim < i) errorStackmachine("The initial value must not be greater than limit value (for).\n"); */ - for ( ; i<=lim; i += inc) { - Kpush(KpoInteger(i)); - tokenArray = ob1.lc.tokenArray; - size = ob1.rc.ival; - for (j=0; j i) errorStackmachine("The initial value must not be less than limit value (for).\n"); + if (lim > i) errorStackmachine("The initial value must not be less than limit value (for).\n"); */ - for ( ; i>=lim; i += inc) { - Kpush(KpoInteger(i)); - tokenArray = ob1.lc.tokenArray; - size = ob1.rc.ival; - for (j=0; j=lim; i += inc) { + Kpush(KpoInteger(i)); + tokenArray = ob1.lc.tokenArray; + size = ob1.rc.ival; + for (j=0; jlc).ival, - (ob1.rc.op->rc).ival,ob2, - CurrentContextp->userDictionary); + (ob1.rc.op->rc).ival,ob2, + CurrentContextp->userDictionary); if (k < 0) { str = (char *)sGC_malloc(sizeof(char)*(strlen(ob1.lc.str) + 256)); if (str == (char *)NULL) { - errorStackmachine("No memory.\n"); + errorStackmachine("No memory.\n"); } if (k == -PROTECT) { - sprintf(str,"You rewrited the protected symbol %s.\n",ob1.lc.str); - /* cf. [(chattr) num sym] extension */ - warningStackmachine(str); + sprintf(str,"You rewrited the protected symbol %s.\n",ob1.lc.str); + /* cf. [(chattr) num sym] extension */ + warningStackmachine(str); } else if (k == -ABSOLUTE_PROTECT) { - sprintf(str,"You cannot rewrite the protected symbol %s.\n",ob1.lc.str); - errorStackmachine(str); + sprintf(str,"You cannot rewrite the protected symbol %s.\n",ob1.lc.str); + errorStackmachine(str); } else errorStackmachine("Unknown return value of putUserDictioanry\n"); } break; @@ -960,9 +956,9 @@ struct object ob; default: errorStackmachine("Usage:load"); } ob1 = findUserDictionary(ob1.lc.str, - (ob1.rc.op->lc).ival, - (ob1.rc.op->rc).ival, - CurrentContextp); + (ob1.rc.op->lc).ival, + (ob1.rc.op->rc).ival, + CurrentContextp); if (ob1.tag == -1) Kpush(NullObject); else Kpush(ob1); @@ -976,19 +972,19 @@ struct object ob; default: errorStackmachine("Usage:set"); } k= putUserDictionary(ob1.lc.str,(ob1.rc.op->lc).ival, - (ob1.rc.op->rc).ival,ob2, - CurrentContextp->userDictionary); + (ob1.rc.op->rc).ival,ob2, + CurrentContextp->userDictionary); if (k < 0) { str = (char *)sGC_malloc(sizeof(char)*(strlen(ob1.lc.str) + 256)); if (str == (char *)NULL) { - errorStackmachine("No memory.\n"); + errorStackmachine("No memory.\n"); } if (k == -PROTECT) { - sprintf(str,"You rewrited the protected symbol %s. \n",ob1.lc.str); - warningStackmachine(str); + sprintf(str,"You rewrited the protected symbol %s. \n",ob1.lc.str); + warningStackmachine(str); } else if (k == -ABSOLUTE_PROTECT) { - sprintf(str,"You cannot rewrite the protected symbol %s.\n",ob1.lc.str); - errorStackmachine(str); + sprintf(str,"You cannot rewrite the protected symbol %s.\n",ob1.lc.str); + errorStackmachine(str); } else errorStackmachine("Unknown return value of putUserDictioanry\n"); } break; @@ -1012,9 +1008,9 @@ struct object ob; switch(ob2.tag) { case Sdollar: if (ob1.tag != Sclass) { - rob = KdataConversion(ob1,ob2.lc.str); + rob = KdataConversion(ob1,ob2.lc.str); }else{ - rob = KclassDataConversion(ob1,ob2); + rob = KclassDataConversion(ob1,ob2); } break; case Sarray: @@ -1044,9 +1040,10 @@ struct object ob; break; case Sfileopen: /* filename mode file descripter */ - /* ob2 ob1 */ + /* ob2 ob1 */ ob1 = Kpop(); ob2 = Kpop(); + if (SecureMode) errorStackmachine("Security violation: you cannot open a file."); switch(ob1.tag) { case Sdollar: break; default: errorStackmachine("Usage:file"); @@ -1059,22 +1056,22 @@ struct object ob; rob = NullObject; if (ob2.tag == Sdollar) { if (strcmp(ob2.lc.str,"%stdin") == 0) { - rob.tag = Sfile; rob.lc.str="%stdin"; rob.rc.file = stdin; + rob.tag = Sfile; rob.lc.str="%stdin"; rob.rc.file = stdin; }else if (strcmp(ob2.lc.str,"%stdout") == 0) { - rob.tag = Sfile; rob.lc.str="%stdout"; rob.rc.file = stdout; + rob.tag = Sfile; rob.lc.str="%stdout"; rob.rc.file = stdout; }else if (strcmp(ob2.lc.str,"%stderr") == 0) { - rob.tag = Sfile; rob.lc.str="%stderr"; rob.rc.file = stderr; + rob.tag = Sfile; rob.lc.str="%stderr"; rob.rc.file = stderr; }else if ( (rob.rc.file = fopen(ob2.lc.str,ob1.lc.str)) != (FILE *)NULL) { - rob.tag = Sfile; rob.lc.str = ob2.lc.str; + rob.tag = Sfile; rob.lc.str = ob2.lc.str; }else { - errorStackmachine("I cannot open the file."); + errorStackmachine("I cannot open the file."); } }else { rob.rc.file = fdopen(ob2.lc.ival,ob1.lc.str); if ( rob.rc.file != (FILE *)NULL) { - rob.tag = Sfile; rob.lc.ival = ob2.lc.ival; + rob.tag = Sfile; rob.lc.ival = ob2.lc.ival; }else{ - errorStackmachine("I cannot fdopen the given fd."); + errorStackmachine("I cannot fdopen the given fd."); } } @@ -1111,7 +1108,7 @@ struct object ob; break; case Spushfile: /* filename pushfile string */ - /* ob2 */ + /* ob2 */ ob2 = Kpop(); switch(ob2.tag) { case Sdollar: break; @@ -1128,35 +1125,35 @@ struct object ob; ob1.tag = Sfile; ob1.lc.str = ob2.lc.str; }else { if (ob1.rc.file == (FILE *)NULL) { - char fname2[1024]; - strcpy(fname2,getLOAD_SM1_PATH()); - strcat(fname2,ob2.lc.str); - ob1.rc.file = fopen(fname2,"r"); - if (ob1.rc.file == (FILE *)NULL) { - strcpy(fname2,LOAD_SM1_PATH); - strcat(fname2,ob2.lc.str); - ob1.rc.file = fopen(fname2,"r"); - if (ob1.rc.file == (FILE *)NULL) { - fprintf(stderr,"Warning: Cannot open the file <<%s>> for loading in the current directory nor the library directories %s and %s.\n",ob2.lc.str,getLOAD_SM1_PATH(),LOAD_SM1_PATH); - errorStackmachine("I cannot open the file."); - } - } + char fname2[1024]; + strcpy(fname2,getLOAD_SM1_PATH()); + strcat(fname2,ob2.lc.str); + ob1.rc.file = fopen(fname2,"r"); + if (ob1.rc.file == (FILE *)NULL) { + strcpy(fname2,LOAD_SM1_PATH); + strcat(fname2,ob2.lc.str); + ob1.rc.file = fopen(fname2,"r"); + if (ob1.rc.file == (FILE *)NULL) { + fprintf(stderr,"Warning: Cannot open the file <<%s>> for loading in the current directory nor the library directories %s and %s.\n",ob2.lc.str,getLOAD_SM1_PATH(),LOAD_SM1_PATH); + errorStackmachine("I cannot open the file."); + } + } } } /* read the strings - */ + */ n = 256; j=0; rob.tag = Sdollar; rob.lc.str = (char *) sGC_malloc(sizeof(char)*n); if (rob.lc.str == (char *)NULL) errorStackmachine("No more memory."); while ((i = fgetc(ob1.rc.file)) != EOF) { if (j >= n-1) { - n = 2*n; - if (n <= 0) errorStackmachine("Too large file to put on the stack."); + n = 2*n; + if (n <= 0) errorStackmachine("Too large file to put on the stack."); str = (char *)sGC_malloc(sizeof(char)*n); - if (str == (char *)NULL) errorStackmachine("No more memory."); - for (k=0; k< n/2; k++) str[k] = (rob.lc.str)[k]; - rob.lc.str = str; + if (str == (char *)NULL) errorStackmachine("No more memory."); + for (k=0; k< n/2; k++) str[k] = (rob.lc.str)[k]; + rob.lc.str = str; } (rob.lc.str)[j] = i; (rob.lc.str)[j+1] = '\0'; j++; @@ -1179,6 +1176,7 @@ struct object ob; case Sstring: break; default: errorStackmachine("Usage:system"); } + if (SecureMode) errorStackmachine("Security violation."); system( ob1.lc.str ); break; @@ -1194,7 +1192,7 @@ struct object ob; ob2 = peek(i); switch(ob2.tag) { case Sdollar: break; - default: errorStackmachine("Usage:cat_n"); + default: errorStackmachine("Usage:cat_n"); } k += strlen(ob2.lc.str); } @@ -1227,12 +1225,12 @@ struct object ob; times(&after); after_real = time(&after_real); if (TimerOn) { - printf("User time: %f seconds, System time: %f seconds, Real time: %d s\n", - ((double)(after.tms_utime - before.tms_utime)) /100.0, - ((double)(after.tms_stime - before.tms_stime)) /100.0, - (int) (after_real-before_real)); - /* In cases of Solaris and Linux, the unit of tms_utime seems to - be given 0.01 seconds. */ + printf("User time: %f seconds, System time: %f seconds, Real time: %d s\n", + ((double)(after.tms_utime - before.tms_utime)) /100.0, + ((double)(after.tms_stime - before.tms_stime)) /100.0, + (int) (after_real-before_real)); + /* In cases of Solaris and Linux, the unit of tms_utime seems to + be given 0.01 seconds. */ } timerStart = 1; TimerOn = 0; @@ -1275,6 +1273,7 @@ struct object ob; KsetOrderByObjArray(ob1); break; case Sset_up_ring: + KresetDegreeShift(); ob5 = Kpop(); ob4=Kpop(); ob3=Kpop(); ob2=Kpop(); ob1=Kpop(); KsetUpRing(ob1,ob2,ob3,ob4,ob5); break; @@ -1352,8 +1351,17 @@ struct object ob; if (ob2.tag != Sarray) { Kpush(Khead(ob2)); }else{ - ob1 = Kpop(); - Kpush(oInitW(ob1,ob2)); + if (getoaSize(ob2) > 0) { + if (getoa(ob2,getoaSize(ob2)-1).tag == Spoly) { + Kpush(oInitW(ob2,newObjectArray(0))); + }else{ + ob1 = Kpop(); + Kpush(oInitW(ob1,ob2)); + } + }else{ + ob1 = Kpop(); + Kpush(oInitW(ob1,ob2)); + } } break; @@ -1412,10 +1420,10 @@ struct object ob; switch (ob1.tag) { case Sclass: if (ClassTypes[ob1.lc.ival] == CLASS_OBJ) { - Kpush(*(ob1.rc.op)); + Kpush(*(ob1.rc.op)); }else{ - warningStackmachine("<> works only for a class object with CLASS_OBJ attribute.\n"); - Kpush(ob1); + warningStackmachine("<> works only for a class object with CLASS_OBJ attribute.\n"); + Kpush(ob1); } break; default: @@ -1430,7 +1438,7 @@ struct object ob; switch(ob1.tag) { case Sclass: if (ob2.tag == Sdollar) { - Kpush(KnewContext(ob1,KopString(ob2))); + Kpush(KnewContext(ob1,KopString(ob2))); }else errorStackmachine("Usage:newcontext"); break; default: @@ -1475,11 +1483,11 @@ struct object ob; ccflag = 0; if (ob2.tag == Sarray ) { if (getoaSize(ob2) >= 1) { - ob3 = getoa(ob2,0); - if (ectag(ob3) == CLASSNAME_CONTEXT) { - contextControl(CCPUSH); ccflag = 1; /* push the current context. */ - CurrentContextp = (struct context *)ecbody(ob3); - } + ob3 = getoa(ob2,0); + if (ectag(ob3) == CLASSNAME_CONTEXT) { + contextControl(CCPUSH); ccflag = 1; /* push the current context. */ + CurrentContextp = (struct context *)ecbody(ob3); + } } } if (!ccflag) { @@ -1513,20 +1521,20 @@ struct object ob; ccflag = 0; if (ob2.tag == Sarray ) { if (getoaSize(ob2) >= 1) { - ob3 = getoa(ob2,0); - if (ectag(ob3) == CLASSNAME_CONTEXT) { - contextControl(CCPUSH); ccflag = 1; /* push the current context. */ - CurrentContextp = (struct context *)ecbody(ob3); - } + ob3 = getoa(ob2,0); + if (ectag(ob3) == CLASSNAME_CONTEXT) { + contextControl(CCPUSH); ccflag = 1; /* push the current context. */ + CurrentContextp = (struct context *)ecbody(ob3); + } } } if (!ccflag && ob4.tag == Sarray) { if (getoaSize(ob4) >= 1) { - ob3 = getoa(ob4,0); - if (ectag(ob3) == CLASSNAME_CONTEXT) { - contextControl(CCPUSH); ccflag = 1; /* push the current context. */ - CurrentContextp = (struct context *)ecbody(ob3); - } + ob3 = getoa(ob4,0); + if (ectag(ob3) == CLASSNAME_CONTEXT) { + contextControl(CCPUSH); ccflag = 1; /* push the current context. */ + CurrentContextp = (struct context *)ecbody(ob3); + } } } if (!ccflag) { @@ -1539,8 +1547,38 @@ struct object ob; size = ob1.rc.ival; for (i=0; icontextName)); + } + putoa(qattr,0,qattr2); + putoa(qob,1,qattr); + putoa(qob,2,ob4); /* Argument */ + qob = KpoTree(qob); + Kpush(qob); + } else if (status != 0) break; } if (ccflag) { contextControl(CCPOP); ccflag = 0; @@ -1584,26 +1622,26 @@ struct object ob; ccflag = 0; if (ob2.tag == Sarray ) { if (getoaSize(ob2) >= 1) { - ob3 = getoa(ob2,0); - if (ectag(ob3) == CLASSNAME_CONTEXT) { - if (((struct context *)ecbody(ob3))->super == NULL) { - errorStackmachine("supmsg2: SuperClass is NIL."); - } - contextControl(CCPUSH); ccflag = 1; /* push the current context. */ - CurrentContextp = ((struct context *)ecbody(ob3))->super; - } + ob3 = getoa(ob2,0); + if (ectag(ob3) == CLASSNAME_CONTEXT) { + if (((struct context *)ecbody(ob3))->super == NULL) { + errorStackmachine("supmsg2: SuperClass is NIL."); + } + contextControl(CCPUSH); ccflag = 1; /* push the current context. */ + CurrentContextp = ((struct context *)ecbody(ob3))->super; + } } } if (!ccflag && (ob4.tag == Sarray) ) { if (getoaSize(ob4) >= 1) { - ob3 = getoa(ob4,0); - if (ectag(ob3) == CLASSNAME_CONTEXT) { - if (((struct context *)ecbody(ob3))->super == NULL) { - errorStackmachine("supmsg2: SuperClass is NIL."); - } - contextControl(CCPUSH); ccflag = 1; /* push the current context. */ - CurrentContextp = ((struct context *)ecbody(ob3))->super; - } + ob3 = getoa(ob4,0); + if (ectag(ob3) == CLASSNAME_CONTEXT) { + if (((struct context *)ecbody(ob3))->super == NULL) { + errorStackmachine("supmsg2: SuperClass is NIL."); + } + contextControl(CCPUSH); ccflag = 1; /* push the current context. */ + CurrentContextp = ((struct context *)ecbody(ob3))->super; + } } } if (!ccflag) { @@ -1631,7 +1669,7 @@ struct object ob; /* compose error message */ ob = Kpop(); str = (char *) sGC_malloc(sizeof(char)*(strlen("error operator : ")+ - strlen(KopString(ob1))+ 10)); + strlen(KopString(ob1))+ 10)); if (str == NULL) errorStackmachine("No more memory."); strcpy(str,"error operator : "); strcat(str,KopString(ob1)); @@ -1659,13 +1697,60 @@ struct object ob; ob1 = Kpop(); Kpush(hilberto(ob1,ob2)); /* - { - ob1 = Kpop(); - Kpush(test(ob1)); + { + ob1 = Kpop(); + Kpush(test(ob1)); - } + } */ break; + + case Soxshell: + ob1 = Kpop(); + Kpush(KoxShell(ob1)); + break; + + case Stlimit: + /* { } time tlimit */ + ob2 = Kpop(); + ob1 = Kpop(); + switch(ob2.tag) { + case Sinteger: break; + default: errorStackmachine("Usage:tlimit"); break; + } + switch(ob1.tag) { + case SexecutableArray: break; + default: + errorStackmachine("Usage:tlimit"); + break; + } + 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