Merge branch 'master' of git://github.com/slavapestov/factor

db4
erikc 2010-01-28 14:14:33 -08:00
commit ef20b40093
5 changed files with 37 additions and 35 deletions

View File

@ -554,12 +554,19 @@ M: quotation '
: fixup-header ( -- ) : fixup-header ( -- )
heap-size data-heap-size-offset fixup ; heap-size data-heap-size-offset fixup ;
: build-generics ( -- )
[
all-words
[ generic? ] filter
[ make-generic ] each
] with-compilation-unit ;
: build-image ( -- image ) : build-image ( -- image )
800000 <vector> image set 800000 <vector> image set
20000 <hashtable> objects set 20000 <hashtable> objects set
emit-image-header t, 0, 1, -1, emit-image-header t, 0, 1, -1,
"Building generic words..." print flush "Building generic words..." print flush
remake-generics build-generics
"Serializing words..." print flush "Serializing words..." print flush
emit-words emit-words
"Serializing JIT data..." print flush "Serializing JIT data..." print flush

View File

@ -64,12 +64,15 @@ M: rename pprint-qualified ( rename -- )
tri tri
] with-pprint ; ] with-pprint ;
: filter-interesting ( seq -- seq' )
[ [ vocab? ] [ extra-words? ] bi or not ] filter ;
PRIVATE> PRIVATE>
: (pprint-manifest ( manifest -- quots ) : (pprint-manifest ( manifest -- quots )
[ [
[ search-vocabs>> [ '[ _ pprint-using ] , ] unless-empty ] [ search-vocabs>> [ '[ _ pprint-using ] , ] unless-empty ]
[ qualified-vocabs>> [ extra-words? not ] filter [ '[ _ pprint-qualified ] , ] each ] [ qualified-vocabs>> filter-interesting [ '[ _ pprint-qualified ] , ] each ]
[ current-vocab>> [ '[ _ pprint-in ] , ] when* ] [ current-vocab>> [ '[ _ pprint-in ] , ] when* ]
tri tri
] { } make ; ] { } make ;

View File

@ -31,32 +31,31 @@ architecture get {
! Now we have ( syntax-quot arch-quot layouts-quot ) on the stack ! Now we have ( syntax-quot arch-quot layouts-quot ) on the stack
! Bring up a bare cross-compiling vocabulary. ! Bring up a bare cross-compiling vocabulary.
"syntax" vocab vocab-words bootstrap-syntax set { "syntax" vocab vocab-words bootstrap-syntax set
dictionary
new-classes H{ } clone dictionary set
changed-definitions changed-generics changed-effects H{ } clone root-cache set
outdated-generics forgotten-definitions H{ } clone source-files set
root-cache source-files update-map implementors-map H{ } clone update-map set
} [ H{ } clone swap set ] each H{ } clone implementors-map set
init-caches init-caches
bootstrapping? on
call( -- )
call( -- )
! Vocabulary for slot accessors ! Vocabulary for slot accessors
"accessors" create-vocab drop "accessors" create-vocab drop
dummy-compiler compiler-impl set
call( -- )
call( -- )
call( -- )
! After we execute bootstrap/layouts ! After we execute bootstrap/layouts
num-types get f <array> builtins set num-types get f <array> builtins set
bootstrapping? on
[ [
call( -- )
! Create some empty vocabs where the below primitives and ! Create some empty vocabs where the below primitives and
! classes will go ! classes will go
{ {

View File

@ -64,16 +64,6 @@ M: f process-forgotten-words drop ;
: without-optimizer ( quot -- ) : without-optimizer ( quot -- )
[ f compiler-impl ] dip with-variable ; inline [ f compiler-impl ] dip with-variable ; inline
! Trivial compiler. We don't want to touch the code heap
! during stage1 bootstrap, it would just waste time.
SINGLETON: dummy-compiler
M: dummy-compiler to-recompile f ;
M: dummy-compiler recompile drop { } ;
M: dummy-compiler process-forgotten-words drop ;
: <definitions> ( -- pair ) { H{ } H{ } } [ clone ] map ; : <definitions> ( -- pair ) { H{ } H{ } } [ clone ] map ;
SYMBOL: definition-observers SYMBOL: definition-observers
@ -143,13 +133,15 @@ M: object bump-effect-counter* drop f ;
[ drop ] [ notify-definition-observers notify-error-observers ] if ; [ drop ] [ notify-definition-observers notify-error-observers ] if ;
: finish-compilation-unit ( -- ) : finish-compilation-unit ( -- )
[ ] [
remake-generics remake-generics
to-recompile recompile to-recompile recompile
update-tuples update-tuples
process-forgotten-definitions process-forgotten-definitions
modify-code-heap modify-code-heap
bump-effect-counter bump-effect-counter
notify-observers ; notify-observers
] if-bootstrapping ;
PRIVATE> PRIVATE>

View File

@ -16,7 +16,8 @@ checksum
definitions ; definitions ;
: record-top-level-form ( quot file -- ) : record-top-level-form ( quot file -- )
(>>top-level-form) H{ } notify-definition-observers ; (>>top-level-form)
[ ] [ H{ } notify-definition-observers ] if-bootstrapping ;
: record-checksum ( lines source-file -- ) : record-checksum ( lines source-file -- )
[ crc32 checksum-lines ] dip (>>checksum) ; [ crc32 checksum-lines ] dip (>>checksum) ;