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 (refcount > MOST_POSITIVE_FIXNUM)
{
module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
return module_nil;
}
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);
}
/* Like for `signal', DATA must be a list. */
static void
module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data)
{
check_main_thread ();
if (module_non_local_exit_check (env) == emacs_funcall_exit_return)
module_non_local_exit_signal_1 (env, value_to_lisp (sym),
value_to_lisp (data));
}
static bool
module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer,
ptrdiff_t *length)
{
MODULE_FUNCTION_BEGIN (false);
Lisp_Object lisp_str = value_to_lisp (value);
if (! STRINGP (lisp_str))
{
module_wrong_type (env, Qstringp, lisp_str);
return false;
}
Lisp_Object lisp_str_utf8 = ENCODE_UTF_8 (lisp_str);
ptrdiff_t raw_size = SBYTES (lisp_str_utf8);
if (raw_size == PTRDIFF_MAX)
{
module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
return false;
}
ptrdiff_t required_buf_size = raw_size + 1;
eassert (length != NULL);
if (buffer == NULL)
{
*length = required_buf_size;
return true;
}
eassert (*length >= 0);
if (*length < required_buf_size)
{
*length = required_buf_size;
module_non_local_exit_signal_1 (env, Qargs_out_of_range, Qnil);
return false;
}
*length = required_buf_size;
memcpy (buffer, SDATA (lisp_str_utf8), raw_size + 1);
return true;
}
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_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 void
module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val)
{
/* FIXME: This function should return bool because it can fail. */
MODULE_FUNCTION_BEGIN ();
Lisp_Object lvec = value_to_lisp (vec);
if (! VECTORP (lvec))
{
module_wrong_type (env, Qvectorp, lvec);
return;
}
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;
}
ASET (lvec, i, value_to_lisp (val));
}
