]> gitweb.factorcode.org Git - factor.git/commitdiff
instances word, memory vocabulary
authorSlava Pestov <slava@factorcode.org>
Tue, 15 Feb 2005 02:58:07 +0000 (02:58 +0000)
committerSlava Pestov <slava@factorcode.org>
Tue, 15 Feb 2005 02:58:07 +0000 (02:58 +0000)
25 files changed:
Makefile
TODO.FACTOR.txt
library/bootstrap/boot-stage2.factor
library/bootstrap/init-stage2.factor
library/bootstrap/primitives.factor
library/compiler/assembler.factor
library/compiler/x86/generator.factor
library/compiler/x86/stack.factor
library/generic/tuple.factor
library/httpd/browser-responder.factor
library/primitives.factor
library/syntax/unparser.factor
library/test/test.factor
library/tools/heap-stats.factor
library/tools/listener.factor
library/tools/word-tools.factor
library/vocabularies.factor
native/debug.c
native/factor.h
native/memory.c
native/memory.h
native/primitives.c
native/string.h
native/walk.c [new file with mode: 0644]
native/walk.h [new file with mode: 0644]

index 45e4277e61586126fb20fe606fc24bfa4018f822..f0f5ea296b69eb69d7aa52af69651d3541c86fb9 100644 (file)
--- 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:"
index 0d0f43c90b887e2be6b6e9ca09de9eaadc00cad7..74401e2fade43aebde2e8f160acb836dec7e67c4 100644 (file)
@@ -1,5 +1,6 @@
 72/73:\r
 \r
+- [ [ dup call ] dup call ] infer hangs\r
 - move tuple to generic vocab\r
 - update plugin docs\r
 - extract word keeps indent\r
@@ -20,6 +21,9 @@
 - ppc register decls\r
 - rename f* words to stream-*\r
 \r
+- port leak\r
+- references primitive\r
+- ditch % for tuples?\r
 - resize window: world not updated until mouse moved\r
 - x>offset\r
 - fix completion invoke in middle of word\r
index 4e839a3f1d098fe627c7cf31611a93216f044a86..5dc2a8e8b8b490c30f028caed0c06cc82a3dc012 100644 (file)
@@ -65,6 +65,7 @@ USING: kernel lists parser stdio words namespaces ;
     "/library/io/stdio-binary.factor"\r
     "/library/io/files.factor"\r
     "/library/eval-catch.factor"\r
+    "/library/tools/heap-stats.factor"\r
     "/library/tools/listener.factor"\r
     "/library/tools/word-tools.factor"\r
     "/library/test/test.factor"\r
@@ -72,7 +73,6 @@ USING: kernel lists parser stdio words namespaces ;
     "/library/tools/telnetd.factor"\r
     "/library/tools/jedit-wire.factor"\r
     "/library/tools/profiler.factor"\r
-    "/library/tools/heap-stats.factor"\r
     "/library/gensym.factor"\r
     "/library/tools/interpreter.factor"\r
 \r
index 32a38e6ac1449caa09342c71108b1968f0f9387e..c367df1f9f93b724309e9e325430d65bb6e1fefe 100644 (file)
@@ -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
index 0ea76fd777ea1711c2da1a69d11f31be540d7df6..9030f3d3274275f3826bddd4c6ca342befec3471 100644 (file)
@@ -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" "<tuple>" ]]
     [[ "kernel-internals" ">array" ]]
     [[ "kernel-internals" ">tuple" ]]
+    [[ "memory" "(instances)" ]]
 ] [
     unswons create swap 1 + [ f define ] keep
 ] each drop
index 54d0229fa1ece0bf58a539d591d56c2b8a282a10..f6e33f55a9f7255a73d8b9c773db84f99992a817 100644 (file)
 ! 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
 
index 35a2f15012317fffa89751c572092a50bc45ea37..1a6bdbce3bf110a05cd8810810cd689f023af7a9 100644 (file)
@@ -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
index 535f701c857a375458e1a53cf104ffeb554162e1..8c49b996d8e45aa5667d58b3933fac90e60165eb 100644 (file)
@@ -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
index edd0df70b37b4fb4f3f04af48f5e7d72c7e5e1c7..1cb0cb225947f37c3a094b4e173ab587bc35b4be 100644 (file)
@@ -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 -- )
index 4a3556fc57096c9f89f256c65f2450ae9f8f4497..4c840df6a22239ad0b7d28a04eb467e9f1f97e22 100644 (file)
 ! 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 ;
 
 : <browser> ( allow-edit? vocab word -- )
   #! An object for storing the current browser
index 7dc72c8f1b6b9408fb601be40efb783f4412c67b..f6980015bc885a5a10fd1351023517e31c2d2340 100644 (file)
@@ -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 ;
     [ <tuple>                [ [ number ] [ tuple ] ] ]
     [ >array                 [ [ object ] [ array ] ] ]
     [ >tuple                 [ [ object ] [ tuple ] ] ]
+    [ (instances)            [ [ integer ] [ general-list ] ] ]
 ] [
     2unlist dup string? [
         "stack-effect" set-word-property
index f56641ec2c7c8ce6bcd5c480c33fda2ccee1dd02..f58545638f4c8f409e6832e4f49cf4eac541fb4b 100644 (file)
@@ -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 )
 
index d7fdd643a027ee2b1ab2f350fbd03baa4ba332fc..d3fb0f9d9d6cdfe4a5823bc4f83d793444f3ee4d 100644 (file)
@@ -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 ;
index a8ab447470425a5bb66ca204ff35b46577e4dd9b..9cbeb5f5bbc2e9af661e26f0a21b50a5d0640d9a 100644 (file)
@@ -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) ;
index 683f6ffe81f0ca38f5b88b245a7b68d6e181b84f..f44508395c80d79ed7e121562e755a7865f69119 100644 (file)
@@ -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
index 1bf8fb7c227011be0edfeeed81c7a50da1a05def..dbc6866674a1e23d5a72752d897c2c9cd5fc3eab 100644 (file)
@@ -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 ;
index 595d20d79b34500aecb4ffae5edd1eae85640eaf..78461e3082ef45a6881db9ff0d681e08bbe6511b 100644 (file)
@@ -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"
index 5d4f793d2a1d711c64ef6b09a621aeb1d3a14ba0..1ab9daf1ea06f69fadecfedb74f4d33946731b21 100644 (file)
@@ -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);
index 08c7259fab7def3fa46ab91d4755e83e2192f3e6..dc1e0143e090788362cededc8d58c808281fbb2b 100644 (file)
@@ -123,5 +123,6 @@ typedef unsigned char BYTE;
 #include "relocate.h"
 #include "ffi.h"
 #include "debug.h"
+#include "walk.h"
 
 #endif /* __FACTOR_H__ */
index 62e10b63dc58ffb27478b345a2c3e6b1a1b3082f..83ce4ab1dc3a1446fde3ae536e2fbe56e7c00afe 100644 (file)
@@ -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);
-}
index 301bb10a0e21d9a04f9fc956da4f9b4073841edf..8b1c357197a722eaec6c823127a2e078b3c2b8f0 100644 (file)
@@ -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);
index 7a36c0f14c5f6450e392224ceecf917422996b46..05bfb8cf1417ffee1038459889c18a86025c68f5 100644 (file)
@@ -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)
index 6f06c7f50e00c6fe6fd328afd4b6867240795b4b..d61b58157d31fb29a403d9d36b4c56b5ff5054d6 100644 (file)
@@ -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 (file)
index 0000000..51257d9
--- /dev/null
@@ -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 (file)
index 0000000..5a76a5f
--- /dev/null
@@ -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);