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