common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Remove :HOST mode from SB-COLD::FEATURE-IN-LIST-P

Browse source
This commit is contained in:
Douglas Katzman 2020-07-13 10:21:02 -04:00
parent f90b4c996f
commit e77ad2a355
3 changed files with 9 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
make-host-1.lisp
View file

@ -49,8 +49,7 @@
;; that are known to build cleanly.
(sb-int:simple-style-warning
(lambda (c &aux (fc (simple-condition-format-control c)))
(when (and (feature-in-list-p '(:or :x86 :x86-64 :arm64)
:target)
(when (and (featurep '(:or :x86 :x86-64 :arm64))
in-summary
(stringp fc)
(search "undefined" fc))

9
make-host-2.lisp
View file

@ -31,9 +31,7 @@
;; Enforce absence of unexpected forward-references to warm loaded code.
;; Looking into a hidden detail of this compiler seems fair game.
(when (and sb-c::*undefined-warnings*
(feature-in-list-p
'(:or :x86 :x86-64 :arm64) ; until all the rest are clean
:target))
(featurep '(:or :x86 :x86-64 :arm64))) ; until all the rest are clean
(setf fail t)
(dolist (warning sb-c::*undefined-warnings*)
(case (sb-c::undefined-warning-kind warning)
@ -42,7 +40,7 @@
(:function (setf functions t))))))
;; Exit the compilation unit so that the summary is printed. Then complain.
;; win32 is not clean
(when (and fail (not (feature-in-list-p :win32 :target)))
(when (and fail (not (featurep :win32)))
(cerror "Proceed anyway"
"Undefined ~:[~;variables~] ~:[~;types~]~
~:[~;functions (incomplete SB-COLD::*UNDEFINED-FUN-WHITELIST*?)~]"
@ -103,8 +101,7 @@
;; As each platform's build becomes warning-free,
;; it should be added to the list here to prevent regresssions.
(when (and likely-suspicious
(feature-in-list-p '(:and (:or :x86 :x86-64) (:or :linux :darwin))
:target))
(featurep '(:and (:or :x86 :x86-64) (:or :linux :darwin))))
(warn "Expected zero inlinining failures"))))
;; After cross-compiling, show me a list of types that checkgen

16
src/cold/shebang.lisp
View file

@ -88,25 +88,19 @@
;;; We should never call this with a selector of :HOST any more,
;;; but I'm keeping it in case of emergency.
(defun feature-in-list-p (feature selector
&aux (list (ecase selector
(:host cl:*features*)
(:target sb-xc:*features*))))
(defun featurep (feature &aux (list sb-xc:*features*))
(etypecase feature
(symbol
(if (and (string= feature "SBCL") (eq selector :target))
(if (string= feature "SBCL")
(error "Testing SBCL as a target feature is obviously bogus")
(member feature list :test #'eq)))
(cons (flet ((subfeature-in-list-p (subfeature)
(feature-in-list-p subfeature selector)))
(cons (flet ((subfeature-in-list-p (subfeature) (featurep subfeature)))
(ecase (first feature)
(:or (some #'subfeature-in-list-p (rest feature)))
(:and (every #'subfeature-in-list-p (rest feature)))
(:not (destructuring-bind (subexpr) (cdr feature)
(not (subfeature-in-list-p subexpr))))
((:vop-named :vop-translates)
(when (eq selector :host)
(error "Invalid host feature test: ~S" feature))
(destructuring-bind (subexpr) (cdr feature)
(case (first feature)
(:vop-named
@ -115,7 +109,7 @@
(:vop-translates
(recording-feature-eval
feature (any-vop-translates-p subexpr)))))))))))
(compile 'feature-in-list-p)
(compile 'featurep)
(defun read-targ-feature-expr (stream sub-character infix-parameter)
(when infix-parameter
@ -123,7 +117,7 @@
(if (char= (if (let* ((*package* (find-package "KEYWORD"))
(*read-suppress* nil)
(feature (read stream t nil t)))
(feature-in-list-p feature :target))
(featurep feature))
#\+ #\-)
sub-character)
(read stream t nil t)