SBCL：究極のアセンブリコードブレッドボード（2014）

【訂正】ルート・オイラー（Lutz Euler）氏が指摘した通り、次のシーケンス（NEXT）は、元々、ベースレジスタを伴わずにインデックスレジスタを使って実効アドレスをエンコードする用途にも使用されていました。このミスの影響で命令の意味が変わるわけではありませんが、無駄なエンコーディングを強いることになります。マシンのコードに見られる差異は以下の通りです。

以前（14 バイト）: 1 2 3 4 ; 03: 8B043D00000000 MOV EAX, [RDI] ; 5 ユーティレスなバイト! ; 0A: 4883C704 ADD RDI, 4 ; 0E: 4801F0 ADD EAX, RSI ; 11: FFE0 JMP RAX

現在（9 バイト）: 1 2 3 4 ; 93: 8B07 MOV EAX, [RDI] ; 95: 4883C704 ADD RDI, 4 ; 99: 4801F0 ADD EAX, RSI ; 9C: FFE0 JMP RAX

NEXT の定義は修正済みですが、以下のディスアSEMBリー（逆アセンブル）のスニペットは未だに旧来のマシンコードを示しています。

今週初め頃には、再び F18 というシステムにも目を通しました。チャック・ムーアの作品の場合いつものように、狂気に過ぎないかという程度の驚異的な才能かの区別が難しいというのが通例ですが；）一つ強く印象に残ったのはスタックの小ささでした：10 個のスロットしかなく、複雑なオーバーフローやアンダーフローのトラップがありません。その理由づけは、「もしもより多くのスロットが必要なら、やり方を間違えている」という点であり、沈黙するオーバーフローは、自分たちが何をしているか理解している際に有用だということです。これは確かに HP-41C や x87 での私の経験と一致します。また、djb 氏が私達による x87 の回転式スタックの誤用を嘆いた投稿にも思い起こさせられます。彼のテーゼは、「慎重なスケジューリングにより、『無料』な FXCH がスタックを同等であるか、それともそれに越したことはないほど優位なものにすることができる」というものでした。記事の最後には、x87 の暗黙的なスタック回転のおかげでデータをシャッフルするサイクルを浪费しない（非パイプライン化された）ループが記されています。

それは私に対し、スタックのスロット数を例えば 8 に制限するようなスタックベースの VM においてどのような実装技術が可能になるかを考えさせることになりました。理想的にはすべてレジスタ内に保ち続けることです。しかし、それを素朴に行うとプッシュとポップが大きく複雑化します；フォर्थエンジンが通常スタックの上端の要素のみを 1-2 つキャッシュしておく理由就在这里です。

そこで私は x87 と F18 を模倣することにしました（訂正：後者の TOS キャッシュレジスタ 2 つを除く）；プッシュやポップはデータ移動を引き起こさないようにする代わりに、以下に示す図のように、スタックの先頭（TOS）を指すモジュラーカウンターを減算・加算します。これは依然としてソフトウェア上で遅いでしょう（大多数の ISA はレジスタへのインデックス化ができません）。重要な点は、このカウンターはあまり多くの値を取ることができないということです：スタックのスロットが 8 つしかない場合、つまり 8 の値しか持たないことです。スタック VM はいくつかのパフォーマンス向上のために既にプリミティブ関数を重複させています（例として、BTB の助けを借りて同じプリミティブの実行を複数のアドレスに分散させるなど），したがって、スタックカウンターが取ることをできたすべての 8 つの値に対して特別に設計されたプリミティブを作成することは合理的に見えるでしょう。

通常の直接スレッド化 VM では、大部分のプリミティブ関数は次の命令にジャンプするコードシーケンスで終わるものでした；何かのような add rsi, 8 ; ジャンプ前に仮想 IP をインCREMENT jmp [rsi-8] ; RSI が以前指していたアドレスにジャンプ ここで rsi は仮想命令ポインタであり、VM 命令は単に関連するプリミティブのマシンコードへのポインタです。

このシーケンスに対し私は 2 つの変更を行います。バイトコード内にハードコーディングされたアドレスを嫌うため、そして 1 命令あたり 64 ビットは過剰に浪费しています；代わりに、プリミティブ関数ブロックからのオフセットをエンコードすることにします： mov eax, [rsi] add rsi, 4 add rax, rdi jmp rax ここで rdi はプリミティブ関数の基本アドレスです。

また、暗黙的なスタックカウンターの新しい値に基づいてディスパッチする必要があります。各プリミティブ関数のバリアントを規則的な間隔（例：1 ページ）に格納することでディスパッチをできるだけ簡単にしたのです。私はそれを 64 * 67 = 4288 バイトで丸めました；エイリアシングの事故を最小限にするためです。NEXT は何かのようなものになります mov eax, [rsi] add rsi, 4 lea rax, [rax + rdi + variant_offset] jmp rax

トリックは、variant_offset = 4288 * stack_counter であり、スタックカウンターは（通常）プリミティブがコンパイルされる際に既知であることです。スタックをそのまま残せば、カウンターもそのままであり；値をプッシュするとカウンターを減算し、ポップすると増分します。

それはまあまあ妥当に見えるでしょう。それが機能するか見てみましょう。

予備的考察 (Preliminaries)

私がいかに多くの反復的なマシンコードを生成する必要があるかを探求したいと考えています。SLIME の REPL と SBCL のアセンブラはその任務に完璧です！（支援されていない内部を使っていることが明確であるかどうか、もし壊れても断片を保ってください。）

VM の基本設計は以下の通りです：

r8-r15: スロット（32 ビット） rsi: マシンコードプリミティブの基本アドレス rdi: 仮想命令ポインタ（次の命令を指す） rax, rbx, rcx, rdx: スクラッチレジスタ rsp: （仮想）リターンスタックポインタ。

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35

(import '(sb-assem:inst sb-vm::make-ea)) ; これら 2 つを多用します

;; 私たちのスタックの裏打ちストア (defvar stack (make-array 8 :initial-contents (list sb-vm::r8d-tn sb-vm::r9d-tn sb-vm::r10d-tn sb-vm::r11d-tn sb-vm::r12d-tn sb-vm::r13d-tn sb-vm::r14d-tn sb-vm::r15d-tn)))

;; プリミティブ関数生成時のスタックポインタ (defvar stack-pointer)

;; (@ 0) は現在の TOS レジスタを返す、(@ 1) はそれより下のものを返すなど (defun @ (i) (aref stack (mod (+ i stack-pointer) (length stack))))

(defvar code-base sb-vm::rsi-tn) (defvar virtual-ip sb-vm::rdi-tn)

(defvar rax sb-vm::rax-tn) (defvar rbx sb-vm::rax-tn) (defvar rcx sb-vm::rax-tn) (defvar rdx sb-vm::rax-tn)

;; バリアントは primitive-code-offset バイトだけ離れています (defvar primitive-code-offset (* 64 67))

;; 各 stack-pointer の値には独自のコードページがあります (defstruct code-page (alloc 0) ; 次の空きバイトのインデックス (code (make-array primitive-code-offset :element-type '(unsigned-byte 8))))

考えは、プリミティブ関数各々に対してアセンブリコードを生成する関数を定義することです；これらの関数は暗黙的に @ を通じて stack-pointer パラメータ化されます。私たちはそれらを必要に応じて呼び出すことができ、これにより stack-pointer のすべての値をカバーします。問題なのはコードシーケンスの長さが異なるため、すべてを同期に保つためにパディングを挿入する必要があることです；それが emit-code が行うことです：

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

(defun emit-code (pages emitter) ;; コードページの数にはスタックスロットと同じ数必要です (assert (= (length stack) (length pages))) ;; 右端の開始点を見付け、16 バイトに整列します (let* ((alloc (logandc2 (+ 15 (reduce #'max pages :key #'code-page-alloc)) 15)) (bytes (loop for i below (length pages) for page = (elt pages i) collect (let ((segment (sb-assem:make-segment)) (stack-pointer i)) ;; この値のバリアントを生成するアセンブリコード ;; セグメントに挿入します (sb-assem:assemble (segment) ;; まずパディングを挿入 (sb-vm::emit-long-nop segment (- alloc (code-page-alloc page))) (funcall emitter)) ;; 戻る参照を整理 (sb-assem:finalize-segment segment) ;; 次に位置非依存のマシンコードとしてバイトベクタを取得 (sb-assem:segment-contents-as-vector segment))))) ;; 最後に、マシンの各コードシーケンスを適切なコードページにコピーします (map nil (lambda (page bytes) (let ((alloc (code-page-alloc page))) (replace (code-page-code page) bytes :start1 alloc) (assert (<= (+ alloc (length bytes)) (length (code-page-code page)))) (setf (code-page-alloc page) (+ alloc (length bytes))))) pages bytes) ;; そのコードシーケンスのオフセットを返します alloc))

この関数は emit-all-code によって一連のプリミティブ関数に対するマシンコードを生成する際に使用され、各プリミティブ関数の開始オフセットを追跡します。

1 2 3 4 5 6 7 8 9 10

(defun emit-all-code (&rest emitters) (let ((pages (loop repeat (length stack) for page = (make-code-page) ;; すべてのものをワンバイトの NOP で埋める do (fill (code-page-code page) #x90) collect page))) (values (mapcar (lambda (emitter) (emit-code pages emitter)) emitters) pages)))

さて、主役です： 1 2 3 4 5 6 7 8 9 10 11 12 13

(defun next (&optional offset) (setf offset (or offset 0)) ; IP を操作するプリミティブ関数を収容します (let ((rotation (mod stack-pointer (length stack)))) (inst movzx rax (make-ea :dword :base virtual-ip :disp offset)) (unless (= -4 offset) (inst add virtual-ip (+ 4 offset))) (if (zerop rotation) (inst add rax code-base) (inst lea rax (make-ea :qword :base code-base :index rax :disp (* rotation primitive-code-offset)))) (inst jmp rax)))

最初のステップ

いくつかの単純なプリミティブ関数を追加しましょう。

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

(defun swap () (inst xchg (@ 0) (@ 1)) ; スタックの先頭とスタック [1] を交換します (next))

(defun dup () (decf stack-pointer) ; スタックを増やし（これは下方向に成長します） (inst mov (@ 0) (@ 1)) ; TOS を書き込みます (next))

(defun drop (&optional offset) (incf stack-pointer) ; ただスタックを縮めます (next offset))

(defun add () (inst add (@ 1) (@ 0)) ; 2 つ目の要素が TOS になります (drop))

(defun sub () (inst sub (@ 1) (@ 0)) (drop))

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 CL-USER> (setf print-length 100) 100 CL-USER> (emit-all-code 'swap 'dup 'drop 'add 'sub) (0 32 64 96 128) (#S(CODE-PAGE :ALLOC 152 :CODE #(69 135 193 139 4 61 0 0 0 0 72 131 199 4 72 1 240 255 224 102 15 31 132 0 0 0 0 0 15 31 64 0 69 139 248 139 4 61 0 0 0 0 72 131 199 4 72 141 132 6 64 117 0 0 255 224 15 31 132 0 0 0 0 0 139 4 61 0 0 0 0 72 131 199 4 72 141 132 6 192 16 0 0 255 224 102 15 31 132 0 0 0 0 0 102 144 69 1 193 139 ...)) ...) CL-USER> (defparameter code0 (code-page-code (first (second /)))) CODE0 CL-USER> (defparameter code1 (code-page-code (second (second //)))) CODE1

swap のコードは 0 バイトから 32 バイットの間にあります。スタックポインタ = 0 と 1 のバージョンを見てみましょう。

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

CL-USER> (sb-sys:with-pinned-objects (code0) (sb-disassem:disassemble-memory (sb-sys:vector-sap code0) 32)) ; サイズ：32 バイト ; 0669C700: 4587C1 XCHG R8D, R9D ; 03: 8B043D00000000 MOV EAX, [RDI] ; 0A: 4883C704 ADD RDI, 4 ; 0E: 4801F0 ADD EAX, RSI ; 11: FFE0 JMP RAX ; 13: 660F1F840000000000 NOP ; パディング NOPs ; 1C: 0F1F4000 NOP NIL CL-USER> (sb-sys:with-pinned-objects (code1) (sb-disassem:disassemble-memory (sb-sys:vector-sap code1) 32)) ; サイズ：32 バイト ; 0669D810: 4587CA XCHG R9D, R10D ; 13: 8B043D00000000 MOV EAX, [RDI] ; 1A: 4883C704 ADD RDI, 4 ; 1E: 488D8406C0100000 LEA RAX, [RSI+RAX+4288] ; 26: FFE0 JMP RAX ; 28: 0F1F840000000000 NOP NIL

dup は 32-64 にあり、sub は 128-152 です： 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21

CL-USER> (sb-sys:with-pinned-objects (code0) (sb-disassem:disassemble-memory (sb-sys:sap+ (sb-sys:vector-sap code0) 32) 32)) ; サイズ：32 バイト ; 0669C720: 458BF8 MOV R15D, R8D ; 23: 8B043D00000000 MOV EAX, [RDI] ; 2A: 4883C704 ADD RDI, 4 ; 2E: 488D840640750000 LEA RAX, [RSI+RAX+30016] ; 36: FFE0 JMP RAX ; 38: 0F1F840000000000 NOP NIL CL-USER> (sb-sys:with-pinned-objects (code0) (sb-disassem:disassemble-memory (sb-sys:sap+ (sb-sys:vector-sap code0) 128) 24)) ; サイズ：24 バイト ; 0669C780: 4529C1 SUB R9D, R8D ; 83: 8B043D00000000 MOV EAX, [RDI] ; 8A: 4883C704 ADD RDI, 4 ; 8E: 488D8406C0100000 LEA RAX, [RSI+RAX+4288] ; 96: FFE0 JMP RAX NIL

これらは比較的緊密です。私はそこにどれほど少ないデータシャッフルがあるか確かに気に入っています；NEXT シーケンスはいくつかこじれがありますが、間接ジャンプは恐らくその最も弱い（かつ最も避けられない）点です。

制御フローのプリミティブ関数

制御フローがない VM は遊び物さえもではありません。まず、不条件相対的ジャンプです。これらは [jmp] [offset] とエンコードでき、32 ビットのオフセットはオフセットの終了から相対的です。私達はただ virtual-ip に新しいアドレスを上書きするだけです。

1 2 3 4 5

(defun jmp () (inst movsx rax (make-ea :dword :base virtual-ip)) (inst lea virtual-ip (make-ea :dword :base virtual-ip :index rax :disp 4)) (next))

コールとリターンはフォースエンジンにとって心臓部です。ret は簡単です：ただ制御スタックから virtual-ip にポップするだけです。 1 2 3

(defun ret () (inst pop virtual-ip) (next))

コールはいくぶん複雑です。jmp と似ていますが、次の命令のアドレスを制御スタックにプッシュします： 1 2 3 4 5 6

(defun call () (inst movsx rax (make-ea :dword :base virtual-ip)) (inst add virtual-ip 4) (inst push virtual-ip) (inst add virtual-ip rax) (next))

結果するマシンコードを見てみましょう。 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36

CL-USER> (emit-all-code 'jmp 'ret 'call) (0 32 64) (#S(CODE-PAGE :ALLOC 91 :CODE #(72 99 7 72 141 124 7 4 139 4 61 0 0 0 0 72 131 199 4 72 1 240 255 224 15 31 132 0 0 0 0 0 95 139 4 61 0 0 0 0 72 131 199 4 72 1 240 255 224 102 15 31 132 0 0 0 0 0 102 15 31 68 0 0 72 99 7 72 131 199 4 87 72 1 199 139 4 61 0 0 0 0 72 131 199 4 72 1 240 255 224 144 144 144 144 144 144 144 144 144 ...)) ...) CL-USER> (let ((code (code-page-code (first (second /))))) (sb-sys:with-pinned-objects (code) (sb-disassem:disassemble-memory (sb-sys:vector-sap code) 91))) ; サイズ：91 バイト ; 08395200: 486307 MOVSXD RAX, DWORD PTR [RDI] ; jmp ; 03: 488D7C0704 LEA RDI, [RDI+RAX+4] ; 08: 8B043D00000000 MOV EAX, [RDI] ; 0F: 4883C704 ADD RDI, 4 ; 13: 4801F0 ADD EAX, RSI ; 16: FFE0 JMP RAX ; 18: 0F1F840000000000 NOP ; 20: 5F POP RDI ; ret ; 21: 8B043D00000000 MOV EAX, [RDI] ; 28: 4883C704 ADD RDI, 4 ; 2C: 4801F0 ADD EAX, RSI ; 2F: FFE0 JMP RAX ; 31: 660F1F840000000000 NOP ; 3A: 660F1F440000 NOP ; 40: 486307 MOVSXD RAX, DWORD PTR [RDI] ; call ; 43: 4883C704 ADD RDI, 4 ; 47: 57 PUSH RDI ; 48: 4801C7 ADD RDI, RAX ; 4B: 8B043D00000000 MOV EAX, [RDI] ; 52: 4883C704 ADD RDI, 4 ; 56: 4801F0 ADD EAX, RSI ; 59: FFE0 JMP RAX

SBCL からの FFI

面白いデモのためにはほぼ十分なものが揃いました。唯一欠けているのは重要なのは、CL から VM へのコールです。呼出者が重要なレジスタを保存することを管理し、プリミティブ関数（rsi）と仮想 IP（rdi）レジスタが正しくセットアップされていることを前提にします。スタックは入力で充填され、rax が指すバッファから値をコピーされ、退出時に書き戻されます。

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

(defun enter () (inst push sb-vm::rbp-tn) (inst mov sb-vm::rbp-tn sb-vm::rsp-tn) ; 通常のフレームをセットアップします (inst push rax) ; rax を一時保存します (dotimes (i 8) ; スタックをコピーして入れます (inst mov (@ i) (make-ea :dword :base rax :disp (* 4 i)))) (next))

(defun leave () ;; RAX を復元します (inst mov rax (make-ea :qword :base sb-vm::rbp-tn :disp -8)) ;; 出力スタックを上書きします (dotimes (i 8) (inst mov (make-ea :dword :base rax :disp (* 4 i)) (@ i))) ;; フレームを unwind します (inst mov sb-vm::rsp-tn sb-vm::rbp-tn) (inst pop sb-vm::rbp-tn) (inst ret))

enter の CL サイドの対話者は、VOP として続きます： 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 (sb-c:defknown %enter-vm (system-area-pointer system-area-pointer system-area-pointer) (values) (sb-c:any) :overwrite-fndb-silently t)

(in-package "SB-VM") (sb-vm::define-vop (cl-user::%enter-vm) (:translate cl-user::%enter-vm) (:policy :fast-safe) (:args (stack :scs (sap-reg) :target rax) (code :scs (sap-reg) :target rdi) (primitives :scs (sap-reg) :target rsi)) (:arg-types system-area-pointer system-area-pointer system-area-pointer) (:results) (:temporary (:sc sap-reg :offset rax-offset :from (:argument 0)) rax) (:temporary (:sc sap-reg :offset rbx-offset :from :eval) rbx) (:temporary (:sc sap-reg :offset rcx-offset :from :eval) rcx) (:temporary (:sc sap-reg :offset rdx-offset :from :eval) rdx) (:temporary (:sc sap-reg :offset rdi-offset :from (:argument 1)) rdi) (:temporary (:sc sap-reg :offset rsi-offset :from (:argument 2)) rsi) (:ignore rbx rcx rdx) (:generator 0 (inst push r8-tn) ;; スタックは単に痛すぎて宣言できないほどでした (inst push r9-tn) ;; 仮定として... そしてそれは (inst push r10-tn) ;; スレッドベースの TN を書き込みます、これは regalloc が無視します。 (inst push r11-tn) (inst push r12-tn) (inst push r13-tn) (inst push r14-tn) (inst push r15-tn)

(move rax stack)
(move rdi code)
(move rsi primitives)
(inst call rsi)   ;; コードページが ENTER で始まると仮定します

(inst pop r15-tn)
(inst pop r14-tn)
(inst pop r13-tn)
(inst pop r12-tn)
(inst pop r11-tn)
(inst pop r10-tn)
(inst pop r9-tn)
(inst pop r8-tn)))

(in-package "CL-USER")

(defun %enter-vm (stack-sap bytecode-sap primitives-sap) (declare (type system-area-pointer stack-sap bytecode-sap primitives-sap)) (%enter-vm stack-sap bytecode-sap primitives-sap))

(defun vm (stack-designator bytecode primitives) (declare (type (simple-array (unsigned-byte 32) 1) bytecode) (type system-area-pointer primitives)) ;; スタックを設計要素で初期化します。 (let ((stack (make-array 8 :element-type '(unsigned-byte 32) :initial-element 0))) (if (typep stack-designator 'sequence) (map-into stack (lambda (x) (ldb (byte 32 0) x)) stack-designator) (fill stack (ldb (byte 32 0) stack-designator))) (sb-sys:with-pinned-objects (stack bytecode) (time (%enter-vm (sb-sys:vector-sap stack) (sb-sys:vector-sap bytecode) primitives))) stack))

残っているのは、プリミティブ関数のマシンコードを実行可能な範囲のメモリ内に保存することだけです。

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26

;; まず、実行可能な範囲のメモリを取得します (defvar code-page (sb-posix:mmap nil (* (length stack) primitive-code-offset) (logior sb-posix:prot-read sb-posix:prot-write sb-posix:prot-exec) (logior sb-posix:map-anon sb-posix:map-private) -1 0))

;; 私たちのプリミティブ関数名リスト (defvar primops '(enter leave swap dup drop add sub jmp call ret))

(defun assemble-primops () (multiple-value-bind (offsets pages) (apply 'emit-all-code primops) (loop for page in pages for offset upfrom 0 by primitive-code-offset do (sb-kernel:copy-ub8-to-system-area (code-page-code page) 0 code-page offset primitive-code-offset)) (mapcar 'cons primops offsets)))

;; この alist はプリミティブ関数名をオフセットにマッピングします (defparameter primops-offsets (assemble-primops))

1 2 3 CL-USER> primops-offsets ((ENTER . 0) (LEAVE . 64) (SWAP . 112) (DUP . 144) (DROP . 176) (ADD . 208) (SUB . 240) (JMP . 272) (CALL . 304) (RET . 336))

add sub を実行し（leave で終わります）見てみましょう。 1 2 3 4 5 6 7 8 9

CL-USER> (vm '(3 2 10) (coerce '(208 240 64) '(simple-array (unsigned-byte 32) 1)) code-page) Evaluation took: 0.000 seconds of real time 0.000003 seconds of total run time (0.000002 user, 0.000001 system) 100.00% CPU 2,288 processor cycles 0 bytes consed

#(5 0 0 0 0 0 3 5)

そして確かに、10 - (3 + 2) = 5 です。

我们也应该测试函数调用 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

CL-USER> (vm '(3 2 10) (coerce '(304 8 ; call F 240 64 ;; F: 208 336) '(simple-array (unsigned-byte 32) 1)) code-page) Evaluation took: 0.000 seconds of real time 0.000005 seconds of total run time (0.000003 user, 0.000002 system) 100.00% CPU 2,640 processor cycles 0 bytes consed

#(5 0 0 0 0 0 3 5)

直接 add を実行するのではなく、このバイトコードシーケンスは call 命令から 8 バイト（2 dwords）後にあるものを呼び出します；私たちの場合、add ret です。

バイトコードを手書きするのは面倒です。この小さな関数は愚かしくもないことを管理します。 1 2 3 4 5 6 7

(defun assemble (opcodes) (map '(simple-array (unsigned-byte 32) 1) (lambda (opcode) (if (integerp opcode) (ldb (byte 32 0) opcode) (cdr (assoc opcode primops-offsets)))) opcodes))

私たちは今、次に書けます 1 2 3 4 5 6 7 CL-USER> (vm '(3 2 10) (assemble '(call 8 sub leave

                               add
                               ret))
         *code-page*)

条件分岐

今では基本的に直線コードや無限ループを書けます。私たちは条件分岐が必要です。その実装は jmp と似ていますが、小さなねじりがあります。ジャンプもし（スタックの先頭が）ゼロでなく、そしてゼロである場合からのジャンプから始めましょう。

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

(defun jcc (cc) ;; 次のワードは条件を満たされる場合オフセットであり、そうでない場合は継続します。 (inst movsx rax (make-ea :dword :base virtual-ip)) (inst lea rax (make-ea :dword :base virtual-ip :index rax :disp 4)) (inst add virtual-ip 4) (inst test (@ 0) (@ 0)) ;; 更新します virtual-ip だけですゼロ/非ゼロの場合 (inst cmov cc virtual-ip rax) (next))

(defun jnz () (jcc :nz))

(defun jz () (jcc :z))

直近値なしではプログラムを書くのは難しいです。以前の制御フロープリミティブは仮想命令ストリーム内に即座なデータをエンコードしました。私たちは lit、inc、dec でも同じことを行います：

1 2 3 4 5 6 7 8 9 10 11 12

(defun lit () (decf stack-pointer) ; スタックを成長させます (inst mov (@ 0) (make-ea :dword :base virtual-ip)) ; 次のワードをロードします (next 4)) ; 次の命令に進み越します

(defun inc () (inst add (@ 0) (make-ea :dword :base virtual-ip)) (next 4))

(defun dec () (inst sub (@ 0) (make-ea :dword :base virtual-ip)) (next 4))

私の最初のループ

最後に、使い物にならない（もし役に立たなくても）良い見えるループを持っています。まず、プリミティブ関数コードページを更新します： 1 2 3 4 5 6 7 8

;; C-M-x を再評価を強制し、または defparameter (defvar primops '(enter leave lit swap dup drop add sub inc dec jmp jnz jz call ret))

(defvar primops-offsets (assemble-primops))

1 2 3 4 5 6 7 8 9 10 CL-USER> (vm '(1000000) (assemble '(lit 1 sub jnz -20 leave)) code-page) Evaluation took: 0.009 seconds of real time 0.009464 seconds of total run time (0.009384 user, 0.000080 system) 100.00% CPU 14,944,792 processor cycles 0 bytes consed

#(0 0 0 0 0 0 0 1)

この反則的なループの百万回反復、ただカウンターを減算するだけで 15M サイクルかかりました。1 サイクル/反復はそんなに悪くないです... 特にそれが 1 をロードした後、減算した後、そしてゼロと比較した後、間接ジャンプを実行しますことを考慮すると。

私たちは lit sub を dec に融合させることでより良くできます：

1 2 3 4 5 6 7 8 9 10 CL-USER> (vm '(1000000) (assemble '(dec 1 jnz -16 leave)) code-page) Evaluation took: 0.007 seconds of real time 0.006905 seconds of total run time (0.006848 user, 0.000057 system) 100.00% CPU 11,111,128 processor cycles 0 bytes consed

#(0 0 0 0 0 0 0 0)

すべてを融合させます！

カウンターを減算しゼロでなければジャンプすることは一般的な操作です（古い x86 はそれがハードウェアで実装した、loop で）；decrement and jump if non-zero (djn) を VM に追加しましょう：

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

(defun djn () (inst movsx rax (make-ea :dword :base virtual-ip)) (inst lea rax (make-ea :dword :base virtual-ip :index rax :disp 4)) (inst add virtual-ip 4) (inst sub (@ 0) 1) (inst cmov :nz virtual-ip rax) (next))

(defvar primops '(enter leave lit swap dup drop add sub inc dec jmp jnz jz djn call ret))

(defvar primops-offsets (assemble-primops))

1 2 3 4 5 6 7 8 9 10 CL-USER> (vm '(1000000) (assemble '(djn -8 leave)) code-page) Evaluation took: 0.005 seconds of real time 0.005575 seconds of total run time (0.005542 user, 0.000033 system) 120.00% CPU 8,823,896 processor cycles 0 bytes consed

#(0 0 0 0 0 0 0 0)

それはよくなります... しかし私は条件付き移動について本当に確信していません。分岐は通常予測可能なので、ハードウェアにそれを開示し、NEXT シーケンスを複製する意味があります。

1 2 3 4 5 6 7 8 9 10

(defun djn2 () (sb-assem:assemble () (inst sub (@ 0) 1) (inst jmp :z fallthrough) (inst movsx rax (make-ea :dword :base virtual-ip)) (inst lea virtual-ip (make-ea :dword :base virtual-ip :index rax :disp 8)) (next -4) ; virtual-ip を事前に増分しておきます fallthrough ; ASSEMBLE はラベルを解析します、TAGBODY のように (next 4)))

生成されたコードは大きくなりすぎず、2 つの間接ジャンプは 16 バイト離れています。 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

; サイズ：64 バイト ; 00510220: 4183E801 SUB R8D, 1 ; 24: 7414 JEQ L0 ; 26: 486307 MOVSXD RAX, DWORD PTR [RDI] ; 29: 488D7C0708 LEA RDI, [RDI+RAX+8] ; 2E: 8B043DFCFFFFFF MOV EAX, [RDI-4] ; 35: 4801F0 ADD EAX, RSI ; 38: FFE0 JMP RAX ; 3A: L0: 8B043D04000000 MOV EAX, [RDI+4] ; 41: 4883C708 ADD RDI, 8 ; 45: 4801F0 ADD EAX, RSI ; 48: FFE0 JMP RAX ; 4A: 660F1F840000000000 NOP ; 53: 660F1F840000000000 NOP ; 5C: 0F1F4000 NOP

この代替実装は私たちの反則的なループでより良く機能します。 1 2 3 4 5 6 7 8 9 10

CL-USER> (vm '(1000000) (assemble '(djn2 -8 leave)) code-page) Evaluation took: 0.004 seconds of real time 0.004034 seconds of total run time (0.003913 user, 0.000121 system) 100.00% CPU 6,183,488 processor cycles 0 bytes consed

#(0 0 0 0 0 0 0 0)

それがどのように純粋なアセンブリコードと比較するか見てみましょう。 1 2 3 4 5 6

(defun ubench () (sb-assem:assemble () head (inst sub (@ 0) 1) (inst jmp :nz head) (next)))

1 2 3 4 5 6 7 8 9 10

CL-USER> (vm '(1000000) (assemble '(ubench leave)) code-page) Evaluation took: 0.000 seconds of real time 0.000629 seconds of total run time (0.000628 user, 0.000001 system) 100.00% CPU 1,001,904 processor cycles 0 bytes consed

#(0 0 0 0 0 0 0 0)

私の遅い MacBook Air は制御オーバーヘッドの 100％のループで 1 サイクル/反復得ます。djn2 で、合理的な特別化オペレータの良い実装では、ループはネイティブコードの約 6 倍遅いです。djn の worse な実装はまだネイティブコードの 8 倍しか遅くありませんが、ひどく特別化されていないバイトコードはネイティブコードの 11-15 倍遅いです。

判決 (Verdict)

スタックサイズを小さく制限する時に、仮想スタックポインタにプリミティブ関数を特別化するのは実践的に実現可能です。スレッド化インタプリタのためにそれなりのランタイムオーバーヘッドも持つように見えます。私は実際にはストレートスタック言語には興味を持っていません；しかしながら、ローカル変数との組み合わせで、固定スタック VM は美しいランタイム IR になると信じています。私たちは高水準言語をそのような VM 用のスーパーオペレータに翻訳する時間を発見できるかどうか見てみましょう。融合されたオペレーターは NEXT の重要性を減少させます；一方、単純な関数コール（アイテムを正しい位置で積み上げるためにシャッフルが少ないため）は依然として有用になります。

SBCL が分野特化のマシンコード生成を探求するための良い伴侶であることについて確かに証明されています。私はインタラクティブプログラミングとマシンコード生成（および検査）のためのそのようなサポートを持つ他の言語実装を知りません。FWIW、私は LuaJIT + dynasm はまもなく同等であると信じています。

Steel Bank Common Lisp：なぜなら C が抽象化しすぎることがあるため；）