Lisp from .NET using COM

Here’s another silly example.

Calling a Lisp COM-server from .NET(use RDNZL to load compiled assembly into Lisp and call LispCOM.Foo)

using System;
using System.Runtime.InteropServices;

namespace LispCOM
{
    [Guid("F9210244-38D1-49C0-A848-684EDD3DBFF0"),
     InterfaceType(ComInterfaceType.InterfaceIsIUnknown)]
    interface IHelloWorld
    {
        void HelloWorld([In, MarshalAs(UnmanagedType.LPWStr)] string message);
    }

    [ComImport, Guid("DF748DA7-BCB9-4F67-8D32-F9AA1AAA3ABF")]
    class HelloWorld
    {
    }

    public class LispCOM
    {
        public static void Foo()
        {
            try
            {
                IHelloWorld helloWorld = (IHelloWorld)(new HelloWorld());
                helloWorld.HelloWorld("Hello from .NET!");
            }
            catch (Exception e)
            {
                Console.WriteLine("Exception: {0}", e.Message);
            }
        }
    }
}

Current status of the library is as follows(tested under Windows 2000 and Windows 7 on x86):

clisp – works

SBCL – works. But, you’ll need to use patched version of SBCL(Which you can obtain here: sources and binaries) to work with COM. Anton Kovalenko(a developer, who is currently working on improving SBCL port for Windows) has recently added support for stdcall callbacks(which is a vital thing for COM interop) to Dmitry Kalyanov’s fork of SBCL. Oh, and, here’s the patch for CFFI.

Clozure CL – COM interop works only partially. Some problems with callbacks. I will try to fix them, though.

COM-WRAPPER

Today i’ve added COM-WRAPPER-CLASS and COM-WRAPPER classes to Doors.

COM-WRAPPER is roughly identical to .NET’s “Runtime callable wrapper” – its instances encapsulate underlying COM objects and all of their interface pointers.

COM-WRAPPER’s SHARED-INITIALIZE method uses CoCreateInstanceEx function to obtain pointer to IUnknown interface and then it uses IUnknown::QueryInterface to obtain other pointers.

Wrappers are garbage-collected, meaning that you should not bother about manually calling AddRef/Release functions.

Here’s an example. Note that it uses HELLO-WORLD-OBJECT class, which is described in the previous post.

(defclass hello-world-wrapper (com-wrapper)
  ()
  (:metaclass com-wrapper-class)
  ;;A list of interfaces implemented by this class:
  (:interfaces hello-world)
  ;; In case when :clsid is a string,
  ;; CLSIDFromString function is used to obtain a GUID structure.
  (:clsid . "{DF748DA7-BCB9-4F67-8D32-F9AA1AAA3ABF}"))

;;An example
;;  (which of course implies that you've already registered
;;            a HELLO-WORLD-OBJECT server):
;(defvar *wrapper* (make-instance 'hello-world-wrapper))
;(hello-world *wrapper*) ;; ==> 'Hello, world!' message on *STANDARD-OUTPUT*

COM-CLASS metaobjects

I’ve updated Doors this morning.

COM-CLASS metaobjects are now COM-OBJECTs themselves, meaning that you can acquire their interfaces and so on.

Therefore, an example described in the previous post could be simplified to this:

(define-interface hello-world
    ((iid-hello-world
       #xF9210244 #x38D1 #x49C0
       #xA8 #x48 #x68 #x4E #xDD #x3D #xBF #xF0)
     unknown)
  (hello-world (hresult)
      (string (& wstring) :optional "Hello, world!")))

(define-guid clsid-hello-world
  #xDF748DA7 #xBCB9 #x4F67
  #x8D #x32 #xF9 #xAA #x1A #xAA #x3A #xBF)

(defclass hello-world-object (com-object)
  ()
  (:metaclass com-class)
  (:clsid . clsid-hello-world))

(defmethod hello-world ((object hello-world-object)
                        &optional (string "Hello, world!"))
  (write-line string)
  (values nil string))

(defmethod lock-server ((class (eql (find-class 'hello-world-object))) lock)
  (if lock
    (add-ref class)
    (release class))
  (values nil lock))

(defmethod create-instance
    ((class (eql (find-class 'hello-world-object))) iid &optional outer)
  (if outer
    (error 'com-error :code error-not-implemented)
    (progn
      (unless (member (class-name iid)
                      '(unknown hello-world))
        (error 'com-error :code error-no-interface))
      (let ((object (make-instance class)))
        (values nil outer iid (acquire-interface object iid))))))

(defun register-server ()
  (handler-bind
    ((windows-status #'muffle-warning))
    (initialize))
  (register-class-object 'hello-world-object :server :multiple-use))

COM interop in Doors

Last week i’ve been working mainly on improving COM-related part of Doors.

As i have mentioned before, Doors allows two-way interoperability with COM.

This means Doors allows you not only to use external interfaces, but also to define you own COM classes, and pass their instances’ interfaces into foreign code.

As you probably know, COM is a binary standard of an object model, the core concept of which is a so-called COM-interface, which is basically a pointer to an array of functions(a so-called virtual method table). COM specification requires that the only way to gain access to the methods of an interface is through a pointer to the interface.

The specification does not mention anything about the actual object which implements an interface, therefore completely separating interface from its implementation. An interface may be a part of an actual object, which is, as far as i know, the case of Visual C++, or it may be a simple proxy, which delegates interface implementation to something else. The latter case is exactly how COM interfaces are implemented in Doors.

Every lisp-side COM object(an instance of COM-OBJECT class, or any of its descendants) holds a hash-table, which maps interface classes to pointers, each of which points to a block of memory which holds a pointer to a method table. Those blocks of memory are allocated during a call to ACQUIRE-INTERFACE function(and are allocated only once for each interface class) and deallocated inside the object’s finalizer(i.e. during the process of garbage collection). By the way, objects will not be garbage collected until their reference count reaches zero.

Instance of COM-OBJECT A hash-table A block of foreign memory -------------------- ---------------------------- ------------------------------- [ interface pointers ] ----> [ interface class metaobject ] -----> [ a pointer to the method table ] -------------------- ---------------------------- ------------------------------- [ ref-count ] [ ... ] -------------------- ---------------------------- [ other slots ] [ ... ] --------------------

Method tables are constructed inside DEFINE-INTERFACE macro. Every function inside a method table is a simple trampoline which translates arguments into lisp values and calls corresponding generic function. ‘this’ argument is translated by performing a lookup in the global hash-table which maps interface pointers to lisp objects.

Methods with HRESULT return type are treated in a special way. Trampoline establishes handlers, which translate lisp errors into HRESULT codes. Warnings are also handled, but unlike errors, they do not cause stack unwinding, allowing generic function to proceed execution.

IUnknown method table --------------------------- [ QueryInterface trampoline ] -------------> QUERY-INTERFACE generic function --------------------------- [ AddRef trampoline ] -------------> ADD-REF generic function --------------------------- [ Release trampoline ] -------------> RELEASE generic function ---------------------------

Interfaces, by the way, are also represented as CLOS objects. An interface object is a simple wrapper around a pointer. Generic functions’ methods which are specialized on interface classes perform translation of lisp values into foreign values and invoke corresponding foreign functions from the interfaces’ method tables. Those methods are defined inside DEFINE-INTERFACE macro, but you can redefine them using DEFINE-INTERFACE-METHOD.

Instance of COM-INTERFACE ------------------------- [ pointer ] -----------------> Actual COM interface ------------------------- [ other slots ] [ ... ] ------------------------- IUnknown method table ----------------------- QUERY-INTERFACE ((interface UNKNOWN) iid) -----> [ QueryInterface method ] ADD-REF ((interface UNKNOWN)) ----------> [ AddRef method ] RELEASE ((interface UNKNOWN)) ----------> [ Release method ]

Here’s an example. Registering a simple COM server, which is able to output a string to the console.

(define-interface hello-world ;;interface class name
    ((iid-hello-world
       ;;Interface identifier.
       ;;this particular guid has been generated by
       ;;DOORS.COM:CREATE-GUID function
       #xF9210244 #x38D1 #x49C0
       #xA8 #x48 #x68 #x4E #xDD #x3D #xBF #xF0)
     ;;parent interface class:
     unknown)
  ;;(defmethod hello-world ((interface hello-world)
  ;;                        &optional (string "Hello, world!"))
  ;;    ...)
  (hello-world (hresult)
      ;;(& wstring) is translated into a pointer to utf-16 string
      (string (& wstring) :optional "Hello, world!")))

;;define-guid macro defines a constant variable which holds GUID structure
(define-guid clsid-hello-world
  #xDF748DA7 #xBCB9 #x4F67
  #x8D #x32 #xF9 #xAA #x1A #xAA #x3A #xBF)

;;the actual object class
(defclass hello-world-object (com-object)
  ;;this slot is required to implement IClassFactory::LockServer
  ((locked :initform nil :accessor hwo-locked-p))
  (:metaclass com-class)
  (:clsid . clsid-hello-world))

(defmethod hello-world ((object hello-world-object)
                        &optional (string "Hello, world!"))
  (write-line string)
  ;; (values ...) form is required to support arguments of
  ;; reference types(particulary :inout and :out ones).
  ;; Every method that could be called inside a trampoline
  ;;  must return all of its arguments as multiple values
  ;;  in order that is specified in the interface definition
  (values nil string))

(defmethod lock-server ((object hello-world-object) lock)
  (if (hwo-locked-p object)
    (if lock
      (warn 'windows-status :code status-false)
      (progn (release object)
             (setf (hwo-locked-p object) nil)))
    (if lock
      (progn (add-ref object)
             (setf (hwo-locked-p object) t))
      (warn 'windows-status :code status-false)))
  (values nil lock))

(defmethod create-instance
    ((object hello-world-object) iid &optional outer)
  (if outer
    (error 'com-error :code error-not-implemented)
    (progn
      (unless (typep iid 'com-interface-class)
        (setf iid (find-interface-class iid)))
      (unless (member (class-name iid)
                      ;; HELLO-WORLD-OBJECT implements only
                      ;; IUnknown, IClassFactory and HELLO-WORLD interfaces
                      '(unknown class-factory hello-world))
        (error 'com-error :code error-no-interface))
      (let ((object (make-instance 'hello-world-object)))
        (values nil outer iid (acquire-interface object iid))))))

(defun register-server ()
  (handler-bind
    ((windows-status #'muffle-warning))
    ;;CoInitialize may return S_FALSE(0x00000001)
    (initialize))
  (let* ((object (make-instance 'hello-world-object))
         (unknown (acquire-interface object 'unknown t))
         (register (register-class-object ;;CoRegisterClassObject
                     'hello-world-object ;;CLSID
                     unknown ;;an interface pointer
                     :server ;;CLSCTX_SERVER
                     :multiple-use))) ;;REGCLS_MULTIPLEUSE
    (values register object)))

;;After calling REGISTER-SERVER we can create
;;instances of hello-world-object
;;using CoCreateInstance/CoGetClassObject
;;An example:
;(defvar *hello-world-interface* (create-com-instance ;;CoCreateInstance
;                                    'hello-world-object ;;CLSID
;                                    'hello-world ;;IID
;                                    nil
;                                    :server))
;(hello-world *hello-world-interface*) ;; outputs 'Hello, world!' to *STANDARD-OUTPUT*

This server can also be called from foreign code.
I.e.

// You'll need Microsoft Visual C++ compiler to compile this.
// cl.exe /LD doors_com_example.cpp ole32.lib
// Then you should load the library into lisp using cffi:load-foreign-library
// And then call "foo" function using cffi:foreign-funcall
// i.e. (cffi:foreign-funcall "foo" :void)
// If everything goes well, you'll notice "Hi there" message on the console
#include <stdlib.h>
#include <stdio.h>
#include <windows.h>

const CLSID CLSID_HelloWorld = {0xdf748da7, 0xbcb9, 0x4f67,
                                {0x8D, 0x32, 0xf9, 0xaa, 0x1a, 0xaa, 0x3a, 0xbf}};

const IID IID_IHelloWorld = {0xf9210244, 0x38d1, 0x49c0,
                             {0xa8, 0x48, 0x68, 0x4e, 0xdd, 0x3d, 0xbf, 0xf0}};

typedef interface IHelloWorld IHelloWorld;
extern "C++"
{
    MIDL_INTERFACE("DF748DA7-BCB9-4F67-8D32-F9AA1AAA3ABF")
    IHelloWorld : public IUnknown
    {
        public:
                virtual HRESULT STDMETHODCALLTYPE HelloWorld(
                        /* [in] */ LPCWSTR message
                        ) = 0;
    };
}

extern "C"
{
    void __declspec(dllexport) foo()
    {
        IClassFactory* factory = NULL;
        IHelloWorld* helloWorld = NULL;
        HRESULT hr = 0;
        hr = CoGetClassObject(CLSID_HelloWorld, CLSCTX_INPROC_SERVER,
                              NULL, IID_IClassFactory, (void**)&factory);
        if(FAILED(hr))
        {
            printf("Failure: %08X\n", hr);
            return;
        }
        hr = factory->CreateInstance(NULL, IID_IHelloWorld, (void**)&helloWorld);
        if(FAILED(hr))
        {
            printf("Factory failure: %08X\n", hr);
            factory->Release();
            return;
        }
        hr = helloWorld->HelloWorld(L"Hi there!");
        if(FAILED(hr))
        {
            printf("HelloWorld failure: %08X\n", hr);
        }
        factory->Release();
        helloWorld->Release();
    }
}

Note for SBCL users:

COM interface methods use stdcall calling convention. And unfortunately, SBCL does not support stdcall callbacks at the moment, so passing lisp interfaces into foreign code will likely cause stack corruption and will likely result in weird errors, such as EXCEPTION_PRIV_INSTRUCTION.  Although, i’m going to implement some workaround in Virgil in the future.

Intro

This blog’s purpose is to describe the process of development of Virgil, Doors and LDX, which are my attempts to make Common Lisp more Windows-friendly.

* What purpose do these libraries serve?

Well, in short – Doors is intended to become a complete binding to the basic Windows API(including COM and OLE), LDX is an attempt to wrap DirectX into lisper-friendly form, and Virgil is an advanced FFI, which Doors and LDX use as a back-end.

* Why invent a new FFI instead of just using CFFI?

CFFI, in my opinion, suffers from several significant design flaws, which cannot be fixed rather easily:

(1)  It does not handle translations of aggregate data types, such as structures and arrays, and instead force users to directly manipulate foreign memory.  Moreover, there are no “true” aggregate types at all – all of the existing ones are represented as pointers, and because of this, the semantics of  mem-ref and (setf mem-ref) operations are highly vague.

(2) And unfortunately, CFFI isn’t extensible enough to allow users of the library to fix this issue. For example, you can not define your own aggregate types and there is no way to extend existing ones.

There are also other minor issues: all unions are treated as aggregates, string translators do not insert BOM while encoding unicode strings and always allocate new lisp string while decoding foreign one, and so on.

However, CFFI has one very significant advantage – it is highly portable.

Virgil uses its primitive types, such as :int, and its basic macros, such as foreign-funcall, and implements an advanced and extensible FFI on top of it. A FFI that is quite similar to CFFI, but strives to address its issues.

“Advanced” means in particular that it can handle translation of lisp aggregate types, such as arrays and structures into foreign memory and back(and can even handle circular references). And “extensible” means that you can extend it in any desirable way, particulary you can even define your own structure and array translators if you are not satisfied with built-in ones.

* Doors

Doors is a binding to MS Windows API.

It strives to provide as lispy interface as possible. Therefore it uses Virgil  meaning that most of the winapi function wrappers operate on lisp data – lisp structures, lisp arrays, strings etc. Also, windows error codes(those which are obtained through GetLastError function, or those which are represented by HRESULT type) are translated into lisp conditions.

Also, for the reasons described above i do not use any grovelers and/or binding generators like SWIG, and write all the code by hand.

The bindings are not yet complete,  moreover they are far from completion, given how huge winapi is.

Parts of windows api, bindings to which are implemented so far:

Windows console: http://msdn.microsoft.com/en-us/library/ms682010%28v=VS.85%29.aspx

DLLs:  http://msdn.microsoft.com/en-us/library/ms682589%28v=VS.85%29.aspx

PSAPI:  http://msdn.microsoft.com/en-us/library/ms684884%28v=VS.85%29.aspx

Handles’ stuff: http://msdn.microsoft.com/en-us/library/ms724457%28v=VS.85%29.aspx

And stuff associated with processes: http://msdn.microsoft.com/en-us/library/ms684841%28v=VS.85%29.aspx

Here’s an example. Using PSAPI to find Firefox process, and empty its working set:

(let ((pids (make-array 1024 :element-type 'dword)))
  (loop :for i :below (enum-processes pids)
    :for process = (ignore-errors ;;System may deny access to some processes.
                                  ;;In this case, condition of type WINDOWS-ERROR will be signaled.
                     (open-process '(:query-information :vm-read :set-quota)
                                   (aref pids i)))
    :when process :do
    (when (equalp (ignore-errors ;;see above
                    (module-base-name process))
                  "firefox.exe")
      (format t "~&Fat Firefox(PID ~a) uses ~:d KB of physical memory~%"
              (aref pids i)
              (floor (process-mc-working-set-size
                       (process-memory-info process))
                     1024))
      (empty-working-set process)
      (write-line "...Used."))
    (close-handle process)))

;;==> Fat Firefox(PID 1476) uses 145,356 KB of physical memory
;;    ...Used.


Few other examples can be found in my blog on livejournal(which is in Russian, fyi)

* What about COM?

Yes, Doors provides binding to Component Object Model.

The implementation is based on the paper “Modern languages and Microsoft’s component object model”, which describes interoperability with COM in Harlequin Dylan.

In short, both COM-interface wrappers and COM-objects are implemented as CLOS objects. And while interfaces are simple wrappers around com-pointers, objects are ordinary CLOS instances, with the exception that their classes must inherit from COM-OBJECT class. Both interface and object methods are implemented through generic functions, and the method tables for interfaces which are implemented by lisp-side COM-objects contain trampolines which call corresponding generic functions.

Interface wrappers, which classes inherit from UNKNOWN, may be finalized. If so, IUnknown::Release method is called inside the finalizer. But this feature is optional, because we can not determine whether the interface wrapper should be finalized in the general case. Well, at least i doubt it could be determined. If someone has any ideas on this subject, i will gladly accept them.

* LDX

LDX is a binding to Microsoft’s DirectX api. Its development has not yet started, but will begin soon.

Follow

Get every new post delivered to your Inbox.