Changeset 7429


Ignore:
Timestamp:
Oct 12, 2007, 6:21:28 PM (13 years ago)
Author:
rme
Message:

x8632 changes in:

  • x862-make-closure
  • x862-lambda
  • x862-inline-logior2 (use *x862-target-fixnum-shift*)
  • x862-vset1 (incomplete)
  • x862-immediate-get-xxx (incomplete)
File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/ia32/compiler/X86/x862.lisp

    r7340 r7429  
    695695                     (target-arch-case
    696696                      (: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))
    698698                              (srt-frag (x86-lap-label-frag label))
    699699                              (srt-index (x86-lap-label-offset label)))
     
    713713                                     (+ (frag-address frag) (reloc-pos reloc)))
    714714                               (incf srt-index 4)))))
    715                        (show-frag-bytes frag-list)))
    716                  
     715                       ;;(show-frag-bytes frag-list)
     716                       ))
     717                     
    717718                     (x862-lap-process-regsave-info frag-list regsave-label regsave-mask regsave-addr)
    718719                     (setf (afunc-lfun afunc)
     
    23012302                   reg)))))))
    23022303
     2304
     2305;;; xxx
    23032306(defun x862-vset1 (seg vreg xfer type-keyword src unscaled-idx index-known-fixnum val-reg unboxed-val-reg constval node-value-needs-memoization)
    23042307  (with-x86-local-vinsn-macros (seg vreg xfer)
     
    23122315           (is-signed (member type-keyword '(:signed-8-bit-vector :signed-16-bit-vector :signed-32-bit-vector :signed-64-bit-vector :fixnum-vector))))
    23132316      (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)))
    23152320                          (eql (hard-regspec-value unscaled-idx) *x862-arg-y*)
    23162321                          (eql (hard-regspec-value val-reg) *x862-arg-z*))
     
    24342439           (needs-memoization (and is-node (x862-acode-needs-memoization value)))
    24352440           (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))))
    24372444             (unscaled-idx ($ *x862-arg-y*))
    24382445             (result-reg ($ *x862-arg-z*)))
     
    27982805                (x862-lri seg *x862-imm0* (- (ash (logandc2 (+ vsize 2) 1) (arch::target-word-shift arch)) x8632::fulltag-misc)))
    27992806               (: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))))
    28012808              (! %allocate-uvector dest)))
    28022809          (! init-nclosure *x862-arg-z*)
    28032810          (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*))
    28132830          (! misc-set-c-node *x862-arg-y* dest cell))
    28142831        (! finalize-closure dest)
     
    58255842                (when hardopt
    58265843                  (x862-reserve-vstack-lcells num-opt)
    5827                   (x862-lri seg *x862-imm0* (ash num-opt *x862-target-fixnum-shift*))
    58285844
    58295845                  ;; ! opt-supplied-p wants nargs to contain the
     
    58375853                        ((= 2 num-opt)
    58385854                         (! 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))))
    58405862                (let* ((nwords-vpushed (+ num-fixed
    58415863                                          num-opt
     
    70117033                    (! branch-unless-both-args-fixnums ($ *x862-arg-y*) ($ *x862-arg-z*) (aref *backend-labels* out-of-line)))))
    70127034              (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*))
    70147036                (! %logior2 ($ *x862-arg-z*) ($ *x862-arg-z*) ($ *x862-arg-y*)))
    70157037              (-> done)
    70167038              (@ out-of-line)
    70177039              (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*)))
    70197041              (! call-subprim-2 ($ *x862-arg-z*) (subprim-name->offset '.SPbuiltin-logior) ($ *x862-arg-y*) ($ *x862-arg-z*))
    70207042              (@ done)
     
    76757697   
    76767698     
    7677                                      
     7699;;; gonna run out of imm regs here                                     
    76787700;;; This returns an unboxed object, unless the caller wants to box it.
    76797701(defx862 x862-immediate-get-xxx immediate-get-xxx (seg vreg xfer bits ptr offset)
     
    76967718           (and absptr (%i> (integer-length absptr) 31) (setq absptr nil))
    76977719           (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))))
    76997723            (:x8664 (when (or fixnump (eql size 8) (and (eql size 8) signed))
    77007724                      (and offval (logtest 3 offval) (setq offval nil))
     
    77067730                  (absptr                             
    77077731                   (target-arch-case
    7708                    
     7732                    (:x8632 (! mem-ref-c-absolute-fullword dest absptr))
    77097733                    (:x8664 (! mem-ref-c-absolute-doubleword dest  absptr))))
    77107734                  (offval
     
    77127736                      (x862-one-targeted-reg-form seg ptr src-reg)
    77137737                      (target-arch-case
    7714                        
     7738                       (:x8632 (! mem-ref-c-fullword dest src-reg offval))
    77157739                       (:x8664 (! mem-ref-c-doubleword dest src-reg offval)))))
    77167740                  (t
     
    77297753                           (x862-close-undo)))
    77307754                       (target-arch-case
    7731                        
     7755                        (:x8632 (! mem-ref-fullword dest src-reg offset-reg))
    77327756                        (:x8664 (! mem-ref-doubleword dest src-reg offset-reg)))))))
    77337757                (if (node-reg-p vreg)
     
    77747798                   ((1 2) (! box-fixnum vreg dest))
    77757799                   (4 (target-arch-case
    7776                        
     7800                       (:x8632 (<- dest))
    77777801                       (:x8664 (! box-fixnum vreg dest))))
    77787802                   (8 (<- dest)))
Note: See TracChangeset for help on using the changeset viewer.