X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-c-call.lisp;h=5d3efec57769a9c592b8ab714136fc58c1186fae;hb=2db3b6b4cb740d5b6512459c223859f747807b09;hp=df2459e4314c4557c71170c3145612e9fdd27a8b;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/code/target-c-call.lisp b/src/code/target-c-call.lisp index df2459e..5d3efec 100644 --- a/src/code/target-c-call.lisp +++ b/src/code/target-c-call.lisp @@ -1,5 +1,10 @@ -;;;; This file contains some extensions to the Alien facility to -;;;; simplify importing C interfaces. +;;;; FIXME: This file and host-c-call.lisp are separate from the +;;;; rest of the alien source code for historical reasons: CMU CL +;;;; made a distinction between the stuff in the C-CALL package and +;;;; stuff in the ALIEN package. There's no obvious boundary +;;;; there, though, and SBCL doesn't try to make this distinction, +;;;; so it might make sense to just merge these files in with the +;;;; rest of the SB-ALIEN code. ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -10,38 +15,36 @@ ;;;; provided with absolutely no warranty. See the COPYING and CREDITS ;;;; files for more information. -(in-package "SB!C-CALL") +(in-package "SB!ALIEN") ;;;; extra types -(def-alien-type char (integer 8)) -(def-alien-type short (integer 16)) -(def-alien-type int (integer 32)) -(def-alien-type long (integer #!-alpha 32 #!+alpha 64)) +(define-alien-type char (integer 8)) +(define-alien-type short (integer 16)) +(define-alien-type int (integer 32)) +(define-alien-type long (integer #!-alpha 32 #!+alpha 64)) -(def-alien-type unsigned-char (unsigned 8)) -(def-alien-type unsigned-short (unsigned 16)) -(def-alien-type unsigned-int (unsigned 32)) -(def-alien-type unsigned-long (unsigned #!-alpha 32 #!+alpha 64)) +(define-alien-type unsigned-char (unsigned 8)) +(define-alien-type unsigned-short (unsigned 16)) +(define-alien-type unsigned-int (unsigned 32)) +(define-alien-type unsigned-long (unsigned #!-alpha 32 #!+alpha 64)) -(def-alien-type float single-float) -(def-alien-type double double-float) +(define-alien-type float single-float) +(define-alien-type double double-float) -(def-alien-type-translator void () +(define-alien-type-translator void () (parse-alien-type '(values) (sb!kernel:make-null-lexenv))) (defun %naturalize-c-string (sap) (declare (type system-area-pointer sap)) - (with-alien ((ptr (* char) sap)) - (locally - (declare (optimize (speed 3) (safety 0))) - (let ((length (loop - for offset of-type fixnum upfrom 0 - until (zerop (deref ptr offset)) - finally (return offset)))) - (let ((result (make-string length))) - (sb!kernel:copy-from-system-area (alien-sap ptr) 0 - result (* sb!vm:vector-data-offset - sb!vm:word-bits) - (* length sb!vm:byte-bits)) - result))))) + (locally + (declare (optimize (speed 3) (safety 0))) + (let ((length (loop for offset of-type fixnum upfrom 0 + until (zerop (sap-ref-8 sap offset)) + finally (return offset)))) + (let ((result (make-string length))) + (sb!kernel:copy-from-system-area sap 0 + result (* sb!vm:vector-data-offset + sb!vm:n-word-bits) + (* length sb!vm:n-byte-bits)) + result))))