Commit db4f61d3 authored by anton's avatar anton

bugfix <2007Oct22.192528@mips.complang.tuwien.ac.at> and cleanup

parent 1256af15
......@@ -123,6 +123,7 @@ exec_prefix = @exec_prefix@
srcdir = @srcdir@
bindir = @bindir@
#read-only architecture-independent files
datarootdir = @datarootdir@
datadir = @datadir@
#read-only architecture-dependent non-ascii files
libdir = @libdir@
......@@ -265,7 +266,7 @@ FORTH_SRC = $(KERN_SRC) $(GFORTH_FI_SRC) $(EC_SRC) \
unbuffer.fs wordsets.fs xwords.fs \
test/tester.fs test/ttester.fs \
test/coretest.fs test/postpone.fs test/dbltest.fs \
test/string.fs test/float.fs test/gforth.fs \
test/string.fs test/float.fs test/search.fs test/gforth.fs \
test/other.fs test/signals.fs test/checkans.fs \
test/primtest.fs test/coreext.fs test/deferred.fs \
test/coremore.fs test/gforth-nofast.fs test/libcc.fs \
......@@ -641,7 +642,7 @@ check: gforths gforth.fi
@echo "*** Check successful ***"
checkone test: gforth$(EC)$(EXE) gforth.fi engine/prim-s.i
$(FORTH) test/tester.fs test/coretest.fs test/postpone.fs test/dbltest.fs test/string.fs test/float.fs test/deferred.fs test/coreext.fs -e bye 2>&1 | tr -d '\015' | diff -c - $(srcdir)/test/coretest.out
$(FORTH) test/tester.fs test/coretest.fs test/postpone.fs test/dbltest.fs test/string.fs test/float.fs test/deferred.fs test/coreext.fs test/search.fs -e bye 2>&1 | tr -d '\015' | diff -c - $(srcdir)/test/coretest.out
$(FORTH) test/other.fs -e bye
$(FORTHS) test/signals.fs -e bye
$(FORTHS) test/coremore.fs test/gforth.fs -e bye 2>&1 | tr -d '\015' | diff -c - $(srcdir)/test/gforth.out
......
......@@ -23,6 +23,8 @@ require struct.fs
$10 Value maxvp \ current size of search order stack
$400 Value maxvp-limit \ upper limit for resizing search order stack
0 AValue vp \ will be initialized later (dynamic)
\ the first cell at vp contains the search order depth, the others
\ contain the wordlists, starting with the last-searched one.
: get-current ( -- wid ) \ search
\G @i{wid} is the identifier of the current compilation word list.
......@@ -96,13 +98,10 @@ Variable slowvoc 0 slowvoc !
: (vocfind) ( addr count wid -- nfa|false )
\ !! generalize this to be independent of vp
drop vp dup @ 1- cells over +
DO 2dup I 2@ over <>
IF (search-wordlist) dup
IF nip nip UNLOOP EXIT
THEN drop
ELSE drop 2drop THEN
[ -1 cells ] Literal +LOOP
drop 0 vp @ -DO ( addr count ) \ note that the loop does not reach 0
2dup vp i cells + @ (search-wordlist) dup if ( addr count nt )
nip nip unloop exit then
drop 1 -loop
2drop false ;
0 value locals-wordlist
......@@ -203,7 +202,9 @@ lookup ! \ our dictionary search order becomes the law ( -- )
THEN
dup check-maxvp
dup vp!
?dup IF 1- FOR vp cell+ I cells + ! NEXT THEN ;
0 swap -DO ( wid1 ... widi )
vp i cells + ! \ note that the loop does not reach 0
1 -loop ;
: seal ( -- ) \ gforth
\G Remove all word lists from the search order stack other than the word
......
\ test search order wordset partially
\ Copyright (C) 2007 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., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
require ./tester.fs
decimal
: test-set-order0 ( c-addr u -- n )
2>r get-order 2r> 0 set-order ['] evaluate catch dup if
nip nip then
>r set-order r> ;
: test-set-order1 ( c-addr u wid -- n )
2>r get-order 2r> forth-wordlist 1 set-order ['] evaluate catch dup if
nip nip then
>r set-order r> ;
{ s" order" test-set-order0 -> -13 }
{ s" 5e" test-set-order0 -> 0 5e }
{ s" root +" test-set-order1 -> -13 }
{ s" root forth" test-set-order1 -> 0 }
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment