diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-10-04 22:03:25 +0200 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-10-04 22:03:25 +0200 |
| commit | 8c5db651a2d55a8692b0dd78e37d4c01c4794585 (patch) | |
| tree | 6464d1133b0bb9f1011e2732c6f8938f930d1a87 /Lisp/method-invocation.lisp | |
| parent | 37222b85b82a8152dbf5223cb346e3114f167624 (diff) | |
Make PRIMITIVE-INVOKE compatible with Allegro CL.
darcs-hash:fbad6db938521eb19fe3bf74ed61ad4577651276
Diffstat (limited to 'Lisp/method-invocation.lisp')
| -rw-r--r-- | Lisp/method-invocation.lisp | 30 |
1 files changed, 19 insertions, 11 deletions
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 |