(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)))))