diff --git a/Nmakefile b/Nmakefile index a8b7e103ec..5297e49171 100755 --- 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 b049b6dbc4..cf5c421f16 100644 --- 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 4173507e6c..d10cd7a8cb 100644 --- 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 522893f368..55e113e1bd 100644 --- 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 index 0000000000..6a1b3e726a --- /dev/null +++ b/extra/hashtables/identity/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/hashtables/identity/identity-tests.factor b/extra/hashtables/identity/identity-tests.factor new file mode 100644 index 0000000000..871d8e3d32 --- /dev/null +++ b/extra/hashtables/identity/identity-tests.factor @@ -0,0 +1,31 @@ +! (c)2010 Joe Groff bsd license +USING: assocs hashtables.identity kernel literals tools.test ; +IN: hashtables.identity.tests + +CONSTANT: the-real-slim-shady "marshall mathers" + +CONSTANT: will + IH{ + { $ the-real-slim-shady t } + { "marshall mathers" f } + } + +: please-stand-up ( assoc key -- value ) + swap at ; + +[ t ] [ will the-real-slim-shady please-stand-up ] unit-test +[ t ] [ will clone the-real-slim-shady please-stand-up ] unit-test + +[ 2 ] [ will assoc-size ] unit-test +[ { { "marshall mathers" f } } ] [ + the-real-slim-shady will clone + [ delete-at ] [ >alist ] bi +] unit-test +[ t ] [ + t the-real-slim-shady identity-associate + t the-real-slim-shady identity-associate = +] unit-test +[ f ] [ + t the-real-slim-shady identity-associate + t "marshall mathers" identity-associate = +] unit-test diff --git a/extra/hashtables/identity/identity.factor b/extra/hashtables/identity/identity.factor new file mode 100644 index 0000000000..5f1aeca636 --- /dev/null +++ b/extra/hashtables/identity/identity.factor @@ -0,0 +1,62 @@ +! (c)2010 Joe Groff bsd license +USING: accessors arrays assocs fry hashtables kernel parser +sequences vocabs.loader ; +IN: hashtables.identity + +TUPLE: identity-wrapper + { underlying read-only } ; +C: identity-wrapper + +M: identity-wrapper equal? + over identity-wrapper? + [ [ underlying>> ] bi@ eq? ] + [ 2drop f ] if ; inline + +M: identity-wrapper hashcode* + nip underlying>> identity-hashcode ; inline + +TUPLE: identity-hashtable + { underlying hashtable read-only } ; + +: ( n -- ihash ) + identity-hashtable boa ; inline + + ] [ underlying>> ] bi* ; inline +PRIVATE> + +M: identity-hashtable at* + identity@ at* ; inline + +M: identity-hashtable clear-assoc + underlying>> clear-assoc ; inline + +M: identity-hashtable delete-at + identity@ delete-at ; inline + +M: identity-hashtable assoc-size + underlying>> assoc-size ; inline + +M: identity-hashtable set-at + identity@ set-at ; inline + +: identity-associate ( value key -- hash ) + 2 [ set-at ] keep ; inline + +M: identity-hashtable >alist + underlying>> >alist [ [ first underlying>> ] [ second ] bi 2array ] map ; + +M: identity-hashtable clone + underlying>> clone identity-hashtable boa ; inline + +M: identity-hashtable equal? + over identity-hashtable? [ [ underlying>> ] bi@ = ] [ 2drop f ] if ; + +: >identity-hashtable ( assoc -- ihashtable ) + dup assoc-size [ '[ swap _ set-at ] assoc-each ] keep ; + +SYNTAX: IH{ \ } [ >identity-hashtable ] parse-literal ; + +{ "hashtables.identity" "prettyprint" } "hashtables.identity.prettyprint" require-when +{ "hashtables.identity" "mirrors" } "hashtables.identity.mirrors" require-when diff --git a/extra/hashtables/identity/mirrors/mirrors.factor b/extra/hashtables/identity/mirrors/mirrors.factor new file mode 100644 index 0000000000..1ba891cd85 --- /dev/null +++ b/extra/hashtables/identity/mirrors/mirrors.factor @@ -0,0 +1,4 @@ +USING: hashtables.identity mirrors ; +IN: hashtables.identity.mirrors + +M: identity-hashtable make-mirror ; diff --git a/extra/hashtables/identity/prettyprint/prettyprint.factor b/extra/hashtables/identity/prettyprint/prettyprint.factor new file mode 100644 index 0000000000..15a4849257 --- /dev/null +++ b/extra/hashtables/identity/prettyprint/prettyprint.factor @@ -0,0 +1,12 @@ +! (c)2010 Joe Groff bsd license +USING: assocs continuations hashtables.identity kernel +namespaces prettyprint.backend prettyprint.config +prettyprint.custom ; +IN: hashtables.identity.prettyprint + +M: identity-hashtable >pprint-sequence >alist ; +M: identity-hashtable pprint-delims drop \ IH{ \ } ; + +M: identity-hashtable pprint* + nesting-limit inc + [ pprint-object ] [ nesting-limit dec ] [ ] cleanup ; diff --git a/extra/hashtables/identity/summary.txt b/extra/hashtables/identity/summary.txt new file mode 100644 index 0000000000..6c6ec09e85 --- /dev/null +++ b/extra/hashtables/identity/summary.txt @@ -0,0 +1 @@ +Hashtables keyed by object identity (eq?) rather than by logical value (=) diff --git a/vm/contexts.cpp b/vm/contexts.cpp index 8ec3363662..8359e09307 100644 --- 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 b937d0a6ef..9a3252aa2c 100644 --- 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 d5229a19a5..dbbe11b9d7 100644 --- 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 new mode 100755 index 4223f94a57..d4479ee102 --- 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); } } }