Changeset 14375


Ignore:
Timestamp:
Oct 26, 2010, 5:16:37 PM (9 years ago)
Author:
gb
Message:

In the frontend:

binary boolean operations assert their result's type.
logand of an unsigned natural integer and an integer constant is always
an unsigned natural (and the constant can be truncated to the word size.)

This helps with some examples involving (e.g.) DPB on word-sized integers;
it's likely that handling other cases require improvements in later phases.

Location:
trunk/source/compiler
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/nx0.lisp

    r14369 r14375  
    27392739         (use-naturalop (nx-binary-natural-op-p arg-1 arg-2 env)))
    27402740    (if (or use-fixop use-naturalop intop)
    2741       (make-acode (if use-fixop fixop (if use-naturalop naturalop intop))
    2742                   (nx1-form arg-1)
    2743                   (nx1-form arg-2))
     2741      (make-acode (%nx1-operator typed-form)
     2742                  (if use-fixop *nx-target-fixnum-type*
     2743                    (if use-naturalop *nx-target-natural-type* 'integer))
     2744                  (make-acode (if use-fixop fixop (if use-naturalop naturalop intop))
     2745                              (nx1-form arg-1)
     2746                              (nx1-form arg-2)))
    27442747      (nx1-treat-as-call whole))))
    27452748
  • trunk/source/compiler/nx1.lisp

    r14348 r14375  
    475475                      (%nx1-operator %natural-logxor)))
    476476
    477 (defnx1 nx1-logand-2 ((logand-2)) (&whole w &environment env arg-1 arg-2)
    478   (nx-binary-boole-op w
    479                       env
    480                       arg-1
    481                       arg-2
    482                       (%nx1-operator %ilogand2)
    483                       (%nx1-operator logand2)
    484                       (%nx1-operator %natural-logand)))
     477(defnx1 nx1-logand-2 ((logand-2)) (&environment env arg-1 arg-2)
     478  (let* ((nat1 (nx-form-typep arg-1 *nx-target-natural-type* env))
     479         (nat2 (nx-form-typep arg-2 *nx-target-natural-type* env)))
     480    (cond ((and (nx-form-typep arg-1 *nx-target-fixnum-type* env)
     481                (nx-form-typep arg-2 *nx-target-fixnum-type* env))
     482           (make-acode (%nx1-operator typed-form)
     483                       *nx-target-fixnum-type*
     484                       (make-acode (%nx1-operator %ilogand2)
     485                                   (nx1-form arg-1 env)
     486                                   (nx1-form arg-2 env))))
     487          ((and nat1 (typep arg-2 'integer))
     488           (make-acode (%nx1-operator typed-form)
     489                       *nx-target-natural-type*
     490                       (make-acode (%nx1-operator %natural-logand)
     491                                   (nx1-form arg-1 env)
     492                                   (nx1-form (logand arg-2
     493                                                     (1- (ash 1 (target-word-size-case
     494                                                                 (32 32)
     495                                                                 (64 64)))))
     496                                             env))))
     497          ((and nat2 (typep arg-1 'integer))
     498           (make-acode (%nx1-operator typed-form)
     499                       *nx-target-natural-type*
     500                       (make-acode (%nx1-operator %natural-logand)
     501                                   (nx1-form arg-2 env)
     502                                   (nx1-form (logand arg-1
     503                                                     (1- (ash 1 (target-word-size-case
     504                                                                 (32 32)
     505                                                                 (64 64)))))
     506                                             env))))
     507          ((and nat1 nat2)
     508           (make-acode (%nx1-operator typed-form)
     509                       *nx-target-natural-type*
     510                       (make-acode (%nx1-operator %natural-logand)
     511                                   (nx1-form arg-1 env)
     512                                   (nx1-form arg-2 env))))
     513          (t
     514           (make-acode (%nx1-operator typed-form)
     515                       'integer
     516                       (make-acode (%nx1-operator logand2)
     517                                   (nx1-form arg-1 env)
     518                                   (nx1-form arg-2 env)))))))
     519
    485520
    486521(defnx1 nx1-require ((require-simple-vector)
Note: See TracChangeset for help on using the changeset viewer.