Changeset 14056 for branches/qres/ccl


Ignore:
Timestamp:
Jul 27, 2010, 1:40:45 AM (9 years ago)
Author:
gz
Message:

r13980 from trunk (defmethod memory leak)

Location:
branches/qres/ccl
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/qres/ccl

  • branches/qres/ccl/level-1/l1-clos-boot.lisp

    r14049 r14056  
    745745        (when (and doc-p *save-doc-strings*)
    746746          (set-documentation method t documentation))
    747         (record-source-file method 'method)
    748747        (when old-method (%move-method-encapsulations-maybe old-method method))
    749748        method))))
    750        
     749
    751750
    752751(defun %anonymous-method (function specializers qualifiers  lambda-list &optional documentation
  • branches/qres/ccl/level-1/l1-dcode.lisp

    r13070 r14056  
    711711
    712712(let* ((eql-specializers-lock (make-lock))
    713        (eql-specializers-hash (make-hash-table :test #'eql)))
     713       (eql-specializers-hash (make-hash-table :test #'eql  :weak :value)))
    714714  (defun intern-eql-specializer (object)
    715715    (with-lock-grabbed (eql-specializers-lock)
  • branches/qres/ccl/lib/macros.lisp

    r13565 r14056  
    18301830
    18311831(defmacro defmethod (name &rest args &environment env)
    1832   (multiple-value-bind (function-form specializers-form qualifiers lambda-list documentation specializers)
    1833       (parse-defmethod name args env)
    1834     `(progn
    1835        (eval-when (:compile-toplevel)
    1836          (record-function-info ',(maybe-setf-function-name name)
    1837                                ',(multiple-value-bind (bits keyvect) (encode-lambda-list lambda-list t)
    1838                                    (unless bits ;; verify failed
    1839                                      (signal-program-error "Invalid lambda list ~s"
    1840                                                            (find-if #'listp args)))
    1841                                    (%cons-def-info 'defmethod bits keyvect nil specializers qualifiers))
    1842                                ,env))
    1843        (compiler-let ((*nx-method-warning-name* '(,name ,@qualifiers ,specializers)))
    1844          (ensure-method ',name ,specializers-form
    1845                         :function ,function-form
    1846                         :qualifiers ',qualifiers
    1847                         :lambda-list ',lambda-list
    1848                         ,@(if documentation `(:documentation ,documentation)))))))
     1832  (let* ((method (gensym)))
     1833    (multiple-value-bind (function-form specializers-form qualifiers lambda-list documentation specializers)
     1834        (parse-defmethod name args env)
     1835      `(progn
     1836        (eval-when (:compile-toplevel)
     1837          (record-function-info ',(maybe-setf-function-name name)
     1838                                ',(multiple-value-bind (bits keyvect) (encode-lambda-list lambda-list t)
     1839                                                       (unless bits;; verify failed
     1840                                                         (signal-program-error "Invalid lambda list ~s"
     1841                                                                               (find-if #'listp args)))
     1842                                                       (%cons-def-info 'defmethod bits keyvect nil specializers qualifiers))
     1843                                ,env))
     1844        (compiler-let ((*nx-method-warning-name* '(,name ,@qualifiers ,specializers)))
     1845          (let* ((,method (ensure-method ',name ,specializers-form
     1846                                         :function ,function-form
     1847                                         :qualifiers ',qualifiers
     1848                                         :lambda-list ',lambda-list
     1849                                         ,@(if documentation `(:documentation ,documentation)))))
     1850            (record-source-file ,method 'method)
     1851            ,method))))))
    18491852
    18501853
Note: See TracChangeset for help on using the changeset viewer.