1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-16 18:50:23 +02:00

fix up some assumptions that cmethods were lists

* libguile/eval.i.c (type_dispatch, apply_vm_cmethod)
  (apply_memoized_cmethod): Tweak the nastiness a bit more so as to deal
  with the '(no-method) empty entries. I would like to stop the search if
  the cdr isn't a pair, but currently with the inlined memoized bits, the
  cdr is a pair. The fix would be to make the memoizer return a procedure
  and not the already-inlined bits -- slightly slower but the vm will be
  faster anyway.

* libguile/objects.c (scm_mcache_lookup_cmethod): Same fixes here.

* oop/goops/dispatch.scm (cache-hashval, cache-try-hash!): Allow non-list
  cmethod tails.
This commit is contained in:
Andy Wingo 2008-10-30 15:50:48 +01:00
parent 5487977b1b
commit 05b37c17ff
3 changed files with 27 additions and 19 deletions

View file

@ -176,7 +176,8 @@
(let ((hashset-index (+ hashset-index hashset)))
(do ((sum 0)
(classes entry (cdr classes)))
((not (struct? (car classes))) sum)
((not (and (pair? classes) (struct? (car classes))))
sum)
(set! sum (+ sum (struct-ref (car classes) hashset-index))))))
;;; FIXME: the throw probably is expensive, given that this function
@ -191,7 +192,8 @@
((null? ls) max-misses)
(do ((i (logand mask (cache-hashval hashset (car ls)))
(logand mask (+ i 1))))
((not (struct? (car (vector-ref cache i))))
((and (pair? (vector-ref cache i))
(eq? (car (vector-ref cache i)) 'no-method))
(vector-set! cache i (car ls)))
(set! misses (+ 1 misses))
(if (>= misses min-misses)