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                    <your name>


        Pressing any other key should produce a beep (CONTROL G EMIT).

comment;