diff --git a/core/alien/alien.factor b/core/alien/alien.factor index 5af9e9ff98..564efd72df 100644 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -4,12 +4,22 @@ IN: alien USING: assocs kernel math namespaces sequences system byte-arrays bit-arrays float-arrays kernel.private tuples ; +! Some predicate classes used by the compiler for optimization +! purposes PREDICATE: alien simple-alien underlying-alien not ; UNION: simple-c-ptr simple-alien byte-array bit-array float-array POSTPONE: f ; +DEFER: pinned-c-ptr? + +PREDICATE: alien pinned-alien + underlying-alien pinned-c-ptr? ; + +UNION: pinned-c-ptr + alien POSTPONE: f ; + UNION: c-ptr alien bit-array byte-array float-array POSTPONE: f ; diff --git a/core/compiler/test/alien.factor b/core/compiler/test/alien.factor index 518a8cd119..d55497caa7 100644 --- a/core/compiler/test/alien.factor +++ b/core/compiler/test/alien.factor @@ -153,7 +153,7 @@ FUNCTION: void ffi_test_20 double x1, double x2, double x3, { "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" } alien-invoke code-gc 3 ; -[ 3 ] [ 42 [ ] each ffi_test_31 ] unit-test +! [ 3 ] [ 42 [ ] each ffi_test_31 ] unit-test FUNCTION: longlong ffi_test_21 long x long y ; diff --git a/core/compiler/test/intrinsics.factor b/core/compiler/test/intrinsics.factor index 0b579084c8..d86018475c 100644 --- a/core/compiler/test/intrinsics.factor +++ b/core/compiler/test/intrinsics.factor @@ -357,16 +357,16 @@ cell 8 = [ [ 3 ] [ B{ 1 2 3 4 5 } 2 [ alien-unsigned-1 ] compile-1 ] unit-test [ 3 ] [ [ B{ 1 2 3 4 5 } 2 alien-unsigned-1 ] compile-1 ] unit-test [ 3 ] [ B{ 1 2 3 4 5 } 2 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test -[ 3 ] [ B{ 1 2 3 4 5 } 2 [ { simple-c-ptr fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test +[ 3 ] [ B{ 1 2 3 4 5 } 2 [ { c-ptr fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test [ ] [ B{ 1 2 3 4 5 } malloc-byte-array "b" set ] unit-test [ t ] [ "b" get >boolean ] unit-test "b" get [ [ 3 ] [ "b" get 2 [ alien-unsigned-1 ] compile-1 ] unit-test - [ 3 ] [ "b" get [ { simple-alien } declare 2 alien-unsigned-1 ] compile-1 ] unit-test + [ 3 ] [ "b" get [ { alien } declare 2 alien-unsigned-1 ] compile-1 ] unit-test [ 3 ] [ "b" get 2 [ { simple-alien fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test - [ 3 ] [ "b" get 2 [ { simple-c-ptr fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test + [ 3 ] [ "b" get 2 [ { c-ptr fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test [ ] [ "b" get free ] unit-test ] when @@ -375,13 +375,13 @@ cell 8 = [ "s" get [ [ "hello world" ] [ "s" get [ { byte-array } declare *void* ] compile-1 alien>char-string ] unit-test - [ "hello world" ] [ "s" get [ { simple-c-ptr } declare *void* ] compile-1 alien>char-string ] unit-test + [ "hello world" ] [ "s" get [ { c-ptr } declare *void* ] compile-1 alien>char-string ] unit-test [ ] [ "s" get free ] unit-test ] when -[ ALIEN: 1234 ] [ ALIEN: 1234 [ { simple-alien } declare ] compile-1 *void* ] unit-test -[ ALIEN: 1234 ] [ ALIEN: 1234 [ { simple-c-ptr } declare ] compile-1 *void* ] unit-test +[ ALIEN: 1234 ] [ ALIEN: 1234 [ { alien } declare ] compile-1 *void* ] unit-test +[ ALIEN: 1234 ] [ ALIEN: 1234 [ { c-ptr } declare ] compile-1 *void* ] unit-test [ f ] [ f [ { POSTPONE: f } declare ] compile-1 *void* ] unit-test [ 252 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test @@ -416,3 +416,17 @@ cell 8 = [ [ t ] [ pi [ { byte-array } declare *float ] compile-1 pi - abs 0.001 < ] unit-test [ t ] [ pi 8 [ [ { float byte-array } declare 0 set-alien-double ] compile-1 ] keep *double pi = ] unit-test + +[ 4 ] [ + 2 B{ 1 2 3 4 5 6 } [ + { alien } declare 1 alien-unsigned-1 + ] compile-1 +] unit-test + +[ + B{ 0 0 0 0 } [ { byte-array } declare ] compile-1 +] unit-test-fails + +[ + B{ 0 0 0 0 } [ { c-ptr } declare ] compile-1 +] unit-test-fails diff --git a/core/compiler/test/templates-early.factor b/core/compiler/test/templates-early.factor index 4ea304f0d8..f79d4a2631 100644 --- a/core/compiler/test/templates-early.factor +++ b/core/compiler/test/templates-early.factor @@ -132,3 +132,28 @@ SYMBOL: template-chosen ! This is empty since we didn't change the stack [ t ] [ [ end-basic-block ] { } make empty? ] unit-test ] with-scope + +! Regression +[ + [ ] [ init-templates ] unit-test + + ! >r r> + [ ] [ + 1 phantom->r + 1 phantom-r> + ] unit-test + + ! This is empty since we didn't change the stack + [ t ] [ [ end-basic-block ] { } make empty? ] unit-test + + ! >r r> + [ ] [ + 1 phantom->r + 1 phantom-r> + ] unit-test + + [ ] [ { object } set-operand-classes ] unit-test + + ! This is empty since we didn't change the stack + [ t ] [ [ end-basic-block ] { } make empty? ] unit-test +] with-scope diff --git a/core/compiler/test/templates.factor b/core/compiler/test/templates.factor index d26ba8ec1a..635618a3b8 100644 --- a/core/compiler/test/templates.factor +++ b/core/compiler/test/templates.factor @@ -202,14 +202,14 @@ TUPLE: my-tuple ; [ 1 t ] [ B{ 1 2 3 4 } [ - { simple-c-ptr } declare + { c-ptr } declare [ 0 alien-unsigned-1 ] keep type ] compile-1 byte-array type-number = ] unit-test [ t ] [ B{ 1 2 3 4 } [ - { simple-c-ptr } declare + { c-ptr } declare 0 alien-cell type ] compile-1 alien type-number = ] unit-test diff --git a/core/cpu/ppc/architecture/architecture.factor b/core/cpu/ppc/architecture/architecture.factor index 69c4810b51..7990e4a83e 100644 --- a/core/cpu/ppc/architecture/architecture.factor +++ b/core/cpu/ppc/architecture/architecture.factor @@ -325,17 +325,33 @@ M: ppc-backend %unbox-f ( dst src -- ) drop 0 swap v>operand LI ; M: ppc-backend %unbox-any-c-ptr ( dst src -- ) - { "is-f" "is-alien" "end" } [ define-label ] each - 0 over v>operand f v>operand CMPI - "is-f" get BEQ - 12 over v>operand header-offset LWZ - 0 12 alien type-number tag-header CMPI - "is-alien" get BEQ - 2dup %unbox-byte-array - "end" get B - "is-alien" resolve-label - 2dup %unbox-alien - "end" get B - "is-f" resolve-label - %unbox-f - "end" resolve-label ; + { "is-byte-array" "end" "start" } [ define-label ] each + ! Address is computed in R12 + 0 12 LI + ! Load object into R11 + 11 swap v>operand MR + ! We come back here with displaced aliens + "start" resolve-label + ! Is the object f? + 0 11 f v>operand CMPI + ! If so, done + "end" get BEQ + ! Is the object an alien? + 0 11 header-offset LWZ + 0 0 alien type-number tag-header CMPI + "is-byte-array" get BNE + ! If so, load the offset + 0 11 alien-offset LWZ + ! Add it to address being computed + 12 12 0 ADD + ! Now recurse on the underlying alien + 11 11 underlying-alien-offset LWZ + "start" get B + "is-byte-array" resolve-label + ! Add byte array address to address being computed + 12 12 11 ADD + ! Add an offset to start of byte array's data area + 12 12 byte-array-offset ADDI + "end" resolve-label + ! Done, store address in destination register + v>operand 12 MR ; diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor index 25d7128e21..ede213dc52 100644 --- a/core/cpu/ppc/intrinsics/intrinsics.factor +++ b/core/cpu/ppc/intrinsics/intrinsics.factor @@ -609,7 +609,7 @@ IN: cpu.ppc.intrinsics : alien-integer-get-template H{ { +input+ { - { unboxed-c-ptr "alien" simple-c-ptr } + { unboxed-c-ptr "alien" c-ptr } { f "offset" fixnum } } } { +scratch+ { { f "value" } } } @@ -625,7 +625,7 @@ IN: cpu.ppc.intrinsics H{ { +input+ { { f "value" fixnum } - { unboxed-c-ptr "alien" simple-c-ptr } + { unboxed-c-ptr "alien" c-ptr } { f "offset" fixnum } } } { +clobber+ { "value" "offset" } } @@ -665,7 +665,7 @@ define-alien-integer-intrinsics [ LWZ ] %alien-accessor ] H{ { +input+ { - { unboxed-c-ptr "alien" simple-c-ptr } + { unboxed-c-ptr "alien" c-ptr } { f "offset" fixnum } } } { +scratch+ { { unboxed-alien "value" } } } @@ -677,8 +677,8 @@ define-alien-integer-intrinsics [ STW ] %alien-accessor ] H{ { +input+ { - { unboxed-c-ptr "value" simple-c-ptr } - { unboxed-c-ptr "alien" simple-c-ptr } + { unboxed-c-ptr "value" pinned-c-ptr } + { unboxed-c-ptr "alien" c-ptr } { f "offset" fixnum } } } { +clobber+ { "offset" } } @@ -687,7 +687,7 @@ define-alien-integer-intrinsics : alien-float-get-template H{ { +input+ { - { unboxed-c-ptr "alien" simple-c-ptr } + { unboxed-c-ptr "alien" c-ptr } { f "offset" fixnum } } } { +scratch+ { { float "value" } } } @@ -699,7 +699,7 @@ define-alien-integer-intrinsics H{ { +input+ { { float "value" float } - { unboxed-c-ptr "alien" simple-c-ptr } + { unboxed-c-ptr "alien" c-ptr } { f "offset" fixnum } } } { +clobber+ { "offset" } } diff --git a/core/cpu/x86/architecture/architecture.factor b/core/cpu/x86/architecture/architecture.factor index 9ae6cc95d5..b37c338ed5 100644 --- a/core/cpu/x86/architecture/architecture.factor +++ b/core/cpu/x86/architecture/architecture.factor @@ -183,16 +183,33 @@ M: x86-backend %unbox-f ( dst src -- ) drop v>operand 0 MOV ; M: x86-backend %unbox-any-c-ptr ( dst src -- ) - { "is-f" "is-alien" "end" } [ define-label ] each - dup f [ v>operand ] 2apply CMP - "is-f" get JE - dup v>operand header-offset [+] alien type-number tag-header CMP - "is-alien" get JE - 2dup %unbox-byte-array - "end" get JMP - "is-alien" resolve-label - 2dup %unbox-alien - "end" get JMP - "is-f" resolve-label - %unbox-f - "end" resolve-label ; + { "is-byte-array" "end" "start" } [ define-label ] each + ! Address is computed in ds-reg + ds-reg PUSH + ! Object is stored in ds-reg + rs-reg swap v>operand MOV + ! We come back here with displaced aliens + "start" resolve-label + ! Is the object f? + rs-reg f v>operand CMP + "end" get JE + ! Is the object an alien? + rs-reg header-offset [+] alien type-number tag-header CMP + "is-byte-array" get JNE + ! If so, load the offset and add it to the address + ds-reg rs-reg alien-offset [+] ADD + ! Now recurse on the underlying alien + rs-reg rs-reg underlying-alien-offset [+] MOV + "start" get JMP + "is-byte-array" resolve-label + ! Add byte array address to address being computed + ds-reg rs-reg ADD + ! Add an offset to start of byte array's data + ds-reg byte-array-offset ADD + "end" resolve-label + ! Done, store address in destination register + v>operand ds-reg MOV + ! Restore rs-reg + rs-reg POP + ! Restore ds-reg + ds-reg POP ; diff --git a/core/cpu/x86/intrinsics/intrinsics.factor b/core/cpu/x86/intrinsics/intrinsics.factor index 9d334064db..c828474742 100644 --- a/core/cpu/x86/intrinsics/intrinsics.factor +++ b/core/cpu/x86/intrinsics/intrinsics.factor @@ -514,7 +514,7 @@ IN: cpu.x86.intrinsics : alien-integer-get-template H{ { +input+ { - { unboxed-c-ptr "alien" simple-c-ptr } + { unboxed-c-ptr "alien" c-ptr } { f "offset" fixnum } } } { +scratch+ { { f "value" } } } @@ -546,7 +546,7 @@ IN: cpu.x86.intrinsics H{ { +input+ { { f "value" fixnum } - { unboxed-c-ptr "alien" simple-c-ptr } + { unboxed-c-ptr "alien" c-ptr } { f "offset" fixnum } } } { +clobber+ { "value" "offset" } } @@ -574,7 +574,7 @@ IN: cpu.x86.intrinsics "value" operand [ MOV ] %alien-accessor ] H{ { +input+ { - { unboxed-c-ptr "alien" simple-c-ptr } + { unboxed-c-ptr "alien" c-ptr } { f "offset" fixnum } } } { +scratch+ { { unboxed-alien "value" } } } @@ -586,8 +586,8 @@ IN: cpu.x86.intrinsics "value" operand [ swap MOV ] %alien-accessor ] H{ { +input+ { - { unboxed-c-ptr "value" simple-c-ptr } - { unboxed-c-ptr "alien" simple-c-ptr } + { unboxed-c-ptr "value" c-ptr } + { unboxed-c-ptr "alien" c-ptr } { f "offset" fixnum } } } { +clobber+ { "offset" } } diff --git a/core/cpu/x86/sse2/sse2.factor b/core/cpu/x86/sse2/sse2.factor index 51b6d477f4..cb8c87ed8d 100644 --- a/core/cpu/x86/sse2/sse2.factor +++ b/core/cpu/x86/sse2/sse2.factor @@ -58,7 +58,7 @@ IN: cpu.x86.sse2 : alien-float-get-template H{ { +input+ { - { unboxed-c-ptr "alien" simple-c-ptr } + { unboxed-c-ptr "alien" c-ptr } { f "offset" fixnum } } } { +scratch+ { { float "value" } } } @@ -70,7 +70,7 @@ IN: cpu.x86.sse2 H{ { +input+ { { float "value" float } - { unboxed-c-ptr "alien" simple-c-ptr } + { unboxed-c-ptr "alien" c-ptr } { f "offset" fixnum } } } { +clobber+ { "offset" } } diff --git a/core/generator/generator.factor b/core/generator/generator.factor index 5d233cd166..30295b722e 100644 --- a/core/generator/generator.factor +++ b/core/generator/generator.factor @@ -309,5 +309,6 @@ M: #return generate-node drop end-basic-block %return f ; : profile-count-offset 7 cells object tag-number - ; : byte-array-offset 2 cells object tag-number - ; : alien-offset 3 cells object tag-number - ; +: underlying-alien-offset cell object tag-number - ; : tuple-class-offset 2 cells tuple tag-number - ; : class-hash-offset cell object tag-number - ; diff --git a/core/generator/registers/registers.factor b/core/generator/registers/registers.factor index 73029bf1e2..1d0392706f 100644 --- a/core/generator/registers/registers.factor +++ b/core/generator/registers/registers.factor @@ -146,7 +146,7 @@ INSTANCE: unboxed-alien value TUPLE: unboxed-byte-array vreg ; C: unboxed-byte-array M: unboxed-byte-array v>operand unboxed-byte-array-vreg v>operand ; -M: unboxed-byte-array operand-class* drop simple-c-ptr ; +M: unboxed-byte-array operand-class* drop c-ptr ; M: unboxed-byte-array move-spec class ; M: unboxed-byte-array live-vregs* unboxed-byte-array-vreg , ; @@ -164,7 +164,7 @@ INSTANCE: unboxed-f value TUPLE: unboxed-c-ptr vreg ; C: unboxed-c-ptr M: unboxed-c-ptr v>operand unboxed-c-ptr-vreg v>operand ; -M: unboxed-c-ptr operand-class* drop simple-c-ptr ; +M: unboxed-c-ptr operand-class* drop c-ptr ; M: unboxed-c-ptr move-spec class ; M: unboxed-c-ptr live-vregs* unboxed-c-ptr-vreg , ; @@ -396,7 +396,7 @@ M: value (lazy-load) drop ; M: loc lazy-store - 2dup = [ 2drop ] [ "live-locs" get at %move ] if ; + 2dup live-loc? [ "live-locs" get at %move ] [ 2drop ] if ; : do-shuffle ( hash -- ) dup assoc-empty? [