Annotation of OpenXM/src/k097/sm1sm.c, Revision 1.1
1.1 ! takayama 1: /* $OpenXM$ */
! 2: /* This is imported from kxx/sm1stackmachine.c */
! 3: #include <stdio.h>
! 4: #include <setjmp.h>
! 5: #include "../kxx/ox_kan.h"
! 6: #include "../kxx/serversm.h"
! 7: extern int OXprintMessage;
! 8:
! 9: /* server stack machine */
! 10:
! 11:
! 12: void *Sm1_mathcap() {
! 13: int n,i;
! 14: struct mathCap *mathcap;
! 15: mathcap = KSmathCapByStruct();
! 16: return((void *)mathcap);
! 17: }
! 18:
! 19: int Sm1_setMathCap(ox_stream os) {
! 20: /* Set the mathcap data of the client in the server. */
! 21: /* sm1 <====== ox_sm1 mathcap is set in ox_stream = FILE2 * */
! 22: /* The mathcap data is on the stack. */
! 23: struct object ob;
! 24: struct object ob2;
! 25: int n,i;
! 26: ob = KSpop();
! 27: KSpush(ob); KSexecuteString(" (mathcap data is ) message message ");
! 28: Kan_setMathCapToStream(os,ob);
! 29: /* set the math cap data associated to the ox_stream. */
! 30: }
! 31: void Sm1_pops(void) {
! 32: char data[100];
! 33: sprintf(data," 1 1 3 -1 roll { pop pop } for ");
! 34: KSexecuteString(data);
! 35: }
! 36: int Sm1_executeStringByLocalParser(void) {
! 37: int i;
! 38: char *s;
! 39: s = Sm1_popString();
! 40: if (s == NULL) {
! 41: printf("NULL argument for executeString.\n");
! 42: return(-1);
! 43: }else{
! 44: if (OXprintMessage) fprintf(stderr,"KSexecuteString(%s)\n",s);
! 45: i = KSexecuteString(s);
! 46: return(i);
! 47: }
! 48: }
! 49: char *Sm1_popString(void) {
! 50: char *KSpopString();
! 51: KSexecuteString(" toString ");
! 52: return(KSpopString());
! 53: }
! 54:
! 55:
! 56: int Sm1_setName(void)
! 57: {
! 58: char *s;
! 59: struct object ob;
! 60: s = Sm1_popString();
! 61: if (s == NULL) {
! 62: printf("NULL argument for setName.\n");
! 63: return(-1);
! 64: }else{
! 65: ob = KSpop();
! 66: printf("/%s tag=%d def\n",s,ob.tag);
! 67: KputUserDictionary(s,ob);
! 68: return(0);
! 69: }
! 70: }
! 71:
! 72: int Sm1_evalName(void)
! 73: {
! 74: char *s;
! 75: struct object ob;
! 76: s = Sm1_popString();
! 77: if (s == NULL) {
! 78: printf("NULL argument for evalName.\n");
! 79: return(-1);
! 80: }else{
! 81: ob = KfindUserDictionary(s);
! 82: if (ob.tag == -1) {
! 83: printf("findUserDictionary(%s)--> tag=%d Not found.\n",s,ob.tag);
! 84: return(-1);
! 85: }
! 86: printf("findUserDictionary(%s)--> tag=%d\n",s,ob.tag);
! 87: KSpush(ob);
! 88: return(0);
! 89: }
! 90: }
! 91:
! 92: int Sm1_pushCMO(ox_stream fp)
! 93: {
! 94: return(Kan_pushCMOFromStream(fp));
! 95: }
! 96: int Sm1_popCMO(ox_stream fp,int serial)
! 97: {
! 98: return(Kan_popCMOToStream(fp,serial));
! 99: }
! 100:
! 101: int Sm1_pushError2(int serial, int no, char *s)
! 102: {
! 103: struct object ob;
! 104: ob = KnewErrorPacket(serial,no,s);
! 105: KSpush(ob);
! 106: }
! 107:
! 108: char *Sm1_popErrorMessage(char *s) {
! 109: char *e;
! 110: char *a;
! 111: extern int ErrorMessageMode;
! 112: /* Set ErrorMessageMode = 2 to use this function. */
! 113: if (ErrorMessageMode != 2) return(s);
! 114: e = popErrorStackByString();
! 115: if (e == NULL ) {
! 116: a = (char *) sGC_malloc(sizeof(char)*(strlen(s)+80));
! 117: if (a == NULL) {
! 118: fprintf(stderr,"No more memory in Sm1_popErrorMessage.\n");
! 119: exit(10);
! 120: }
! 121: strcpy(a,s); strcat(a,"No error message on the error stack.");
! 122: return(a);
! 123: }else{
! 124: a = (char *) sGC_malloc(sizeof(char)*(strlen(s)+strlen(e)+2));
! 125: if (a == NULL) {
! 126: fprintf(stderr,"No more memory in Sm1_popErrorMessage.\n");
! 127: exit(10);
! 128: }
! 129: strcpy(a,s); strcat(a,e);
! 130: return(a);
! 131: }
! 132: }
! 133:
! 134: void Sm1_getsp(void) {
! 135: KSpush(KpoInteger(KSstackPointer()));
! 136: }
! 137:
! 138: void Sm1_dupErrors(void) {
! 139: KSpush(KSdupErrors());
! 140: }
! 141:
! 142: void Sm1_pushCMOtag(int serial) {
! 143: struct object obj;
! 144: int t;
! 145: obj = KSpeek(0);
! 146: t = KgetCmoTagOfObject(obj);
! 147: if (t != -1) {
! 148: KSpush(KpoInteger(t));
! 149: }else{
! 150: Sm1_pushError2(serial,-1,"The top object on the server stack cannot be translated to cmo.");
! 151: }
! 152: }
! 153:
! 154:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>