[Openmcl-cvs-notifications] r12241 - /trunk/source/level-0/X86/x86-def.lisp

[gb at clozure.com]

Author: gb
Date: Wed Jun 10 04:53:13 2009
New Revision: 12241

Log:
Handle :REGISTERS pseudo-arg in x8664 %FF-CALL.

Modified:
    trunk/source/level-0/X86/x86-def.lisp

Modified: trunk/source/level-0/X86/x86-def.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-0/X86/x86-def.lisp (original)
+++ trunk/source/level-0/X86/x86-def.lisp Wed Jun 10 04:53:13 2009
@@ -587,12 +587,38 @@
   (movl ($ nil) (%l arg_z))
   (restore-simple-frame)
   (single-value-return))
+
+(defx86lapfunction %do-ff-call-return-registers ((fp-regs 8)(nfp 0) (frame=
 arg_x) (regbuf arg_y) (entry arg_z))
+  (popq (% ra0))
+  (popq (% rax))
+  (popq (% temp0))
+  (movq (% rbp) (@  (% rsp)))
+  (movq (% rsp) (% rbp))
+  (movq (% ra0) (@ 8 (% rbp)))
+  (macptr-ptr temp0 temp0)
+  (sarq ($ x8664::fixnumshift) (% rax))
+  (movq (@ (% temp0)) (% fp0))
+  (movq (@ 8 (% temp0)) (% fp1))
+  (movq (@ 16 (% temp0)) (% fp2))
+  (movq (@ 24 (% temp0)) (% fp3))
+  (movq (@ 32 (% temp0)) (% fp4))
+  (movq (@ 40 (% temp0)) (% fp5))
+  (movq (@ 48 (% temp0)) (% fp6))
+  (movq (@ 56 (% temp0)) (% fp7))
+  (call-subprim .SPffcall-return-registers)
+  (movq (:rcontext x8664::tcr.foreign-sp) (% mm5))
+  (movq (% mm5) (@ (% frame)))
+  (movq (% frame) (:rcontext x8664::tcr.foreign-sp))
+  (movl ($ nil) (%l arg_z))
+  (restore-simple-frame)
+  (single-value-return))
   =

 =

 (defun %ff-call (entry &rest specs-and-vals)
   (declare (dynamic-extent specs-and-vals))
   (let* ((len (length specs-and-vals))
-         (total-words 0))
+         (total-words 0)
+         (regbuf nil))
     (declare (fixnum len total-words))
     (let* ((result-spec (or (car (last specs-and-vals)) :void))
            (nargs (ash (the fixnum (1- len)) -1))
@@ -617,6 +643,7 @@
                         :signed-halfword :unsigned-halfword
                         :signed-byte :unsigned-byte)
               (incf total-words))
+             (:registers )
              (t (if (typep spec 'unsigned-byte)
                   (incf total-words spec)
                   (error "unknown arg spec ~s" spec)))))
@@ -679,6 +706,7 @@
                               (t =

                                (setf (%get-single-float argptr other-offse=
t) val)
                                (incf other-offset 8))))
+                       (:registers (setq regbuf val))
                        (t
                         (let* ((p 0))
                           (declare (fixnum p))
@@ -686,7 +714,9 @@
                             (setf (%get-ptr argptr other-offset) (%get-ptr=
 val p))
                             (incf p 8)
                             (incf other-offset 8)))))))
-                 (%do-ff-call (min n-fp-args 8) frame fp-args entry)
+                 (if regbuf
+                   (%do-ff-call-return-registers fp-args (min n-fp-args 8)=
 frame regbuf entry)
+                   (%do-ff-call (min n-fp-args 8) frame fp-args entry))
                  (ecase result-spec
                    (:void nil)
                    (:address (%get-ptr argptr 8))