|
( 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 |