steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix fixnum-shift overflow check

cvs
Slava Pestov 2006-01-21 08:23:14 +00:00
parent 9ee2327fdf
commit df4c2fc067
6 changed files with 41 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
contrib/httpd/browser-responder.factor
View File

@ -62,9 +62,9 @@ memory namespaces prettyprint sequences words xml ;
#! Write out the HTML for the body of the main browser page.
<table "100%" =width table>
<tr>
<td> <b> "Vocabularies" write </b> </td>
<td> <b> "Words" write </b> </td>
<td> <b> "Documentation" write </b> </td>
<th> "Vocabularies" write </th>
<th> "Words" write </th>
<th> "Documentation" write </th>
</tr>
<tr>
<td "top" =valign "width: 200" =style td> over vocab-list </td>

6
library/collections/sequences-epilogue.facts
View File

@ -80,12 +80,6 @@ HELP: add "( seq elt -- newseq )"
{ $description "Outputs a new sequence consisting of the elements of " { $snippet "seq1" } " followed by " { $snippet "elt" } "." }
{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." } ;
HELP: adjoin "( elt seq -- )"
{ $values { "elt" "an object" } { "seq" "a resizable mutable sequence" } }
{ $description "Adds the element at the end of the sequence if the sequence does not already contain an equal element." }
{ $side-effects "seq" }
{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." } ;
HELP: diff "( seq1 seq2 -- newseq )"
{ $values { "seq1" "a sequence" } { "seq2" "a sequence" } { "newseq" "a sequence" } }
{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq2" } " but not " { $snippet "seq1" } ", comparing elements for equality." } ;

52
library/compiler/amd64/alien.factor
View File

@ -3,29 +3,29 @@
IN: compiler-backend
USING: alien assembler kernel math sequences ;
GENERIC: store-insn ( offset reg-class -- )
GENERIC: load-insn ( elt parameter reg-class -- )
M: int-regs store-insn drop >r 3 1 r> stack@ STW ;
M: int-regs load-insn drop 3 + 1 rot stack@ LWZ ;
M: %unbox generate-node ( vop -- )
drop
! Call the unboxer
1 input f compile-c-call
! Store the return value on the C stack
0 input 2 input store-insn ;
M: %parameter generate-node ( vop -- )
! Move a value from the C stack into the fastcall register
drop 0 input 1 input 2 input load-insn ;
M: %box generate-node ( vop -- )
drop
! Move return value of C function into input register
param-regs first RAX MOV
0 input f compile-c-call ;
M: %cleanup generate-node ( vop -- ) drop ;
! GENERIC: store-insn ( offset reg-class -- )
!
! GENERIC: load-insn ( elt parameter reg-class -- )
!
! M: int-regs store-insn drop >r 3 1 r> stack@ STW ;
!
! M: int-regs load-insn drop 3 + 1 rot stack@ LWZ ;
!
! M: %unbox generate-node ( vop -- )
! drop
! ! Call the unboxer
! 1 input f compile-c-call
! ! Store the return value on the C stack
! 0 input 2 input store-insn ;
!
! M: %parameter generate-node ( vop -- )
! ! Move a value from the C stack into the fastcall register
! drop 0 input 1 input 2 input load-insn ;
!
! M: %box generate-node ( vop -- )
! drop
! ! Move return value of C function into input register
! param-regs first RAX MOV
! 0 input f compile-c-call ;
!
! M: %cleanup generate-node ( vop -- ) drop ;

3
library/test/compiler/intrinsics.factor
View File

@ -173,6 +173,7 @@ math-internals sequences strings test words ;
[ t ] [ 1 20 shift 1 20 shift [ fixnum* ] compile-1 1 40 shift = ] unit-test
[ t ] [ 1 20 shift neg 1 20 shift [ fixnum* ] compile-1 1 40 shift neg = ] unit-test
[ t ] [ 1 20 shift neg 1 20 shift neg [ fixnum* ] compile-1 1 40 shift = ] unit-test
[ -351382792 ] [ -43922849 [ 3 fixnum-shift ] compile-1 ] unit-test
[ 268435456 ] [ -268435456 >fixnum -1 [ fixnum/i ] compile-1 ] unit-test
@ -199,7 +200,7 @@ cell 8 = [
[ t ] [ 1 40 shift neg 1 40 shift neg [ fixnum* ] compile-1 1 80 shift = ] unit-test
[ t ] [ 1 30 shift neg 1 50 shift neg [ fixnum* ] compile-1 1 80 shift = ] unit-test
[ t ] [ 1 50 shift neg 1 30 shift neg [ fixnum* ] compile-1 1 80 shift = ] unit-test
[ 18446744073709551616 ] [ 1 64 [ fixnum-shift ] compile-1 ] unit-test
[ 18446744073709551616 ] [ 1 [ 64 fixnum-shift ] compile-1 ] unit-test
[ 18446744073709551616 ] [ 1 [ 32 fixnum-shift 32 fixnum-shift ] compile-1 ] unit-test

2
library/test/math/integer.factor
View File

@ -99,3 +99,5 @@ unit-test
[ 14355 ] [ 1591517158873146351817850880000000 32769 mod ] unit-test
[ { 0 1 1 0 } ] [ [ -10 [ , ] each-bit ] { } make ] unit-test
[ -351382792 ] [ -43922849 3 shift ] unit-test

19
native/fixnum.c
View File

@ -136,7 +136,12 @@ void primitive_fixnum_shift(void)
F_FIXNUM y = untag_fixnum_fast(dpop());
F_FIXNUM x = untag_fixnum_fast(dpop());
if(y < 0)
if(x == 0 || y == 0)
{
dpush(tag_fixnum(x));
return;
}
else if(y < 0)
{
if(y <= -WORD_SIZE)
dpush(x < 0 ? tag_fixnum(-1) : tag_fixnum(0));
@ -144,18 +149,10 @@ void primitive_fixnum_shift(void)
dpush(tag_fixnum(x >> -y));
return;
}
else if(y == 0)
{
dpush(tag_fixnum(x));
return;
}
else if(y < WORD_SIZE - TAG_BITS)
{
F_FIXNUM mask = (1 << (WORD_SIZE - 1 - TAG_BITS - y));
if(x > 0)
mask = -mask;
if((x & mask) == 0)
F_FIXNUM mask = -(1 << (WORD_SIZE - 1 - TAG_BITS - y));
if((x > 0 && (x & mask) == 0) || (x & mask) == mask)
{
dpush(tag_fixnum(x << y));
return;