basis/compiler/cfg/debugger/debugger.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel words sequences quotations namespaces io vectors
   4 classes.tuple accessors prettyprint prettyprint.config
   5 prettyprint.backend prettyprint.custom prettyprint.sections
   6 parser compiler.tree.builder compiler.tree.optimizer
   7 compiler.cfg.builder compiler.cfg.linearization
   8 compiler.cfg.registers compiler.cfg.stack-frame
   9 compiler.cfg.linear-scan compiler.cfg.two-operand
  10 compiler.cfg.optimizer
  11 compiler.cfg.mr compiler.cfg ;
  12 IN: compiler.cfg.debugger
  13
  14 GENERIC: test-cfg ( quot -- cfgs )
  15
  16 M: callable test-cfg
  17     build-tree optimize-tree gensym build-cfg ;
  18
  19 M: word test-cfg
  20     [ build-tree optimize-tree ] keep build-cfg ;
  21
  22 : test-mr ( quot -- mrs )
  23     test-cfg [
  24         optimize-cfg
  25         build-mr
  26     ] map ;
  27
  28 : insn. ( insn -- )
  29     tuple>array but-last [ pprint bl ] each nl ;
  30
  31 : mr. ( mrs -- )
  32     [
  33         "=== word: " write
  34         dup word>> pprint
  35         ", label: " write
  36         dup label>> pprint nl nl
  37         instructions>> [ insn. ] each
  38         nl
  39     ] each ;
  40
  41 ! Prettyprinting
  42 M: vreg pprint*
  43     <block
  44     \ V pprint-word [ reg-class>> pprint* ] [ n>> pprint* ] bi
  45     block> ;
  46
  47 : pprint-loc ( loc word -- ) <block pprint-word n>> pprint* block> ;
  48
  49 M: ds-loc pprint* \ D pprint-loc ;
  50
  51 M: rs-loc pprint* \ R pprint-loc ;
  52
  53 : test-bb ( insns n -- )
  54     [ <basic-block> swap >>number swap >>instructions ] keep set ;
  55
  56 : test-diamond ( -- )
  57     1 get 1vector 0 get (>>successors)
  58     2 get 3 get V{ } 2sequence 1 get (>>successors)
  59     4 get 1vector 2 get (>>successors)
  60     4 get 1vector 3 get (>>successors) ;