static enum emacs_funcall_exit module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data) { check_main_thread (); struct emacs_env_private *p = env->private_members; if (p->pending_non_local_exit != emacs_funcall_exit_return) { /* FIXME: lisp_to_value can exit non-locally. */ *sym = lisp_to_value (p->non_local_exit_symbol); *data = lisp_to_value (p->non_local_exit_data); } return p->pending_non_local_exit; }
static emacs_value module_make_string (emacs_env *env, const char *str, ptrdiff_t length) { MODULE_FUNCTION_BEGIN (module_nil); Lisp_Object lstr = make_unibyte_string (str, length); return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false)); }
static emacs_value module_make_global_ref (emacs_env *env, emacs_value ref) { MODULE_FUNCTION_BEGIN (module_nil); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); Lisp_Object new_obj = value_to_lisp (ref); EMACS_UINT hashcode; ptrdiff_t i = hash_lookup (h, new_obj, &hashcode); if (i >= 0) { Lisp_Object value = HASH_VALUE (h, i); EMACS_INT refcount = XFASTINT (value) + 1; if (MOST_POSITIVE_FIXNUM < refcount) xsignal0 (Qoverflow_error); value = make_natnum (refcount); set_hash_value_slot (h, i, value); } else { hash_put (h, new_obj, make_natnum (1), hashcode); } return lisp_to_value (new_obj); }
static emacs_value module_make_integer (emacs_env *env, intmax_t n) { MODULE_FUNCTION_BEGIN (module_nil); if (FIXNUM_OVERFLOW_P (n)) xsignal0 (Qoverflow_error); return lisp_to_value (make_number (n)); }
static emacs_value module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) { MODULE_FUNCTION_BEGIN (module_nil); Lisp_Object lvec = value_to_lisp (vec); CHECK_VECTOR (lvec); CHECK_RANGED_INTEGER (make_number (i), 0, ASIZE (lvec) - 1); return lisp_to_value (AREF (lvec, i)); }
static emacs_value module_make_integer (emacs_env *env, intmax_t n) { MODULE_FUNCTION_BEGIN (module_nil); if (! (MOST_NEGATIVE_FIXNUM <= n && n <= MOST_POSITIVE_FIXNUM)) { module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); return module_nil; } return lisp_to_value (make_number (n)); }
static emacs_value module_make_string (emacs_env *env, const char *str, ptrdiff_t length) { MODULE_FUNCTION_BEGIN (module_nil); if (length > STRING_BYTES_BOUND) { module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); return module_nil; } Lisp_Object lstr = make_unibyte_string (str, length); return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false)); }
static emacs_value module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, emacs_value args[]) { MODULE_FUNCTION_BEGIN (module_nil); /* Make a new Lisp_Object array starting with the function as the first arg, because that's what Ffuncall takes. */ Lisp_Object *newargs; USE_SAFE_ALLOCA; SAFE_ALLOCA_LISP (newargs, nargs + 1); newargs[0] = value_to_lisp (fun); for (ptrdiff_t i = 0; i < nargs; i++) newargs[1 + i] = value_to_lisp (args[i]); emacs_value result = lisp_to_value (Ffuncall (nargs + 1, newargs)); SAFE_FREE (); return result; }
static emacs_value module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) { MODULE_FUNCTION_BEGIN (module_nil); Lisp_Object lvec = value_to_lisp (vec); if (! VECTORP (lvec)) { module_wrong_type (env, Qvectorp, lvec); return module_nil; } if (! (0 <= i && i < ASIZE (lvec))) { if (MOST_NEGATIVE_FIXNUM <= i && i <= MOST_POSITIVE_FIXNUM) module_args_out_of_range (env, lvec, make_number (i)); else module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil); return module_nil; } return lisp_to_value (AREF (lvec, i)); }
static emacs_value module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, emacs_subr subr, const char *documentation, void *data) { MODULE_FUNCTION_BEGIN (module_nil); if (! (0 <= min_arity && (max_arity < 0 ? max_arity == emacs_variadic_function : min_arity <= max_arity))) xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity)); /* FIXME: This should be freed when envobj is GC'd. */ struct module_fun_env *envptr = xmalloc (sizeof *envptr); envptr->min_arity = min_arity; envptr->max_arity = max_arity; envptr->subr = subr; envptr->data = data; Lisp_Object envobj = make_save_ptr (envptr); Lisp_Object doc = (documentation ? code_convert_string_norecord (build_unibyte_string (documentation), Qutf_8, false) : Qnil); /* FIXME: Use a bytecompiled object, or even better a subr. */ Lisp_Object ret = list4 (Qlambda, list2 (Qand_rest, Qargs), doc, list4 (Qapply, list2 (Qfunction, Qinternal__module_call), envobj, Qargs)); return lisp_to_value (ret); }
static emacs_value module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) { MODULE_FUNCTION_BEGIN (module_nil); return lisp_to_value (make_user_ptr (fin, ptr)); }
static emacs_value module_make_float (emacs_env *env, double d) { MODULE_FUNCTION_BEGIN (module_nil); return lisp_to_value (make_float (d)); }
static emacs_value module_type_of (emacs_env *env, emacs_value value) { MODULE_FUNCTION_BEGIN (module_nil); return lisp_to_value (Ftype_of (value_to_lisp (value))); }
static emacs_value module_intern (emacs_env *env, const char *name) { MODULE_FUNCTION_BEGIN (module_nil); return lisp_to_value (intern (name)); }