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