156 lines
4.4 KiB
Factor
156 lines
4.4 KiB
Factor
! Copyright (C) 2005, 2006 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: alien arrays assembler generic kernel kernel-internals
|
|
math memory namespaces sequences words ;
|
|
IN: compiler
|
|
|
|
: code-format 1 ; inline
|
|
|
|
! x86 register assignments
|
|
! EAX, ECX, EDX integer vregs
|
|
! XMM0 - XMM7 float vregs
|
|
! ESI datastack
|
|
! EDI callstack
|
|
|
|
! AMD64 redefines a lot of words in this file
|
|
|
|
: ds-reg ESI ; inline
|
|
: cs-reg EDI ; inline
|
|
: remainder-reg EDX ; inline
|
|
: alloc-tmp-reg EBX ; inline
|
|
: stack-reg ESP ; inline
|
|
: stack@ stack-reg swap [+] ;
|
|
|
|
: reg-stack ( n reg -- op ) swap cells neg [+] ;
|
|
|
|
M: ds-loc v>operand ds-loc-n ds-reg reg-stack ;
|
|
M: cs-loc v>operand cs-loc-n cs-reg reg-stack ;
|
|
|
|
: %alien-invoke ( symbol dll -- ) (CALL) rel-dlsym ;
|
|
|
|
: with-aligned-stack ( n quot -- )
|
|
#! On Linux, there is no requirement to align stack frames,
|
|
#! so this is mostly a no-op.
|
|
swap slip stack-reg swap ADD ; inline
|
|
|
|
: compile-c-call* ( symbol dll args -- operands )
|
|
dup length cells [
|
|
<reversed> [ PUSH ] each %alien-invoke
|
|
] with-aligned-stack ;
|
|
|
|
GENERIC: push-return-reg ( reg-class -- )
|
|
GENERIC: pop-return-reg ( reg-class -- )
|
|
GENERIC: load-return-reg ( stack@ reg-class -- )
|
|
GENERIC: store-return-reg ( stack@ reg-class -- )
|
|
|
|
! On x86, parameters are never passed in registers.
|
|
M: int-regs return-reg drop EAX ;
|
|
M: int-regs fastcall-regs drop { } ;
|
|
M: int-regs vregs drop { EAX ECX EDX } ;
|
|
M: int-regs %freg>stack drop >r stack@ r> MOV ;
|
|
M: int-regs %stack>freg drop swap stack@ MOV ;
|
|
M: int-regs push-return-reg return-reg PUSH ;
|
|
M: int-regs pop-return-reg return-reg POP ;
|
|
: load/store-int-return return-reg stack-reg rot [+] ;
|
|
M: int-regs load-return-reg load/store-int-return MOV ;
|
|
M: int-regs store-return-reg load/store-int-return swap MOV ;
|
|
|
|
: MOVSS/D float-regs-size 4 = [ MOVSS ] [ MOVSD ] if ;
|
|
|
|
M: float-regs fastcall-regs drop { } ;
|
|
M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
|
|
M: float-regs %freg>stack >r >r stack@ r> r> MOVSS/D ;
|
|
M: float-regs %stack>freg >r swap stack@ r> MOVSS/D ;
|
|
|
|
: FSTP 4 = [ FSTPS ] [ FSTPL ] if ;
|
|
|
|
M: float-regs push-return-reg
|
|
stack-reg swap reg-size [ SUB stack-reg [] ] keep FSTP ;
|
|
|
|
: FLD 4 = [ FLDS ] [ FLDL ] if ;
|
|
|
|
: drop-return-reg stack-reg swap reg-size ADD ;
|
|
|
|
M: float-regs pop-return-reg
|
|
stack-reg [] over reg-size FLD drop-return-reg ;
|
|
|
|
: load/store-float-return reg-size >r stack-reg swap [+] r> ;
|
|
M: float-regs load-return-reg load/store-float-return FLD ;
|
|
M: float-regs store-return-reg load/store-float-return FSTP ;
|
|
|
|
: address-operand ( address -- operand )
|
|
#! On x86, we can always use an address as an operand
|
|
#! directly.
|
|
; inline
|
|
|
|
: fixnum>slot@ 1 SHR ; inline
|
|
|
|
: prepare-division CDQ ; inline
|
|
|
|
M: immediate load-literal
|
|
v>operand swap v>operand MOV ;
|
|
|
|
: load-indirect ( literal reg -- )
|
|
0 [] MOV rel-absolute-cell rel-literal ;
|
|
|
|
M: object load-literal
|
|
v>operand load-indirect ;
|
|
|
|
: (%call) ( label -- label )
|
|
dup (compile) dup primitive? [ address-operand ] when ;
|
|
|
|
: %call ( label -- ) (%call) CALL ;
|
|
|
|
: %jump ( label -- ) %epilogue (%call) JMP ;
|
|
|
|
: %jump-label ( label -- ) JMP ;
|
|
|
|
: %jump-t ( label -- ) "flag" operand f v>operand CMP JNE ;
|
|
|
|
: compile-aligned ( -- )
|
|
compiled-offset [ 8 align ] keep - 0 <array> % ;
|
|
|
|
: %dispatch ( -- )
|
|
#! Compile a piece of code that jumps to an offset in a
|
|
#! jump table indexed by the fixnum at the top of the stack.
|
|
#! The jump table must immediately follow this macro.
|
|
! Untag and multiply to get a jump table offset
|
|
"end" define-label
|
|
"n" operand fixnum>slot@
|
|
! Add to jump table base. We use a temporary register since
|
|
! on AMD64 we have to load a 64-bit immediate. On x86, this
|
|
! is redundant.
|
|
"scratch" operand HEX: ffffffff MOV
|
|
"end" get rel-absolute-cell rel-label
|
|
"n" operand "scratch" operand ADD
|
|
! Jump to jump table entry
|
|
"n" operand [] JMP
|
|
! Align for better performance
|
|
compile-aligned
|
|
! Fix up jump table pointer
|
|
"end" get resolve-label ;
|
|
|
|
: %target ( label -- ) 0 cell, rel-absolute-cell rel-label ;
|
|
|
|
: %return ( -- ) %epilogue RET ;
|
|
|
|
: %move-int>int ( dst src -- )
|
|
[ v>operand ] 2apply MOV ;
|
|
|
|
: %move-int>float ( dst src -- )
|
|
[ v>operand ] 2apply float-offset [+] MOVSD ;
|
|
|
|
M: int-regs (%peek) drop %move-int>int ;
|
|
|
|
M: int-regs (%replace) drop swap %move-int>int ;
|
|
|
|
: (%inc) swap cells dup 0 > [ ADD ] [ neg SUB ] if ;
|
|
|
|
: %inc-d ( n -- ) ds-reg (%inc) ;
|
|
|
|
: %inc-r ( n -- ) cs-reg (%inc) ;
|
|
|
|
M: object %stack>freg 3drop ;
|
|
|
|
M: object %freg>stack 3drop ;
|