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 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);
    }
}
示例#3
0
static void
handle_profiler_signal (int signal)
{
  if (EQ (backtrace_top_function (), Qautomatic_gc))
    /* Special case the time-count inside GC because the hash-table
       code is not prepared to be used while the GC is running.
       More specifically it uses ASIZE at many places where it does
       not expect the ARRAY_MARK_FLAG to be set.  We could try and
       harden the hash-table code, but it doesn't seem worth the
       effort.  */
    cpu_gc_count = saturated_add (cpu_gc_count, 1);
  else
    {
      EMACS_INT count = 1;
#ifdef HAVE_ITIMERSPEC
      if (profiler_timer_ok)
	{
	  int overruns = timer_getoverrun (profiler_timer);
	  eassert (overruns >= 0);
	  count += overruns;
	}
#endif
      eassert (HASH_TABLE_P (cpu_log));
      record_backtrace (XHASH_TABLE (cpu_log), count);
    }
}
示例#4
0
static Lisp_Object
hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
{
  struct Lisp_Hash_Table *h;
  ptrdiff_t i;
  EMACS_UINT hash;

  if (NILP (XCHAR_TABLE (table)->extras[1]))
    set_char_table_extras
      (table, 1,
       make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
			make_float (DEFAULT_REHASH_SIZE),
			make_float (DEFAULT_REHASH_THRESHOLD),
			Qnil));
  h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
  i = hash_lookup (h, category_set, &hash);
  if (i >= 0)
    return HASH_KEY (h, i);
  hash_put (h, category_set, Qnil, hash);
  return category_set;
}
示例#5
0
文件: category.c 项目: oscarfv/emacs
static Lisp_Object
hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
{
  Lisp_Object val;
  struct Lisp_Hash_Table *h;
  int i;
  unsigned hash;

  if (NILP (XCHAR_TABLE (table)->extras[1]))
    XCHAR_TABLE (table)->extras[1]
      = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
			 make_float (DEFAULT_REHASH_SIZE),
			 make_float (DEFAULT_REHASH_THRESHOLD),
			 Qnil, Qnil, Qnil);
  h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
  i = hash_lookup (h, category_set, &hash);
  if (i >= 0)
    return HASH_KEY (h, i);
  hash_put (h, category_set, Qnil, hash);
  return category_set;
}
示例#6
0
static Lisp_Object
make_log (int heap_size, int max_stack_depth)
{
  /* We use a standard Elisp hash-table object, but we use it in
     a special way.  This is OK as long as the object is not exposed
     to Elisp, i.e. until it is returned by *-profiler-log, after which
     it can't be used any more.  */
  Lisp_Object log = make_hash_table (hashtest_profiler,
				     make_number (heap_size),
				     make_float (DEFAULT_REHASH_SIZE),
				     make_float (DEFAULT_REHASH_THRESHOLD),
				     Qnil);
  struct Lisp_Hash_Table *h = XHASH_TABLE (log);

  /* What is special about our hash-tables is that the keys are pre-filled
     with the vectors we'll put in them.  */
  int i = ASIZE (h->key_and_value) / 2;
  while (i > 0)
    set_hash_key_slot (h, --i,
		       Fmake_vector (make_number (max_stack_depth), Qnil));
  return log;
}
示例#7
0
文件: json.c 项目: yuanfeng0905/emacs
static json_t *
lisp_to_json_toplevel_1 (Lisp_Object lisp)
{
  json_t *json;
  ptrdiff_t count;

  if (VECTORP (lisp))
    {
      ptrdiff_t size = ASIZE (lisp);
      json = json_check (json_array ());
      count = SPECPDL_INDEX ();
      record_unwind_protect_ptr (json_release_object, json);
      for (ptrdiff_t i = 0; i < size; ++i)
        {
          int status
            = json_array_append_new (json, lisp_to_json (AREF (lisp, i)));
          if (status == -1)
            json_out_of_memory ();
        }
      eassert (json_array_size (json) == size);
    }
  else if (HASH_TABLE_P (lisp))
    {
      struct Lisp_Hash_Table *h = XHASH_TABLE (lisp);
      json = json_check (json_object ());
      count = SPECPDL_INDEX ();
      record_unwind_protect_ptr (json_release_object, json);
      for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
        if (!NILP (HASH_HASH (h, i)))
          {
            Lisp_Object key = json_encode (HASH_KEY (h, i));
            /* We can't specify the length, so the string must be
               null-terminated.  */
            check_string_without_embedded_nulls (key);
            const char *key_str = SSDATA (key);
            /* Reject duplicate keys.  These are possible if the hash
               table test is not `equal'.  */
            if (json_object_get (json, key_str) != NULL)
              wrong_type_argument (Qjson_value_p, lisp);
            int status = json_object_set_new (json, key_str,
                                              lisp_to_json (HASH_VALUE (h, i)));
            if (status == -1)
              {
                /* A failure can be caused either by an invalid key or
                   by low memory.  */
                json_check_utf8 (key);
                json_out_of_memory ();
              }
          }
    }
  else if (NILP (lisp))
    return json_check (json_object ());
  else if (CONSP (lisp))
    {
      Lisp_Object tail = lisp;
      json = json_check (json_object ());
      count = SPECPDL_INDEX ();
      record_unwind_protect_ptr (json_release_object, json);
      bool is_plist = !CONSP (XCAR (tail));
      FOR_EACH_TAIL (tail)
        {
          const char *key_str;
          Lisp_Object value;
          Lisp_Object key_symbol;
          if (is_plist)
            {
              key_symbol = XCAR (tail);
              tail = XCDR (tail);
              CHECK_CONS (tail);
              value = XCAR (tail);
              if (EQ (tail, li.tortoise)) circular_list (lisp);
            }
          else
            {
              Lisp_Object pair = XCAR (tail);
              CHECK_CONS (pair);
              key_symbol = XCAR (pair);
              value = XCDR (pair);
            }
          CHECK_SYMBOL (key_symbol);
          Lisp_Object key = SYMBOL_NAME (key_symbol);
          /* We can't specify the length, so the string must be
             null-terminated.  */
          check_string_without_embedded_nulls (key);
          key_str = SSDATA (key);
          /* In plists, ensure leading ":" in keys is stripped.  It
             will be reconstructed later in `json_to_lisp'.*/
          if (is_plist && ':' == key_str[0] && key_str[1])
            {
              key_str = &key_str[1];
            }
          /* Only add element if key is not already present.  */
          if (json_object_get (json, key_str) == NULL)
            {
              int status
                = json_object_set_new (json, key_str, lisp_to_json (value));
              if (status == -1)
                json_out_of_memory ();
            }
        }
      CHECK_LIST_END (tail, lisp);
    }
  else