Changeset 5785

Timestamp:

Jan 23, 2007, 2:28:17 PM (18 years ago)

Author:

Gary Byers

Message:

Get FPRs from where subprim saved them.
Return FPRs in the same place. (Will need to re-work all of this
for platform-dependent structure stuff.)

Location:

trunk/ccl/compiler/PPC

Files:

• PPC32/ppc32-backend.lisp (modified) (2 diffs)
• PPC64/ppc64-backend.lisp (modified) (2 diffs)

trunk/ccl/compiler/PPC/PPC32/ppc32-backend.lisp

@@ -287 +287 @@
 (defun defcallback-body-ppc32-poweropen (stack-ptr lets dynamic-extent-names decls body return-type error-return error-delta #+poweropen-target fp-arg-ptr)
   (let* ((result (gensym))
-         (offset (case return-type
-                   ((:single-float :double-float)
-                    8)
-                   (t 0)))
+         (return-ptr (case return-type
+                       ((:single-float :double-float)
+                        fp-arg-ptr)
+                       (t stack-ptr)))
          (condition-name (if (atom error-return) 'error (car error-return)))
          (error-return-function (if (atom error-return) error-return (cadr error-return)))
          (body
-          `(%stack-block ((,fp-arg-ptr (* 8 13)))
-            (%get-fp-arg-regs ,fp-arg-ptr)
+          `(with-macptrs ((,fp-arg-ptr))
+            (%setf-macptr ,fp-arg-ptr (%get-ptr ,stack-ptr (- ppc32::c-frame.unused-1 ppc32::c-frame.param0)))
             (let ,lets
               (declare (dynamic-extent ,@dynamic-extent-names))
@@ -315 +315 @@
                                  (:unsigned-doubleword '%%get-unsigned-longlong)
                                  ((:double-float :single-float) '%get-double-float)
-                                 (t  '%get-long)) ,stack-ptr ,offset) ,result)))))))
+                                 (t  '%get-long)) ,return-ptr 0) ,result)))))))
     (if error-return
       (let* ((cond (gensym)))

trunk/ccl/compiler/PPC/PPC64/ppc64-backend.lisp

@@ -138 +138 @@
 (defun defcallback-body-ppc64-poweropen (stack-ptr lets dynamic-extent-names decls body return-type error-return error-delta  fp-arg-ptr)
   (let* ((result (gensym))
-         (offset (case return-type
-                   ((:single-float :double-float) 16)
-                   (t 0)))
+         (result-ptr (case return-type
+                   ((:single-float :double-float) fp-arg-ptr)
+                   (t stack-ptr)))
          (condition-name (if (atom error-return) 'error (car error-return)))
          (error-return-function (if (atom error-return) error-return (cadr error-return)))
          (body
-          `(%stack-block ((,fp-arg-ptr (* 8 13)))
-            (%get-fp-arg-regs ,fp-arg-ptr)
+          `(with-macptrs ((,fp-arg-ptr (%get-ptr ,stack-ptr (- ppc64::c-frame.unused-1 ppc64::c-frame.param0)))) 
             (let ,lets
               (declare (dynamic-extent ,@dynamic-extent-names))
@@ -165 +164 @@
                                  (:unsigned-doubleword '%%get-unsigned-longlong)
                                  ((:double-float :single-float) '%get-double-float)
-                                 (t #+ppc32-target '%get-long
-                                    #+ppc64-target '%%get-signed-longlong)) ,stack-ptr ,offset) ,result)))))))
+                                 (t '%%get-signed-longlon )) ,result-ptr 0) ,result)))))))
     (if error-return
       (let* ((cond (gensym)))