2008-09-11 03:05:22 -04:00
|
|
|
! Copyright (C) 2008 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
USING: kernel words sequences quotations namespaces io
|
2008-10-20 02:56:28 -04:00
|
|
|
classes.tuple accessors prettyprint prettyprint.config
|
2008-12-08 15:58:00 -05:00
|
|
|
prettyprint.backend prettyprint.custom prettyprint.sections
|
|
|
|
parser compiler.tree.builder compiler.tree.optimizer
|
2008-10-07 21:00:38 -04:00
|
|
|
compiler.cfg.builder compiler.cfg.linearization
|
2008-12-08 15:58:00 -05:00
|
|
|
compiler.cfg.registers compiler.cfg.stack-frame
|
|
|
|
compiler.cfg.linear-scan compiler.cfg.two-operand
|
2009-05-31 13:20:46 -04:00
|
|
|
compiler.cfg.liveness compiler.cfg.optimizer
|
|
|
|
compiler.cfg.mr ;
|
2008-09-11 03:05:22 -04:00
|
|
|
IN: compiler.cfg.debugger
|
|
|
|
|
|
|
|
GENERIC: test-cfg ( quot -- cfgs )
|
|
|
|
|
|
|
|
M: callable test-cfg
|
2008-09-17 01:46:38 -04:00
|
|
|
build-tree optimize-tree gensym build-cfg ;
|
2008-09-11 03:05:22 -04:00
|
|
|
|
|
|
|
M: word test-cfg
|
2009-04-22 00:02:00 -04:00
|
|
|
[ build-tree optimize-tree ] keep build-cfg ;
|
2008-09-11 03:05:22 -04:00
|
|
|
|
2008-10-07 21:00:38 -04:00
|
|
|
: test-mr ( quot -- mrs )
|
2008-10-20 02:56:28 -04:00
|
|
|
test-cfg [
|
2008-10-22 19:39:41 -04:00
|
|
|
optimize-cfg
|
2009-05-29 14:11:34 -04:00
|
|
|
build-mr
|
2008-10-20 02:56:28 -04:00
|
|
|
] map ;
|
|
|
|
|
|
|
|
: insn. ( insn -- )
|
2009-05-31 13:20:46 -04:00
|
|
|
tuple>array [ pprint bl ] each nl ;
|
2008-09-11 03:05:22 -04:00
|
|
|
|
|
|
|
: mr. ( mrs -- )
|
|
|
|
[
|
|
|
|
"=== word: " write
|
|
|
|
dup word>> pprint
|
|
|
|
", label: " write
|
|
|
|
dup label>> pprint nl nl
|
2008-10-20 02:56:28 -04:00
|
|
|
instructions>> [ insn. ] each
|
2008-09-11 03:05:22 -04:00
|
|
|
nl
|
|
|
|
] each ;
|
2008-12-08 15:58:00 -05:00
|
|
|
|
|
|
|
! Prettyprinting
|
|
|
|
M: vreg pprint*
|
|
|
|
<block
|
|
|
|
\ V pprint-word [ reg-class>> pprint* ] [ n>> pprint* ] bi
|
|
|
|
block> ;
|
|
|
|
|
|
|
|
: pprint-loc ( loc word -- ) <block pprint-word n>> pprint* block> ;
|
|
|
|
|
|
|
|
M: ds-loc pprint* \ D pprint-loc ;
|
|
|
|
|
|
|
|
M: rs-loc pprint* \ R pprint-loc ;
|