=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/ext.c,v retrieving revision 1.21 retrieving revision 1.50 diff -u -p -r1.21 -r1.50 --- OpenXM/src/kan96xx/Kan/ext.c 2003/12/06 02:49:22 1.21 +++ OpenXM/src/kan96xx/Kan/ext.c 2020/10/06 11:33:46 1.50 @@ -1,11 +1,14 @@ -/* $OpenXM: OpenXM/src/kan96xx/Kan/ext.c,v 1.20 2003/12/04 07:49:24 takayama Exp $ */ +/* $OpenXM: OpenXM/src/kan96xx/Kan/ext.c,v 1.49 2018/09/07 00:09:32 takayama Exp $ */ #include +#include #include #include #include #include #include #include +#include +#include #include "datatype.h" #include "stackm.h" #include "extern.h" @@ -14,20 +17,28 @@ #include "plugin.h" #include "kclass.h" #include +#include +#include #include "ox_pathfinder.h" +#include "mysig.h" +void cmoDumpCmo(struct object ob); /* defined in ../plugin/cmo0.h */ + +extern int Quiet; extern char **environ; +extern char *MsgSourceTrace; #define MYCP_SIZE 100 static int Mychildren[MYCP_SIZE]; static int Mycp = 0; +static int Verbose_mywait = 0; static void mywait() { int status; int pid; int i,j; - /* signal(SIGCHLD,SIG_IGN); */ + /* mysignal(SIGCHLD,SIG_IGN); */ pid = wait(&status); - fprintf(stderr,"Child process %d is exiting.\n",pid); + if ((!Quiet) && (Verbose_mywait)) fprintf(stderr,"Child process %d is exiting.\n",pid); for (i=0; i 0) Mycp--; } } - signal(SIGCHLD,mywait); + mysignal(SIGCHLD,mywait); } #define SIZE_OF_ENVSTACK 5 @@ -84,18 +95,24 @@ static char *ext_generateUniqueFileName(char *s) return(NULL); } +static struct object oregexec(struct object oregex,struct object ostrArray,struct object oflag); + struct object Kextension(struct object obj) { char *key; int size; - struct object keyo; + struct object keyo = OINIT; struct object rob = NullObject; - struct object obj1,obj2,obj3,obj4; + struct object obj1 = OINIT; + struct object obj2 = OINIT; + struct object obj3 = OINIT; + struct object obj4 = OINIT; int m,i,pid, uid; int argListc, fdListc; char *abc; char *abc2; extern struct context *CurrentContextp; + struct timeval tm; #if (__CYGWIN__) extern sigjmp_buf EnvOfStackMachine; #else @@ -103,14 +120,15 @@ struct object Kextension(struct object obj) #endif extern void ctrlC(); extern int SigIgn; - extern errno; extern int DebugCMO; extern int OXprintMessage; struct stat buf; char **argv; FILE *fp; void (*oldsig)(); - extern SecureMode; + extern int SecureMode; + extern char *UD_str; + extern int UD_attr; if (obj.tag != Sarray) errorKan1("%s\n","Kextension(): The argument must be an array."); size = getoaSize(obj); @@ -128,10 +146,10 @@ struct object Kextension(struct object obj) pushEnv(EnvOfStackMachine); m = KSexecuteString(obj1.lc.str); /* This is critical area. If you catch ctrl-c here, program crashes. */ - oldsig = signal(SIGINT,SIG_IGN); + oldsig = mysignal(SIGINT,SIG_IGN); popEnv(EnvOfStackMachine); /* OK! We passed the critical area. */ - signal(SIGINT,oldsig); + mysignal(SIGINT,oldsig); rob = KpoInteger(m); }else if (strcmp(key,"getpid") == 0) { rob = KpoInteger( (int) getpid() ); @@ -144,10 +162,17 @@ struct object Kextension(struct object obj) obj1 = getoa(obj,1); if (obj1.tag != Sinteger) errorKan1("%s\n","[(chattrs) num] extension."); m = KopInteger(obj1); - if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT)) - errorKan1("%s\n","The number must be 0, 1 or 2."); + /* if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT || m == ATTR_INFIX)) + errorKan1("%s\n","The number must be 0, 1 or 2.");*/ putUserDictionary2((char *)NULL,0,0,m | SET_ATTR_FOR_ALL_WORDS, CurrentContextp->userDictionary); + }else if (strcmp(key,"or_attrs")==0) { + if (size != 2) errorKan1("%s\n","[(or_attrs) num] extension."); + obj1 = getoa(obj,1); + if (obj1.tag != Sinteger) errorKan1("%s\n","[(or_attrs) num] extension."); + m = KopInteger(obj1); + putUserDictionary2((char *)NULL,0,0,m | OR_ATTR_FOR_ALL_WORDS, + CurrentContextp->userDictionary); }else if (strcmp(key,"keywords")==0) { if (size != 1) errorKan1("%s\n","[(keywords)] extension."); rob = showSystemDictionary(1); @@ -158,6 +183,10 @@ struct object Kextension(struct object obj) else { system(KopString(getoa(obj,1))); exit(0); } */ + }else if (strcmp(key,"date")==0) { + if (size != 1) errorKan1("%s\n","[(date)] extension."); + gettimeofday(&tm,NULL); + rob = KpoString(ctime((time_t *)&(tm.tv_sec))); }else if (strcmp(key,"defaultPolyRing")==0) { if (size != 2) errorKan1("%s\n","[(defaultPolyRing) n] extension."); rob = KdefaultPolyRing(getoa(obj,1)); @@ -204,6 +233,12 @@ struct object Kextension(struct object obj) putoa(obj3,0,KpoInteger((int) buf.st_size)); putoa(rob,1,obj3); /* We have not yet read buf fully */ } + }else if (strcmp(key,"gethostname")==0) { + abc = (char *)sGC_malloc(sizeof(char)*1024); + if (gethostname(abc,1023) < 0) { + errorKan1("%s\n","hostname could not be obtained."); + } + rob = KpoString(abc); }else if (strcmp(key,"forkExec")==0) { if (size != 4) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension."); obj1 = getoa(obj,1); @@ -223,7 +258,7 @@ struct object Kextension(struct object obj) if (m&2) { /* Do not call singal to turn around a trouble on cygwin. BUG. */ }else{ - signal(SIGCHLD,mywait); /* to kill Zombie */ + mysignal(SIGCHLD,mywait); /* to kill Zombie */ } Mychildren[Mycp++] = pid; if (Mycp >= MYCP_SIZE-1) { @@ -292,6 +327,18 @@ struct object Kextension(struct object obj) printObject(obj2,0,fp); fclose(fp); rob = NullObject; + }else if (strcmp(key,"getAttributeList")==0) { + if (size != 2) errorKan1("%s\n","[(getAttributeList) ob] extension rob"); + rob = KgetAttributeList(getoa(obj,1)); + }else if (strcmp(key,"setAttributeList")==0) { + if (size != 3) errorKan1("%s\n","[(setAttributeList) ob attrlist] extension rob"); + rob = KsetAttributeList(getoa(obj,1), getoa(obj,2)); + }else if (strcmp(key,"getAttribute")==0) { + if (size != 3) errorKan1("%s\n","[(getAttribute) ob key] extension rob"); + rob = KgetAttribute(getoa(obj,1),getoa(obj,2)); + }else if (strcmp(key,"setAttribute")==0) { + if (size != 4) errorKan1("%s\n","[(setAttributeList) ob key value] extension rob"); + rob = KsetAttribute(getoa(obj,1), getoa(obj,2),getoa(obj,3)); }else if (strcmp(key,"hilbert")==0) { if (size != 3) errorKan1("%s\n","[(hilbert) obgb obvlist] extension."); rob = hilberto(getoa(obj,1),getoa(obj,2)); @@ -314,16 +361,43 @@ struct object Kextension(struct object obj) if (obj1.tag != Sinteger) errorKan1("%s\n","[(chattr) num symbol] extension."); if (obj2.tag != Sstring) errorKan1("%s\n","[(chattr) num symbol] extension."); m = KopInteger(obj1); - if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT)) - errorKan1("%s\n","The number must be 0, 1 or 2."); + /* if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT || m == ATTR_INFIX)) + errorKan1("%s\n","The number must be 0, 1 or 2.");*/ putUserDictionary2(obj2.lc.str,(obj2.rc.op->lc).ival,(obj2.rc.op->rc).ival, m,CurrentContextp->userDictionary); + }else if (strcmp(key,"or_attr")==0) { + if (size != 3) errorKan1("%s\n","[(or_attr) num symbol] extension."); + obj1 = getoa(obj,1); + obj2 = getoa(obj,2); + if (obj1.tag != Sinteger) errorKan1("%s\n","[(or_attr) num symbol] extension."); + if (obj2.tag != Sstring) errorKan1("%s\n","[(or_attr) num symbol] extension."); + m = KopInteger(obj1); + rob = KfindUserDictionary(obj2.lc.str); + if (rob.tag != NoObject.tag) { + if (strcmp(UD_str,obj2.lc.str) == 0) { + m |= UD_attr; + }else errorKan1("%s\n","or_attr: internal error."); + } + rob = KpoInteger(m); + putUserDictionary2(obj2.lc.str,(obj2.rc.op->lc).ival,(obj2.rc.op->rc).ival, + m,CurrentContextp->userDictionary); + }else if (strcmp(key,"getattr")==0) { + if (size != 2) errorKan1("%s\n","[(getattr) symbol] extension."); + obj1 = getoa(obj,1); + if (obj1.tag != Sstring) errorKan1("%s\n","[(getattr) symbol] extension."); + rob = KfindUserDictionary(obj1.lc.str); + if (rob.tag != NoObject.tag) { + if (strcmp(UD_str,obj1.lc.str) == 0) { + rob = KpoInteger(UD_attr); + }else errorKan1("%s\n","getattr: internal error."); + }else rob = NullObject; }else if (strcmp(key,"getServerEnv")==0) { if (size != 2) errorKan1("%s\n","[(getServerEnv) serverName] extension."); obj1 = getoa(obj,1); if (obj1.tag != Sdollar) errorKan1("%s\n","[(getServerEnv) serverName] extension."); { char **se; int ii; int nn; + char **getServerEnv(char *); se = getServerEnv(KopString(obj1)); if (se == NULL) { debugServerEnv(KopString(obj1)); @@ -336,6 +410,29 @@ struct object Kextension(struct object obj) } } } + }else if (strcmp(key,"read")==0) { + if (size != 3) errorKan1("%s\n","[(read) fd size] extension."); + obj1 = getoa(obj,1); + if (obj1.tag != Sinteger) errorKan1("%s\n","[(read) fd size] extension. fd must be an integer."); + obj2 = getoa(obj,2); + if (obj2.tag != Sinteger) errorKan1("%s\n","[(read) fd size] extension. size must be an integer."); + { + int total, n, fd; + char *s; char *s0; + fd = KopInteger(obj1); + total = KopInteger(obj2); + if (total <= 0) errorKan1("%s\n","[(read) ...]; negative size has not yet been implemented."); + /* Return a string. todo: implement SbyteArray case. */ + s0 = s = (char *) sGC_malloc(total+1); + if (s0 == NULL) errorKan1("%s\n","[(read) ...]; no more memory."); + while (total >0) { + n = read(fd, s, total); + if (n < 0) { perror("read"); errorKan1("%s\n","[(read) ...]; read error.");} + s[n] = 0; + total -= n; s = &(s[n]); + } + rob = KpoString(s0); + } }else if (strcmp(key,"regionMatches")==0) { if (size != 3) errorKan1("%s\n","[(regionMatches) str strArray] extension."); obj1 = getoa(obj,1); @@ -363,19 +460,83 @@ struct object Kextension(struct object obj) obj1 = getoa(obj,1); obj2 = getoa(obj,2); rob = KooPower(obj1,obj2); + }else if (strcmp(key,"Krest")==0) { + if (size != 2) errorKan1("%s\n","[(Krest) a] extension b"); + obj1 = getoa(obj,1); + rob = Krest(obj1); + }else if (strcmp(key,"Kjoin")==0) { + if (size != 3) errorKan1("%s\n","[(Kjoin) a b] extension c"); + obj1 = getoa(obj,1); + obj2 = getoa(obj,2); + rob = Kjoin(obj1,obj2); }else if (strcmp(key,"ostype")==0) { - rob = newObjectArray(1); - /* Hard encode the OS type. */ + /* Hard encode the OS type. cpp -dM /dev/null */ #if defined(__CYGWIN__) + rob = newObjectArray(1); putoa(rob,0,KpoString("windows")); #else + rob = newObjectArray(2); putoa(rob,0,KpoString("unix")); +#if defined(__APPLE__) + putoa(rob,1,KpoString("mac")); +#else + putoa(rob,1,KpoString("generic")); #endif +#endif + }else if (strcmp(key,"stringToArgv")==0) { + if (size != 2) errorKan1("%s\n","[(stringToArgv) a ] extension b"); + obj1 = getoa(obj,1); + if (obj1.tag != Sdollar) errorKan1("%s\n","[(stringToArgv) a ] extension b, a must be a string."); + rob = KstringToArgv(obj1); + }else if (strcmp(key,"stringToArgv2")==0) { + if (size != 3) errorKan1("%s\n","[(stringToArgv2) str separator] extension b"); + obj1 = getoa(obj,1); + obj2 = getoa(obj,2); + rob = KstringToArgv2(obj1,obj2); + }else if (strcmp(key,"traceClearStack")==0) { + traceClearStack(); + rob = NullObject; + }else if (strcmp(key,"traceShowStack")==0) { + char *ssst; + ssst = traceShowStack(); + if (ssst != NULL) { + rob = KpoString(ssst); + }else{ + rob = NullObject; + } + }else if (strcmp(key,"traceShowScannerBuf")==0) { + char *ssst; + ssst = MsgSourceTrace; + if (ssst != NULL) { + rob = KpoString(ssst); + }else{ + rob = NullObject; + } + }else if (strcmp(key,"regexec")==0) { + if ((size != 3) && (size != 4)) errorKan1("%s\n","[(regexec) reg strArray flag(optional)] extension b"); + obj1 = getoa(obj,1); + if (obj1.tag != Sdollar) errorKan1("%s\n","regexec, the first argument should be a string (regular expression)."); + obj2 = getoa(obj,2); + if (obj2.tag != Sarray) errorKan1("%s\n","regexec, the second argument should be an array of a string."); + if (size == 3) obj3 = newObjectArray(0); + else obj3 = getoa(obj,3); + rob = oregexec(obj1,obj2,obj3); + }else if (strcmp(key,"unlink")==0) { + if (size != 2) errorKan1("%s\n","[(unlink) filename] extension b"); + obj1 = getoa(obj,1); + if (obj1.tag != Sdollar) errorKan1("%s\n","unlink, the first argument should be a string (filename)."); + rob = KpoInteger(oxDeleteFile(KopString(obj1))); + }else if (strcmp(key,"quiet")==0) { + obj1 = getoa(obj,1); + if (obj1.tag != Sinteger) errorKan1("%s\n","quiet, the first argument should be an integer."); + Quiet = KopInteger(obj1); + rob = obj1; } #include "plugin.hh" #include "Kclass/tree.hh" else{ - errorKan1("%s\n","Unknown tag for extension."); + fprintf(stderr,"key=%s; ",key); + errorKan1("%s\n","Unknown key for extension."); } @@ -384,7 +545,7 @@ struct object Kextension(struct object obj) struct object KregionMatches(struct object sobj, struct object keyArray) { - struct object rob; + struct object rob = OINIT; int n,i,j,m,keyn; char *s,*key; rob = newObjectArray(3); @@ -417,3 +578,80 @@ struct object KregionMatches(struct object sobj, struc return rob; } +static struct object oregexec(struct object oregex,struct object ostrArray,struct object oflag) { + struct object rob = OINIT; + struct object ob = OINIT; + int n,i,j,m,keyn,cflag,eflag,er; + char *regex; + regex_t preg; + char *s; + char *mbuf; int mbufSize; +#define REGMATCH_SIZE 100 + regmatch_t pmatch[100]; size_t nmatch; + int size; + + nmatch = (size_t) REGMATCH_SIZE; + rob = newObjectArray(0); + mbufSize = 1024; + + if (oregex.tag != Sdollar) return rob; + if (ostrArray.tag != Sarray) return rob; + n = getoaSize(ostrArray); + for (i=0; i