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