Annotation of OpenXM/src/k097/ki.c, Revision 1.1.1.1
1.1 maekawa 1: /* ki.c ( kx interpreter ) */
2:
3: #include <stdio.h>
4: #include "datatype.h"
5: #include "stackm.h"
6: #include "extern.h"
7: #include "extern2.h"
8: #include "lookup.h"
9: #include "matrix.h"
10: #include "gradedset.h"
11: #include <setjmp.h>
12: #include <signal.h>
13:
14: char *getLOAD_K_PATH(); /* from d.h */
15:
16: #ifdef CALLASIR
17: #include "ak0.h"
18: #endif
19:
20: extern jmp_buf KCenvOfParser;
21:
22: char Ktmp[10240];
23: int Ksize = 10240;
24: char *Kbuff = Ktmp;
25: int Kpt = 0;
26: int DebugCompiler = 0; /* 0: , 1: Displays sendKan[ .... ] */
27: int K00_verbose = 0;
28:
29: extern int DebugMode;
30:
31: sendKan(int p) {
32: static int n = 2;
33: extern int Interactive;
34: struct object obj;
35: int result;
36: signal(SIGINT,SIG_IGN); /* Don't jump to ctrlC(). */
37: if (p == 10) {printf("In(%d)=",n++); return;}
38: if (p == 0 && DebugCompiler) printf("sendKan[%s]\n",Kbuff);
39: /* printf("sendKan[%s]\n",Kbuff); */
40: if (strlen(Kbuff) != 0) {
41: signal(SIGINT,SIG_DFL);
42: result = KSexecuteString(Kbuff);
43: /* fprintf(stderr,"r=%d ",result); */
44: signal(SIGINT,SIG_IGN); /* Reset SIGINT. Don't jump to ctrlC(). */
45: }
46: /* fprintf(stderr,"r=%d ",result); */
47: if (result == -1) {
48: K00recoverFromError();
49: fprintf(stderr,"--- Engine error or interrupt : ");
50: if (DebugMode) {
51: signal(SIGINT,SIG_DFL);
52: KSexecuteString("db.DebugStack setstack ");
53: signal(SIGINT,SIG_IGN); /* Reset SIGINT. Don't jump to ctrlC(). */
54: obj = KSpop();
55: signal(SIGINT,SIG_DFL);
56: KSexecuteString("stdstack ");
57: signal(SIGINT,SIG_IGN); /* Reset SIGINT. Don't jump to ctrlC(). */
58: if (obj.tag == Sdollar) {
59: fprintf(stderr,"%s\n",obj.lc.str);
60: fprintf(stderr,"\n");
61: }else{
62: fprintf(stderr,"The error occured on the top level.\n");
63: }
64: fprintf(stderr,"Type in Cleards() to exit the debug mode and Where() to see the stack trace.\n");
65: }
66: }
67: #define AFO
68: #ifdef AFO
69: if (setjmp(KCenvOfParser)) {
70: fprintf(stderr,"Error: Goto the top level.\n");
71: parseAfile(stdin);
72: KCparse();
73: /* Call KCparse() recursively when there is error. */
74: /* This is the easiest way to handle errors. */
75: /* However, it should be rewrited in a future. */
76: }else{ /* fprintf(stderr,"setjmp\n"); */ }
77: #endif
78: if (p == 0 && Interactive) printf("In(%d)=",n++);
79: Kpt=0; Kbuff[0] = '\0';
80: }
81:
82:
83: void pkkan(s)
84: char *s;
85: {
86: char *t;
87: if (strlen(s)+Kpt >= Ksize) {
88: Ksize = Ksize*2;
89: t = (char *)GC_malloc(sizeof(char)*Ksize);
90: if (t == (char *)NULL) { fprintf(stderr,"No memory."); exit();}
91: strcpy(t,Kbuff); Kbuff = t;
92: }
93: strcpy(&(Kbuff[Kpt]),s);
94: Kpt += strlen(s);
95: }
96:
97: void pkdebug(char *s0,char *s1, char *s2,char *s3) {
98: if (DebugMode) {
99: pkkan(" db.DebugStack setstack $");
100: pkkan(s0); pkkan(s1); pkkan(s2); pkkan(s3);
101: pkkan("$ stdstack \n");
102: }
103: }
104:
105: void pkdebug2(void) {
106: if (DebugMode) {
107: pkkan(" db.DebugStack setstack pop stdstack \n");
108: }
109: }
110:
111:
112: void *mymalloc(int n)
113: {
114: return((void *)GC_malloc(n));
115: }
116:
117: execFile(char *s)
118: {
119: FILE *fp;
120: #define TMP_SIZE 1024
121: char tmp[TMP_SIZE+1];
122: char tname[1024];
123: char tname2[1024];
124: char tname3[1024];
125: char tname4[1024];
126: int c;
127: if ((fp = fopen(s,"r")) == (FILE *) NULL) {
128: strcpy(tname,LOAD_SM1_PATH2);
129: strcat(tname,s);
130: strcpy(tname2,tname);
131: if ((fp = fopen(tname,"r")) == (FILE *) NULL) {
132: strcpy(tname,getLOAD_K_PATH());
133: strcat(tname,s);
134: strcpy(tname3,tname);
135: if ((fp = fopen(tname,"r")) == (FILE *) NULL) {
136: strcpy(tname,LOAD_K_PATH);
137: strcat(tname,s);
138: strcpy(tname4,tname);
139: if ((fp = fopen(tname,"r")) == (FILE *) NULL) {
140: strcpy(tname,getLOAD_K_PATH());
141: strcat(tname,"../kan96xx/Kan/");
142: strcat(tname,s);
143: if ((fp = fopen(tname,"r")) == (FILE *) NULL) {
144: fprintf(stderr,"Fatal error: Cannot open the system macro %s in %s, %s, %s nor %s.\n",
145: s,tname2,tname3,tname4,tname);
146: exit(11);
147: return;
148: }
149: }
150: }
151: }
152: }
153: /* printf("Reading\n"); fflush(stdout); */
154: while (fgets(tmp,TMP_SIZE,fp) != NULL) {
155: pkkan(tmp);
156: }
157: /* printf("Done.\n"); fflush(stdout); */
158: sendKan(1);
159: /* printf("sendKan, done.\n"); fflush(stdout); */
160: }
161:
162: /*Tag: yychar = YYEMPTY; Put the following line in simple.tab.c */
163: /* It makes segmentation fault. */
164: /*
165: #include <setjmp.h>
166: extern jmp_buf KCenvOfParser;
167: if (setjmp(KCenvOfParser)) {
168: parseAfile(stdin);
169: fprintf(stderr,"Error: Goto the top level.\n");
170: }else{ }
171: */
172:
173:
174: void testNewFunction(objectp op)
175: {
176: fprintf(stderr,"This is testNewFunction of NOT CALLASIR.\n");
177: if (op->tag != Sstring) {
178: fprintf(stderr,"The argument must be given as an argment of load.\n");
179: return;
180: }
181: fprintf(stderr,"Now execute .. <<%s>> \n",op->lc.str);
182: parseAstring(op->lc.str);
183: fprintf(stderr,"\nDone.\n");
184: }
185:
186:
187:
188:
189:
190:
191:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ki.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097