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