-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: functors assocs kernel accessors compiler.cfg.instructions
-lexer parser ;
+USING: accessors arrays assocs compiler.cfg.def-use
+compiler.cfg.instructions compiler.cfg.instructions.syntax fry
+functors generic.parser kernel lexer namespaces parser sequences
+sets slots words ;
IN: compiler.cfg.renaming.functor
+! Like compiler.cfg.def-use, but for changing operands
+
+: slot-change-quot ( slots quot -- quot' )
+ '[ [ _ ] dip changer-word [ ] 2sequence ] map [ ] join
+ [ drop ] append ;
+
FUNCTOR: define-renaming ( NAME DEF-QUOT USE-QUOT TEMP-QUOT -- )
rename-insn-defs DEFINES ${NAME}-insn-defs
WHERE
GENERIC: rename-insn-defs ( insn -- )
-
-M: ##flushable rename-insn-defs
- DEF-QUOT change-dst
- drop ;
-
-M: ##fixnum-overflow rename-insn-defs
- DEF-QUOT change-dst
- drop ;
-
-M: _fixnum-overflow rename-insn-defs
- DEF-QUOT change-dst
- drop ;
-
-M: insn rename-insn-defs drop ;
-
GENERIC: rename-insn-uses ( insn -- )
+GENERIC: rename-insn-temps ( insn -- )
-M: ##effect rename-insn-uses
- USE-QUOT change-src
- drop ;
-
-M: ##unary rename-insn-uses
- USE-QUOT change-src
- drop ;
-
-M: ##binary rename-insn-uses
- USE-QUOT change-src1
- USE-QUOT change-src2
- drop ;
-
-M: ##binary-imm rename-insn-uses
- USE-QUOT change-src1
- drop ;
-
-M: ##slot rename-insn-uses
- USE-QUOT change-obj
- USE-QUOT change-slot
- drop ;
-
-M: ##slot-imm rename-insn-uses
- USE-QUOT change-obj
- drop ;
-
-M: ##set-slot rename-insn-uses
- dup call-next-method
- USE-QUOT change-obj
- USE-QUOT change-slot
- drop ;
-
-M: ##string-nth rename-insn-uses
- USE-QUOT change-obj
- USE-QUOT change-index
- drop ;
-
-M: ##set-string-nth-fast rename-insn-uses
- dup call-next-method
- USE-QUOT change-obj
- USE-QUOT change-index
- drop ;
-
-M: ##set-slot-imm rename-insn-uses
- dup call-next-method
- USE-QUOT change-obj
- drop ;
+M: insn rename-insn-defs drop ;
+M: insn rename-insn-uses drop ;
+M: insn rename-insn-temps drop ;
-M: ##alien-getter rename-insn-uses
- dup call-next-method
- USE-QUOT change-src
- drop ;
+! Instructions with unusual operands
-M: ##alien-setter rename-insn-uses
- dup call-next-method
- USE-QUOT change-value
- drop ;
+! Special rename-insn-defs methods
+M: ##parallel-copy rename-insn-defs
+ [ [ first2 DEF-QUOT dip 2array ] map ] change-values drop ;
-M: ##conditional-branch rename-insn-uses
- USE-QUOT change-src1
- USE-QUOT change-src2
- drop ;
+M: ##phi rename-insn-defs DEF-QUOT change-dst drop ;
-M: ##compare-imm-branch rename-insn-uses
- USE-QUOT change-src1
+M: alien-call-insn rename-insn-defs
+ [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
drop ;
-M: ##dispatch rename-insn-uses
- USE-QUOT change-src
+M: ##callback-inputs rename-insn-defs
+ [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
+ [ [ first3 DEF-QUOT 2dip 3array ] map ] change-stack-outputs
drop ;
-M: ##fixnum-overflow rename-insn-uses
- USE-QUOT change-src1
- USE-QUOT change-src2
- drop ;
+! Special rename-insn-uses methods
+M: ##parallel-copy rename-insn-uses
+ [ [ first2 USE-QUOT call 2array ] map ] change-values drop ;
M: ##phi rename-insn-uses
- [ USE-QUOT assoc-map ] change-inputs
- drop ;
-
-M: insn rename-insn-uses drop ;
+ [ USE-QUOT assoc-map ] change-inputs drop ;
-GENERIC: rename-insn-temps ( insn -- )
-
-M: ##write-barrier rename-insn-temps
- TEMP-QUOT change-card#
- TEMP-QUOT change-table
+M: alien-call-insn rename-insn-uses
+ [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
+ [ [ first3 USE-QUOT 2dip 3array ] map ] change-stack-inputs
drop ;
-M: ##unary/temp rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##allot rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##dispatch rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##slot rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##set-slot rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##string-nth rename-insn-temps
- TEMP-QUOT change-temp drop ;
+M: ##alien-indirect rename-insn-uses
+ USE-QUOT change-src call-next-method ;
-M: ##set-string-nth-fast rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##compare rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##compare-imm rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##compare-float rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##gc rename-insn-temps
- TEMP-QUOT change-temp1
- TEMP-QUOT change-temp2
+M: ##callback-outputs rename-insn-uses
+ [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
drop ;
-M: _dispatch rename-insn-temps
- TEMP-QUOT change-temp drop ;
+! Generate methods for everything else
+insn-classes get special-vreg-insns diff [ insn-def-slots empty? ] reject [
+ [ \ rename-insn-defs create-method-in ]
+ [ insn-def-slots [ name>> ] map DEF-QUOT slot-change-quot ] bi
+ define
+] each
-M: insn rename-insn-temps drop ;
+insn-classes get special-vreg-insns diff [ insn-use-slots empty? ] reject [
+ [ \ rename-insn-uses create-method-in ]
+ [ insn-use-slots [ name>> ] map USE-QUOT slot-change-quot ] bi
+ define
+] each
+
+insn-classes get [ insn-temp-slots empty? ] reject [
+ [ \ rename-insn-temps create-method-in ]
+ [ insn-temp-slots [ name>> ] map TEMP-QUOT slot-change-quot ] bi
+ define
+] each
;FUNCTOR
-SYNTAX: RENAMING: scan scan-object scan-object scan-object define-renaming ;
\ No newline at end of file
+SYNTAX: RENAMING: scan-token scan-object scan-object scan-object define-renaming ;