Changeset 8627


Ignore:
Timestamp:
Mar 1, 2008, 6:11:36 PM (12 years ago)
Author:
rme
Message:

Checkpoint work in progress.

Includes:

  • bit vector changes (don't use word index register, just use large

bit offsets)

  • improved x862-consp
File:
1 edited

Legend:

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

    r8348 r8627  
    15601560              )))))
    15611561
    1562 
     1562;; xxx
    15631563(defun x862-box-s32 (seg node-dest s32-src)
    15641564  (with-x86-local-vinsn-macros (seg)
     
    15731573        (x862-copy-register seg node-dest arg_z)))))
    15741574
     1575;; xxx
    15751576(defun x862-box-s64 (seg node-dest s64-src)
    15761577  (with-x86-local-vinsn-macros (seg)
     
    15901591        (x862-copy-register seg node-dest arg_z)))))
    15911592
     1593;; xxx
    15921594(defun x862-box-u32 (seg node-dest u32-src)
    15931595  (with-x86-local-vinsn-macros (seg)
     
    16021604        (x862-copy-register seg node-dest arg_z)))))
    16031605
     1606;; xxx
    16041607(defun x862-box-u64 (seg node-dest u64-src)
    16051608  (with-x86-local-vinsn-macros (seg)
     
    17961799             (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
    17971800               (! misc-ref-c-bit-fixnum target src index-known-fixnum)
    1798                (with-additional-imm-reg ()
    1799                  (with-additional-imm-reg ()
    1800                    (with-imm-temps
    1801                        () (word-index bitnum)
    1802                      (if index-known-fixnum
    1803                        (progn
    1804                          (x862-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -6)))
    1805                          (x862-lri seg bitnum (logand index-known-fixnum #x63)))
    1806                        (! word-index-and-bitnum-from-index word-index bitnum unscaled-idx))
    1807                      (! ref-bit-vector-fixnum target bitnum src word-index))))))))))
     1801               (with-imm-target () bitnum
     1802                 (if index-known-fixnum
     1803                   (x862-lri seg bitnum index-known-fixnum)
     1804                   (! scale-1bit-misc-index bitnum unscaled-idx))
     1805                 (! nref-bit-vector-fixnum target bitnum src))))))))
    18081806    (^)))
    18091807
     
    24762474                        (progn
    24772475                          (! set-constant-bit-to-variable-value src index-known-fixnum val-reg)))
    2478                       (with-imm-temps () (word-index bit-number)
     2476                      (progn
    24792477                        (if index-known-fixnum
    2480                           (progn
    2481                             (x862-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -6)))
    2482                             (x862-lri seg bit-number (logand index-known-fixnum #x63)))
    2483                           (! word-index-and-bitnum-from-index word-index bit-number unscaled-idx))
     2478                          (x862-lri seg scaled-idx index-known-fixnum)
     2479                          (! scale-1bit-misc-index scaled-idx unscaled-idx))
    24842480                        (if constval
    24852481                          (if (zerop constval)
    2486                             (! set-variable-bit-to-zero src word-index bit-number)
    2487                             (! set-variable-bit-to-one src word-index bit-number))
     2482                            (! nset-variable-bit-to-zero src scaled-idx)
     2483                            (! nset-variable-bit-to-one src scaled-idx))
    24882484                          (progn
    2489                             (! set-variable-bit-to-variable-value src word-index bit-number val-reg)))))))))))
     2485                            (! nset-variable-bit-to-variable-value src scaled-idx val-reg)))))))))))
    24902486      (when (and vreg val-reg) (<- val-reg))
    24912487      (^))))
     
    45834579                 (1
    45844580                  (if (>= intval 128) (setq intval (- intval 256))))))
    4585           (with-additional-imm-reg ()
    4586             (cond (intval
    4587                    (cond (offval
    4588                           (with-imm-target () (ptr-reg :address)
    4589                             (let* ((ptr-reg (x862-one-untargeted-reg-form seg
    4590                                                                           ptr
    4591                                                                           ptr-reg)))
    4592                               (case size
    4593                                 (8 (! mem-set-c-constant-doubleword signed-intval ptr-reg offval))
    4594                                 (4 (! mem-set-c-constant-fullword signed-intval ptr-reg offval))
    4595                                 (2 (! mem-set-c-constant-halfword signed-intval ptr-reg offval))
    4596                                 (1 (! mem-set-c-constant-byte signed-intval ptr-reg offval))))))
    4597                          (t
    4598                           (with-imm-target () (ptr-reg :address)
     4581          (cond (intval
     4582                 (cond (offval
     4583                        (with-imm-target () (ptr-reg :address)
     4584                          (let* ((ptr-reg (x862-one-untargeted-reg-form seg
     4585                                                                        ptr
     4586                                                                        ptr-reg)))
     4587                            (case size
     4588                              (8 (! mem-set-c-constant-doubleword signed-intval ptr-reg offval))
     4589                              (4 (! mem-set-c-constant-fullword signed-intval ptr-reg offval))
     4590                              (2 (! mem-set-c-constant-halfword signed-intval ptr-reg offval))
     4591                              (1 (! mem-set-c-constant-byte signed-intval ptr-reg offval))))))
     4592                       (t
     4593                        (with-imm-target () (ptr-reg :address)
     4594                          (with-additional-imm-reg (*x862-arg-z*)
    45994595                            (with-imm-target (ptr-reg) (offsetreg :signed-natural)
    46004596                              (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
     
    46044600                                (4 (! mem-set-constant-fullword intval ptr-reg offsetreg))
    46054601                                (2 (! mem-set-constant-halfword intval ptr-reg offsetreg))
    4606                                 (1 (! mem-set-constant-byte intval ptr-reg offsetreg)))))))
    4607                    (if for-value
    4608                      (ensuring-node-target (target vreg)
    4609                        (x862-lri seg vreg (ash intval *x862-target-fixnum-shift*)))))
    4610                   (offval
    4611                    ;; simpler thant the general case
    4612                    (with-imm-target () (ptr-reg :address)
    4613                      (x862-push-register seg
    4614                                          (x862-one-untargeted-reg-form seg ptr ptr-reg)))
    4615                    (val-to-argz-and-imm0)
    4616                    (with-imm-target (*x862-imm0*) (ptr-reg :address)
     4602                                (1 (! mem-set-constant-byte intval ptr-reg offsetreg))))))))
     4603                 (if for-value
     4604                   (ensuring-node-target (target vreg)
     4605                     (x862-lri seg vreg (ash intval *x862-target-fixnum-shift*)))))
     4606                (offval
     4607                 ;; simpler than the general case
     4608                 (with-imm-target () (ptr-reg :address)
     4609                   (x862-push-register seg
     4610                                       (x862-one-untargeted-reg-form seg ptr ptr-reg)))
     4611                 (val-to-argz-and-imm0)
     4612                 (target-arch-case
     4613                  (:x8632
     4614                   (with-additional-imm-reg (*x862-arg-z*)
     4615                     (with-imm-temps (x8632::imm0) (ptr-reg)
     4616                       (x862-pop-register seg ptr-reg)
     4617                       (case size
     4618                         (8 (! mem-set-c-doubleword *x862-imm0* ptr-reg offval))
     4619                         (4 (! mem-set-c-fullword *x862-imm0* ptr-reg offval))
     4620                         (2 (! mem-set-c-halfword *x862-imm0* ptr-reg offval))
     4621                         (1 (! mem-set-c-byte *x862-imm0* ptr-reg offval))))))
     4622                  (:x8664
     4623                   (with-imm-target (x8664::imm0) (ptr-reg :address)
    46174624                     (x862-pop-register seg ptr-reg)
    46184625                     (case size
     
    46204627                       (4 (! mem-set-c-fullword *x862-imm0* ptr-reg offval))
    46214628                       (2 (! mem-set-c-halfword *x862-imm0* ptr-reg offval))
    4622                        (1 (! mem-set-c-byte *x862-imm0* ptr-reg offval))))
    4623                    (if for-value
    4624                      (<- *x862-arg-z*)))
    4625                   (t
    4626                    (with-imm-target () (ptr-reg :address)
     4629                       (1 (! mem-set-c-byte *x862-imm0* ptr-reg offval))))))
     4630                 (if for-value
     4631                   (<- *x862-arg-z*)))
     4632                (t
     4633                 (with-imm-target () (ptr-reg :address)
     4634                   (with-additional-imm-reg (*x862-arg-z* ptr-reg)
    46274635                     (with-imm-target (ptr-reg) (offset-reg :address)
    46284636                       (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
    46294637                       (! fixnum->signed-natural offset-reg *x862-arg-z*)
    46304638                       (! fixnum-add2 ptr-reg offset-reg)
    4631                        (x862-push-register seg ptr-reg)))
    4632                    (val-to-argz-and-imm0)
    4633                    (with-imm-target (*x862-imm0*) (ptr-reg :address)
     4639                       (x862-push-register seg ptr-reg))))
     4640                 (val-to-argz-and-imm0)
     4641                 (target-arch-case
     4642                  (:x8632
     4643                     ;; Ensure imm0 is marked as in use so that some
     4644                     ;; vinsn doesn't decide to use it a temp.
     4645                     (with-additional-imm-reg ()
     4646                       (with-imm-temps (x8632::imm0) (ptr-reg)
     4647                         (x862-pop-register seg ptr-reg)
     4648                         (case size
     4649                           (8 (! mem-set-c-doubleword *x862-imm0* ptr-reg 0))
     4650                           (4 (! mem-set-c-fullword *x862-imm0* ptr-reg 0))
     4651                           (2 (! mem-set-c-halfword *x862-imm0* ptr-reg 0))
     4652                           (1 (! mem-set-c-byte *x862-imm0* ptr-reg 0))))))
     4653                  (:x8664
     4654                   (with-imm-target (x8664::imm0) (ptr-reg :address)
    46344655                     (x862-pop-register seg ptr-reg)
    46354656                     (case size
     
    46374658                       (4 (! mem-set-c-fullword *x862-imm0* ptr-reg 0))
    46384659                       (2 (! mem-set-c-halfword *x862-imm0* ptr-reg 0))
    4639                        (1 (! mem-set-c-byte *x862-imm0* ptr-reg 0))))
    4640                    (if for-value
    4641                      (< *x862-arg-z*)))))
     4660                       (1 (! mem-set-c-byte *x862-imm0* ptr-reg 0))))))
     4661                 (if for-value
     4662                   (< *x862-arg-z*))))
    46424663
    46434664          (^))))))
     
    59365957                    (dotimes (i (the fixnum (+ nkeys nkeys)))
    59375958                      (x862-new-vstack-lcell :reserved *x862-target-lcell-size* 0 nil))
    5938                     (x862-lri seg *x862-temp1* (ash flags *x862-target-fixnum-shift*))
     5959                    (target-arch-case
     5960                     ;; xxx hack alert (see SPkeyword_bind in x86-spentry32.s)
     5961                     (:x8632
     5962                      (! set-high-halfword *x862-temp1* flags))
     5963                     (:x8664
     5964                      (x862-lri seg *x862-temp1* (ash flags *x862-target-fixnum-shift*))))
    59395965                    (unless (= nprev 0)
    59405966                      (x862-lri seg *x862-imm0* (ash nprev *x862-target-fixnum-shift*)))
     
    61686194  (if (null vreg)
    61696195    (x862-form seg vreg xfer form)
    6170     (let* ((tagreg *x862-imm0*))
    6171       (multiple-value-bind (cr-bit true-p) (acode-condition-to-x86-cr-bit cc)
    6172         (! extract-fulltag tagreg (x862-one-untargeted-reg-form seg form *x862-arg-z*))
    6173         (! compare-u8-constant tagreg x8664::fulltag-cons)
    6174         (regspec-crf-gpr-case
    6175          (vreg dest)
    6176          (^ cr-bit true-p)
    6177          (progn
    6178            (ensuring-node-target (target dest)
    6179              (if (not true-p)
    6180                (setq cr-bit (logxor 1 cr-bit)))
    6181              (! cr-bit->boolean target cr-bit))
    6182            (^)))))))
     6196    (multiple-value-bind (cr-bit true-p) (acode-condition-to-x86-cr-bit cc)
     6197      (! set-z-flag-if-consp (x862-one-untargeted-reg-form seg form *x862-arg-z*))
     6198      (regspec-crf-gpr-case
     6199       (vreg dest)
     6200       (^ cr-bit true-p)
     6201       (progn
     6202         (ensuring-node-target (target dest)
     6203           (if (not true-p)
     6204             (setq cr-bit (logxor 1 cr-bit)))
     6205           (! cr-bit->boolean target cr-bit))
     6206         (^))))))
    61836207     
    61846208(defx862 x862-cons cons (seg vreg xfer y z)
     
    89989022         (*x862-top-vstack-lcell* *x862-top-vstack-lcell*)
    89999023         (*x862-cstack* *x862-cstack*)
     9024         (offset 0)
    90009025         (simple-foreign-args nil)
    90019026         (nwords 0))
     
    90219046             (absptr (acode-absolute-ptr-p valform)))
    90229047        (case spec
    9023           (:registers)
    9024           (:double-float)
    9025           (:single-float)
    9026           (:address)
    9027           (t))))
     9048          (:registers
     9049           (error "don't know what to do with argspec ~s" spec))
     9050          (:double-float
     9051           (let* ((df ($ x8632::fp0 :class :fpr :mode :double-float)))
     9052             (x862-one-targeted-reg-form seg valform df)
     9053             (! set-double-c-arg df offset))
     9054           (incf offset 2))
     9055          (:single-float
     9056           (let* ((sf ($ x8632::fp0 :class :fpr :mode :single-float)))
     9057             (x862-one-targeted-reg-form seg valform sf)
     9058             (! set-single-c-arg sf offset))
     9059           (incf offset))
     9060          (:address
     9061           (with-imm-target () (ptr :address)
     9062             (if absptr
     9063               (x862-lri seg ptr absptr)
     9064               (x862-form seg ptr nil valform))
     9065             (! set-c-arg ptr offset))
     9066           (incf offset))
     9067          (t
     9068           (if (typep spec 'unsigned-byte)
     9069             (progn
     9070               (with-imm-target () (ptr :address)
     9071                 (x862-one-targeted-reg-form seg valform ptr)
     9072                 (with-additional-imm-reg (ptr)
     9073                   (with-imm-target (ptr) (r :natural)
     9074                     (dotimes (i spec)
     9075                       (! mem-ref-c-fullword r ptr (ash i x8632::word-shift))
     9076                       (! set-c-arg r offset)))))
     9077               (incf offset spec))
     9078             (with-imm-target () (valreg :natural)
     9079               (let* ((reg (x862-unboxed-integer-arg-to-reg seg valform valreg spec)))
     9080                 (! set-c-arg reg offset)
     9081                 (incf offset))))))))
     9082    (if simple-foreign-args
     9083      (x862-one-targeted-reg-form seg address x8632::arg_z)
     9084      (x862-vpop-register seg ($ x8632::arg_z)))
    90289085    (! ff-call)
    90299086    (x862-close-undo)
     
    90389095            ((eq resultspec :unsigned-doubleword)
    90399096             (ensuring-node-target (target vreg)
     9097               ;; xxx -- need to ensure that edx is marked as an imm reg
    90409098               (! makeu64)
    90419099               (x862-copy-register seg target ($ *x862-arg-z*))))
    90429100            ((eq resultspec :signed-doubleword)
    90439101             (ensuring-node-target (target vreg)
     9102               ;; xxx -- need to ensure that edx is marked as an imm reg
    90449103               (! makes64)
    90459104               (x862-copy-register seg target ($ *x862-arg-z*))))
     
    90499108               (:signed-halfword (! sign-extend-s16 *x862-imm0* *x862-imm0*))
    90509109               (:unsigned-byte (! zero-extend-u8 *x862-imm0* *x862-imm0*))
    9051                (:unsigned-halfword (! zero-extend-u16 *x862-imm0* *x862-imm0*))))
    9052             (<- (make-wired-lreg x8632::imm0
    9053                                  :mode
    9054                                  (gpr-mode-name-value
    9055                                   (case resultspec
    9056                                     (:address :address)
    9057                                     (:signed-byte :s8)
    9058                                     (:unsigned-byte :u8)
    9059                                     (:signed-halfword :s16)
    9060                                     (:unsigned-halfword :u16)
    9061                                     (:signed-fullword :s32)
    9062                                     (t :u32)))))))
     9110               (:unsigned-halfword (! zero-extend-u16 *x862-imm0* *x862-imm0*)))
     9111             (<- (make-wired-lreg x8632::imm0
     9112                                  :mode
     9113                                  (gpr-mode-name-value
     9114                                   (case resultspec
     9115                                     (:address :address)
     9116                                     (:signed-byte :s8)
     9117                                     (:unsigned-byte :u8)
     9118                                     (:signed-halfword :s16)
     9119                                     (:unsigned-halfword :u16)
     9120                                     (:signed-fullword :s32)
     9121                                     (t :u32))))))))
    90639122    (^)))
    90649123
Note: See TracChangeset for help on using the changeset viewer.