From ab23bd2c5e34e5e95c49cfcefd8abb6cecc7c3de Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Wed, 3 Oct 1990 15:01:15 +0000 Subject: [PATCH] Fixed some problems with interpreted alien access. --- code/alieneval.lisp | 52 +++++++++++++++++++++++---------------------- 1 file changed, 27 insertions(+), 25 deletions(-) diff --git a/code/alieneval.lisp b/code/alieneval.lisp index 703907440..bae826d8c 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.3 1990/08/24 18:09:34 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.4 1990/10/03 15:01:15 ram Exp $ ;;; ;;; This file contains any the part of the Alien implementation that ;;; is not part of the compiler. @@ -920,10 +920,10 @@ ((:minimum smin) nil) ((:unit sunit) 32)) &body (body decls)) - (%with-alien sap offset ounit - size sconst smin sunit - ',n-sap ',n-offset ',n-size - body decls))) + (%with-alien sap offset ounit + size sconst smin sunit + ',n-sap ',n-offset ',n-size + body decls))) ,@body))) #-new-compiler (eval-when (compile) @@ -945,10 +945,10 @@ `(let ((,',n-scaled-offset (/ ,,n-offset ,,ounit)) (,',n-scaled-size (/ ,,n-size ,,sunit))) ,',n-scaled-size ; Ignorable... - ,@',(when sconst - `((check= ,n-scaled-size ,sconst))) - ,@',(when smin - `((check<= ,smin ,n-scaled-size))) + ,,@(when sconst + `(`(check= ,',n-scaled-size ,,sconst))) + ,,@(when smin + `(`(check<= ,,smin ,',n-scaled-size))) ,,@body)))) ); Eval-When (Compile Load Eval) @@ -986,22 +986,24 @@ ;;; (defun %set-alien-access (alien lisp-type &optional (new-value nil nvp)) (declare (type alien-value alien)) - (let* ((lisp-type (if nvp lisp-type nil)) - (new-value (if nvp new-value lisp-type)) - (alien-type (alien-value-type alien)) - (access (get-alien-access-method alien-type lisp-type)) - (n-sap (gensym)) - (n-offset (gensym)) - (n-size (gensym)) - (n-nval (gensym))) - (eval - `(let ((,n-sap ',(alien-value-sap alien)) - (,n-offset ',(alien-value-offset alien)) - (,n-size ',(alien-value-size alien)) - (,n-nval ,new-value)) - ,(funcall access n-sap n-offset n-size alien-type :write n-nval - '(setf alien-access)))) - new-value)) + (multiple-value-bind (lisp-type new-value) + (if nvp + (values lisp-type new-value) + (values nil lisp-type)) + (let* ((alien-type (alien-value-type alien)) + (access (get-alien-access-method alien-type lisp-type)) + (n-sap (gensym)) + (n-offset (gensym)) + (n-size (gensym)) + (n-nval (gensym))) + (eval + `(let ((,n-sap ',(alien-value-sap alien)) + (,n-offset ',(alien-value-offset alien)) + (,n-size ',(alien-value-size alien)) + (,n-nval ,new-value)) + ,(funcall access n-sap n-offset n-size alien-type :write n-nval + '(setf alien-access)))) + new-value))) ;;;; Miscellaneous alien access methods: -- GitLab