Changeset 14763
- Timestamp:
- Apr 30, 2011, 3:19:57 AM (14 years ago)
- File:
-
- 1 edited
-
trunk/source/compiler/ARM/arm2.lisp (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/compiler/ARM/arm2.lisp
r14739 r14763 2765 2765 ;;; The compiler often generates superfluous pushes & pops. Try to 2766 2766 ;;; eliminate them. 2767 ;;; It's easier to elide pushes and pops to the TSP.2767 ;;; It's easier to elide pushes and pops to the SP. 2768 2768 (defun arm2-elide-pushes (seg push-vinsn pop-vinsn) 2769 2769 (with-arm-local-vinsn-macros (seg) … … 2772 2772 (same-reg (eq (hard-regspec-value pushed-reg) 2773 2773 (hard-regspec-value popped-reg))) 2774 (sp-p (vinsn-attribute-p push-vinsn : sp)))2774 (sp-p (vinsn-attribute-p push-vinsn :csp))) 2775 2775 (when (and sp-p t) ; vsp case is harder. 2776 (unless (vinsn-sequence-has-attribute-p push-vinsn pop-vinsn : tsp :discard)2776 (unless (vinsn-sequence-has-attribute-p push-vinsn pop-vinsn :csp :discard) 2777 2777 (let* ((pushed-reg-is-set (vinsn-sequence-sets-reg-p 2778 2778 push-vinsn pop-vinsn pushed-reg)) … … 5495 5495 5496 5496 (defarm2 arm2-struct-ref struct-ref (seg vreg xfer struct offset) 5497 (arm2-vref seg vreg xfer :struct struct offset (unless *arm2-reckless* (nx-lookup-target-uvector-subtag :struct)))) 5497 ;; Assume that typechecking for a specific structure type has already 5498 ;; occurred, unless we're generating unsafe code. If we're not, we 5499 ;; still want to bounds-check, since the typecheck doesn't really 5500 ;; give us a whole lot of safety: we may be dealing with an instance 5501 ;; of a different version of the structure type than we expect. 5502 (arm2-vref seg vreg xfer :struct struct offset (unless *arm2-reckless* t))) 5498 5503 5499 5504 (defarm2 arm2-struct-set struct-set (seg vreg xfer struct offset value) … … 6155 6160 (arm2-unary-builtin seg vreg xfer '%negate form)) 6156 6161 6162 (defarm2 arm2-%double-float-negate %double-float-negate (seg vreg xfer form) 6163 (with-fp-target () (r1 :double-float) 6164 (setq r1 (arm2-one-untargeted-reg-form seg form r1)) 6165 (if (and vreg 6166 (= (hard-regspec-class vreg) hard-reg-class-fpr) 6167 (= (get-regspec-mode vreg) hard-reg-class-fpr-mode-double)) 6168 (! double-float-negate vreg r1) 6169 (with-fp-target (r1) (r2 :double-float) 6170 (! double-float-negate r2 r1) 6171 (ensuring-node-target (target vreg) 6172 (arm2-copy-register seg target r2)))) 6173 (^))) 6174 6175 6176 (defarm2 arm2-%single-float-negate %single-float-negate (seg vreg xfer form) 6177 (with-fp-target () (r1 :single-float) 6178 (setq r1 (arm2-one-untargeted-reg-form seg form r1)) 6179 (if (and vreg 6180 (= (hard-regspec-class vreg) hard-reg-class-fpr) 6181 (= (get-regspec-mode vreg) hard-reg-class-fpr-mode-single)) 6182 (! double-float-negate vreg r1) 6183 (with-fp-target (r1) (r2 :single-float) 6184 (! double-float-negate r2 r1) 6185 (ensuring-node-target (target vreg) 6186 (arm2-copy-register seg target r2)))) 6187 (^))) 6188 6157 6189 (defun arm2-inline-add2 (seg vreg xfer form1 form2) 6158 6190 (with-arm-local-vinsn-macros (seg vreg xfer) … … 6732 6764 (t 6733 6765 (let* ((fixoffset (acode-fixnum-form-p offset))) 6734 (if (and (typep fixoffset '(signed-byte 1 2))6735 ( eql (logcount fixoffset) 1))6766 (if (and (typep fixoffset '(signed-byte 10)) 6767 (not (logtest fixoffset #x3))) 6736 6768 (with-imm-target () (ptrreg :address) 6737 6769 (arm2-form seg ptrreg nil ptr) … … 6741 6773 (with-imm-target () (ptrreg :address) 6742 6774 (with-imm-target (ptrreg) (offsetreg :s32) 6743 (arm2-two-targeted-reg-forms seg 6744 ptr ptrreg 6745 offset ($ arm::arg_z)) 6746 (! fixnum->signed-natural offsetreg arm::arg_z) 6747 (if double-p 6748 (! mem-ref-double-float fp-reg ptrreg offsetreg) 6749 (! mem-ref-single-float fp-reg ptrreg offsetreg))))) 6775 (arm2-two-targeted-reg-forms seg 6776 ptr ptrreg 6777 offset offsetreg) 6778 (let* ((last (dll-node-pred seg))) 6779 (if (and (typep last 'vinsn) 6780 (eq (vinsn-template-name (vinsn-template last)) 'lri) 6781 (typep (setq fixoffset (svref (vinsn-variable-parts last) 1)) 6782 '(signed-byte 10)) 6783 (not (logtest fixoffset #x3))) 6784 (progn 6785 (remove-dll-node last) 6786 (if double-p 6787 (! mem-ref-c-double-float fp-reg ptrreg fixoffset) 6788 (! mem-ref-c-single-float fp-reg ptrreg fixoffset))) 6789 (progn 6790 (if double-p 6791 (! mem-ref-double-float fp-reg ptrreg offsetreg) 6792 (! mem-ref-single-float fp-reg ptrreg offsetreg)))))))) 6750 6793 (<- fp-reg)) 6751 6794 (^))))) … … 6753 6796 6754 6797 (defarm2 arm2-%get-double-float %get-double-float (seg vreg xfer ptr offset) 6755 (with-fp-target () (fp-reg :double-float) 6756 (arm2-get-float seg vreg xfer ptr offset t fp-reg))) 6798 (if (and vreg (= (hard-regspec-class vreg) hard-reg-class-fpr) 6799 (= (get-regspec-mode vreg) hard-reg-class-fpr-mode-double)) 6800 (arm2-get-float seg vreg xfer ptr offset t vreg) 6801 (with-fp-target () (fp-reg :double-float) 6802 (arm2-get-float seg vreg xfer ptr offset t fp-reg)))) 6757 6803 6758 6804 (defarm2 arm2-%get-single-float %get-single-float (seg vreg xfer ptr offset) … … 6763 6809 (with-arm-local-vinsn-macros (seg vreg xfer) 6764 6810 (let* ((fixoffset (acode-fixnum-form-p offset)) 6765 (immoffset (typep fixoffset '(unsigned-byte 15)))) 6811 (immoffset (and (typep fixoffset '(unsigned-byte 10)) 6812 (not (logtest fixoffset #x3))))) 6766 6813 (with-imm-target () (ptr-reg :address) 6767 6814 (cond ((or (null vreg) 6768 (= (hard-regspec-class vreg) hard-reg-class-fpr)) 6815 (and (= (hard-regspec-class vreg) hard-reg-class-fpr) 6816 (= (get-regspec-mode vreg) (if double-p hard-reg-class-fpr-mode-double hard-reg-class-fpr-mode-single)))) 6769 6817 (cond (immoffset 6770 6818 (arm2-push-register … … 8077 8125 (case spec 8078 8126 (:double-float 8079 ( let* ((df ($ arm::d0 :class :fpr :mode :double-float)))8127 (with-fp-target () (df :double-float) 8080 8128 (when (and natural-64-bit-alignment (oddp next-arg-word)) 8081 8129 (incf next-arg-word)) … … 8084 8132 (incf next-arg-word 2))) 8085 8133 (:single-float 8086 ( let* ((sf ($ arm::s0 :class :fpr :mode :single-float)))8134 (with-fp-target () (sf :single-float) 8087 8135 (arm2-one-targeted-reg-form seg valform sf) 8088 8136 (! set-single-eabi-c-arg sf next-arg-word) … … 8128 8176 (cond ((eq resultspec :void) (<- nil)) 8129 8177 ((eq resultspec :double-float) 8130 (! gpr-pair-to-double-float arm::d0 arm::imm0 arm::imm1) 8131 (<- ($ arm::d0 :class :fpr :mode :double-float))) 8178 (if (and (eq (hard-regspec-class vreg) hard-reg-class-fpr) 8179 (eq (get-regspec-mode vreg) hard-reg-class-fpr-mode-double)) 8180 (! gpr-pair-to-double-float vreg arm::imm0 arm::imm1) 8181 (progn 8182 (! gpr-pair-to-double-float arm::d0 arm::imm0 arm::imm1) 8183 (<- ($ arm::d0 :class :fpr :mode :double-float))))) 8132 8184 ((eq resultspec :single-float) 8133 (! gpr-to-single-float arm::s0 arm::imm0) 8134 (<- ($ arm::s0 :class :fpr :mode :single-float))) 8185 (if (and (eq (hard-regspec-class vreg) hard-reg-class-fpr) 8186 (eq (get-regspec-mode vreg) hard-reg-class-fpr-mode-single)) 8187 (! gpr-to-single-float vreg arm::imm0) 8188 (progn 8189 (! gpr-to-single-float arm::s0 arm::imm0) 8190 (<- ($ arm::s0 :class :fpr :mode :single-float))))) 8135 8191 ((eq resultspec :unsigned-doubleword) 8136 8192 (ensuring-node-target (target vreg)
Note:
See TracChangeset
for help on using the changeset viewer.
