Changeset 5346
- Timestamp:
- Oct 14, 2006, 5:27:23 AM (18 years ago)
- File:
-
- 1 edited
-
trunk/ccl/compiler/X86/x862.lisp (modified) (26 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ccl/compiler/X86/x862.lisp
r5263 r5346 3036 3036 (vreg dest) 3037 3037 (^ cr-bit true-p) 3038 (ensuring-node-target (target dest) 3039 (if (not true-p) 3040 (setq cr-bit (logxor 1 cr-bit))) 3041 (! cr-bit->boolean target cr-bit) 3038 (progn 3039 (ensuring-node-target (target dest) 3040 (if (not true-p) 3041 (setq cr-bit (logxor 1 cr-bit))) 3042 (! cr-bit->boolean target cr-bit)) 3042 3043 (^)))))) 3043 3044 … … 3132 3133 (progn 3133 3134 (ensuring-node-target (target dest) 3134 (! cr-bit->boolean target cr-bit) 3135 (^)))))3135 (! cr-bit->boolean target cr-bit)) 3136 (^)))) 3136 3137 (^)))) 3137 3138 … … 3145 3146 (vreg dest) 3146 3147 (^ cr-bit true-p) 3147 (ensuring-node-target (target dest) 3148 (if (not true-p) 3149 (setq cr-bit (logxor 1 cr-bit))) 3150 (! cr-bit->boolean target cr-bit) 3148 (progn 3149 (ensuring-node-target (target dest) 3150 (if (not true-p) 3151 (setq cr-bit (logxor 1 cr-bit))) 3152 (! cr-bit->boolean target cr-bit)) 3151 3153 (^)))) 3152 3154 (^)))) … … 3159 3161 (vreg dest) 3160 3162 (^ cr-bit true-p) 3163 (progn 3161 3164 (ensuring-node-target (target dest) 3162 3165 (if (not true-p) 3163 3166 (setq cr-bit (logxor 1 cr-bit))) 3164 (! cr-bit->boolean target cr-bit) 3165 3167 (! cr-bit->boolean target cr-bit)) 3168 (^)))))) 3166 3169 3167 3170 (defun x862-cr-bit-for-unsigned-comparison (cr-bit) … … 3232 3235 (vreg dest) 3233 3236 (^ cr-bit true-p) 3234 (ensuring-node-target (target dest) 3235 (if (not true-p) 3236 (setq cr-bit (logxor 1 cr-bit))) 3237 (! cr-bit->boolean target cr-bit) 3237 (progn 3238 (ensuring-node-target (target dest) 3239 (if (not true-p) 3240 (setq cr-bit (logxor 1 cr-bit))) 3241 (! cr-bit->boolean target cr-bit)) 3238 3242 (^))))) 3239 3243 … … 5499 5503 (with-node-temps (v) (temp) 5500 5504 (! %slot-ref temp v i) 5501 ( <-temp))))5505 (x862-copy-register seg target temp)))) 5502 5506 (^)) 5503 5507 … … 5540 5544 (vreg dest) 5541 5545 (^ cr-bit true-p) 5542 (ensuring-node-target (target dest) 5543 (if (not true-p) 5544 (setq cr-bit (logxor 1 cr-bit))) 5545 (! cr-bit->boolean target cr-bit) 5546 (progn 5547 (ensuring-node-target (target dest) 5548 (if (not true-p) 5549 (setq cr-bit (logxor 1 cr-bit))) 5550 (! cr-bit->boolean target cr-bit)) 5546 5551 (^))))))) 5547 5552 … … 5683 5688 (if (null vreg) 5684 5689 (x862-form seg vreg xfer n) 5685 (ensuring-node-target (target vreg) 5686 (x862-one-targeted-reg-form seg n target) 5687 (! negate-fixnum target) 5688 (x862-check-fixnum-overflow seg target) 5690 (progn 5691 (ensuring-node-target (target vreg) 5692 (x862-one-targeted-reg-form seg n target) 5693 (! negate-fixnum target) 5694 (x862-check-fixnum-overflow seg target)) 5689 5695 (^ )))) 5690 5696 … … 5692 5698 (if (null vreg) 5693 5699 (x862-form seg vreg xfer n) 5694 (ensuring-node-target (target vreg) 5695 (x862-one-targeted-reg-form seg n target) 5696 (when vreg 5697 (! negate-fixnum target)) 5700 (progn 5701 (ensuring-node-target (target vreg) 5702 (x862-one-targeted-reg-form seg n target) 5703 (when vreg 5704 (! negate-fixnum target))) 5698 5705 (^)))) 5699 5706 … … 5703 5710 (pushnew (%nx1-operator struct-ref) *x862-operator-supports-push*) 5704 5711 (defx862 x862-struct-ref struct-ref (seg vreg xfer struct offset) 5705 (x862-misc-node-ref seg vreg xfer struct offset ( nx-lookup-target-uvector-subtag :struct)))5712 (x862-misc-node-ref seg vreg xfer struct offset (unless *x862-reckless* (nx-lookup-target-uvector-subtag :struct)))) 5706 5713 5707 5714 (defx862 x862-struct-set struct-set (seg vreg xfer struct offset value) 5708 (x862-misc-node-set seg vreg xfer struct offset value ( nx-lookup-target-uvector-subtag :struct)))5715 (x862-misc-node-set seg vreg xfer struct offset value (unless *x862-reckless* (nx-lookup-target-uvector-subtag :struct)))) 5709 5716 5710 5717 (defx862 x862-istruct-typep istruct-typep (seg vreg xfer cc form type) … … 5715 5722 (vreg dest) 5716 5723 (^ cr-bit true-p) 5717 (ensuring-node-target (target dest) 5718 (if (not true-p) 5719 (setq cr-bit (logxor 1 cr-bit))) 5720 (! cr-bit->boolean target cr-bit) 5724 (progn 5725 (ensuring-node-target (target dest) 5726 (if (not true-p) 5727 (setq cr-bit (logxor 1 cr-bit))) 5728 (! cr-bit->boolean target cr-bit)) 5721 5729 (^)))))) 5722 5730 … … 5908 5916 (x862-compare seg vreg xfer form1 form2 cr-bit true-p))) 5909 5917 5910 5918 (defx862 x862-numcmp numcmp (seg vreg xfer cc form1 form2) 5919 (let* ((name (ecase (cadr cc) 5920 (:eq '=-2) 5921 (:ne '/=-2) 5922 (:lt '<-2) 5923 (:le '<=-2) 5924 (:gt '>-2) 5925 (:ge '>=-2)))) 5926 (if (or (x862-explicit-non-fixnum-type-p form1) 5927 (x862-explicit-non-fixnum-type-p form2)) 5928 (x862-binary-builtin seg vreg xfer name form1 form2) 5929 (x862-inline-numcmp seg vreg xfer cc name form1 form2)))) 5930 5931 (defun x862-inline-numcmp (seg vreg xfer cc name form1 form2) 5932 (with-x86-local-vinsn-macros (seg vreg xfer) 5933 (let* ((fix1 (acode-fixnum-form-p form1)) 5934 (fix2 (acode-fixnum-form-p form2)) 5935 (fixval (or fix1 fix2)) 5936 (fiximm (if fixval (<= (integer-length fixval) 5937 (- 31 *x862-target-fixnum-shift*)))) 5938 (otherform (when fiximm (if fix1 form2 form1))) 5939 (out-of-line (backend-get-next-label)) 5940 (done (backend-get-next-label))) 5941 (if otherform 5942 (x862-one-targeted-reg-form seg otherform ($ x8664::arg_y)) 5943 (x862-two-targeted-reg-forms seg form1 ($ x8664::arg_y) form2 ($ x8664::arg_z))) 5944 (if otherform 5945 (unless (acode-fixnum-form-p otherform) 5946 (! branch-unless-arg-fixnum ($ x8664::arg_y) (aref *backend-labels* out-of-line))) 5947 (if (acode-fixnum-form-p form1) 5948 (! branch-unless-arg-fixnum ($ x8664::arg_z) (aref *backend-labels* out-of-line)) 5949 (if (acode-fixnum-form-p form2) 5950 (! branch-unless-arg-fixnum ($ x8664::arg_y) (aref *backend-labels* out-of-line)) 5951 (! branch-unless-both-args-fixnums ($ x8664::arg_y) ($ x8664::arg_z) (aref *backend-labels* out-of-line))))) 5952 (if otherform 5953 (if (zerop fixval) 5954 (! compare-reg-to-zero ($ x8664::arg_y)) 5955 (! compare-s32-constant ($ x8664::arg_y) (ash fixval x8664::fixnumshift))) 5956 (! compare ($ x8664::arg_y) ($ x8664::arg_z))) 5957 (multiple-value-bind (cr-bit true-p) (acode-condition-to-x86-cr-bit cc) 5958 (when otherform 5959 (unless (or fix2 (eq cr-bit x86::x86-e-bits)) 5960 (setq cr-bit (x862-reverse-cr-bit cr-bit)))) 5961 (if (not true-p) 5962 (setq cr-bit (logxor 1 cr-bit))) 5963 (! cr-bit->boolean ($ x8664::arg_z) cr-bit) 5964 (-> done) 5965 (@ out-of-line) 5966 (when otherform 5967 (x862-lri seg ($ x8664::arg_z) (ash fixval x8664::fixnumshift)) 5968 (unless (or fix2 (eq cr-bit x86::x86-e-bits)) 5969 (! xchg-registers ($ x8664::arg_z) ($ x8664::arg_y)))) 5970 (let* ((index (arch::builtin-function-name-offset name)) 5971 (idx-subprim (x862-builtin-index-subprim index))) 5972 (! call-subprim-2 ($ x8664::arg_z) idx-subprim ($ x8664::arg_y) ($ x8664::arg_z))) 5973 (@ done) 5974 (<- ($ x8664::arg_z)) 5975 (^))))) 5976 5977 5978 5911 5979 5912 5980 (defx862 x862-%word-to-int %word-to-int (seg vreg xfer form) … … 6009 6077 (multiple-value-bind (rbit rform) (x862-two-untargeted-reg-forms seg bitnum x8664::arg_y form x8664::arg_z) 6010 6078 (! set-c-flag-if-variable-logbitp rbit rform))) 6011 (regspec-crf-gpr-case 6012 (vreg dest) 6013 (^ cr-bit true-p) 6014 (ensuring-node-target (target dest) 6015 (if (not true-p) 6016 (setq cr-bit (logxor 1 cr-bit))) 6017 (! cr-bit->boolean target cr-bit) 6018 (^))))))) 6079 (regspec-crf-gpr-case 6080 (vreg dest) 6081 (^ cr-bit true-p) 6082 (progn 6083 (ensuring-node-target (target dest) 6084 (if (not true-p) 6085 (setq cr-bit (logxor 1 cr-bit))) 6086 (! cr-bit->boolean target cr-bit)) 6087 (^))))))) 6019 6088 6020 6089 … … 6252 6321 (not (subtypep target-fixnum-type type))))) 6253 6322 6254 (defun x862-inline-add2 (seg vreg xfer form1 form2) 6255 (with-x86-local-vinsn-macros (seg vreg xfer) 6256 (x862-two-targeted-reg-forms seg form1 ($ x8664::arg_y) form2 ($ x8664::arg_z)) 6323 (defun x862-inline-sub2 (seg vreg xfer form1 form2) 6324 (let* ((v2 (acode-fixnum-form-p form2))) 6325 (if (and v2 (not (eql v2 most-negative-fixnum))) 6326 (x862-inline-add2 seg vreg xfer form1 (make-acode (%nx1-operator fixnum) (- v2))) 6327 (with-x86-local-vinsn-macros (seg vreg xfer) 6328 (x862-two-targeted-reg-forms seg form1 ($ x8664::arg_y) form2 ($ x8664::arg_z)) 6257 6329 (let* ((out-of-line (backend-get-next-label)) 6258 6330 (done (backend-get-next-label))) … … 6263 6335 (! branch-unless-arg-fixnum ($ x8664::arg_y) (aref *backend-labels* out-of-line)) 6264 6336 (! branch-unless-both-args-fixnums ($ x8664::arg_y) ($ x8664::arg_z) (aref *backend-labels* out-of-line)))) 6265 (! fixnum- add2 ($ x8664::arg_z) ($ x8664::arg_y))6337 (! fixnum-sub2 ($ x8664::arg_z) ($ x8664::arg_y) ($ x8664::arg_z)) 6266 6338 (x862-check-fixnum-overflow seg ($ x8664::arg_z) done) 6267 6339 (@ out-of-line) 6268 (! call-subprim-2 ($ x8664::arg_z) (subprim-name->offset '.SPbuiltin- plus) ($ x8664::arg_y) ($ x8664::arg_z))6340 (! call-subprim-2 ($ x8664::arg_z) (subprim-name->offset '.SPbuiltin-minus) ($ x8664::arg_y) ($ x8664::arg_z)) 6269 6341 (@ done) 6270 (x862-copy-register seg target ($ x8664::arg_z)) 6342 (x862-copy-register seg target ($ x8664::arg_z))) 6343 (^)))))) 6344 6345 (defun x862-inline-add2 (seg vreg xfer form1 form2) 6346 (with-x86-local-vinsn-macros (seg vreg xfer) 6347 (let* ((fix1 (acode-fixnum-form-p form1)) 6348 (fix2 (acode-fixnum-form-p form2)) 6349 (otherform (if (and fix1 6350 (typep (ash fix1 *x862-target-fixnum-shift*) 6351 '(signed-byte 32))) 6352 form2 6353 (if (and fix2 6354 (typep (ash fix2 *x862-target-fixnum-shift*) 6355 '(signed-byte 32))) 6356 form1)))) 6357 (if otherform 6358 (x862-one-targeted-reg-form seg otherform ($ x8664::arg_z)) 6359 (x862-two-targeted-reg-forms seg form1 ($ x8664::arg_y) form2 ($ x8664::arg_z))) 6360 (let* ((out-of-line (backend-get-next-label)) 6361 (done (backend-get-next-label))) 6362 6363 (ensuring-node-target (target vreg) 6364 (if otherform 6365 (unless (acode-fixnum-form-p otherform) 6366 (! branch-unless-arg-fixnum ($ x8664::arg_z) (aref *backend-labels* out-of-line))) 6367 (if (acode-fixnum-form-p form1) 6368 (! branch-unless-arg-fixnum ($ x8664::arg_z) (aref *backend-labels* out-of-line)) 6369 (if (acode-fixnum-form-p form2) 6370 (! branch-unless-arg-fixnum ($ x8664::arg_y) (aref *backend-labels* out-of-line)) 6371 (! branch-unless-both-args-fixnums ($ x8664::arg_y) ($ x8664::arg_z) (aref *backend-labels* out-of-line))))) 6372 (if otherform 6373 (! add-constant ($ x8664::arg_z) (ash (or fix1 fix2) *x862-target-fixnum-shift*)) 6374 (! fixnum-add2 ($ x8664::arg_z) ($ x8664::arg_y))) 6375 (x862-check-fixnum-overflow seg ($ x8664::arg_z) done) 6376 (@ out-of-line) 6377 (if otherform 6378 (x862-lri seg ($ x8664::arg_y) (ash (or fix1 fix2) *x862-target-fixnum-shift*))) 6379 (! call-subprim-2 ($ x8664::arg_z) (subprim-name->offset '.SPbuiltin-plus) ($ x8664::arg_y) ($ x8664::arg_z)) 6380 (@ done) 6381 (x862-copy-register seg target ($ x8664::arg_z))) 6271 6382 (^))))) 6272 6383 … … 6332 6443 form2 6333 6444 t) 6334 (x862-binary-builtin seg vreg xfer '--2 form1 form2)))))) 6445 (if (or (x862-explicit-non-fixnum-type-p form1) 6446 (x862-explicit-non-fixnum-type-p form2)) 6447 (x862-binary-builtin seg vreg xfer '--2 form1 form2) 6448 (x862-inline-sub2 seg vreg xfer form1 form2))))))) 6335 6449 6336 6450 (defx862 x862-mul2 mul2 (seg vreg xfer form1 form2) … … 6412 6526 (! call-subprim-2 ($ x8664::arg_z) (subprim-name->offset '.SPbuiltin-logior) ($ x8664::arg_y) ($ x8664::arg_z)) 6413 6527 (@ done) 6414 (x862-copy-register seg target ($ x8664::arg_z)) 6415 (^))))))))6528 (x862-copy-register seg target ($ x8664::arg_z))) 6529 (^))))))) 6416 6530 6417 6531 (defx862 x862-logior2 logior2 (seg vreg xfer form1 form2) … … 6457 6571 (! call-subprim-2 ($ x8664::arg_z) (subprim-name->offset '.SPbuiltin-logand) ($ x8664::arg_y) ($ x8664::arg_z)) 6458 6572 (@ done) 6459 (x862-copy-register seg target ($ x8664::arg_z)) 6460 (^))))))))6573 (x862-copy-register seg target ($ x8664::arg_z))) 6574 (^))))))) 6461 6575 6462 6576 (defx862 x862-logand2 logand2 (seg vreg xfer form1 form2) … … 6510 6624 (if (and fix2 6511 6625 (typep (ash fix2 *x862-target-fixnum-shift*) 6512 6626 '(signed-byte 32))) 6513 6627 form1)))) 6514 6628 (if (and fix1 fix2) … … 6519 6633 (x862-form seg vreg nil other) 6520 6634 (if overflow 6521 (ensuring-node-target (target vreg) 6522 (x862-one-targeted-reg-form seg other target) 6523 (unless (zerop constant) 6635 (ensuring-node-target (target vreg) 6636 (x862-one-targeted-reg-form seg other target) 6524 6637 (! add-constant target constant) 6525 (x862-check-fixnum-overflow seg target)) )6526 (ensuring-node-target (target vreg)6527 (let* ((reg (x862-one-untargeted-reg-form seg other target)))6528 (! add-constant3 target reg constant))))))6638 (x862-check-fixnum-overflow seg target)) 6639 (ensuring-node-target (target vreg) 6640 (let* ((reg (x862-one-untargeted-reg-form seg other target))) 6641 (! add-constant3 target reg constant)))))) 6529 6642 (if (not overflow) 6530 6643 (multiple-value-bind (r1 r2) (x862-two-untargeted-reg-forms seg form1 x8664::arg_y form2 x8664::arg_z) … … 6811 6924 (<- result) 6812 6925 (ensuring-node-target (target vreg) 6813 ( <-result)))))6926 (x862-copy-register seg target result))))) 6814 6927 (^))))))) 6815 6928 … … 6835 6948 (<- result) 6836 6949 (ensuring-node-target (target vreg) 6837 ( <-result)))))6950 (x862-copy-register seg target result))))) 6838 6951 (^))))))) 6839 6952 ) … … 7582 7695 (ensuring-node-target (target vreg) 7583 7696 (x862-lri seg target (target-arch-case 7584 7585 7697 (:x8664 x8664::slot-unbound-marker))))) 7586 7698 (^)) … … 7590 7702 (ensuring-node-target (target vreg) 7591 7703 (x862-lri seg target (target-arch-case 7592 7593 7704 (:x8664 x8664::illegal-marker))))) 7594 7705 (^)) … … 7935 8046 (ensuring-node-target (target vreg) 7936 8047 (! makeu64) 7937 ( <-($ x8664::arg_z))))8048 (x862-copy-register seg target ($ x8664::arg_z)))) 7938 8049 ((eq resultspec :signed-doubleword) 7939 8050 (ensuring-node-target (target vreg) 7940 8051 (! makes64) 7941 ( <-($ x8664::arg_z))))8052 (x862-copy-register seg target ($ x8664::arg_z)))) 7942 8053 (t 7943 8054 (case resultspec … … 8137 8248 (let* ((reg (if (eq (hard-regspec-value target) x8664::arg_z) ($ x8664::arg_y) ($ x8664::arg_z)))) 8138 8249 (x862-one-targeted-reg-form seg arg reg) 8139 (! eep.address target reg)) 8140 (^)))8250 (! eep.address target reg))) 8251 (^)) 8141 8252 8142 8253 (defx862 x862-%natural+ %natural+ (seg vreg xfer x y)
Note:
See TracChangeset
for help on using the changeset viewer.
