From 69e640c55b7a2e972f0b7bf67171deb8f1c64fab Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 26 Aug 2009 22:37:59 -0500 Subject: [PATCH 1/5] throw a friendlier error when attempting to create a struct without slots --- basis/classes/struct/struct-tests.factor | 8 +++++++- basis/classes/struct/struct.factor | 7 ++++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index f19d71974f..64b8ba83e2 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -5,7 +5,8 @@ destructors io.encodings.utf8 io.pathnames io.streams.string kernel libc literals math multiline namespaces prettyprint prettyprint.config see sequences specialized-arrays.ushort system tools.test compiler.tree.debugger struct-arrays -classes.tuple.private specialized-arrays.direct.int ; +classes.tuple.private specialized-arrays.direct.int +compiler.units ; IN: classes.struct.tests << @@ -22,6 +23,11 @@ IN: classes.struct.tests "f-stdcall" libfactor-ffi-tests-path "stdcall" add-library >> +SYMBOL: struct-test-empty + +[ [ struct-test-empty { } define-struct-class ] with-compilation-unit ] +[ struct-must-have-slots? ] must-fail-with + STRUCT: struct-test-foo { x char } { y int initial: 123 } diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 93cb8e3203..52f3b7df9f 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -12,6 +12,8 @@ IN: classes.struct ! struct class +ERROR: struct-must-have-slots ; + TUPLE: struct { (underlying) c-ptr read-only } ; @@ -207,7 +209,10 @@ M: struct-class heap-size [ c-type>> c-type drop ] each ; : (define-struct-class) ( class slots offsets-quot -- ) - [ drop struct f define-tuple-class ] + [ + [ struct-must-have-slots ] + [ drop struct f define-tuple-class ] if-empty + ] swap '[ make-slots dup [ check-struct-slots ] _ [ struct-align [ align ] keep ] tri From f662e6403a415831a12e2df25a174638b32aa7de Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Aug 2009 00:06:19 -0500 Subject: [PATCH 2/5] compiler: new inline intrinsic for where the inputs have known types; value numbering now eliminates unnecessary allocation of displaced aliens if the result is immediately unboxed again --- basis/compiler/cfg/def-use/def-use.factor | 1 + basis/compiler/cfg/hats/hats.factor | 1 + .../cfg/instructions/instructions.factor | 1 + .../cfg/intrinsics/alien/alien.factor | 17 +++++- .../compiler/cfg/intrinsics/intrinsics.factor | 5 +- .../cfg/renaming/functor/functor.factor | 3 + .../preferred/preferred.factor | 1 + .../value-numbering/rewrite/rewrite.factor | 23 +++++++- .../value-numbering/simplify/simplify.factor | 7 +++ .../value-numbering-tests.factor | 58 +++++++++++++++++++ .../value-numbering/value-numbering.factor | 8 ++- basis/compiler/codegen/codegen.factor | 9 ++- basis/compiler/tests/intrinsics.factor | 48 +++++++++++++++ basis/cpu/architecture/architecture.factor | 1 + basis/cpu/ppc/ppc.factor | 43 +++++++++++--- basis/cpu/x86/x86.factor | 35 +++++++++-- 16 files changed, 239 insertions(+), 22 deletions(-) diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor index c56bd80779..ca0c5df0fa 100644 --- a/basis/compiler/cfg/def-use/def-use.factor +++ b/basis/compiler/cfg/def-use/def-use.factor @@ -21,6 +21,7 @@ M: ##slot temp-vregs temp>> 1array ; M: ##set-slot temp-vregs temp>> 1array ; M: ##string-nth temp-vregs temp>> 1array ; M: ##set-string-nth-fast temp-vregs temp>> 1array ; +M: ##box-displaced-alien temp-vregs temp>> 1array ; M: ##compare temp-vregs temp>> 1array ; M: ##compare-imm temp-vregs temp>> 1array ; M: ##compare-float temp-vregs temp>> 1array ; diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor index d90745a25e..012434bc03 100644 --- a/basis/compiler/cfg/hats/hats.factor +++ b/basis/compiler/cfg/hats/hats.factor @@ -51,6 +51,7 @@ IN: compiler.cfg.hats : ^^allot-array ( n -- dst ) 2 + cells array ^^allot ; inline : ^^allot-byte-array ( n -- dst ) 2 cells + byte-array ^^allot ; inline : ^^box-alien ( src -- dst ) ^^r1 next-vreg ##box-alien ; inline +: ^^box-displaced-alien ( base displacement -- dst ) ^^r2 next-vreg ##box-displaced-alien ; inline : ^^unbox-alien ( src -- dst ) ^^r1 ##unbox-alien ; inline : ^^unbox-c-ptr ( src class -- dst ) ^^r2 next-vreg ##unbox-c-ptr ; : ^^alien-unsigned-1 ( src -- dst ) ^^r1 ##alien-unsigned-1 ; inline diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 87c6909a9f..bd93214297 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -118,6 +118,7 @@ INSN: ##unbox-float < ##unary ; INSN: ##unbox-any-c-ptr < ##unary/temp ; INSN: ##box-float < ##unary/temp ; INSN: ##box-alien < ##unary/temp ; +INSN: ##box-displaced-alien < ##binary temp ; : ##unbox-f ( dst src -- ) drop 0 ##load-immediate ; : ##unbox-byte-array ( dst src -- ) byte-array-offset ##add-imm ; diff --git a/basis/compiler/cfg/intrinsics/alien/alien.factor b/basis/compiler/cfg/intrinsics/alien/alien.factor index 246a2cb924..332cb7f225 100644 --- a/basis/compiler/cfg/intrinsics/alien/alien.factor +++ b/basis/compiler/cfg/intrinsics/alien/alien.factor @@ -1,11 +1,24 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel sequences alien math classes.algebra fry -locals combinators cpu.architecture compiler.tree.propagation.info -compiler.cfg.hats compiler.cfg.stacks compiler.cfg.instructions +locals combinators combinators.short-circuit cpu.architecture +compiler.tree.propagation.info compiler.cfg.hats +compiler.cfg.stacks compiler.cfg.instructions compiler.cfg.utilities compiler.cfg.builder.blocks ; IN: compiler.cfg.intrinsics.alien +: emit-? ( node -- ? ) + node-input-infos { + [ first class>> fixnum class<= ] + [ second class>> c-ptr class<= ] + } 1&& ; + +: emit- ( node -- ) + dup emit-? + [ drop 2inputs [ ^^untag-fixnum ] dip ^^box-displaced-alien ds-push ] + [ emit-primitive ] + if ; + : (prepare-alien-accessor-imm) ( class offset -- offset-vreg ) ds-drop [ ds-pop swap ^^unbox-c-ptr ] dip ^^add-imm ; diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index 27d9970a91..b1ecf24eea 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -10,6 +10,8 @@ compiler.cfg.intrinsics.float compiler.cfg.intrinsics.slots compiler.cfg.intrinsics.misc compiler.cfg.comparisons ; +QUALIFIED: alien +QUALIFIED: alien.accessors QUALIFIED: kernel QUALIFIED: arrays QUALIFIED: byte-arrays @@ -20,7 +22,6 @@ QUALIFIED: classes.tuple.private QUALIFIED: math.private QUALIFIED: math.integers.private QUALIFIED: math.libm -QUALIFIED: alien.accessors IN: compiler.cfg.intrinsics { @@ -54,6 +55,7 @@ IN: compiler.cfg.intrinsics byte-arrays: byte-arrays:(byte-array) kernel: + alien: alien.accessors:alien-unsigned-1 alien.accessors:set-alien-unsigned-1 alien.accessors:alien-signed-1 @@ -144,6 +146,7 @@ IN: compiler.cfg.intrinsics { \ byte-arrays: [ emit- ] } { \ byte-arrays:(byte-array) [ emit-(byte-array) ] } { \ kernel: [ emit-simple-allot ] } + { \ alien: [ emit- ] } { \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] } { \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] } { \ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] } diff --git a/basis/compiler/cfg/renaming/functor/functor.factor b/basis/compiler/cfg/renaming/functor/functor.factor index ffb824f093..05e1015432 100644 --- a/basis/compiler/cfg/renaming/functor/functor.factor +++ b/basis/compiler/cfg/renaming/functor/functor.factor @@ -140,6 +140,9 @@ M: ##string-nth rename-insn-temps M: ##set-string-nth-fast rename-insn-temps TEMP-QUOT change-temp drop ; +M: ##box-displaced-alien rename-insn-temps + TEMP-QUOT change-temp drop ; + M: ##compare rename-insn-temps TEMP-QUOT change-temp drop ; diff --git a/basis/compiler/cfg/representations/preferred/preferred.factor b/basis/compiler/cfg/representations/preferred/preferred.factor index e9ec7e8835..7de2ff6c52 100644 --- a/basis/compiler/cfg/representations/preferred/preferred.factor +++ b/basis/compiler/cfg/representations/preferred/preferred.factor @@ -25,6 +25,7 @@ M: ##slot temp-vreg-reps drop { int-rep } ; M: ##set-slot temp-vreg-reps drop { int-rep } ; M: ##string-nth temp-vreg-reps drop { int-rep } ; M: ##set-string-nth-fast temp-vreg-reps drop { int-rep } ; +M: ##box-displaced-alien temp-vreg-reps drop { int-rep } ; M: ##compare temp-vreg-reps drop { int-rep } ; M: ##compare-imm temp-vreg-reps drop { int-rep } ; M: ##compare-float temp-vreg-reps drop { int-rep } ; diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor index 50f809cc99..7c7961449a 100755 --- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor +++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors combinators combinators.short-circuit arrays fry kernel layouts math namespaces sequences cpu.architecture -math.bitwise math.order classes vectors +math.bitwise math.order classes vectors locals make compiler.cfg compiler.cfg.registers compiler.cfg.comparisons @@ -350,3 +350,24 @@ M: ##shl rewrite \ ##shl-imm rewrite-arithmetic ; M: ##shr rewrite \ ##shr-imm rewrite-arithmetic ; M: ##sar rewrite \ ##sar-imm rewrite-arithmetic ; + +: box-displaced-alien? ( expr -- ? ) + op>> \ ##box-displaced-alien eq? ; + +! ##box-displaced-alien f 1 2 3 +! ##unbox-any-c-ptr 4 1 +! => +! ##box-displaced-alien f 1 2 3 +! ##unbox-any-c-ptr 5 3 +! ##add 4 5 2 + +:: rewrite-unbox-displaced-alien ( insn expr -- insns ) + [ + next-vreg :> temp + temp expr in2>> vn>vreg insn temp>> ##unbox-any-c-ptr + insn dst>> temp expr in1>> vn>vreg ##add + ] { } make ; + +M: ##unbox-any-c-ptr rewrite + dup src>> vreg>expr dup box-displaced-alien? + [ rewrite-unbox-displaced-alien ] [ 2drop f ] if ; diff --git a/basis/compiler/cfg/value-numbering/simplify/simplify.factor b/basis/compiler/cfg/value-numbering/simplify/simplify.factor index b805d7834c..38a5136a63 100644 --- a/basis/compiler/cfg/value-numbering/simplify/simplify.factor +++ b/basis/compiler/cfg/value-numbering/simplify/simplify.factor @@ -87,6 +87,12 @@ M: unary-expr simplify* [ 2drop f ] } cond ; inline +: simplify-box-displaced-alien ( expr -- vn/expr/f ) + >binary-expr< { + { [ over expr-zero? ] [ nip ] } + [ 2drop f ] + } cond ; + M: binary-expr simplify* dup op>> { { \ ##add [ simplify-add ] } @@ -107,6 +113,7 @@ M: binary-expr simplify* { \ ##sar-imm [ simplify-shr ] } { \ ##shl [ simplify-shl ] } { \ ##shl-imm [ simplify-shl ] } + { \ ##box-displaced-alien [ simplify-box-displaced-alien ] } [ 2drop f ] } case ; diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor index f3c950679a..7a746713d3 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor @@ -870,6 +870,63 @@ cell 8 = [ ] unit-test ] when +! Displaced alien optimizations +3 vreg-counter set-global + +[ + { + T{ ##peek f 0 D 0 } + T{ ##load-immediate f 2 16 } + T{ ##box-displaced-alien f 1 2 0 } + T{ ##unbox-any-c-ptr f 4 0 } + T{ ##add-imm f 3 4 16 } + } +] [ + { + T{ ##peek f 0 D 0 } + T{ ##load-immediate f 2 16 } + T{ ##box-displaced-alien f 1 2 0 } + T{ ##unbox-any-c-ptr f 3 1 } + } value-numbering-step +] unit-test + +4 vreg-counter set-global + +[ + { + T{ ##box-alien f 0 1 } + T{ ##load-immediate f 2 16 } + T{ ##box-displaced-alien f 3 2 0 } + T{ ##copy f 5 1 any-rep } + T{ ##add-imm f 4 5 16 } + } +] [ + { + T{ ##box-alien f 0 1 } + T{ ##load-immediate f 2 16 } + T{ ##box-displaced-alien f 3 2 0 } + T{ ##unbox-any-c-ptr f 4 3 } + } value-numbering-step +] unit-test + +3 vreg-counter set-global + +[ + { + T{ ##peek f 0 D 0 } + T{ ##load-immediate f 2 0 } + T{ ##copy f 3 0 any-rep } + T{ ##replace f 3 D 1 } + } +] [ + { + T{ ##peek f 0 D 0 } + T{ ##load-immediate f 2 0 } + T{ ##box-displaced-alien f 3 2 0 } + T{ ##replace f 3 D 1 } + } value-numbering-step +] unit-test + ! Branch folding [ { @@ -1301,3 +1358,4 @@ V{ ] unit-test [ f ] [ 1 get instructions>> [ ##peek? ] any? ] unit-test + diff --git a/basis/compiler/cfg/value-numbering/value-numbering.factor b/basis/compiler/cfg/value-numbering/value-numbering.factor index 689d1d32c6..6874f2c001 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces assocs kernel accessors -sorting sets sequences +sorting sets sequences arrays cpu.architecture +sequences.deep compiler.cfg compiler.cfg.rpo compiler.cfg.instructions @@ -32,10 +33,13 @@ M: insn process-instruction dup rewrite [ process-instruction ] [ ] ?if ; +M: array process-instruction + [ process-instruction ] map ; + : value-numbering-step ( insns -- insns' ) init-value-graph init-expressions - [ process-instruction ] map ; + [ process-instruction ] map flatten ; : value-numbering ( cfg -- cfg' ) [ value-numbering-step ] local-optimization diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 6395d8644f..72c6feeb1a 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -177,10 +177,13 @@ M: ##float>integer generate-insn dst/src %float>integer ; M: ##copy generate-insn [ dst/src ] [ rep>> ] bi %copy ; -M: ##unbox-float generate-insn dst/src %unbox-float ; +M: ##unbox-float generate-insn dst/src %unbox-float ; M: ##unbox-any-c-ptr generate-insn dst/src/temp %unbox-any-c-ptr ; -M: ##box-float generate-insn dst/src/temp %box-float ; -M: ##box-alien generate-insn dst/src/temp %box-alien ; +M: ##box-float generate-insn dst/src/temp %box-float ; +M: ##box-alien generate-insn dst/src/temp %box-alien ; + +M: ##box-displaced-alien generate-insn + [ dst/src1/src2 ] [ temp>> ] bi %box-displaced-alien ; M: ##alien-unsigned-1 generate-insn dst/src %alien-unsigned-1 ; M: ##alien-unsigned-2 generate-insn dst/src %alien-unsigned-2 ; diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index 0e620e068c..6180e49bef 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -463,6 +463,54 @@ cell 8 = [ ] compile-call ] unit-test +[ ALIEN: 123 ] [ + 123 [ ] compile-call +] unit-test + +[ ALIEN: 123 ] [ + 123 [ { fixnum } declare ] compile-call +] unit-test + +[ ALIEN: 123 ] [ + [ 123 ] compile-call +] unit-test + +[ f ] [ + 0 [ ] compile-call +] unit-test + +[ f ] [ + 0 [ { fixnum } declare ] compile-call +] unit-test + +[ f ] [ + [ 0 ] compile-call +] unit-test + +[ ALIEN: 321 ] [ + 0 ALIEN: 321 [ ] compile-call +] unit-test + +[ ALIEN: 321 ] [ + 0 ALIEN: 321 [ { fixnum c-ptr } declare ] compile-call +] unit-test + +[ ALIEN: 321 ] [ + ALIEN: 321 [ 0 swap ] compile-call +] unit-test + +[ B{ 0 1 2 3 4 } ] [ + 2 B{ 0 1 2 3 4 } + [ 1 swap ] compile-call + underlying>> +] unit-test + +[ B{ 0 1 2 3 4 } ] [ + 2 B{ 0 1 2 3 4 } + [ 1 swap { c-ptr } declare ] compile-call + underlying>> +] unit-test + [ B{ 0 0 0 0 } [ { byte-array } declare ] compile-call ] must-fail diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 71200e1ede..f80ec9458c 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -120,6 +120,7 @@ HOOK: %unbox-float cpu ( dst src -- ) HOOK: %unbox-any-c-ptr cpu ( dst src temp -- ) HOOK: %box-float cpu ( dst src temp -- ) HOOK: %box-alien cpu ( dst src temp -- ) +HOOK: %box-displaced-alien cpu ( dst displacement base temp -- ) HOOK: %alien-unsigned-1 cpu ( dst src -- ) HOOK: %alien-unsigned-2 cpu ( dst src -- ) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index aec7e85b56..c3d89e6d02 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -315,23 +315,50 @@ M:: ppc %unbox-any-c-ptr ( dst src temp -- ) : alien@ ( n -- n' ) cells object tag-number - ; +:: %allot-alien ( dst base displacement temp -- ) + dst 4 cells alien temp %allot + temp \ f tag-number %load-immediate + ! Store expired slot + temp dst 1 alien@ STW + ! Store underlying-alien slot + base dst 2 alien@ STW + ! Store offset + displacement dst 3 alien@ STW ; + M:: ppc %box-alien ( dst src temp -- ) [ "f" define-label dst \ f tag-number %load-immediate 0 src 0 CMPI "f" get BEQ - dst 4 cells alien temp %allot - ! Store offset - src dst 3 alien@ STW - ! Store expired slot - temp \ f tag-number %load-immediate - temp dst 1 alien@ STW - ! Store underlying-alien slot - temp dst 2 alien@ STW + dst temp src temp %allot-alien "f" resolve-label ] with-scope ; +M:: ppc %box-displaced-alien ( dst displacement base temp -- ) + [ + "end" define-label + "ok" define-label + ! If displacement is zero, return the base + dst base MR + 0 displacement 0 CMPI + "end" get BEQ + ! If base is already a displaced alien, unpack it + 0 base \ f tag-number CMPI + "ok" get BEQ + temp base header-offset LWZ + 0 temp alien type-number tag-fixnum CMPI + "ok" get BEQ + ! displacement += base.displacement + temp base 3 alien@ LWZ + displacement displacement temp ADD + ! base = base.base + base base 1 alien@ LWZ + "ok" resolve-label + dst base displacement temp %allot-alien + "end" resolve-label + ] with-scope ; + M: ppc %alien-unsigned-1 0 LBZ ; M: ppc %alien-unsigned-2 0 LHZ ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index f61dd82276..456b430a9e 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -255,17 +255,42 @@ M:: x86 %box-float ( dst src temp -- ) : alien@ ( reg n -- op ) cells alien tag-number - [+] ; +:: %allot-alien ( dst base displacement temp -- ) + dst 4 cells alien temp %allot + dst 1 alien@ base MOV ! alien + dst 2 alien@ \ f tag-number MOV ! expired + dst 3 alien@ displacement MOV ! displacement + ; + M:: x86 %box-alien ( dst src temp -- ) [ "end" define-label dst \ f tag-number MOV src 0 CMP "end" get JE - dst 4 cells alien temp %allot - dst 1 alien@ \ f tag-number MOV - dst 2 alien@ \ f tag-number MOV - ! Store src in alien-offset slot - dst 3 alien@ src MOV + dst \ f tag-number src temp %allot-alien + "end" resolve-label + ] with-scope ; + +M:: x86 %box-displaced-alien ( dst displacement base temp -- ) + [ + "end" define-label + "ok" define-label + ! If displacement is zero, return the base + dst base MOV + displacement 0 CMP + "end" get JE + ! If base is already a displaced alien, unpack it + base \ f tag-number CMP + "ok" get JE + base header-offset [+] alien type-number tag-fixnum CMP + "ok" get JNE + ! displacement += base.displacement + displacement base 3 alien@ ADD + ! base = base.base + base base 1 alien@ MOV + "ok" resolve-label + dst base displacement temp %allot-alien "end" resolve-label ] with-scope ; From f808f43ffbc6cbb4547d2607cf296fd0fd0e2608 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Aug 2009 04:09:12 -0500 Subject: [PATCH 3/5] A few inline declarations --- basis/alien/c-types/c-types.factor | 6 +++--- basis/bit-arrays/bit-arrays.factor | 2 +- basis/io/buffers/buffers.factor | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 9f7ac75558..400af25373 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -236,9 +236,9 @@ M: c-type stack-size size>> cell align ; GENERIC: byte-length ( seq -- n ) flushable -M: byte-array byte-length length ; +M: byte-array byte-length length ; inline -M: f byte-length drop 0 ; +M: f byte-length drop 0 ; inline : c-getter ( name -- quot ) c-type-getter [ @@ -281,7 +281,7 @@ M: memory-stream stream-read ] [ [ + ] change-index drop ] 2bi ; : byte-array>memory ( byte-array base -- ) - swap dup byte-length memcpy ; + swap dup byte-length memcpy ; inline : array-accessor ( type quot -- def ) [ diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor index 0b5a63a906..0f87cf4cb6 100644 --- a/basis/bit-arrays/bit-arrays.factor +++ b/basis/bit-arrays/bit-arrays.factor @@ -83,7 +83,7 @@ M: bit-array resize bit-array boa dup clean-up ; inline -M: bit-array byte-length length 7 + -3 shift ; +M: bit-array byte-length length 7 + -3 shift ; inline SYNTAX: ?{ \ } [ >bit-array ] parse-literal ; diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor index c9396dd081..82c5326b1d 100644 --- a/basis/io/buffers/buffers.factor +++ b/basis/io/buffers/buffers.factor @@ -42,7 +42,7 @@ M: buffer dispose* ptr>> free ; [ fill>> ] [ pos>> ] bi - ; inline : buffer@ ( buffer -- alien ) - [ pos>> ] [ ptr>> ] bi ; + [ pos>> ] [ ptr>> ] bi ; inline : buffer-read ( n buffer -- byte-array ) [ buffer-length min ] keep From 8f19f14c1f5ef9c19e3d5c2616ac6d876999937a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Aug 2009 04:09:35 -0500 Subject: [PATCH 4/5] compiler.cfg.instructions: forgot that ##box-displaced-alien needs a GC check; fixes segfault in benchmark.mandel --- basis/compiler/cfg/instructions/instructions.factor | 7 ++++++- basis/compiler/tests/codegen.factor | 8 +++++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index bd93214297..b98e24253d 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -153,7 +153,12 @@ INSN: ##set-alien-double < ##alien-setter ; ! Memory allocation INSN: ##allot < ##flushable size class temp ; -UNION: ##allocation ##allot ##box-float ##box-alien ##integer>bignum ; +UNION: ##allocation +##allot +##box-float +##box-alien +##box-displaced-alien +##integer>bignum ; INSN: ##write-barrier < ##effect card# table ; diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index 5f06fc8d2a..d45b4aa151 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -401,4 +401,10 @@ cell 4 = [ dup [ [ 1 fixnum+fast ] dip ] [ [ drop 1 ] dip ] if ; [ 2 t ] [ 0 t global-dcn-bug-1 ] unit-test -[ 1 f ] [ 0 f global-dcn-bug-1 ] unit-test \ No newline at end of file +[ 1 f ] [ 0 f global-dcn-bug-1 ] unit-test + +! Forgot a GC check +: missing-gc-check-1 ( a -- b ) { fixnum } declare ; +: missing-gc-check-2 ( -- ) 10000000 [ missing-gc-check-1 drop ] each-integer ; + +[ ] [ missing-gc-check-2 ] unit-test \ No newline at end of file From 98f93f799b7a084319b22dfca5f74601a5bd2167 Mon Sep 17 00:00:00 2001 From: sheeple Date: Thu, 27 Aug 2009 04:43:45 -0500 Subject: [PATCH 5/5] cpu.ppc: fix ##box-displaced-alien --- basis/cpu/ppc/ppc.factor | 14 +++++++------- basis/cpu/x86/x86.factor | 6 +++--- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index c3d89e6d02..d21f5756b9 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -315,13 +315,13 @@ M:: ppc %unbox-any-c-ptr ( dst src temp -- ) : alien@ ( n -- n' ) cells object tag-number - ; -:: %allot-alien ( dst base displacement temp -- ) +:: %allot-alien ( dst displacement base temp -- ) dst 4 cells alien temp %allot temp \ f tag-number %load-immediate - ! Store expired slot - temp dst 1 alien@ STW ! Store underlying-alien slot - base dst 2 alien@ STW + base dst 1 alien@ STW + ! Store expired slot + temp dst 2 alien@ STW ! Store offset displacement dst 3 alien@ STW ; @@ -331,7 +331,7 @@ M:: ppc %box-alien ( dst src temp -- ) dst \ f tag-number %load-immediate 0 src 0 CMPI "f" get BEQ - dst temp src temp %allot-alien + dst src temp temp %allot-alien "f" resolve-label ] with-scope ; @@ -348,14 +348,14 @@ M:: ppc %box-displaced-alien ( dst displacement base temp -- ) "ok" get BEQ temp base header-offset LWZ 0 temp alien type-number tag-fixnum CMPI - "ok" get BEQ + "ok" get BNE ! displacement += base.displacement temp base 3 alien@ LWZ displacement displacement temp ADD ! base = base.base base base 1 alien@ LWZ "ok" resolve-label - dst base displacement temp %allot-alien + dst displacement base temp %allot-alien "end" resolve-label ] with-scope ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 456b430a9e..0d028a4862 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -255,7 +255,7 @@ M:: x86 %box-float ( dst src temp -- ) : alien@ ( reg n -- op ) cells alien tag-number - [+] ; -:: %allot-alien ( dst base displacement temp -- ) +:: %allot-alien ( dst displacement base temp -- ) dst 4 cells alien temp %allot dst 1 alien@ base MOV ! alien dst 2 alien@ \ f tag-number MOV ! expired @@ -268,7 +268,7 @@ M:: x86 %box-alien ( dst src temp -- ) dst \ f tag-number MOV src 0 CMP "end" get JE - dst \ f tag-number src temp %allot-alien + dst src \ f tag-number temp %allot-alien "end" resolve-label ] with-scope ; @@ -290,7 +290,7 @@ M:: x86 %box-displaced-alien ( dst displacement base temp -- ) ! base = base.base base base 1 alien@ MOV "ok" resolve-label - dst base displacement temp %allot-alien + dst displacement base temp %allot-alien "end" resolve-label ] with-scope ;