リリカル☆Lisp開発日記

※リストの循環は脳に悪影響を及ぼす可能性があります。
　本エントリを読むときは必ず(setq *print-circle* t)を利用して下さい。

＜括弧を書かずに循環構造をつくろうとしたのがことの始まりでした＞

'#1='#1# => #1='#1#

リーダマクロ ‘ を展開すると結果は、 #1=(quote #1#) になり、循環構造ができます。
しかし、CLISPでこれのcdrを取るとスタックオーバフローします。

(cdr '#1='#1#)
*** - Program stack overflow. RESET

ちなみに、SBCLだとちゃんと結果が表示されます。

(cdr '#1='#1#) => (#1='#1#)

＜ちゃんと！？＞
よくよく見ると、微妙におかしなことに気づきました。
#1=(quote #1#)は2個のコンスセルから構成されます。
しかし、(#1=’#1#)は3個のコンスセルから構成されてるじゃないですか！
(cdr ‘#1=’#1#)は#1=((quote . #1#))じゃないとおかしいはず(図参照)。

＜何かがおかしい＞
もし(#1=’#1#)が図の右側のような構造で表されていた場合、
(#1=’#1#)と(cdar (#1=’#1#))は別のものになるはずです。しかし、

(defvar a (cdr '#1='#1#)) => A
a => (#1='#1#)
(eq a (cdar a)) => T

同一のものと判定されてしまいました。
しかし、

(defvar b '(#1='#1#)) => B
(eq b (cdar b)) => NIL

やっぱり同一じゃなかった！？
つまり、ここから得られる結論は
(#1=’#1#)は(#1=’#1#)であって(#1=’#1#)ではない、なんじゃそりゃ。

＜更なる謎＞
CLISPで色々試していると更に訳の分からないことが起きました。

(cdr '#1=(quote #1#))
*** - Program stack overflow. RESET
(cdr '#1=(q #1#)) => #1=((Q . #1#))

quoteだと駄目で、qなら大丈夫！？
シンボルが別のものになっただけで、なんで結果が変わるのでしょうか。

＜それでもGaucheなら・・・Gaucheならきっと何とかしてくれる＞
もうCommon Lispの処理系に頼るのに嫌気がさして来たのでGaucheを使ってみました。

'#1='#1# => #0='#0#

Gaucheだと##は0から始まるみたいです。で、これのcdrをとると

(cdr '#1='#1#) =>
#0=('''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''
(中略)
'''''''''''''''''''''''''''''''''''''''''''
Segmentation fault

やたらと沢山の引用符が出た後に死んでしまいました。

ここまで来てやっとすべての謎が解けました。
CLISPがスタックオーバフローを起こした原因は(恐らく)この引用符です。
表示部分で(quote X)を’Xに変換する処理が素直であったために死んでしまったのでしょう。

一方、素直でない(?)SBCLは生き残ることに成功しましたが、
(#1=’#1#)という表示と(#1=’#1#)という入力が別物になるという問題が生まれてしまいます。
個人的にはLispWorksの動作が一番好きです。

Common Lispにはwith-open-fileというマクロがあります。

(with-open-file (stream filename)
  ...
  (read-line s)
 ...
 )

このマクロは、ファイルをオープンして、
ここを抜けるときに自動的にファイルをクローズしてくれるというものです。
そのため、ファイルの閉じ忘れがおこりません。

このマクロをC++、もしくはC99で再現する方法を思いついたのでメモしておきます。

#define with_open_file(s,p,m) \
  for(FILE *s=fopen(p,m); s; fclose(s),s=NULL)
...
void hoge(char *path) {
  char buf[256];
  with_open_file(fp, path, "r") {
    ...
    fgets(buf, sizeof(buf), fp);
    ...
  }
}

短いコードでなかなかいい感じだと思います。
残念ながら、本物のwith-open-fileと異なり、returnなどで関数を抜けたときに、
ファイルを閉じてくれないという問題がありますが。
(その他にも、breakやcontinueを中で使ったらまずいとか、色々あるけど、
まあ、一発ネタなんで、深いことは考えないことにします。)

またも前のエントリから1ヶ月が経過してました。

時間経つの早すぎ。

みなさん、覚えていますか？

マンガで分かるLispは「Lispで世界を救う話」だったということを。

気がついたら、1ヶ月以上更新が止まってました。

そして、気がついたら大学院生になってました。

富山に行ってきました。

そこで素敵なお買い物カードを手に入れました。池田市のカードもこれくらい頑張ってほしい。

卒論出した。

あとは発表だけ。

「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);
}

もう2月になってしまった。

卒論の締め切りが迫ってきた。

お久しぶりです。

もうすぐ、このサイトができてから3年になります。