( This file is part of muFORTH: http://pages.nimblemachines.com/muforth
Copyright 2002-2008 David Frech. All rights reserved, and all wrongs
reversed. (See the file COPYRIGHT for details.)
( see.mu4 - Little tools for exploring the system.)
cr " Memory inspector " file[#
decimal
( 2002-mar-27. Converted to muforth.)
( 06-apr-1999. Changed to be smart about the addresses it prints, so that
dumps of target-compiled data will have meaningful addresses printed.)
( Memory inspection - dump, decompile, and, later, disassemble.)
( We defer these so that, later, the target compiler can possibly read from
the target, rather than local memory.)
( Let's make this less ARM/x86 specific.)
variable |cell
defer |c@
defer |@
( NOTE: These are `backwards' from the words defined in dforth.m4, which are
in turn `backwards' from what the rest of the world does. I'm still not sure
which I like better. The dforth.m4 style is another of CM's `innovations'
in cmForth.)
: |c@+ ( |a - |a+1 ch) dup 1+ swap |c@ ;
: |@+ ( |a - |a+|cell n) dup |cell @ + swap |@ ;
( Call, return.)
8 array inspect-stack
variable inspect-sp ( stack pointer) 0 inspect-sp !
: inspect-push ( old ea - old | ea) swap ( ea old)
inspect-sp @ dup 8 u< if
dup 1+ inspect-sp ! inspect-stack ! ^ then
( ea old sp) drop nip ;
: inspect-pop ( old - old | new)
inspect-sp @ dup if
1- dup inspect-sp ! inspect-stack @ nip ^ then drop ;
: .nesting inspect-sp @ ?for char > emit next space then ;
( For switching inspection modes.)
defer 1inspect
variable skip ( number of |cell's to skip)
: inspect! ( '1inspect default-skip) skip ! is 1inspect ;
( We're going to defer the heck out of these definitions so we can switch
between modes, and refine behavior later.)
( Now for the cmd keys.)
-: ( a ea - a -1) drop -1 ; ( discard & quit)
128 defarray seekeys
: key: -: \f char seekeys ! ;
( advance rounds down to nearest `skip'.)
: advance ( a ea skip - a') nip + ( advance) skip @ negate and ( round) 0 ;
-: ( skip+) skip @ advance ;
dup 32 seekeys !
dup char n seekeys !
dup #CR seekeys !
char j seekeys !
-: ( skip-) skip @ negate advance ;
dup char p seekeys !
dup #DEL seekeys !
dup char - seekeys !
dup char b seekeys !
char k seekeys !
( so we can skip by different amounts)
key: 1 ( a ea - a 0) drop 4 skip ! 0 ;
key: 4 ( a ea - a 0) drop 16 skip ! 0 ;
variable '1dump ( memory dump)
variable '1see ( decompiler)
variable '1dis ( disassembler) ' -1 '1dis ! ( safety)
key: d ( >dump) ( a ea - a f) drop '1dump @ 16 inspect! 0 ;
key: i ( >dis) ( a ea - a f) drop '1dis @ 4 inspect! 0 ;
key: s ( >see) ( a ea - a f) drop '1see @ 4 inspect! 0 ;
key: r ( return) ( new ea - new|old f) drop inspect-pop 0 ;
key: c ( call) ( old ea - old|ea f) inspect-push 0 ;
key: g ( go) ( old ea - ea f) nip 0 ;
: inspect-key ( a ea - a')
key dup 128 u< if seekeys @execute ^ then 2drop ( ea key) -1 ;
-: ( inspect loop) begin 1inspect inspect-key until ;
: inspect ( a '1inspect skip - a')
inspect! ( inspect-sp off)
radix @ push tty raw [ ] catch tty cooked pop radix ! ( re-) throw ;
( Byte and word conversion to ascii)
( These should right adjust to a field size.)
: .h8 hex <# # # #> type ;
: .o8 octal <# # # # #> type ;
: .hcell hex <# |cell @ 2* for # next #> type ;
: .addr cr ( -16 and) .hcell space ; ( round addr down 16)
: _addr cr |cell @ 2* 1+ spaces ;
comment
====================================================
How much horizontal room does each four bytes take?
First, with octal:
A \ 3 &
aa bb cc dd
000 000 000 000
ffff ffff
97ffee00
group*(digits + space between)
char: 4*(1 + 3) = 16
hex: 4*(2 + 2) = 16
octal: 4*(3 + 1) = 16 #field = 4
word16: 2*(4 + 4) = 16
word32: 1*(8 + 8) = 16
Then, without octal:
A \ 3 &
aa bb cc dd
ffff ffff
97ffee00
group*(digits + space between)
char: 4*(1 + 2) = 12
hex: 4*(2 + 1) = 12 #field = 3
word16: 2*(4 + 2) = 12
word32: 1*(8 + 4) = 12
====================================================
variable #field ( width of each byte, rendered)
( XXX This doesn't work if we put spacing before chars. Need to use
field-1,and put spacing after chars, since the addr it will be 1..16 rather
than 0..15!)
: .padding ( a - a)
.nesting dup 15 and dup #field @ * swap 2/ 2/ + spaces ;
: |_field| ( width) #field @ swap - spaces ;
: #bytes ( a - a #bytes) 16 over 15 and - ; ( 1 .. 16, end on multiple)
: .spacing ( a - a) dup 3 and 0= if space then ; ( every 4th add a space)
( >letter is pickier than >graphic, to make strings easier to read. This is
America-centric and not very international, which is unfortunate.)
: >letter ( ch - ch') dup letter? if ^ then drop bl ;
: >graphic ( ch - ch') dup graphic? if ^ then drop bl ;
defer .byte
: .char >graphic 1 |_field| emit ;
: .hex-byte 2 |_field| .h8 ;
: .oct-byte 3 |_field| .o8 ;
: .hex-cell #field @ 2 - |cell @ * spaces .hcell ;
: .bytes ( a) .padding #bytes for
|c@+ .byte .spacing next drop ;
: .cells ( a) dup _addr
|cell @ negate and .padding #bytes |cell @ / for
|@+ .hex-cell .spacing next drop ;
( .chars is first, and prints the address)
: .chars ( a) dup .addr ['] .char is .byte .bytes ;
: .hex-bytes ( a) dup _addr ['] .hex-byte is .byte .bytes ;
: .oct-bytes ( a) dup _addr ['] .oct-byte is .byte .bytes ;
defer .other ( hex-bytes or octal-bytes, depending on arch)
: .other! #field ! is .other ;
: octal-bytes ['] .oct-bytes 4 .other! ;
: hex-bytes ['] .hex-bytes 3 .other! ;
octal-bytes
: 1dump ( a - a ea)
dup .chars dup .hex-bytes dup .oct-bytes dup .cells
( a) dup |@ ( a ea) ;
' 1dump '1dump !
: du ( a - a') ['] 1dump 16 inspect ;
( Batch mode)
: dumps ( start limit)
inspect-sp off
swap begin 1dump drop 16 + 2dup u< until 2drop ;
comment broken_for_native_code
( See. a grotty little decompiler)
: >dict< ( a - f) ( within dict) [ ' unnest ] here within ;
: -named dup >dict< if >name type 0 ^ then -1 ;
( this word is UNUSED right now.)
: code? ( code - name T | body F)
forth begin @ dup while 2dup ( >code) = until
cell+ ( name) nip -1 ^ then ( 0) ;
: .ch ( n - n') dup "ff and >letter emit 8 rshift ;
: 1see ( a - a ea)
cr dup .a16 inspect-nesting
dup @ dup .w16 space dup .ch .ch .ch .ch drop space space
-named if ( 10 u.r) .w16 space then ( a)
dup |@ cell- ( code) ( a ea) ;
' 1see '1see !
: (see) ( a - a) ['] 1see 4 inspect ;
: see ' cell- ( code) (see) ;
broken_for_native_code
#]file
|