\ Copyright (C) 2008 Stephan Becher
\
\ This file is part of StrongForth.f.
\
\ StrongForth.f 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.
\
\ StrongForth.f 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 StrongForth.f; if not, write to the Free Software
\ Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
\
\ Contact: stephan.becher@vr-web.de

\ Required ANS word sets:
\ TOOLS

\ Implemented word sets:
\ TOOLS

: WORDS ( -- )
  CONTEXT @ LAST PARSE-WORD LOCALS| COUNT ADDR |
  BEGIN DUP 0= INVERT
  WHILE COUNT
     IF DUP ADDR COUNT ROT NAME COMPARE 0= ELSE TRUE THEN
     IF CR DUP . THEN PREV
  REPEAT DROP ;

'HOST DUMP IMPORT DUMP ( ADDRESS UNSIGNED -- )

: DUMP ( ADDRESS -> SINGLE UNSIGNED -- )
  CELLS DUMP ;

: DUMP ( ADDRESS -> DOUBLE UNSIGNED -- )
  CELLS 2* DUMP ;

: DUMP ( CADDRESS UNSIGNED -- )
  CHARS DUMP ;

'HOST-PARSING SEE IMPORT SEE ( -- )

: [ELSE] ( -- )
  1 \ level \
  BEGIN
     BEGIN PARSE-WORD DUP
     WHILE OVER OVER " [IF]" COMPARE 0=
        IF DROP DROP 1+
        ELSE OVER OVER " [ELSE]" COMPARE 0=
           IF DROP DROP 1- DUP IF 1+ THEN
           ELSE " [THEN]" COMPARE 0= IF 1- THEN
           THEN
        THEN DUP 0= IF DROP EXIT THEN
     REPEAT DROP DROP REFILL 0=
  UNTIL DROP ; IMMEDIATE

: [IF] ( SINGLE -- )
  0= IF POSTPONE [ELSE] THEN ; IMMEDIATE

: [THEN] ( -- ) ; IMMEDIATE

: ? ( -- )
  POSTPONE @ POSTPONE . ; IMMEDIATE

VOCABULARY EDITOR

'HOST CS-PICK IMPORT CS-PICK ( ORIG/DEST UNSIGNED -- 1ST DEST )
'HOST CS-ROLL IMPORT CS-ROLL ( ORIG/DEST UNSIGNED -- ORIG/DEST )

GET-CURRENT ENVIRONMENT-WORDLIST SET-CURRENT
CREATE TOOLS TRUE ,
CREATE TOOLS-EXT TRUE ,
SET-CURRENT

\ EOF