一日でできるセルフホスティングForthコンパイラ

# はじめに

これは「[言語実装 Advent Calendar 2017](https://qiita.com/advent-calendar/2017/lang_dev)」24日目の記事です。

この記事では 64bit版Windows で実行可能な x86_64 のセルフホスティング Forth コンパイラを作ります。

対象読者としては「C言語そこそこわかる」「x64アセンブラに嫌悪感はない」ぐらいの人を想定しています。コンパイラの知識は特に前提としません。

完成品は[こちら](https://github.com/usm-takl/self-hosting-forth-compiler-in-1-day/)から取得できます。

bootstrap には C を使います。しかしC言語的にお行儀の悪いことを色々やりますので、バージョンやコンパイルオプション等によっては動かないかもしれません。ご了承ください。一応完成版は以下の環境で動作を確認しています。

* Cygwin64 の gcc
    * option: -O3 と -O なし両方
    * version: 6.4.0 (GCC)
    * target: x86_64-pc-cygwin
* Msys2 の gcc
    * option: -O3 と -O なし両方
    * version: 5.3.0 (GCC)
    * target: x86_64-pc-msys
* VisualStudio2015 Desktop Edition[^vs17]
    * Debug Build とRelease Build の両方

なお、プログラムの性質上、出来上がった実行ファイルにアンチウィルスソフトが反応したりします。アンチウィルスソフトが反応したら報告書を書かなければいけないような会社にお勤めの方は、会社のPCで実行しないようご注意下さい[^shimatsusho]。

# セルフホスティングコンパイラとは

セルフホスティングコンパイラとは、自身のコンパイル対象の言語で書かれたコンパイラのことです。例えば「Cで書かれたCコンパイラ」はCのセルフホスティングコンパイラです。自作コンパイラがセルフホスティングできるようになって何が嬉しいのかよくわかりませんが、趣味でコンパイラを作る人ならば一度は作ってみたくなる何かであるようです。というわけで、作りましょう。

今回はForthっぽい言語のセルフホスティングコンパイラを作ります。Forthはコンパイラを作るのがとても簡単な割に実用的な言語です。さくっと作るためにターゲットはこの言語にします。

# 文献など

手元に置いておいたりタブで開いておいたり先に読んでおいたりすると良い文献などです。

* [Forth200x](http://www.forth200x.org/)
    * 新しい Forth の標準化を進めているグループです。名前は200xですが最新のドラフトは2016年版です。記事中では [forth16-1.pdf](http://www.forth200x.org/documents/?C=N;O=D) をちょくちょく参照します。Forthで困ったらとりあえずこれを見ましょう。
* [Intel® 64 and IA-32 Architectures Software Developer Manuals](https://software.intel.com/en-us/articles/intel-sdm)
    * x64 の一次情報です。アセンブラ/機械語で困ったらここを見ると良いと思います。いくつか資料がありますが、[全部入り](https://software.intel.com/sites/default/files/managed/39/c5/325462-sdm-vol-1-2abcd-3abcd.pdf)を持っておくといいと思います。AMD派はAMDの資料を読みましょう。
* [x64 Software Conventions](https://msdn.microsoft.com/en-us/library/7kcdt6fy.aspx)
    * Windows 上での x64 の呼び出し規約が載っています。これが一次情報で良いんでしょうか？よくわかりませんが、私はここを参照しました。
* [PE Format](https://msdn.microsoft.com/en-us/library/windows/desktop/ms680547(v=vs.85).aspx)
    * いわゆる .exe 形式のファイルフォーマットです。この記事を書くのにここを参照しました…が、情報が足りていない気がします。一次情報は他にあるかと思われます。
* [PE ファイルについて (1) - IMAGE_DOS_HEADER](http://tech.blog.aerie.jp/entry/2015/12/21/183741)
    * Windows & Microsoft技術 基礎 Advent Calendar 2015 の20日目の記事です。いわゆる .exe 形式のファイルフォーマットを解説しています。この記事と、関連記事を辿っておくと、とりあえず実行ファイルが作れるようになると思います。
* [Forthについてのメモ書き](https://qiita.com/gyabo/items/f7e9b2ce14f3c0c12f16)
    * 言語実装 Advent Calendar 2017 の19日目の記事です。私とは違った方法でForthを実装しています。とても素直な実装なので、先に読んでおくと良いと思います。
* [Online x86 / x64 Assembler and Disassembler](https://defuse.ca/online-x86-assembler.htm)
    * Web上でアセンブル/ディスアセンブルできるサイトです。この手のサイトはいくつか見つかるのですが、個人的にはこれが一番使いやすかったです。

# Forth を軽く紹介

本記事ではForthのセルフホスティングコンパイラを作るのですが、なにぶんForthは古代言語です。名前は聞いたことがあっても触ったことはない人が多いのではないでしょうか。まずは軽くForthについて紹介しておきます。

## pForth の install

まずForthのインストールです。「とりあえずちょっと触ってみる」ぐらいなら pForth がお勧めです。Cygwin があれば build は簡単。[こちら](https://github.com/philburk/pforth)から pforth-master の zip を download して次のようにすれば実行できます。

```shell-session:bash
$ unzip pforth-mater.zip
$ cd pforth-master/build/unix
$ make
$ ./pforth_standalone
```

では、触ってみましょう。

## integer と stack

pForth を起動すると text intepreter が起動します。「text interpreter は入力を読んでは実行する」をひたすら繰り返します。

text interpreter は、最初は interpretation state という状態になっています。interpretation stateで整数を入力すると、整数が stack に積まれます。とりあえず`1`を入力してみましょう(`⏎`はEnterの押下を表しています)。

```forth:pForthへの入力
1 ⏎
```

```forth:pForthの画面
1    ok
Stack<10> 1
```

画面中の `Stack<10> 1` が現在の stack の状態を表しています[^ten]

2も積んでみましょう。

```forth:pForthへの入力
2 ⏎
```

```forth:pForthの画面
2    ok
Stack<10> 1 2
```

増えていきます。

## word

Forth ではいわゆる「名前」を word と呼びます[^word_def]。

text interpreter が interpretation state のときに word を入力すると、その word の interpretation semantics が実行されます。

例として `+`という word を紹介します。この word の interpretation semantics は「stack から 2個値を pop し、和を求め、その値を push する」です。

実行してみましょう。

```forth:pForthへの入力
+ ⏎
```

```forth:pForthの画面
Stack<10> 3
```

1 と 2 が stack から pop され、3 が push されていますね。

もうひとつ、`.` という word を紹介します。この word の interpretation semantics は「stack から 1 つ値を pop し、その値を表示する」です。実行してみましょう。

```forth:pForthへの入力
. ⏎
```

```forth:pForthの画面
. 3    ok
Stack<10>
```
stack が空になり、3が表示されました。

## interpretation state

text intepreter は、 interpretation state のとき、入力された word の interpretation semantics を順に実行します。今度は一度に次のように入力してみましょう。

```forth:pForthへの入力
1 2 + . ⏎
```

すると、表示は次のようになります。

```forth:pForthの画面
1 2 + . 3    ok
Stack<10>
```

このプログラムは前から順に実行されました。つまり次の表のような動作をしました。

|順序 |入力 |動作 |
|---|---|---|
|1 | `1` | スタックに `1` を push する |
|2 | `2` | スタックに `2` を push する |
|3 | `+` | スタックから2つの値を pop し加算し push する(3がpushされる) |
|4 | `.` | スタックから値を pop し表示する(3が表示される) |

というわけで覚えておいてください。「text intepreter は、 interpretation state のとき、入力された word の interpretation semantics を順に実行する」です。

## compilation state

Forth で word を定義するには `:` を使います。例えば 1 と 2 を足して表示する word を定義するには、次のように入力します。

```forth:forthへの入力
: w 1 2 + . ; ⏎
```

成功すると、画面は次のようになります。

```forth:forthの画面
: w 1 2 + . ;    ok
Stack<10>
```
定義された word を使うには、 interpretation state で w を入力します。

```forth:pForthへの入力
w ⏎
```

```forth:pForthの画面
w 3    ok
Stack<10>
```

実はこの `:` と `;` は特別な構文ではありません。ただの word です。`:` の interpretation semantics は「word を一つ読み、その word を名前に持つ definition を作成し、 compilation state に入る」です。また、`;` の compilation semantics は「呼び出し元に帰るコードを definition に追加し、 interpretation state に戻る」です。そして text intepreter の compilation state のときの動作は、「入力された word の compilation semantics を順に実行する」です。そして多くの場合、 word の compilation semantics は「それ自身の interpretation semantics を現在定義中の word の interpretation semantics に追加する」です。

ややこしいですね。どういうことか、処理系に `: w 1 2 + . ; w` と入力したときの動作の例を挙げて説明します。

処理系に `: w 1 2 + . ; w` を入力すると、次のようなことが起こります。

| 順序 | 入力 | 動作 | `w` のinterpretation semantics |
|---|---|---|---|
| 1 |  `:` | `w` という名前の word を作成し、compilation state に入る。 | 空 |
| 2 | `1` |「スタックに `1` を push する」を `w` の interpretation semantics に追加する | スタックに `1` を push する |
| 3 | `2` | 「スタックに `2` を push する」を `w` の interpretation semantics に追加する | スタックに `1` を push して、スタックに `2` を push する |
| 4 | `+` | 「`+`のinterpretatoin semanticsを実行する」を `w` の interpretation semantics に追加する | スタックに `1` を push して、スタックに `2` を push して、`+`のinterpretation semantics を実行する |
| 5 | `.` |「`.`のinterpretatoin semanticsを実行する」を `w` の interpretation semantics に追加する | スタックに `1` を push して、スタックに `2` を push して、`+`のinterpretation semantics を実行して、`.` のinterpretation semantics を実行する |
| 6 | `;` |「呼び出し元に帰る」を `w` の interpretation semantics に追加し、 interpretation state に戻る | スタックに `1` を push して、スタックに `2` を push して、`+`のinterpretation semantics を実行して、`.` のinterpretation semantics を実行して、呼び出し元に帰る |
| 7 | `w` | `w` の intepretation semantics、つまり「スタックに `1` を push して、スタックに `2` を push して、`+`のinterpretation semantics を実行して、`.` のinterpretation semantics を実行して、呼び出し元に帰る」を実行する | スタックに `1` を push して、スタックに `2` を push して、`+`のinterpretation semantics を実行して、`.` のinterpretation semantics を実行して、呼び出し元に帰る |

というわけで覚えておいてください。「text intepreter は、 compilation state のとき、入力された word の compilation semantics を順に実行する」です。

## immediate ― コンパイル中に word を実行する
wordを定義した直後に`immediate`を実行すると、直前に定義された word は immediate wordになります。immediate word になると、その word の compilation semantics は interpretation semantics と同じものになります。つまり、immediate word がコンパイル中に現れると、その word は即座に実行されます。

やってみましょう。10を表示する word を定義し、immediate word にします。

```forth:pForthへの入力
: x 10 . ; immediate ⏎
```

```forth:pForthの画面
: x 10 . ; immediate    ok
Stack<10>
```

ここで次のように入力します。

```forth:pForthへの入力
: y x ⏎
```

```forth:pForthの画面
: y x 10
```

compileが終わっていないのに`10`が表示されています。

つまり、Forth では compile 中に任意のプログラムを実行できるということです。この immediate word が Forth を Forth たらしめている要素です。この immediate word は、事実上、コンパイラを拡張しています。この immediate word があるからこそ、 Forth はシンプルかつ強力な言語になっているのです。

## Forth まとめ

というわけで、とりあえず次の3点を覚えておきましょう。

* text interpreter が interpretation state のとき、text interpreter は読んだ word の interpretation semantics を順に実行する
* text interpreter が compilation state のとき、text interpreter は読んだ word の compilation semantics を順に実行する
* compile 中に任意のプログラムを実行できる

# 前準備 ― メモリ上に native code を書き込み、実行する

今回作るコンパイラは native code を生成します。その過程で native code をメモリ上に書き込んでそのまま実行する方法を使います。ですので、まず、メモリ上に native code を書き込んで実行する方法を紹介しておきます。

native code を生成して実行するのは次の3ステップでできます。

1. 読み書き実行可能なメモリ領域を確保する
2. 確保したメモリ領域にプログラムを書き込む
3. 書き込んだプログラムを実行する

とりあえず「何もしないが実行可能なプログラム」を実行するプログラムを作ってみましょう。

```c++:test.c(新規)
#include<stdint.h>
#include<stdio.h>
#include<windows.h>

static uint8_t *mem;

int main() {
  // 1. 読み書き実行可能なメモリ領域を確保する
  // * Windows では VirtualAlloc という関数でOSからメモリを貰うことができます。
  // * 第一引数には、貰ったメモリを自プロセスの何番地に割り当てるか指定します。
  //   0 を指定すると、割り当てる場所は OS が勝手に決めます。
  // * 第二引数には、確保するメモリ量を指定します。
  //   640KBもあれば誰でも十分だと思ったので 640 * 1024 にしました。
  // * 第三引数には、メモリ確保方法を指定します。
  //   MEM_COMMIT を指定すれば今すぐ使えるメモリを確保してくれます。
  // * 第四引数には、アクセス保護の方法を指定します。
  //   PAGE_EXECUTE_READWRITE を指定すると確保したメモリ領域は読み書き実行可能になります。
  mem = VirtualAlloc(0, 640 * 1024, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
  
  // 2. 確保したメモリ領域にプログラムを書き込む
  // ここでは「 RET 命令のみからなるプログラム」
  // つまり「何もしないで呼び出し元に帰るプログラム」を書き込んでいます。
  // x86_64 の RET 命令は 0xc3 の1バイト命令です。これを書き込みます。
  mem[0] = 0xc3; // RET
  
  // 3. 書き込んだプログラムを実行
  // void(*)() は「引数を何個とっても良く値を返さない関数の型」です。
  // (void(*)())mem は mem をこの型にキャストする式です。
  // ((void(*)())mem)() は引数0個で mem にあるプログラムを呼び出す式です。
  // Cの言語仕様上未定義動作なのでしょうが、
  // 現実的には CALL 命令で mem に飛ぶコードになります。
  ((void(*)())mem)();
  
  printf("OK!\n");
  return 0;
}
```

実行して `OK!` と表示されたら「何もしないが実行可能なプログラム」が実行できたことになります。

```shell-session:bash
$ gcc test.c && ./a
OK!
```

ちなみに `VirtualAlloc` の第四引数を `PAGE_READWRITE`(読み書き可能・実行不能)等 に変更すると異常終了します。試してみると良いと思います。

## Cから引数を受け取りCへ値を返す

次の native code は「二つの引数を受け取り和を返すプログラム」です。

[x64 Software Conventions](https://docs.microsoft.com/en-us/cpp/build/x64-software-conventions)から辿れる[Register Usage](https://docs.microsoft.com/en-us/cpp/build/register-usage)や[Parameter Passing](https://docs.microsoft.com/en-us/cpp/build/parameter-passing)を読むと、引数と返却値に使うレジスタがわかります。

本記事で押さえておきたいところだけ抜き出すと、

* 整数の第一引数はRCX
* 整数の第二引数はRDX
* 整数の第三引数はR8
* 整数の第四引数はR9
* 返却値はRAX

あたりですかね。

「二つの引数を受け取り和を返す関数として動くプログラム」は次のようになるでしょう。

```nasm:inc.s
    MOV RAX, RCX ; 48 89 c8
    ADD RAX, RDX ; 48 01 d0
    RET          ; c3
```

先ほどのCのプログラムを少し書き換えて試しましょう。

```c++:test.c(新規)
#include<stdint.h>
#include<stdio.h>
#include<windows.h>

static uint8_t *mem;

int main() {
  // 1. 読み書き実行可能なメモリ領域を確保
  mem = VirtualAlloc(0, 640 * 1024, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
  
  // 2. 確保したメモリ領域にプログラムを書き込む
  mem[0] = 0x48; mem[1] = 0x89; mem[2] = 0xc8; // MOV RAX, RCX
  mem[3] = 0x48; mem[4] = 0x01; mem[5] = 0xd0; // ADD RAX, RDX
  mem[6] = 0xc3;                               // RET
  
  // 3. 書き込んだプログラムを実行
  uint64_t ret = ((uint64_t(*)(uint64_t,uint64_t))(mem))(11,31);
  
  printf("%d\n", ret);
  return 0;
}
```

```shell-session:bash
$ gcc test.c && ./a
42
```

できてますね。

ところで、二モニックと機械語の対応ですが、バイナリアンなら当然丸暗記してますよね。私はしてないので[Online x86 / x64 Assembler and Disassembler](https://defuse.ca/online-x86-assembler.htm)を使ったり「nasm で .o に変換してから`objdump -d`」したりしています。

## Cの関数を呼び出す

native code から C の関数を呼び出せるようにもしたいです。

というわけで再度呼び出し規約を調べましょう。[x64 Software Conventions](https://msdn.microsoft.com/en-us/library/7kcdt6fy.aspx)から辿れる[Register Usage](https://docs.microsoft.com/en-us/cpp/build/register-usage)や[Stack Allocation](https://docs.microsoft.com/en-us/cpp/build/stack-allocation)を読むと、

* call 命令直前に、スタック上に32バイト分の空き領域を確保しておかなければならない
* call 命令直前に、RSP は 32バイト境界に合っていなければならない[^wakarinikui]
* RBP は callee save

等のことがわかります。

呼び出したい関数へのポインタがRCXに入っていたら、次のようなプログラムになるでしょう。

```asm:Cの関数を呼ぶ
PUSH RBP      ; 55          ; 元々のRBPの値をスタックに退避
MOV RBP, RSP  ; 48 89 e5    ; 元々のRSPの値をRBPに退避
SUB RSP, 32   ; 48 83 ec 20 ; スタックに shadow space を用意
AND RSP, ~0xf ; 48 83 e4 f0 ; RSPを32バイト境界に合わせる
CALL RCX      ; ff d1       ; 呼び出す
MOV RSP, RBP  ; 48 89 ec    ; RSPの値を元に戻す
POP RBP       ; 5d          ; RBPの値を元に戻す
RET           ; c3          ; 呼び出し元に帰る
```

少し補足です。このコードではRSPの退避場所にRBPを使っています。RBPは callee-save なので、CALL命令から帰って来たあと、元のRPSの値を保持しています。そのためRSPの値を元に戻すことができるのです。ところで、RBPはcallee-saveなので、このプログラムのCALL元はRBPの値が保持されていることを期待しているはずです。そのため、このプログラムでは、最初に元のRBPをスタックに退避して、最後に復元しています。

というわけで、実行してみましょう。

```c++:test.c(新規)
#include<stdio.h>
#include<windows.h>

static uint8_t *mem;

// hello と表示して 42 を返す関数
static uint64_t hello42(void) {
  printf("hello\n");
  return 42;
}

int main() {
  // 1. 読み書き実行可能なメモリ領域を確保
  uint8_t *mem = VirtualAlloc(0, 640 * 1024, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
  
  // 2. 確保したメモリ領域にプログラムを書き込む
  mem[ 0] = 0x55;                                                 // PUSH RBP
  mem[ 1] = 0x48; mem[ 2] = 0x89; mem[ 3] = 0xe5;                 // MOV RBP, RSP
  mem[ 4] = 0x48; mem[ 5] = 0x83; mem[ 6] = 0xec; mem[ 7] = 0x20; // SUB RSP, 32
  mem[ 8] = 0x48; mem[ 9] = 0x83; mem[10] = 0xe4; mem[11] = 0xf0; // AND RSP, ~0xf
  mem[12] = 0xff; mem[13] = 0xd1;                                 // CALL RCX
  mem[14] = 0x48; mem[15] = 0x89; mem[16] = 0xec;                 // MOV RSP, RBP
  mem[17] = 0x5d;                                                 // POP RBP
  mem[18] = 0xc3;                                                 // RET
  
  // 3. 書き込んだプログラムを実行
  uint64_t ret = ((uint64_t(*)(void *))(mem))(hello42);
  
  printf("%d\n", ret);
  return 0;
}
```

```shell-session:bash
$ gcc test.c && ./a
hello
42
```

いい感じですね。

## native code まとめ

ざっくりとですが次のことができるようになりました。

* メモリに native code を書き込んで実行できる
* 書き込んだ native code に引数を渡したり返却値を受け取ったりできる
* 書き込んだ native code からCの関数を呼び出せる

大体もう何でもできそうな気がしますね。

# セルフホスティング Forth コンパイラの方針

というわけで本題に入ります。

セルフホスティングまでの全体の方針はこんな感じです。

* C で Forth コンパイラ(forth0.c)を書く
* Cコンパイラで forth0.c をコンパイルする(forth0.exe ができる)
* Forth で Forth コンパイラ(forth.ft)を書く
* forth0.exe で forth.ft をコンパイルする(forth1.exe ができる)
* forth1.exe で forth.ft をコンパイルする(forth2.exe ができる)
* forth2.exe で forth.ft をコンパイルする(forth3.exe ができる)
* forth2.exe と forth3.exe とで同一のバイナリができることを確認する

それでは行きましょう。

# forth0.exe を作る

forth0.exe コンパイラを作る方針はこんな感じです。

* 最初にメモリをごっそり確保する
* 確保したメモリに word の definition を書き込む
* 確保したメモリを .exe としてまるごと書き出す

方針が決まったのでコードを書き始めましょう。forth0.c はここから始めようと思います。

```c++:forth0.c(新規)
#include<stdio.h>
#include<stdlib.h>
#include<inttypes.h>
#include<windows.h>
#include<sys/stat.h>

static uint8_t *mem;

// 以下、「forth0.c に追加」とあったら、このコメントの上にコードを追加してくだい。

void init() {
  mem = VirtualAlloc(0, 640 * 1024, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
  // 以下、「init() に追加」とあったら、このコメントの上にコードを追加してくだい。
}
```

ここで確保した `mem` の先にあれこれ書き込むことで、最初の forth コンパイラを作っていきます。

## メモリの使い方

メモリの使い方を最初に決めます。forth0.exe は `VirtualAlloc` 確保したメモリを次のように使います。

```text:forth0.exeのメモリの使い方
+------------------+ 先頭 (=VirtualAllocが返したアドレス)
| MZ/PE headers    |
|                  |
+------------------+ 先頭 + 0x00200 番地
| Import Table     |
+------------------+ 先頭 + 0x00300 番地
| startup routine  |
+------------------+ 先頭 + 0x00320 番地
| c_to_ft routine  |
+------------------+ 先頭 + 0x00340 番地
| global variables |
|                  |
+------------------+ 先頭 + 0x00400 番地
| word definitions |
|                  |
:                  :
|                  |
| data stack       |
+------------------+ 先頭 + 0xa0000 番地
```

各領域の雑な説明は次の表をご覧ください。

|名称 | 説明 |
|---|---|
| startup routine | .exe ファイルが起動しときに最初に実行されるコードを置きます。ですので、今回のプログラムでは PE ヘッダの AddressOfEntryPoint は 0x401300 になります。 |
| c_to_ft routine | C から Forth のプログラムを呼び出すときに使うコードを置きます。 |
| global variables | 文字通りグローバル変数を置きます。メモリアドレス直でアクセスできるようにしておくと、CプログラムとForthプログラムとで変数を共用するときに便利です。  |
| word definitions | word definition を入れます。|
| data stack | data stack として使う領域です。word definitions の領域と data stack の領域は重なっています。危険そうですが、危険です。word を多く定義しすぎたり data stack が伸びすぎたりすると壊れます。手抜きコンパイラなのでべつにいいでしょう。 |

使い方が決まったので、`#define` しておきます。

```c:forth0.cに追加
#define import           (mem+0x200)
#define import_limit     (mem+0x300)
#define startup          (mem+0x300)
#define startup_limit    (mem+0x320)
#define c_to_ft          (mem+0x320)
#define c_to_ft_limit    (mem+0x330)
#define word_definitions (mem+0x400)
```

グローバル変数はこんな感じで割り当てています。

```c:forth0.cに追加
#define ftmain (*(uint64_t *)(mem+0x3a8))
#define state  (*(uint64_t *)(mem+0x3b0))
#define fin    (*(FILE **)(mem+0x3b8))
#define token  ((char *)(mem+0x3c0))
#define mrd1   (*(uint8_t **)(mem+0x3e0))
#define mrd2   (*(uint8_t **)(mem+0x3e8))
#define ep     (*(uint8_t **)(mem+0x3f0))
```

|変数名 |説明 |
|---|---|
| `ftmain` | forth の `main` という word のコード領域のアドレスです。`startup_routine`は`ftmain`に格納されたアドレスからコードを実行しようとします。forthN.exe から forth(N+1).exe に `main` のアドレスを渡すために使います。  |
| `state` | text interpreter が interpretation state ならば 0 が、compilation state ならば 1 が入ります。ひどい名前と思われるかもしれませんが forth16-1.pdf でもこの名前を使ってますのでそれに倣いました。 |
| `fin` | Forth ソースコードを読み込むための`FILE *`です。色々な word から参照されますのでグローバルにします。ひどい名前と思われるかもしませんが毒を食らわば皿までです。 |
| `token` | 構文解析というか字句解析というかそんな感じのやつの結果を入れるための領域です。32バイトあります。 |
| `mrd1` | most recent definition 1です。forthN.exe 実行中、forth(N-1).exe で最後に定義された word の definition を指します。forth1.exe, forth2.exe, forth3.exe ... では使いますが、forth0.exe では使いません。 |
| `mrd2` | most recent definition 2です。forthN.exe 実行中、最後に定義された word の definition を指します。 |
| `ep` | emit pointer です。 `B`, `D`, `Q` 等のマクロ(後述)を評価したときにデータを書き込む位置です。`begin_def`(後述) と `end_def`(後述) との間でのみ有効です。 |

## word の definition を作成できるようにする

Forth の text interpreter はひたすら word の semantics を実行するだけのプログラムです。word というのは要するに名前でした。従って、native code に名前を付けて、名前で呼び出せるようになれば、簡単に text intepreter を作れそうです。

というわけで、名前からデータを引けるデータ構造を考えましょう。ハッシュテーブルなどを使うとかっこいいのかもしれませんが、変則連結リストを使います。

まず、word の definition ひとつの構造を次のように決めます。

```text:wordのdefinition
+------------+
| name       | 32 bytes
|            | この definition の名前。0終端文字列。
+------------+
| immediate  | 8 bytes: 0なら通常のword、1ならimmediate word。
+------------+
| body       | 可変長のバイト列
:            : 基本的には x64 命令が入る。
|            |
+------------+
| size       | 8bytes: name から size まで全て合わせたこの definitioin のバイト数が入る
+------------+
              <-- この definition へのポインタ
```

また、「word の definition へのポインタ」は「その definition の最後の byte の次を指すポインタ」であると決めます。

definition の各領域にアクセスするためのマクロを定義しましょう。

```c:forth0.cに追加
#define WORD_SIZE(word) (((uint64_t *)(word))[-1])
#define WORD_HEAD(word) ((uint8_t *)(word)-WORD_SIZE(word))
#define WORD_NAME(word) ((char *)WORD_HEAD(word))
#define WORD_IMMEDIATE(word) (*(uint64_t *)(WORD_HEAD(word)+32))
#define WORD_BODY(word) (WORD_HEAD(word)+40)
```

次に word を定義するためのコードを追加します。

「新しく定義する word の definition は、最後に定義した word の definition の直後に置く」という決まりにしましょう。最後に定義した word の definition へのポインタは `mrd2` にすると決めたのでした。というわけで `mrd2` の初期値に、`word definitions` 領域の先頭へのポインタを設定しましょう。

```c:init()に追加
  mrd2 = word_definitions;
```

次にデータを書き出すマクロを用意します。`ep` (後述)が指している場所から順にデータを書き出すマクロです。何をしたいかはコードを見ればわかりますよね。邪悪ですが意外といいやつらです[^alignment]。

```c:forth0.cに追加
#define B(b) (*(uint8_t *)ep=(uint8_t)(b),ep+=1)
#define D(d) (*(uint32_t *)ep=(uint32_t)(d),ep+=4)
#define Q(q) (*(uint64_t *)ep=(uint64_t)(q),ep+=8)
```

そして word のヘッダとフッタにあたる部分を出力する関数を定義します。前述の `ep` は`begin_def`で有効化され、`end_def`で無効化されます。`end_def`で word の定義が完了したとき、`mrd2`が更新されます。

```c++:forth0.cに追加
static void begin_def(const char *name, int immediate) {
  ep = mrd2;
  strncpy((char *)ep, name, 32); ep+=32;
  Q(immediate);
}
```

```c++:forth0.cに追加
static void end_def(void) {
  Q(ep - mrd2 + 8); // size
  mrd2 = ep;
  ep = 0;
}
```

さて、これで道具は揃いました。

早速 word の definition を作成しましょう。word の definition を作成するには

1. `begin_def()` を呼び出す
2. `B()`,`D()`,`Q()` を使ってBODY部分を出力
3. `end_def()` を呼び出す

とします。

まずRET命令だけを含む word を定義してみましょう。

```c++:test.c(新規)
#include"forth0.c" // 行儀は悪いですが、テストコードを書くのに便利といえば便利

int main () {
  init();

  // nop1 を定義する
  begin_def("nop1", 0);
  B(0xc3); // RET
  end_def();

  // フィールドアクセス用マクロが動くかテスト
  printf("%s\n", WORD_NAME(mrd2)); // nop1 と表示される
  printf("%d\n", WORD_IMMEDIATE(mrd2)); // 0 と表示される
  printf("%x\n", *WORD_BODY(mrd2)); // c3 と表示される
  printf("%d\n", WORD_SIZE(mrd2)); // 49 と表示される
  ((void(*)())WORD_BODY(mrd2))(); // クラッシュしないはず
  printf("OK!\n");
  return 0;
}
```

```shell-session:bash
$ gcc test.c && ./a
nop1
0
c3
49
OK!
```

期待通りになります。

さて、ここで `nop1` と `nop2` を作るとどうなるでしょうか。

```c++:test.c(新規)
#include"forth0.c"

int main () {
  init();

  begin_def("nop1", 0);
  B(0xc3); // RET
  end_def();

  begin_def("nop2", 0);
  B(0xc3); // RET
  end_def();
  
  // 以下略
```

メモリ上で次のようになります。

```text
+------------------+
| size : 0         | 8 bytes / mem + 0x3f8 番地
+==================+
| name : nop1      | 32 bytes
|                  |
+------------------+
| immediate:  0    | 8 bytes
+------------------+
| body : RET       | 1 byte
+------------------+
| size : 49        | 8 bytes
+==================+ <-- nop1 へのポインタ
| name : nop2      | 32 bytes
|                  |
+------------------+
| immediate: 0     | 8 bytes
+------------------+
| body : RET       | 1 byte
+------------------+
| size : 49        | 8 bytes
+==================+
                    <-- nop2 へのポインタ = mrd2
```

word を定義すればするほど、definition 用領域が伸びていくことになります。

ところで、各 definition は連続しているので、「ある definition へのポインタ」から「その defitnion の size」を引けば、「ひとつ前の definition へのポインタ」が得られます。

便利そうですので「ひとつ前の definition を取得するマクロ」を作りましょう。

```c++:forth0.cに追加
#define WORD_PREV(word) ((uint8_t *)(word)-WORD_SIZE(word))
```

これを使えば word の definition を線形探索できますね。番兵はサイズ0の definition を使いましょう。ちょうどmem+0x3f8番地には0が入っていますので、mem+0x400を指すポインタはサイズ0の word を指していると見做すことができます。さっそく実装です。

```c++:forth0.cに追加
static uint8_t *find_word(const char *name) {
  uint8_t *word = mrd2; // 最新のdefinition(most recent definition) へのポインタ
  while (WORD_SIZE(word)) {
    if (!strcmp(WORD_NAME(word), name)) return word;
    word = WORD_PREV(word);
  }
  return 0;
}
```

テストしましょう。

```c++:test.c(新規)
#include"forth0.c"

int main () {
  init();

  begin_def("nop1", 0); B(0xc3 /* RET */); end_def();
  begin_def("nop2", 0); B(0xc3 /* RET */); end_def();
  printf("%s\n", WORD_NAME(find_word("nop1"))); // nop1 が表示される
  printf("%s\n", WORD_NAME(find_word("nop2"))); // nop2 が表示される
  ((void(*)())WORD_BODY(find_word("nop1")))(); // クラッシュしない
  ((void(*)())WORD_BODY(find_word("nop2")))(); // クラッシュしない
  printf("%p\n",find_word("nop3")); // ヌルポインタ的な何かが表示される(表示内容は処理系定義)
  printf("OK!\n");
  return 0;
}
```
```shell-session:bash
$ gcc test.c && ./a
nop1
nop2
0x0
OK!
```

よさげですね。

## hello と表示する word を定義する

次は、生成した native code から Cの関数を呼び出そうと思います。呼び出す対象は次の関数です。

```c++
static uint64_t hello(void) {
  printf("hello\n");
}
```

呼び出し規約はもうわかっていますので、さくっと書けますね。

```c++:test.c(新規)
#include"forth0.c"

static uint64_t hello(void) {
  printf("hello\n");
}

int main () {
  init();

  begin_def("hello", 0);
  B(0x55);                         // PUSH RBP
  B(0x48),B(0x89),B(0xe5);         // MOV RBP, RSP
  B(0x48),B(0x83),B(0xec),B(0x20); // SUB RSP, 32
  B(0x48),B(0x83),B(0xe4),B(0xf0); // AND RSP, ~0xf
  B(0x48),B(0xb8),Q(hello);        // MOV RAX, hello
  B(0xff),B(0xd0);                 // CALL RAX
  B(0x48),B(0x89),B(0xec);         // MOV RSP, RBP
  B(0x5d);                         // POP RBP
  B(0xc3);                         // RET
  end_def();

  ((void(*)())WORD_BODY(find_word("hello")))();
  
  return 0;
}
```

```shell-session:bash
$ gcc test.c && ./a
hello
```

呼べました。

が、ちょっと `B` が多いですね。Cの関数を呼び出すたびにこれを書くのは面倒です。「Cの関数を呼び出す word を定義する関数」があるとよさそうなので、ここは関数化しておきましょう[^func_void]。

```c++:forth0.cに追加
static void def_cfun(const char *name, void *cfun, int immediate) {
  begin_def(name, immediate);
  B(0x48),B(0x89),B(0xe5);         // MOV RBP, RSP
  B(0x48),B(0x83),B(0xec),B(0x20); // SUB RSP, 32
  B(0x48),B(0x83),B(0xe4),B(0xf0); // AND RSP, ~0xf0
  B(0x48),B(0xb8),Q(cfun);         // MOV RAX, cfun
  B(0xff),B(0xd0);                 // CALL RAX
  B(0x48),B(0x89),B(0xec);         // MOV RSP, RBP
  B(0xc3);                         // RET
  end_def();
}
```

```c++:test.c
#include"forth0.c"

static uint64_t hello(void) {
  printf("hello\n");
}

int main () {
  init();

  def_cfun("hello", hello, 0);
  ((void(*)())WORD_BODY(find_word("hello")))();

  return 0;
}
```

```shell-session:bash
$ gcc test.c && ./a
hello
```

便利になりました。

## data stack / return stack

Forth は stack を使う言語です。stack を用意しましょう。

Forth にはふたつの stack があります[^number_of_stacks]。data stack と return stack です。data stack は主に word への引数や word からの返却値を扱うのに使います。return stack は主に return address を格納するのに使います。

### return stack

return stack は Windows の用意してくれる stack をそのまま使います。こうすると x64 のCALL/RET 命令でそのまま return address を扱えて便利です。

### data stack

data stack は Windows は用意してくれません。メモリ領域と stack pointer を用意しましょう。

グローバル変数`sp`を data stack pointer とし、 `VirtualAlloc` で確保したメモリ領域の末尾を data stack にします。

```C++:forth0.cに追加
static uint8_t *sp;
```

```C++:init()に追加
  sp = mem + 640 * 1024;
```

C コード内では `sp` をスタックポインタにしましたが、Forth コード内では data stack pointer はレジスタに置きたいです。RBP を data stack pointer として使うことにします。

では `sp` と RBP の橋渡しをするための関数を用意します。

```c++:forth0.cに追加
static void execute(uint8_t *word) {
  // RCXに native code へのポインタを代入し、
  // RDXに stack pointer を代入し、
  // c_to_ft を実行する。
  // 帰って来たあとは sp に RAX の値を代入する
  sp = ((uint8_t *(*)(uint8_t *,uint8_t *))c_to_ft)(WORD_BODY(word),sp);
}
```

また、c_to_ft を次の様に作ります。

```c++:init()に追加
  static const char *c_to_ft_image =
    "53 "       // PUSH RBX
    "55 "       // PUSH RBP
    "48 89 d3 " // MOV RBX, RDX
    "ff d1 "    // CALL RCX
    "48 89 d8 " // MOV RAX, RBX
    "5d "       // POP RBP
    "5b "       // POP RBX
    "c3 "       // RET
    ;
  write_hex(c_to_ft, c_to_ft_limit, c_to_ft_image);
```

ここで使った `write_hex` は文字列をバイト列に変換して `outp` の先に書き込む関数です。3文字1バイトに変換していきます。実装は以下です。

```c++:forth0.cに追加
static void write_hex(uint8_t *outp, uint8_t *limit, const char *data) {
  for (int i = 0; data[i]; i += 3, ++outp) {
    if (limit <= outp) {
      printf("error: too many data: write_hex\n");
      exit(EXIT_FAILURE);
    }
    *outp = strtol(&data[i], 0, 16);
  }
}
```

プログラムを書きやすくするためだけの関数なので、まあ、手抜き実装です。ちなみに `limit` はうっかりミスを防ぐためにつけました。なくてもいいです。

ともかくこれで

* sp を RBP にコピーしてから forth の word を実行
* forth の word を実行してから RBP を sp に書き戻す

のふたつができます。

テストしてみましょう。

```c++:test.c(新規)
#include"forth0.c"

int main() {
  init();

  // 42 を push する word
  begin_def("lit42", 0);
  B(0x48),B(0x83),B(0xeb),B(0x08); // SUB RBX, 8
  B(0x48),B(0xc7),B(0x03),D(42);   // MOV QWORD PTR [RBX], 42
  B(0xc3); // RET
  end_def();

  execute(find_word("lit42"));
  printf("%"PRId64, sp[0]);
  
  return 0;
}
```

```shell-session
$ gcc test.c && ./a
42
```

`sp` と RBX の橋渡しができており、用意した data stack に書き込めているようです。

そろそろ標準入力から word を入力して実行できそうな雰囲気ですね。

## 構文解析

みんな大好き、構文解析の時間です。

forth16-1.pdf では、`PARSE-NAME` という構文解析器が定義されています。動作としては「空白を読み飛ばし、非空白文字の列を取り出し、空白をひとつ読み捨てる」です。これを実装します。

本来`PARSE-NAME`は「取り出した文字列の先頭のアドレス」と「その文字列の文字数」を stack に積む word なのですが、手抜きのために次のような制約を付けました。

* 文字列はグローバル変数 `fin` から取り出す
* 取り出された文字列はグローバル変数 `token` に格納される
* `token`に格納された文字列はゼロ終端文字列
* 非空白文字が32文字以上連続で現れたら、32文字目以降は読み捨てられる
* 非空白文字が現れる前にEOFに到達したら、`token` には空文字列が格納される
* stack には何も積まない

以上の制約があれば、比較的簡単に構文解析器を書けます。さっそく書きましょう。

```c++:forth0.cに追加
static void parse_name(void) {
  token[0] = '\0';
  fscanf(fin, "%31s%*[^ \t\n\r]", token);
  getc(fin);
}
```

構文解析器、完成です！[^tokenizer]

## text interpreter を作る

ついに Forth 本体ともいえる text interpreter の話です。

text interpreter は次のような動作をします[^text_interpreter]。

1. parse-name する
2. eof に到達したら終了
3. parse-name で得た word を検索して definition を探し、definition が見つかった場合
  * interpretation state なら、その definition の interpretation semantics を実行し、最初に戻る
  * compilation state なら、その definition の compilation semantics を実行し、最初に戻る
4. parse-name で得た word が数値として解釈できる場合[^strtoll]
   * interpretation state なら、その数値を data stack に詰み、最初に戻る
   * compilation state なら、その数値を data stack に詰むコードを現在の definition に追加して、最初に戻る
5. ここに到達したら、エラーを出力して終了

これをコードにします。

少々天下り的で長いですが、大したことはしていません。とりあえず打ち込んでみてください。

```c++:forth0.cに追加
static void perform_compilation_semantics(uint8_t *word) {
  // immediate word であれば interpretation semantics を実行する。
  // immediate word でなければ「interpretation semantics を実行するコード」を追加する。
  if (WORD_IMMEDIATE(word)) {
    execute(word);
  } else {
    // 「interpretation semantics を実行するコード」というのは要するに CALL 命令
    B(0xe8),D(WORD_BODY(word) - (ep + 4)); // CALL rel32
  }
}

static void perform_interpretation_semantics(uint8_t *word) {
  execute(word);
}

static void text_interpreter(void) {
  while (1) {
    // 1. parse-name する
    parse_name();
    
    // 2. eof に到達したら終了
    if (token[0] == '\0') return;

    // 3. parse-name で得た word を検索して definition を探し、definition が見つかった場合...
    uint8_t *word = find_word(token);
    if (word) {
      if (state) {
        perform_compilation_semantics(word);
      } else {
        perform_interpretation_semantics(word);
      }
      continue;
    }

    // 4. parse-name で得た word が数値として解釈できる場合...
    char *p;
    long long i = strtoll(token, &p, 0);
    if (!*p) {
      if (state) {
        // RBX が forth コード実行中の data stack pointer。
        // 定数を data stack pointer に push するコードを出力している。
        B(0x48),B(0x83),B(0xeb),B(0x08); // SUB RBX, 8
        B(0x48),B(0xb8),Q(i);            // MOV RAX, i
        B(0x48),B(0x89),B(0x03);         // MOV [RBX], RAX
      } else {
        sp -= 8;
        *(int64_t *)sp = i;
      }
      continue;
    }

    // 5. ここに到達したら、エラーを出力して終了
    printf("undefined word: %s\n", token);
    exit(EXIT_FAILURE);
  }
}
```

さっそく使ってみましょう。

```c++:test.c(新規)
#include"forth0.c"

static void hello(void) { printf("hello, "); }
static void world(void) { printf("world!\n"); }

int main () {
  init ();

  def_cfun("hello", hello, 0);
  def_cfun("world", world, 0);

  fin = stdin;
  text_interpreter();

  return 0;
}
```

```shell-session:bash
$ gcc test.c && echo hello world | ./a
hello, world!

```

いけますね。

この時点で「並べたコマンドを順に実行」はできるようになってます。

## word を定義する word ― `:` と `;`

word を定義できるようにしましょう。

「Forth を軽く紹介」でも紹介しましたが、

* `:` の interpretation semantics は「word を一つ読み、その word を名前に持つ definition を作成し、 compilation state に入る」
* `;` の compilation semantics は「呼び出し元に帰るコードを definition に追加し、 interpretation state に戻る」

でした。今まで準備してきた物を使えば楽勝ですね。書きましょう。

```c++:forth0.cに追加
static void colon(void) {
  parse_name();
  begin_def(token, 0);
  state = 1;
}

static void semicolon(void) {
  B(0xc3);
  end_def();
  state = 0;
}
```

```c++:init()に追加
  def_cfun(":", colon, 0);
  def_cfun(";", semicolon, 1 /* ; is an immediate word */);
```
```c++:test.c(新規)
#include"forth0.c"
static void hello(void) { printf("hello, "); }
static void world(void) { printf("world!\n"); }

int main () {
  init ();

  def_cfun("hello", hello, 0);
  def_cfun("world", world, 0);

  fin = stdin;
  text_interpreter();

  return 0;
}
```

さっそく `hello` と `world` を使って `hello, world!` と表示できる word を定義してみましょう。コマンドラインから `hello-world` の定義と実行を流し込みます[^bash_semicolon]。

```shell-session:bash
$ gcc test.c && echo ': hello-world hello world ; hello-world' | ./a
hello, world!

```

こんにちは、世界！

## コメント

プログラムが長くなるとコメントが欲しくなりますね。実は forth ではコメントもただの word です。その名も`(`。paren と読むそうです。

実装は簡単でしょう。`)`かEOFが来るまで読み飛ばすだけですね。

```c++:forth0.cに追加
static void paren(void) {
  while (1) {
    int c = getc(fin);
    if (c == EOF || c == ')') return;
  }
}
```

```c++:init()に追加
  def_cfun("(", paren, 1); //  immediate word は compile 中でも inteprete 中でも使える
```

先程の test.c で試してみましょう。

```shell-session:bash
$ gcc test.c && echo ': hello-world ( hoge ) hello world ; ( hoge ) hello-world' | ./a
hello, world!

```

`(` と `)` の間がきちんと無視されています。

## native code を出力する immediate word ― `X`

突然ですが`X`というwordを導入します。

この word の compilation sematics は「ひとつ word を読み込み、数値として解釈し、現在定義中の word の interpretation semantics に追加する」です。

これもまた簡単に実装できます。

```c++:forth0.cに追加
static void X(void) {
  parse_name();
  B(strtol(token, 0, 0)); // エラー処理が甘いけど気にしない
}
```

```c++:init()に追加
  def_cfun("X", X, 1);
```

これで何が嬉しいかというと、 word の定義に native code を直接書き込めるようになります。

例えば x64 の nop 命令は 0x90 ですので、 nop だけを実行する word を、次の様に定義・実行できます。

```c++:bash
$ gcc test.c && echo ': nop X 0x90 ; nop' | ./a ; echo $?
0

```

word を native code で直接定義できるということは、プロセス内でできることはもう何でもできるということです。俄然力強くなってまいりました。

## RCX に値を移動する word ― `>rcx`

思い出して欲しいのですが、Forth 実行中の data stack pointer は RBX です。

ということは次のコードで data stack から pop した値を RCX に入れることができます。

```forth:core.ft(新規)
: >rcx
  X 0x48 X 0x8b X 0x0b        ( MOV RCX, [RBX] )
  X 0x48 X 0x83 X 0xc3 X 0x08 ( ADD RBX, 8     )
;
```

ところで、Cの関数の第一引数はRCXでしたね。

ということは、次の様に定義すると…

```c++:forth0.cに追加
static void print_rcx_as_int(uint64_t n) {
  printf("%" PRId64, n);
  fflush(stdout);
}
```
```c++:init()に追加
  def_cfun("print-rcx-as-int", print_rcx_as_int, 0);
```
```forth:test.ft(新規)
: main
  10 >rcx print-rcx-as-int
;
main
```
```c++:bash
$ gcc test.c && cat core.ft test.ft | ./a
10

```

なんとCの関数に引数を渡せます！！！

この調子で`>rdx`(第二引数)、`>r8`(第三引数)、`>r9`(第四引数)も用意して core.ft に追加しておいてください。これで引数4個までならCの関数に引数を渡せるようになりました[^more_than_four]。

ついでなので、RAX を push する `rax>` も作っておきましょう。これで返却値を forth で使うことができます。

```forth:core.ftに追加
: rax>
  X 0x48 X 0x83 X 0xeb X 0x08 ( SUB RBX, 8     )
  X 0x48 X 0x89 X 0x03        ( MOV [RBX], RAX )
;
```

また、現在の data stack pointer を data stack に積む `sp@` も定義しておきましょう。あると何かと便利です。

```forth:core.ftに追加
: sp@
  X 0x48 X 0x89 X 0x5b X 0xf8 ( MOV [RBX-8], RBX )
  X 0x48 X 0x83 X 0xeb X 0x08 ( SUB RBX, 8       )
;
```

## 文字列を push する word ― `s"`

プログラムを書いていたら、当然文字列リテラルが欲しくなりますよね。実は文字列リテラルも今までの枠組みの中で定義できます。プログラム中に文字列を書き出しておき、「文字列のアドレスを pushして、文字列の次に`jmp`するコード[^s_quote]」を出力する immediate word を定義すればよいです。

図にすると次のような感じですね。

```text:
:                  :
| s" の前のコード  |
+------------------+
| 文字列のアドレス-----,
| をPUSHするコード |   |
+------------------+   |
| s" の終わりへ    |-----,
| jmp するコード   |   | |
+------------------+   | |
|                  |<--' |
| 文字列           |     |
|                  |     |
+------------------+     |
| s" の次のコード  |<----'
:                  :
```

コードはこんな感じです[^s_backslash_quote]。

```c++:forth0.cに追加
static void s_quote(void) {
  B(0x48),B(0x83),B(0xeb),B(0x08); // SUB RBX, 8
  B(0x48),B(0x8d),B(0x05),D(8);    // LEA RAX, [RIP+8]
  B(0x48),B(0x89),B(0x03);         // MOV [RBX], RAX
  B(0xe9),D(0);                    // JMP REL32
  uint8_t *rel32 = ep;

  while (1) {
    int c = getc(fin);
    if (c == EOF || c == '"') break;
    if (c == '\\') c = getc(fin); // \" を " として出力できるようにする
    B(c);
  }
  B(0);

  *(uint32_t *)(rel32 - 4) = ep - rel32;
}
```
```c++:init()に追加
  def_cfun("s\"", s_quote, 1);
```

表示用に `print-rcx-as-cstr` も追加してテストしましょう。

```c++:forth0.cに追加
static void print_rcx_as_cstr(const char *s) {
  printf("%s", s);
  fflush(stdout);
}
```

```c++:init()に追加
  def_cfun("print-rcx-as-cstr", print_rcx_as_cstr, 0);
```

```forth:test.ft(新規作成)
: main
  s" hello, world!" >rcx print-rcx-as-cstr
;
main
```

```shell-session:bash
$ gcc test.c && cat core.ft test.ft | ./a
hello, world!
```

これで文字列リテラルも扱えますね。

## 足し算、引き算、その他便利 word

だいぶ慣れてきたと思いまので、いくつか便利 word を定義しておきましょう。

まずは足し算です。

```forth:core.ftに追加
: + ( n1 n2 -- n1+n2 )
  X 0x48 X 0x8b X 0x03        ( MOV RAX, [RBX] )
  X 0x48 X 0x83 X 0xc3 X 0x08 ( ADD RBX, 8     )
  X 0x48 X 0x01 X 0x03        ( ADD [RBX], RAX )
;
```
```forth:test.ft(新規)
1 2 + .
```
```shell-session:bash
$ gcc test.c && cat core.ft test.ft | ./a
3
```

できてます。

ちなみに `( n1 n2 -- n1+n2 )` のコメントは forth の文化です。`--` の左が word 呼び出しの前の data stack の状態を、`--` の右が word 呼び出し後の data stack の状態を表します。`( n1 n2 -- n1+n2 )` は「実行前は値2個、実行後は値1個」という意味です。まあ、コメントなので雰囲気でつけておけばいいと思います。

他にも後で使いたい便利 word がいくつかあるのですが、あまりスペースをとってもなんなので、読者への課題とします。以下の word を定義してください。

| word | data stack | 説明 |
|---|---|---|
| `-` | `(n1 n0 -- n1-n0 )` | data stack の1番目から0番目を引く (`2 1 -` の結果は `1` です) |
| `dup` | `( n -- n n )` | data stack の top を複製する | 
| `drop` | `( n -- )` | data stack の top を捨てる |
| `swap` | `( n1 n0 -- n0 n1 )` | data stack の 1番目と0番目を入れ替える |
| `over` | `( n1 n0 -- n1 n0 n1 )` | data stack の 1番目を複製し、push する |
| `pick` | `( xn ... x1 x0 n -- xn ... x1 x0 xn )` | 1) data stack の top を pop しその値を n とする。2) data stack の n 番目の値を push する |

参考までに、`pick`があれば`dup`と`over`は次のように実装できます。この辺はお好みでどうぞ。

```forth:forth
: dup 0 pick ;
: over 1 pick ;
```

## メモリの読み書き ― `@`, `!`

プログラムを書くのですから、当然メモリの読み書きは必須です。`@` と `!` を使います。`@` は fetch、`!` は store と読むそうです。このように定義できます。

```fort:core.ftに追加
: ! ( n addr -- )
  X 0x48 X 0x8b X 0x03        ( MOV RAX, [RBX]   )
  X 0x48 X 0x8b X 0x53 X 0x08 ( MOV RDX, [RBX+8] )
  X 0x48 X 0x89 X 0x10        ( MOV [RAX], RDX   )
  X 0x48 X 0x83 X 0xc3 X 0x10 ( ADD RBX, 16      )
;

: @ ( addr -- n )
  X 0x48 X 0x8b X 0x03 ( MOV RAX, [RBX] )
  X 0x48 X 0x8b X 0x00 ( MOV RAX, [RAX] )
  X 0x48 X 0x89 X 0x03 ( MOV [RBX], RAX )
;
```

`42 0x1000 !` とすると 0x1000 番地に 42 が書き込まれ、`0x1000 @` とすると 0x1000 番地から値を読み込めます。

…が、読み書きしていいアドレスが forth からはわかりません。`VirtualAlloc`が返した値を data stack の top に加算する word、`base+` を定義します。

```c++:init()に追加
  begin_def("base+", 0);
  B(0x48),B(0x8d),B(0x05),D(mem - (ep + 4)); // LEA RAX, [RIP - mem]
  B(0x48),B(0x01),B(0x03);                   // ADD [RBX], RAX
  B(0xc3);
  end_def();
```

`mem+0x380` 番地が空いているので、ちょっと試してみましょう。

```forth:test.ft(新規作成)
: main
  42 0x380 base+ ! ( mem+0x380 番地に 42 を書き込む )
  0x380 base+ @ ( mem+0x380 番地から 42 を読む )
  >rcx print-rcx-as-int
;
main
```

```shell-session:bash
$ gcc test.c && cat core.ft test.ft | ./a
42
```

できました。これでもう、読み書き権限のある場所ならどこでも読み書きできます。

次節以降で使うので、練習も兼ねて次の3つを作っておいてください。

* 1バイト読み込む `c@`
* 1バイト書き込む `c!`
* 4バイト書き込む `d!`

ちなみに `d@` は使いません。余力があったら定義してもいいと思います。

## グローバル変数

ところで `VirtualAlloc` で確保したメモリの先頭から0x3a8番地～0x3f0番地はグローバル変数でした。これにアクセスするための `word` を定義しましょう。

```forth:core.ftに追加
: ftmain 0x3a8 base+ ;
: state  0x3b0 base+ ;
: fin    0x3b8 base+ ;
: token  0x3c0 base+ ;
: mrd1   0x3e0 base+ ;
: mrd2   0x3e8 base+ ;
: ep     0x3f0 base+ ;
```

とりあえず forth0.c で使っているグローバル変数に、forthから直接アクセスできるようになりました。

## word を操作する word

さて、グローバル変数にアクセスできるようになりました。この中で `mrd2` は最後に定義した word を保持する変数でした。ということは次のようにすると…

```forth:core.ftに追加
: word-size ( word -- size )
  8 - @
;
```

```forth:test.ft(新規)
: . >rcx print-rcx-as-int ;
: hoge ; ( RET 命令のみの word。全体で49バイト )
mrd2 @ word-size .
```

```shell-session:bash
$ gcc test.c && cat core.ft test.ft | ./a
49
```

最後に定義した word のサイズを取ることができるようになりました。

ついでなので、`name`、`body`、`immediate`も取得できるようにしましょう。

```forth:core.ftに追加
: word-head ( word -- word-head )
  dup word-size -
;

: word-name ( word -- name )
  word-head
;

: word-body ( word -- execution-token )
  word-head 40 +
;

: word-immediate ( word -- flag )
  word-head 32 + @
;
```

```forth:test.ft(新規)
: %s >rcx print-rcx-as-cstr ;
: hoge ;
mrd2 @ word-name %s
```

```shell-session:bash
$ gcc test.c && cat core.ft test.ft | ./a
hoge
```

word の定義自体を参照できるようになりました。

ところで、 `immediate`フィールドを参照できるぐらいですので、変更もできますよね。早速定義しましょう。

```forth:core.ftに追加
: immediate ( -- )
  1 mrd2 @ word-head 32 + !
;
```

この word は最後に定義した word を immediate word にします。immediate word になると、compilation semantics が interpretation semantics と同じになるのでした。すなわち、コンパイル中に現れると intepretation semantics が実行されます。

```forth:test.ft(新規)
: %s >rcx print-rcx-as-cstr ;
: hoge s" immediate!" %s ; immediate
: fuga hoge ;
```

```shell-session:bash
$ gcc test.c && cat core.ft test.ft | ./a
immediate!
```

コンパイルしかしていないのに `hoge` が実行されてますね。

## コードを出力する word

`immediate` が使えるようになりましたが、ここでちょっとグローバル変数`ep`に注目してみましょう。`ep` はコンパイル中に「次にコードを出力する位置」を保持している変数でした。そこでこんな word を定義してみましょう。

```forth:core.ftに追加
: B ( byte -- )
  ep @ c!
  ep @ 1 + ep !
;

: exit
  0xc3 B ( RET )
; immediate
```

`B` は `forth0.c` にある `B` マクロと同じ振る舞いをします。つまり、コード領域に1バイト出力します。そして`exit`ですが、その場に RET 命令を出力します。

この word を word 定義の途中で使うとどうなるでしょうか。

```forth:test.ft(新規)
: . >rcx print-rcx-as-int ;
: w 10 exit 20 ;
w .
```

```shell-session:bash
$ gcc test.c && cat core.ft test.ft | ./a
10
```

なんと、 word の途中で脱出できます[^exit_return]！

ところで、`B` の他に、4バイト出力の `D` と、8バイト出力`Q` を定義したいのですが、これは課題とします。

## 条件分岐 ― `if`・`else`・`then`

いよいよ条件分岐です。これまで定義してきた word の組み合わせで条件分岐が実現できます。

```forth:core.ftに追加
: if ( -- next-of-if )
  0x48 B 0x8b B 0x03 B        ( MOV  RAX, [RBX] )
  0x48 B 0x83 B 0xc3 B 0x08 B ( ADD  RBX, 8     )
  0x48 B 0x85 B 0xc0 B        ( TEST RAX, RAX   )
  0x0f B 0x84 B 0x00000000 D  ( JZ REL32        )
  ep @
; immediate

: then ( next-of-jx -- )
  ep @ over ( next-of-jx then-addr next-of-jx )
  -         ( next-of-jx rel32-value )
  swap 4 -  ( rel32-value real32-addr )
  d!
; immediate
```

解説が要りますね。`if`は『「data stack から値を pop し、それが 0 だったらどこかへ分岐する」というコードを出力し、そのコードの末尾のアドレスを data stack に push する』というコードです。「どこかへ分岐する」ので、この状態ではどこに分岐するかわかりません。

そして`then`です。`then`は「data stack からアドレスを pop し、`ep`との相対距離を pop したアドレス-4番地に書き込む」wordです。もう少しわかりやすく言うと『分岐命令の「どこかへ」の部分を「ここへ」』に書き換えるwordです。

要するに`if`の時点で不定だった分岐先を、`then`のときに確定させているのです。

実行してみましょう。

```forth:test.ft(新規)
: . >rcx print-rcx-as-int ;
: x if 11 . then 22 . ;
1 x 0 x
```

```shell-session:bash
$ gcc test.c && cat core.ft test.ft | ./a
112222
```

ついでに `else` です。

```forth:core.ftに追加:
: else ( next-of-if -- next-of-else )
  0xe9 B 0x00000000 D ( JMP REL32 )
  dup 4 -      ( next-of-if       rel32-addr-of-if  )
  swap         ( rel32-addr-of-if next-of-if        )
  ep @ swap -  ( rel32-addr-of-if rel32-value-of-if )
  swap d!      ( )
  ep @         ( next-of-else )
; immediate
```

`else` は 「どこかへ分岐する」というコードを出力し、『`if`の分岐命令の「どこかへ」の部分を「ここへ」に書き換え、出力したコードの末尾のアドレスを pushする』というコードです。難しいかもしれませんが、一ステップずつ追いかけていけばなんとかなるはずです。

テストしましょう。

```forth:test.ft(新規)
: . >rcx print-rcx-as-int ;
: x if 11 . else 22 . then 33 . ;
1 x 0 x
```

```shell-session:bash
$ gcc test.c && cat core.ft test.ft | ./a
11332233
```

できました。

## 真偽値について少し

条件分岐ができたところで真偽値について少し。Forth では、`true` は全ビットが1で、`false` は全ビットが0です。そして `=` は二つ値を pop し、同じ値だったら `true` を、異なる値だったら `false` を返す word です。`if`の分岐条件は0か非0かなので、次のように`=`を定義できます。

```forth:core.ftに追加
: true -1 ;
: false 0 ;
: = - if false else true then ;
```

`X` を使ってもいいのですが、せっかく条件分岐ができたのでこうしました。

## 繰り返し ― `begin`・`while`・`repeat`

条件分岐ができたのですから、繰り返しも行けるでしょう。

forth の繰り返しは次のように書きます。

```forth:forthの繰り返し
begin A while B repeat
```

次のような感じで実行されます。

1. Aを実行する
2. stack の top を pop し、0 なら脱出
3. B を実行し、1に戻る。

コードは以下。

```forth:core.ftに追加
: begin ( -- begin-addr )
  ep @
; immediate

: while ( begin-addr -- begin-addr next-of-while )
  0x48 B 0x8b B 0x03 B        ( MOV  RAX, [RBX] )
  0x48 B 0x83 B 0xc3 B 0x08 B ( ADD  RBX, 8     )
  0x48 B 0x85 B 0xc0 B        ( TEST RAX, RAX   )
  0x0f B 0x84 B 0x00000000 D  ( JZ REL32        )
  ep @
; immediate

: repeat ( begin-addr next-of-while -- )
  0xe9 B 0x00000000 D ( jmp rel32 )
  swap ep @ - ( next-of-while begin-minus-repeat )
  ep @ 4 - d! ( next-of-while )
  ep @ over - ( next-of-while repeat-minus-while )
  swap 4 - d! ( )
; immediate
```

やっていることは次のような感じです。

* `begin` は現在位置を data stack に push する
* `while` は「data stack の top が 0 ならどこかへ分岐するコード」を出力する
* `repeat` は `while` の分岐先を `repeat` の次に書き換え、「`begin` の位置に分岐するコード」を出力する

例の如くテストです。

```forth:test.ft(新規)
: . >rcx print-rcx-as-int ;
: w
  10
  begin
  dup while
    1 -
    dup .
  repeat
  drop
;
w
```

```shell-session:bash
$ gcc test.c && cat core.ft test.ft | ./a
9876543210
```

繰り返しができました。

## .exe ファイルを作る

forth0.exe の山場、 .exe ファイルの作成です。

…すみません、解説を断念させてください。.exeファイルを作成するのは次のようなプログラムです。元々解説が短くなるようにコードを書いたので、かなり行儀の悪い .exe ファイルとなっております。すみません。

```c++:forth0.cに追加
static void save(const char *filename) {
  IMAGE_DOS_HEADER *idh = (IMAGE_DOS_HEADER *)mem;
  idh->e_magic = 0x5a4d; // MZ
  idh->e_lfanew = sizeof(IMAGE_DOS_HEADER);

  IMAGE_NT_HEADERS64 *inh = (IMAGE_NT_HEADERS64 *)(idh + 1);
  inh->Signature = 0x4550; // PE
  inh->FileHeader.Machine = 0x8664; // x86_64
  inh->FileHeader.NumberOfSections = 1;
  inh->FileHeader.SizeOfOptionalHeader = sizeof(IMAGE_OPTIONAL_HEADER64);
  inh->FileHeader.Characteristics = 2; // executable
  inh->OptionalHeader.Magic = IMAGE_NT_OPTIONAL_HDR64_MAGIC;
  inh->OptionalHeader.AddressOfEntryPoint = startup - mem + 0x1000;
  inh->OptionalHeader.ImageBase = 0x400000;
  inh->OptionalHeader.SectionAlignment = 0x1000;
  inh->OptionalHeader.FileAlignment = 0x200;
  inh->OptionalHeader.MajorSubsystemVersion = 5;
  inh->OptionalHeader.SizeOfImage = 0x1000 + 0xa0000 + 0xa0000;
  inh->OptionalHeader.SizeOfHeaders =
    idh->e_lfanew + sizeof(IMAGE_NT_HEADERS64) + sizeof(IMAGE_SECTION_HEADER);
  inh->OptionalHeader.Subsystem = 3; // CUI
  inh->OptionalHeader.NumberOfRvaAndSizes = 16;
  inh->OptionalHeader.DataDirectory[1].Size = 1;
  inh->OptionalHeader.DataDirectory[1].VirtualAddress = 0x1200;

  IMAGE_SECTION_HEADER *ish = (IMAGE_SECTION_HEADER *)(inh + 1);
  memcpy(ish->Name, ".idata\0\0", 8);
  ish->Misc.VirtualSize = 0xa0000 + 0xa0000;
  ish->VirtualAddress = 0x1000;
  ish->SizeOfRawData = 0xa0000;
  ish->PointerToRawData = 0x200;
  ish->Characteristics = 0xe0000060;

  static const char *import_image =
    //0  1  2  3  4  5  6  7  8  9  a  b  c  d  e  f
    "70 12 00 00 00 00 00 00 00 00 00 00 30 12 00 00 " // 40120x
    "90 12 00 00 00 00 00 00 00 00 00 00 00 00 00 00 " // 40121x
    "00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 " // 40122x
    "6b 65 72 6e 65 6c 33 32 2e 64 6c 6c 00 00 00 00 " // 40123x kernel32.dll
    "00 00 4c 6f 61 64 4c 69 62 72 61 72 79 41 00 00 " // 40124x LoadLibraryA
    "00 47 65 74 50 72 6f 63 41 64 64 72 65 73 73 00 " // 40125x GetProcAddress
    "00 00 45 78 69 74 50 72 6f 63 65 73 73 00 00 00 " // 40126x ExitProcess
    "40 12 00 00 00 00 00 00 4f 12 00 00 00 00 00 00 " // 40127x INT
    "60 12 00 00 00 00 00 00 00 00 00 00 00 00 00 00 " // 40128x INT
    "40 12 00 00 00 00 00 00 4f 12 00 00 00 00 00 00 " // 40129x IAT
    "60 12 00 00 00 00 00 00 00 00 00 00 00 00 00 00 " // 4012ax IAT
    ;
  write_hex(import, import_limit, import_image);
  
  static const char *startup_image =
    "bb 00 10 4a 00 " // MOV EBX, 0x4a1000
    "b8 a8 13 40 00 " // MOV EAX, 0x4013a8 (ftmain)
    "ff 10 "          // CALL [RAX]
    "b8 a0 12 40 00 " // MOV EAX, 0x4012a0 (ExitProcess)
    "ff 10 "          // CALL [RAX]
    ;
  write_hex(startup, startup_limit, startup_image);

  uint8_t *main_ = find_word("main");
  if (!main_) {
    printf("error: cannot find 'main'\n");
    exit(EXIT_FAILURE);
  }

  ftmain = WORD_BODY(main_) - mem + 0x401000;
  mrd1 = (uint8_t *)(mrd2 - mem + 0x401000);
  mrd2 = (uint8_t *)0x4a1400;

  FILE *fp = fopen(filename, "wb");
  fwrite(mem, 1, 0x200, fp);
  fwrite(mem, 1, 640 * 1024, fp);
  fclose(fp);
  chmod(filename, 0777);
}
```

「解説一切なしです」というのもいけないので、要点を書きます。

作られた実行ファイルは次のような動作をします。

1. プロセス起動時、`0x401000`～`0x541000`番地が読み書き実行可能になります
2. 元々 `mem` ～ `mem+0xa0000` 番地にあったデータが、 `0x401000`～`0x4a1000` 番地にコピーされます
3. `0x4a1000`～`0x541000`番地が 0 で埋められます
4. Windows が import_image を解釈します
    * 0x401290番地に LoadLibrary へのポインタが格納されます
    * 0x401298番地に GetProcAddress へのポインタが格納されます
    * 0x4012a0番地に ExitProcess へのポインタが格納されます
5. startup_image に書かれたプログラムが実行されます
    * startup_image は以下のようなプログラムです
        1. RBP に 0x4a1000 を設定（data stack pointer を初期化）
        2. ftmain を call
        3. もし帰ってきたら、引数を指定せずに ExitProcess を呼ぶ

作り方の要点は以下のような感じです。

* `VirtualAlloc` で確保したメモリの先頭に .exe のヘッダを作成して `fwrite` で書き出す
* ftmain に `main` という word のコード部分へのアドレスを格納する。ただし、プロセス起動後に位置が合うように調整する。
* mrd1 に現在の mrd2 を格納する。ただし、プロセス起動後に位置が合うように調整する（mrd1を残しておくことで、forth1.exe は、forth0.exe 内で定義した word を検索できる）

では main 関数を追加して forth0.c/forth0.exe を完成としましょう。

```c++:forth0.cに追加
int main(int argc, char **argv) {
  init();
  fin = stdin;
  text_interpreter();
  if (1 < argc) save(argv[1]);
  return 0;
}
```
```shell-session:bash
$ gcc forth0.c -o forth0.exe
```

これで実行ファイルを生成できるようになります。

さっそく何もしない実行ファイルを作って実行してみましょう。

```shell-session:bash
$ echo ': main ;' | ./forth0 a.exe && ./a ; echo [ $? ]
[ 0 ]
```

いけますね。 

## プロセスに exit status を返させる

先ほど作成した ./a.exe では、 exit status は指定していないはずですが、私の環境では 0 が帰っています。偶然 RCX の最下位8bitに 0 が入っていたのでしょう。環境によってこの値は変わるかもしれません[^dollar_question]。

では RCX に何か値を入れて終了してみましょう。

```forth:test.ft(新規)
: main 99 >rcx ;
```
```shell-session:bash
$ cat core.ft test.ft | ./forth0 a.exe && ./a ; echo [ $? ]
[ 99 ]
```

exit status を無事返せているようですね。

## Hello, world! に失敗する

では、伝統の hello, world! をしてみましょう。

```forth:test.ft(新規)
: main
  s" hello, world!" >rcx print-rcx-as-cstr
  0 >rcx
;
```
```shell-session:bash
$ cat core.ft test.ft | ./forth0 a.exe && ./a
Segmentation fault
```

だめでした。

原因は `print-rcx-as-cstr` です。`print-rcx-as-cstr` は forth0.exe 内にある C で書かれた `print_rcx_as_int()` を呼ぼうとします。しかしもはや `print_rcx_as_int()` は存在しません。結局 `print-rcx-as-cstr` は何だかよくわからない場所を呼んでクラッシュします。

というわけでこのままでは forth0.exe は何一つ表示することができません。

そこで、Windows 付属の C のラインタイムライブラリ、 msvcrt.dll を使います[^c_runtime]。

## kernel32.dll と msvcrt.dll

.exe ファイルを作成するときに `LoadLibrary`, `GetProcAddress`, `ExitProcess` へのポインタを取得できるように仕込んでおきました。まずはこれらを使えるようにします。

```forth:msvcrt.ft(新規作成)
: kernel32.LoadLibrary    0x290 base+ ;
: kernel32.GetProcAddress 0x298 base+ ;
: kernel32.ExitProcess    0x2a0 base+ ;

: c-call ( addr -- )
  X 0x48 X 0x8b X 0x03        ( MOV RAX, [RBX] )
  X 0x48 X 0x83 X 0xc3 X 0x08 ( ADD RBX, 8     )
  X 0x48 X 0x89 X 0xe5        ( MOV RBP, RSP   )
  X 0x48 X 0x83 X 0xec X 0x20 ( SUB RSP, 32    )
  X 0x48 X 0x83 X 0xe4 X 0xf0 ( AND RSP, ~0xf  )
  X 0xff X 0x10               ( CALL [RAX]     )
  X 0x48 X 0x89 X 0xec        ( MOV RSP, RBP   )
;

: load-library ( name -- handle )
  >rcx kernel32.LoadLibrary c-call rax>
;

: bye
  0 >rcx kernel32.ExitProcess c-call
;

: get-proc-address ( handle proc-name -- proc-address )
  >rdx >rcx kernel32.GetProcAddress c-call rax>
;
```

特定のC(と同じ呼び出し規約)の関数を呼び出す `c-call`、DLLをロードできる `load-library`、DLL内の関数へのポインタを取得できる `get-proc-address`を作成しました。

さっそく msvcrt.dll をロードするコードと、wrapper を作ります。

```forth:msvcrt.ftに追加
: msvcrt            0x340 base+ ;
: msvcrt.__iob_func 0x348 base+ ;
: msvcrt.fprintf    0x350 base+ ;
: msvcrt.fgetc      0x358 base+ ;
: msvcrt.fwrite     0x360 base+ ;
: msvcrt.fopen      0x368 base+ ;
: msvcrt.fclose     0x370 base+ ;
: msvcrt._chmod     0x378 base+ ;
: msvcrt._strtoi64  0x380 base+ ;
: msvcrt.memcpy     0x388 base+ ;
: msvcrt.strcmp     0x390 base+ ;
: msvcrt.fscanf     0x398 base+ ;
: msvcrt.strncpy    0x3a0 base+ ;

: msvcrt.init
  s" msvcrt.dll" load-library msvcrt !
  msvcrt @ s" __iob_func" get-proc-address msvcrt.__iob_func !
  msvcrt @ s" fprintf"    get-proc-address msvcrt.fprintf    !
  msvcrt @ s" fgetc"      get-proc-address msvcrt.fgetc      !
  msvcrt @ s" fwrite"     get-proc-address msvcrt.fwrite     !
  msvcrt @ s" fopen"      get-proc-address msvcrt.fopen      !
  msvcrt @ s" fclose"     get-proc-address msvcrt.fclose     !
  msvcrt @ s" _chmod"     get-proc-address msvcrt._chmod     !
  msvcrt @ s" _strtoi64"  get-proc-address msvcrt._strtoi64  !
  msvcrt @ s" memcpy"     get-proc-address msvcrt.memcpy     !
  msvcrt @ s" strcmp"     get-proc-address msvcrt.strcmp     !
  msvcrt @ s" fscanf"     get-proc-address msvcrt.fscanf     !
  msvcrt @ s" strncpy"    get-proc-address msvcrt.strncpy     !
;

: stdin ( -- fp )
  msvcrt.__iob_func c-call rax>
;

: stdout ( -- fp )
  msvcrt.__iob_func c-call rax> 48 +
;

: eof 0xffffffff ;

: fopen ( filename mode -- fp )
  >rdx >rcx msvcrt.fopen c-call rax>
;

: fclose ( fp -- )
  >rcx msvcrt.fclose c-call
;

: fgetc ( fp -- ch )
  >rcx msvcrt.fgetc c-call rax>
;

: fwrite ( ptr size nmemb fp -- )
  >r9 >r8 >rdx >rcx msvcrt.fwrite c-call
;

: %s ( cstr-addr -- )
  stdout >rcx
  s" %s" >rdx
  >r8
  msvcrt.fprintf c-call
;

: . ( n -- )
  stdout >rcx
  s" %d" >rdx
  >r8
  msvcrt.fprintf c-call
;

: cr ( -- )
  stdout >rcx
  s" 
" >rdx
  msvcrt.fprintf c-call
;

: chmod ( filename mode -- )
  >rdx >rcx msvcrt._chmod c-call
;

: strtoll ( cstr radix -- i true | false )
  >r8 >rcx 0 sp@ >rdx msvcrt._strtoi64 c-call rax>

  swap c@ if
    drop false
  else
    true
  then
;

: memcpy ( dst src len -- )
  >r8 >rdx >rcx msvcrt.memcpy c-call
;

: strcmp ( s0 s1 -- zero|non-zero )
  >rdx >rcx msvcrt.strcmp c-call rax>
;

: fscanf-1 ( fp fmt arg1 -- )
  >r8 >rdx >rcx msvcrt.fscanf c-call
;

: strncpy ( dst src len -- )
  >r8 >rdx >rcx msvcrt.strncpy c-call
;
```

基本的にはつまらない wrapper です。strtoll がちょっと頭の体操になりますかね(`sp@`の値を第三引数にすることで、Cの関数から直接 data stack に書き込ませている)。

再度伝統の hello, world! です。

```test.ft
: main
  msvcrt.init
  s" Hello, world!" %s
  bye
;
```
```shell-session:bash
$ cat core.ft msvcrt.ft test.ft | ./forth0 a.exe && ./a
hello, world!
```

できました！

# forth1.exe を作る

入出力ができるようになりましたので、forthでforthコンパイラを書く時です。はじめましょう。名前は forth1.exe です。

## forth1.exe のメモリの使い方

forth1.exe では次のようにメモリを使います。

```text:forth1.exeのメモリの使い方
+--------------------+ 0x401000 番地(PEヘッダで指定)
| MZ/PE headers      |
|                    |
+--------------------+ 0x401200 番地
| Import Table       |
+--------------------+ 0x401300 番地
| startup routine    |
+--------------------+ 0x401320 番地
| c_to_ft_routine    |
+--------------------+ 0x401340 番地
| global variables   |
|                    |
+--------------------+ 0x401400 番地
| word definitions 1 |
|                    |
:                    :
|                    |
| data stack         |
+====================+ 0x4a1000 番地
| MZ/PE headers      |
|                    |
+--------------------+ 0x4a1200 番地
| Import Table       |
+--------------------+ 0x4a1300 番地
| startup routine    |
+--------------------+ 0x4a1320 番地
| c_to_ft_routine    |
+--------------------+ 0x4a1340 番地
| global variables   |
|                    |
+--------------------+ 0x4a1400 番地
| word definitions 2 |
|                    |
:                    :
|                    |
|                    |
+--------------------+ 0x541000 番地
```

同じ構造がふたつあります。各領域の意味は基本的に同じなのですが、プロセス起動時点では、forth0.exe の出力が [0x401000, 0x4a1000) に配置され、[0x4a1000, 0x541000) は全て 0 で埋めれられています。また、data stack pointer の初期値は 0x4a1000 です。

## forth1.exe が forth2.exe を作成する方針

forth0.exe が forth1.exe を作るときは `VirtualAlloc` で取得したメモリに .exe ファイルの中身を作成して fwrite していました。forth1.exe が forth2.exe を作るときは [0x4a1000, 0x541000) に .exe ファイルの中身を作成して fwrite します。

ただしグローバル変数は [0x401340,0x401400)を使います。

## word を検索する word

最初は word を検索する word を作ります。Cで作っていた`PREV_WORD`と`find_word`の代わりです。

```forth:forth.ft(新規)
: prev-word ( word_n -- word_{n-1}|0 )
  dup word-size if
    dup word-size -
  else
    drop 0
  then
;

: find-word-1 ( name word -- word )
  begin
    dup word-size if else
      drop drop 0 exit
    then

    over over word-name strcmp 0 = if
      swap drop exit
    then

    prev-word
  true while repeat
;

: find-word ( name -- word|0 )
  dup mrd2 @ ( name name mrd2 )
  find-word-1 ( name word|0 )
  dup if
    swap drop exit ( word )
  then

  drop ( name )
  mrd1 @ find-word-1 ( word|0 )
;
```

`prev-word` は特に問題ないと思います。

`find-word-1` は C で書いた `find_word` とほぼ同じです。

`find-word` は少し説明が要ると思います。forth1.exe には word のリストがふたつあります。`mrd1`から辿れるリストと`mrd2`から辿れるリストです。`mrd1` からは forth0.exe で定義された word のリストを辿れます。`mrd2` からはこれから定義する word のリストを辿れます。`find-word` は`find-word-1`を使って`mrd2`を検索してから、`mrd1`を検索しています。こうすることで、旧世代の word のリストと新世代の word のリストの両方を検索対象にしています。

テストしましょう。

```forth:test.ft(新規)
: main
  msvcrt.init
  s" +" find-word word-name %s ( + と表示 )
  s" +" find-word word-body c@ . ( MOV命令の1バイト目[72]を表示  )
  bye
;
```
```shell-session:bash
$ cat core.ft msvcrt.ft forth.ft test.ft | ./forth0 forth1.exe && ./forth1
+72
```

forth0.exe 内で定義した word がきちんと検索できていますね。

## 構文解析

みんな大好き、構文解析の時間です。

```forth:forth.ftに追加
: parse-name ( "<spaces>ccc<space>" -- )
  0 token c!
  fin @ s" %31s*%[^	 
]" token fscanf-1
  fin @ fgetc drop
;
```

完成です。

ちなみに、ですが`[^`の後にはタブと空白と改行があります。コピペする方はちゃんとコピペできているか確認してください。CRにも対応したい方はソースコードをCRLFで保存してください。

## text interpreter

ちょっと長いですが text interpreter を作ります。ほぼ Cのコードをそのまま forth で書き換えただけですので、あまり語ることはありません。ただ、`execute`がCと少し違います。前回はCの世界とforthの世界の橋渡しをするため、レジスタを保存したりなんなりする必要があったのですが、今回はアドレスを pop して call するだけで良いです。

```forth:forth.ftに追加
: execute ( exection-token -- )
  X 0x48 X 0x8b X 0x03        ( MOV RAX, [RBX] )
  X 0x48 X 0x83 X 0xc3 X 0x08 ( MOV RBX, 8     )
  X 0xff X 0xd0               ( CALL RAX       )
;

: perform-compilation-semantics
  dup word-immediate if
    word-body execute
  else
    0xe8 B word-body ep @ 4 + - D ( CALL REL32 )
  then
;

: perform-interpretation-semantics
  word-body execute
;

: interpret-token ( -- )
  token find-word dup if
    state @ if
      perform-compilation-semantics
    else
      perform-interpretation-semantics
    then
    exit
  then
  drop

  token 0 strtoll if
    state @ if
      0x48 B 0x83 B 0xeb B 0x08 B ( SUB RBX,8      )
      0x48 B 0xb8 B Q             ( MOV RAX, IMM64 )
      0x48 B 0x89 B 0x03 B        ( MOV [RBX], RAX )
    else
      ( do nothing. the integer has been pushed by strtoll. )
    then
    exit
  then

  token %s s"  : not found" %s cr bye
;

: text-interpreter
  begin
    parse-name
  token c@ while
    interpret-token
  repeat
;
```

テストします。

```forth:test.ft(新規)
: main
  msvcrt.init

  stdin fin !
  text-interpreter

  bye
;
```
```shell-session:bash
$ cat core.ft msvcrt.ft forth.ft test.ft | ./forth0 forth1.exe && echo 1 2 + . | ./forth1
3
```

forth で書かれた forth で text interpreter が動きました。

## word を定義する word

さて、 text interpreter が動いたように見えますが困ったことに compile ができません。

```shell-session:bash
$ cat core.ft msvcrt.ft forth.ft test.ft | ./forth0 forth1.exe && echo ': w 1 2 + . ; w' | ./forth1
Segmentation fault
```

`:` が相変わらず forth0.exe 内の関数を呼んでいるからです。

が、困ったことに forth.ft 内では `:` を再定義できません。forth0.exe は forth.ft 内で `:` を再定義した時点から新しい `:` を使おうとするからです。しかし forth0.exe 内では msvcrt.dll がロードされていませんので、 次の word を定義しようとした瞬間、異常終了します。

というわけでちょっとしたトリックを使い、`:`と`;`を定義します。まず、`$:`と`$;` を定義します。

```forth:forth.ftに追加
: begin-def ( name -- )
  mrd2 @ ep !
  mrd2 @ swap 32 strncpy
  mrd2 @ 32 + ep !
  0 Q
;

: end-def ( -- )
  ep @ mrd2 @ - 8 + Q
  ep @ mrd2 !
  0 ep !
;

: $:
  parse-name
  token begin-def
  1 state !
;

: $;
  0xc3 B ( RET )
  end-def
  0 state !
; immediate
```

そして、main側で `$:` と `$;` を置き換えてしまいます。

```test:test.ft(新規)
: main
  msvcrt.init

  s" $:" find-word word-name s" :" 2 memcpy
  s" $;" find-word word-name s" ;" 2 memcpy

  stdin fin !
  text-interpreter
  bye
;
```

```shell-session:bash
$ cat core.ft msvcrt.ft forth.ft test.ft | ./forth0 forth1.exe && echo ': w 1 2 + . ; w' | ./forth1
3
```

forth で forth を compile できました！

## `(` と `s"` と `X` と `base+`

他には `(`と `s"` と `X` と `base+` が C 側で実装されていました。これらも同様に置き換えます。

ただし `$X` は作りません。`X`だけはこれ以降出現しないからです。

また、`base+` はグローバル変数アクセス用の word よりも前に定義されていなければならないので、 `main`の中で定義します。

```forth:forth.ftに追加
: $(
  begin
    fin @ fgetc
    dup 41 = ( close-parenthesis? ) if
      drop exit
    then
  eof - while repeat
; immediate

: $s"
  0x48 B 0x83 B 0xeb B 0x08 B ( SUB RBX, 8       )
  0x48 B 0x8d B 0x05 B 0x08 D ( LEA RAX, [RIP+8] )
  0x48 B 0x89 B 0x03 B        ( MOV [RBX], RAX   )
  0xe9 B ep @ 0x00 D          ( JMP REL32 )
  ( TOS is the address of the REL32 )

  begin
    fin @ fgetc
    dup eof = if
      s" error: eof inside s\"" bye
    then
  dup 0x22 - while ( 0x22 is " )
    dup 0x5c = if ( 0x5c is \ )
      drop
      fin @ fgetc
    then
    B
  repeat

  drop   ( drop " )
  0x00 B ( terminate with NUL )

  ( TOS is the address of the REL32 of the JMP )
  dup 4 + ep @ ( rel32-addr next-of-jmp-addr ep )
  swap -       ( rel32-addr rel32-value )
  swap d!
; immediate

: X ( "<spaces>integer<space>" -- )
  parse-name
  token 0 strtoll if B then
; immediate
```
```forth:あとでmainに付け加える
  s" base+" begin-def
    0x48 B 0x81 B 0x03 B 0x401000 D ( ADD QWORD PTR [RBX], 0x401000 )
    0xc3 B                          ( RET )
  end-def
```

## .exe ファイルを作る

いよいよ最後が近づいてきました。実行ファイルを作ります。

```forth:forth.ftに追加
: save ( filename -- )
  s" main" find-word ( filename main )
  dup if else
    s" forth.ft: cannot find 'main'" %s cr bye
  then

  0x4a1000 0x401000 0x340 memcpy  ( copy header )
  0x4a1290 0x4a1270    32 memcpy  ( restore IAT )
  word-body 0x0a0000 - 0x4a13a8 ! ( ftmain )
  mrd2 @    0x0a0000 - 0x4a13e0 ! ( mrd1 )
  0x4a1400             0x4a13e8 ! ( mrd2 )

  dup s" wb" fopen ( filename fp )
  dup if else
    s" cannot open the output file" %s cr bye
  then
  0x4a1000 1 0x00200 3 pick fwrite
  0x4a1000 1 0xa0000 3 pick fwrite
  fclose

  0777 chmod
;
```

Cのものとほぼ同じですが、微妙な違いがあります。

* Cのときは `VirtualAlloc`で確保したメモリを `fwrite` で書き出していましたが、今回は `0x4a1000`～`0x541000`番地を `fwrite` で書き出します。
* Cのときは .exe のヘッダを頑張って作っていましたが、今回は `0x401000`番地から`0x401340`番地に .exe ファイルのヘッダが残っているので、再利用します(copy header と書いてある場所)。
* ただし、IAT(LoadLibrary等のアドレスが書き込まれた場所)が書き換えられてしまっているので、元に戻します(restore IAT と書いてある場所)[^iranai]。

というわけでテストです。

```forth:test.ft(新規)
: main
  msvcrt.init

  s" $("   find-word word-name s" ("   2 memcpy
  s" $s\"" find-word word-name s" s\"" 3 memcpy
  s" $:"   find-word word-name s" :"   2 memcpy
  s" $;"   find-word word-name s" ;"   2 memcpy
  s" base+" begin-def
    0x48 B 0x81 B 0x03 B 0x401000 D ( ADD QWORD PTR [RBX], 0x401000 )
    0xc3 B                          ( RET )
  end-def

  stdin fin !
  text-interpreter
  
  s" a.exe" save
  bye
;
```
```forth:hello.ft
: main
  msvcrt.init
  s" Hello, world!" %s
  bye
;
```
```
$ cat core.ft msvcrt.ft forth.ft test.ft | ./forth0 forth1.exe && cat core.ft msvcrt.ft hello.ft | ./forth1 && ./a
Hello, world!
```

ついに forth で書かれた forth コンパイラで hello, world! と表示する実行ファイルが作れました！

## CLI

最後に、ちょっとした CLI をつくってやります。まあ、べつになくてもいいですが、雰囲気的にほしいやつです。

このCLIは次のような動作をします。

1. 標準入力からトークンを読み込む
2. トークンがから文字列(eof)であったら、exit
3. トークンが `--save` であったら次のトークンを読み、それをファイル名として .exe ファイルを作成し、exit
4. トークンが `--` であったら標準入力の残りを全て forth プログラムとして interpret し、exit
5. トークンをファイル名と見做して、そのファイルの中身を interpret し、1に戻る

普通こういうのはコマンドライン引数からやるんじゃないかとか思われるかもしれませんが、

* `msvcrt.dll` の `__getmainargs` は引数が5つ必要で面倒
* `kernel32.dll` の `GetCommandLine` は `parse-name` が流用できなくて面倒
* `kernel32.dll` の `CommandLineToArgvW` はUTF16版しかなくて面倒

と、どれも面倒なので諦めました。

というわけで、面倒でない方法で、さくっと実装します。

```forth:forth.ftに追加
: interpret-file ( filename -- )
  fin @ swap s" r" fopen ( old-fin new-fin )
  dup if else
    s" cannot open '" %s token %s s" '" %s cr bye
  then

  fin !
  text-interpreter
  fin @ fclose
  fin !
;

: interpret-argument ( -- )
  parse-name

  token c@ if else bye then

  token s" --save" strcmp 0 = if
    parse-name token save
    exit
  then

  token s" --" strcmp 0 = if
    text-interpreter bye
  then

  token interpret-file
;

: main
  msvcrt.init

  s" $("   find-word word-name s" ("   2 memcpy
  s" $s\"" find-word word-name s" s\"" 3 memcpy
  s" $:"   find-word word-name s" :"   2 memcpy
  s" $;"   find-word word-name s" ;"   2 memcpy

  s" base+" begin-def
    0x48 B 0x81 B 0x03 B 0x401000 D ( ADD QWORD PTR [RBX], 0x401000 )
    0xc3 B                          ( RET )
  end-def

  stdin fin !
  begin true while
    interpret-argument
  repeat
;
```

最後にコンパイルして forth1.exe の完成です！

```shell-session:bash
$ cat core.ft msvcrt.ft forth.ft | ./forth0 forth1.exe
```

# forth2.exe を作る

forth1.exe に自分自身のソースコードを流し込みましょう。
上手くできていれば forth2.exe も forth コンパイラとなるはずです。

```shell-session:bash
$ echo core.ft msvcrt.ft forth.ft --save forth2.exe | ./forth1
$ echo '-- 1 2 + .' | ./forth2
3
$ echo '-- : w s" hello, world" %s ; w' | ./forth2
hello, world
$ echo ': main msvcrt.init s" hello, world" %s ;' > test.ft
$ echo core.ft msvcrt.ft test.ft --save a.exe | ./forth2
$ ./a
hello, world
```

できてます。

# forth3.exe を作る

さて、forth2.exe に再度 forth コンパイラのソースコードを流し込みましょう。
上手くできていれば forth2.exe と同一の forth3.exe ができるはずです。

```shell-session:bash
$ echo core.ft msvcrt.ft forth.ft --save forth3.exe | ./forth2
$ diff forth2.exe forth3.exe; echo $?
0
```

できてます！

forth2.exe と forth3.exe は同一のバイナリです！

forth のセルフホスティングができました！

完成です！

# 最後に

お疲れ様でした。

駆け足でしたが、セルフホスティングコンパイラを作ることができました。「一日でできる」と銘打ってはいますが、一度理解してしまえば、たぶん４時間ぐらいでできるんじゃないかと思います。この記事を読んで下さった方々が「へぇ、きみ、プログラマを自称するんだったらセルフホスティングコンパイラぐらい作れるんだよね？」等の煽りを受けた際に、「まぁ、ものによるけど、４時間あればできるかな！」等と返せるようになって頂けたら、幸いです。

[^vs17]: Visual Studio 2017を入れる時間がありませんでしたごめんなさい。
[^shimatsusho]: 私は書かされたことがあります。
[^word_def]: forth200x での定義は http://www.forth200x.org/documents/forth16-1.pdf p.20 "Depending on context, either 1) the name of a Forth definition; or 2) a parsed sequence of non-space characters, which could be the name of a Forth definition."(拙訳: 文脈に依存するが、次のいずれか 1) Forth definition の名前; もしくは 2) 非空白の文字の並びであって、Forth definitionの名前になりうるもの)
[^ten]: `<10>`は「現在10進数で表示しています」の意です。`hex` `decimal` `octal` `binary` 等の word で変更できます。
[^wakarinikui]: 正直なところ、私はMSDNの文章からこの規約を読み取るのにとても苦労したんですが、もう少しわかりやすく定義したページがMSDN内のどこかにあるんでしょうか…。
[^alignment]: C/C++警察の方々はアラインメントが気になると思うのですが、x64限定なのでいいということにして見逃してください。
[^func_void]: 本当は関数へのポインタを `void *` にキャストしてはいけないのですが、これもいいことにします。
[^tokenizer]: これは普通は tokenizer というんじゃないかとか言われそうですが、言語仕様書で parse という単語を使ってるので構文解析です。そういうことにします。
[^number_of_stacks]: もう少し細かく言うと「最低でも2個」です。forth16-1.pdf ではfloating point stack や control flow stack などがあります。
[^text_interpreter]: 色々端折ってますが、forth16-1.pdf の pp.36-37 の "3.4 The Forth text interpreter" ほぼそのままです。
[^strtoll]: 手抜きのために「`strtoll`が数として解釈できるもの」を数としています。forth16-1.pdf での定義は 3.4.1.3 をご覧ください。
[^bash_semicolon]: `;` が bash にとって特別な意味をもつので、`''` で囲う必要があります。
[^more_than_four]: なお、5個以上の引数に対応する予定というか余力はありません。
[^s_quote]: 実行速度の面から言うと、大変行儀の悪い行為です。
[^s_backslash_quote]: `\` で quoteできるようにしていますが、これは forth16-1.pdf とは異なる動作です。forth16-1.pdf には特殊文字を含む文字列リテラル用に `s\"` という独立した word があります。今回は処理系を小さくするために`s"`に`"`を含められるようにしてしまいました。
[^exit_return]: Cをはじめとした多くの言語で `return` と呼ばれているものは、 Forth では`exit` です。ちなみにプロセス終了は `bye` です。Forth は古代言語なので、現代から見ると言葉の選び方が奇妙に感じるかもしれません。
[^image_section_header]: がんばると0個でも行けます。
[^dollar_question]: bashでは「最後に実行したプロセス」の exit status を `$?` で取得できます。cmd.exe では `%errorlevel%` で取得できます。cygwin の bash では exit status は最下位8bitだけを取得するようです(恐らくPOSIXに合わせるため)。cmd.exeの `%errorlevel%` は32bitの値を取得できます。cmd.exe で何回か調べたところ、a.exe は様々な値を返していました。しかしどれも最下位8bitは0でした。この辺、あまり詳しく調べていません。
[^c_runtime]: 「結局Cランタイム使うのかよ」と思われる方もいるかもしれませんが、Cランタイムを禁止したとしてもWindows からは kernel32.dll の WriteFile 等を呼ぶ他ありません。msvcrt.dllの代わりにkernel32.dllを使っても面倒なだけで面白味がないと思いました。この辺、妥協のしどころだと思います。
[^iranai]: どうもIATは0以外ならなんでもいいようなので、IATは戻さなくても動くみたいです。将来どうなるかわかりませんが。