Changeset 9413


Ignore:
Timestamp:
May 9, 2008, 9:07:42 AM (11 years ago)
Author:
gb
Message:

Port rme's SBIT improvements from trunk to this branch.

Introduce *X862-FULL-SAFETY*, set it when processing encoded declaration
info. (The idea is to make the backend aware of when (optimize (safety 3))
is in effect and to avoid unsafe behavior in the backend when it is.)
Needs work to be useful, but probably the right idea.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711-perf/ccl/compiler/X86/x862.lisp

    r9165 r9413  
    5656          (*x862-reckless* *x862-reckless*)
    5757          (*x862-open-code-inline* *x862-open-code-inline*)
    58           (*x862-trust-declarations* *x862-trust-declarations*))
     58          (*x862-trust-declarations* *x862-trust-declarations*)
     59          (*x862-full-safety* *x862-full-safety*))
    5960     (x862-decls ,declsform)
    6061     ,@body))
     
    169170(defvar *x862-tail-allow* t)
    170171(defvar *x862-reckless* nil)
     172(defvar *x862-full-safety* nil)
    171173(defvar *x862-trust-declarations* nil)
    172174(defvar *x862-entry-vstack* nil)
     
    500502           (*x862-tail-allow* t)
    501503           (*x862-reckless* nil)
     504           (*x862-full-safety* nil)
    502505           (*x862-trust-declarations* t)
    503506           (*x862-entry-vstack* nil)
     
    747750      (setq *x862-tail-allow* (neq 0 (%ilogand2 $decl_tailcalls decls))
    748751            *x862-open-code-inline* (neq 0 (%ilogand2 $decl_opencodeinline decls))
     752            *x862-full-safety* (neq 0 (%ilogand2 $decl_full_safety decls))
    749753            *x862-reckless* (neq 0 (%ilogand2 $decl_unsafe decls))
    750754            *x862-trust-declarations* (neq 0 (%ilogand2 $decl_trustdecls decls))))))
     
    11881192                        (setq fn (svref *x862-specials* (%ilogand #.operator-id-mask (setq op (acode-operator form))))))
    11891193                   (if (and (null vreg)
     1194                            (not *x862-full-safety*)
    11901195                            (%ilogbitp operator-acode-subforms-bit op)
    11911196                            (%ilogbitp operator-assignment-free-bit op))
     
    16891694             (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
    16901695               (! misc-ref-c-bit-fixnum target src index-known-fixnum)
    1691                (with-imm-temps
    1692                    () (word-index bitnum)
    1693                  (if index-known-fixnum
    1694                    (progn
    1695                      (x862-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -6)))
    1696                      (x862-lri seg bitnum (logand index-known-fixnum #x63)))
    1697                    (! word-index-and-bitnum-from-index word-index bitnum unscaled-idx))
    1698                  (! ref-bit-vector-fixnum target bitnum src word-index))))))))
     1696               (with-imm-target () bitnum
     1697                 (if index-known-fixnum
     1698                   (x862-lri seg bitnum index-known-fixnum)
     1699                   (! scale-1bit-misc-index bitnum unscaled-idx))
     1700                 (! nref-bit-vector-fixnum target bitnum src))))))))
    16991701    (^)))
    17001702
     
    17061708(defun x862-vref (seg vreg xfer type-keyword vector index safe)
    17071709  (with-x86-local-vinsn-macros (seg vreg xfer)
     1710    (when *x862-full-safety*
     1711      (unless vreg (setq vreg x8664::arg_z)))
    17081712    (if (null vreg)
    17091713      (progn
     
    23542358                      (progn
    23552359                        (! set-constant-bit-to-variable-value src index-known-fixnum val-reg)))
    2356                     (with-imm-temps () (word-index bit-number)
    2357                       (if index-known-fixnum
    2358                         (progn
    2359                           (x862-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -6)))
    2360                           (x862-lri seg bit-number (logand index-known-fixnum #x63)))
    2361                         (! word-index-and-bitnum-from-index word-index bit-number unscaled-idx))
    2362                       (if constval
    2363                         (if (zerop constval)
    2364                           (! set-variable-bit-to-zero src word-index bit-number)
    2365                           (! set-variable-bit-to-one src word-index bit-number))
    2366                         (progn
    2367                           (! set-variable-bit-to-variable-value src word-index bit-number val-reg))))))))))
     2360                    (progn
     2361                      (if index-known-fixnum
     2362                        (x862-lri seg scaled-idx index-known-fixnum)
     2363                        (! scale-1bit-misc-index scaled-idx unscaled-idx))
     2364                      (if constval
     2365                        (if (zerop constval)
     2366                          (! nset-variable-bit-to-zero src scaled-idx)
     2367                          (! nset-variable-bit-to-one src scaled-idx))
     2368                        (progn
     2369                          (! nset-variable-bit-to-variable-value src scaled-idx val-reg))))))))))
    23682370      (when (and vreg val-reg) (<- val-reg))
    23692371      (^))))
     
    33963398         (^))))))
    33973399
     3400(defun x862-coalesce-fixnum-boolean-comparison (seg vreg xfer fixnum form cr-bit true-p fixnum-was-first)
     3401  (declare (ignorable  fixnum-was-first))
     3402  (let* ((form (nx-untyped-form form)))
     3403    (cond ((and (acode-p form)
     3404                (eql (acode-operator form) (%nx1-operator %typed-uvref))
     3405                (eq (x862-immediate-operand (cadr form)) :bit-vector)
     3406                (or (eql fixnum 0) (eql fixnum (ash 1 *x862-target-fixnum-shift*)))
     3407                (eql cr-bit x86::x86-e-bits))
     3408           (with-x86-local-vinsn-macros (seg vreg xfer)
     3409             (destructuring-bind (vector index) (cddr form)
     3410               (let* ((safe (not *x862-reckless*))
     3411                      (arch (backend-target-arch *target-backend*))
     3412                      (index-known-fixnum (acode-fixnum-form-p index))
     3413                      (unscaled-idx nil)
     3414                      (src nil))
     3415                 (if (or safe (not index-known-fixnum))
     3416                   (multiple-value-setq (src unscaled-idx)
     3417                     (x862-two-untargeted-reg-forms seg vector x8664::arg_y index x8664::arg_z))
     3418                   (setq src (x862-one-untargeted-reg-form seg vector x8664::arg_z)))
     3419                 (when safe
     3420                   (! trap-unless-typecode= src (nx-lookup-target-uvector-subtag :bit-vector))
     3421                   (unless index-known-fixnum
     3422                     (! trap-unless-fixnum unscaled-idx))
     3423                   (! check-misc-bound unscaled-idx src))
     3424                 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
     3425                   (! misc-ref-c-bit-flags  src index-known-fixnum)
     3426                   (with-imm-target () bitnum
     3427                     (if index-known-fixnum
     3428                       (x862-lri seg bitnum index-known-fixnum)
     3429                       (! scale-1bit-misc-index bitnum unscaled-idx))
     3430                     (! nref-bit-vector-flags bitnum src)))
     3431                 (setq true-p (eq (not (eql fixnum 0)) (not (null true-p)))
     3432                       cr-bit x86::x86-b-bits)
     3433                 (if (backend-crf-p vreg)
     3434                   (^ x86::x86-b-bits true-p)
     3435                   (progn
     3436                     (ensuring-node-target (target vreg)
     3437                       (if (not true-p)
     3438                         (setq cr-bit (logxor 1 cr-bit)))
     3439                       (! cr-bit->boolean target cr-bit))
     3440                     (^))))))
     3441           t)
     3442          (t nil))))
     3443
    33983444;;; There are other cases involving constants that are worth exploiting.
    33993445(defun x862-compare (seg vreg xfer i j cr-bit true-p)
     
    34133459        (if u8-operator
    34143460          (x862-compare-u8 seg vreg xfer u8-operand u8 (if (and iu8 (not (eq cr-bit x86::x86-e-bits))) (logxor 1 cr-bit) cr-bit) true-p u8-operator)
    3415           (if (and boolean (or js32 is32))
    3416             (let* ((reg (x862-one-untargeted-reg-form seg (if js32 i j) x8664::arg_z))
    3417                    (constant (or js32 is32)))
    3418               (if (zerop constant)
    3419                 (! compare-reg-to-zero reg)
    3420                 (! compare-s32-constant reg (or js32 is32)))
    3421               (unless (or js32 (eq cr-bit x86::x86-e-bits))
    3422                 (setq cr-bit (x862-reverse-cr-bit cr-bit)))
    3423               (^ cr-bit true-p))
    3424             (if (and ;(eq cr-bit x86::x86-e-bits)
     3461          (or (and (or js32 is32)
     3462                   (x862-coalesce-fixnum-boolean-comparison seg vreg xfer (or is32 js32) (if is32 j i) cr-bit true-p is32))
     3463              (if (and boolean (or js32 is32))
     3464                (let* ((reg (x862-one-untargeted-reg-form seg (if js32 i j) x8664::arg_z))
     3465                       (constant (or js32 is32)))
     3466                  (if (zerop constant)
     3467                    (! compare-reg-to-zero reg)
     3468                    (! compare-s32-constant reg (or js32 is32)))
     3469                  (unless (or js32 (eq cr-bit x86::x86-e-bits))
     3470                    (setq cr-bit (x862-reverse-cr-bit cr-bit)))
     3471                  (^ cr-bit true-p))
     3472                (if (and ;(eq cr-bit x86::x86-e-bits)
    34253473                     (or js32 is32))
    3426               (progn
    3427                 (unless (or js32 (eq cr-bit x86::x86-e-bits))
    3428                   (setq cr-bit (x862-reverse-cr-bit cr-bit)))
    3429               (x862-test-reg-%izerop
    3430                seg
    3431                vreg
     3474                  (progn
     3475                    (unless (or js32 (eq cr-bit x86::x86-e-bits))
     3476                      (setq cr-bit (x862-reverse-cr-bit cr-bit)))
     3477                    (x862-test-reg-%izerop
     3478                     seg
     3479                     vreg
    34323480               xfer
    34333481               (x862-one-untargeted-reg-form
     
    34393487               (or js32 is32)))
    34403488              (multiple-value-bind (ireg jreg) (x862-two-untargeted-reg-forms seg i x8664::arg_y j x8664::arg_z)
    3441                 (x862-compare-registers seg vreg xfer ireg jreg cr-bit true-p)))))))))
     3489                (x862-compare-registers seg vreg xfer ireg jreg cr-bit true-p))))))))))
    34423490
    34433491(defun x862-natural-compare (seg vreg xfer i j cr-bit true-p)
Note: See TracChangeset for help on using the changeset viewer.