Merge branch 'master' of git://factorcode.org/git/factor
commit
65036db93e
|
@ -138,7 +138,8 @@ ERROR: bad-superclass class ;
|
||||||
dup boa-check-quot "boa-check" set-word-prop ;
|
dup boa-check-quot "boa-check" set-word-prop ;
|
||||||
|
|
||||||
: tuple-prototype ( class -- prototype )
|
: tuple-prototype ( class -- prototype )
|
||||||
[ all-slots [ initial>> ] map ] keep slots>tuple ;
|
[ all-slots [ initial>> ] map ] keep
|
||||||
|
over [ ] contains? [ slots>tuple ] [ 2drop f ] if ;
|
||||||
|
|
||||||
: define-tuple-prototype ( class -- )
|
: define-tuple-prototype ( class -- )
|
||||||
dup tuple-prototype "prototype" set-word-prop ;
|
dup tuple-prototype "prototype" set-word-prop ;
|
||||||
|
@ -317,7 +318,8 @@ M: tuple hashcode*
|
||||||
] recursive-hashcode ;
|
] recursive-hashcode ;
|
||||||
|
|
||||||
M: tuple-class new
|
M: tuple-class new
|
||||||
"prototype" word-prop (clone) ;
|
dup "prototype" word-prop
|
||||||
|
[ (clone) ] [ tuple-layout <tuple> ] ?if ;
|
||||||
|
|
||||||
M: tuple-class boa
|
M: tuple-class boa
|
||||||
[ "boa-check" word-prop call ]
|
[ "boa-check" word-prop call ]
|
||||||
|
|
|
@ -12,42 +12,36 @@ namespaces continuations layouts accessors ;
|
||||||
] with-directory ;
|
] with-directory ;
|
||||||
|
|
||||||
: small-enough? ( n -- ? )
|
: small-enough? ( n -- ? )
|
||||||
>r "test.image" temp-file file-info size>> r> <= ;
|
>r "test.image" temp-file file-info size>> r> cell 4 / * <= ;
|
||||||
|
|
||||||
[ ] [ "hello-world" shake-and-bake ] unit-test
|
[ ] [ "hello-world" shake-and-bake ] unit-test
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [ 50000 small-enough? ] unit-test
|
||||||
cell 8 = 8 5 ? 100000 * small-enough?
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ ] [ "sudoku" shake-and-bake ] unit-test
|
[ ] [ "sudoku" shake-and-bake ] unit-test
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [ 80000 small-enough? ] unit-test
|
||||||
cell 8 = 20 10 ? 100000 * small-enough?
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ ] [ "hello-ui" shake-and-bake ] unit-test
|
[ ] [ "hello-ui" shake-and-bake ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ 130000 small-enough? ] unit-test
|
||||||
|
|
||||||
[ "staging.math-compiler-ui-strip.image" ] [
|
[ "staging.math-compiler-ui-strip.image" ] [
|
||||||
"hello-ui" deploy-config
|
"hello-ui" deploy-config
|
||||||
[ bootstrap-profile staging-image-name file-name ] bind
|
[ bootstrap-profile staging-image-name file-name ] bind
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ t ] [
|
|
||||||
cell 8 = 35 17 ? 100000 * small-enough?
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ ] [ "maze" shake-and-bake ] unit-test
|
[ ] [ "maze" shake-and-bake ] unit-test
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [ 120000 small-enough? ] unit-test
|
||||||
cell 8 = 30 15 ? 100000 * small-enough?
|
|
||||||
] unit-test
|
[ ] [ "tetris" shake-and-bake ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ 120000 small-enough? ] unit-test
|
||||||
|
|
||||||
[ ] [ "bunny" shake-and-bake ] unit-test
|
[ ] [ "bunny" shake-and-bake ] unit-test
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [ 250000 small-enough? ] unit-test
|
||||||
cell 8 = 50 30 ? 100000 * small-enough?
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
{
|
{
|
||||||
"tools.deploy.test.1"
|
"tools.deploy.test.1"
|
||||||
|
|
|
@ -4,7 +4,7 @@ USING: accessors qualified io.streams.c init fry namespaces
|
||||||
assocs kernel parser lexer strings.parser tools.deploy.config
|
assocs kernel parser lexer strings.parser tools.deploy.config
|
||||||
vocabs sequences words words.private memory kernel.private
|
vocabs sequences words words.private memory kernel.private
|
||||||
continuations io prettyprint vocabs.loader debugger system
|
continuations io prettyprint vocabs.loader debugger system
|
||||||
strings sets ;
|
strings sets vectors quotations byte-arrays ;
|
||||||
QUALIFIED: bootstrap.stage2
|
QUALIFIED: bootstrap.stage2
|
||||||
QUALIFIED: classes
|
QUALIFIED: classes
|
||||||
QUALIFIED: command-line
|
QUALIFIED: command-line
|
||||||
|
@ -79,8 +79,8 @@ IN: tools.deploy.shaker
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
props>> swap
|
props>> swap
|
||||||
'[ drop , member? not ] assoc-filter
|
'[ drop , member? not ] assoc-filter sift-assoc
|
||||||
sift-assoc f assoc-like
|
dup assoc-empty? [ drop f ] [ >alist >vector ] if
|
||||||
] keep (>>props)
|
] keep (>>props)
|
||||||
] with each ;
|
] with each ;
|
||||||
|
|
||||||
|
@ -93,7 +93,10 @@ IN: tools.deploy.shaker
|
||||||
"compiled-uses"
|
"compiled-uses"
|
||||||
"constraints"
|
"constraints"
|
||||||
"declared-effect"
|
"declared-effect"
|
||||||
|
"default"
|
||||||
|
"default-method"
|
||||||
"default-output-classes"
|
"default-output-classes"
|
||||||
|
"derived-from"
|
||||||
"identities"
|
"identities"
|
||||||
"if-intrinsics"
|
"if-intrinsics"
|
||||||
"infer"
|
"infer"
|
||||||
|
@ -103,15 +106,18 @@ IN: tools.deploy.shaker
|
||||||
"loc"
|
"loc"
|
||||||
"members"
|
"members"
|
||||||
"methods"
|
"methods"
|
||||||
|
"method-class"
|
||||||
|
"method-generic"
|
||||||
"combination"
|
"combination"
|
||||||
"cannot-infer"
|
"cannot-infer"
|
||||||
"default-method"
|
"no-compile"
|
||||||
"optimizer-hooks"
|
"optimizer-hooks"
|
||||||
"output-classes"
|
"output-classes"
|
||||||
"participants"
|
"participants"
|
||||||
"predicate"
|
"predicate"
|
||||||
"predicate-definition"
|
"predicate-definition"
|
||||||
"predicating"
|
"predicating"
|
||||||
|
"tuple-dispatch-generic"
|
||||||
"slots"
|
"slots"
|
||||||
"slot-names"
|
"slot-names"
|
||||||
"specializer"
|
"specializer"
|
||||||
|
@ -127,6 +133,8 @@ IN: tools.deploy.shaker
|
||||||
|
|
||||||
strip-prettyprint? [
|
strip-prettyprint? [
|
||||||
{
|
{
|
||||||
|
"break-before"
|
||||||
|
"break-after"
|
||||||
"delimiter"
|
"delimiter"
|
||||||
"flushable"
|
"flushable"
|
||||||
"foldable"
|
"foldable"
|
||||||
|
@ -265,13 +273,27 @@ IN: tools.deploy.shaker
|
||||||
21 setenv
|
21 setenv
|
||||||
] [ drop ] if ;
|
] [ drop ] if ;
|
||||||
|
|
||||||
|
: compress ( pred string -- )
|
||||||
|
"Compressing " prepend show
|
||||||
|
instances
|
||||||
|
dup H{ } clone [ [ ] cache ] curry map
|
||||||
|
become ; inline
|
||||||
|
|
||||||
|
: compress-byte-arrays ( -- )
|
||||||
|
[ byte-array? ] "byte arrays" compress ;
|
||||||
|
|
||||||
|
: compress-quotations ( -- )
|
||||||
|
[ quotation? ] "quotations" compress ;
|
||||||
|
|
||||||
|
: compress-strings ( -- )
|
||||||
|
[ string? ] "strings" compress ;
|
||||||
|
|
||||||
: finish-deploy ( final-image -- )
|
: finish-deploy ( final-image -- )
|
||||||
"Finishing up" show
|
"Finishing up" show
|
||||||
>r { } set-datastack r>
|
>r { } set-datastack r>
|
||||||
{ } set-retainstack
|
{ } set-retainstack
|
||||||
V{ } set-namestack
|
V{ } set-namestack
|
||||||
V{ } set-catchstack
|
V{ } set-catchstack
|
||||||
|
|
||||||
"Saving final image" show
|
"Saving final image" show
|
||||||
[ save-image-and-exit ] call-clear ;
|
[ save-image-and-exit ] call-clear ;
|
||||||
|
|
||||||
|
@ -295,7 +317,10 @@ SYMBOL: deploy-vocab
|
||||||
deploy-vocab get vocab-main set-boot-quot*
|
deploy-vocab get vocab-main set-boot-quot*
|
||||||
stripped-word-props >r
|
stripped-word-props >r
|
||||||
stripped-globals strip-globals
|
stripped-globals strip-globals
|
||||||
r> strip-words ;
|
r> strip-words
|
||||||
|
compress-byte-arrays
|
||||||
|
compress-quotations
|
||||||
|
compress-strings ;
|
||||||
|
|
||||||
: (deploy) ( final-image vocab config -- )
|
: (deploy) ( final-image vocab config -- )
|
||||||
#! Does the actual work of a deployment in the slave
|
#! Does the actual work of a deployment in the slave
|
||||||
|
|
|
@ -308,6 +308,8 @@ DEFINE_PRIMITIVE(code_room)
|
||||||
/* Dump all code blocks for debugging */
|
/* Dump all code blocks for debugging */
|
||||||
void dump_heap(F_HEAP *heap)
|
void dump_heap(F_HEAP *heap)
|
||||||
{
|
{
|
||||||
|
CELL size = 0;
|
||||||
|
|
||||||
F_BLOCK *scan = first_block(heap);
|
F_BLOCK *scan = first_block(heap);
|
||||||
|
|
||||||
while(scan)
|
while(scan)
|
||||||
|
@ -319,9 +321,11 @@ void dump_heap(F_HEAP *heap)
|
||||||
status = "free";
|
status = "free";
|
||||||
break;
|
break;
|
||||||
case B_ALLOCATED:
|
case B_ALLOCATED:
|
||||||
|
size += object_size(block_to_compiled(scan)->relocation);
|
||||||
status = "allocated";
|
status = "allocated";
|
||||||
break;
|
break;
|
||||||
case B_MARKED:
|
case B_MARKED:
|
||||||
|
size += object_size(block_to_compiled(scan)->relocation);
|
||||||
status = "marked";
|
status = "marked";
|
||||||
break;
|
break;
|
||||||
default:
|
default:
|
||||||
|
@ -333,6 +337,8 @@ void dump_heap(F_HEAP *heap)
|
||||||
|
|
||||||
scan = next_block(heap,scan);
|
scan = next_block(heap,scan);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
printf("%ld bytes of relocation data\n",size);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Compute where each block is going to go, after compaction */
|
/* Compute where each block is going to go, after compaction */
|
||||||
|
|
Loading…
Reference in New Issue