Annotation of OpenXM/src/kan96xx/Kan/ext.c, Revision 1.1.1.1
1.1 maekawa 1: #include <stdio.h>
2: #include <sys/types.h>
3: #include <sys/stat.h>
4: #include <fcntl.h>
5: #include <stdlib.h>
6: #include <unistd.h>
7: #include <sys/wait.h>
8: #include "datatype.h"
9: #include "stackm.h"
10: #include "extern.h"
11: #include "extern2.h"
12: #include <signal.h>
13: #include "plugin.h"
14:
15: #define MYCP_SIZE 100
16: static int Mychildren[MYCP_SIZE];
17: static int Mycp = 0;
18: static void mywait() {
19: int status;
20: int pid;
21: int i,j;
22: signal(SIGCHLD,SIG_IGN);
23: pid = wait(&status);
24: fprintf(stderr,"Child process %d is exiting.\n",pid);
25: for (i=0; i<Mycp; i++) {
26: if (Mychildren[i] == pid) {
27: for (j=i; j<Mycp-1; j++) {
28: Mychildren[j] = Mychildren[j+1];
29: }
30: if (Mycp > 0) Mycp--;
31: }
32: }
33: signal(SIGCHLD,mywait);
34: }
35:
36: #define SIZE_OF_ENVSTACK 5
37: static jmp_buf EnvStack[SIZE_OF_ENVSTACK];
38: static int Envp = 0;
39: static void pushEnv(jmp_buf jb) {
40: if (Envp < SIZE_OF_ENVSTACK) {
41: *(EnvStack[Envp]) = *jb;
42: Envp++;
43: }else{
44: fprintf(stderr,"Overflow of EnvStack.\n");
45: exit(2);
46: }
47: }
48: static void popEnv(jmp_buf jbp) {
49: if (Envp <= 0) {
50: fprintf(stderr,"Underflow of EnvStack.\n");
51: exit(3);
52: }else{
53: Envp--;
54: *jbp = *EnvStack[Envp];
55: }
56: }
57:
58: static char *ext_generateUniqueFileName(char *s)
59: {
60: char *t;
61: int i;
62: struct stat statbuf;
63: t = (char *)sGC_malloc(sizeof(char)*strlen(s)+4+2);
64: for (i=0; i<1000; i++) {
65: /* Give up if we failed for 1000 names. */
66: sprintf(t,"%s.%d",s,i);
67: /* if (phc_overwrite) return(t); */
68: if (stat(t,&statbuf) < 0) {
69: return(t);
70: }
71: }
72: errorKan1("%s\n","ext_generateUniqueFileName: could not generate a unique file name. Exhausted all the names.");
73: return(NULL);
74: }
75:
76: struct object Kextension(struct object obj)
77: {
78: char *key;
79: int size;
80: struct object keyo;
81: struct object rob = NullObject;
82: struct object obj1,obj2,obj3,obj4;
83: int m,i;
84: int argListc, fdListc;
85: char *abc;
86: char *abc2;
87: extern struct context *CurrentContextp;
88: extern jmp_buf EnvOfStackMachine;
89: extern void ctrlC();
90: extern int SigIgn;
91: extern errno;
92: extern int DebugCMO;
93: extern int OXprintMessage;
94: struct stat buf;
95: char **argv;
96: FILE *fp;
97: void (*oldsig)();
98:
99: if (obj.tag != Sarray) errorKan1("%s\n","Kextension(): The argument must be an array.");
100: size = getoaSize(obj);
101: if (size < 1) errorKan1("%s\n","Kextension(): Empty array.");
102: keyo = getoa(obj,0);
103: if (keyo.tag != Sdollar) errorKan1("%s\n","Kextension(): No key word.");
104: key = KopString(keyo);
105:
106: /* branch by they key word. */
107: if (strcmp(key,"parse")==0) {
108: if (size != 2) errorKan1("%s\n","[(parse) string] extension.");
109: obj1 = getoa(obj,1);
110: if (obj1.tag != Sdollar) errorKan1("%s\n","[(parse) string] extension");
111:
112: pushEnv(EnvOfStackMachine);
113: m = KSexecuteString(obj1.lc.str);
114: /* This is critical area. If you catch ctrl-c here, program crashes. */
115: oldsig = signal(SIGINT,SIG_IGN);
116: popEnv(EnvOfStackMachine);
117: /* OK! We passed the critical area. */
118: signal(SIGINT,oldsig);
119: rob = KpoInteger(m);
120: }else if (strcmp(key,"getpid") == 0) {
121: rob = KpoInteger( (int) getpid() );
122: }else if (strcmp(key,"flush") == 0) {
123: /* fflush(NULL); */
124: fflush(stdout);
125: rob.tag = Snull;
126: }else if (strcmp(key,"chattrs")==0) {
127: if (size != 2) errorKan1("%s\n","[(chattrs) num] extension.");
128: obj1 = getoa(obj,1);
129: if (obj1.tag != Sinteger) errorKan1("%s\n","[(chattrs) num] extension.");
130: m = KopInteger(obj1);
131: if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT))
132: errorKan1("%s\n","The number must be 0, 1 or 2.");
133: putUserDictionary2((char *)NULL,0,0,m | SET_ATTR_FOR_ALL_WORDS,
134: CurrentContextp->userDictionary);
135: }else if (strcmp(key,"keywords")==0) {
136: if (size != 1) errorKan1("%s\n","[(keywords)] extension.");
137: rob = showSystemDictionary(1);
138: /* }else if (strcmp(key,"fork0")==0) {
139: if (size != 2) errorKan1("%s\n","[(fork0) sss] extension.");
140: m = fork();
141: if (m>0) { rob = KpoInteger(m); }
142: else {
143: system(KopString(getoa(obj,1))); exit(0);
144: } */
145: }else if (strcmp(key,"defaultPolyRing")==0) {
146: if (size != 2) errorKan1("%s\n","[(defaultPolyRing) n] extension.");
147: rob = KdefaultPolyRing(getoa(obj,1));
148: }else if (strcmp(key,"getenv")==0) {
149: if (size != 2) errorKan1("%s\n","[(getenv) envstr] extension.");
150: obj1 = getoa(obj,1);
151: if (obj1.tag != Sdollar) errorKan1("%s\n","[(getenv) envstr] extension");
152: abc = getenv(KopString(obj1));
153: if (abc == NULL) {
154: rob = NullObject;
155: }else{
156: abc2 = (char *)sGC_malloc(sizeof(char)*(strlen(abc)+2));
157: strcpy(abc2,abc);
158: rob = KpoString(abc2);
159: }
160: }else if (strcmp(key,"stat")==0) {
161: if (size != 2) errorKan1("%s\n","[(stat) fname] extension.");
162: obj1 = getoa(obj,1);
163: if (obj1.tag != Sdollar) errorKan1("%s\n","[(stat) fname] extension ; string fname.");
164: m = stat(KopString(obj1),&buf);
165: rob = newObjectArray(2);
166: if (m == -1) {
167: /* fail */
168: obj2 = NullObject;
169: putoa(rob,0,obj2);
170: obj3 = newObjectArray(2);
171: putoa(obj3,0,KpoString("error no"));
172: putoa(obj3,1,KpoInteger(errno));
173: putoa(rob,1,obj3);
174: }else{
175: /* success */
176: putoa(rob,0,KpoInteger(0));
177: putoa(rob,1,newObjectArray(0)); /* We have not yet read buf */
178: }
179: }else if (strcmp(key,"forkExec")==0) {
180: if (size != 4) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension.");
181: obj1 = getoa(obj,1);
182: if (obj1.tag != Sarray) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. array argList.");
183: obj2 = getoa(obj,2);
184: if (obj2.tag != Sarray) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. array fdList.");
185: obj3 = getoa(obj,3);
186: if (obj3.tag != Sinteger) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. integer sigblock.");
187: m = KopInteger(obj3); /* m == 1 : block ctrl-C. */
188: argListc = getoaSize(obj1);
189: fdListc = getoaSize(obj2);
190: if ((m = fork()) > 0) {
191: /* parent */
192: signal(SIGCHLD,mywait); /* to kill Zombie */
193: Mychildren[Mycp++] = m;
194: if (Mycp >= MYCP_SIZE-1) {
195: errorKan1("%s\n","Child process table is full.\n");
196: Mycp = 0;
197: }
198: rob = KpoInteger(m);
199: /* Done */
200: }else{
201: /* Child */
202: for (i=0; i<fdListc; i++) {
203: /* close the specified files */
204: close(KopInteger(getoa(obj2,i)));
205: }
206: /* execl */
207: if (m == 1) {
208: {
209: sigset_t sss;
210: sigemptyset(&sss);
211: sigaddset(&sss,SIGINT);
212: sigprocmask(SIG_BLOCK,&sss,NULL);
213: }
214: }
215: argv = (char **) sGC_malloc(sizeof(char *)*(argListc+1));
216: if (argv == NULL) {
217: fprintf(stderr," no more momory. forkExec --- exiting.\n");
218: _exit(10);
219: }
220: for (i=0; i<argListc; i++) {
221: argv[i] = KopString(getoa(obj1,i));
222: argv[i+1] = NULL;
223: }
224: execv(argv[0],argv);
225: /* This place will never be reached unless execv fails. */
226: fprintf(stderr,"forkExec fails: ");
227: for (i=0; i<argListc; i++) {
228: fprintf(stderr,"%s ",argv[i]);
229: }
230: fprintf(stderr,"\nExiting, but staying as Zombie.\n");
231: _exit(10);
232: }
233: }else if (strcmp(key,"getchild")==0) {
234: if (size != 1) errorKan1("%s\n","[(getchild)] extension.");
235: rob = newObjectArray(Mycp);
236: for (i=0; i<Mycp; i++) {
237: putoa(rob,i,KpoInteger(Mychildren[i]));
238: }
239: }else if (strcmp(key,"getUniqueFileName")==0) {
240: if (size != 2) errorKan1("%s\n","[(getUniqueFileName) path] extension.");
241: obj1 = getoa(obj,1);
242: if (obj1.tag != Sdollar) errorKan1("%s\n","[(getUniqueFileName) path] extension. path must be a string.");
243: rob = KpoString(ext_generateUniqueFileName(KopString(obj1)));
244: }else if (strcmp(key,"outputObjectToFile")==0) {
245: if (size != 3) errorKan1("%s\n","[(outputObjectToFile) path obj] extension.");
246: obj1 = getoa(obj,1);
247: if (obj1.tag != Sdollar) errorKan1("%s\n","[(outputObjectToFile) path obj] extension. path must be a string.");
248: obj2 = getoa(obj,2);
249: fp = fopen(KopString(obj1),"w");
250: if (fp == NULL) errorKan1("%s\n","[(outputObjectToFile) path object] extension : could not open the path.");
251: printObject(obj2,0,fp);
252: fclose(fp);
253: rob = NullObject;
254: }else if (strcmp(key,"hilbert")==0) {
255: if (size != 3) errorKan1("%s\n","[(hilbert) obgb obvlist] extension.");
256: rob = hilberto(getoa(obj,1),getoa(obj,2));
257: }else if (strcmp(key,"chattr")==0) {
258: if (size != 3) errorKan1("%s\n","[(chattr) num symbol] extension.");
259: obj1 = getoa(obj,1);
260: obj2 = getoa(obj,2);
261: if (obj1.tag != Sinteger) errorKan1("%s\n","[(chattr) num symbol] extension.");
262: if (obj2.tag != Sstring) errorKan1("%s\n","[(chattr) num symbol] extension.");
263: m = KopInteger(obj1);
264: if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT))
265: errorKan1("%s\n","The number must be 0, 1 or 2.");
266: putUserDictionary2(obj2.lc.str,(obj2.rc.op->lc).ival,(obj2.rc.op->rc).ival,
267: m,CurrentContextp->userDictionary);
268: }
269: #include "plugin.hh"
270: else{
271: errorKan1("%s\n","Unknown tag for extension.");
272: }
273:
274:
275: return(rob);
276: }
277:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ext.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Kan