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 _Noreturn void
json_parse_error (const json_error_t *error)
{
Lisp_Object symbol;
#if JSON_HAS_ERROR_CODE
switch (json_error_code (error))
{
case json_error_premature_end_of_input:
symbol = Qjson_end_of_file;
break;
case json_error_end_of_input_expected:
symbol = Qjson_trailing_content;
break;
default:
symbol = Qjson_parse_error;
break;
}
#else
if (json_has_suffix (error->text, "expected near end of file"))
symbol = Qjson_end_of_file;
else if (json_has_prefix (error->text, "end of file expected"))
symbol = Qjson_trailing_content;
else
symbol = Qjson_parse_error;
#endif
xsignal (symbol,
list5 (json_build_string (error->text),
json_build_string (error->source), make_natnum (error->line),
make_natnum (error->column), make_natnum (error->position)));
}
static void
module_free_global_ref (emacs_env *env, emacs_value ref)
{
/* TODO: This probably never signals. */
/* FIXME: Wait a minute. Shouldn't this function report an error if
the hash lookup fails? */
MODULE_FUNCTION_BEGIN ();
struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
Lisp_Object obj = value_to_lisp (ref);
EMACS_UINT hashcode;
ptrdiff_t i = hash_lookup (h, obj, &hashcode);
if (i >= 0)
{
Lisp_Object value = HASH_VALUE (h, i);
EMACS_INT refcount = XFASTINT (value) - 1;
if (refcount > 0)
{
value = make_natnum (refcount);
set_hash_value_slot (h, i, value);
}
else
hash_remove_from_table (h, value);
}
}
