basis/compiler/cfg/checker/checker.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel compiler.cfg.instructions compiler.cfg.rpo
   4 compiler.cfg.def-use compiler.cfg.linearization
   5 combinators.short-circuit accessors math sequences sets assocs ;
   6 IN: compiler.cfg.checker
   7
   8 ERROR: last-insn-not-a-jump insn ;
   9
  10 : check-last-instruction ( bb -- )
  11     last dup {
  12         [ ##branch? ]
  13         [ ##dispatch? ]
  14         [ ##conditional-branch? ]
  15         [ ##compare-imm-branch? ]
  16         [ ##return? ]
  17         [ ##callback-return? ]
  18         [ ##jump? ]
  19         [ ##fixnum-add? ]
  20         [ ##fixnum-sub? ]
  21         [ ##fixnum-mul? ]
  22         [ ##no-tco? ]
  23     } 1|| [ drop ] [ last-insn-not-a-jump ] if ;
  24
  25 ERROR: bad-loop-entry ;
  26
  27 : check-loop-entry ( bb -- )
  28     dup length 2 >= [
  29         2 head* [ ##loop-entry? ] any?
  30         [ bad-loop-entry ] when
  31     ] [ drop ] if ;
  32
  33 ERROR: bad-successors ;
  34
  35 : check-successors ( bb -- )
  36     dup successors>> [ predecessors>> memq? ] with all?
  37     [ bad-successors ] unless ;
  38
  39 : check-basic-block ( bb -- )
  40     [ instructions>> check-last-instruction ]
  41     [ instructions>> check-loop-entry ]
  42     [ check-successors ]
  43     tri ;
  44
  45 ERROR: bad-live-in ;
  46
  47 ERROR: undefined-values uses defs ;
  48
  49 : check-mr ( mr -- )
  50     ! Check that every used register has a definition
  51     instructions>>
  52     [ [ uses-vregs ] map concat ]
  53     [ [ [ defs-vregs ] [ temp-vregs ] bi append ] map concat ] bi
  54     2dup subset? [ 2drop ] [ undefined-values ] if ;
  55
  56 : check-cfg ( cfg -- )
  57     [ [ check-basic-block ] each-basic-block ]
  58     [ flatten-cfg check-mr ]
  59     bi ;