cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
cpu.architecture kernel kernel.private math memory namespaces make
sequences words system layouts combinators math.order fry locals
-compiler.constants byte-arrays
+compiler.constants vm byte-arrays
compiler.cfg.registers
compiler.cfg.instructions
compiler.cfg.intrinsics
compiler.cfg.comparisons
compiler.cfg.stack-frame
-compiler.codegen
compiler.codegen.fixup ;
+FROM: math => float ;
IN: cpu.x86
<< enable-fixnum-log2 >>
M: x86 %broadcast-vector ( dst src rep -- )
{
- { float-4-rep [ [ MOVAPS ] [ drop dup 0 SHUFPS ] 2bi ] }
- { double-2-rep [ [ MOVAPD ] [ drop dup 0 SHUFPD ] 2bi ] }
+ { float-4-rep [ [ MOVSS ] [ drop dup 0 SHUFPS ] 2bi ] }
+ { double-2-rep [ [ MOVSD ] [ drop dup UNPCKLPD ] 2bi ] }
} case ;
M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- )
dst src1 MOVSS
dst src2 UNPCKLPS
src3 src4 UNPCKLPS
- dst src3 HEX: 44 SHUFPS
+ dst src3 MOVLHPS
]
}
} case ;
{
double-2-rep
[
- dst src1 MOVAPD
- dst src2 0 SHUFPD
+ dst src1 MOVSD
+ dst src2 UNPCKLPD
]
}
} case ;
M: x86 %shr [ SHR ] emit-shift ;
M: x86 %sar [ SAR ] emit-shift ;
+M: x86 %vm-field-ptr ( dst field -- )
+ [ drop 0 MOV rc-absolute-cell rt-vm rel-fixup ]
+ [ vm-field-offset ADD ] 2bi ;
+
: load-zone-ptr ( reg -- )
#! Load pointer to start of zone array
- 0 MOV "nursery" f rc-absolute-cell rel-dlsym ;
+ "nursery" %vm-field-ptr ;
: load-allot-ptr ( nursery-ptr allot-ptr -- )
[ drop load-zone-ptr ] [ swap cell [+] MOV ] 2bi ;
dst class store-tagged
nursery-ptr size inc-allot-ptr ;
+
M:: x86 %write-barrier ( src card# table -- )
#! Mark the card pointed to by vreg.
! Mark the card
card# src MOV
card# card-bits SHR
- table "cards_offset" f %alien-global
+ table "cards_offset" %vm-field-ptr
table table [] MOV
table card# [+] card-mark <byte> MOV
! Mark the card deck
card# deck-bits card-bits - SHR
- table "decks_offset" f %alien-global
+ table "decks_offset" %vm-field-ptr
table table [] MOV
table card# [+] card-mark <byte> MOV ;
! Pass number of roots as second parameter
param-reg-2 gc-root-count MOV
! Call GC
- %prepare-alien-invoke
- "inline_gc" f %alien-invoke ;
+ "inline_gc" %vm-invoke-3rd-arg ;
-M: x86 %alien-global
- [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
+M: x86 %alien-global ( dst symbol library -- )
+ [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
"no-move" resolve-label
] with-scope ;
-M:: x86 %compare-float ( dst src1 src2 cc temp -- )
+:: (%compare-float) ( dst src1 src2 cc temp compare -- )
cc {
- { cc< [ src2 src1 COMISD dst temp \ CMOVA %boolean ] }
- { cc<= [ src2 src1 COMISD dst temp \ CMOVAE %boolean ] }
- { cc> [ src1 src2 COMISD dst temp \ CMOVA %boolean ] }
- { cc>= [ src1 src2 COMISD dst temp \ CMOVAE %boolean ] }
- { cc= [ src1 src2 UCOMISD dst temp \ %cmov-float= %boolean ] }
- { cc<> [ src1 src2 COMISD dst temp \ CMOVNE %boolean ] }
- { cc<>= [ src1 src2 COMISD dst temp \ CMOVNP %boolean ] }
- { cc/< [ src2 src1 UCOMISD dst temp \ CMOVBE %boolean ] }
- { cc/<= [ src2 src1 UCOMISD dst temp \ CMOVB %boolean ] }
- { cc/> [ src1 src2 UCOMISD dst temp \ CMOVBE %boolean ] }
- { cc/>= [ src1 src2 UCOMISD dst temp \ CMOVB %boolean ] }
- { cc/= [ src1 src2 UCOMISD dst temp \ %cmov-float/= %boolean ] }
- { cc/<> [ src1 src2 UCOMISD dst temp \ CMOVE %boolean ] }
- { cc/<>= [ src1 src2 UCOMISD dst temp \ CMOVP %boolean ] }
- } case ;
+ { cc< [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVA %boolean ] }
+ { cc<= [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVAE %boolean ] }
+ { cc> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVA %boolean ] }
+ { cc>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVAE %boolean ] }
+ { cc= [ src1 src2 \ compare execute( a b -- ) dst temp \ %cmov-float= %boolean ] }
+ { cc<> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVNE %boolean ] }
+ { cc<>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVNP %boolean ] }
+ { cc/< [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVBE %boolean ] }
+ { cc/<= [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVB %boolean ] }
+ { cc/> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVBE %boolean ] }
+ { cc/>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVB %boolean ] }
+ { cc/= [ src1 src2 \ compare execute( a b -- ) dst temp \ %cmov-float/= %boolean ] }
+ { cc/<> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVE %boolean ] }
+ { cc/<>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVP %boolean ] }
+ } case ; inline
+
+M: x86 %compare-float-ordered ( dst src1 src2 cc temp -- )
+ \ COMISD (%compare-float) ;
+
+M: x86 %compare-float-unordered ( dst src1 src2 cc temp -- )
+ \ UCOMISD (%compare-float) ;
M:: x86 %compare-branch ( label src1 src2 cc -- )
src1 src2 CMP
: %jump-float/= ( label -- )
[ JNE ] [ JP ] bi ;
-M:: x86 %compare-float-branch ( label src1 src2 cc -- )
+:: (%compare-float-branch) ( label src1 src2 cc compare -- )
cc {
- { cc< [ src2 src1 COMISD label JA ] }
- { cc<= [ src2 src1 COMISD label JAE ] }
- { cc> [ src1 src2 COMISD label JA ] }
- { cc>= [ src1 src2 COMISD label JAE ] }
- { cc= [ src1 src2 UCOMISD label %jump-float= ] }
- { cc<> [ src1 src2 COMISD label JNE ] }
- { cc<>= [ src1 src2 COMISD label JNP ] }
- { cc/< [ src2 src1 UCOMISD label JBE ] }
- { cc/<= [ src2 src1 UCOMISD label JB ] }
- { cc/> [ src1 src2 UCOMISD label JBE ] }
- { cc/>= [ src1 src2 UCOMISD label JB ] }
- { cc/= [ src1 src2 UCOMISD label %jump-float/= ] }
- { cc/<> [ src1 src2 UCOMISD label JE ] }
- { cc/<>= [ src1 src2 UCOMISD label JP ] }
+ { cc< [ src2 src1 \ compare execute( a b -- ) label JA ] }
+ { cc<= [ src2 src1 \ compare execute( a b -- ) label JAE ] }
+ { cc> [ src1 src2 \ compare execute( a b -- ) label JA ] }
+ { cc>= [ src1 src2 \ compare execute( a b -- ) label JAE ] }
+ { cc= [ src1 src2 \ compare execute( a b -- ) label %jump-float= ] }
+ { cc<> [ src1 src2 \ compare execute( a b -- ) label JNE ] }
+ { cc<>= [ src1 src2 \ compare execute( a b -- ) label JNP ] }
+ { cc/< [ src2 src1 \ compare execute( a b -- ) label JBE ] }
+ { cc/<= [ src2 src1 \ compare execute( a b -- ) label JB ] }
+ { cc/> [ src1 src2 \ compare execute( a b -- ) label JBE ] }
+ { cc/>= [ src1 src2 \ compare execute( a b -- ) label JB ] }
+ { cc/= [ src1 src2 \ compare execute( a b -- ) label %jump-float/= ] }
+ { cc/<> [ src1 src2 \ compare execute( a b -- ) label JE ] }
+ { cc/<>= [ src1 src2 \ compare execute( a b -- ) label JP ] }
} case ;
+M: x86 %compare-float-ordered-branch ( label src1 src2 cc -- )
+ \ COMISD (%compare-float-branch) ;
+
+M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- )
+ \ UCOMISD (%compare-float-branch) ;
+
M:: x86 %spill ( src rep n -- )
n spill@ src rep copy-register ;
M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
-M: x86 %prepare-alien-invoke
+M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
#! Save Factor stack pointers in case the C code calls a
#! callback which does a GC, which must reliably trace
#! all roots.
- temp-reg "stack_chain" f %alien-global
- temp-reg temp-reg [] MOV
- temp-reg [] stack-reg MOV
- temp-reg [] cell SUB
- temp-reg 2 cells [+] ds-reg MOV
- temp-reg 3 cells [+] rs-reg MOV ;
+ temp1 0 MOV rc-absolute-cell rt-vm rel-fixup
+ temp1 temp1 "stack_chain" vm-field-offset [+] MOV
+ temp2 stack-reg cell neg [+] LEA
+ temp1 [] temp2 MOV
+ callback-allowed? [
+ temp1 2 cells [+] ds-reg MOV
+ temp1 3 cells [+] rs-reg MOV
+ ] when ;
M: x86 value-struct? drop t ;