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