The branch "master" has been updated in SBCL:
via 681ffac4a11a2eea8f9164f270ad108ad2ef7d0e (commit)
from 5d82f710246b2a2b03d0f7ba2645a508ffdf74c0 (commit)
- Log -----------------------------------------------------------------
commit 681ffac4a11a2eea8f9164f270ad108ad2ef7d0e
Author: Douglas Katzman <do...@go...>
Date: Sat Apr 4 22:24:34 2015 -0400
Avoid forward-reference to some simple inline functions.
- %OTHER-POINTER-WIDETAG is needed by early-extensions.lisp
- WEAK-POINTER-VALUE is needed by array.lisp
- NEQ was emitted in keyword argument checking code, and the COMMA
constructor takes keywords, but unlike SINGLETON-P which is both
defined and used in backq, it is non-obvious why NEQ was used,
so instead use /= which does the right thing.
---
build-order.lisp-expr | 9 ++++++---
src/code/kernel.lisp | 15 ---------------
src/code/target-misc.lisp | 15 +++++++++++++++
src/compiler/ir1tran-lambda.lisp | 2 +-
4 files changed, 22 insertions(+), 19 deletions(-)
diff --git a/build-order.lisp-expr b/build-order.lisp-expr
index 15c8d8d..5514e63 100644
--- a/build-order.lisp-expr
+++ b/build-order.lisp-expr
@@ -113,6 +113,10 @@
("src/compiler/generic/early-objdef")
("src/code/early-array") ; needs "early-vm" numbers
+ ;; "early-extensions" contains a call to TYPEP that is transformed into a call
+ ;; to %OTHER-POINTER-WIDETAG, which is an ordinary inline function, and not
+ ;; known to the cross-compiler until it has seen the DEFUN in 'kernel'
+ ("src/code/kernel" :not-host)
("src/code/early-extensions") ; on host for COLLECT, SYMBOLICATE, etc.
("src/code/parse-body") ; on host for PARSE-BODY
("src/code/parse-defmacro") ; on host for PARSE-DEFMACRO
@@ -183,7 +187,6 @@
;; and stuff."
;; Dunno exactly what this meant or whether it still holds. -- WHN 19990803
;; FIXME: more informative and up-to-date comment?
- ("src/code/kernel" :not-host)
("src/code/toplevel" :not-host)
("src/code/cold-error" :not-host)
;; 'info-vector' is needed at least as early as 'fdefinition' so that the
@@ -208,7 +211,8 @@
("src/code/typedefs")
("src/compiler/generic/vm-array")
- ("src/code/array" :not-host)
+ ("src/code/weak" :not-host)
+ ("src/code/array" :not-host) ; needs WEAK-POINTER-VALUE
("src/code/early-float" :not-host)
("src/code/target-sxhash" :not-host) ; needs most-fooative-foo-float constants
@@ -295,7 +299,6 @@
("src/code/sort" :not-host)
("src/code/time" :not-host)
("src/code/timer" :not-host)
- ("src/code/weak" :not-host)
("src/code/final" :not-host)
("src/code/setf-funs" :not-host)
diff --git a/src/code/kernel.lisp b/src/code/kernel.lisp
index 45fb70f..0056825 100644
--- a/src/code/kernel.lisp
+++ b/src/code/kernel.lisp
@@ -211,21 +211,6 @@
(defun code-instructions (code-obj)
(code-instructions code-obj))
-(defun code-n-unboxed-data-words (code-obj)
- ;; If the number of boxed words (from the header) is not the same as
- ;; the displacement backwards from the first simple-fun to the header,
- ;; then there are unboxed constants between the end of the boxed constants
- ;; and the first simple-fun.
- (let ((f (%code-entry-points code-obj)))
- (or (and f
- (let ((from (get-header-data code-obj))
- (to (ash (with-pinned-objects (f)
- (sap-ref-word (int-sap (get-lisp-obj-address f))
- (- sb!vm:fun-pointer-lowtag)))
- (- sb!vm:n-widetag-bits))))
- (and (< from to) (- to from))))
- 0)))
-
;;; Extract the INDEXth element from the header of CODE-OBJ. Can be
;;; set with SETF.
(defun code-header-ref (code-obj index)
diff --git a/src/code/target-misc.lisp b/src/code/target-misc.lisp
index 0773b0e..b11703f 100644
--- a/src/code/target-misc.lisp
+++ b/src/code/target-misc.lisp
@@ -173,6 +173,21 @@
(setf (random-documentation name 'function) new-value)))))
(setf (%simple-fun-doc (%fun-fun function)) new-value)))
new-value)
+
+(defun code-n-unboxed-data-words (code-obj)
+ ;; If the number of boxed words (from the header) is not the same as
+ ;; the displacement backwards from the first simple-fun to the header,
+ ;; then there are unboxed constants between the end of the boxed constants
+ ;; and the first simple-fun.
+ (let ((f (%code-entry-points code-obj)))
+ (or (and f
+ (let ((from (get-header-data code-obj))
+ (to (ash (with-pinned-objects (f)
+ (sap-ref-word (int-sap (get-lisp-obj-address f))
+ (- sb!vm:fun-pointer-lowtag)))
+ (- sb!vm:n-widetag-bits))))
+ (and (< from to) (- to from))))
+ 0)))
;;; various environment inquiries
diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index 6aca8c8..e868939 100644
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -652,7 +652,7 @@
(cond ,@(tests))))))
(unless allowp
- (body `(when (and (neq ,n-losep 0) (not ,n-allowp))
+ (body `(when (and (/= ,n-losep 0) (not ,n-allowp))
(%unknown-key-arg-error ,n-lose)))))))
(let ((ep (ir1-convert-lambda-body
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|
