From ac97b7229f874d5d3ad5000411168af2a31834ec Mon Sep 17 00:00:00 2001
From: Brian Mastenbrook <bmastenb@cs.indiana.edu>
Date: Mon, 3 Nov 2008 21:44:31 +0000
Subject: [PATCH] 1.0.22.14: fix a bug in PPC alien function calls

 * On SVR4 ABI systems (Linux and NetBSD), fix a bogus situation where
   the proper alignment would not be set when a SAP is passed before a
   long long argument.
---
 NEWS                         |  3 +++
 src/compiler/ppc/c-call.lisp | 11 ++++-------
 tests/foreign.test.sh        | 12 ++++++++++++
 version.lisp-expr            |  2 +-
 4 files changed, 20 insertions(+), 8 deletions(-)

diff --git a/NEWS b/NEWS
index a3de84571..8d2819874 100644
--- a/NEWS
+++ b/NEWS
@@ -14,6 +14,9 @@ changes in sbcl-1.0.23 relative to 1.0.22:
   * bug fix: #426; nested function calls are inlined properly.
     Previously if FOO was an inline function, in calls of the form
     (FOO (FOO ...)) the outer call was not inlined.
+  * bug fix: long long arguments passed in registers to alien
+    functions on PowerPC Linux and NetBSD are now handled correctly
+    when preceded by SYSTEM-AREA-POINTERs. (reported by Josh Elsasser)
 
 changes in sbcl-1.0.22 relative to 1.0.21:
   * minor incompatible change: LOAD-SHARED-OBJECT no longer by default looks
diff --git a/src/compiler/ppc/c-call.lisp b/src/compiler/ppc/c-call.lisp
index 1d75529c3..286988398 100644
--- a/src/compiler/ppc/c-call.lisp
+++ b/src/compiler/ppc/c-call.lisp
@@ -265,12 +265,6 @@
                      (new-arg-types (parse-alien-type
                                      '(unsigned 32)
                                      (sb!kernel:make-null-lexenv))))
-                    ((alien-integer-type-p type)
-                     (if (< gprs 8)
-                         (incf gprs 1)
-                         (incf stack 1))
-                     (new-args arg)
-                     (new-arg-types type))
                     ((alien-single-float-type-p type)
                      (if (< fprs 8)
                          (incf fprs)
@@ -285,7 +279,10 @@
                              (incf stack 2))) ; the stack.
                      (new-args arg)
                      (new-arg-types type))
-                    (t
+                    (t ;; integer or SAP
+                     (if (< gprs 8)
+                         (incf gprs 1)
+                         (incf stack 1))
                      (new-args arg)
                      (new-arg-types type)))))
                  (cond ((and (alien-integer-type-p result-type)
diff --git a/tests/foreign.test.sh b/tests/foreign.test.sh
index 01fdc8557..d34a9007a 100644
--- a/tests/foreign.test.sh
+++ b/tests/foreign.test.sh
@@ -100,6 +100,14 @@ int long_test2(int i1, int i2, int i3, int i4, int i5, int i6,
     return (l1 == (1 + powish(2,37)));
 }
 
+int long_sap_test1(int *p1, long long l1) {
+    return (l1 == (3 + powish(2,*p1)));
+}
+
+int long_sap_test2(int *p1, int i1, long long l1) {
+    return (l1 == (3 + powish(2,*p1)));
+}
+
 long long return_long_long() {
     return powish(2,33);
 }
@@ -150,6 +158,8 @@ cat > $TEST_FILESTEM.base.lisp <<EOF
   (define-alien-routine long-test8 int (int1 int) (int2 int) (int3 int) (int4 int) (int5 int) (int6 int) (int7 int) (long1 (integer 64)))
   (define-alien-routine long-test9 int (int1 int) (int2 int) (int3 int) (int4 int) (int5 int) (int6 int) (int7 int) (long1 (integer 64)) (int8 int))
   (define-alien-routine long-test2 int (int1 int) (int2 int) (int3 int) (int4 int) (int5 int) (int6 int) (int7 int) (int8 int) (int9 int) (long1 (integer 64)) (long2 (integer 64)))
+  (define-alien-routine long-sap-test1 int (ptr1 int :copy) (long1 (integer 64)))
+  (define-alien-routine long-sap-test2 int (ptr1 int :copy) (int1 int) (long1 (integer 64)))
   (define-alien-routine return-long-long (integer 64))
 
   ;; compiling this gets us the FOP-FOREIGN-DATAREF-FIXUP on
@@ -214,6 +224,8 @@ cat > $TEST_FILESTEM.test.lisp <<EOF
   (assert (= 1 (long-test8 1 2 3 4 5 6 7 (ash 1 34))))
   (assert (= 1 (long-test9 1 2 3 4 5 6 7 (ash 1 35) 8)))
   (assert (= 1 (long-test2 1 2 3 4 5 6 7 8 9 (+ 1 (ash 1 37)) 15)))
+  (assert (= 1 (long-sap-test1 38 (+ 3 (ash 1 38)))))
+  (assert (= 1 (long-sap-test2 38 1 (+ 3 (ash 1 38)))))
   (assert (= (ash 1 33) (return-long-long)))
 
   (note "/initial assertions ok")
diff --git a/version.lisp-expr b/version.lisp-expr
index cf64264d7..2155293d0 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.22.13"
+"1.0.22.14"
-- 
2.11.4.GIT