Annotation of OpenXM/src/k097/Replace/test.c, Revision 1.1
1.1 ! maekawa 1: /* stackmachin.c */
! 2:
! 3: #include <stdio.h>
! 4: #include "datatype.h"
! 5: #include "stackm.h"
! 6: #include "extern.h"
! 7: #include <signal.h>
! 8: #include <sys/types.h>
! 9: #include <sys/times.h>
! 10:
! 11:
! 12: #define OPERAND_STACK_SIZE 2000
! 13: #define SYSTEM_DICTIONARY_SIZE 200
! 14: #define USER_DICTIONARY_SIZE 1223
! 15: /* The value of USER_DICTIONARY_SIZE must be prime number, because of hashing
! 16: method */
! 17: #define OB_ARRAY_MAX (AGLIMIT+100)
! 18: #define ARGV_WORK_MAX (AGLIMIT+100)
! 19: #define EMPTY (char *)NULL
! 20:
! 21: /* global variables */
! 22: struct object OperandStack[OPERAND_STACK_SIZE];
! 23: int Osp = 0; /* OperandStack pointer */
! 24: struct dictionary SystemDictionary[SYSTEM_DICTIONARY_SIZE];
! 25: int Sdp = 0; /* SystemDictionary pointer */
! 26: struct dictionary UserDictionary[USER_DICTIONARY_SIZE];
! 27: int Udp = 0; /* UserDictionary pointer */
! 28:
! 29: int PrintDollar = 1; /* flag for printObject() */
! 30: int PrintComma = 1; /* flag for printObject() */
! 31: static struct object ObjTmp; /* for poor compiler */
! 32:
! 33: int StandardMacros = 1;
! 34: int StartAFile = 0;
! 35: char *StartFile;
! 36:
! 37:
! 38:
! 39: static char *SMacros =
! 40: #include "smacro.h"
! 41:
! 42: static isInteger(char *);
! 43: static strToInteger(char *);
! 44: static power(int s,int i);
! 45: static struct object pop(void);
! 46: static push(struct object);
! 47: static char *operatorType(int i);
! 48: static void pstack(void);
! 49: static struct object executableStringToExecutableArray(char *str);
! 50:
! 51: /****** primitive functions *****************************************
! 52: the values must be greater than 1. 0 is used for special purposes.*/
! 53: #define Sadd 1
! 54: #define Ssub 2
! 55: #define Smult 3
! 56: #define Sset_up_ring 4
! 57: #define Soptions 6
! 58: #define Sgroebner 7
! 59: #define Sdef 8
! 60: #define Spop 9
! 61: #define Sput 10
! 62: #define Sprint 11
! 63: #define Spstack 12
! 64: #define Sshow_ring 13
! 65: #define Sprint_options 14
! 66: #define Sshow_systemdictionary 15
! 67: #define Slength 16
! 68: #define Sfor 17
! 69: #define Sroll 18
! 70: #define Squit 19
! 71: #define Stest 20 /* this is used for test of new function*/
! 72: #define Ssyzygies 21
! 73: #define Sresolution 22
! 74: #define Sfileopen 23
! 75: #define Sclosefile 24
! 76: #define Sidiv 25
! 77: #define Sdup 26
! 78: #define Smap 27
! 79: #define Sreduction 28
! 80: #define Sreplace 29
! 81: #define SleftBrace 30 /* primitive [ */
! 82: #define SrightBrace 31 /* primitive ] */
! 83: #define Srun 32 /* run from a file */
! 84: #define Sloop 33
! 85: #define Saload 34
! 86: #define Sifelse 35
! 87: #define Sequal 36
! 88: #define Sexec 37
! 89: #define Sset 38
! 90: #define Sget 41
! 91: #define Scopy 43
! 92: #define Sindex 44
! 93: #define Ssystem 45
! 94: #define Shilbert 47
! 95: #define Sset_order_by_matrix 50
! 96: #define Sshow_user_dictionary 54
! 97: #define Selimination_order 55
! 98: #define Sswitch_function 58
! 99: #define Sprint_switch_status 59
! 100: #define Scat_n 62
! 101: #define Sless 63
! 102: #define Sgreater 64
! 103: #define Swritestring 66
! 104: #define Sset_timer 67
! 105: #define Sspol 68
! 106: #define Susage 69
! 107: #define Sto_records 70
! 108: #define Scoefficients 71
! 109: #define Ssystem_variable 72
! 110: #define Sdata_conversion 73
! 111: #define Sdegree 74
! 112: #define Sinit 75
! 113: #define Sload 76
! 114: #define Seval 77
! 115: #define Shomogenize 78
! 116: #define Sprincipal 79
! 117: #define Spushfile 80
! 118: /***********************************************/
! 119:
! 120: struct object * newObject()
! 121: {
! 122: struct object *r;
! 123: r = (struct object *)GC_malloc(sizeof(struct object));
! 124: if (r == (struct object *)NULL) errorStackmachine("No memory\n");
! 125: r->tag = 0;
! 126: (r->lc).ival = 0;
! 127: (r->rc).ival = 0;
! 128: return(r);
! 129: }
! 130:
! 131: struct object newObjectArray(size)
! 132: int size;
! 133: {
! 134: struct object rob;
! 135: struct object *op;
! 136: if (size < 0) return(NullObject);
! 137: if (size > 0) {
! 138: op = (struct object *)GC_malloc(size*sizeof(struct object));
! 139: if (op == (struct object *)NULL) errorStackmachine("No memory\n");
! 140: }else{
! 141: op = (struct object *)NULL;
! 142: }
! 143: rob.tag = Sarray;
! 144: rob.lc.ival = size;
! 145: rob.rc.op = op;
! 146: return(rob);
! 147: }
! 148:
! 149: isNullObject(obj)
! 150: struct object obj;
! 151: {
! 152: if (obj.tag == 0) return(1);
! 153: else return(0);
! 154: }
! 155:
! 156: int putSystemDictionary(str,ob)
! 157: char *str; /* key */
! 158: struct object ob; /* value */
! 159: {
! 160: int i;
! 161: int j;
! 162: int flag = 0;
! 163:
! 164: for (i = Sdp-1; i>=0; i--) {
! 165: /*printf("Add %d %s\n",i,str);*/
! 166: if (strcmp(str,(SystemDictionary[i]).key) > 0) {
! 167: for (j=Sdp-1; j>=i+1; j--) {
! 168: (SystemDictionary[j+1]).key = (SystemDictionary[j]).key;
! 169: (SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;
! 170: }
! 171: (SystemDictionary[i+1]).key = str;
! 172: (SystemDictionary[i+1]).obj = ob;
! 173: flag = 1;
! 174: break;
! 175: }
! 176: }
! 177: if (!flag) { /* str is the minimum element */
! 178: for (j=Sdp-1; j>=0; j--) {
! 179: (SystemDictionary[j+1]).key = (SystemDictionary[j]).key;
! 180: (SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;
! 181: }
! 182: (SystemDictionary[0]).key = str;
! 183: (SystemDictionary[0]).obj = ob;
! 184: }
! 185: Sdp++;
! 186: if (Sdp >= SYSTEM_DICTIONARY_SIZE) {
! 187: warningStackmachine("No space for system dictionary area.\n");
! 188: Sdp--;
! 189: return(-1);
! 190: }
! 191: return(Sdp-1);
! 192: }
! 193:
! 194: int findSystemDictionary(str)
! 195: /* only used for primitive functions */
! 196: /* returns 0, if there is no item. */
! 197: /* This function assumes that the dictionary is sorted by strcmp() */
! 198: char *str; /* key */
! 199: {
! 200: int first,last,rr,middle;
! 201:
! 202: /* binary search */
! 203: first = 0; last = Sdp-1;
! 204: while (1) {
! 205: if (first > last) {
! 206: return(0);
! 207: } else if (first == last) {
! 208: if (strcmp(str,(SystemDictionary[first]).key) == 0) {
! 209: return((SystemDictionary[first]).obj.lc.ival);
! 210: }else {
! 211: return(0);
! 212: }
! 213: } else if (last - first == 1) { /* This case is necessary */
! 214: if (strcmp(str,(SystemDictionary[first]).key) == 0) {
! 215: return((SystemDictionary[first]).obj.lc.ival);
! 216: }else if (strcmp(str,(SystemDictionary[last]).key) == 0) {
! 217: return((SystemDictionary[last]).obj.lc.ival);
! 218: }else return(0);
! 219: }
! 220:
! 221: middle = (first + last)/2;
! 222: rr = strcmp(str,(SystemDictionary[middle]).key);
! 223: if (rr < 0) { /* str < middle */
! 224: last = middle;
! 225: }else if (rr == 0) {
! 226: return((SystemDictionary[middle]).obj.lc.ival);
! 227: }else { /* str > middle */
! 228: first = middle;
! 229: }
! 230: }
! 231: }
! 232:
! 233: int putUserDictionary(str,h0,h1,ob)
! 234: char *str; /* key */
! 235: int h0,h1; /* Hash values of the key */
! 236: struct object ob; /* value */
! 237: {
! 238: int x;
! 239: x = h0;
! 240: if (str[0] == '\0') {
! 241: errorKan1("%s\n","putUserDictionary(): You are defining a value with the null key.");
! 242: }
! 243: while (1) {
! 244: if ((UserDictionary[x]).key == EMPTY) break;
! 245: if (strcmp((UserDictionary[x]).key,str) == 0) break;
! 246: x = (x+h1) % USER_DICTIONARY_SIZE;
! 247: if (x == h0) {
! 248: errorStackmachine("User dictionary is full. loop hashing.\n");
! 249: }
! 250: }
! 251: (UserDictionary[x]).key = str;
! 252: (UserDictionary[x]).obj = ob;
! 253: (UserDictionary[x]).h0 = h0;
! 254: (UserDictionary[x]).h1 = h1;
! 255: return(x);
! 256: }
! 257:
! 258: struct object findUserDictionary(str,h0,h1)
! 259: /* returns NoObject, if there is no item. */
! 260: char *str; /* key */
! 261: int h0,h1; /* The hashing values of the key. */
! 262: {
! 263: int x;
! 264: x = h0;
! 265: while (1) {
! 266: if ((UserDictionary[x]).key == EMPTY) return(NoObject);
! 267: /* if ((UserDictionary[x]).h1 != h1) return(NoObject); */
! 268: if (strcmp((UserDictionary[x]).key,str) == 0) {
! 269: return( (UserDictionary[x]).obj );
! 270: }
! 271: x = (x+h1) % USER_DICTIONARY_SIZE;
! 272: if (x == h0) {
! 273: errorStackmachine("User dictionary is full. loop hashing in findUserDictionary.\n");
! 274: }
! 275: }
! 276:
! 277: }
! 278:
! 279:
! 280: int putPrimitiveFunction(str,number)
! 281: char *str;
! 282: int number;
! 283: {
! 284: struct object ob;
! 285: ob.tag = Soperator;
! 286: ob.lc.ival = number;
! 287: return(putSystemDictionary(str,ob));
! 288: }
! 289:
! 290: struct tokens lookupTokens(t)
! 291: struct tokens t;
! 292: {
! 293: struct object *left;
! 294: struct object *right;
! 295: t.object.tag = Slist;
! 296: left = t.object.lc.op = newObject();
! 297: right = t.object.rc.op = newObject();
! 298: left->tag = Sinteger;
! 299: (left->lc).ival = hash0(t.token);
! 300: (left->rc).ival = hash1(t.token);
! 301: right->tag = Sinteger;
! 302: (right->lc).ival = findSystemDictionary(t.token);
! 303: return(t);
! 304: }
! 305:
! 306: struct object lookupLiteralString(s)
! 307: char *s; /* s must be a literal string */
! 308: {
! 309: struct object ob;
! 310: ob.tag = Slist;
! 311: ob.lc.op = newObject();
! 312: ob.rc.op = (struct object *)NULL;
! 313: ob.lc.op->tag = Sinteger;
! 314: (ob.lc.op->lc).ival = hash0(&(s[1]));
! 315: (ob.lc.op->rc).ival = hash1(&(s[1]));
! 316: return(ob);
! 317: }
! 318:
! 319:
! 320: int hash0(str)
! 321: char *str;
! 322: {
! 323: int h=0;
! 324: while (*str != '\0') {
! 325: h = ((h*128)+(*str)) % USER_DICTIONARY_SIZE;
! 326: str++;
! 327: }
! 328: return(h);
! 329: }
! 330:
! 331: int hash1(str)
! 332: char *str;
! 333: {
! 334: return(8-(str[0]%8));
! 335: }
! 336:
! 337: void hashInitialize(void)
! 338: {
! 339: int i;
! 340: for (i=0; i<USER_DICTIONARY_SIZE; i++) {
! 341: (UserDictionary[i]).key = EMPTY;
! 342: }
! 343: }
! 344:
! 345: static isInteger(str)
! 346: char *str;
! 347: {
! 348: int i;
! 349: int n;
! 350: int start;
! 351:
! 352: n = strlen(str);
! 353: if ((str[0] == '+') || (str[0] == '-'))
! 354: start = 1;
! 355: else
! 356: start = 0;
! 357: if (start >= n) return(0);
! 358:
! 359: for (i=start; i<n; i++) {
! 360: if (('0' <= str[i]) && (str[i] <= '9')) ;
! 361: else return(0);
! 362: }
! 363: return(1);
! 364: }
! 365:
! 366: static strToInteger(str)
! 367: char *str;
! 368: {
! 369: int i;
! 370: int n;
! 371: int r;
! 372: int start;
! 373:
! 374: if ((str[0] == '+') || (str[0] == '-'))
! 375: start = 1;
! 376: else
! 377: start = 0;
! 378: n = strlen(str);
! 379: r = 0;
! 380: for (i=n-1; i>=start ; i--) {
! 381: r += (int)(str[i]-'0') *power(10,n-1-i);
! 382: }
! 383: if (str[0] == '-') r = -r;
! 384: return(r);
! 385: }
! 386:
! 387: static power(s,i)
! 388: int s;
! 389: int i;
! 390: {
! 391: if (i == 0) return 1;
! 392: else return( s*power(s,i-1) );
! 393: }
! 394:
! 395: static push(ob)
! 396: struct object ob;
! 397: {
! 398: OperandStack[Osp++] = ob;
! 399: if (Osp >= OPERAND_STACK_SIZE) {
! 400: warningStackmachine("Operand stack overflow. \n");
! 401: Osp--;
! 402: return(-1);
! 403: }
! 404: return(0);
! 405: }
! 406:
! 407: static struct object pop()
! 408: {
! 409: if (Osp <= 0) {
! 410: return( NullObject );
! 411: }else{
! 412: return( OperandStack[--Osp]);
! 413: }
! 414: }
! 415:
! 416: struct object peek(k)
! 417: int k;
! 418: {
! 419: if ((Osp-k-1) < 0) {
! 420: return( NullObject );
! 421: }else{
! 422: return( OperandStack[Osp-k-1]);
! 423: }
! 424: }
! 425:
! 426: int isLiteral(str)
! 427: char *str;
! 428: {
! 429: if (strlen(str) <2) return(0);
! 430: else {
! 431: if ((str[0] == '/') && (str[1] != '/')) return(1);
! 432: else return(0);
! 433: }
! 434: }
! 435:
! 436: void printOperandStack() {
! 437: int i;
! 438: struct object ob;
! 439: int vs;
! 440: vs = VerboseStack; VerboseStack = 2;
! 441: for (i=Osp-1; i>=0; i--) {
! 442: fprintf(Fstack,"[%d] ",i);
! 443: ob = OperandStack[i];
! 444: printObject(ob,1,Fstack);
! 445: }
! 446: VerboseStack = vs;
! 447: }
! 448:
! 449:
! 450: void printObject(ob,nl,fp)
! 451: struct object ob;
! 452: int nl;
! 453: FILE *fp;
! 454: /* print the object on the top of the stack. */
! 455: {
! 456:
! 457: int size;
! 458: int i;
! 459: struct tokens *ta;
! 460:
! 461: if (VerboseStack >= 2) {
! 462: /*fprintf(fp,"@@@");*/
! 463: switch (ob.tag) {
! 464: case 0:
! 465: fprintf(fp,"<null> "); /* null object */
! 466: break;
! 467: case Sinteger:
! 468: fprintf(fp,"<integer> ");
! 469: break;
! 470: case Sstring:
! 471: fprintf(fp,"<literal-string> ");
! 472: break;
! 473: case Soperator:
! 474: fprintf(fp,"<operator> ");
! 475: break;
! 476: case Sdollar:
! 477: fprintf(fp,"<string(dollar)> ");
! 478: break;
! 479: case SexecutableArray:
! 480: fprintf(fp,"<executable array> ");
! 481: break;
! 482: case Sarray:
! 483: fprintf(fp,"<array> ");
! 484: break;
! 485: case SleftBraceTag:
! 486: fprintf(fp,"<leftBraceTag> ");
! 487: break;
! 488: case SrightBraceTag:
! 489: fprintf(fp,"<rightBraceTag> ");
! 490: break;
! 491: case Spoly:
! 492: fprintf(fp,"<poly> ");
! 493: break;
! 494: case SarrayOfPOLY:
! 495: fprintf(fp,"<arrayOfPOLY> ");
! 496: break;
! 497: case SmatrixOfPOLY:
! 498: fprintf(fp,"<matrixOfPOLY> ");
! 499: break;
! 500: case Slist:
! 501: fprintf(fp,"<list> ");
! 502: break;
! 503: case Sfile:
! 504: fprintf(fp,"<file> ");
! 505: break;
! 506: case Sring:
! 507: fprintf(fp,"<ring> ");
! 508: break;
! 509: default:
! 510: fprintf(fp,"<Unknown object tag. %d >",ob.tag);
! 511: break;
! 512: }
! 513: }
! 514: switch (ob.tag) {
! 515: case 0:
! 516: fprintf(fp,"%%[null]"); /* null object */
! 517: break;
! 518: case Sinteger:
! 519: fprintf(fp,"%d",ob.lc.ival);
! 520: break;
! 521: case Sstring:
! 522: fprintf(fp,"%s",ob.lc.str);
! 523: break;
! 524: case Soperator:
! 525: fprintf(fp,"%s %%[operator] ",operatorType(ob.lc.ival));
! 526: break;
! 527: case Sdollar:
! 528: if (PrintDollar == 2) {
! 529: fprintf(fp,"(%s)",ob.lc.str);
! 530: } else if (PrintDollar == 0 ) {
! 531: fprintf(fp,ob.lc.str);
! 532: } else {
! 533: fprintf(fp,"$%s$",ob.lc.str);
! 534: }
! 535: break;
! 536: case SexecutableArray:
! 537: size = ob.rc.ival;
! 538: ta = ob.lc.tokenArray;
! 539: fprintf(fp,"{ ");
! 540: for (i=0; i<size; i++) {
! 541: switch ((ta[i]).kind) {
! 542: case ID:
! 543: fprintf(fp,"<<ID>>%s ",(ta[i]).token);
! 544: break;
! 545: case EXECUTABLE_STRING:
! 546: fprintf(fp,"<<EXECUTABLE_STRING>>{%s} ",(ta[i]).token);
! 547: break;
! 548: case EXECUTABLE_ARRAY:
! 549: printObject((ta[i]).object,nl,fp);
! 550: break;
! 551: default:
! 552: fprintf(fp,"Unknown token type\n");
! 553: break;
! 554: }
! 555: }
! 556: fprintf(fp," }");
! 557: break;
! 558: case Sarray:
! 559: printObjectArray(ob,0,fp);
! 560: break;
! 561: case SleftBraceTag:
! 562: fprintf(fp,"[ ");
! 563: break;
! 564: case SrightBraceTag:
! 565: fprintf(fp,"] ");
! 566: break;
! 567: case Spoly:
! 568: fprintf(fp,"%s",KPOLYToString(ob.lc.poly));
! 569: break;
! 570: case SarrayOfPOLY:
! 571: fprintf(fp,"Sorry! The object arrayOfPOLY cannot be printed.");
! 572: break;
! 573: case SmatrixOfPOLY:
! 574: fprintf(fp,"Sorry! The object matrixOfPOLY cannot be printed.");
! 575: break;
! 576: case Slist:
! 577: printObjectList(&ob);
! 578: break;
! 579: case Sfile:
! 580: fprintf(fp,"Name=%s, FILE *=%x ",ob.lc.str,(int) ob.rc.file);
! 581: break;
! 582: case Sring:
! 583: fprintf(fp,"Ring."); KshowRing(KopRingp(ob));
! 584: break;
! 585: default:
! 586: fprintf(fp,"[Unknown object tag.]");
! 587: break;
! 588: }
! 589: if (nl) fprintf(fp,"\n");
! 590: }
! 591:
! 592:
! 593: void printObjectArray(ob,nl,fp)
! 594: struct object ob;
! 595: int nl;
! 596: FILE *fp;
! 597: {
! 598: int size;
! 599: int i;
! 600: size = ob.lc.ival;
! 601: fprintf(fp,"[ ");
! 602: for (i=0; i<size; i++) {
! 603: if (PrintComma && (i != 0)) {
! 604: fprintf(fp," , ");
! 605: }else{
! 606: fprintf(fp," ");
! 607: }
! 608: printObject((ob.rc.op)[i],0,fp);
! 609: }
! 610: fprintf(fp," ] ");
! 611: if (nl) fprintf(fp,"\n");
! 612: }
! 613:
! 614: static initSystemDictionary()
! 615: {
! 616: /* It is recommended to sort the follows for performance */
! 617: putPrimitiveFunction("mul",Smult);
! 618: putPrimitiveFunction("add",Sadd);
! 619: putPrimitiveFunction("sub",Ssub);
! 620: putPrimitiveFunction("lt",Sless);
! 621: putPrimitiveFunction("set",Sset);
! 622: putPrimitiveFunction("eq",Sequal);
! 623: putPrimitiveFunction("gt",Sgreater);
! 624: putPrimitiveFunction("QUIT",Squit);
! 625: putPrimitiveFunction("[",SleftBrace);
! 626: putPrimitiveFunction("]",SrightBrace);
! 627: putPrimitiveFunction("bye",Squit);
! 628: putPrimitiveFunction("length",Slength);
! 629: putPrimitiveFunction("for",Sfor);
! 630: putPrimitiveFunction("roll",Sroll);
! 631: putPrimitiveFunction("cat_n",Scat_n);
! 632: putPrimitiveFunction("coefficients",Scoefficients);
! 633: putPrimitiveFunction("copy",Scopy);
! 634: putPrimitiveFunction("data_conversion",Sdata_conversion);
! 635: putPrimitiveFunction("aload",Saload);
! 636: putPrimitiveFunction("def",Sdef);
! 637: putPrimitiveFunction("degree",Sdegree);
! 638: putPrimitiveFunction("elimination_order",Selimination_order);
! 639: putPrimitiveFunction("exec",Sexec);
! 640: putPrimitiveFunction("exit",Squit);
! 641: putPrimitiveFunction("get",Sget);
! 642: putPrimitiveFunction("groebner",Sgroebner);
! 643: putPrimitiveFunction("hilbert",Shilbert);
! 644: putPrimitiveFunction("ifelse",Sifelse);
! 645: putPrimitiveFunction("index",Sindex);
! 646: putPrimitiveFunction("dup",Sdup);
! 647: putPrimitiveFunction("init",Sinit);
! 648: putPrimitiveFunction("loop",Sloop);
! 649: putPrimitiveFunction("options",Soptions);
! 650: putPrimitiveFunction("pop",Spop);
! 651: putPrimitiveFunction("put",Sput);
! 652: putPrimitiveFunction("print",Sprint);
! 653: putPrimitiveFunction("pstack",Spstack);
! 654: putPrimitiveFunction("print_options",Sprint_options);
! 655: putPrimitiveFunction("print_switch_status",Sprint_switch_status);
! 656: putPrimitiveFunction("quit",Squit);
! 657: putPrimitiveFunction("file",Sfileopen);
! 658: putPrimitiveFunction("closefile",Sclosefile);
! 659: putPrimitiveFunction("idiv",Sidiv);
! 660: putPrimitiveFunction("reduction",Sreduction);
! 661: putPrimitiveFunction("replace",Sreplace);
! 662: putPrimitiveFunction("resolution",Sresolution);
! 663: putPrimitiveFunction("run",Srun);
! 664: putPrimitiveFunction("set_order_by_matrix",Sset_order_by_matrix);
! 665: putPrimitiveFunction("set_timer",Sset_timer);
! 666: putPrimitiveFunction("set_up_ring@",Sset_up_ring);
! 667: putPrimitiveFunction("show_ring",Sshow_ring);
! 668: putPrimitiveFunction("show_systemdictionary",Sshow_systemdictionary);
! 669: putPrimitiveFunction("show_user_dictionary",Sshow_user_dictionary);
! 670: putPrimitiveFunction("spol",Sspol);
! 671: putPrimitiveFunction("switch_function",Sswitch_function);
! 672: putPrimitiveFunction("system",Ssystem);
! 673: putPrimitiveFunction("system_variable",Ssystem_variable);
! 674: putPrimitiveFunction("syzygies",Ssyzygies);
! 675: putPrimitiveFunction("test",Stest);
! 676: putPrimitiveFunction("map",Smap);
! 677: putPrimitiveFunction("to_records",Sto_records);
! 678: putPrimitiveFunction("Usage",Susage);
! 679: putPrimitiveFunction("load",Sload);
! 680: putPrimitiveFunction("writestring",Swritestring);
! 681: putPrimitiveFunction("eval",Seval);
! 682: putPrimitiveFunction("homogenize",Shomogenize);
! 683: putPrimitiveFunction("principal",Sprincipal);
! 684: putPrimitiveFunction("pushfile",Spushfile);
! 685:
! 686: }
! 687:
! 688: static showSystemDictionary() {
! 689: int i;
! 690: int maxl;
! 691: char format[1000];
! 692: int nl;
! 693: maxl = 1;
! 694: for (i=0; i<Sdp; i++) {
! 695: if (strlen((SystemDictionary[i]).key) >maxl)
! 696: maxl = strlen((SystemDictionary[i]).key);
! 697: }
! 698: maxl += 3;
! 699: nl = 80/maxl;
! 700: if (nl < 2) nl = 2;
! 701: sprintf(format,"%%-%ds",maxl);
! 702: for (i=0; i<Sdp; i++) {
! 703: fprintf(Fstack,format,(SystemDictionary[i]).key);
! 704: if (i % nl == nl-1) fprintf(Fstack,"\n");
! 705: }
! 706: fprintf(Fstack,"\n");
! 707: }
! 708:
! 709: static showUserDictionary()
! 710: {
! 711: int i,j;
! 712: int maxl;
! 713: char format[1000];
! 714: int nl;
! 715: maxl = 1;
! 716: for (i=0; i<USER_DICTIONARY_SIZE; i++) {
! 717: if ((UserDictionary[i]).key != EMPTY) {
! 718: if (strlen((UserDictionary[i]).key) >maxl)
! 719: maxl = strlen((UserDictionary[i]).key);
! 720: }
! 721: }
! 722: maxl += 3;
! 723: nl = 80/maxl;
! 724: if (nl < 2) nl = 2;
! 725: sprintf(format,"%%-%ds",maxl);
! 726: for (i=0,j=0; i<USER_DICTIONARY_SIZE; i++) {
! 727: if ((UserDictionary[i]).key != EMPTY) {
! 728: fprintf(Fstack,format,(UserDictionary[i]).key);
! 729: /*{ char *sss; int ii,h0,h1;
! 730: sss = UserDictionary[i].key;
! 731: h0 = UserDictionary[i].h0;
! 732: h1 = UserDictionary[i].h1;
! 733: for (ii=0; ii<strlen(sss); ii++) fprintf(Fstack,"%x ",sss[ii]);
! 734: fprintf(Fstack,": h0=%d, h1=%d, %d\n",h0,h1,i);
! 735: }*/
! 736: if (j % nl == nl-1) fprintf(Fstack,"\n");
! 737: j++;
! 738: }
! 739: }
! 740: fprintf(Fstack,"\n");
! 741: }
! 742:
! 743: static char *operatorType(type)
! 744: int type;
! 745: { int i;
! 746: for (i=0; i<Sdp; i++) {
! 747: if (type == (SystemDictionary[i]).obj.lc.ival) {
! 748: return((SystemDictionary[i]).key);
! 749: }
! 750: }
! 751: return("Unknown operator");
! 752: }
! 753:
! 754: static struct object executableStringToExecutableArray(s)
! 755: char *s;
! 756: {
! 757: struct tokens *tokenArray;
! 758: struct object ob;
! 759: int i;
! 760: int size;
! 761: tokenArray = decomposeToTokens(s,&size);
! 762: ob.tag = SexecutableArray;
! 763: ob.lc.tokenArray = tokenArray;
! 764: ob.rc.ival = size;
! 765: for (i=0; i<size; i++) {
! 766: if ( ((ob.lc.tokenArray)[i]).kind == EXECUTABLE_STRING) {
! 767: ((ob.lc.tokenArray)[i]).kind = EXECUTABLE_ARRAY;
! 768: ((ob.lc.tokenArray)[i]).object =
! 769: executableStringToExecutableArray(((ob.lc.tokenArray)[i]).token);
! 770: }
! 771: }
! 772: return(ob);
! 773: }
! 774: /**************** stack machine **************************/
! 775: void scanner() {
! 776: struct tokens token;
! 777: struct object ob;
! 778: extern int ctrlC();
! 779: int tmp;
! 780: char *tmp2;
! 781: getokenSM(INIT);
! 782: initSystemDictionary();
! 783:
! 784: if (setjmp(EnvOfStackMachine)) {
! 785: /* do nothing in the case of error */
! 786: } else {
! 787: if (signal(SIGINT,SIG_IGN) != SIG_IGN) {
! 788: signal(SIGINT,ctrlC);
! 789: }
! 790:
! 791: KSdefineMacros();
! 792:
! 793: if (StartAFile) {
! 794: tmp2 = StartFile;
! 795: StartFile = (char *)GC_malloc(sizeof(char)*(strlen(StartFile)+
! 796: 40));
! 797: sprintf(StartFile,"$%s$ run\n",tmp2);
! 798: token.kind = EXECUTABLE_STRING;
! 799: token.token = StartFile;
! 800: executeToken(token); /* execute startup commands */
! 801: token.kind = ID;
! 802: token.token = "exec";
! 803: token = lookupTokens(token); /* set hashing values */
! 804: tmp = findSystemDictionary(token.token);
! 805: ob.tag = Soperator;
! 806: ob.lc.ival = tmp;
! 807: executePrimitive(ob); /* exec */
! 808: }
! 809:
! 810: }
! 811:
! 812: for (;;) {
! 813: if (setjmp(EnvOfStackMachine)) {
! 814: if (DebugStack >= 1) {
! 815: fprintf(Fstack,"\nscanner> ");
! 816: }
! 817: } else { }
! 818: if (DebugStack >= 1) { printOperandStack(); }
! 819: token = getokenSM(GET);
! 820: if ((tmp=executeToken(token)) < 0) break;
! 821: /***if (tmp == 1) fprintf(stderr," --- exit --- \n");*/
! 822: }
! 823: }
! 824:
! 825:
! 826: int ctrlC(sig)
! 827: int sig;
! 828: {
! 829: extern int ctrlC();
! 830:
! 831: signal(sig,SIG_IGN);
! 832: /* see 133p */
! 833:
! 834: fprintf(Fstack,"User interruption by ctrl-C. We are in the top-level.\n");
! 835: fprintf(Fstack,"Type in quit in order to exit sm1.\n");
! 836: /*fprintf(Fstack,"Warning! The handler of ctrl-C has a bug, so you might have a core-dump.\n");*/
! 837: /*
! 838: $(x0+1)^50$ $x1 x0 + x1^20$ 2 groebner_n
! 839: ctrl-C
! 840: $(x0+1)^50$ $x1 x0 + x1^20$ 2 groebner_n
! 841: It SOMETIMES makes core dump.
! 842: */
! 843: getokenSM(INIT); /* It might fix the bug above. 1992/11/14 */
! 844: signal(SIGINT,ctrlC);
! 845: longjmp(EnvOfStackMachine,1);
! 846: }
! 847:
! 848: int executeToken(token)
! 849: struct tokens token;
! 850: {
! 851: struct object ob;
! 852: int primitive;
! 853: int size;
! 854: int status;
! 855: struct tokens *tokenArray;
! 856: int i,h0,h1;
! 857:
! 858: if (token.kind == DOLLAR) {
! 859: ob.tag = Sdollar;
! 860: ob.lc.str = token.token;
! 861: push(ob);
! 862: } else if (token.kind == ID) { /* ID */
! 863:
! 864: if (strcmp(token.token,"exit") == 0) return(1);
! 865: /* "exit" is not primitive here. */
! 866:
! 867: if (isLiteral(token.token)) {
! 868: /* literal object */
! 869: ob.tag = Sstring;
! 870: ob.lc.str = (char *)GC_malloc((strlen(token.token)+1)*sizeof(char));
! 871: if (ob.lc.str == (char *)NULL) errorStackmachine("No space.");
! 872: strcpy(ob.lc.str, &((token.token)[1]));
! 873:
! 874: if (token.object.tag != Slist) {
! 875: fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
! 876: token.object = lookupLiteralString(token.token);
! 877: }
! 878: ob.rc.op = token.object.lc.op;
! 879: push(ob);
! 880: } else if (isInteger(token.token)) {
! 881: /* integer object */
! 882: ob.tag = Sinteger ;
! 883: ob.lc.ival = strToInteger(token.token);
! 884: push(ob);
! 885: } else {
! 886: if (token.object.tag != Slist) {
! 887: fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
! 888: token = lookupTokens(token);
! 889: }
! 890: h0 = ((token.object.lc.op)->lc).ival;
! 891: h1 = ((token.object.lc.op)->rc).ival;
! 892: ob = findUserDictionary(token.token,h0,h1);
! 893: primitive = ((token.object.rc.op)->lc).ival;
! 894: if (ob.tag >= 0) {
! 895: /* there is a definition in the user dictionary */
! 896: if (ob.tag == SexecutableArray) {
! 897: tokenArray = ob.lc.tokenArray;
! 898: size = ob.rc.ival;
! 899: for (i=0; i<size; i++) {
! 900: status = executeToken(tokenArray[i]);
! 901: if (status != 0) return(status);
! 902: }
! 903: }else {
! 904: push(ob);
! 905: }
! 906: } else if (primitive) {
! 907: /* system operator */
! 908: ob.tag = Soperator;
! 909: ob.lc.ival = primitive;
! 910: return(executePrimitive(ob));
! 911: } else {
! 912: fprintf(Fstack,"\n%%Warning: The identifier <<%s>> is not in the system dictionary\n%% nor in the user dictionary. Push NullObject.\n",token.token);
! 913: /*fprintf(Fstack,"(%d,%d)\n",h0,h1);*/
! 914: push(NullObject);
! 915: }
! 916: }
! 917: } else if (token.kind == EXECUTABLE_STRING) {
! 918: push(executableStringToExecutableArray(token.token));
! 919: } else if (token.kind == EXECUTABLE_ARRAY) {
! 920: push(token.object);
! 921: } else if ((token.kind == -1) || (token.kind == -2)) { /* eof token */
! 922: return(-1);
! 923: } else {
! 924: /*fprintf(Fstack,"\n%%Error: Unknown token type\n");***/
! 925: fprintf(stderr,"\nUnknown token type = %d\n",token.kind);
! 926: fprintf(stderr,"\ntype in ctrl-\\ if you like to make core-dump.\n");
! 927: fprintf(stderr,"If you like to continue, type in RETURN key.\n");
! 928: fprintf(stderr,"The author expects the bug report.\n");
! 929: getchar();
! 930: errorStackmachine("Error: Unknown token type.\n");
! 931: /**return(-2); /* exit */
! 932: }
! 933: return(0); /* normal exit */
! 934: }
! 935:
! 936: int executePrimitive(ob)
! 937: struct object ob;
! 938: {
! 939: struct object ob1;
! 940: struct object ob2;
! 941: struct object ob3;
! 942: struct object ob4;
! 943: struct object ob5;
! 944: struct object rob;
! 945: struct object obArray[OB_ARRAY_MAX];
! 946: struct object obArray2[OB_ARRAY_MAX];
! 947: int size;
! 948: int i,j,k,n;
! 949: int status;
! 950: struct tokens *tokenArray;
! 951: struct tokens token;
! 952: FILE *fp;
! 953: char *fname;
! 954: int rank;
! 955: struct object oMat;
! 956: static int timerStart = 1;
! 957: static struct tms before, after;
! 958: struct object oInput;
! 959: char *str;
! 960: extern int KeepInput;
! 961: extern int History;
! 962: extern struct ring *CurrentRingp;
! 963:
! 964: if (DebugStack >= 2) {
! 965: fprintf(Fstack,"In execute\n"); printOperandStack();
! 966: }
! 967:
! 968: switch (ob.lc.ival) {
! 969: /* Postscript primitives :stack */
! 970: case Spop:
! 971: ob1 = pop();
! 972: break;
! 973:
! 974: case Sdup:
! 975: ob1 = pop();
! 976: push(ob1); push(ob1);
! 977: break;
! 978: case Scopy: /* copy values. cf. dup */
! 979: ob1 = pop();
! 980: switch(ob1.tag) {
! 981: case Sinteger: break;
! 982: default: errorStackmachine("Usage:copy");
! 983: }
! 984: size = ob1.lc.ival;
! 985: k = 0;
! 986: for (i=size-1; i>=0; i--) {
! 987: ob2 = peek(i+k);
! 988: switch(ob2.tag) {
! 989: case Sdollar: /* copy by value */
! 990: str = (char *)GC_malloc(strlen(ob2.lc.str)+3);
! 991: if (str == (char *)NULL) errorStackmachine("No memory (copy)");
! 992: strcpy(str,ob2.lc.str);
! 993: push(KpoString(str));
! 994: break;
! 995: case Spoly:
! 996: errorStackmachine("no pCopy (copy)");
! 997: break;
! 998: case Sarray:
! 999: n = ob2.lc.ival;
! 1000: ob3 = newObjectArray(n);
! 1001: for (j=0; j<n; j++) {
! 1002: putoa(ob3,j,getoa(ob2,j));
! 1003: }
! 1004: push(ob3);
! 1005: break;
! 1006: default:
! 1007: push(ob2);
! 1008: break;
! 1009: }
! 1010: k++;
! 1011: }
! 1012: break;
! 1013: case Sroll:
! 1014: ob1 = pop();
! 1015: ob2 = pop();
! 1016: switch(ob1.tag) {
! 1017: case Sinteger:
! 1018: j = ob1.lc.ival;
! 1019: break;
! 1020: default: errorStackmachine("Usage:roll");
! 1021: }
! 1022: switch(ob2.tag) {
! 1023: case Sinteger:
! 1024: n = ob2.lc.ival;
! 1025: break;
! 1026: default: errorStackmachine("Usage:roll");
! 1027: }
! 1028: for (i=0; i<n; i++) {
! 1029: if (i < OB_ARRAY_MAX) {
! 1030: obArray[i] = pop();
! 1031: }else{
! 1032: errorStackmachine("exceeded OB_ARRAY_MAX (roll)\n");
! 1033: }
! 1034: }
! 1035: for (i=0; i<n; i++) {
! 1036: k = (j-1)%n;
! 1037: k = (k>=0?k: k+n);
! 1038: push(obArray[k]);
! 1039: j--;
! 1040: }
! 1041: break;
! 1042: case Spstack:
! 1043: printOperandStack();
! 1044: break;
! 1045:
! 1046: /* Postscript primitives :arithmetic */
! 1047: case Sadd:
! 1048: ob1 = pop();
! 1049: ob2 = pop();
! 1050: rob = KooAdd(ob1,ob2);
! 1051: push(rob);
! 1052: break;
! 1053: case Ssub:
! 1054: ob2 = pop();
! 1055: ob1 = pop();
! 1056: rob = KooSub(ob1,ob2);
! 1057: push(rob);
! 1058: break;
! 1059: case Smult:
! 1060: ob2 = pop();
! 1061: ob1 = pop();
! 1062: rob = KooMult(ob1,ob2);
! 1063: push(rob);
! 1064: break;
! 1065: case Sidiv:
! 1066: ob2 = pop(); ob1 = pop();
! 1067: rob = KooDiv(ob1,ob2);
! 1068: push(rob);
! 1069: break;
! 1070:
! 1071: /* Postscript primitives :array */
! 1072: case SleftBrace:
! 1073: rob.tag = SleftBraceTag;
! 1074: push(rob);
! 1075: break;
! 1076:
! 1077: case SrightBrace:
! 1078: size = 0;
! 1079: ob1 = peek(size);
! 1080: while (!(Osp-size-1 < 0)) { /* while the stack is not underflow */
! 1081: if (ob1.tag == SleftBraceTag) {
! 1082: rob = newObjectArray(size);
! 1083: for (i=0; i<size; i++) {
! 1084: (rob.rc.op)[i] = peek(size-1-i);
! 1085: }
! 1086: for (i=0; i<size+1; i++) {
! 1087: pop();
! 1088: }
! 1089: break;
! 1090: }
! 1091: size++;
! 1092: ob1 = peek(size);
! 1093: }
! 1094: push(rob);
! 1095: break;
! 1096:
! 1097: case Sget:
! 1098: /* [a_0 ... a_{n-1}] i get a_i */
! 1099: /* ob2 ob1 get */
! 1100: ob1 = pop();
! 1101: ob2 = pop();
! 1102: switch(ob2.tag) {
! 1103: case Sarray: break;
! 1104: default: errorStackmachine("Usage:get");
! 1105: }
! 1106: switch(ob1.tag) {
! 1107: case Sinteger: break;
! 1108: default: errorStackmachine("Usage:get");
! 1109: }
! 1110: i =ob1.lc.ival;
! 1111: size = getoaSize(ob2);
! 1112: if ((0 <= i) && (i<size)) {
! 1113: push(getoa(ob2,i));
! 1114: }else{
! 1115: errorStackmachine("Index is out of bound. (get)\n");
! 1116: }
! 1117: break;
! 1118:
! 1119: case Sput:
! 1120: /* [a_0 ... a_{n-1}] index any put */
! 1121: /* ob3 ob2 ob1 put */
! 1122: ob1 = pop(); ob2 = pop(); ob3 = pop();
! 1123: switch(ob2.tag) {
! 1124: case Sinteger: break;
! 1125: default: errorStackmachine("Usage:put");
! 1126: }
! 1127: switch(ob3.tag) {
! 1128: case Sarray:
! 1129: i = ob2.lc.ival;
! 1130: size = getoaSize(ob3);
! 1131: if ((0 <= i) && (i<size)) {
! 1132: getoa(ob3,i) = ob1;
! 1133: }else{
! 1134: errorStackmachine("Index is out of bound. (put)\n");
! 1135: }
! 1136: break;
! 1137: case Sdollar:
! 1138: i = ob2.lc.ival;
! 1139: size = strlen(ob3.lc.str);
! 1140: if ((0 <= i) && (i<size)) {
! 1141: if (ob1.tag == Sdollar) {
! 1142: (ob3.lc.str)[i] = (ob1.lc.str)[0];
! 1143: }else{
! 1144: (ob3.lc.str)[i] = ob1.lc.ival;
! 1145: }
! 1146: }else{
! 1147: errorStackmachine("Index is out of bound. (put)\n");
! 1148: }
! 1149: break;
! 1150: default: errorStackmachine("Usage:put");
! 1151: }
! 1152: break;
! 1153:
! 1154: case Sindex:
! 1155: ob1 = pop();
! 1156: switch(ob1.tag) {
! 1157: case Sinteger: break;
! 1158: default: errorStackmachine("Usage:index");
! 1159: }
! 1160: size = ob1.lc.ival;
! 1161: push(peek(size-1));
! 1162: break;
! 1163:
! 1164: case Saload:
! 1165: /* [a1 a2 ... an] aload a1 a2 ... an [a1 ... an] */
! 1166: ob1 = pop();
! 1167: switch(ob1.tag) {
! 1168: case Sarray: break;
! 1169: default:
! 1170: errorStackmachine("Usage:aload");
! 1171: }
! 1172: size = getoaSize(ob1);
! 1173: for (i=0; i<size; i++) {
! 1174: push(getoa(ob1,i));
! 1175: }
! 1176: push(ob1);
! 1177:
! 1178: break;
! 1179:
! 1180: case Slength:
! 1181: /* [a_0 ... a_{n-1}] length n */
! 1182: /* ob1 length rob */
! 1183: ob1 = pop();
! 1184: switch(ob1.tag) {
! 1185: case Sarray:
! 1186: size = getoaSize(ob1);
! 1187: push(KpoInteger(size));
! 1188: break;
! 1189: case Sdollar:
! 1190: push(KpoInteger(strlen(ob1.lc.str)));
! 1191: break;
! 1192: default: errorStackmachine("Usage:length");
! 1193: }
! 1194: break;
! 1195:
! 1196: /* Postscript primitives :relation */
! 1197: case Sequal:
! 1198: /* obj1 obj2 == bool */
! 1199: ob2 = pop();
! 1200: ob1 = pop();
! 1201: if(KooEqualQ(ob1,ob2)) {
! 1202: push(KpoInteger(1));
! 1203: }else{
! 1204: push(KpoInteger(0));
! 1205: }
! 1206: break;
! 1207:
! 1208: case Sless:
! 1209: /* obj1 obj2 < bool */
! 1210: ob2 = pop();
! 1211: ob1 = pop();
! 1212: push(KooLess(ob1,ob2));
! 1213: break;
! 1214:
! 1215: case Sgreater:
! 1216: /* obj1 obj2 < bool */
! 1217: ob2 = pop();
! 1218: ob1 = pop();
! 1219: push(KooGreater(ob1,ob2));
! 1220: break;
! 1221:
! 1222:
! 1223: /* Postscript primitives :controle */
! 1224: case Sloop:
! 1225: /* { .... exit .....} loop */
! 1226: ob1 = pop();
! 1227: switch(ob1.tag) {
! 1228: case SexecutableArray: break;
! 1229: default:
! 1230: errorStackmachine("Usage:loop");
! 1231: break;
! 1232: }
! 1233: tokenArray = ob1.lc.tokenArray;
! 1234: size = ob1.rc.ival;
! 1235: i = 0;
! 1236: while (1) {
! 1237: token = tokenArray[i];
! 1238: /***printf("[token %d]%s\n",i,token.token);*/
! 1239: i++;
! 1240: if (i >= size) i=0;
! 1241: status = executeToken(token);
! 1242: if (status != 0) break;
! 1243: /* here, do not return 1. Do not propagate exit signal outside of the
! 1244: loop. */
! 1245: }
! 1246: break;
! 1247:
! 1248: case Sfor:
! 1249: /* init inc limit { } for */
! 1250: /* ob4 ob3 ob2 ob1 */
! 1251: ob1 =pop(); ob2 = pop(); ob3 = pop(); ob4 = pop();
! 1252: switch(ob1.tag) {
! 1253: case SexecutableArray: break;
! 1254: default: errorStackmachine("Usage:for");
! 1255: }
! 1256: switch(ob2.tag) {
! 1257: case Sinteger: break;
! 1258: default:
! 1259: errorStackmachine("Usage:for The 3rd argument must be integer.");
! 1260: }
! 1261: switch(ob3.tag) {
! 1262: case Sinteger: break;
! 1263: default: errorStackmachine("Usage:for The 2nd argument must be integer.");
! 1264: }
! 1265: switch(ob4.tag) {
! 1266: case Sinteger: break;
! 1267: default: errorStackmachine("Usage:for The 1st argument must be integer.");
! 1268: }
! 1269: {
! 1270: int i,lim,inc,j;
! 1271: i = ob4.lc.ival;
! 1272: lim = ob2.lc.ival;
! 1273: inc = ob3.lc.ival;
! 1274: if (inc > 0) {
! 1275: /*
! 1276: if (lim < i) errorStackmachine("The initial value must not be greater than limit value (for).\n");
! 1277: */
! 1278: for ( ; i<=lim; i += inc) {
! 1279: push(KpoInteger(i));
! 1280: tokenArray = ob1.lc.tokenArray;
! 1281: size = ob1.rc.ival;
! 1282: for (j=0; j<size; j++) {
! 1283: status = executeToken(tokenArray[j]);
! 1284: if (status) goto xyz;
! 1285: }
! 1286: }
! 1287: }else{
! 1288: /*
! 1289: if (lim > i) errorStackmachine("The initial value must not be less than limit value (for).\n");
! 1290: */
! 1291: for ( ; i>=lim; i += inc) {
! 1292: push(KpoInteger(i));
! 1293: tokenArray = ob1.lc.tokenArray;
! 1294: size = ob1.rc.ival;
! 1295: for (j=0; j<size; j++) {
! 1296: status = executeToken(tokenArray[j]);
! 1297: if (status) goto xyz;
! 1298: }
! 1299: }
! 1300: }
! 1301: xyz: ;
! 1302: }
! 1303: break;
! 1304:
! 1305: case Smap:
! 1306: ob2 = pop(); ob1 = pop();
! 1307: switch(ob1.tag) {
! 1308: case Sarray: break;
! 1309: default:
! 1310: errorStackmachine("Usage:map The 1st argument must be an array.");
! 1311: break;
! 1312: }
! 1313: switch(ob2.tag) {
! 1314: case SexecutableArray: break;
! 1315: default:
! 1316: errorStackmachine("Usage:map The 2nd argument must be an executable array.");
! 1317: break;
! 1318: }
! 1319: { int osize,size;
! 1320: int i,j;
! 1321: osize = getoaSize(ob1);
! 1322:
! 1323: /*KSexecuteString("[");*/
! 1324: rob.tag = SleftBraceTag;
! 1325: push(rob);
! 1326:
! 1327: for (i=0; i<osize; i++) {
! 1328: push(getoa(ob1,i));
! 1329: tokenArray = ob2.lc.tokenArray;
! 1330: size = ob2.rc.ival;
! 1331: for (j=0; j<size; j++) {
! 1332: status = executeToken(tokenArray[j]);
! 1333: if (status) goto foor;
! 1334: }
! 1335: }
! 1336: foor: ;
! 1337: /*KSexecuteString("]");*/
! 1338: {
! 1339: size = 0;
! 1340: ob1 = peek(size);
! 1341: while (!(Osp-size-1 < 0)) { /* while the stack is not underflow */
! 1342: if (ob1.tag == SleftBraceTag) {
! 1343: rob = newObjectArray(size);
! 1344: for (i=0; i<size; i++) {
! 1345: (rob.rc.op)[i] = peek(size-1-i);
! 1346: }
! 1347: for (i=0; i<size+1; i++) {
! 1348: pop();
! 1349: }
! 1350: break;
! 1351: }
! 1352: size++;
! 1353: ob1 = peek(size);
! 1354: }
! 1355: push(rob);
! 1356: }
! 1357: }
! 1358: break;
! 1359:
! 1360:
! 1361: case Sifelse:
! 1362: /* bool { } { } ifelse */
! 1363: ob1 = pop();
! 1364: ob2 = pop();
! 1365: ob3 = pop();
! 1366: switch (ob1.tag) {
! 1367: case SexecutableArray: break;
! 1368: default: errorStackmachine("Usage:ifelse");
! 1369: }
! 1370: switch (ob2.tag) {
! 1371: case SexecutableArray: break;
! 1372: default: errorStackmachine("Usage:ifelse");
! 1373: }
! 1374: switch (ob3.tag) {
! 1375: case Sinteger: break;
! 1376: default: errorStackmachine("Usage:ifelse");
! 1377: }
! 1378: if (ob3.lc.ival) {
! 1379: /* execute ob2 */
! 1380: ob1 = ob2;
! 1381: }
! 1382: /* execute ob1 */
! 1383: tokenArray = ob1.lc.tokenArray;
! 1384: size = ob1.rc.ival;
! 1385: for (i=0; i<size; i++) {
! 1386: token = tokenArray[i];
! 1387: status = executeToken(token);
! 1388: if (status != 0) return(status);
! 1389: }
! 1390:
! 1391: break;
! 1392:
! 1393: case Sexec:
! 1394: /* { .........} exec */
! 1395: ob1 = pop();
! 1396: switch(ob1.tag) {
! 1397: case SexecutableArray: break;
! 1398: default: errorStackmachine("Usage:exec");
! 1399: }
! 1400: tokenArray = ob1.lc.tokenArray;
! 1401: size = ob1.rc.ival;
! 1402: for (i=0; i<size; i++) {
! 1403: token = tokenArray[i];
! 1404: /***printf("[token %d]%s\n",i,token.token);*/
! 1405: status = executeToken(token);
! 1406: if (status != 0) break;
! 1407: }
! 1408: break;
! 1409:
! 1410: /* Postscript primitives :dictionary */
! 1411: case Sdef:
! 1412: ob2 = pop();
! 1413: ob1 = pop();
! 1414: /* type check */
! 1415: switch(ob1.tag) {
! 1416: case Sstring: break;
! 1417: default:
! 1418: errorStackmachine("Usage:def");
! 1419: break;
! 1420: }
! 1421: putUserDictionary(ob1.lc.str,(ob1.rc.op->lc).ival,
! 1422: (ob1.rc.op->rc).ival,ob2);
! 1423: break;
! 1424:
! 1425: case Sload:
! 1426: ob1 = pop();
! 1427: switch(ob1.tag) {
! 1428: case Sstring: break;
! 1429: default: errorStackmachine("Usage:load");
! 1430: }
! 1431: ob1 = findUserDictionary(ob1.lc.str,
! 1432: (ob1.rc.op->lc).ival,
! 1433: (ob1.rc.op->rc).ival);
! 1434: if (ob1.tag == -1) push(NullObject);
! 1435: else push(ob1);
! 1436:
! 1437: break;
! 1438:
! 1439: case Sset:
! 1440: ob1 = pop();
! 1441: ob2 = pop();
! 1442: switch(ob1.tag) {
! 1443: case Sstring: break;
! 1444: default: errorStackmachine("Usage:set");
! 1445: }
! 1446: putUserDictionary(ob1.lc.str,(ob1.rc.op->lc).ival,
! 1447: (ob1.rc.op->rc).ival,ob2);
! 1448: break;
! 1449:
! 1450: case Sshow_systemdictionary:
! 1451: fprintf(Fstack,"------------- system dictionary -------------------\n");
! 1452: showSystemDictionary();
! 1453: break;
! 1454:
! 1455: case Sshow_user_dictionary:
! 1456: showUserDictionary("");
! 1457: break;
! 1458:
! 1459:
! 1460:
! 1461: /* Postscript primitives : convert */
! 1462: case Sdata_conversion:
! 1463: ob2 = pop();
! 1464: ob1 = pop();
! 1465: switch(ob2.tag) {
! 1466: case Sdollar: break;
! 1467: default: errorStackmachine("Usage:data_conversion");
! 1468: }
! 1469: rob = KdataConversion(ob1,ob2.lc.str);
! 1470: push(rob);
! 1471: break;
! 1472:
! 1473:
! 1474: /* Postscript ptimitives :file */
! 1475: case Srun:
! 1476: ob1 = pop();
! 1477: switch(ob1.tag) {
! 1478: case Sdollar: break;
! 1479: case Sstring: break;
! 1480: default:
! 1481: errorStackmachine("Usage:run");
! 1482: break;
! 1483: }
! 1484: getokenSM(OPEN,ob1.lc.str); /* open the file, $filename$ run */
! 1485: break;
! 1486:
! 1487: case Sprint:
! 1488: ob1 = pop();
! 1489: printObject(ob1,0,Fstack);
! 1490: break;
! 1491:
! 1492: case Sfileopen: /* filename mode file descripter */
! 1493: /* ob2 ob1 */
! 1494: ob1 = pop();
! 1495: ob2 = pop();
! 1496: switch(ob1.tag) {
! 1497: case Sdollar: break;
! 1498: default: errorStackmachine("Usage:file");
! 1499: }
! 1500: switch(ob2.tag) {
! 1501: case Sdollar: break;
! 1502: default:errorStackmachine("Usage:file");
! 1503: }
! 1504: rob = NullObject;
! 1505: if (strcmp(ob2.lc.str,"%stdin") == 0) {
! 1506: rob.tag = Sfile; rob.lc.str="%stdin"; rob.rc.file = stdin;
! 1507: }else if (strcmp(ob2.lc.str,"%stdout") == 0) {
! 1508: rob.tag = Sfile; rob.lc.str="%stdout"; rob.rc.file = stdout;
! 1509: }else if (strcmp(ob2.lc.str,"%stderr") == 0) {
! 1510: rob.tag = Sfile; rob.lc.str="%stderr"; rob.rc.file = stderr;
! 1511: }else if ( (rob.rc.file = fopen(ob2.lc.str,ob1.lc.str)) != (FILE *)NULL) {
! 1512: rob.tag = Sfile; rob.lc.str = ob2.lc.str;
! 1513: }else {
! 1514: errorStackmachine("I cannot open the file.");
! 1515: }
! 1516: push(rob);
! 1517: break;
! 1518:
! 1519:
! 1520: case Swritestring:
! 1521: /* file string writestring
! 1522: ob2 ob1
! 1523: */
! 1524: ob1 = pop();
! 1525: ob2 = pop();
! 1526: switch(ob2.tag) {
! 1527: case Sfile: break;
! 1528: default: errorStackmachine("Usage:writestring");
! 1529: }
! 1530: switch(ob1.tag) {
! 1531: case Sdollar: break;
! 1532: default: errorStackmachine("Usage:writestring");
! 1533: }
! 1534: fprintf(ob2.rc.file,"%s",ob1.lc.str);
! 1535: break;
! 1536:
! 1537: case Sclosefile:
! 1538: ob1 = pop();
! 1539: switch(ob1.tag) {
! 1540: case Sfile: break;
! 1541: default: errorStackmachine("Usage:closefile");
! 1542: }
! 1543: if (fclose(ob1.rc.file) == EOF) {
! 1544: errorStackmachine("I couldn't close the file.\n");
! 1545: }
! 1546: break;
! 1547:
! 1548: case Spushfile: /* filename pushfile string */
! 1549: /* ob2 */
! 1550: ob2 = pop();
! 1551: switch(ob2.tag) {
! 1552: case Sdollar: break;
! 1553: default:errorStackmachine("Usage:pushfile");
! 1554: }
! 1555: rob = NullObject;
! 1556: if (strcmp(ob2.lc.str,"%stdin") == 0) {
! 1557: ob1.tag = Sfile; ob1.lc.str="%stdin"; ob1.rc.file = stdin;
! 1558: }else if (strcmp(ob2.lc.str,"%stdout") == 0) {
! 1559: ob1.tag = Sfile; ob1.lc.str="%stdout"; ob1.rc.file = stdout;
! 1560: }else if (strcmp(ob2.lc.str,"%stderr") == 0) {
! 1561: ob1.tag = Sfile; ob1.lc.str="%stderr"; ob1.rc.file = stderr;
! 1562: }else if ( (ob1.rc.file = fopen(ob2.lc.str,"r")) != (FILE *)NULL) {
! 1563: ob1.tag = Sfile; ob1.lc.str = ob2.lc.str;
! 1564: }else {
! 1565: errorStackmachine("I cannot open the file.");
! 1566: }
! 1567:
! 1568: /* read the strings
! 1569: */
! 1570: n = 256; j=0;
! 1571: rob.tag = Sdollar; rob.lc.str = (char *) GC_malloc(sizeof(char)*n);
! 1572: if (rob.lc.str == (char *)NULL) errorStackmachine("No more memory.");
! 1573: while ((i = fgetc(ob1.rc.file)) != EOF) {
! 1574: if (j >= n-1) {
! 1575: n = 2*n;
! 1576: if (n <= 0) errorStackmachine("Too large file to put on the stack.");
! 1577: str = (char *)GC_malloc(sizeof(char)*n);
! 1578: if (str == (char *)NULL) errorStackmachine("No more memory.");
! 1579: for (k=0; k< n/2; k++) str[k] = (rob.lc.str)[k];
! 1580: rob.lc.str = str;
! 1581: }
! 1582: (rob.lc.str)[j] = i; (rob.lc.str)[j+1] = '\0';
! 1583: j++;
! 1584: }
! 1585:
! 1586: fclose(ob1.rc.file);
! 1587: push(rob);
! 1588: break;
! 1589:
! 1590: /* Postscript primitives :misc */
! 1591: case Squit:
! 1592: Kclose(); stackmachine_close();
! 1593: exit(0);
! 1594: break;
! 1595:
! 1596: case Ssystem:
! 1597: ob1 = pop();
! 1598: switch(ob1.tag) {
! 1599: case Sdollar: break;
! 1600: case Sstring: break;
! 1601: default: errorStackmachine("Usage:system");
! 1602: }
! 1603: system( ob1.lc.str );
! 1604: break;
! 1605:
! 1606: case Scat_n:
! 1607: ob1 = pop();
! 1608: switch(ob1.tag) {
! 1609: case Sinteger: break;
! 1610: default: errorStackmachine("Usage:cat_n");
! 1611: }
! 1612: size = ob1.lc.ival;
! 1613: k = 0;
! 1614: for (i=size-1; i>=0; i--) {
! 1615: ob2 = peek(i);
! 1616: switch(ob2.tag) {
! 1617: case Sdollar: break;
! 1618: default: errorStackmachine("Usage:cat_n");
! 1619: }
! 1620: k += strlen(ob2.lc.str);
! 1621: }
! 1622: ob1.tag = Sdollar;
! 1623: ob1.lc.str = (char *)GC_malloc(sizeof(char)*(k+1));
! 1624: if (ob1.lc.str == (char *)NULL) {
! 1625: errorStackmachine("No more memory.\n");
! 1626: }
! 1627: /* concatnate */
! 1628: k = 0;
! 1629: for (i=size-1; i>=0; i--) {
! 1630: ob2 = peek(i);
! 1631: strcpy(&((ob1.lc.str)[k]),ob2.lc.str);
! 1632: k = strlen(ob1.lc.str);
! 1633: }
! 1634: /* clear the arguments */
! 1635: for (i=size-1; i>=0; i--) {
! 1636: ob2 = pop();
! 1637: }
! 1638: push(ob1);
! 1639: break;
! 1640:
! 1641: case Sset_timer:
! 1642: /* 118p */
! 1643: if (timerStart) {
! 1644: times(&before);
! 1645: timerStart = 0;
! 1646: }else{
! 1647: times(&after);
! 1648: printf("User time: %f seconds, System time: %f seconds\n",
! 1649: ((double)(after.tms_utime - before.tms_utime)) /60.0,
! 1650: ((double)(after.tms_stime - before.tms_stime)) /60.0);
! 1651: timerStart = 1;
! 1652: }
! 1653: break;
! 1654:
! 1655: case Susage:
! 1656: ob1 = pop();
! 1657: Kusage(ob1);
! 1658: break;
! 1659:
! 1660: case Sto_records:
! 1661: ob1 = pop();
! 1662: switch(ob1.tag) {
! 1663: case Sdollar: break;
! 1664: default: errorStackmachine("Usage:to_records");
! 1665: }
! 1666: ob2 = KtoRecords(ob1);
! 1667: size = getoaSize(ob2);
! 1668: for (i=0; i<size; i++) {
! 1669: push(getoa(ob2,i));
! 1670: }
! 1671: rob.tag = Sinteger;
! 1672: rob.lc.ival = size;
! 1673: push(rob);
! 1674: break;
! 1675:
! 1676: case Ssystem_variable:
! 1677: ob1 = pop();
! 1678: switch(ob1.tag) {
! 1679: case Sarray: break;
! 1680: default: errorStackmachine("Usage:system_variable");
! 1681: }
! 1682: push(KsystemVariable(ob1));
! 1683: break;
! 1684:
! 1685: /* kan primitives :kan :ring */
! 1686: case Sset_order_by_matrix:
! 1687: ob1 = pop();
! 1688: KsetOrderByObjArray(ob1);
! 1689: break;
! 1690: case Sset_up_ring:
! 1691: ob5 = pop(); ob4=pop(); ob3=pop(); ob2=pop(); ob1=pop();
! 1692: KsetUpRing(ob1,ob2,ob3,ob4,ob5);
! 1693: break;
! 1694: case Sshow_ring:
! 1695: KshowRing(CurrentRingp);
! 1696: break;
! 1697: case Sswitch_function:
! 1698: ob1 = pop();
! 1699: ob2 = pop();
! 1700: KswitchFunction(ob2,ob1);
! 1701: break;
! 1702: case Sprint_switch_status:
! 1703: KprintSwitchStatus();
! 1704: break;
! 1705: case Sreplace:
! 1706: ob2 = pop();
! 1707: ob1 = pop();
! 1708: push(KoReplace(ob1,ob2));
! 1709: break;
! 1710:
! 1711: case Scoefficients:
! 1712: ob2 = pop();
! 1713: ob1 = pop();
! 1714: push(Kparts(ob1,ob2));
! 1715: break;
! 1716:
! 1717: case Sdegree:
! 1718: ob2 = pop();
! 1719: ob1 = pop();
! 1720: push(Kdegree(ob1,ob2));
! 1721: break;
! 1722: case Sspol:
! 1723: ob2 = pop();
! 1724: ob1 = pop();
! 1725: push(Ksp(ob1,ob2));
! 1726: break;
! 1727:
! 1728: case Seval:
! 1729: ob1 = pop();
! 1730: push(Keval(ob1));
! 1731: break;
! 1732:
! 1733: case Sreduction:
! 1734: ob2 = pop();
! 1735: ob1 = pop();
! 1736: push(Kreduction(ob1,ob2));
! 1737: break;
! 1738:
! 1739: case Sgroebner :
! 1740: ob1 = pop();
! 1741: push(Kgroebner(ob1));
! 1742: break;
! 1743:
! 1744: case Shomogenize :
! 1745: ob1 = pop();
! 1746: push(homogenizeObject(ob1,&i));
! 1747: break;
! 1748:
! 1749: case Sprincipal :
! 1750: ob1 = pop();
! 1751: push(oPrincipalPart(ob1));
! 1752: break;
! 1753:
! 1754: case Sinit:
! 1755: ob1 = pop();
! 1756: push(Khead(ob1));
! 1757: break;
! 1758:
! 1759: case Stest:
! 1760: /* test is used for a test of a new function. */
! 1761: ob1 = pop();
! 1762: push(test(ob1));
! 1763: /*
! 1764: {
! 1765:
! 1766: }
! 1767: */
! 1768: break;
! 1769:
! 1770:
! 1771: default:
! 1772: errorStackmachine("Unknown Soperator type. \n");
! 1773: }
! 1774: return(0); /* normal exit */
! 1775: }
! 1776:
! 1777:
! 1778:
! 1779:
! 1780:
! 1781: errorStackmachine(str)
! 1782: char *str;
! 1783: {
! 1784: int i,j,k;
! 1785: static char *u="Usage:";
! 1786: char message0[1024];
! 1787: char *message;
! 1788: message = message0;
! 1789: i = 0;
! 1790: while (i<6 && str[i]!='0') {
! 1791: if (str[i] != u[i]) break;
! 1792: i++;
! 1793: }
! 1794: if (i==6) {
! 1795: fprintf(stderr,"ERROR(sm): \n");
! 1796: while (str[i] != '\0' && str[i] != ' ') {
! 1797: i++;
! 1798: }
! 1799: if (str[i] == ' ') {
! 1800: fprintf(stderr," %s\n",&(str[i+1]));
! 1801: k = 0;
! 1802: if (i-6 > 1022) message = (char *)GC_malloc(sizeof(char)*i);
! 1803: for (j=6; j<i ; j++) {
! 1804: message[k] = str[j];
! 1805: message[k+1] = '\0';
! 1806: k++;
! 1807: }
! 1808: Kusage2(stderr,message);
! 1809: }else{
! 1810: Kusage2(stderr,&(str[6]));
! 1811: }
! 1812: }else {
! 1813: fprintf(stderr,"ERROR(sm): ");
! 1814: fprintf(stderr,str);
! 1815: }
! 1816: fprintf(stderr,"\n");
! 1817: longjmp(EnvOfStackMachine,1);
! 1818: }
! 1819:
! 1820: warningStackmachine(str)
! 1821: char *str;
! 1822: {
! 1823: fprintf(stderr,"WARNING(sm): ");
! 1824: fprintf(stderr,str);
! 1825: return(0);
! 1826: }
! 1827:
! 1828:
! 1829: /* exports */
! 1830: KSexecuteString(s)
! 1831: char *s;
! 1832: {
! 1833: struct tokens token;
! 1834: struct object ob;
! 1835: int tmp;
! 1836:
! 1837:
! 1838: if (setjmp(EnvOfStackMachine)) {
! 1839: return(-1);
! 1840: }else{
! 1841: token.token = s;
! 1842: token.kind = EXECUTABLE_STRING;
! 1843: executeToken(token);
! 1844: token.kind = ID;
! 1845: token.token = "exec";
! 1846: token = lookupTokens(token); /* no use */
! 1847: tmp = findSystemDictionary(token.token);
! 1848: ob.tag = Soperator;
! 1849: ob.lc.ival = tmp;
! 1850: executePrimitive(ob);
! 1851: return(0);
! 1852: }
! 1853: }
! 1854:
! 1855: KSdefineMacros() {
! 1856: struct tokens token;
! 1857: int tmp;
! 1858: struct object ob;
! 1859:
! 1860: if (setjmp(EnvOfStackMachine)) {
! 1861: return(-1);
! 1862: }else{
! 1863: if (StandardMacros && (strlen(SMacros))) {
! 1864: token.kind = EXECUTABLE_STRING;
! 1865: token.token = SMacros;
! 1866: executeToken(token); /* execute startup commands */
! 1867: token.kind = ID;
! 1868: token.token = "exec";
! 1869: token = lookupTokens(token); /* no use */
! 1870: tmp = findSystemDictionary(token.token);
! 1871: ob.tag = Soperator;
! 1872: ob.lc.ival = tmp;
! 1873: executePrimitive(ob); /* exec */
! 1874: }
! 1875: return(0);
! 1876: }
! 1877: }
! 1878:
! 1879: void KSstart() {
! 1880: stackmachine_init(); KinitKan();
! 1881: getokenSM(INIT); initSystemDictionary();
! 1882: KSdefineMacros();
! 1883: /* setjmp(EnvOfStackMachine) */
! 1884: }
! 1885:
! 1886: void KSstop() {
! 1887: Kclose(); stackmachine_close();
! 1888: }
! 1889:
! 1890:
! 1891: struct object KSpop() {
! 1892: return(pop());
! 1893: }
! 1894:
! 1895: void KSpush(ob)
! 1896: struct object ob;
! 1897: {
! 1898: push(ob);
! 1899: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to test.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097 / Replace