\ 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'.
comment;
: table ( list n +++ )
CREATE
0 DO
C,
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
| | | || |-------|
| | | || |(LOOP) |
| | | || |-------|
| | | ||--| 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
IF
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 as
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
NEXT
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
NEXT
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
NEXT
END-CODE
\ Get the current video mode
CODE get.vmode ( -- n )
MOV AH, # 15
INT 16 \ current video state
MOV AH, # 0
PUSH AX
NEXT
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 @ =
IF
DROP 0
THEN
row_select !
movcur
invline ;
: up.curs ( -- )
movcur
invline
row_select @ 1- DUP 0<
IF
DROP no_items @ 1-
THEN
row_select !
movcur
invline ;
\ Every defined menu has the following values stored in its
\ parameter field
\ | upper.left.col | upper.left.row | width | no.items |
\ The following constants are the offsets into the parameter field:
0 CONSTANT [upper.left.col]
2 CONSTANT [upper.left.row]
4 CONSTANT [width]
6 CONSTANT [no.items]
comment:
To define a menu of a certain size you would type
{ 25 [upper.left.col]
15 [upper.left.row]
20 [width]
3 [no.items] }
define.menu menu1
The defining word "define.menu" is defined as follows:
comment;
: define.menu ( list n +++ )
CREATE
HERE 8 ALLOT SWAP \ list pfa n
2/ 0 DO \ v1 ix1 v2 ix2 v3 ix3 pfa
SWAP OVER + \ v1 ix1 v2 ix2 v3 pfa addr
ROT SWAP ! \ v1 ix1 v2 ix2 pfa
LOOP
DROP
DOES> ( pfa -- pfa )
DUP [upper.left.col] + @ 1+ col_start !
DUP [upper.left.row] + @ 1+ row_start !
DUP [no.items] + @ no_items ! ;
comment:
Note that this will define the word "menu1" with the values
25, 15, 20, and 3 associated with the size of the menu stored
in the parameter field. Recall from Lesson 7 that the brackets
{ ... } will leave the number of items between the brackets on
top of the stack. You will need to FLOAD LESSON7 before you
FLOAD LESSON8 in order to have the brackets { and } defined.
When the word "menu1" is executed the values in its parameter
field will be used to store values in col_start, row_start and
no_items appropriate for this particular menu.
comment;
\ This word prepares the stack for the F-PC word BOX&FILL.
\ See the file BOXTEXT.SEQ for a description of BOX&FILL.
: ul.br ( pfa -- ul.col ul.row br.col br.row )
DUP [upper.left.col] + @ \ pfa ul.col
OVER [upper.left.row] + @ \ pfa ul.col ul.row
2 PICK [width] + @ 1- 2 PICK + \ pfa ul.col ul.row br.col
3 ROLL [no.items] + @ 2* 2 PICK + ;
\ Define main menu
{ 25 [upper.left.col]
8 [upper.left.row]
20 [width]
3 [no.items] }
define.menu main.menu
\ First menu ------------------------
{ 30 [upper.left.col]
10 [upper.left.row]
20 [width]
2 [no.items] }
define.menu first.menu
: first.menu.display ( -- )
0 inv.field \ invert first item
SAVESCR \ save screen
first.menu \ get new coordinates
ul.br BOX&FILL \ draw box
." First sub1 item"
bcr bcr ." Second sub1 item"
inv.first.chars
select.first.item ;
: first.sub1 ;
: second.sub1 ;
: escape.first ( -- )
RESTSCR
main.menu DROP
0 row_select !
2R> 2DROP
2R> 2DROP
EXIT ;
: enttbl.first ( n -- )
EXEC:
first.sub1
second.sub1 ;
: enter.first ( -- )
row_select @ enttbl.first ;
EXEC.TABLE do.key.first
'up | up.curs
'down | down.curs
ASCII F | first.sub1
ASCII f | first.sub1
ASCII S | second.sub1
ASCII s | second.sub1
'esc | escape.first
CONTROL M | enter.first ( enter key - select item )
DEFAULT| UNUSED
: first.item ( -- )
first.menu.display
BEGIN
KEY do.key.first
AGAIN ;
\ Second menu ------------------------
{ 30 [upper.left.col]
12 [upper.left.row]
20 [width]
2 [no.items] }
define.menu second.menu
: second.menu.display ( -- )
1 inv.field \ invert second item
SAVESCR \ save screen
second.menu \ get new coordinates
ul.br BOX&FILL \ draw box
." First sub2 item"
bcr bcr ." Second sub2 item"
inv.first.chars
select.first.item ;
: first.sub2 ;
: second.sub2 ;
: escape.second ( -- )
RESTSCR
main.menu
1 row_select !
2R> 2DROP
2R> 2DROP
EXIT ;
: enttbl.second ( n -- )
EXEC:
first.sub2
second.sub2 ;
: enter.second ( -- )
row_select @ enttbl.second ;
EXEC.TABLE do.key.second
'up | up.curs
'down | down.curs
ASCII F | first.sub2
ASCII f | first.sub2
ASCII S | second.sub2
ASCII s | second.sub2
'esc | escape.second
CONTROL M | enter.second ( enter key - select item )
DEFAULT| UNUSED
: second.item ( -- )
second.menu.display
BEGIN
KEY do.key.second
AGAIN ;
\ Main menu --------------------
: main.menu.display ( -- )
DARK
main.menu \ get new coordinates
ul.br BOX&FILL \ draw box
." First item"
bcr bcr ." Second item"
bcr bcr ." Quit"
inv.first.chars
select.first.item
CURSOR-OFF ;
: quit.main ( -- )
CURSOR-ON DARK ABORT ;
: enttbl.main ( n -- )
EXEC:
first.item
second.item
quit.main ;
: enter.main ( -- )
row_select @ enttbl.main ;
EXEC.TABLE do.key.main
'up | up.curs
'down | down.curs
ASCII F | first.item
ASCII f | first.item
ASCII S | second.item
ASCII s | second.item
ASCII Q | quit.main
ASCII q | quit.main
CONTROL M | enter.main ( enter key - select item )
DEFAULT| UNUSED
: main ( -- )
main.menu.display
BEGIN
KEY do.key.main
AGAIN ;
comment:
8-6 EXERCISES
8.1 Define a defining word named BASED. which will create number output
words for specific bases. For example,
16 BASED. HEX.
would define HEX. to be a word which prints the top of the stack
in hex but does not permanently change BASE. That is, typing
DECIMAL
17 DUP HEX. .
would print out
11 17 ok
8.2 Use vectored execution (i.e. a jump table) in a Forth program
that will print the following messages in response to the
indicated key pressings:
Key pressed Message
F Forth is fun!
C Computers can compute
J Jump tables
N <your name>
Pressing any other key should produce a beep (CONTROL G EMIT).
comment;