steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.cfg.debugger: better code for outputting using the formatting vocab

char-rename
Björn Lindqvist 2016-08-30 04:04:21 +02:00
parent b82ea14af0
commit c26379ea7e
1 changed files with 26 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
basis/compiler/cfg/debugger/debugger.factor
View File

@ -6,9 +6,8 @@ compiler.cfg.instructions compiler.cfg.linearization
compiler.cfg.optimizer compiler.cfg.registers compiler.cfg.optimizer compiler.cfg.registers
compiler.cfg.representations compiler.cfg.save-contexts compiler.cfg.representations compiler.cfg.save-contexts
compiler.cfg.utilities compiler.tree.builder compiler.tree.optimizer compiler.cfg.utilities compiler.tree.builder compiler.tree.optimizer
fry io kernel namespaces prettyprint prettyprint.backend formatting fry io kernel namespaces prettyprint quotations sequences
prettyprint.custom prettyprint.sections quotations sequences strings strings words ;
words ;
FROM: compiler.cfg.linearization => number-blocks ; FROM: compiler.cfg.linearization => number-blocks ;
IN: compiler.cfg.debugger IN: compiler.cfg.debugger
@ -55,24 +54,34 @@ M: insn insn. tuple>array but-last [
dup string? [ print ] [ pprint ] if dup string? [ print ] [ pprint ] if
] interleave nl ; ] interleave nl ;
: block. ( bb -- ) : block-header. ( bb -- )
"=== Basic block #" write dup number>> . nl [ number>> ] [ kill-block?>> "(k)" "" ? ] bi
dup instructions>> [ insn. ] each nl "=== Basic block #%d %s\n\n" printf ;
: instructions. ( bb -- )
instructions>> [ insn. ] each nl ;
: successors. ( bb -- )
successors>> [ successors>> [
"Successors: " write [ number>> unparse ] map ", " join
[ number>> unparse ] map ", " join print nl "Successors: %s\n\n" printf
] unless-empty ; ] unless-empty ;
: block. ( bb -- )
[ block-header. ] [ instructions. ] [ successors. ] tri ;
: cfg-header. ( cfg -- )
[ word>> ] [ label>> ] bi "=== word: %u, label: %u\n\n" printf ;
: blocks. ( cfg -- )
linearization-order [ block. ] each ;
: stack-frame. ( cfg -- )
stack-frame>> "=== stack frame: %u\n" printf ;
: cfg. ( cfg -- ) : cfg. ( cfg -- )
[ dup linearization-order number-blocks [
dup linearization-order number-blocks [ cfg-header. ] [ blocks. ] [ stack-frame. ] tri
"=== word: " write
dup word>> pprint
", label: " write
dup label>> pprint nl nl
dup linearization-order [ block. ] each
"=== stack frame: " write
stack-frame>> .
] with-scope ; ] with-scope ;
: cfgs. ( cfgs -- ) : cfgs. ( cfgs -- )