Fixes for FFI changes

db4
Slava Pestov 2010-05-16 04:09:47 -04:00
parent 5b48cd2a63
commit e6abc0be15
4 changed files with 206 additions and 208 deletions

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008, 2010 Slava Pestov. ! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays layouts math math.order math.parser USING: accessors assocs arrays layouts math math.order math.parser
combinators combinators.short-circuit fry make sequences combinators combinators.short-circuit fry make sequences
sequences.generalizations alien alien.private alien.strings sequences.generalizations alien alien.private alien.strings
alien.c-types alien.libraries classes.struct namespaces kernel alien.c-types alien.libraries classes.struct namespaces kernel
@ -151,7 +151,9 @@ M: #alien-assembly emit-node
[ [
[ [ first2 callee-parameter ] 1 2 mnmap ] 1 2 mnmap [ [ first2 callee-parameter ] 1 2 mnmap ] 1 2 mnmap
concat [ ##load-reg-param? ] partition [ % ] bi@ concat [ ##load-reg-param? ] partition [ % ] bi@
] keep ; ]
[ [ keys ] map ]
bi ;
: box-parameters ( vregs reps params -- ) : box-parameters ( vregs reps params -- )
##begin-callback ##begin-callback

View File

@ -85,7 +85,7 @@ M: long-long-type unbox-return (unbox-return) store-return ;
M: struct-c-type unbox-return M: struct-c-type unbox-return
dup return-struct-in-registers? dup return-struct-in-registers?
[ unbox keys store-return ] [ (unbox-return) store-return ]
[ [ struct-return-area get ] 2dip (unbox-return) implode-struct ] if ; [ [ struct-return-area get ] 2dip (unbox-return) implode-struct ] if ;
GENERIC: flatten-parameter-type ( c-type -- reps ) GENERIC: flatten-parameter-type ( c-type -- reps )
@ -121,8 +121,7 @@ GENERIC: box-return ( c-type -- dst )
: load-return ( c-type -- vregs reps ) : load-return ( c-type -- vregs reps )
[ [
flatten-c-type keys flatten-c-type keys
[ [ [ next-return-reg ] keep ^^load-reg-param ] keep ] [ [ [ next-return-reg ] keep ^^load-reg-param ] map ] keep
1 2 mnmap
] with-return-regs ; ] with-return-regs ;
M: c-type box-return [ load-return ] keep box ; M: c-type box-return [ load-return ] keep box ;

View File

@ -7,9 +7,6 @@ cpu.x86 cpu.x86.64 compiler.cfg.builder.alien
compiler.cfg.builder.alien.boxing compiler.cfg.registers ; compiler.cfg.builder.alien.boxing compiler.cfg.registers ;
IN: cpu.x86.64.unix IN: cpu.x86.64.unix
M: int-regs param-regs
2drop { RDI RSI RDX RCX R8 R9 } ;
M: x86.64 param-regs M: x86.64 param-regs
drop { drop {
{ int-regs { RDI RSI RDX RCX R8 R9 } } { int-regs { RDI RSI RDX RCX R8 R9 } }

View File

@ -88,11 +88,11 @@ MEMO: sse-version ( -- n )
: popcnt? ( -- ? ) : popcnt? ( -- ? )
bool { } cdecl [ bool { } cdecl [
int-regs return-reg 1 MOV return-reg 1 MOV
CPUID CPUID
ECX 23 BT ECX 23 BT
int-regs return-reg dup XOR return-reg dup XOR
int-regs return-reg SETB return-reg SETB
] alien-assembly ; ] alien-assembly ;
: sse-string ( version -- string ) : sse-string ( version -- string )