| \ Structural Conditionals 12dec92py |
\ Structural Conditionals 12dec92py |
| |
|
| \ Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1999,2000,2003 Free Software Foundation, Inc. |
| |
|
| \ This file is part of Gforth. |
\ This file is part of Gforth. |
| |
|
| |
|
| \ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
| \ along with this program; if not, write to the Free Software |
\ along with this program; if not, write to the Free Software |
| \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
| |
|
| 0 constant defstart |
|
| |
|
| : ?struc ( flag -- ) abort" unstructured " ; |
|
| : sys? ( sys -- ) dup 0= ?struc ; |
|
| : >mark ( -- sys ) here 0 , ; |
|
| : >resolve ( sys -- ) here over - swap ! ; |
|
| : <resolve ( sys -- ) here - , ; |
|
| |
|
| : BUT sys? swap ; immediate restrict |
|
| : YET sys? dup ; immediate restrict |
|
| |
|
| \ Structural Conditionals 12dec92py |
|
| |
|
| : AHEAD compile branch >mark ; immediate restrict |
|
| : IF compile ?branch >mark ; immediate restrict |
|
| : THEN sys? dup @ ?struc >resolve ; immediate restrict |
|
| : ELSE sys? compile AHEAD swap compile THEN ; |
|
| immediate restrict |
|
| |
|
| ' THEN Alias ENDIF immediate restrict |
|
| |
|
| : BEGIN here ; immediate restrict |
|
| : WHILE sys? compile IF swap ; immediate restrict |
|
| : AGAIN sys? compile branch <resolve ; immediate restrict |
|
| : UNTIL sys? compile ?branch <resolve ; immediate restrict |
|
| : REPEAT over 0= ?struc compile AGAIN compile THEN ; |
|
| immediate restrict |
|
| |
|
| \ Structural Conditionals 12dec92py |
|
| |
|
| Variable leavings |
|
| |
|
| : (leave) here leavings @ , leavings ! ; |
|
| : LEAVE compile branch (leave) ; immediate restrict |
|
| : ?LEAVE compile 0= compile ?branch (leave) ; |
|
| immediate restrict |
|
| |
|
| : DONE ( addr -- ) leavings @ |
|
| BEGIN 2dup u<= WHILE dup @ swap >resolve REPEAT |
|
| leavings ! drop ; immediate restrict |
|
| |
|
| \ Structural Conditionals 12dec92py |
|
| |
|
| : DO compile (do) here ; immediate restrict |
|
| |
|
| : ?DO compile (?do) (leave) here ; |
|
| immediate restrict |
|
| : FOR compile (for) here ; immediate restrict |
|
| |
|
| : loop] dup <resolve 2 cells - compile done compile unloop ; |
|
| |
|
| : LOOP sys? compile (loop) loop] ; immediate restrict |
|
| : +LOOP sys? compile (+loop) loop] ; immediate restrict |
|
| : NEXT sys? compile (next) loop] ; immediate restrict |
|
| |
|
| : EXIT compile ;s ; immediate restrict |
|
| : ?EXIT postpone IF postpone EXIT postpone THEN ; immediate restrict |
|
| |
|
| |
include ./cbr.fs |
| |
include ./cloop.fs |
