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