Changeset 16192 for release


Ignore:
Timestamp:
Sep 8, 2014, 3:17:16 PM (5 years ago)
Author:
rme
Message:

Merge from trunk. (See ticket:1226, ticket:1231, ticket:1232)

Location:
release/1.10/source
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • release/1.10/source

  • release/1.10/source/compiler/X86/X8632/x8632-vinsns.lisp

    r16104 r16192  
    42384238(define-x8632-vinsn (nfp-store-unboxed-word :nfp :set) (()
    42394239                                                        ((val :u32)
    4240                                                          (offset :u16const)
    4241                                                          (nfp :imm)))
    4242   (movl (:%l val) (:@ (:apply + 16 offset) (:% nfp))))
     4240                                                         (offset :u16const)))
     4241  (movd (:%l val) (:%mmx x8632::stack-temp))
     4242  (movl (:@ (:%seg :rcontext) x8632::tcr.nfp) (:%l val))
     4243  (movd (:%mmx x8632::stack-temp) (:@ (:apply + 16 offset) (:% val)))
     4244  (movd (:%mmx x8632::stack-temp) (:% val)))
    42434245
    42444246
    42454247(define-x8632-vinsn (nfp-load-unboxed-word :nfp :ref) (((val :u32))
    4246                                                        ((offset :u16const)
    4247                                                         (nfp :imm)))
    4248   (movl (:@ (:apply + 16 offset) (:% nfp)) (:%l val)))
     4248                                                       ((offset :u16const)))
     4249  (movl (:@ (:%seg :rcontext) x8632::tcr.nfp) (:%l val))
     4250  (movl (:@ (:apply + 16 offset) (:% val)) (:%l val)))
    42494251
    42504252(define-x8632-vinsn (nfp-store-single-float :nfp :set)
     
    43024304  (movl (:@ (:%seg :rcontext) x8632::tcr.nfp) (:%l nfp))
    43034305  (cmpl (:%l reg) (:@ (:apply + offset 16) (:%l nfp))))
     4306
     4307(define-x8632-vinsn nfp-logior-natural-register (()
     4308                                                  ((offset :u16const)
     4309                                                   (reg :u32))
     4310                                                  ((nfp :lisp))) ; sic
     4311  (movl (:@ (:%seg :rcontext) x8632::tcr.nfp) (:%l nfp))
     4312  (orl (:@ (:apply + offset 16) (:%l nfp)) (:%l reg)))
     4313
     4314(define-x8632-vinsn nfp-logand-natural-register (()
     4315                                                  ((offset :u16const)
     4316                                                   (reg :u32))
     4317                                                  ((nfp :lisp))) ; sic
     4318  (movl (:@ (:%seg :rcontext) x8632::tcr.nfp) (:%l nfp))
     4319  (andl (:@ (:apply + offset 16) (:%l nfp)) (:%l reg)))
     4320
     4321(define-x8632-vinsn nfp-logxor-natural-register (()
     4322                                                  ((offset :u16const)
     4323                                                   (reg :u32))
     4324                                                  ((nfp :lisp))) ; sic
     4325  (movl (:@ (:%seg :rcontext) x8632::tcr.nfp) (:%l nfp))
     4326  (xorl (:@ (:apply + offset 16) (:%l nfp)) (:%l reg)))
     4327
     4328(define-x8632-vinsn nfp-add-natural-register (()
     4329                                                  ((offset :u16const)
     4330                                                   (reg :u32))
     4331                                                  ((nfp :lisp))) ; sic
     4332  (movl (:@ (:%seg :rcontext) x8632::tcr.nfp) (:%l nfp))
     4333  (addl (:@ (:apply + offset 16) (:%l nfp)) (:%l reg)))
     4334
     4335(define-x8632-vinsn nfp-subtract-natural-register (()
     4336                                                  ((offset :u16const)
     4337                                                   (reg :u32))
     4338                                                  ((nfp :lisp))) ; sic
     4339  (movl (:@ (:%seg :rcontext) x8632::tcr.nfp) (:%l nfp))
     4340  (subl (:%l reg) (:@ (:apply + offset 16) (:%l nfp)))
     4341  (movl (:@ (:apply + offset 16) (:%l nfp)) (:%l reg)))
     4342
     4343
     4344
    43044345
    43054346(define-x8632-vinsn (temp-push-unboxed-word :push :word :csp)
  • release/1.10/source/compiler/X86/x862.lisp

    r16186 r16192  
    297297              (setq reg (available-imm-temp
    298298                         *available-backend-imm-temps*
    299                          :u32)))
     299                         :natural)))           
    300300            (setq vinsn
    301301                  (! nfp-load-unboxed-word reg offset nfp)))
     
    350350      (ecase type
    351351        (#. memspec-nfp-type-natural
    352             (if (and (eql vreg-class hard-reg-class-gpr)
    353                      (eql vreg-mode hard-reg-class-gpr-mode-u32))
     352            (if (and (eql vreg-class hard-reg-class-gpr)                     
     353                     (eql vreg-mode (target-word-size-case
     354                                     (64 hard-reg-class-gpr-mode-u64)
     355                                     (32 hard-reg-class-gpr-mode-u32))))
    354356              vreg
    355357              (make-unwired-lreg
    356                (available-imm-temp *available-backend-imm-temps* :u32))))
     358               (available-imm-temp *available-backend-imm-temps* :natural))))
    357359        (#. memspec-nfp-type-double-float
    358360            (if (and (eql vreg-class hard-reg-class-fpr)
     
    406408             (reg nil)
    407409             (nfp-bits 0))
    408         (cond ((and (subtypep type '(unsigned-byte 32))
     410        (cond ((and (subtypep type *nx-target-natural-type*)
    409411                    NIL
    410                     (not (subtypep type '(signed-byte 30))))
     412                    (not (subtypep type *nx-target-fixnum-type*)))
    411413               (setq reg (available-imm-temp
    412                           *available-backend-imm-temps* :u32)
     414                          *available-backend-imm-temps* :natural)
    413415                     nfp-bits memspec-nfp-type-natural))
    414416              ((subtypep type 'single-float)
     
    37853787        (let* ((offset *x862-nfp-depth*)
    37863788               (size 16)
    3787                (nfp (x862-nfp-reg seg)))
     3789               (nfp (if (target-arch-case (:x8664 t) (:x8632 a-float))(x862-nfp-reg seg))))
    37883790          (setq vinsn
    37893791                (if a-float
     
    37933795                    (:complex-single-float (! nfp-store-complex-single-float areg offset nfp))
    37943796                    (:complex-double-float (! nfp-store-complex-double-float areg offset nfp)))
    3795                   (! nfp-store-unboxed-word areg offset nfp)))
     3797                  (target-arch-case
     3798                   (:x8664 (! nfp-store-unboxed-word areg offset nfp))
     3799                   (:x8632 (! nfp-store-unboxed-word areg offset)))))
    37963800          (incf offset size)
    37973801          (push vinsn *x862-all-nfp-pushes*)
     
    38113815        (setq vinsn (x862-vpop-register seg areg))
    38123816        (let* ((offset (- *x862-nfp-depth* 16))
    3813                (nfp (x862-nfp-reg seg)))
     3817               (nfp (if (target-arch-case (:x8664 t) (:x8632 a-float))
     3818                      (x862-nfp-reg seg))))
    38143819          (setq vinsn
    38153820                (if a-float
     
    38193824                    (:complex-single-float (! nfp-load-complex-single-float areg offset nfp))
    38203825                    (:complex-double-float (! nfp-load-complex--float areg offset nfp)))
    3821                   (! nfp-load-unboxed-word areg offset nfp)))
     3826                  (target-arch-case
     3827                   (:x8664
     3828                    (! nfp-load-unboxed-word areg offset nfp))
     3829                   (:x8632
     3830                    (! nfp-load-unboxed-word areg offset)))))
    38223831          (setq *x862-nfp-depth* offset)))
    38233832      vinsn)))
     
    1076410773          (if (not (or u31x u31y))
    1076510774            (with-imm-target () (xreg :natural)
    10766               (with-additional-imm-reg ()
     10775              (target-arch-case
     10776               (:x8664
    1076710777                (with-imm-target (xreg) (yreg :natural)
    1076810778                  (x862-two-targeted-reg-forms seg x xreg y yreg)
    1076910779                  (! %natural+ xreg yreg)))
     10780               (:x8632
     10781                (let* ((*x862-nfp-depth* *x862-nfp-depth*)
     10782                       (offset *x862-nfp-depth*))
     10783                  (x862-one-targeted-reg-form seg x xreg)
     10784                  (x862-push-register seg xreg)
     10785                  (x862-one-targeted-reg-form seg y xreg)
     10786                  (! nfp-add-natural-register offset xreg))))
    1077010787              (<- xreg))
    1077110788            (let* ((other (if u31x y x)))
     
    1078810805          (if (not u31y)
    1078910806            (with-imm-target () (xreg :natural)
    10790               (with-additional-imm-reg ()
     10807              (target-arch-case
     10808               (:x8664
    1079110809                (with-imm-target (xreg) (yreg :natural)
    1079210810                  (x862-two-targeted-reg-forms seg x xreg y yreg)
    10793                   (! %natural- xreg yreg))
    10794                 (<- xreg)))
     10811                  (! %natural- xreg yreg)))
     10812               (:x8632
     10813                (let* ((*x862-nfp-depth* *x862-nfp-depth*)
     10814                       (offset *x862-nfp-depth*))
     10815                  (x862-one-targeted-reg-form seg x xreg)
     10816                  (x862-push-register seg xreg)
     10817                  (x862-one-targeted-reg-form seg y xreg)
     10818                  (! nfp-subtract-natural-register offset xreg))))
     10819                (<- xreg))
    1079510820            (progn
    1079610821              (with-imm-target () (xreg :natural)
     
    1081410839          (if (not constant)
    1081510840            (with-imm-target () (xreg :natural)
    10816               (with-additional-imm-reg ()
     10841              (target-arch-case
     10842               (:x8664
    1081710843                (with-imm-target (xreg) (yreg :natural)
    1081810844                  (x862-two-targeted-reg-forms seg x xreg y yreg)
    1081910845                  (! %natural-logior xreg yreg)))
     10846               (:x8632
     10847                (let* ((*x862-nfp-depth* *x862-nfp-depth*)
     10848                       (offset *x862-nfp-depth*))
     10849                  (x862-one-targeted-reg-form seg x xreg)
     10850                  (x862-push-register seg xreg)
     10851                  (x862-one-targeted-reg-form seg y xreg)
     10852                  (! nfp-logior-natural-register offset xreg))))
    1082010853              (<- xreg))
    1082110854            (let* ((other (if u31x y x)))
     
    1084010873          (if (not constant)
    1084110874            (with-imm-target () (xreg :natural)
    10842               (with-additional-imm-reg ()
     10875              (target-arch-case
     10876               (:x8664
    1084310877                (with-imm-target (xreg) (yreg :natural)
    1084410878                  (x862-two-targeted-reg-forms seg x xreg y yreg)
    1084510879                  (! %natural-logxor xreg yreg)))
     10880               (:x8632
     10881                (let* ((*x862-nfp-depth* *x862-nfp-depth*)
     10882                       (offset *x862-nfp-depth*))
     10883                  (x862-one-targeted-reg-form seg x xreg)
     10884                  (x862-push-register seg xreg)
     10885                  (x862-one-targeted-reg-form seg y xreg)
     10886                  (! nfp-logxor-natural-register offset xreg))))
    1084610887              (<- xreg))
    1084710888            (let* ((other (if u32x y x)))
     
    1086610907          (if (not constant)
    1086710908            (with-imm-target () (xreg :natural)
    10868               (with-additional-imm-reg ()
     10909              (target-arch-case
     10910               (:x8664
    1086910911                (with-imm-target (xreg) (yreg :natural)
    1087010912                  (x862-two-targeted-reg-forms seg x xreg y yreg)
    1087110913                  (! %natural-logand xreg yreg)))
     10914               (:x8632
     10915                (let* ((*x862-nfp-depth* *x862-nfp-depth*)
     10916                       (offset *x862-nfp-depth*))
     10917                  (x862-one-targeted-reg-form seg x xreg)
     10918                  (x862-push-register seg xreg)
     10919                  (x862-one-targeted-reg-form seg y xreg)
     10920                  (! nfp-logand-natural-register offset xreg))))
    1087210921              (<- xreg))
    1087310922            (let* ((other (if u31x y x)))
  • release/1.10/source/compiler/acode-rewrite.lisp

    r16174 r16192  
    7171(defun rewrite-acode-form (form &optional (type t))
    7272  (when (acode-p form)
    73     (let* ((op (acode-operator form))
    74            (rewrite (svref *acode-rewrite-functions* (logand op operator-id-mask))))
    75       (if rewrite
    76         (funcall rewrite form type)
    77         (if (logbitp operator-acode-subforms-bit op)
    78           (dolist (operand (acode-operands form))
    79             (rewrite-acode-form operand))
    80           (format t "~&can't rewrite ~s : ~s" (acode-operator-name op) form))))))
     73    (unless (acode-walked form)
     74      (setf (acode-walked form) t)
     75      (let* ((op (acode-operator form))
     76             (rewrite (svref *acode-rewrite-functions* (logand op operator-id-mask))))
     77        (if rewrite
     78          (funcall rewrite form type)
     79          (if (logbitp operator-acode-subforms-bit op)
     80            (dolist (operand (acode-operands form))
     81              (rewrite-acode-form operand))
     82            (format t "~&can't rewrite ~s : ~s" (acode-operator-name op) form)))))))
    8183
    8284(defun acode-wrap-in-unary-op (form op)
     
    171173             (if c2
    172174               (setf (acode-operator form2) (%nx1-operator immediate)
     175                     (acode.asserted-type form2) nil
    173176                     (acode-operands form2) (cons (float c2 0.0d0) nil))
    174177               (if (acode-form-typep form2 'fixnum trust-decls)
     
    178181           (if c1
    179182               (setf (acode-operator form1) (%nx1-operator immediate)
     183                     (acode.asserted-type form1) nil
    180184                     (acode-operands form1) (cons (float c1 0.0d0) nil))
    181185             (if (acode-form-typep form1 'fixnum trust-decls)
     
    186190             (if c2
    187191               (setf (acode-operator form2) (%nx1-operator immediate)
     192                     (acode.asserted-type form2) nil
    188193                     (acode-operands form2) (cons (float c2 0.0f0) nil))
    189194               (if (acode-form-typep form2 'fixnum trust-decls)
     
    193198             (if c1
    194199               (setf (acode-operator form1) (%nx1-operator immediate)
     200                     (acode.asserted-type form1) nil
    195201                     (acode-operands form1) (cons (float c1 0.0f0) nil))
    196202               (if (acode-form-typep form1 'fixnum trust-decls)
  • release/1.10/source/compiler/nx-basic.lisp

    r16085 r16192  
    6868;;; a plist someday.
    6969(defun acode-note (acode)
    70   (acode.info acode))
     70  (when (acode-p acode)
     71    (cdr (acode.info acode))))
    7172
    7273(defun (setf acode-note) (note acode)
    73   (when note
     74  (when (and note (acode-p acode))
    7475    ;; Only record if have a unique key
    7576    (unless (or (nx-null acode)
    7677                (nx-t acode))
    77       (setf (acode.info acode) note))))
     78      (setf (cdr (acode.info acode)) note))))
     79
     80(defun acode-walked (acode)
     81  (car (acode.info acode)))
     82
     83(defun (setf acode-walked) (val acode)
     84  (setf (car (acode.info acode)) val))
    7885
    7986
  • release/1.10/source/compiler/nxenv.lisp

    r16085 r16192  
    3232  acode.operands                        ; list, elements often acode
    3333  acode.asserted-type                   ; NIL or type specifier.
    34   acode.info                            ; plist: notes, etc
     34  acode.info                            ; cons of "walked" marker, notr
    3535  )
    3636 
     
    485485
    486486(defmacro make-acode* (operator operands)
    487   `(%istruct 'acode ,operator ,operands nil nil))
     487  `(%istruct 'acode ,operator ,operands nil (cons nil nil)))
    488488
    489489(defmacro make-acode (operator &rest args)
Note: See TracChangeset for help on using the changeset viewer.