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