From 02301098f2d78b4b71e33c9280da5d0466c36696 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Sat, 21 Jul 1990 15:18:33 +0000
Subject: [PATCH] Fixed compute-call-form to quote all the types it passes to
 make-alien, and to correctly deal with returning pointer-types.

---
 code/c-call.lisp | 14 +++++++++++---
 1 file changed, 11 insertions(+), 3 deletions(-)

diff --git a/code/c-call.lisp b/code/c-call.lisp
index 19ec8e991..1f97a213f 100644
--- a/code/c-call.lisp
+++ b/code/c-call.lisp
@@ -504,7 +504,7 @@
 			 single-float double-float)
 	    (sub-compute-call-form descr))
 	   (null-terminated-string
-	    `(alien-access (make-alien ,descr
+	    `(alien-access (make-alien ',descr
 				       ,(c-type-size return-type)
 				       ,(sub-compute-call-form
 					 'system-area-pointer))
@@ -523,11 +523,19 @@
 	    (error "Can't return ~S yet." descr)))))
       (record-type
        (error "Can't return ~S yet." (c-type-description return-type)))
-      ((or array-type pointer-type)
+      (pointer-type
+       (let ((type (pointer-type-to return-type)))
+	 (unless (c-type-size type)
+	   (error "Can't return pointers to objects of unknown size: ~S"
+		  (c-type-description return-type)))
+	 `(make-alien ',(c-type-description type)
+		      ,(c-type-size type)
+		      ,(sub-compute-call-form 'system-area-pointer))))
+      (array-type
        (unless (c-type-size return-type)
 	 (error "Can't return arrays of unknown size: ~S"
 		(c-type-description return-type)))
-       `(make-alien ,(c-type-description return-type)
+       `(make-alien ',(c-type-description return-type)
 		    ,(c-type-size return-type)
 		    ,(sub-compute-call-form 'system-area-pointer))))))
 
-- 
GitLab