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