gforth: gforth/Attic/tools.fs

1 :	anton	1.1	\ TOOLS.FS Toolkit extentions 2may93jaw
2 :
3 :			\ May be cross-compiled
4 :
5 :			hex
6 :
7 :			\ .S CORE / CORE EXT 9may93jaw
8 :
9 :	anton	1.2	variable maxdepth-.s
10 :			9 maxdepth-.s !
11 :
12 :	anton	1.1	: .s ( -- )
13 :	anton	1.2	." <" depth 0 .r ." > "
14 :			depth 0 max maxdepth-.s @ min
15 :			dup 0
16 :			?do
17 :			dup i - pick .
18 :			loop
19 :			drop ;
20 :	anton	1.1
21 :			\ DUMP 2may93jaw - 9may93jaw 06jul93py
22 :			\ looks very nice, I know
23 :
24 :			: .4 ( addr -- addr' )
25 :			3 FOR dup c@ 0 <# # # #> type space char+ NEXT ;
26 :			: .chars ( addr -- )
27 :			10 bounds DO I c@ dup 7f bl within
28 :			IF drop [char] . THEN emit LOOP ;
29 :
30 :			: .line ( addr -- )
31 :			dup .4 space .4 ." - " .4 space .4 drop space .chars ;
32 :
33 :			: dump ( addr u -- )
34 :			cr base @ >r hex \ save base on return stack
35 :			$F + $10 / \ calc number of lines
36 :			0 ?DO dup 8 u.r ." : " dup .line 10 + cr LOOP
37 :			drop r> base ! ;
38 :
39 :			\ ? 17may93jaw
40 :
41 :			: ? @ . ;
42 :
43 :			\ INCLUDE see.fs
44 :