Unterschiede

Hier werden die Unterschiede zwischen zwei Versionen angezeigt.

--- papierkorb:4th_lesson_8 [2025-08-16 19:10] – ↷ Seite von projects:4th_lesson_8 nach papierkorb:4th_lesson_8 verschoben mka
+++ papierkorb:4th_lesson_8 [Unbekanntes Datum] (aktuell) – gelöscht - Externe Bearbeitung (Unbekanntes Datum) 127.0.0.1
@@ Zeile 1: / Zeile 1: @@
-=== Lesson 8 ===
-<code>
-\       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
-.1  CREATE...DOES>                             8-2
-.2  A SIMPLE JUMP TABLE                        8-4
-.3  JUMP TABLE WITH ARBITRARY STACK VALUES     8-6
-.4  JUMP TABLE WITH FORTH WORDS                8-8
-.5  POP-UP MENUS                              8-10
-.6  EXERCISES                                 8-18
-.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
-DO
-                      C,
-                   LOOP
-                DOES>   ( ix -- c )
-                   + C@ ;
-\        This word can be used to define the new word "junk" as follows:
-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,
-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.
-.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
-JUMP.TABLE do.key
-word
-word
-word
-word
-word
-        The following definition of JUMP.TABLE will do the job:
-comment;
-        : JUMP.TABLE            ( n +++  )
-                CREATE
-                   DUP ,
-?DO
-                      ' ,
-                   LOOP
-                DOES>           ( n pfa -- )
-                   SWAP 1+ SWAP                 \ n+1 pfa
-DUP @ >                     \ n+1 pfa (n+1)>nmax
-                   IF
-DROP
-                   ELSE
-                      SWAP                      \ pfa n+1
-* +                      \ 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.
-.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
-bkspace
-quit
-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
-+                        \ pfa cnt
-                   REPEAT
-                   DROP ' ,                     \ pfa cnt
-                   SWAP !
-                DOES>           ( n pfa -- )
-                   DUP 2+                       \ n pfa pfa+2
-                   SWAP @                       \ n pfa+2 cnt
-DO                         \ n code.addr
-DUP @ =                  \ n addr (n=code)
-                      IF                        \ n addr
-                         NIP 2+ LEAVE           \ -> CFA
-                      THEN
-+                       \ 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.
-.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
-DO                         \ n code.addr
-DUP @ =                  \ n addr (n=code)
-                      IF                        \ n addr
-                         NIP 2+ LEAVE           \ -> CFA
-                      THEN
-+                       \ 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
-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.
-.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;
-     CONSTANT 'up
-     CONSTANT 'down
-     CONSTANT 'left
-     CONSTANT 'right
-     CONSTANT 'home
-     CONSTANT 'end
-     CONSTANT 'pg.up
-     CONSTANT 'pg.dn
-     CONSTANT 'ins
-     CONSTANT 'del
-       CONSTANT 'bksp
-       CONSTANT 'tab
-      CONSTANT 'enter
-      CONSTANT 'esc
-     CONSTANT 'f1
-     CONSTANT 'f2
-     CONSTANT 'f3
-     CONSTANT 'f4
-     CONSTANT 'f5
-     CONSTANT 'f6
-     CONSTANT 'f7
-     CONSTANT 'f8
-     CONSTANT 'f9
-     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
-=
-                UNTIL ;
-: movcur        ( -- )  \ move cursor to selected row   \ double space
-                col_start @ row_select @
-* row_start @ + AT ;
-: inv.first.chars       ( -- )
-                no_items @ 0 DO
-                     I row_select !
-                     movcur togatt
-                LOOP ;
-: select.first.item     ( -- )
-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:
-       CONSTANT  [upper.left.col]
-       CONSTANT  [upper.left.row]
-       CONSTANT  [width]
-       CONSTANT  [no.items]
-comment:
-        To define a menu of a certain size you would type
-              { 25 [upper.left.col]
-[upper.left.row]
-[width]
-[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
-/ 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
-, 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
-PICK [width] + @ 1- 2 PICK +    \ pfa ul.col ul.row br.col
-ROLL [no.items] + @ 2* 2 PICK + ;
-\       Define main menu
-              { 25 [upper.left.col]
-[upper.left.row]
-[width]
-[no.items] }
-              define.menu main.menu
-\       First menu  ------------------------
-              { 30 [upper.left.col]
-[upper.left.row]
-[width]
-[no.items] }
-              define.menu first.menu
-: first.menu.display    ( -- )
-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
-row_select !
-R> 2DROP
-R> 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]
-[upper.left.row]
-[width]
-[no.items] }
-              define.menu second.menu
-: second.menu.display    ( -- )
-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
-row_select !
-R> 2DROP
-R> 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:
--6  EXERCISES
-.1  Define a defining word named BASED. which will create number output
-        words for specific bases.  For example,
-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
-DUP HEX. .
-        would print out
-17 ok
-.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;
-</code>