Annotation of OpenXM/src/k097/Replace/test.c, Revision 1.1.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