File:  [gforth] / gforth / kernel / tools.fs
Revision 1.2: download - view: text, annotated - select for diffs
Sun Jul 6 15:56:17 1997 UTC (25 years, 5 months ago) by jwilke
Branches: MAIN
CVS tags: HEAD
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

    1: \ TOOLS.FS     Toolkit extentions                      2may93jaw
    2: 
    3: \ Copyright (C) 1995 Free Software Foundation, Inc.
    4: 
    5: \ This file is part of Gforth.
    6: 
    7: \ Gforth is free software; you can redistribute it and/or
    8: \ modify it under the terms of the GNU General Public License
    9: \ as published by the Free Software Foundation; either version 2
   10: \ of the License, or (at your option) any later version.
   11: 
   12: \ This program is distributed in the hope that it will be useful,
   13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: \ GNU General Public License for more details.
   16: 
   17: \ You should have received a copy of the GNU General Public License
   18: \ along with this program; if not, write to the Free Software
   19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   20: 
   21: \ May be cross-compiled
   22: 
   23: hex
   24: 
   25: \ .S            CORE / CORE EXT                         9may93jaw
   26: 
   27: variable maxdepth-.s
   28: 9 maxdepth-.s !
   29: 
   30: : .s ( -- )
   31:     ." <" depth 0 .r ." > "
   32:     depth 0 max maxdepth-.s @ min
   33:     dup 0
   34:     ?do
   35: 	dup i - pick .
   36:     loop
   37:     drop ;
   38: 
   39: \ DUMP                       2may93jaw - 9may93jaw    06jul93py
   40: \ looks very nice, I know
   41: 
   42: Variable /dump
   43: 
   44: : .4 ( addr -- addr' )
   45:     3 FOR  -1 /dump +!  /dump @ 0<
   46:         IF  ."    "  ELSE  dup c@ 0 <# # # #> type space  THEN
   47:     char+ NEXT ;
   48: : .chars ( addr -- )
   49:     /dump @ bounds
   50:     ?DO I c@ dup 7f bl within
   51: 	IF  drop [char] .  THEN  emit
   52:     LOOP ;
   53: 
   54: : .line ( addr -- )
   55:   dup .4 space .4 ." - " .4 space .4 drop  10 /dump +!  space .chars ;
   56: 
   57: : dump  ( addr u -- )
   58:     cr base @ >r hex        \ save base on return stack
   59:     0 ?DO  I' I - 10 min /dump !
   60: 	dup 8 u.r ." : " dup .line cr  10 +
   61: 	10 +LOOP
   62:     drop r> base ! ;
   63: 
   64: \ ?                                                     17may93jaw
   65: 
   66: : ? @ . ;
   67: 
   68: \ words visible in roots                               14may93py
   69: 
   70: include  termsize.fs
   71: 
   72: : words ( -- ) \ tools
   73:     cr 0 context @
   74:     BEGIN
   75: 	@ dup
   76:     WHILE
   77: 	2dup head>string nip 2 + dup >r +
   78: 	cols >=
   79: 	IF
   80: 	    cr nip 0 swap
   81: 	THEN
   82: 	dup head>string type space r> rot + swap
   83:     REPEAT
   84:     2drop ;
   85: 
   86: ' words alias vlist ( -- ) \ gforth
   87: \g Old (pre-Forth-83) name for @code{WORDS}.
   88: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>