compiler.cfg.instructions: change vreg-insn from a mixin into a superclass
parent
6d30bb8bf4
commit
1a61c50896
|
@ -16,9 +16,12 @@ V{ } clone insn-classes set-global
|
||||||
! Virtual CPU instructions, used by CFG IR
|
! Virtual CPU instructions, used by CFG IR
|
||||||
TUPLE: insn ;
|
TUPLE: insn ;
|
||||||
|
|
||||||
|
! Instructions which use vregs
|
||||||
|
TUPLE: vreg-insn < insn ;
|
||||||
|
|
||||||
! Instructions which are referentially transparent; used for
|
! Instructions which are referentially transparent; used for
|
||||||
! value numbering
|
! value numbering
|
||||||
TUPLE: pure-insn < insn ;
|
TUPLE: pure-insn < vreg-insn ;
|
||||||
|
|
||||||
! Constants
|
! Constants
|
||||||
INSN: ##load-integer
|
INSN: ##load-integer
|
||||||
|
@ -859,13 +862,3 @@ UNION: def-is-use-insn
|
||||||
##box-alien
|
##box-alien
|
||||||
##box-displaced-alien
|
##box-displaced-alien
|
||||||
##unbox-any-c-ptr ;
|
##unbox-any-c-ptr ;
|
||||||
|
|
||||||
SYMBOL: vreg-insn
|
|
||||||
|
|
||||||
[
|
|
||||||
vreg-insn
|
|
||||||
insn-classes get [
|
|
||||||
"insn-slots" word-prop [ type>> { def use temp } member-eq? ] any?
|
|
||||||
] filter
|
|
||||||
define-union-class
|
|
||||||
] with-compilation-unit
|
|
||||||
|
|
|
@ -56,21 +56,32 @@ TUPLE: insn-slot-spec type name rep ;
|
||||||
: insn-word ( -- word )
|
: insn-word ( -- word )
|
||||||
"insn" "compiler.cfg.instructions" lookup ;
|
"insn" "compiler.cfg.instructions" lookup ;
|
||||||
|
|
||||||
|
: vreg-insn-word ( -- word )
|
||||||
|
"vreg-insn" "compiler.cfg.instructions" lookup ;
|
||||||
|
|
||||||
: pure-insn-word ( -- word )
|
: pure-insn-word ( -- word )
|
||||||
"pure-insn" "compiler.cfg.instructions" lookup ;
|
"pure-insn" "compiler.cfg.instructions" lookup ;
|
||||||
|
|
||||||
: insn-effect ( word -- effect )
|
: insn-effect ( word -- effect )
|
||||||
boa-effect in>> but-last { } <effect> ;
|
boa-effect in>> but-last { } <effect> ;
|
||||||
|
|
||||||
: define-insn-tuple ( class superclass specs -- )
|
: uses-vregs? ( specs -- ? )
|
||||||
|
[ type>> { def use temp } member-eq? ] any? ;
|
||||||
|
|
||||||
|
: insn-superclass ( pure? specs -- superclass )
|
||||||
|
pure-insn-word swap uses-vregs? vreg-insn-word insn-word ? ? ;
|
||||||
|
|
||||||
|
: define-insn-tuple ( class pure? specs -- )
|
||||||
|
[ insn-superclass ] keep
|
||||||
[ name>> ] map "insn#" suffix define-tuple-class ;
|
[ name>> ] map "insn#" suffix define-tuple-class ;
|
||||||
|
|
||||||
: define-insn-ctor ( class specs -- )
|
: define-insn-ctor ( class specs -- )
|
||||||
[ dup '[ _ ] [ f ] [ boa , ] surround ] dip
|
[ dup '[ _ ] [ f ] [ boa , ] surround ] dip
|
||||||
[ name>> ] map { } <effect> define-declared ;
|
[ name>> ] map { } <effect> define-declared ;
|
||||||
|
|
||||||
: define-insn ( class superclass specs -- )
|
: define-insn ( class pure? specs -- )
|
||||||
parse-insn-slot-specs {
|
parse-insn-slot-specs
|
||||||
|
{
|
||||||
[ nip "insn-slots" set-word-prop ]
|
[ nip "insn-slots" set-word-prop ]
|
||||||
[ 2drop insn-classes-word get push ]
|
[ 2drop insn-classes-word get push ]
|
||||||
[ define-insn-tuple ]
|
[ define-insn-tuple ]
|
||||||
|
@ -78,6 +89,6 @@ TUPLE: insn-slot-spec type name rep ;
|
||||||
[ nip define-insn-ctor ]
|
[ nip define-insn-ctor ]
|
||||||
} 3cleave ;
|
} 3cleave ;
|
||||||
|
|
||||||
SYNTAX: INSN: CREATE-CLASS insn-word ";" parse-tokens define-insn ;
|
SYNTAX: INSN: CREATE-CLASS f ";" parse-tokens define-insn ;
|
||||||
|
|
||||||
SYNTAX: PURE-INSN: CREATE-CLASS pure-insn-word ";" parse-tokens define-insn ;
|
SYNTAX: PURE-INSN: CREATE-CLASS t ";" parse-tokens define-insn ;
|
||||||
|
|
Loading…
Reference in New Issue