From f89b85db7b81d67cc22df6fdea6ca9b9cc19a60d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 12 May 2010 01:40:41 -0400 Subject: [PATCH] Temporary fixes for x86-32 until FFI boxing is rewritten --- basis/compiler/cfg/builder/alien/alien.factor | 19 +++++-- basis/cpu/architecture/architecture.factor | 3 ++ basis/cpu/x86/32/32.factor | 51 +++++++++++++++---- basis/cpu/x86/64/64.factor | 5 ++ basis/cpu/x86/x86.factor | 3 -- 5 files changed, 65 insertions(+), 16 deletions(-) diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor index 7f42bdf322..d3bcbd3517 100644 --- a/basis/compiler/cfg/builder/alien/alien.factor +++ b/basis/compiler/cfg/builder/alien/alien.factor @@ -64,8 +64,7 @@ M:: struct-c-type unbox-parameter ( src c-type -- ) ] when ; : (objects>registers) ( vregs -- ) - ! Place instructions in reverse order, so that the - ! ##store-stack-param instructions come first. This ensures + ! Place ##store-stack-param instructions first. This ensures ! that no registers are used after the ##store-reg-param ! instructions. [ @@ -73,7 +72,7 @@ M:: struct-c-type unbox-parameter ( src c-type -- ) [ [ alloc-stack-param ] keep \ ##store-stack-param new-insn ] [ [ next-reg-param ] keep \ ##store-reg-param new-insn ] if - ] map reverse % ; + ] map [ ##store-stack-param? ] partition [ % ] bi@ ; : objects>registers ( params -- stack-size ) [ abi>> ] [ parameters>> ] [ return>> ] tri @@ -230,8 +229,20 @@ GENERIC: flatten-c-type ( type -- reps ) M: struct-c-type flatten-c-type flatten-struct-type [ first2 [ drop stack-params ] when ] map ; + M: long-long-type flatten-c-type drop { int-rep int-rep } ; -M: c-type flatten-c-type rep>> 1array ; + +M: c-type flatten-c-type + rep>> { + { int-rep [ { int-rep } ] } + { float-rep [ float-on-stack? { stack-params } { float-rep } ? ] } + { double-rep [ + float-on-stack? + cell 4 = { stack-params stack-params } { stack-params } ? + { double-rep } ? + ] } + } case ; + M: object flatten-c-type base-type flatten-c-type ; : flatten-c-types ( types -- reps ) diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 2d9f845c57..3aa1f67356 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -552,6 +552,9 @@ HOOK: dummy-fp-params? cpu ( -- ? ) ! If t, long longs are never passed in param regs HOOK: long-long-on-stack? cpu ( -- ? ) +! If t, floats are never passed in param regs +HOOK: float-on-stack? cpu ( -- ? ) + ! If t, the struct return pointer is never passed in a param reg HOOK: struct-return-on-stack? cpu ( -- ? ) diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 68957e0f5f..bbd304ee47 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -7,6 +7,7 @@ command-line make words compiler compiler.units compiler.constants compiler.alien compiler.codegen compiler.codegen.fixup compiler.cfg.instructions compiler.cfg.builder compiler.cfg.builder.alien +compiler.cfg.builder.alien.params compiler.cfg.intrinsics compiler.cfg.stack-frame cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 cpu.architecture vm ; @@ -116,11 +117,37 @@ M: stack-params store-return-reg drop EAX MOV ; M: int-rep load-return-reg drop EAX swap MOV ; M: int-rep store-return-reg drop EAX MOV ; -M: float-rep load-return-reg drop FLDS ; -M: float-rep store-return-reg drop FSTPS ; +:: load-float-return ( src x87-insn sse-insn -- ) + src register? [ + ESP 4 SUB + ESP [] src sse-insn execute + ESP [] x87-insn execute + ESP 4 ADD + ] [ + src x87-insn execute + ] if ; inline -M: double-rep load-return-reg drop FLDL ; -M: double-rep store-return-reg drop FSTPL ; +:: store-float-return ( dst x87-insn sse-insn -- ) + dst register? [ + ESP 4 SUB + ESP [] x87-insn execute + dst ESP [] sse-insn execute + ESP 4 ADD + ] [ + dst x87-insn execute + ] if ; inline + +M: float-rep load-return-reg + drop \ FLDS \ MOVSS load-float-return ; + +M: float-rep store-return-reg + drop \ FSTPS \ MOVSS store-float-return ; + +M: double-rep load-return-reg + drop \ FLDL \ MOVSD load-float-return ; + +M: double-rep store-return-reg + drop \ FSTPL \ MOVSD store-float-return ; M: x86.32 %prologue ( n -- ) dup PUSH @@ -138,9 +165,12 @@ M: x86.32 %prepare-jump M:: x86.32 %unbox ( dst src func rep -- ) src func call-unbox-func - dst rep reg-class-of return-reg rep %copy ; + dst ?spill-slot rep store-return-reg ; -M:: x86.32 %store-long-long-return ( src1 src2 n func -- ) +M:: x86.32 %store-return ( src rep -- ) + src ?spill-slot rep load-return-reg ; + +M:: x86.32 %store-long-long-return ( src1 src2 -- ) src2 EAX = [ src1 src2 XCHG src2 src1 ] [ src1 src2 ] if :> ( src1 src2 ) EAX src1 int-rep %copy EDX src2 int-rep %copy ; @@ -256,9 +286,9 @@ M:: x86.32 %binary-float-function ( dst src1 src2 func -- ) bi and ; : stack-arg-size ( params -- n ) - dup abi>> '[ + dup abi>> [ alien-parameters flatten-c-types - [ _ alloc-parameter 2drop ] each + [ alloc-parameter 2drop ] each stack-params get ] with-param-regs ; @@ -289,7 +319,10 @@ M: x86.32 dummy-fp-params? f ; M: x86.32 long-long-on-stack? t ; -M: x86.32 structs-on-stack? t ; +M: x86.32 float-on-stack? t ; + +M: x86.32 flatten-struct-type + stack-size cell /i { int-rep t } ; M: x86.32 struct-return-on-stack? os linux? not ; diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 3721c17cf4..0a43961888 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -124,6 +124,9 @@ M:: x86.64 %unbox ( dst src func rep -- ) { float-regs [ float-regs get pop swap MOVSD ] } } case ; +M:: x86.64 %store-return ( src rep -- ) + rep reg-class-of return-reg src rep %copy ; + M:: x86.64 %store-struct-return ( src c-type -- ) ! Move src to R11 so that we don't clobber it. R11 src int-rep %copy @@ -220,6 +223,8 @@ M:: x86.64 %call-gc ( gc-roots -- ) M: x86.64 long-long-on-stack? f ; +M: x86.64 float-on-stack? f ; + M: x86.64 struct-return-on-stack? f ; ! The result of reading 4 bytes from memory is a fixnum on diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index bdf325a826..78e6131795 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -1458,9 +1458,6 @@ M:: x86 %store-reg-param ( src reg rep -- ) M:: x86 %store-stack-param ( src n rep -- ) n param@ src rep %copy ; -M:: x86 %store-return ( src rep -- ) - rep reg-class-of return-reg src rep %copy ; - HOOK: struct-return@ cpu ( n -- operand ) M: x86 %prepare-struct-area ( dst -- )