付録B DOER/MAKEの定義

あなたのシステムに DOERMAKE がまだ定義されていない場合、この付録はそれらをインストールするのを助け、必要ならばそれらがどのように動作するかを理解するためのものです。 その性質上、この構造はシステムに依存するため、この付録の最後にいくつかの異なる実装を含めました。それらのうちの1つがあなたのために働くことを願っています。 もしこの節それらを実行するのに十分な情報をあなたに与えないなら、あなたのForthシステムがたぶん特殊なものです。私たちに助けを求めないで、あなたのForthベンダーに尋ねてください。

その仕組みは次のとおりです。 DOER はパラメータフィールドに一つのセルを持つエントリを作成する定義ワードです。 そのセルはベクタアドレスを含み、 NOTHING と呼ばれる無操作ワードを指すように初期化されます。

DOER の子はその DOES>DOER コードを実行します。これは2つのことだけを行います。つまり、ベクトルアドレスを取得してリターンスタックに配置する。 それで全部です。 その後、Forthの実行(execution)がリターンスタックのこのアドレスで続行されます。これにより、ベクトル機能が実行されます。FORTH-83規格に関してはそれだけです。

' NOTHING >BODY >R <return>

これは NOTHING を実行します(このトリックはコロンの定義でのみ機能します)。

次のように入力したときに作成された辞書エントリの図です。

_images/appendixb-img1.png

今、次のように定義したとします。

: TEST   MAKE JOE  CR ;

つまり、キャリッジリターン CR するために JOE をベクトル化できるワードを定義します。

以下はコンパイルされた TEST の定義の図です。

_images/appendixb-img2.png

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 のベクタアドレスに格納します。
  今や JOETEST の定義の中を指しています。 JOE と打つと、改行します。
@ ?DUP IF >R THEN ゼロを含むセルの内容を取得します。 セルにはゼロが含まれているので、 IF…THEN ステートメントは実行されません。

それが基本的な考え方です。 しかし、ゼロを含むセルはどうでしょうか。 これは ;AND を使うためのものです。 TESTを以下の通り変更したとします。

: TEST   MAKE JOE  CR ;AND SPACE ;

つまり、TESTを起動すると、JOEに CR を実行させ、今すぐ SPACE を実行させます。 この新しいバージョンのTESTは次のようになります。

_images/appendixb-img3.png

以下が ;AND の定義です。

: ;AND   COMPILE  EXIT  HERE MARKER @ ! ;   IMMEDIATE

セミコロンと同じように、 ;ANDEXIT をコンパイルしたことがわかります。

次に、 MAKE がそのセルのアドレスを MARKER という変数に保存したことを思い出してください。 これで ;ANDHERE ( 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 ;