From 36f324370aeaeae00852e540812a3caf581638f7 Mon Sep 17 00:00:00 2001 From: slava Date: Wed, 17 May 2006 23:05:44 +0000 Subject: [PATCH] Cons-less runtime now bootstraps itself --- library/bootstrap/image.factor | 2 +- library/compiler/alien/syntax.factor | 6 +++--- library/help/syntax.factor | 6 +++--- library/syntax/parse-stream.factor | 2 +- library/syntax/parse-syntax.factor | 24 ++++++++++++------------ library/test/errors.factor | 2 +- native/memory.c | 2 +- native/run.c | 8 +++++--- native/stack.c | 10 +++++----- 9 files changed, 32 insertions(+), 30 deletions(-) diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index 5db09c30ea..ed1b70d60e 100644 --- a/library/bootstrap/image.factor +++ b/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 diff --git a/library/compiler/alien/syntax.factor b/library/compiler/alien/syntax.factor index f8ec3bf37f..bcc3693bf6 100644 --- a/library/compiler/alien/syntax.factor +++ b/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 diff --git a/library/help/syntax.factor b/library/help/syntax.factor index 5442fe07db..1e13f73deb 100644 --- a/library/help/syntax.factor +++ b/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 diff --git a/library/syntax/parse-stream.factor b/library/syntax/parse-stream.factor index bb9a3988e8..138ffca672 100644 --- a/library/syntax/parse-stream.factor +++ b/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 ; diff --git a/library/syntax/parse-syntax.factor b/library/syntax/parse-syntax.factor index cebad06a7b..3ae20cf381 100644 --- a/library/syntax/parse-syntax.factor +++ b/library/syntax/parse-syntax.factor @@ -30,12 +30,12 @@ SYMBOL: t : ] >quotation parsed ; parsing : ; >quotation swap call ; parsing : } swap call parsed ; parsing -: { [ >array ] [ ] ; parsing -: V{ [ >vector ] [ ] ; parsing -: H{ [ alist>hash ] [ ] ; parsing -: C{ [ first2 rect> ] [ ] ; parsing -: T{ [ >tuple ] [ ] ; parsing -: W{ [ first ] [ ] ; parsing +: { [ >array ] f ; parsing +: V{ [ >vector ] f ; parsing +: H{ [ alist>hash ] f ; parsing +: C{ [ first2 rect> ] f ; parsing +: T{ [ >tuple ] f ; parsing +: W{ [ first ] 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 -: M: scan-word scan-word [ -rot define-method ] [ ] ; parsing +: G: CREATE dup reset-word [ define-generic* ] f ; 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 diff --git a/library/test/errors.factor b/library/test/errors.factor index 0fdd3cb730..fe421ff6c1 100644 --- a/library/test/errors.factor +++ b/library/test/errors.factor @@ -1,5 +1,5 @@ IN: temporary -USING: sequences ; +USE: sequences USE: errors USE: kernel USE: namespaces diff --git a/native/memory.c b/native/memory.c index 1641a48c51..2df076d055 100644 --- a/native/memory.c +++ b/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)); diff --git a/native/run.c b/native/run.c index 1d92f5fe7b..9fb22f3d10 100644 --- a/native/run.c +++ b/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]); diff --git a/native/stack.c b/native/stack.c index 86921a326b..8effbb8b69 100644 --- a/native/stack.c +++ b/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(); }