[gforth] / gforth / kernel / tools.fs  

gforth: gforth/kernel/tools.fs


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

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help