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