Merge branch 'master' of git://factorcode.org/git/factor

diff --git a/Nmakefile b/Nmakefile
index a8b7e103ec21b312b3d862cc57a65671a615c3fb..5297e491713e2f482add4e0821095fbf6208c133 100755 (executable)
--- a/Nmakefile
+++ b/Nmakefile
@@ -5,7 +5,7 @@ BOOTIMAGE_VERSION = latest
 !IF DEFINED(PLATFORM)
 
 LINK_FLAGS = /nologo shell32.lib
-CL_FLAGS = /nologo /O2 /W3 /D_CRT_SECURE_NO_WARNINGS
+CL_FLAGS = /nologo /O2 /WX /W3 /D_CRT_SECURE_NO_WARNINGS
 
 !IF DEFINED(DEBUG)
 LINK_FLAGS = $(LINK_FLAGS) /DEBUG

diff --git a/basis/math/quaternions/quaternions-tests.factor b/basis/math/quaternions/quaternions-tests.factor
index b049b6dbc41a202652ed59d561b6b1a899d2ae1d..cf5c421f16ec7780db0de8f8da80da9eed6e81d4 100644 (file)
--- a/basis/math/quaternions/quaternions-tests.factor
+++ b/basis/math/quaternions/quaternions-tests.factor
@@ -29,3 +29,6 @@ CONSTANT: qk { 0 0 0 1 }
 [ t ] [ qi qi q- q0 = ] unit-test
 [ t ] [ qi qj q+ qj qi q+ = ] unit-test
 [ t ] [ qi qj q- qj qi q- -1 q*n = ] unit-test
+
+[ { 2 2 2 2 } ] [ { 1 1 1 1 } 2 q*n ] unit-test
+[ { 2 2 2 2 } ] [ 2 { 1 1 1 1 } n*q ] unit-test

diff --git a/basis/math/quaternions/quaternions.factor b/basis/math/quaternions/quaternions.factor
index 4173507e6ca27246809fdda9fec74cfef4e83669..d10cd7a8cbef179e407f8c968f24439a8bf4876b 100644 (file)
--- a/basis/math/quaternions/quaternions.factor
+++ b/basis/math/quaternions/quaternions.factor
@@ -35,8 +35,8 @@ M: object qconjugate ( u -- u' )
 : q/ ( u v -- u/v )
     qrecip q* ; inline
 
-: n*q ( q n -- r )
-    v*n ; inline
+: n*q ( n q -- r )
+    n*v ; inline
 
 : q*n ( q n -- r )
     v*n ; inline

diff --git a/basis/tools/disassembler/udis/udis-tests.factor b/basis/tools/disassembler/udis/udis-tests.factor
index 522893f3687d6817440e6f7391a09e1f48b51e95..55e113e1bd79f246c68c3e631f7ab0af3f5c9182 100644 (file)
--- a/basis/tools/disassembler/udis/udis-tests.factor
+++ b/basis/tools/disassembler/udis/udis-tests.factor
@@ -2,7 +2,14 @@ IN: tools.disassembler.udis.tests
 USING: tools.disassembler.udis tools.test alien.c-types system combinators kernel ;
 
 {
-    { [ cpu x86.32? ] [ [ 604 ] [ ud heap-size ] unit-test ] }
+    {
+        [ cpu x86.32? ]
+        [
+            os windows?
+            [ [ 624 ] [ ud heap-size ] unit-test ]
+            [ [ 604 ] [ ud heap-size ] unit-test ] if
+        ]
+    }
     { [ cpu x86.64? ] [ [ 672 ] [ ud heap-size ] unit-test ] }
     [ ]
 } cond
\ No newline at end of file

diff --git a/extra/hashtables/identity/authors.txt b/extra/hashtables/identity/authors.txt
new file mode 100644 (file)
index 0000000..6a1b3e7
--- /dev/null
+++ b/extra/hashtables/identity/authors.txt
@@ -0,0 +1 @@
+Joe Groff\r

diff --git a/extra/hashtables/identity/identity-tests.factor b/extra/hashtables/identity/identity-tests.factor
new file mode 100644 (file)
index 0000000..871d8e3
--- /dev/null
+++ b/extra/hashtables/identity/identity-tests.factor
@@ -0,0 +1,31 @@
+! (c)2010 Joe Groff bsd license\r
+USING: assocs hashtables.identity kernel literals tools.test ;\r
+IN: hashtables.identity.tests\r
+\r
+CONSTANT: the-real-slim-shady "marshall mathers"\r
+\r
+CONSTANT: will\r
+    IH{\r
+        { $ the-real-slim-shady t }\r
+        { "marshall mathers"    f }\r
+    }\r
+\r
+: please-stand-up ( assoc key -- value )\r
+    swap at ;\r
+\r
+[ t ] [ will the-real-slim-shady please-stand-up ] unit-test\r
+[ t ] [ will clone the-real-slim-shady please-stand-up ] unit-test\r
+\r
+[ 2 ] [ will assoc-size ] unit-test\r
+[ { { "marshall mathers" f } } ] [\r
+    the-real-slim-shady will clone\r
+    [ delete-at ] [ >alist ] bi\r
+] unit-test\r
+[ t ] [\r
+    t the-real-slim-shady identity-associate\r
+    t the-real-slim-shady identity-associate =\r
+] unit-test\r
+[ f ] [\r
+    t the-real-slim-shady identity-associate\r
+    t "marshall mathers"  identity-associate =\r
+] unit-test\r

diff --git a/extra/hashtables/identity/identity.factor b/extra/hashtables/identity/identity.factor
new file mode 100644 (file)
index 0000000..5f1aeca
--- /dev/null
+++ b/extra/hashtables/identity/identity.factor
@@ -0,0 +1,62 @@
+! (c)2010 Joe Groff bsd license\r
+USING: accessors arrays assocs fry hashtables kernel parser\r
+sequences vocabs.loader ;\r
+IN: hashtables.identity\r
+\r
+TUPLE: identity-wrapper\r
+    { underlying read-only } ;\r
+C: <identity-wrapper> identity-wrapper\r
+\r
+M: identity-wrapper equal?\r
+    over identity-wrapper?\r
+    [ [ underlying>> ] bi@ eq? ]\r
+    [ 2drop f ] if ; inline\r
+\r
+M: identity-wrapper hashcode*\r
+    nip underlying>> identity-hashcode ; inline\r
+\r
+TUPLE: identity-hashtable\r
+    { underlying hashtable read-only } ;\r
+\r
+: <identity-hashtable> ( n -- ihash )\r
+    <hashtable> identity-hashtable boa ; inline\r
+\r
+<PRIVATE\r
+: identity@ ( key ihash -- ikey hash )\r
+    [ <identity-wrapper> ] [ underlying>> ] bi* ; inline\r
+PRIVATE>\r
+\r
+M: identity-hashtable at*\r
+    identity@ at* ; inline\r
+\r
+M: identity-hashtable clear-assoc\r
+    underlying>> clear-assoc ; inline\r
+\r
+M: identity-hashtable delete-at\r
+    identity@ delete-at ; inline\r
+\r
+M: identity-hashtable assoc-size\r
+    underlying>> assoc-size ; inline\r
+\r
+M: identity-hashtable set-at\r
+    identity@ set-at ; inline\r
+\r
+: identity-associate ( value key -- hash )\r
+    2 <identity-hashtable> [ set-at ] keep ; inline\r
+\r
+M: identity-hashtable >alist\r
+    underlying>> >alist [ [ first underlying>> ] [ second ] bi 2array ] map ;\r
+    \r
+M: identity-hashtable clone\r
+    underlying>> clone identity-hashtable boa ; inline\r
+\r
+M: identity-hashtable equal?\r
+    over identity-hashtable? [ [ underlying>> ] bi@ = ] [ 2drop f ] if ;\r
+\r
+: >identity-hashtable ( assoc -- ihashtable )\r
+    dup assoc-size <identity-hashtable> [ '[ swap _ set-at ] assoc-each ] keep ;\r
+\r
+SYNTAX: IH{ \ } [ >identity-hashtable ] parse-literal ;\r
+\r
+{ "hashtables.identity" "prettyprint" } "hashtables.identity.prettyprint" require-when\r
+{ "hashtables.identity" "mirrors" } "hashtables.identity.mirrors" require-when\r

diff --git a/extra/hashtables/identity/mirrors/mirrors.factor b/extra/hashtables/identity/mirrors/mirrors.factor
new file mode 100644 (file)
index 0000000..1ba891c
--- /dev/null
+++ b/extra/hashtables/identity/mirrors/mirrors.factor
@@ -0,0 +1,4 @@
+USING: hashtables.identity mirrors ;\r
+IN: hashtables.identity.mirrors\r
+\r
+M: identity-hashtable make-mirror ;\r

diff --git a/extra/hashtables/identity/prettyprint/prettyprint.factor b/extra/hashtables/identity/prettyprint/prettyprint.factor
new file mode 100644 (file)
index 0000000..15a4849
--- /dev/null
+++ b/extra/hashtables/identity/prettyprint/prettyprint.factor
@@ -0,0 +1,12 @@
+! (c)2010 Joe Groff bsd license\r
+USING: assocs continuations hashtables.identity kernel\r
+namespaces prettyprint.backend prettyprint.config\r
+prettyprint.custom ;\r
+IN: hashtables.identity.prettyprint\r
+\r
+M: identity-hashtable >pprint-sequence >alist ;\r
+M: identity-hashtable pprint-delims drop \ IH{ \ } ;\r
+\r
+M: identity-hashtable pprint*\r
+    nesting-limit inc\r
+    [ pprint-object ] [ nesting-limit dec ] [ ] cleanup ;\r

diff --git a/extra/hashtables/identity/summary.txt b/extra/hashtables/identity/summary.txt
new file mode 100644 (file)
index 0000000..6c6ec09
--- /dev/null
+++ b/extra/hashtables/identity/summary.txt
@@ -0,0 +1 @@
+Hashtables keyed by object identity (eq?) rather than by logical value (=)\r

diff --git a/vm/contexts.cpp b/vm/contexts.cpp
index 8ec3363662652c3c194d4d3b9f4be7668f97d6e8..8359e09307057aac03a7f3ed02de9a98219568f4 100644 (file)
--- a/vm/contexts.cpp
+++ b/vm/contexts.cpp
@@ -62,14 +62,14 @@ void context::scrub_stacks(gc_info *info, cell index)
        {
                cell base = info->scrub_d_base(index);
 
-               for(cell loc = 0; loc < info->scrub_d_count; loc++)
+               for(int loc = 0; loc < info->scrub_d_count; loc++)
                {
                        if(bitmap_p(bitmap,base + loc))
                        {
 #ifdef DEBUG_GC_MAPS
                                std::cout << "scrubbing datastack location " << loc << std::endl;
 #endif
-                               ((cell *)datastack)[-loc] = 0;
+                               *((cell *)datastack - loc) = 0;
                        }
                }
        }
@@ -77,14 +77,14 @@ void context::scrub_stacks(gc_info *info, cell index)
        {
                cell base = info->scrub_r_base(index);
 
-               for(cell loc = 0; loc < info->scrub_r_count; loc++)
+               for(int loc = 0; loc < info->scrub_r_count; loc++)
                {
                        if(bitmap_p(bitmap,base + loc))
                        {
 #ifdef DEBUG_GC_MAPS
                                std::cout << "scrubbing retainstack location " << loc << std::endl;
 #endif
-                               ((cell *)retainstack)[-loc] = 0;
+                               *((cell *)retainstack - loc) = 0;
                        }
                }
        }

diff --git a/vm/gc_info.cpp b/vm/gc_info.cpp
index b937d0a6effdd6d1579fd3546a8017a8410ea730..9a3252aa2cdcfff4c4dcea357109ce204e85b92d 100644 (file)
--- a/vm/gc_info.cpp
+++ b/vm/gc_info.cpp
@@ -7,7 +7,7 @@ int gc_info::return_address_index(cell return_address)
 {
        u32 *return_address_array = return_addresses();
 
-       for(cell i = 0; i < return_address_count; i++)
+       for(int i = 0; i < return_address_count; i++)
        {
                if(return_address == return_address_array[i])
                        return i;

diff --git a/vm/gc_info.hpp b/vm/gc_info.hpp
index d5229a19a5584414dba78a89b5de02cba555229b..dbbe11b9d79c52caac342defd6b7d582c1a2e66a 100644 (file)
--- a/vm/gc_info.hpp
+++ b/vm/gc_info.hpp
@@ -2,10 +2,10 @@ namespace factor
 {
 
 struct gc_info {
-       u32 scrub_d_count;
-       u32 scrub_r_count;
-       u32 gc_root_count;
-       u32 return_address_count;
+       int scrub_d_count;
+       int scrub_r_count;
+       int gc_root_count;
+       int return_address_count;
 
        cell total_bitmap_size()
        {

diff --git a/vm/slot_visitor.hpp b/vm/slot_visitor.hpp
old mode 100644 (file)
new mode 100755 (executable)
index 4223f94..d4479ee
--- a/vm/slot_visitor.hpp
+++ b/vm/slot_visitor.hpp
@@ -303,14 +303,14 @@ struct call_frame_slot_visitor {
                cell base = info->spill_slot_base(index);
                cell *stack_pointer = (cell *)(parent->frame_successor(frame) + 1);
 
-               for(cell spill_slot = 0; spill_slot < info->gc_root_count; spill_slot++)
+               for(int spill_slot = 0; spill_slot < info->gc_root_count; spill_slot++)
                {
                        if(bitmap_p(bitmap,base + spill_slot))
                        {
 #ifdef DEBUG_GC_MAPS
                                std::cout << "visiting spill slot " << spill_slot << std::endl;
 #endif
-                               visitor->visit_handle(&stack_pointer[spill_slot]);
+                               visitor->visit_handle(stack_pointer + spill_slot);
                        }
                }
        }