From ee3d429ae24570a4a81525aa4fc6bf99b81d7839 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Sun, 24 Jun 1990 19:35:15 +0000
Subject: [PATCH] Added a hack to get (setf sap-ref-32) to work.  Basically,
 the result type has to be asserted as more restrictive than the defknown,
 'cause there is no primitive type that covers (or (signed-byte 32)
 (unsigned-byte 32)).

---
 code/alieneval.lisp | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/code/alieneval.lisp b/code/alieneval.lisp
index 6f8f99b73..6f5b278b2 100644
--- a/code/alieneval.lisp
+++ b/code/alieneval.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.1.1.18 1990/06/11 02:25:52 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.1.1.19 1990/06/24 19:35:15 wlott Exp $
 ;;;
 ;;;    This file contains any the part of the Alien implementation that
 ;;; is not part of the compiler.
@@ -156,7 +156,9 @@
   (declare (type system-area-pointer sap)
 	   (type index offset)
 	   (type (or (signed-byte 32) (unsigned-byte 32)) new-value))
-  (setf (sap-ref-32 sap offset) new-value))
+  (if (minusp new-value)
+      (truly-the (signed-byte 32) (setf (sap-ref-32 sap offset) new-value))
+      (truly-the (unsigned-byte 32) (setf (sap-ref-32 sap offset) new-value))))
 
 (defun %set-sap-ref-sap (sap offset new-value)
   (declare (type system-area-pointer sap new-value)
-- 
GitLab