steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Cons-less runtime now bootstraps itself

slava 2006-05-17 23:05:44 +00:00
parent b826aeba7b
commit 36f324370a
9 changed files with 32 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
library/bootstrap/image.factor
View File

@ -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

6
library/compiler/alien/syntax.factor
View File

@ -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

6
library/help/syntax.factor
View File

@ -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

2
library/syntax/parse-stream.factor
View File

@ -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 ;

24
library/syntax/parse-syntax.factor
View File

@ -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 <wrapper> ] [ ] ; parsing
: { [ >array ] f ; parsing
: V{ [ >vector ] f ; parsing
: H{ [ alist>hash ] f ; parsing
: C{ [ first2 rect> ] f ; parsing
: T{ [ >tuple ] f ; 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
: 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

2
library/test/errors.factor
View File

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

2
native/memory.c
View File

@ -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));

8
native/run.c
View File

@ -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]);

10
native/stack.c
View File

@ -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();
}