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