diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor index 694ddaf8d6..4364f7fcfb 100644 --- a/library/bootstrap/primitives.factor +++ b/library/bootstrap/primitives.factor @@ -200,7 +200,6 @@ vocabularies get [ [ "" "kernel-internals" [ [ number ] [ tuple ] ] ] [ ">array" "kernel-internals" [ [ object ] [ array ] ] ] [ ">tuple" "kernel-internals" [ [ object ] [ tuple ] ] ] - [ "(instances)" "memory" [ [ integer ] [ general-list ] ] ] [ "begin-scan" "memory" [ [ ] [ ] ] ] [ "next-object" "memory" [ [ ] [ object ] ] ] [ "end-scan" "memory" [ [ ] [ object ] ] ] diff --git a/library/tools/heap-stats.factor b/library/tools/heap-stats.factor index 9cbeb5f5bb..26273599c9 100644 --- a/library/tools/heap-stats.factor +++ b/library/tools/heap-stats.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: memory -USING: kernel lists math namespaces prettyprint stdio words -vectors unparser generic ; +USING: errors generic kernel lists math namespaces prettyprint +stdio unparser vectors words ; : kb. 1024 /i unparse write " KB" write ; @@ -30,6 +30,26 @@ vectors unparser generic ; #! Print heap allocation breakdown. 0 heap-stats [ dupd uncons heap-stat. 1 + ] each drop ; +: (each-object) ( quot -- ) + next-object dup [ + swap dup slip (each-object) + ] [ + 2drop + ] ifte ; inline + +: each-object ( quot -- ) + #! Applies the quotation to each object in the image. + [ + begin-scan (each-object) + ] [ + end-scan rethrow + ] catch ; inline + : instances ( class -- list ) - #! Return a list of all instances of a built-in class. - "builtin-type" word-property (instances) ; + #! Return a list of all instances of a built-in or tuple + #! class. + [ + [ + dup class pick = [ , ] [ drop ] ifte + ] each-object drop + ] make-list ; diff --git a/native/primitives.c b/native/primitives.c index 2775f4a02e..f84b55328c 100644 --- a/native/primitives.c +++ b/native/primitives.c @@ -179,7 +179,6 @@ void* primitives[] = { primitive_tuple, primitive_to_array, primitive_to_tuple, - primitive_instances, primitive_begin_scan, primitive_next_object, primitive_end_scan diff --git a/native/scan.c b/native/scan.c index b7a2170d3a..517a694c76 100644 --- a/native/scan.c +++ b/native/scan.c @@ -81,35 +81,3 @@ void primitive_heap_stats(void) dpush(list); } - -void primitive_instances(void) -{ - CELL list = F; - CELL search_type = to_fixnum(dpop()); - CELL here; - - primitive_gc(); - - here = active.here; - - begin_heap_scan(); - - for(;;) - { - CELL size, type; - CELL obj = heap_step(&size,&type); - - if(walk_donep()) - break; - - /* don't want an infinite loop if we ask for a list of all - conses in the image! */ - if(heap_scan_ptr >= here) - break; - - if(search_type == type) - list = cons(obj,list); - } - - dpush(list); -}