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));
}
