Annotation of OpenXM/src/kan96xx/Kan/stackmachine.c, Revision 1.42
1.42 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.41 2016/03/31 05:27:34 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>
1.41 takayama 14: #include "mysig.h"
1.1 maekawa 15:
1.37 takayama 16: /* The msys2 seems to make a buffer overflow of EnvOfStackmachine[].
17: The code
18: [(x) ring_of_differential_operators 11] define_ring
19: ( Dx*(x+Dx) ) /ff set
20: causes the segfault because Mp_zero is borken. Is it a bug of msys2?
21: Anyway, the following definition seems to be a workaround. 2015.09
22: Singnals do not work properly on msys2. (gcc -dM -E ... to see macros defs)
1.39 takayama 23: See stackm.h
1.37 takayama 24: */
1.1 maekawa 25:
26: /* #define OPERAND_STACK_SIZE 2000 */
27: #define OPERAND_STACK_SIZE 30000
28: #define SYSTEM_DICTIONARY_SIZE 200
1.8 takayama 29: /* #define USER_DICTIONARY_SIZE 1223, 3581, 27449 */
30: #define USER_DICTIONARY_SIZE 59359
1.1 maekawa 31: /* The value of USER_DICTIONARY_SIZE must be prime number, because of hashing
32: method */
33: #define ARGV_WORK_MAX (AGLIMIT+100)
34: #define EMPTY (char *)NULL
35:
36:
37: /* global variables */
38: struct object StandardStackA[OPERAND_STACK_SIZE];
39: int StandardStackP = 0;
40: int StandardStackMax = OPERAND_STACK_SIZE;
41: struct operandStack StandardStack;
42: /* Initialization of operandStack will be done in initSystemDictionary(). */
43: #define ERROR_STACK_SIZE 100
44: struct object ErrorStackA[ERROR_STACK_SIZE];
45: int ErrorStackP = 0;
46: int ErrorStackMax = ERROR_STACK_SIZE;
47: struct operandStack ErrorStack;
48: /* Initialization of ErrorStack will be done in initSystemDictionary(). */
49:
50: struct operandStack *CurrentOperandStack = &StandardStack;
51: struct object *OperandStack = StandardStackA;
52: int Osp = 0; /* OperandStack pointer */
53: int OspMax = OPERAND_STACK_SIZE;
54:
55: struct dictionary SystemDictionary[SYSTEM_DICTIONARY_SIZE];
56: int Sdp = 0; /* SystemDictionary pointer */
57: struct dictionary UserDictionary[USER_DICTIONARY_SIZE];
58:
59: struct context StandardContext ;
60: /* Initialization of StructContext will be done in initSystemDictionary(). */
61: /* hashInitialize is done in global.c (initStackmachine()) */
62: struct context *StandardContextp = &StandardContext;
63: struct context *CurrentContextp = &StandardContext;
64: struct context *PrimitiveContextp = &StandardContext;
65:
66:
1.31 takayama 67: static struct object ObjTmp = OINIT; /* for poor compiler */
1.1 maekawa 68:
1.16 takayama 69: int Calling_ctrlC_hook = 0;
70:
1.1 maekawa 71: int StandardMacros = 1;
72: int StartAFile = 0;
73: char *StartFile;
74:
75: int StartAString = 0;
76: char *StartString;
77:
78: char *GotoLabel = (char *)NULL;
79: int GotoP = 0;
80:
81: static char *SMacros =
82: #include "smacro.h"
83:
84: static isInteger(char *);
85: static strToInteger(char *);
86: static power(int s,int i);
87: static void pstack(void);
88: static struct object executableStringToExecutableArray(char *str);
1.29 takayama 89: static int isThereExecutableArrayOnStack(int n);
1.1 maekawa 90:
91: extern int SerialCurrent;
1.13 takayama 92: extern int QuoteMode;
1.1 maekawa 93:
94: int SGClock = 0;
95: int UserCtrlC = 0;
96: int OXlock = 0;
97: int OXlockSaved = 0;
98:
1.19 takayama 99: char *UD_str;
100: int UD_attr;
101:
1.34 takayama 102: struct object *MsgStackTraceInArrayp = NULL;
1.33 takayama 103: char *MsgStackTrace = NULL;
104: char *MsgSourceTrace = NULL;
105:
1.1 maekawa 106: struct object * newObject()
107: {
108: struct object *r;
109: r = (struct object *)sGC_malloc(sizeof(struct object));
110: if (r == (struct object *)NULL) errorStackmachine("No memory\n");
111: r->tag = 0;
112: (r->lc).ival = 0;
113: (r->rc).ival = 0;
1.30 takayama 114: r->attr = NULL;
1.1 maekawa 115: return(r);
116: }
117:
118: struct object newObjectArray(size)
1.7 takayama 119: int size;
1.1 maekawa 120: {
1.31 takayama 121: struct object rob = OINIT;
1.1 maekawa 122: struct object *op;
123: if (size < 0) return(NullObject);
124: if (size > 0) {
125: op = (struct object *)sGC_malloc(size*sizeof(struct object));
126: if (op == (struct object *)NULL) errorStackmachine("No memory\n");
127: }else{
128: op = (struct object *)NULL;
129: }
130: rob.tag = Sarray;
131: rob.lc.ival = size;
132: rob.rc.op = op;
133: return(rob);
134: }
135:
136: isNullObject(obj)
1.7 takayama 137: struct object obj;
1.1 maekawa 138: {
139: if (obj.tag == 0) return(1);
140: else return(0);
141: }
142:
143: int putSystemDictionary(str,ob)
1.7 takayama 144: char *str; /* key */
145: struct object ob; /* value */
1.1 maekawa 146: {
147: int i;
148: int j;
149: int flag = 0;
150:
151: for (i = Sdp-1; i>=0; i--) {
152: /*printf("Add %d %s\n",i,str);*/
153: if (strcmp(str,(SystemDictionary[i]).key) > 0) {
154: for (j=Sdp-1; j>=i+1; j--) {
1.7 takayama 155: (SystemDictionary[j+1]).key = (SystemDictionary[j]).key;
156: (SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;
1.1 maekawa 157: }
158: (SystemDictionary[i+1]).key = str;
159: (SystemDictionary[i+1]).obj = ob;
160: flag = 1;
161: break;
162: }
163: }
164: if (!flag) { /* str is the minimum element */
165: for (j=Sdp-1; j>=0; j--) {
166: (SystemDictionary[j+1]).key = (SystemDictionary[j]).key;
167: (SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;
168: }
169: (SystemDictionary[0]).key = str;
170: (SystemDictionary[0]).obj = ob;
171: }
172: Sdp++;
173: if (Sdp >= SYSTEM_DICTIONARY_SIZE) {
174: warningStackmachine("No space for system dictionary area.\n");
175: Sdp--;
176: return(-1);
177: }
178: return(Sdp-1);
179: }
180:
181: int findSystemDictionary(str)
182: /* only used for primitive functions */
183: /* returns 0, if there is no item. */
184: /* This function assumes that the dictionary is sorted by strcmp() */
185: char *str; /* key */
186: {
187: int first,last,rr,middle;
188:
189: /* binary search */
190: first = 0; last = Sdp-1;
191: while (1) {
192: if (first > last) {
193: return(0);
194: } else if (first == last) {
195: if (strcmp(str,(SystemDictionary[first]).key) == 0) {
1.7 takayama 196: return((SystemDictionary[first]).obj.lc.ival);
1.1 maekawa 197: }else {
1.7 takayama 198: return(0);
1.1 maekawa 199: }
200: } else if (last - first == 1) { /* This case is necessary */
201: if (strcmp(str,(SystemDictionary[first]).key) == 0) {
1.7 takayama 202: return((SystemDictionary[first]).obj.lc.ival);
1.1 maekawa 203: }else if (strcmp(str,(SystemDictionary[last]).key) == 0) {
1.7 takayama 204: return((SystemDictionary[last]).obj.lc.ival);
1.1 maekawa 205: }else return(0);
206: }
207:
208: middle = (first + last)/2;
209: rr = strcmp(str,(SystemDictionary[middle]).key);
210: if (rr < 0) { /* str < middle */
211: last = middle;
212: }else if (rr == 0) {
213: return((SystemDictionary[middle]).obj.lc.ival);
214: }else { /* str > middle */
215: first = middle;
216: }
217: }
218: }
219:
220: int putUserDictionary(str,h0,h1,ob,dic)
1.7 takayama 221: char *str; /* key */
222: int h0,h1; /* Hash values of the key */
223: struct object ob; /* value */
224: struct dictionary *dic;
1.1 maekawa 225: {
226: int x,r;
227: extern int Strict2;
228: x = h0;
229: if (str[0] == '\0') {
230: errorKan1("%s\n","putUserDictionary(): You are defining a value with the null key.");
231: }
232: while (1) {
233: if ((dic[x]).key == EMPTY) break;
234: if (strcmp((dic[x]).key,str) == 0) break;
235: x = (x+h1) % USER_DICTIONARY_SIZE;
236: if (x == h0) {
237: errorStackmachine("User dictionary is full. loop hashing.\n");
238: }
239: }
240: r = x;
241: if (Strict2) {
1.20 takayama 242: switch(((dic[x]).attr) & (PROTECT | ABSOLUTE_PROTECT)) {
1.1 maekawa 243: case PROTECT:
244: r = -PROTECT; /* Protected, but we rewrite it. */
245: break;
246: case ABSOLUTE_PROTECT:
247: r = -ABSOLUTE_PROTECT; /* Protected and we do not rewrite it. */
248: return(r);
249: default:
1.20 takayama 250: /* (dic[x]).attr = 0; */ /* It is not necesarry, I think. */
1.1 maekawa 251: break;
252: }
253: }
254: (dic[x]).key = str;
255: (dic[x]).obj = ob;
256: (dic[x]).h0 = h0;
257: (dic[x]).h1 = h1;
258: return(r);
259: }
260:
261: struct object KputUserDictionary(char *str,struct object ob)
262: {
263: int r;
264: r = putUserDictionary(str,hash0(str),hash1(str),ob,CurrentContextp->userDictionary);
265: return(KpoInteger(r));
266: }
267:
268: struct object findUserDictionary(str,h0,h1,cp)
1.7 takayama 269: /* returns NoObject, if there is no item. */
270: char *str; /* key */
271: int h0,h1; /* The hashing values of the key. */
272: struct context *cp;
1.19 takayama 273: /* Set char *UD_str, int UD_attr (attributes) */
1.1 maekawa 274: {
275: int x;
276: struct dictionary *dic;
1.19 takayama 277: extern char *UD_str;
278: extern int UD_attr;
279: UD_str = NULL; UD_attr = -1;
1.1 maekawa 280: dic = cp->userDictionary;
281: x = h0;
282: while (1) {
283: if ((dic[x]).key == EMPTY) { break; }
284: if (strcmp((dic[x]).key,str) == 0) {
1.19 takayama 285: UD_str = (dic[x]).key; UD_attr = (dic[x]).attr;
1.1 maekawa 286: return( (dic[x]).obj );
287: }
288: x = (x+h1) % USER_DICTIONARY_SIZE;
289: if (x == h0) {
290: errorStackmachine("User dictionary is full. loop hashing in findUserDictionary.\n");
291: }
292: }
293: if (cp->super == (struct context *)NULL) return(NoObject);
294: else return(findUserDictionary(str,h0,h1,cp->super));
295:
296: }
297:
298: struct object KfindUserDictionary(char *str) {
299: return(findUserDictionary(str,hash0(str),hash1(str),CurrentContextp));
300: }
301:
302: int putUserDictionary2(str,h0,h1,attr,dic)
1.7 takayama 303: char *str; /* key */
304: int h0,h1; /* Hash values of the key */
305: int attr; /* attribute field */
306: struct dictionary *dic;
1.1 maekawa 307: {
308: int x;
309: int i;
310: if (SET_ATTR_FOR_ALL_WORDS & attr) {
311: for (i=0; i<USER_DICTIONARY_SIZE; i++) {
312: if ((dic[i]).key !=EMPTY) (dic[i]).attr = attr&(~SET_ATTR_FOR_ALL_WORDS);
1.27 takayama 313: }
314: return(0);
315: }
316: if (OR_ATTR_FOR_ALL_WORDS & attr) {
317: for (i=0; i<USER_DICTIONARY_SIZE; i++) {
318: if ((dic[i]).key !=EMPTY) (dic[i]).attr |= attr&(~OR_ATTR_FOR_ALL_WORDS);
1.1 maekawa 319: }
320: return(0);
321: }
322: x = h0;
323: if (str[0] == '\0') {
324: errorKan1("%s\n","putUserDictionary2(): You are defining a value with the null key.");
325: }
326: while (1) {
327: if ((dic[x]).key == EMPTY) return(-1);
328: if (strcmp((dic[x]).key,str) == 0) break;
329: x = (x+h1) % USER_DICTIONARY_SIZE;
330: if (x == h0) {
331: errorStackmachine("User dictionary is full. loop hashing.\n");
332: }
333: }
334: (dic[x]).attr = attr;
335: return(x);
336: }
337:
338:
339: int putPrimitiveFunction(str,number)
1.7 takayama 340: char *str;
341: int number;
1.1 maekawa 342: {
1.31 takayama 343: struct object ob = OINIT;
1.1 maekawa 344: ob.tag = Soperator;
345: ob.lc.ival = number;
346: return(putSystemDictionary(str,ob));
347: }
348:
349: struct tokens lookupTokens(t)
1.7 takayama 350: struct tokens t;
1.1 maekawa 351: {
352: struct object *left;
353: struct object *right;
354: t.object.tag = Slist;
355: left = t.object.lc.op = newObject();
356: right = t.object.rc.op = newObject();
357: left->tag = Sinteger;
358: (left->lc).ival = hash0(t.token);
359: (left->rc).ival = hash1(t.token);
360: right->tag = Sinteger;
361: (right->lc).ival = findSystemDictionary(t.token);
362: return(t);
363: }
364:
365: struct object lookupLiteralString(s)
1.7 takayama 366: char *s; /* s must be a literal string */
1.1 maekawa 367: {
368: struct object ob;
369: ob.tag = Slist;
370: ob.lc.op = newObject();
371: ob.rc.op = (struct object *)NULL;
372: ob.lc.op->tag = Sinteger;
373: (ob.lc.op->lc).ival = hash0(&(s[1]));
374: (ob.lc.op->rc).ival = hash1(&(s[1]));
375: return(ob);
376: }
377:
378:
379: int hash0(str)
1.7 takayama 380: char *str;
1.1 maekawa 381: {
382: int h=0;
383: while (*str != '\0') {
1.17 takayama 384: h = ((h*128)+((unsigned char)(*str))) % USER_DICTIONARY_SIZE;
1.1 maekawa 385: str++;
386: }
387: return(h);
388: }
389:
390: int hash1(str)
1.7 takayama 391: char *str;
1.1 maekawa 392: {
1.17 takayama 393: return(8-((unsigned char)(str[0])%8));
1.1 maekawa 394: }
395:
396: void hashInitialize(struct dictionary *dic)
397: {
398: int i;
399: for (i=0; i<USER_DICTIONARY_SIZE; i++) {
400: (dic[i]).key = EMPTY; (dic[i]).attr = 0;
401: }
402: }
403:
404: static isInteger(str)
1.7 takayama 405: char *str;
1.1 maekawa 406: {
407: int i;
408: int n;
409: int start;
410:
411: n = strlen(str);
412: if ((str[0] == '+') || (str[0] == '-'))
413: start = 1;
414: else
415: start = 0;
416: if (start >= n) return(0);
417:
418: for (i=start; i<n; i++) {
419: if (('0' <= str[i]) && (str[i] <= '9')) ;
420: else return(0);
421: }
422: return(1);
423: }
424:
425: static strToInteger(str)
1.7 takayama 426: char *str;
1.1 maekawa 427: {
428: int i;
429: int n;
430: int r;
431: int start;
432:
433: if ((str[0] == '+') || (str[0] == '-'))
434: start = 1;
435: else
436: start = 0;
437: n = strlen(str);
438: r = 0;
439: for (i=n-1; i>=start ; i--) {
440: r += (int)(str[i]-'0') *power(10,n-1-i);
441: }
442: if (str[0] == '-') r = -r;
443: return(r);
444: }
445:
446: static power(s,i)
1.7 takayama 447: int s;
448: int i;
1.1 maekawa 449: {
450: if (i == 0) return 1;
451: else return( s*power(s,i-1) );
452: }
453:
454: int Kpush(ob)
1.7 takayama 455: struct object ob;
1.1 maekawa 456: {
457: OperandStack[Osp++] = ob;
458: if (Osp >= OspMax) {
459: warningStackmachine("Operand stack overflow. \n");
460: Osp--;
461: return(-1);
462: }
463: return(0);
464: }
465:
466: struct object Kpop()
467: {
468: if (Osp <= 0) {
469: return( NullObject );
470: }else{
471: return( OperandStack[--Osp]);
472: }
473: }
474:
475: struct object peek(k)
1.7 takayama 476: int k;
1.1 maekawa 477: {
478: if ((Osp-k-1) < 0) {
479: return( NullObject );
480: }else{
481: return( OperandStack[Osp-k-1]);
482: }
483: }
484:
1.29 takayama 485: static int isThereExecutableArray(struct object ob) {
486: int n,i;
1.31 takayama 487: struct object otmp = OINIT;
1.29 takayama 488: if (ob.tag == SexecutableArray) return(1);
489: if (ob.tag == Sarray) {
490: n = getoaSize(ob);
491: for (i=0; i<n; i++) {
492: otmp = getoa(ob,i);
493: if (isThereExecutableArray(otmp)) return(1);
494: }
495: return(0);
496: }
497: /* Class and list is not checked, since there is no parser
498: to directory translte these objects. */
499: return(0);
500: }
501: static int isThereExecutableArrayOnStack(int n) {
502: int i;
1.31 takayama 503: struct object ob = OINIT;
1.29 takayama 504: for (i=0; i<n; i++) {
505: if (Osp-i-1 < 0) return(0);
506: ob = peek(i);
507: if (isThereExecutableArray(ob)) return(1);
508: }
509: return(0);
510: }
1.1 maekawa 511:
512: struct object newOperandStack(int size)
513: {
514: struct operandStack *os ;
1.31 takayama 515: struct object ob = OINIT;
1.1 maekawa 516: os = (struct operandStack *)sGC_malloc(sizeof(struct operandStack));
517: if (os == (void *)NULL) errorStackmachine("No more memory.");
518: if (size <= 0) errorStackmachine("Size of stack must be more than 1.");
519: os->size = size;
520: os->sp = 0;
521: os->ostack = (struct object *)sGC_malloc(sizeof(struct object)*(size+1));
522: if (os->ostack == (void *)NULL) errorStackmachine("No more memory.");
523: ob.tag = Sclass;
524: ob.lc.ival = CLASSNAME_OPERANDSTACK;
525: ob.rc.voidp = os;
526: return(ob);
527: }
528:
529: void setOperandStack(struct object ob) {
530: if (ob.tag != Sclass) errorStackmachine("The argument must be class.");
531: if (ob.lc.ival != CLASSNAME_OPERANDSTACK)
532: errorStackmachine("The argument must be class.OperandStack.");
533: CurrentOperandStack->ostack = OperandStack;
534: CurrentOperandStack->sp = Osp;
535: CurrentOperandStack->size = OspMax;
536: OperandStack = ((struct operandStack *)(ob.rc.voidp))->ostack;
537: Osp = ((struct operandStack *)(ob.rc.voidp))->sp;
538: OspMax = ((struct operandStack *)(ob.rc.voidp))->size;
539: CurrentOperandStack = ob.rc.voidp;
540: }
541:
542: void stdOperandStack(void) {
543: CurrentOperandStack->ostack = OperandStack;
544: CurrentOperandStack->sp = Osp;
545: CurrentOperandStack->size = OspMax;
546:
547: CurrentOperandStack = &StandardStack;
548: OperandStack = CurrentOperandStack->ostack;
549: Osp = CurrentOperandStack->sp;
550: OspMax = CurrentOperandStack->size;
551: }
552:
553: /* functions to handle contexts. */
554: void fprintContext(FILE *fp,struct context *cp) {
555: if (cp == (struct context *)NULL) {
556: fprintf(fp," Context=NIL \n");
557: return;
558: }
559: fprintf(fp," ContextName = %s, ",cp->contextName);
560: fprintf(fp,"Super = ");
561: if (cp->super == (struct context *)NULL) fprintf(fp,"NIL");
562: else {
563: fprintf(fp,"%s",cp->super->contextName);
564: }
565: fprintf(fp,"\n");
566: }
567:
568: struct context *newContext0(struct context *super,char *name) {
569: struct context *cp;
570: cp = sGC_malloc(sizeof(struct context));
571: if (cp == (struct context *)NULL) errorStackmachine("No memory (newContext0)");
572: cp->userDictionary=sGC_malloc(sizeof(struct dictionary)*USER_DICTIONARY_SIZE);
573: if (cp->userDictionary==(struct dictionary *)NULL)
574: errorStackmachine("No memory (newContext0)");
575: hashInitialize(cp->userDictionary);
576: cp->contextName = name;
577: cp->super = super;
578: return(cp);
579: }
580:
581: void KsetContext(struct object contextObj) {
582: if (contextObj.tag != Sclass) {
583: errorStackmachine("Usage:setcontext");
584: }
585: if (contextObj.lc.ival != CLASSNAME_CONTEXT) {
586: errorStackmachine("Usage:setcontext");
587: }
588: if (contextObj.rc.voidp == NULL) {
589: errorStackmachine("You cannot set NullContext to the CurrentContext.");
590: }
591: CurrentContextp = (struct context *)(contextObj.rc.voidp);
592: }
593:
594:
595: struct object getSuperContext(struct object contextObj) {
1.31 takayama 596: struct object rob = OINIT;
1.1 maekawa 597: struct context *cp;
598: if (contextObj.tag != Sclass) {
599: errorStackmachine("Usage:supercontext");
600: }
601: if (contextObj.lc.ival != CLASSNAME_CONTEXT) {
602: errorStackmachine("Usage:supercontext");
603: }
604: cp = (struct context *)(contextObj.rc.voidp);
605: if (cp->super == (struct context *)NULL) {
606: return(NullObject);
607: }else{
608: rob.tag = Sclass;
609: rob.lc.ival = CLASSNAME_CONTEXT;
610: rob.rc.voidp = cp->super;
611: }
612: return(rob);
613: }
614:
615: #define CSTACK_SIZE 1000
616: void contextControl(actionOfContextControl ctl) {
617: static struct context *cstack[CSTACK_SIZE];
618: static int cstackp = 0;
619: switch(ctl) {
620: case CCRESTORE:
621: if (cstackp == 0) return;
622: else {
623: CurrentContextp = cstack[0];
624: cstackp = 0;
625: }
626: break;
627: case CCPUSH:
628: if (cstackp < CSTACK_SIZE) {
629: cstack[cstackp] = CurrentContextp;
630: cstackp++;
631: }else{
632: contextControl(CCRESTORE);
633: errorStackmachine("Context stack (cstack) is overflow. CurrentContext is restored.\n");
634: }
635: break;
636: case CCPOP:
637: if (cstackp > 0) {
638: cstackp--;
639: CurrentContextp = cstack[cstackp];
640: }
641: break;
642: default:
643: break;
644: }
645: return;
646: }
647:
648:
649:
650: int isLiteral(str)
1.7 takayama 651: char *str;
1.1 maekawa 652: {
653: if (strlen(str) <2) return(0);
654: else {
655: if ((str[0] == '/') && (str[1] != '/')) return(1);
656: else return(0);
657: }
658: }
659:
660: void printOperandStack() {
661: int i;
1.31 takayama 662: struct object ob = OINIT;
1.1 maekawa 663: int vs;
664: vs = VerboseStack; VerboseStack = 2;
665: for (i=Osp-1; i>=0; i--) {
666: fprintf(Fstack,"[%d] ",i);
667: ob = OperandStack[i];
668: printObject(ob,1,Fstack);
669: }
670: VerboseStack = vs;
671: }
672:
673:
674:
675: static initSystemDictionary()
1.7 takayama 676: {
1.1 maekawa 677: StandardStack.ostack = StandardStackA;
678: StandardStack.sp = StandardStackP;
679: StandardStack.size = OPERAND_STACK_SIZE;
680:
681: ErrorStack.ostack = ErrorStackA;
682: ErrorStack.sp = ErrorStackP;
683: ErrorStack.size = ErrorStackMax;
684:
685: StandardContext.userDictionary = UserDictionary;
686: StandardContext.contextName = "StandardContext";
687: StandardContext.super = (struct context *)NULL;
688:
689: KdefinePrimitiveFunctions();
690:
1.7 takayama 691: }
1.1 maekawa 692:
693: struct object showSystemDictionary(int f) {
694: int i;
695: int maxl;
696: char format[1000];
697: int nl;
1.31 takayama 698: struct object rob = OINIT;
1.1 maekawa 699: rob = NullObject;
700: if (f != 0) {
701: rob = newObjectArray(Sdp);
702: for (i=0; i<Sdp; i++) {
703: putoa(rob,i,KpoString((SystemDictionary[i]).key));
704: }
705: return(rob);
706: }
707: maxl = 1;
708: for (i=0; i<Sdp; i++) {
709: if (strlen((SystemDictionary[i]).key) >maxl)
710: maxl = strlen((SystemDictionary[i]).key);
711: }
712: maxl += 3;
713: nl = 80/maxl;
714: if (nl < 2) nl = 2;
715: sprintf(format,"%%-%ds",maxl);
716: for (i=0; i<Sdp; i++) {
717: fprintf(Fstack,format,(SystemDictionary[i]).key);
718: if (i % nl == nl-1) fprintf(Fstack,"\n");
719: }
720: fprintf(Fstack,"\n");
721: return(rob);
722: }
723:
724: int showUserDictionary()
725: {
726: int i,j;
727: int maxl;
728: char format[1000];
729: int nl;
730: struct dictionary *dic;
731: dic = CurrentContextp->userDictionary;
732: fprintf(Fstack,"DictionaryName=%s, super= ",CurrentContextp->contextName);
733: if (CurrentContextp->super == (struct context *)NULL) {
734: fprintf(Fstack,"NIL\n");
735: }else{
736: fprintf(Fstack,"%s\n",CurrentContextp->super->contextName);
737: }
738: maxl = 1;
739: for (i=0; i<USER_DICTIONARY_SIZE; i++) {
740: if ((dic[i]).key != EMPTY) {
741: if (strlen((dic[i]).key) >maxl)
1.7 takayama 742: maxl = strlen((dic[i]).key);
1.1 maekawa 743: }
744: }
745: maxl += 3;
746: nl = 80/maxl;
747: if (nl < 2) nl = 2;
748: sprintf(format,"%%-%ds",maxl);
749: for (i=0,j=0; i<USER_DICTIONARY_SIZE; i++) {
750: if ((dic[i]).key != EMPTY) {
751: fprintf(Fstack,format,(dic[i]).key);
752: /*{ char *sss; int ii,h0,h1;
1.7 takayama 753: sss = dic[i].key;
754: h0 = dic[i].h0;
755: h1 = dic[i].h1;
756: for (ii=0; ii<strlen(sss); ii++) fprintf(Fstack,"%x ",sss[ii]);
757: fprintf(Fstack,": h0=%d, h1=%d, %d\n",h0,h1,i);
758: }*/
1.1 maekawa 759: if (j % nl == nl-1) fprintf(Fstack,"\n");
760: j++;
761: }
762: }
763: fprintf(Fstack,"\n");
764: }
765:
766:
767: static struct object executableStringToExecutableArray(s)
1.7 takayama 768: char *s;
1.1 maekawa 769: {
770: struct tokens *tokenArray;
1.31 takayama 771: struct object ob = OINIT;
1.1 maekawa 772: int i;
773: int size;
774: tokenArray = decomposeToTokens(s,&size);
775: ob.tag = SexecutableArray;
776: ob.lc.tokenArray = tokenArray;
777: ob.rc.ival = size;
778: for (i=0; i<size; i++) {
779: if ( ((ob.lc.tokenArray)[i]).kind == EXECUTABLE_STRING) {
780: ((ob.lc.tokenArray)[i]).kind = EXECUTABLE_ARRAY;
781: ((ob.lc.tokenArray)[i]).object =
1.7 takayama 782: executableStringToExecutableArray(((ob.lc.tokenArray)[i]).token);
1.1 maekawa 783: }
784: }
785: return(ob);
786: }
787: /**************** stack machine **************************/
788: void scanner() {
789: struct tokens token;
1.31 takayama 790: struct object ob = OINIT;
1.1 maekawa 791: extern int Quiet;
792: extern void ctrlC();
1.22 takayama 793: int tmp, status;
1.1 maekawa 794: char *tmp2;
795: extern int ErrorMessageMode;
796: int jval;
1.14 takayama 797: extern int InSendmsg2;
1.22 takayama 798: int infixOn = 0;
799: struct tokens infixToken;
1.28 takayama 800: extern int RestrictedMode, RestrictedMode_saved;
1.1 maekawa 801: getokenSM(INIT);
802: initSystemDictionary();
803:
1.9 takayama 804: #if defined(__CYGWIN__)
1.39 takayama 805: if (MYSIGSETJMP(EnvOfStackMachine,1)) {
1.9 takayama 806: #else
1.39 takayama 807: if (MYSETJMP(EnvOfStackMachine)) {
1.9 takayama 808: #endif
1.1 maekawa 809: /* do nothing in the case of error */
810: fprintf(stderr,"An error or interrupt in reading macros, files and command strings.\n");
811: exit(10);
812: } else { }
1.40 takayama 813: if (mysignal(SIGINT,SIG_IGN) != SIG_IGN) {
814: mysignal(SIGINT,ctrlC);
1.1 maekawa 815: }
816:
817: /* setup quiet mode or not */
1.21 takayama 818: token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1 maekawa 819: if (Quiet) {
820: token.token = " /@@@.quiet 1 def ";
821: }else {
822: token.token = " /@@@.quiet 0 def ";
823: }
824: executeToken(token); /* execute startup commands */
1.21 takayama 825: token.kind = ID; token.tflag = 0;
1.1 maekawa 826: token.token = "exec";
827: token = lookupTokens(token); /* set hashing values */
828: tmp = findSystemDictionary(token.token);
829: ob.tag = Soperator;
830: ob.lc.ival = tmp;
831: executePrimitive(ob); /* exec */
832:
833:
834: KSdefineMacros();
835:
836: if (StartAFile) {
837: tmp2 = StartFile;
838: StartFile = (char *)sGC_malloc(sizeof(char)*(strlen(StartFile)+
1.7 takayama 839: 40));
1.1 maekawa 840: sprintf(StartFile,"$%s$ run\n",tmp2);
1.21 takayama 841: token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1 maekawa 842: token.token = StartFile;
1.7 takayama 843: executeToken(token); /* execute startup commands */
1.21 takayama 844: token.kind = ID; token.tflag = 0;
1.1 maekawa 845: token.token = "exec";
846: token = lookupTokens(token); /* set hashing values */
847: tmp = findSystemDictionary(token.token);
848: ob.tag = Soperator;
849: ob.lc.ival = tmp;
1.7 takayama 850: executePrimitive(ob); /* exec */
1.1 maekawa 851: }
852:
853: if (StartAString) {
1.21 takayama 854: token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1 maekawa 855: token.token = StartString;
1.7 takayama 856: executeToken(token); /* execute startup commands */
1.21 takayama 857: token.kind = ID; token.tflag = 0;
1.1 maekawa 858: token.token = "exec";
859: token = lookupTokens(token); /* set hashing values */
860: tmp = findSystemDictionary(token.token);
861: ob.tag = Soperator;
862: ob.lc.ival = tmp;
1.7 takayama 863: executePrimitive(ob); /* exec */
1.1 maekawa 864: }
865:
866:
867: for (;;) {
1.9 takayama 868: #if defined(__CYGWIN__)
1.39 takayama 869: if (jval=MYSIGSETJMP(EnvOfStackMachine,1)) {
1.9 takayama 870: #else
1.39 takayama 871: if (jval=MYSETJMP(EnvOfStackMachine)) {
1.9 takayama 872: #endif
1.1 maekawa 873: /* *** The following does not work properly. ****
1.7 takayama 874: if (jval == 2) {
875: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
876: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
877: }
878: }
879: **** */
1.1 maekawa 880: if (DebugStack >= 1) {
1.7 takayama 881: fprintf(Fstack,"\nscanner> ");
1.1 maekawa 882: }
1.16 takayama 883: if (!Calling_ctrlC_hook) { /* to avoid recursive call of ctrlC-hook. */
1.28 takayama 884: Calling_ctrlC_hook = 1; RestrictedMode = 0;
1.16 takayama 885: KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
1.28 takayama 886: RestrictedMode = RestrictedMode_saved;
1.16 takayama 887: }
888: Calling_ctrlC_hook = 0;
1.12 takayama 889: KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook? */
1.14 takayama 890: InSendmsg2 = 0;
1.22 takayama 891: infixOn = 0;
1.7 takayama 892: continue ;
1.1 maekawa 893: } else { }
894: if (DebugStack >= 1) { printOperandStack(); }
1.22 takayama 895: token = getokenSM(GET);
896: if ((status=executeToken(token)) < 0) break;
897: /***if (status == 1) fprintf(stderr," --- exit --- \n");*/
898: /* fprintf(stderr,"token.token=%s, status=%d, infixOn=%d\n",token.token,status,infixOn); */
899: if (status & STATUS_INFIX) {
900: infixOn = 1; infixToken = token; infixToken.tflag |= NO_DELAY;
901: }else if (infixOn) {
902: infixOn = 0;
903: if ((status=executeToken(infixToken)) < 0) break;
904: }
1.1 maekawa 905: }
906: }
907:
908:
909: void ctrlC(sig)
1.7 takayama 910: int sig;
1.1 maekawa 911: {
912: extern void ctrlC();
913: extern int ErrorMessageMode;
914: extern int SGClock;
915: extern int UserCtrlC;
916: extern int OXlock;
1.28 takayama 917: extern int RestrictedMode, RestrictedMode_saved;
1.14 takayama 918:
1.40 takayama 919: mysignal(sig,SIG_IGN);
1.1 maekawa 920: /* see 133p */
1.28 takayama 921: RestrictedMode = RestrictedMode_saved;
1.10 takayama 922: cancelAlarm();
923: if (sig == SIGALRM) {
924: fprintf(stderr,"ctrlC by SIGALRM\n");
925: }
1.1 maekawa 926:
927: if (SGClock) {
928: UserCtrlC = 1;
929: fprintf(stderr,"ctrl-c is locked because of gc.\n");
1.40 takayama 930: mysignal(sig,ctrlC); if (sig == SIGALRM) alarm((unsigned int)10);
1.1 maekawa 931: return;
932: }
933: if (OXlock) {
934: if (UserCtrlC > 0) UserCtrlC++;
935: else UserCtrlC = 1;
936: if (UserCtrlC > 3) {
937: fprintf(stderr,"OK. You are eager to cancel the computation.\n");
938: fprintf(stderr,"You should close the ox communication cannel.\n");
1.40 takayama 939: mysignal(SIGINT,ctrlC);
1.1 maekawa 940: unlockCtrlCForOx();
941: }
942: fprintf(stderr,"ctrl-c is locked because of ox lock %d.\n",UserCtrlC);
1.40 takayama 943: mysignal(sig,ctrlC); if (sig == SIGALRM) alarm((unsigned int)10);
1.1 maekawa 944: return;
945: }
946: if (ErrorMessageMode != 1) {
1.16 takayama 947: (void *) traceShowStack();
1.1 maekawa 948: fprintf(Fstack,"User interruption by ctrl-C. We are in the top-level.\n");
949: fprintf(Fstack,"Type in quit in order to exit sm1.\n");
950: }
1.16 takayama 951: traceClearStack();
1.1 maekawa 952: if (GotoP) {
953: fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
954: GotoP = 0;
955: }
956: stdOperandStack(); contextControl(CCRESTORE);
957: /*fprintf(Fstack,"Warning! The handler of ctrl-C has a bug, so you might have a core-dump.\n");*/
958: /*
959: $(x0+1)^50$ $x1 x0 + x1^20$ 2 groebner_n
960: ctrl-C
961: $(x0+1)^50$ $x1 x0 + x1^20$ 2 groebner_n
962: It SOMETIMES makes core dump.
963: */
964: getokenSM(INIT); /* It might fix the bug above. 1992/11/14 */
1.40 takayama 965: mysignal(SIGINT,ctrlC);
1.9 takayama 966: #if defined(__CYGWIN__)
1.39 takayama 967: MYSIGLONGJMP(EnvOfStackMachine,2);
1.9 takayama 968: #else
1.39 takayama 969: MYLONGJMP(EnvOfStackMachine,2); /* returns 2 for ctrl-C */
1.9 takayama 970: #endif
1.1 maekawa 971: }
972:
973: int executeToken(token)
1.7 takayama 974: struct tokens token;
1.1 maekawa 975: {
1.31 takayama 976: struct object ob = OINIT;
1.1 maekawa 977: int primitive;
978: int size;
979: int status;
980: int i,h0,h1;
981: extern int WarningMessageMode;
982: extern int Strict;
1.14 takayama 983: extern int InSendmsg2;
1.28 takayama 984: extern int RestrictedMode, RestrictedMode_saved;
985: int localRestrictedMode_saved;
1.1 maekawa 986:
1.28 takayama 987: localRestrictedMode_saved = 0;
1.1 maekawa 988: if (GotoP) { /* for goto */
989: if (token.kind == ID && isLiteral(token.token)) {
990: if (strcmp(&((token.token)[1]),GotoLabel) == 0) {
1.7 takayama 991: GotoP = 0;
992: return(0); /* normal exit */
1.1 maekawa 993: }
994: }
995: return(0); /* normal exit */
996: }
997: if (token.kind == DOLLAR) {
998: ob.tag = Sdollar;
999: ob.lc.str = token.token;
1000: Kpush(ob);
1001: } else if (token.kind == ID) { /* ID */
1002:
1003: if (strcmp(token.token,"exit") == 0) return(1);
1004: /* "exit" is not primitive here. */
1005:
1006: if (isLiteral(token.token)) {
1007: /* literal object */
1008: ob.tag = Sstring;
1009: ob.lc.str = (char *)sGC_malloc((strlen(token.token)+1)*sizeof(char));
1010: if (ob.lc.str == (char *)NULL) errorStackmachine("No space.");
1011: strcpy(ob.lc.str, &((token.token)[1]));
1012:
1013: if (token.object.tag != Slist) {
1.7 takayama 1014: fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
1015: token.object = lookupLiteralString(token.token);
1.1 maekawa 1016: }
1017: ob.rc.op = token.object.lc.op;
1018: Kpush(ob);
1019: } else if (isInteger(token.token)) {
1020: /* integer object */
1021: ob.tag = Sinteger ;
1022: ob.lc.ival = strToInteger(token.token);
1023: Kpush(ob);
1024: } else {
1025: if (token.object.tag != Slist) {
1.7 takayama 1026: fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
1027: token = lookupTokens(token);
1.1 maekawa 1028: }
1029: h0 = ((token.object.lc.op)->lc).ival;
1030: h1 = ((token.object.lc.op)->rc).ival;
1031: ob=findUserDictionary(token.token,h0,h1,CurrentContextp);
1032: primitive = ((token.object.rc.op)->lc).ival;
1.22 takayama 1033: if (!(token.tflag & NO_DELAY)) {
1034: if ((ob.tag >= 0) && (UD_attr & ATTR_INFIX)) {
1.24 takayama 1035: return STATUS_INFIX;
1.22 takayama 1036: }
1037: }
1.1 maekawa 1038: if (ob.tag >= 0) {
1.7 takayama 1039: /* there is a definition in the user dictionary */
1040: if (ob.tag == SexecutableArray) {
1.28 takayama 1041: if (RestrictedMode) {
1042: if (UD_attr & ATTR_EXPORT) {
1043: localRestrictedMode_saved = RestrictedMode; RestrictedMode = 0;
1.29 takayama 1044: if (isThereExecutableArrayOnStack(5)) {
1045: int i;
1046: for (i=0; i<5; i++) { (void) Kpop(); }
1047: errorStackmachine("Executable array is on the argument stack (restricted mode). They are automatically removed.\n");
1048: }
1.28 takayama 1049: }else{
1050: tracePushName(token.token);
1051: errorStackmachine("You cannot execute this function in restricted mode.\n");
1052: }
1053: }
1054:
1.25 takayama 1055: status = executeExecutableArray(ob,token.token,0);
1.28 takayama 1056:
1057: if (localRestrictedMode_saved) RestrictedMode = localRestrictedMode_saved;
1.24 takayama 1058: if ((status & STATUS_BREAK) || (status < 0)) return status;
1.7 takayama 1059: }else {
1060: Kpush(ob);
1061: }
1.1 maekawa 1062: } else if (primitive) {
1.15 takayama 1063: tracePushName(token.token);
1.7 takayama 1064: /* system operator */
1065: ob.tag = Soperator;
1066: ob.lc.ival = primitive;
1.15 takayama 1067: status = executePrimitive(ob);
1.18 takayama 1068: tracePopName();
1.15 takayama 1069: return(status);
1.1 maekawa 1070: } else {
1.14 takayama 1071: if (QuoteMode) {
1072: if (InSendmsg2) return(DO_QUOTE);
1073: else {
1074: Kpush(KpoString(token.token));
1075: return(0); /* normal exit.*/
1076: }
1.13 takayama 1077: }
1.35 takayama 1078: {
1.7 takayama 1079: char tmpc[1024];
1080: if (strlen(token.token) < 900) {
1.36 takayama 1081: sprintf(tmpc,"\n>>Warning: The identifier <<%s>> is not in the system dictionary\n>> nor in the user dictionaries. Push NullObject.\n",token.token);
1082: }else {strcpy(tmpc,"\n>>Warning: identifier is not in the dictionaries.\n");}
1083: /* do not use %% in a string. tmpc will be used as fprintf(stderr,tmpc); */
1.35 takayama 1084: if (WarningMessageMode == 1 || WarningMessageMode == 2) {
1085: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));
1086: }
1087: if (WarningMessageMode != 1) {
1088: fprintf(Fstack,"%s",tmpc);
1089: /*fprintf(Fstack,"(%d,%d)\n",h0,h1);*/
1090: }
1091: if (Strict) {
1092: errorStackmachine(tmpc);
1093: }
1094: Kpush(NullObject);
1.7 takayama 1095: }
1.1 maekawa 1096: }
1097: }
1098: } else if (token.kind == EXECUTABLE_STRING) {
1099: Kpush(executableStringToExecutableArray(token.token));
1100: } else if (token.kind == EXECUTABLE_ARRAY) {
1101: Kpush(token.object);
1102: } else if ((token.kind == -1) || (token.kind == -2)) { /* eof token */
1103: return(-1);
1104: } else {
1105: /*fprintf(Fstack,"\n%%Error: Unknown token type\n");***/
1106: fprintf(stderr,"\nUnknown token type = %d\n",token.kind);
1107: fprintf(stderr,"\ntype in ctrl-\\ if you like to make core-dump.\n");
1108: fprintf(stderr,"If you like to continue, type in RETURN key.\n");
1109: fprintf(stderr,"Note that you cannot input null string.\n");
1110: getchar();
1111: errorStackmachine("Error: Unknown token type.\n");
1112: /* return(-2); /* exit */
1113: }
1114: return(0); /* normal exit */
1115: }
1116:
1117:
1118:
1119:
1120: errorStackmachine(str)
1.7 takayama 1121: char *str;
1.1 maekawa 1122: {
1123: int i,j,k;
1124: static char *u="Usage:";
1125: char message0[1024];
1126: char *message;
1127: extern int ErrorMessageMode;
1.28 takayama 1128: extern int RestrictedMode, RestrictedMode_saved;
1129: RestrictedMode = RestrictedMode_saved;
1.10 takayama 1130: cancelAlarm();
1.33 takayama 1131: MsgStackTrace = NULL;
1132: MsgSourceTrace = NULL;
1.1 maekawa 1133: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
1134: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));
1135: }
1136: if (ErrorMessageMode != 1) {
1137: message = message0;
1138: i = 0;
1139: while (i<6 && str[i]!='0') {
1140: if (str[i] != u[i]) break;
1141: i++;
1142: }
1143: if (i==6) {
1144: fprintf(stderr,"ERROR(sm): \n");
1145: while (str[i] != '\0' && str[i] != ' ') {
1.7 takayama 1146: i++;
1.1 maekawa 1147: }
1148: if (str[i] == ' ') {
1.7 takayama 1149: fprintf(stderr," %s\n",&(str[i+1]));
1150: k = 0;
1151: if (i-6 > 1022) message = (char *)sGC_malloc(sizeof(char)*i);
1152: for (j=6; j<i ; j++) {
1153: message[k] = str[j];
1154: message[k+1] = '\0';
1155: k++;
1156: }
1157: Kusage2(stderr,message);
1.1 maekawa 1158: }else{
1.7 takayama 1159: Kusage2(stderr,&(str[6]));
1.1 maekawa 1160: }
1161: }else {
1162: fprintf(stderr,"ERROR(sm): ");
1163: fprintf(stderr,str);
1164: }
1165: fprintf(stderr,"\n");
1.34 takayama 1166: MsgStackTraceInArrayp = traceNameStackToArrayp();
1.33 takayama 1167: MsgStackTrace = traceShowStack();
1168: MsgSourceTrace = traceShowScannerBuf();
1.1 maekawa 1169: }
1.16 takayama 1170: traceClearStack();
1.1 maekawa 1171: if (GotoP) {
1172: fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
1173: GotoP = 0;
1174: }
1175: stdOperandStack(); contextControl(CCRESTORE);
1176: getokenSM(INIT); /* It might fix the bug. 1996/3/10 */
1177: /* fprintf(stderr,"Now, Long jump!\n"); */
1.39 takayama 1178: MYLONGJMP(EnvOfStackMachine,1);
1.1 maekawa 1179: }
1180:
1181: warningStackmachine(str)
1.7 takayama 1182: char *str;
1.1 maekawa 1183: {
1184: extern int WarningMessageMode;
1185: extern int Strict;
1186: if (WarningMessageMode == 1 || WarningMessageMode == 2) {
1187: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));
1188: }
1189: if (WarningMessageMode != 1) {
1190: fprintf(stderr,"WARNING(sm): ");
1191: fprintf(stderr,str);
1192: }
1193: if (Strict) errorStackmachine(" ");
1194: return(0);
1195: }
1196:
1197:
1198: /* exports */
1199: /* NOTE: If you call this function and an error occured,
1200: you have to reset the jump buffer by setjmp(EnvOfStackMachine).
1201: cf. kxx/memo1.txt, kxx/stdserver00.c 1998, 2/6 */
1202: KSexecuteString(s)
1.7 takayama 1203: char *s;
1.1 maekawa 1204: {
1205: struct tokens token;
1.31 takayama 1206: struct object ob = OINIT;
1.1 maekawa 1207: int tmp;
1208: extern int CatchCtrlC;
1209: int jval;
1210: static int recursive = 0;
1211: extern int ErrorMessageMode;
1212: extern int KSPushEnvMode;
1213: jmp_buf saved_EnvOfStackMachine;
1214: void (*sigfunc)();
1215: int localCatchCtrlC ;
1.28 takayama 1216: extern int RestrictedMode, RestrictedMode_saved;
1.1 maekawa 1217:
1218: localCatchCtrlC = CatchCtrlC;
1219: /* If CatchCtrlC is rewrited in this program,
1220: we crash. So, we use localCatchCtrlC. */
1221:
1222: if (localCatchCtrlC) {
1.40 takayama 1223: sigfunc = mysignal(SIGINT,SIG_IGN);
1224: mysignal(SIGINT,ctrlC);
1.1 maekawa 1225: }
1226:
1227: if (KSPushEnvMode) {
1228: *saved_EnvOfStackMachine = *EnvOfStackMachine;
1.9 takayama 1229: #if defined(__CYGWIN__)
1.39 takayama 1230: if (jval = MYSIGSETJMP(EnvOfStackMachine,1)) {
1.9 takayama 1231: #else
1.39 takayama 1232: if (jval = MYSETJMP(EnvOfStackMachine)) {
1.9 takayama 1233: #endif
1.1 maekawa 1234: *EnvOfStackMachine = *saved_EnvOfStackMachine;
1235: if (jval == 2) {
1.7 takayama 1236: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
1237: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
1238: }
1.1 maekawa 1239: }
1240: recursive--;
1.40 takayama 1241: if (localCatchCtrlC) { mysignal(SIGINT, sigfunc); }
1.16 takayama 1242: if (!Calling_ctrlC_hook) {
1.28 takayama 1243: Calling_ctrlC_hook = 1; RestrictedMode = 0;
1.16 takayama 1244: KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
1.28 takayama 1245: RestrictedMode_saved;
1.16 takayama 1246: }
1247: Calling_ctrlC_hook = 0;
1.12 takayama 1248: KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/
1.42 ! takayama 1249: /* fprintf(stderr,"result code=-1 for %s\n",s); */
1.1 maekawa 1250: return(-1);
1251: }else{ }
1252: }else{
1253: if (recursive == 0) {
1.9 takayama 1254: #if defined(__CYGWIN__)
1.39 takayama 1255: if (jval=MYSIGSETJMP(EnvOfStackMachine,1)) {
1.9 takayama 1256: #else
1.39 takayama 1257: if (jval=MYSETJMP(EnvOfStackMachine)) {
1.9 takayama 1258: #endif
1.7 takayama 1259: if (jval == 2) {
1260: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
1261: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
1262: }
1263: }
1264: recursive = 0;
1.40 takayama 1265: if (localCatchCtrlC) { mysignal(SIGINT, sigfunc); }
1.16 takayama 1266: if (!Calling_ctrlC_hook) {
1.28 takayama 1267: Calling_ctrlC_hook = 1; RestrictedMode = 0;
1.16 takayama 1268: KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
1.28 takayama 1269: RestrictedMode = RestrictedMode_saved;
1.16 takayama 1270: }
1271: Calling_ctrlC_hook = 0;
1272: Calling_ctrlC_hook = 0;
1.11 takayama 1273: KSexecuteString(" (Computation is interrupted.) ");
1.42 ! takayama 1274: /* fprintf(stderr,"result code=-1 for %s\n",s);*/
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;
1.40 takayama 1293: if (localCatchCtrlC) { mysignal(SIGINT, sigfunc); }
1.1 maekawa 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.39 takayama 1330: if (MYSETJMP(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);
1.40 takayama 1628: mysignal(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