36 lines
1.5 KiB
Forth
36 lines
1.5 KiB
Forth
\ BRANCH and LOOP COMPILERS
|
|
|
|
\ branch offset computation operators
|
|
: AHEAD ( -- addr) HERE 0 , ;
|
|
: BACK ( addr -- ) HERE - , ;
|
|
: RESOLVE ( addr -- ) HERE OVER - SWAP ! ;
|
|
|
|
\ LEAVE stack is called L0. It is initialized by QUIT.
|
|
: >L ( x -- ) ( L: -- x ) 2 LP +! LP @ ! ;
|
|
: L> ( -- x ) ( L: x -- ) LP @ @ -2 LP +! ;
|
|
|
|
\ finite loop compilers
|
|
: DO ( -- ) POSTPONE <DO> HERE 0 >L 3 ; IMMEDIATE
|
|
: ?DO ( -- ) POSTPONE <?DO> HERE 0 >L 3 ; IMMEDIATE
|
|
: LEAVE ( -- ) ( L: -- addr )
|
|
POSTPONE UNLOOP POSTPONE BRANCH AHEAD >L ; IMMEDIATE
|
|
|
|
: RAKE ( -- ) ( L: 0 a1 a2 .. aN -- )
|
|
BEGIN L> ?DUP WHILE RESOLVE REPEAT ; IMMEDIATE
|
|
|
|
: LOOP ( -- ) 3 ?PAIRS POSTPONE <LOOP> BACK RAKE ; IMMEDIATE
|
|
: +LOOP ( -- ) 3 ?PAIRS POSTPONE <+LOOP> BACK RAKE ; IMMEDIATE
|
|
|
|
\ conditional branches
|
|
: IF ( ? -- ) POSTPONE ?BRANCH AHEAD 2 ; IMMEDIATE
|
|
: THEN ( -- ) ?COMP 2 ?PAIRS RESOLVE ; IMMEDIATE
|
|
: ELSE ( -- ) 2 ?PAIRS POSTPONE BRANCH AHEAD SWAP 2
|
|
POSTPONE THEN 2 ; IMMEDIATE
|
|
|
|
\ infinite loop compilers
|
|
: BEGIN ( -- addr n) ?COMP HERE 1 ; IMMEDIATE
|
|
: AGAIN ( -- ) 1 ?PAIRS POSTPONE BRANCH BACK ; IMMEDIATE
|
|
: UNTIL ( ? -- ) 1 ?PAIRS POSTPONE ?BRANCH BACK ; IMMEDIATE
|
|
: WHILE ( ? -- ) POSTPONE IF 2+ ; IMMEDIATE
|
|
: REPEAT ( -- ) 2>R POSTPONE AGAIN 2R> 2- POSTPONE THEN ; IMMEDIATE
|