Annotation of OpenXM/src/kan96xx/Kan/ext.c, Revision 1.50
1.50 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/ext.c,v 1.49 2018/09/07 00:09:32 takayama Exp $ */
1.1 maekawa 2: #include <stdio.h>
1.38 ohara 3: #include <string.h>
1.1 maekawa 4: #include <sys/types.h>
5: #include <sys/stat.h>
6: #include <fcntl.h>
7: #include <stdlib.h>
8: #include <unistd.h>
9: #include <sys/wait.h>
1.44 takayama 10: #include <sys/time.h>
11: #include <time.h>
1.1 maekawa 12: #include "datatype.h"
13: #include "stackm.h"
14: #include "extern.h"
15: #include "extern2.h"
16: #include <signal.h>
17: #include "plugin.h"
1.17 takayama 18: #include "kclass.h"
1.10 takayama 19: #include <ctype.h>
1.22 takayama 20: #include <errno.h>
1.30 takayama 21: #include <regex.h>
1.15 takayama 22: #include "ox_pathfinder.h"
1.48 takayama 23: #include "mysig.h"
1.1 maekawa 24:
1.50 ! takayama 25: void cmoDumpCmo(struct object ob); /* defined in ../plugin/cmo0.h */
! 26:
1.23 takayama 27: extern int Quiet;
1.14 takayama 28: extern char **environ;
1.39 takayama 29: extern char *MsgSourceTrace;
1.14 takayama 30:
1.1 maekawa 31: #define MYCP_SIZE 100
32: static int Mychildren[MYCP_SIZE];
33: static int Mycp = 0;
1.26 takayama 34: static int Verbose_mywait = 0;
1.1 maekawa 35: static void mywait() {
36: int status;
37: int pid;
38: int i,j;
1.47 takayama 39: /* mysignal(SIGCHLD,SIG_IGN); */
1.1 maekawa 40: pid = wait(&status);
1.26 takayama 41: if ((!Quiet) && (Verbose_mywait)) fprintf(stderr,"Child process %d is exiting.\n",pid);
1.1 maekawa 42: for (i=0; i<Mycp; i++) {
43: if (Mychildren[i] == pid) {
44: for (j=i; j<Mycp-1; j++) {
1.5 takayama 45: Mychildren[j] = Mychildren[j+1];
1.1 maekawa 46: }
47: if (Mycp > 0) Mycp--;
48: }
49: }
1.47 takayama 50: mysignal(SIGCHLD,mywait);
1.1 maekawa 51: }
52:
53: #define SIZE_OF_ENVSTACK 5
1.9 takayama 54: #if defined(__CYGWIN__)
55: #define JMP_BUF sigjmp_buf
56: #else
57: #define JMP_BUF jmp_buf
58: #endif
59: static JMP_BUF EnvStack[SIZE_OF_ENVSTACK];
1.1 maekawa 60: static int Envp = 0;
1.9 takayama 61: static void pushEnv(JMP_BUF jb) {
1.1 maekawa 62: if (Envp < SIZE_OF_ENVSTACK) {
63: *(EnvStack[Envp]) = *jb;
64: Envp++;
65: }else{
66: fprintf(stderr,"Overflow of EnvStack.\n");
67: exit(2);
68: }
69: }
1.9 takayama 70: static void popEnv(JMP_BUF jbp) {
1.1 maekawa 71: if (Envp <= 0) {
72: fprintf(stderr,"Underflow of EnvStack.\n");
73: exit(3);
74: }else{
75: Envp--;
76: *jbp = *EnvStack[Envp];
77: }
78: }
79:
80: static char *ext_generateUniqueFileName(char *s)
81: {
82: char *t;
83: int i;
84: struct stat statbuf;
85: t = (char *)sGC_malloc(sizeof(char)*strlen(s)+4+2);
86: for (i=0; i<1000; i++) {
87: /* Give up if we failed for 1000 names. */
88: sprintf(t,"%s.%d",s,i);
89: /* if (phc_overwrite) return(t); */
90: if (stat(t,&statbuf) < 0) {
91: return(t);
92: }
93: }
94: errorKan1("%s\n","ext_generateUniqueFileName: could not generate a unique file name. Exhausted all the names.");
95: return(NULL);
96: }
97:
1.30 takayama 98: static struct object oregexec(struct object oregex,struct object ostrArray,struct object oflag);
99:
1.1 maekawa 100: struct object Kextension(struct object obj)
101: {
102: char *key;
103: int size;
1.36 takayama 104: struct object keyo = OINIT;
1.1 maekawa 105: struct object rob = NullObject;
1.36 takayama 106: struct object obj1 = OINIT;
107: struct object obj2 = OINIT;
108: struct object obj3 = OINIT;
109: struct object obj4 = OINIT;
1.13 takayama 110: int m,i,pid, uid;
1.1 maekawa 111: int argListc, fdListc;
112: char *abc;
113: char *abc2;
114: extern struct context *CurrentContextp;
1.45 takayama 115: struct timeval tm;
1.9 takayama 116: #if (__CYGWIN__)
117: extern sigjmp_buf EnvOfStackMachine;
118: #else
1.1 maekawa 119: extern jmp_buf EnvOfStackMachine;
1.9 takayama 120: #endif
1.1 maekawa 121: extern void ctrlC();
122: extern int SigIgn;
123: extern int DebugCMO;
124: extern int OXprintMessage;
125: struct stat buf;
126: char **argv;
127: FILE *fp;
1.3 takayama 128: void (*oldsig)();
1.50 ! takayama 129: extern int SecureMode;
1.27 takayama 130: extern char *UD_str;
131: extern int UD_attr;
1.1 maekawa 132:
133: if (obj.tag != Sarray) errorKan1("%s\n","Kextension(): The argument must be an array.");
134: size = getoaSize(obj);
135: if (size < 1) errorKan1("%s\n","Kextension(): Empty array.");
136: keyo = getoa(obj,0);
137: if (keyo.tag != Sdollar) errorKan1("%s\n","Kextension(): No key word.");
138: key = KopString(keyo);
139:
140: /* branch by they key word. */
141: if (strcmp(key,"parse")==0) {
142: if (size != 2) errorKan1("%s\n","[(parse) string] extension.");
143: obj1 = getoa(obj,1);
144: if (obj1.tag != Sdollar) errorKan1("%s\n","[(parse) string] extension");
145:
146: pushEnv(EnvOfStackMachine);
147: m = KSexecuteString(obj1.lc.str);
148: /* This is critical area. If you catch ctrl-c here, program crashes. */
1.47 takayama 149: oldsig = mysignal(SIGINT,SIG_IGN);
1.1 maekawa 150: popEnv(EnvOfStackMachine);
151: /* OK! We passed the critical area. */
1.47 takayama 152: mysignal(SIGINT,oldsig);
1.1 maekawa 153: rob = KpoInteger(m);
154: }else if (strcmp(key,"getpid") == 0) {
155: rob = KpoInteger( (int) getpid() );
156: }else if (strcmp(key,"flush") == 0) {
157: /* fflush(NULL); */
158: fflush(stdout);
159: rob.tag = Snull;
160: }else if (strcmp(key,"chattrs")==0) {
161: if (size != 2) errorKan1("%s\n","[(chattrs) num] extension.");
162: obj1 = getoa(obj,1);
163: if (obj1.tag != Sinteger) errorKan1("%s\n","[(chattrs) num] extension.");
164: m = KopInteger(obj1);
1.28 takayama 165: /* if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT || m == ATTR_INFIX))
166: errorKan1("%s\n","The number must be 0, 1 or 2.");*/
1.1 maekawa 167: putUserDictionary2((char *)NULL,0,0,m | SET_ATTR_FOR_ALL_WORDS,
1.31 takayama 168: CurrentContextp->userDictionary);
169: }else if (strcmp(key,"or_attrs")==0) {
170: if (size != 2) errorKan1("%s\n","[(or_attrs) num] extension.");
171: obj1 = getoa(obj,1);
172: if (obj1.tag != Sinteger) errorKan1("%s\n","[(or_attrs) num] extension.");
173: m = KopInteger(obj1);
174: putUserDictionary2((char *)NULL,0,0,m | OR_ATTR_FOR_ALL_WORDS,
1.5 takayama 175: CurrentContextp->userDictionary);
1.1 maekawa 176: }else if (strcmp(key,"keywords")==0) {
177: if (size != 1) errorKan1("%s\n","[(keywords)] extension.");
178: rob = showSystemDictionary(1);
179: /* }else if (strcmp(key,"fork0")==0) {
1.5 takayama 180: if (size != 2) errorKan1("%s\n","[(fork0) sss] extension.");
181: m = fork();
182: if (m>0) { rob = KpoInteger(m); }
183: else {
184: system(KopString(getoa(obj,1))); exit(0);
185: } */
1.44 takayama 186: }else if (strcmp(key,"date")==0) {
187: if (size != 1) errorKan1("%s\n","[(date)] extension.");
188: gettimeofday(&tm,NULL);
1.46 takayama 189: rob = KpoString(ctime((time_t *)&(tm.tv_sec)));
1.5 takayama 190: }else if (strcmp(key,"defaultPolyRing")==0) {
191: if (size != 2) errorKan1("%s\n","[(defaultPolyRing) n] extension.");
192: rob = KdefaultPolyRing(getoa(obj,1));
193: }else if (strcmp(key,"getenv")==0) {
194: if (size != 2) errorKan1("%s\n","[(getenv) envstr] extension.");
195: obj1 = getoa(obj,1);
196: if (obj1.tag != Sdollar) errorKan1("%s\n","[(getenv) envstr] extension");
197: abc = getenv(KopString(obj1));
1.10 takayama 198: #if defined(__CYGWIN__)
199: if (abc == NULL) {
1.11 takayama 200: abc2 = (char *)sGC_malloc(sizeof(char)*(strlen(KopString(obj1))+2));
1.10 takayama 201: strcpy(abc2,KopString(obj1));
202: for (i=0; i<strlen(abc2); i++) {
203: abc2[i] = toupper(abc2[i]);
204: }
205: abc = getenv(abc2);
206: }
207: #endif
1.5 takayama 208: if (abc == NULL) {
209: rob = NullObject;
210: }else{
211: abc2 = (char *)sGC_malloc(sizeof(char)*(strlen(abc)+2));
212: strcpy(abc2,abc);
213: rob = KpoString(abc2);
214: }
215: }else if (strcmp(key,"stat")==0) {
216: if (size != 2) errorKan1("%s\n","[(stat) fname] extension.");
217: obj1 = getoa(obj,1);
218: if (obj1.tag != Sdollar) errorKan1("%s\n","[(stat) fname] extension ; string fname.");
219: m = stat(KopString(obj1),&buf);
220: rob = newObjectArray(2);
221: if (m == -1) {
222: /* fail */
223: obj2 = NullObject;
224: putoa(rob,0,obj2);
225: obj3 = newObjectArray(2);
226: putoa(obj3,0,KpoString("error no"));
227: putoa(obj3,1,KpoInteger(errno));
228: putoa(rob,1,obj3);
229: }else{
230: /* success */
231: putoa(rob,0,KpoInteger(0));
232: obj3 = newObjectArray(1);
233: putoa(obj3,0,KpoInteger((int) buf.st_size));
234: putoa(rob,1,obj3); /* We have not yet read buf fully */
235: }
1.32 takayama 236: }else if (strcmp(key,"gethostname")==0) {
237: abc = (char *)sGC_malloc(sizeof(char)*1024);
238: if (gethostname(abc,1023) < 0) {
239: errorKan1("%s\n","hostname could not be obtained.");
240: }
241: rob = KpoString(abc);
1.5 takayama 242: }else if (strcmp(key,"forkExec")==0) {
243: if (size != 4) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension.");
244: obj1 = getoa(obj,1);
1.14 takayama 245: if (obj1.tag == Sdollar) {
246: obj1 = KstringToArgv(obj1);
247: }
1.5 takayama 248: if (obj1.tag != Sarray) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. array argList.");
1.14 takayama 249: obj2 = getoa(obj,2);
1.5 takayama 250: if (obj2.tag != Sarray) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. array fdList.");
251: obj3 = getoa(obj,3);
252: if (obj3.tag != Sinteger) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. integer sigblock.");
1.7 takayama 253: m = KopInteger(obj3); /* m&1 : block ctrl-C. */
1.5 takayama 254: argListc = getoaSize(obj1);
255: fdListc = getoaSize(obj2);
1.6 takayama 256: if ((pid = fork()) > 0) {
1.5 takayama 257: /* parent */
1.7 takayama 258: if (m&2) {
1.6 takayama 259: /* Do not call singal to turn around a trouble on cygwin. BUG. */
260: }else{
1.47 takayama 261: mysignal(SIGCHLD,mywait); /* to kill Zombie */
1.6 takayama 262: }
263: Mychildren[Mycp++] = pid;
1.5 takayama 264: if (Mycp >= MYCP_SIZE-1) {
265: errorKan1("%s\n","Child process table is full.\n");
266: Mycp = 0;
267: }
1.6 takayama 268: rob = KpoInteger(pid);
1.5 takayama 269: /* Done */
270: }else{
271: /* Child */
272: for (i=0; i<fdListc; i++) {
273: /* close the specified files */
274: close(KopInteger(getoa(obj2,i)));
1.1 maekawa 275: }
1.5 takayama 276: /* execl */
1.7 takayama 277: if (m&1) {
1.5 takayama 278: {
279: sigset_t sss;
280: sigemptyset(&sss);
281: sigaddset(&sss,SIGINT);
282: sigprocmask(SIG_BLOCK,&sss,NULL);
283: }
1.1 maekawa 284: }
1.5 takayama 285: argv = (char **) sGC_malloc(sizeof(char *)*(argListc+1));
286: if (argv == NULL) {
287: fprintf(stderr," no more momory. forkExec --- exiting.\n");
288: _exit(10);
1.1 maekawa 289: }
1.5 takayama 290: for (i=0; i<argListc; i++) {
291: argv[i] = KopString(getoa(obj1,i));
292: argv[i+1] = NULL;
1.7 takayama 293: }
294:
295: if (m&4) {
296: fprintf(stderr,"execv %s\n",argv[0]);
297: sleep(5);
298: fprintf(stderr,">>>\n");
1.1 maekawa 299: }
1.14 takayama 300: execve(argv[0],argv,environ);
1.5 takayama 301: /* This place will never be reached unless execv fails. */
302: fprintf(stderr,"forkExec fails: ");
303: for (i=0; i<argListc; i++) {
304: fprintf(stderr,"%s ",argv[i]);
305: }
306: fprintf(stderr,"\nExiting, but staying as Zombie.\n");
307: _exit(10);
308: }
309: }else if (strcmp(key,"getchild")==0) {
310: if (size != 1) errorKan1("%s\n","[(getchild)] extension.");
311: rob = newObjectArray(Mycp);
312: for (i=0; i<Mycp; i++) {
313: putoa(rob,i,KpoInteger(Mychildren[i]));
1.1 maekawa 314: }
1.5 takayama 315: }else if (strcmp(key,"getUniqueFileName")==0) {
316: if (size != 2) errorKan1("%s\n","[(getUniqueFileName) path] extension.");
317: obj1 = getoa(obj,1);
318: if (obj1.tag != Sdollar) errorKan1("%s\n","[(getUniqueFileName) path] extension. path must be a string.");
319: rob = KpoString(ext_generateUniqueFileName(KopString(obj1)));
320: }else if (strcmp(key,"outputObjectToFile")==0) {
321: if (size != 3) errorKan1("%s\n","[(outputObjectToFile) path obj] extension.");
322: obj1 = getoa(obj,1);
323: if (obj1.tag != Sdollar) errorKan1("%s\n","[(outputObjectToFile) path obj] extension. path must be a string.");
324: obj2 = getoa(obj,2);
325: fp = fopen(KopString(obj1),"w");
326: if (fp == NULL) errorKan1("%s\n","[(outputObjectToFile) path object] extension : could not open the path.");
327: printObject(obj2,0,fp);
328: fclose(fp);
329: rob = NullObject;
1.35 takayama 330: }else if (strcmp(key,"getAttributeList")==0) {
331: if (size != 2) errorKan1("%s\n","[(getAttributeList) ob] extension rob");
332: rob = KgetAttributeList(getoa(obj,1));
1.37 takayama 333: }else if (strcmp(key,"setAttributeList")==0) {
334: if (size != 3) errorKan1("%s\n","[(setAttributeList) ob attrlist] extension rob");
335: rob = KsetAttributeList(getoa(obj,1), getoa(obj,2));
1.35 takayama 336: }else if (strcmp(key,"getAttribute")==0) {
337: if (size != 3) errorKan1("%s\n","[(getAttribute) ob key] extension rob");
338: rob = KgetAttribute(getoa(obj,1),getoa(obj,2));
1.37 takayama 339: }else if (strcmp(key,"setAttribute")==0) {
340: if (size != 4) errorKan1("%s\n","[(setAttributeList) ob key value] extension rob");
341: rob = KsetAttribute(getoa(obj,1), getoa(obj,2),getoa(obj,3));
1.5 takayama 342: }else if (strcmp(key,"hilbert")==0) {
343: if (size != 3) errorKan1("%s\n","[(hilbert) obgb obvlist] extension.");
344: rob = hilberto(getoa(obj,1),getoa(obj,2));
1.13 takayama 345: }else if (strcmp(key,"nobody") == 0) {
346: uid = getuid();
347: if (uid == 0) {
348: #define NOBODY 65534
349: /* If I'm a super user, then change uid to nobody. */
350: if (setuid(NOBODY) != 0) {
351: fprintf(stderr,"Failed to change uid to nobody (%d)\n",NOBODY);
352: exit(10);
353: }
354: fprintf(stderr,"uid is changed to nobody (%d).\n",NOBODY);
355: rob.tag = Snull;
356: }
1.5 takayama 357: }else if (strcmp(key,"chattr")==0) {
358: if (size != 3) errorKan1("%s\n","[(chattr) num symbol] extension.");
359: obj1 = getoa(obj,1);
360: obj2 = getoa(obj,2);
361: if (obj1.tag != Sinteger) errorKan1("%s\n","[(chattr) num symbol] extension.");
362: if (obj2.tag != Sstring) errorKan1("%s\n","[(chattr) num symbol] extension.");
363: m = KopInteger(obj1);
1.28 takayama 364: /* if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT || m == ATTR_INFIX))
365: errorKan1("%s\n","The number must be 0, 1 or 2.");*/
1.29 takayama 366: putUserDictionary2(obj2.lc.str,(obj2.rc.op->lc).ival,(obj2.rc.op->rc).ival,
367: m,CurrentContextp->userDictionary);
368: }else if (strcmp(key,"or_attr")==0) {
369: if (size != 3) errorKan1("%s\n","[(or_attr) num symbol] extension.");
370: obj1 = getoa(obj,1);
371: obj2 = getoa(obj,2);
372: if (obj1.tag != Sinteger) errorKan1("%s\n","[(or_attr) num symbol] extension.");
373: if (obj2.tag != Sstring) errorKan1("%s\n","[(or_attr) num symbol] extension.");
374: m = KopInteger(obj1);
375: rob = KfindUserDictionary(obj2.lc.str);
376: if (rob.tag != NoObject.tag) {
377: if (strcmp(UD_str,obj2.lc.str) == 0) {
378: m |= UD_attr;
379: }else errorKan1("%s\n","or_attr: internal error.");
380: }
381: rob = KpoInteger(m);
1.5 takayama 382: putUserDictionary2(obj2.lc.str,(obj2.rc.op->lc).ival,(obj2.rc.op->rc).ival,
383: m,CurrentContextp->userDictionary);
1.27 takayama 384: }else if (strcmp(key,"getattr")==0) {
385: if (size != 2) errorKan1("%s\n","[(getattr) symbol] extension.");
386: obj1 = getoa(obj,1);
387: if (obj1.tag != Sstring) errorKan1("%s\n","[(getattr) symbol] extension.");
388: rob = KfindUserDictionary(obj1.lc.str);
389: if (rob.tag != NoObject.tag) {
390: if (strcmp(UD_str,obj1.lc.str) == 0) {
391: rob = KpoInteger(UD_attr);
392: }else errorKan1("%s\n","getattr: internal error.");
393: }else rob = NullObject;
1.15 takayama 394: }else if (strcmp(key,"getServerEnv")==0) {
395: if (size != 2) errorKan1("%s\n","[(getServerEnv) serverName] extension.");
396: obj1 = getoa(obj,1);
397: if (obj1.tag != Sdollar) errorKan1("%s\n","[(getServerEnv) serverName] extension.");
398: {
399: char **se; int ii; int nn;
1.42 takayama 400: char **getServerEnv(char *);
1.15 takayama 401: se = getServerEnv(KopString(obj1));
402: if (se == NULL) {
403: debugServerEnv(KopString(obj1));
404: rob = NullObject;
405: }else{
406: for (ii=0,nn=0; se[ii] != NULL; ii++) nn++;
407: rob = newObjectArray(nn);
408: for (ii=0; ii<nn; ii++) {
409: putoa(rob,ii,KpoString(se[ii]));
410: }
411: }
412: }
1.33 takayama 413: }else if (strcmp(key,"read")==0) {
414: if (size != 3) errorKan1("%s\n","[(read) fd size] extension.");
415: obj1 = getoa(obj,1);
416: if (obj1.tag != Sinteger) errorKan1("%s\n","[(read) fd size] extension. fd must be an integer.");
417: obj2 = getoa(obj,2);
418: if (obj2.tag != Sinteger) errorKan1("%s\n","[(read) fd size] extension. size must be an integer.");
419: {
420: int total, n, fd;
421: char *s; char *s0;
422: fd = KopInteger(obj1);
423: total = KopInteger(obj2);
424: if (total <= 0) errorKan1("%s\n","[(read) ...]; negative size has not yet been implemented.");
425: /* Return a string. todo: implement SbyteArray case. */
426: s0 = s = (char *) sGC_malloc(total+1);
427: if (s0 == NULL) errorKan1("%s\n","[(read) ...]; no more memory.");
428: while (total >0) {
429: n = read(fd, s, total);
430: if (n < 0) { perror("read"); errorKan1("%s\n","[(read) ...]; read error.");}
431: s[n] = 0;
432: total -= n; s = &(s[n]);
433: }
434: rob = KpoString(s0);
435: }
1.12 takayama 436: }else if (strcmp(key,"regionMatches")==0) {
437: if (size != 3) errorKan1("%s\n","[(regionMatches) str strArray] extension.");
438: obj1 = getoa(obj,1);
439: if (obj1.tag != Sdollar) errorKan1("%s\n","[(regionMatches) str strArray] extension. str must be a string.");
440: obj2 = getoa(obj,2);
441: if (obj2.tag != Sarray) errorKan1("%s\n","[(regionMatches) str strArray] extension. strArray must be an array.");
442: rob = KregionMatches(obj1,obj2);
1.16 takayama 443: }else if (strcmp(key,"newVector")==0) {
444: if (size != 2) errorKan1("%s\n","[(newVector) m] extension.");
445: obj1 = getoa(obj,1);
446: if (obj1.tag != Sinteger) errorKan1("%s\n","[(newVector) m] extension. m must be an integer.");
447: rob = newObjectArray(KopInteger(obj1));
448: }else if (strcmp(key,"newMatrix")==0) {
449: if (size != 3) errorKan1("%s\n","[(newMatrix) m n] extension.");
450: obj1 = getoa(obj,1);
451: if (obj1.tag != Sinteger) errorKan1("%s\n","[(newMatrix) m n] extension. m must be an integer.");
452: obj2 = getoa(obj,2);
453: if (obj2.tag != Sinteger) errorKan1("%s\n","[(newMatrix) m n] extension. n must be an integer.");
454: rob = newObjectArray(KopInteger(obj1));
455: for (i=0; i<KopInteger(obj1); i++) {
456: putoa(rob,i,newObjectArray(KopInteger(obj2)));
457: }
1.21 takayama 458: }else if (strcmp(key,"ooPower")==0) {
459: if (size != 3) errorKan1("%s\n","[(ooPower) a b] extension.");
460: obj1 = getoa(obj,1);
461: obj2 = getoa(obj,2);
462: rob = KooPower(obj1,obj2);
1.25 takayama 463: }else if (strcmp(key,"Krest")==0) {
464: if (size != 2) errorKan1("%s\n","[(Krest) a] extension b");
465: obj1 = getoa(obj,1);
466: rob = Krest(obj1);
467: }else if (strcmp(key,"Kjoin")==0) {
468: if (size != 3) errorKan1("%s\n","[(Kjoin) a b] extension c");
469: obj1 = getoa(obj,1);
470: obj2 = getoa(obj,2);
471: rob = Kjoin(obj1,obj2);
1.8 takayama 472: }else if (strcmp(key,"ostype")==0) {
1.43 takayama 473: /* Hard encode the OS type. cpp -dM /dev/null */
474: #if defined(__CYGWIN__)
1.8 takayama 475: rob = newObjectArray(1);
476: putoa(rob,0,KpoString("windows"));
477: #else
1.43 takayama 478: rob = newObjectArray(2);
1.8 takayama 479: putoa(rob,0,KpoString("unix"));
1.43 takayama 480: #if defined(__APPLE__)
481: putoa(rob,1,KpoString("mac"));
482: #else
483: putoa(rob,1,KpoString("generic"));
484: #endif
1.8 takayama 485: #endif
1.40 takayama 486: }else if (strcmp(key,"stringToArgv")==0) {
487: if (size != 2) errorKan1("%s\n","[(stringToArgv) a ] extension b");
488: obj1 = getoa(obj,1);
489: if (obj1.tag != Sdollar) errorKan1("%s\n","[(stringToArgv) a ] extension b, a must be a string.");
490: rob = KstringToArgv(obj1);
1.41 takayama 491: }else if (strcmp(key,"stringToArgv2")==0) {
492: if (size != 3) errorKan1("%s\n","[(stringToArgv2) str separator] extension b");
493: obj1 = getoa(obj,1);
494: obj2 = getoa(obj,2);
495: rob = KstringToArgv2(obj1,obj2);
1.24 takayama 496: }else if (strcmp(key,"traceClearStack")==0) {
497: traceClearStack();
498: rob = NullObject;
499: }else if (strcmp(key,"traceShowStack")==0) {
500: char *ssst;
501: ssst = traceShowStack();
1.39 takayama 502: if (ssst != NULL) {
503: rob = KpoString(ssst);
504: }else{
505: rob = NullObject;
506: }
507: }else if (strcmp(key,"traceShowScannerBuf")==0) {
508: char *ssst;
509: ssst = MsgSourceTrace;
1.24 takayama 510: if (ssst != NULL) {
511: rob = KpoString(ssst);
512: }else{
513: rob = NullObject;
514: }
1.30 takayama 515: }else if (strcmp(key,"regexec")==0) {
516: if ((size != 3) && (size != 4)) errorKan1("%s\n","[(regexec) reg strArray flag(optional)] extension b");
517: obj1 = getoa(obj,1);
518: if (obj1.tag != Sdollar) errorKan1("%s\n","regexec, the first argument should be a string (regular expression).");
519: obj2 = getoa(obj,2);
520: if (obj2.tag != Sarray) errorKan1("%s\n","regexec, the second argument should be an array of a string.");
521: if (size == 3) obj3 = newObjectArray(0);
522: else obj3 = getoa(obj,3);
523: rob = oregexec(obj1,obj2,obj3);
1.34 takayama 524: }else if (strcmp(key,"unlink")==0) {
525: if (size != 2) errorKan1("%s\n","[(unlink) filename] extension b");
526: obj1 = getoa(obj,1);
527: if (obj1.tag != Sdollar) errorKan1("%s\n","unlink, the first argument should be a string (filename).");
528: rob = KpoInteger(oxDeleteFile(KopString(obj1)));
1.49 takayama 529: }else if (strcmp(key,"quiet")==0) {
530: obj1 = getoa(obj,1);
531: if (obj1.tag != Sinteger) errorKan1("%s\n","quiet, the first argument should be an integer.");
532: Quiet = KopInteger(obj1);
533: rob = obj1;
1.5 takayama 534: }
1.1 maekawa 535: #include "plugin.hh"
1.17 takayama 536: #include "Kclass/tree.hh"
1.1 maekawa 537: else{
1.33 takayama 538: fprintf(stderr,"key=%s; ",key);
539: errorKan1("%s\n","Unknown key for extension.");
1.1 maekawa 540: }
541:
542:
543: return(rob);
1.12 takayama 544: }
545:
546: struct object KregionMatches(struct object sobj, struct object keyArray)
547: {
1.36 takayama 548: struct object rob = OINIT;
1.12 takayama 549: int n,i,j,m,keyn;
550: char *s,*key;
551: rob = newObjectArray(3);
552: getoa(rob,0) = KpoInteger(-1);
553: getoa(rob,1) = NullObject;
554: getoa(rob,2) = NullObject;
555:
556: if (sobj.tag != Sdollar) return rob;
557: if (keyArray.tag != Sarray) return rob;
558: n = getoaSize(keyArray);
559: for (i=0; i<n; i++) {
560: if (getoa(keyArray,i).tag != Sdollar) { return rob; }
561: }
562:
563: s = KopString(sobj);
564: m = strlen(s);
565:
566: for (i=0; i<n; i++) {
567: key = KopString(getoa(keyArray,i));
568: keyn = strlen(key);
569: for (j=0; j<m; j++) {
570: if (strncmp(&(s[j]),key,keyn) == 0) {
571: getoa(rob,0) = KpoInteger(j);
572: getoa(rob,1) = KpoString(key);
573: getoa(rob,2) = KpoInteger(i);
574: return rob;
575: }
576: }
577: }
578: return rob;
1.1 maekawa 579: }
580:
1.30 takayama 581: static struct object oregexec(struct object oregex,struct object ostrArray,struct object oflag) {
1.36 takayama 582: struct object rob = OINIT;
583: struct object ob = OINIT;
1.30 takayama 584: int n,i,j,m,keyn,cflag,eflag,er;
585: char *regex;
586: regex_t preg;
587: char *s;
588: char *mbuf; int mbufSize;
589: #define REGMATCH_SIZE 100
590: regmatch_t pmatch[100]; size_t nmatch;
591: int size;
592:
593: nmatch = (size_t) REGMATCH_SIZE;
594: rob = newObjectArray(0);
595: mbufSize = 1024;
596:
597: if (oregex.tag != Sdollar) return rob;
598: if (ostrArray.tag != Sarray) return rob;
599: n = getoaSize(ostrArray);
600: for (i=0; i<n; i++) {
601: if (getoa(ostrArray,i).tag != Sdollar) { return rob; }
602: }
603: if (oflag.tag != Sarray) errorKan1("%s\n","oregexec: oflag should be an array of integers.");
604: cflag = eflag = 0;
605: oflag = Kto_int32(oflag);
606: for (i=0; i<getoaSize(oflag); i++) {
607: ob = getoa(oflag,i);
608: if (ob.tag != Sinteger) errorKan1("%s\n","oregexec: oflag is not an array of integers.");
609: if (i == 0) cflag = KopInteger(ob);
610: if (i == 1) eflag = KopInteger(ob);
611: }
612:
613: regex = KopString(oregex);
614: if (er=regcomp(&preg,regex,cflag)) {
615: mbuf = (char *) sGC_malloc(mbufSize);
616: if (mbuf == NULL) errorKan1("%s\n","No more memory.");
617: regerror(er,&preg,mbuf,mbufSize-1);
618: errorKan1("regcomp error: %s\n",mbuf);
619: }
620:
621: size = 0; /* We should use list instead of counting the size. */
622: for (i=0; i<n; i++) {
623: s = KopString(getoa(ostrArray,i));
624: er=regexec(&preg,s,nmatch,pmatch,eflag);
625: if ((er != 0) && (er != REG_NOMATCH)) {
626: mbuf = (char *) sGC_malloc(mbufSize);
627: if (mbuf == NULL) errorKan1("%s\n","No more memory.");
628: regerror(er,&preg,mbuf,mbufSize-1);
629: errorKan1("regcomp error: %s\n",mbuf);
630: }
631: if (er == 0) size++;
632: }
633:
634: rob = newObjectArray(size);
635: size = 0;
636: for (i=0; i<n; i++) {
637: s = KopString(getoa(ostrArray,i));
638: er=regexec(&preg,s,nmatch,pmatch,eflag);
639: if ((er != 0) && (er != REG_NOMATCH)) {
640: mbuf = (char *) sGC_malloc(mbufSize);
641: if (mbuf == NULL) errorKan1("%s\n","No more memory.");
642: regerror(er,&preg,mbuf,mbufSize-1);
643: errorKan1("regcomp error: %s\n",mbuf);
644: }
645: if (er == 0) {
646: ob = newObjectArray(3);
647: putoa(ob,0,KpoString(s));
648: /* temporary */
649: putoa(ob,1,KpoInteger((int) (pmatch[0].rm_so)));
650: putoa(ob,2,KpoInteger((int) (pmatch[0].rm_eo)));
651: putoa(rob,size,ob);
652: size++;
653: }
654: }
655: regfree(&preg);
656: return rob;
657: }
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