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