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