sexp sexp_bignum_add_digits (sexp ctx, sexp dst, sexp a, sexp b) { sexp_uint_t alen=sexp_bignum_hi(a), blen=sexp_bignum_hi(b), carry=0, i, n, *adata, *bdata, *cdata; sexp_gc_var1(c); if (alen < blen) return sexp_bignum_add_digits(ctx, dst, b, a); sexp_gc_preserve1(ctx, c); c = ((dst && sexp_bignum_hi(dst) >= alen) ? dst : sexp_copy_bignum(ctx, NULL, a, 0)); adata = sexp_bignum_data(a); bdata = sexp_bignum_data(b); cdata = sexp_bignum_data(c); for (i=0; i<blen; i++) { n = adata[i]; cdata[i] = n + bdata[i] + carry; carry = (n > (SEXP_UINT_T_MAX - bdata[i]) ? 1 : 0); } for ( ; carry && (i<alen); i++) { carry = (cdata[i] == SEXP_UINT_T_MAX-1 ? 1 : 0); cdata[i]++; } if (carry) { c = sexp_copy_bignum(ctx, NULL, c, alen+1); sexp_bignum_data(c)[alen] = 1; } sexp_gc_release1(ctx); return c; }
static sexp sexp_current_directory_stub (sexp ctx, sexp self, sexp_sint_t n) { char *err; char buf0[256]; int len0; char *tmp0; sexp res; sexp_gc_var1(res0); sexp_gc_preserve1(ctx, res0); len0 = 256; tmp0 = buf0; loop: err = getcwd(tmp0, len0); if (!err) { if (len0 != 256) free(tmp0); len0 *= 2; tmp0 = (char*) calloc(len0, sizeof(tmp0[0])); goto loop; } else { res0 = sexp_c_string(ctx, tmp0, -1); res = res0; } if (len0 != 256) free(tmp0); sexp_gc_release1(ctx); return res; }
sexp sexp_bignum_remainder (sexp ctx, sexp a, sexp b) { sexp_gc_var1(rem); sexp_gc_preserve1(ctx, rem); sexp_bignum_quot_rem(ctx, &rem, a, b); /* discard quotient */ sexp_gc_release1(ctx); return rem; }
sexp sexp_bignum_quotient (sexp ctx, sexp a, sexp b) { sexp res; sexp_gc_var1(rem); sexp_gc_preserve1(ctx, rem); res = sexp_bignum_quot_rem(ctx, &rem, a, b); sexp_gc_release1(ctx); return res; }
sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, sexp_abi_identifier_t abi) { sexp t; sexp_gc_var1(name); if (!(sexp_version_compatible(ctx, version, sexp_version) && sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER))) return SEXP_ABI_ERROR; #if SEXP_USE_GREEN_THREADS sexp_gc_preserve1(ctx, name); sexp_global(ctx, SEXP_G_THREADS_MUTEX_ID) = sexp_lookup_named_type(ctx, env, "Mutex"); name = sexp_c_string(ctx, "pollfds", -1); t = sexp_register_type(ctx, name, SEXP_FALSE, SEXP_FALSE, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, sexp_make_fixnum(sexp_sizeof_pollfds), SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, NULL, (sexp_proc2)sexp_free_pollfds); if (sexp_typep(t)) { sexp_global(ctx, SEXP_G_THREADS_POLLFDS_ID) = sexp_make_fixnum(sexp_type_tag(t)); } sexp_define_type_predicate_by_tag(ctx, env, "thread?", SEXP_CONTEXT); sexp_define_foreign(ctx, env, "thread-timeout?", 0, sexp_thread_timeoutp); sexp_define_foreign(ctx, env, "current-thread", 0, sexp_current_thread); sexp_define_foreign_opt(ctx, env, "make-thread", 2, sexp_make_thread, SEXP_FALSE); sexp_define_foreign(ctx, env, "thread-start!", 1, sexp_thread_start); sexp_define_foreign(ctx, env, "%thread-terminate!", 1, sexp_thread_terminate); sexp_define_foreign(ctx, env, "%thread-join!", 2, sexp_thread_join); sexp_define_foreign(ctx, env, "%thread-sleep!", 1, sexp_thread_sleep); sexp_define_foreign(ctx, env, "thread-name", 1, sexp_thread_name); sexp_define_foreign(ctx, env, "thread-specific", 1, sexp_thread_specific); sexp_define_foreign(ctx, env, "thread-specific-set!", 2, sexp_thread_specific_set); sexp_define_foreign(ctx, env, "%thread-end-result", 1, sexp_thread_end_result); sexp_define_foreign(ctx, env, "%thread-exception?", 1, sexp_thread_exceptionp); sexp_define_foreign(ctx, env, "mutex-state", 1, sexp_mutex_state); sexp_define_foreign(ctx, env, "%mutex-lock!", 3, sexp_mutex_lock); sexp_define_foreign(ctx, env, "%mutex-unlock!", 3, sexp_mutex_unlock); sexp_define_foreign(ctx, env, "condition-variable-signal!", 1, sexp_condition_variable_signal); sexp_define_foreign(ctx, env, "condition-variable-broadcast!", 1, sexp_condition_variable_broadcast); sexp_define_foreign(ctx, env, "pop-signal!", 0, sexp_pop_signal); sexp_define_foreign(ctx, env, "get-signal-handler", 1, sexp_get_signal_handler); sexp_global(ctx, SEXP_G_THREADS_SCHEDULER) = sexp_make_foreign(ctx, "scheduler", 1, 0, (sexp_proc1)sexp_scheduler, SEXP_FALSE); sexp_global(ctx, SEXP_G_THREADS_BLOCKER) = sexp_make_foreign(ctx, "blocker", 1, 0, (sexp_proc1)sexp_blocker, SEXP_FALSE); /* remember the env to lookup the runner later */ sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = env; sexp_gc_release1(ctx); #endif /* SEXP_USE_GREEN_THREADS */ return SEXP_VOID; }
void sexp_resume() { sexp_gc_var1(tmp); sexp_gc_preserve1(sexp_resume_ctx, tmp); tmp = sexp_list1(sexp_resume_ctx, SEXP_VOID); if (sexp_applicablep(sexp_resume_proc)) { sexp_resume_proc = check_exception(sexp_resume_ctx, sexp_apply(sexp_resume_ctx, sexp_resume_proc, tmp)); } sexp_gc_release1(sexp_resume_ctx); }
int main() { sexp ctx = sexp_make_eval_context(NULL, NULL, NULL, 0, 0); sexp_load_standard_env(ctx, NULL, SEXP_SEVEN); sexp_gc_var1(score); sexp_gc_preserve1(ctx, score); bool ret = ext::load_file(ctx, "mammon.ss"); if (!ret) { std::cout << "Could not find configuration file `mammon.ss`." << std::endl; return 1; } score = sexp_eval_string(ctx, "score", -1, NULL); if (sexp_procedurep(score)) { score::ext_score = [&ctx](const char *b, const char *t) { return ext::call_fun_str2(ctx, "score", b, t); }; } const auto boards = ext::config_get_list(ctx, "boards"); if (boards.empty()) { std::cout << "Please add a value for `boards` in your configuration " "file.\ne.g. (define boards '(\"g\" \"a\" \"k\"))" << std::endl; return 1; } const std::string dom = ext::config_get_str(ctx, "dom", ""); std::unique_ptr<chan_proc> pc; if (dom == "4chan") { pc = std::unique_ptr<chan_proc>(new fourchan_proc()); } else if (dom == "8chan") { std::string url = ext::config_get_str(ctx, "url-8chan", ""); pc = std::unique_ptr<chan_proc>(new eightchan_proc(std::move(url))); } else { std::cout << "Please specify a value for `dom` in your configuration " "file.\nPossible values are:" << std::endl; std::cout << "\t4chan\n" << "\t8chan\n" << std::endl; return 1; } for (const auto &b: boards) pc->proc_board(b); sexp_gc_release1(ctx); sexp_destroy_context(ctx); return 0; }
sexp sexp_ratio_ceiling (sexp ctx, sexp a) { sexp_gc_var1(q); sexp_gc_preserve1(ctx, q); q = sexp_quotient(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(a)); if (sexp_positivep(sexp_ratio_numerator(a))) q = sexp_add(ctx, q, SEXP_ONE); sexp_gc_release1(ctx); return q; }
static sexp sexp_env_push_op (sexp ctx, sexp self, sexp_sint_t n, sexp env, sexp name, sexp value) { sexp_gc_var1(tmp); sexp_assert_type(ctx, sexp_envp, SEXP_ENV, env); sexp_assert_type(ctx, sexp_idp, SEXP_SYMBOL, name); sexp_gc_preserve1(ctx, tmp); sexp_env_push(ctx, env, tmp, name, value); sexp_gc_release1(ctx); return SEXP_VOID; }
sexp sexp_complex_expt (sexp ctx, sexp a, sexp b) { sexp_gc_var1(res); sexp_gc_preserve1(ctx, res); res = sexp_to_complex(ctx, a); res = sexp_complex_log(ctx, res); res = sexp_mul(ctx, b, res); res = sexp_complex_exp(ctx, res); sexp_gc_release1(ctx); return res; }
sexp sexp_get_output_bytevector (sexp ctx, sexp self, sexp port) { sexp_gc_var1(res); sexp_assert_type(ctx, sexp_oportp, SEXP_OPORT, port); if (!sexp_port_binaryp(port)) return sexp_xtype_exception(ctx, self, "not a binary port", port); sexp_gc_preserve1(ctx, res); res = sexp_get_output_string(ctx, port); res = sexp_string_to_bytes(ctx, res); sexp_gc_release1(ctx); return res; }
sexp sexp_bignum_add_fixnum (sexp ctx, sexp a, sexp b) { sexp_gc_var1(c); sexp_gc_preserve1(ctx, c); c = sexp_copy_bignum(ctx, NULL, a, 0); if (sexp_bignum_sign(c) == sexp_fx_sign(b)) c = sexp_bignum_fxadd(ctx, c, sexp_unbox_fixnum(sexp_fx_abs(b))); else c = sexp_bignum_fxsub(ctx, c, sexp_unbox_fixnum(sexp_fx_abs(b))); sexp_gc_release1(ctx); return c; }
sexp sexp_complex_exp (sexp ctx, sexp z) { double e2x = exp(sexp_to_double(sexp_complex_real(z))), y = sexp_to_double(sexp_complex_imag(z)); sexp_gc_var1(res); sexp_gc_preserve1(ctx, res); res = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO); sexp_complex_real(res) = sexp_make_flonum(ctx, e2x*cos(y)); sexp_complex_imag(res) = sexp_make_flonum(ctx, e2x*sin(y)); sexp_gc_release1(ctx); return res; }
sexp sexp_complex_log (sexp ctx, sexp z) { double x = sexp_to_double(sexp_complex_real(z)), y = sexp_to_double(sexp_complex_imag(z)); sexp_gc_var1(res); sexp_gc_preserve1(ctx, res); res = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO); sexp_complex_real(res) = sexp_make_flonum(ctx, log(sqrt(x*x + y*y))); sexp_complex_imag(res) = sexp_make_flonum(ctx, atan2(y, x)); sexp_gc_release1(ctx); return res; }
sexp sexp_complex_cos (sexp ctx, sexp z) { double x = sexp_to_double(sexp_complex_real(z)), y = sexp_to_double(sexp_complex_imag(z)); sexp_gc_var1(res); sexp_gc_preserve1(ctx, res); res = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO); sexp_complex_real(res) = sexp_make_flonum(ctx, cos(x)*cosh(y)); sexp_complex_imag(res) = sexp_make_flonum(ctx, -sin(x)*sinh(y)); sexp_gc_release1(ctx); return res; }
static sexp sexp_make_random_source (sexp ctx, sexp self, sexp_sint_t n) { sexp res; sexp_gc_var1(state); sexp_gc_preserve1(ctx, state); state = sexp_make_string(ctx, STATE_SIZE, SEXP_UNDEF); res = sexp_alloc_tagged(ctx, sexp_sizeof_random, rs_type_id); if (sexp_exceptionp(res)) return res; sexp_random_state(res) = state; sexp_random_init(res, 1); sexp_gc_release1(ctx); return res; }
sexp sexp_complex_sqrt (sexp ctx, sexp z) { double x = sexp_to_double(sexp_complex_real(z)), y = sexp_to_double(sexp_complex_imag(z)), r; sexp_gc_var1(res); sexp_gc_preserve1(ctx, res); r = sqrt(x*x + y*y); res = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO); sexp_complex_real(res) = sexp_make_flonum(ctx, sqrt((x+r)/2)); sexp_complex_imag(res) = sexp_make_flonum(ctx, (y<0?-1:1)*sqrt((-x+r)/2)); sexp_gc_release1(ctx); return res; }
static sexp sexp_make_timeval_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) { struct timeval* r; sexp_gc_var1(res); sexp_gc_preserve1(ctx, res); res = sexp_alloc_tagged(ctx, sexp_sizeof(cpointer), sexp_unbox_fixnum(sexp_opcode_return_type(self))); sexp_cpointer_value(res) = calloc(1, sizeof(struct timeval)); r = (struct timeval*) sexp_cpointer_value(res); memset(r, 0, sizeof(struct timeval)); sexp_freep(res) = 1; r->tv_sec = sexp_unshift_epoch(sexp_uint_value(arg0)); r->tv_usec = sexp_sint_value(arg1); sexp_gc_release1(ctx); return res; }
sexp sexp_thread_list (sexp ctx, sexp self, sexp_sint_t n) { sexp ls; sexp_gc_var1(res); sexp_gc_preserve1(ctx, res); res = SEXP_NULL; #if SEXP_USE_GREEN_THREADS for (ls=sexp_global(ctx, SEXP_G_THREADS_FRONT); sexp_pairp(ls); ls=sexp_cdr(ls)) sexp_push(ctx, res, sexp_car(ls)); for (ls=sexp_global(ctx, SEXP_G_THREADS_PAUSED); sexp_pairp(ls); ls=sexp_cdr(ls)) sexp_push(ctx, res, sexp_car(ls)); #endif if (sexp_not(sexp_memq(ctx, ctx, res))) sexp_push(ctx, res, ctx); sexp_gc_release1(ctx); return res; }
static sexp sexp_load_standard_params (sexp ctx, sexp e, int nonblocking) { sexp_gc_var1(res); sexp_gc_preserve1(ctx, res); sexp_load_standard_ports(ctx, e, stdin, stdout, stderr, 0); if (nonblocking) { sexp_make_unblocking(ctx, sexp_param_ref(ctx, e, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL))); sexp_make_unblocking(ctx, sexp_param_ref(ctx, e, sexp_global(ctx, SEXP_G_CUR_OUT_SYMBOL))); sexp_make_unblocking(ctx, sexp_param_ref(ctx, e, sexp_global(ctx, SEXP_G_CUR_ERR_SYMBOL))); } res = sexp_make_env(ctx); sexp_env_parent(res) = e; sexp_context_env(ctx) = res; sexp_set_parameter(ctx, sexp_meta_env(ctx), sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL), res); sexp_gc_release1(ctx); return res; }
sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) { sexp t; sexp_gc_var1(name); sexp_gc_preserve1(ctx, name); sexp_mutex_id = sexp_lookup_type(ctx, env, "mutex"); sexp_condvar_id = sexp_lookup_type(ctx, env, "condition-variable"); name = sexp_c_string(ctx, "pollfds", -1); t = sexp_register_type(ctx, name, SEXP_FALSE, SEXP_FALSE, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, sexp_make_fixnum(sexp_sizeof_pollfds), SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, (sexp_proc2)sexp_free_pollfds); if (sexp_typep(t)) sexp_pollfds_id = sexp_type_tag(t); sexp_define_type_predicate_by_tag(ctx, env, "thread?", SEXP_CONTEXT); sexp_define_foreign(ctx, env, "thread-timeout?", 0, sexp_thread_timeoutp); sexp_define_foreign(ctx, env, "current-thread", 0, sexp_current_thread); sexp_define_foreign_opt(ctx, env, "make-thread", 2, sexp_make_thread, SEXP_FALSE); sexp_define_foreign(ctx, env, "thread-start!", 1, sexp_thread_start); sexp_define_foreign(ctx, env, "%thread-terminate!", 1, sexp_thread_terminate); sexp_define_foreign(ctx, env, "%thread-join!", 2, sexp_thread_join); sexp_define_foreign(ctx, env, "%thread-sleep!", 1, sexp_thread_sleep); sexp_define_foreign(ctx, env, "thread-name", 1, sexp_thread_name); sexp_define_foreign(ctx, env, "thread-specific", 1, sexp_thread_specific); sexp_define_foreign(ctx, env, "thread-specific-set!", 2, sexp_thread_specific_set); sexp_define_foreign(ctx, env, "mutex-state", 1, sexp_mutex_state); sexp_define_foreign(ctx, env, "%mutex-lock!", 3, sexp_mutex_lock); sexp_define_foreign(ctx, env, "%mutex-unlock!", 3, sexp_mutex_unlock); sexp_define_foreign(ctx, env, "condition-variable-signal!", 1, sexp_condition_variable_signal); sexp_define_foreign(ctx, env, "condition-variable-broadcast!", 1, sexp_condition_variable_broadcast); sexp_define_foreign(ctx, env, "pop-signal!", 0, sexp_pop_signal); sexp_define_foreign(ctx, env, "get-signal-handler", 1, sexp_get_signal_handler); sexp_global(ctx, SEXP_G_THREADS_SCHEDULER) = sexp_make_foreign(ctx, "scheduler", 1, 0, (sexp_proc1)sexp_scheduler, SEXP_FALSE); sexp_global(ctx, SEXP_G_THREADS_BLOCKER) = sexp_make_foreign(ctx, "blocker", 1, 0, (sexp_proc1)sexp_blocker, SEXP_FALSE); /* remember the env to lookup the runner later */ sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = env; sexp_gc_release1(ctx); return SEXP_VOID; }
static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k, int bootp, int nonblocking) { sexp_gc_var1(e); sexp_gc_preserve1(ctx, e); e = sexp_load_standard_env(ctx, env, k); if (!sexp_exceptionp(e)) { #if SEXP_USE_MODULES if (!bootp) e = sexp_eval_string(ctx, sexp_default_environment, -1, sexp_global(ctx, SEXP_G_META_ENV)); if (!sexp_exceptionp(e)) sexp_add_import_binding(ctx, e); #endif if (!sexp_exceptionp(e)) e = sexp_load_standard_params(ctx, e, nonblocking); } sexp_gc_release1(ctx); return e; }
static sexp sexp_time_3e_string_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) { char *err; char tmp1[64]; sexp res; sexp_gc_var1(res1); 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); sexp_gc_preserve1(ctx, res1); err = asctime_r((struct tm*)sexp_cpointer_value(arg0), tmp1); if (!err) { res = SEXP_FALSE; } else { res1 = sexp_c_string(ctx, tmp1, -1); res = res1; } sexp_gc_release1(ctx); return res; }
static sexp sexp_to_complex (sexp ctx, sexp x) { #if SEXP_USE_RATIOS sexp_gc_var1(tmp); #endif if (sexp_flonump(x) || sexp_fixnump(x) || sexp_bignump(x)) { return sexp_make_complex(ctx, x, SEXP_ZERO); #if SEXP_USE_RATIOS } else if (sexp_ratiop(x)) { sexp_gc_preserve1(ctx, tmp); tmp = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO); sexp_complex_real(tmp) = sexp_make_flonum(ctx, sexp_to_double(x)); sexp_gc_release1(ctx); return tmp; #endif } else { return x; } }
sexp sexp_make_thread (sexp ctx, sexp self, sexp_sint_t n, sexp thunk, sexp name) { sexp *stack; sexp_gc_var1(res); sexp_assert_type(ctx, sexp_procedurep, SEXP_PROCEDURE, thunk); sexp_gc_preserve1(ctx, res); res = sexp_make_eval_context(ctx, SEXP_FALSE, sexp_context_env(ctx), 0, 0); sexp_context_name(res) = name; sexp_context_proc(res) = thunk; sexp_context_ip(res) = sexp_bytecode_data(sexp_procedure_code(thunk)); stack = sexp_stack_data(sexp_context_stack(res)); stack[0] = stack[1] = stack[3] = SEXP_ZERO; stack[2] = sexp_global(ctx, SEXP_G_FINAL_RESUMER); sexp_context_top(res) = 4; sexp_context_last_fp(res) = 0; sexp_context_dk(res) = sexp_list1(ctx, SEXP_FALSE); sexp_gc_release1(ctx); return res; }
sexp sexp_read_bignum (sexp ctx, sexp in, sexp_uint_t init, signed char sign, sexp_uint_t base) { int c, digit; sexp_gc_var1(res); sexp_gc_preserve1(ctx, res); res = sexp_make_bignum(ctx, SEXP_INIT_BIGNUM_SIZE); sexp_bignum_sign(res) = sign; sexp_bignum_data(res)[0] = init; for (c=sexp_read_char(ctx, in); sexp_isxdigit(c); c=sexp_read_char(ctx, in)) { digit = digit_value(c); if ((digit < 0) || (digit >= base)) break; res = sexp_bignum_fxmul(ctx, res, res, base, 0); res = sexp_bignum_fxadd(ctx, res, digit); } if (c=='.' || c=='e' || c=='E') { if (base != 10) { res = sexp_read_error(ctx, "found non-base 10 float", SEXP_NULL, in); } else { if (c!='.') sexp_push_char(ctx, c, in); /* push the e back */ res = sexp_read_float_tail(ctx, in, sexp_bignum_to_double(res), (sign==-1)); } #if SEXP_USE_RATIOS } else if (c=='/') { res = sexp_bignum_normalize(res); res = sexp_make_ratio(ctx, res, SEXP_ONE); sexp_ratio_denominator(res) = sexp_read_number(ctx, in, 10); res = sexp_ratio_normalize(ctx, res, in); #endif #if SEXP_USE_COMPLEX } else if (c=='i' || c=='i' || c=='+' || c=='-') { sexp_push_char(ctx, c, in); res = sexp_bignum_normalize(res); res = sexp_read_complex_tail(ctx, in, res); #endif } else if ((c!=EOF) && ! sexp_is_separator(c)) { res = sexp_read_error(ctx, "invalid numeric syntax", sexp_make_character(c), in); } else { sexp_push_char(ctx, c, in); } sexp_gc_release1(ctx); return sexp_bignum_normalize(res); }
static sexp sexp_make_tm_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2, sexp arg3, sexp arg4, sexp arg5, sexp arg6) { struct tm* r; sexp_gc_var1(res); sexp_gc_preserve1(ctx, res); res = sexp_alloc_tagged(ctx, sexp_sizeof(cpointer), sexp_unbox_fixnum(sexp_opcode_return_type(self))); sexp_cpointer_value(res) = calloc(1, sizeof(struct tm)); r = (struct tm*) sexp_cpointer_value(res); memset(r, 0, sizeof(struct tm)); sexp_freep(res) = 1; r->tm_sec = sexp_sint_value(arg0); r->tm_min = sexp_sint_value(arg1); r->tm_hour = sexp_sint_value(arg2); r->tm_mday = sexp_sint_value(arg3); r->tm_mon = sexp_sint_value(arg4); r->tm_year = sexp_sint_value(arg5); r->tm_isdst = sexp_sint_value(arg6); sexp_gc_release1(ctx); return res; }
static sexp sexp_stat_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) { int err; struct stat* tmp1; sexp res; sexp_gc_var1(res1); if (! sexp_stringp(arg0)) return sexp_type_exception(ctx, self, SEXP_STRING, arg0); sexp_gc_preserve1(ctx, res1); tmp1 = (struct stat*) calloc(1, 1 + sizeof(tmp1[0])); err = stat(sexp_string_data(arg0), tmp1); if (err) { res = SEXP_FALSE; } else { res1 = sexp_make_cpointer(ctx, sexp_unbox_fixnum(sexp_opcode_arg2_type(self)), tmp1, SEXP_FALSE, 1); res = res1; } sexp_gc_release1(ctx); 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; }
static sexp sexp_seconds_3e_string_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) { char *err; char tmp1[64]; time_t tmp0; sexp res; sexp_gc_var1(res1); if (! sexp_exact_integerp(arg0)) return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg0); sexp_gc_preserve1(ctx, res1); tmp0 = sexp_unshift_epoch(sexp_uint_value(arg0)); err = ctime_r(&tmp0, tmp1); if (!err) { res = SEXP_FALSE; } else { res1 = sexp_c_string(ctx, tmp1, -1); res = res1; } sexp_gc_release1(ctx); return res; }