Commit c0aa4728 authored by ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f's avatar ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files

3 changes:

 - Improve speed of "multi-homed symbol" removal
 - Generate autoloader EXPORT commands based on
    EXPORTed symbols in the compiled files, instead of
    on the symbols currently exported (this one fixes the SLIME
      MAKE-THREAD-LOCK issue)
 - Reverse the "multi-homed filtering" and the "autoloads file exclusion"
     in order to stop considering symbols overridden by extensible
     sequences (e.g. COUNT-IF, REMOVE, etc) as being multi-homed:
     we want to autoload the non-extensible versions by default.
parent f3286619
...@@ -90,10 +90,18 @@ ...@@ -90,10 +90,18 @@
(mapcar #'second combos))))) (mapcar #'second combos)))))
(defun remove-multi-combo-symbols (combos) (defun remove-multi-combo-symbols (combos)
(remove-if (lambda (x) (princ "; Removing multi-homed symbols")
(< 1 (count x combos :key #'second))) (let ((sym-hash (make-hash-table :size (* 2 (length combos)))))
combos (dolist (combo combos)
:key #'second)) (incf (gethash (second combo) sym-hash 0)))
(print (remove-if-not (lambda (x)
(< 1 (gethash x sym-hash)))
combos
:key #'second))
(remove-if (lambda (x)
(< 1 (gethash x sym-hash)))
combos
:key #'second)))
(defun set-equal (set1 set2 &key test) (defun set-equal (set1 set2 &key test)
(or (eq set1 set2) (or (eq set1 set2)
...@@ -118,7 +126,8 @@ ...@@ -118,7 +126,8 @@
:key #'first) :key #'first)
(pushnew (first symbol-fileset) (pushnew (first symbol-fileset)
(cdr (assoc (cdr symbol-fileset) fileset-symbols (cdr (assoc (cdr symbol-fileset) fileset-symbols
:test (lambda (x y) (set-equal x y :test #'string=)))))) :test (lambda (x y)
(set-equal x y :test #'string=))))))
fileset-symbols)) fileset-symbols))
(defun write-autoloader (stream package type fileset-symbols) (defun write-autoloader (stream package type fileset-symbols)
...@@ -163,25 +172,34 @@ ...@@ -163,25 +172,34 @@
(defun generate-autoloads (symbol-files-pathspec) (defun generate-autoloads (symbol-files-pathspec)
(flet ((filter-combos (combos) (flet ((filter-combos (combos)
(remove-if (lambda (x) (remove-multi-combo-symbols
;; exclude the symbols from the files (remove-if (lambda (x)
;; below: putting autoloaders on some of ;; exclude the symbols from the files
;; the symbols conflicts with the bootstrapping ;; below: putting autoloaders on some of
;; Primitives which have been defined Java-side ;; the symbols conflicts with the bootstrapping
(member x '( ;; function definitions to be excluded ;; Primitives which have been defined Java-side
"fdefinition" "early-defuns" (member x '( ;; function definitions to be excluded
"require" "signal" "fdefinition" "early-defuns"
"extensible-sequences-base" "restart" "require" "signal" "restart"
"extensible-sequences"
;; macro definitions to be excluded ;; extensible sequences override
"macros" "backquote" "precompiler") ;; lots of default functions;
:test #'string=)) ;; java-collections implements
(remove-multi-combo-symbols combos) ;; extensible sequences
:key #'first)) "extensible-sequences-base"
"extensible-sequences" "java-collections"
;; macro definitions to be excluded
"macros" ;; "backquote"
"precompiler")
:test #'string=))
combos
:key #'first)))
(symbols-pathspec (filespec) (symbols-pathspec (filespec)
(merge-pathnames filespec symbol-files-pathspec))) (merge-pathnames filespec symbol-files-pathspec)))
(let ((funcs (filter-combos (load-combos (symbols-pathspec "*.funcs")))) (let ((funcs (filter-combos (load-combos (symbols-pathspec "*.funcs"))))
(macs (filter-combos (load-combos (symbols-pathspec "*.macs"))))) (macs (filter-combos (load-combos (symbols-pathspec "*.macs"))))
(exps (filter-combos (load-combos (symbols-pathspec "*.exps")))))
(with-open-file (f (symbols-pathspec "autoloads-gen.lisp") (with-open-file (f (symbols-pathspec "autoloads-gen.lisp")
:direction :output :if-does-not-exist :create :direction :output :if-does-not-exist :create
:if-exists :supersede) :if-exists :supersede)
...@@ -198,13 +216,13 @@ ...@@ -198,13 +216,13 @@
;; and ASDF are not being created. Nor are these packages ;; and ASDF are not being created. Nor are these packages
;; vital to the correct operation of the base system. ;; vital to the correct operation of the base system.
(let ((*package* (find-package package)) (let* ((*package* (find-package package))
externals) (all-exported-symbols
(do-external-symbols (sym package (remove-duplicates (mapcar #'second exps)))
externals) (externals (remove-if-not (lambda (sym)
(when (eq (symbol-package sym) (eq (symbol-package sym)
*package*) *package*))
(push sym externals))) all-exported-symbols)))
(when externals (when externals
(write-line ";; EXPORTS" f) (write-line ";; EXPORTS" f)
(write `(cl:in-package ,package) :stream f) (write `(cl:in-package ,package) :stream f)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment