Changeset 7764


Ignore:
Timestamp:
Nov 27, 2007, 5:20:18 AM (12 years ago)
Author:
rme
Message:

Catch some more places that need additional imm regs.
Add a missed case in x862-copy-register. Make some fp stuff
32/64 bit agnostic. x862-i386-ff-call and x862-i386-syscall stubs.

File:
1 edited

Legend:

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

    r7708 r7764  
    205205(defvar *x862-allocptr* nil)
    206206
     207(defvar *x862-fp0* nil)
     208(defvar *x862-fp1* nil)
     209
     210
    207211(declaim (fixnum *x862-vstack* *x862-cstack*))
    208212
     
    503507           (*x862-allocptr* (target-arch-case (:x8632 x8632::allocptr)
    504508                                              (:x8664 x8664::allocptr)))
    505            
     509           (*x862-fp0* (target-arch-case (:x8632 x8632::fp0)
     510                                         (:x8664 x8664::fp0)))
     511           (*x862-fp1* (target-arch-case (:x8632 x8632::fp1)
     512                                         (:x8664 x8664::fp1)))
    506513
    507514           (*x862-target-num-arg-regs* (target-arch-case
     
    24742481                                              value result-reg)))
    24752482        (when safe
    2476           (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
    2477                  (value (if (eql (hard-regspec-class result-reg)
    2478                                  hard-reg-class-gpr)
    2479                           (hard-regspec-value result-reg))))
    2480             (when (and value (logbitp value *available-backend-imm-temps*))
    2481               (setq *available-backend-imm-temps* (bitclr value *available-backend-imm-temps*)))
    2482             (if (typep safe 'fixnum)
    2483               (! trap-unless-typecode= src safe))
    2484             (unless index-known-fixnum
    2485               (! trap-unless-fixnum unscaled-idx))
    2486             (! check-misc-bound unscaled-idx src)))
     2483          (with-additional-imm-reg (src unscaled-idx result-reg)
     2484            (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
     2485                   (value (if (eql (hard-regspec-class result-reg)
     2486                                   hard-reg-class-gpr)
     2487                            (hard-regspec-value result-reg))))
     2488              (when (and value (logbitp value *available-backend-imm-temps*))
     2489                (setq *available-backend-imm-temps* (bitclr value *available-backend-imm-temps*)))
     2490              (if (typep safe 'fixnum)
     2491                (! trap-unless-typecode= src safe))
     2492              (unless index-known-fixnum
     2493                (! trap-unless-fixnum unscaled-idx))
     2494              (! check-misc-bound unscaled-idx src))))
    24872495        (x862-vset1 seg vreg xfer type-keyword src unscaled-idx index-known-fixnum result-reg (x862-unboxed-reg-for-aset seg type-keyword result-reg safe constval) constval needs-memoization)))))
    24882496
     
    37913799                               (! trap-unless-macptr src))
    37923800                             (! deref-macptr dest src)))))
     3801                       ((#.hard-reg-class-gpr-mode-u32
     3802                         #.hard-reg-class-gpr-mode-s32
     3803                         #.hard-reg-class-gpr-mode-address)
     3804                        (unless (eql  dest-gpr src-gpr)
     3805                          (! copy-gpr dest src)))
     3806                       (#.hard-reg-class-gpr-mode-u16
     3807                        (! u16->u32 dest src))                 
     3808                       (#.hard-reg-class-gpr-mode-s16
     3809                        (! s16->s32 dest src))
     3810                       (#.hard-reg-class-gpr-mode-u8
     3811                        (! u8->u32 dest src))
     3812                       (#.hard-reg-class-gpr-mode-s8
     3813                        (! s8->s32 dest src))))
     3814                    (#.hard-reg-class-gpr-mode-s32
     3815                     (case src-mode
     3816                       (#.hard-reg-class-gpr-mode-node
     3817                        (! unbox-s32 dest src))
    37933818                       ((#.hard-reg-class-gpr-mode-u32
    37943819                         #.hard-reg-class-gpr-mode-s32
     
    43804405
    43814406
    4382 
     4407;; xxx imm regs
    43834408(defun x862-%immediate-set-ptr (seg vreg xfer  ptr offset val)
    43844409  (with-x86-local-vinsn-macros (seg vreg xfer)
     
    53055330                (setq n 0))
    53065331              (if *x862-open-code-inline*
    5307                 (let* ((*available-backend-node-temps* (bitclr *x862-arg-z* (bitclr x8664::rcx *available-backend-node-temps*))))
     5332                (let* ((*available-backend-node-temps*
     5333                        (target-arch-case
     5334                         ;; I don't see where %ecx is used...
     5335                         (:x8632 (bitclr x8632::arg_z *available-backend-node-temps*))
     5336                         (:x8664 (bitclr x8664::arg_z (bitclr x8664::rcx *available-backend-node-temps*))))))
    53085337                  (! unbind-interrupt-level-inline))
    53095338                (! unbind-interrupt-level)))
     
    71077136                    (! branch-unless-both-args-fixnums ($ *x862-arg-y*) ($ *x862-arg-z*) (aref *backend-labels* out-of-line)))))
    71087137              (if otherform
    7109                 (! %logand-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval x8664::fixnumshift))
     7138                (! %logand-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval *x862-target-fixnum-shift*))
    71107139                (! %logand2 ($ *x862-arg-z*) ($ *x862-arg-z*) ($ *x862-arg-y*)))
    71117140              (-> done)
    71127141              (@ out-of-line)
    71137142              (if otherform
    7114                 (x862-lri seg ($ *x862-arg-y*) (ash fixval x8664::fixnumshift)))
     7143                (x862-lri seg ($ *x862-arg-y*) (ash fixval *x862-target-fixnum-shift*)))
    71157144              (! call-subprim-2 ($ *x862-arg-z*) (subprim-name->offset '.SPbuiltin-logand) ($ *x862-arg-y*) ($ *x862-arg-z*))
    71167145              (@ done)
     
    74087437          (target-arch-case
    74097438           (:x8632
    7410             (! setup-uvector-allocation n))
     7439            (! setup-uvector-allocation header)
     7440            (x862-lri seg x8632::imm0 n))
    74117441           (:x8664
    74127442            (x862-lri seg x8664::imm1 n)))
     
    85658595    (x862-vpop-register seg *x862-arg-z*)
    85668596    (unless (or *x862-reckless* (x862-form-typep x 'macptr))
    8567       (with-imm-temps (src-reg) ()
    8568         (! trap-unless-macptr *x862-arg-z*)))
     8597      (with-additional-imm-reg ()
     8598        (with-imm-temps (src-reg) ()
     8599          (! trap-unless-macptr *x862-arg-z*))))
    85698600    (! set-macptr-address src-reg *x862-arg-z*)
    85708601    (<- *x862-arg-z*)
     
    85738604(defx862 x862-%setf-double-float %setf-double-float (seg vref xfer fnode fval)
    85748605  (x862-vpush-register seg (x862-one-untargeted-reg-form seg fnode *x862-arg-z*))
    8575   (let* ((target ($ x8664::fp1 :class :fpr :mode :double-float))
     8606  (let* ((target ($ *x862-fp1* :class :fpr :mode :double-float))
    85768607         (node ($ *x862-arg-z*)))
    85778608    (x862-one-targeted-reg-form seg fval target)
     
    87288759  (x862-mvcall seg vreg xfer fn arglist))
    87298760
    8730 
     8761(defx862 x862-i386-syscall i386-syscall (seg vreg xfer idx argspecs argvals resultspec &optional monitor-exception-ports)
     8762  (format t "i386-syscall"))
    87318763
    87328764(defx862 x862-syscall syscall (seg vreg xfer idx argspecs argvals resultspec &optional monitor-exception-ports)
     
    88228854      (^)))
    88238855
    8824 
    88258856(defx862 x862-i386-ff-call i386-ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor)
    88268857  (declare (ignore monitor))
     8858  #||
     8859  (let* ((*x862-vstack* *x862-vstack*)
     8860         (*x862-top-vstack-lcell* *x862-top-vstack-lcell*)
     8861         (*x862-cstack* *x862-cstack*)
     8862         (return-registers ())
     8863         (simple-foreign-args nil)
     8864         (nwords 0))
     8865    (dolist (argspec argspecs)
     8866      (case argspec
     8867        ((:double-float :unsigned-doubleword :signed-doubleword)
     8868         (incf nwords 2))
     8869        (t (incf nwords))))
     8870    (when (null argspecs)
     8871      (setq simple-foreign-args t))
     8872    (! alloc-c-frame nwords)
     8873    (x862-open-undo $undo-x86-c-frame)
     8874    (unless simple-foreign-args
     8875      (x862-vpush-register seg (x862-one-untargeted-reg-form seg address x8632::arg_z)))
     8876    ;; Evaluate each form into the C frame, according to the
     8877    ;; matching argspec.
     8878    (do* ((specs argspecs (cdr specs))
     8879          (vals argvals (cdr vals)))
     8880         ((null specs))
     8881      (declare (list specs vals))
     8882      (let* ((valform (car vals))
     8883             (spec (car specs))
     8884             (absptr (acode-absolute-ptr-p valform)))
     8885        (case spec
     8886          (:registers)
     8887          (:double-float)
     8888          (:single-float)
     8889          (:address)
     8890          (t)))))
     8891  ||#
    88278892  (format t "~&i386-ff-call")
    88288893)
     
    88758940      (setq ngpr-args 0 nfpr-args 0)
    88768941      (unless simple-foreign-args
    8877         (x862-vpush-register seg (x862-one-untargeted-reg-form seg address *x862-arg-z*)))
     8942        (x862-vpush-register seg (x862-one-untargeted-reg-form seg address x8664::arg_z)))
    88788943      ;; Evaluate each form into the C frame, according to the
    88798944      ;; matching argspec.  Remember type and arg offset of any FP
     
    88888953          (case spec
    88898954            (:registers
    8890              (let* ((reg (x862-one-untargeted-reg-form seg valform *x862-arg-z*)))
     8955             (let* ((reg (x862-one-untargeted-reg-form seg valform x8664::arg_z)))
    88918956               (unless *x862-reckless*
    88928957                 (! trap-unless-macptr reg))
     
    89579022            (! reload-single-c-arg ($ fpreg :class :fpr :mode :single-float) from))))
    89589023      (if return-registers
    8959         (x862-vpop-register seg ($ *x862-arg-y*)))
     9024        (x862-vpop-register seg ($ x8664::arg_y)))
    89609025      (if simple-foreign-args
    8961         (x862-one-targeted-reg-form seg address *x862-arg-z*)
    8962         (x862-vpop-register seg ($ *x862-arg-z*)))
     9026        (x862-one-targeted-reg-form seg address x8664::arg_z)
     9027        (x862-vpop-register seg ($ x8664::arg_z)))
    89639028      (x862-lri seg x8664::rax (min 8 nfpr-args))
    89649029      (if return-registers
     
    89769041                 (progn
    89779042                   (! makeu64)
    8978                    (<- ($ *x862-arg-z*)))
     9043                   (<- ($ x8664::arg_z)))
    89799044                 (<- ($  x8664::rax :class :gpr :mode :u64))))
    89809045              ((eq resultspec :signed-doubleword)
     
    89829047                 (progn
    89839048                   (! makes64)
    8984                    (<- ($ *x862-arg-z*)))
     9049                   (<- ($ x8664::arg_z)))
    89859050                 (<- ($  x8664::rax :class :gpr :mode :s64))))
    89869051              (t
    89879052               (case resultspec
    8988                  (:signed-byte (! sign-extend-s8 *x862-imm0* *x862-imm0*))
    8989                  (:signed-halfword (! sign-extend-s16 *x862-imm0* *x862-imm0*))
    8990                  (:signed-fullword (! sign-extend-s32 *x862-imm0* *x862-imm0*))
    8991                  (:unsigned-byte (! zero-extend-u8 *x862-imm0* *x862-imm0*))
    8992                  (:unsigned-halfword (! zero-extend-u16 *x862-imm0* *x862-imm0*))
    8993                  (:unsigned-fullword (! zero-extend-u32 *x862-imm0* *x862-imm0*)))
    8994                (<- (make-wired-lreg *x862-imm0*
     9053                 (:signed-byte (! sign-extend-s8 x8664::imm0 x8664::imm0))
     9054                 (:signed-halfword (! sign-extend-s16 x8664::imm0 x8664::imm0))
     9055                 (:signed-fullword (! sign-extend-s32 x8664::imm0 x8664::imm0))
     9056                 (:unsigned-byte (! zero-extend-u8 x8664::imm0 x8664::imm0))
     9057                 (:unsigned-halfword (! zero-extend-u16 x8664::imm0 x8664::imm0))
     9058                 (:unsigned-fullword (! zero-extend-u32 x8664::imm0 x8664::imm0)))
     9059               (<- (make-wired-lreg x8664::imm0
    89959060                                    :mode
    89969061                                    (gpr-mode-name-value
     
    90909155          (if (not constant)
    90919156            (with-imm-target () (xreg :natural)
    9092               (with-imm-target (xreg) (yreg :natural)
    9093                 (x862-two-targeted-reg-forms seg x xreg y yreg)
    9094                 (! %natural-logior xreg yreg))
     9157              (with-additional-imm-reg ()
     9158                (with-imm-target (xreg) (yreg :natural)
     9159                  (x862-two-targeted-reg-forms seg x xreg y yreg)
     9160                  (! %natural-logior xreg yreg)))
    90959161              (<- xreg))
    90969162            (let* ((other (if u31x y x)))
Note: See TracChangeset for help on using the changeset viewer.