Skip to content
Snippets Groups Projects
Commit 518b6f8d authored by wlott's avatar wlott
Browse files

This commit was generated by cvs2svn to compensate for changes in r883,

which included commits to RCS files with non-trunk default branches.
parents 9e4a0b26 cbfedf18
No related branches found
No related tags found
No related merge requests found
...@@ -196,6 +196,11 @@ ...@@ -196,6 +196,11 @@
:description spec :description spec
:size size :size size
:alignment (find-alignment size))))) :alignment (find-alignment size)))))
(pointer
(make-primitive-type
:description spec
:size vm:word-bits
:alignment vm:word-bits))
(alien (alien
(let ((size (third spec))) (let ((size (third spec)))
(unless size (unless size
...@@ -598,7 +603,9 @@ ...@@ -598,7 +603,9 @@
(setf (routine-info-arg-size info) (setf (routine-info-arg-size info)
(+ offset size)) (+ offset size))
(push `(defoperator (,(arg-info-buffer arg) (push `(defoperator (,(arg-info-buffer arg)
,(c-type-description (arg-info-type arg))) ,(c-type-description
(pointer-type-to
(arg-info-type arg))))
((foo ,(routine-info-stack-record info))) ((foo ,(routine-info-stack-record info)))
`(alien-index (alien-value ,foo) ,,offset ,,size)) `(alien-index (alien-value ,foo) ,,offset ,,size))
top-level-forms) top-level-forms)
...@@ -626,10 +633,14 @@ ...@@ -626,10 +633,14 @@
,,(arg-info-offset arg) ,,(arg-info-offset arg)
,,size)) ,,size))
top-level-forms)) top-level-forms))
(push `(setf (alien-access (,(arg-info-accessor arg) (push
(alien-value stack))) `(setf (alien-access (,(arg-info-accessor arg)
,(arg-info-passing-form arg)) (alien-value stack))
arg-set-forms)) ,@(when (or (not (eq (arg-info-mode arg) :in))
(pointer-type-p (arg-info-type arg)))
'('system-area-pointer)))
,(arg-info-passing-form arg))
arg-set-forms))
(when (member (arg-info-mode arg) '(:out :in-out)) (when (member (arg-info-mode arg) '(:out :in-out))
(push `(alien-access (,(arg-info-buffer arg) stack)) (push `(alien-access (,(arg-info-buffer arg) stack))
...@@ -807,16 +818,16 @@ ...@@ -807,16 +818,16 @@
(c-size (c-type-size c-info))) (c-size (c-type-size c-info)))
`(progn `(progn
(defparameter ,symbol (defparameter ,symbol
(make-alien ',type ,size (make-alien ',c-type ,c-size
(%primitive c::foreign-symbol-address ,name))) (%primitive c::foreign-symbol-address ,name)))
(eval-when ,*alien-eval-when* (eval-when ,*alien-eval-when*
(setf (info variable alien-value ',name) (setf (info variable alien-value ',symbol)
(lisp::make-ct-a-val (lisp::make-ct-a-val
:type ',type :type ',c-type
:size ,size :size ,c-size
:offset 0 :offset 0
:sap '(%primitive c::foreign-symbol-addres ,name) :sap '(%primitive c::foreign-symbol-address ,name)
:alien ',name))))))) :alien ',symbol)))))))
#| #|
;;; Def-C-Procedure defines data structures etc. so that C can be passed ;;; Def-C-Procedure defines data structures etc. so that C can be passed
......
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