Archive for the ‘プログラミング’ Category

setjmpとlongjmpでユーザレベルスレッドを作る

木曜日, 2月 11th, 2010

「C言語のsetjmpとlongjmpがあればスレッドは作れる」
という話を聞いたので実際にやってみました。
まずは、完成品の使用例から。

#include <stdio.h>
#include <stdlib.h>
#include "ahothread.h"

void f1(void *args)
{
  int i, j;
  char *str = (char*)args;
  for (i=0; i<3; i++) {
    puts(str);
    for (j=0; j<10000000; j+= 1 + rand()%2);
  }
}

int main(int argc, char **argv)
{
  int t1, t2;
  ahothread_init();
  t1 = ahothread_create(f1, "aho");
  t2 = ahothread_create(f1, "baka");
  ahothread_join(t1);
  ahothread_join(t2);
  return 0;
}

ahoとbakaが交互に出ます。多分。
ループの中でrand()を呼ぶことにより時間稼ぎをしているので、
環境によっては交互じゃない可能性もあります。

次は、スレッドの中身で、もっとも重要な部分。

int ahothread_create(void (*func)(void*), void *args)
{
  int id = search_free_thread();
  thread_table[id].state = ALIVE;
  if (setjmp(thread_table[current_thread].jb) == 0) {
    if (id > current_thread) {
      alloca((id-current_thread) * FRAME_SIZE);
    }
    else {
      assert(0);
    }
    current_thread = id;
    func(args);
  }
  return id;
}

void ahothread_yield()
{
  if (setjmp(thread_table[current_thread].jb) == 0) {
    int next = search_alive_thread();
    current_thread = next;
    longjmp(thread_table[next].jb, 1);
  }
}

ahothread_createは、setjmpで現在の状態を記憶し、
allocaでスタックポインタを適当に押し上げた後に、(別のスレッドとして)目的の関数を呼びます。
ahothread_yieldは、setjmpで現在の状態を記憶し、
適当な(多くの場合、現在とは別の)スレッドを探し、longjmpで制御を移します。
ahothread_yieldを定期的に呼ぶことにより、実行するスレッドが定期的に切り替わります。

最後に、全部のソースを載せておきますが、
かなりやっつけで作ったのでバグが沢山埋もれている可能性があります。

#include <stdlib.h>
#include <setjmp.h>
#include <assert.h>
#include <signal.h>
#include <sys/time.h>

#define MAX_THREAD 32
#define FRAME_SIZE 10240

#define DEAD 0
#define ALIVE 1
#define JOIN 2

struct thread_data {
  jmp_buf jb;
  int state;
  int wait;
};

struct thread_data thread_table[MAX_THREAD];
static int current_thread = 0;
static int num_thread = 1;


static int search_alive_thread()
{
  int i;
  for (i=current_thread+1; i<num_thread; i++) {
    if (thread_table[i].state == ALIVE) {
      return i;
    }
  }
  for (i=0; i<=current_thread; i++) {
    if (thread_table[i].state == ALIVE) {
      return i;
    }
  }
  assert(0);
  return -1;
}

static int search_free_thread()
{
  int i = num_thread++;
  assert(i < MAX_THREAD);
  return i;
}

static int search_join_thread(int id)
{
  int i;
  for (i=0; i<num_thread; i++) {
    if (thread_table[i].state == JOIN &&
        thread_table[i].wait == id) {
      return i;
    }
  }
  return -1;
}

void ahothread_yield()
{
  if (setjmp(thread_table[current_thread].jb) == 0) {
    int next = search_alive_thread();
    current_thread = next;
    longjmp(thread_table[next].jb, 1);
  }
}

void ahothread_join(int id)
{
  if (thread_table[id].state != DEAD) {
    thread_table[current_thread].state = JOIN;
    thread_table[current_thread].wait = id;
    ahothread_yield();
  }
}
void ahothread_exit()
{
  int join;
  if (current_thread == 0) {
    exit(0);
  }
  join = search_join_thread(current_thread);
  if (join != -1) {
    thread_table[join].state = ALIVE;
  }
  thread_table[current_thread].state = DEAD;
  ahothread_yield();
}

int ahothread_create(void (*func)(void*), void *args)
{
  int id = search_free_thread();
  thread_table[id].state = ALIVE;
  if (setjmp(thread_table[current_thread].jb) == 0) {
    if (id > current_thread) {
      alloca((id-current_thread) * FRAME_SIZE);
    }
    else {
      assert(0);
    }
    current_thread = id;
    func(args);
  }
  return id;
}


static void ahothread_handler(int sig)
{
  if (num_thread > 1) {
    ahothread_yield();
  }
}

void ahothread_init()
{
  struct sigaction sa = {
    .sa_handler = ahothread_handler,
    .sa_flags = SA_RESTART
  };
  struct itimerval it = {};
  thread_table[0].state = ALIVE;
  it.it_interval.tv_sec = 0;
  it.it_interval.tv_usec = 100000;
  it.it_value = it.it_interval;
  sigemptyset(&sa.sa_mask);
  sigaction(SIGALRM, &sa, NULL);
  setitimer(ITIMER_REAL, &it, 0);
}

Prologでオシオキ

火曜日, 12月 1st, 2009

メモリたくさん欲しいです(Yet Another Ranha)
を読んで、私もオシオキしてみることにしました。

画像が小さくて良く見えませんが、4人が水泳大会の順位を言っていて、
そのなかで一人だけ嘘をついているのでその人を見つけ出すみたいです。
(順位も求めるみたいですが、誰が嘘をついているか分かれば順位は自明なので、
 順位は表示したりしていません。)

私はranhaさんのように変態紳士では無いので、素直にPrologを使いました。
処理系はSWI-Prolog。

;; 二つの集合が等しいか
set_eq([], []).
set_eq([X|Xs], Y) :- member(X, Y), delete(Y, X, Z), set_eq(Xs, Z).
;; 4人が別々の順位になるか
rank(X,Y,Z,W) :- set_eq([X,Y,Z,W], [1,2,3,4]).
;; それぞれの言い分
ayu(1).
ayu(2).
suzu(1).
suzu(2).
naru(N, S) :- N < S.
kotori(1).
;; オシオキされる人
oshioki(ayu)   :- suzu(S), kotori(K), rank(_,S,N,K), naru(N, S).
oshioki(suzu)  :- ayu(A), kotori(K), rank(A,S,N,K), naru(N, S).
oshioki(naru)  :- ayu(A), suzu(S), kotori(K), rank(A,S,_,K).
oshioki(kotori):- ayu(A), suzu(S), rank(A,S,N,_), naru(N, S).

で、動かしてみたら、誰をオシオキしたらいいのかすぐに分かります。

?- oshioki(X).
X = suzu

SWI-Prologのdeleteの引数が想像と逆ですこしハマりました。
それにしてもあまりきれいじゃないですね。
もう少しうまく書けないものか。

cl-openglで変なもの作った

火曜日, 10月 13th, 2009

ものすごく適当に書いてもそれっぽく動く。cl-opengl凄い。
Common Lispでゲームを作るのは案外簡単な気がしてきた。

背景の写真は滋賀県の某所で撮ったものです。
画面のキャプチャにはCopernicusを使用しました。
ただ、Mac Bookのスペックの問題か、秒間2フレームほどでしか撮影できなかったので、
cl-openglのプログラムの方をゆっくり動かし、撮影した動画をiMovieで早送りしました。

早めのreturn

土曜日, 10月 10th, 2009

例えば、C言語で

int foo()
{
  int ret;
  if (bar()) {
    /* (行数的に)短い処理 */
    ret = 1;
  }
  else {
    /* (行数的に)長い処理 */
    ret = 0;
  }
  return ret;
}

こんな風な書き方をする人と、

int foo()
{
  if (bar()) {
    /* 短い処理 */
    return 1;
  }
  /* 長い処理 */
  return 0;
}

こんな風な書き方をする人、どちらが多いんでしょうか。
私は早めにreturnで関数を抜ける方が読み易いし、
長い処理のネストが一段浅くなるので、後者の方を好んで使いますが、
一部業界では「関数にreturnは1個しか書けない」という謎の規約があるため、
前者のような書き方を強要されるそうです。
Common Lispでも同様に

(defun foo ()
  (cond ((bar)
    ;短い処理
    1)
  (t
    ;長い処理
    0)));

のような書き方をするか、

(defun foo ()
  (when (bar)
    ;短い処理
    (return-from foo 1))
  ;長い処理
  0)

のような書き方をするか選べます。私はこれも後者を好んで使います。
けど、Lispの入門書ではこのようにreturn-fromを使ってるのをあまり見ない気がします。
Schemeだとreturnがないのでcall/ccを使うことになります。

(define (foo)
  (call/cc
    (lambda (ret)
      (if (bar)
        (begin
          ;短い処理
          (ret 1)))
      ;長い処理
      0)))

ただ、この書き方だと結局ネストが深くなってしまうので、
引数として継続を受け取った方が自然かもしれません。

(define (foo ret)
  (if (bar)
    (begin
      ;短い処理
      (ret 1)))
  ;長い処理
  0)
(call/cc foo)

Schemeのcall/ccを利用した早めのreturnも好きなんですが、
その目的のためだけにcall/ccはちょっと重たいかもしれません。
脱出専用なので、処理系がどうにかして効率のいい実行をしてくれないのかな。

cl-openglとかarrayの型とか

木曜日, 10月 8th, 2009

*cl-opengl*
OpenGLのことなんて何も知らないけど、
適当にcl-openglを弄ったらなんだか3Dっぽくなった。
gltest02
gltest03
静止画像じゃ分かりにくいですが、回転します。
あと、回転すると、表示の前後関係が狂います(笑)
*arrayの型*
以前のエントリで
「本当は (array (unsigned-byte 8) (*))を指定した方がいいけど、
リーダマクロ #( で作った配列を扱いたいから、 (array t (*)) を指定しました」
みたいなことを書いたんですが、思いっきり間違ってました。
(array t (*))は任意のオブジェクトを保持できる一次元配列で、
(array (unsigned-byte 8) (*))のような、要素の方が制限された配列を含みません。

(subtypep '(array (unsigned-byte 8) (*)) '(array t (*)))
;=> NIL

この場合は、(array t (*))ではなく、(array * (*))を使うのが正しいようです。

cl-openglで画像出た

日曜日, 9月 27th, 2009

何も分からないままにcl-openglのサンプルを適当にいじったら画像が表示できた。
テクスチャとして貼付けてるので、簡単に回転できた。
gltest01

それにしても、asdfやrequireというのがよくわからない。
cl-openglを使ったソースを探したら、みんな
(require :cl-glut)
とかやってるけど、これをするとcl-openglが見つからないと怒られる。
(asdf:oos ‘asdf:load-op :cl-glut)
これで代用できるみたいだけど面倒だ。
画像を読み込むために、cl-pngというのを入れたけど、これも同じ。それから、
(asdf:oos ‘asdf:load-op :png)
という風に、cl-pngではなくpngと指定しないといけない。ややこしい。

(defclass hello-window (glut:window)
  ((image :initarg :image :initform nil :accessor image)
   (texture :accessor texture))
  (:default-initargs :pos-x 100 :pos-y 100 :width 800 :height 600
                     :mode '(:single :rgb) :title "YUNOHA"))
(defmethod glut:display-window :before ((w hello-window))
  (gl:clear-color 0 0 0 0)
  (gl:matrix-mode :projection)
  (gl:load-identity)
  (gl:ortho -4 4 -3 3 -1 1)
  (gl:pixel-store :unpack-alignment 1)
  (setf (texture w) (car (gl:gen-textures 1)))
  (gl:bind-texture :texture-2d (texture w))
  (gl:tex-parameter :texture-2d :texture-min-filter :nearest)
  (gl:tex-parameter :texture-2d :texture-mag-filter :nearest)
  (gl:tex-image-2d :texture-2d 0 :rgb 800 600 0 :rgb :unsigned-byte (image w)))
(defmethod glut:display ((w hello-window))
  (gl:clear :color-buffer-bit)
  (gl:rotate 4 0 0 1)
  (gl:raster-pos 0 0)
  (gl:enable :texture-2d)
  (gl:with-primitive :quads
    (gl:tex-coord 0 0)
    (gl:vertex -3.75 -2.75 0)
    (gl:tex-coord 1 0)
    (gl:vertex 3.75 -2.75 0)
    (gl:tex-coord 1 1)
    (gl:vertex 3.75 2.75 0)
    (gl:tex-coord 0 1)
    (gl:vertex -3.75 2.75 0))
  (gl:disable :texture-2d)
  (gl:flush))
(defmethod glut:idle ((widow hello-window))
  (sleep (/ 1.0 30.0))
  (glut:post-redisplay))
(defmethod glut:keyboard ((window hello-window) key x y)
  (declare (ignore x y))
  (case key
    (#¥Esc (glut:destroy-current-window))))
(defun run ()
  (glut:display-window (make-instance 'hello-window :image (png->raw "kawanishi_lico01.png"))))
(defun png->raw (input-pathname)
  (let* ((old (with-open-file (input input-pathname
                                     :element-type '(unsigned-byte 8))
                (png:decode input)))
         (new (make-array (* (png:image-width old) (png:image-height old) 3)
                          :element-type '(unsigned-byte 8))))
    (dotimes (i (png:image-height old) new)
      (dotimes (j (png:image-width old))
        (dotimes (k 3)
          (setf (aref new (+ (* i (png:image-width old) 3) (* j 3) k))
                (aref old (- (png:image-height old) i 1) j k)))))))

cl-opengl試した

土曜日, 9月 26th, 2009

いつかCLでゲームを作ろうと思い、その下準備としてcl-openglを入れました。
OSはMac OS X v10.5、処理系はSBCL 1.0.29。
以下はその時のメモ。
1)darcsをインストール。今回はMacPortsを利用。
2)cl-openglを取ってくる

% darcs get http://www.common-lisp.net/project/cl-opengl/darcs/cl-opengl/

3)cl-openglを適切な場所に置く

% mv ./cl-opengl /opt/local/lib/sbcl/site/
% cd /opt/local/lib/sbcl/site-system/
% ln -s ../cl-opengl/*.asd .

4)cffiをインストール

% sbcl
* (require 'asdf-install)
* (asdf-install:install :cffi)

5)cl-openglをコンパイル

* (asdf:oos 'asdf:load-op :cl-opengl)

6)テスト

* (asdf:oos 'asdf:load-op :cl-glut-examples)
* (cl-glut-examples:gears)

gears
ゲームは「いつか」作ります。

バイナリストリームを対話環境でテストする

土曜日, 9月 26th, 2009

Java逆アセンブラを作っていたときの話。
バイナリファイルを読み込んで色々するプログラムを書くので、
「バイナリストリームからNバイト読み込んで…」
といった関数を沢山書いたんですが、これのテストがやりにくいです。
ファイルを実際に開く以外に、バイナリストリームを作る方法を知らないので、
ちょっとしたテストをする場合にも、実際にファイルを作らないといけない。
これでは非常に面倒です。
文字ストリームを扱う関数をテストする場合には、
with-input-from-stream, with-output-to-stream
を使えば、対話環境で楽に試せるので、
これのバイナリストリーム版を作ってみました。
Gray Streamを使っています。
SBCLでテスト済み。

(defclass binary-array-input-stream (fundamental-binary-input-stream)
  ((array :initarg :array :type (array t (*)))
   (index :initarg :start :type fixnum)
   (end :initarg :end :type fixnum)))
(defun make-binary-array-input-stream (array &optional (start 0) end)
  (make-instance 'binary-array-input-stream
                 :array array :start start :end (or end (length array))))
(defmethod stream-read-byte ((stream binary-array-input-stream))
  (with-slots (index end array) stream
    (if (>= index end)
	:eof
	(prog1 (aref array index)
          (incf index)))))
(defmacro with-input-from-binary-array((var array)
                                       &body body)
  `(let ((,var (make-binary-array-input-stream ,array)))
     (multiple-value-prog1
         (unwind-protect
              (progn ,@body)
           (close ,var)))))

配列の型は本当は (array (unsigned-byte 8) (*)) の方がいいんでしょうが、
そうすると、 #(1 2 3) の記法が使えなくなって面倒なので指定を緩くしました。
ここで、次のような関数を作ったとします。

(defun byte-list->number (byte-list &optional little-endian-p)
  (reduce #'(lambda (high low) (+ (ash high 8) low))
          (if little-endian-p
              (reverse byte-list)
              byte-list)))
(defun read-byte-list (n stream)
  (let (byte-list)
    (dotimes (_ n (nreverse byte-list))
      (push (read-byte stream) byte-list))))

これらの関数を対話環境でテストしたければ、次のようにします。

(with-input-from-binary-array (s #(1 44))
  (let ((byte-list (read-byte-list 2 s)))
    (format t "big endian: ~A~%" (byte-list->number byte-list))
    (format t "little endian: ~A~%" (byte-list->number byte-list t))))

big endianは300、little endianは11265となり、ちゃんと動きます。

Javaのアセンブラ/逆アセンブラをLispで作った

水曜日, 9月 23rd, 2009

Javaのアセンブラと逆アセンブラをCommon Lispで作りました。
一部対応してない命令がありますが、大体動作します。
アセンブリはもちろんS式で記述します。読み込むときはreadするだけ。
オペランドのない命令はアトム、オペランド付きの命令はリストとなっています。
とりあえずhello world。

;; ljTest.lja
(class "ljTest" "java/lang/Object" (public super)
 method
 ("<init>" "()V" (public)
   aload_0
   (invokespecial "java/lang/Object" "" "()V")
   return)
 method
 ("main" "([Ljava/lang/String;)V" (public static)
   (meta max-stack 2)
   (getstatic "java/lang/System" "out" "Ljava/io/PrintStream;")
   (ldc "hello world")
   (invokevirtual "java/io/PrintStream" "println" "(Ljava/lang/String;)V")
   return))

hello worldだけなのに長いです。さすがJava。
<init>というのはコンストラクタです。

% clisp
> (load "ljasm.lisp")
> (assemble-file "ljTest.java")
> (exit)
% java ljTest
hello world

こんな感じに動作します。
次は逆アセンブル。

// le.java
public class le{
  public static void main(String args[]) {
    try {
      for (int i=5; i>=0; i--) {
        System.out.println(100 / i);
      }
    } catch (ArithmeticException e) {
      System.out.println("Nice exception...");
    }
  }
}

ループと例外が使われています。

% javac le.java
% clisp
> (load "ljasm.lisp")
> (disassemble-file "le.class")
> (exit)

これで次のようなファイルが作られます。
(整形は私が手作業でやりました)

(CLASS "le" "java/lang/Object" (PUBLIC SUPER)
 INTERFACE NIL
 METHOD
 ("" "()V" (PUBLIC)
   (META MAX-STACK 1)
   (META MAX-LOCAL 1)
   ALOAD_0
   (INVOKESPECIAL "java/lang/Object" "" "()V")
   RETURN)
 METHOD
 ("main" "([Ljava/lang/String;)V" (PUBLIC STATIC)
   (META MAX-STACK 3)
   (META MAX-LOCAL 2)
   :L0
   ICONST_5 ISTORE_1
   :L2
   ILOAD_1 (IFLT :L22)
   (GETSTATIC "java/lang/System" "out" "Ljava/io/PrintStream;")
   (BIPUSH 100) ILOAD_1 IDIV
   (INVOKEVIRTUAL "java/io/PrintStream" "println" "(I)V")
   (IINC 1 255) (GOTO :L2)
   :L22
   (GOTO :L34)
   :L25
   ASTORE_1  ;store exception object                                                                                                                                               
   (GETSTATIC "java/lang/System" "out" "Ljava/io/PrintStream;")
   (LDC "Nice exception...")
   (INVOKEVIRTUAL "java/io/PrintStream" "println" "(Ljava/lang/String;)V")
   :L34
   RETURN
   (META EXCEPTION :L0 :L22 :L25 "java/lang/ArithmeticException"))

キーワードはラベルと見なされます。
逆アセンブリするときはラベル名は自動生成されます。
例外の指定は非常に地味です。 (META EXCEPTION …) の
最初の:L0と:L22は例外を捕まえる範囲、:L25は例外ハンドラです。
という訳で、それっぽく動いています。
めでたしめでたし。

BiwaSchemeでゲームつくった

木曜日, 7月 16th, 2009

マンガで分かるLisp [その3]で出てくるトランプのゲーム
「ドボン」をBiwaSchemeで作りました。
Firefox, Opera, Google Chromeで動作を確認しています。
残念ながら、Internet Explorerでは動作しません。
どぼん on BiwaScheme
ソースを見ればわかりますが、すべてSchemeで書いてます。
少しくらいはJavaScriptを書かないといけないかと思ったんですが、
一行たりとも書かずにすみました。BiwaSchemeすごい。
どうやらバグがあるようで、時々止まったりします orz