guile with ffi

友人が、「NASAより宇宙に近い町工場」と言う本を紹介してくれた。リアル「下町ロケット」のモデルとなった北海道の植松電機の事が綴られているそうな。

ペンシルロケットとか。何に使うの? その彼が言うには、スペースデブリの掃除を目指しているんではなかろうかと。

壊れた人工衛星等がごみとして宇宙に漂っている。ざっと、その数は2万個。マッハ25のスピードで動いているそうなので、衝突すればひとたまりもない。これを掃除するのに、小型ロケットを打ち上げて、デブリをキャッチ、地球に落下させて燃やしてしまおうと言う魂胆。 そのために、安く打ち上げられるロケットが必要。パイは2万個あるから、儲かる?

誰がそんなロケットを発注するの?ゴミは散らかした人が片付けのが原則。でも、デブリには出身国なんて書いてないでしょう(多分)。知らんぷりが関の山。

100歩ゆずって、この高度はXXXを運用するに丁度良いな。(例えば、人工衛星をバンバン打ち上げて、ネットワーク中継するとか)よし、この軌道は、掃海して、人工衛星のダメージを防ごう。なんて事になるのかな?

それとも、宇宙軍の秘密兵器の材料になったりして。

guile-3.0 in debian

27分かけて、32Bit機にもguile-3.0を入れた。

早速走らせてみると、libguile-3.0.so.1が無いと言う。本当か? /usr/local/libにちゃんと鎮座してるんだけどな。こういう場合は、あれだな。

debian:guile-3.0.0$ sudo ldconfig
[sudo] password for sakae:
ldconfig: /usr/local/lib/libguile-3.0.so.1.0.1-gdb.scm is not an ELF file - it has the wrong magic bytes at the start.

gdb.scmって、debugのお供にってやつかな? まあいい、それよりちゃんと走るかだな。

GNU Guile 3.0.0
Copyright (C) 1995-2020 Free Software Foundation, Inc.

Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.

Enter `,help' for help.
scheme@(guile-user)> (* 2 3 4 5 6 7 8 9)
$1 = 362880

まあ、走ってると思っていいかな。事前にmake checkで出来栄えを確認しておいたから、大丈夫でしょう。

真面目にハロワからやってみる。

debian:tmp$ cat halowa.c
#include <stdlib.h>
#include <libguile.h>

static SCM my_hostname (void) {
  char *s = getenv ("HOSTNAME");
  if (s == NULL)
    return SCM_BOOL_F;
  else
    return scm_from_locale_string (s);
}

static void inner_main (void *data, int argc, char **argv) {
  scm_c_define_gsubr ("my-hostname", 0, 0, 0, my_hostname);
  scm_shell (argc, argv);
}

int main (int argc, char **argv) {
  scm_boot_guile (argc, argv, inner_main, 0);
  return 0; /* never reached */
}

ふむ、guileからC語を呼び出すハロワだな。main()が、guileをbootするやつか。本番は、inner_main()が担当。中身は、my_hostnameってC語を登録。そしてscm_shellを呼び出す。shellってreplの事だね。前回のgaucheの時に看破しておいたけど、guileの人も、同様に考えている。my_hostname()は、それらしい名前の環境変数を読むだけ。ハロワに相応しい内容だ。

debian:tmp$ cc halowa.c `pkg-config --cflags --libs guile-3.0`
debian:tmp$ export HOSTNAME=hogefuga
debian:tmp$ ./a.out
  :
scheme@(guile-user)> (my-hostname)
$1 = "hogefuga"

実行例。あらかじめHOSTNAMEを適当に設定しておくと吉。guileとC語のコラボレーションが分かり易い形で提示されてる。まて、バックスラッシュで囲まれたpkg-configは何? バックスラッシュで囲むと、そこに実行結果が展開されるんで、普通のshell上で確認するなら、バックスラッシュを外して実行すれば良い。

debian:tmp$ pkg-config --cflags --libs guile-3.0
-pthread -I/usr/local/include/guile/3.0 -L/usr/local/lib -lguile-3.0 -lgc

ハロワ本だと、コンパイルする時に必要な、おまじないですって解説で、お茶を濁すんだろうね。(お茶と言えば、タピオカ入りが普通になったようだけど、悪乗りの便乗で、タピオカ入りのアイスクリームなんてのが有るのね。ゲテモノ好きな女房も、これには手を出さなかったぞ)

コンパイルする時に必要なインクルードファイルは、/usr/local/include/guile/3.0の下にあるからね。ライブラリィーの在処は、/usr/local/libの中にも有るから、調べて使ってね。その他、-pthreadとかも必要だからねって意味。毎回入力するのめんどいので、おまじないって訳。

じゃ、指定した成分が含まれているのか?

debian:tmp$ ldd ./a.out
        linux-gate.so.1 (0xb7ed9000)
        libguile-3.0.so.1 => /usr/local/lib/libguile-3.0.so.1 (0xb7d4a000)
        libgc.so.1 => /usr/lib/i386-linux-gnu/libgc.so.1 (0xb7ced000)
        libpthread.so.0 => /lib/i386-linux-gnu/libpthread.so.0 (0xb7ccc000)
        libc.so.6 => /lib/i386-linux-gnu/libc.so.6 (0xb7aee000)
        libffi.so.6 => /usr/lib/i386-linux-gnu/libffi.so.6 (0xb7ae4000)
        libunistring.so.2 => /usr/lib/i386-linux-gnu/libunistring.so.2 (0xb795f000)
        libgmp.so.10 => /usr/lib/i386-linux-gnu/libgmp.so.10 (0xb78d0000)
        libltdl.so.7 => /usr/lib/i386-linux-gnu/libltdl.so.7 (0xb78c4000)
        libdl.so.2 => /lib/i386-linux-gnu/libdl.so.2 (0xb78be000)
        libcrypt.so.1 => /lib/i386-linux-gnu/libcrypt.so.1 (0xb788b000)
        libm.so.6 => /lib/i386-linux-gnu/libm.so.6 (0xb7783000)
        /lib/ld-linux.so.2 (0xb7edb000)

これだけの成分が入っていて、

debian:tmp$ ls -l ./a.out /usr/local/bin/guile
-rwxr-xr-x 1 sakae sakae 15724 Jan 23 07:09 ./a.out*
-rwxr-xr-x 1 root  root  30796 Jan 23 06:51 /usr/local/bin/guile*

本物よりも容量が半分。奥様、お値打ち品でございます事よ。取り込んでいる成分は、本家の物と一緒なので、無駄を省いた軽量品でございますって趣です。皆さん、積極的に利用して、地球環境を守りましょう。恵方巻で無駄を出したら、営業停止1か月ぐらいの荒療治をやれよ。>農林水産省殿。

もう一つ例が有った。今度はCentOSで試してみる。

(base) [sakae@c8 tmp]$ cat be.c
#include <math.h>
#include <libguile.h>

SCM j0_wrapper (SCM x) {
  return scm_from_double (j0 (scm_to_double (x)));
}

void init_bessel () {
  scm_c_define_gsubr ("j0", 1, 0, 0, j0_wrapper);
}

数学ライブラリィーにある、ベッセル関数を使う例。今度はmainが無い。すなわち、guile用のライブラリィーである。

(base) [sakae@c8 tmp]$ cc `pkg-config --cflags guile-3.0` -shared -o lib-be.so -fPIC be.c

コンパイルはシェアードファイルを作るように指示する。

(base) [sakae@c8 tmp]$ ldd lib-be.so
        linux-vdso.so.1 (0x00007ffccaebf000)
        libpthread.so.0 => /lib64/libpthread.so.0 (0x00007fc81c193000)
        libc.so.6 => /lib64/libc.so.6 (0x00007fc81bdd0000)
        /lib64/ld-linux-x86-64.so.2 (0x00007fc81c5b5000)

出来上がった中身。一瞬、mathやguileを同梱していないのではと思ったけど、これらは本体側のguileが持ってるから不要なんだな。

(base) [sakae@c8 tmp]$ guile
  :
scheme@(guile-user)> (load-extension "./lib-be" "init_bessel")
scheme@(guile-user)> (j0 2)
$1 = 0.22389077914123567

拡張機能をロードすると、使えるようになるとな。

tutorial kame

上の例で分かるようにguileはどうも、糊言語って雰囲気がする。糊は英語でglue。何となく綴りが似てないか。糊言語と言えば、その筆頭がperlとかだった。perlから各種のunixコマンドを容易に呼び出せたものだから、一時期、萌え言語と思って使ってたな。まあ、そういう過去の事は打っちゃっておく。

guileの勉強サイトに行くと、いの一番で、 Tortoise: Extending a C program with Guile なんてのが眼に飛び込んでくる。

解説を流し読みすると、guileとgnuplotを繋げてみましょって例。で、何をやるかと言うと、昔流行ったlogoの実現。亀さんグラフィック。亀の足に墨を塗っておいて、3歩前進、右に90度回ってから、5歩前進とかやるやつだ。そうすると亀の歩いた所に線が引ける。

gunplotは、その台紙を提供。guile側から(move 3) (tern 90) (move 5)とかやりたい。直接guileとgnuplotを接続出来ないので、間はC語で書いたもので接続。

段階を踏んで解説してる。最初はC語だけで動く物を作り、それで動作確認。動くのが確認出来たら改造を施して、亀内蔵のguileに仕立て上げる。

著者は最初これをgtkでやろうとしたけど、gtkの主張が強すぎて、guileと合体出来なかったそうな。苦肉の策としてgnuplotをキャンバスに選び、パイプ接続で描画命令(単に2点を結ぶ線を書くだけ)を送り込む事にしたとな。アイデア賞ですな。

(base) sakae@debian:tmp$ cc kame.c `pkg-config --cflags --libs guile-2.2` -lm

guileは、3.0がオイラーの所ではブームになってるけど、後方互換性確認の元も残しておこうってんで、64Bit版のdebianから素直に、guile-2.2-devを入れた。devが入っていないと、上記はコンパイル出来ないと言うブービートラップがあるので注意。

FFI in guile

上記の亀さんのように手軽にC語と仲良く出来るなら、それを一般化した便利なやつが有るに違いない。マニュアルを漁っていたら、 6.21.6 Dynamic FFIなんてのが眼に入ってきた。debianで試したら、指定のライブラリィーが見つからんエラーになった。藁にすがって、OpenBSDで提供されてた奴で試してみる。

ob$ rlwrap guile
GNU Guile 2.2.6
  :
(define-module (math bessel)
  #:use-module (system foreign)
  #:export (j0))

(define libm (dynamic-link "libm"))

$1 = #<directory (math bessel) 451c858960>
(define j0
  (pointer->procedure double
                      (dynamic-func "j0" libm)
                      (list double)))
scheme@(math bessel)> (j0 2)
$2 = 0.22389077914123567

これが、最終的な使い方になるみたい。

scheme@(guile-user)> ,use (system foreign)
(define memcpy
  (let ((this (dynamic-link)))
    (pointer->procedure '*
                        (dynamic-func "memcpy" this)
                        (list '* '* size_t))))
scheme@(guile-user)> (use-modules (rnrs bytevectors))

(define src-bits
  (u8-list->bytevector '(0 1 2 3 4 5 6 7)))
(define src
  (bytevector->pointer src-bits))
(define dest
  (bytevector->pointer (make-bytevector 16 0)))
scheme@(guile-user)>
(memcpy dest src (bytevector-length src-bits))

$3 = #<pointer 0x8b64d980>
scheme@(guile-user)> (bytevector->u8-list (pointer->bytevector dest 16))
$4 = (0 1 2 3 4 5 6 7 0 0 0 0 0 0 0 0)

,use (system foreign) しておくと、その場で使えるみたい。これは便利そう。

scheme@(guile-user)> (define gettimeofday
  (let ((f (pointer->procedure
            (apply values (parse-c-struct timeval tv-type))
            int
            (dynamic-func "gettimeofday" (dynamic-link))
            (list '* '*)))
        (tv-type (list long long)))
    (lambda ()
      (let* ((timeval (make-c-struct tv-type (list 0 0)))
             (ret (f timeval %null-pointer)))
        (if (zero? ret)
            (apply values (parse-c-struct timeval tv-type))
            (error "gettimeofday returned an error" ret))))))
scheme@(guile-user)> (gettimeofday)
$5 = 1579739956
$6 = 64514

もう何でも来い来いの趣。qsortの例も載ってて、無事に動いた。これでもうC語のコンパイラーとはおさらば出来るぞ。(そう簡単に行くかって声が有るのは承知の助ですが)

Chap-15. Guile と C言語 の連携

各種処理系のFFIコールバック仕様を見てみる会

FFIブリッジを作ろう - Sagittarius / Guile / Vicare

How to extend C programs with Guile

header.h read then ...

上で出て来たmemcpyについて考える。天下りはいかんぜよって事でね。

scheme@(guile-user)> (import (system foreign))
(define memcpy
  (let ((this (dynamic-link)))
    (pointer->procedure '*
                        (dynamic-func "memcpy" this)
                        (list '* '* size_t))))

,useじゃなくて、スクリプト上は、importを使うんだろうね。勘だけど。問題はその下にあるmemcpyの定義。何となくC語のライブラリィーを使う時のヘッダーの(一部)に見えてきた。

MEMCPY(3)                  Linux Programmer's Manual                 MEMCPY(3)

NAME
       memcpy - copy memory area

SYNOPSIS
       #include <string.h>

       void *memcpy(void *dest, const void *src, size_t n);

DESCRIPTION
       The  memcpy()  function  copies  n bytes from memory area src to memory
       area dest.  The memory areas must not overlap.  Use memmove(3)  if  the
       memory areas do overlap.

RETURN VALUE
       The memcpy() function returns a pointer to dest.

いや、ヘッダーじゃなくて、manだな。ヘッダーはCコンパイラーが使うもので、人間が見るには適しておりません。どうしても見たいと言うなら、

/* Copy N bytes of SRC to DEST.  */
extern void *memcpy (void *__restrict __dest, const void *__restrict __src,
                     size_t __n) __THROW __nonnull ((1, 2));

こんなのが、見られるけどね。

pointer->procedureの定義は

 -- Scheme Procedure: pointer->procedure return_type func_ptr arg_types
          [#:return-errno?=#f]

さらっと書いてあるけど、manで出て来る呼び出し規約をそのままScheme語に翻訳してる。 普通、ライブラリィーには複数の関数が定義されてて、その仕様書であるヘッダーファイルも同様だ。でも、ライブラリィーにある関数を全部使う訳ではない。

エコシステムになってて、使う分だけScheme語で宣言しなさいって訳だな。これが分かれば、気が楽になる。Cで書く所を自分の頭でScheme語に変換して書くんだから。

ついでに、dynamic-funcの方も、見ておく。

 -- Scheme Procedure: dynamic-func name dobj
 -- C Function: scm_dynamic_func (name, dobj)
     Return a “handle” for the func NAME in the shared object referred
     to by DOBJ.  The handle can be passed to ‘dynamic-call’ to actually
     call the function.

C語とScheme語の呼び出し方法が、仲良く並んでいる。

libltdl

guileの中に忍ばせてあるやつ。どんな物が知らないので、、、

libltdlの使用

大分古いマニュアルだけど、コンセプトは一緒だろう。libtoolに結構泣かされた事があったからね。特に、 実行形式のデバッグの所ね。

libtool-docを入れたら、infoが入った。そうか、誰かが言ってたな。manに無くてもinfoに有る事が多いので、確認せいと。特に開発関係はね。みんなemacs大好きな人達なんだな。そりゃそうでしょう。GNUな人は、親分に倣ってemacsを使うのがしきたりですから。

そのせいか、guileもgeiserってモジュール(去年調べた)で、emacsから便利に使えるようになってるぞ。

error dynamic-link

debian(32Bit)機でダイナミックリンクが上手く出来たので、CentOSでも確認

(base) [sakae@c8 tmp]$ guile
GNU Guile 3.0.0
 :
scheme@(guile-user)> (import (system foreign))
scheme@(guile-user)> (dynamic-link "libm")
ice-9/boot-9.scm:1669:16: In procedure raise-exception:
In procedure dynamic-link: file: "libm", message: "file not found"

Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
scheme@(guile-user) [1]> ,bt
           1 (dynamic-link "libm")
In ice-9/boot-9.scm:
  1669:16  0 (raise-exception _ #:continuable? _)

どうした事か、そんなの見つからんエラーになる。調べてみると、ちょっと昔の投稿 だけど、下記が見つかった。

The `dynamic-link` will search and dlopen the shared library.  The guile
from guix doesn’t search common places like ‘/usr/lib’, so you need to
set the environment variable `LD_LIBRARY_PATH` or `LTDL_LIBRARY_PATH`
explicitly to the directory contains `libm.so`.

でも、違った。別の投稿にヒントが有った。斜め上から調べてる。

(base) [sakae@c8 tmp]$ locate libm.so
/usr/lib64/libm.so
/usr/lib64/libm.so.6
  :
(base) [sakae@c8 tmp]$ file /usr/lib64/libm.so
/usr/lib64/libm.so: ASCII text
(base) [sakae@c8 tmp]$ file /usr/lib64/libm.so.6
/usr/lib64/libm.so.6: symbolic link to libm-2.28.so

大体、soファイルがASCIIファイルなんて、ソー(soの読み方です)な事有ってもいいのかと、親父ギャグです。

(base) [sakae@c8 tmp]$ cat /usr/lib64/libm.so
/* GNU ld script
*/
OUTPUT_FORMAT(elf64-x86-64)
GROUP ( /lib64/libm.so.6  AS_NEEDED ( /usr/lib64/libmvec_nonshared.a /lib64/libmvec.so.1 ) )

リンカースクリプトですってさ。そういうのは、想定外(流行りましたねぇ)。本チャンは、libm-2.28.soなんで、guileに忖度(これも流行りましたねぇ)してみる。

scheme@(guile-user)> (dynamic-link "libm-2.28")
$1 = #<dynamic-object "libm-2.28">

忖度されて、ご満悦(まるで、どこかの首相みたいだな。偉いんです、裸の王様です。国民は不幸になる事は、昔の物語で散々警告されてます。)

(base) [sakae@c8 tmp]$ file /usr/lib64/libncurses.so
/usr/lib64/libncurses.so: ASCII text
(base) [sakae@c8 tmp]$ file /usr/lib64/libncurses.so.6
/usr/lib64/libncurses.so.6: symbolic link to libncurses.so.6.1
(base) [sakae@c8 tmp]$ file /usr/lib64/libncurses.so.6.1
/usr/lib64/libncurses.so.6.1: ELF 64-bit LSB shared object, x86-64, version 1 (SYSV), dynamically linked, BuildID[sha1]=63d42395e2ac6dd60332da36d26486f8a669b2cb, stripped, too many notes (256)

こんなncursesはどうよ。本物をリンクしようとすると、

scheme@(guile-user)> (dynamic-link "libncurses.so.6.1")
ice-9/boot-9.scm:1669:16: In procedure raise-exception:
In procedure dynamic-link: file: "libncurses.so.6.1", message: "file not found"

ほら、怒られた。忖度出来ない、外国勢が多数の世界です。内弁慶は国を亡ぼすぞ。

OSSの楽しみ、ソース嫁で、libguile/dynl.c このあたりかな。

static void *
sysdep_dynl_link (const char *fname, const char *subr)
{
  lt_dlhandle handle;

  if (fname == NULL)
    /* Return a handle for the program as a whole.  */
    handle = lt_dlopen (NULL);
  else
    {
      handle = lt_dlopenext (fname);
        :

久しぶりのgdbだ。CentOSのgdbってguileを引き連れて来るのね。いえね、guile-3.0を野良で入れた時、前任者のguileを追い出しちゃったんだ。つられてgdbも消えたのかな。再度gdbを入れて、気が付いた。

(gdb) n
72            handle = lt_dlopenext (fname);
(gdb) p fname
$1 = 0x1ae91f0 "libncurses"
(gdb) n
74            if (handle == NULL
(gdb) p handle
$2 = (lt_dlhandle) 0x0
(gdb) p fname
$3 = 0x1d718d0 "libm-2.28"
(gdb) p handle
$4 = (lt_dlhandle) 0x1d7b300

こちらは、忖度がちゃんと効いた時。これはもう、guileの人に報告かな。

まて、早まるな。lt-dlopenextのmanぐらい引いておけ。無かったぞ。see info !!

 -- Function: lt_dlhandle lt_dlopenext (const char *FILENAME)
     The same as 'lt_dlopen', except that it tries to append different
     file name extensions to the file name.  If the file with the file
     name FILENAME cannot be found libltdl tries to append the following
     extensions:

       1. the libtool archive extension '.la'
       2. the extension used for native dynamically loadable modules on
          the host platform, e.g., '.so', '.sl', etc.

最大限に忖度してるっぽいな。でも、忖度度合いが足りないのかな。誰か、日本流のおもてなしを組み込んで欲しいぞ。

でもね、リンカースクリプトの領域まで手を出すって、越権行為と言われそうだな。

そうだ、gdbのお供で付いてきた、専門家が作ったguileで試してみるか。一応、念のため。

(base) [sakae@c8 tmp]$ /usr/bin/guile
GNU Guile 2.0.14
 :
scheme@(guile-user)> (dynamic-link "libm")
ERROR: In procedure dynamic-link:
ERROR: In procedure dynamic-link: file: "libm", message: "file not found"

Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
scheme@(guile-user) [1]> ,q
scheme@(guile-user)> (dynamic-link "libm-2.28")
$1 = #<dynamic-object "libm-2.28">

やっぱりオイラーが作ったのと同じ挙動だね。

後やる事と言ったら、ちゃんと動くdebian(32Bit機)の、soファイルの確認ぐらいだな。 思うにCentOSは業務用。selinxとかで、特殊な仕掛けが施されていたりして。だから、そんなOSは相手にしません。(まさかが本当なら、由々しき問題ですよ)

guileを騙す

確認の前に、guileを騙す方法を思いつたので、試してみる(散歩効果)。今度は、debian(64Bit)機。元々入ってたやつでも上記が失敗してたから。(実験機がコロコロ変わるのは、時間を置いて、マシンを勝って気ままに起動してるからです)

原理は簡単。libm.soがASCIIなんで無視。全く別物のファイル名で、実体にリンクしちゃえ。

(base) sakae@debian:x86_64-linux-gnu$ ls -l libm.so*
-rw-r--r-- 1 root root 186 May  2  2019 libm.so
lrwxrwxrwx 1 root root  12 May  2  2019 libm.so.6 -> libm-2.28.so
(base) sakae@debian:x86_64-linux-gnu$ sudo ln -s libm-2.28.so guile-libm.so
(base) sakae@debian:x86_64-linux-gnu$ sudo ldconfig

guile-libm.soって言うguile用のリンク作成。そしてldconfigでキャッシュを更新(これは必須です。実施しないと、新しいリンクをguileが見つけられない)

(base) sakae@debian:tmp$ guile
GNU Guile 2.2.4
  :
scheme@(guile-user)> (dynamic-link "libm")
ERROR: In procedure dynamic-link:
In procedure dynamic-link: file: "libm", message: "file not found"
  :
scheme@(guile-user)> (dynamic-link "guile-libm")
$1 = #<dynamic-object "guile-libm">

これが、騙しのテクニック。この方法を使えば、ちょっと変態だけど、急場を凌げるだろう。 そんなにダイナミックリンクを色々やるとも思えないからね。

でも、もっと正統な解決方法がありそうだな。ちらちらとdlopenのmanを見ていたんだ。 例が載ってた。

       #include <gnu/lib-names.h>  /* Defines LIBM_SO (which will be a
                                      string such as "libm.so.6") */
       int
       main(void)
       {
           void *handle;
           double (*cosine)(double);
           char *error;

           handle = dlopen(LIBM_SO, RTLD_LAZY);

libm.soを直に指定したい所なんだけど、おまじないのgnu/lib-names.hを読み込んで、その中のマクロ名を指定している。そのヘッダーを参照すると

#define LIBM_SO                         "libm.so.6"

libm.soってASCIIファイルを避けているよ。全くLinuxって奴と言うか、glib類の製造元は狂った事をやるもんだ。このヘッダーに登録されていないライブラリィーはどうすんねん? 一貫性の無い設計、その場しのぎの設計。困ったものだ。だからオイラーは、OpenBSDが好きなのさ。

game

クリチカルな問題に向き合ってしまったので、しばし骨休め。

scheme でシューティングゲームを作ってみる

guile で書いてあるので、勉強にうってつけ。ゲームしないでソース読みって、どゆ事?

ついでに、コピペした亀も載せておきます。起動したら、最初に(reset)してください。

かめさん