[gforth] / gforth / kernel / cloop.fs  

gforth: gforth/kernel/cloop.fs


1 : jwilke 1.1 \ Structural Conditionals, loops part 12dec92py
2 :    
3 : anton 1.5 \ Copyright (C) 1995,1996,1997,1999,2001 Free Software Foundation, Inc.
4 : jwilke 1.1
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 : anton 1.3 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
20 : jwilke 1.1
21 :     \ Structural Conditionals 12dec92py
22 :    
23 :     Variable leavings
24 :    
25 :     : (leave) here leavings @ , leavings ! ;
26 : jwilke 1.4 : LEAVE postpone branch (leave) ; immediate restrict
27 :     : ?LEAVE postpone 0= postpone ?branch (leave) ;
28 : jwilke 1.1 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 : jwilke 1.4 : DO postpone (do) here ; immediate restrict
37 : jwilke 1.1
38 : jwilke 1.4 : ?DO postpone (?do) (leave) here ;
39 : jwilke 1.1 immediate restrict
40 : jwilke 1.4 : FOR postpone (for) here ; immediate restrict
41 : jwilke 1.1
42 : jwilke 1.4 : loop] dup <resolve 2 cells - postpone done postpone unloop ;
43 : jwilke 1.1
44 : jwilke 1.4 : LOOP sys? postpone (loop) loop] ; immediate restrict
45 :     : +LOOP sys? postpone (+loop) loop] ; immediate restrict
46 :     : NEXT sys? postpone (next) loop] ; immediate restrict
47 : jwilke 1.1
48 : jwilke 1.4 : EXIT postpone ;s ; immediate restrict
49 : jwilke 1.1 : ?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