1: \ TOOLS.FS Toolkit extentions 2may93jaw
2:
3: \ Copyright (C) 1995,1998,1999,2001,2003,2006 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., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
20:
21: \ May be cross-compiled
22:
23: require ./io.fs \ type ...
24: require ./nio.fs \ . <# ...
25: require ./int.fs \ wordlist-id ..
26:
27: hex
28:
29: \ .S CORE / CORE EXT 9may93jaw
30:
31: variable maxdepth-.s \ gforth maxdepth-dot-s
32: \G A variable containing 9 by default. @code{.s} and @code{f.s}
33: \G display at most that many stack items.
34: 9 maxdepth-.s !
35:
36: : .s ( -- ) \ tools dot-s
37: \G Display the number of items on the data stack, followed by a list
38: \G of the items (but not more than specified by @code{maxdepth-.s};
39: \G TOS is the right-most item.
40: ." <" depth 0 .r ." > "
41: depth 0 max maxdepth-.s @ min
42: dup 0
43: ?do
44: dup i - pick .
45: loop
46: drop ;
47:
48: \ DUMP 2may93jaw - 9may93jaw 06jul93py
49: \ looks very nice, I know
50:
51: Variable /dump
52:
53: : .4 ( addr -- addr' )
54: 3 FOR -1 /dump +! /dump @ 0<
55: IF ." " ELSE dup c@ 0 <<# # # #> type #>> space THEN
56: char+ NEXT ;
57: : .chars ( addr -- )
58: /dump @ bounds
59: ?DO I c@ dup 7f bl within
60: IF drop [char] . THEN emit
61: LOOP ;
62:
63: : .line ( addr -- )
64: dup .4 space .4 ." - " .4 space .4 drop 10 /dump +! space .chars ;
65:
66: : dump ( addr u -- ) \ tools dump
67: \G Display @var{u} lines of memory starting at address @var{addr}. Each line
68: \G displays the contents of 16 bytes. When Gforth is running under
69: \G an operating system you may get @file{Invalid memory address} errors
70: \G if you attempt to access arbitrary locations.
71: cr base @ >r hex \ save base on return stack
72: 0 ?DO I' I - 10 min /dump !
73: dup 8 u.r ." : " dup .line cr 10 +
74: 10 +LOOP
75: drop r> base ! ;
76:
77: \ ? 17may93jaw
78:
79: : ? ( a-addr -- ) \ tools question
80: \G Display the contents of address @var{a-addr} in the current number base.
81: @ . ;
82:
83: \ words visible in roots 14may93py
84:
85: include ./../termsize.fs
86:
87: : wordlist-words ( wid -- ) \ gforth
88: \G Display the contents of the wordlist wid.
89: [ has? ec 0= [IF] ] wordlist-id [ [THEN] ]
90: 0 swap cr
91: BEGIN
92: @ dup
93: WHILE
94: 2dup name>string nip 2 + dup >r +
95: cols >=
96: IF
97: cr nip 0 swap
98: THEN
99: dup name>string type space r> rot + swap
100: REPEAT
101: 2drop ;
102:
103: : words
104: \G ** this will not get annotated. See other defn in search.fs .. **
105: \G It does not work to use "wordset-" prefix since this file is glossed
106: \G by cross.fs which doesn't have the same functionalty as makedoc.fs
107: [ has? ec 0= [IF] ] context @ [ [ELSE] ] forth-wordlist [ [THEN] ]
108: wordlist-words ;
109:
110: ' words alias vlist ( -- ) \ gforth
111: \g Old (pre-Forth-83) name for @code{WORDS}.
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>