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;
}
sexp sexp_thread_terminate (sexp ctx, sexp self, sexp_sint_t n, sexp thread) {
sexp res = sexp_make_boolean(ctx == thread);
for ( ; thread && sexp_contextp(thread); thread=sexp_context_child(thread))
sexp_context_refuel(thread) = 0;
/* return true if terminating self */
return res;
}
static sexp sexp_is_a_tty_p_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
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);
res = sexp_make_boolean(isatty((sexp_portp(arg0) ? sexp_port_fileno(arg0) : sexp_filenop(arg0) ? sexp_fileno_fd(arg0) : sexp_unbox_fixnum(arg0))));
return res;
}
static void do_init_context (sexp* ctx, sexp* env, sexp_uint_t heap_size,
sexp_uint_t heap_max_size, sexp_sint_t fold_case) {
*ctx = sexp_make_eval_context(NULL, NULL, NULL, heap_size, heap_max_size);
if (! *ctx) {
fprintf(stderr, "chibi-scheme: out of memory\n");
exit_failure();
}
#if SEXP_USE_FOLD_CASE_SYMS
sexp_global(*ctx, SEXP_G_FOLD_CASE_P) = sexp_make_boolean(fold_case);
#endif
*env = sexp_context_env(*ctx);
}
sexp sexp_current_ntp_clock_values (sexp ctx, sexp self, sexp_sint_t n) {
double second;
int leap_second_indicator;
sexp_gc_var3(res, car, cdr);
current_ntp_clock_values (&second, &leap_second_indicator);
sexp_gc_preserve3(ctx, res, car, cdr);
cdr = sexp_make_boolean(leap_second_indicator);
car = sexp_make_flonum(ctx, second);
res = sexp_cons(ctx, car, cdr);
sexp_gc_release3(ctx);
return res;
}
sexp sexp_thread_terminate (sexp ctx, sexp self, sexp_sint_t n, sexp thread) {
sexp res = sexp_make_boolean(ctx == thread);
/* terminate the thread and all children */
for ( ; thread && sexp_contextp(thread); thread=sexp_context_child(thread)) {
/* zero the refuel - this tells the scheduler the thread is terminated */
sexp_context_refuel(thread) = 0;
/* unblock the thread if needed so it can be scheduled and terminated */
if (sexp_delete_list(ctx, SEXP_G_THREADS_PAUSED, thread))
sexp_thread_start(ctx, self, 1, thread);
}
/* return true if terminating self, then we can yield */
return res;
}
sexp sexp_thread_exceptionp (sexp ctx, sexp self, sexp_sint_t n, sexp thread) {
sexp_assert_type(ctx, sexp_contextp, SEXP_CONTEXT, thread);
return sexp_make_boolean(sexp_context_errorp(thread));
}
sexp sexp_thread_timeoutp (sexp ctx, sexp self, sexp_sint_t n) {
return sexp_make_boolean(sexp_context_timeoutp(ctx));
}
static sexp sexp_get_opcode_variadic_p (sexp ctx, sexp self, sexp_sint_t n, sexp op) {
sexp_assert_type(ctx, sexp_opcodep, SEXP_OPCODE, op);
return sexp_make_boolean(sexp_opcode_variadic_p(op));
}
sexp sexp_thread_timeoutp (sexp ctx sexp_api_params(self, n)) {
return sexp_make_boolean(sexp_context_timeoutp(ctx));
}
static sexp sexp_get_procedure_variadic_p (sexp ctx, sexp self, sexp_sint_t n, sexp proc) {
sexp_assert_type(ctx, sexp_procedurep, SEXP_PROCEDURE, proc);
return sexp_make_boolean(sexp_procedure_variadic_p(proc));
}
static sexp sexp_unsetenv (sexp ctx, sexp self, sexp_sint_t n, sexp name) {
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, name);
return sexp_make_boolean(unsetenv(sexp_string_data(name)));
}
static sexp sexp_setenv (sexp ctx, sexp self, sexp_sint_t n, sexp name, sexp value) {
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, name);
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, value);
return sexp_make_boolean(setenv(sexp_string_data(name), sexp_string_data(value), 1));
}
static sexp sexp_env_syntactic_op (sexp ctx, sexp self, sexp_sint_t n, sexp e) {
sexp_assert_type(ctx, sexp_envp, SEXP_ENV, e);
return sexp_make_boolean(sexp_env_syntactic_p(e));
}
