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

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

db4
Anton Gorenko 2010-06-18 20:53:55 +06:00
parent 507583c8d3 c186b54449
commit dc98054775
14 changed files with 136 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Nmakefile
View File

@ -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

3
basis/math/quaternions/quaternions-tests.factor
View File

@ -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

4
basis/math/quaternions/quaternions.factor
View File

@ -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

9
basis/tools/disassembler/udis/udis-tests.factor
View File

@ -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

1
extra/hashtables/identity/authors.txt Normal file
View File

@ -0,0 +1 @@
Joe Groff

31
extra/hashtables/identity/identity-tests.factor Normal file
View File

@ -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

62
extra/hashtables/identity/identity.factor Normal file
View File

@ -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> 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 } ;
: <identity-hashtable> ( n -- ihash )
<hashtable> identity-hashtable boa ; inline
<PRIVATE
: identity@ ( key ihash -- ikey hash )
[ <identity-wrapper> ] [ 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 <identity-hashtable> [ 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 <identity-hashtable> [ '[ 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

4
extra/hashtables/identity/mirrors/mirrors.factor Normal file
View File

@ -0,0 +1,4 @@
USING: hashtables.identity mirrors ;
IN: hashtables.identity.mirrors
M: identity-hashtable make-mirror ;

12
extra/hashtables/identity/prettyprint/prettyprint.factor Normal file
View File

@ -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 ;

1
extra/hashtables/identity/summary.txt Normal file
View File

@ -0,0 +1 @@
Hashtables keyed by object identity (eq?) rather than by logical value (=)

8
vm/contexts.cpp
View File

@ -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;
}
}
}

2
vm/gc_info.cpp
View File

@ -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;

8
vm/gc_info.hpp
View File

@ -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()
{

4
vm/slot_visitor.hpp Normal file → Executable file
View File

@ -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);
}
}
}