From 5e54e23d6bd23bd9294207549e47476ace1ad4c3 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Tue, 10 Mar 1992 11:24:05 +0000
Subject: [PATCH] FREEZE-TYPE ALIEN-VALUE, and make a half-assed fix to
 ALIEN-SUBTYPEP of array types.

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

diff --git a/code/alieneval.lisp b/code/alieneval.lisp
index 9c8efada5..e6a68fa4a 100644
--- a/code/alieneval.lisp
+++ b/code/alieneval.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.23 1992/03/07 08:34:52 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.24 1992/03/10 11:24:05 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -457,13 +457,20 @@
 
 (defun alien-subtype-p (type1 type2)
   "Return T iff the alien type TYPE1 is a subtype of TYPE2.  Currently, the
-   only supported subtype relationship is that any pointer type is a subtype
-   of (* t).  Otherwise, the two types have to be ALIEN-TYPE-=."
+   only supported subtype relationships are is that any pointer type is a
+   subtype of (* t), and any array type first dimension will match 
+   (array <eltype> nil ...).  Otherwise, the two types have to be
+   ALIEN-TYPE-=."
   (typecase type1
     (alien-pointer-type
      (and (alien-pointer-type-p type2)
 	  (or (null (alien-pointer-type-to type2))
 	      (alien-type-= type1 type2))))
+    (alien-array-type
+     (and (alien-array-type-p type2)
+	  (let ((dims (alien-array-type-dimensions type2)))
+	    (or (and dims (null (first dims)))
+		(alien-type-= type1 type2)))))
     (t
      (alien-type-= type1 type2))))
 
@@ -1370,6 +1377,7 @@
 	     (unparse-alien-type (alien-value-type value))
 	     (sap-int (alien-value-sap value)))))
 
+(declaim (freeze-type alien-value))
 
 (declaim (inline null-alien))
 (defun null-alien (x)
-- 
GitLab