[bknr-cvs] r2491 - in branches/trunk-reorg/thirdparty: slime uffi-1.6.0/src

[hhubner at common-lisp.net]

Author: hhubner
Date: Thu Feb 14 04:02:22 2008
New Revision: 2491

Modified:
   branches/trunk-reorg/thirdparty/slime/swank.lisp
   branches/trunk-reorg/thirdparty/uffi-1.6.0/src/primitives.lisp
Log:
Fixes for thirdparty packages to make quickhoney run on CCL (and it does!):

UFFI:  Support pointer-to-pointer in structures
SLIME: Fix Marco's package deletion fix again


Modified: branches/trunk-reorg/thirdparty/slime/swank.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/swank.lisp	(original)
+++ branches/trunk-reorg/thirdparty/slime/swank.lisp	Thu Feb 14 04:02:22 2008
@@ -82,9 +82,12 @@
   "Abbreviate dotted package names to their last component if T.")
 
 (defvar *swank-io-package*
-  (let ((package (make-package :swank-io-package :use '())))
-    (import '(nil t quote) package)
-    package))
+  (progn
+    (when (find-package :swank-io-package)
+      (delete-package :swank-io-package))
+    (let ((package (make-package :swank-io-package :use '())))
+      (import '(nil t quote) package)
+      package)))
 
 (defconstant default-server-port 4005
   "The default TCP port for the server (when started manually).")

Modified: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/primitives.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/uffi-1.6.0/src/primitives.lisp	(original)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/primitives.lisp	Thu Feb 14 04:02:22 2008
@@ -286,7 +286,10 @@
      #+openmcl
      ((eq (car result) :address)
       (if (eq context :struct)
-	  (append '(:*) (cdr result))
+	  (append '(:*) (if (listp (cadr result))
+                            ;; hack to make pointers to pointers work
+                            (list (convert-from-uffi-type (cadr result) context))
+                            (cdr result)))
 	:address))
      #+digitool
      ((and (eq (car result) :pointer) (eq context :allocation) :pointer))