]> gitweb.factorcode.org Git - factor.git/commitdiff
Fix conflicts
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 8 Sep 2009 04:51:25 +0000 (23:51 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 8 Sep 2009 04:51:25 +0000 (23:51 -0500)
1  2 
basis/alien/c-types/c-types.factor
basis/compiler/tree/propagation/propagation-tests.factor
basis/cpu/ppc/ppc.factor
basis/cpu/x86/x86.factor
basis/specialized-arrays/functor/functor.factor
basis/specialized-arrays/specialized-arrays-tests.factor
basis/struct-arrays/struct-arrays-tests.factor

Simple merge
index 00d982c2bf6fbce2720f8238b2e4d36dbbf67074,209efb3913ad86120a825c02e8ad373d6c6f4ed3..06e68d3e3575278e73f72f85be600befd446f92c
@@@ -800,18 -800,5 +800,21 @@@ SYMBOL: not-an-asso
  [ t ] [ [ (( a b c -- c b a )) shuffle ] { shuffle } inlined? ] unit-test
  [ f ] [ [ { 1 2 3 } swap shuffle ] { shuffle } inlined? ] unit-test
  
 +! Type function for 'clone' had a subtle issue
 +TUPLE: tuple-with-read-only-slot { x read-only } ;
 +
 +M: tuple-with-read-only-slot clone
 +    x>> clone tuple-with-read-only-slot boa ; inline
 +
 +[ V{ object } ] [
 +    [ { 1 2 3 } dup tuple-with-read-only-slot boa clone x>> eq? ] final-classes
 +] unit-test
 +
 +! alien-cell outputs a simple-alien or f
 +[ t ] [
 +    [ { byte-array fixnum } declare alien-cell dup [ "OOPS" throw ] unless ] final-classes
 +    first simple-alien class=
 +] unit-test
++
+ ! Don't crash if bad literal inputs are passed to unsafe words
+ [ f ] [ [ { } 1 fixnum+fast ] final-info first literal?>> ] unit-test
index c0961734a2e95357dfb517aeae07f77b52c9c09c,6a3fb9dc5260695606fa81306ddf7bcdd3ed38da..b3865f273ff5b4551f2a25a70938f33af7cb45ab
@@@ -500,37 -501,61 +501,65 @@@ M: ppc %epilogue ( n -- 
      dst \ t %load-reference
      "end" get resolve-label ; inline
  
- : %boolean ( dst cc temp -- )
-     swap negate-cc {
-         { cc< [ \ BLT (%boolean) ] }
-         { cc<= [ \ BLE (%boolean) ] }
-         { cc> [ \ BGT (%boolean) ] }
-         { cc>= [ \ BGE (%boolean) ] }
-         { cc= [ \ BEQ (%boolean) ] }
-         { cc/= [ \ BNE (%boolean) ] }
 -:: %boolean ( dst temp cc -- )
++:: %boolean ( dst cc temp -- )
+     cc negate-cc order-cc {
+         { cc<  [ dst temp \ BLT f (%boolean) ] }
+         { cc<= [ dst temp \ BLE f (%boolean) ] }
+         { cc>  [ dst temp \ BGT f (%boolean) ] }
+         { cc>= [ dst temp \ BGE f (%boolean) ] }
+         { cc=  [ dst temp \ BEQ f (%boolean) ] }
+         { cc/= [ dst temp \ BNE f (%boolean) ] }
      } case ;
  
  : (%compare) ( src1 src2 -- ) [ 0 ] dip CMP ; inline
  : (%compare-imm) ( src1 src2 -- ) [ 0 ] 2dip CMPI ; inline
- : (%compare-float) ( src1 src2 -- ) [ 0 ] dip FCMPU ; inline
+ : (%compare-float-unordered) ( src1 src2 -- ) [ 0 ] dip FCMPU ; inline
+ : (%compare-float-ordered) ( src1 src2 -- ) [ 0 ] dip FCMPO ; inline
 -:: (%compare-float) ( cc src1 src2 -- branch1 branch2 )
++:: (%compare-float) ( src1 src2 cc -- branch1 branch2 )
+     cc {
+         { cc<    [ src1 src2 (%compare-float-ordered)   \ BLT f     ] }
+         { cc<=   [ src1 src2 (%compare-float-ordered)   \ BLT \ BEQ ] }
+         { cc>    [ src1 src2 (%compare-float-ordered)   \ BGT f     ] }
+         { cc>=   [ src1 src2 (%compare-float-ordered)   \ BGT \ BEQ ] }
+         { cc=    [ src1 src2 (%compare-float-unordered) \ BEQ f     ] }
+         { cc<>   [ src1 src2 (%compare-float-ordered)   \ BLT \ BGT ] }
+         { cc<>=  [ src1 src2 (%compare-float-ordered)   \ BNO f     ] }
+         { cc/<   [ src1 src2 (%compare-float-unordered) \ BGE f     ] }
+         { cc/<=  [ src1 src2 (%compare-float-unordered) \ BGT \ BO  ] }
+         { cc/>   [ src1 src2 (%compare-float-unordered) \ BLE f     ] }
+         { cc/>=  [ src1 src2 (%compare-float-unordered) \ BLT \ BO  ] }
+         { cc/=   [ src1 src2 (%compare-float-unordered) \ BNE f     ] }
+         { cc/<>  [ src1 src2 (%compare-float-unordered) \ BEQ \ BO  ] }
+         { cc/<>= [ src1 src2 (%compare-float-unordered) \ BO  f     ] }
+     } case ; inline
  
 -M: ppc %compare (%compare) %boolean ;
 -M: ppc %compare-imm (%compare-imm) %boolean ;
 -M:: ppc %compare-float ( dst temp cc src1 src2 -- )
 +M: ppc %compare [ (%compare) ] 2dip %boolean ;
++
 +M: ppc %compare-imm [ (%compare-imm) ] 2dip %boolean ;
- M: ppc %compare-float [ (%compare-float) ] 2dip %boolean ;
 +
- : %branch ( label cc -- )
-     {
-         { cc< [ BLT ] }
-         { cc<= [ BLE ] }
-         { cc> [ BGT ] }
-         { cc>= [ BGE ] }
-         { cc= [ BEQ ] }
-         { cc/= [ BNE ] }
++M:: ppc %compare-float ( dst src1 src2 cc temp -- )
+     cc negate-cc src1 src2 (%compare-float) :> branch2 :> branch1
+     dst temp branch1 branch2 (%boolean) ;
+ :: %branch ( label cc -- )
+     cc order-cc {
+         { cc<  [ label BLT ] }
+         { cc<= [ label BLE ] }
+         { cc>  [ label BGT ] }
+         { cc>= [ label BGE ] }
+         { cc=  [ label BEQ ] }
+         { cc/= [ label BNE ] }
      } case ;
  
 -M: ppc %compare-branch (%compare) %branch ;
 -M: ppc %compare-imm-branch (%compare-imm) %branch ;
 -M:: ppc %compare-float-branch ( label cc src1 src2 -- )
 +M: ppc %compare-branch [ (%compare) ] 2dip %branch ;
++
 +M: ppc %compare-imm-branch [ (%compare-imm) ] 2dip %branch ;
- M: ppc %compare-float-branch [ (%compare-float) ] 2dip %branch ;
++
++M:: ppc %compare-float-branch ( label src1 src2 cc -- )
+     cc src1 src2 (%compare-float) :> branch2 :> branch1
+     label branch1 execute( label -- )
+     branch2 [ label branch2 execute( label -- ) ] when ;
  
  : load-from-frame ( dst n rep -- )
      {
index 9213af041582b1256ea771ee5cc3a44f0d8acac6,91d2cf8fde9368d1f759b3dc11a9281c853561db..299d3db84c46ebdab8867713bf6ed703469425e7
@@@ -1,4 -1,4 +1,4 @@@
--! Copyright (C) 2005, 2008 Slava Pestov.
++! Copyright (C) 2005, 2009 Slava Pestov.
  ! See http://factorcode.org/license.txt for BSD license.
  USING: accessors assocs alien alien.c-types arrays strings
  cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
@@@ -623,57 -511,104 +623,107 @@@ M: x86 %epilogue ( n -- ) cell - incr-s
      temp 0 MOV \ t rc-absolute-cell rel-immediate
      dst temp word execute ; inline
  
 -M:: x86 %compare ( dst temp cc src1 src2 -- )
 +M: x86 %compare ( dst src1 src2 cc temp -- )
-     [ CMP ] 2dip swap {
-         { cc< [ \ CMOVL %boolean ] }
-         { cc<= [ \ CMOVLE %boolean ] }
-         { cc> [ \ CMOVG %boolean ] }
-         { cc>= [ \ CMOVGE %boolean ] }
-         { cc= [ \ CMOVE %boolean ] }
-         { cc/= [ \ CMOVNE %boolean ] }
+     src1 src2 CMP
+     cc order-cc {
+         { cc<  [ dst temp \ CMOVL %boolean ] }
+         { cc<= [ dst temp \ CMOVLE %boolean ] }
+         { cc>  [ dst temp \ CMOVG %boolean ] }
+         { cc>= [ dst temp \ CMOVGE %boolean ] }
+         { cc=  [ dst temp \ CMOVE %boolean ] }
+         { cc/= [ dst temp \ CMOVNE %boolean ] }
      } case ;
  
 -M: x86 %compare-imm ( dst temp cc src1 src2 -- )
 +M: x86 %compare-imm ( dst src1 src2 cc temp -- )
      %compare ;
  
- M: x86 %compare-float ( dst src1 src2 cc temp -- )
-     [ UCOMISD ] 2dip swap {
-         { cc< [ \ CMOVB %boolean ] }
-         { cc<= [ \ CMOVBE %boolean ] }
-         { cc> [ \ CMOVA %boolean ] }
-         { cc>= [ \ CMOVAE %boolean ] }
-         { cc= [ \ CMOVE %boolean ] }
-         { cc/= [ \ CMOVNE %boolean ] }
+ : %cmov-float= ( dst src -- )
+     [
+         "no-move" define-label
+         "no-move" get [ JNE ] [ JP ] bi
+         MOV
+         "no-move" resolve-label
+     ] with-scope ;
+ : %cmov-float/= ( dst src -- )
+     [
+         "no-move" define-label
+         "move" define-label
+         "move" get JP
+         "no-move" get JE
+         "move" resolve-label
+         MOV
+         "no-move" resolve-label
+     ] with-scope ;
 -M:: x86 %compare-float ( dst temp cc src1 src2 -- )
++M:: x86 %compare-float ( dst src1 src2 cc temp -- )
+     cc {
+         { cc<    [ src2 src1  COMISD dst temp \ CMOVA  %boolean ] }
+         { cc<=   [ src2 src1  COMISD dst temp \ CMOVAE %boolean ] }
+         { cc>    [ src1 src2  COMISD dst temp \ CMOVA  %boolean ] }
+         { cc>=   [ src1 src2  COMISD dst temp \ CMOVAE %boolean ] }
+         { cc=    [ src1 src2 UCOMISD dst temp \ %cmov-float= %boolean ] }
+         { cc<>   [ src1 src2  COMISD dst temp \ CMOVNE %boolean ] }
+         { cc<>=  [ src1 src2  COMISD dst temp \ CMOVNP %boolean ] }
+         { cc/<   [ src2 src1 UCOMISD dst temp \ CMOVBE %boolean ] }
+         { cc/<=  [ src2 src1 UCOMISD dst temp \ CMOVB  %boolean ] }
+         { cc/>   [ src1 src2 UCOMISD dst temp \ CMOVBE %boolean ] }
+         { cc/>=  [ src1 src2 UCOMISD dst temp \ CMOVB  %boolean ] }
+         { cc/=   [ src1 src2 UCOMISD dst temp \ %cmov-float/= %boolean ] }
+         { cc/<>  [ src1 src2 UCOMISD dst temp \ CMOVE  %boolean ] }
+         { cc/<>= [ src1 src2 UCOMISD dst temp \ CMOVP  %boolean ] }
      } case ;
  
- M: x86 %compare-branch ( label src1 src2 cc -- )
-     [ CMP ] dip {
-         { cc< [ JL ] }
-         { cc<= [ JLE ] }
-         { cc> [ JG ] }
-         { cc>= [ JGE ] }
-         { cc= [ JE ] }
-         { cc/= [ JNE ] }
 -M:: x86 %compare-branch ( label cc src1 src2 -- )
++M:: x86 %compare-branch ( label src1 src2 cc -- )
+     src1 src2 CMP
+     cc order-cc {
+         { cc<  [ label JL ] }
+         { cc<= [ label JLE ] }
+         { cc>  [ label JG ] }
+         { cc>= [ label JGE ] }
+         { cc=  [ label JE ] }
+         { cc/= [ label JNE ] }
      } case ;
  
  M: x86 %compare-imm-branch ( label src1 src2 cc -- )
      %compare-branch ;
  
- M: x86 %compare-float-branch ( label src1 src2 cc -- )
-     [ UCOMISD ] dip {
-         { cc< [ JB ] }
-         { cc<= [ JBE ] }
-         { cc> [ JA ] }
-         { cc>= [ JAE ] }
-         { cc= [ JE ] }
-         { cc/= [ JNE ] }
+ : %jump-float= ( label -- )
+     [
+         "no-jump" define-label
+         "no-jump" get JP
+         JE
+         "no-jump" resolve-label
+     ] with-scope ;
+ : %jump-float/= ( label -- )
+     [ JNE ] [ JP ] bi ;
 -M:: x86 %compare-float-branch ( label cc src1 src2 -- )
++M:: x86 %compare-float-branch ( label src1 src2 cc -- )
+     cc {
+         { cc<    [ src2 src1  COMISD label JA  ] }
+         { cc<=   [ src2 src1  COMISD label JAE ] }
+         { cc>    [ src1 src2  COMISD label JA  ] }
+         { cc>=   [ src1 src2  COMISD label JAE ] }
+         { cc=    [ src1 src2 UCOMISD label %jump-float= ] }
+         { cc<>   [ src1 src2  COMISD label JNE ] }
+         { cc<>=  [ src1 src2  COMISD label JNP ] }
+         { cc/<   [ src2 src1 UCOMISD label JBE ] }
+         { cc/<=  [ src2 src1 UCOMISD label JB  ] }
+         { cc/>   [ src1 src2 UCOMISD label JBE ] }
+         { cc/>=  [ src1 src2 UCOMISD label JB  ] }
+         { cc/=   [ src1 src2 UCOMISD label %jump-float/= ] }
+         { cc/<>  [ src1 src2 UCOMISD label JE  ] }
+         { cc/<>= [ src1 src2 UCOMISD label JP  ] }
      } case ;
  
 -M: x86 %spill ( src n rep -- ) [ spill@ swap ] dip copy-register ;
 -M: x86 %reload ( dst n rep -- ) [ spill@ ] dip copy-register ;
 +M:: x86 %spill ( src rep n -- )
 +    n spill@ src rep copy-register ;
 +
 +M:: x86 %reload ( dst rep n -- )
 +    dst n spill@ rep copy-register ;
  
  M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
  
index aaec309523c6a6749e49ff7c7292f11103cdf2b2,45539b7624bcc2b85cf6cf6e3a8e90c9f002c2dc..b4d052467d3567a7cba7edec67268c6aa739d1c2
mode 100644,100755..100755
@@@ -62,26 -67,22 +67,22 @@@ M: A new-sequence drop (A) ; inlin
  M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
  
  M: A resize
-     [ drop ] [
+     [
          [ T heap-size * ] [ underlying>> ] bi*
          resize-byte-array
-     ] 2bi
-     A boa ; inline
+     ] [ drop ] 2bi
+     <direct-A> ; inline
  
  M: A byte-length underlying>> length ; inline
  M: A pprint-delims drop \ A{ \ } ;
  M: A >pprint-sequence ;
  
- M: A pprint* pprint-object ;
  SYNTAX: A{ \ } [ >A ] parse-literal ;
+ SYNTAX: A@ scan-object scan-object <direct-A> parsed ;
  
- INSTANCE: A sequence
- INSTANCE: A S
+ INSTANCE: A specialized-array
  
 -A T c-type-boxed-class specialize-vector-words
 +A T c-type-boxed-class specialize-vector-words
  
  T c-type
      \ A >>array-class
index c983f29c71a6dc0e24af273f8f70a00714a4aab4,ad7315303386634f6a7ed06326fad8470aa86b24..9ca356506e66df7399f7c49ac095e309b680b8ff
mode 100644,100755..100755
@@@ -30,6 -28,7 +28,11 @@@ specialized-arrays.char specialized-arr
      int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array
  ] unit-test
  
- [ f ] [ [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] compile-call ] unit-test
 +[ f ] [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] unit-test
 +
 -] unit-test
++[ f ] [ [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] compile-call ] unit-test
++
+ [ ushort-array{ 0 0 0 } ] [
+     3 ALIEN: 123 100 <direct-ushort-array> new-sequence
+     dup [ drop 0 ] change-each
++] unit-test