static uim_lisp
c_execve(uim_lisp file_, uim_lisp argv_, uim_lisp envp_)
{
char **argv;
char **envp;
int i;
int argv_len = uim_scm_length(argv_);
int envp_len;
uim_lisp ret_;
if (argv_len < 1)
return uim_scm_f();
argv = uim_malloc(sizeof(char *) * (argv_len + 1));
for (i = 0; i < argv_len; i++) {
argv[i] = uim_strdup(REFER_C_STR(CAR(argv_)));
argv_ = CDR(argv_);
}
argv[argv_len] = NULL;
if (FALSEP(envp_) || NULLP(envp_)) {
envp_len = 0;
envp = NULL;
} else {
envp_len = uim_scm_length(envp_);
envp = uim_malloc(sizeof(char *) * (envp_len + 1));
for (i = 0; i < envp_len; i++) {
uim_lisp env_ = CAR(envp_);
uim_asprintf(&envp[i], "%s=%s", REFER_C_STR(CAR(env_)), REFER_C_STR(CDR(env_)));
envp_ = CDR(envp_);
}
envp[envp_len] = NULL;
}
ret_ = MAKE_INT(execve(REFER_C_STR(file_), argv, envp));
for (i = 0; i < argv_len; i++)
free(argv[i]);
free(argv);
for (i = 0; i < envp_len; i++)
free(envp[i]);
free(envp);
return ret_;
}
static uim_lisp
c_execvp(uim_lisp file_, uim_lisp argv_)
{
char **argv;
int i;
int len = uim_scm_length(argv_);
uim_lisp ret_;
if (len < 1)
return uim_scm_f();
argv = uim_malloc(sizeof(char *) * (len + 1));
for (i = 0; i < len; i++) {
argv[i] = uim_strdup(REFER_C_STR(CAR(argv_)));
argv_ = CDR(argv_);
}
argv[len] = NULL;
ret_ = MAKE_INT(execvp(REFER_C_STR(file_), argv));
for (i = 0; i < len; i++)
free(argv[i]);
free(argv);
return ret_;
}
static uim_lisp
c_file_poll(uim_lisp fds_, uim_lisp timeout_)
{
struct pollfd *fds;
int timeout = C_INT(timeout_);
int nfds = uim_scm_length(fds_);
uim_lisp fd_ = uim_scm_f();
int i;
int ret;
uim_lisp ret_;
struct c_file_poll_args args;
fds = uim_calloc(nfds, sizeof(struct pollfd));
for (i = 0; i < nfds; i++) {
fd_ = CAR(fds_);
fds[i].fd = C_INT(CAR(fd_));
fds[i].events = C_INT(CDR(fd_));
fds_ = CDR(fds_);
}
ret = poll(fds, nfds, timeout);
if (ret == -1)
return uim_scm_f();
else if (ret == 0)
return uim_scm_null();
args.fds = fds;
args.nfds = nfds;
ret_ = (uim_lisp)uim_scm_call_with_gc_ready_stack((uim_gc_gate_func_ptr)c_file_poll_internal,
(void *)&args);
free(fds);
return uim_scm_callf("reverse", "o", ret_);
}
static uim_lisp
str_seq_equal(uim_lisp seq, uim_lisp rule)
{
int sl = uim_scm_length(seq);
int rl = uim_scm_length(rule);
int i;
if (sl != rl) {
return uim_scm_f();
}
for (i = 0; i < sl; i++) {
if (!string_equalp(uim_scm_car(seq), uim_scm_car(rule))) {
return uim_scm_f();
}
seq = uim_scm_cdr(seq);
rule = uim_scm_cdr(rule);
}
return uim_scm_t();
}
/*
* Partial -> first string of remaining sequence
* eg. ("a" "b") ("a" "b" "c") -> "c"
* Not partial -> #f
*
*/
static uim_lisp
str_seq_partial(uim_lisp seq, uim_lisp rule)
{
int sl = uim_scm_length(seq);
int rl = uim_scm_length(rule);
int i;
if (sl >= rl) {
return uim_scm_f();
}
/* Obviously. sl < rl */
for (i = 0; i < sl; i++) {
if (!string_equalp(uim_scm_car(seq), uim_scm_car(rule))) {
return uim_scm_f();
}
seq = uim_scm_cdr(seq);
rule = uim_scm_cdr(rule);
}
if (rule && uim_scm_car(rule)) {
return uim_scm_car(rule);
}
/* never reach here */
return uim_scm_f();
}
static uim_lisp
c_file_write(uim_lisp d_, uim_lisp buf_)
{
int nbytes = uim_scm_length(buf_);
uim_lisp ret_;
unsigned char *buf;
unsigned char *p;
buf = p = uim_malloc(nbytes);
while (!NULLP(buf_)) {
*p = C_CHAR(CAR(buf_));
p++;
buf_ = CDR(buf_);
}
ret_ = MAKE_INT((int)write(C_INT(d_), buf, nbytes));
free(buf);
return ret_;
}
static uim_lisp
c_ffi_call(uim_lisp result_, uim_lisp fun_, uim_lisp argv_)
{
ffi_cif cif;
ffi_type **arg_types;
void **arg_values;
ffi_status status;
ffi_type *result_type = NULL;
void *result;
int args;
int i;
void *p;
uim_lisp ret_;
object_type return_object_type;
int input_void = 0;
args = uim_scm_length(argv_);
arg_types = uim_malloc(args * sizeof(void *));
arg_values = uim_malloc(args * sizeof(ffi_type *));
return_object_type = select_object_type(result_);
switch (return_object_type) {
case RET_UNKNOWN:
break;
case RET_VOID:
result_type = &ffi_type_void;
break;
case RET_UCHAR:
result_type = &ffi_type_uchar;
break;
case RET_SCHAR:
result_type = &ffi_type_schar;
break;
case RET_USHORT:
result_type = &ffi_type_ushort;
break;
case RET_SSHORT:
result_type = &ffi_type_sshort;
break;
case RET_ULONG:
result_type = &ffi_type_ulong;
break;
case RET_SLONG:
result_type = &ffi_type_slong;
break;
case RET_UINT:
result_type = &ffi_type_uint;
break;
case RET_SINT:
result_type = &ffi_type_sint;
break;
case RET_FLOAT:
result_type = &ffi_type_float;
break;
case RET_DOUBLE:
result_type = &ffi_type_double;
break;
case RET_STR:
result_type = &ffi_type_pointer;
break;
case RET_PTR:
result_type = &ffi_type_pointer;
break;
case RET_SCM:
result_type = &ffi_type_pointer;
break;
}
result = uim_malloc(1024); /* huge? */
for (i = 0; i < args; i++) {
uim_lisp arg_ = CAR(argv_);
switch (select_object_type(CAR(arg_))) {
case RET_UNKNOWN:
break;
case RET_VOID:
input_void = 1;
break;
case RET_UCHAR:
p = uim_malloc(sizeof(unsigned char));
*((unsigned char *)p) = C_CHAR(CDR(arg_));
arg_types[i] = &ffi_type_uchar;
arg_values[i] = p;
break;
case RET_SCHAR:
p = uim_malloc(sizeof(signed char));
*((signed char *)p) = C_CHAR(CDR(arg_));
arg_types[i] = &ffi_type_schar;
arg_values[i] = p;
break;
case RET_USHORT:
p = uim_malloc(sizeof(unsigned short));
*((unsigned short *)p) = C_INT(CDR(arg_));
arg_types[i] = &ffi_type_ushort;
arg_values[i] = p;
break;
case RET_SSHORT:
p = uim_malloc(sizeof(unsigned short));
*((signed short *)p) = C_INT(CDR(arg_));
arg_types[i] = &ffi_type_sshort;
arg_values[i] = p;
break;
case RET_UINT:
p = uim_malloc(sizeof(unsigned int));
*((unsigned int *)p) = C_INT(CDR(arg_));
arg_types[i] = &ffi_type_uint;
arg_values[i] = p;
break;
case RET_SINT:
p = uim_malloc(sizeof(signed int));
*((signed int *)p) = C_INT(CDR(arg_));
arg_types[i] = &ffi_type_sint;
arg_values[i] = p;
break;
case RET_ULONG:
p = uim_malloc(sizeof(unsigned long));
*((unsigned long *)p) = C_INT(CDR(arg_));
arg_types[i] = &ffi_type_ulong;
arg_values[i] = p;
break;
case RET_SLONG:
p = uim_malloc(sizeof(signed long));
*((signed long *)p) = C_INT(CDR(arg_));
arg_types[i] = &ffi_type_slong;
arg_values[i] = p;
break;
case RET_FLOAT:
{
char *endptr;
p = uim_malloc(sizeof(float));
*((double *)p) = strtof(REFER_C_STR(CDR(arg_)), &endptr);
arg_types[i] = &ffi_type_float;
arg_values[i] = p;
}
break;
case RET_DOUBLE:
{
char *endptr;
p = uim_malloc(sizeof(double));
*((double *)p) = strtod(REFER_C_STR(CDR(arg_)), &endptr);
arg_types[i] = &ffi_type_double;
arg_values[i] = p;
}
break;
case RET_STR:
p = uim_malloc(sizeof(void *));
*((void **)p) = (void *)REFER_C_STR(CDR(arg_));
arg_types[i] = &ffi_type_pointer;
arg_values[i] = p;
break;
case RET_PTR:
p = uim_malloc(sizeof(void *));
if (NULLP(CDR(arg_)))
*((void **)p) = NULL;
else
*((void **)p) = C_PTR(CDR(arg_));
arg_types[i] = &ffi_type_pointer;
arg_values[i] = p;
break;
case RET_SCM:
p = uim_malloc(sizeof(void *));
*((void **)p) = CDR(arg_);
arg_types[i] = &ffi_type_pointer;
arg_values[i] = p;
}
argv_ = CDR(argv_);
}
if (input_void)
args = 0;
status = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, args, result_type, arg_types);
switch (status) {
case FFI_OK:
break;
case FFI_BAD_TYPEDEF:
ffi_strerr_ = ffi_strerr_messages[FFI_STRERR_BAD_TYPEDEF];
break;
case FFI_BAD_ABI:
ffi_strerr_ = ffi_strerr_messages[FFI_STRERR_BAD_ABI];
break;
default:
ffi_strerr_ = ffi_strerr_messages[FFI_STRERR_UNKOWN];
}
if (status == FFI_OK)
ffi_call(&cif, (void (*)(void))C_PTR(fun_), result, arg_values);
for (i = 0; i < args; i++)
free(arg_values[i]);
free(arg_types);
free(arg_values);
if (status != FFI_OK) {
free(result);
return uim_scm_f();
}
ret_ = uim_scm_f();
switch (return_object_type) {
case RET_UNKNOWN:
case RET_VOID:
break;
case RET_UCHAR:
ret_ = MAKE_CHAR(*(unsigned char *)result);
break;
case RET_SCHAR:
ret_ = MAKE_CHAR(*(signed char *)result);
break;
case RET_USHORT:
ret_ = MAKE_INT(*(unsigned short *)result);
break;
case RET_SSHORT:
ret_ = MAKE_INT(*(signed short *)result);
break;
case RET_UINT:
ret_ = MAKE_INT(*(unsigned int *)result);
break;
case RET_SINT:
ret_ = MAKE_INT(*(signed int *)result);
break;
case RET_ULONG:
ret_ = MAKE_INT(*(unsigned long *)result);
break;
case RET_SLONG:
ret_ = MAKE_INT(*(signed long *)result);
break;
case RET_FLOAT:
{
char str[1024];
snprintf(str, sizeof(str), "%f", *((float *)result));
ret_ = MAKE_STR(str);
}
break;
case RET_DOUBLE:
{
char str[1024];
snprintf(str, sizeof(str), "%f", *((double *)result));
ret_ = MAKE_STR(str);
}
break;
case RET_STR:
ret_ = MAKE_STR(*((char **)result));
break;
case RET_PTR:
ret_ = MAKE_PTR(*((void **)result));
break;
case RET_SCM:
ret_ = *(uim_lisp *)result;
break;
}
free(result);
ffi_strerr_ = NULL;
return ret_;
}