diff --git a/Makefile b/Makefile index 45e4277e61..f0f5ea296b 100644 --- a/Makefile +++ b/Makefile @@ -22,7 +22,8 @@ OBJS = $(UNIX_OBJS) native/arithmetic.o native/array.o native/bignum.o \ native/word.o native/compiler.o \ native/ffi.o native/boolean.o \ native/debug.o \ - native/hashtable.o + native/hashtable.o \ + native/walk.o default: @echo "Run 'make' with one of the following parameters:" diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 0d0f43c90b..74401e2fad 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,5 +1,6 @@ 72/73: +- [ [ dup call ] dup call ] infer hangs - move tuple to generic vocab - update plugin docs - extract word keeps indent @@ -20,6 +21,9 @@ - ppc register decls - rename f* words to stream-* +- port leak +- references primitive +- ditch % for tuples? - resize window: world not updated until mouse moved - x>offset - fix completion invoke in middle of word diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index 4e839a3f1d..5dc2a8e8b8 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/library/bootstrap/boot-stage2.factor @@ -65,6 +65,7 @@ USING: kernel lists parser stdio words namespaces ; "/library/io/stdio-binary.factor" "/library/io/files.factor" "/library/eval-catch.factor" + "/library/tools/heap-stats.factor" "/library/tools/listener.factor" "/library/tools/word-tools.factor" "/library/test/test.factor" @@ -72,7 +73,6 @@ USING: kernel lists parser stdio words namespaces ; "/library/tools/telnetd.factor" "/library/tools/jedit-wire.factor" "/library/tools/profiler.factor" - "/library/tools/heap-stats.factor" "/library/gensym.factor" "/library/tools/interpreter.factor" diff --git a/library/bootstrap/init-stage2.factor b/library/bootstrap/init-stage2.factor index 32a38e6ac1..c367df1f9f 100644 --- a/library/bootstrap/init-stage2.factor +++ b/library/bootstrap/init-stage2.factor @@ -1,50 +1,9 @@ -! :folding=indent:collapseFolds=1: - -! $Id$ -! -! Copyright (C) 2004 Slava Pestov. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - +! Copyright (C) 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: kernel -USE: alien -USE: compiler -USE: errors -USE: inference -USE: command-line -USE: listener -USE: lists -USE: math -USE: namespaces -USE: parser -USE: random -USE: streams -USE: stdio -USE: presentation -USE: words -USE: unparser -USE: kernel-internals -USE: console -USE: assembler +USING: alien compiler errors inference command-line listener +lists math namespaces parser random streams stdio presentation +words unparser kernel-internals console assembler memory ; : default-cli-args #! Some flags are *on* by default, unless user specifies diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor index 0ea76fd777..9030f3d327 100644 --- a/library/bootstrap/primitives.factor +++ b/library/bootstrap/primitives.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: image -USING: kernel lists math namespaces parser words vectors +USING: kernel lists math memory namespaces parser words vectors hashtables generic ; ! Bring up a bare cross-compiling vocabulary. @@ -125,9 +125,9 @@ vocabularies get [ [[ "io-internals" "open-file" ]] [[ "files" "stat" ]] [[ "files" "(directory)" ]] - [[ "kernel" "garbage-collection" ]] - [[ "kernel" "gc-time" ]] - [[ "kernel" "save-image" ]] + [[ "memory" "garbage-collection" ]] + [[ "memory" "gc-time" ]] + [[ "memory" "save-image" ]] [[ "kernel" "datastack" ]] [[ "kernel" "callstack" ]] [[ "kernel" "set-datastack" ]] @@ -150,7 +150,7 @@ vocabularies get [ [[ "io-internals" "add-copy-io-task" ]] [[ "io-internals" "pending-io-error" ]] [[ "io-internals" "next-io-task" ]] - [[ "kernel" "room" ]] + [[ "memory" "room" ]] [[ "kernel" "os-env" ]] [[ "kernel" "millis" ]] [[ "random" "init-random" ]] @@ -162,7 +162,7 @@ vocabularies get [ [[ "assembler" "set-compiled-offset" ]] [[ "assembler" "literal-top" ]] [[ "assembler" "set-literal-top" ]] - [[ "kernel" "address" ]] + [[ "memory" "address" ]] [[ "alien" "dlopen" ]] [[ "alien" "dlsym" ]] [[ "alien" "dlclose" ]] @@ -176,7 +176,7 @@ vocabularies get [ [[ "alien" "set-alien-2" ]] [[ "alien" "alien-1" ]] [[ "alien" "set-alien-1" ]] - [[ "kernel" "heap-stats" ]] + [[ "memory" "heap-stats" ]] [[ "errors" "throw" ]] [[ "kernel-internals" "string>memory" ]] [[ "kernel-internals" "memory>string" ]] @@ -197,6 +197,7 @@ vocabularies get [ [[ "kernel-internals" "" ]] [[ "kernel-internals" ">array" ]] [[ "kernel-internals" ">tuple" ]] + [[ "memory" "(instances)" ]] ] [ unswons create swap 1 + [ f define ] keep ] each drop diff --git a/library/compiler/assembler.factor b/library/compiler/assembler.factor index 54d0229fa1..f6e33f55a9 100644 --- a/library/compiler/assembler.factor +++ b/library/compiler/assembler.factor @@ -26,11 +26,7 @@ ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. IN: assembler -USE: alien -USE: math -USE: kernel -USE: hashtables -USE: namespaces +USING: alien math memory kernel hashtables namespaces ; SYMBOL: interned-literals diff --git a/library/compiler/x86/generator.factor b/library/compiler/x86/generator.factor index 35a2f15012..1a6bdbce3b 100644 --- a/library/compiler/x86/generator.factor +++ b/library/compiler/x86/generator.factor @@ -1,40 +1,8 @@ -! :folding=indent:collapseFolds=1: - -! $Id$ -! -! Copyright (C) 2004, 2005 Slava Pestov. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - +! Copyright (C) 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: compiler -USE: alien -USE: assembler -USE: inference -USE: kernel -USE: kernel-internals -USE: lists -USE: math -USE: namespaces -USE: words +USING: alien assembler inference kernel kernel-internals lists +math memory namespaces words ; \ slot [ PEEK-DS diff --git a/library/compiler/x86/stack.factor b/library/compiler/x86/stack.factor index 535f701c85..8c49b996d8 100644 --- a/library/compiler/x86/stack.factor +++ b/library/compiler/x86/stack.factor @@ -1,37 +1,7 @@ -! :folding=none:collapseFolds=1: - -! $Id$ -! ! Copyright (C) 2005 Slava Pestov. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - +! See http://factor.sf.net/license.txt for BSD license. IN: compiler -USE: inference -USE: kernel -USE: assembler -USE: words -USE: lists -USE: alien +USING: inference kernel assembler words lists alien memory ; : rel-ds ( -- ) #! Add an entry to the relocation table for the 32-bit diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor index edd0df70b3..1cb0cb2259 100644 --- a/library/generic/tuple.factor +++ b/library/generic/tuple.factor @@ -58,8 +58,7 @@ kernel-internals math hashtables errors vectors ; : tuple-predicate ( word -- ) #! Make a foo? word for testing the tuple class at the top #! of the stack. - dup predicate-word swap - [ swap dup tuple? [ class eq? ] [ 2drop f ] ifte ] cons + dup predicate-word swap [ swap class eq? ] cons define-compound ; : check-shape ( word slots -- ) diff --git a/library/httpd/browser-responder.factor b/library/httpd/browser-responder.factor index 4a3556fc57..4c840df6a2 100644 --- a/library/httpd/browser-responder.factor +++ b/library/httpd/browser-responder.factor @@ -25,27 +25,9 @@ ! cont-responder facilities. ! IN: browser-responder -USE: html -USE: cont-responder -USE: kernel -USE: stdio -USE: namespaces -USE: words -USE: lists -USE: streams -USE: strings -USE: inspector -USE: kernel -USE: prettyprint -USE: words -USE: html -USE: parser -USE: errors -USE: unparser -USE: logging -USE: listener -USE: url-encoding -USE: hashtables +USING: html cont-responder kernel stdio namespaces words lists +streams strings inspector kernel prettyprint words html parser +errors unparser logging listener url-encoding hashtables memory ; : ( allow-edit? vocab word -- ) #! An object for storing the current browser diff --git a/library/primitives.factor b/library/primitives.factor index 7dc72c8f1b..f6980015bc 100644 --- a/library/primitives.factor +++ b/library/primitives.factor @@ -7,7 +7,7 @@ DEFER: dll USING: alien assembler compiler errors files generic io-internals kernel kernel-internals lists math math-internals parser profiler random strings unparser vectors words -hashtables ; +hashtables memory ; [ [ execute " word -- " f ] @@ -187,6 +187,7 @@ hashtables ; [ [ [ number ] [ tuple ] ] ] [ >array [ [ object ] [ array ] ] ] [ >tuple [ [ object ] [ tuple ] ] ] + [ (instances) [ [ integer ] [ general-list ] ] ] ] [ 2unlist dup string? [ "stack-effect" set-word-property diff --git a/library/syntax/unparser.factor b/library/syntax/unparser.factor index f56641ec2c..f58545638f 100644 --- a/library/syntax/unparser.factor +++ b/library/syntax/unparser.factor @@ -1,40 +1,8 @@ -! :folding=indent:collapseFolds=1: - -! $Id$ -! -! Copyright (C) 2004 Slava Pestov. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: unparser -USE: generic -USE: kernel -USE: lists -USE: math -USE: namespaces -USE: parser -USE: stdio -USE: strings -USE: words +USING: generic kernel lists math namespaces parser stdio strings +words memory ; GENERIC: unparse ( obj -- str ) diff --git a/library/test/test.factor b/library/test/test.factor index d7fdd643a0..d3fb0f9d9d 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -1,18 +1,8 @@ ! Factor test suite. IN: test -USE: errors -USE: kernel -USE: lists -USE: math -USE: namespaces -USE: parser -USE: prettyprint -USE: stdio -USE: strings -USE: words -USE: vectors -USE: unparser +USING: errors kernel lists math memory namespaces parser +prettyprint stdio strings words vectors unparser ; : assert ( t -- ) [ "Assertion failed!" throw ] unless ; diff --git a/library/tools/heap-stats.factor b/library/tools/heap-stats.factor index a8ab447470..9cbeb5f5bb 100644 --- a/library/tools/heap-stats.factor +++ b/library/tools/heap-stats.factor @@ -1,41 +1,21 @@ -! :folding=indent:collapseFolds=1: +! 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 ; -! $Id$ -! -! Copyright (C) 2004 Slava Pestov. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +: kb. 1024 /i unparse write " KB" write ; -IN: listener -USE: kernel -USE: lists -USE: math -USE: namespaces -USE: prettyprint -USE: stdio -USE: words -USE: vectors -USE: unparser -USE: generic +: (room.) ( free total -- ) + 2dup swap - swap ( free used total ) + kb. " total " write + kb. " used " write + kb. " free" print ; + +: room. ( -- ) + room + "Data space: " write (room.) + "Code space: " write (room.) ; : heap-stat. ( type instances bytes -- ) dup 0 = [ @@ -49,3 +29,7 @@ USE: generic : heap-stats. ( -- ) #! Print heap allocation breakdown. 0 heap-stats [ dupd uncons heap-stat. 1 + ] each drop ; + +: instances ( class -- list ) + #! Return a list of all instances of a built-in class. + "builtin-type" word-property (instances) ; diff --git a/library/tools/listener.factor b/library/tools/listener.factor index 683f6ffe81..f44508395c 100644 --- a/library/tools/listener.factor +++ b/library/tools/listener.factor @@ -1,44 +1,8 @@ -! :folding=indent:collapseFolds=1: - -! $Id$ -! -! Copyright (C) 2003, 2004 Slava Pestov. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - +! Copyright (C) 2003, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: listener -USE: errors -USE: kernel -USE: lists -USE: math -USE: namespaces -USE: parser -USE: stdio -USE: strings -USE: presentation -USE: words -USE: unparser -USE: vectors -USE: ansi +USING: errors kernel lists math memory namespaces parser stdio +strings presentation words unparser vectors ansi ; SYMBOL: cont-prompt SYMBOL: listener-prompt @@ -87,19 +51,6 @@ global [ #! Run a listener loop that executes user input. quit-flag get [ quit-flag off ] [ listen listener ] ifte ; -: kb. 1024 /i unparse write " KB" write ; - -: (room.) ( free total -- ) - 2dup swap - swap ( free used total ) - kb. " total " write - kb. " used " write - kb. " free" print ; - -: room. ( -- ) - room - "Data space: " write (room.) - "Code space: " write (room.) ; - : print-banner ( -- ) "Factor " write version write " (OS: " write os write diff --git a/library/tools/word-tools.factor b/library/tools/word-tools.factor index 1bf8fb7c22..dbc6866674 100644 --- a/library/tools/word-tools.factor +++ b/library/tools/word-tools.factor @@ -84,4 +84,4 @@ M: generic word-uses? ( of in -- ? ) : reload ( word -- ) #! Reload the source file the word originated from. - word-file run-resource ; + word-file run-file ; diff --git a/library/vocabularies.factor b/library/vocabularies.factor index 595d20d79b..78461e3082 100644 --- a/library/vocabularies.factor +++ b/library/vocabularies.factor @@ -78,7 +78,7 @@ IN: words USING: hashtables kernel lists namespaces strings ; [ "compiler" "debugger" "errors" "files" "generic" "hashtables" "inference" "interpreter" "jedit" "kernel" - "listener" "lists" "math" "namespaces" "parser" + "listener" "lists" "math" "memory" "namespaces" "parser" "prettyprint" "processes" "profiler" "streams" "stdio" "strings" "syntax" "test" "threads" "unparser" "vectors" "words" "scratchpad" diff --git a/native/debug.c b/native/debug.c index 5d4f793d2a..1ab9daf1ea 100644 --- a/native/debug.c +++ b/native/debug.c @@ -119,7 +119,7 @@ void print_obj(CELL obj) switch(type_of(obj)) { case FIXNUM_TYPE: - fprintf(stderr,"%d",untag_fixnum_fast(obj)); + fprintf(stderr,"%ld",untag_fixnum_fast(obj)); break; case CONS_TYPE: print_cons(obj); diff --git a/native/factor.h b/native/factor.h index 08c7259fab..dc1e0143e0 100644 --- a/native/factor.h +++ b/native/factor.h @@ -123,5 +123,6 @@ typedef unsigned char BYTE; #include "relocate.h" #include "ffi.h" #include "debug.h" +#include "walk.h" #endif /* __FACTOR_H__ */ diff --git a/native/memory.c b/native/memory.c index 62e10b63dc..83ce4ab1dc 100644 --- a/native/memory.c +++ b/native/memory.c @@ -119,49 +119,3 @@ void primitive_address(void) { dpush(tag_bignum(s48_ulong_to_bignum(dpop()))); } - -void primitive_heap_stats(void) -{ - int instances[TYPE_COUNT], bytes[TYPE_COUNT]; - int i; - CELL ptr; - CELL list = F; - - for(i = 0; i < TYPE_COUNT; i++) - instances[i] = 0; - - for(i = 0; i < TYPE_COUNT; i++) - bytes[i] = 0; - - ptr = active.base; - while(ptr < active.here) - { - CELL value = get(ptr); - CELL size; - CELL type; - - if(headerp(value)) - { - size = align8(untagged_object_size(ptr)); - type = untag_header(value); - } - else - { - size = CELLS * 2; - type = CONS_TYPE; - } - - instances[type]++; - bytes[type] += size; - ptr += size; - } - - for(i = TYPE_COUNT - 1; i >= 0; i--) - { - list = cons( - cons(tag_fixnum(instances[i]),tag_fixnum(bytes[i])), - list); - } - - dpush(list); -} diff --git a/native/memory.h b/native/memory.h index 301bb10a0e..8b1c357197 100644 --- a/native/memory.h +++ b/native/memory.h @@ -72,4 +72,3 @@ void primitive_memory_1(void); void primitive_set_memory_cell(void); void primitive_set_memory_4(void); void primitive_set_memory_1(void); -void primitive_heap_stats(void); diff --git a/native/primitives.c b/native/primitives.c index 7a36c0f14c..05bfb8cf14 100644 --- a/native/primitives.c +++ b/native/primitives.c @@ -178,7 +178,8 @@ void* primitives[] = { primitive_array, primitive_tuple, primitive_to_array, - primitive_to_tuple + primitive_to_tuple, + primitive_instances }; CELL primitive_to_xt(CELL primitive) diff --git a/native/string.h b/native/string.h index 6f06c7f50e..d61b58157d 100644 --- a/native/string.h +++ b/native/string.h @@ -1,5 +1,3 @@ - - typedef struct { CELL header; /* untagged num of chars */ diff --git a/native/walk.c b/native/walk.c new file mode 100644 index 0000000000..51257d93c6 --- /dev/null +++ b/native/walk.c @@ -0,0 +1,65 @@ +#include "factor.h" + +void primitive_heap_stats(void) +{ + int instances[TYPE_COUNT], bytes[TYPE_COUNT]; + int i; + CELL list = F; + + for(i = 0; i < TYPE_COUNT; i++) + instances[i] = 0; + + for(i = 0; i < TYPE_COUNT; i++) + bytes[i] = 0; + + begin_heap_walk(); + + for(;;) + { + CELL size, type; + heap_step(&size,&type); + + if(walk_donep()) + break; + + instances[type]++; + bytes[type] += size; + } + + for(i = TYPE_COUNT - 1; i >= 0; i--) + { + list = cons( + cons(tag_fixnum(instances[i]),tag_fixnum(bytes[i])), + list); + } + + dpush(list); +} + +void primitive_instances(void) +{ + CELL list = F; + CELL search_type = to_fixnum(dpop()); + CELL here = active.here; + + begin_heap_walk(); + + 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_walk_ptr >= here) + break; + + if(search_type == type) + list = cons(obj,list); + } + + dpush(list); +} diff --git a/native/walk.h b/native/walk.h new file mode 100644 index 0000000000..5a76a5f70c --- /dev/null +++ b/native/walk.h @@ -0,0 +1,43 @@ +/* A heap walk allows useful things to be done, like finding all +references to an object for debugging purposes. */ +CELL heap_walk_ptr; + +/* Begin iterating through the heap. This is not re-entrant. */ +INLINE void begin_heap_walk(void) +{ + heap_walk_ptr = active.base; +} + +INLINE bool heap_step(CELL* size, CELL* type) +{ + CELL value = get(heap_walk_ptr); + CELL obj = heap_walk_ptr; + + if(headerp(value)) + { + *size = align8(untagged_object_size(heap_walk_ptr)); + *type = untag_header(value); + } + else + { + *size = CELLS * 2; + *type = CONS_TYPE; + } + + heap_walk_ptr += *size; + + if(*type < HEADER_TYPE) + obj = RETAG(obj,*type); + else + obj = RETAG(obj,OBJECT_TYPE); + + return obj; +} + +INLINE bool walk_donep(void) +{ + return (heap_walk_ptr >= active.here); +} + +void primitive_heap_stats(void); +void primitive_instances(void);