●仮想計算機 COMETⅡの簡易シミュレータ (6)
Common Lisp 入門 の番外編です。今回はＣ言語の標準ライブラリ関数 malloc と free を参考にして、COMET2A 用の簡単なメモリ管理プログラムを作ってみましょう。近代的なコンピュータには「仮想記憶 (virtual memory) 機構」を備えているものがありますが、COMETⅡにそのような機能はありません。本稿ではメモリを動的に割り当てる単純な方法を考えることにします。
●メモリの動的割り当て
高水準言語の場合、変数を宣言することでメモリを確保することができます。たとえばＣ言語の場合、関数の引数や局所変数はスタック上に割り当てられるのが一般的で [*1]、外部変数はあるメモリ領域に割り当てられます。前者を「メモリの動的割り当て (dynamic allocation) 」といい、後者を「メモリの静的割り当て (static allocation) 」といいます。COMET2A では、ds や dc で確保した領域が静的に割り当てられたメモリで、スタック上に確保した引数や局所変数が動的に割り当てられたメモリになります。
サブルーチンの引数や局所変数は、そのサブルーチンを実行している間だけ有効です。これらの変数はスタック上に割り当てられているため、サブルーチンから戻るときにそれらの領域は自動的に解放されます。サブルーチンを呼び出すたびにメモリの割り当てと解放を自動的に行うことができるので、近代的なプログラミングでは必要不可欠な機能なのですが、これだけでは十分ではありません。サブルーチンの呼び出しに関係なく、メモリの割り当てと解放を自由に行いたい場合があるのです。
「連結リスト (Linked List) 」や「二分木 (Binary Tree) 」といったデータ構造を考えてみましょう。たとえば、ファイルからデータを読み込み、これらのデータ構造を使ってある処理を行う場合、あらかじめ必要なメモリを静的に確保しておくと、取り扱うデータによっては途中でメモリが足りなくなったり、逆にメモリが余って無駄遣いになる恐れがあります。また、これらのデータ構造はプログラムの実行中に大きさが変化するのが普通です。
このような場合、プログラムの実行中に任意のタイミングでメモリを割り当て、不要になったらメモリを解放する手段が必要になります。一般には、このことを「メモリの動的割り当て」といいます。広い意味で言えば、スタック上のメモリ割り当ても動的割り当てになるのですが、普通はスタックを使ったものを除外した狭い意味で用いられています。
Ｃ言語の場合、メモリの動的割り当ては標準ライブラリに用意されている関数 malloc と free を使うことで簡単に実現することができます。まず最初に、Ｃ言語の関数 malloc と free の動作について簡単に説明しましょう。
[*1] 引数や局所変数のメモリ割り当てはＣ言語の仕様に規定されておらず、それらは処理系 (コンパイラ) に依存します。一般的には、引数はスタックに積み、局所変数もスタック上に確保する処理系がほとんどです。もちろん、引数をレジスタで渡すコンパイラがあってもかまいません。また、最適化により局所変数をレジスタに割り当てることも普通に行われています。
●malloc の動作
malloc は「ヒープ (heap) 」から必要なメモリを確保します。プログラムを実行するとき、OS はプログラムのコードをメモリにロードするとともに、実行に必要なメモリを割り当てます。メモリ領域は大きく分けると 4 種類あり、プログラムのコードを格納するコード領域、あらかじめプログラムで定義されているデータや外部変数のためのデータ領域、スタックとして使用するスタック領域、最後のひとつがプログラムで自由に利用できるヒープ領域です。
これらメモリ領域の配置は処理系によって異なりますが、ある処理系の場合、次のようにヒープ領域はスタック領域の後ろに用意されています。
一般に、ヒープ領域が足りなくなると、空きメモリがあれば自動的に拡張されます。ある処理系の場合は、上図に示すように高位アドレスに向かって拡張されます。
Ｃ言語の場合、メモリを割り当てる関数は malloc と calloc、それから realloc があります。前者は新しくメモリを割り当てる場合に使い、後者はすでに獲得したメモリ領域のサイズを変更する場合に使います。
malloc によってメモリの要求が行なわれると、ヒープ領域の中から空き領域を探します。ユーザーが要求したサイズだけ割り当てられるのではなく、ヒープ領域を管理するための情報が必要です。上図に示すように、Header が管理領域で、この中に領域が使用中で大きさがいくつであるか、といった情報が書き込まれます。malloc の返り値は、ユーザーが使える領域の先頭アドレスが返されます。
確保したメモリは、領域の範囲内で使用するように注意して下さい。領域の前後をはみ出せば、自分の管理領域やほかの管理領域、もしくはほかの領域の中身を破壊することになります。これは、普通の変数の場合と同じですね。Ｃ言語の場合、ほかの領域を破壊しても無頓着ですから、次のメモリを要求したときや、壊された領域の中身をアクセスしたときに、ひどい目に合うことになります。
●free の動作
使い終わったメモリは解放しないといけません。メモリの解放には free を使います。free の引数は、malloc などの返り値を与えなければならないことに注意してください。
メモリを解放する場合、与えられたアドレスから管理領域を求めて、上下のエリアが空き領域であれば、ひとつの空き領域にまとめる処理を行ないます。これは、小さな空き領域ばかりに分割されると、大きな領域を割り当てるには、新しいメモリを取得するしかなくなり、メモリを浪費することになるからです。与えられたアドレスのすぐ上に管理領域があることを前提として動作するので、ほかのアドレスを与えた場合の動作は不定です。
●メモリの管理方法
malloc と free を実装する場合、使用可能なメモリを管理する方法が必要になります。メモリ管理のアルゴリズムはいろいろありますが、今回は使用可能なメモリ領域とその管理情報をブロックにまとめ、それを連結リストでつないで管理することにします。なお、連結リストのかわりに双方向リストを使う方法もあります。興味のある方は 参考文献 3. をお読みください。
下図にブロックの構造を示します。
1 word 1 word
[ next | size | ... free area ... ]
| |
<---------- size * 2 (word) --------->
next : 次のブロック
size ; ブロックの大きさ (header を含む)
unit (1 unit = 2 word) 単位で管理する
図 : ブロックの構造
1 word 目に次のブロックへのアドレス (リンケージ)、2 word 目にブロックの大きさを格納します。この 2 word がブロックの管理情報になります。本稿ではこれを「ヘッダ (header) 」と呼ぶことにします。ブロックの大きさはヘッダの大きさを基準に管理します。この単位を unit と呼ぶことにします。今回は 1 unit = 2 word になります。たとえば、11 word のメモリを取得する場合、実際に必要となるメモリの大きさは (1+ (ceiling 11 2)) => 7 unit (14 word) になります。
ブロックのリンケージを図に示すと、次のようになります。
番地 (10進数)
10000 : [ 10800 | 100 | ... ]
10200 : [ 0 | 300 | ... ] (使用中)
10800 : [ 12200 | 500 | ... ]
11800 : [ 0 | 200 | ... ] (使用中)
12200 : [ 0 | 400 | ... ]
free-list -> [10000] -> [10800] -> [12200] -> null (0)
図 : ブロックのリンケージ
空きブロックを格納したリストを「フリーリスト (free list) 」と呼ぶことにします。フリーリストに格納したブロックはアドレス (先頭番地) の小さい順に並べておきます。こうするとブロックを解放するとき、前後のブロックとの統合処理が簡単になります。
実際にメモリを割り当てる場合、連結リストをたどって割り当て可能なブロックを探します。たとえば、大きさ 450 unit のブロックが必要な場合、上図では 10800 番地のブロックを割り当てることができます。この場合、ブロックの後ろから 450 unit を切り出します。次の図を見てください。
10800 番地のブロックから 450 unit を切り出すので、このブロックの大きさは 50 unit になり、切り出すブロックの先頭アドレスは 10800 + (50 * 2) = 10900 番地になります。10801 番地の値を 50 に書き換え、切り出したブロックの大きさ 450 unit を 10901 番地に書き込みます。malloc の返り値は 10902 番地になります。
ブロックを分割した場合、元のブロックをフリーリストからはずす必要はありません。要求されたメモリと大きさが等しいブロックが見つかった場合は、そのブロックをフリーリストからはずして、ブロックの先頭アドレスに 2 を加えた値を返します。
●ブロックの選択アルゴリズム
ところで、大きさ d [unit] 以上のブロックを探した結果、条件を満たすブロックが複数見つかることもあるでしょう。このとき、ブロックを選択するアルゴリズムとして、次に示す 3 通りの方法が考えられます。
- 初適合法 (first-fit)
最初に見つけたブロックを選択する - 最良適合法 (best-fit)
大きさ d 以上のブロックの中で最小のブロックを選択する - 最悪適合法 (worst-fit)
大きさ d 以上のブロックの中で最大のブロックを選択する
最良適合法と最悪適合法は、フリーリストに格納されている空きブロックをすべて調べなければならないので、初適合法よりも遅くなります。逆に、初適合法はフリーリストの前の方にあるブロックを分割していくことになるため、フリーリストの前の方には小さな空きブロックしか残っていない、ということもありえます。そのような場合、大きなメモリを割り当てようとすると、フリーリストの探索に時間がかかる場合もあります。
最良適合法は大きな空きブロックを保存することができますが、その反面、小さな空きブロックを多数作り出す傾向があります。この欠点を改良するために提案された方法が最悪適合法です。大きな空きブロックから必要なメモリを切り出していくため、小さな空きブロックの生成は抑えることができますが、逆に大きな空きブロックを保存することはできなくなります。
このほかに、初適合法を改良した next-fit 法があります。next-fit 法はフリーリストの先頭から探索するのではなく、前回割り当てたブロックの次から探索を開始することで、
初適合法の欠点である小さなブロックがフリーリストの前のほうに集まる傾向を軽減できる、とされています。参考文献 1. にはＣ言語による next-fit 法のプログラムが掲載されています。このように、それぞれのアルゴリズムに一長一短があります。また、管理するメモリ領域の大きさ、プログラムから要求されるメモリの大きさやその頻度によっても向き不向きがあると思います。COMET2A には 64 k word のメモリしかないので、今回は簡単に実装できる first-fit 法でプログラムを作ることにします。
●Common Lisp での実装
COMET2A でプログラムを作る前に、まずは Common Lisp で first-fit, best-fit, worst-fit 法のプログラムを作り、その動作を確認することにしましょう。メモリの定義とブロックの操作関数は次のようになります。
リスト : メモリと操作関数の定義
; メモリの定義
(defvar *memory* (make-array 65536
:element-type '(unsigned-byte 16)
:initial-element 0))
; 比較回数
(defvar *count* 0)
; 操作関数
(defun get-units (b)
(aref *memory* (1+ b)))
(defun set-units (b s)
(setf (aref *memory* (1+ b)) s))
(defun inc-units (b s)
(incf (aref *memory* (1+ b)) s))
(defun dec-units (b s)
(decf (aref *memory* (1+ b)) s))
(defun get-next-block (b)
(aref *memory* b))
(defun set-next-block (b p)
(setf (aref *memory* b) p))
メモリの定義は COMET2A と同じです。操作関数の引数 b と p はブロックの先頭アドレス (数値) を表します。引数 s はサイズ (unit) です。*count* はフリーリストをたどるときにブロックを比較した回数を求めるために使います。
ヒープ領域の初期化は関数 initialize で行います。
リスト : ヒープ領域の初期化 ; 初期化 (defun initialize () (setf *count* 0) (setf (aref *memory* 0) 2) ; header として使用する (setf (aref *memory* 2) 0) (setf (aref *memory* 3) 32767)) ; 65534 / 2 unit
0, 1 番地はダミーヘッダとして使います。0 番地が示すメモリ領域が実際のヒープ領域になります。連結リストの終端は null (0) で表します。2 番地に null をセットし、3 番地には 32767 (unit) をセットします。また、ダミーヘッダの unit を 0 に設定します。これで、ダミーヘッダの領域が他のブロックと統合されることはありません。
●first-fit 法
次はヒープ領域からメモリを取得する関数を作ります。最初は first-fit 法でメモリを取得する malloc-first です。
リスト : メモリの取得 (1)
; ブロックの分割
(defun divide-block (b units)
; b のサイズを減らす
(dec-units b units)
; 切り出すブロックの先頭アドレス
(incf b (* (get-units b) 2))
; 切り出したブロックのサイズをセット
(set-units b units)
(set-next-block b 0)
(+ b 2))
; メモリの取得 (fist-fit 法)
(defun malloc-first (size)
(do ((units (1+ (ceiling size 2)))
(q 0 p) ; 一つ前のブロック
(p (get-next-block 0) (get-next-block p))) ; 調査中のブロック
((zerop p) 0) ; 空きメモリ無し
(incf *count*)
(let ((punits (get-units p)))
(cond ((= punits units)
; ちょうどよい
; リンクをはずすだけ
(set-next-block q (get-next-block p))
(set-next-block p 0)
(return (+ p 2)))
((> punits units)
; 最初に見つけたブロックを選択
(return (divide-block p units)))))))
最初に必要な unit 数を求めて変数 units にセットします。変数 q が一つ前のブロックを表し、p が調べるブロックを表します。p が null (0) の場合、大きさが units 以上のブロックを見つけることができなかったので 0 を返します。
do ループの中では、まずブロック p の unit 数を求めて変数 punits にセットします。punits と units が等しい場合は、そのブロックをそのまま割り当てます。p の次のブロックを q のリンケージにセットします。これで p をフリーリストからはずすことができます。そして、p のリンケージを 0 に初期化してから、return で p + 2 番地を返します。
punits が units よりも大きい場合は、ブロック p を分割します。この処理を関数 divide-block で行います。最初にブロック b のサイズを units だけ減らします。そして、切り出すブロックの先頭アドレスを求めて変数 b にセットします。そして、そのブロックのヘッダに units を書き込み、リンケージを 0 に初期化します。最後に b + 2 番地を返します。
●best-fit 法と worst-fit 法
次は best-fit 法と worst-fit 法のプログラムを作ります。
リスト : メモリの取得 (2)
; best-fit, worst-fit 法
(defun malloc-sub (size selector)
(do ((units (1+ (ceiling size 2)))
(b nil) ; 選択したブロック
(q 0 p) ; 一つ前のブロック
(p (get-next-block 0) (get-next-block p))) ; 調査中のブロック
((zerop p)
(if (null b)
0 ; 空きメモリ無し
(divide-block b units)))
(incf *count*)
(let ((punits (get-units p)))
(cond ((= punits units)
; ちょうどよい
; リンクをはずすだけ
(set-next-block q (get-next-block p))
(set-next-block p 0)
(return (+ p 2)))
((> punits units)
(when (or (null b)
(funcall selector punits (get-units b)))
; p を選択する
(setf b p)))))))
; best-fit 法
(defun malloc-best (size) (malloc-sub size #'<))
; worst-fit 法
(defun malloc-worst (size) (malloc-sub size #'>))
実際の処理は関数 malloc-sub で行います。malloc-sub はフリーリストをたどってすべての空きブロックを調べ、条件を満たすブロックを選択します。best-fit 法の場合、selector に #'< を渡して、units 以上のブロックの中で最小のものを選択します。worst-fit 法は #'> を渡して最大のものを選択します。そして、do ループの終わりで選択したブロックを divide-block で分割します。
●メモリの解放
次はメモリを解放する関数 free を作ります。
リスト : メモリの解放
; ブロックの統合
(defun append-block (p q)
(cond ((= (+ p (* (get-units p) 2)) q)
; 統合する
(inc-units p (get-units q))
(set-next-block p (get-next-block q)))
(t
; つなげるだけ
(set-next-block p q))))
; メモリの解放
(defun free (ap)
(unless (zerop ap)
(do ((b (- ap 2)) ; ブロックの先頭アドレス
(q 0 p)
(p (get-next-block 0) (get-next-block p)))
((or (zerop p) (< b p))
; 統合処理
(when (plusp p)
(append-block b p))
(append-block q b)))))
関数 append-block はブロック p と q を統合します。q よりも p の番地が小さいものとします。まず、p の unit から p の次のブロックの先頭番地を求めます。この値が q と等しい場合は p と q を統合することができます。p の unit に q の unit を加算して、p のリンケージに q の次のブロックの番地をセットします。これで p と q を統合することができます。統合できない場合は、p のリンケージに q をセットするだけです。
関数 free はフリーリストをたどり、解放するブロック b を挿入する位置を求めます。p が 0 か b < p の場合は、q の後ろに b を挿入します。p が 0 でない場合は、b と p を統合してから q と b を統合します。これでブロック b を解放することができます。
●簡単なテスト
それでは実際にプログラムを実行してみましょう。次のリストを見てください。
リスト : malloc, free のテスト
; フリーブロックの表示
(defun print-free-block ()
(do ((c 0 (1+ c))
(p (get-next-block 0) (get-next-block p)))
((zerop p)
(format t "Free Blocks = ~D~%" c))
(format t "~4,'0X : ~D units~%" p (get-units p))))
; 簡単なテスト
(defun test (min-size allocator)
(initialize)
(print-free-block)
(do ((buff (make-array 64 :initial-element 0))
(x 0 (1+ x))
(req 0)
(fail 0))
((= x 10000)
(print-free-block)
(terpri)
(map nil #'(lambda (x) (free x)) buff)
(print-free-block)
(format t "req ~D, fail ~D, ~G~%" req fail (float (/ (- req fail) req)))
(format t "count ~D, avg ~G~%" *count* (float (/ *count* 10000))))
(let ((n (random 64))
(m (* min-size (1+ (random 256)))))
(when (plusp (aref buff n))
(free (aref buff n)))
(setf (aref buff n) (funcall allocator m))
(incf req m)
(if (zerop (aref buff n))
(incf fail m)))))
引数 min-size は要求するメモリの最小単位 (word) を、allocator はメモリの取得関数を表します。最初に大きさ 64 のバッファ buff を用意し、allocator で取得したメモリのアドレスを buff にセットします。buff が 0 でない場合、そのメモリを free で解放してからセットします。buff の位置と取得するメモリの大きさは乱数で決定します。これを 10000 回繰り返し、要求したメモリと実際に取得できたメモリを求めます。乱数を使っているのであくまでも擬似的にですが、メモリの取得と解放をシミュレートすることができます。
実行結果は次のようになりました。
* (test 4 #'malloc-first) 0002 : 32767 units Free Blocks = 1 0002 : 5 units 0094 : 36 units 0208 : 75 units 0504 : 34 units 05CE : 78 units 06BC : 71 units 0954 : 23 units 0A58 : 69 units 1106 : 8 units 155E : 19 units 18DE : 71 units 1EEE : 91 units 2162 : 147 units 2682 : 30 units 2864 : 36 units 2CAC : 178 units 32A8 : 301 units 387A : 70 units 4080 : 124 units 4AD4 : 13 units 517E : 76 units 5812 : 670 units 5FB0 : 290 units 67D0 : 157 units 6BAC : 251 units 731A : 291 units 79F8 : 765 units 858A : 126 units 9336 : 368 units 9D42 : 1331 units AB62 : 10831 units Free Blocks = 31 0002 : 32767 units Free Blocks = 1 req 5085132, fail 0, 1. count 163960, avg 16.396 NIL
* (test 4 #'malloc-best) 0002 : 32767 units Free Blocks = 1 0002 : 11121 units 5ABE : 104 units 5DAC : 174 units 615A : 197 units 68D4 : 123 units 6AE4 : 16 units 6F5C : 47 units 764A : 191 units 787A : 264 units 87F0 : 42 units 8BC8 : 11 units 9116 : 8 units 9302 : 12 units 9424 : 173 units A498 : 85 units A9E4 : 7 units AC46 : 153 units B502 : 66 units B700 : 256 units BD44 : 49 units C59E : 2 units C7AC : 188 units CC52 : 13 units CD9E : 31 units CF86 : 40 units D13E : 2408 units E752 : 1 units E7DA : 154 units EE2A : 211 units F212 : 15 units F7C4 : 6 units F8D2 : 37 units FD0E : 66 units Free Blocks = 33 0002 : 32767 units Free Blocks = 1 req 5136632, fail 0, 1. count 303162, avg 30.3162 NIL
* (test 4 #'malloc-worst) 0002 : 32767 units Free Blocks = 1 0002 : 330 units 0A4E : 843 units 1462 : 496 units 1E3A : 594 units 256C : 637 units 2C4C : 631 units 32C2 : 31 units 35B8 : 847 units 419A : 323 units 49E6 : 394 units 5236 : 424 units 58E0 : 163 units 5CB0 : 193 units 6138 : 531 units 6914 : 339 units 6D50 : 352 units 7166 : 352 units 7500 : 799 units 7EB0 : 187 units 8378 : 672 units 931C : 454 units 972A : 799 units A178 : 624 units A86E : 21 units ABA6 : 668 units B55E : 555 units BC1A : 522 units C6E0 : 273 units CA64 : 852 units D41A : 123 units DC94 : 584 units E3EE : 684 units EEEA : 362 units F83A : 676 units Free Blocks = 34 0002 : 32767 units Free Blocks = 1 req 5119360, fail 0, 1. count 305537, avg 30.5537 NIL
要求するメモリの最小単位が 4 word の場合、どの方法でもメモリ割り当てに失敗することはありません。また、フリーリストに連結された空きブロックは、どの方法でも 30 個以上あり、ヒープ領域が分断されていることがわかります。これを「断片化」といいます。たとえば first-fit 法の場合、空きブロックの総容量は約 32 k word ありますが、実際に割り当てることができるメモリは最も大きなブロックの容量 (10831 - 1) * 2 = 21660 word までになります。それよりも大きなメモリを割り当てることはできません。
ブロックの比較回数 (count) では fist-fit 法が一番少なく、メモリの割り当ては他の方法よりも高速であることがわかります。first-fit 法の場合、比較的小さなブロックがフリーリストの先頭に集まる傾向がみられます。best-fit 法は大きなブロックが保存されていて、小さなブロックが多くなる傾向がみられます。傾向がまったく異なるのが worst-fit 法で、大きなブロックがないかわりに小さなブロックも少なく、中規模なブロックが多数を占めています。
今度は、要求するメモリの最小単位を 8 word に増やしてみましょう。実行結果は次のようになりました。
* (test 8 #'malloc-first) 0002 : 32767 units Free Blocks = 1 0002 : 8 units 00B6 : 40 units ・・・省略・・・ DFBC : 625 units E8B8 : 405 units Free Blocks = 28 0002 : 32767 units Free Blocks = 1 req 10238016, fail 1951152, 0.8094209 count 164036, avg 16.4036 NIL * (test 8 #'malloc-best) 0002 : 32767 units Free Blocks = 1 0002 : 15 units 0412 : 444 units ・・・省略・・・ E830 : 30 units EEA0 : 17 units Free Blocks = 30 0002 : 32767 units Free Blocks = 1 req 10393800, fail 1844928, 0.82249725 count 275349, avg 27.5349 NIL * (test 8 #'malloc-worst) 0002 : 32767 units Free Blocks = 1 0002 : 497 units 0726 : 623 units ・・・省略・・・ F3BA : 498 units FAC8 : 227 units Free Blocks = 29 0002 : 32767 units Free Blocks = 1 req 10238720, fail 2946192, 0.71225 count 252217, avg 25.2217 NIL
どの方法でもメモリの割り当てに失敗することがあります。成功率が一番高いのが best-fit 法です。大きな空きブロックを残すことにより、メモリ割り当ての成功率が高くなっていると思います。first-fit 法の場合も成功率はそれほど悪くはありません。単純なアルゴリズムですが、思っていたよりも first-fit 法の性能は高いようです。
成功率が一番悪かったのが worst-fit 法です。worst-fit 法の場合、大きなブロックはほとんど存在しません。このため、大きなメモリを要求されたとき、メモリ割り当てに失敗する確率が他の方法よりも高くなるようです。今回のテストでは最大で 2 k word のメモリを要求するので、worst-fit 法にとって相性の悪いテストだったと思います。
今回はここまでです。次回は COMET2A で first-fit 法のプログラムを作ってみましょう。
●参考文献
- Brain W.Kernighan, D.M. Ritche, 『プログラミング言語Ｃ』, 共立出版, 1981
- A.V. Aho, J.E. Hopcroft, J.D. Ullman, 『データ構造とアルゴリズム』, 培風館, 1987
- 近藤嘉雪, 『定本Ｃプログラマのためのアルゴリズムとデータ構造』, 1998, ソフトバンク
●プログラムリスト１
;
; malloc.l : メモリ管理ルーチンのテスト
;
; Copyright (C) 2011 Makoto Hiroi
;
; メモリの定義
(defvar *memory* (make-array 65536
:element-type '(unsigned-byte 16)
:initial-element 0))
; 比較回数
(defvar *count* 0)
; 初期化
(defun initialize ()
(setf *count* 0)
(setf (aref *memory* 0) 2) ; header として使用する
(setf (aref *memory* 2) 0)
(setf (aref *memory* 3) 32767)) ; 65534 / 2 unit
; 操作関数
(defun get-units (b)
(aref *memory* (1+ b)))
(defun set-units (b s)
(setf (aref *memory* (1+ b)) s))
(defun inc-units (b s)
(incf (aref *memory* (1+ b)) s))
(defun dec-units (b s)
(decf (aref *memory* (1+ b)) s))
(defun get-next-block (b)
(aref *memory* b))
(defun set-next-block (b p)
(setf (aref *memory* b) p))
; ブロックの分割
(defun divide-block (b units)
; b のサイズを減らす
(dec-units b units)
; 切り出すブロックの先頭アドレス
(incf b (* (get-units b) 2))
; 切り出したブロックのサイズをセット
(set-units b units)
(set-next-block b 0)
(+ b 2))
; メモリの取得 (fist-fit 法)
(defun malloc-first (size)
(do ((units (1+ (ceiling size 2)))
(q 0 p) ; 一つ前のブロック
(p (get-next-block 0) (get-next-block p))) ; 調査中のブロック
((zerop p) 0) ; 空きメモリ無し
(incf *count*)
(let ((punits (get-units p)))
(cond ((= punits units)
; ちょうどよい
; リンクをはずすだけ
(set-next-block q (get-next-block p))
(set-next-block p 0)
(return (+ p 2)))
((> punits units)
; 最初に見つけたブロックを選択
(return (divide-block p units)))))))
; best-fit, worst-fit 法
(defun malloc-sub (size selector)
(do ((units (1+ (ceiling size 2)))
(b nil) ; 選択したブロック
(q 0 p) ; 一つ前のブロック
(p (get-next-block 0) (get-next-block p))) ; 調査中のブロック
((zerop p)
(if (null b)
0 ; 空きメモリ無し
(divide-block b units)))
(incf *count*)
(let ((punits (get-units p)))
(cond ((= punits units)
; ちょうどよい
; リンクをはずすだけ
(set-next-block q (get-next-block p))
(set-next-block p 0)
(return (+ p 2)))
((> punits units)
(when (or (null b)
(funcall selector punits (get-units b)))
; p を選択する
(setf b p)))))))
; best-fit 法
(defun malloc-best (size) (malloc-sub size #'<))
; worst-fit 法
(defun malloc-worst (size) (malloc-sub size #'>))
; メモリの統合
(defun append-block (p q)
(cond ((= (+ p (* (get-units p) 2)) q)
; 統合する
(inc-units p (get-units q))
(set-next-block p (get-next-block q)))
(t
; つなげるだけ
(set-next-block p q))))
; メモリの解放
(defun free (ap)
(unless (zerop ap)
(do ((b (- ap 2)) ; ブロックの先頭アドレス
(q 0 p)
(p (get-next-block 0) (get-next-block p)))
((or (zerop p) (< b p))
; 統合処理
(when (plusp p)
(append-block b p))
(append-block q b)))))
; フリーブロックの表示
(defun print-free-block ()
(do ((c 0 (1+ c))
(p (get-next-block 0) (get-next-block p)))
((zerop p)
(format t "Free Blocks = ~D~%" c))
(format t "~4,'0X : ~D units~%" p (get-units p))))
;;; 簡単なテスト
(defun test (bmin allocator)
(initialize)
(print-free-block)
(do ((buff (make-array 64 :initial-element 0))
(x 0 (1+ x))
(req 0)
(fail 0))
((= x 10000)
(print-free-block)
(terpri)
(map nil #'(lambda (x) (free x)) buff)
(print-free-block)
(format t "req ~D, fail ~D, ~G~%" req fail (float (/ (- req fail) req)))
(format t "count ~D, avg ~G~%" *count* (float (/ *count* 10000))))
(let ((n (random 64))
(m (* bmin (1+ (random 256)))))
(when (plusp (aref buff n))
(free (aref buff n)))
(setf (aref buff n) (funcall allocator m))
(incf req m)
(if (zerop (aref buff n))
(incf fail m)))))