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