I am trying to get rdnzl 0.13.3 to work on clozure cl 1.6 on a windows 7 32 bit machine. I am running it from the lisp in a box system. I've tried both with slime and w/o slime and I get the same problem. I modified port-sbcl.lisp and added the appropriate #+:ccl in load.lisp. I included the content of the port-sbcl.lisp file below (I know this makes it a long post but I hope its ok). I then tried to run the first example: CL-USER> (load "C:/Users/idan.mandelbaum/Desktop/lispbox-0.7/rdnzl-0.13.3/load.lisp") #P"C:/Users/idan.mandelbaum/Desktop/lispbox-0.7/rdnzl-0.13.3/load.lisp" CL-USER> (in-package rdnzl-user) #<Package "RDNZL-USER"> RDNZL-USER> (enable-rdnzl-syntax) ; No value RDNZL-USER> (import-types "System.Windows.Forms" "MessageBox" "MessageBoxButtons" "DialogResult")
I get the following: Trying to call function RDNZL::%INVOKE-STATIC-MEMBER with NULL object #<CONTAINER NULL #x28C1B10>. [Condition of type SIMPLE-ERROR] Restarts: 0: [RETRY] Retry SLIME REPL evaluation request. 1: [*ABORT] Return to SLIME's top level. 2: [ABORT-BREAK] Reset this thread 3: [ABORT] Kill this thread Backtrace: 0: (INVOKE "System.Reflection.Assembly" "LoadWithPartialName" "System.Windows.Forms") Locals: RDNZL::OBJECT = "System.Reflection.Assembly" RDNZL::METHOD-NAME = "LoadWithPartialName" RDNZL::ARGS = ("System.Windows.Forms") #:OBJECT1390 = #<CONTAINER NULL #x28C1B10> #:POINTER1391 = #<A Foreign Pointer #x28C1B10> 1: (LOAD-ASSEMBLY "System.Windows.Forms") Locals: RDNZL::NAME = "System.Windows.Forms" 2: (IMPORT-TYPES "System.Windows.Forms" "MessageBox" "MessageBoxButtons" "DialogResult") 3: (CCL::CALL-CHECK-REGS IMPORT-TYPES "System.Windows.Forms" "MessageBox" "MessageBoxButtons" "DialogResult") 4: (CCL::CHEAP-EVAL (IMPORT-TYPES "System.Windows.Forms" "MessageBox" "MessageBoxButtons" "DialogResult")) 5: (SWANK::EVAL-REGION "(import-types "System.Windows.Forms" "MessageBox" "MessageBoxButtons" "DialogResult")\n") 6: ((:INTERNAL SWANK::REPL-EVAL)) 7: (SWANK::TRACK-PACKAGE #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL SWANK::REPL-EVAL) #x1891A766>) 8: (SWANK::CALL-WITH-RETRY-RESTART "Retry SLIME REPL evaluation request." #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL SWANK::REPL-EVAL) #x1891A7B6>) 9: (SWANK::CALL-WITH-BUFFER-SYNTAX NIL #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL SWANK::REPL-EVAL) #x1891A7DE>) 10: (SWANK::REPL-EVAL "(import-types "System.Windows.Forms" "MessageBox" "MessageBoxButtons" "DialogResult")\n") 11: (CCL::CALL-CHECK-REGS SWANK:LISTENER-EVAL "(import-types "System.Windows.Forms" "MessageBox" "MessageBoxButtons" "DialogResult")\n") 12: (CCL::CHEAP-EVAL (SWANK:LISTENER-EVAL "(import-types "System.Windows.Forms" "MessageBox" "MessageBoxButtons" "DialogResult")\n")) 13: (SWANK:EVAL-FOR-EMACS (SWANK:LISTENER-EVAL "(import-types "System.Windows.Forms" "MessageBox" "MessageBoxButtons" "DialogResult")\n") "RDNZL-USER" 11) 14: (SWANK::PROCESS-REQUESTS NIL) 15: ((:INTERNAL SWANK::HANDLE-REQUESTS)) 16: ((:INTERNAL SWANK::HANDLE-REQUESTS)) 17: (SWANK-BACKEND:CALL-WITH-DEBUGGER-HOOK #<Compiled-function SWANK:SWANK-DEBUGGER-HOOK #x1844386E> #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL SWANK::HANDLE-REQUESTS) #x187AC8C6>) 18: (SWANK::CALL-WITH-BINDINGS ((*STANDARD-OUTPUT* . #<SWANK-BACKEND::SLIME-OUTPUT-STREAM #x1879F07E>) (*STANDARD-INPUT* . #<SWANK-BACKEND::SLIME-INPUT-STREAM #x1879F2B6>) ..))) #<CCL:COMPILED-LEXICAL-CLO.. 19: (SWANK::HANDLE-REQUESTS #<CONNECTION #x186C734E> NIL) 20: (CCL::RUN-PROCESS-INITIAL-FORM #<PROCESS repl-thread(10) [Active] #x1879F786> (#<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL CCL::%PROCESS-RUN-FUNCTION) #x1879F646>)) 21: ((:INTERNAL (CCL::%PROCESS-PRESET-INTERNAL (CCL:PROCESS))) #<PROCESS repl-thread(10) [Active] #x1879F786> (#<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL CCL::%PROCESS-RUN-FUNCTION) #x1879F646>)) 22: ((:INTERNAL CCL::THREAD-MAKE-STARTUP-FUNCTION)) I traced this to a failure in [System.Reflection.Assembly.LoadWithPartialName name] called within load-addembly in the import.lisp file. Upon further tracing it seems like the error ocures becasue make-type-from-name may have a problem when called with "System.Reflection.Assembly". I think they might be something wrong with the way I am working with strings in the ffi-call-with-foreign-string* function below. Any thoughts/ideas? My modified port-sbcl.lisp file (called port-clozurecl.lisp) ;;; Clozure-specific definitions (in-package :rdnzl) (defconstant +ffi-pointer-size+ 4 "The size of a pointer in octets.") (defmacro ffi-register-module (path &optional (module-name path)) "Loads a C library designated by PATH." (declare (ignore module-name)) `(eval-when (:compile-toplevel :load-toplevel :execute) (ccl:open-shared-library ,path))) (defun ffi-pointer-p (object) "Tests whether OBJECT is an FFI pointer." (typep object 'ccl:macptr)) (defun ffi-null-pointer-p (pointer) "Returns whether the FFI pointer POINTER is a null pointer." (ccl:%null-ptr-p pointer)) (defun ffi-pointer-address (pointer) "Returns the address of the FFI pointer POINTER." (ccl:%ptr-to-int pointer)) ;Defines void pointer to use in this package (ccl:def-foreign-type :voidpointer (:* T)) (defun ffi-map-type (type-name) "Maps type names like FFI-INTEGER to their corresponding names in the SBCL FFI." (ecase type-name (ffi-void ':void) (ffi-void-pointer '(:* T)) (ffi-const-string ':address) (ffi-integer ':signed-halfword) (ffi-boolean ':unsigned-byte) (ffi-wide-char ':unsigned-halfword) (ffi-unsigned-short ':unsigned-halfword) (ffi-float ':single-float) (ffi-double ':double-float))) (defun flatten (structure) "Flatten only the first level of a list of arguments for use in ccl:ffi macros below" (cond ((null structure) nil) (t (append (first structure) (flatten (rest structure)))))) (defmacro ffi-define-function* ((lisp-name c-name) arg-list result-type) "Defines a Lisp function LISP-NAME which acts as an interface to the C function C-NAME. ARG-LIST is a list of (NAME TYPE) pairs. All types are supposed to be symbols mappable by FFI-MAP-TYPE above." `(defun ,lisp-name ,(mapcar #'first arg-list) (ccl:external-call ,c-name ,@(flatten (mapcar (lambda (name-and-type) (destructuring-bind (name type) name-and-type (list (ffi-map-type type) name))) arg-list)) ,(when (ffi-map-type result-type) (ffi-map-type result-type))))) (defmacro ffi-define-callable ((c-name result-type) arg-list &body body) "Defines a Lisp function which can be called from C. ARG-LIST is a list of (NAME TYPE) pairs. All types are supposed to be symbols mappable by FFI-MAP-TYPE above." `(ccl:defcallback ,c-name ( ,@(flatten (mapcar (lambda (name-and-type) (destructuring-bind (name type) name-and-type (list (ffi-map-type type) name))) arg-list)) ,(when (ffi-map-type result-type) (ffi-map-type result-type)) ) ,@body)) (defun ffi-make-pointer (name) "Returns an FFI pointer to the (callback) address specified by the name NAME." (if (symbolp name) (symbol-value name) name)) (defun ffi-make-null-pointer () "Returns an FFI NULL pointer." (ccl:%null-ptr)) (defun ffi-alloc (size) "Allocates an `alien' of size SIZE octets and returns a pointer to it. Must be freed with FFI-FREE afterwards." (#_malloc size)) (defun ffi-free (pointer) "Frees space that was allocated with FFI-ALLOC." (#_free pointer)) (defun ffi-convert-from-foreign-ucs-2-string (pointer size) "Converts the foreign UCS-2 string pointed to by POINTER of size SIZE octets to a Lisp string." (with-output-to-string (out) (loop for i from 0 below size by 2 do (write-char (code-char (+ (ccl:%get-unsigned-byte pointer i) (ash (ccl:%get-unsigned-byte pointer (1+ i)) 8))) out)))) (defmacro ffi-get-call-by-ref-string (function object length-function) "Calls the foreign function FUNCTION. FUNCTION is supposed to call a C function f with the signature void f(..., __wchar_t *s) where s is a result string which is returned by this macro. OBJECT is the first argument given to f. Prior to calling f the length of the result string s is obtained by evaluating (LENGTH-FUNCTION OBJECT)." (with-rebinding (object) (with-unique-names (length temp) `(let ((,length (* 2 (,length-function ,object))) ,temp) (unwind-protect (progn (setq ,temp (ffi-alloc (+ 2 ,length))) (,function ,object ,temp) (ffi-convert-from-foreign-ucs-2-string ,temp ,length)) (when ,temp (ffi-free ,temp))))))) (defmacro with-ucs-2-string ((var lisp-string) &body body) "Converts the Lisp string LISP-STRING to a foreign string using UCS-2 encoding and evaluates BODY with VAR bound to this foreign string." `(ccl:with-encoded-cstrs :ucs-2 ((,var ,lisp-string)) ,@body)) (defmacro ffi-call-with-foreign-string* (function string &optional other-args) "Applies the foreign function FUNCTION to the string STRING and OTHER-ARGS. OTHER-ARGS (a list of CONTAINER structures or `native' Lisp objects) is converted to a foreign array prior to calling FUNCTION. STRING may be NIL which means that this argument is skipped (i.e. the macro actually needs a better name)." (with-rebinding (other-args) (with-unique-names (length arg-pointers ffi-arg-pointers arg i arg-pointer foreign-string) (declare (ignorable foreign-string)) `(let* ((,length (length ,other-args)) (,arg-pointers (make-array ,length :initial-element nil))) (unwind-protect (let ((,ffi-arg-pointers (loop for ,arg in ,other-args for ,i from 0 for ,arg-pointer = (cond ((container-p ,arg) (pointer ,arg)) (t (setf (aref ,arg-pointers ,i) (box* ,arg)))) collect ,arg-pointer))) ,(cond (string `(with-ucs-2-string (,foreign-string ,string) (apply #',function ,foreign-string ,ffi-arg-pointers))) (t `(apply #',function ,ffi-arg-pointers)))) ;; all .NET elements that were solely created (by BOX*) ;; for this FFI call are immediately freed (dotimes (,i ,length) (named-when (,arg-pointer (aref ,arg-pointers ,i)) (%free-dot-net-container ,arg-pointer)))))))) (defmacro ffi-call-with-args* (function object name args) "Applies the foreign function FUNCTION to OBJECT and ARGS. ARGS (a list of CONTAINER structures or `native' Lisp objects) is converted to a foreign array prior to calling FUNCTION. If NAME is not NIL, then it should be a string and the first argument to FUNCTION will be the corresponding foreign string." (with-rebinding (args) (with-unique-names (length arg-pointers ffi-arg-pointers arg i j arg-pointer foreign-name) (declare (ignorable foreign-name)) `(let* ((,length (length ,args)) (,arg-pointers (make-array ,length :initial-element nil)) ,ffi-arg-pointers) (unwind-protect (progn (setq ,ffi-arg-pointers (ffi-alloc (* ,length +ffi-pointer-size+))) (loop for ,arg in ,args for ,i from 0 for ,j from 0 by +ffi-pointer-size+ for ,arg-pointer = (cond ((container-p ,arg) (pointer ,arg)) (t (setf (aref ,arg-pointers ,i) (box* ,arg)))) do (ccl:%setf-macptr (ccl:%get-ptr ,ffi-arg-pointers ,j) ,arg-pointer)) ,(cond (name `(with-ucs-2-string (,foreign-name ,name) (,function ,foreign-name ,object ,length ,ffi-arg-pointers))) (t `(,function ,object ,length ,ffi-arg-pointers)))) (when ,ffi-arg-pointers (ffi-free ,ffi-arg-pointers)) ;; all .NET elements that were solely created (by BOX*) ;; for this FFI call are immediately freed (dotimes (,i ,length) (named-when (,arg-pointer (aref ,arg-pointers ,i)) (%free-dot-net-container ,arg-pointer)))))))) (defmacro make-fun-for-finalization (object function) "Make function to call function for flag-for finalization since clozure cl only allows function ccl:terminate to be called" `(defmethod ccl:terminate ((x ,(type-of object))) (funcall ,function))) (defun flag-for-finalization (object &optional function) "Mark OBJECT such that FUNCTION is applied to OBJECT before OBJECT is removed by GC." (ccl:terminate-when-unreachable object) (unless (null function) (make-fun-for-finalization object function))) (defun register-exit-function (function &optional name) "Makes sure the function FUNCTION (with no arguments) is called before the Lisp images exits." ;; don't know how to do that in SBCL (declare (ignore function name))) (defun full-gc () "Invokes a full garbage collection." (ccl:gc))