From 645ddb6058f211b5174caa9f68bd5fadbbb08df6 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Sat, 11 Jul 2015 22:07:42 -0400 Subject: [PATCH] Make explicit escape syntax for host feature in #!+ #!- syntax. And eliminate a few warnings re. TYPECASE clauses dispatching on NIL. --- src/cold/shebang.lisp | 17 ++++++++++++----- src/compiler/x86-64/vm.lisp | 18 ++++++------------ 2 files changed, 18 insertions(+), 17 deletions(-) diff --git a/src/cold/shebang.lisp b/src/cold/shebang.lisp index da6f33174..e23de1171 100644 --- a/src/cold/shebang.lisp +++ b/src/cold/shebang.lisp @@ -26,6 +26,10 @@ (labels ((sane-expr-p (x) (typecase x (symbol (and (string/= x "SB-XC") (string/= x "SB-XC-HOST"))) + ;; This allows you to write #!+(host-feature sbcl) + ;; to muffle conditions, bypassing the "probable XC bug" check. + ;; Using the escape hatch is assumed never to be a mistake. + ((cons (eql :host-feature)) t) (cons (every #'sane-expr-p (cdr x)))))) (unless (sane-expr-p feature) (error "Target feature expression ~S looks screwy" feature))) @@ -36,11 +40,14 @@ (ecase (first feature) (:or (some #'subfeature-in-list-p (rest feature))) (:and (every #'subfeature-in-list-p (rest feature))) - (:not (let ((rest (cdr feature))) - (if (or (null (car rest)) (cdr rest)) - (error "wrong number of terms in compound feature ~S" - feature) - (not (subfeature-in-list-p (second feature))))))))))) + ((:host-feature :not) + (destructuring-bind (subexpr) (cdr feature) + (cond ((eq (first feature) :host-feature) + ;; (:HOST-FEATURE :sym) looks in *FEATURES* for :SYM + (check-type subexpr symbol) + (member subexpr *features* :test #'eq)) + (t + (not (subfeature-in-list-p subexpr))))))))))) (compile 'feature-in-list-p) (defun shebang-reader (stream sub-character infix-parameter) diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp index f62010b00..d9b273979 100644 --- a/src/compiler/x86-64/vm.lisp +++ b/src/compiler/x86-64/vm.lisp @@ -490,18 +490,12 @@ (if (eql value #c(0d0 0d0)) 'fp-complex-double-zero 'fp-complex-double-immediate))) - #!+sb-simd-pack - (#+sb-xc-host nil - #-sb-xc-host (simd-pack double-float) - (sc-number-or-lose 'double-sse-immediate)) - #!+sb-simd-pack - (#+sb-xc-host nil - #-sb-xc-host (simd-pack single-float) - (sc-number-or-lose 'single-sse-immediate)) - #!+sb-simd-pack - (#+sb-xc-host nil - #-sb-xc-host simd-pack - (sc-number-or-lose 'int-sse-immediate)))) + #!+(and sb-simd-pack (not (host-feature sb-xc-host))) + ((simd-pack double-float) (sc-number-or-lose 'double-sse-immediate)) + #!+(and sb-simd-pack (not (host-feature sb-xc-host))) + ((simd-pack single-float) (sc-number-or-lose 'single-sse-immediate)) + #!+(and sb-simd-pack (not (host-feature sb-xc-host))) + (simd-pack (sc-number-or-lose 'int-sse-immediate)))) (defun boxed-immediate-sc-p (sc) (eql sc (sc-number-or-lose 'immediate))) -- 2.11.4.GIT