version 1.2, 2000/01/16 07:55:38 |
version 1.9, 2002/02/24 10:27:18 |
|
|
/* $OpenXM$ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/ext.c,v 1.8 2001/08/21 14:12:46 takayama Exp $ */ |
#include <stdio.h> |
#include <stdio.h> |
#include <sys/types.h> |
#include <sys/types.h> |
#include <sys/stat.h> |
#include <sys/stat.h> |
Line 26 static void mywait() { |
|
Line 26 static void mywait() { |
|
for (i=0; i<Mycp; i++) { |
for (i=0; i<Mycp; i++) { |
if (Mychildren[i] == pid) { |
if (Mychildren[i] == pid) { |
for (j=i; j<Mycp-1; j++) { |
for (j=i; j<Mycp-1; j++) { |
Mychildren[j] = Mychildren[j+1]; |
Mychildren[j] = Mychildren[j+1]; |
} |
} |
if (Mycp > 0) Mycp--; |
if (Mycp > 0) Mycp--; |
} |
} |
Line 35 static void mywait() { |
|
Line 35 static void mywait() { |
|
} |
} |
|
|
#define SIZE_OF_ENVSTACK 5 |
#define SIZE_OF_ENVSTACK 5 |
static jmp_buf EnvStack[SIZE_OF_ENVSTACK]; |
#if defined(__CYGWIN__) |
|
#define JMP_BUF sigjmp_buf |
|
#else |
|
#define JMP_BUF jmp_buf |
|
#endif |
|
static JMP_BUF EnvStack[SIZE_OF_ENVSTACK]; |
static int Envp = 0; |
static int Envp = 0; |
static void pushEnv(jmp_buf jb) { |
static void pushEnv(JMP_BUF jb) { |
if (Envp < SIZE_OF_ENVSTACK) { |
if (Envp < SIZE_OF_ENVSTACK) { |
*(EnvStack[Envp]) = *jb; |
*(EnvStack[Envp]) = *jb; |
Envp++; |
Envp++; |
Line 46 static void pushEnv(jmp_buf jb) { |
|
Line 51 static void pushEnv(jmp_buf jb) { |
|
exit(2); |
exit(2); |
} |
} |
} |
} |
static void popEnv(jmp_buf jbp) { |
static void popEnv(JMP_BUF jbp) { |
if (Envp <= 0) { |
if (Envp <= 0) { |
fprintf(stderr,"Underflow of EnvStack.\n"); |
fprintf(stderr,"Underflow of EnvStack.\n"); |
exit(3); |
exit(3); |
Line 81 struct object Kextension(struct object obj) |
|
Line 86 struct object Kextension(struct object obj) |
|
struct object keyo; |
struct object keyo; |
struct object rob = NullObject; |
struct object rob = NullObject; |
struct object obj1,obj2,obj3,obj4; |
struct object obj1,obj2,obj3,obj4; |
int m,i; |
int m,i,pid; |
int argListc, fdListc; |
int argListc, fdListc; |
char *abc; |
char *abc; |
char *abc2; |
char *abc2; |
extern struct context *CurrentContextp; |
extern struct context *CurrentContextp; |
|
#if (__CYGWIN__) |
|
extern sigjmp_buf EnvOfStackMachine; |
|
#else |
extern jmp_buf EnvOfStackMachine; |
extern jmp_buf EnvOfStackMachine; |
|
#endif |
extern void ctrlC(); |
extern void ctrlC(); |
extern int SigIgn; |
extern int SigIgn; |
extern errno; |
extern errno; |
Line 95 struct object Kextension(struct object obj) |
|
Line 104 struct object Kextension(struct object obj) |
|
struct stat buf; |
struct stat buf; |
char **argv; |
char **argv; |
FILE *fp; |
FILE *fp; |
void (*oldsig)(); |
void (*oldsig)(); |
|
extern SecureMode; |
|
|
if (obj.tag != Sarray) errorKan1("%s\n","Kextension(): The argument must be an array."); |
if (obj.tag != Sarray) errorKan1("%s\n","Kextension(): The argument must be an array."); |
size = getoaSize(obj); |
size = getoaSize(obj); |
Line 132 struct object Kextension(struct object obj) |
|
Line 142 struct object Kextension(struct object obj) |
|
if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT)) |
if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT)) |
errorKan1("%s\n","The number must be 0, 1 or 2."); |
errorKan1("%s\n","The number must be 0, 1 or 2."); |
putUserDictionary2((char *)NULL,0,0,m | SET_ATTR_FOR_ALL_WORDS, |
putUserDictionary2((char *)NULL,0,0,m | SET_ATTR_FOR_ALL_WORDS, |
CurrentContextp->userDictionary); |
CurrentContextp->userDictionary); |
}else if (strcmp(key,"keywords")==0) { |
}else if (strcmp(key,"keywords")==0) { |
if (size != 1) errorKan1("%s\n","[(keywords)] extension."); |
if (size != 1) errorKan1("%s\n","[(keywords)] extension."); |
rob = showSystemDictionary(1); |
rob = showSystemDictionary(1); |
/* }else if (strcmp(key,"fork0")==0) { |
/* }else if (strcmp(key,"fork0")==0) { |
if (size != 2) errorKan1("%s\n","[(fork0) sss] extension."); |
if (size != 2) errorKan1("%s\n","[(fork0) sss] extension."); |
m = fork(); |
m = fork(); |
if (m>0) { rob = KpoInteger(m); } |
if (m>0) { rob = KpoInteger(m); } |
else { |
else { |
system(KopString(getoa(obj,1))); exit(0); |
system(KopString(getoa(obj,1))); exit(0); |
} */ |
} */ |
}else if (strcmp(key,"defaultPolyRing")==0) { |
}else if (strcmp(key,"defaultPolyRing")==0) { |
if (size != 2) errorKan1("%s\n","[(defaultPolyRing) n] extension."); |
if (size != 2) errorKan1("%s\n","[(defaultPolyRing) n] extension."); |
rob = KdefaultPolyRing(getoa(obj,1)); |
rob = KdefaultPolyRing(getoa(obj,1)); |
}else if (strcmp(key,"getenv")==0) { |
}else if (strcmp(key,"getenv")==0) { |
if (size != 2) errorKan1("%s\n","[(getenv) envstr] extension."); |
if (size != 2) errorKan1("%s\n","[(getenv) envstr] extension."); |
obj1 = getoa(obj,1); |
obj1 = getoa(obj,1); |
if (obj1.tag != Sdollar) errorKan1("%s\n","[(getenv) envstr] extension"); |
if (obj1.tag != Sdollar) errorKan1("%s\n","[(getenv) envstr] extension"); |
abc = getenv(KopString(obj1)); |
abc = getenv(KopString(obj1)); |
if (abc == NULL) { |
if (abc == NULL) { |
rob = NullObject; |
rob = NullObject; |
|
}else{ |
|
abc2 = (char *)sGC_malloc(sizeof(char)*(strlen(abc)+2)); |
|
strcpy(abc2,abc); |
|
rob = KpoString(abc2); |
|
} |
|
}else if (strcmp(key,"stat")==0) { |
|
if (size != 2) errorKan1("%s\n","[(stat) fname] extension."); |
|
obj1 = getoa(obj,1); |
|
if (obj1.tag != Sdollar) errorKan1("%s\n","[(stat) fname] extension ; string fname."); |
|
m = stat(KopString(obj1),&buf); |
|
rob = newObjectArray(2); |
|
if (m == -1) { |
|
/* fail */ |
|
obj2 = NullObject; |
|
putoa(rob,0,obj2); |
|
obj3 = newObjectArray(2); |
|
putoa(obj3,0,KpoString("error no")); |
|
putoa(obj3,1,KpoInteger(errno)); |
|
putoa(rob,1,obj3); |
|
}else{ |
|
/* success */ |
|
putoa(rob,0,KpoInteger(0)); |
|
obj3 = newObjectArray(1); |
|
putoa(obj3,0,KpoInteger((int) buf.st_size)); |
|
putoa(rob,1,obj3); /* We have not yet read buf fully */ |
|
} |
|
}else if (strcmp(key,"forkExec")==0) { |
|
if (size != 4) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension."); |
|
obj1 = getoa(obj,1); |
|
if (obj1.tag != Sarray) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. array argList."); |
|
obj2 = getoa(obj,2); |
|
if (obj2.tag != Sarray) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. array fdList."); |
|
obj3 = getoa(obj,3); |
|
if (obj3.tag != Sinteger) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. integer sigblock."); |
|
m = KopInteger(obj3); /* m&1 : block ctrl-C. */ |
|
argListc = getoaSize(obj1); |
|
fdListc = getoaSize(obj2); |
|
if ((pid = fork()) > 0) { |
|
/* parent */ |
|
if (m&2) { |
|
/* Do not call singal to turn around a trouble on cygwin. BUG. */ |
}else{ |
}else{ |
abc2 = (char *)sGC_malloc(sizeof(char)*(strlen(abc)+2)); |
signal(SIGCHLD,mywait); /* to kill Zombie */ |
strcpy(abc2,abc); |
|
rob = KpoString(abc2); |
|
} |
} |
}else if (strcmp(key,"stat")==0) { |
Mychildren[Mycp++] = pid; |
if (size != 2) errorKan1("%s\n","[(stat) fname] extension."); |
if (Mycp >= MYCP_SIZE-1) { |
obj1 = getoa(obj,1); |
errorKan1("%s\n","Child process table is full.\n"); |
if (obj1.tag != Sdollar) errorKan1("%s\n","[(stat) fname] extension ; string fname."); |
Mycp = 0; |
m = stat(KopString(obj1),&buf); |
|
rob = newObjectArray(2); |
|
if (m == -1) { |
|
/* fail */ |
|
obj2 = NullObject; |
|
putoa(rob,0,obj2); |
|
obj3 = newObjectArray(2); |
|
putoa(obj3,0,KpoString("error no")); |
|
putoa(obj3,1,KpoInteger(errno)); |
|
putoa(rob,1,obj3); |
|
}else{ |
|
/* success */ |
|
putoa(rob,0,KpoInteger(0)); |
|
putoa(rob,1,newObjectArray(0)); /* We have not yet read buf */ |
|
} |
} |
}else if (strcmp(key,"forkExec")==0) { |
rob = KpoInteger(pid); |
if (size != 4) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension."); |
/* Done */ |
obj1 = getoa(obj,1); |
}else{ |
if (obj1.tag != Sarray) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. array argList."); |
/* Child */ |
obj2 = getoa(obj,2); |
for (i=0; i<fdListc; i++) { |
if (obj2.tag != Sarray) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. array fdList."); |
/* close the specified files */ |
obj3 = getoa(obj,3); |
close(KopInteger(getoa(obj2,i))); |
if (obj3.tag != Sinteger) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. integer sigblock."); |
|
m = KopInteger(obj3); /* m == 1 : block ctrl-C. */ |
|
argListc = getoaSize(obj1); |
|
fdListc = getoaSize(obj2); |
|
if ((m = fork()) > 0) { |
|
/* parent */ |
|
signal(SIGCHLD,mywait); /* to kill Zombie */ |
|
Mychildren[Mycp++] = m; |
|
if (Mycp >= MYCP_SIZE-1) { |
|
errorKan1("%s\n","Child process table is full.\n"); |
|
Mycp = 0; |
|
} |
|
rob = KpoInteger(m); |
|
/* Done */ |
|
}else{ |
|
/* Child */ |
|
for (i=0; i<fdListc; i++) { |
|
/* close the specified files */ |
|
close(KopInteger(getoa(obj2,i))); |
|
} |
|
/* execl */ |
|
if (m == 1) { |
|
{ |
|
sigset_t sss; |
|
sigemptyset(&sss); |
|
sigaddset(&sss,SIGINT); |
|
sigprocmask(SIG_BLOCK,&sss,NULL); |
|
} |
|
} |
|
argv = (char **) sGC_malloc(sizeof(char *)*(argListc+1)); |
|
if (argv == NULL) { |
|
fprintf(stderr," no more momory. forkExec --- exiting.\n"); |
|
_exit(10); |
|
} |
|
for (i=0; i<argListc; i++) { |
|
argv[i] = KopString(getoa(obj1,i)); |
|
argv[i+1] = NULL; |
|
} |
|
execv(argv[0],argv); |
|
/* This place will never be reached unless execv fails. */ |
|
fprintf(stderr,"forkExec fails: "); |
|
for (i=0; i<argListc; i++) { |
|
fprintf(stderr,"%s ",argv[i]); |
|
} |
|
fprintf(stderr,"\nExiting, but staying as Zombie.\n"); |
|
_exit(10); |
|
} |
} |
}else if (strcmp(key,"getchild")==0) { |
/* execl */ |
if (size != 1) errorKan1("%s\n","[(getchild)] extension."); |
if (m&1) { |
rob = newObjectArray(Mycp); |
{ |
for (i=0; i<Mycp; i++) { |
sigset_t sss; |
putoa(rob,i,KpoInteger(Mychildren[i])); |
sigemptyset(&sss); |
|
sigaddset(&sss,SIGINT); |
|
sigprocmask(SIG_BLOCK,&sss,NULL); |
|
} |
} |
} |
}else if (strcmp(key,"getUniqueFileName")==0) { |
argv = (char **) sGC_malloc(sizeof(char *)*(argListc+1)); |
if (size != 2) errorKan1("%s\n","[(getUniqueFileName) path] extension."); |
if (argv == NULL) { |
obj1 = getoa(obj,1); |
fprintf(stderr," no more momory. forkExec --- exiting.\n"); |
if (obj1.tag != Sdollar) errorKan1("%s\n","[(getUniqueFileName) path] extension. path must be a string."); |
_exit(10); |
rob = KpoString(ext_generateUniqueFileName(KopString(obj1))); |
} |
}else if (strcmp(key,"outputObjectToFile")==0) { |
for (i=0; i<argListc; i++) { |
if (size != 3) errorKan1("%s\n","[(outputObjectToFile) path obj] extension."); |
argv[i] = KopString(getoa(obj1,i)); |
obj1 = getoa(obj,1); |
argv[i+1] = NULL; |
if (obj1.tag != Sdollar) errorKan1("%s\n","[(outputObjectToFile) path obj] extension. path must be a string."); |
} |
obj2 = getoa(obj,2); |
|
fp = fopen(KopString(obj1),"w"); |
if (m&4) { |
if (fp == NULL) errorKan1("%s\n","[(outputObjectToFile) path object] extension : could not open the path."); |
fprintf(stderr,"execv %s\n",argv[0]); |
printObject(obj2,0,fp); |
sleep(5); |
fclose(fp); |
fprintf(stderr,">>>\n"); |
rob = NullObject; |
} |
}else if (strcmp(key,"hilbert")==0) { |
execv(argv[0],argv); |
if (size != 3) errorKan1("%s\n","[(hilbert) obgb obvlist] extension."); |
/* This place will never be reached unless execv fails. */ |
rob = hilberto(getoa(obj,1),getoa(obj,2)); |
fprintf(stderr,"forkExec fails: "); |
}else if (strcmp(key,"chattr")==0) { |
for (i=0; i<argListc; i++) { |
if (size != 3) errorKan1("%s\n","[(chattr) num symbol] extension."); |
fprintf(stderr,"%s ",argv[i]); |
obj1 = getoa(obj,1); |
} |
obj2 = getoa(obj,2); |
fprintf(stderr,"\nExiting, but staying as Zombie.\n"); |
if (obj1.tag != Sinteger) errorKan1("%s\n","[(chattr) num symbol] extension."); |
_exit(10); |
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."); |
|
putUserDictionary2(obj2.lc.str,(obj2.rc.op->lc).ival,(obj2.rc.op->rc).ival, |
|
m,CurrentContextp->userDictionary); |
|
} |
} |
|
}else if (strcmp(key,"getchild")==0) { |
|
if (size != 1) errorKan1("%s\n","[(getchild)] extension."); |
|
rob = newObjectArray(Mycp); |
|
for (i=0; i<Mycp; i++) { |
|
putoa(rob,i,KpoInteger(Mychildren[i])); |
|
} |
|
}else if (strcmp(key,"getUniqueFileName")==0) { |
|
if (size != 2) errorKan1("%s\n","[(getUniqueFileName) path] extension."); |
|
obj1 = getoa(obj,1); |
|
if (obj1.tag != Sdollar) errorKan1("%s\n","[(getUniqueFileName) path] extension. path must be a string."); |
|
rob = KpoString(ext_generateUniqueFileName(KopString(obj1))); |
|
}else if (strcmp(key,"outputObjectToFile")==0) { |
|
if (size != 3) errorKan1("%s\n","[(outputObjectToFile) path obj] extension."); |
|
obj1 = getoa(obj,1); |
|
if (obj1.tag != Sdollar) errorKan1("%s\n","[(outputObjectToFile) path obj] extension. path must be a string."); |
|
obj2 = getoa(obj,2); |
|
fp = fopen(KopString(obj1),"w"); |
|
if (fp == NULL) errorKan1("%s\n","[(outputObjectToFile) path object] extension : could not open the path."); |
|
printObject(obj2,0,fp); |
|
fclose(fp); |
|
rob = NullObject; |
|
}else if (strcmp(key,"hilbert")==0) { |
|
if (size != 3) errorKan1("%s\n","[(hilbert) obgb obvlist] extension."); |
|
rob = hilberto(getoa(obj,1),getoa(obj,2)); |
|
}else if (strcmp(key,"chattr")==0) { |
|
if (size != 3) errorKan1("%s\n","[(chattr) num symbol] extension."); |
|
obj1 = getoa(obj,1); |
|
obj2 = getoa(obj,2); |
|
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."); |
|
putUserDictionary2(obj2.lc.str,(obj2.rc.op->lc).ival,(obj2.rc.op->rc).ival, |
|
m,CurrentContextp->userDictionary); |
|
}else if (strcmp(key,"ostype")==0) { |
|
rob = newObjectArray(1); |
|
/* Hard encode the OS type. */ |
|
#if defined(__CYGWIN__) |
|
putoa(rob,0,KpoString("windows")); |
|
#else |
|
putoa(rob,0,KpoString("unix")); |
|
#endif |
|
} |
#include "plugin.hh" |
#include "plugin.hh" |
else{ |
else{ |
errorKan1("%s\n","Unknown tag for extension."); |
errorKan1("%s\n","Unknown tag for extension."); |