-! Copyright (C) 2005, 2010 Slava Pestov.
+! Copyright (C) 2005, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: locals alien alien.c-types alien.libraries alien.syntax
arrays kernel fry math namespaces sequences system layouts io
vocabs.loader accessors init classes.struct combinators make
-words compiler.constants compiler.codegen.fixup
+words compiler.constants compiler.codegen.gc-maps
+compiler.codegen.labels compiler.codegen.relocation
compiler.cfg.instructions compiler.cfg.builder
compiler.cfg.builder.alien.boxing compiler.cfg.intrinsics
compiler.cfg.stack-frame cpu.x86.assembler
IN: cpu.x86.32
: x86-float-regs ( -- seq )
- "cpu.x86.sse" vocab
+ "cpu.x86.sse" lookup-vocab
{ XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 }
{ ST0 ST1 ST2 ST3 ST4 ST5 ST6 }
? ;
[ 0 MOV ] dip rc-absolute-cell rel-vm ;
M: x86.32 %mark-card
- drop HEX: ffffffff [+] card-mark <byte> MOV
+ drop 0xffffffff [+] card-mark <byte> MOV
building get pop
rc-absolute-cell rel-cards-offset
building get push ;
M: x86.32 %mark-deck
- drop HEX: ffffffff [+] card-mark <byte> MOV
+ drop 0xffffffff [+] card-mark <byte> MOV
building get pop
rc-absolute-cell rel-decks-offset
building get push ;
-M:: x86.32 %dispatch ( src temp -- )
- ! Load jump table base.
- temp src HEX: ffffffff [+] LEA
- building get length :> start
- 0 rc-absolute-cell rel-here
- ! Go
- temp HEX: 7f [+] JMP
- building get length :> end
- ! Fix up the displacement above
- cell alignment
- [ end start - + building get dup pop* push ]
- [ (align-code) ]
- bi ;
-
M: x86.32 pic-tail-reg EDX ;
M: x86.32 reserved-stack-space 0 ;
stack@ 0 MOV 0 rc-absolute-cell rel-vm ;
M: x86.32 return-struct-in-registers? ( c-type -- ? )
- c-type
+ lookup-c-type
[ return-in-registers?>> ]
[ heap-size { 1 2 4 8 } member? ] bi
- os { linux netbsd solaris } member? not
+ os linux? not
and or ;
! On x86, parameters are usually never passed in registers,
M: x86.32 %prepare-jump
pic-tail-reg 0 MOV xt-tail-pic-offset rc-absolute-cell rel-here ;
+M: x86.32 %load-stack-param ( dst rep n -- )
+ next-stack@ swap pick register? [ %copy ] [
+ {
+ { int-rep [ [ EAX ] dip MOV ?spill-slot EAX MOV ] }
+ { float-rep [ FLDS ?spill-slot FSTPS ] }
+ { double-rep [ FLDL ?spill-slot FSTPL ] }
+ } case
+ ] if ;
+
+M: x86.32 %store-stack-param ( src rep n -- )
+ stack@ swap pick register? [ [ swap ] dip %copy ] [
+ {
+ { int-rep [ [ [ EAX ] dip ?spill-slot MOV ] [ EAX MOV ] bi* ] }
+ { float-rep [ [ ?spill-slot FLDS ] [ FSTPS ] bi* ] }
+ { double-rep [ [ ?spill-slot FLDL ] [ FSTPL ] bi* ] }
+ } case
+ ] if ;
+
:: load-float-return ( dst x87-insn rep -- )
dst register? [
ESP 4 SUB
dst ?spill-slot x87-insn execute
] if ; inline
-M: x86.32 %load-reg-param ( dst reg rep -- )
- {
+M: x86.32 %load-reg-param ( vreg rep reg -- )
+ swap {
{ int-rep [ int-rep %copy ] }
{ float-rep [ drop \ FSTPS float-rep load-float-return ] }
{ double-rep [ drop \ FSTPL double-rep load-float-return ] }
src ?spill-slot x87-insn execute
] if ; inline
-M: x86.32 %store-reg-param ( src reg rep -- )
- {
+M: x86.32 %store-reg-param ( vreg rep reg -- )
+ swap {
{ int-rep [ swap int-rep %copy ] }
{ float-rep [ drop \ FLDS float-rep store-float-return ] }
{ double-rep [ drop \ FLDL double-rep store-float-return ] }
} case ;
+M: x86.32 %discard-reg-param ( rep reg -- )
+ drop {
+ { int-rep [ ] }
+ { float-rep [ ST0 FSTP ] }
+ { double-rep [ ST0 FSTP ] }
+ } case ;
+
:: call-unbox-func ( src func -- )
EAX src tagged-rep %copy
4 save-vm-ptr
0 stack@ EAX MOV
- func f %alien-invoke ;
+ func f f %c-invoke ;
M:: x86.32 %unbox ( dst src func rep -- )
src func call-unbox-func
dst rep %load-return ;
-M:: x86.32 %unbox-long-long ( src out func -- )
- EAX src int-rep %copy
- 0 stack@ EAX MOV
- EAX out int-rep %copy
- 4 stack@ EAX MOV
- 8 save-vm-ptr
- func f %alien-invoke ;
+M:: x86.32 %unbox-long-long ( dst1 dst2 src func -- )
+ src int-rep 0 %store-stack-param
+ 4 save-vm-ptr
+ func f f %c-invoke
+ dst1 EAX int-rep %copy
+ dst2 EDX int-rep %copy ;
-M:: x86.32 %box ( dst src func rep -- )
+M:: x86.32 %box ( dst src func rep gc-map -- )
+ src rep 0 %store-stack-param
rep rep-size save-vm-ptr
- src rep %store-return
- 0 stack@ rep %load-return
- func f %alien-invoke
+ func f gc-map %c-invoke
dst EAX tagged-rep %copy ;
-M:: x86.32 %box-long-long ( dst src1 src2 func -- )
+M:: x86.32 %box-long-long ( dst src1 src2 func gc-map -- )
+ src1 int-rep 0 %store-stack-param
+ src2 int-rep 4 %store-stack-param
8 save-vm-ptr
- EAX src1 int-rep %copy
- 0 stack@ EAX int-rep %copy
- EAX src2 int-rep %copy
- 4 stack@ EAX int-rep %copy
- func f %alien-invoke
- dst EAX tagged-rep %copy ;
-
-M:: x86.32 %allot-byte-array ( dst size -- )
- 4 save-vm-ptr
- 0 stack@ size MOV
- "allot_byte_array" f %alien-invoke
+ func f gc-map %c-invoke
dst EAX tagged-rep %copy ;
-M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
+M: x86.32 %c-invoke
+ [ 0 CALL rc-relative rel-dlsym ] dip gc-map-here ;
M: x86.32 %begin-callback ( -- )
0 save-vm-ptr
4 stack@ 0 MOV
- "begin_callback" f %alien-invoke ;
-
-M: x86.32 %alien-callback ( quot -- )
- [ EAX ] dip %load-reference
- EAX quot-entry-point-offset [+] CALL ;
+ "begin_callback" f f %c-invoke ;
M: x86.32 %end-callback ( -- )
0 save-vm-ptr
- "end_callback" f %alien-invoke ;
-
-GENERIC: float-function-param ( n dst src -- )
-
-M:: spill-slot float-function-param ( n dst src -- )
- ! We can clobber dst here since its going to contain the
- ! final result
- dst src double-rep %copy
- dst n double-rep %store-stack-param ;
-
-M:: register float-function-param ( n dst src -- )
- src n double-rep %store-stack-param ;
-
-M:: x86.32 %unary-float-function ( dst src func -- )
- 0 dst src float-function-param
- func "libm" load-library %alien-invoke
- dst double-rep %load-return ;
-
-M:: x86.32 %binary-float-function ( dst src1 src2 func -- )
- 0 dst src1 float-function-param
- 8 dst src2 float-function-param
- func "libm" load-library %alien-invoke
- dst double-rep %load-return ;
+ "end_callback" f f %c-invoke ;
: funny-large-struct-return? ( return abi -- ? )
#! MINGW ABI incompatibility disaster
[ large-struct? ] [ mingw eq? os windows? not or ] bi* and ;
+M: x86.32 %prepare-var-args ( -- ) ;
+
M:: x86.32 stack-cleanup ( stack-size return abi -- n )
#! a) Functions which are stdcall/fastcall/thiscall have to
#! clean up the caller's stack frame.
M: x86.32 %cleanup ( n -- )
[ ESP swap SUB ] unless-zero ;
-M:: x86.32 %call-gc ( gc-roots -- )
- 4 save-vm-ptr
- 0 stack@ gc-roots gc-root-offsets %load-reference
- "inline_gc" f %alien-invoke ;
+M: x86.32 %safepoint
+ 0 EAX MOVABS rc-absolute rel-safepoint ;
M: x86.32 dummy-stack-params? f ;
M: x86.32 float-on-stack? t ;
M: x86.32 flatten-struct-type
- call-next-method [ first t 2array ] map ;
+ call-next-method [ first t f 3array ] map ;
M: x86.32 struct-return-on-stack? os linux? not ;
projects / factor.git / blobdiff