Changeset 13887


Ignore:
Timestamp:
Jun 25, 2010, 2:33:40 AM (9 years ago)
Author:
rme
Message:

Make the compiler work a little harder to identify cases where
LOGAND and LOGIOR can use natural-sized operations.

Location:
trunk/source
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • trunk/source

  • trunk/source/compiler/PPC/ppc2.lisp

    r13469 r13887  
    91169116      (^))))
    91179117
     9118(defppc2 ppc2-%fixnum-mask-to-natural %fixnum-mask-to-natural (seg vreg xfer arg)
     9119  (with-imm-target () (dreg :natural)
     9120    (let* ((r (ppc2-one-untargeted-reg-form seg arg ppc::arg_z)))
     9121      (unless (or (acode-fixnum-form-p arg)
     9122                  *ppc2-reckless*)
     9123        (! trap-unless-fixnum r))
     9124      (! fixnum->signed-natural dreg r)
     9125      (<- dreg)
     9126      (^))))
     9127
    91189128(defppc2 ppc2-%double-float %double-float (seg vreg xfer arg)
    91199129  (let* ((real (or (acode-fixnum-form-p arg)
  • trunk/source/compiler/X86/x862.lisp

    r13538 r13887  
    1009410094      (^))))
    1009510095
     10096(defx862 x862-%fixnum-mask-to-natural %fixnum-mask-to-natural (seg vreg xfer arg)
     10097  (with-imm-target () (target :natural)
     10098    (let ((r (x862-one-untargeted-reg-form seg arg *x862-arg-z*)))
     10099      (unless (or (acode-fixnum-form-p arg)
     10100                  *x862-reckless*)
     10101        (! trap-unless-finxum r))
     10102      (! fixnum->signed-natural target r)
     10103      (<- target)
     10104      (^))))
     10105
    1009610106(defx862 x862-%double-float %double-float (seg vreg xfer arg)
    1009710107  (let* ((real (or (acode-fixnum-form-p arg)
  • trunk/source/compiler/nx0.lisp

    r13813 r13887  
    589589         int)))
    590590
     591(defun acode-natural-constant-p (x)
     592  (let* ((int (or (acode-fixnum-form-p x)
     593                  (progn
     594                    (setq x (acode-unwrapped-form x))
     595                    (if (acode-p x)
     596                      (if (and (eq (acode-operator x) (%nx1-operator immediate))
     597                               (typep (cadr x) 'fixnum))
     598                        (cadr x)))))))
     599    (and int
     600         (target-word-size-case
     601          (32 (typep int '(unsigned-byte 32)))
     602          (64 (typep int '(unsigned-byte 64))))
     603         int)))
     604
     605
     606
    591607(defun acode-real-constant-p (x)
    592608  (or (acode-fixnum-form-p x)
     
    692708(defun nx-acode-fixnum-type-p (form env)
    693709    (acode-fixnum-type-p form (nx-trust-declarations env)))
     710
     711(defun acode-natural-type-p (form trust-decls)
     712  (and trust-decls
     713       (acode-p form)
     714       (eq (acode-operator form) (%nx1-operator typed-form))
     715       (subtypep (cadr form) (target-word-size-case
     716                              (32 '(unsigned-byte 32))
     717                              (64 '(unsigned-byte 64))))))
     718
     719(defun nx-acode-natural-type-p (form env)
     720  (acode-natural-type-p form (nx-trust-declarations env)))
    694721
    695722; Is acode-expression the result of alphatizing (%int-to-ptr <integer>) ?
     
    27132740    (subtypep (nx-form-type arg env) type env)))
    27142741
    2715 
    27162742(defun nx-binary-fixnum-op-p (form1 form2 env &optional ignore-result-type)
    27172743  (setq form1 (nx-transform form1 env)
     
    27462772             (64 (subtypep *nx-form-type* '(unsigned-byte 64))))))))
    27472773
    2748    
    2749 
     2774(defun nx-logand-2-op (arg-1 arg-2 env)
     2775  (let* ((form-1 (nx1-form arg-1))
     2776         (form-2 (nx1-form arg-2))
     2777         (fix-1 (nx-acode-fixnum-type-p form-1 env))
     2778         (fix-2 (nx-acode-fixnum-type-p form-2 env))
     2779         (nat-1 (nx-acode-natural-type-p form-1 env))
     2780         (nat-2 (nx-acode-natural-type-p form-2 env)))
     2781    (cond
     2782      ((and fix-1 fix-2)
     2783       (make-acode (%nx1-operator %ilogand2) form-1 form-2))
     2784      ((and nat-1 nat-2)
     2785       (make-acode (%nx1-operator typed-form)
     2786                   (target-word-size-case
     2787                    (32 '(unsigned-byte 32))
     2788                    (64 '(unsigned-byte 64)))
     2789                   (make-acode (%nx1-operator %natural-logand) form-1 form-2)))
     2790      ((and fix-1 nat-2)
     2791       (make-acode (%nx1-operator typed-form)
     2792                   (target-word-size-case
     2793                    (32 '(unsigned-byte 32))
     2794                    (64 '(unsigned-byte 64)))
     2795                   (make-acode (%nx1-operator %natural-logand)
     2796                               (make-acode (%nx1-operator %fixnum-mask-to-natural)
     2797                                           form-1)
     2798                               form-2)))
     2799      ((and nat-1 fix-2)
     2800       (make-acode (%nx1-operator typed-form)
     2801                   (target-word-size-case
     2802                    (32 '(unsigned-byte 32))
     2803                    (64 '(unsigned-byte 64)))
     2804                   (make-acode (%nx1-operator %natural-logand)
     2805                               form-1
     2806                               (make-acode (%nx1-operator %fixnum-mask-to-natural)
     2807                                                          form-2))))
     2808      (t
     2809       (make-acode (%nx1-operator logand2) form-1 form-2)))))
     2810
     2811(defun nx-logior-2-op (arg-1 arg-2 env)
     2812  (let* ((form-1 (nx1-form arg-1))
     2813         (form-2 (nx1-form arg-2))
     2814         (fix-1 (nx-acode-fixnum-type-p form-1 env))
     2815         (fix-2 (nx-acode-fixnum-type-p form-2 env))
     2816         (nat-1 (or (acode-natural-constant-p form-1)
     2817                    (nx-acode-natural-type-p form-1 env)))
     2818         (nat-2 (or (acode-natural-constant-p form-2)
     2819                    (nx-acode-natural-type-p form-2 env))))
     2820    (cond
     2821      ((and fix-1 fix-2)
     2822       (make-acode (%nx1-operator %ilogior2) form-1 form-2))
     2823      ((and nat-1 nat-2)
     2824       (make-acode (%nx1-operator typed-form)
     2825                   (target-word-size-case
     2826                    (32 '(unsigned-byte 32))
     2827                    (64 '(unsigned-byte 64)))
     2828                   (make-acode (%nx1-operator %natural-logior) form-1 form-2)))
     2829      (t
     2830       (make-acode (%nx1-operator logior2) form-1 form-2)))))
    27502831
    27512832(defun nx-binary-boole-op (whole env arg-1 arg-2 fixop intop naturalop)
  • trunk/source/compiler/nx1.lisp

    r13488 r13887  
    450450                (nx1-form newvalue)))
    451451
    452 (defnx1 nx1-logior-2 ((logior-2)) (&whole w &environment env arg-1 arg-2)
    453   (nx-binary-boole-op w
    454                       env
    455                       arg-1
    456                       arg-2
    457                       (%nx1-operator %ilogior2)
    458                       (%nx1-operator logior2)
    459                       (%nx1-operator %natural-logior)))
     452(defnx1 nx1-logior-2 ((logior-2)) (&environment env arg-1 arg-2)
     453  (nx-logior-2-op arg-1 arg-2 env))
    460454
    461455(defnx1 nx1-logxor-2 ((logxor-2)) (&whole w &environment env arg-1 arg-2)
     
    468462                      (%nx1-operator %natural-logxor)))
    469463
    470 (defnx1 nx1-logand-2 ((logand-2)) (&whole w &environment env arg-1 arg-2)
    471   (nx-binary-boole-op w
    472                       env
    473                       arg-1
    474                       arg-2
    475                       (%nx1-operator %ilogand2)
    476                       (%nx1-operator logand2)
    477                       (%nx1-operator %natural-logand)))
     464(defnx1 nx1-logand-2 ((logand-2)) (&environment env arg-1 arg-2)
     465  (nx-logand-2-op arg-1 arg-2 env))
    478466
    479467(defnx1 nx1-require ((require-simple-vector)
     
    21982186              (nx1-form arg)))
    21992187
     2188(defnx1 nx1-%fixnum-mask-to-natural ((%fixnum-mask-to-natural)) (arg)
     2189  (make-acode (%nx1-operator %fixnum-mask-to-natural)
     2190              (nx1-form arg)))
     2191
    22002192(defnx1 nx1-%double-float ((%double-float)) (&whole whole arg &optional (result nil result-p))
    22012193  (declare (ignore result))
  • trunk/source/compiler/nxenv.lisp

    r13782 r13887  
    370370     (%double-float . #. #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask))
    371371     (i386-ff-call . 0)
    372      (i386-syscall . 0))))
     372     (i386-syscall . 0)
     373     (%fixnum-mask-to-natural  . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask)))))
    373374
    374375(defmacro %nx1-operator (sym)
Note: See TracChangeset for help on using the changeset viewer.