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