Skip to content
Snippets Groups Projects
Commit 5339b590 authored by dtc's avatar dtc
Browse files

Enable the passing of single-float arguments in the %alien-funcall

transform; from Raymond Toy.
parent 10e743e0
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/c-call.lisp,v 1.13 1998/06/18 07:02:34 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/c-call.lisp,v 1.14 1998/07/10 03:09:45 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -96,13 +96,17 @@ ...@@ -96,13 +96,17 @@
(arg-types (alien-function-type-arg-types type)) (arg-types (alien-function-type-arg-types type))
(result-type (alien-function-type-result-type type))) (result-type (alien-function-type-result-type type)))
(assert (= (length arg-types) (length args))) (assert (= (length arg-types) (length args)))
(if (or (some #'alien-double-float-type-p arg-types) (if (or (some #'alien-single-float-type-p arg-types)
(some #'alien-double-float-type-p arg-types)
#+long-float (some #'alien-long-float-type-p arg-types)) #+long-float (some #'alien-long-float-type-p arg-types))
(collect ((new-args) (lambda-vars) (new-arg-types)) (collect ((new-args) (lambda-vars) (new-arg-types))
(dolist (type arg-types) (dolist (type arg-types)
(let ((arg (gensym))) (let ((arg (gensym)))
(lambda-vars arg) (lambda-vars arg)
(cond ((alien-double-float-type-p type) (cond ((alien-single-float-type-p type)
(new-args `(single-float-bits ,arg))
(new-arg-types (parse-alien-type '(signed 32))))
((alien-double-float-type-p type)
(new-args `(double-float-high-bits ,arg)) (new-args `(double-float-high-bits ,arg))
(new-args `(double-float-low-bits ,arg)) (new-args `(double-float-low-bits ,arg))
(new-arg-types (parse-alien-type '(signed 32))) (new-arg-types (parse-alien-type '(signed 32)))
......
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