From ba5b90e0633a59f19f64ee8ddbe68e4a4c0bc3e1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 3 Jan 2010 01:03:30 +1300 Subject: [PATCH] Change how non-volatile register preservation is done in alien callbacks, with the aim of fixing callbacks on PowerPC, and to eventually eliminate assembly code from VM - Simplify calculation of offset in relocation table - Open-code %alien-callback - Remove magic_frame hack from context objects - Move magical return instruction from optimizing compiler backend into callback entry stub --- basis/bootstrap/image/image.factor | 7 +- basis/compiler/cfg/builder/builder.factor | 6 +- basis/compiler/cfg/checker/checker.factor | 4 +- .../cfg/instructions/instructions.factor | 5 +- basis/compiler/codegen/codegen.factor | 7 +- basis/compiler/codegen/fixup/fixup.factor | 7 +- basis/compiler/constants/constants.factor | 3 +- basis/cpu/architecture/architecture.factor | 9 +- basis/cpu/x86/32/32.factor | 46 ++++---- basis/cpu/x86/32/bootstrap.factor | 2 + basis/cpu/x86/64/64.factor | 101 +++++++++--------- basis/cpu/x86/64/bootstrap.factor | 1 + basis/cpu/x86/64/unix/bootstrap.factor | 2 + basis/cpu/x86/64/winnt/bootstrap.factor | 2 + basis/cpu/x86/bootstrap.factor | 48 ++++++++- basis/cpu/x86/x86.factor | 22 +++- basis/stack-checker/alien/alien.factor | 14 +-- .../known-words/known-words.factor | 2 +- core/bootstrap/primitives.factor | 2 +- vm/callbacks.cpp | 24 ++++- vm/callbacks.hpp | 2 +- vm/contexts.cpp | 9 +- vm/contexts.hpp | 14 +-- vm/cpu-x86.32.S | 7 +- vm/cpu-x86.hpp | 2 +- vm/factor.cpp | 4 +- vm/instruction_operands.cpp | 43 ++++---- vm/instruction_operands.hpp | 4 +- vm/vm.hpp | 3 +- 29 files changed, 234 insertions(+), 168 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index b3eb7646af..bf2d14e3aa 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -109,12 +109,11 @@ SYMBOL: jit-relocations SYMBOL: jit-offset -: compute-offset ( rc -- offset ) - [ building get length jit-offset get + ] dip - rc-absolute-cell = bootstrap-cell 4 ? - ; +: compute-offset ( -- offset ) + building get length jit-offset get + ; : jit-rel ( rc rt -- ) - over compute-offset 3array jit-relocations get push-all ; + compute-offset 3array jit-relocations get push-all ; SYMBOL: jit-parameters diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index f1b3447fc7..e67b8e3737 100644 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2009 Slava Pestov. +! Copyright (C) 2004, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators hashtables kernel math fry namespaces make sequences words byte-arrays @@ -240,9 +240,9 @@ M: #alien-callback emit-node dup params>> xt>> dup [ ##prologue - dup [ ##alien-callback ] emit-alien-node + [ ##alien-callback ] emit-alien-node ##epilogue - params>> ##callback-return + ##return ] with-cfg-builder ; ! No-op nodes diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor index 051b0e3e1f..d6f2702ee7 100644 --- a/basis/compiler/cfg/checker/checker.factor +++ b/basis/compiler/cfg/checker/checker.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel combinators.short-circuit accessors math sequences sets assocs compiler.cfg.instructions compiler.cfg.rpo @@ -14,7 +14,7 @@ ERROR: bad-kill-block bb ; dup instructions>> dup penultimate ##epilogue? [ { [ length 2 = ] - [ last { [ ##return? ] [ ##callback-return? ] [ ##jump? ] } 1|| ] + [ last { [ ##return? ] [ ##jump? ] } 1|| ] } 1&& ] [ last ##branch? ] if [ drop ] [ bad-kill-block ] if ; diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 662c12ed33..20008ea85e 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs accessors arrays kernel sequences namespaces words math math.order layouts classes.algebra classes.union @@ -674,9 +674,6 @@ literal: params stack-frame ; INSN: ##alien-callback literal: params stack-frame ; -INSN: ##callback-return -literal: params ; - ! Instructions used by CFG IR only. INSN: ##prologue ; INSN: ##epilogue ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 430b48e1ef..c67048cf0d 100644 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces make math math.order math.parser sequences accessors kernel kernel.private layouts assocs words summary arrays @@ -496,11 +496,6 @@ TUPLE: callback-context ; [ callback-context new do-callback ] % ] [ ] make ; -M: ##callback-return generate-insn - #! All the extra book-keeping for %unwind is only for x86. - #! On other platforms its an alias for %return. - params>> %callback-return ; - M: ##alien-callback generate-insn params>> [ registers>objects ] diff --git a/basis/compiler/codegen/fixup/fixup.factor b/basis/compiler/codegen/fixup/fixup.factor index aafa6edd94..dbe7c864a5 100644 --- a/basis/compiler/codegen/fixup/fixup.factor +++ b/basis/compiler/codegen/fixup/fixup.factor @@ -34,13 +34,10 @@ TUPLE: label offset ; dup label? [ get ] unless compiled-offset >>offset drop ; -: offset-for-class ( class -- n ) - rc-absolute-cell = cell 4 ? compiled-offset swap - ; - TUPLE: label-fixup { label label } { class integer } { offset integer } ; : label-fixup ( label class -- ) - dup offset-for-class \ label-fixup boa label-table get push ; + compiled-offset \ label-fixup boa label-table get push ; ! Relocation table SYMBOL: relocation-table @@ -53,7 +50,7 @@ SYMBOL: relocation-table { 0 24 28 } bitfield relocation-table get push-4 ; : rel-fixup ( class type -- ) - swap dup offset-for-class add-relocation-entry ; + swap compiled-offset add-relocation-entry ; : add-dlsym-parameters ( symbol dll -- ) [ string>symbol add-parameter ] [ add-parameter ] bi* ; diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index cfa893546d..83b50b61f4 100644 --- a/basis/compiler/constants/constants.factor +++ b/basis/compiler/constants/constants.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: math kernel layouts system strings words quotations byte-arrays alien arrays literals sequences ; @@ -37,6 +37,7 @@ CONSTANT: rc-relative-ppc-3 6 CONSTANT: rc-relative-arm-3 7 CONSTANT: rc-indirect-arm 8 CONSTANT: rc-indirect-arm-pc 9 +CONSTANT: rc-absolute-2 10 ! Relocation types CONSTANT: rt-primitive 0 diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 26878f7c1f..5127b56acf 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2006, 2009 Slava Pestov. +! Copyright (C) 2006, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs generic kernel kernel.private math memory namespaces make sequences layouts system hashtables @@ -550,6 +550,8 @@ HOOK: %save-param-reg cpu ( stack reg rep -- ) HOOK: %load-param-reg cpu ( stack reg rep -- ) +HOOK: %load-context cpu ( temp1 temp2 -- ) + HOOK: %save-context cpu ( temp1 temp2 -- ) HOOK: %prepare-var-args cpu ( -- ) @@ -574,7 +576,6 @@ HOOK: %nest-stacks cpu ( -- ) HOOK: %unnest-stacks cpu ( -- ) -! Return to caller with stdcall unwinding (only for x86) -HOOK: %callback-return cpu ( params -- ) +HOOK: callback-return-rewind cpu ( params -- n ) -M: object %callback-return drop %return ; +M: object callback-return-rewind drop 0 ; diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 70c7b9d513..8b44b65809 100644 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2009 Slava Pestov. +! Copyright (C) 2005, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: locals alien.c-types alien.libraries alien.syntax arrays kernel fry math namespaces sequences system layouts io @@ -20,6 +20,7 @@ M: x86.32 machine-registers M: x86.32 ds-reg ESI ; M: x86.32 rs-reg EDI ; M: x86.32 stack-reg ESP ; +M: x86.32 frame-reg EBP ; M: x86.32 temp-reg ECX ; : local@ ( n -- op ) @@ -42,7 +43,7 @@ M: x86.32 %mark-deck M:: x86.32 %dispatch ( src temp -- ) ! Load jump table base. temp src HEX: ffffffff [+] LEA - building get length cell - :> start + building get length :> start 0 rc-absolute-cell rel-here ! Go temp HEX: 7f [+] JMP @@ -215,11 +216,7 @@ M:: x86.32 %unbox-large-struct ( n c-type -- ) "to_value_struct" f %alien-invoke ; M: x86.32 %nest-stacks ( -- ) - ! Save current frame to ctx->magic_frame. - ! See comment in vm/contexts.hpp. - EAX stack-reg stack-frame get total-size>> 3 cells - [+] LEA - 4 save-vm-ptr - 0 stack@ EAX MOV + 0 save-vm-ptr "nest_stacks" f %alien-invoke ; M: x86.32 %unnest-stacks ( -- ) @@ -238,10 +235,11 @@ M: x86.32 %alien-indirect ( -- ) EBP CALL ; M: x86.32 %alien-callback ( quot -- ) + EAX EDX %load-context EAX swap %load-reference - 0 stack@ EAX MOV - 4 save-vm-ptr - "c_to_factor" f %alien-invoke ; + EDX %mov-vm-ptr + EAX quot-xt-offset [+] CALL + EAX EDX %save-context ; M: x86.32 %callback-value ( ctype -- ) %pop-context-stack @@ -300,20 +298,6 @@ M: x86.32 %cleanup ( params -- ) [ drop ] } cond ; -M: x86.32 %callback-return ( n -- ) - #! a) If the callback is stdcall, we have to clean up the - #! caller's stack frame. - #! b) If the callback is returning a large struct, we have - #! to fix ESP. - { - { [ dup abi>> "stdcall" = ] [ - - [ params>> ] [ return>> ] bi + - ] } - { [ dup return>> large-struct? ] [ drop 4 ] } - [ drop 0 ] - } cond RET ; - M:: x86.32 %call-gc ( gc-root-count temp -- ) temp gc-root-base special@ LEA 8 save-vm-ptr @@ -327,6 +311,20 @@ M: x86.32 dummy-int-params? f ; M: x86.32 dummy-fp-params? f ; +M: x86.32 callback-return-rewind ( params -- n ) + #! a) If the callback is stdcall, we have to clean up the + #! caller's stack frame. + #! b) If the callback is returning a large struct, we have + #! to fix ESP. + { + { [ dup abi>> "stdcall" = ] [ + + [ params>> ] [ return>> ] bi + + ] } + { [ dup return>> large-struct? ] [ drop 4 ] } + [ drop 0 ] + } cond ; + ! Dreadful M: object flatten-value-type (flatten-int-type) ; diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor index bb289851ea..580db11946 100644 --- a/basis/cpu/x86/32/bootstrap.factor +++ b/basis/cpu/x86/32/bootstrap.factor @@ -18,6 +18,8 @@ IN: bootstrap.x86 : temp3 ( -- reg ) EBX ; : safe-reg ( -- reg ) EAX ; : stack-reg ( -- reg ) ESP ; +: frame-reg ( -- reg ) EBP ; +: nv-regs ( -- seq ) { ESI EDI EBX } ; : ds-reg ( -- reg ) ESI ; : rs-reg ( -- reg ) EDI ; : fixnum>slot@ ( -- ) temp0 2 SAR ; diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index f78fe366d9..5fc6ae8c16 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -1,17 +1,19 @@ -! Copyright (C) 2005, 2009 Slava Pestov. +! Copyright (C) 2005, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays kernel math namespaces make sequences system -layouts alien alien.c-types alien.accessors slots +USING: accessors arrays kernel math namespaces make sequences +system layouts alien alien.c-types alien.accessors slots splitting assocs combinators locals compiler.constants -compiler.codegen compiler.codegen.fixup compiler.cfg.instructions -compiler.cfg.builder compiler.cfg.intrinsics compiler.cfg.stack-frame -cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 cpu.architecture ; +compiler.codegen compiler.codegen.fixup +compiler.cfg.instructions compiler.cfg.builder +compiler.cfg.intrinsics compiler.cfg.stack-frame +cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 +cpu.architecture ; IN: cpu.x86.64 -: param-reg-1 ( -- reg ) int-regs param-regs first ; inline -: param-reg-2 ( -- reg ) int-regs param-regs second ; inline -: param-reg-3 ( -- reg ) int-regs param-regs third ; inline -: param-reg-4 ( -- reg ) int-regs param-regs fourth ; inline +: 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 M: x86.64 pic-tail-reg RBX ; @@ -21,6 +23,7 @@ M: float-regs return-reg drop XMM0 ; M: x86.64 ds-reg R14 ; M: x86.64 rs-reg R15 ; M: x86.64 stack-reg RSP ; +M: x86.64 frame-reg RBP ; M: x86.64 extra-stack-space drop 0 ; @@ -56,9 +59,9 @@ M: x86.64 %mark-deck [+] card-mark MOV ; M:: x86.64 %dispatch ( src temp -- ) - building get length :> start ! Load jump table base. temp HEX: ffffffff MOV + building get length :> start 0 rc-absolute-cell rel-here ! Add jump table base temp src ADD @@ -66,7 +69,7 @@ M:: x86.64 %dispatch ( src temp -- ) building get length :> end ! Fix up the displacement above cell code-alignment - [ end start - 2 - + building get dup pop* push ] + [ end start - + building get dup pop* push ] [ align-code ] bi ; @@ -89,16 +92,16 @@ M: x86.64 %load-param-reg [ swap param@ ] dip %copy ; ] with-scope ; inline M: x86.64 %pop-stack ( n -- ) - param-reg-1 swap ds-reg reg-stack MOV ; + param-reg-0 swap ds-reg reg-stack MOV ; M: x86.64 %pop-context-stack ( -- ) temp-reg %load-context-datastack - param-reg-1 temp-reg [] MOV - param-reg-1 param-reg-1 [] MOV + param-reg-0 temp-reg [] MOV + param-reg-0 param-reg-0 [] MOV temp-reg [] bootstrap-cell SUB ; M:: x86.64 %unbox ( n rep func -- ) - param-reg-2 %mov-vm-ptr + param-reg-1 %mov-vm-ptr ! Call the unboxer func f %alien-invoke ! Store the return value on the C stack if this is an @@ -110,15 +113,15 @@ M: x86.64 %unbox-long-long ( n func -- ) [ int-rep ] dip %unbox ; : %unbox-struct-field ( c-type i -- ) - ! Alien must be in param-reg-1. + ! Alien must be in param-reg-0. R11 swap cells [+] swap rep>> reg-class-of { { int-regs [ int-regs get pop swap MOV ] } { float-regs [ float-regs get pop swap MOVSD ] } } case ; M: x86.64 %unbox-small-struct ( c-type -- ) - ! Alien must be in param-reg-1. - param-reg-2 %mov-vm-ptr + ! Alien must be in param-reg-0. + param-reg-1 %mov-vm-ptr "alien_offset" f %alien-invoke ! Move alien_offset() return value to R11 so that we don't ! clobber it. @@ -128,12 +131,12 @@ M: x86.64 %unbox-small-struct ( c-type -- ) ] with-return-regs ; M:: x86.64 %unbox-large-struct ( n c-type -- ) - ! Source is in param-reg-1 - ! Load destination address into param-reg-2 - param-reg-2 n param@ LEA - ! Load structure size into param-reg-3 - param-reg-3 c-type heap-size MOV - param-reg-4 %mov-vm-ptr + ! Source is in param-reg-0 + ! Load destination address into param-reg-1 + param-reg-1 n param@ LEA + ! Load structure size into param-reg-2 + param-reg-2 c-type heap-size MOV + param-reg-3 %mov-vm-ptr ! Copy the struct to the C stack "to_value_struct" f %alien-invoke ; @@ -151,7 +154,7 @@ M:: x86.64 %box ( n rep func -- ) ] [ rep load-return-value ] if - rep int-rep? [ param-reg-2 ] [ param-reg-1 ] if %mov-vm-ptr + rep int-rep? [ param-reg-1 ] [ param-reg-0 ] if %mov-vm-ptr func f %alien-invoke ; M: x86.64 %box-long-long ( n func -- ) @@ -169,10 +172,10 @@ M: x86.64 %box-small-struct ( c-type -- ) #! Box a <= 16-byte struct. [ [ flatten-value-type [ %box-struct-field ] each-index ] - [ param-reg-3 swap heap-size MOV ] bi - param-reg-1 0 box-struct-field@ MOV - param-reg-2 1 box-struct-field@ MOV - param-reg-4 %mov-vm-ptr + [ param-reg-2 swap heap-size MOV ] bi + param-reg-0 0 box-struct-field@ MOV + param-reg-1 1 box-struct-field@ MOV + param-reg-3 %mov-vm-ptr "from_small_struct" f %alien-invoke ] with-return-regs ; @@ -181,10 +184,10 @@ M: x86.64 %box-small-struct ( c-type -- ) M: x86.64 %box-large-struct ( n c-type -- ) ! Struct size is parameter 2 - param-reg-2 swap heap-size MOV + param-reg-1 swap heap-size MOV ! Compute destination address - param-reg-1 swap struct-return@ LEA - param-reg-3 %mov-vm-ptr + param-reg-0 swap struct-return@ LEA + param-reg-2 %mov-vm-ptr ! Copy the struct from the C stack "from_value_struct" f %alien-invoke ; @@ -202,19 +205,17 @@ M: x86.64 %alien-invoke R11 CALL ; M: x86.64 %nest-stacks ( -- ) - ! Save current frame. See comment in vm/contexts.hpp - param-reg-1 stack-reg stack-frame get total-size>> 3 cells - [+] LEA - param-reg-2 %mov-vm-ptr + param-reg-0 %mov-vm-ptr "nest_stacks" f %alien-invoke ; M: x86.64 %unnest-stacks ( -- ) - param-reg-1 %mov-vm-ptr + param-reg-0 %mov-vm-ptr "unnest_stacks" f %alien-invoke ; M: x86.64 %prepare-alien-indirect ( -- ) - param-reg-1 ds-reg [] MOV + param-reg-0 ds-reg [] MOV ds-reg 8 SUB - param-reg-2 %mov-vm-ptr + param-reg-1 %mov-vm-ptr "pinned_alien_offset" f %alien-invoke RBP RAX MOV ; @@ -222,19 +223,21 @@ M: x86.64 %alien-indirect ( -- ) RBP CALL ; M: x86.64 %alien-callback ( quot -- ) - param-reg-1 swap %load-reference - param-reg-2 %mov-vm-ptr - "c_to_factor" f %alien-invoke ; + param-reg-0 param-reg-1 %load-context + param-reg-0 swap %load-reference + param-reg-1 %mov-vm-ptr + param-reg-0 quot-xt-offset [+] CALL + param-reg-0 param-reg-1 %save-context ; M: x86.64 %callback-value ( ctype -- ) %pop-context-stack RSP 8 SUB - param-reg-1 PUSH - param-reg-1 %mov-vm-ptr + param-reg-0 PUSH + param-reg-0 %mov-vm-ptr ! Restore data/call/retain stacks "unnest_stacks" f %alien-invoke - ! Put former top of data stack in param-reg-1 - param-reg-1 POP + ! Put former top of data stack in param-reg-0 + param-reg-0 POP RSP 8 ADD ! Unbox former top of data stack to return registers unbox-return ; @@ -260,11 +263,11 @@ M:: x86.64 %binary-float-function ( dst src1 src2 func -- ) M:: x86.64 %call-gc ( gc-root-count temp -- ) ! Pass pointer to start of GC roots as first parameter - param-reg-1 gc-root-base param@ LEA + param-reg-0 gc-root-base param@ LEA ! Pass number of roots as second parameter - param-reg-2 gc-root-count MOV + param-reg-1 gc-root-count MOV ! Pass VM ptr as third parameter - param-reg-3 %mov-vm-ptr + param-reg-2 %mov-vm-ptr ! Call GC "inline_gc" f %alien-invoke ; diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor index dbc0178ce1..a1bdcbd1ff 100644 --- a/basis/cpu/x86/64/bootstrap.factor +++ b/basis/cpu/x86/64/bootstrap.factor @@ -17,6 +17,7 @@ IN: bootstrap.x86 : temp3 ( -- reg ) RBX ; : safe-reg ( -- reg ) RAX ; : stack-reg ( -- reg ) RSP ; +: frame-reg ( -- reg ) RBP ; : ds-reg ( -- reg ) R14 ; : rs-reg ( -- reg ) R15 ; : fixnum>slot@ ( -- ) temp0 1 SAR ; diff --git a/basis/cpu/x86/64/unix/bootstrap.factor b/basis/cpu/x86/64/unix/bootstrap.factor index 350c037e3a..d19b5306a0 100644 --- a/basis/cpu/x86/64/unix/bootstrap.factor +++ b/basis/cpu/x86/64/unix/bootstrap.factor @@ -6,9 +6,11 @@ sequences system vocabs ; IN: bootstrap.x86 : stack-frame-size ( -- n ) 4 bootstrap-cells ; +: nv-regs ( -- seq ) { RBX R12 R13 R14 R15 } ; : arg1 ( -- reg ) RDI ; : arg2 ( -- reg ) RSI ; : arg3 ( -- reg ) RDX ; +: arg4 ( -- reg ) RCX ; << "vocab:cpu/x86/64/bootstrap.factor" parse-file suffix! >> call diff --git a/basis/cpu/x86/64/winnt/bootstrap.factor b/basis/cpu/x86/64/winnt/bootstrap.factor index d25cc98084..113a13918f 100644 --- a/basis/cpu/x86/64/winnt/bootstrap.factor +++ b/basis/cpu/x86/64/winnt/bootstrap.factor @@ -6,9 +6,11 @@ cpu.x86.assembler.operands ; IN: bootstrap.x86 : stack-frame-size ( -- n ) 8 bootstrap-cells ; +: nv-regs ( -- seq ) { RBX RSI RDI R12 R13 R14 R15 } ; : arg1 ( -- reg ) RCX ; : arg2 ( -- reg ) RDX ; : arg3 ( -- reg ) R8 ; +: arg4 ( -- reg ) R9 ; << "vocab:cpu/x86/64/bootstrap.factor" parse-file suffix! >> call diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index d4e50694bf..f0e869fe5b 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -8,6 +8,49 @@ IN: bootstrap.x86 big-endian off +! C to Factor entry point +[ + ! Optimizing compiler's side of callback accesses + ! arguments that are on the stack via the frame pointer. + ! On x86-64, some arguments are passed in registers, and + ! so the only register that is safe for use here is safe-reg. + frame-reg PUSH + frame-reg stack-reg MOV + + ! Save all non-volatile registers + nv-regs [ PUSH ] each + + ! Save old stack pointer and align + safe-reg stack-reg MOV + stack-reg bootstrap-cell SUB + stack-reg -16 AND + stack-reg [] safe-reg MOV + + ! Register shadow area - only required on Win64, but doesn't + ! hurt on other platforms + stack-reg 32 SUB + + ! Call into Factor code + safe-reg 0 MOV rc-absolute-cell rt-xt jit-rel + safe-reg CALL + + ! Tear down register shadow area + stack-reg 32 ADD + + ! Undo stack alignment + stack-reg stack-reg [] MOV + + ! Restore non-volatile registers + nv-regs [ POP ] each + + frame-reg POP + + ! Callbacks which return structs, or use stdcall, need a + ! parameter here. See the comment in callback-return-rewind + ! in cpu.x86.32 + HEX: ffff RET rc-absolute-2 rt-untagged jit-rel +] callback-stub jit-define + [ ! Load word temp0 0 MOV rc-absolute-cell rt-literal jit-rel @@ -206,11 +249,6 @@ big-endian off ! fall-through on miss ] mega-lookup jit-define -[ - safe-reg 0 MOV rc-absolute-cell rt-xt jit-rel - safe-reg JMP -] callback-stub jit-define - ! ! ! Sub-primitives ! Objects diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 465e2d4929..69a0f39945 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -24,6 +24,8 @@ M: x86 vector-regs float-regs ; HOOK: stack-reg cpu ( -- reg ) +HOOK: frame-reg cpu ( -- reg ) + HOOK: reserved-stack-space cpu ( -- n ) HOOK: extra-stack-space cpu ( stack-frame -- n ) @@ -84,7 +86,7 @@ M: x86 %call ( word -- ) 0 CALL rc-relative rel-word-pic ; : xt-tail-pic-offset ( -- n ) #! See the comment in vm/cpu-x86.hpp - cell 4 + 1 + ; inline + 4 1 + ; inline M: x86 %jump ( word -- ) pic-tail-reg 0 MOV xt-tail-pic-offset rc-absolute-cell rel-here @@ -1408,15 +1410,31 @@ M:: x86 %reload ( dst rep src -- ) dst src rep %copy ; M: x86 %loop-entry 16 code-alignment [ NOP ] times ; +M:: x86 %load-context ( temp1 temp2 -- ) + #! Load Factor stack pointers on entry from C to Factor. + #! Also save callstack bottom! + temp1 "ctx" %vm-field-ptr + temp1 temp1 [] MOV + ! callstack_bottom + temp2 stack-reg stack-frame get total-size>> cell - [+] LEA + temp1 1 cells [+] temp2 MOV + ! datastack + ds-reg temp1 2 cells [+] MOV + ! retainstack + rs-reg temp1 3 cells [+] MOV ; + M:: x86 %save-context ( temp1 temp2 -- ) #! Save Factor stack pointers in case the C code calls a #! callback which does a GC, which must reliably trace #! all roots. temp1 "ctx" %vm-field-ptr temp1 temp1 [] MOV + ! callstack_top temp2 stack-reg cell neg [+] LEA temp1 [] temp2 MOV + ! datastack temp1 2 cells [+] ds-reg MOV + ! retainstack temp1 3 cells [+] rs-reg MOV ; M: x86 value-struct? drop t ; @@ -1432,7 +1450,7 @@ M: x86 immediate-bitwise? ( n -- ? ) #! input values to callbacks; the callback has its own #! stack frame set up, and we want to read the frame #! set up by the caller. - stack-frame get total-size>> + stack@ ; + frame-reg swap 2 cells + [+] ; enable-min/max enable-fixnum-log2 diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor index f9ab1ae96c..deeada3735 100644 --- a/basis/stack-checker/alien/alien.factor +++ b/basis/stack-checker/alien/alien.factor @@ -1,8 +1,9 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences accessors combinators math namespaces init sets words assocs alien.libraries alien alien.c-types -stack-checker.backend stack-checker.errors stack-checker.visitor ; +cpu.architecture fry stack-checker.backend stack-checker.errors +stack-checker.visitor ; IN: stack-checker.alien TUPLE: alien-node-params return parameters abi in-d out-d ; @@ -49,7 +50,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ; pop-literal nip >>parameters pop-literal nip >>return ! Quotation which coerces parameters to required types - dup param-prep-quot [ dip ] curry infer-quot-here + dup param-prep-quot '[ _ dip ] infer-quot-here ! Magic #: consume the function pointer, too dup 1 alien-stack ! Add node to IR @@ -57,11 +58,12 @@ TUPLE: alien-callback-params < alien-node-params quot xt ; ! Quotation which coerces return value to required type return-prep-quot infer-quot-here ; -: callback-xt ( word -- alien ) - callbacks get [ ] cache ; +: callback-xt ( word return-rewind -- alien ) + [ callbacks get ] dip '[ _ ] cache ; : callback-bottom ( params -- ) - xt>> [ callback-xt ] curry infer-quot-here ; + [ xt>> ] [ callback-return-rewind ] bi + '[ _ _ callback-xt ] infer-quot-here ; : infer-alien-callback ( -- ) alien-callback-params new diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 40e41d1a8d..316ae6ca2f 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -709,7 +709,7 @@ M: bad-executable summary \ strip-stack-traces { } { } define-primitive -\ { word } { alien } define-primitive +\ { integer word } { alien } define-primitive \ enable-gc-events { } { } define-primitive \ disable-gc-events { } { object } define-primitive diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 4a4d178f9e..ac1f4fad69 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -518,7 +518,7 @@ tuple { "quot-compiled?" "quotations" (( quot -- ? )) } { "vm-ptr" "vm" (( -- ptr )) } { "strip-stack-traces" "kernel.private" (( -- )) } - { "" "alien" (( word -- alien )) } + { "" "alien" (( return-rewind word -- alien )) } { "enable-gc-events" "memory" (( -- )) } { "disable-gc-events" "memory" (( -- events )) } { "(identity-hashcode)" "kernel.private" (( obj -- code )) } diff --git a/vm/callbacks.cpp b/vm/callbacks.cpp index e5cdb805d3..061c42927d 100644 --- a/vm/callbacks.cpp +++ b/vm/callbacks.cpp @@ -38,7 +38,7 @@ void callback_heap::update(code_block *stub) stub->flush_icache(); } -code_block *callback_heap::add(cell owner) +code_block *callback_heap::add(cell owner, cell return_rewind) { tagged code_template(parent->special_objects[CALLBACK_STUB]); tagged insns(array_nth(code_template.untagged(),0)); @@ -57,6 +57,24 @@ code_block *callback_heap::add(cell owner) stub->relocation = false_object; memcpy(stub->xt(),insns->data(),size); + + /* On x86, the RET instruction takes an argument which depends on + the callback's calling convention */ + if(array_capacity(code_template.untagged()) == 7) + { + cell rel_class = untag_fixnum(array_nth(code_template.untagged(),4)); + cell rel_type = untag_fixnum(array_nth(code_template.untagged(),5)); + cell offset = untag_fixnum(array_nth(code_template.untagged(),6)); + + relocation_entry rel( + (relocation_type)rel_type, + (relocation_class)rel_class, + offset); + + instruction_operand op(rel,stub,0); + op.store_value(return_rewind); + } + update(stub); return stub; @@ -81,9 +99,11 @@ void callback_heap::update() void factor_vm::primitive_callback() { + cell return_rewind = to_cell(ctx->pop()); tagged w(ctx->pop()); + w.untag_check(this); - ctx->push(allot_alien(callbacks->add(w.value())->xt())); + ctx->push(allot_alien(callbacks->add(w.value(),return_rewind)->xt())); } } diff --git a/vm/callbacks.hpp b/vm/callbacks.hpp index 8662d3ccbb..136d9b82b4 100644 --- a/vm/callbacks.hpp +++ b/vm/callbacks.hpp @@ -39,7 +39,7 @@ struct callback_heap { } void update(code_block *stub); - code_block *add(cell owner); + code_block *add(cell owner, cell return_rewind); void update(); diff --git a/vm/contexts.cpp b/vm/contexts.cpp index 27cbb8e3aa..394d14e55d 100644 --- a/vm/contexts.cpp +++ b/vm/contexts.cpp @@ -8,7 +8,6 @@ context::context(cell ds_size, cell rs_size) : callstack_bottom(NULL), datastack(0), retainstack(0), - magic_frame(NULL), datastack_region(new segment(ds_size,false)), retainstack_region(new segment(rs_size,false)), catchstack_save(0), @@ -41,15 +40,13 @@ void factor_vm::dealloc_context(context *old_context) } /* called on entry into a compiled callback */ -void factor_vm::nest_stacks(stack_frame *magic_frame) +void factor_vm::nest_stacks() { context *new_ctx = alloc_context(); new_ctx->callstack_bottom = (stack_frame *)-1; new_ctx->callstack_top = (stack_frame *)-1; - new_ctx->magic_frame = magic_frame; - /* save per-callback special_objects */ new_ctx->current_callback_save = special_objects[OBJ_CURRENT_CALLBACK]; new_ctx->catchstack_save = special_objects[OBJ_CATCHSTACK]; @@ -61,9 +58,9 @@ void factor_vm::nest_stacks(stack_frame *magic_frame) ctx = new_ctx; } -void nest_stacks(stack_frame *magic_frame, factor_vm *parent) +void nest_stacks(factor_vm *parent) { - return parent->nest_stacks(magic_frame); + return parent->nest_stacks(); } /* called when leaving a compiled callback */ diff --git a/vm/contexts.hpp b/vm/contexts.hpp index 14a853bf37..9ba9bb313c 100644 --- a/vm/contexts.hpp +++ b/vm/contexts.hpp @@ -13,18 +13,6 @@ struct context { /* current retain stack top pointer */ cell retainstack; - /* callback-bottom stack frame, or NULL for top-level context. - When nest_stacks() is called, callstack layout with callbacks - is as follows: - - [ C function ] - [ callback stub in code heap ] <-- this is the magic frame - [ native frame: c_to_factor() ] - [ callback quotation frame ] <-- first call frame in call stack - - magic frame is retained so that it's XT can be traced and forwarded. */ - stack_frame *magic_frame; - /* memory region holding current datastack */ segment *datastack_region; @@ -86,7 +74,7 @@ struct context { } }; -VM_C_API void nest_stacks(stack_frame *magic_frame, factor_vm *vm); +VM_C_API void nest_stacks(factor_vm *vm); VM_C_API void unnest_stacks(factor_vm *vm); } diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S index 04df3db89d..ee3ec25aa3 100644 --- a/vm/cpu-x86.32.S +++ b/vm/cpu-x86.32.S @@ -18,9 +18,9 @@ DEF(void,c_to_factor,(cell quot, void *vm)): push %edi /* Save old stack pointer and align */ - mov %esp,%ebp + mov %esp,%ebx and $-16,%esp - push %ebp + push %ebx /* Set up stack frame for the call to the boot quotation */ sub $4,%esp @@ -49,8 +49,7 @@ DEF(void,c_to_factor,(cell quot, void *vm)): add $4,%esp /* Undo stack alignment */ - pop %ebp - mov %ebp,%esp + mov (%esp),%esp /* Load context */ mov (%edx),%ecx diff --git a/vm/cpu-x86.hpp b/vm/cpu-x86.hpp index 35327b2940..349548f1ca 100644 --- a/vm/cpu-x86.hpp +++ b/vm/cpu-x86.hpp @@ -15,7 +15,7 @@ inline static void flush_icache(cell start, cell len) {} the offset from the immediate operand to MOV to the instruction after the jump is a cell for the immediate operand, 4 bytes for the JMP destination, and one byte for the JMP opcode. */ -static const fixnum xt_tail_pic_offset = sizeof(cell) + 4 + 1; +static const fixnum xt_tail_pic_offset = 4 + 1; static const unsigned char call_opcode = 0xe8; static const unsigned char jmp_opcode = 0xe9; diff --git a/vm/factor.cpp b/vm/factor.cpp index 04961ff505..d4824fdcd5 100755 --- a/vm/factor.cpp +++ b/vm/factor.cpp @@ -164,14 +164,14 @@ void factor_vm::start_factor(vm_parameters *p) { if(p->fep) factorbug(); - nest_stacks(NULL); + nest_stacks(); c_to_factor_toplevel(special_objects[OBJ_STARTUP_QUOT]); unnest_stacks(); } void factor_vm::stop_factor() { - nest_stacks(NULL); + nest_stacks(); c_to_factor_toplevel(special_objects[OBJ_SHUTDOWN_QUOT]); unnest_stacks(); } diff --git a/vm/instruction_operands.cpp b/vm/instruction_operands.cpp index 747a45a817..e815fc9619 100644 --- a/vm/instruction_operands.cpp +++ b/vm/instruction_operands.cpp @@ -10,17 +10,17 @@ instruction_operand::instruction_operand(relocation_entry rel_, code_block *comp fixnum instruction_operand::load_value_2_2() { cell *ptr = (cell *)pointer; - cell hi = (ptr[-1] & 0xffff); - cell lo = (ptr[ 0] & 0xffff); + cell hi = (ptr[-2] & 0xffff); + cell lo = (ptr[-1] & 0xffff); return hi << 16 | lo; } /* Load a value from a bitfield of a PowerPC instruction */ fixnum instruction_operand::load_value_masked(cell mask, cell bits, cell shift) { - fixnum *ptr = (fixnum *)pointer; + s32 *ptr = (s32 *)(pointer - sizeof(u32)); - return (((*ptr & (fixnum)mask) << bits) >> bits) << shift; + return (((*ptr & (s32)mask) << bits) >> bits) << shift; } fixnum instruction_operand::load_value(cell relative_to) @@ -28,11 +28,11 @@ fixnum instruction_operand::load_value(cell relative_to) switch(rel.rel_class()) { case RC_ABSOLUTE_CELL: - return *(cell *)pointer; + return *(cell *)(pointer - sizeof(cell)); case RC_ABSOLUTE: - return *(u32*)pointer; + return *(u32 *)(pointer - sizeof(u32)); case RC_RELATIVE: - return *(s32*)pointer + relative_to + sizeof(u32); + return *(s32 *)(pointer - sizeof(u32)) + relative_to; case RC_ABSOLUTE_PPC_2_2: return load_value_2_2(); case RC_ABSOLUTE_PPC_2: @@ -42,11 +42,13 @@ fixnum instruction_operand::load_value(cell relative_to) case RC_RELATIVE_PPC_3: return load_value_masked(rel_relative_ppc_3_mask,6,0) + relative_to; case RC_RELATIVE_ARM_3: - return load_value_masked(rel_relative_arm_3_mask,6,2) + relative_to + sizeof(cell) * 2; + return load_value_masked(rel_relative_arm_3_mask,6,2) + relative_to + sizeof(cell); case RC_INDIRECT_ARM: - return load_value_masked(rel_indirect_arm_mask,20,0) + relative_to + sizeof(cell); + return load_value_masked(rel_indirect_arm_mask,20,0) + relative_to; case RC_INDIRECT_ARM_PC: - return load_value_masked(rel_indirect_arm_mask,20,0) + relative_to + sizeof(cell) * 2; + return load_value_masked(rel_indirect_arm_mask,20,0) + relative_to + sizeof(cell); + case RC_ABSOLUTE_2: + return *(u16 *)(pointer - sizeof(u16)); default: critical_error("Bad rel class",rel.rel_class()); return 0; @@ -72,14 +74,14 @@ code_block *instruction_operand::load_code_block() void instruction_operand::store_value_2_2(fixnum value) { cell *ptr = (cell *)pointer; - ptr[-1] = ((ptr[-1] & ~0xffff) | ((value >> 16) & 0xffff)); - ptr[ 0] = ((ptr[ 0] & ~0xffff) | (value & 0xffff)); + ptr[-2] = ((ptr[-2] & ~0xffff) | ((value >> 16) & 0xffff)); + ptr[-1] = ((ptr[-1] & ~0xffff) | (value & 0xffff)); } /* Store a value into a bitfield of a PowerPC instruction */ void instruction_operand::store_value_masked(fixnum value, cell mask, cell shift) { - cell *ptr = (cell *)pointer; + u32 *ptr = (u32 *)(pointer - sizeof(u32)); *ptr = ((*ptr & ~mask) | ((value >> shift) & mask)); } @@ -90,13 +92,13 @@ void instruction_operand::store_value(fixnum absolute_value) switch(rel.rel_class()) { case RC_ABSOLUTE_CELL: - *(cell *)pointer = absolute_value; + *(cell *)(pointer - sizeof(cell)) = absolute_value; break; case RC_ABSOLUTE: - *(u32*)pointer = absolute_value; + *(u32 *)(pointer - sizeof(u32)) = absolute_value; break; case RC_RELATIVE: - *(s32*)pointer = relative_value - sizeof(u32); + *(s32 *)(pointer - sizeof(s32)) = relative_value; break; case RC_ABSOLUTE_PPC_2_2: store_value_2_2(absolute_value); @@ -111,13 +113,16 @@ void instruction_operand::store_value(fixnum absolute_value) store_value_masked(relative_value,rel_relative_ppc_3_mask,0); break; case RC_RELATIVE_ARM_3: - store_value_masked(relative_value - sizeof(cell) * 2,rel_relative_arm_3_mask,2); + store_value_masked(relative_value - sizeof(cell),rel_relative_arm_3_mask,2); break; case RC_INDIRECT_ARM: - store_value_masked(relative_value - sizeof(cell),rel_indirect_arm_mask,0); + store_value_masked(relative_value,rel_indirect_arm_mask,0); break; case RC_INDIRECT_ARM_PC: - store_value_masked(relative_value - sizeof(cell) * 2,rel_indirect_arm_mask,0); + store_value_masked(relative_value - sizeof(cell),rel_indirect_arm_mask,0); + break; + case RC_ABSOLUTE_2: + *(u16 *)(pointer - sizeof(u16)) = absolute_value; break; default: critical_error("Bad rel class",rel.rel_class()); diff --git a/vm/instruction_operands.hpp b/vm/instruction_operands.hpp index 1aa7073271..0798e5178f 100644 --- a/vm/instruction_operands.hpp +++ b/vm/instruction_operands.hpp @@ -54,7 +54,9 @@ enum relocation_class { /* pointer to address in an ARM LDR/STR instruction */ RC_INDIRECT_ARM, /* pointer to address in an ARM LDR/STR instruction offset by 8 bytes */ - RC_INDIRECT_ARM_PC + RC_INDIRECT_ARM_PC, + /* absolute address in a 16-bit location */ + RC_ABSOLUTE_2 }; static const cell rel_absolute_ppc_2_mask = 0xffff; diff --git a/vm/vm.hpp b/vm/vm.hpp index 101b47c298..ef2d7e0644 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -94,7 +94,7 @@ struct factor_vm // contexts context *alloc_context(); void dealloc_context(context *old_context); - void nest_stacks(stack_frame *magic_frame); + void nest_stacks(); void unnest_stacks(); void init_stacks(cell ds_size_, cell rs_size_); bool stack_to_array(cell bottom, cell top); @@ -113,7 +113,6 @@ struct factor_vm while(ctx) { iterate_callstack(ctx,iter); - if(ctx->magic_frame) iter(ctx->magic_frame); ctx = ctx->next; } }