\ EXECUTE en EVALUATE

\ Artikel in Forth Dimensions of BYTE magazin,
\ ca. 30 jaar geleden, gedateerd: 1 april.

: GOTO   >IN @
        BL-WORD FIND
        IF NIP EXECUTE EXIT
        THEN DROP
        >IN ! ;
: GOTO   BL-WORD COUNT EVALUATE ;
: GOTO   ' EXECUTE ;

\ ----- EVALUATE -----

\ Macro's

: ?EXIT if exit then ;          \ Gaat niet werken
: ?EXIT postpone if
        postpone exit
        postpone then ; immediate
: ?EXIT s" if exit then" evaluate ; immediate

\ Teller op de return stack
: R1+   r> 1+ >r ;              \ Gaat niet werken
: R1+   postpone r>
        postpone 1+
        postpone >r ; immediate
: R1+   s" r> 1+ >r" evaluate ; immediate

----- EXECUTE -----

\ KEY KEY? EMIT turn-key programma zijn "gevectord" via
\ de value's 'KEY 'KEY? 'EMIT APP

(*
0 value #NAMES
: ALLWORDS ( -- ) 0 to #names
    hor if cr then
    [ hot 8 cells bounds ] 2literal
    do i @
        begin
            dup lfa>n ( NFA )

            count 1F and
            type incr #names
            8 hor 7 and - spaces
            hx 40 hor < if cr then

            @ ( lnk@ )
            dup 0=
        until drop
        cell
    +loop #names ?dup if (.) 0 .r then ;
*)

16 varianten van WORDS in noForth t

' true value YES?
0 value #NAMES
: ()WORDS ( xt -- ) to yes? 0 to #names
    hor if cr then
    [ hot 8 cells bounds ] 2literal
    do i @
        begin
            dup lfa>n ( NFA )
            dup yes? execute
            if dup 
                count hx 1F and
                type incr #names
                8 hor 7 and - spaces
                hx 40 hor < if cr then
            then drop
            @ ( lnk@ )
            dup 0=
        until drop
        cell
    +loop #names ?dup if (.) 0 .r then ;

\ 1 alles en niets
: ALLWORDS ( -- ) ['] 0<> ()words ;
: NOWORDS ( -- ) ['] 0= ()words ;

\ 2 immediate
    : NFA> ( nfa -- cfa ) count hx 1F and + aligned ;
    :noname ( nfa -- 0|80 ) c@ hx 80 and ; to yes?
: IMMWORDS ( -- ) [ yes? ] literal ()words ;

\ 3 naamlengte
    0 value THIS
    :noname ( nfa -- flag ) c@ hx 1F and this = ; to yes?
: LENWORDS ( len -- ) to this [ yes? ] literal ()words ;

\ 4 vocabulary
    :noname ( nfa -- flag ) 1- c@ hx 7F and this = ; to yes?
: VOCWORDS ( voc# -- ) to this [ yes? ] literal ()words ;

    :noname ( nfa -- flag ) 1- c@ hx 80 < ; to yes?
: REDEFWORDS ( -- ) [ yes? ] literal ()words ;

\ 5 beginletter
    :noname ( nfa -- flag ) 1+ c@ this = ; to yes?
: CHWORDS ( ch -- ) upc to this [ yes? ] literal ()words ;
: ALFAWORDS ( -- ) hx 7f ch z 1+ ch a ch !
                   2 for do i chwords loop next ;

\ 6 character in de naam
    :noname ( nfa -- flag ) count hx 1F and bounds this scan <> ; to yes?
: WITHWORDS ( ch -- ) upc to this [ yes? ] literal ()words ;

\ 7 woorden voor en na 'adr'
    :noname ( nfa -- flag ) this < ; to yes?
: BEFOREWORDS ( adr -- ) to this [ yes? ] literal ()words ;

    :noname ( nfa -- flag ) this > ; to yes?
: AFTERWORDS ( adr -- ) to this [ yes? ] literal ()words ;

\ 8 woordsoorten
    :noname ( nfa -- flag ) nfa> @+ = ; to yes?
: CODEWORDS ( -- ) [ yes? ] literal ()words ;

    :noname ( -- flag ) nfa> @ this = ; to yes?
: SIMILWORDS ( xt -- ) @ to this [ yes? ] literal ()words ;

    :noname ( -- flag ) nfa> @+ > ; to yes?
: NORMWORDS ( -- ) [ yes? ] literal ()words ;

    :noname ( nfa -- flag ) nfa> @+ < ; to yes?
: QUIRKWORDS ( -- ) [ yes? ] literal ()words ;

\ 9 enzovoort...
    :noname ( -- flag ) count swap c@ xor 7 and this = ; to yes?
: THREADWORDS ( nr -- ) to this [ yes? ] literal ()words ;

Overzicht

ALLWORDS    ( -- )          \ Alle woorden
NOWORDS     ( -- )          \ Geen enkel woord
IMMWORDS    ( -- )          \ Immediate woorden
LENWORDS    ( len -- )      \ Woorden met namen van 'len' tekens
VOCWORDS    ( voc# -- )     \ Woorden in vocabulary nr 'voc#'
REDEFWORDS  ( -- )          \ Namen die niet uniek zijn
CHWORDS     ( ch1 -- )      \ Woorden met namen die beginnen met 'ch1'
ALFAWORDS   ( -- )          \ Alle woorden alfabetisch op 1e letter
WITHWORDS   ( ch -- )       \ Woorden met 'ch' in de naam
BEFOREWORDS ( adr -- )      \ Voor 'adr' gecompileerde woorden
AFTERWORDS  ( adr -- )      \ Na 'adr' gecompileerde woorden
CODEWORDS   ( -- )          \ Gewone assembler woorden (primitieven)
SIMILWORDS  ( xt -- )       \ Woorden met dezelfde doer
NORMWORDS   ( -- )          \ Normale forthwoorden
QUIRKWORDS  ( -- )          \ Afwijkende woorden, zoals kangoeroes
THREADWORDS ( thread# -- )  \ Woorden in de draad 'thread#'