Skip to content
Snippets Groups Projects
Commit 135dcc38 authored by wlott's avatar wlott
Browse files

*** empty log message ***

parent 369b3ffb
No related branches found
No related tags found
No related merge requests found
...@@ -477,7 +477,7 @@ ...@@ -477,7 +477,7 @@
;;; by hand. ;;; by hand.
;;; ;;;
(defun naturalize-integer (signed sap offset size form) (defun naturalize-integer (signed sap offset size form)
(multiple-value-bind (q r) (truncate offset address-alignment) (multiple-value-bind (q r) (truncate offset alien-alignment)
(cond (cond
((and (= size 32) (zerop r)) ((and (= size 32) (zerop r))
(if signed (if signed
...@@ -785,31 +785,35 @@ ...@@ -785,31 +785,35 @@
(let ((n-sap (gensym)) (let ((n-sap (gensym))
(n-offset (gensym)) (n-offset (gensym))
(n-size (gensym))) (n-size (gensym)))
`(%define-alien-access `(progn
',lisp-type '(,atype ,@more-types) (%define-alien-access
#'(lambda (,n-sap ,n-offset ,n-size ,alien-var ,kind-var ,value-var ',lisp-type '(,atype ,@more-types)
,source-var) #'(lambda (,n-sap ,n-offset ,n-size ,alien-var ,kind-var ,value-var
,@(unless source-p ,source-var)
`((declare (ignore ,source-var)))) ,@(unless source-p
`((declare (ignore ,source-var))))
(unless (memq (mostcar ,alien-var) '(,atype ,@more-types))
(error "Wrong Alien type ~S, should have been ~S~ (unless (memq (mostcar ,alien-var) '(,atype ,@more-types))
~{~#[~; or~:;,~] ~S~}." (error "Wrong Alien type ~S, should have been ~S~
,alien-var ',atype ',more-types)) ~{~#[~; or~:;,~] ~S~}."
,alien-var ',atype ',more-types))
(macrolet ((with-alien ((sap)
(offset &key (macrolet ((with-alien ((sap)
((:unit ounit) 32)) (offset &key
(size &key ((:unit ounit) 32))
((:constant sconst) nil) (size &key
((:minimum smin) nil) ((:constant sconst) nil)
((:unit sunit) 32)) ((:minimum smin) nil)
&body (body decls)) ((:unit sunit) 32))
(%with-alien sap offset ounit &body (body decls))
size sconst smin sunit (%with-alien sap offset ounit
',n-sap ',n-offset ',n-size size sconst smin sunit
body decls))) ',n-sap ',n-offset ',n-size
,@body))))) body decls)))
,@body)))
#-new-compile
(eval-when (compile)
(clc::clc-mumble "alien-access ~S compiled.~%" lisp-type)))))
(eval-when (compile load eval) (eval-when (compile load eval)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment