Changeset 12861


Ignore:
Timestamp:
Sep 22, 2009, 3:05:49 AM (10 years ago)
Author:
gb
Message:

compiler/optimizers.lisp: * (multiplication) compiler-macro: always
transform into a sequence of pairwise multiplications.

other files: compiler frontend changes, largely intended to address
ticket:186. These changes are a bit hard to bootstrap; new images
soon.

Location:
trunk/source
Files:
8 edited

Legend:

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

    r12838 r12861  
    21112111         (is-node  (member type-keyword (arch::target-gvector-types arch))))
    21122112    (if is-node
    2113       (cond ((eq form *nx-nil*)
     2113      (cond ((nx-null form)
    21142114             (target-nil-value))
    2115             ((eq form *nx-t*)
     2115            ((nx-t form)
    21162116             (+ (target-nil-value) (arch::target-t-offset arch)))
    21172117            (t
     
    35483548  (let ((value (acode-unwrapped-form-value form)))
    35493549    (when (acode-p value)
    3550       (if (or (eq value *nx-t*)
    3551               (eq value *nx-nil*)
     3550      (if (or (nx-t value)
     3551              (nx-null value)
    35523552              (let* ((operator (acode-operator value)))
    35533553                (member operator *x862-operator-supports-push*)))
     
    36963696
    36973697(defun x862-compare-register-to-constant (seg vreg xfer ireg cr-bit true-p constant)
    3698   (cond ((eq constant *nx-nil*)
     3698  (cond ((nx-null constant)
    36993699         (x862-compare-register-to-nil seg vreg xfer ireg cr-bit true-p))
    37003700        (t
    37013701         (with-x86-local-vinsn-macros (seg vreg xfer)
    37023702           (when vreg
    3703              (if (eq constant *nx-t*)
     3703             (if (nx-t constant)
    37043704               (! compare-to-t ireg)
    37053705               (let* ((imm (x862-immediate-operand constant))
     
    43684368                   (let* ((bits (nx-var-bits var)))
    43694369                     (if (%ilogbitp $vbitpuntable bits)
    4370                        (nx-untyped-form initform)))))
     4370                       initform))))
    43714371            (declare (inline x862-puntable-binding-p))
    43724372            (if (and (not (x862-load-ea-p val))
     
    43744374              (progn
    43754375                (nx-set-var-bits var (%ilogior (%ilsl $vbitpunted 1) bits))
     4376                (nx2-replace-var-refs var puntval)
    43764377                (x862-set-var-ea seg var puntval))
    43774378              (progn
     
    44814482  (with-x86-local-vinsn-macros (seg)
    44824483    (let* ((ea-p (x862-load-ea-p value))
    4483            (nil-p (unless ea-p (eq (setq value (nx-untyped-form value)) *nx-nil*)))
     4484           (nil-p (unless ea-p (nx-null (setq value (nx-untyped-form value)))))
    44844485           (self-p (unless ea-p (and (or
    44854486                                      (eq (acode-operator value) (%nx1-operator bound-special-ref))
     
    49984999    nil
    49995000    (let* ((val (acode-unwrapped-form-value valform)))
    5000       (if (or (eq val *nx-t*)
    5001               (eq val *nx-nil*)
     5001      (if (or (nx-t val)
     5002              (nx-null val)
    50025003              (and (acode-p val)
    50035004                   (let* ((op (acode-operator val)))
     
    63386339    (x862-form seg vreg xfer form)))
    63396340
     6341(defx862 x862-type-asserted-form type-asserted-form (seg vreg xfer typespec form &optional check)
     6342  (declare (ignore typespec check))
     6343  (x862-form seg vreg xfer form))
     6344
    63406345(defx862 x862-%primitive %primitive (seg vreg xfer &rest ignore)
    63416346  (declare (ignore seg vreg xfer ignore))
     
    67346739      (let* ((f1 (acode-unwrapped-form form1))
    67356740             (f2 (acode-unwrapped-form form2)))
    6736         (cond ((or (eq f1 *nx-nil*)
    6737                    (eq f1 *nx-t*)
     6741        (cond ((or (nx-null f1 )
     6742                   (nx-t f1)
    67386743                   (and (acode-p f1)
    67396744                        (eq (acode-operator f1) (%nx1-operator immediate))))
    67406745               (x862-compare-register-to-constant seg vreg xfer (x862-one-untargeted-reg-form seg form2 ($ *x862-arg-z*)) cr-bit true-p f1))
    6741               ((or (eq f2 *nx-nil*)
    6742                    (eq f2 *nx-t*)
     6746              ((or (nx-null f2)
     6747                   (nx-t f2)
    67436748                   (and (acode-p f2)
    67446749                        (eq (acode-operator f2) (%nx1-operator immediate))))
  • trunk/source/compiler/nx-basic.lisp

    r12618 r12861  
    484484 
    485485(defun cons-var (name &optional (bits 0))
    486   (%istruct 'var name bits nil nil nil nil nil))
     486  (%istruct 'var name bits nil nil nil nil nil nil))
    487487
    488488
  • trunk/source/compiler/nx0.lisp

    r12583 r12861  
    436436
    437437
    438 (defun acode-form-type (form trust-decls)
    439   (nx-target-type
    440    (if (acode-p form)
    441      (let* ((op (acode-operator form)))
    442        (if (eq op (%nx1-operator fixnum))
    443          'fixnum
    444          (if (eq op (%nx1-operator immediate))
    445            (type-of (%cadr form))
    446            (and trust-decls
    447                 (if (eq op (%nx1-operator typed-form))
    448                   (if (eq (%cadr form) 'number)
    449                     (or (acode-form-type (nx-untyped-form form) trust-decls)
    450                         'number)
    451                     (%cadr form))
    452                   (if (eq op (%nx1-operator lexical-reference))
    453                     (let* ((var (cadr form))
    454                            (bits (nx-var-bits var))
    455                            (punted (logbitp $vbitpunted bits)))
    456                       (if (or punted
    457                               (eql 0 (%ilogand $vsetqmask bits)))
    458                         (var-inittype var)))
    459                     (if (or (eq op (%nx1-operator %aref1))
    460                             (eq op (%nx1-operator simple-typed-aref2))
    461                             (eq op (%nx1-operator general-aref2))
    462                             (eq op (%nx1-operator simple-typed-aref3))
    463                             (eq op (%nx1-operator general-aref3)))
    464                       (let* ((atype (acode-form-type (cadr form) t))
    465                              (actype (if atype (specifier-type atype))))
    466                         (if (typep actype 'array-ctype)
    467                           (type-specifier (array-ctype-specialized-element-type
    468                                            actype))))
    469                       (if (member op *numeric-acode-ops*)
    470                         (multiple-value-bind (f1 f2)
    471                             (nx-binop-numeric-contagion (cadr form)
    472                                                         (caddr form)
    473                                                         trust-decls)
    474                           (if (and (acode-form-typep f1 'float trust-decls)
    475                                    (acode-form-typep f2 'float trust-decls))
    476 
    477                             (if (or (acode-form-typep f1 'double-float trust-decls)
    478                                     (acode-form-typep f2 'double-float trust-decls))
    479                             'double-float
    480                             'single-float)))
    481                         (cdr (assq op *nx-operator-result-types*)))))))))))))
     438
     439(defun acode-form-type (form trust-decls &optional (assert t))
     440  (let* ((typespec
     441          (if (nx-null form)
     442            'null
     443            (if (eq form *nx-t*)
     444              'boolean
     445              (nx-target-type
     446               (if (acode-p form)
     447                 (let* ((op (acode-operator form)))
     448                   (if (eq op (%nx1-operator fixnum))
     449                     'fixnum
     450                     (if (eq op (%nx1-operator immediate))
     451                       (type-of (%cadr form))
     452                       (and trust-decls
     453                            (if (eq op (%nx1-operator type-asserted-form))
     454                              (progn
     455                                (setq assert nil)
     456                                (%cadr form))
     457                              (if (eq op (%nx1-operator typed-form))
     458                                (progn
     459                                  (when (and assert (null (nth 3 form)))
     460                                    (setf (%car form) (%nx1-operator type-asserted-form)
     461                                          assert nil))
     462                                  (if (eq (%cadr form) 'number)
     463                                    (or (acode-form-type (nx-untyped-form form) trust-decls)
     464                                        'number)
     465                                    (%cadr form)))
     466                                (if (eq op (%nx1-operator lexical-reference))
     467                                  (let* ((var (cadr form))
     468                                         (bits (nx-var-bits var))
     469                                         (punted (logbitp $vbitpunted bits)))
     470                                    (if (or punted
     471                                            (eql 0 (%ilogand $vsetqmask bits)))
     472                                      (var-inittype var)))
     473                                  (if (or (eq op (%nx1-operator %aref1))
     474                                          (eq op (%nx1-operator simple-typed-aref2))
     475                                          (eq op (%nx1-operator general-aref2))
     476                                          (eq op (%nx1-operator simple-typed-aref3))
     477                                          (eq op (%nx1-operator general-aref3)))
     478                                    (let* ((atype (acode-form-type (cadr form) t))
     479                                           (actype (if atype (specifier-type atype))))
     480                                      (if (typep actype 'array-ctype)
     481                                        (type-specifier (array-ctype-specialized-element-type
     482                                                         actype))))
     483                                    (if (member op *numeric-acode-ops*)
     484                                      (multiple-value-bind (f1 f2)
     485                                          (nx-binop-numeric-contagion (cadr form)
     486                                                                      (caddr form)
     487                                                                      trust-decls)
     488                                        (if (and (acode-form-typep f1 'float trust-decls)
     489                                                 (acode-form-typep f2 'float trust-decls))
     490
     491                                          (if (or (acode-form-typep f1 'double-float trust-decls)
     492                                                  (acode-form-typep f2 'double-float trust-decls))
     493                                            'double-float
     494                                            'single-float)))
     495                                      (cdr (assq op *nx-operator-result-types*)))))))))))))))))
     496    (when (and (acode-p form) (typep (acode-operator form) 'fixnum) assert)
     497      (unless typespec (setq typespec t))
     498      (let* ((new (cons typespec (cons (cons (%car form) (%cdr form)) nil))))
     499        (setf (%car form) (%nx1-operator type-asserted-form)
     500              (%cdr form) new)))
     501    typespec))
    482502
    483503(defun nx-binop-numeric-contagion (form1 form2 trust-decls)
     
    18181838                    (nx-set-var-bits info (%ilogior2 (%ilsl $vbitreffed 1) (nx-var-bits info))))
    18191839                  (nx-adjust-ref-count info)
    1820                   (make-acode (%nx1-operator lexical-reference) info)))
     1840                  (nx-make-lexical-reference info)))
    18211841              (make-acode
    18221842               (if (nx1-check-special-ref form info)
     
    25262546       ((fixnump bits) (setf (var-bits var) newbits))))
    25272547
     2548(defun nx-make-lexical-reference (var)
     2549  (let* ((ref (make-acode (%nx1-operator lexical-reference) var)))
     2550    (push ref (var-ref-forms var))
     2551    ref))
     2552
    25282553(defun nx-adjust-ref-count (var)
    25292554  (let* ((bits (nx-var-bits var))
     
    25672592                  (or (and op (cdr (assq op *nx-operator-result-types*)))
    25682593                      (and (not op)(cdr (assq (car form) *nx-operator-result-types-by-name*)))
    2569                       (and (memq (car form) *numeric-ops*)
     2594                      #+no (and (memq (car form) *numeric-ops*)
    25702595                           (grovel-numeric-form form env))
    2571                       (and (memq (car form) *logical-ops*)
     2596                      #+no (and (memq (car form) *logical-ops*)
    25722597                           (grovel-logical-form form env))
    25732598                      (nx-declared-result-type (%car form) env)
  • trunk/source/compiler/nx1.lisp

    r12583 r12861  
    322322(defun nx-untyped-form (form)
    323323  (while (and (consp form)
    324               (eq (%car form) (%nx1-operator typed-form))
    325               (null (nth 3 form)))
     324              (or (and (eq (%car form) (%nx1-operator typed-form))
     325                       (null (nth 3 form)))
     326                  (eq (%car form) (%nx1-operator type-asserted-form))))
    326327    (setq form (%caddr form)))
    327328  form)
     
    12541255              (%nx1-operator closed-function)
    12551256              (%nx1-operator simple-function)))
    1256         (ref (afunc-ref-form afunc)))
     1257        (ref (acode-unwrapped-form (afunc-ref-form afunc))))
    12571258    (if ref
    12581259      (%rplaca ref op) ; returns ref
     
    14701471            (make-acode
    14711472             (%nx1-operator catch)
    1472              (make-acode (%nx1-operator lexical-reference) tagvar)
     1473             (nx-make-lexical-reference tagvar)
    14731474             body)
    14741475            0)))))))
     
    19581959                                    (%nx1-operator debind)
    19591960                                    nil
    1960                                     (make-acode
    1961                                      (%nx1-operator lexical-reference) var)
     1961                                    (nx-make-lexical-reference var)
    19621962                                    nil
    19631963                                    nil
  • trunk/source/compiler/nx2.lisp

    r12060 r12861  
    226226                (setq entries new)))))))
    227227    entries))
    228                
     228
     229(defun nx2-replace-var-refs (var value)
     230  (when (acode-p value)
     231    (let* ((op (acode-operator value))
     232           (operands (acode-operands value)))
     233      (when (typep op 'fixnum)
     234        (dolist (ref (var-ref-forms var) (setf (var-ref-forms var) nil))
     235          (when (acode-p ref)
     236            (setf (acode-operator ref) op
     237                  (acode-operands ref) operands)))))))
  • trunk/source/compiler/nxenv.lisp

    r12071 r12861  
    2525  (require 'lispequ)
    2626)
     27
     28#-bootstrapped
     29(eval-when (:compile-toplevel :load-toplevel :execute)
     30  (when (and (macro-function 'var-decls)
     31             (not (macro-function 'var-ref-forms)))
     32    (setf (macro-function 'var-ref-forms)
     33          (macro-function 'var-decls))))
    2734
    2835#+ppc-target (require "PPCENV")
     
    124131     (local-tagbody . #.operator-single-valued-mask)
    125132     (%fixnum-set-natural . #.operator-single-valued-mask)
    126      (spushl . #.operator-single-valued-mask)
     133     (type-asserted-form . 0)
    127134     (spushp . #.operator-single-valued-mask)
    128135     (simple-function . #.operator-single-valued-mask)
     
    487494; More Bootstrapping Shit.
    488495(defmacro acode-operator (form)
    489   ; Gak.
     496  ;; Gak.
    490497  `(%car ,form))
    491498
    492499(defmacro acode-operand (n form)
    493   ; Gak. Gak.
     500  ;; Gak. Gak.
    494501  `(nth ,n (the list ,form)))
     502
     503(defmacro acode-operands (form)
     504  ;; Gak. Gak. Gak.
     505  `(%cdr ,form))
    495506
    496507(defmacro acode-p (x)
  • trunk/source/compiler/optimizers.lisp

    r12535 r12861  
    12261226      `(%negate ,n0))))
    12271227
    1228 (define-compiler-macro * (&whole w &environment env &optional (n0 nil n0p) (n1 nil n1p) &rest more)
     1228(define-compiler-macro * (&optional (n0 nil n0p) (n1 nil n1p) &rest more)
    12291229  (if more
    1230     (let ((type (nx-form-type w env)))
    1231       (if (and type (numeric-type-p type)) ; go pairwise if type known, else not
    1232         `(*-2 ,n0 (* ,n1 ,@more))
    1233         w))
     1230    `(*-2 ,n0 (* ,n1 ,@more))
    12341231    (if n1p
    12351232      `(*-2 ,n0 ,n1)
  • trunk/source/library/lispequ.lisp

    r12679 r12861  
    199199  (var-bits var-parent)                 ; fixnum or ptr to parent
    200200  (var-ea  var-expansion)               ; p2 address (or symbol-macro expansion)
    201   var-decls                             ; list of applicable decls [not used]
     201  var-ref-forms                         ; in intermediate-code
    202202  var-inittype
    203203  var-binding-info
    204204  var-refs
    205205  var-nvr
     206  var-declared-type
    206207)
    207208
Note: See TracChangeset for help on using the changeset viewer.