X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fhost-alieneval.lisp;h=1f554c654885971f3e871f88d2fbb18574067a8f;hb=d720bc359f03734ccb9baf66cb45dc01d623f369;hp=db3baad686d129829ee80ee4c49cbec0cb71fed3;hpb=bda733c26c2555335d355e4bc453e443c2e5741c;p=sbcl.git diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp index db3baad..1f554c6 100644 --- a/src/code/host-alieneval.lisp +++ b/src/code/host-alieneval.lisp @@ -160,7 +160,7 @@ (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 @@ -364,8 +364,8 @@ (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) @@ -404,15 +404,27 @@ (: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))) ;;;; Interfaces to the different methods @@ -468,10 +480,10 @@ (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) @@ -484,7 +496,7 @@ (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)) @@ -502,8 +514,11 @@ (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)) ;;;; default methods @@ -521,8 +536,8 @@ (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) @@ -588,10 +603,25 @@ (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) @@ -787,7 +817,8 @@ (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) @@ -1183,7 +1214,7 @@ #!+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)