Subject: Re: bug#36487: Evaluations do not complete since commit c30d117822a8ca26cd8c06c0a3974955bef68eac

From: Ludovic Courtès <[email-masked]>
Date: Wed, 03 Jul 2019 19:01:06 +0200

Ludovic Courtès <[email-masked]> skribis:

> #104 0x00007fc5247f3a92 in scm_hash_fn_ref () from /gnu/store/r658y3cgpnf99nxjxqgjiaizx20ac4k0-guile-2.2.4/lib/libguile-2.2.so.1
> #105 0x00007fc524859715 in vm_regular_engine () from /gnu/store/r658y3cgpnf99nxjxqgjiaizx20ac4k0-guile-2.2.4/lib/libguile-2.2.so.1
> #106 0x00007fc52485cd6a in scm_call_n () from /gnu/store/r658y3cgpnf99nxjxqgjiaizx20ac4k0-guile-2.2.4/lib/libguile-2.2.so.1
> #107 0x00007fc5247e0da7 in scm_primitive_eval () from /gnu/store/r658y3cgpnf99nxjxqgjiaizx20ac4k0-guile-2.2.4/lib/libguile-2.2.so.1
>
>
> and with debugging symbols:
>
> #3  0x00007fc5247ddc23 in scm_equal_p (x=x@entry="/gnu/store/djh3drjx3hnxlx1bsdnixdm3xjbg5v2c-guile-bootstrap-2.0/bin/guile", 
>     y=y@entry="/gnu/store/djh3drjx3hnxlx1bsdnixdm3xjbg5v2c-guile-bootstrap-2.0/bin/guile") at eq.c:290
> #4  0x00007fc52484891b in scm_i_struct_equalp (s1="#<struct <derivation>>" = {...}, s2="#<struct <derivation>>" = {...}) at struct.c:693
> #5  0x00007fc52484891b in scm_i_struct_equalp (s1="#<struct <derivation-input>>" = {...}, s2="#<struct <derivation-input>>" = {...}) at struct.c:693
> #6  0x00007fc5247ddc82 in scm_equal_p (
>
> So this process is busy comparing deep structures, probably as a
> consequence of 5cf4b26d52bcea382d98fb4becce89be9ee37b55.

With some debugging, I found that the pathological behavior comes from
the memoization hash table of ‘derivation->bytevector’, specifically
after ‘invalidate-derivation-caches!’ has been called.

Namely, after ‘invalidate-derivation-caches!’ has been called, that hash
table has 24K buckets, including 72 buckets of size 6 or more.  One
bucket has 18 entries, which are all alike:

  #<derivation #f => /gnu/store/…-module-import-compiled 94283c0>

The ‘equal?’ calls come from those buckets, and each of them involves
traversing the whole <derivation> tree.

I’m looking for a workaround.

Ludo’.

PS: Below is some debugging code.

(use-modules (system foreign)
             (ice-9 match))

;;       typedef struct {
;;    0    scm_t_weak_entry **buckets;   /* the data */
;;    8    scm_i_pthread_mutex_t lock;   /* the lock */
;;   48    scm_t_weak_table_kind kind;   /* what kind of table it is */
;;   56    unsigned long n_buckets;    	/* total number of buckets. */
;;   64    unsigned long n_items;	/* number of items in table */
;;   72    unsigned long lower;		/* when to shrink */
;;   80    unsigned long upper;		/* when to grow */
;;   88    int size_index;		/* index into hashtable_size */
;;   92    int min_size_index;		/* minimum size_index */
;;   96    GC_word last_gc_no;
;;       } scm_t_weak_table;

(define (weak-table-data table)
  "Return an alist describing TABLE."
  (unless (or (weak-key-hash-table? table)
              (weak-value-hash-table? table))
    (error "wrong type argument" table))

  (let* ((address (object-address table))
         (ptr     (dereference-pointer
                   (make-pointer (+ address 8)))))
    (match (parse-c-struct (make-pointer (+ (pointer-address ptr) 48))
                           (list int
                                 unsigned-long unsigned-long
                                 unsigned-long unsigned-long
                                 int
                                 int
                                 unsigned-long))
      ((kind buckets items lower upper size-index min-size-index last-gc-no)
       `((kind . ,kind) (items . ,items) (buckets . ,buckets)
         (lower . ,lower) (upper . ,upper)
         (size-index . ,size-index) (min-size-index . ,min-size-index)
         (last-gc-no . ,last-gc-no))))))

;; typedef struct scm_t_hashtable {
;;   unsigned long n_items;	/* number of items in table */
;;   unsigned long lower;		/* when to shrink */
;;   unsigned long upper;		/* when to grow */
;;   int size_index;		/* index into hashtable_size */
;;   int min_size_index;		/* minimum size_index */
;;   scm_t_hash_fn hash_fn;  /* for rehashing after a GC. */
;; } scm_t_hashtable;

(define (hash-table-data table)
  (unless (hash-table? table)
    (error "wrong type argument" table))

  (let* ((address (object-address table))
         (ptr     (dereference-pointer
                   (make-pointer (+ address (* 2 (sizeof '*)))))))
    (match (parse-c-struct ptr
                           (list unsigned-long
                                 unsigned-long unsigned-long
                                 int
                                 int))
      ((items lower upper size-index min-size-index)
       `((items . ,items)
         (lower . ,lower) (upper . ,upper)
         (size-index . ,size-index) (min-size-index . ,min-size-index))))))

(define (hash-table-buckets table)
  (unless (hash-table? table)
    (error "wrong type argument" table))

  (let* ((address (object-address table))
         (ptr     (dereference-pointer
                   (make-pointer (+ address (* 1 (sizeof '*)))))))
    (pointer->scm ptr)))

(define (hash-table-bucket-sizes table)
  (let ((buckets (hash-table-buckets table)))
    (let loop ((index 0)
               (result '()))
      (if (< index (vector-length buckets))
          (loop (+ 1 index)
                (cons (length (vector-ref buckets index))
                      result))
          (reverse result)))))