some progress towards self hosting

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index da7819cfb43aff6d7684e0c63ddd83c28ef5b06b..1d50330c554473c0a857cb0221c5042a4d7f2d3f 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,5 +1,8 @@
 + native:\r
 \r
+ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable" ]\r
+\r
+- decide if overflow is a fatal error\r
 - f >n: crashes\r
 - typecases: type error reporting bad\r
 - image output\r
@@ -13,7 +16,6 @@
 - inspector: sort\r
 - index of str\r
 - accept: return socket, instead of printing msg\r
-- crash: [ primitives, ] with-image .\r
 - enforce bottom-up in native bootstrap\r
 \r
 + interactive:\r

diff --git a/build.sh b/build.sh
index cb1bece2dc9c293007f3e62bf70cda06fa87d759..335db6cef2df39bd17e5486a2fcd8e4928e9dac6 100644 (file)
--- a/build.sh
+++ b/build.sh
@@ -6,3 +6,8 @@ export CFLAGS="-pedantic -Wall -Winline -Os -march=pentium4 -fomit-frame-pointer
 $CC $CFLAGS -o f native/*.c
 
 strip f
+
+#export CC=gcc
+#export CFLAGS="-pedantic -Wall -g"
+#
+#$CC $CFLAGS -o f-debug native/*.c

diff --git a/library/image.factor b/library/image.factor
index 0693086cede709c55d5c694b2db855ed4bcceff4..f174ee51b664d4973ddd9796298d445c0a4bfb43 100644 (file)
--- a/library/image.factor
+++ b/library/image.factor
@@ -69,7 +69,6 @@ USE: words
 : object-tag BIN: 011 ;
 : header-tag BIN: 100 ;
 
-: fixnum-mask HEX: 1fffffff ;
 : immediate ( x tag -- tagged ) swap tag-bits shift< bitor ;
 : >header ( id -- tagged ) header-tag immediate ;
 
@@ -137,7 +136,7 @@ USE: words
     dup pooled-object dup [
         nip swap fixup
     ] [
-        drop "Not in image: " swap cat2 throw
+        drop "Not in image: " swap word-name cat2 throw
     ] ifte ;
 
 : fixup-words ( -- )
@@ -184,7 +183,7 @@ DEFER: '
     object-tag here-as swap
     11 >header emit
     dup str-length emit
-    dup hashcode ( fixnum-mask bitand ) emit
+    dup hashcode emit
     pack-string
     pad ;
 

diff --git a/library/lists.factor b/library/lists.factor
index 1f5bd9cfa4639b4c999be63f21cc491364d67d6c..415c079c6a440a28c88deb823034a110ba1af028 100644 (file)
--- a/library/lists.factor
+++ b/library/lists.factor
@@ -31,6 +31,7 @@ USE: combinators
 USE: kernel
 USE: logic
 USE: stack
+USE: vectors
 
 : 2list ( a b -- [ a b ] )
     #! Construct a proper list of 2 elements.
@@ -338,3 +339,12 @@ DEFER: tree-contains?
         cons-hashcode r>
         xor
     ] ifte ;
+
+: list>vector ( list -- vector )
+    dup length <vector> swap [ over vector-push ] each ;
+
+: stack>list ( vector -- list )
+    [ ] swap [ swons ] vector-each ;
+
+: vector>list ( vector -- list )
+    stack>list nreverse ;

diff --git a/library/platform/jvm/vectors.factor b/library/platform/jvm/vectors.factor
index b154c85bd61c5dc916851dbef2b66c7bcef040ad..ecf149320eb4553dc9bfb1c712118d9e74311cbb 100644 (file)
--- a/library/platform/jvm/vectors.factor
+++ b/library/platform/jvm/vectors.factor
@@ -41,17 +41,6 @@ USE: stack
 : set-vector-length ( vector -- length )
     "factor.FactorArray" "top" jvar-set ;
 
-: vector>list ( vector -- list )
-    #! Turns a vector into a list.
-    [ ] "factor.FactorArray" "toList" jinvoke ;
-
-: stack>list ( vector -- list )
-    #! Turns a vector into a list.
-    vector>list ;
-
-: list>vector ( list -- vector )
-    [ "factor.Cons" ] "factor.FactorArray" jnew ;
-
 : vector-nth ( index vector -- )
     [ "int" ] "factor.FactorArray" "get" jinvoke ;
 

diff --git a/library/platform/native/boot.factor b/library/platform/native/boot.factor
index 79b5e8877fb3db0468c8413f73a4e8b17b368f59..ce6de3d4825f01fbdcaf6ce2cf2fb9658d01b2a2 100644 (file)
--- a/library/platform/native/boot.factor
+++ b/library/platform/native/boot.factor
@@ -92,7 +92,6 @@ primitives,
     "/library/platform/native/prettyprint.factor"
     "/library/platform/native/stack.factor"
     "/library/platform/native/words.factor"
-    "/library/platform/native/vectors.factor"
     "/library/platform/native/vocabularies.factor"
     "/library/platform/native/unparser.factor"
     "/library/platform/native/cross-compiler.factor"

diff --git a/library/platform/native/errors.factor b/library/platform/native/errors.factor
index 344cfdf96310b10f46901c9a72c8472373047945..19c08005e44ecf621fea2fd04b9cfb4e92fe1427 100644 (file)
--- a/library/platform/native/errors.factor
+++ b/library/platform/native/errors.factor
@@ -63,6 +63,7 @@ USE: vectors
         "Bad primitive: "
         "Incompatible handle: "
         "I/O error: "
+        "Overflow"
     ] ?nth ;
 
 : ?kernel-error ( cons -- error# param )

diff --git a/library/platform/native/parse-numbers.factor b/library/platform/native/parse-numbers.factor
index 906559c58876591f1ecbd5e895c85646ca8fdb2d..6348d4cbe804045d5cb16e931261de052e36cfd0 100644 (file)
--- a/library/platform/native/parse-numbers.factor
+++ b/library/platform/native/parse-numbers.factor
@@ -79,3 +79,6 @@ USE: unparser
             drop (str>fixnum)
         ] ifte
     ] ifte ;
+
+: parse-number ( str -- num/f )
+    [ str>fixnum ] [ [ drop f ] when ] catch ;

diff --git a/library/platform/native/parse-syntax.factor b/library/platform/native/parse-syntax.factor
index b30ea49cb756ebb83bcf4655f39481ffc3e4240c..1cd207f350fb93f90bb3ea36bdba2b65b1d4453b 100644 (file)
--- a/library/platform/native/parse-syntax.factor
+++ b/library/platform/native/parse-syntax.factor
@@ -36,6 +36,7 @@ USE: namespaces
 USE: stack
 USE: strings
 USE: words
+USE: vectors
 USE: vocabularies
 USE: unparser
 
@@ -49,7 +50,7 @@ IN: builtins
 : f f parsed ; parsing
 
 ! Lists
-: [ f ; parsing
+: [ [ ] ; parsing
 : ] nreverse parsed ; parsing
 
 : | ( syntax: | cdr ] )
@@ -57,17 +58,23 @@ IN: builtins
     #! 'parsed' acts accordingly.
     "|" ; parsing
 
+! Vectors
+: { f ; parsing
+: } nreverse list>vector parsed ; parsing
+
 ! Colon defs
+: CREATE: scan "in" get create ;
+
 : :
     #! Begin a word definition. Word name follows.
-    scan "in" get create f ; parsing
+    CREATE: [ ] ; parsing
 
 : ;
     #! End a word definition.
     nreverse define ; parsing
 
 ! Vocabularies
-: DEFER: scan "in" get create drop ; parsing
+: DEFER: CREATE: drop ; parsing
 : USE: scan "use" cons@ ; parsing
 : IN: scan dup "use" cons@ "in" set ; parsing
 

diff --git a/library/platform/native/vectors.factor b/library/platform/native/vectors.factor
deleted file mode 100644 (file)
index 06ce9c7..0000000
--- a/library/platform/native/vectors.factor
+++ /dev/null
@@ -1,36 +0,0 @@
-! :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.
-
-IN: vectors
-USE: lists
-USE: stack
-
-: stack>list ( vector -- list )
-    [ ] swap [ swons ] vector-each ;
-
-: vector>list ( vector -- list )
-    stack>list nreverse ;

diff --git a/library/vectors.factor b/library/vectors.factor
index ba4d48db99b0642c2d1082bd34d26c86b86d6a15..8ddbb8f299a81d6d9eb63e35d5e785cc29f3e9cf 100644 (file)
--- a/library/vectors.factor
+++ b/library/vectors.factor
@@ -28,6 +28,7 @@
 IN: vectors
 USE: arithmetic
 USE: kernel
+USE: lists
 USE: stack
 
 : vector-empty? ( obj -- ? )

diff --git a/native/error.c b/native/error.c
index a85b7d31b05e205057af773130dd3654080a688a..a7a83cf0abd6a546d361fd965399bd47655ddfd2 100644 (file)
--- a/native/error.c
+++ b/native/error.c
@@ -15,9 +15,9 @@ void critical_error(char* msg, CELL tagged)
 
 void fix_stacks(void)
 {
-       if(env.ds < env.ds_bot + sizeof(ARRAY))
+       if(UNDERFLOW(env.ds,env.ds_bot) || OVERFLOW(env.ds,env.ds_bot))
                reset_datastack();
-       if(env.cs <= env.cs_bot + sizeof(ARRAY))
+       if(UNDERFLOW(env.cs,env.cs_bot) || OVERFLOW(env.cs,env.cs_bot))
                reset_callstack();
 }
 

diff --git a/native/error.h b/native/error.h
index 74677341aa996685853d1d44198ca12fe3892c65..57d3be328bf102301632c572510e898ce1deef41 100644 (file)
--- a/native/error.h
+++ b/native/error.h
@@ -6,6 +6,7 @@
 #define ERROR_BAD_PRIMITIVE (5<<3)
 #define ERROR_HANDLE_INCOMPAT (6<<3)
 #define ERROR_IO (7<<3)
+#define ERROR_OVERFLOW (8<<3)
 
 void fatal_error(char* msg, CELL tagged);
 void critical_error(char* msg, CELL tagged);

diff --git a/native/gc.c b/native/gc.c
index ec4039f60a4e92a4e05a62098c75a64eda15b068..13f64d9e221424f69a15dadc83c731ee0fb88e98 100644 (file)
--- a/native/gc.c
+++ b/native/gc.c
@@ -31,15 +31,16 @@ void copy_object(CELL* handle)
        CELL tag = TAG(pointer);
        CELL header, newpointer;
 
-       if(in_zone(active,pointer))
-               critical_error("copy_object given newspace ptr",pointer);
-
        if(tag == FIXNUM_TYPE)
        {
                /* convinience */
+               gc_debug("FIXNUM",pointer);
                return;
        }
        
+       if(in_zone(active,pointer))
+               critical_error("copy_object given newspace ptr",pointer);
+
        header = get(UNTAG(pointer));
        
        if(TAG(header) == GC_COLLECTED)
@@ -83,6 +84,7 @@ void collect_object(void)
                break;
        case HANDLE_TYPE:
                collect_handle((HANDLE*)scan);
+               break;
        }
        
        scan += size;

diff --git a/native/stack.h b/native/stack.h
index ee2496020337cf3a8decca18df652c0efe129948..f2734f1cbd81991baa3467552f300c9a49ab52a4 100644 (file)
--- a/native/stack.h
+++ b/native/stack.h
@@ -1,5 +1,6 @@
 #define UNDERFLOW_CHECKING
 
+#define UNDERFLOW(stack,bot) ((stack) < UNTAG(bot) + sizeof(ARRAY))
 #define OVERFLOW(stack,bot) ((stack) >= UNTAG(bot) + object_size(bot))
 
 INLINE void check_stacks(void)
@@ -7,9 +8,9 @@ INLINE void check_stacks(void)
 
 #ifdef UNDERFLOW_CHECKING
        if(OVERFLOW(env.ds,env.ds_bot))
-               fatal_error("datastack overflow",env.ds);
+               general_error(ERROR_OVERFLOW,F);
        if(OVERFLOW(env.cs,env.cs_bot))
-               fatal_error("callstack overflow",env.ds);
+               general_error(ERROR_OVERFLOW,F);
 #endif
 
 }

diff --git a/native/types.c b/native/types.c
index 2e869630926d550519e1931e4b67da8ba9f45dcd..cc86afa5675dd2f574d07793a0f64cd869008f6d 100644 (file)
--- a/native/types.c
+++ b/native/types.c
@@ -99,6 +99,9 @@ CELL untagged_object_size(CELL pointer)
        case SBUF_TYPE:
                size = sizeof(SBUF);
                break;
+       case BIGNUM_TYPE:
+               size = sizeof(BIGNUM);
+               break;
        case HANDLE_TYPE:
                size = sizeof(HANDLE);
                break;

diff --git a/native/vector.c b/native/vector.c
index a2ea50409b1ed49a76fd320260fae53f484f120d..880e8e32ec918e6280bc59420b31b511a44ae639 100644 (file)
--- a/native/vector.c
+++ b/native/vector.c
@@ -46,7 +46,7 @@ void primitive_vector_nth(void)
        env.dt = array_nth(vector->array,index);
 }
 
-void vector_ensure_capacity(VECTOR* vector, int index)
+void vector_ensure_capacity(VECTOR* vector, CELL index)
 {
        ARRAY* array = vector->array;
        CELL capacity = array->capacity;

diff --git a/native/vector.h b/native/vector.h
index 8683dbf076d8b7ce64daff740190fb987674c3ec..074bb36bb24088c76003814f5ade9171b74354a4 100644 (file)
--- a/native/vector.h
+++ b/native/vector.h
@@ -20,7 +20,7 @@ void primitive_vector(void);
 void primitive_vector_length(void);
 void primitive_set_vector_length(void);
 void primitive_vector_nth(void);
-void vector_ensure_capacity(VECTOR* vector, int index);
+void vector_ensure_capacity(VECTOR* vector, CELL index);
 void primitive_set_vector_nth(void);
 void fixup_vector(VECTOR* vector);
 void collect_vector(VECTOR* vector);