lispとrubyとpythonと その4 Cライブラリの呼び出し(lisp）

今回はCライブラリの呼び出し。
SBCL限定なので注意。
sb-alienにCを呼び出すために必要なもろもろが入ってる。
一応動いてるんだけど、これであってんのかなぁ。
C側でmallocした時とか、GCのコンパクションでまずいことになったりしないんだろうか・・・。
参考はここ。
http://www.sbcl.org/manual/Foreign-Function-Interface.html#Foreign-Function-Interface

まず、呼び出すcのライブラリはこんなの。

ffi-test.h

int f(int i);

int f0(char* buf,int len);

int f1(char** buf);

char* f2();

typedef struct person{
  char* name;
  int age;
} person_t;

int f3(person_t* person,int len);

int f4(person_t** person);

実装はこちら。
ffi-test.c

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "ffi-test.h"

int f(int i)
{
  return i + 1;
}

//呼び出し元でAlloc
int f0(char* buf,int len)
{
  printf("hello\n");
  strncpy(buf,"日本語\n",len);
  return 0;
}

//関数内でAlloc
int f1(char** buf)
{
  int sz = sizeof(char) * 64;
  *buf =(char*) malloc(sz);
  strncpy(*buf,"日本語2\n",sizeof(char) * 64);
  return 0;
}

//戻り値で返してみる
char* f2()
{
  int sz = sizeof(char) * 64;
  char* buf =(char*) malloc(sz);
  strncpy(buf,"日本語3\n",sizeof(char) * 64);
  return buf;
}

//構造体 呼び出し元でAlloc
int f3(person_t* person,int len)
{
  strncpy(person->name,"名前あああ",len);
  person->age = 30;
  return 0;
}

//構造体 関数内でAlloc
int f4(person_t** person)
{
  int sz1 = sizeof(person_t);
  *person = (person_t*)malloc(sz1);
  int sz2 = sizeof(char) * 64;
  (*person)->name = malloc(sz2);
  strncpy((*person)->name,"名前いいい",sz2);
  (*person)->age = 40;
  return 0;
}

んで、これを

gcc -shared ffitest.c -o libffi-test.so

でコンパイル。

呼び出すlisp側はこんな感じ。
define-alien-routineでcライブラリとのラッパを宣言。
make-alienがmallocでfree-alienがfree。

(load-shared-object "libffi-test.so")

(declaim (inline f))
(sb-alien:define-alien-routine f
    sb-alien:int
  (i sb-alien:int))

(declaim (inline f0))
(sb-alien:define-alien-routine f0
    sb-alien:int
  (buf (sb-alien:* sb-alien:char))
  (len sb-alien:int))

(declaim (inline f1))
(sb-alien:define-alien-routine f1
    sb-alien:int
  (buf (sb-alien:* (sb-alien:c-string :external-format :utf8))))

(declaim (inline f2))
(sb-alien:define-alien-routine f2
    sb-alien:c-string)

(sb-alien:define-alien-type person_t
    (sb-alien:struct person
       (name (sb-alien:* sb-alien:char))
       (age int)))

(declaim (inline f3))
(sb-alien:define-alien-routine f3
    sb-alien:int
  (person (sb-alien:* person_t))
  (len sb-alien:int))

(declaim (inline f4))
(sb-alien:define-alien-routine f4
    sb-alien:int
  (buf (sb-alien:* (sb-alien:* person_t))))

(defun lisp-f0()
  (sb-alien:with-alien ((len sb-alien:int (* (sb-alien:alien-size sb-alien:char) 64))
   (buf (sb-alien:* sb-alien:char) (sb-alien:make-alien sb-alien:char len)))
    (unwind-protect
        (sb-alien:with-alien ((status sb-alien:int (f0 buf len))
                (rtn (sb-alien:c-string :external-format :utf8) buf))
          rtn)
      (sb-alien:free-alien buf))))

(defun lisp-f1()
  (sb-alien:with-alien ((buf (sb-alien:c-string :external-format :utf8)))
    (sb-alien:with-alien ((rtn sb-alien:int (f1 (sb-alien:addr buf))))
      buf)))

(defun lisp-f2()
  (sb-alien:with-alien ((buf (sb-alien:c-string :external-format :utf8) (f2)))
    buf))

(defun lisp-f3()
  (sb-alien:with-alien ((len sb-alien:int (* (sb-alien:alien-size sb-alien:char) 64))
   (p
    (sb-alien:* person_t)
    (sb-alien:make-alien person_t 1)))
    (unwind-protect
  (progn
    (setf (slot p 'name) (sb-alien:make-alien sb-alien:char len))
    (unwind-protect
  (sb-alien:with-alien ((status sb-alien:int (f3 p len))
          (rtn (sb-alien:c-string :external-format :utf8) (slot p 'name)))
    rtn)
      (sb-alien:free-alien (slot p 'name))))
      (sb-alien:free-alien p))))

(defun lisp-f4()
  (sb-alien:with-alien ((p (sb-alien:* person_t))
   (status sb-alien:int (f4 (sb-alien:addr p)))
   (rtn (sb-alien:c-string :external-format :utf8) (slot p 'name)))
    rtn))

で呼び出し結果がこれ。

CL-USER> (lisp-f0)
"日本語
"
CL-USER> (lisp-f1)
"日本語2
"
CL-USER> (lisp-f2)
"日本語3
"
CL-USER> (lisp-f3)
"名前あああ"
CL-USER> (lisp-f4)
"名前いいい"