1 ! Copyright (C) 2008, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays byte-arrays kernel layouts math
4 namespaces sequences combinators splitting parser effects
5 words cpu.architecture compiler.cfg.registers
6 compiler.cfg.instructions compiler.cfg.instructions.syntax ;
13 : hat-name ( insn -- word )
14 name>> "##" ?head drop "^^" prepend create-in ;
16 : hat-quot ( insn -- quot )
18 "insn-slots" word-prop [ ] [
20 { def [ [ next-vreg dup ] ] }
21 { temp [ [ next-vreg ] ] }
23 } case swap [ dip ] curry compose
27 : hat-effect ( insn -- effect )
28 "insn-slots" word-prop
29 [ type>> { def temp } memq? not ] filter [ name>> ] map
32 : define-hat ( insn -- )
33 [ hat-name ] [ hat-quot ] [ hat-effect ] tri define-inline ;
38 dup [ insn-def-slot ] [ name>> "##" head? ] bi and
39 [ define-hat ] [ drop ] if
44 : ^^load-literal ( obj -- dst )
45 [ next-vreg dup ] dip {
46 { [ dup not ] [ drop \ f tag-number ##load-immediate ] }
47 { [ dup fixnum? ] [ tag-fixnum ##load-immediate ] }
51 : ^^unbox-c-ptr ( src class -- dst )
52 [ next-vreg dup ] 2dip next-vreg ##unbox-c-ptr ; inline
54 : ^^neg ( src -- dst ) [ 0 ^^load-literal ] dip ^^sub ; inline
55 : ^^allot-tuple ( n -- dst ) 2 + cells tuple ^^allot ; inline
56 : ^^allot-array ( n -- dst ) 2 + cells array ^^allot ; inline
57 : ^^allot-byte-array ( n -- dst ) 2 cells + byte-array ^^allot ; inline
58 : ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] [ any-rep ^^copy ] if ; inline
59 : ^^tag-fixnum ( src -- dst ) tag-bits get ^^shl-imm ; inline
60 : ^^untag-fixnum ( src -- dst ) tag-bits get ^^sar-imm ; inline