Changeset 13885 for branches/rme-logops


Ignore:
Timestamp:
Jun 24, 2010, 11:48:25 PM (9 years ago)
Author:
rme
Message:

purported improvements to logior on natural-sized operands

Location:
branches/rme-logops/compiler
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/rme-logops/compiler/nx0.lisp

    r13876 r13885  
    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>) ?
     
    27912818      (t
    27922819       (make-acode (%nx1-operator logand2) form-1 form-2)))))
    2793          
     2820
     2821(defun nx-logior-2-op (arg-1 arg-2 env)
     2822  (let* ((form-1 (nx1-form arg-1))
     2823         (form-2 (nx1-form arg-2))
     2824         (fix-1 (nx-acode-fixnum-type-p form-1 env))
     2825         (fix-2 (nx-acode-fixnum-type-p form-2 env))
     2826         (nat-1 (or (acode-natural-constant-p form-1)
     2827                    (nx-acode-natural-type-p form-1 env)))
     2828         (nat-2 (or (acode-natural-constant-p form-2)
     2829                    (nx-acode-natural-type-p form-2 env))))
     2830    (cond
     2831      ((and fix-1 fix-2)
     2832       (make-acode (%nx1-operator %ilogior2) form-1 form-2))
     2833      ((and nat-1 nat-2)
     2834       (make-acode (%nx1-operator typed-form)
     2835                   (target-word-size-case
     2836                    (32 '(unsigned-byte 32))
     2837                    (64 '(unsigned-byte 64)))
     2838                   (make-acode (%nx1-operator %natural-logior) form-1 form-2)))
     2839      (t
     2840       (make-acode (%nx1-operator logior2) form-1 form-2)))))
    27942841
    27952842(defun nx-binary-boole-op (whole env arg-1 arg-2 fixop intop naturalop)
  • branches/rme-logops/compiler/nx1.lisp

    r13876 r13885  
    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)
     
    470464(defnx1 nx1-logand-2 ((logand-2)) (&environment env arg-1 arg-2)
    471465  (nx-logand-2-op arg-1 arg-2 env))
    472 
    473 #+not-any-more
    474 (defnx1 nx1-logand-2 ((logand-2)) (&whole w &environment env arg-1 arg-2)
    475   (nx-binary-boole-op w
    476                       env
    477                       arg-1
    478                       arg-2
    479                       (%nx1-operator %ilogand2)
    480                       (%nx1-operator logand2)
    481                       (%nx1-operator %natural-logand)))
    482466
    483467(defnx1 nx1-require ((require-simple-vector)
Note: See TracChangeset for help on using the changeset viewer.