factor: arch -> arch-name. fix breakage caused by other patch.
parent
28dcd0667a
commit
46587f8457
|
@ -13,22 +13,22 @@ sequences sequences.private source-files strings system vectors
|
||||||
vocabs words ;
|
vocabs words ;
|
||||||
IN: bootstrap.image
|
IN: bootstrap.image
|
||||||
|
|
||||||
: arch ( os cpu -- arch )
|
: arch-name ( os cpu -- arch )
|
||||||
2dup [ windows? ] [ ppc? ] bi* or [
|
2dup [ windows? ] [ ppc? ] bi* or [
|
||||||
[ drop unix ] dip
|
[ drop unix ] dip
|
||||||
] unless
|
] unless
|
||||||
[ name>> ] bi@ "-" glue ;
|
[ name>> ] bi@ "-" glue ;
|
||||||
|
|
||||||
: my-arch ( -- arch )
|
: my-arch-name ( -- arch )
|
||||||
os cpu arch ;
|
os cpu arch-name ;
|
||||||
|
|
||||||
: boot-image-name ( arch -- string )
|
: boot-image-name ( arch -- string )
|
||||||
"boot." ".image" surround ;
|
"boot." ".image" surround ;
|
||||||
|
|
||||||
: my-boot-image-name ( -- string )
|
: my-boot-image-name ( -- string )
|
||||||
my-arch boot-image-name ;
|
my-arch-name boot-image-name ;
|
||||||
|
|
||||||
CONSTANT: image-strings
|
CONSTANT: image-names
|
||||||
{
|
{
|
||||||
"windows-x86.32" "unix-x86.32"
|
"windows-x86.32" "unix-x86.32"
|
||||||
"windows-x86.64" "unix-x86.64"
|
"windows-x86.64" "unix-x86.64"
|
||||||
|
@ -596,7 +596,7 @@ PRIVATE>
|
||||||
] with-variables ;
|
] with-variables ;
|
||||||
|
|
||||||
: make-images ( -- )
|
: make-images ( -- )
|
||||||
image-strings [ make-image ] each ;
|
image-names [ make-image ] each ;
|
||||||
|
|
||||||
: make-my-image ( -- )
|
: make-my-image ( -- )
|
||||||
my-arch make-image ;
|
my-arch-name make-image ;
|
||||||
|
|
|
@ -23,7 +23,7 @@ SYMBOL: build-images-destination
|
||||||
: checksums-path ( -- temp ) "checksums.txt" temp-file ;
|
: checksums-path ( -- temp ) "checksums.txt" temp-file ;
|
||||||
|
|
||||||
: boot-image-names ( -- seq )
|
: boot-image-names ( -- seq )
|
||||||
images [ boot-image-name ] map ;
|
image-names [ boot-image-name ] map ;
|
||||||
|
|
||||||
: compute-checksums ( -- )
|
: compute-checksums ( -- )
|
||||||
checksums-path ascii [
|
checksums-path ascii [
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: tools.test namespaces assocs alien.syntax kernel
|
USING: tools.test namespaces assocs alien.syntax kernel
|
||||||
compiler.errors accessors alien alien.c-types alien.strings
|
compiler.errors accessors alien alien.c-types alien.strings
|
||||||
debugger literals kernel.private ;
|
debugger literals kernel.private alien.libraries ;
|
||||||
IN: compiler.tests.linkage-errors
|
IN: compiler.tests.linkage-errors
|
||||||
|
|
||||||
! Regression: calling an undefined function would raise a protection fault
|
! Regression: calling an undefined function would raise a protection fault
|
||||||
|
|
|
@ -66,7 +66,7 @@ M: funky url-of "http://www.funky-town.com/" swap town>> append ;
|
||||||
{ "<img src=\"/icons/class-word.tiff\"/>" } [
|
{ "<img src=\"/icons/class-word.tiff\"/>" } [
|
||||||
[
|
[
|
||||||
"text"
|
"text"
|
||||||
{ { image "vocab:definitions/icons/class-word.tiff" } }
|
{ { image-style "vocab:definitions/icons/class-word.tiff" } }
|
||||||
format
|
format
|
||||||
] make-html-string
|
] make-html-string
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -8,7 +8,7 @@ threads tools.test unix unix.process ;
|
||||||
IN: io.launcher.unix.tests
|
IN: io.launcher.unix.tests
|
||||||
|
|
||||||
: arch-temp-file ( str -- str' )
|
: arch-temp-file ( str -- str' )
|
||||||
"-" my-arch 3append temp-file ;
|
"-" my-arch-name 3append temp-file ;
|
||||||
|
|
||||||
{ } [
|
{ } [
|
||||||
[ "launcher-test-1" arch-temp-file delete-file ] ignore-errors
|
[ "launcher-test-1" arch-temp-file delete-file ] ignore-errors
|
||||||
|
|
|
@ -62,13 +62,13 @@ ERROR: can't-deploy-library-file library ;
|
||||||
] { } make ;
|
] { } make ;
|
||||||
|
|
||||||
: staging-image-name ( profile -- name )
|
: staging-image-name ( profile -- name )
|
||||||
"-" join "." my-arch 3append
|
"-" join "." my-arch-name 3append
|
||||||
"staging." ".image" surround cache-file ;
|
"staging." ".image" surround cache-file ;
|
||||||
|
|
||||||
: delete-staging-images ( -- )
|
: delete-staging-images ( -- )
|
||||||
cache-directory [
|
cache-directory [
|
||||||
[ "staging." head? ] filter
|
[ "staging." head? ] filter
|
||||||
"." my-arch ".image" 3append [ tail? ] curry filter
|
"." my-arch-name ".image" 3append [ tail? ] curry filter
|
||||||
[ delete-file ] each
|
[ delete-file ] each
|
||||||
] with-directory-files ;
|
] with-directory-files ;
|
||||||
|
|
||||||
|
|
|
@ -5,7 +5,7 @@ tools.deploy.backend tools.deploy.config.editor ;
|
||||||
IN: tools.deploy.test
|
IN: tools.deploy.test
|
||||||
|
|
||||||
: test-image ( -- str )
|
: test-image ( -- str )
|
||||||
my-arch "test." ".image" surround ;
|
my-arch-name "test." ".image" surround ;
|
||||||
|
|
||||||
: shake-and-bake ( vocab -- )
|
: shake-and-bake ( vocab -- )
|
||||||
[ test-image temp-file delete-file ] ignore-errors
|
[ test-image temp-file delete-file ] ignore-errors
|
||||||
|
|
|
@ -3,6 +3,7 @@
|
||||||
USING: accessors assocs combinators kernel locals math
|
USING: accessors assocs combinators kernel locals math
|
||||||
math.ranges memoize sequences strings hashtables
|
math.ranges memoize sequences strings hashtables
|
||||||
math.parser grouping ;
|
math.parser grouping ;
|
||||||
|
QUALIFIED: assocs
|
||||||
IN: benchmark.hashtables
|
IN: benchmark.hashtables
|
||||||
|
|
||||||
MEMO: strings ( -- str )
|
MEMO: strings ( -- str )
|
||||||
|
@ -32,7 +33,7 @@ MEMO: strings ( -- str )
|
||||||
] map drop
|
] map drop
|
||||||
|
|
||||||
keys [
|
keys [
|
||||||
hash [ 1 + ] change-at
|
hash [ 1 + ] assocs:change-at
|
||||||
] each ;
|
] each ;
|
||||||
|
|
||||||
: string-mix ( hash -- )
|
: string-mix ( hash -- )
|
||||||
|
|
|
@ -10,6 +10,7 @@ compiler.cfg.predecessors
|
||||||
compiler.cfg.renaming.functor
|
compiler.cfg.renaming.functor
|
||||||
compiler.cfg.rpo ;
|
compiler.cfg.rpo ;
|
||||||
FROM: namespaces => set ;
|
FROM: namespaces => set ;
|
||||||
|
QUALIFIED: assocs
|
||||||
IN: compiler.cfg.gvn.avail
|
IN: compiler.cfg.gvn.avail
|
||||||
|
|
||||||
: defined ( bb -- vregs )
|
: defined ( bb -- vregs )
|
||||||
|
@ -39,6 +40,6 @@ M: avail-analysis transfer-set drop defined assoc-union ;
|
||||||
keep swap [ available-uses? ] [ drop f ] if ; inline
|
keep swap [ available-uses? ] [ drop f ] if ; inline
|
||||||
|
|
||||||
: make-available ( vreg -- )
|
: make-available ( vreg -- )
|
||||||
basic-block get avail-ins get [ dupd clone ?set-at ] change-at ;
|
basic-block get avail-ins get [ dupd clone ?set-at ] assocs:change-at ;
|
||||||
|
|
||||||
RENAMING: >avail [ ] [ dup >avail-vreg swap or ] [ ]
|
RENAMING: >avail [ ] [ dup >avail-vreg swap or ] [ ]
|
||||||
|
|
|
@ -6,6 +6,7 @@ compiler.cfg.dominance.private compiler.cfg.rpo
|
||||||
compiler.tree.builder compiler.tree.recursive graphviz.render io
|
compiler.tree.builder compiler.tree.recursive graphviz.render io
|
||||||
io.encodings.ascii io.files io.files.unique io.launcher kernel
|
io.encodings.ascii io.files io.files.unique io.launcher kernel
|
||||||
make math math.parser namespaces quotations sequences words ;
|
make math math.parser namespaces quotations sequences words ;
|
||||||
|
QUALIFIED: assocs
|
||||||
IN: compiler.graphviz
|
IN: compiler.graphviz
|
||||||
|
|
||||||
: quotes ( str -- str' ) "\"" "\"" surround ;
|
: quotes ( str -- str' ) "\"" "\"" surround ;
|
||||||
|
@ -106,7 +107,8 @@ SYMBOL: vertex-names
|
||||||
: vertex-name ( call-graph-node -- string )
|
: vertex-name ( call-graph-node -- string )
|
||||||
label>> vertex-names get [
|
label>> vertex-names get [
|
||||||
word>> name>>
|
word>> name>>
|
||||||
dup word-counts get [ 0 or 1 + dup ] change-at number>string " #" glue
|
dup word-counts get [ 0 or 1 + dup ] assocs:change-at
|
||||||
|
number>string " #" glue
|
||||||
] cache ;
|
] cache ;
|
||||||
|
|
||||||
: vertex-attrs ( obj -- string )
|
: vertex-attrs ( obj -- string )
|
||||||
|
|
|
@ -15,7 +15,7 @@ IN: mason.platform
|
||||||
"make" ;
|
"make" ;
|
||||||
|
|
||||||
: target-arch ( -- arch )
|
: target-arch ( -- arch )
|
||||||
target-os get target-cpu get arch ;
|
target-os get target-cpu get arch-name ;
|
||||||
|
|
||||||
: target-boot-image-name ( -- string )
|
: target-boot-image-name ( -- string )
|
||||||
target-arch boot-image-name ;
|
target-arch boot-image-name ;
|
||||||
|
|
|
@ -7,7 +7,7 @@ IN: mason.release.tidy
|
||||||
|
|
||||||
: useless-files ( -- seq )
|
: useless-files ( -- seq )
|
||||||
"build-support/cleanup" ascii file-lines
|
"build-support/cleanup" ascii file-lines
|
||||||
images [ boot-image-name ] map append
|
image-names [ boot-image-name ] map append
|
||||||
target-os get macosx? [ "Factor.app" suffix ] unless ;
|
target-os get macosx? [ "Factor.app" suffix ] unless ;
|
||||||
|
|
||||||
: tidy ( -- )
|
: tidy ( -- )
|
||||||
|
|
|
@ -9,7 +9,7 @@ IN: tools.image-analyzer.tests
|
||||||
dup image-path exists? [ drop ] [ make-image ] if ;
|
dup image-path exists? [ drop ] [ make-image ] if ;
|
||||||
|
|
||||||
: loadable-images ( -- images )
|
: loadable-images ( -- images )
|
||||||
images cpu name>> '[ _ tail? ] filter ;
|
image-names cpu name>> '[ _ tail? ] filter ;
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
loadable-images [ [ ?make-image ] each ] [
|
loadable-images [ [ ?make-image ] each ] [
|
||||||
|
|
|
@ -4,7 +4,7 @@ IN: update.backup
|
||||||
|
|
||||||
: backup-boot-image ( -- )
|
: backup-boot-image ( -- )
|
||||||
my-boot-image-name
|
my-boot-image-name
|
||||||
{ "boot." my-arch "-" [ "datestamp" get ] ".image" } to-string
|
{ "boot." my-arch-name "-" [ "datestamp" get ] ".image" } to-string
|
||||||
move-file ;
|
move-file ;
|
||||||
|
|
||||||
: backup-image ( -- )
|
: backup-image ( -- )
|
||||||
|
|
|
@ -20,7 +20,7 @@ IN: webapps.mason.version.source
|
||||||
".gitignore" delete-file ;
|
".gitignore" delete-file ;
|
||||||
|
|
||||||
: download-images ( -- )
|
: download-images ( -- )
|
||||||
images [ boot-image-name download-image ] each ;
|
image-names [ boot-image-name download-image ] each ;
|
||||||
|
|
||||||
: prepare-source ( git-id -- )
|
: prepare-source ( git-id -- )
|
||||||
"factor" [
|
"factor" [
|
||||||
|
|
Loading…
Reference in New Issue