Changeset 14348


Ignore:
Timestamp:
Oct 11, 2010, 4:36:21 PM (9 years ago)
Author:
gb
Message:

Define (obvious) compiler-macros on LOG{AND,OR}C{1,2}.
Define *NX-TARGET-FIXNUM-TYPE* and *NX-TARGET-NATURAL-TYPE*; bind them
appropriately in the compiler, and try to use them consistently.
Define "portable" acode optimizers for LOGAND2/LOGIOR2/LOGXOR2; handle
opportunities for constant-folding, strength reduction there. Use them
(so far) in the x86 backend.

doc/src/streams.xml: describe extensions to STREAM-EXTERNAL-FORMAT; don't
discuss imaginary STREAM-EXTERNAL-ENCODING.

Location:
trunk/source/compiler
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/x862.lisp

    r14343 r14348  
    75787578
    75797579(defx862 x862-logior2 logior2 (seg vreg xfer form1 form2)
    7580   (if (or (x862-explicit-non-fixnum-type-p form1)
    7581           (x862-explicit-non-fixnum-type-p form2))
    7582     (x862-binary-builtin seg vreg xfer 'logior-2 form1 form2)
    7583     (x862-inline-logior2 seg vreg xfer form1 form2)))
     7580  (or (acode-optimize-logior2 seg vreg xfer form1 form2 *x862-trust-declarations*)
     7581      (if (or (x862-explicit-non-fixnum-type-p form1)
     7582              (x862-explicit-non-fixnum-type-p form2))
     7583        (x862-binary-builtin seg vreg xfer 'logior-2 form1 form2)
     7584        (x862-inline-logior2 seg vreg xfer form1 form2))))
    75847585
    75857586(defx862 x862-logxor2 logxor2 (seg vreg xfer form1 form2)
    7586   (x862-binary-builtin seg vreg xfer 'logxor-2 form1 form2))
     7587  (or (acode-optimize-logxor2 seg vreg xfer form1 form2 *x862-trust-declarations*)
     7588      (x862-binary-builtin seg vreg xfer 'logxor-2 form1 form2)))
    75877589
    75887590(defun x862-inline-logand2 (seg vreg xfer form1 form2)
     
    76237625
    76247626(defx862 x862-logand2 logand2 (seg vreg xfer form1 form2)
    7625     (if (or (x862-explicit-non-fixnum-type-p form1)
    7626             (x862-explicit-non-fixnum-type-p form2))
    7627       (x862-binary-builtin seg vreg xfer 'logand-2 form1 form2)
    7628       (x862-inline-logand2 seg vreg xfer form1 form2)))
     7627  (or (acode-optimize-logand2 seg vreg xfer form1 form2 *x862-trust-declarations*)
     7628      (if (or (x862-explicit-non-fixnum-type-p form1)
     7629              (x862-explicit-non-fixnum-type-p form2))
     7630        (x862-binary-builtin seg vreg xfer 'logand-2 form1 form2)
     7631        (x862-inline-logand2 seg vreg xfer form1 form2))))
    76297632
    76307633(defx862 x862-%quo2 %quo2 (seg vreg xfer form1 form2)
  • trunk/source/compiler/nx-basic.lisp

    r14299 r14348  
    3737
    3838(defvar *lisp-compiler-version* 666 "I lost count.")
     39
     40(defparameter *nx-32-bit-fixnum-type* '(signed-byte 30))
     41(defparameter *nx-64-bit-fixnum-type* '(signed-byte 61))
     42(defparameter *nx-32-bit-natural-type* '(unsigned-byte 32))
     43(defparameter *nx-64-bit-natural-type* '(unsigned-byte 64))
     44(defparameter *nx-target-fixnum-type* 'fixnum)
     45
     46(defparameter *nx-target-natural-type*
     47  #+32-bit-target *nx-32-bit-natural-type*
     48  #+64-bit-target *nx-64-bit-natural-type*)
    3949
    4050(defvar *nx-compile-time-types* nil)
  • trunk/source/compiler/nx.lisp

    r14323 r14348  
    153153(defparameter *load-time-eval-token* nil)
    154154
     155
    155156(defparameter *nx-discard-xref-info-hook* nil)
    156157
    157158(defparameter *nx-in-frontend* nil)
     159
     160
    158161
    159162(defun compile-named-function (def &key name env policy load-time-eval-token target
     
    182185     (setf (lexenv.variables env) 'barrier)
    183186     (let* ((*target-backend* (or (if target (find-backend target)) *host-backend*))
     187            (*nx-target-fixnum-type*
     188             (target-word-size-case
     189              (32 *nx-32-bit-fixnum-type*)
     190              (64 *nx-64-bit-fixnum-type*)))
     191            (*nx-target-natural-type*
     192               (target-word-size-case
     193                (32 *nx-32-bit-natural-type*)
     194                (64 *nx-64-bit-natural-type*)))
    184195            (*nx-in-frontend* t)
    185196            (afunc (nx1-compile-lambda
  • trunk/source/compiler/nx0.lisp

    r14304 r14348  
    3636
    3737(defvar *compile-code-coverage* nil "True to instrument for code coverage")
     38
     39
     40
    3841
    3942(defvar *nx-blocks* nil)
     
    691694       (acode-p form)
    692695       (eq (acode-operator form) (%nx1-operator typed-form))
    693        (subtypep (cadr form) (target-word-size-case
    694                               (32 '(unsigned-byte 32))
    695                               (64 '(unsigned-byte 64))))))
     696       (subtypep (cadr form) *nx-target-natural-type*)))
    696697
    697698(defun nx-acode-natural-type-p (form env)
     
    17941795                        (eq (acode-operator form) (%nx1-operator immediate)))
    17951796                  (cadr form))))
    1796       (target-word-size-case
    1797        (32 (and (typep val '(unsigned-byte 32)) val))
    1798        (64 (and (typep val '(unsigned-byte 64)) val))))))
     1797      (and (typep val *nx-target-natural-type*) val))))
    17991798
    18001799(defun nx-u32-constant-p (form)
     
    27232722        form2 (nx-transform form2 env))
    27242723  (and
    2725    (target-word-size-case
    2726     (32 (nx-form-typep form1 '(signed-byte 30) env))
    2727     (64 (nx-form-typep form1 '(signed-byte 61) env)))
    2728    (target-word-size-case
    2729     (32 (nx-form-typep form2 '(signed-byte 30) env))
    2730     (64 (nx-form-typep form2 '(signed-byte 61) env)))
     2724   (nx-form-typep form1 *nx-target-fixnum-type* env)
     2725   (nx-form-typep form2 *nx-target-fixnum-type* env)
    27312726   (or ignore-result-type
    27322727        (and (nx-trust-declarations env)
    2733                 (target-word-size-case
    2734                  (32 (subtypep *nx-form-type* '(signed-byte 30)))
    2735                  (64 (subtypep *nx-form-type* '(signed-byte 61))))))))
     2728             (subtypep *nx-form-type* *nx-target-fixnum-type*)))))
    27362729
    27372730
    27382731(defun nx-binary-natural-op-p (form1 form2 env &optional (ignore-result-type t))
    27392732  (and
    2740    (target-word-size-case
    2741     (32
    2742      (and (nx-form-typep form1 '(unsigned-byte 32)  env)
    2743           (nx-form-typep form2 '(unsigned-byte 32)  env)))
    2744     (64
    2745      (and (nx-form-typep form1 '(unsigned-byte 64)  env)
    2746           (nx-form-typep form2 '(unsigned-byte 64)  env))))
     2733   (nx-form-typep form1 *nx-target-natural-type* env)
     2734   (nx-form-typep form2 *nx-target-natural-type* env)
    27472735   (or ignore-result-type
    27482736       (and (nx-trust-declarations env)
    2749             (target-word-size-case
    2750              (32 (subtypep *nx-form-type* '(unsigned-byte 32)))
    2751              (64 (subtypep *nx-form-type* '(unsigned-byte 64))))))))
     2737            (subtypep *nx-form-type* *nx-target-natural-type*)))))
    27522738
    27532739(defun nx-binary-boole-op (whole env arg-1 arg-2 fixop intop naturalop)
  • trunk/source/compiler/nx1.lisp

    r14335 r14348  
    631631          (if (nx-binary-natural-op-p num1 num2 env nil)
    632632            (make-acode (%nx1-operator typed-form)
    633                         (target-word-size-case
    634                          (32 '(unsigned-byte 32))
    635                          (64 '(unsigned-byte 64)))
     633                        *nx-target-natural-type*
    636634                        (make-acode (%nx1-operator %natural+) f1 f2))
    637635            (make-acode (%nx1-operator typed-form) 'number
     
    22532251                            (nx1-form amt)))
    22542252               (nx1-treat-as-call call))))
    2255     (let* ((unsigned-natural-type (target-word-size-case
    2256                                    (32 '(unsigned-byte 32))
    2257                                    (64 '(unsigned-byte 64))))
     2253    (let* ((unsigned-natural-type *nx-target-natural-type*)
    22582254           (max (target-word-size-case (32 32) (64 64)))
    22592255           (maxbits (target-word-size-case
  • trunk/source/compiler/nx2.lisp

    r14336 r14348  
    279279         seg vreg xfer forms))
    280280
     281(defun acode-constant-fold-integer-binop (seg vreg xfer x y function)
     282  (let* ((const-x (acode-integer-form-p x))
     283         (const-y (acode-integer-form-p y))
     284         (result (and const-x const-y (ignore-errors (funcall function x y)))))
     285    (when result
     286      (backend-use-operator (if (nx1-target-fixnump result)
     287                              (%nx1-operator fixnum)
     288                              (%nx1-operator immediate))
     289                            seg
     290                            vreg
     291                            xfer
     292                            result)
     293      t)))
     294
    281295;;; Return non-nil iff we can do something better than a subprim call
    282296;;; to .SPbuiltin-ash.
    283297(defun acode-optimize-ash (seg vreg xfer num amt trust-decls &optional (result-type 'integer))
    284   (let* ((unsigned-natural-type (target-word-size-case
    285                                  (32 '(unsigned-byte 32))
    286                                  (64 '(unsigned-byte 64))))
    287          (target-fixnum-type (target-word-size-case
    288                               (32 '(signed-byte 30))
    289                               (64 '(signed-byte 61))))
     298  (let* ((unsigned-natural-type *nx-target-natural-type*)
     299         (target-fixnum-type *nx-target-fixnum-type*)
    290300         (max (target-word-size-case (32 32) (64 64)))
    291301         (maxbits (target-word-size-case
     
    377387                 t)))
    378388          (t nil))))
    379          
    380                    
     389
     390
     391
     392
     393(defun acode-optimize-logand2 (seg vreg xfer num1 num2 trust-decls &optional (result-type 'integer))
     394  (declare (ignore result-type))        ;see below
     395  (or (acode-constant-fold-integer-binop seg vreg xfer num1 num2 'logand)
     396      (let* ((unsigned-natural-type *nx-target-natural-type*)
     397             (target-fixnum-type *nx-target-fixnum-type*))
     398        (cond ((eql (acode-fixnum-form-p num1) -1)
     399               (backend-use-operator (%nx1-operator require-integer)
     400                                     seg
     401                                     vreg
     402                                     xfer
     403                                     num2)
     404               t)
     405              ((eql (acode-fixnum-form-p num2) -1)
     406               (backend-use-operator (%nx1-operator require-integer)
     407                                     seg
     408                                     vreg
     409                                     xfer
     410                                     num1)
     411               t)
     412              ((and (acode-form-typep num1 target-fixnum-type trust-decls)
     413                    (acode-form-typep num2 target-fixnum-type trust-decls))
     414               (backend-use-operator (%nx1-operator %ilogand2)
     415                                     seg
     416                                     vreg
     417                                     xfer
     418                                     num1
     419                                     num2)
     420               t)
     421              ((and (acode-form-typep num1 unsigned-natural-type trust-decls)
     422                    (acode-form-typep num2 unsigned-natural-type trust-decls))
     423               (backend-use-operator (%nx1-operator %natural-logand)
     424                                     seg
     425                                     vreg
     426                                     xfer
     427                                     num1
     428                                     num2)
     429               t)
     430              ;; LOGAND of a natural integer N and a signed integer
     431              ;; is a natural integer <= N, and there may be cases
     432              ;; where we want to truncate a larger result to the
     433              ;; machine word size based on the result type.  Later.
     434              (t nil)))))
     435
     436(defun acode-optimize-logior2 (seg vreg xfer num1 num2 trust-decls &optional (result-type 'integer))
     437  (declare (ignorable result-type))
     438  (or (acode-constant-fold-integer-binop seg vreg xfer num1 num2 'logior)
     439      (let* ((unsigned-natural-type *nx-target-natural-type*)
     440             (target-fixnum-type *nx-target-fixnum-type*))
     441        (cond ((eql (acode-fixnum-form-p num1) 0)
     442               (backend-use-operator (%nx1-operator require-integer)
     443                                     seg
     444                                     vreg
     445                                     xfer
     446                                     num2)
     447               t)
     448              ((eql (acode-fixnum-form-p num2) 0)
     449               (backend-use-operator (%nx1-operator require-integer)
     450                                     seg
     451                                     vreg
     452                                     xfer
     453                                     num1)
     454               t)
     455              ((and (acode-form-typep num1 target-fixnum-type trust-decls)
     456                    (acode-form-typep num2 target-fixnum-type trust-decls))
     457               (backend-use-operator (%nx1-operator %ilogior2)
     458                                     seg
     459                                     vreg
     460                                     xfer
     461                                     num1
     462                                     num2)
     463               t)
     464              ((and (acode-form-typep num1 unsigned-natural-type trust-decls)
     465                    (acode-form-typep num2 unsigned-natural-type trust-decls))
     466               (backend-use-operator (%nx1-operator %natural-logior)
     467                                     seg
     468                                     vreg
     469                                     xfer
     470                                     num1
     471                                     num2)
     472               t)
     473              (t nil)))))
     474
     475(defun acode-optimize-logxor2 (seg vreg xfer num1 num2 trust-decls &optional (result-type 'integer))
     476  (declare (ignorable result-type))
     477  (or (acode-constant-fold-integer-binop seg vreg xfer num1 num2 'logxor)
     478      (let* ((unsigned-natural-type *nx-target-natural-type*)
     479             (target-fixnum-type *nx-target-fixnum-type*))
     480        (cond ((eql (acode-fixnum-form-p num1) 0)
     481               (backend-use-operator (%nx1-operator require-integer)
     482                                     seg
     483                                     vreg
     484                                     xfer
     485                                     num2)
     486               t)
     487              ((eql (acode-fixnum-form-p num2) 0)
     488               (backend-use-operator (%nx1-operator require-integer)
     489                                     seg
     490                                     vreg
     491                                     xfer
     492                                     num1)
     493               t)
     494              ((and (acode-form-typep num1 target-fixnum-type trust-decls)
     495                    (acode-form-typep num2 target-fixnum-type trust-decls))
     496               (backend-use-operator (%nx1-operator %ilogxor2)
     497                                     seg
     498                                     vreg
     499                                     xfer
     500                                     num1
     501                                     num2)
     502               t)
     503              ((and (acode-form-typep num1 unsigned-natural-type trust-decls)
     504                    (acode-form-typep num2 unsigned-natural-type trust-decls))
     505               (backend-use-operator (%nx1-operator %natural-logxor)
     506                                     seg
     507                                     vreg
     508                                     xfer
     509                                     num1
     510                                     num2)
     511               t)
     512              (t nil)))))
    381513                 
    382514               
  • trunk/source/compiler/nxenv.lisp

    r14331 r14348  
    568568  `(logior ,@(mapcar #'(lambda (w) `(ash 1 ,w)) weights)))
    569569
     570
     571
    570572(provide "NXENV")
    571573
  • trunk/source/compiler/optimizers.lisp

    r14119 r14348  
    13151315
    13161316
     1317(define-compiler-macro logandc1 (n0 n1)
     1318  `(logand (lognot ,n0) ,n1))
     1319
    13171320(define-compiler-macro logandc2 (n0 n1)
    1318   (let ((n1var (gensym))
    1319         (n0var (gensym)))
    1320     `(let ((,n0var ,n0)
    1321            (,n1var ,n1))
    1322        (logandc1 ,n1var ,n0var))))
     1321  `(logand ,n0 (lognot ,n1)))
     1322
     1323
     1324(define-compiler-macro logorc1 (n0 n1)
     1325  `(logior (lognot ,n0) ,n1))
    13231326
    13241327(define-compiler-macro logorc2 (n0 n1)
    1325   (let ((n1var (gensym))
    1326         (n0var (gensym)))
    1327     `(let ((,n0var ,n0)
    1328            (,n1var ,n1))
    1329        (logorc1 ,n1var ,n0var))))
     1328  `(logior ,n0 (lognot ,n1)))
    13301329
    13311330(define-compiler-macro lognand (n0 n1)
Note: See TracChangeset for help on using the changeset viewer.