version 1.12, 2002/02/04 21:25:18
|
version 1.30, 2012/12/31 15:25:19
|
Line 1
|
Line 1
|
\ Structural Conditionals 12dec92py |
\ Structural Conditionals 12dec92py |
|
|
\ Copyright (C) 1995,1996,1997,2000 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,2000,2003,2004,2007,2010,2011,2012 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
\ Gforth is free software; you can redistribute it and/or |
\ Gforth is free software; you can redistribute it and/or |
\ modify it under the terms of the GNU General Public License |
\ modify it under the terms of the GNU General Public License |
\ as published by the Free Software Foundation; either version 2 |
\ as published by the Free Software Foundation, either version 3 |
\ of the License, or (at your option) any later version. |
\ of the License, or (at your option) any later version. |
|
|
\ This program is distributed in the hope that it will be useful, |
\ This program is distributed in the hope that it will be useful, |
Line 15
|
Line 15
|
\ GNU General Public License for more details. |
\ GNU General Public License for more details. |
|
|
\ 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, see http://www.gnu.org/licenses/. |
\ 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 92 variable backedge-locals
|
Line 91 variable backedge-locals
|
rdrop |
rdrop |
dup cs-item? ; |
dup cs-item? ; |
|
|
|
: CS-DROP ( dest -- ) \ gforth |
|
dest? 2drop ; |
|
|
: cs-push-part ( -- list addr ) |
: cs-push-part ( -- list addr ) |
locals-list @ here ; |
locals-list @ here ; |
|
|
Line 105 variable backedge-locals
|
Line 107 variable backedge-locals
|
|
|
\ Structural Conditionals 12dec92py |
\ Structural Conditionals 12dec92py |
|
|
|
defer other-control-flow ( -- ) |
|
\ hook for control-flow stuff that's not handled by begin-like etc. |
|
|
: ?struc ( flag -- ) abort" unstructured " ; |
: ?struc ( flag -- ) abort" unstructured " ; |
: sys? ( sys -- ) dup 0= ?struc ; |
: sys? ( sys -- ) dup 0= ?struc ; |
: >mark ( -- orig ) |
: >mark ( -- orig ) |
cs-push-orig 0 , ; |
cs-push-orig 0 , other-control-flow ; |
: >resolve ( addr -- ) |
: >resolve ( addr -- ) |
here over - swap ! |
here swap ! |
basic-block-end ; |
basic-block-end ; |
: <resolve ( addr -- ) here - , ; |
: <resolve ( addr -- ) , ; |
|
|
: BUT |
: BUT |
1 cs-roll ; immediate restrict |
1 cs-roll ; immediate restrict |
Line 148 immediate restrict
|
Line 153 immediate restrict
|
\ people who have not been brought up with Forth (or who have been |
\ people who have not been brought up with Forth (or who have been |
\ brought up with fig-Forth). |
\ brought up with fig-Forth). |
|
|
: ELSE ( compilation orig1 -- orig2 ; run-time f -- ) \ core |
: ELSE ( compilation orig1 -- orig2 ; run-time -- ) \ core |
POSTPONE ahead |
POSTPONE ahead |
1 cs-roll |
1 cs-roll |
POSTPONE then ; immediate restrict |
POSTPONE then ; immediate restrict |
Line 182 IS until-like
|
Line 187 IS until-like
|
POSTPONE again |
POSTPONE again |
POSTPONE then ; immediate restrict |
POSTPONE then ; immediate restrict |
|
|
|
\ not clear if this should really go into Gforth's kernel... |
|
|
|
: CONTINUE ( dest-sys j*sys -- dest-sys j*sys ) \ gforth |
|
\g jump to the next outer BEGIN |
|
depth 0 ?DO I pick dest = IF |
|
I cs-item-size / cs-pick postpone AGAIN |
|
UNLOOP EXIT THEN |
|
cs-item-size +LOOP |
|
true abort" no BEGIN found" ; immediate restrict |
|
|
\ counted loops |
\ counted loops |
|
|
\ leave poses a little problem here |
\ leave poses a little problem here |
Line 222 Avariable leave-sp leave-stack 3 cells
|
Line 237 Avariable leave-sp leave-stack 3 cells
|
leave-sp ! ; |
leave-sp ! ; |
|
|
: DONE ( compilation orig -- ; run-time -- ) \ gforth |
: DONE ( compilation orig -- ; run-time -- ) \ gforth |
\ !! the original done had ( addr -- ) |
\g resolves all LEAVEs up to the compilaton orig (from a BEGIN) |
drop >r drop |
drop >r drop |
begin |
begin |
leave> |
leave> |