Cons-less runtime now bootstraps itself

library/bootstrap/image.factor

@@ -258,7 +258,7 @@ M: array ' ( array -- pointer )
     array-type emit-array ;
 
 M: quotation ' ( array -- pointer )
-    objects get [ quotation-type emit-array ] cache ;
+    quotation-type emit-array ;
 
 M: vector ' ( vector -- pointer )
     dup underlying ' swap length

library/compiler/alien/syntax.factor

@@ -12,7 +12,7 @@ sequences syntax words ;
 
 : FUNCTION:
     scan "c-library" get scan string-mode on
-    [ string-mode off define-c-word ] [ ] ; parsing
+    [ string-mode off define-c-word ] f ; parsing
 
 : TYPEDEF: scan scan typedef ; parsing
 
@@ -30,11 +30,11 @@ sequences syntax words ;
     string-mode on [
         string-mode off
         0 [ define-member ] reduce define-struct-type
-    ] [ ] ; parsing
+    ] f ; parsing
 
 : C-ENUM:
     string-mode on [
         string-mode off 0 [
             create-in swap [ unit define-compound ] keep 1+
         ] reduce drop
-    ] [ ] ; parsing
+    ] f ; parsing

library/help/syntax.factor

@@ -7,10 +7,10 @@ USING: arrays help kernel parser sequences syntax words ;
     scan-word bootstrap-word dup [
         >array uncons* >r "stack-effect" set-word-prop r>
         "help" set-word-prop
-    ] [ ] ; parsing
+    ] f ; parsing
 
 : ARTICLE:
-    [ >array [ first2 2 ] keep tail add-article ] [ ] ; parsing
+    [ >array [ first2 2 ] keep tail add-article ] f ; parsing
 
 : GLOSSARY:
-    [ >array [ first 1 ] keep tail add-term ] [ ] ; parsing
+    [ >array [ first 1 ] keep tail add-term ] f ; parsing

library/syntax/parse-stream.factor

@@ -11,7 +11,7 @@ words ;
 
 : parse-lines ( lines -- quot )
     [
-        dup length [ ] [ 1+ line-number set (parse) ] 2reduce
+        dup length f [ 1+ line-number set (parse) ] 2reduce
         >quotation
     ] with-parser ;
 

library/syntax/parse-syntax.factor

@@ -30,12 +30,12 @@ SYMBOL: t
 : ] >quotation parsed ; parsing
 : ; >quotation swap call ; parsing
 : } swap call parsed ; parsing
-: { [ >array ] [ ] ; parsing
+: { [ >array ] f ; parsing
-: V{ [ >vector ] [ ] ; parsing
+: V{ [ >vector ] f ; parsing
-: H{ [ alist>hash ] [ ] ; parsing
+: H{ [ alist>hash ] f ; parsing
-: C{ [ first2 rect> ] [ ] ; parsing
+: C{ [ first2 rect> ] f ; parsing
-: T{ [ >tuple ] [ ] ; parsing
+: T{ [ >tuple ] f ; parsing
-: W{ [ first <wrapper> ] [ ] ; parsing
+: W{ [ first <wrapper> ] f ; parsing
 : POSTPONE: scan-word parsed ; parsing
 : \ scan-word literalize parsed ; parsing
 : parsing word t "parsing" set-word-prop ; parsing
@@ -46,20 +46,20 @@ SYMBOL: t
 
 DEFER: PRIMITIVE: parsing
 : DEFER: CREATE dup reset-generic drop ; parsing
-: : CREATE dup reset-generic [ define-compound ] [ ] ; parsing
+: : CREATE dup reset-generic [ define-compound ] f ; parsing
 : GENERIC: CREATE dup reset-word define-generic ; parsing
-: G: CREATE dup reset-word [ define-generic* ] [ ] ; parsing
+: G: CREATE dup reset-word [ define-generic* ] f ; parsing
-: M: scan-word scan-word [ -rot define-method ] [ ] ; parsing
+: M: scan-word scan-word [ -rot define-method ] f ; parsing
 
 : UNION: ( -- class predicate definition )
     CREATE dup intern-symbol dup predicate-word
     [ dupd unit "predicate" set-word-prop ] keep
-    [ define-union ] [ ] ; parsing
+    [ define-union ] f ; parsing
 
 : PREDICATE: ( -- class predicate definition )
     scan-word CREATE dup intern-symbol
     dup rot "superclass" set-word-prop dup predicate-word
-    [ define-predicate-class ] [ ] ; parsing
+    [ define-predicate-class ] f ; parsing
 
 : TUPLE:
     scan string-mode on [ string-mode off define-tuple ] f ;
@@ -67,6 +67,6 @@ DEFER: PRIMITIVE: parsing
 
 : C:
     scan-word [ create-constructor ] keep
-    [ define-constructor ] [ ] ; parsing
+    [ define-constructor ] f ; parsing
 
 : FORGET: scan use get hash-stack [ forget ] when* ; parsing

library/test/errors.factor

@@ -1,5 +1,5 @@
 IN: temporary
-USING: sequences ;
+USE: sequences
 USE: errors
 USE: kernel
 USE: namespaces

native/memory.c

@@ -192,7 +192,7 @@ void primitive_next_object(void)
 	type = untag_header(value);
 	heap_scan_ptr += align8(untagged_object_size(heap_scan_ptr));
 
-	if(type < HEADER_TYPE)
+	if(type <= HEADER_TYPE)
 		dpush(RETAG(obj,type));
 	else
 		dpush(RETAG(obj,OBJECT_TYPE));

native/run.c

@@ -17,10 +17,10 @@ void call(CELL quot)
 	/* tail call optimization */
 	if(callframe_scan < callframe_end)
 	{
-		put(cs + CELLS,callframe);
-		put(cs + CELLS * 2,callframe_scan);
-		put(cs + CELLS * 3,callframe_end);
 		cs += CELLS * 3;
+		put(cs - CELLS * 2,callframe);
+		put(cs - CELLS,callframe_scan);
+		put(cs,callframe_end);
 	}
 
 	callframe = quot;
@@ -42,6 +42,8 @@ void handle_error(void)
 		else
 			fix_stacks();
 
+		callframe_scan = callframe_end = 0;
+
 		dpush(thrown_error);
 		/* Notify any 'catch' blocks */
 		call(userenv[BREAK_ENV]);

native/stack.c

@@ -19,15 +19,15 @@ void fix_stacks(void)
 {
 	if(STACK_UNDERFLOW(ds,stack_chain->data_region))
 		reset_datastack();
-	else if(STACK_OVERFLOW(ds,stack_chain->data_region))
+	if(STACK_OVERFLOW(ds,stack_chain->data_region))
 		reset_datastack();
-	else if(STACK_UNDERFLOW(rs,stack_chain->retain_region))
+	if(STACK_UNDERFLOW(rs,stack_chain->retain_region))
 		reset_retainstack();
-	else if(STACK_OVERFLOW(rs,stack_chain->retain_region))
+	if(STACK_OVERFLOW(rs,stack_chain->retain_region))
 		reset_retainstack();
-	else if(STACK_UNDERFLOW(cs,stack_chain->call_region))
+	if(STACK_UNDERFLOW(cs,stack_chain->call_region))
 		reset_callstack();
-	else if(STACK_OVERFLOW(cs,stack_chain->call_region))
+	if(STACK_OVERFLOW(cs,stack_chain->call_region))
 		reset_callstack();
 }