(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
(defun auxiliary-type-definitions (env)
(multiple-value-bind (result expanded-p)
- (sb!xc:macroexpand '&auxiliary-type-definitions& env)
+ (%macroexpand '&auxiliary-type-definitions& env)
(if expanded-p
result
;; This is like having the global symbol-macro definition be
(declare (ignore type))
'system-area-pointer)
-(define-alien-type-method (system-area-pointer :alien-rep) (type)
- (declare (ignore type))
+(define-alien-type-method (system-area-pointer :alien-rep) (type context)
+ (declare (ignore type context))
'system-area-pointer)
(define-alien-type-method (system-area-pointer :naturalize-gen) (type alien)
(:make-load-form-fun sb!kernel:just-dump-it-normally))
;; The type of this alien.
(type (missing-arg) :type alien-type)
- ;; The form to evaluate to produce the SAP pointing to where in the heap
- ;; it is.
- (sap-form (missing-arg)))
+ ;; Its name.
+ (alien-name (missing-arg) :type simple-string)
+ ;; Data or code?
+ (datap (missing-arg) :type boolean))
(def!method print-object ((info heap-alien-info) stream)
(print-unreadable-object (info stream :type t)
- (funcall (formatter "~S ~S")
+ (funcall (formatter "~S ~S~@[ (data)~]")
stream
- (heap-alien-info-sap-form info)
- (unparse-alien-type (heap-alien-info-type info)))))
+ (heap-alien-info-alien-name info)
+ (unparse-alien-type (heap-alien-info-type info))
+ (heap-alien-info-datap info))))
+
+;;; The form to evaluate to produce the SAP pointing to where in the heap
+;;; it is.
+(defun heap-alien-info-sap-form (info)
+ `(foreign-symbol-sap ,(heap-alien-info-alien-name info)
+ ,(heap-alien-info-datap info)))
+
+(defun heap-alien-info-sap (info)
+ (foreign-symbol-sap (heap-alien-info-alien-name info)
+ (heap-alien-info-datap info)))
\f
;;;; Interfaces to the different methods
(def!macro maybe-with-pinned-objects (variables types &body body)
(declare (ignorable variables types))
(let ((pin-variables
- ;; Only pin things on x86/x86-64, since on non-conservative
- ;; gcs it'd imply disabling the GC. Which is something we
- ;; don't want to do every time we're calling to C.
- #!+(or x86 x86-64)
+ ;; Only pin things on GENCGC, since on CHENEYGC it'd imply
+ ;; disabling the GC. Which is something we don't want to do
+ ;; every time we're calling to C.
+ #!+gencgc
(loop for variable in variables
for type in types
when (invoke-alien-type-method :deport-pin-p type)
(defun compute-deposit-lambda (type)
(declare (type alien-type type))
- `(lambda (sap offset ignore value)
+ `(lambda (value sap offset ignore)
(declare (type system-area-pointer sap)
(type unsigned-byte offset)
(ignore ignore))
(defun compute-lisp-rep-type (type)
(invoke-alien-type-method :lisp-rep type))
-(defun compute-alien-rep-type (type)
- (invoke-alien-type-method :alien-rep type))
+;;; CONTEXT is either :NORMAL (the default) or :RESULT (alien function
+;;; return values). See the :ALIEN-REP method for INTEGER for
+;;; details.
+(defun compute-alien-rep-type (type &optional (context :normal))
+ (invoke-alien-type-method :alien-rep type context))
\f
;;;; default methods
(declare (ignore type))
nil)
-(define-alien-type-method (root :alien-rep) (type)
- (declare (ignore type))
+(define-alien-type-method (root :alien-rep) (type context)
+ (declare (ignore type context))
'*)
(define-alien-type-method (root :naturalize-gen) (type alien)
(list (if (alien-integer-type-signed type) 'signed-byte 'unsigned-byte)
(alien-integer-type-bits type)))
-(define-alien-type-method (integer :alien-rep) (type)
- (list (if (alien-integer-type-signed type) 'signed-byte 'unsigned-byte)
- (alien-integer-type-bits type)))
-
+(define-alien-type-method (integer :alien-rep) (type context)
+ ;; When returning integer values that are narrower than a machine
+ ;; register from a function, some platforms leave the higher bits of
+ ;; the register uninitialized. On those platforms, we use an
+ ;; alien-rep of the full register width when checking for purposes
+ ;; of return values and override the naturalize method to perform
+ ;; the sign extension (in compiler/target/c-call.lisp).
+ (ecase context
+ ((:normal #!-(or x86 x86-64) :result)
+ (list (if (alien-integer-type-signed type) 'signed-byte 'unsigned-byte)
+ (alien-integer-type-bits type)))
+ #!+(or x86 x86-64)
+ (:result
+ (list (if (alien-integer-type-signed type) 'signed-byte 'unsigned-byte)
+ sb!vm:n-word-bits))))
+
+;;; As per the comment in the :ALIEN-REP method above, this is defined
+;;; elsewhere for x86oids.
+#!-(or x86 x86-64)
(define-alien-type-method (integer :naturalize-gen) (type alien)
(declare (ignore type))
alien)
(define-alien-type-method (float :lisp-rep) (type)
(alien-float-type-type type))
-(define-alien-type-method (float :alien-rep) (type)
+(define-alien-type-method (float :alien-rep) (type context)
+ (declare (ignore context))
(alien-float-type-type type))
(define-alien-type-method (float :naturalize-gen) (type alien)
#!+sb-doc
"Return an Alien pointer to the data addressed by Expr, which must be a call
to SLOT or DEREF, or a reference to an Alien variable."
- (let ((form (sb!xc:macroexpand expr env)))
+ (let ((form (%macroexpand expr env)))
(or (typecase form
(cons
(case (car form)
projects / sbcl.git / blobdiff