Annotation of OpenXM/src/kxx/sm1stackmachine.c, Revision 1.9
1.1 maekawa 1: #include <stdio.h>
2: #include <setjmp.h>
1.8 takayama 3: #include <stdlib.h>
1.1 maekawa 4: #include "ox_kan.h"
5: #include "serversm.h"
6: extern int OXprintMessage;
1.5 takayama 7: extern char *MsgStackTrace;
8: extern char *MsgSourceTrace;
1.6 takayama 9: extern struct object *MsgStackTraceInArrayp;
1.1 maekawa 10:
1.9 ! takayama 11: void KSstart(); // kan96xx/Kan/datatype.h
! 12: int KSexecuteString(char *s); // kan96xx/Kan/datatype.h
! 13: int Kan_pushCMOFromStream(FILE2 *fp); //kan96xx/Kan/plugin.h
! 14: int Kan_popCMOToStream(FILE2 *fp,int serial); //
! 15: int KgetCmoTagOfObject(struct object obj); //
! 16: int KSstackPointer(void); //kan96xx/Kan/extern.h
! 17: int Kan_setMathCapToStream(FILE2 *fp,struct object ob); // kan96xx/plugin/cmo.c
! 18:
! 19:
1.1 maekawa 20: /* server stack machine */
21:
22: int Sm1_start(int argc, char *fnames[],char *myname) {
23: int i;
24: char cmd[4092];
25: extern int ErrorMessageMode;
26: extern char *VersionString;
27: extern int CmoClientMode;
28: CmoClientMode = 0;
29: KSstart();
30: fprintf(stderr,"sm1 version : %s\n",VersionString);
31: fprintf(stderr,"sm1 url : http://www.math.kobe-u.ac.jp/KAN\n");
32: fprintf(stderr,"name = %s\n",myname);
33:
34: /* Initialize for ox_sm1 */
35: ErrorMessageMode = 2;
36: KSexecuteString(" [ [(Strict) 1] system_variable ] pop ");
37:
38: /* Write a system start-up script here. */
39: KSexecuteString(" [(cmoLispLike) 1] extension pop ");
40:
41: /* if argc > 0, execute the system startup files fnames and
42: set oxSystemName to myname. */
43: if (argc > 0) {
44: for (i=0; i<argc; i++) {
45: /* load files from the search path */
46: if (strlen(fnames[i]) > 1024) {
1.3 takayama 47: fprintf(stderr,"Too long name for sm1 library file to load.\n");
48: exit(10);
1.1 maekawa 49: }
50: sprintf(cmd," [(parse) (%s) pushfile ] extension pop ",fnames[i]);
51: KSexecuteString(cmd);
52: }
53: sprintf(cmd," [(cmoOxSystem) (ox_sm1_%s) ] extension pop ",myname);
54: KSexecuteString(cmd);
55: }
56: KSexecuteString(" (---------------------------------------------------) message ");
57: KSexecuteString(" [(flush)] extension pop ");
58:
59: return(0);
60: }
61:
62: void *Sm1_mathcap() {
63: int n,i;
64: struct mathCap *mathcap;
65: mathcap = KSmathCapByStruct();
66: return((void *)mathcap);
67: }
68:
69: int Sm1_setMathCap(ox_stream os) {
70: /* Set the mathcap data of the client in the server. */
71: /* sm1 <====== ox_sm1 mathcap is set in ox_stream = FILE2 * */
72: /* The mathcap data is on the stack. */
1.4 takayama 73: struct object ob = OINIT;
74: struct object ob2 = OINIT;
1.1 maekawa 75: int n,i;
76: ob = KSpop();
77: KSpush(ob); KSexecuteString(" (mathcap data is ) message message ");
78: Kan_setMathCapToStream(os,ob);
79: /* set the math cap data associated to the ox_stream. */
80: }
81: void Sm1_pops(void) {
82: char data[100];
83: sprintf(data," 1 1 3 -1 roll { pop pop } for ");
84: KSexecuteString(data);
85: }
86: int Sm1_executeStringByLocalParser(void) {
87: int i;
88: char *s;
89: s = Sm1_popString();
90: if (s == NULL) {
91: printf("NULL argument for executeString.\n");
92: return(-1);
93: }else{
94: if (OXprintMessage) fprintf(stderr,"KSexecuteString(%s)\n",s);
95: i = KSexecuteString(s);
96: return(i);
97: }
98: }
99: char *Sm1_popString(void) {
100: char *KSpopString();
101: KSexecuteString(" toString ");
102: return(KSpopString());
103: }
104:
105:
106: int Sm1_setName(void)
107: {
108: char *s;
1.4 takayama 109: struct object ob = OINIT;
1.1 maekawa 110: s = Sm1_popString();
111: if (s == NULL) {
112: printf("NULL argument for setName.\n");
113: return(-1);
114: }else{
115: ob = KSpop();
116: printf("/%s tag=%d def\n",s,ob.tag);
117: KputUserDictionary(s,ob);
118: return(0);
119: }
120: }
121:
122: int Sm1_evalName(void)
123: {
124: char *s;
1.4 takayama 125: struct object ob = OINIT;
1.1 maekawa 126: s = Sm1_popString();
127: if (s == NULL) {
128: printf("NULL argument for evalName.\n");
129: return(-1);
130: }else{
131: ob = KfindUserDictionary(s);
132: if (ob.tag == -1) {
133: printf("findUserDictionary(%s)--> tag=%d Not found.\n",s,ob.tag);
134: return(-1);
135: }
136: printf("findUserDictionary(%s)--> tag=%d\n",s,ob.tag);
137: KSpush(ob);
138: return(0);
139: }
140: }
141:
142: int Sm1_pushCMO(ox_stream fp)
143: {
144: return(Kan_pushCMOFromStream(fp));
145: }
146: int Sm1_popCMO(ox_stream fp,int serial)
147: {
148: return(Kan_popCMOToStream(fp,serial));
149: }
150:
151: int Sm1_pushError2(int serial, int no, char *s)
152: {
1.4 takayama 153: struct object ob = OINIT;
1.6 takayama 154: struct object core = OINIT;
155: struct object core1 = OINIT;
1.5 takayama 156: char *ss;
1.7 takayama 157:
158: ss = (char *)sGC_malloc(strlen(s)+1);
159: strcpy(ss,s);
160: /*
1.5 takayama 161: char *error_message="<ox103:error_message>";
162: char *message="<ox103:message>";
163: char *stack_trace="<ox103:stack_trace>";
164: char *source_trace="<ox103:source_trace>";
165: char *error_message2="</ox103:error_message>";
166: char *message2="</ox103:message>";
167: char *stack_trace2="</ox103:stack_trace>";
168: char *source_trace2="</ox103:source_trace>";
169: ss = (char *) sGC_malloc(strlen(s)+strlen(MsgStackTrace)+
170: strlen(MsgSourceTrace)+
171: strlen(error_message)+strlen(error_message2)+
172: strlen(message)+strlen(message2)+
173: strlen(stack_trace)+strlen(stack_trace2)+
174: strlen(source_trace)+strlen(source_trace2)+2);
175:
176: strcat(ss,error_message);
177: strcat(ss,message);
178: strcat(ss,s);
179: strcat(ss,message2);
180: if (MsgStackTrace != NULL) {
181: strcat(ss,stack_trace);
182: strcat(ss,MsgStackTrace);
183: strcat(ss,stack_trace2);
184: }
185: if (MsgSourceTrace != NULL) {
186: strcat(ss,source_trace);
187: strcat(ss,MsgSourceTrace);
188: strcat(ss,source_trace2);
189: }
190: strcat(ss,error_message2);
1.7 takayama 191: */
1.6 takayama 192:
193: if (MsgStackTraceInArrayp != NULL) {
194: core = KSnewObjectArray(2);
195: core1 = KSnewObjectArray(2);
196: putoa(core1,0,KpoString("where")); /* keyword */
197: putoa(core1,1,(*MsgStackTraceInArrayp));
198: putoa(core,0,core1);
199: core1 = KSnewObjectArray(2);
200: putoa(core1,0,KpoString("reason_of_error")); /* keyword */
201: putoa(core1,1,KpoString(s));
202: putoa(core,1,core1);
203: }else{
204: core = KSnewObjectArray(0);
205: }
206: ob = KSnewObjectArray(4);
207: putoa(ob,0,KpoInteger(serial)); putoa(ob,1,KpoInteger(no));
208: putoa(ob,2,KpoString(ss));
209: putoa(ob,3,core);
210:
211: ob = KnewErrorPacketObj(ob);
1.1 maekawa 212: KSpush(ob);
213: }
214:
215: char *Sm1_popErrorMessage(char *s) {
216: char *e;
217: char *a;
218: extern int ErrorMessageMode;
219: /* Set ErrorMessageMode = 2 to use this function. */
220: if (ErrorMessageMode != 2) return(s);
221: e = popErrorStackByString();
222: if (e == NULL ) {
223: a = (char *) sGC_malloc(sizeof(char)*(strlen(s)+80));
224: if (a == NULL) {
225: fprintf(stderr,"No more memory in Sm1_popErrorMessage.\n");
226: exit(10);
227: }
228: strcpy(a,s); strcat(a,"No error message on the error stack.");
229: return(a);
230: }else{
231: a = (char *) sGC_malloc(sizeof(char)*(strlen(s)+strlen(e)+2));
232: if (a == NULL) {
233: fprintf(stderr,"No more memory in Sm1_popErrorMessage.\n");
234: exit(10);
235: }
236: strcpy(a,s); strcat(a,e);
237: return(a);
238: }
239: }
240:
241: void Sm1_getsp(void) {
242: KSpush(KpoInteger(KSstackPointer()));
243: }
244:
245: void Sm1_dupErrors(void) {
246: KSpush(KSdupErrors());
247: }
248:
1.2 takayama 249: void Sm1_pushCMOtag(int serial) {
1.4 takayama 250: struct object obj = OINIT;
1.2 takayama 251: int t;
252: obj = KSpeek(0);
253: t = KgetCmoTagOfObject(obj);
254: if (t != -1) {
1.3 takayama 255: KSpush(KpoInteger(t));
1.2 takayama 256: }else{
1.3 takayama 257: Sm1_pushError2(serial,-1,"The top object on the server stack cannot be translated to cmo.");
1.2 takayama 258: }
259: }
1.1 maekawa 260:
261:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>