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