From 8c5db651a2d55a8692b0dd78e37d4c01c4794585 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Thu, 4 Oct 2007 22:03:25 +0200 Subject: Make PRIMITIVE-INVOKE compatible with Allegro CL. darcs-hash:fbad6db938521eb19fe3bf74ed61ad4577651276 --- Lisp/method-invocation.lisp | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) (limited to 'Lisp/method-invocation.lisp') diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index 8f80621..b260f2a 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -231,15 +231,25 @@ easier to use with __apply__. for i from 0 to raw-argc do (let* ((type-name (lisp-value->type-name arg))) (typecase arg + ;; According to Allegro CL, strings + ;; are POINTERP (and thus elements of + ;; the C-POINTER type), so they have + ;; to come first in this TYPECASE + ;; form. Weird. + ;; + ;; By the way, pointers are + ;; represented as integers in Allegro + ;; CL, so all integers are POINTERP, + ;; too. + (string + (setf (argref :string (+ i 2)) + (alloc-string-and-register arg))) ((or c-pointer-wrapper c-pointer) (setf (argref :pointer (+ i 2)) (typecase arg (c-pointer-wrapper (pointer-to arg)) (t arg)))) - (string - (setf (argref :string (+ i 2)) - (alloc-string-and-register arg))) (t (setf (argref (type-name->c-type type-name) (+ i 2)) arg))) @@ -247,14 +257,12 @@ easier to use with __apply__. (alloc-string-and-register (type-name->type-id type-name))))))) (ad-hoc-arglist->objc-arglist! args) - (let* ((return-type-cell (alloc-string-and-register - (type-name->type-id return-type))) - (error-cell - (%objcl-invoke-with-types raw-argc - return-type-cell - arg-types - return-value-cell - objc-arg-ptrs))) + (let ((error-cell + (%objcl-invoke-with-types raw-argc + (type-name->type-id return-type) + arg-types + return-value-cell + objc-arg-ptrs))) (unless (cffi:null-pointer-p error-cell) ;; Note that we do not FOREIGN-FREE the error cell, ;; because it is either a null pointer or a pointer to -- cgit v1.2.3