Commit 79da408f authored by wlott's avatar wlott
Browse files

Fixed DEF-ALIEN-ROUTINE to only make local alien variables with WITH-ALIEN

for things we need to take the address of.  Otherwise, just pass in the
parent 85ee6da1
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.13 1992/02/14 23:44:11 wlott Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.14 1992/02/19 03:04:20 wlott Exp $")
;;; **********************************************************************
......@@ -1728,7 +1728,7 @@
(lisp-name alien-name)
(pick-lisp-and-alien-names name)
(collect ((docs) (lisp-args) (arg-types) (alien-vars)
(collect ((docs) (lisp-args) (arg-types) (alien-vars) (decls)
(alien-args) (results))
(dolist (arg args)
(if (stringp arg)
......@@ -1737,20 +1737,22 @@
(unless (member style '(:in :copy :out :in-out))
(error "Bogus argument style ~S in ~S." style arg))
(unless (eq style :out)
(lisp-args name))
(if (eq style :in)
(arg-types type)
(arg-types `(* ,type)))
(if (eq style :out)
(alien-vars `(,name ,type))
(alien-vars `(,name ,type ,name)))
(if (eq style :in)
(alien-args name)
(alien-args `(addr ,name)))
(lisp-args name)
(decls `(type (alien ,type) ,name)))
(cond ((eq style :in)
(arg-types type)
(alien-args name))
(arg-types `(* ,type))
(if (eq style :out)
(alien-vars `(,name ,type))
(alien-vars `(,name ,type ,name)))
(alien-args `(addr ,name))))
(when (or (eq style :out) (eq style :in-out))
(results name)))))
`(defun ,lisp-name ,(lisp-args)
(declare ,@(decls))
((,lisp-name (function ,result-type ,@(arg-types))
:extern ,alien-name)
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment