Ignore:
Timestamp:
Aug 9, 2010, 6:59:18 AM (9 years ago)
Author:
gb
Message:

FF-CALL on win64 is sufficiently different from other x8664 platforms
that it's clearer to split off the compiler handling of it and the
runtime implementation (%FF-CALL and %DO-FF-CALL) into separate functions.

The cases that I was aware of that were handled incorrectly seem to be
handled correctly now.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/x862.lisp

    r13887 r14156  
    95999599    (^)))
    96009600
     9601
     9602(defun x862-x8664-ff-call-return (seg vreg resultspec)
     9603  (with-x86-local-vinsn-macros (seg vreg)
     9604    (when vreg
     9605      (cond ((eq resultspec :void) (<- nil))
     9606            ((eq resultspec :double-float)
     9607             (<- ($  x8664::fp0 :class :fpr :mode :double-float)))
     9608            ((eq resultspec :single-float)
     9609             (<- ($ x8664::fp0 :class :fpr :mode :single-float)))
     9610            ((eq resultspec :unsigned-doubleword)
     9611             (if (node-reg-p vreg)
     9612               (progn
     9613                 (! makeu64)
     9614                 (<- ($ x8664::arg_z)))
     9615               (<- ($  x8664::rax :class :gpr :mode :u64))))
     9616            ((eq resultspec :signed-doubleword)
     9617             (if (node-reg-p vreg)
     9618               (progn
     9619                 (! makes64)
     9620                 (<- ($ x8664::arg_z)))
     9621               (<- ($  x8664::rax :class :gpr :mode :s64))))
     9622            (t
     9623             (case resultspec
     9624               (:signed-byte (! sign-extend-s8 x8664::imm0 x8664::imm0))
     9625               (:signed-halfword (! sign-extend-s16 x8664::imm0 x8664::imm0))
     9626               (:signed-fullword (! sign-extend-s32 x8664::imm0 x8664::imm0))
     9627               (:unsigned-byte (! zero-extend-u8 x8664::imm0 x8664::imm0))
     9628               (:unsigned-halfword (! zero-extend-u16 x8664::imm0 x8664::imm0))
     9629               (:unsigned-fullword (! zero-extend-u32 x8664::imm0 x8664::imm0)))
     9630             (<- (make-wired-lreg x8664::imm0
     9631                                  :mode
     9632                                  (gpr-mode-name-value
     9633                                   (case resultspec
     9634                                     (:address :address)
     9635                                     (:signed-byte :s8)
     9636                                     (:unsigned-byte :u8)
     9637                                     (:signed-halfword :s16)
     9638                                     (:unsigned-halfword :u16)
     9639                                     (:signed-fullword :s32)
     9640                                     (t :u32))))))))))
     9641
     9642(defun x862-win64-ff-call (seg vreg xfer address argspecs argvals resultspec)
     9643  (with-x86-local-vinsn-macros (seg vreg xfer)
     9644    (let* ((*x862-vstack* *x862-vstack*)
     9645           (*x862-top-vstack-lcell* *x862-top-vstack-lcell*)
     9646           (*x862-cstack* *x862-cstack*)
     9647           (nargwords 0)
     9648           (arg-offset 0)
     9649           (simple-foreign-args nil)
     9650           (fp-loads ()))
     9651      (declare (fixnum nargwords arg-offset))
     9652      (dolist (argspec argspecs)
     9653        (case argspec
     9654          (:double-float (incf nargwords))
     9655          (:single-float (incf nargwords))
     9656          (:registers (compiler-bug "Foreign argument type ~s not supported on Win64" argspec))
     9657          (t
     9658           (if (typep argspec 'unsigned-byte)
     9659             (incf nargwords argspec)
     9660             (incf nargwords)))))
     9661      (when (null argspecs)
     9662        (setq simple-foreign-args t))
     9663      (! alloc-c-frame nargwords)
     9664      (x862-open-undo $undo-x86-c-frame)
     9665      (unless simple-foreign-args
     9666        (x862-vpush-register seg (x862-one-untargeted-reg-form seg address x8664::arg_z)))
     9667      ;; Evaluate each form into the C frame, according to the
     9668      ;; matching argspec.  Remember type and arg offset of any FP
     9669      ;; args, since FP regs will have to be loaded later.
     9670      (do* ((specs argspecs (cdr specs))
     9671            (vals argvals (cdr vals)))
     9672           ((null specs))
     9673        (declare (list specs vals))
     9674        (let* ((valform (car vals))
     9675               (spec (car specs))
     9676               (absptr (acode-absolute-ptr-p valform)))
     9677          (case spec
     9678            (:double-float
     9679             (let* ((df ($ x8664::fp1 :class :fpr :mode :double-float)))
     9680               (x862-one-targeted-reg-form seg valform df )
     9681               (! set-double-c-arg df arg-offset)
     9682               (when (< arg-offset 4)
     9683                 (push (cons :double-float arg-offset) fp-loads))
     9684               (incf arg-offset)))
     9685            (:single-float
     9686             (let* ((sf ($ x8664::fp1 :class :fpr :mode :single-float)))
     9687               (x862-one-targeted-reg-form seg valform sf)
     9688               (! set-single-c-arg sf arg-offset)
     9689               (when (< arg-offset 4)
     9690                 (push (cons :single-float arg-offset) fp-loads))
     9691               (incf arg-offset)))
     9692            (:address
     9693             (with-imm-target () (ptr :address)
     9694               (if absptr
     9695                 (x862-lri seg ptr absptr)
     9696                 (x862-form seg ptr nil valform))
     9697               (! set-c-arg ptr arg-offset)
     9698               (incf arg-offset)))
     9699            (t
     9700             (if (typep spec 'unsigned-byte)
     9701               (progn
     9702                 (with-imm-target () (ptr :address)
     9703                   (x862-one-targeted-reg-form seg valform ptr)
     9704                   (with-imm-target (ptr) (r :natural)
     9705                     (dotimes (i spec)
     9706                       (! mem-ref-c-doubleword r ptr (ash i x8664::word-shift))
     9707                       (! set-c-arg r arg-offset)
     9708                       (incf arg-offset)))))               
     9709               (with-imm-target () (valreg :natural)
     9710                 (let* ((reg (x862-unboxed-integer-arg-to-reg seg valform valreg spec)))
     9711                   (! set-c-arg reg arg-offset)
     9712                   (incf arg-offset))))))))
     9713      (dolist (reload fp-loads)
     9714        (let* ((size (car reload))
     9715               (offset (cdr reload))
     9716               (fpr (+ x8664::fp0 offset)))
     9717          (if (eq size :double-float)
     9718            (! reload-double-c-arg ($ fpr :class :fpr :mode :double-float) offset)
     9719            (! reload-single-c-arg ($ fpr :class :fpr :mode :single-float) offset))))
     9720
     9721      (if simple-foreign-args
     9722        (x862-one-targeted-reg-form seg address x8664::arg_z)
     9723        (x862-vpop-register seg ($ x8664::arg_z)))
     9724      (! ff-call)
     9725      (x862-close-undo)
     9726      (x862-x8664-ff-call-return seg vreg resultspec)
     9727      (^))))
     9728   
    96019729(defx862 x862-ff-call ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor)
    96029730  (declare (ignore monitor))
    9603   (let* ((*x862-vstack* *x862-vstack*)
    9604          (*x862-top-vstack-lcell* *x862-top-vstack-lcell*)
    9605          (*x862-cstack* *x862-cstack*)
    9606          (gpr-offset 0)
    9607          (other-offset 6)
    9608          (single-float-offset 6)
    9609          (double-float-offset 6)
    9610          (nsingle-floats 0)              ; F
    9611          (ndouble-floats 0)             ; D
    9612          (nother-words 0)
    9613          (nfpr-args 0)
    9614          (ngpr-args 0)
    9615          (simple-foreign-args nil)
    9616          (fp-loads ())
    9617          (return-registers ()))
     9731  (if (eq (backend-target-os *target-backend*) :win64)
     9732    (x862-win64-ff-call seg vreg xfer address argspecs argvals resultspec)
     9733    (let* ((*x862-vstack* *x862-vstack*)
     9734           (*x862-top-vstack-lcell* *x862-top-vstack-lcell*)
     9735           (*x862-cstack* *x862-cstack*)
     9736           (gpr-offset 0)
     9737           (other-offset 6)
     9738           (single-float-offset 6)
     9739           (double-float-offset 6)
     9740           (nsingle-floats 0)           ; F
     9741           (ndouble-floats 0)           ; D
     9742           (nother-words 0)
     9743           (nfpr-args 0)
     9744           (ngpr-args 0)
     9745           (simple-foreign-args nil)
     9746           (fp-loads ())
     9747           (return-registers ()))
    96189748      (declare (fixnum  nsingle-floats ndouble-floats nfpr-args ngpr-args nother-words
    96199749                        gpr-offset other-offset single-float-offset double-float-offset))
     
    97379867        (! ff-call) )
    97389868      (x862-close-undo)
    9739       (when vreg
    9740         (cond ((eq resultspec :void) (<- nil))
    9741               ((eq resultspec :double-float)
    9742                (<- ($  x8664::fp0 :class :fpr :mode :double-float)))
    9743               ((eq resultspec :single-float)
    9744                (<- ($ x8664::fp0 :class :fpr :mode :single-float)))
    9745               ((eq resultspec :unsigned-doubleword)
    9746                (if (node-reg-p vreg)
    9747                  (progn
    9748                    (! makeu64)
    9749                    (<- ($ x8664::arg_z)))
    9750                  (<- ($  x8664::rax :class :gpr :mode :u64))))
    9751               ((eq resultspec :signed-doubleword)
    9752                (if (node-reg-p vreg)
    9753                  (progn
    9754                    (! makes64)
    9755                    (<- ($ x8664::arg_z)))
    9756                  (<- ($  x8664::rax :class :gpr :mode :s64))))
    9757               (t
    9758                (case resultspec
    9759                  (:signed-byte (! sign-extend-s8 x8664::imm0 x8664::imm0))
    9760                  (:signed-halfword (! sign-extend-s16 x8664::imm0 x8664::imm0))
    9761                  (:signed-fullword (! sign-extend-s32 x8664::imm0 x8664::imm0))
    9762                  (:unsigned-byte (! zero-extend-u8 x8664::imm0 x8664::imm0))
    9763                  (:unsigned-halfword (! zero-extend-u16 x8664::imm0 x8664::imm0))
    9764                  (:unsigned-fullword (! zero-extend-u32 x8664::imm0 x8664::imm0)))
    9765                (<- (make-wired-lreg x8664::imm0
    9766                                     :mode
    9767                                     (gpr-mode-name-value
    9768                                      (case resultspec
    9769                                        (:address :address)
    9770                                        (:signed-byte :s8)
    9771                                        (:unsigned-byte :u8)
    9772                                        (:signed-halfword :s16)
    9773                                        (:unsigned-halfword :u16)
    9774                                        (:signed-fullword :s32)
    9775                                        (t :u32))))))))
    9776       (^)))
     9869      (x862-x8664-ff-call-return seg vreg resultspec)
     9870      (^))))
    97779871
    97789872
Note: See TracChangeset for help on using the changeset viewer.