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