version 1.6, 1999/05/10 13:58:05
|
version 1.10, 2000/09/23 15:47:09
|
Line 1
|
Line 1
|
\ Structural Conditionals 12dec92py |
\ Structural Conditionals 12dec92py |
|
|
\ Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,2000 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 16
|
Line 16
|
|
|
\ 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. |
|
|
here 0 , \ just a dummy, the real value of locals-list is patched into it in glocals.fs |
here 0 , \ just a dummy, the real value of locals-list is patched into it in glocals.fs |
AConstant locals-list \ acts like a variable that contains |
AConstant locals-list \ acts like a variable that contains |
Line 80 variable backedge-locals
|
Line 80 variable backedge-locals
|
|
|
3 constant cs-item-size |
3 constant cs-item-size |
|
|
: CS-PICK ( ... u -- ... destu ) \ tools-ext |
: CS-PICK ( ... u -- ... destu ) \ tools-ext c-s-pick |
1+ cs-item-size * 1- >r |
1+ cs-item-size * 1- >r |
r@ pick r@ pick r@ pick |
r@ pick r@ pick r@ pick |
rdrop |
rdrop |
dup non-orig? ; |
dup non-orig? ; |
|
|
: CS-ROLL ( destu/origu .. dest0/orig0 u -- .. dest0/orig0 destu/origu ) \ tools-ext |
: CS-ROLL ( destu/origu .. dest0/orig0 u -- .. dest0/orig0 destu/origu ) \ tools-ext c-s-roll |
1+ cs-item-size * 1- >r |
1+ cs-item-size * 1- >r |
r@ roll r@ roll r@ roll |
r@ roll r@ roll r@ roll |
rdrop |
rdrop |
Line 163 Defer again-like ( dest -- addr )
|
Line 163 Defer again-like ( dest -- addr )
|
: AGAIN ( compilation dest -- ; run-time -- ) \ core-ext |
: AGAIN ( compilation dest -- ; run-time -- ) \ core-ext |
dest? again-like POSTPONE branch <resolve ; immediate restrict |
dest? again-like POSTPONE branch <resolve ; immediate restrict |
|
|
Defer until-like |
Defer until-like ( list addr xt1 xt2 -- ) |
: until, ( list addr xt1 xt2 -- ) drop compile, <resolve drop ; |
:noname ( list addr xt1 xt2 -- ) |
' until, IS until-like |
drop compile, <resolve drop ; |
|
IS until-like |
|
|
: UNTIL ( compilation dest -- ; run-time f -- ) \ core |
: UNTIL ( compilation dest -- ; run-time f -- ) \ core |
dest? ['] ?branch ['] ?branch-lp+!# until-like ; immediate restrict |
dest? ['] ?branch ['] ?branch-lp+!# until-like ; immediate restrict |