Movitz: a Common Lisp x86 development platform

Common Lisp で書かれた OS というか，そもそもファイルシステムとか持ってない感じなので，文字通り「x86 CPU 開発環境 for Common Lisp」って感じですね．ブートローダー + α って感じです．

x86 CPU におけるデータ構造のレイアウトプロトコルとか，コンパイラの中身とかの話がけっこう面白い感じです．

The Movitz Development Platform (PDF)

ここからイメージファイルが落とせて，簡単に QEMU などで試すことができます (以下，Windows 版の QEMU を C 以下に解凍して使ってます．QEMU 単体だと遅すぎるので，KQEMU もインストール済み)．

C:\qemu-0.9.0-windows> cat grub-bootloader.img floppy.img > movitz.img
C:\qemu-0.9.0-windows> qemu.exe -L . -fda movitz.img -boot a

で，grub が立ち上がります．







う〜む，組み込み関数が良くわからない．リファレンスは無いのかな ?

とりあえず higepon さんはこれで OS 書けば良いのではないだろうか (笑)

---

ぐぐったらおもいっきり一発目でがいしゅつでした ！ ごめんなさい ＞＜

---

tinyWM

chicken の xlib binding が微妙過ぎて，全然短くなりませんでした．C の構造体触るとか，Lisp 系は辛すぎる．なぜか xevent-xbutton という共用体メンバが定義されて無かったので，C なら start = ev.xbutton; の，構造体の一発代入で済むところを，全メンバをいちいち set! しないと駄目だったりとか，いろいろ酷い．あと，chicken の場合，コンパイル時のチャックが全く無いので，起動するまで関数名が間違っているのに気がつかなかったりとか．

(require-extension xlib)

(let ((dpy (xopendisplay #f)))
  (assert dpy)
  (let ((root (xdefaultrootwindow dpy)))
    (xgrabkey dpy XK_F1 MOD1MASK root 1 GRABMODEASYNC GRABMODEASYNC)
    (xgrabbutton dpy 1 MOD1MASK root 1 BUTTONPRESSMASK GRABMODEASYNC GRABMODEASYNC NONE NONE)
    (xgrabbutton dpy 3 MOD1MASK root 1 BUTTONPRESSMASK GRABMODEASYNC GRABMODEASYNC NONE NONE)
    (let ((event (make-xevent))
          (attr (make-xwindowattributes))
          (start (make-xbuttonevent)))
      (let eventloop ()
        (xnextevent dpy event)
        (cond
          ((and (eqv? (xevent-type event) KEYPRESS)
                (not (eqv? (xevent-xkey-subwindow event) NONE)))
           (xraisewindow dpy (xevent-xkey-subwindow event)))
          ((and (eqv? (xevent-type event) BUTTONPRESS)
                (not (eqv? (xevent-xbutton-subwindow event) NONE)))
           (xgrabpointer dpy (xevent-xbutton-subwindow event) 1
                         (bitwise-ior POINTERMOTIONMASK BUTTONRELEASEMASK)
                         GRABMODEASYNC GRABMODEASYNC NONE NONE CURRENTTIME)
           (xgetwindowattributes dpy (xevent-xbutton-subwindow event) attr)
           (set-xbuttonevent-type!        start (xevent-xbutton-type event))
           (set-xbuttonevent-serial!      start (xevent-xbutton-serial event))
           (set-xbuttonevent-send_event!  start (xevent-xbutton-send_event event))
           (set-xbuttonevent-display!     start (xevent-xbutton-display event))
           (set-xbuttonevent-window!      start (xevent-xbutton-window event))
           (set-xbuttonevent-root!        start (xevent-xbutton-root event))
           (set-xbuttonevent-subwindow!   start (xevent-xbutton-subwindow event))
           (set-xbuttonevent-time!        start (xevent-xbutton-time event))
           (set-xbuttonevent-x!           start (xevent-xbutton-x event))
           (set-xbuttonevent-y!           start (xevent-xbutton-y event))
           (set-xbuttonevent-x_root!      start (xevent-xbutton-x_root event))
           (set-xbuttonevent-y_root!      start (xevent-xbutton-y_root event))
           (set-xbuttonevent-state!       start (xevent-xbutton-state event))
           (set-xbuttonevent-button!      start (xevent-xbutton-button event))
           (set-xbuttonevent-same_screen! start (xevent-xbutton-same_screen event)))
          ((eqv? (xevent-type event) MOTIONNOTIFY)
           (let ((xdiff (- (xevent-xbutton-x_root event)
                           (xbuttonevent-x_root start)))
                 (ydiff (- (xevent-xbutton-y_root event)
                           (xbuttonevent-y_root start))))
             (xmoveresizewindow dpy (xevent-xmotion-window event)
                                (+ (xwindowattributes-x attr)
                                   (if (eqv? (xbuttonevent-button start) 1)
                                     xdiff 0))
                                (+ (xwindowattributes-y attr)
                                   (if (eqv? (xbuttonevent-button start) 1)
                                     ydiff 0))
                                (max 1 (+ (xwindowattributes-width attr)
                                          (if (eqv? (xbuttonevent-button start) 3)
                                            xdiff 0)))
                                (max 1 (+ (xwindowattributes-height attr)
                                          (if (eqv? (xbuttonevent-button start) 3)
                                            ydiff 0))))))
          ((eqv? (xevent-type event) BUTTONRELEASE)
           (xungrabpointer dpy CURRENTTIME)))
        (eventloop)))))

使い方は，$csc tinywm.scm みたいに適当にコンパイルして，.xsession の最後に exec /path/to/tinywm とか適当に書くか，WM 無しのセッション exec mlterm とかで入って起動してください．

元々の tinyWM と同じく，Alt + ドロップでウィンドウを移動したり，拡大縮小できたりします．

結局，Python 最強，ということで (アーカイブに付いてくる，tinywm.py)．現状，こういう binding library とかのできぐあいを勝負すると，たいてい Python の圧勝の気がします．

# TinyWM is written by Nick Welch <[e-mail]>, 2005.
#
# This software is in the public domain
# and is provided AS IS, with NO WARRANTY.

from Xlib.display import Display
from Xlib import X, XK

dpy = Display()
root = dpy.screen().root

root.grab_key(XK.string_to_keysym("F1"), X.Mod1Mask, 1,
        X.GrabModeAsync, X.GrabModeAsync)
root.grab_button(1, X.Mod1Mask, 1, X.ButtonPressMask,
        X.GrabModeAsync, X.GrabModeAsync, X.NONE, X.NONE)
root.grab_button(3, X.Mod1Mask, 1, X.ButtonPressMask,
        X.GrabModeAsync, X.GrabModeAsync, X.NONE, X.NONE)

while 1:
    ev = root.display.next_event()

    if ev.type == X.KeyPress and ev.child != X.NONE:
        ev.window.circulate(X.RaiseLowest)
    elif ev.type == X.ButtonPress and ev.child != X.NONE:
        ev.child.grab_pointer(1, X.PointerMotionMask|X.ButtonReleaseMask,
                X.GrabModeAsync, X.GrabModeAsync, X.NONE, X.NONE, X.CurrentTime)
        attr = ev.child.get_geometry()
        start = ev
    elif ev.type == X.MotionNotify:
        #while(XCheckTypedEvent(dpy, MotionNotify, &ev));
        xdiff = ev.root_x - start.root_x
        ydiff = ev.root_y - start.root_y
        ev.window.configure(
            x = attr.x + (start.detail == 1 and xdiff or 0),
            y = attr.y + (start.detail == 1 and ydiff or 0),
            width = max(1, attr.width + (start.detail == 3 and xdiff or 0)),
            height = max(1, attr.height + (start.detail == 3 and ydiff or 0)))
    elif ev.type == X.ButtonRelease:
        dpy.ungrab_pointer(X.CurrentTime)

Xlib がちゃんと OOP っぽくアレンジされていて良い感じですね．

Common Lisp も，現状 C 以外で，唯一 X プロトコルを xlib の binding ではなく，ネイティブでしゃべれる (CLX) 言語のわりには，いろいろな要因で微妙な気がします （まずスタンドアローンイメージがやたらでかくなるとか）

---

ここから xlib.egg を持ってきてもいいし wget してもいい．

$ wget http://www.call-with-current-continuation.org/eggs/xlib.egg
$ su
# chicken-setup xlib.egg
  /usr/bin/csc -feature compiling-extension xlib.scm -s -O2 -d0 -L "-L/usr/X11R6/lib -lX11" -C "-I/usr/X11R6/include" -emit-exports xlib.exports
Compiling xlib (this may take a while) ...
xlib.c: In function 'stub5816':
xlib.c:18615: 警告: passing argument 3 of 'XwcTextPropertyToTextList' from incompatible pointer type
xlib.c: In function 'stub5773':
xlib.c:18644: 警告: passing argument 1 of 'XwcFreeStringList' from incompatible pointer type
xlib.c: In function 'stub5758':
xlib.c:18656: 警告: passing argument 2 of 'XwcTextListToTextProperty' from incompatible pointer type
xlib.c: In function 'stub5252':
xlib.c:19011: 警告: passing argument 4 of 'XGetWMSizeHints' from incompatible pointer type
xlib.c: In function 'stub5234':
xlib.c:19022: 警告: passing argument 4 of 'XGetWMNormalHints' from incompatible pointer type
xlib.c: In function 'stub5106':
xlib.c:19117: 警告: passing argument 3 of 'XGetRGBColormaps' from incompatible pointer type
xlib.c: In function 'stub5075':
xlib.c:19138: 警告: passing argument 3 of 'XGetIconSizes' from incompatible pointer type
xlib.c: In function 'stub4956':
xlib.c:19265: 警告: passing argument 3 of 'XwcLookupString' from incompatible pointer type
xlib.c: In function 'stub4819':
xlib.c:19385: 警告: passing argument 7 of 'XwcDrawImageString' from incompatible pointer type
xlib.c: In function 'stub4767':
xlib.c:19415: 警告: passing argument 7 of 'XwcDrawString' from incompatible pointer type
xlib.c: In function 'stub4663':
xlib.c:19474: 警告: passing argument 2 of 'XwcTextPerCharExtents' from incompatible pointer type
xlib.c: In function 'stub4603':
xlib.c:19502: 警告: passing argument 2 of 'XwcTextExtents' from incompatible pointer type
xlib.c: In function 'stub4567':
xlib.c:19524: 警告: passing argument 2 of 'XwcTextEscapement' from incompatible pointer type
xlib.c: In function 'stub4511':
xlib.c:19576: 警告: passing argument 2 of 'XFontsOfFontSet' from incompatible pointer type
xlib.c: In function 'stub1078':
xlib.c:22141: 警告: passing argument 1 of 'XAddToExtensionList' from incompatible pointer type
xlib.c: In function 'stub706':
xlib.c:22491: 警告: passing argument 1 of 'XFindOnExtensionList' from incompatible pointer type
xlib.c: In function 'stub543':
xlib.c:22636: 警告: passing argument 5 of 'XListFontsWithInfo' from incompatible pointer type
  rm -fr /var/lib/chicken/1/xlib.so
  cp -r xlib.so /var/lib/chicken/1/xlib.so
  cp -r xlib.exports /var/lib/chicken/1/xlib.exports

なんか警告がいっぱい出てますが，これでインストールが完了．サンプルコードが動くようになる．

$ cat xlibtest.scm

(require-extension xlib)

(let* ((display (xopendisplay #f)))
  (assert display)
  (let* ((screen (xdefaultscreen display))
         (root (xrootwindow display screen))
         (window (xcreatesimplewindow
                    display root 100 200 300 50 0
                    (xblackpixel display screen)
                    (xwhitepixel display screen))))
    (assert window)
    (let ((font (xloadfont display "10x20")))
      (assert font)
      (let ((gc (xcreategc display window 0 #f))
            (event (make-xevent)))
        (xsetforeground display gc (xblackpixel display screen))
        (xsetbackground display gc (xwhitepixel display screen))
        (xsetfunction display gc GXCOPY)
        (xsetfont display gc font)
        (xselectinput display window (bitwise-ior EXPOSUREMASK BUTTONPRESSMASK))
        (xmapwindow display window)
        (xnextevent display event)
        (xdrawstring display window gc 100 30 "hello, world!" 12)
        (xflush display)
        (xnextevent display event)))))

$ csc xlibtest.scm
$ ./xlibtest

んー，xsetlocale とか無い感じ… 日本語は表示できないのかな ?

$ cat /var/lib/chicken/1/xlib.exports | grep locale
xlocaleoffontset
xlocaleofim
xsupportslocale
xsetlocalemodifiers

setlocale って何を require すれば良いのだろうか ? chicken のマニュアルは調べ難すぎる気がする．

---