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