cpu.architecture: alter param-regs to take abi as an (ignored for now) argument

release
Joe Groff 2010-04-01 02:53:40 -07:00
parent fca8ba3d0a
commit 4fd61f0b5c
10 changed files with 40 additions and 37 deletions

View File

@ -300,12 +300,12 @@ M: float-rep next-fastcall-param
M: double-rep next-fastcall-param
float-regs inc [ ?dummy-stack-params ] [ ?dummy-int-params ] bi ;
GENERIC: reg-class-full? ( reg-class -- ? )
GENERIC# reg-class-full? 1 ( reg-class abi -- ? )
M: stack-params reg-class-full? drop t ;
M: stack-params reg-class-full? 2drop t ;
M: reg-class reg-class-full?
[ get ] [ param-regs length ] bi >= ;
[ get ] swap '[ _ param-regs length ] bi >= ;
: alloc-stack-param ( rep -- n reg-class rep )
stack-params get
@ -315,10 +315,10 @@ M: reg-class reg-class-full?
: alloc-fastcall-param ( rep -- n reg-class rep )
[ [ reg-class-of get ] [ reg-class-of ] [ next-fastcall-param ] tri ] keep ;
: alloc-parameter ( parameter -- reg rep )
c-type-rep dup reg-class-of reg-class-full?
:: alloc-parameter ( parameter abi -- reg rep )
parameter c-type-rep dup reg-class-of abi reg-class-full?
[ alloc-stack-param ] [ alloc-fastcall-param ] if
[ param-reg ] dip ;
[ abi param-reg ] dip ;
: (flatten-int-type) ( type -- seq )
stack-size cell align cell /i void* c-type <repetition> ;
@ -355,8 +355,8 @@ M: c-type-name flatten-value-type c-type flatten-value-type ;
#! Moves values from C stack to registers (if word is
#! %load-param-reg) and registers to C stack (if word is
#! %save-param-reg).
[ alien-parameters flatten-value-types ]
[ '[ alloc-parameter _ execute ] ]
[ [ alien-parameters flatten-value-types ] [ abi>> ] bi ]
[ '[ _ alloc-parameter _ execute ] ]
bi* each-parameter ; inline
: reverse-each-parameter ( parameters quot -- )

View File

@ -484,15 +484,15 @@ HOOK: %loop-entry cpu ( -- )
GENERIC: return-reg ( reg-class -- reg )
! Sequence of registers used for parameter passing in class
GENERIC: param-regs ( reg-class -- regs )
GENERIC# param-regs 1 ( reg-class abi -- regs )
M: stack-params param-regs drop f ;
M: stack-params param-regs 2drop f ;
GENERIC: param-reg ( n reg-class -- reg )
GENERIC# param-reg 1 ( n reg-class abi -- reg )
M: reg-class param-reg param-regs nth ;
M: stack-params param-reg drop ;
M: stack-params param-reg 2drop ;
! Is this integer small enough to be an immediate operand for
! %add-imm, %sub-imm, and %mul-imm?

View File

@ -13,7 +13,7 @@ M: linux reserved-area-size 2 cells ;
M: linux lr-save 1 cells ;
M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 } ;
M: float-regs param-regs 2drop { 1 2 3 4 5 6 7 8 } ;
M: ppc value-struct? drop f ;

View File

@ -8,7 +8,7 @@ M: macosx reserved-area-size 6 cells ;
M: macosx lr-save 2 cells ;
M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 9 10 11 12 13 } ;
M: float-regs param-regs 2drop { 1 2 3 4 5 6 7 8 9 10 11 12 13 } ;
M: ppc value-struct? drop t ;

View File

@ -237,7 +237,7 @@ M: spill-slot float-function-param* [ 1 ] dip n>> spill@ LFD ;
M: integer float-function-param* FMR ;
: float-function-param ( i src -- )
[ float-regs param-regs nth ] dip float-function-param* ;
[ float-regs cdecl param-regs nth ] dip float-function-param* ;
: float-function-return ( reg -- )
float-regs return-reg double-rep %copy ;
@ -587,7 +587,7 @@ M: ppc %reload ( dst rep src -- )
M: ppc %loop-entry ;
M: int-regs return-reg drop 3 ;
M: int-regs param-regs drop { 3 4 5 6 7 8 9 10 } ;
M: int-regs param-regs 2drop { 3 4 5 6 7 8 9 10 } ;
M: float-regs return-reg drop 1 ;
M:: ppc %save-param-reg ( stack reg rep -- )
@ -647,7 +647,7 @@ M:: ppc %box ( n rep func -- )
! If the source is a stack location, load it into freg #0.
! If the source is f, then we assume the value is already in
! freg #0.
n [ 0 rep reg-class-of param-reg rep %load-param-reg ] when*
n [ 0 rep reg-class-of cdecl param-reg rep %load-param-reg ] when*
rep double-rep? 5 4 ? %load-vm-addr
func f %alien-invoke ;

View File

@ -85,8 +85,8 @@ M: x86.32 return-struct-in-registers? ( c-type -- ? )
! On x86, parameters are never passed in registers.
M: int-regs return-reg drop EAX ;
M: int-regs param-regs drop { } ;
M: float-regs param-regs drop { } ;
M: int-regs param-regs 2drop { } ;
M: float-regs param-regs 2drop { } ;
GENERIC: load-return-reg ( src rep -- )
GENERIC: store-return-reg ( dst rep -- )
@ -297,14 +297,17 @@ M:: x86.32 %binary-float-function ( dst src1 src2 func -- )
[ abi>> mingw = os windows? not or ]
bi and ;
: callee-cleanup? ( abi -- ? )
{ stdcall fastcall thiscall } member? ;
M: x86.32 %cleanup ( params -- )
#! a) If we just called an stdcall function in Windows, it
#! a) If we just called a stdcall function in Windows, it
#! cleaned up the stack frame for us. But we don't want that
#! so we 'undo' the cleanup since we do that in %epilogue.
#! b) If we just called a function returning a struct, we
#! have to fix ESP.
{
{ [ dup abi>> stdcall? ] [ drop ESP stack-frame get params>> SUB ] }
{ [ dup abi>> callee-cleanup? ] [ drop ESP stack-frame get params>> SUB ] }
{ [ dup funny-large-struct-return? ] [ drop EAX PUSH ] }
[ drop ]
} cond ;

View File

@ -11,10 +11,10 @@ cpu.architecture vm ;
FROM: layouts => cell cells ;
IN: cpu.x86.64
: param-reg-0 ( -- reg ) 0 int-regs param-reg ; inline
: param-reg-1 ( -- reg ) 1 int-regs param-reg ; inline
: param-reg-2 ( -- reg ) 2 int-regs param-reg ; inline
: param-reg-3 ( -- reg ) 3 int-regs param-reg ; inline
: param-reg-0 ( -- reg ) 0 int-regs cdecl param-reg ; inline
: param-reg-1 ( -- reg ) 1 int-regs cdecl param-reg ; inline
: param-reg-2 ( -- reg ) 2 int-regs cdecl param-reg ; inline
: param-reg-3 ( -- reg ) 3 int-regs cdecl param-reg ; inline
M: x86.64 pic-tail-reg RBX ;
@ -154,7 +154,7 @@ M:: x86.64 %unbox-large-struct ( n c-type -- )
"to_value_struct" f %alien-invoke ;
: load-return-value ( rep -- )
[ [ 0 ] dip reg-class-of param-reg ]
[ [ 0 ] dip reg-class-of cdecl param-reg ]
[ reg-class-of return-reg ]
[ ]
tri %copy ;
@ -162,7 +162,7 @@ M:: x86.64 %unbox-large-struct ( n c-type -- )
M:: x86.64 %box ( n rep func -- )
n [
n
0 rep reg-class-of param-reg
0 rep reg-class-of cdecl param-reg
rep %load-param-reg
] [
rep load-return-value
@ -249,7 +249,7 @@ M: x86.64 %end-callback-value ( ctype -- )
unbox-return ;
: float-function-param ( i src -- )
[ float-regs param-regs nth ] dip double-rep %copy ;
[ float-regs cdecl param-regs nth ] dip double-rep %copy ;
: float-function-return ( reg -- )
float-regs return-reg double-rep %copy ;

View File

@ -7,10 +7,10 @@ compiler.cfg.registers ;
IN: cpu.x86.64.unix
M: int-regs param-regs
drop { RDI RSI RDX RCX R8 R9 } ;
2drop { RDI RSI RDX RCX R8 R9 } ;
M: float-regs param-regs
drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
2drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
M: x86.64 reserved-stack-space 0 ;

View File

@ -5,9 +5,9 @@ compiler.cfg.registers cpu.architecture cpu.x86.assembler cpu.x86
cpu.x86.assembler.operands ;
IN: cpu.x86.64.winnt
M: int-regs param-regs drop { RCX RDX R8 R9 } ;
M: int-regs param-regs 2drop { RCX RDX R8 R9 } ;
M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ;
M: float-regs param-regs 2drop { XMM0 XMM1 XMM2 XMM3 } ;
M: x86.64 reserved-stack-space 4 cells ;

View File

@ -4,22 +4,22 @@ IN: math.floats.env.x86.64
M: x86.64 get-sse-env
void { void* } cdecl [
int-regs param-regs first [] STMXCSR
int-regs cdecl param-regs first [] STMXCSR
] alien-assembly ;
M: x86.64 set-sse-env
void { void* } cdecl [
int-regs param-regs first [] LDMXCSR
int-regs cdecl param-regs first [] LDMXCSR
] alien-assembly ;
M: x86.64 get-x87-env
void { void* } cdecl [
int-regs param-regs first [] FNSTSW
int-regs param-regs first 2 [+] FNSTCW
int-regs cdecl param-regs first [] FNSTSW
int-regs cdecl param-regs first 2 [+] FNSTCW
] alien-assembly ;
M: x86.64 set-x87-env
void { void* } cdecl [
FNCLEX
int-regs param-regs first 2 [+] FLDCW
int-regs cdecl param-regs first 2 [+] FLDCW
] alien-assembly ;