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);
  CHECK_STRING (lisp_str);

  Lisp_Object lisp_str_utf8 = ENCODE_UTF_8 (lisp_str);
  ptrdiff_t raw_size = SBYTES (lisp_str_utf8);
  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;
      xsignal0 (Qargs_out_of_range);
    }

  *length = required_buf_size;
  memcpy (buffer, SDATA (lisp_str_utf8), raw_size + 1);

  return true;
}
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_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;
  if (nargs == PTRDIFF_MAX)
    xsignal0 (Qoverflow_error);
  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;
}
Beispiel #5
0
static _Noreturn void
json_out_of_memory (void)
{
  xsignal0 (Qjson_out_of_memory);
}