(:export #:assert-consing
#:assert-no-consing
#:compiler-derived-type
+ #:count-full-calls
#:find-value-cell-values
#:find-code-constants
#:find-named-callees
(cl:in-package :ctu)
(unless (fboundp 'compiler-derived-type)
- (defknown compiler-derived-type (t) (values t t) (movable flushable unsafe))
+ (defknown compiler-derived-type (t) (values t t) (flushable))
(deftransform compiler-derived-type ((x) * * :node node)
(sb-c::delay-ir1-transform node :optimize)
`(values ',(type-specifier (sb-c::lvar-type x)) t))
(unwind-protect
(progn
(with-open-file (f lisp :direction :output)
- (dolist (form toplevel-forms)
- (prin1 form f)))
+ (if (stringp toplevel-forms)
+ (write-line toplevel-forms f)
+ (dolist (form toplevel-forms)
+ (prin1 form f))))
(multiple-value-bind (fasl warn fail) (compile-file lisp)
(when load
(load fasl))
(values warn fail)))
(ignore-errors (delete-file lisp))
(ignore-errors (delete-file fasl)))))
+
+;; Pretty horrible, but does the job
+(defun count-full-calls (name function)
+ (let ((code (with-output-to-string (s)
+ (disassemble function :stream s)))
+ (n 0))
+ (with-input-from-string (s code)
+ (loop for line = (read-line s nil nil)
+ while line
+ when (and (search name line)
+ (search "#<FDEFINITION" line))
+ do (incf n)))
+ n))