diff --git a/contrib/httpd/browser-responder.factor b/contrib/httpd/browser-responder.factor index f0e75bfca9..36fd08c2c0 100644 --- a/contrib/httpd/browser-responder.factor +++ b/contrib/httpd/browser-responder.factor @@ -62,9 +62,9 @@ memory namespaces prettyprint sequences words xml ; #! Write out the HTML for the body of the main browser page. - - - + + + diff --git a/library/collections/sequences-epilogue.facts b/library/collections/sequences-epilogue.facts index 73bf19a9c3..7d9e56ee75 100644 --- a/library/collections/sequences-epilogue.facts +++ b/library/collections/sequences-epilogue.facts @@ -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." } ; diff --git a/library/compiler/amd64/alien.factor b/library/compiler/amd64/alien.factor index bd0df2d9bf..e89c6f318a 100644 --- a/library/compiler/amd64/alien.factor +++ b/library/compiler/amd64/alien.factor @@ -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 ; diff --git a/library/test/compiler/intrinsics.factor b/library/test/compiler/intrinsics.factor index 1a4646cf00..bd35d2f89d 100644 --- a/library/test/compiler/intrinsics.factor +++ b/library/test/compiler/intrinsics.factor @@ -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 diff --git a/library/test/math/integer.factor b/library/test/math/integer.factor index 31e0c5d2fb..82fe2322f5 100644 --- a/library/test/math/integer.factor +++ b/library/test/math/integer.factor @@ -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 diff --git a/native/fixnum.c b/native/fixnum.c index 2f60958781..b23db2b15f 100644 --- a/native/fixnum.c +++ b/native/fixnum.c @@ -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;
"Vocabularies" write "Words" write "Documentation" write "Vocabularies" write "Words" write "Documentation" write
over vocab-list