steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge git://factorcode.org/git/factor

release
Doug Coleman 2007-10-31 14:33:30 -05:00
parent 5ca4f88188 edca458b09
commit ac208e23ff
3 changed files with 18 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/alien/compiler/compiler.factor
View File

@ -248,6 +248,7 @@ M: alien-invoke generate-node
end-basic-block end-basic-block
%prepare-alien-invoke %prepare-alien-invoke
dup objects>registers dup objects>registers
%prepare-var-args
dup alien-invoke-dlsym %alien-invoke dup alien-invoke-dlsym %alien-invoke
dup %cleanup dup %cleanup
box-return* box-return*
@ -287,6 +288,7 @@ M: alien-indirect generate-node
! Save alien at top of stack to temporary storage ! Save alien at top of stack to temporary storage
%prepare-alien-indirect %prepare-alien-indirect
dup objects>registers dup objects>registers
%prepare-var-args
! Call alien in temporary storage ! Call alien in temporary storage
%alien-indirect %alien-indirect
dup %cleanup dup %cleanup

4
core/cpu/architecture/architecture.factor
View File

@ -132,6 +132,10 @@ GENERIC: %load-param-reg ( stack reg reg-class -- )
HOOK: %prepare-alien-invoke compiler-backend ( -- ) HOOK: %prepare-alien-invoke compiler-backend ( -- )
HOOK: %prepare-var-args compiler-backend ( -- )
M: object %prepare-var-args ;
HOOK: %alien-invoke compiler-backend ( library function -- ) HOOK: %alien-invoke compiler-backend ( library function -- )
HOOK: %cleanup compiler-backend ( alien-node -- ) HOOK: %cleanup compiler-backend ( alien-node -- )

28
core/cpu/x86/64/64.factor
View File

@ -40,9 +40,6 @@ M: amd64-backend address-operand ( address -- operand )
#! call, where all vregs have been flushed anyway. #! call, where all vregs have been flushed anyway.
temp-reg v>operand [ swap MOV ] keep ; temp-reg v>operand [ swap MOV ] keep ;
: compile-c-call ( symbol dll -- )
0 address-operand >r rc-absolute-cell rel-dlsym r> CALL ;
M: amd64-backend fixnum>slot@ drop ; M: amd64-backend fixnum>slot@ drop ;
M: amd64-backend prepare-division CQO ; M: amd64-backend prepare-division CQO ;
@ -65,7 +62,7 @@ M: amd64-backend %prepare-unbox ( -- )
M: amd64-backend %unbox ( n reg-class func -- ) M: amd64-backend %unbox ( n reg-class func -- )
! Call the unboxer ! Call the unboxer
f compile-c-call f %alien-invoke
! Store the return value on the C stack ! Store the return value on the C stack
over [ [ return-reg ] keep %save-param-reg ] [ 2drop ] if ; over [ [ return-reg ] keep %save-param-reg ] [ 2drop ] if ;
@ -74,13 +71,13 @@ M: amd64-backend %unbox-long-long ( n func -- )
M: amd64-backend %unbox-struct-1 ( -- ) M: amd64-backend %unbox-struct-1 ( -- )
#! Alien must be in RDI. #! Alien must be in RDI.
"alien_offset" f compile-c-call "alien_offset" f %alien-invoke
! Load first cell ! Load first cell
RAX RAX [] MOV ; RAX RAX [] MOV ;
M: amd64-backend %unbox-struct-2 ( -- ) M: amd64-backend %unbox-struct-2 ( -- )
#! Alien must be in RDI. #! Alien must be in RDI.
"alien_offset" f compile-c-call "alien_offset" f %alien-invoke
! Load second cell ! Load second cell
RDX RAX cell [+] MOV RDX RAX cell [+] MOV
! Load first cell ! Load first cell
@ -93,7 +90,7 @@ M: amd64-backend %unbox-large-struct ( n size -- )
! Load structure size ! Load structure size
RDX swap MOV RDX swap MOV
! Copy the struct to the C stack ! Copy the struct to the C stack
"to_value_struct" f compile-c-call ; "to_value_struct" f %alien-invoke ;
: load-return-value ( reg-class -- ) : load-return-value ( reg-class -- )
0 over param-reg swap return-reg 0 over param-reg swap return-reg
@ -105,7 +102,7 @@ M: amd64-backend %box ( n reg-class func -- )
] [ ] [
swap load-return-value swap load-return-value
] if* ] if*
f compile-c-call ; f %alien-invoke ;
M: amd64-backend %box-long-long ( n func -- ) M: amd64-backend %box-long-long ( n func -- )
T{ int-regs } swap %box ; T{ int-regs } swap %box ;
@ -117,7 +114,7 @@ M: amd64-backend %box-small-struct ( size -- )
RDI RAX MOV RDI RAX MOV
RSI RDX MOV RSI RDX MOV
RDX swap MOV RDX swap MOV
"box_small_struct" f compile-c-call ; "box_small_struct" f %alien-invoke ;
M: amd64-backend %box-large-struct ( n size -- ) M: amd64-backend %box-large-struct ( n size -- )
! Struct size is parameter 2 ! Struct size is parameter 2
@ -125,28 +122,27 @@ M: amd64-backend %box-large-struct ( n size -- )
! Compute destination address ! Compute destination address
swap struct-return@ RDI RSP rot [+] LEA swap struct-return@ RDI RSP rot [+] LEA
! Copy the struct from the C stack ! Copy the struct from the C stack
"box_value_struct" f compile-c-call ; "box_value_struct" f %alien-invoke ;
M: amd64-backend %prepare-box-struct ( size -- ) M: amd64-backend %prepare-box-struct ( size -- )
! Compute target address for value struct return ! Compute target address for value struct return
RAX RSP rot f struct-return@ [+] LEA RAX RSP rot f struct-return@ [+] LEA
RSP 0 [+] RAX MOV ; RSP 0 [+] RAX MOV ;
: reset-sse RAX RAX XOR ; M: amd64-backend %prepare-var-args RAX RAX XOR ;
M: amd64-backend %alien-invoke ( symbol dll -- ) M: amd64-backend %alien-invoke ( symbol dll -- )
reset-sse compile-c-call ; 0 address-operand >r rc-absolute-cell rel-dlsym r> CALL ;
M: amd64-backend %prepare-alien-indirect ( -- ) M: amd64-backend %prepare-alien-indirect ( -- )
"unbox_alien" f compile-c-call "unbox_alien" f %alien-invoke
cell temp@ RAX MOV ; cell temp@ RAX MOV ;
M: amd64-backend %alien-indirect ( -- ) M: amd64-backend %alien-indirect ( -- )
reset-sse
cell temp@ CALL ; cell temp@ CALL ;
M: amd64-backend %alien-callback ( quot -- ) M: amd64-backend %alien-callback ( quot -- )
RDI load-indirect "c_to_factor" f compile-c-call ; RDI load-indirect "c_to_factor" f %alien-invoke ;
M: amd64-backend %callback-value ( ctype -- ) M: amd64-backend %callback-value ( ctype -- )
! Save top of data stack ! Save top of data stack
@ -205,4 +201,4 @@ M: struct-type flatten-value-type ( type -- seq )
] each ] each
] if ; ] if ;
14 set-profiler-prologues 12 set-profiler-prologues