=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/primitive.c,v retrieving revision 1.1.1.1 retrieving revision 1.26 diff -u -p -r1.1.1.1 -r1.26 --- OpenXM/src/kan96xx/Kan/primitive.c 1999/10/08 02:12:02 1.1.1.1 +++ OpenXM/src/kan96xx/Kan/primitive.c 2020/10/06 11:33:46 1.26 @@ -1,17 +1,26 @@ +/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.25 2018/09/07 00:15:44 takayama Exp $ */ /* primitive.c */ /* The functions in this module were in stackmachine.c */ #include +#include +#include +#include +#include +#include #include "datatype.h" #include "stackm.h" #include "extern.h" +#include "extern2.h" #include "gradedset.h" #include "kclass.h" #include #include +#include "mysig.h" 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,20 +31,24 @@ 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 "); break; + case SbyteArray: + fprintf(fp," "); + break; default: fprintf(fp,"",ob.tag); break; @@ -225,20 +243,20 @@ FILE *fp; 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," }"); @@ -265,7 +283,7 @@ FILE *fp; printObjectList(&ob); break; case Sfile: - fprintf(fp,"Name=%s, FILE *=%x ",ob.lc.str,(int) ob.rc.file); + fprintf(fp,"Name=%s, FILE *=%p ",ob.lc.str,ob.rc.file); break; case Sring: fprintf(fp,"Ring."); KshowRing(KopRingp(ob)); @@ -285,6 +303,9 @@ FILE *fp; case Sdouble: fprintf(fp,"%f",KopDouble(ob)); break; + case SbyteArray: + printObject(byteArrayToArray(ob),nl,fp); /* Todo: I should save memory.*/ + break; default: fprintf(fp,"[Unknown object tag.]"); break; @@ -293,14 +314,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(); } + 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); switch (ob.lc.ival) { /* Postscript primitives :stack */ @@ -468,25 +510,30 @@ 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; - } - status = executeToken(token); - if (status || GotoP) break; + status = executeExecutableArray(ob1,(char *)NULL,1); + if ((status & STATUS_BREAK) || GotoP) break; /* here, do not return 1. Do not propagate exit signal outside of the - loop. */ + loop. */ } break; @@ -789,32 +835,24 @@ 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)); + status = executeExecutableArray(ob1,(char *)NULL,1); + if ((status & STATUS_BREAK) || GotoP) goto xyz; + } } - xyz: ; + xyz: ; } break; @@ -833,44 +871,40 @@ struct object ob; break; } { int osize,size; - int i,j; - osize = getoaSize(ob1); + int i,j; + osize = getoaSize(ob1); - /*KSexecuteString("[");*/ - rob.tag = SleftBraceTag; - Kpush(rob); + /*KSexecuteString("[");*/ + rob.tag = SleftBraceTag; + Kpush(rob); - for (i=0; ilc).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 +982,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 +998,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 +1034,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 +1066,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 +1082,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 +1134,7 @@ struct object ob; break; case Spushfile: /* filename pushfile string */ - /* ob2 */ + /* ob2 */ ob2 = Kpop(); switch(ob2.tag) { case Sdollar: break; @@ -1128,35 +1151,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,7 +1202,8 @@ struct object ob; case Sstring: break; default: errorStackmachine("Usage:system"); } - system( ob1.lc.str ); + if (SecureMode) errorStackmachine("Security violation."); + {int rr; rr=system( ob1.lc.str );} break; case Scat_n: @@ -1194,7 +1218,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 +1251,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 +1299,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 +1377,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 +1446,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 +1464,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 +1509,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) { @@ -1488,17 +1522,12 @@ struct object ob; } /* normal exec. */ Kpush(ob2); - tokenArray = ob1.lc.tokenArray; - size = ob1.rc.ival; - for (i=0; i= 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) { @@ -1535,12 +1564,57 @@ struct object ob; } /* normal exec. */ Kpush(ob2); Kpush(ob4); + + /* We cannot use executeExecutableArray(ob1,(char *)NULL) because of + the quote mode. Think about it later. */ tokenArray = ob1.lc.tokenArray; 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 & STATUS_BREAK) break; + } if (ccflag) { contextControl(CCPOP); ccflag = 0; @@ -1560,14 +1634,7 @@ struct object ob; contextControl(CCPUSH); ccflag = 1; CurrentContextp = PrimitiveContextp; /* normal exec. */ - tokenArray = ob1.lc.tokenArray; - size = ob1.rc.ival; - for (i=0; i= 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) { @@ -1612,13 +1679,7 @@ struct object ob; } /* normal exec. */ Kpush(ob2); Kpush(ob4); - tokenArray = ob1.lc.tokenArray; - size = ob1.rc.ival; - for (i=0; i 0) { + mysignal(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: