Author: wmb Date: Mon Mar 19 20:46:09 2012 New Revision: 2898 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2898
Log: Colorized the decompiler output.
Modified: forth/kernel/kernel.fth forth/lib/decomp.fth
Modified: forth/kernel/kernel.fth ============================================================================== --- forth/kernel/kernel.fth Sat Mar 17 02:51:04 2012 (r2897) +++ forth/kernel/kernel.fth Mon Mar 19 20:46:09 2012 (r2898) @@ -369,12 +369,12 @@
: [""] \ word (s Compile-time: -- ) (s Run-time: -- pstr ) - compile ("s) safe-parse-word ", + compile (p") safe-parse-word ", ; immediate
\ Obsolete : ["] \ string" (s -- str ) - compile ("s) ," + compile (p") ," ; immediate
: \ \ rest-of-line (s -- ) \ skips rest of line @@ -383,7 +383,7 @@
: compile-pstring ( adr len -- ) state @ if - compile ("s) ", + compile (p") ", else switch-string "temp npack then @@ -636,7 +636,7 @@ if skipstr $abort else skipstr 2drop then ; : ?throw ( flag throw-code -- ) swap if throw else drop then ; -: ("s) (s -- str-addr ) skipstr ( addr len ) drop 1- ; +: (p") (s -- str-addr ) skipstr ( addr len ) drop 1- ;
nuser 'lastacf \ acf of latest definition : lastacf ( -- acf ) 'lastacf token@ ;
Modified: forth/lib/decomp.fth ============================================================================== --- forth/lib/decomp.fth Sat Mar 17 02:51:04 2012 (r2897) +++ forth/lib/decomp.fth Mon Mar 19 20:46:09 2012 (r2898) @@ -56,7 +56,7 @@ hidden definitions headerless \ Like ." but goes to a new line if needed. -: cr". ( adr len -- ) dup ?line type ; +: cr". ( adr len -- ) dup ?line magenta-letters type cancel ; : .." ( -- ) [compile] " compile cr". ; immediate
\ Positional case defining word @@ -280,28 +280,38 @@ dup immediate? if .." [compile] " then ;
-: put" (s -- ) ascii " emit space ; +: put" (s -- ) ascii " emit space ;
-: .cword (s ip -- ip' ) \ Display run-time word, e.g. (is) sans '()' - dup token@ ?cr ( ip acf ) - >name name>string ( ip adr len ) - swap 1+ swap 2 - type space ( ip ) \ Remove parentheses - ta1+ +: cword-name (s ip -- ip' $ name$ ) + dup token@ ( ip acf ) + >name name>string ( ip name$ ) + swap 1+ swap 2 - ( ip name$' ) \ Remove parentheses + rot ta1+ -rot ( ip' name$ ) + 2 pick count ( ip name$ $ ) + 2swap ( ip $ name$ ) +; +: .string-tail ( $ name$ -- ) + 2 pick over + 3 + ?line ( $ name$ ) \ Keep word and string on the same line + cr". space ( $ ) + red-letters type ( ) + .." "" " ( ) ; + +: pretty-n. ( n -- ) green-letters n. cancel ; +: pretty-. ( n -- ) green-letters . cancel ; + : .word ( ip -- ip' ) dup token@ check-[compile] ?cr .name ta1+ ; : skip-word ( ip -- ip' ) ta1+ ; -: .inline ( ip -- ip' ) ta1+ dup unaligned-@ n. na1+ ; +: .inline ( ip -- ip' ) ta1+ dup unaligned-@ pretty-n. na1+ ; : skip-inline ( ip -- ip' ) ta1+ na1+ ; -: .wlit ( ip -- ip' ) ta1+ dup unaligned-w@ 1- . wa1+ ; +: .wlit ( ip -- ip' ) ta1+ dup unaligned-w@ 1- pretty-. wa1+ ; : skip-wlit ( ip -- ip' ) ta1+ wa1+ ; -: .llit ( ip -- ip' ) ta1+ dup unaligned-l@ 1- . la1+ ; +: .llit ( ip -- ip' ) ta1+ dup unaligned-l@ 1- pretty-. la1+ ; : skip-llit ( ip -- ip' ) ta1+ la1+ ; -: .dlit ( ip -- ip' ) ta1+ dup d@ (d.) type ." . " 2 na+ ; +: .dlit ( ip -- ip' ) ta1+ dup d@ (d.) green-letters type ." . " cancel 2 na+ ; : skip-dlit ( ip -- ip' ) ta1+ 2 na+ ; : skip-branch ( ip -- ip' ) +branch ; -: .quote ( ip -- ip' ) .word .word ; -: skip-quote ( ip -- ip' ) ta1+ ta1+ ; -: .compile ( ip -- ip' ) ." compile " ta1+ .word ; +: .compile ( ip -- ip' ) .." compile " ta1+ .word ; : skip-compile ( ip -- ip' ) ta1+ ta1+ ; : skip-string ( ip -- ip' ) ta1+ +str ; : skip-nstring ( ip -- ip' ) ta1+ +nstr ; @@ -309,11 +319,9 @@ headers : skip-(') ( ip -- ip' ) ta1+ ta1+ ; headerless -: .is ( ip -- ip' ) ." to " ta1+ dup token@ .name ta1+ ; -: .string-tail ( ip -- ip' ) dup count type +str ; -: .string ( ip -- ip' ) .cword .string-tail put" ; -: .pstring ( ip -- ip' ) ?cr ." p" put" ta1+ .string-tail put" ; -: .nstring ( ip -- ip' ) ?cr put" ta1+ dup ncount type +nstr put" ; +: .is ( ip -- ip' ) .." to " ta1+ dup token@ .name ta1+ ; +: .string ( ip -- ip' ) cword-name .string-tail +str ; +: .nstring ( ip -- ip' ) ta1+ dup ncount " n""" .string-tail +nstr ;
\ Use this version of .branch if the structured conditional code is not used \ : .branch ( ip -- ip' ) .word dup <w@ . /branch + ; @@ -325,7 +333,6 @@ .." exit " ta1+ then ; - : dummy ;
\ classify each word in a definition @@ -344,7 +351,7 @@ ( 14 ) [compile] exit ( 15 ) [compile] (wlit) ( 16 ) [compile] (') ( 17 ) [compile] (of) ( 18 ) [compile] (endof) ( 19 ) [compile] (endcase) - ( 20 ) [compile] ("s) ( 21 ) [compile] (is) + ( 20 ) [compile] (p") ( 21 ) [compile] (is) ( 22 ) [compile] (dlit) ( 23 ) [compile] (llit) ( 24 ) [compile] (n") ( 25 ) [compile] isdefer ( 26 ) [compile] isuser ( 27 ) [compile] isvalue @@ -365,7 +372,7 @@ ( 14 ) .unnest ( 15 ) .wlit ( 16 ) .(') ( 17 ) .of ( 18 ) .endof ( 19 ) .endcase - ( 20 ) .pstring ( 21 ) .is + ( 20 ) .string ( 21 ) .is ( 22 ) .dlit ( 23 ) .llit ( 24 ) .nstring ( 25 ) .is ( 26 ) .is ( 27 ) .is @@ -447,36 +454,38 @@
: .immediate ( acf -- ) immediate? if .." immediate" then ;
-: .definer ( acf definer-acf -- acf ) .name dup .name ; +: .definer ( acf definer-acf -- acf ) + magenta-letters .name dup blue-letters .name cancel +;
: dump-body ( pfa -- ) push-hex - dup @ n. 2 spaces 8 emit.ln + dup @ pretty-n. 2 spaces 8 emit.ln pop-base ; \ Display category of word : .: ( acf definer -- ) .definer space space >body .pf ; -: .constant ( acf definer -- ) over >data ? .definer drop ; -: .2constant ( acf definer -- ) over >data dup ? na1+ ? .definer drop ; +: .constant ( acf definer -- ) over >data @ pretty-n. .definer drop ; +: .2constant ( acf definer -- ) over >data dup @ pretty-n. na1+ @ pretty-n. .definer drop ; : .vocabulary ( acf definer -- ) .definer drop ; : .code ( acf definer -- ) .definer >code disassemble ; : .variable ( acf definer -- ) - over >data n. .definer .." value = " >data ? + over >data n. .definer ." value = " >data @ pretty-n. ; : .create ( acf definer -- ) - over >body n. .definer .." value = " >body dump-body + over >body n. .definer ." value = " >body dump-body ; : .user ( acf definer -- ) - over >body ? .definer .." value = " >data ? + over >body @ n. .definer ." value = " >data @ pretty-n. ; : .defer ( acf definer -- ) - .definer .." is " cr >data token@ (see) + .definer ." is " cr >data token@ (see) ; : .alias ( acf definer -- ) .definer >body token@ .name ; : .value ( acf definer -- ) - swap >data ? .definer + swap >data @ pretty-n. .definer ;
@@ -487,7 +496,6 @@ .definer >body ." (Body: " dump-body ." ) " cr ;
- \ Classify a word based on its acf alias isalias noop create iscreate
openfirmware@openfirmware.info
-
repository service