Annotation of OpenXM/src/kan96xx/Kan/stackmachine.c, Revision 1.25
1.25 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.24 2004/09/12 08:55:36 takayama Exp $ */
1.1 maekawa 2: /* stackmachin.c */
3:
4: #include <stdio.h>
5: #include "datatype.h"
6: #include "stackm.h"
7: #include "extern.h"
8: #include "gradedset.h"
9: #include "kclass.h"
10: #include <signal.h>
11: #include <sys/types.h>
12:
13:
14: /* #define OPERAND_STACK_SIZE 2000 */
15: #define OPERAND_STACK_SIZE 30000
16: #define SYSTEM_DICTIONARY_SIZE 200
1.8 takayama 17: /* #define USER_DICTIONARY_SIZE 1223, 3581, 27449 */
18: #define USER_DICTIONARY_SIZE 59359
1.1 maekawa 19: /* The value of USER_DICTIONARY_SIZE must be prime number, because of hashing
20: method */
21: #define ARGV_WORK_MAX (AGLIMIT+100)
22: #define EMPTY (char *)NULL
23:
24:
25: /* global variables */
26: struct object StandardStackA[OPERAND_STACK_SIZE];
27: int StandardStackP = 0;
28: int StandardStackMax = OPERAND_STACK_SIZE;
29: struct operandStack StandardStack;
30: /* Initialization of operandStack will be done in initSystemDictionary(). */
31: #define ERROR_STACK_SIZE 100
32: struct object ErrorStackA[ERROR_STACK_SIZE];
33: int ErrorStackP = 0;
34: int ErrorStackMax = ERROR_STACK_SIZE;
35: struct operandStack ErrorStack;
36: /* Initialization of ErrorStack will be done in initSystemDictionary(). */
37:
38: struct operandStack *CurrentOperandStack = &StandardStack;
39: struct object *OperandStack = StandardStackA;
40: int Osp = 0; /* OperandStack pointer */
41: int OspMax = OPERAND_STACK_SIZE;
42:
43: struct dictionary SystemDictionary[SYSTEM_DICTIONARY_SIZE];
44: int Sdp = 0; /* SystemDictionary pointer */
45: struct dictionary UserDictionary[USER_DICTIONARY_SIZE];
46:
47: struct context StandardContext ;
48: /* Initialization of StructContext will be done in initSystemDictionary(). */
49: /* hashInitialize is done in global.c (initStackmachine()) */
50: struct context *StandardContextp = &StandardContext;
51: struct context *CurrentContextp = &StandardContext;
52: struct context *PrimitiveContextp = &StandardContext;
53:
54:
55: static struct object ObjTmp; /* for poor compiler */
56:
1.16 takayama 57: int Calling_ctrlC_hook = 0;
58:
1.1 maekawa 59: int StandardMacros = 1;
60: int StartAFile = 0;
61: char *StartFile;
62:
63: int StartAString = 0;
64: char *StartString;
65:
66: char *GotoLabel = (char *)NULL;
67: int GotoP = 0;
68:
69: static char *SMacros =
70: #include "smacro.h"
71:
72: static isInteger(char *);
73: static strToInteger(char *);
74: static power(int s,int i);
75: static void pstack(void);
76: static struct object executableStringToExecutableArray(char *str);
77:
78: extern int SerialCurrent;
1.13 takayama 79: extern int QuoteMode;
1.1 maekawa 80:
81: int SGClock = 0;
82: int UserCtrlC = 0;
83: int OXlock = 0;
84: int OXlockSaved = 0;
85:
1.19 takayama 86: char *UD_str;
87: int UD_attr;
88:
1.1 maekawa 89: struct object * newObject()
90: {
91: struct object *r;
92: r = (struct object *)sGC_malloc(sizeof(struct object));
93: if (r == (struct object *)NULL) errorStackmachine("No memory\n");
94: r->tag = 0;
95: (r->lc).ival = 0;
96: (r->rc).ival = 0;
97: return(r);
98: }
99:
100: struct object newObjectArray(size)
1.7 takayama 101: int size;
1.1 maekawa 102: {
103: struct object rob;
104: struct object *op;
105: if (size < 0) return(NullObject);
106: if (size > 0) {
107: op = (struct object *)sGC_malloc(size*sizeof(struct object));
108: if (op == (struct object *)NULL) errorStackmachine("No memory\n");
109: }else{
110: op = (struct object *)NULL;
111: }
112: rob.tag = Sarray;
113: rob.lc.ival = size;
114: rob.rc.op = op;
115: return(rob);
116: }
117:
118: isNullObject(obj)
1.7 takayama 119: struct object obj;
1.1 maekawa 120: {
121: if (obj.tag == 0) return(1);
122: else return(0);
123: }
124:
125: int putSystemDictionary(str,ob)
1.7 takayama 126: char *str; /* key */
127: struct object ob; /* value */
1.1 maekawa 128: {
129: int i;
130: int j;
131: int flag = 0;
132:
133: for (i = Sdp-1; i>=0; i--) {
134: /*printf("Add %d %s\n",i,str);*/
135: if (strcmp(str,(SystemDictionary[i]).key) > 0) {
136: for (j=Sdp-1; j>=i+1; j--) {
1.7 takayama 137: (SystemDictionary[j+1]).key = (SystemDictionary[j]).key;
138: (SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;
1.1 maekawa 139: }
140: (SystemDictionary[i+1]).key = str;
141: (SystemDictionary[i+1]).obj = ob;
142: flag = 1;
143: break;
144: }
145: }
146: if (!flag) { /* str is the minimum element */
147: for (j=Sdp-1; j>=0; j--) {
148: (SystemDictionary[j+1]).key = (SystemDictionary[j]).key;
149: (SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;
150: }
151: (SystemDictionary[0]).key = str;
152: (SystemDictionary[0]).obj = ob;
153: }
154: Sdp++;
155: if (Sdp >= SYSTEM_DICTIONARY_SIZE) {
156: warningStackmachine("No space for system dictionary area.\n");
157: Sdp--;
158: return(-1);
159: }
160: return(Sdp-1);
161: }
162:
163: int findSystemDictionary(str)
164: /* only used for primitive functions */
165: /* returns 0, if there is no item. */
166: /* This function assumes that the dictionary is sorted by strcmp() */
167: char *str; /* key */
168: {
169: int first,last,rr,middle;
170:
171: /* binary search */
172: first = 0; last = Sdp-1;
173: while (1) {
174: if (first > last) {
175: return(0);
176: } else if (first == last) {
177: if (strcmp(str,(SystemDictionary[first]).key) == 0) {
1.7 takayama 178: return((SystemDictionary[first]).obj.lc.ival);
1.1 maekawa 179: }else {
1.7 takayama 180: return(0);
1.1 maekawa 181: }
182: } else if (last - first == 1) { /* This case is necessary */
183: if (strcmp(str,(SystemDictionary[first]).key) == 0) {
1.7 takayama 184: return((SystemDictionary[first]).obj.lc.ival);
1.1 maekawa 185: }else if (strcmp(str,(SystemDictionary[last]).key) == 0) {
1.7 takayama 186: return((SystemDictionary[last]).obj.lc.ival);
1.1 maekawa 187: }else return(0);
188: }
189:
190: middle = (first + last)/2;
191: rr = strcmp(str,(SystemDictionary[middle]).key);
192: if (rr < 0) { /* str < middle */
193: last = middle;
194: }else if (rr == 0) {
195: return((SystemDictionary[middle]).obj.lc.ival);
196: }else { /* str > middle */
197: first = middle;
198: }
199: }
200: }
201:
202: int putUserDictionary(str,h0,h1,ob,dic)
1.7 takayama 203: char *str; /* key */
204: int h0,h1; /* Hash values of the key */
205: struct object ob; /* value */
206: struct dictionary *dic;
1.1 maekawa 207: {
208: int x,r;
209: extern int Strict2;
210: x = h0;
211: if (str[0] == '\0') {
212: errorKan1("%s\n","putUserDictionary(): You are defining a value with the null key.");
213: }
214: while (1) {
215: if ((dic[x]).key == EMPTY) break;
216: if (strcmp((dic[x]).key,str) == 0) break;
217: x = (x+h1) % USER_DICTIONARY_SIZE;
218: if (x == h0) {
219: errorStackmachine("User dictionary is full. loop hashing.\n");
220: }
221: }
222: r = x;
223: if (Strict2) {
1.20 takayama 224: switch(((dic[x]).attr) & (PROTECT | ABSOLUTE_PROTECT)) {
1.1 maekawa 225: case PROTECT:
226: r = -PROTECT; /* Protected, but we rewrite it. */
227: break;
228: case ABSOLUTE_PROTECT:
229: r = -ABSOLUTE_PROTECT; /* Protected and we do not rewrite it. */
230: return(r);
231: default:
1.20 takayama 232: /* (dic[x]).attr = 0; */ /* It is not necesarry, I think. */
1.1 maekawa 233: break;
234: }
235: }
236: (dic[x]).key = str;
237: (dic[x]).obj = ob;
238: (dic[x]).h0 = h0;
239: (dic[x]).h1 = h1;
240: return(r);
241: }
242:
243: struct object KputUserDictionary(char *str,struct object ob)
244: {
245: int r;
246: r = putUserDictionary(str,hash0(str),hash1(str),ob,CurrentContextp->userDictionary);
247: return(KpoInteger(r));
248: }
249:
250: struct object findUserDictionary(str,h0,h1,cp)
1.7 takayama 251: /* returns NoObject, if there is no item. */
252: char *str; /* key */
253: int h0,h1; /* The hashing values of the key. */
254: struct context *cp;
1.19 takayama 255: /* Set char *UD_str, int UD_attr (attributes) */
1.1 maekawa 256: {
257: int x;
258: struct dictionary *dic;
1.19 takayama 259: extern char *UD_str;
260: extern int UD_attr;
261: UD_str = NULL; UD_attr = -1;
1.1 maekawa 262: dic = cp->userDictionary;
263: x = h0;
264: while (1) {
265: if ((dic[x]).key == EMPTY) { break; }
266: if (strcmp((dic[x]).key,str) == 0) {
1.19 takayama 267: UD_str = (dic[x]).key; UD_attr = (dic[x]).attr;
1.1 maekawa 268: return( (dic[x]).obj );
269: }
270: x = (x+h1) % USER_DICTIONARY_SIZE;
271: if (x == h0) {
272: errorStackmachine("User dictionary is full. loop hashing in findUserDictionary.\n");
273: }
274: }
275: if (cp->super == (struct context *)NULL) return(NoObject);
276: else return(findUserDictionary(str,h0,h1,cp->super));
277:
278: }
279:
280: struct object KfindUserDictionary(char *str) {
281: return(findUserDictionary(str,hash0(str),hash1(str),CurrentContextp));
282: }
283:
284: int putUserDictionary2(str,h0,h1,attr,dic)
1.7 takayama 285: char *str; /* key */
286: int h0,h1; /* Hash values of the key */
287: int attr; /* attribute field */
288: struct dictionary *dic;
1.1 maekawa 289: {
290: int x;
291: int i;
292: if (SET_ATTR_FOR_ALL_WORDS & attr) {
293: for (i=0; i<USER_DICTIONARY_SIZE; i++) {
294: if ((dic[i]).key !=EMPTY) (dic[i]).attr = attr&(~SET_ATTR_FOR_ALL_WORDS);
295: }
296: return(0);
297: }
298: x = h0;
299: if (str[0] == '\0') {
300: errorKan1("%s\n","putUserDictionary2(): You are defining a value with the null key.");
301: }
302: while (1) {
303: if ((dic[x]).key == EMPTY) return(-1);
304: if (strcmp((dic[x]).key,str) == 0) break;
305: x = (x+h1) % USER_DICTIONARY_SIZE;
306: if (x == h0) {
307: errorStackmachine("User dictionary is full. loop hashing.\n");
308: }
309: }
310: (dic[x]).attr = attr;
311: return(x);
312: }
313:
314:
315: int putPrimitiveFunction(str,number)
1.7 takayama 316: char *str;
317: int number;
1.1 maekawa 318: {
319: struct object ob;
320: ob.tag = Soperator;
321: ob.lc.ival = number;
322: return(putSystemDictionary(str,ob));
323: }
324:
325: struct tokens lookupTokens(t)
1.7 takayama 326: struct tokens t;
1.1 maekawa 327: {
328: struct object *left;
329: struct object *right;
330: t.object.tag = Slist;
331: left = t.object.lc.op = newObject();
332: right = t.object.rc.op = newObject();
333: left->tag = Sinteger;
334: (left->lc).ival = hash0(t.token);
335: (left->rc).ival = hash1(t.token);
336: right->tag = Sinteger;
337: (right->lc).ival = findSystemDictionary(t.token);
338: return(t);
339: }
340:
341: struct object lookupLiteralString(s)
1.7 takayama 342: char *s; /* s must be a literal string */
1.1 maekawa 343: {
344: struct object ob;
345: ob.tag = Slist;
346: ob.lc.op = newObject();
347: ob.rc.op = (struct object *)NULL;
348: ob.lc.op->tag = Sinteger;
349: (ob.lc.op->lc).ival = hash0(&(s[1]));
350: (ob.lc.op->rc).ival = hash1(&(s[1]));
351: return(ob);
352: }
353:
354:
355: int hash0(str)
1.7 takayama 356: char *str;
1.1 maekawa 357: {
358: int h=0;
359: while (*str != '\0') {
1.17 takayama 360: h = ((h*128)+((unsigned char)(*str))) % USER_DICTIONARY_SIZE;
1.1 maekawa 361: str++;
362: }
363: return(h);
364: }
365:
366: int hash1(str)
1.7 takayama 367: char *str;
1.1 maekawa 368: {
1.17 takayama 369: return(8-((unsigned char)(str[0])%8));
1.1 maekawa 370: }
371:
372: void hashInitialize(struct dictionary *dic)
373: {
374: int i;
375: for (i=0; i<USER_DICTIONARY_SIZE; i++) {
376: (dic[i]).key = EMPTY; (dic[i]).attr = 0;
377: }
378: }
379:
380: static isInteger(str)
1.7 takayama 381: char *str;
1.1 maekawa 382: {
383: int i;
384: int n;
385: int start;
386:
387: n = strlen(str);
388: if ((str[0] == '+') || (str[0] == '-'))
389: start = 1;
390: else
391: start = 0;
392: if (start >= n) return(0);
393:
394: for (i=start; i<n; i++) {
395: if (('0' <= str[i]) && (str[i] <= '9')) ;
396: else return(0);
397: }
398: return(1);
399: }
400:
401: static strToInteger(str)
1.7 takayama 402: char *str;
1.1 maekawa 403: {
404: int i;
405: int n;
406: int r;
407: int start;
408:
409: if ((str[0] == '+') || (str[0] == '-'))
410: start = 1;
411: else
412: start = 0;
413: n = strlen(str);
414: r = 0;
415: for (i=n-1; i>=start ; i--) {
416: r += (int)(str[i]-'0') *power(10,n-1-i);
417: }
418: if (str[0] == '-') r = -r;
419: return(r);
420: }
421:
422: static power(s,i)
1.7 takayama 423: int s;
424: int i;
1.1 maekawa 425: {
426: if (i == 0) return 1;
427: else return( s*power(s,i-1) );
428: }
429:
430: int Kpush(ob)
1.7 takayama 431: struct object ob;
1.1 maekawa 432: {
433: OperandStack[Osp++] = ob;
434: if (Osp >= OspMax) {
435: warningStackmachine("Operand stack overflow. \n");
436: Osp--;
437: return(-1);
438: }
439: return(0);
440: }
441:
442: struct object Kpop()
443: {
444: if (Osp <= 0) {
445: return( NullObject );
446: }else{
447: return( OperandStack[--Osp]);
448: }
449: }
450:
451: struct object peek(k)
1.7 takayama 452: int k;
1.1 maekawa 453: {
454: if ((Osp-k-1) < 0) {
455: return( NullObject );
456: }else{
457: return( OperandStack[Osp-k-1]);
458: }
459: }
460:
461:
462: struct object newOperandStack(int size)
463: {
464: struct operandStack *os ;
465: struct object ob;
466: os = (struct operandStack *)sGC_malloc(sizeof(struct operandStack));
467: if (os == (void *)NULL) errorStackmachine("No more memory.");
468: if (size <= 0) errorStackmachine("Size of stack must be more than 1.");
469: os->size = size;
470: os->sp = 0;
471: os->ostack = (struct object *)sGC_malloc(sizeof(struct object)*(size+1));
472: if (os->ostack == (void *)NULL) errorStackmachine("No more memory.");
473: ob.tag = Sclass;
474: ob.lc.ival = CLASSNAME_OPERANDSTACK;
475: ob.rc.voidp = os;
476: return(ob);
477: }
478:
479: void setOperandStack(struct object ob) {
480: if (ob.tag != Sclass) errorStackmachine("The argument must be class.");
481: if (ob.lc.ival != CLASSNAME_OPERANDSTACK)
482: errorStackmachine("The argument must be class.OperandStack.");
483: CurrentOperandStack->ostack = OperandStack;
484: CurrentOperandStack->sp = Osp;
485: CurrentOperandStack->size = OspMax;
486: OperandStack = ((struct operandStack *)(ob.rc.voidp))->ostack;
487: Osp = ((struct operandStack *)(ob.rc.voidp))->sp;
488: OspMax = ((struct operandStack *)(ob.rc.voidp))->size;
489: CurrentOperandStack = ob.rc.voidp;
490: }
491:
492: void stdOperandStack(void) {
493: CurrentOperandStack->ostack = OperandStack;
494: CurrentOperandStack->sp = Osp;
495: CurrentOperandStack->size = OspMax;
496:
497: CurrentOperandStack = &StandardStack;
498: OperandStack = CurrentOperandStack->ostack;
499: Osp = CurrentOperandStack->sp;
500: OspMax = CurrentOperandStack->size;
501: }
502:
503: /* functions to handle contexts. */
504: void fprintContext(FILE *fp,struct context *cp) {
505: if (cp == (struct context *)NULL) {
506: fprintf(fp," Context=NIL \n");
507: return;
508: }
509: fprintf(fp," ContextName = %s, ",cp->contextName);
510: fprintf(fp,"Super = ");
511: if (cp->super == (struct context *)NULL) fprintf(fp,"NIL");
512: else {
513: fprintf(fp,"%s",cp->super->contextName);
514: }
515: fprintf(fp,"\n");
516: }
517:
518: struct context *newContext0(struct context *super,char *name) {
519: struct context *cp;
520: cp = sGC_malloc(sizeof(struct context));
521: if (cp == (struct context *)NULL) errorStackmachine("No memory (newContext0)");
522: cp->userDictionary=sGC_malloc(sizeof(struct dictionary)*USER_DICTIONARY_SIZE);
523: if (cp->userDictionary==(struct dictionary *)NULL)
524: errorStackmachine("No memory (newContext0)");
525: hashInitialize(cp->userDictionary);
526: cp->contextName = name;
527: cp->super = super;
528: return(cp);
529: }
530:
531: void KsetContext(struct object contextObj) {
532: if (contextObj.tag != Sclass) {
533: errorStackmachine("Usage:setcontext");
534: }
535: if (contextObj.lc.ival != CLASSNAME_CONTEXT) {
536: errorStackmachine("Usage:setcontext");
537: }
538: if (contextObj.rc.voidp == NULL) {
539: errorStackmachine("You cannot set NullContext to the CurrentContext.");
540: }
541: CurrentContextp = (struct context *)(contextObj.rc.voidp);
542: }
543:
544:
545: struct object getSuperContext(struct object contextObj) {
546: struct object rob;
547: struct context *cp;
548: if (contextObj.tag != Sclass) {
549: errorStackmachine("Usage:supercontext");
550: }
551: if (contextObj.lc.ival != CLASSNAME_CONTEXT) {
552: errorStackmachine("Usage:supercontext");
553: }
554: cp = (struct context *)(contextObj.rc.voidp);
555: if (cp->super == (struct context *)NULL) {
556: return(NullObject);
557: }else{
558: rob.tag = Sclass;
559: rob.lc.ival = CLASSNAME_CONTEXT;
560: rob.rc.voidp = cp->super;
561: }
562: return(rob);
563: }
564:
565: #define CSTACK_SIZE 1000
566: void contextControl(actionOfContextControl ctl) {
567: static struct context *cstack[CSTACK_SIZE];
568: static int cstackp = 0;
569: switch(ctl) {
570: case CCRESTORE:
571: if (cstackp == 0) return;
572: else {
573: CurrentContextp = cstack[0];
574: cstackp = 0;
575: }
576: break;
577: case CCPUSH:
578: if (cstackp < CSTACK_SIZE) {
579: cstack[cstackp] = CurrentContextp;
580: cstackp++;
581: }else{
582: contextControl(CCRESTORE);
583: errorStackmachine("Context stack (cstack) is overflow. CurrentContext is restored.\n");
584: }
585: break;
586: case CCPOP:
587: if (cstackp > 0) {
588: cstackp--;
589: CurrentContextp = cstack[cstackp];
590: }
591: break;
592: default:
593: break;
594: }
595: return;
596: }
597:
598:
599:
600: int isLiteral(str)
1.7 takayama 601: char *str;
1.1 maekawa 602: {
603: if (strlen(str) <2) return(0);
604: else {
605: if ((str[0] == '/') && (str[1] != '/')) return(1);
606: else return(0);
607: }
608: }
609:
610: void printOperandStack() {
611: int i;
612: struct object ob;
613: int vs;
614: vs = VerboseStack; VerboseStack = 2;
615: for (i=Osp-1; i>=0; i--) {
616: fprintf(Fstack,"[%d] ",i);
617: ob = OperandStack[i];
618: printObject(ob,1,Fstack);
619: }
620: VerboseStack = vs;
621: }
622:
623:
624:
625: static initSystemDictionary()
1.7 takayama 626: {
1.1 maekawa 627: StandardStack.ostack = StandardStackA;
628: StandardStack.sp = StandardStackP;
629: StandardStack.size = OPERAND_STACK_SIZE;
630:
631: ErrorStack.ostack = ErrorStackA;
632: ErrorStack.sp = ErrorStackP;
633: ErrorStack.size = ErrorStackMax;
634:
635: StandardContext.userDictionary = UserDictionary;
636: StandardContext.contextName = "StandardContext";
637: StandardContext.super = (struct context *)NULL;
638:
639: KdefinePrimitiveFunctions();
640:
1.7 takayama 641: }
1.1 maekawa 642:
643: struct object showSystemDictionary(int f) {
644: int i;
645: int maxl;
646: char format[1000];
647: int nl;
648: struct object rob;
649: rob = NullObject;
650: if (f != 0) {
651: rob = newObjectArray(Sdp);
652: for (i=0; i<Sdp; i++) {
653: putoa(rob,i,KpoString((SystemDictionary[i]).key));
654: }
655: return(rob);
656: }
657: maxl = 1;
658: for (i=0; i<Sdp; i++) {
659: if (strlen((SystemDictionary[i]).key) >maxl)
660: maxl = strlen((SystemDictionary[i]).key);
661: }
662: maxl += 3;
663: nl = 80/maxl;
664: if (nl < 2) nl = 2;
665: sprintf(format,"%%-%ds",maxl);
666: for (i=0; i<Sdp; i++) {
667: fprintf(Fstack,format,(SystemDictionary[i]).key);
668: if (i % nl == nl-1) fprintf(Fstack,"\n");
669: }
670: fprintf(Fstack,"\n");
671: return(rob);
672: }
673:
674: int showUserDictionary()
675: {
676: int i,j;
677: int maxl;
678: char format[1000];
679: int nl;
680: struct dictionary *dic;
681: dic = CurrentContextp->userDictionary;
682: fprintf(Fstack,"DictionaryName=%s, super= ",CurrentContextp->contextName);
683: if (CurrentContextp->super == (struct context *)NULL) {
684: fprintf(Fstack,"NIL\n");
685: }else{
686: fprintf(Fstack,"%s\n",CurrentContextp->super->contextName);
687: }
688: maxl = 1;
689: for (i=0; i<USER_DICTIONARY_SIZE; i++) {
690: if ((dic[i]).key != EMPTY) {
691: if (strlen((dic[i]).key) >maxl)
1.7 takayama 692: maxl = strlen((dic[i]).key);
1.1 maekawa 693: }
694: }
695: maxl += 3;
696: nl = 80/maxl;
697: if (nl < 2) nl = 2;
698: sprintf(format,"%%-%ds",maxl);
699: for (i=0,j=0; i<USER_DICTIONARY_SIZE; i++) {
700: if ((dic[i]).key != EMPTY) {
701: fprintf(Fstack,format,(dic[i]).key);
702: /*{ char *sss; int ii,h0,h1;
1.7 takayama 703: sss = dic[i].key;
704: h0 = dic[i].h0;
705: h1 = dic[i].h1;
706: for (ii=0; ii<strlen(sss); ii++) fprintf(Fstack,"%x ",sss[ii]);
707: fprintf(Fstack,": h0=%d, h1=%d, %d\n",h0,h1,i);
708: }*/
1.1 maekawa 709: if (j % nl == nl-1) fprintf(Fstack,"\n");
710: j++;
711: }
712: }
713: fprintf(Fstack,"\n");
714: }
715:
716:
717: static struct object executableStringToExecutableArray(s)
1.7 takayama 718: char *s;
1.1 maekawa 719: {
720: struct tokens *tokenArray;
721: struct object ob;
722: int i;
723: int size;
724: tokenArray = decomposeToTokens(s,&size);
725: ob.tag = SexecutableArray;
726: ob.lc.tokenArray = tokenArray;
727: ob.rc.ival = size;
728: for (i=0; i<size; i++) {
729: if ( ((ob.lc.tokenArray)[i]).kind == EXECUTABLE_STRING) {
730: ((ob.lc.tokenArray)[i]).kind = EXECUTABLE_ARRAY;
731: ((ob.lc.tokenArray)[i]).object =
1.7 takayama 732: executableStringToExecutableArray(((ob.lc.tokenArray)[i]).token);
1.1 maekawa 733: }
734: }
735: return(ob);
736: }
737: /**************** stack machine **************************/
738: void scanner() {
739: struct tokens token;
740: struct object ob;
741: extern int Quiet;
742: extern void ctrlC();
1.22 takayama 743: int tmp, status;
1.1 maekawa 744: char *tmp2;
745: extern int ErrorMessageMode;
746: int jval;
1.14 takayama 747: extern int InSendmsg2;
1.22 takayama 748: int infixOn = 0;
749: struct tokens infixToken;
1.1 maekawa 750: getokenSM(INIT);
751: initSystemDictionary();
752:
1.9 takayama 753: #if defined(__CYGWIN__)
754: if (sigsetjmp(EnvOfStackMachine,1)) {
755: #else
1.1 maekawa 756: if (setjmp(EnvOfStackMachine)) {
1.9 takayama 757: #endif
1.1 maekawa 758: /* do nothing in the case of error */
759: fprintf(stderr,"An error or interrupt in reading macros, files and command strings.\n");
760: exit(10);
761: } else { }
762: if (signal(SIGINT,SIG_IGN) != SIG_IGN) {
763: signal(SIGINT,ctrlC);
764: }
765:
766: /* setup quiet mode or not */
1.21 takayama 767: token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1 maekawa 768: if (Quiet) {
769: token.token = " /@@@.quiet 1 def ";
770: }else {
771: token.token = " /@@@.quiet 0 def ";
772: }
773: executeToken(token); /* execute startup commands */
1.21 takayama 774: token.kind = ID; token.tflag = 0;
1.1 maekawa 775: token.token = "exec";
776: token = lookupTokens(token); /* set hashing values */
777: tmp = findSystemDictionary(token.token);
778: ob.tag = Soperator;
779: ob.lc.ival = tmp;
780: executePrimitive(ob); /* exec */
781:
782:
783: KSdefineMacros();
784:
785: if (StartAFile) {
786: tmp2 = StartFile;
787: StartFile = (char *)sGC_malloc(sizeof(char)*(strlen(StartFile)+
1.7 takayama 788: 40));
1.1 maekawa 789: sprintf(StartFile,"$%s$ run\n",tmp2);
1.21 takayama 790: token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1 maekawa 791: token.token = StartFile;
1.7 takayama 792: executeToken(token); /* execute startup commands */
1.21 takayama 793: token.kind = ID; token.tflag = 0;
1.1 maekawa 794: token.token = "exec";
795: token = lookupTokens(token); /* set hashing values */
796: tmp = findSystemDictionary(token.token);
797: ob.tag = Soperator;
798: ob.lc.ival = tmp;
1.7 takayama 799: executePrimitive(ob); /* exec */
1.1 maekawa 800: }
801:
802: if (StartAString) {
1.21 takayama 803: token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1 maekawa 804: token.token = StartString;
1.7 takayama 805: executeToken(token); /* execute startup commands */
1.21 takayama 806: token.kind = ID; token.tflag = 0;
1.1 maekawa 807: token.token = "exec";
808: token = lookupTokens(token); /* set hashing values */
809: tmp = findSystemDictionary(token.token);
810: ob.tag = Soperator;
811: ob.lc.ival = tmp;
1.7 takayama 812: executePrimitive(ob); /* exec */
1.1 maekawa 813: }
814:
815:
816: for (;;) {
1.9 takayama 817: #if defined(__CYGWIN__)
818: if (jval=sigsetjmp(EnvOfStackMachine,1)) {
819: #else
1.1 maekawa 820: if (jval=setjmp(EnvOfStackMachine)) {
1.9 takayama 821: #endif
1.1 maekawa 822: /* *** The following does not work properly. ****
1.7 takayama 823: if (jval == 2) {
824: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
825: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
826: }
827: }
828: **** */
1.1 maekawa 829: if (DebugStack >= 1) {
1.7 takayama 830: fprintf(Fstack,"\nscanner> ");
1.1 maekawa 831: }
1.16 takayama 832: if (!Calling_ctrlC_hook) { /* to avoid recursive call of ctrlC-hook. */
833: Calling_ctrlC_hook = 1;
834: KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
835: }
836: Calling_ctrlC_hook = 0;
1.12 takayama 837: KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook? */
1.14 takayama 838: InSendmsg2 = 0;
1.22 takayama 839: infixOn = 0;
1.7 takayama 840: continue ;
1.1 maekawa 841: } else { }
842: if (DebugStack >= 1) { printOperandStack(); }
1.22 takayama 843: token = getokenSM(GET);
844: if ((status=executeToken(token)) < 0) break;
845: /***if (status == 1) fprintf(stderr," --- exit --- \n");*/
846: /* fprintf(stderr,"token.token=%s, status=%d, infixOn=%d\n",token.token,status,infixOn); */
847: if (status & STATUS_INFIX) {
848: infixOn = 1; infixToken = token; infixToken.tflag |= NO_DELAY;
849: }else if (infixOn) {
850: infixOn = 0;
851: if ((status=executeToken(infixToken)) < 0) break;
852: }
1.1 maekawa 853: }
854: }
855:
856:
857: void ctrlC(sig)
1.7 takayama 858: int sig;
1.1 maekawa 859: {
860: extern void ctrlC();
861: extern int ErrorMessageMode;
862: extern int SGClock;
863: extern int UserCtrlC;
864: extern int OXlock;
1.14 takayama 865:
1.1 maekawa 866: signal(sig,SIG_IGN);
867: /* see 133p */
1.10 takayama 868: cancelAlarm();
869: if (sig == SIGALRM) {
870: fprintf(stderr,"ctrlC by SIGALRM\n");
871: }
1.1 maekawa 872:
873: if (SGClock) {
874: UserCtrlC = 1;
875: fprintf(stderr,"ctrl-c is locked because of gc.\n");
1.10 takayama 876: signal(sig,ctrlC); if (sig == SIGALRM) alarm((unsigned int)10);
1.1 maekawa 877: return;
878: }
879: if (OXlock) {
880: if (UserCtrlC > 0) UserCtrlC++;
881: else UserCtrlC = 1;
882: if (UserCtrlC > 3) {
883: fprintf(stderr,"OK. You are eager to cancel the computation.\n");
884: fprintf(stderr,"You should close the ox communication cannel.\n");
885: signal(SIGINT,ctrlC);
886: unlockCtrlCForOx();
887: }
888: fprintf(stderr,"ctrl-c is locked because of ox lock %d.\n",UserCtrlC);
1.10 takayama 889: signal(sig,ctrlC); if (sig == SIGALRM) alarm((unsigned int)10);
1.1 maekawa 890: return;
891: }
892: if (ErrorMessageMode != 1) {
1.16 takayama 893: (void *) traceShowStack();
1.1 maekawa 894: fprintf(Fstack,"User interruption by ctrl-C. We are in the top-level.\n");
895: fprintf(Fstack,"Type in quit in order to exit sm1.\n");
896: }
1.16 takayama 897: traceClearStack();
1.1 maekawa 898: if (GotoP) {
899: fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
900: GotoP = 0;
901: }
902: stdOperandStack(); contextControl(CCRESTORE);
903: /*fprintf(Fstack,"Warning! The handler of ctrl-C has a bug, so you might have a core-dump.\n");*/
904: /*
905: $(x0+1)^50$ $x1 x0 + x1^20$ 2 groebner_n
906: ctrl-C
907: $(x0+1)^50$ $x1 x0 + x1^20$ 2 groebner_n
908: It SOMETIMES makes core dump.
909: */
910: getokenSM(INIT); /* It might fix the bug above. 1992/11/14 */
911: signal(SIGINT,ctrlC);
1.9 takayama 912: #if defined(__CYGWIN__)
913: siglongjmp(EnvOfStackMachine,2);
914: #else
1.1 maekawa 915: longjmp(EnvOfStackMachine,2); /* returns 2 for ctrl-C */
1.9 takayama 916: #endif
1.1 maekawa 917: }
918:
919: int executeToken(token)
1.7 takayama 920: struct tokens token;
1.1 maekawa 921: {
922: struct object ob;
923: int primitive;
924: int size;
925: int status;
926: int i,h0,h1;
927: extern int WarningMessageMode;
928: extern int Strict;
1.14 takayama 929: extern int InSendmsg2;
1.1 maekawa 930:
931: if (GotoP) { /* for goto */
932: if (token.kind == ID && isLiteral(token.token)) {
933: if (strcmp(&((token.token)[1]),GotoLabel) == 0) {
1.7 takayama 934: GotoP = 0;
935: return(0); /* normal exit */
1.1 maekawa 936: }
937: }
938: return(0); /* normal exit */
939: }
940: if (token.kind == DOLLAR) {
941: ob.tag = Sdollar;
942: ob.lc.str = token.token;
943: Kpush(ob);
944: } else if (token.kind == ID) { /* ID */
945:
946: if (strcmp(token.token,"exit") == 0) return(1);
947: /* "exit" is not primitive here. */
948:
949: if (isLiteral(token.token)) {
950: /* literal object */
951: ob.tag = Sstring;
952: ob.lc.str = (char *)sGC_malloc((strlen(token.token)+1)*sizeof(char));
953: if (ob.lc.str == (char *)NULL) errorStackmachine("No space.");
954: strcpy(ob.lc.str, &((token.token)[1]));
955:
956: if (token.object.tag != Slist) {
1.7 takayama 957: fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
958: token.object = lookupLiteralString(token.token);
1.1 maekawa 959: }
960: ob.rc.op = token.object.lc.op;
961: Kpush(ob);
962: } else if (isInteger(token.token)) {
963: /* integer object */
964: ob.tag = Sinteger ;
965: ob.lc.ival = strToInteger(token.token);
966: Kpush(ob);
967: } else {
968: if (token.object.tag != Slist) {
1.7 takayama 969: fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
970: token = lookupTokens(token);
1.1 maekawa 971: }
972: h0 = ((token.object.lc.op)->lc).ival;
973: h1 = ((token.object.lc.op)->rc).ival;
974: ob=findUserDictionary(token.token,h0,h1,CurrentContextp);
975: primitive = ((token.object.rc.op)->lc).ival;
1.22 takayama 976: if (!(token.tflag & NO_DELAY)) {
977: if ((ob.tag >= 0) && (UD_attr & ATTR_INFIX)) {
1.24 takayama 978: return STATUS_INFIX;
1.22 takayama 979: }
980: }
1.1 maekawa 981: if (ob.tag >= 0) {
1.7 takayama 982: /* there is a definition in the user dictionary */
983: if (ob.tag == SexecutableArray) {
1.25 ! takayama 984: status = executeExecutableArray(ob,token.token,0);
1.24 takayama 985: if ((status & STATUS_BREAK) || (status < 0)) return status;
1.7 takayama 986: }else {
987: Kpush(ob);
988: }
1.1 maekawa 989: } else if (primitive) {
1.15 takayama 990: tracePushName(token.token);
1.7 takayama 991: /* system operator */
992: ob.tag = Soperator;
993: ob.lc.ival = primitive;
1.15 takayama 994: status = executePrimitive(ob);
1.18 takayama 995: tracePopName();
1.15 takayama 996: return(status);
1.1 maekawa 997: } else {
1.14 takayama 998: if (QuoteMode) {
999: if (InSendmsg2) return(DO_QUOTE);
1000: else {
1001: Kpush(KpoString(token.token));
1002: return(0); /* normal exit.*/
1003: }
1.13 takayama 1004: }
1.7 takayama 1005: if (WarningMessageMode == 1 || WarningMessageMode == 2) {
1006: char tmpc[1024];
1007: if (strlen(token.token) < 900) {
1008: sprintf(tmpc,"\n%%Warning: The identifier <<%s>> is not in the system dictionary\n%% nor in the user dictionaries. Push NullObject.\n",token.token);
1009: }else {strcpy(tmpc,"Warning: identifier is not in the dictionaries.");}
1010: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));
1011: }
1012: if (WarningMessageMode != 1) {
1013: fprintf(Fstack,"\n%%Warning: The identifier <<%s>> is not in the system dictionary\n%% nor in the user dictionaries. Push NullObject.\n",token.token);
1014: /*fprintf(Fstack,"(%d,%d)\n",h0,h1);*/
1015: }
1016: if (Strict) {
1017: errorStackmachine("Warning: identifier is not in the dictionaries");
1018: }
1019: Kpush(NullObject);
1.1 maekawa 1020: }
1021: }
1022: } else if (token.kind == EXECUTABLE_STRING) {
1023: Kpush(executableStringToExecutableArray(token.token));
1024: } else if (token.kind == EXECUTABLE_ARRAY) {
1025: Kpush(token.object);
1026: } else if ((token.kind == -1) || (token.kind == -2)) { /* eof token */
1027: return(-1);
1028: } else {
1029: /*fprintf(Fstack,"\n%%Error: Unknown token type\n");***/
1030: fprintf(stderr,"\nUnknown token type = %d\n",token.kind);
1031: fprintf(stderr,"\ntype in ctrl-\\ if you like to make core-dump.\n");
1032: fprintf(stderr,"If you like to continue, type in RETURN key.\n");
1033: fprintf(stderr,"Note that you cannot input null string.\n");
1034: getchar();
1035: errorStackmachine("Error: Unknown token type.\n");
1036: /* return(-2); /* exit */
1037: }
1038: return(0); /* normal exit */
1039: }
1040:
1041:
1042:
1043:
1044: errorStackmachine(str)
1.7 takayama 1045: char *str;
1.1 maekawa 1046: {
1047: int i,j,k;
1048: static char *u="Usage:";
1049: char message0[1024];
1050: char *message;
1051: extern int ErrorMessageMode;
1.10 takayama 1052: cancelAlarm();
1.1 maekawa 1053: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
1054: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));
1055: }
1056: if (ErrorMessageMode != 1) {
1057: message = message0;
1058: i = 0;
1059: while (i<6 && str[i]!='0') {
1060: if (str[i] != u[i]) break;
1061: i++;
1062: }
1063: if (i==6) {
1064: fprintf(stderr,"ERROR(sm): \n");
1065: while (str[i] != '\0' && str[i] != ' ') {
1.7 takayama 1066: i++;
1.1 maekawa 1067: }
1068: if (str[i] == ' ') {
1.7 takayama 1069: fprintf(stderr," %s\n",&(str[i+1]));
1070: k = 0;
1071: if (i-6 > 1022) message = (char *)sGC_malloc(sizeof(char)*i);
1072: for (j=6; j<i ; j++) {
1073: message[k] = str[j];
1074: message[k+1] = '\0';
1075: k++;
1076: }
1077: Kusage2(stderr,message);
1.1 maekawa 1078: }else{
1.7 takayama 1079: Kusage2(stderr,&(str[6]));
1.1 maekawa 1080: }
1081: }else {
1082: fprintf(stderr,"ERROR(sm): ");
1083: fprintf(stderr,str);
1084: }
1085: fprintf(stderr,"\n");
1.16 takayama 1086: (void) traceShowStack();
1.1 maekawa 1087: }
1.16 takayama 1088: traceClearStack();
1.1 maekawa 1089: if (GotoP) {
1090: fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
1091: GotoP = 0;
1092: }
1093: stdOperandStack(); contextControl(CCRESTORE);
1094: getokenSM(INIT); /* It might fix the bug. 1996/3/10 */
1095: /* fprintf(stderr,"Now, Long jump!\n"); */
1096: longjmp(EnvOfStackMachine,1);
1097: }
1098:
1099: warningStackmachine(str)
1.7 takayama 1100: char *str;
1.1 maekawa 1101: {
1102: extern int WarningMessageMode;
1103: extern int Strict;
1104: if (WarningMessageMode == 1 || WarningMessageMode == 2) {
1105: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));
1106: }
1107: if (WarningMessageMode != 1) {
1108: fprintf(stderr,"WARNING(sm): ");
1109: fprintf(stderr,str);
1110: }
1111: if (Strict) errorStackmachine(" ");
1112: return(0);
1113: }
1114:
1115:
1116: /* exports */
1117: /* NOTE: If you call this function and an error occured,
1118: you have to reset the jump buffer by setjmp(EnvOfStackMachine).
1119: cf. kxx/memo1.txt, kxx/stdserver00.c 1998, 2/6 */
1120: KSexecuteString(s)
1.7 takayama 1121: char *s;
1.1 maekawa 1122: {
1123: struct tokens token;
1124: struct object ob;
1125: int tmp;
1126: extern int CatchCtrlC;
1127: int jval;
1128: static int recursive = 0;
1129: extern int ErrorMessageMode;
1130: extern int KSPushEnvMode;
1131: jmp_buf saved_EnvOfStackMachine;
1132: void (*sigfunc)();
1133: int localCatchCtrlC ;
1134:
1135: localCatchCtrlC = CatchCtrlC;
1136: /* If CatchCtrlC is rewrited in this program,
1137: we crash. So, we use localCatchCtrlC. */
1138:
1139: if (localCatchCtrlC) {
1140: sigfunc = signal(SIGINT,SIG_IGN);
1141: signal(SIGINT,ctrlC);
1142: }
1143:
1144: if (KSPushEnvMode) {
1145: *saved_EnvOfStackMachine = *EnvOfStackMachine;
1.9 takayama 1146: #if defined(__CYGWIN__)
1147: if (jval = sigsetjmp(EnvOfStackMachine,1)) {
1148: #else
1.1 maekawa 1149: if (jval = setjmp(EnvOfStackMachine)) {
1.9 takayama 1150: #endif
1.1 maekawa 1151: *EnvOfStackMachine = *saved_EnvOfStackMachine;
1152: if (jval == 2) {
1.7 takayama 1153: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
1154: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
1155: }
1.1 maekawa 1156: }
1157: recursive--;
1158: if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
1.16 takayama 1159: if (!Calling_ctrlC_hook) {
1160: Calling_ctrlC_hook = 1;
1161: KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
1162: }
1163: Calling_ctrlC_hook = 0;
1.12 takayama 1164: KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/
1.1 maekawa 1165: return(-1);
1166: }else{ }
1167: }else{
1168: if (recursive == 0) {
1.9 takayama 1169: #if defined(__CYGWIN__)
1170: if (jval=sigsetjmp(EnvOfStackMachine,1)) {
1171: #else
1.1 maekawa 1172: if (jval=setjmp(EnvOfStackMachine)) {
1.9 takayama 1173: #endif
1.7 takayama 1174: if (jval == 2) {
1175: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
1176: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
1177: }
1178: }
1179: recursive = 0;
1180: if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
1.16 takayama 1181: if (!Calling_ctrlC_hook) {
1182: Calling_ctrlC_hook = 1;
1183: KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
1184: }
1185: Calling_ctrlC_hook = 0;
1186: Calling_ctrlC_hook = 0;
1.11 takayama 1187: KSexecuteString(" (Computation is interrupted.) ");
1.7 takayama 1188: return(-1);
1.1 maekawa 1189: }else { }
1190: }
1191: }
1192:
1193: recursive++;
1194: token.token = s;
1.21 takayama 1195: token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1 maekawa 1196: executeToken(token);
1.21 takayama 1197: token.kind = ID; token.tflag = 0;
1.1 maekawa 1198: token.token = "exec";
1199: token = lookupTokens(token); /* no use */
1200: tmp = findSystemDictionary(token.token);
1201: ob.tag = Soperator;
1202: ob.lc.ival = tmp;
1203: executePrimitive(ob);
1204: recursive--;
1205: if (KSPushEnvMode) *EnvOfStackMachine = *saved_EnvOfStackMachine;
1206: if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
1207: return(0);
1208: }
1209:
1210: KSdefineMacros() {
1211: struct tokens token;
1212: int tmp;
1213: struct object ob;
1214:
1215: if (StandardMacros && (strlen(SMacros))) {
1.21 takayama 1216: token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1 maekawa 1217: token.token = SMacros;
1.7 takayama 1218: executeToken(token); /* execute startup commands */
1.21 takayama 1219: token.kind = ID; token.tflag = 0;
1.1 maekawa 1220: token.token = "exec";
1221: token = lookupTokens(token); /* no use */
1222: tmp = findSystemDictionary(token.token);
1223: ob.tag = Soperator;
1224: ob.lc.ival = tmp;
1.7 takayama 1225: executePrimitive(ob); /* exec */
1.1 maekawa 1226: }
1227: return(0);
1228:
1229: }
1230:
1231: void KSstart() {
1232: struct tokens token;
1233: int tmp;
1234: struct object ob;
1235: extern int Quiet;
1236:
1237: stackmachine_init(); KinitKan();
1238: getokenSM(INIT); initSystemDictionary();
1239:
1240: /* The following line may cause a core dump, if you do not setjmp properly
1241: after calling KSstart().*/
1242: /*
1.7 takayama 1243: if (setjmp(EnvOfStackMachine)) {
1.1 maekawa 1244: fprintf(stderr,"KSstart(): An error or interrupt in reading macros, files and command strings.\n");
1245: exit(10);
1.7 takayama 1246: } else { } */
1.1 maekawa 1247:
1248: /* setup quiet mode or not */
1.21 takayama 1249: token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1 maekawa 1250: if (Quiet) {
1251: token.token = " /@@@.quiet 1 def ";
1252: }else {
1253: token.token = " /@@@.quiet 0 def ";
1254: }
1255: executeToken(token); /* execute startup commands */
1.21 takayama 1256: token.kind = ID; token.tflag = 0;
1.1 maekawa 1257: token.token = "exec";
1258: token = lookupTokens(token); /* set hashing values */
1259: tmp = findSystemDictionary(token.token);
1260: ob.tag = Soperator;
1261: ob.lc.ival = tmp;
1262: executePrimitive(ob); /* exec */
1263:
1264: KSdefineMacros();
1265: }
1266:
1267: void KSstop() {
1268: Kclose(); stackmachine_close();
1269: }
1270:
1271:
1272: struct object KSpop() {
1273: return(Kpop());
1274: }
1275:
1276: void KSpush(ob)
1.7 takayama 1277: struct object ob;
1.1 maekawa 1278: {
1279: Kpush(ob);
1.4 takayama 1280: }
1281:
1282: struct object KSpeek(k) {
1283: return(peek(k));
1.1 maekawa 1284: }
1285:
1286: char *KSstringPop() {
1287: /* pop a string */
1288: struct object rob;
1289: rob = Kpop();
1290: if (rob.tag == Sdollar) {
1291: return(rob.lc.str);
1292: }else{
1293: return((char *)NULL);
1294: }
1295: }
1296:
1297: char *KSpopString() {
1298: return(KSstringPop());
1299: }
1300:
1301: int KSset(char *name) {
1302: char *tmp2;
1303: char tmp[1024];
1304: tmp2 = tmp;
1305: if (strlen(name) < 1000) {
1306: sprintf(tmp2," /%s set ",name);
1307: }else{
1308: tmp2 = sGC_malloc(sizeof(char)*(strlen(name)+20));
1309: if (tmp2 == (char *)NULL) errorStackmachine("Out of memory.");
1310: sprintf(tmp2," /%s set ",name);
1311: }
1312: return( KSexecuteString(tmp2) );
1313: }
1314:
1315: int KSpushBinary(int size,char *data) {
1316: /* struct object KbinaryToObject(int size, char *data); */
1317: errorStackmachine("KSpushBinary is not implemented.\n");
1318: return(-1);
1319: }
1320:
1321: char *KSpopBinary(int *size) {
1322: /* char *KobjectToBinary(struct object ob,int *size); */
1323: errorStackmachine("KSpopBinary is not implemented.\n");
1324: *size = 0;
1325: return((char *)NULL);
1326: }
1327:
1328: int pushErrorStack(struct object obj)
1329: {
1330: if (CurrentOperandStack == &ErrorStack) {
1331: fprintf(stderr,"You cannot call pushErrorStack when ErrorStack is the CurrentOperandStack. \n");
1332: return(-1);
1333: }
1334: (ErrorStack.ostack)[(ErrorStack.sp)++] = obj;
1335: /* printf("ErrorStack.sp = %d\n",ErrorStack.sp); */
1336: if ((ErrorStack.sp) >= (ErrorStack.size)) {
1337: ErrorStack.sp = 0;
1338: fprintf(stderr,"pushErrorStack():ErrorStack overflow. It is reset.\n");
1339: /* Note that it avoids recursive call.*/
1340: return(-1);
1341: }
1342: return(0);
1343: }
1344:
1345: struct object popErrorStack(void) {
1346: if (CurrentOperandStack == &ErrorStack) {
1347: fprintf(stderr,"You cannot call popErrorStack when ErrorStack is the CurrentOperandStack. \n");
1348: return(NullObject);
1349: }
1350: if ((ErrorStack.sp) <= 0) {
1351: return( NullObject );
1352: }else{
1353: return( (ErrorStack.ostack)[--(ErrorStack.sp)]);
1354: }
1355: }
1356:
1357: char *popErrorStackByString(void) {
1358: struct object obj;
1359: struct object eobj;
1360: eobj = popErrorStack();
1361: if (ectag(eobj) != CLASSNAME_ERROR_PACKET) {
1362: return(NULL);
1363: }else{
1364: obj = *(KopErrorPacket(eobj));
1365: }
1366: if (obj.tag != Sarray || getoaSize(obj) != 3) {
1367: fprintf(stderr,"errorPacket format error.\n");
1368: printObject(eobj,0,stderr); fflush(stderr);
1369: return("class errorPacket format error. Bug of sm1.");
1370: }
1371: obj = getoa(obj,2);
1372: if (obj.tag != Sdollar) {
1373: fprintf(stderr,"errorPacket format error at position 2..\n");
1374: printObject(eobj,0,stderr); fflush(stderr);
1375: return("class errorPacket format error at the position 2. Bug of sm1.");
1376: }
1377: return(KopString(obj));
1378: }
1379:
1380:
1381: int KScheckErrorStack(void)
1382: {
1383: return(ErrorStack.sp);
1384: }
1385:
1386: struct object KnewErrorPacket(int serial,int no,char *message)
1387: {
1388: struct object obj;
1389: struct object *myop;
1390: char *s;
1391: /* Set extended tag. */
1392: obj.tag = Sclass; obj.lc.ival = CLASSNAME_ERROR_PACKET ;
1393: myop = (struct object *)sGC_malloc(sizeof(struct object));
1394: if (myop == (struct object *)NULL) errorStackmachine("No memory\n");
1395: *myop = newObjectArray(3);
1396: /*fprintf(stderr,"newErrorPacket() in stackmachine.c: [%d, %d, %s] \n",serial,no,message); **kxx:CMO_ERROR */
1397: putoa((*myop),0,KpoInteger(serial));
1398: putoa((*myop),1,KpoInteger(no));
1399: s = (char *)sGC_malloc(sizeof(char)*(strlen(message)+2));
1400: if (s == (char *)NULL) errorStackmachine("No memory\n");
1401: strcpy(s,message);
1402: putoa((*myop),2,KpoString(s));
1403: obj.rc.op = myop;
1404: return(obj);
1405: }
1406:
1407:
1408: struct object KnewErrorPacketObj(struct object ob1)
1409: {
1410: struct object obj;
1411: struct object *myop;
1412: char *s;
1413: /* Set extended tag. */
1414: obj.tag = Sclass; obj.lc.ival = CLASSNAME_ERROR_PACKET ;
1415: myop = (struct object *)sGC_malloc(sizeof(struct object));
1416: if (myop == (struct object *)NULL) errorStackmachine("No memory\n");
1417: *myop = ob1;
1418: obj.rc.op = myop;
1419: return(obj);
1420: }
1421:
1422: void *sGC_malloc(size_t n) { /* synchronized function */
1423: void *c;
1424: int id;
1425: extern int SGClock, UserCtrlC;
1426:
1427: SGClock = 1;
1428: c = GC_malloc(n);
1429: SGClock = 0;
1430: if (UserCtrlC) {
1431: UserCtrlC = 0;
1432: id = getpid();
1433: kill(id,SIGINT);
1434: return(c);
1435: }else{
1436: return(c);
1437: }
1438: }
1439:
1440: void *sGC_realloc(void *p,size_t new) { /* synchronized function */
1441: void *c;
1442: int id;
1443: extern int SGClock, UserCtrlC;
1444:
1445: SGClock = 1;
1446: c = GC_realloc(p,new);
1447: SGClock = 0;
1448: if (UserCtrlC) {
1449: UserCtrlC = 0;
1450: id = getpid();
1451: kill(id,SIGINT);
1452: return(c);
1453: }else{
1454: return(c);
1455: }
1456: }
1457:
1458: void sGC_free(void *c) { /* synchronized function */
1459: int id;
1460: extern int SGClock, UserCtrlC;
1461:
1462: SGClock = 1;
1463: GC_free(c);
1464: SGClock = 0;
1465: if (UserCtrlC) {
1466: UserCtrlC = 0;
1467: id = getpid();
1468: kill(id,SIGINT);
1469: return;
1470: }else{
1471: return;
1472: }
1473: }
1474:
1475: void lockCtrlCForOx() {
1476: extern int OXlock;
1477: extern int OXlockSaved;
1478: OXlockSaved = OXlock;
1479: OXlock = 1;
1480: }
1481:
1482: void unlockCtrlCForOx() {
1483: int id;
1484: extern int OXlock, UserCtrlC;
1485: extern int OXlockSaved;
1486: OXlockSaved = OXlock;
1487: OXlock = 0;
1488: if (UserCtrlC) {
1489: UserCtrlC = 0;
1490: id = getpid();
1491: kill(id,SIGINT);
1492: return;
1493: }else{
1494: return;
1495: }
1496: }
1497:
1498: void restoreLockCtrlCForOx() {
1499: extern int OXlock;
1500: extern int OXlockSaved;
1501: OXlock = OXlockSaved;
1502: }
1503:
1504: int KSstackPointer() {
1505: return(Osp);
1506: }
1507:
1508: struct object KSdupErrors() {
1509: struct object rob;
1510: struct object ob;
1511: int i;
1512: int n;
1513: int m;
1514:
1515: n = KSstackPointer();
1516: m = 0;
1517: for (i=0; i<n; i++) {
1518: ob = peek(i);
1519: if (ob.tag == Sclass && ectag(ob) == CLASSNAME_ERROR_PACKET) {
1520: m++;
1521: }
1522: }
1523: rob = newObjectArray(m);
1524: m = 0;
1525: for (i=0; i<n; i++) {
1526: ob = peek(i);
1527: if (ob.tag == Sclass && ectag(ob) == CLASSNAME_ERROR_PACKET) {
1528: putoa(rob, m, ob);
1529: m++;
1530: }
1531: }
1532: return(rob);
1533: }
1.10 takayama 1534:
1535: void cancelAlarm() {
1536: alarm((unsigned int) 0);
1537: signal(SIGALRM,SIG_DFL);
1.15 takayama 1538: }
1539:
1540: /* back-trace */
1541: #define TraceNameStackSize 3000
1542: char *TraceNameStack[TraceNameStackSize];
1543: int TraceNameStackp = 0;
1544: void tracePushName(char *s) {
1545: char *t;
1546: /*
1547: t = (char *)sGC_malloc(strlen(s)+1);
1548: if (t == NULL) {
1549: fprintf(stderr,"No more memory.\n"); return;
1550: }
1551: strcpy(t,s);
1552: */
1553: t = s;
1554: TraceNameStack[TraceNameStackp++] = t;
1555: if (TraceNameStackp >= TraceNameStackSize) {
1556: fprintf(stderr,"Warning: TraceNameStack overflow. Clearing the stack.\n");
1557: TraceNameStackp = 0;
1558: }
1559: }
1560: void traceClearStack(void) {
1561: TraceNameStackp = 0;
1562: }
1563: char *tracePopName(void) {
1564: if (TraceNameStackp <= 0) return (char *) NULL;
1565: return TraceNameStack[--TraceNameStackp];
1566: }
1567: #define TRACE_MSG_SIZE 320
1568: char *traceShowStack(void) {
1569: char *s;
1570: char *t;
1571: int p;
1572: s = (char *) sGC_malloc(TRACE_MSG_SIZE);
1573: if (s == NULL) {
1574: fprintf(stderr,"No more memory.\n"); return NULL;
1575: }
1576: sprintf(s,"Trace: ");
1577: p = strlen(s);
1578: do {
1579: t = tracePopName();
1580: if (t == NULL) {
1581: s[p] = ';'; s[p+1] = 0;
1582: break;
1.16 takayama 1583: }else if ((strlen(t) + p -10) > TRACE_MSG_SIZE) {
1584: /* fprintf(stderr,"p=%d, TraceNameStackp=%d, strlen(t)=%d, t=%s\n",p,TraceNameStackp,strlen(t),t); */
1.15 takayama 1585: strcpy(&(s[p])," ...");
1586: break;
1587: }
1588: strcpy(&(s[p]),t); p += strlen(t);
1589: strcpy(&(s[p]),"<-"); p += 2;
1590: } while (t != (char *)NULL);
1591: fprintf(stderr,"%s\n",s);
1592: return s;
1.24 takayama 1593: }
1594:
1595: /*
1596: if (fname != NULL) fname is pushed to the trace stack.
1597: */
1.25 ! takayama 1598: int executeExecutableArray(struct object ob,char *fname,int withGotoP) {
1.24 takayama 1599: struct tokens *tokenArray;
1600: int size,i;
1601: int status;
1602: int infixOn;
1603: struct tokens infixToken;
1604: extern int GotoP;
1605:
1606: infixOn = 0;
1607: if (ob.tag != SexecutableArray) errorStackmachine("Error (executeTokenArray): the argument is not a token array.");
1608:
1609: if (fname != NULL) tracePushName(fname);
1610: tokenArray = ob.lc.tokenArray;
1611: size = ob.rc.ival;
1612: for (i=0; i<size; i++) {
1613: status = executeToken(tokenArray[i]);
1.25 ! takayama 1614: if ((status & STATUS_BREAK) || (status < 0) || (withGotoP && GotoP)) {
1.24 takayama 1615: if (fname != NULL) tracePopName();
1616: return(status);
1617: }
1618:
1619: if (status & STATUS_INFIX) {
1620: if (i == size-1) errorStackmachine("Infix operator at the end of an executable array.");
1621: infixOn = 1; infixToken = tokenArray[i];
1622: infixToken.tflag |= NO_DELAY;
1623: continue;
1624: }else if (infixOn) {
1625: infixOn = 0;
1626: status = executeToken(infixToken);
1.25 ! takayama 1627: if ((status & STATUS_BREAK) || (status < 0) || (withGotoP && GotoP)) {
1.24 takayama 1628: if (fname != NULL) tracePopName();
1629: return(status);
1630: }
1631: }
1632: }
1633: if (fname != NULL) tracePopName();
1634: return(0); /* normal exit */
1.10 takayama 1635: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>