- Timestamp:
- Oct 12, 2007, 11:21:28 AM (17 years ago)
- File:
-
- 1 edited
-
branches/ia32/compiler/X86/x862.lisp (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/ia32/compiler/X86/x862.lisp
r7340 r7429 695 695 (target-arch-case 696 696 (:x8632 697 (let* ((label (find srt-tag *x86-lap-labels* :test #'eq :key #'x86-lap-label-name))697 (let* ((label (find-x86-lap-label srt-tag)) 698 698 (srt-frag (x86-lap-label-frag label)) 699 699 (srt-index (x86-lap-label-offset label))) … … 713 713 (+ (frag-address frag) (reloc-pos reloc))) 714 714 (incf srt-index 4))))) 715 (show-frag-bytes frag-list))) 716 715 ;;(show-frag-bytes frag-list) 716 )) 717 717 718 (x862-lap-process-regsave-info frag-list regsave-label regsave-mask regsave-addr) 718 719 (setf (afunc-lfun afunc) … … 2301 2302 reg))))))) 2302 2303 2304 2305 ;;; xxx 2303 2306 (defun x862-vset1 (seg vreg xfer type-keyword src unscaled-idx index-known-fixnum val-reg unboxed-val-reg constval node-value-needs-memoization) 2304 2307 (with-x86-local-vinsn-macros (seg vreg xfer) … … 2312 2315 (is-signed (member type-keyword '(:signed-8-bit-vector :signed-16-bit-vector :signed-32-bit-vector :signed-64-bit-vector :fixnum-vector)))) 2313 2316 (cond ((and is-node node-value-needs-memoization) 2314 (unless (and (eql (hard-regspec-value src) x8664::arg_x) 2317 (unless (and (eql (hard-regspec-value src) (target-arch-case 2318 (:x8632 x8632::temp0) ;xxx ? 2319 (:x8664 x8664::arg_x))) 2315 2320 (eql (hard-regspec-value unscaled-idx) *x862-arg-y*) 2316 2321 (eql (hard-regspec-value val-reg) *x862-arg-z*)) … … 2434 2439 (needs-memoization (and is-node (x862-acode-needs-memoization value))) 2435 2440 (index-known-fixnum (acode-fixnum-form-p index))) 2436 (let* ((src ($ x8664::arg_x)) 2441 (let* ((src (target-arch-case 2442 (:x8632 ($ x8632::temp0)) ;xxx ? 2443 (:x8664 ($ x8664::arg_x)))) 2437 2444 (unscaled-idx ($ *x862-arg-y*)) 2438 2445 (result-reg ($ *x862-arg-z*))) … … 2798 2805 (x862-lri seg *x862-imm0* (- (ash (logandc2 (+ vsize 2) 1) (arch::target-word-shift arch)) x8632::fulltag-misc))) 2799 2806 (:x8664 2800 (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ vsize 2) 1) (arch::target-word-shift arch)) (target-arch-case (:x8664 x8664::fulltag-misc))))))2807 (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ vsize 2) 1) (arch::target-word-shift arch)) x8664::fulltag-misc)))) 2801 2808 (! %allocate-uvector dest))) 2802 2809 (! init-nclosure *x862-arg-z*) 2803 2810 (x862-store-immediate seg (x862-afunc-lfun-ref afunc) *x862-ra0*) 2804 (with-node-temps (*x862-arg-z*) (t0 t1 t2 t3) 2805 (do* ((func *x862-ra0* nil)) 2806 ((null inherited-vars)) 2807 (let* ((t0r (or func (if inherited-vars (var-to-reg (pop inherited-vars) t0)))) 2808 (t1r (if inherited-vars (var-to-reg (pop inherited-vars) t1))) 2809 (t2r (if inherited-vars (var-to-reg (pop inherited-vars) t2))) 2810 (t3r (if inherited-vars (var-to-reg (pop inherited-vars) t3)))) 2811 (setq cell (set-some-cells dest cell t0r t1r t2r t3r))))) 2812 (x862-lri seg *x862-arg-y* (ash (logior (ash 1 $lfbits-noname-bit) (ash 1 $lfbits-trampoline-bit)) *x862-target-fixnum-shift*)) 2811 (target-arch-case 2812 (:x8632 2813 (with-node-temps (*x862-arg-z*) (t0) 2814 (do* ((func *x862-ra0* nil)) 2815 ((null inherited-vars)) 2816 (let* ((t0r (or func (if inherited-vars 2817 (var-to-reg (pop inherited-vars) t0))))) 2818 (! misc-set-c-node t0r dest cell) 2819 (incf cell))))) 2820 (:x8664 2821 (with-node-temps (*x862-arg-z*) (t0 t1 t2 t3) 2822 (do* ((func *x862-ra0* nil)) 2823 ((null inherited-vars)) 2824 (let* ((t0r (or func (if inherited-vars (var-to-reg (pop inherited-vars) t0)))) 2825 (t1r (if inherited-vars (var-to-reg (pop inherited-vars) t1))) 2826 (t2r (if inherited-vars (var-to-reg (pop inherited-vars) t2))) 2827 (t3r (if inherited-vars (var-to-reg (pop inherited-vars) t3)))) 2828 (setq cell (set-some-cells dest cell t0r t1r t2r t3r))))))) 2829 (x862-lri seg *x862-arg-y* (ash (logior (ash -1 $lfbits-noname-bit) (ash 1 $lfbits-trampoline-bit)) *x862-target-fixnum-shift*)) 2813 2830 (! misc-set-c-node *x862-arg-y* dest cell)) 2814 2831 (! finalize-closure dest) … … 5825 5842 (when hardopt 5826 5843 (x862-reserve-vstack-lcells num-opt) 5827 (x862-lri seg *x862-imm0* (ash num-opt *x862-target-fixnum-shift*))5828 5844 5829 5845 ;; ! opt-supplied-p wants nargs to contain the … … 5837 5853 ((= 2 num-opt) 5838 5854 (! two-opt-supplied-p)) 5839 (t (! opt-supplied-p)))) 5855 (t 5856 (target-arch-case 5857 (:x8664 (x862-lri seg *x862-imm0* 5858 (ash num-opt *x862-target-fixnum-shift*))) 5859 (:x8632 (x862-lri seg *x862-arg-z* 5860 (ash num-opt *x862-target-fixnum-shift*)))) 5861 (! opt-supplied-p)))) 5840 5862 (let* ((nwords-vpushed (+ num-fixed 5841 5863 num-opt … … 7011 7033 (! branch-unless-both-args-fixnums ($ *x862-arg-y*) ($ *x862-arg-z*) (aref *backend-labels* out-of-line))))) 7012 7034 (if otherform 7013 (! %logior-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval x8664::fixnumshift))7035 (! %logior-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval *x862-target-fixnum-shift*)) 7014 7036 (! %logior2 ($ *x862-arg-z*) ($ *x862-arg-z*) ($ *x862-arg-y*))) 7015 7037 (-> done) 7016 7038 (@ out-of-line) 7017 7039 (if otherform 7018 (x862-lri seg ($ *x862-arg-y*) (ash fixval x8664::fixnumshift)))7040 (x862-lri seg ($ *x862-arg-y*) (ash fixval *x862-target-fixnum-shift*))) 7019 7041 (! call-subprim-2 ($ *x862-arg-z*) (subprim-name->offset '.SPbuiltin-logior) ($ *x862-arg-y*) ($ *x862-arg-z*)) 7020 7042 (@ done) … … 7675 7697 7676 7698 7677 7699 ;;; gonna run out of imm regs here 7678 7700 ;;; This returns an unboxed object, unless the caller wants to box it. 7679 7701 (defx862 x862-immediate-get-xxx immediate-get-xxx (seg vreg xfer bits ptr offset) … … 7696 7718 (and absptr (%i> (integer-length absptr) 31) (setq absptr nil)) 7697 7719 (target-arch-case 7698 7720 (:x8632 (when (or fixnump (eql size 4) (and (eql size 4) signed)) 7721 (and offval (logtest 2 offval) (setq offval nil)) 7722 (and absptr (logtest 2 absptr) (setq absptr nil)))) 7699 7723 (:x8664 (when (or fixnump (eql size 8) (and (eql size 8) signed)) 7700 7724 (and offval (logtest 3 offval) (setq offval nil)) … … 7706 7730 (absptr 7707 7731 (target-arch-case 7708 7732 (:x8632 (! mem-ref-c-absolute-fullword dest absptr)) 7709 7733 (:x8664 (! mem-ref-c-absolute-doubleword dest absptr)))) 7710 7734 (offval … … 7712 7736 (x862-one-targeted-reg-form seg ptr src-reg) 7713 7737 (target-arch-case 7714 7738 (:x8632 (! mem-ref-c-fullword dest src-reg offval)) 7715 7739 (:x8664 (! mem-ref-c-doubleword dest src-reg offval))))) 7716 7740 (t … … 7729 7753 (x862-close-undo))) 7730 7754 (target-arch-case 7731 7755 (:x8632 (! mem-ref-fullword dest src-reg offset-reg)) 7732 7756 (:x8664 (! mem-ref-doubleword dest src-reg offset-reg))))))) 7733 7757 (if (node-reg-p vreg) … … 7774 7798 ((1 2) (! box-fixnum vreg dest)) 7775 7799 (4 (target-arch-case 7776 7800 (:x8632 (<- dest)) 7777 7801 (:x8664 (! box-fixnum vreg dest)))) 7778 7802 (8 (<- dest)))
Note:
See TracChangeset
for help on using the changeset viewer.
