static uim_lisp
c_duplicate2_fileno(uim_lisp oldd_, uim_lisp newd_)
{
if (FALSEP(newd_))
return MAKE_INT(dup(C_INT(oldd_)));
return MAKE_INT(dup2(C_INT(oldd_), C_INT(newd_)));
}
static uim_lisp
c_create_pipe(void)
{
int fildes[2];
if (pipe(fildes) == -1)
return uim_scm_f();
return CONS(MAKE_INT(fildes[0]), MAKE_INT(fildes[1]));
}
static uim_lisp
c_getpeereid(uim_lisp s_)
{
uid_t euid;
gid_t egid;
if (getpeereid(C_INT(s_), &euid, &egid) == -1)
return uim_scm_f();
return CONS(MAKE_INT(euid), MAKE_INT(egid));
}
static uim_lisp
c_file_poll_internal(struct c_file_poll_args *args)
{
int i;
uim_lisp ret_ = uim_scm_null();
struct pollfd *fds = args->fds;
for (i = 0; i < args->nfds; i++)
if (fds[i].revents != 0)
ret_ = CONS(CONS(MAKE_INT(fds[i].fd), MAKE_INT(fds[i].revents)), ret_);
return ret_;
}
/* R6RS (R5.91RS) compatible */
SCM_EXPORT ScmObj
scm_p_greatest_fixnum(void)
{
DECLARE_FUNCTION("greatest-fixnum", procedure_fixed_0);
return MAKE_INT(SCM_INT_MAX);
}
/* R6RS (R5.91RS) compatible */
SCM_EXPORT ScmObj
scm_p_least_fixnum(void)
{
DECLARE_FUNCTION("least-fixnum", procedure_fixed_0);
return MAKE_INT(SCM_INT_MIN);
}
/* R6RS (R5.91RS) compatible */
SCM_EXPORT ScmObj
scm_p_fixnum_width(void)
{
DECLARE_FUNCTION("fixnum-width", procedure_fixed_0);
return MAKE_INT(SCM_INT_BITS);
}
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_sun_len(uim_lisp sun_)
{
struct sockaddr_un *s_un = C_PTR(sun_);
return MAKE_INT(SUN_LEN(s_un));
}
static uim_lisp
c_ref_sockaddr_un_sun_family(uim_lisp sun_)
{
struct sockaddr_un *s_un = C_PTR(sun_);
return MAKE_INT(s_un->sun_family);
}
static uim_lisp
c_addrinfo_ref_ai_addrlen(uim_lisp addrinfo_)
{
struct addrinfo *addrinfo = C_PTR(addrinfo_);
return MAKE_INT(addrinfo->ai_addrlen);
}
static uim_lisp
c_addrinfo_ref_ai_protocol(uim_lisp addrinfo_)
{
struct addrinfo *addrinfo = C_PTR(addrinfo_);
return MAKE_INT(addrinfo->ai_protocol);
}
static uim_lisp
c_addrinfo_ref_ai_socktype(uim_lisp addrinfo_)
{
struct addrinfo *addrinfo = C_PTR(addrinfo_);
return MAKE_INT(addrinfo->ai_socktype);
}
static uim_lisp
get_unconv_candidate(uim_lisp ac_, uim_lisp seg_)
{
uim_lisp nth_;
nth_ = MAKE_INT(NTH_UNCONVERTED_CANDIDATE);
return get_nth_candidate(ac_, seg_, nth_);
}
static uim_lisp
c_process_waitpid(uim_lisp pid_, uim_lisp options_)
{
uim_lisp ret_ = uim_scm_null();
int status;
ret_ = MAKE_INT(waitpid(C_INT(pid_), &status, C_INT(options_)));
if (WIFEXITED(status))
return LIST5(ret_, uim_scm_t(), uim_scm_f(), uim_scm_f(), MAKE_INT(WEXITSTATUS(status)));
else if (WIFSIGNALED(status))
return LIST5(ret_, uim_scm_f(), uim_scm_t(), uim_scm_f(), MAKE_INT(WTERMSIG(status)));
#ifdef WIFSTOPPED
else if (WIFSTOPPED(status))
return LIST5(ret_, uim_scm_f(), uim_scm_f(), uim_scm_t(), MAKE_INT(WSTOPSIG(status)));
#endif
return LIST5(ret_, uim_scm_f(), uim_scm_f(), uim_scm_f(), MAKE_INT(status));
}
SCM_EXPORT ScmObj
scm_p_srfi60_lognot(ScmObj n)
{
DECLARE_FUNCTION("lognot", procedure_fixed_1);
ENSURE_INT(n);
return MAKE_INT(~SCM_INT_VALUE(n));
}
static uim_lisp
c_accept(uim_lisp s_, uim_lisp storage_)
{
socklen_t storagelen;
struct sockaddr_storage *storage = C_PTR(storage_);
storagelen = sizeof(struct sockaddr_storage);
return MAKE_INT(accept(C_INT(s_), (struct sockaddr *)storage, &storagelen));
}
static uim_lisp
uim_sqlite3_step(uim_lisp pStmt_)
{
int ret;
ret = sqlite3_step(C_PTR(pStmt_));
if (ret != SQLITE_OK)
uim_scm_f();
return MAKE_INT(ret);
}
static void *
uim_xml_parse_internal(struct uim_xml_parse_args *args)
{
uim_xml_ctx *ctx = C_PTR(args->ctx_);
const XML_Char *s = REFER_C_STR(args->s_);
int isFinal = C_INT(args->isFinal_);
XML_SetUserData(ctx->parser, ctx->data);
return MAKE_INT(XML_Parse(ctx->parser, s, strlen(s), isFinal));
}
static uim_lisp
c_file_position_set(uim_lisp fildes_, uim_lisp offset_, uim_lisp whence_)
{
int ret = 0;
ret = lseek(C_INT(fildes_), C_INT(offset_), C_INT(whence_));
if (ret == -1) {
uim_lisp err_ = LIST3(fildes_, offset_, whence_);
ERROR_OBJ(strerror(errno), err_);
}
return MAKE_INT(ret);
}
static uim_lisp
file_mtime(uim_lisp filename)
{
struct stat st;
int err;
err = stat(REFER_C_STR(filename), &st);
if (err)
ERROR_OBJ("stat failed for file", filename);
return MAKE_INT(st.st_mtime);
}
static void
validate_segment_index(anthy_context_t ac, int i)
{
int err;
struct anthy_conv_stat cs;
err = anthy_get_stat(ac, &cs);
if (err)
uim_fatal_error("anthy_get_stat() failed");
if (!(0 <= i && i < cs.nr_segment))
ERROR_OBJ("invalid segment index", MAKE_INT(i));
}
static void
init_dbg(void)
{
l_debug_mode = 0;
DEFINE("%debug-macro-compiler", MAKE_INT(DBG_COMPILER));
DEFINE("%debug-macro-matcher", MAKE_INT(DBG_MATCHER));
DEFINE("%debug-macro-transcriptor", MAKE_INT(DBG_TRANSCRIPTOR));
DEFINE("%debug-macro-funcall", MAKE_INT(DBG_FUNCALL));
DEFINE("%debug-macro-pvar", MAKE_INT(DBG_PVAR));
DEFINE("%debug-macro-return", MAKE_INT(DBG_RETURN));
DEFINE("%debug-macro-unwrap", MAKE_INT(DBG_UNWRAP));
DEFINE("%debug-macro-expander", MAKE_INT(DBG_EXPANDER));
scm_register_funcs(dbg_funcs);
}
static uim_lisp
get_nr_segments(uim_lisp ac_)
{
anthy_context_t ac;
struct anthy_conv_stat cs;
int err;
ac = get_anthy_context(ac_);
err = anthy_get_stat(ac, &cs);
if (err)
uim_fatal_error("anthy_get_stat() failed");
return MAKE_INT(cs.nr_segment);
}
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_;
}
SCM_EXPORT ScmObj
scm_p_srfi60_bitwise_if(ScmObj mask, ScmObj n0, ScmObj n1)
{
scm_int_t result, c_mask;
DECLARE_FUNCTION("bitwise-if", procedure_fixed_3);
ENSURE_INT(mask);
ENSURE_INT(n0);
ENSURE_INT(n1);
c_mask = SCM_INT_VALUE(mask);
result = (c_mask & SCM_INT_VALUE(n0)) | (~c_mask & SCM_INT_VALUE(n1));
return MAKE_INT(result);
}
/*
* Dotted list length is returned as follows:
*
* list SRFI-1 dotted length length* result
* 'term 0 -1
* '(1 . term) 1 -2
* '(1 2 . term) 2 -3
* '(1 2 3 . term) 3 -4
*/
SCM_EXPORT ScmObj
scm_p_lengthstar(ScmObj lst)
{
scm_int_t len;
DECLARE_FUNCTION("length*", procedure_fixed_1);
len = scm_length(lst);
if (!SCM_LISTLEN_PROPERP(len)) { /* make fast path for proper list */
if (SCM_LISTLEN_DOTTEDP(len))
len = -SCM_LISTLEN_DOTTED(len) - 1;
else if (SCM_LISTLEN_CIRCULARP(len))
return SCM_FALSE;
}
return MAKE_INT(len);
}
void set_normal_type_instance_attribute(VALUE obj, VALUE attr, VALUE v) {
VALUE ut;
HASH_OBJECT_ENTRY *e;
size_t n;
ut = NORMAL_TYPE_INSTANCE_TYPE(obj);
e = get_hash_key(NGS_TYPE_FIELDS(ut), attr);
if(e) {
n = GET_INT(e->val);
} else {
n = OBJ_LEN(NGS_TYPE_FIELDS(ut));
set_hash_key(NGS_TYPE_FIELDS(ut), attr, MAKE_INT(n));
}
// TODO: more optimized
while(OBJ_LEN(NORMAL_TYPE_INSTANCE_FIELDS(obj)) < n) {
array_push(NORMAL_TYPE_INSTANCE_FIELDS(obj), (VALUE){.num = V_UNDEF});
}
SCM_EXPORT ScmObj
scm_p_string2number(ScmObj str, ScmObj args)
{
scm_int_t ret;
int r;
const char *c_str;
scm_bool err;
DECLARE_FUNCTION("string->number", procedure_variadic_1);
ENSURE_STRING(str);
c_str = SCM_STRING_STR(str);
r = prepare_radix(SCM_MANGLE(name), args);
ret = scm_string2number(c_str, r, &err);
return (err) ? SCM_FALSE : MAKE_INT(ret);
}
static uim_lisp
get_nr_predictions(uim_lisp ac_)
{
#ifdef HAS_ANTHY_PREDICTION
anthy_context_t ac;
struct anthy_prediction_stat ps;
int err;
ac = get_anthy_context(ac_);
err = anthy_get_prediction_stat(ac, &ps);
if (err)
uim_fatal_error("anthy_get_prediction_stat() failed");
return MAKE_INT(ps.nr_prediction);
#else
return uim_scm_f();
#endif
}
