新增網頁9

\ Lesson 8 - Defining Words

\ The Forth Course

\ by Richard E. Haskell

\ Dept. of Computer Science and Engineering

\ Oakland University, Rochester, MI 48309

comment:

Lesson 8

DEFINING WORDS

8.1 CREATE...DOES> .......................................................................... 8-2

8.2 A SIMPLE JUMP TABLE ................................................................. 8-4

8.3 JUMP TABLE WITH ARBITRARY STACK VALUES .................... 8-6

8.4 JUMP TABLE WITH FORTH WORDS ............................................ 8-8

8.5 POP-UP MENUS .............................................................................. 8-10

8.6 EXERCISES .................................................................................... 8-18

8.1 CREATE...DOES>

The Forth word pair CREATE...DOES> are used to define "defining words", that is, words that can define new words. The unique thing about defining words is that at the time they are defined the run-time behavior is specified for all future words that may be defined using this defining word. We will illustrate the use of CREATE...DOES> by the following definition of the defining word 'table'. (You will need to FLOAD Lesson7 before FLOADing Lesson8.)

comment;

: table ( list n +++ )

CREATE

0 DO

LOOP

DOES> ( ix -- c )

+ C@ ;

\ This word can be used to define the new word "junk" as follows:

3 15 7 2 4 table junk

comment:

When the word 'table' is executed, the Forth words between CREATE and DOES> in the definition of 'table' are executed. This will cause the word 'junk' to be added to the dictionary with the following values stored in the pfa of 'junk'.

junk

______________ |

CFA | CALL ^DOES | <------|

|-------------------|

PFA | 2 | ix = 0

|--------------------|

| 7 | ix = 1

|--------------------|

| 15 | ix = 2

|--------------------|

| 3 | ix = 3

|--------------------|

Code Segment ?CS:

The code field of 'junk' contains a CALL instruction to machine code which will cause the Forth words following DOES> in the definition of 'table' to be executed. Because this is a CALL instruction, the PFA of 'junk' will be on the stack when these Forth instructions are executed. Thus, when the word 'junk' is executed with an index ix on the stack, this index will be added to the PFA and then C@ will fetch the byte at that location. For example,

2 junk .

will print 15.

The way CREATE...DOES> works is as follows. When the word 'table' is defined it produces the following dictionary structure.

table

_____________ |

CFA | JMP NEST | <------|

|---------------------| _________

PFA | LSO1 | ----- +XSEG -------> | CREATE | ES:0

|---------------------| |-------------|

|--> ^DOES |CALL DODOES | <-------| | (LIT) |

| |---------------------| | |-------------|

| | LSO2 |----| | | 0 |

| |---------------------| | | |-------------|

| Code Segment ?CS: | | | (DO) |

| | | |-------------|

| | | |-----| 16 |

| | | | |-------------|

| | | | |->| C, | ES:10

| | | | | |-------------|

| | | | | |-------------|

| | | | |--| 10 |

| | | | |--------------|

| | | |-->| (;CODE) | ES:16

| | | |--------------|

| | |----------------- | ^DOES |

| | |--------------|

| |

| | |--------------|

| |---+XSEG--------> | + |

| |---------------|

| | C@ |

| |---------------|

| | UNNEST |

| |---------------|

| List Segment XSEG

| Typing 3 15 7 2 4 table junk

| will produce the following entry in the dictionary.

| junk

| ______________ |

|------- CFA | CALL ^DOES | <------|

|-------------------|

PFA | 2 | ix = 0

|-------------------|

| 7 | ix = 1

|-------------------|

| 15 | ix = 2

|-------------------|

| 3 | ix = 3

|-------------------|

Code Segment ?CS:

Note that the code field of 'junk' contains a CALL instruction to the instruction CALL DODOES following the PFA of 'table'. (This CALL ^DOES instruction in inserted into the code field of 'junk' when (;CODE) is executed in the list segment of 'table'). This has two effects. First, it puts the PFA of 'junk' on the stack, and second it executes the statement CALL DODOES which executes the Forth words whose CFAs are in the list segment pointed to by LSO2. These are just the statements that were defined following DOES> in the definition of 'table'. It is important to note that these same Forth words will be executed each time ANY word defined by 'table' is executed. This is a very powerful feature that we will exploit in the following sections to define various types of jump tables.

8.2 A SIMPLE JUMP TABLE

As an example of using a defining word, suppose you want to create a jump table called 'do.key' of the following form:

do.key

______________ |

CFA | CODE | <------|

|--------------------|

PFA | 5 |

|--------------------|

| 0word | n = 0

|--------------------|

| 1word | n = 1

|--------------------|

| 2word | n = 2

|--------------------|

| 3word | n = 3

|--------------------|

| 4word | n = 4

|--------------------|

Code Segment ?CS:

This might be used, for example, if you had a keypad with five keys labeled 0 - 5 which returned the values 0 - 5 on the stack when the corresponding key was pressed. You want to execute the Forth words 0word, 1word, ... , 4word when the corresponding key is pressed. The CFAs of these words are to be stored in the jump table.

We will define a defining word called JUMP.TABLE that can be used to produce 'do.key' or any other similar jump table. To produce 'do.key' we would type

5 JUMP.TABLE do.key

0word

1word

2word

3word

4word

The following definition of JUMP.TABLE will do the job:

comment;

: JUMP.TABLE ( n +++ )

CREATE

DUP ,

0 ?DO

' ,

LOOP

DOES> ( n pfa -- )

SWAP 1+ SWAP \ n+1 pfa

2DUP @ > \ n+1 pfa (n+1)>nmax

2DROP

ELSE

SWAP \ pfa n+1

2* + \ addr = pfa + 2(n+1)

PERFORM

THEN ;

comment:

In this definition the word PERFORM will execute the word whose CFA is stored at the address on top of the stack.

In the DO loop following CREATE the words ' , (tick comma) are used to store in the jump table the CFAs of the words listed after executing JUMP.TABLE do.key.

8.3 JUMP TABLE WITH ARBITRARY STACK VALUES

A limitation of the jump table described in the previous section is that the index into the table must be consecutive integers starting at zero. Often the value one knows is an ASCII code corresponding to a key that has been pressed. A more general jump table would involve a key value (e.g. an ASCII code) plus a CFA value for each entry as shown in the following table.

do.key

______________ |

CFA | CODE | <------|

|------------------|

PFA | 3 |

|------------------|

| 8 |

|------------------|

| bkspace |

|------------------|

| 17 |

|------------------|

| quit |

|------------------|

| 27 |

|------------------|

| escape |

|------------------|

| chrout |

|------------------|

Code Segment ?CS:

This table might be used in an editor where the ASCII code 8 would cause the Forth word 'bkspace' to be executed, the ASCII code 17 (control-Q) would cause the word 'quit' to be executed and the ASCII code 27 would cause the word 'escape' to be executed. The default word 'chrout' would be executed if no match was found in the jump table. This word might display the character on the screen. The 3 at the PFA location is the number of ASCII code - CFA pairs. To make this table you would use the defining word MAKE.TABLE as follows:

MAKE.TABLE do.key

8 bkspace

17 quit

27 escape

-1 chrout

A definition of MAKE.TABLE that will do this is as follows:

comment;

: MAKE.TABLE ( +++ )

CREATE

HERE 0 , 0 \ pfa 0

BEGIN

BL WORD NUMBER DROP \ pfa 0 n

DUP 1+ \ pfa 0 n n+1

WHILE \ pfa 0 n

, ' , \ pfa 0

1+ \ pfa cnt

REPEAT

DROP ' , \ pfa cnt

SWAP !

DOES> ( n pfa -- )

DUP 2+ \ n pfa pfa+2

SWAP @ \ n pfa+2 cnt

0 DO \ n code.addr

2DUP @ = \ n addr (n=code)

IF \ n addr

NIP 2+ LEAVE \ -> CFA

THEN

4 + \ n addr

LOOP

PERFORM ; ( Note: Default word has n on stack )

comment:

Note that a -1 is used to identify the default word. The DUP 1+ before the WHILE statement will cause this -1 to become 0 when the default word is reached and exit the BEGIN...WHILE...REPEAT loop. When 'do.key' is executed with an ASCII code on the stack, the DOES> part of the above definition is executed which will execute either the CFA of an ASCII code match or the default word. Note that if the default word is executed, the ASCII code will still be on the stack so that it can be displayed on the screen.

8.4 JUMP TABLE WITH FORTH WORDS

A disadvantage of using the defining word MAKE.TABLE in the previous section is that the value of the ASCII code must be known when making the table. It would be convenient to be able to use the Forth words ASCII and CONTROL to find these ASCII codes.

For example,

ASCII A

will return the value 65 (hex 41) on the stack. Similarly,

CONTROL Q

will return the value 17 (hex 11) on the stack. It would also be nice to be able in include parentheses comments when making the jump table. This is not allowed when using MAKE.TABLE. We will define a new defining word called EXEC.TABLE that will allow us to make the same jump table as shown in the previous section

by typing

EXEC.TABLE do.key

CONTROL H | bkspace ( backspace key )

CONTROL Q | quit ( quit to DOS )

HEX 2B | escape DECIMAL

DEFAULT| chrout

The definition of the word EXEC.TABLE that will do this is as

follows:

comment;

: EXEC.TABLE ( +++ )

CREATE

HERE 0 , \ pfa

DOES> ( n pfa -- )

DUP 2+ \ n pfa pfa+2

SWAP @ \ n pfa+2 cnt

0 DO \ n code.addr

2DUP @ = \ n addr (n=code)

IF \ n addr

NIP 2+ LEAVE \ -> CFA

THEN

4 + \ n addr

LOOP

PERFORM ; ( Note: Default word has n on stack )

comment:

Note that the DOES> part of this definition is the same as that in the definition of MAKE.TABLE. The CREATE part, however, is much simpler. It simply stores a zero in the count field at the PFA of the defined word (do.key) and leaves this PFA value on the stack. The program then returns to Forth and will exectute the Forth word CONTROL H. This will leave the value 8 on the stack. Thus, at this point the stack contains the values PFA 8.

The vertical bar | is a Forth word with the following definition:

comment;

: | ( addr n -- addr )

, ' , \ store n and CFA in table

1 OVER +! ; \ increment count at PFA

comment:

Note the the first line , ' , (comma-tick-comma) will comma the value of n (the ASCII code) into the table being created and then the tick (') will get the CFA of the Forth word following the vertical bar | and comma it into the table. Any other Forth words on the same line such as ( or DECIMAL will just be executed.

The word DEFAULT| is defined as follows:

comment;

: DEFAULT| ( addr -- )

DROP ' , ;

comment:

It just drops the PFA, gets the CFA of the default word (chrout) and commas it into the jump table.

8.5 POP-UP MENUS

This section will use the defining word EXEC.TABLE to define the action to take in response to various key pressings in pop-up menus. The words defined in this section can be used to produce a nice menu-driven program.

The following key ASCII codes are useful to have on hand:

comment;

200 CONSTANT 'up

208 CONSTANT 'down

203 CONSTANT 'left

205 CONSTANT 'right

199 CONSTANT 'home

207 CONSTANT 'end

201 CONSTANT 'pg.up

209 CONSTANT 'pg.dn

210 CONSTANT 'ins

211 CONSTANT 'del

8 CONSTANT 'bksp

9 CONSTANT 'tab

13 CONSTANT 'enter

27 CONSTANT 'esc

187 CONSTANT 'f1

188 CONSTANT 'f2

189 CONSTANT 'f3

190 CONSTANT 'f4

191 CONSTANT 'f5

192 CONSTANT 'f6

193 CONSTANT 'f7

194 CONSTANT 'f8

195 CONSTANT 'f9

196 CONSTANT 'f10

\ The following common variables are used for each menu:

VARIABLE row_start \ row# of first menu item

VARIABLE col_start \ col# of first char in first menu item

VARIABLE row_select \ row# of selected item

VARIABLE no_items \ no. of menu items

PREFIX

\ Read the character and attribute at the current cursor position

CODE ?char/attr ( -- attr char )

MOV BH, # 0

MOV AH, # 8

INT 16 \ read char/attr

MOV BL, AH

MOV BH, # 0

AND AH, # 0

PUSH BX

PUSH AX

END-CODE

\ Write the character and attribute at the current cursor position

CODE .char/attr ( attr char -- )

POP AX

POP BX

MOV AH, # 9

MOV CX, # 1

MOV BH, # 0

INT 16 \ write char/attr

END-CODE

\ Display n character/attribute pairs

CODE .n.chars ( n attr char -- )

POP AX

POP BX

POP CX

MOV AH, # 9

MOV BH, # 0

INT 16 \ write n chars

END-CODE

\ Get the current video mode

CODE get.vmode ( -- n )

MOV AH, # 15

INT 16 \ current video state

MOV AH, # 0

PUSH AX

END-CODE

: UNUSED ;

\ Increment the cursor

: inc.curs ( -- )

IBM-AT? SWAP 1+ SWAP AT ;

\ Plot character with the opposite attribute

: .char.bar ( attr char -- )

SWAP DUP 2/ 2/ 2/ 2/ 7 AND \ swap foreground

SWAP 7 AND 8* 2* OR \ and background

SWAP .char/attr ;

: togatt ( -- )

?char/attr \ toggle attribute of char

.char.bar ; \ at current cursor location

: invatt ( -- ) \ toggle attribute of word

BEGIN

?char/attr DUP 32 = NOT

WHILE .char.bar inc.curs

REPEAT 2DROP ;

: invline ( -- ) \ invert line of text

BEGIN

invatt \ invert word

togatt \ invert blank

inc.curs

?char/attr \ do until 2 blanks

NIP

32 =

UNTIL ;

: movcur ( -- ) \ move cursor to selected row \ double space

col_start @ row_select @

2* row_start @ + AT ;

: inv.first.chars ( -- )

no_items @ 0 DO

I row_select !

movcur togatt

LOOP ;

: select.first.item ( -- )

0 row_select !

movcur invline ;

: inv.field ( n -- )

movcur \ invert current line

invline

row_select ! \ invert line n

movcur

invline ;

\ The up and down cursor keys will change the selected item.

: down.curs ( -- )

movcur

invline

row_select @ 1+ DUP no_items @ =

DROP 0

THEN

row_select !

movcur

invline ;

: up.curs ( -- )

movcur

invline

row_select @ 1- DUP 0<

DROP no_items @ 1-

THEN

row_select !

movcur

invline ;

\ Every defined menu has the following values stored in its

\ parameter field

\ The following constants are the offsets into the parameter field:

0 CONSTANT [upper.left.col]