付録B DOER/MAKEの定義¶
あなたのシステムに DOER
と MAKE
がまだ定義されていない場合、この付録はそれらをインストールするのを助け、必要ならばそれらがどのように動作するかを理解するためのものです。 その性質上、この構造はシステムに依存するため、この付録の最後にいくつかの異なる実装を含めました。それらのうちの1つがあなたのために働くことを願っています。 もしこの節それらを実行するのに十分な情報をあなたに与えないなら、あなたのForthシステムがたぶん特殊なものです。私たちに助けを求めないで、あなたのForthベンダーに尋ねてください。
その仕組みは次のとおりです。 DOER
はパラメータフィールドに一つのセルを持つエントリを作成する定義ワードです。 そのセルはベクタアドレスを含み、 NOTHING
と呼ばれる無操作ワードを指すように初期化されます。
DOER
の子はその DOES>
の DOER
コードを実行します。これは2つのことだけを行います。つまり、ベクトルアドレスを取得してリターンスタックに配置する。 それで全部です。 その後、Forthの実行(execution)がリターンスタックのこのアドレスで続行されます。これにより、ベクトル機能が実行されます。FORTH-83規格に関してはそれだけです。
' NOTHING >BODY >R <return>
これは NOTHING
を実行します(このトリックはコロンの定義でのみ機能します)。
次のように入力したときに作成された辞書エントリの図です。
今、次のように定義したとします。
: TEST MAKE JOE CR ;
つまり、キャリッジリターン CR
するために JOE
をベクトル化できるワードを定義します。
以下はコンパイルされた TEST
の定義の図です。
MAKE
のコードを見てみましょう。 コロンの定義の中で MAKE
を使っているので、 STATE
がtrueになり、その次のフレーズを実行します。
COMPILE (MAKE) HERE MARKER ! 0 ,
MAKE
がどのようにしてランタイムルーチンのアドレス (MAKE)
をコンパイルし、その後にゼロが続いたかを見ることができます(ゼロの意味と、そのアドレスを変数 MARKER
に保存する理由については後で説明します)。 新しい定義 TEST
を実行したときの (MAKE)
の動作を見てみましょう。
R> | リターンスタックからアドレスを取得します。 このアドレスは (MAKE) の直後の0を格納したセルを指しています。 |
DUP 2+ | (MAKE) の後の2番目のセルのアドレスを取得します。そこには JOE のアドレスが格納されています。 |
DUP 2+ | 実行したいコードが始まる、 (MAKE) の後の3番目のセルのアドレスを取得します。 スタックは次のようになりました。 ( 'marker 'joe 'code ---) |
SWAP @ >BODY | JOE を指し示すアドレスの内容を取得します(すなわち、JOE のアドレスを取得しそして、JOE のpfaを計算し、そのベクトル・アドレスへ行きます)。 |
! | 新しいコード( CR など)が格納されているアドレスを JOE のベクタアドレスに格納します。 |
今や JOE が TEST の定義の中を指しています。 JOE と打つと、改行します。 |
|
@ ?DUP IF >R THEN | ゼロを含むセルの内容を取得します。 セルにはゼロが含まれているので、 IF…THEN ステートメントは実行されません。 |
それが基本的な考え方です。 しかし、ゼロを含むセルはどうでしょうか。 これは ;AND
を使うためのものです。 TESTを以下の通り変更したとします。
: TEST MAKE JOE CR ;AND SPACE ;
つまり、TESTを起動すると、JOEに CR
を実行させ、今すぐ SPACE
を実行させます。 この新しいバージョンのTESTは次のようになります。
以下が ;AND
の定義です。
: ;AND COMPILE EXIT HERE MARKER @ ! ; IMMEDIATE
セミコロンと同じように、 ;AND
が EXIT
をコンパイルしたことがわかります。
次に、 MAKE
がそのセルのアドレスを MARKER
という変数に保存したことを思い出してください。 これで ;AND
は HERE
( SPACE
で始まるコードの2番目の文字列の場所)を、以前はゼロを含んでいたセルに格納します。 これで (MAKE)
は実行を再開する場所へのポインタを持ちます。以下のフレーズをご覧ください。
IF >R THEN
SPACE
で始まるコードのアドレスをリターンスタックに残します。 したがって、実行は MAKE
と ;AND
の間のコードをスキップして残りの定義をセミコロンまで続けます。
UNDO
というワードは、 DOER
というワードの名前を刻み(tick)、その中に NOTHING
というアドレスを格納します。
最後の注意点:いくつかのシステムでは問題に遭遇するかもしれません。 前方参照を作成するためにコロンの定義の外側で MAKE
を使うと、最近定義されたワードを見つけることができないかもしれません。 たとえば、次のようにします。
: REFRAIN DO-DAH DO-DAH ;
MAKE SONG CHORUS REFRAIN ;
あなたのシステムは、refrainが定義されていないと考えるかもしれません。 問題は SMUDGE
の配置によるものです。 解決策として、定義の順番を並べ替えるか、必要ならば、 MAKE
コードを定義の中に入れてから実行してください。
: SETUP MAKE SONG CHORUS REFRAIN ; SETUP
Laboratory Microsystems PC / FORTH 2.0では、9行目の UNSMUDGE
が問題を処理します。 この問題は、Laxen/Perry/Harrisモデルでは発生しません。
最後のスクリーンは DOER/MAKE
を使った例です。 ブロックをロードしたら、以下の通り入力します。
RECITAL
それから入力
WHY?
その後は、好きなだけ何度でも戻ります(毎回異なる理由が表示されます)。
0 1 2 3 4 5 6 7 8 9 10 11 | ( DOER/MAKE Shadow screen LPB 12/05/83 )
NOTHING A no-opp
DOER Defines a word whose behavior is vectorable.
MARKER Saves adr for optional continuation pointer.
(MAKE) Stuffs the address of further code into the
parameter field of a doer word.
MAKE Used interpretively: MAKE doer-name forth-code ;
or inside a definition:
: def MAKE doer-name forth-code ;
Vectors the doer-name word to the forth-code.
;AND Allows continuation of the "making" definition
UNDO Usage: UNDO doer-name ; makes it safe to execute
|
0 1 2 3 4 5 6 7 8 9 10 11 12 13 | \ DOER/MAKE FORTH-83 Laxen/Perry/Harris model LPB 12/05/83
: NOTHING ;
: DOER CREATE ['] NOTHING >BODY , DOES> @ >R ;
VARIABLE MARKER
: (MAKE) R> DUP 2+ DUP 2+ SWAP @ >BODY !
@ ?DUP IF >R THEN ;
: MAKE STATE @ IF ( compiling)
COMPILE (MAKE) HERE MARKER ! 0 ,
ELSE HERE [COMPILE] ' >BODY !
[COMPILE] ] THEN ; IMMEDIATE
: ;AND COMPILE EXIT HERE MARKER @ ! ; IMMEDIATE
: UNDO ['] NOTHING >BODY [COMPILE] ' >BODY ! ;
\
\ The code in this screen is in the public domain.
|
0 1 2 3 4 5 6 7 8 9 10 11 12 13 | ( DOER/MAKE FORTH-83 Lab. Micro PC/FORTH 2.0 LPB 12/05/83 )
: NOTHING ;
: DOER CREATE ['] NOTHING >BODY , DOES> @ >R ;
VARIABLE MARKER
: (MAKE) R> DUP 2+ DUP 2+ SWAP @ >BODY !
@ ?DUP IF >R THEN ;
: MAKE STATE @ IF ( compiling)
COMPILE (MAKE) HERE MARKER ! 0 ,
ELSE HERE [COMPILE] ' >BODY !
[COMPILE] ] UNSMUDGE THEN ; IMMEDIATE
: ;AND COMPILE EXIT HERE MARKER @ ! ; IMMEDIATE
: UNDO ['] NOTHING >BODY [COMPILE] ' >BODY ! ;
\
( The code in this screen is in the public domain.)
|
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | ( DOER/MAKE FIG model LPB 12/05/83 )
: NOTHING ;
: DOES-PFA ( pfa -- pfa of child of <BUILD-DOES> ) 2+ ;
: DOER <BUILDS ' NOTHING , DOES> @ >R ;
0 VARIABLE MARKER
: (MAKE) R> DUP 2+ DUP 2+ SWAP @ 2+ DOES-PFA !
@ -DUP IF >R THEN ;
: MAKE STATE @ IF ( compiling)
COMPILE (MAKE) HERE MARKER ! 0 ,
ELSE HERE [COMPILE] ' DOES-PFA !
SMUDGE [COMPILE] ] THEN ; IMMEDIATE
: ;AND COMPILE ;S HERE MARKER @ ! ; IMMEDIATE
: UNDO ' NOTHING [COMPILE] ' DOES-PFA ! ;
;S
The code in this screen is in the public domain.
|
0 1 2 3 4 5 6 7 8 9 10 11 12 13 | ( DOER/MAKE 79-Standard MVP FORTH LPB 12/05/83 )
: NOTHING ;
: DOER CREATE ' NOTHING , DOES> @ >R ;
VARIABLE MARKER
: (MAKE) R> DUP 2+ DUP 2+ SWAP @ 2+ ( pfa) !
@ ?DUP IF >R THEN ;
: MAKE STATE @ IF ( compiling)
COMPILE (MAKE) HERE MARKER ! 0 ,
ELSE HERE [COMPILE] ' !
[COMPILE] ] THEN ; IMMEDIATE
: ;AND COMPILE EXIT HERE MARKER @ ! ; IMMEDIATE
: UNDO ['] NOTHING [COMPILE] ' ! ;
\
( The code in this screen is in the public domain.)
|
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | ( TODDLER: Example of DOER/MAKE 12/01/83 )
DOER ANSWER
: RECITAL
CR ." Your daddy is standing on the table. Ask him 'WHY?' "
MAKE ANSWER ." To change the light bulb."
BEGIN
MAKE ANSWER ." Because it's burned out."
MAKE ANSWER ." Because it was old."
MAKE ANSWER ." Because we put it in there a long time ago."
MAKE ANSWER ." Because it was dark!"
MAKE ANSWER ." Because it was night time!!"
MAKE ANSWER ." Stop saying WHY?"
MAKE ANSWER ." Because it's driving me crazy."
MAKE ANSWER ." Just let me change this light bulb!"
FALSE UNTIL ;
: WHY? CR ANSWER QUIT ;
|