[gforth] / gforth / kernel / cloop.fs  

gforth: gforth/kernel/cloop.fs


1 : jwilke 1.1 \ Structural Conditionals, loops part 12dec92py
2 :    
3 :     \ Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
4 :    
5 :     \ This file is part of Gforth.
6 :    
7 :     \ Gforth is free software; you can redistribute it and/or
8 :     \ modify it under the terms of the GNU General Public License
9 :     \ as published by the Free Software Foundation; either version 2
10 :     \ of the License, or (at your option) any later version.
11 :    
12 :     \ This program is distributed in the hope that it will be useful,
13 :     \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14 :     \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 :     \ GNU General Public License for more details.
16 :    
17 :     \ You should have received a copy of the GNU General Public License
18 :     \ along with this program; if not, write to the Free Software
19 :     \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20 :    
21 :     \ Structural Conditionals 12dec92py
22 :    
23 :     Variable leavings
24 :    
25 :     : (leave) here leavings @ , leavings ! ;
26 :     : LEAVE compile branch (leave) ; immediate restrict
27 :     : ?LEAVE compile 0= compile ?branch (leave) ;
28 :     immediate restrict
29 :    
30 :     : DONE ( addr -- ) leavings @
31 :     BEGIN 2dup u<= WHILE dup @ swap >resolve REPEAT
32 :     leavings ! drop ; immediate restrict
33 :    
34 :     \ Structural Conditionals 12dec92py
35 :    
36 :     : DO compile (do) here ; immediate restrict
37 :    
38 :     : ?DO compile (?do) (leave) here ;
39 :     immediate restrict
40 :     : FOR compile (for) here ; immediate restrict
41 :    
42 :     : loop] dup <resolve 2 cells - compile done compile unloop ;
43 :    
44 :     : LOOP sys? compile (loop) loop] ; immediate restrict
45 :     : +LOOP sys? compile (+loop) loop] ; immediate restrict
46 :     : NEXT sys? compile (next) loop] ; immediate restrict
47 :    
48 :     : EXIT compile ;s ; immediate restrict
49 :     : ?EXIT postpone IF postpone EXIT postpone THEN ; immediate restrict
50 :    

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help