=== Lesson 8 === \ 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 Pressing any other key should produce a beep (CONTROL G EMIT). comment;