2009-05-25 20:16:58 -04:00
|
|
|
! Copyright (C) 2009 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2009-05-27 19:58:14 -04:00
|
|
|
USING: kernel compiler.cfg.instructions compiler.cfg.rpo compiler.cfg.def-use
|
|
|
|
compiler.cfg.linearization combinators.short-circuit accessors math
|
|
|
|
sequences sets ;
|
2009-05-25 20:16:58 -04:00
|
|
|
IN: compiler.cfg.checker
|
|
|
|
|
|
|
|
ERROR: last-insn-not-a-jump insn ;
|
|
|
|
|
2009-05-27 19:58:14 -04:00
|
|
|
: check-last-instruction ( bb -- )
|
2009-05-25 20:16:58 -04:00
|
|
|
peek dup {
|
|
|
|
[ ##branch? ]
|
|
|
|
[ ##conditional-branch? ]
|
|
|
|
[ ##compare-imm-branch? ]
|
|
|
|
[ ##return? ]
|
|
|
|
[ ##callback-return? ]
|
|
|
|
[ ##jump? ]
|
|
|
|
[ ##call? ]
|
|
|
|
[ ##dispatch-label? ]
|
|
|
|
} 1|| [ drop ] [ last-insn-not-a-jump ] if ;
|
|
|
|
|
2009-05-27 19:58:14 -04:00
|
|
|
ERROR: bad-loop-entry ;
|
|
|
|
|
|
|
|
: check-loop-entry ( bb -- )
|
|
|
|
dup length 2 >= [
|
|
|
|
2 head* [ ##loop-entry? ] any?
|
|
|
|
[ bad-loop-entry ] when
|
|
|
|
] [ drop ] if ;
|
|
|
|
|
|
|
|
: check-basic-block ( bb -- )
|
|
|
|
[ check-last-instruction ] [ check-loop-entry ] bi ;
|
|
|
|
|
2009-05-26 03:58:40 -04:00
|
|
|
: check-rpo ( rpo -- )
|
|
|
|
[ instructions>> check-basic-block ] each ;
|
|
|
|
|
2009-05-27 19:58:14 -04:00
|
|
|
ERROR: undefined-values uses defs ;
|
|
|
|
|
|
|
|
: check-mr ( mr -- )
|
|
|
|
! Check that every used register has a definition
|
|
|
|
instructions>>
|
|
|
|
[ [ uses-vregs ] map concat ]
|
|
|
|
[ [ defs-vregs ] map concat ] bi
|
|
|
|
2dup subset? [ 2drop ] [ undefined-values ] if ;
|
|
|
|
|
2009-05-25 20:16:58 -04:00
|
|
|
: check-cfg ( cfg -- )
|
2009-05-27 19:58:14 -04:00
|
|
|
[ reverse-post-order check-rpo ] [ build-mr check-mr ] bi ;
|