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