SICP 5.3 Storage Allocation and Garbage Collection

ノート

レジスタマシンとしてのScheme評価器を実装する前に、メモリ割り当てに関する問題を片付けておく。
一つの問題はペア（セル）をどう表現するのか。もう一つの問題は実際には有限のメモリサイズをあたかも無限にあるかの様に見せる技術。

5.3.1 Memory as Vectors

メモリは小さな情報を格納出来る容器の並びで、

それぞれはアドレス（あるいはロケーション）で特定する事が出来る
アドレスもメモリに格納する事が出来る
アドレスは算術演算できる

事が要求されている。

vector-ref、vector-set!はSchemeの標準として定義されている。

Representing Lisp data

ベクタを使ってcarだけのベクタ、cdrだけのベクタを作る。
それぞれの要素には基本的にはポインタが入るが、セルへのポインタ（p）、数値（n）、ヌルポインタ（e）等の肩を表すタグを用いる。シンボルもそれ用のタグを付けて各文字をリストとして保存するものと思われる。

Implementing the primitive list operations

前節までに実装したレジスタマシンのプリミティブとしてvector-ref、vector-set!を登録すると、car、cdrを参照する、あるいはそれらに保存する命令を実装出来る。
また、cons、eq?も実装可能。

Implementing stacks

スタックの走査、saveとrestoreもthe-stackと言うベクタへの操作として実装出来る。

Exercise 5.20

Index	0	1	2	3
the-cars		n1	p1	p1
the-cdrs		n2	p3	e0

結果としての各ポインターの値

free	4
x	1
y	2

Exercise 5.21

話の流れからすると、vector-set!やvector-refをプリミティブとして実装する事になりそうだが、

Assume that the list-structure memory operations are available as machine primitives.

と言うのは、car、cdr等がプリミティブとして用意されていて、vector-set!、vector-ref等は使わなくて良いと読める。YouTubeにアップロードされているMITのSICPの講義を見てもvectorを使った具体的なリストの実装には言及していないので、ここでは単に今までの様に数値を扱うのではなくリストを扱う手続きを定義する演習であると解釈する。

make-machineでmake-vectorを呼んでthe-cars、the-cdrsを作ったとしてもstart-machineを呼び出す前にレジスタの中身を設定するのはかなりややこしい話になる。なのでこの部分はベースとなるLispシステムのリストを素直に使うものと仮定する。

今までの例では手続き呼び出しのパターンとしては

最初に引数となる変数に初期値を保存してスタート
レジスタcontinueは手続きから戻るべきラベルを保存する
なので最初の呼び出しから戻った時には終了するので最後のラベルをcontinueに保存する
ここから手続きの本体に傾れ込むかgotoでジャンプする

次に手続きを呼び出す時に

保存しておきたいレジスタを一旦スタックに保存する
continueに戻る場所としてのラベルを設定する
引数として渡す為のレジスタを設定
呼び出す手続きのラベルにジャンプする
戻って来たら、保存していたレジスタを復元する

a.
足し算の引数としての値を保存するレジスタa、pairの結果を保存する為のレジスタp、手続きの戻り値としてレジスタretを使う事にする。

treeに初期値を設定してスタート（ここはマシンの定義の外）
スタックを初期化
ラベルdoneをレジスタcontinueに保存

count-leaves本体

retに0を保存
treeが空かチェック
空なら「リターン処理」にジャンプ
retに1を保存
treeがペアか否かの結果をレジスタpに保存
レジスタpにnotを適用した結果をチェック
pが偽だったら「リターン処理」にジャンプ
保存しておきたいレジスタ（treeとcontinue）をスタックに保存
treeのcarをtreeに設定
continueを「戻る場所その１」を設定
count-leavesにジャンプ

戻る場所その１

保存しておいたレジスタ（continueとtree）を復元
retの値をaに保存
保存しておきたいレジスタ（treeとaとcontinue）をスタックに保存
treeのcdrをtreeに設定
continueを「戻る場所その２」を設定
count-leavesにジャンプ

戻る場所その２

保存しておいたレジスタ（continueとaとtree)を復元
retの値とaの値を足してretに保存する

リターン処理

continueに入っているラベル時ジャンプ

continueのスタックへの保存と復元とか冗長な部分が多少あるが、こんな感じ。

(define count-leaves-machine
  (make-machine
   (list (list 'null? null?)
         (list 'pair? pair?)
         (list 'not not)
         (list 'car car)
         (list 'cdr cdr)
         (list '+ +))
   '((perform (op initialize-stack))
     (assign continue (label done))
     count-leaves
     (assign ret (const 0))
     (test (op null?) (reg tree))
     (branch (label return))
     (assign ret (const 1))
     (assign p (op pair?) (reg tree))
     (test (op not) (reg p))
     (branch (label return))
     (save tree)
     (assign tree (op car) (reg tree))
     (save continue)
     (assign continue (label after-car))
     (goto (label count-leaves))
     after-car
     (restore continue)
     (restore tree)
     (assign a (reg ret))
     (save a)
     (save tree)
     (assign tree (op cdr) (reg tree))
     (save continue)
     (assign continue (label after-cdr))
     (goto (label count-leaves))
     after-cdr
     (restore continue)
     (restore tree)
     (restore a)
     (assign ret (op +) (reg a) (reg ret))
     return
     (goto (reg continue))
     done
     )))

実行結果

> (set-register-contents! count-leaves-machine 'tree '())
'done
> (start count-leaves-machine)
'done
> (get-register-contents count-leaves-machine 'ret)
0
> (set-register-contents! count-leaves-machine 'tree '(1))
'done
> (start count-leaves-machine)
'done
> (get-register-contents count-leaves-machine 'ret)
1
> (set-register-contents! count-leaves-machine 'tree '(1 2 3))
'done
> (start count-leaves-machine)
'done
> (get-register-contents count-leaves-machine 'ret)
3
> (set-register-contents! count-leaves-machine 'tree '((1 2) (3 4) 5))
'done
> (start count-leaves-machine)
'done
> (get-register-contents count-leaves-machine 'ret)
5
>

b.
アキュムレータとしてレジスタnを使うパターン。
今回は一工夫をしてレジスタretを使わずにnだけで関数値を表現する。その代わり、treeがペアでなかった時の演算を条件判断の前には出来ないのでリターンする直前に行う様にジャンプ先を変更。

treeに初期値を設定してスタート（ここはマシンの定義の外）
スタックを初期化
nに0を保存
ラベルdoneをレジスタcontinueに保存

count-iter本体

treeが空かチェック
空なら「リターン処理」にジャンプ
treeがペアか否かの結果をレジスタpに保存
レジスタpにnotを適用した結果をチェック
pが偽だったら「足し算（してリターン）」にジャンプ
保存しておきたいレジスタ（treeとcontinueのみ、nは保存する必要なし）をスタックに保存
treeのcarをtreeに設定
continueを「戻る場所その１」を設定
count-iterにジャンプ

戻る場所

保存しておいたレジスタ（continueとtree）を復元
（※この後はレジスタを保存しておく必要なし）
treeのcdrをtreeに設定
count-iterにジャンプ

足し算（してリターン）

nにn+1を保存

リターン処理

continueに入っているラベル時ジャンプ

(define count-leaves-machine
  (make-machine
   (list (list 'null? null?)
         (list 'pair? pair?)
         (list 'not not)
         (list 'car car)
         (list 'cdr cdr)
         (list '+ +))
   '((perform (op initialize-stack))
     (assign n (const 0))
     (assign continue (label done))
     count-iter
     (test (op null?) (reg tree))
     (branch (label return))
     (assign p (op pair?) (reg tree))
     (test (op not) (reg p))
     (branch (label return-plus-1))
     (save tree)
     (assign tree (op car) (reg tree))
     (save continue)
     (assign continue (label after-car))
     (goto (label count-iter))
     after-car
     (restore continue)
     (restore tree)
     (assign tree (op cdr) (reg tree))
     (goto (label count-iter))
     return-plus-1
     (assign n (op +) (reg n) (const 1))
     return
     (goto (reg continue))
     done
     )))

動作

> (set-register-contents! count-leaves-machine 'tree '())
'done
> (start count-leaves-machine)
'done
> (get-register-contents count-leaves-machine 'n)
0
> (set-register-contents! count-leaves-machine 'tree '(1))
'done
> (start count-leaves-machine)
'done
> (get-register-contents count-leaves-machine 'n)
1
> (set-register-contents! count-leaves-machine 'tree '(1 2 3))
'done
> (start count-leaves-machine)
'done
> (get-register-contents count-leaves-machine 'n)
3
> (set-register-contents! count-leaves-machine 'tree '((1 2) (3 4) 5))
'done
> (start count-leaves-machine)
'done
> (get-register-contents count-leaves-machine 'n)
5
>

Exercise 5.22

Exercise 3.12でのappendの定義は

(define (append x y)
  (if (null? x)
      y
      (cons (car x) (append (cdr x) y))))

同じ様な考え方でappend-machineを設計すると

(define append-machine
  (make-machine
   (list (list 'null? null?)
         (list 'car car)
         (list 'cdr cdr)
         (list 'cons cons))
   '((perform (op initialize-stack))
     (assign continue (label done))
     append
     (assign ret (reg y))
     (test (op null?) (reg x))
     (branch (label return))
     (save x)
     (assign x (op cdr) (reg x))
     (save continue)
     (assign continue (label after-call))
     (goto (label append))
     after-call
     (restore continue)
     (restore x)
     (assign x (op car) (reg x))
     (assign ret (op cons) (reg x) (reg ret))
     return
     (goto (reg continue))
     done
     )))

動作させてみる

> (set-register-contents! append-machine 'x '())
'done
> (set-register-contents! append-machine 'y '())
'done
> (start append-machine)
'done
> (get-register-contents append-machine 'ret)
'()
> (set-register-contents! append-machine 'x '(1))
'done
> (set-register-contents! append-machine 'y '())
'done
> (start append-machine)
'done
> (get-register-contents append-machine 'ret)
'(1)
> (set-register-contents! append-machine 'x '())
'done
> (set-register-contents! append-machine 'y '(2))
'done
> (start append-machine)
'done
> (get-register-contents append-machine 'ret)
'(2)
> (set-register-contents! append-machine 'x '(1))
'done
> (set-register-contents! append-machine 'y '(2))
'done
> (start append-machine)
'done
> (get-register-contents append-machine 'ret)
'(1 2)
> (set-register-contents! append-machine 'x '(1 2))
'done
> (set-register-contents! append-machine 'y '(3 4))
'done
> (start append-machine)
'done
> (get-register-contents append-machine 'ret)
'(1 2 3 4)
> (set-register-contents! append-machine 'x '(1 2))
'done
> (set-register-contents! append-machine 'y '((3 4)))
'done
> (start append-machine)
'done
> (get-register-contents append-machine 'ret)
'(1 2 (3 4))
>

append!の定義は

(define (append! x y)
  (set-cdr! (last-pair x) y)
  x)

(define (last-pair x)
  (if (null? (cdr x))
      x
      (last-pair (cdr x))))

set-cdr!を使うのにset-mcdr!を使うので少しトリッキー。set-mcdr!は値を返さないのでperformを使う。また、最初に引数として与えたレジスタxが指しているペアをそのまま返す為に、最初にxの値をスタックに保存して、最後に復元して戻る。

(define append!-machine
  (make-machine
   (list (list 'null? null?)
         (list 'cdr mcdr)
         (list 'set-cdr! set-mcdr!))
   '((perform (op initialize-stack))
     (save x)
     (assign continue (label done))
     last-pair
     (assign ret (reg x))
     (assign x (op cdr) (reg x))
     (test (op null?) (reg x))
     (branch (label return))
     (goto (label last-pair))
     return
     (goto (reg continue))
     done
     (perform (op set-cdr!) (reg ret) (reg y))
     (restore x)
     )))

動作確認も一工夫。mpairが返って来て結果が見にくいのでdisplayを使って表示する。

> (set-register-contents! append!-machine 'x (mcons 1 '()))
'done
> (set-register-contents! append!-machine 'y (mcons 2 '()))
'done
> (start append!-machine)
'done
> (display (get-register-contents append!-machine 'x))
{1 2}
> (set-register-contents! append!-machine 'x (mcons 1 (mcons 2 '())))
'done
> (set-register-contents! append!-machine 'y (mcons 3 (mcons 4 '())))
'done
> (start append!-machine)
'done
> (display (get-register-contents append!-machine 'x))
{1 2 3 4}
>

5.3.2 Maintaining the Illusion of Infinite Memory

最も（？）シンプルなガーベッジコレクションのstop-and-copy方式の説明。

Implementation of a stop-and-copy garbage collector

the-carsとthe-cdrsのベクタのペアを２セット用意していて、セルが無くなるまではその片方を使用する。consしようとして現在使用中のペアのセルを使い切っていた場合には、rootから辿れる全てのセルをもう片方のペアの方にコピーする。そうするとrootからアクセス出来ないゴミはコピーされないため、コピー後のペアには空きが出来る筈。

セルをコピーする際には元載せるにはコピーが済んでいる目印とコピー先のアドレスを書き込んでおく。ポインタを辿ってセルをコピーして行く際にはコピーされたセルに入っているポインタはまだ以前のアドレスを指している。ポインタの先がまだコピーされていなければそれをコピーしてポインタも更新する。ポインタの先が既にコピーされていたら新しいアドレスでポインタを更新する。

プログラミング再入門

プログラミングをもう一度ちゃんと勉強する読書ノート