static sexp sexp_get_opcode_param_type (sexp ctx, sexp self, sexp_sint_t n, sexp op, sexp k) {
sexp res;
int p = sexp_unbox_fixnum(k);
if (! sexp_opcodep(op))
return sexp_type_exception(ctx, self, SEXP_OPCODE, op);
else if (! sexp_fixnump(k))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, k);
if (p > sexp_opcode_num_args(op) && sexp_opcode_variadic_p(op))
p = sexp_opcode_num_args(op);
switch (p) {
case 0:
res = sexp_opcode_arg1_type(op);
break;
case 1:
res = sexp_opcode_arg2_type(op);
break;
default:
res = sexp_opcode_arg3_type(op);
if (res && sexp_vectorp(res)) {
if (sexp_vector_length(res) > (sexp_unbox_fixnum(k)-2))
res = sexp_vector_ref(res, sexp_fx_sub(k, SEXP_TWO));
else
res = sexp_type_by_index(ctx, SEXP_OBJECT);
}
break;
}
return sexp_translate_opcode_type(ctx, res);
}
static sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp bound) {
sexp res;
int32_t m;
#if SEXP_USE_BIGNUMS
int32_t hi, mod, len, i, *data;
#endif
if (! sexp_random_source_p(rs))
res = sexp_type_exception(ctx, self, rs_type_id, rs);
if (sexp_fixnump(bound)) {
sexp_call_random(rs, m);
res = sexp_make_fixnum(m % sexp_unbox_fixnum(bound));
#if SEXP_USE_BIGNUMS
} else if (sexp_bignump(bound)) {
hi = sexp_bignum_hi(bound);
len = hi * sizeof(sexp_uint_t) / sizeof(int32_t);
res = sexp_make_bignum(ctx, hi);
data = (int32_t*) sexp_bignum_data(res);
for (i=0; i<len-1; i++) {
sexp_call_random(rs, m);
data[i] = m;
}
sexp_call_random(rs, m);
mod = sexp_bignum_data(bound)[hi-1] * sizeof(int32_t) / sizeof(sexp_uint_t);
if (mod)
data[i] = m % mod;
#endif
} else {
res = sexp_type_exception(ctx, self, SEXP_FIXNUM, bound);
}
return res;
}
static sexp sexp_bit_and (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
sexp res;
#if SEXP_USE_BIGNUMS
sexp_sint_t len, i;
#endif
if (sexp_fixnump(x)) {
if (sexp_fixnump(y))
res = (sexp) ((sexp_uint_t)x & (sexp_uint_t)y);
#if SEXP_USE_BIGNUMS
else if (sexp_bignump(y))
res = sexp_bit_and(ctx, self, n, y, x);
#endif
else
res = sexp_type_exception(ctx, self, SEXP_FIXNUM, y);
#if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) {
if (sexp_fixnump(y)) {
res = sexp_make_fixnum(sexp_unbox_fixnum(y) & sexp_bignum_data(x)[0]);
} else if (sexp_bignump(y)) {
if (sexp_bignum_length(x) < sexp_bignum_length(y))
res = sexp_copy_bignum(ctx, NULL, x, 0);
else
res = sexp_copy_bignum(ctx, NULL, y, 0);
for (i=0, len=sexp_bignum_length(res); i<len; i++)
sexp_bignum_data(res)[i]
= sexp_bignum_data(x)[i] & sexp_bignum_data(y)[i];
} else {
res = sexp_type_exception(ctx, self, SEXP_FIXNUM, y);
}
#endif
} else {
res = sexp_type_exception(ctx, self, SEXP_FIXNUM, x);
}
return sexp_bignum_normalize(res);
}
sexp sexp_postmountsrv (sexp ctx, sexp self, sexp_sint_t n, sexp ls, sexp name, sexp mtpt, sexp flags) {
Srv s;
struct sexp_plan9_srv p9s;
if (! sexp_listp(ctx, ls))
return sexp_type_exception(ctx, self, SEXP_PAIR, ls);
if (! sexp_stringp(name))
return sexp_type_exception(ctx, self, SEXP_STRING, name);
if (! sexp_stringp(mtpt))
return sexp_type_exception(ctx, self, SEXP_STRING, mtpt);
if (! sexp_integerp(flags))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, flags);
sexp_build_srv(ctx, &p9s, ls);
s.aux = &p9s;
s.auth = &sexp_9p_auth;
s.attach = &sexp_9p_attach;
s.walk = &sexp_9p_walk;
s.walk1 = &sexp_9p_walk1;
s.clone = &sexp_9p_clone;
s.open = &sexp_9p_open;
s.create = &sexp_9p_create;
s.remove = &sexp_9p_remove;
s.read = &sexp_9p_read;
s.write = &sexp_9p_write;
s.stat = &sexp_9p_stat;
s.wstat = &sexp_9p_wstat;
s.flush = &sexp_9p_flush;
s.destroyfid = &sexp_9p_destroyfid;
s.destroyreq = &sexp_9p_destroyreq;
s.end = &sexp_9p_end;
postmountsrv(&s, sexp_string_data(name), sexp_string_data(mtpt),
sexp_unbox_fixnum(flags));
return SEXP_UNDEF;
}
static sexp sexp_random_source_pseudo_randomize (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp seed) {
if (! sexp_random_source_p(rs))
return sexp_type_exception(ctx, self, rs_type_id, rs);
if (! sexp_fixnump(seed))
return sexp_type_exception(ctx, self, rs_type_id, seed);
sexp_seed_random(sexp_unbox_fixnum(seed), rs);
return SEXP_VOID;
}
sexp sexp_postnote (sexp ctx, sexp self, sexp_sint_t n, sexp pid, sexp note) {
if (! sexp_integerp(pid))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, pid);
if (! sexp_stringp(note))
return sexp_type_exception(ctx, self, SEXP_STRING, note);
postnote(PNPROC, sexp_unbox_fixnum(pid), sexp_string_data(note));
return SEXP_VOID;
}
static sexp sexp_random_uint_range_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
sexp res;
if (! sexp_exact_integerp(arg0))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg0);
if (! sexp_exact_integerp(arg1))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
res = sexp_make_unsigned_integer(ctx, random_uint_range(sexp_uint_value(arg0), sexp_uint_value(arg1)));
return res;
}
static sexp sexp_file_access_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
sexp res;
if (! sexp_stringp(arg0))
return sexp_type_exception(ctx, self, SEXP_STRING, arg0);
if (! sexp_exact_integerp(arg1))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
res = sexp_make_integer(ctx, access(sexp_string_data(arg0), sexp_sint_value(arg1)));
return res;
}
static sexp sexp_random_source_state_set (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp state) {
if (! sexp_random_source_p(rs))
return sexp_type_exception(ctx, self, rs_type_id, rs);
else if (! (sexp_stringp(state)
&& (sexp_string_size(state) == SEXP_RANDOM_STATE_SIZE)))
return sexp_type_exception(ctx, self, SEXP_STRING, state);
sexp_random_state(rs) = state;
sexp_random_init(rs, 1);
return SEXP_VOID;
}
static sexp sexp_open_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
sexp res;
if (! sexp_stringp(arg0))
return sexp_type_exception(ctx, self, SEXP_STRING, arg0);
if (! sexp_exact_integerp(arg1))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
if (! sexp_exact_integerp(arg2))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
res = sexp_make_fileno(ctx, sexp_make_fixnum(open(sexp_string_data(arg0), sexp_sint_value(arg1), sexp_sint_value(arg2))), SEXP_FALSE);
return res;
}
static sexp sexp_player_move_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
sexp res;
if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == sexp_unbox_fixnum(sexp_opcode_arg1_type(self)))))
return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), arg0);
if (! sexp_exact_integerp(arg1))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
if (! sexp_exact_integerp(arg2))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
res = ((player_move((struct player**)sexp_cpointer_value(arg0), sexp_uint_value(arg1), sexp_uint_value(arg2))), SEXP_VOID);
return res;
}
static sexp sexp_random_source_state_set (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp state) {
if (! sexp_random_source_p(rs))
return sexp_type_exception(ctx, self, rs_type_id, rs);
else if (sexp_fixnump(state))
*sexp_random_data(rs) = sexp_unbox_fixnum(state);
#if SEXP_USE_BIGNUMS
else if (sexp_bignump(state))
*sexp_random_data(rs)
= sexp_bignum_data(state)[0]*sexp_bignum_sign(state);
#endif
else
return sexp_type_exception(ctx, self, SEXP_FIXNUM, state);
return SEXP_VOID;
}
static sexp sexp_create_directory_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
int err;
sexp res;
if (! sexp_stringp(arg0))
return sexp_type_exception(ctx, self, SEXP_STRING, arg0);
if (! sexp_exact_integerp(arg1))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
err = mkdir(sexp_string_data(arg0), sexp_sint_value(arg1));
if (err) {
res = SEXP_FALSE;
} else {
res = SEXP_TRUE;
}
return res;
}
static sexp sexp_duplicate_file_descriptor_to_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
int err;
sexp res;
if (! (sexp_filenop(arg0) || sexp_fixnump(arg0)))
return sexp_type_exception(ctx, self, SEXP_FILENO, arg0);
if (! (sexp_filenop(arg1) || sexp_fixnump(arg1)))
return sexp_type_exception(ctx, self, SEXP_FILENO, arg1);
err = dup2((sexp_filenop(arg0) ? sexp_fileno_fd(arg0) : sexp_unbox_fixnum(arg0)), (sexp_filenop(arg1) ? sexp_fileno_fd(arg1) : sexp_unbox_fixnum(arg1)));
if (err) {
res = SEXP_FALSE;
} else {
res = SEXP_TRUE;
}
return res;
}
sexp sexp_fdopen (sexp ctx, sexp self, sexp_sint_t n, sexp fd, sexp mode) {
FILE *f;
if (! sexp_integerp(fd))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, fd);
if (! sexp_stringp(mode))
return sexp_type_exception(ctx, self, SEXP_STRING, mode);
f = fdopen(sexp_unbox_fixnum(fd), sexp_string_data(mode));
if (! f)
return sexp_user_exception(ctx, SEXP_FALSE, "fdopen failed", fd);
/* maybe use fd2path to get the name of the fd */
if (sexp_string_data(mode)[0] == 'w')
return sexp_make_output_port(ctx, f, SEXP_FALSE);
else
return sexp_make_input_port(ctx, f, SEXP_FALSE);
}
static sexp sexp_link_file_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
int err;
sexp res;
if (! sexp_stringp(arg0))
return sexp_type_exception(ctx, self, SEXP_STRING, arg0);
if (! sexp_stringp(arg1))
return sexp_type_exception(ctx, self, SEXP_STRING, arg1);
err = link(sexp_string_data(arg0), sexp_string_data(arg1));
if (err) {
res = SEXP_FALSE;
} else {
res = SEXP_TRUE;
}
return res;
}
static sexp sexp_set_time_of_day_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
int err;
sexp res;
if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == sexp_unbox_fixnum(sexp_opcode_arg1_type(self)))))
return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), arg0);
if (! ((sexp_pointerp(arg1) && (sexp_pointer_tag(arg1) == sexp_unbox_fixnum(sexp_opcode_arg2_type(self)))) || sexp_not(arg1)))
return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg2_type(self)), arg1);
err = settimeofday((struct timeval*)sexp_cpointer_value(arg0), (struct timezone*)sexp_cpointer_maybe_null_value(arg1));
if (err) {
res = SEXP_FALSE;
} else {
res = SEXP_TRUE;
}
return res;
}
sexp sexp_getenv (sexp ctx, sexp self, sexp_sint_t n, sexp name) {
char *value;
if (! sexp_stringp(name))
return sexp_type_exception(ctx, self, SEXP_STRING, name);
value = getenv(sexp_string_data(name));
return ((! value) ? SEXP_FALSE : sexp_c_string(ctx, value, -1));
}
static sexp sexp_rs_random_real (sexp ctx, sexp self, sexp_sint_t n, sexp rs) {
int32_t res;
if (! sexp_random_source_p(rs))
return sexp_type_exception(ctx, self, rs_type_id, rs);
sexp_call_random(rs, res);
return sexp_make_flonum(ctx, (double)res / (double)RAND_MAX);
}
static sexp sexp_time_3e_seconds_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
sexp res;
if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == sexp_unbox_fixnum(sexp_opcode_arg1_type(self)))))
return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), arg0);
res = sexp_make_integer(ctx, sexp_shift_epoch(mktime((struct tm*)sexp_cpointer_value(arg0))));
return res;
}
static sexp sexp_sleep_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
sexp res;
if (! sexp_exact_integerp(arg0))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg0);
res = ((io_sleep(sexp_uint_value(arg0))), SEXP_VOID);
return res;
}
static sexp sexp_player_delete_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
sexp res;
if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == sexp_unbox_fixnum(sexp_opcode_arg1_type(self)))))
return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), arg0);
res = ((player_delete((struct player**)sexp_cpointer_value(arg0))), SEXP_VOID);
return res;
}
static sexp sexp_readdir_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
sexp res;
if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == sexp_unbox_fixnum(sexp_opcode_arg1_type(self)))))
return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), arg0);
res = sexp_make_cpointer(ctx, sexp_unbox_fixnum(sexp_opcode_return_type(self)), readdir((DIR*)sexp_cpointer_value(arg0)), arg0, 0);
return res;
}
static sexp sexp_duplicate_file_descriptor_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
sexp res;
if (! (sexp_filenop(arg0) || sexp_fixnump(arg0)))
return sexp_type_exception(ctx, self, SEXP_FILENO, arg0);
res = sexp_make_fileno(ctx, sexp_make_fixnum(dup((sexp_filenop(arg0) ? sexp_fileno_fd(arg0) : sexp_unbox_fixnum(arg0)))), SEXP_FALSE);
return res;
}
static sexp sexp_opendir_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
sexp res;
if (! sexp_stringp(arg0))
return sexp_type_exception(ctx, self, SEXP_STRING, arg0);
res = sexp_make_cpointer(ctx, sexp_unbox_fixnum(sexp_opcode_return_type(self)), opendir(sexp_string_data(arg0)), SEXP_FALSE, 1);
return res;
}
static sexp sexp_S_ISREG_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
sexp res;
if (! sexp_exact_integerp(arg0))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg0);
res = sexp_make_boolean(S_ISREG(sexp_uint_value(arg0)));
return res;
}
static sexp sexp_get_opcode_name (sexp ctx, sexp self, sexp_sint_t n, sexp op) {
if (! sexp_opcodep(op))
return sexp_type_exception(ctx, self, SEXP_OPCODE, op);
else if (! sexp_opcode_name(op))
return SEXP_FALSE;
else
return sexp_opcode_name(op);
}
sexp sexp_file_exists_p (sexp ctx, sexp self, sexp_sint_t n, sexp path) {
int res;
uchar statbuf[STATMAX];
if (! sexp_stringp(path))
return sexp_type_exception(ctx, self, SEXP_STRING, path);
res = stat(sexp_string_data(path), statbuf, sizeof(statbuf));
return (res < 0) ? SEXP_FALSE : SEXP_TRUE;
}
static sexp sexp_file_truncate_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
sexp res;
if (! (sexp_portp(arg0) || sexp_filenop(arg0) || sexp_fixnump(arg0)))
return sexp_xtype_exception(ctx, self, "not a port or file descriptor",arg0);
if (! sexp_exact_integerp(arg1))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
res = sexp_make_integer(ctx, ftruncate((sexp_portp(arg0) ? sexp_port_fileno(arg0) : sexp_filenop(arg0) ? sexp_fileno_fd(arg0) : sexp_unbox_fixnum(arg0)), sexp_uint_value(arg1)));
return res;
}
static sexp sexp_make_custom_port (sexp ctx, sexp self, char *mode,
sexp read, sexp write,
sexp seek, sexp close) {
FILE *in;
sexp res;
sexp_gc_var1(vec);
if (sexp_truep(read) && ! sexp_procedurep(read))
return sexp_type_exception(ctx, self, SEXP_PROCEDURE, read);
if (sexp_truep(write) && ! sexp_procedurep(write))
return sexp_type_exception(ctx, self, SEXP_PROCEDURE, write);
if (sexp_truep(seek) && ! sexp_procedurep(seek))
return sexp_type_exception(ctx, self, SEXP_PROCEDURE, seek);
if (sexp_truep(close) && ! sexp_procedurep(close))
return sexp_type_exception(ctx, self, SEXP_PROCEDURE, close);
sexp_gc_preserve1(ctx, vec);
vec = sexp_make_vector(ctx, SEXP_SIX, SEXP_VOID);
sexp_cookie_ctx_set(vec, ctx);
sexp_cookie_buffer_set(vec, sexp_make_string(ctx, sexp_make_fixnum(SEXP_PORT_BUFFER_SIZE), SEXP_VOID));
sexp_cookie_read_set(vec, read);
sexp_cookie_write_set(vec, write);
sexp_cookie_seek_set(vec, seek);
sexp_cookie_close_set(vec, close);
#if SEXP_BSD
in = funopen(vec,
(sexp_procedurep(read) ? sexp_cookie_reader : NULL),
(sexp_procedurep(write) ? sexp_cookie_writer : NULL),
NULL, /* (sexp_procedurep(seek) ? sexp_cookie_reader : NULL), */
(sexp_procedurep(close) ? sexp_cookie_cleaner : NULL));
#else
in = fopencookie(vec, mode, (sexp_truep(seek) ? sexp_cookie : sexp_cookie_no_seek));
#endif
if (! in) {
res = sexp_user_exception(ctx, self, "couldn't make custom port", read);
} else {
res = sexp_make_input_port(ctx, in, SEXP_FALSE);
sexp_port_cookie(res) = vec; /* for gc preserving */
}
if (mode && mode[0] == 'w')
sexp_pointer_tag(res) = SEXP_OPORT;
sexp_gc_release1(ctx);
return res;
}
