Annotation of OpenXM/src/kan96xx/Kan/stackmachine.c, Revision 1.35
1.35 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/stackmachine.c,v 1.34 2006/02/01 00:30:05 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.35 ! takayama 1068: {
1.7 takayama 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);
1.35 ! takayama 1072: }else {strcpy(tmpc,"\n%%Warning: identifier is not in the dictionaries.\n");}
! 1073: if (WarningMessageMode == 1 || WarningMessageMode == 2) {
! 1074: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));
! 1075: }
! 1076: if (WarningMessageMode != 1) {
! 1077: fprintf(Fstack,"%s",tmpc);
! 1078: /*fprintf(Fstack,"(%d,%d)\n",h0,h1);*/
! 1079: }
! 1080: if (Strict) {
! 1081: errorStackmachine(tmpc);
! 1082: }
! 1083: Kpush(NullObject);
1.7 takayama 1084: }
1.1 maekawa 1085: }
1086: }
1087: } else if (token.kind == EXECUTABLE_STRING) {
1088: Kpush(executableStringToExecutableArray(token.token));
1089: } else if (token.kind == EXECUTABLE_ARRAY) {
1090: Kpush(token.object);
1091: } else if ((token.kind == -1) || (token.kind == -2)) { /* eof token */
1092: return(-1);
1093: } else {
1094: /*fprintf(Fstack,"\n%%Error: Unknown token type\n");***/
1095: fprintf(stderr,"\nUnknown token type = %d\n",token.kind);
1096: fprintf(stderr,"\ntype in ctrl-\\ if you like to make core-dump.\n");
1097: fprintf(stderr,"If you like to continue, type in RETURN key.\n");
1098: fprintf(stderr,"Note that you cannot input null string.\n");
1099: getchar();
1100: errorStackmachine("Error: Unknown token type.\n");
1101: /* return(-2); /* exit */
1102: }
1103: return(0); /* normal exit */
1104: }
1105:
1106:
1107:
1108:
1109: errorStackmachine(str)
1.7 takayama 1110: char *str;
1.1 maekawa 1111: {
1112: int i,j,k;
1113: static char *u="Usage:";
1114: char message0[1024];
1115: char *message;
1116: extern int ErrorMessageMode;
1.28 takayama 1117: extern int RestrictedMode, RestrictedMode_saved;
1118: RestrictedMode = RestrictedMode_saved;
1.10 takayama 1119: cancelAlarm();
1.33 takayama 1120: MsgStackTrace = NULL;
1121: MsgSourceTrace = NULL;
1.1 maekawa 1122: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
1123: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));
1124: }
1125: if (ErrorMessageMode != 1) {
1126: message = message0;
1127: i = 0;
1128: while (i<6 && str[i]!='0') {
1129: if (str[i] != u[i]) break;
1130: i++;
1131: }
1132: if (i==6) {
1133: fprintf(stderr,"ERROR(sm): \n");
1134: while (str[i] != '\0' && str[i] != ' ') {
1.7 takayama 1135: i++;
1.1 maekawa 1136: }
1137: if (str[i] == ' ') {
1.7 takayama 1138: fprintf(stderr," %s\n",&(str[i+1]));
1139: k = 0;
1140: if (i-6 > 1022) message = (char *)sGC_malloc(sizeof(char)*i);
1141: for (j=6; j<i ; j++) {
1142: message[k] = str[j];
1143: message[k+1] = '\0';
1144: k++;
1145: }
1146: Kusage2(stderr,message);
1.1 maekawa 1147: }else{
1.7 takayama 1148: Kusage2(stderr,&(str[6]));
1.1 maekawa 1149: }
1150: }else {
1151: fprintf(stderr,"ERROR(sm): ");
1152: fprintf(stderr,str);
1153: }
1154: fprintf(stderr,"\n");
1.34 takayama 1155: MsgStackTraceInArrayp = traceNameStackToArrayp();
1.33 takayama 1156: MsgStackTrace = traceShowStack();
1157: MsgSourceTrace = traceShowScannerBuf();
1.1 maekawa 1158: }
1.16 takayama 1159: traceClearStack();
1.1 maekawa 1160: if (GotoP) {
1161: fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
1162: GotoP = 0;
1163: }
1164: stdOperandStack(); contextControl(CCRESTORE);
1165: getokenSM(INIT); /* It might fix the bug. 1996/3/10 */
1166: /* fprintf(stderr,"Now, Long jump!\n"); */
1167: longjmp(EnvOfStackMachine,1);
1168: }
1169:
1170: warningStackmachine(str)
1.7 takayama 1171: char *str;
1.1 maekawa 1172: {
1173: extern int WarningMessageMode;
1174: extern int Strict;
1175: if (WarningMessageMode == 1 || WarningMessageMode == 2) {
1176: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,str));
1177: }
1178: if (WarningMessageMode != 1) {
1179: fprintf(stderr,"WARNING(sm): ");
1180: fprintf(stderr,str);
1181: }
1182: if (Strict) errorStackmachine(" ");
1183: return(0);
1184: }
1185:
1186:
1187: /* exports */
1188: /* NOTE: If you call this function and an error occured,
1189: you have to reset the jump buffer by setjmp(EnvOfStackMachine).
1190: cf. kxx/memo1.txt, kxx/stdserver00.c 1998, 2/6 */
1191: KSexecuteString(s)
1.7 takayama 1192: char *s;
1.1 maekawa 1193: {
1194: struct tokens token;
1.31 takayama 1195: struct object ob = OINIT;
1.1 maekawa 1196: int tmp;
1197: extern int CatchCtrlC;
1198: int jval;
1199: static int recursive = 0;
1200: extern int ErrorMessageMode;
1201: extern int KSPushEnvMode;
1202: jmp_buf saved_EnvOfStackMachine;
1203: void (*sigfunc)();
1204: int localCatchCtrlC ;
1.28 takayama 1205: extern int RestrictedMode, RestrictedMode_saved;
1.1 maekawa 1206:
1207: localCatchCtrlC = CatchCtrlC;
1208: /* If CatchCtrlC is rewrited in this program,
1209: we crash. So, we use localCatchCtrlC. */
1210:
1211: if (localCatchCtrlC) {
1212: sigfunc = signal(SIGINT,SIG_IGN);
1213: signal(SIGINT,ctrlC);
1214: }
1215:
1216: if (KSPushEnvMode) {
1217: *saved_EnvOfStackMachine = *EnvOfStackMachine;
1.9 takayama 1218: #if defined(__CYGWIN__)
1219: if (jval = sigsetjmp(EnvOfStackMachine,1)) {
1220: #else
1.1 maekawa 1221: if (jval = setjmp(EnvOfStackMachine)) {
1.9 takayama 1222: #endif
1.1 maekawa 1223: *EnvOfStackMachine = *saved_EnvOfStackMachine;
1224: if (jval == 2) {
1.7 takayama 1225: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
1226: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
1227: }
1.1 maekawa 1228: }
1229: recursive--;
1230: if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
1.16 takayama 1231: if (!Calling_ctrlC_hook) {
1.28 takayama 1232: Calling_ctrlC_hook = 1; RestrictedMode = 0;
1.16 takayama 1233: KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
1.28 takayama 1234: RestrictedMode_saved;
1.16 takayama 1235: }
1236: Calling_ctrlC_hook = 0;
1.12 takayama 1237: KSexecuteString(" (Computation is interrupted.) "); /* move to ctrlC-hook?*/
1.1 maekawa 1238: return(-1);
1239: }else{ }
1240: }else{
1241: if (recursive == 0) {
1.9 takayama 1242: #if defined(__CYGWIN__)
1243: if (jval=sigsetjmp(EnvOfStackMachine,1)) {
1244: #else
1.1 maekawa 1245: if (jval=setjmp(EnvOfStackMachine)) {
1.9 takayama 1246: #endif
1.7 takayama 1247: if (jval == 2) {
1248: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
1249: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,"User interrupt by ctrl-C."));
1250: }
1251: }
1252: recursive = 0;
1253: if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
1.16 takayama 1254: if (!Calling_ctrlC_hook) {
1.28 takayama 1255: Calling_ctrlC_hook = 1; RestrictedMode = 0;
1.16 takayama 1256: KSexecuteString(" ctrlC-hook "); /* Execute User Defined functions. */
1.28 takayama 1257: RestrictedMode = RestrictedMode_saved;
1.16 takayama 1258: }
1259: Calling_ctrlC_hook = 0;
1260: Calling_ctrlC_hook = 0;
1.11 takayama 1261: KSexecuteString(" (Computation is interrupted.) ");
1.7 takayama 1262: return(-1);
1.1 maekawa 1263: }else { }
1264: }
1265: }
1266:
1267: recursive++;
1268: token.token = s;
1.21 takayama 1269: token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1 maekawa 1270: executeToken(token);
1.21 takayama 1271: token.kind = ID; token.tflag = 0;
1.1 maekawa 1272: token.token = "exec";
1273: token = lookupTokens(token); /* no use */
1274: tmp = findSystemDictionary(token.token);
1275: ob.tag = Soperator;
1276: ob.lc.ival = tmp;
1277: executePrimitive(ob);
1278: recursive--;
1279: if (KSPushEnvMode) *EnvOfStackMachine = *saved_EnvOfStackMachine;
1280: if (localCatchCtrlC) { signal(SIGINT, sigfunc); }
1281: return(0);
1282: }
1283:
1284: KSdefineMacros() {
1285: struct tokens token;
1286: int tmp;
1.31 takayama 1287: struct object ob = OINIT;
1.1 maekawa 1288:
1289: if (StandardMacros && (strlen(SMacros))) {
1.21 takayama 1290: token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1 maekawa 1291: token.token = SMacros;
1.7 takayama 1292: executeToken(token); /* execute startup commands */
1.21 takayama 1293: token.kind = ID; token.tflag = 0;
1.1 maekawa 1294: token.token = "exec";
1295: token = lookupTokens(token); /* no use */
1296: tmp = findSystemDictionary(token.token);
1297: ob.tag = Soperator;
1298: ob.lc.ival = tmp;
1.7 takayama 1299: executePrimitive(ob); /* exec */
1.1 maekawa 1300: }
1301: return(0);
1302:
1303: }
1304:
1305: void KSstart() {
1306: struct tokens token;
1307: int tmp;
1.31 takayama 1308: struct object ob = OINIT;
1.1 maekawa 1309: extern int Quiet;
1310:
1311: stackmachine_init(); KinitKan();
1312: getokenSM(INIT); initSystemDictionary();
1313:
1314: /* The following line may cause a core dump, if you do not setjmp properly
1315: after calling KSstart().*/
1316: /*
1.7 takayama 1317: if (setjmp(EnvOfStackMachine)) {
1.1 maekawa 1318: fprintf(stderr,"KSstart(): An error or interrupt in reading macros, files and command strings.\n");
1319: exit(10);
1.7 takayama 1320: } else { } */
1.1 maekawa 1321:
1322: /* setup quiet mode or not */
1.21 takayama 1323: token.kind = EXECUTABLE_STRING; token.tflag = 0;
1.1 maekawa 1324: if (Quiet) {
1325: token.token = " /@@@.quiet 1 def ";
1326: }else {
1327: token.token = " /@@@.quiet 0 def ";
1328: }
1329: executeToken(token); /* execute startup commands */
1.21 takayama 1330: token.kind = ID; token.tflag = 0;
1.1 maekawa 1331: token.token = "exec";
1332: token = lookupTokens(token); /* set hashing values */
1333: tmp = findSystemDictionary(token.token);
1334: ob.tag = Soperator;
1335: ob.lc.ival = tmp;
1336: executePrimitive(ob); /* exec */
1337:
1338: KSdefineMacros();
1339: }
1340:
1341: void KSstop() {
1342: Kclose(); stackmachine_close();
1343: }
1344:
1345:
1346: struct object KSpop() {
1347: return(Kpop());
1348: }
1349:
1350: void KSpush(ob)
1.7 takayama 1351: struct object ob;
1.1 maekawa 1352: {
1353: Kpush(ob);
1.4 takayama 1354: }
1355:
1356: struct object KSpeek(k) {
1357: return(peek(k));
1.1 maekawa 1358: }
1359:
1360: char *KSstringPop() {
1361: /* pop a string */
1.31 takayama 1362: struct object rob = OINIT;
1.1 maekawa 1363: rob = Kpop();
1364: if (rob.tag == Sdollar) {
1365: return(rob.lc.str);
1366: }else{
1367: return((char *)NULL);
1368: }
1369: }
1370:
1371: char *KSpopString() {
1372: return(KSstringPop());
1373: }
1374:
1375: int KSset(char *name) {
1376: char *tmp2;
1377: char tmp[1024];
1378: tmp2 = tmp;
1379: if (strlen(name) < 1000) {
1380: sprintf(tmp2," /%s set ",name);
1381: }else{
1382: tmp2 = sGC_malloc(sizeof(char)*(strlen(name)+20));
1383: if (tmp2 == (char *)NULL) errorStackmachine("Out of memory.");
1384: sprintf(tmp2," /%s set ",name);
1385: }
1386: return( KSexecuteString(tmp2) );
1387: }
1388:
1389: int KSpushBinary(int size,char *data) {
1390: /* struct object KbinaryToObject(int size, char *data); */
1391: errorStackmachine("KSpushBinary is not implemented.\n");
1392: return(-1);
1393: }
1394:
1395: char *KSpopBinary(int *size) {
1396: /* char *KobjectToBinary(struct object ob,int *size); */
1397: errorStackmachine("KSpopBinary is not implemented.\n");
1398: *size = 0;
1399: return((char *)NULL);
1400: }
1401:
1.34 takayama 1402: struct object KSnewObjectArray(int k) {
1403: return newObjectArray(k);
1404: }
1405:
1.1 maekawa 1406: int pushErrorStack(struct object obj)
1407: {
1408: if (CurrentOperandStack == &ErrorStack) {
1409: fprintf(stderr,"You cannot call pushErrorStack when ErrorStack is the CurrentOperandStack. \n");
1410: return(-1);
1411: }
1412: (ErrorStack.ostack)[(ErrorStack.sp)++] = obj;
1413: /* printf("ErrorStack.sp = %d\n",ErrorStack.sp); */
1414: if ((ErrorStack.sp) >= (ErrorStack.size)) {
1415: ErrorStack.sp = 0;
1416: fprintf(stderr,"pushErrorStack():ErrorStack overflow. It is reset.\n");
1417: /* Note that it avoids recursive call.*/
1418: return(-1);
1419: }
1420: return(0);
1421: }
1422:
1423: struct object popErrorStack(void) {
1424: if (CurrentOperandStack == &ErrorStack) {
1425: fprintf(stderr,"You cannot call popErrorStack when ErrorStack is the CurrentOperandStack. \n");
1426: return(NullObject);
1427: }
1428: if ((ErrorStack.sp) <= 0) {
1429: return( NullObject );
1430: }else{
1431: return( (ErrorStack.ostack)[--(ErrorStack.sp)]);
1432: }
1433: }
1434:
1435: char *popErrorStackByString(void) {
1.31 takayama 1436: struct object obj = OINIT;
1437: struct object eobj = OINIT;
1.1 maekawa 1438: eobj = popErrorStack();
1439: if (ectag(eobj) != CLASSNAME_ERROR_PACKET) {
1440: return(NULL);
1441: }else{
1442: obj = *(KopErrorPacket(eobj));
1443: }
1444: if (obj.tag != Sarray || getoaSize(obj) != 3) {
1445: fprintf(stderr,"errorPacket format error.\n");
1446: printObject(eobj,0,stderr); fflush(stderr);
1447: return("class errorPacket format error. Bug of sm1.");
1448: }
1449: obj = getoa(obj,2);
1450: if (obj.tag != Sdollar) {
1451: fprintf(stderr,"errorPacket format error at position 2..\n");
1452: printObject(eobj,0,stderr); fflush(stderr);
1453: return("class errorPacket format error at the position 2. Bug of sm1.");
1454: }
1455: return(KopString(obj));
1456: }
1457:
1458:
1459: int KScheckErrorStack(void)
1460: {
1461: return(ErrorStack.sp);
1462: }
1463:
1464: struct object KnewErrorPacket(int serial,int no,char *message)
1465: {
1.31 takayama 1466: struct object obj = OINIT;
1.1 maekawa 1467: struct object *myop;
1468: char *s;
1469: /* Set extended tag. */
1470: obj.tag = Sclass; obj.lc.ival = CLASSNAME_ERROR_PACKET ;
1471: myop = (struct object *)sGC_malloc(sizeof(struct object));
1472: if (myop == (struct object *)NULL) errorStackmachine("No memory\n");
1473: *myop = newObjectArray(3);
1474: /*fprintf(stderr,"newErrorPacket() in stackmachine.c: [%d, %d, %s] \n",serial,no,message); **kxx:CMO_ERROR */
1475: putoa((*myop),0,KpoInteger(serial));
1476: putoa((*myop),1,KpoInteger(no));
1477: s = (char *)sGC_malloc(sizeof(char)*(strlen(message)+2));
1478: if (s == (char *)NULL) errorStackmachine("No memory\n");
1479: strcpy(s,message);
1480: putoa((*myop),2,KpoString(s));
1481: obj.rc.op = myop;
1482: return(obj);
1483: }
1484:
1485:
1486: struct object KnewErrorPacketObj(struct object ob1)
1487: {
1.31 takayama 1488: struct object obj = OINIT;
1.1 maekawa 1489: struct object *myop;
1490: char *s;
1491: /* Set extended tag. */
1492: obj.tag = Sclass; obj.lc.ival = CLASSNAME_ERROR_PACKET ;
1493: myop = (struct object *)sGC_malloc(sizeof(struct object));
1494: if (myop == (struct object *)NULL) errorStackmachine("No memory\n");
1495: *myop = ob1;
1496: obj.rc.op = myop;
1497: return(obj);
1498: }
1499:
1500: void *sGC_malloc(size_t n) { /* synchronized function */
1501: void *c;
1502: int id;
1503: extern int SGClock, UserCtrlC;
1504:
1505: SGClock = 1;
1506: c = GC_malloc(n);
1507: SGClock = 0;
1508: if (UserCtrlC) {
1509: UserCtrlC = 0;
1510: id = getpid();
1511: kill(id,SIGINT);
1512: return(c);
1513: }else{
1514: return(c);
1515: }
1516: }
1517:
1518: void *sGC_realloc(void *p,size_t new) { /* synchronized function */
1519: void *c;
1520: int id;
1521: extern int SGClock, UserCtrlC;
1522:
1523: SGClock = 1;
1524: c = GC_realloc(p,new);
1525: SGClock = 0;
1526: if (UserCtrlC) {
1527: UserCtrlC = 0;
1528: id = getpid();
1529: kill(id,SIGINT);
1530: return(c);
1531: }else{
1532: return(c);
1533: }
1534: }
1535:
1536: void sGC_free(void *c) { /* synchronized function */
1537: int id;
1538: extern int SGClock, UserCtrlC;
1539:
1540: SGClock = 1;
1541: GC_free(c);
1542: SGClock = 0;
1543: if (UserCtrlC) {
1544: UserCtrlC = 0;
1545: id = getpid();
1546: kill(id,SIGINT);
1547: return;
1548: }else{
1549: return;
1550: }
1551: }
1552:
1553: void lockCtrlCForOx() {
1554: extern int OXlock;
1555: extern int OXlockSaved;
1556: OXlockSaved = OXlock;
1557: OXlock = 1;
1558: }
1559:
1560: void unlockCtrlCForOx() {
1561: int id;
1562: extern int OXlock, UserCtrlC;
1563: extern int OXlockSaved;
1564: OXlockSaved = OXlock;
1565: OXlock = 0;
1566: if (UserCtrlC) {
1567: UserCtrlC = 0;
1568: id = getpid();
1569: kill(id,SIGINT);
1570: return;
1571: }else{
1572: return;
1573: }
1574: }
1575:
1576: void restoreLockCtrlCForOx() {
1577: extern int OXlock;
1578: extern int OXlockSaved;
1579: OXlock = OXlockSaved;
1580: }
1581:
1582: int KSstackPointer() {
1583: return(Osp);
1584: }
1585:
1586: struct object KSdupErrors() {
1.31 takayama 1587: struct object rob = OINIT;
1588: struct object ob = OINIT;
1.1 maekawa 1589: int i;
1590: int n;
1591: int m;
1592:
1593: n = KSstackPointer();
1594: m = 0;
1595: for (i=0; i<n; i++) {
1596: ob = peek(i);
1597: if (ob.tag == Sclass && ectag(ob) == CLASSNAME_ERROR_PACKET) {
1598: m++;
1599: }
1600: }
1601: rob = newObjectArray(m);
1602: m = 0;
1603: for (i=0; i<n; i++) {
1604: ob = peek(i);
1605: if (ob.tag == Sclass && ectag(ob) == CLASSNAME_ERROR_PACKET) {
1606: putoa(rob, m, ob);
1607: m++;
1608: }
1609: }
1610: return(rob);
1611: }
1.10 takayama 1612:
1613: void cancelAlarm() {
1614: alarm((unsigned int) 0);
1615: signal(SIGALRM,SIG_DFL);
1.15 takayama 1616: }
1617:
1618: /* back-trace */
1619: #define TraceNameStackSize 3000
1620: char *TraceNameStack[TraceNameStackSize];
1621: int TraceNameStackp = 0;
1622: void tracePushName(char *s) {
1623: char *t;
1624: /*
1625: t = (char *)sGC_malloc(strlen(s)+1);
1626: if (t == NULL) {
1627: fprintf(stderr,"No more memory.\n"); return;
1628: }
1629: strcpy(t,s);
1630: */
1631: t = s;
1632: TraceNameStack[TraceNameStackp++] = t;
1633: if (TraceNameStackp >= TraceNameStackSize) {
1634: fprintf(stderr,"Warning: TraceNameStack overflow. Clearing the stack.\n");
1635: TraceNameStackp = 0;
1636: }
1637: }
1638: void traceClearStack(void) {
1639: TraceNameStackp = 0;
1640: }
1641: char *tracePopName(void) {
1642: if (TraceNameStackp <= 0) return (char *) NULL;
1643: return TraceNameStack[--TraceNameStackp];
1.34 takayama 1644: }
1645: struct object *traceNameStackToArrayp(void) {
1646: int n,i;
1647: struct object *op;
1648: op = sGC_malloc(sizeof(struct object));
1649: n = TraceNameStackp; if (n < 0) n = 0;
1650: *op = newObjectArray(n);
1651: for (i=0; i<n; i++) {
1652: putoa((*op),i, KpoString(TraceNameStack[i]));
1653: }
1654: return op;
1.15 takayama 1655: }
1656: #define TRACE_MSG_SIZE 320
1657: char *traceShowStack(void) {
1658: char *s;
1659: char *t;
1660: int p;
1661: s = (char *) sGC_malloc(TRACE_MSG_SIZE);
1662: if (s == NULL) {
1663: fprintf(stderr,"No more memory.\n"); return NULL;
1664: }
1665: sprintf(s,"Trace: ");
1666: p = strlen(s);
1667: do {
1668: t = tracePopName();
1669: if (t == NULL) {
1670: s[p] = ';'; s[p+1] = 0;
1671: break;
1.26 takayama 1672: }else if ((strlen(t) + p) > (TRACE_MSG_SIZE-10)) {
1673: /* fprintf(stderr,"p=%d, TraceNameStackp=%d, strlen(t)=%d, t=%s\n",p,TraceNameStackp,strlen(t),t); */
1.15 takayama 1674: strcpy(&(s[p])," ...");
1675: break;
1676: }
1677: strcpy(&(s[p]),t); p += strlen(t);
1678: strcpy(&(s[p]),"<-"); p += 2;
1679: } while (t != (char *)NULL);
1680: fprintf(stderr,"%s\n",s);
1681: return s;
1.24 takayama 1682: }
1683:
1684: /*
1685: if (fname != NULL) fname is pushed to the trace stack.
1686: */
1.25 takayama 1687: int executeExecutableArray(struct object ob,char *fname,int withGotoP) {
1.24 takayama 1688: struct tokens *tokenArray;
1689: int size,i;
1690: int status;
1691: int infixOn;
1692: struct tokens infixToken;
1693: extern int GotoP;
1694:
1695: infixOn = 0;
1696: if (ob.tag != SexecutableArray) errorStackmachine("Error (executeTokenArray): the argument is not a token array.");
1697:
1698: if (fname != NULL) tracePushName(fname);
1699: tokenArray = ob.lc.tokenArray;
1700: size = ob.rc.ival;
1701: for (i=0; i<size; i++) {
1702: status = executeToken(tokenArray[i]);
1.25 takayama 1703: if ((status & STATUS_BREAK) || (status < 0) || (withGotoP && GotoP)) {
1.24 takayama 1704: if (fname != NULL) tracePopName();
1705: return(status);
1706: }
1707:
1708: if (status & STATUS_INFIX) {
1709: if (i == size-1) errorStackmachine("Infix operator at the end of an executable array.");
1710: infixOn = 1; infixToken = tokenArray[i];
1711: infixToken.tflag |= NO_DELAY;
1712: continue;
1713: }else if (infixOn) {
1714: infixOn = 0;
1715: status = executeToken(infixToken);
1.25 takayama 1716: if ((status & STATUS_BREAK) || (status < 0) || (withGotoP && GotoP)) {
1.24 takayama 1717: if (fname != NULL) tracePopName();
1718: return(status);
1719: }
1720: }
1721: }
1722: if (fname != NULL) tracePopName();
1723: return(0); /* normal exit */
1.10 takayama 1724: }
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