$Header: /home/radek/cvs/forth-book/db-qf-moduly/ondo,v 1.4 2003/12/28 18:21:57 radek Exp $
Volně podle OnDoModule na webu Sleepless-Night Wiki
Modul ondo nabízí podobnou funkcionalitu jako case nebo cond..thens. Má ovšem čistší syntaxi a je lépe optimalizován v QuartusForthu.
Tabulka 17.9. Slova v modulu OnDo [1:2:7]
| slovo | zásobník | popis |
|---|---|---|
| on: | ( x "word" → x ) | porovnej TOS s hodnotou následujícího slova |
| or: | ( x "word" → x ) | je-li shoda, skoč na do:, jinak pokračuj srovnáním z dalším slovem |
| do: | ( "word" → ) | je-li shoda, vykonej následující slovo a potom exit; jina pokračuj |
Věta
on: SOME-VALUE do: SOME-WORD
je ekvivalentní větě
dup SOME-VALUE = if SOME-WORD exit then
Mezi on: a do: smí být libovolné množství
or: SOME-VALUE
Konstrukce on:..or:..do: neodstraňuje nic ze zásobníku.
Příklad 17.7. Příklad použití on:..do:
needs Events
needs ondo
: DoCtlSelect ( -- ) ... ;
: DoMenu ( -- ) ... ;
: DoPenDown ( -- ) ... ;
: dispatch-event ( ekey -- ekey )
on: ctlSelectEvent do: DoCtlSelect
on: menuEvent do: DoMenu
on: penDownEvent do: DoPenDown ;
: event-loop ( -- )
begin
ekey dispatch-event drop
again ;
Příklad 17.8. Modul ondo
\ ondo 2001/8/23 KDJ
\ Provides ON:..DO: construct.
\ Copyright 2001 Kristopher D. Johnson
\
\ WARRANTY ...
\
\ USAGE ...
\
\ Relies upon undocumented features
\ of Quartus Forth 1.2.x; may not
\ be compatible with future releases.
needs condthens
\ M68K opcodes
(hex) be7c constant cmp#,tos
(hex) 6600 constant bne.w
(hex) 6700 constant beq.w
\ Compile conditional branch,
\ leaving ORIG on stack for later
\ resolution by ELSE or THEN
: (bcc-orig) ( op → ) ( C: → orig )
cs, cshere 0 cs, ;
: (eval-word) ( "word" → i**x )
parse-word evaluate ;
: (on:) ( x "word" → x )
cmp#,tos cs,
postpone [ (eval-word) postpone ]
cs, ;
\ Compare top-of-stack with
\ value of following word
: on: ( x "word" → x )
postpone cond
(on:)
; immediate
\ If EQ, branch ahead to DO:,
\ else compare TOS with neot word
: or: ( x "word" → x )
beq.w (bcc-orig)
(on:)
; immediate
\ If EQ, jump to NAME, otherwise
\ branch over NAME
: do: ( "name" → )
bne.w (bcc-orig) >r
postpone thens
(eval-word)
postpone exit
r> postpone then
; immediate
\ drop do:
: ddo: ( "name" → )
bne.w (bcc-orig) >r
postpone thens
postpone drop
(eval-word)
postpone exit
r> postpone then
; immediate