[gforth] / gforth / kernel / toolsext.fs

gforth: gforth/kernel/toolsext.fs

File: [gforth] / gforth / kernel / toolsext.fs (download)
Revision: 1.2, Sun Jul 6 15:56:17 1997 UTC (15 years, 10 months ago) by jwilke
Branch: MAIN
Changes since 1.1: +1 -1 lines

Major change!
hash and search does not rely on each other.
context and voclink are now present in kernel.
words and marker can now defined without loading hash or search
marker went to extend.fs
word went to kernel/tools.fs
table goes to seperate file (at the moment)
glocals.fs and kernel/toolsext.fs are changed because of the change in the
wordlist-map-struct...
Attention: You can't recompile the code without new kernel-files!!!
jens

\ 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

: dummy ;  immediate
: >exec  >r ; restrict ( :-)
: scanIF   f83find  dup 0=  IF  drop ['] dummy >name  THEN  ;

Create [struct]-search    ' scanIF A,  ' (reveal) A,  ' drop A, ' drop A,
Create [struct]-voc       NIL A,       [struct]-search A,
                          NIL A,       NIL A,

: ?if  countif @ 0<
  IF  [ [struct]-voc 3 cells + ] ALiteral @ lookup !  THEN ;

UNLOCK  Tlast @ TNIL Tlast !  LOCK
\ last @  0 last !

: [IF]      1 countif +! ?if ;       immediate
: [THEN]   -1 countif +! ?if ;       immediate
: [ELSE]   postpone [THEN] postpone [IF] ;
                                     immediate
' [IF]   Alias [IFDEF]               immediate
' [IF]   Alias [IFUNDEF]             immediate
' [THEN] Alias [ENDIF]                immediate
' [IF]   Alias [BEGIN]               immediate
' [IF]   Alias [WHILE]               immediate
' [THEN] Alias [UNTIL]               immediate
' [THEN] Alias [AGAIN]               immediate
' [IF]   Alias [DO]                  immediate
' [IF]   Alias [?DO]                 immediate
' [THEN] Alias [LOOP]                immediate
' [THEN] Alias [+LOOP]               immediate
: [REPEAT]  postpone [AGAIN] postpone [THEN] ;
                                     immediate
' ( Alias (                          immediate
' \ Alias \                          immediate

UNLOCK Tlast @ swap Tlast ! LOCK
\ last @ swap last !
1 cells - [struct]-voc !

\ Interpretative Structuren                            30apr92py

: defined   bl word find nip 0<> ; immediate
: [IF] 0= IF  countif off
              lookup @ [ [struct]-voc 3 cells + ] ALiteral !
	      [struct]-voc lookup !
          THEN ;                                      immediate
: [IFDEF]   postpone defined    postpone [IF] ;       immediate
: [IFUNDEF] postpone defined 0= postpone [IF] ;       immediate
: [ELSE] 0 postpone [IF] ;                            immediate
: [THEN] ;                                            immediate
: [ENDIF] ;                                           immediate

\ Structs for interpreter                              28nov92py

User (i)

: [DO]  ( start end -- )  >in @ -rot
  DO   I (i) ! dup >r >in ! interpret r> swap +LOOP  drop ;
                                                      immediate
: [?DO] 2dup = IF 2drop postpone [ELSE] ELSE postpone [DO] THEN ;
                                                      immediate
: [+LOOP] ( n -- ) rdrop rdrop ;                      immediate
: [LOOP] ( -- ) 1 rdrop rdrop ;                       immediate
: [FOR] ( n -- )  0 swap postpone [DO] ;              immediate
: [NEXT] ( n -- ) -1 rdrop rdrop ;                    immediate
: [I] ( -- index ) (I) @ postpone Literal ;           immediate
: [BEGIN] >in @ >r BEGIN r@ >in ! interpret UNTIL rdrop ;
                                                      immediate
' [+LOOP]  Alias [UNTIL] immediate
: [REPEAT]  ( -- )  false rdrop rdrop ;               immediate
' [REPEAT] Alias [AGAIN] immediate
: [WHILE]   ( flag -- )
  0= IF   postpone [ELSE] true rdrop rdrop 1 countif +!  THEN ;
                                                      immediate

CVS Admin

gforth: gforth/kernel/toolsext.fs

ViewCVS and CVS Help