version 1.5, 1995/01/30 18:47:56
|
version 1.9, 1997/02/06 21:23:06
|
Line 1
|
Line 1
|
\ Interpretative Structuren 16feb92py |
\ Interpretative Structuren 16feb92py |
|
|
|
\ Copyright (C) 1995 Free Software Foundation, Inc. |
|
|
|
\ This file is part of Gforth. |
|
|
|
\ Gforth is free software; you can redistribute it and/or |
|
\ modify it under the terms of the GNU General Public License |
|
\ as published by the Free Software Foundation; either version 2 |
|
\ of the License, or (at your option) any later version. |
|
|
|
\ This program is distributed in the hope that it will be useful, |
|
\ but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
\ GNU General Public License for more details. |
|
|
|
\ You should have received a copy of the GNU General Public License |
|
\ along with this program; if not, write to the Free Software |
|
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
|
|
|
|
Variable countif |
Variable countif |
|
|
: dummy ; immediate |
: dummy ; immediate |
Line 7 Variable countif
|
Line 26 Variable countif
|
: scanIF f83find dup 0= IF drop ['] dummy >name THEN ; |
: scanIF f83find dup 0= IF drop ['] dummy >name THEN ; |
|
|
Create [struct]-search ' scanIF A, ' (reveal) A, ' drop A, |
Create [struct]-search ' scanIF A, ' (reveal) A, ' drop A, |
Create [struct]-voc NIL A, G [struct]-search T A, |
Create [struct]-voc NIL A, [struct]-search A, |
NIL A, NIL A, |
NIL A, NIL A, |
|
|
: ?if countif @ 0< |
: ?if countif @ 0< |
IF [ [struct]-voc 3 cells + ] ALiteral @ lookup ! THEN ; |
IF [ [struct]-voc 3 cells + ] ALiteral @ lookup ! THEN ; |
|
|
UNLOCK Tlast @ NIL Tlast ! LOCK |
UNLOCK Tlast @ NIL Tlast ! LOCK |
|
\ last @ 0 last ! |
|
|
: [IF] 1 countif +! ?if ; immediate |
: [IF] 1 countif +! ?if ; immediate |
: [THEN] -1 countif +! ?if ; immediate |
: [THEN] -1 countif +! ?if ; immediate |
: [ELSE] postpone [THEN] r> >exec postpone [IF] ; |
: [ELSE] postpone [THEN] postpone [IF] ; |
immediate |
immediate |
' [IF] Alias [IFDEF] immediate |
' [IF] Alias [IFDEF] immediate |
' [IF] Alias [IFUNDEF] immediate |
' [IF] Alias [IFUNDEF] immediate |
Line 36 UNLOCK Tlast @ NIL Tlast ! LOCK
|
Line 56 UNLOCK Tlast @ NIL Tlast ! LOCK
|
' \ Alias \ immediate |
' \ Alias \ immediate |
|
|
UNLOCK Tlast @ swap Tlast ! LOCK |
UNLOCK Tlast @ swap Tlast ! LOCK |
1 cells - G [struct]-voc T ! |
\ last @ swap last ! |
|
1 cells - [struct]-voc ! |
|
|
\ Interpretative Structuren 30apr92py |
\ Interpretative Structuren 30apr92py |
|
|