Fix more compiler bugs

db4
Slava Pestov 2008-08-29 00:26:47 -05:00
parent c8cd90a824
commit 1fcbdf9d52
8 changed files with 38 additions and 11 deletions

View File

@ -37,9 +37,9 @@ DEFER: (tail-call?)
: tail-call? ( -- ? )
node-stack get [
rest-slice
dup [
dup empty? [ drop t ] [
[ (tail-call?) ]
[ first #terminate? not ]
bi and
] [ drop t ] if
] if
] all? ;

View File

@ -450,3 +450,14 @@ cell 8 = [
[ 8 ] [
1 [ 3 fixnum-shift-fast ] compile-call
] unit-test
TUPLE: alien-accessor-regression { b byte-array } { i fixnum } ;
[ B{ 0 1 } ] [
B{ 0 0 } 1 alien-accessor-regression boa
dup [
{ alien-accessor-regression } declare
[ i>> ] [ b>> ] bi over set-alien-unsigned-1
] compile-call
b>>
] unit-test

View File

@ -358,3 +358,7 @@ TUPLE: some-tuple x ;
[ 5 ] [ { 1 2 { 3 { 4 5 } } } deep-find-test ] unit-test
[ f ] [ { 1 2 { 3 { 4 } } } deep-find-test ] unit-test
[ B{ 0 1 2 3 4 5 6 7 } ] [ [ 8 [ ] B{ } map-as ] compile-call ] unit-test
[ 0 ] [ 1234 [ { fixnum } declare -64 shift ] compile-call ] unit-test

View File

@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences sequences.deep combinators fry
classes.algebra namespaces assocs words math math.private
math.partial-dispatch classes classes.tuple classes.tuple.private
definitions stack-checker.state stack-checker.branches
compiler.tree
math.partial-dispatch math.intervals classes classes.tuple
classes.tuple.private layouts definitions stack-checker.state
stack-checker.branches compiler.tree
compiler.tree.intrinsics
compiler.tree.combinators
compiler.tree.propagation.info
@ -64,9 +64,19 @@ GENERIC: cleanup* ( node -- node/nodes )
{ fixnum-shift fixnum-shift-fast }
} at ;
: (remove-overflow-check?) ( #call -- ? )
node-output-infos first class>> fixnum class<= ;
: small-shift? ( #call -- ? )
node-input-infos second interval>>
0 cell-bits tag-bits get - [a,b] interval-subset? ;
: remove-overflow-check? ( #call -- ? )
dup word>> no-overflow-variant
[ node-output-infos first class>> fixnum class<= ] [ drop f ] if ;
{
{ [ dup word>> \ fixnum-shift eq? ] [ [ (remove-overflow-check?) ] [ small-shift? ] bi and ] }
{ [ dup word>> no-overflow-variant ] [ (remove-overflow-check?) ] }
[ drop f ]
} cond ;
: remove-overflow-check ( #call -- #call )
[ in-d>> ] [ out-d>> ] [ word>> no-overflow-variant ] tri #call cleanup* ;

View File

@ -571,6 +571,8 @@ MIXIN: empty-mixin
[ ] [ [ { empty-mixin } declare empty-mixin? ] final-info drop ] unit-test
[ V{ fixnum } ] [ [ [ bignum-shift drop ] keep ] final-classes ] unit-test
! [ V{ string } ] [
! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
! ] unit-test

View File

@ -404,10 +404,8 @@ IN: cpu.x86.intrinsics
: %alien-integer-set ( quot reg -- )
small-reg PUSH
"offset" get "value" get = [
"value" operand %untag-fixnum
] unless
small-reg "value" operand MOV
small-reg %untag-fixnum
swap %alien-accessor
small-reg POP ; inline

View File

@ -331,7 +331,7 @@ SYMBOL: +primitive+
\ bignum-bitnot { bignum } { bignum } define-primitive
\ bignum-bitnot make-foldable
\ bignum-shift { bignum bignum } { bignum } define-primitive
\ bignum-shift { bignum fixnum } { bignum } define-primitive
\ bignum-shift make-foldable
\ bignum< { bignum bignum } { object } define-primitive

View File

@ -2,7 +2,9 @@ USING: io.binary tools.test classes math ;
IN: io.binary.tests
[ B{ 0 0 4 HEX: d2 } ] [ 1234 4 >be ] unit-test
[ B{ 0 0 0 0 0 0 4 HEX: d2 } ] [ 1234 8 >be ] unit-test
[ B{ HEX: d2 4 0 0 } ] [ 1234 4 >le ] unit-test
[ B{ HEX: d2 4 0 0 0 0 0 0 } ] [ 1234 8 >le ] unit-test
[ 1234 ] [ 1234 4 >be be> ] unit-test
[ 1234 ] [ 1234 4 >le le> ] unit-test