Example #1
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);
    }
}
Example #2
0
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