Changeset 7216
- Timestamp:
- Sep 14, 2007, 9:42:29 PM (13 years ago)
- File:
-
- 1 edited
-
branches/ia32/compiler/X86/x862.lisp (modified) (45 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/ia32/compiler/X86/x862.lisp
r7215 r7216 178 178 (defvar *x862-arg-z* nil) 179 179 (defvar *x862-arg-y* nil) 180 (defvar *x862-imm0* nil) 180 181 (defvar *x862-temp0* nil) 181 182 (defvar *x862-fname* nil) … … 298 299 (x862-copy-register seg ea valreg)) 299 300 ((addrspec-vcell-p ea) ; closed-over vcell 300 (x862-copy-register seg x8664::arg_zvalreg)301 (x862-copy-register seg *x862-arg-z* valreg) 301 302 (x862-stack-to-register seg ea x8664::arg_x) 302 303 (x862-lri seg *x862-arg-y* 0) 303 (! call-subprim-3 x8664::arg_z (subprim-name->offset '.SPgvset) x8664::arg_x *x862-arg-y* x8664::arg_z))304 (! call-subprim-3 *x862-arg-z* (subprim-name->offset '.SPgvset) x8664::arg_x *x862-arg-y* *x862-arg-z*)) 304 305 ((memory-spec-p ea) ; vstack slot 305 306 (x862-register-to-stack seg valreg ea)) … … 318 319 (the fixnum (nx-var-bits var)))) 319 320 (let* ((ea (var-ea var)) 320 (arg ($ x8664::arg_z))321 (result ($ x8664::arg_z)))321 (arg ($ *x862-arg-z*)) 322 (result ($ *x862-arg-z*))) 322 323 (x862-do-lexical-reference seg arg ea) 323 324 (x862-set-nargs seg 1) … … 455 456 (*x862-vstack* 0) 456 457 (*x862-cstack* 0) 458 (*x86-lap-entry-offset* (target-arch-case 459 (:x8632 x8632::fulltag-misc) 460 (:x8664 x8664::fulltag-function))) 457 461 (*x862-result-reg* (target-arch-case 458 462 (:x8632 x8632::arg_z) 459 463 (:x8664 x8664::arg_z))) 464 (*x862-imm0* (target-arch-case (:x8632 x8632::imm0) 465 (:x8664 x8664::imm0))) 460 466 (*x862-arg-z* (target-arch-case (:x8632 x8632::arg_z) 461 467 (:x8664 x8664::arg_z))) … … 572 578 debug-info) 573 579 (make-x86-lap-label end-code-tag) 574 ;; xxx conditionalize for 32 bit here575 580 (target-arch-case 576 581 (:x8664 … … 582 587 (:x8632 583 588 (make-x86-lap-label srt-tag) 584 ;; room for imm word count 585 (x86-lap-directive frag-list :short 0))) 589 ;; count of 32-bit words between header and 590 ;; function boundary marker, inclusive. 591 (x86-lap-directive frag-list :short `(ash (+ (:^ ,end-code-tag) 592 *x86-lap-entry-offset*) -2)))) 586 593 (x862-expand-vinsns vinsns frag-list instruction) 587 594 (when (or *x862-double-float-constant-alist* … … 617 624 618 625 (emit-x86-lap-label frag-list end-code-tag) 619 626 620 627 (dolist (c (reverse *x862-constant-alist*)) 621 628 (let* ((vinsn-label (cdr c))) … … 675 682 (:x8632 676 683 (let* ((label (find srt-tag *x86-lap-labels* :test #'eq :key #'x86-lap-label-name)) 677 (start-frag (dll-header-first frag-list))678 (nbytes (frag-list-length frag-list))679 (nwords (ash nbytes (- x8632::word-shift)))680 684 (srt-frag (x86-lap-label-frag label)) 681 685 (srt-index (x86-lap-label-offset label))) … … 686 690 (setf (frag-ref-32 srt-frag srt-index) 687 691 (+ (frag-address frag) (reloc-pos reloc))) 688 (incf srt-index 4)))) 689 ;; count of 32-bit immediate elements 690 (setf (frag-ref start-frag 0) (logand #xff nwords) 691 (frag-ref start-frag 1) (logand #xff00 nwords))) 692 (incf srt-index 4))))) 692 693 (show-frag-bytes frag-list))) 693 694 694 695 (x862-lap-process-regsave-info frag-list regsave-label regsave-mask regsave-addr) 695 696 (setf (afunc-lfun afunc) … … 1283 1284 (if (eq vreg :push) 1284 1285 (progn 1285 (! vpush-fixnum x8664::nil-value) 1286 (! vpush-fixnum (target-arch-case 1287 (:x8632 x8632::nil-value) 1288 (:x8664 x8664::nil-value))) 1286 1289 (^)) 1287 1290 (progn … … 1295 1298 (if (eq vreg :push) 1296 1299 (progn 1297 (! vpush-fixnum x8664::t-value) 1300 (! vpush-fixnum (target-arch-case 1301 (:x8632 x8632::t-value) 1302 (:x8664 x8664::t-value))) 1298 1303 (^)) 1299 1304 (progn … … 1383 1388 (with-x86-local-vinsn-macros (seg) 1384 1389 (if (typep form 'character) 1385 (! vpush-fixnum (logior (ash (char-code form) 8) x8664::subtag-character)) 1390 (! vpush-fixnum (logior (ash (char-code form) 8) 1391 (arch::target-subtag-char (backend-target-arch *target-backend*)))) 1386 1392 (let* ((reg (x862-register-constant-p form))) 1387 1393 (if reg … … 1480 1486 (! box-fixnum node-dest s32-src) 1481 1487 (let* ((arg_z ($ *x862-arg-z*)) 1482 (imm0 ($ x8664::imm0:mode :s32)))1488 (imm0 ($ *x862-imm0* :mode :s32))) 1483 1489 (x862-copy-register seg imm0 s32-src) 1484 1490 (! call-subprim (subprim-name->offset '.SPmakes32)) … … 1496 1502 (! set-bigits-after-fixnum-overflow node-dest) 1497 1503 (@ no-overflow)) 1498 (let* ((arg_z ($ x8664::arg_z))1499 (imm0 (make-wired-lreg x8664::imm0:mode (get-regspec-mode s64-src))))1504 (let* ((arg_z ($ *x862-arg-z*)) 1505 (imm0 (make-wired-lreg *x862-imm0* :mode (get-regspec-mode s64-src)))) 1500 1506 (x862-copy-register seg imm0 s64-src) 1501 1507 (! call-subprim (subprim-name->offset '.SPmakes64)) … … 1509 1515 (! box-fixnum node-dest u32-src) 1510 1516 (let* ((arg_z ($ *x862-arg-z*)) 1511 (imm0 ($ x8664::imm0:mode :u32)))1517 (imm0 ($ *x862-imm0* :mode :u32))) 1512 1518 (x862-copy-register seg imm0 u32-src) 1513 1519 (! call-subprim (subprim-name->offset '.SPmakeu32)) … … 1527 1533 (@ no-overflow)) 1528 1534 (let* ((arg_z ($ *x862-arg-z*)) 1529 (imm0 ($ x8664::imm0:mode :u64)))1535 (imm0 ($ *x862-imm0* :mode :u64))) 1530 1536 (x862-copy-register seg imm0 u64-src) 1531 1537 (! call-subprim (subprim-name->offset '.SPmakeu64)) … … 2739 2745 (progn 2740 2746 (x862-lri seg 2741 x8664::imm02747 *x862-imm0* 2742 2748 (arch::make-vheader vsize (nx-lookup-target-uvector-subtag :function))) 2743 2749 (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ vsize 2) 1) (arch::target-word-shift arch)) (target-arch-case (:x8664 x8664::fulltag-misc)))) … … 2885 2891 immreg) 2886 2892 (progn 2887 (x862-one-targeted-reg-form seg form (make-wired-lreg x8664::imm0:mode modeval))))))))2893 (x862-one-targeted-reg-form seg form (make-wired-lreg *x862-imm0* :mode modeval)))))))) 2888 2894 2889 2895 … … 2980 2986 (if (= mode hard-reg-class-gpr-mode-node) 2981 2987 ($ *x862-arg-z*) 2982 (make-wired-lreg x8664::imm0:mode mode)))2988 (make-wired-lreg *x862-imm0* :mode mode))) 2983 2989 (t (error "Unknown register class for reg ~s" reg)))))) 2984 2990 … … 4197 4203 (progn 4198 4204 (if intval 4199 (x862-lri seg x8664::imm0intval)4200 (! deref-macptr x8664::imm0*x862-arg-z*))4201 (values x8664::imm0*x862-arg-z*)))4202 (values (x862-macptr-arg-to-reg seg val ($ x8664::imm0:mode :address)) nil))))4205 (x862-lri seg *x862-imm0* intval) 4206 (! deref-macptr *x862-imm0* *x862-arg-z*)) 4207 (values *x862-imm0* *x862-arg-z*))) 4208 (values (x862-macptr-arg-to-reg seg val ($ *x862-imm0* :mode :address)) nil)))) 4203 4209 (unless (typep offval '(signed-byte 32)) 4204 4210 (setq offval nil)) … … 4276 4282 (! gets64) 4277 4283 (! getu64)) 4278 (! fixnum->signed-natural x8664::imm0*x862-arg-z*))))4284 (! fixnum->signed-natural *x862-imm0* *x862-arg-z*)))) 4279 4285 4280 4286 (and offval (%i> (integer-length offval) 31) (setq offval nil)) … … 4316 4322 (x862-one-untargeted-reg-form seg ptr ptr-reg))) 4317 4323 (val-to-argz-and-imm0) 4318 (with-imm-target ( x8664::imm0) (ptr-reg :address)4324 (with-imm-target (*x862-imm0*) (ptr-reg :address) 4319 4325 (x862-pop-register seg ptr-reg) 4320 4326 (case size 4321 (8 (! mem-set-c-doubleword x8664::imm0ptr-reg offval))4322 (4 (! mem-set-c-fullword x8664::imm0ptr-reg offval))4323 (2 (! mem-set-c-halfword x8664::imm0ptr-reg offval))4324 (1 (! mem-set-c-byte x8664::imm0ptr-reg offval))))4327 (8 (! mem-set-c-doubleword *x862-imm0* ptr-reg offval)) 4328 (4 (! mem-set-c-fullword *x862-imm0* ptr-reg offval)) 4329 (2 (! mem-set-c-halfword *x862-imm0* ptr-reg offval)) 4330 (1 (! mem-set-c-byte *x862-imm0* ptr-reg offval)))) 4325 4331 (if for-value 4326 4332 (<- *x862-arg-z*))) … … 4333 4339 (x862-push-register seg ptr-reg))) 4334 4340 (val-to-argz-and-imm0) 4335 (with-imm-target ( x8664::imm0) (ptr-reg :address)4341 (with-imm-target (*x862-imm0*) (ptr-reg :address) 4336 4342 (x862-pop-register seg ptr-reg) 4337 4343 (case size 4338 (8 (! mem-set-c-doubleword x8664::imm0ptr-reg 0))4339 (4 (! mem-set-c-fullword x8664::imm0ptr-reg 0))4340 (2 (! mem-set-c-halfword x8664::imm0ptr-reg 0))4341 (1 (! mem-set-c-byte x8664::imm0ptr-reg 0))))4344 (8 (! mem-set-c-doubleword *x862-imm0* ptr-reg 0)) 4345 (4 (! mem-set-c-fullword *x862-imm0* ptr-reg 0)) 4346 (2 (! mem-set-c-halfword *x862-imm0* ptr-reg 0)) 4347 (1 (! mem-set-c-byte *x862-imm0* ptr-reg 0)))) 4342 4348 (if for-value 4343 4349 (< *x862-arg-z*)))) … … 4519 4525 (cond ((or *x862-open-code-inline* (> nntriv 3)) 4520 4526 (x862-formlist seg initforms nil) 4521 (x862-lri seg x8664::imm0header)4527 (x862-lri seg *x862-imm0* header) 4522 4528 (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) (target-arch-case (:x8664 x8664::fulltag-misc)))) 4523 4529 (! %allocate-uvector vreg) … … 4534 4540 (push nil pending) 4535 4541 (x862-vpush-register seg (x862-one-untargeted-reg-form seg form *x862-arg-z*))))) 4536 (x862-lri seg x8664::imm0header)4542 (x862-lri seg *x862-imm0* header) 4537 4543 (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) (target-arch-case (:x8664 x8664::fulltag-misc)))) 4538 4544 (ensuring-node-target (target vreg) … … 4766 4772 (dotimes (i numundo) (x862-close-undo))) 4767 4773 (progn 4768 ;; There are some cases where storing thru x8664::arg_z4774 ;; There are some cases where storing thru *x862-arg-z* 4769 4775 ;; can be avoided (stores to vlocs, specials, etc.) and 4770 4776 ;; some other case where it can't ($test, $vpush.) The … … 5017 5023 (let* ((tag-label (backend-get-next-label)) 5018 5024 (tag-label-value (aref *backend-labels* tag-label))) 5019 (x862-lri seg x8664::imm0(ash numnthrow *x862-target-fixnum-shift*))5025 (x862-lri seg *x862-imm0* (ash numnthrow *x862-target-fixnum-shift*)) 5020 5026 (if retval 5021 5027 (! nthrowvalues tag-label-value) … … 5057 5063 (if retval 5058 5064 (progn 5059 (x862-lri seg x8664::imm0vdiff)5065 (x862-lri seg *x862-imm0* vdiff) 5060 5066 (! slide-values)) 5061 5067 (! adjust-vsp vdiff))))) … … 5493 5499 (if idx-subprim 5494 5500 (setq subprim idx-subprim) 5495 (if index (! lri ($ x8664::imm0) (ash index *x862-target-fixnum-shift*))))5501 (if index (! lri ($ *x862-imm0*) (ash index *x862-target-fixnum-shift*)))) 5496 5502 (if tail-p 5497 5503 (! jump-subprim subprim) … … 5620 5626 (x862-lri seg x8664::temp1 (ash flags *x862-target-fixnum-shift*)) 5621 5627 (unless (= nprev 0) 5622 (x862-lri seg x8664::imm0(ash nprev *x862-target-fixnum-shift*)))5628 (x862-lri seg *x862-imm0* (ash nprev *x862-target-fixnum-shift*))) 5623 5629 (x86-immediate-label keyvect) 5624 5630 (if (= 0 nprev) … … 5641 5647 (declare (fixnum nprev)) 5642 5648 (unless simple 5643 (x862-lri seg x8664::imm0(ash nprev *x862-target-fixnum-shift*)))5649 (x862-lri seg *x862-imm0* (ash nprev *x862-target-fixnum-shift*))) 5644 5650 (if stack-consed-rest 5645 5651 (if simple … … 5657 5663 (when hardopt 5658 5664 (x862-reserve-vstack-lcells num-opt) 5659 (x862-lri seg x8664::imm0(ash num-opt *x862-target-fixnum-shift*))5665 (x862-lri seg *x862-imm0* (ash num-opt *x862-target-fixnum-shift*)) 5660 5666 5661 5667 ;; ! opt-supplied-p wants nargs to contain the … … 5708 5714 (do* ((vars arg-regs (cdr vars)) 5709 5715 (arg-reg-numbers (target-arch-case 5710 (:x8664 (list x8664::arg_z*x862-arg-y* x8664::arg_x))))5716 (:x8664 (list *x862-arg-z* *x862-arg-y* x8664::arg_x)))) 5711 5717 (arg-reg-num (pop arg-reg-numbers) (pop arg-reg-numbers))) 5712 5718 ((null vars)) … … 5844 5850 (if (null vreg) 5845 5851 (x862-form seg vreg xfer form) 5846 (let* ((tagreg x8664::imm0))5852 (let* ((tagreg *x862-imm0*)) 5847 5853 (multiple-value-bind (cr-bit true-p) (acode-condition-to-x86-cr-bit cc) 5848 5854 (! extract-fulltag tagreg (x862-one-untargeted-reg-form seg form *x862-arg-z*)) … … 6134 6140 (x862-form seg nil xfer form2)) 6135 6141 (let* ((const (acode-fixnum-form-p form1)) 6136 (max (target-arch-case (:x8664 63))))6142 (max (target-arch-case (:x8632 31) (:x8664 63)))) 6137 6143 (ensuring-node-target (target vreg) 6138 6144 (if const … … 6260 6266 (if (zerop fixval) 6261 6267 (! compare-reg-to-zero ($ *x862-arg-y*)) 6262 (! compare-s32-constant ($ *x862-arg-y*) (ash fixval x8664::fixnumshift)))6268 (! compare-s32-constant ($ *x862-arg-y*) (ash fixval *x862-target-fixnum-shift*))) 6263 6269 (! compare ($ *x862-arg-y*) ($ *x862-arg-z*))) 6264 6270 (multiple-value-bind (cr-bit true-p) (acode-condition-to-x86-cr-bit cc) … … 6272 6278 (@ out-of-line) 6273 6279 (when otherform 6274 (x862-lri seg ($ *x862-arg-z*) (ash fixval x8664::fixnumshift))6280 (x862-lri seg ($ *x862-arg-z*) (ash fixval *x862-target-fixnum-shift*)) 6275 6281 (unless (or fix2 (eq cr-bit x86::x86-e-bits)) 6276 6282 (! xchg-registers ($ *x862-arg-z*) ($ *x862-arg-y*)))) … … 6461 6467 (x862-restore-full-lisp-context seg)) 6462 6468 (unless idx-subprim 6463 (! lri x8664::imm0(ash idx *x862-target-fixnum-shift*))6469 (! lri *x862-imm0* (ash idx *x862-target-fixnum-shift*)) 6464 6470 (when (eql subprim (subprim-name->offset '.SPcallbuiltin)) 6465 6471 (x862-set-nargs seg nargs))) … … 7080 7086 (with-x86-local-vinsn-macros (seg vreg xfer) 7081 7087 (multiple-value-bind (cr-bit true-p) (acode-condition-to-x86-cr-bit cc) 7082 (! mask-base-char x8664::imm0(x862-one-untargeted-reg-form seg form *x862-arg-z*))7083 (x862-test-reg-%izerop seg vreg xfer x8664::imm0cr-bit true-p7088 (! mask-base-char *x862-imm0* (x862-one-untargeted-reg-form seg form *x862-arg-z*)) 7089 (x862-test-reg-%izerop seg vreg xfer *x862-imm0* cr-bit true-p 7084 7090 (target-arch-case 7085 7091 … … 7180 7186 (+ nbytes *x862-target-node-size* 7181 7187 (1- *x862-target-dnode-size*))) #x8000)) 7182 (let* ((header x8664::imm0)7188 (let* ((header *x862-imm0*) 7183 7189 (physsize x8664::imm1)) 7184 7190 (x862-lri seg header (arch::make-vheader nelements subtag)) … … 7452 7458 (! mem-ref-c-absolute-natural dest absptr) 7453 7459 (if offval 7454 (let* ((src (x862-macptr-arg-to-reg seg ptr ($ x8664::imm0:mode :address))))7460 (let* ((src (x862-macptr-arg-to-reg seg ptr ($ *x862-imm0* :mode :address)))) 7455 7461 (! mem-ref-c-natural dest src offval)) 7456 (let* ((src (x862-macptr-arg-to-reg seg ptr ($ x8664::imm0:mode :address))))7462 (let* ((src (x862-macptr-arg-to-reg seg ptr ($ *x862-imm0* :mode :address)))) 7457 7463 (if triv-p 7458 7464 (with-imm-temps (src) (x) … … 7862 7868 (x862-one-targeted-reg-form seg form ($ *x862-arg-z*)) 7863 7869 (! integer-sign) 7864 (x862-test-reg-%izerop seg vreg xfer x8664::imm0cr-bit true-p 0)))7870 (x862-test-reg-%izerop seg vreg xfer *x862-imm0* cr-bit true-p 0))) 7865 7871 7866 7872 … … 7896 7902 (x862-multiple-value-body seg valform) 7897 7903 (x862-one-targeted-reg-form seg valform ($ *x862-arg-z*))) 7898 (x862-lri seg x8664::imm0(ash 1 *x862-target-fixnum-shift*))7904 (x862-lri seg *x862-imm0* (ash 1 *x862-target-fixnum-shift*)) 7899 7905 (if mv-pass 7900 7906 (! nthrowvalues tag-label-value) … … 8563 8569 (t 8564 8570 (case resultspec 8565 (:signed-byte (! sign-extend-s8 x8664::imm0 x8664::imm0))8566 (:signed-halfword (! sign-extend-s16 x8664::imm0 x8664::imm0))8567 (:signed-fullword (! sign-extend-s32 x8664::imm0 x8664::imm0))8568 (:unsigned-byte (! zero-extend-u8 x8664::imm0 x8664::imm0))8569 (:unsigned-halfword (! zero-extend-u16 x8664::imm0 x8664::imm0))8570 (:unsigned-fullword (! zero-extend-u32 x8664::imm0 x8664::imm0)))8571 (<- (make-wired-lreg x8664::imm08571 (:signed-byte (! sign-extend-s8 *x862-imm0* *x862-imm0*)) 8572 (:signed-halfword (! sign-extend-s16 *x862-imm0* *x862-imm0*)) 8573 (:signed-fullword (! sign-extend-s32 *x862-imm0* *x862-imm0*)) 8574 (:unsigned-byte (! zero-extend-u8 *x862-imm0* *x862-imm0*)) 8575 (:unsigned-halfword (! zero-extend-u16 *x862-imm0* *x862-imm0*)) 8576 (:unsigned-fullword (! zero-extend-u32 *x862-imm0* *x862-imm0*))) 8577 (<- (make-wired-lreg *x862-imm0* 8572 8578 :mode 8573 8579 (gpr-mode-name-value … … 8741 8747 (t 8742 8748 (case resultspec 8743 (:signed-byte (! sign-extend-s8 x8664::imm0 x8664::imm0))8744 (:signed-halfword (! sign-extend-s16 x8664::imm0 x8664::imm0))8745 (:signed-fullword (! sign-extend-s32 x8664::imm0 x8664::imm0))8746 (:unsigned-byte (! zero-extend-u8 x8664::imm0 x8664::imm0))8747 (:unsigned-halfword (! zero-extend-u16 x8664::imm0 x8664::imm0))8748 (:unsigned-fullword (! zero-extend-u32 x8664::imm0 x8664::imm0)))8749 (<- (make-wired-lreg x8664::imm08749 (:signed-byte (! sign-extend-s8 *x862-imm0* *x862-imm0*)) 8750 (:signed-halfword (! sign-extend-s16 *x862-imm0* *x862-imm0*)) 8751 (:signed-fullword (! sign-extend-s32 *x862-imm0* *x862-imm0*)) 8752 (:unsigned-byte (! zero-extend-u8 *x862-imm0* *x862-imm0*)) 8753 (:unsigned-halfword (! zero-extend-u16 *x862-imm0* *x862-imm0*)) 8754 (:unsigned-fullword (! zero-extend-u32 *x862-imm0* *x862-imm0*))) 8755 (<- (make-wired-lreg *x862-imm0* 8750 8756 :mode 8751 8757 (gpr-mode-name-value
Note: See TracChangeset
for help on using the changeset viewer.
