From 429fe85f460face61d8a31fdc12d001e950249c9 Mon Sep 17 00:00:00 2001
From: "U-SLAVA-DFB8FF805\\Slava" <Slava@slava-dfb8ff805.(none)>
Date: Sun, 9 Nov 2008 17:27:39 -0600
Subject: [PATCH 01/16] Fix compile error
---
basis/io/windows/files/files.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
mode change 100644 => 100755 basis/io/windows/files/files.factor
diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor
old mode 100644
new mode 100755
index 3fb8029ee7..3952299543
--- a/basis/io/windows/files/files.factor
+++ b/basis/io/windows/files/files.factor
@@ -276,7 +276,7 @@ M: winnt file-system-info ( path -- file-system-info )
swap >>type
swap >>mount-point ;
-: find-first-volume ( word -- string handle )
+: find-first-volume ( -- string handle )
MAX_PATH 1+ <byte-array> dup length
dupd
FindFirstVolume dup win32-error=0/f
From 2bf9a55cead31028ef311b3faf066511b60792ea Mon Sep 17 00:00:00 2001
From: "U-SLAVA-DFB8FF805\\Slava" <Slava@slava-dfb8ff805.(none)>
Date: Sun, 9 Nov 2008 17:27:51 -0600
Subject: [PATCH 02/16] Fix Windows deployment
---
basis/tools/deploy/windows/windows.factor | 26 +++++++++++------------
1 file changed, 12 insertions(+), 14 deletions(-)
diff --git a/basis/tools/deploy/windows/windows.factor b/basis/tools/deploy/windows/windows.factor
index ad1b3cbd84..ec1259c777 100755
--- a/basis/tools/deploy/windows/windows.factor
+++ b/basis/tools/deploy/windows/windows.factor
@@ -9,16 +9,14 @@ IN: tools.deploy.windows
"resource:factor.dll" swap copy-file-into ;
: copy-freetype ( bundle-name -- )
- deploy-ui? get [
- {
- "resource:freetype6.dll"
- "resource:zlib1.dll"
- } swap copy-files-into
- ] [ drop ] if ;
+ {
+ "resource:freetype6.dll"
+ "resource:zlib1.dll"
+ } swap copy-files-into ;
: create-exe-dir ( vocab bundle-name -- vm )
+ dup copy-dll
deploy-ui? get [
- dup copy-dll
dup copy-freetype
dup "" copy-fonts
] when
@@ -26,14 +24,14 @@ IN: tools.deploy.windows
M: winnt deploy*
"resource:" [
- deploy-name over deploy-config at
- [
- {
+ dup deploy-config [
+ deploy-name get
+ [
[ create-exe-dir ]
[ image-name ]
[ drop ]
- [ drop deploy-config ]
- } 2cleave make-deploy-image
- ]
- [ nip open-in-explorer ] 2bi
+ 2tri namespace make-deploy-image
+ ]
+ [ nip open-in-explorer ] 2bi
+ ] bind
] with-directory ;
From b8eebd5c2be585b506b00e57f2307ec35f3db1ce Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 10 Nov 2008 00:16:11 -0600
Subject: [PATCH 03/16] swap over == tuck; dupd swap == over
---
basis/io/unix/launcher/parser/parser.factor | 2 +-
basis/peg/ebnf/ebnf.factor | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/io/unix/launcher/parser/parser.factor b/basis/io/unix/launcher/parser/parser.factor
index e5e83ab4e9..276ed45f27 100644
--- a/basis/io/unix/launcher/parser/parser.factor
+++ b/basis/io/unix/launcher/parser/parser.factor
@@ -29,5 +29,5 @@ IN: io.unix.launcher.parser
PEG: tokenize-command ( command -- ast/f )
'argument' " " token repeat1 list-of
- " " token repeat0 swap over pack
+ " " token repeat0 tuck pack
just ;
diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor
index 776450ccd9..ccae0fec93 100644
--- a/basis/peg/ebnf/ebnf.factor
+++ b/basis/peg/ebnf/ebnf.factor
@@ -487,7 +487,7 @@ M: ebnf-terminal (transform) ( ast -- parser )
M: ebnf-foreign (transform) ( ast -- parser )
dup word>> search
[ "Foreign word '" swap word>> append "' not found" append throw ] unless*
- swap rule>> [ main ] unless* dupd swap rule [
+ swap rule>> [ main ] unless* over rule [
nip
] [
execute
From 57af68f7ed49dfcb3b6217731407cd2bd6ee4433 Mon Sep 17 00:00:00 2001
From: Eric Mertens <emertens@galois.com>
Date: Sun, 9 Nov 2008 22:20:12 -0800
Subject: [PATCH 04/16] add project-euler.215
---
extra/project-euler/215/215-tests.factor | 5 +++
extra/project-euler/215/215.factor | 56 ++++++++++++++++++++++++
2 files changed, 61 insertions(+)
create mode 100644 extra/project-euler/215/215-tests.factor
create mode 100644 extra/project-euler/215/215.factor
diff --git a/extra/project-euler/215/215-tests.factor b/extra/project-euler/215/215-tests.factor
new file mode 100644
index 0000000000..ddd87cc2ff
--- /dev/null
+++ b/extra/project-euler/215/215-tests.factor
@@ -0,0 +1,5 @@
+USING: project-euler.215 tools.test ;
+IN: project-euler.215.tests
+
+[ 8 ] [ 9 3 solve ] unit-test
+[ 806844323190414 ] [ euler215 ] unit-test
diff --git a/extra/project-euler/215/215.factor b/extra/project-euler/215/215.factor
new file mode 100644
index 0000000000..056de72e50
--- /dev/null
+++ b/extra/project-euler/215/215.factor
@@ -0,0 +1,56 @@
+USING: accessors kernel locals math ;
+IN: project-euler.215
+
+TUPLE: block two three ;
+TUPLE: end { ways integer } ;
+
+C: <block> block
+C: <end> end
+: <failure> 0 <end> ; inline
+: <success> 1 <end> ; inline
+
+: failure? ( t -- ? ) ways>> 0 = ; inline
+
+: choice ( t p q -- t t ) [ [ two>> ] [ three>> ] bi ] 2dip bi* ; inline
+
+GENERIC: merge ( t t -- t )
+GENERIC# block-merge 1 ( t t -- t )
+GENERIC# end-merge 1 ( t t -- t )
+M: block merge block-merge ;
+M: end merge end-merge ;
+M: block block-merge [ [ two>> ] bi@ merge ]
+ [ [ three>> ] bi@ merge ] 2bi <block> ;
+M: end block-merge nip ;
+M: block end-merge drop ;
+M: end end-merge [ ways>> ] bi@ + <end> ;
+
+GENERIC: h-1 ( t -- t )
+GENERIC: h0 ( t -- t )
+GENERIC: h1 ( t -- t )
+GENERIC: h2 ( t -- t )
+
+M: block h-1 [ h1 ] [ h2 ] choice merge ;
+M: block h0 drop <failure> ;
+M: block h1 [ [ h1 ] [ h2 ] choice merge ]
+ [ [ h0 ] [ h1 ] choice merge ] bi <block> ;
+M: block h2 [ h1 ] [ h2 ] choice merge <failure> swap <block> ;
+
+M: end h-1 drop <failure> ;
+M: end h0 ;
+M: end h1 drop <failure> ;
+M: end h2 dup failure? [ <failure> <block> ] unless ;
+
+: next-row ( t -- t ) [ h-1 ] [ h1 ] choice swap <block> ;
+
+: first-row ( n -- t )
+ [ <failure> <success> <failure> ] dip
+ 1- [| a b c | b c <block> a b ] times 2drop ;
+
+GENERIC: total ( t -- n )
+M: block total [ total ] dup choice + ;
+M: end total ways>> ;
+
+: solve ( width height -- ways )
+ [ first-row ] dip 1- [ next-row ] times total ;
+
+: euler215 ( -- ways ) 32 10 solve ;
From 6df7342b812b53a6c15e7ce100251baaef50c63d Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 10 Nov 2008 02:10:18 -0600
Subject: [PATCH 05/16] ui.gadgets.scrollers: Nicer version of 'find-scroller*'
---
basis/ui/gadgets/scrollers/scrollers.factor | 14 ++++++--------
1 file changed, 6 insertions(+), 8 deletions(-)
diff --git a/basis/ui/gadgets/scrollers/scrollers.factor b/basis/ui/gadgets/scrollers/scrollers.factor
index 633e3ad4a8..8c63e15a4d 100644
--- a/basis/ui/gadgets/scrollers/scrollers.factor
+++ b/basis/ui/gadgets/scrollers/scrollers.factor
@@ -4,7 +4,8 @@ USING: accessors arrays ui.gadgets ui.gadgets.viewports
ui.gadgets.frames ui.gadgets.grids ui.gadgets.theme
ui.gadgets.sliders ui.gestures kernel math namespaces sequences
models models.range models.compose
-combinators math.vectors classes.tuple math.geometry.rect ;
+combinators math.vectors classes.tuple math.geometry.rect
+combinators.short-circuit ;
IN: ui.gadgets.scrollers
TUPLE: scroller < frame viewport x y follows ;
@@ -70,13 +71,10 @@ scroller H{
: relative-scroll-rect ( rect gadget scroller -- newrect )
viewport>> gadget-child relative-loc offset-rect ;
-: find-scroller* ( gadget -- scroller )
- dup find-scroller dup [
- 2dup viewport>> gadget-child
- swap child? [ nip ] [ 2drop f ] if
- ] [
- 2drop f
- ] if ;
+: find-scroller* ( gadget -- scroller/f )
+ dup find-scroller
+ { [ nip ] [ viewport>> gadget-child swap child? ] [ nip ] }
+ 2&& ;
: scroll>rect ( rect gadget -- )
dup find-scroller* dup [
From 359f177a984e16b25e54b613b9565965453e30d7 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 10 Nov 2008 02:40:14 -0600
Subject: [PATCH 06/16] Remove 'builder' vocabulary (now called 'mason')
---
extra/builder/build/build.factor | 46 --------
extra/builder/builder.factor | 21 ----
extra/builder/child/child.factor | 68 ------------
extra/builder/cleanup/cleanup.factor | 26 -----
extra/builder/common/common.factor | 54 ----------
extra/builder/email/email.factor | 24 -----
extra/builder/release/archive/archive.factor | 69 ------------
extra/builder/release/branch/branch.factor | 40 -------
extra/builder/release/release.factor | 27 -----
extra/builder/release/tidy/tidy.factor | 29 -----
extra/builder/release/upload/upload.factor | 54 ----------
extra/builder/report/report.factor | 35 ------
extra/builder/test/test.factor | 35 ------
extra/builder/updates/updates.factor | 31 ------
extra/builder/util/util.factor | 106 -------------------
15 files changed, 665 deletions(-)
delete mode 100644 extra/builder/build/build.factor
delete mode 100644 extra/builder/builder.factor
delete mode 100644 extra/builder/child/child.factor
delete mode 100644 extra/builder/cleanup/cleanup.factor
delete mode 100644 extra/builder/common/common.factor
delete mode 100644 extra/builder/email/email.factor
delete mode 100644 extra/builder/release/archive/archive.factor
delete mode 100644 extra/builder/release/branch/branch.factor
delete mode 100644 extra/builder/release/release.factor
delete mode 100644 extra/builder/release/tidy/tidy.factor
delete mode 100644 extra/builder/release/upload/upload.factor
delete mode 100644 extra/builder/report/report.factor
delete mode 100644 extra/builder/test/test.factor
delete mode 100644 extra/builder/updates/updates.factor
delete mode 100644 extra/builder/util/util.factor
diff --git a/extra/builder/build/build.factor b/extra/builder/build/build.factor
deleted file mode 100644
index e9f58980ea..0000000000
--- a/extra/builder/build/build.factor
+++ /dev/null
@@ -1,46 +0,0 @@
-
-USING: io.files io.launcher io.encodings.utf8 prettyprint
- builder.util builder.common builder.child builder.release
- builder.report builder.email builder.cleanup ;
-
-IN: builder.build
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: create-build-dir ( -- )
- datestamp >stamp
- build-dir make-directory ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: enter-build-dir ( -- ) build-dir set-current-directory ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: clone-builds-factor ( -- )
- { "git" "clone" builds/factor } to-strings try-process ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: record-id ( -- )
- "factor"
- [ git-id "../git-id" utf8 [ . ] with-file-writer ]
- with-directory ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: build ( -- )
- reset-status
- create-build-dir
- enter-build-dir
- clone-builds-factor
- record-id
- build-child
- release
- report
- email-report
- cleanup ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-MAIN: build
\ No newline at end of file
diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor
deleted file mode 100644
index 29daa8160b..0000000000
--- a/extra/builder/builder.factor
+++ /dev/null
@@ -1,21 +0,0 @@
-
-USING: kernel debugger io.files threads calendar
- builder.common
- builder.updates
- builder.build ;
-
-IN: builder
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: build-loop ( -- )
- builds-check
- [
- builds/factor set-current-directory
- new-code-available? [ build ] when
- ]
- try
- 5 minutes sleep
- build-loop ;
-
-MAIN: build-loop
\ No newline at end of file
diff --git a/extra/builder/child/child.factor b/extra/builder/child/child.factor
deleted file mode 100644
index 0f701dfdd7..0000000000
--- a/extra/builder/child/child.factor
+++ /dev/null
@@ -1,68 +0,0 @@
-
-USING: namespaces debugger io.files io.launcher accessors bootstrap.image
- calendar builder.util builder.common ;
-
-IN: builder.child
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: make-clean ( -- ) { gnu-make "clean" } to-strings try-process ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: make-vm ( -- )
- <process>
- gnu-make >>command
- "../compile-log" >>stdout
- +stdout+ >>stderr
- try-process ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: builds-factor-image ( -- img ) builds/factor my-boot-image-name append-path ;
-
-: copy-image ( -- )
- builds-factor-image ".." copy-file-into
- builds-factor-image "." copy-file-into ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: boot-cmd ( -- cmd )
- { "./factor" { "-i=" my-boot-image-name } "-no-user-init" } to-strings ;
-
-: boot ( -- )
- <process>
- boot-cmd >>command
- +closed+ >>stdin
- "../boot-log" >>stdout
- +stdout+ >>stderr
- 60 minutes >>timeout
- try-process ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: test-cmd ( -- cmd ) { "./factor" "-run=builder.test" } ;
-
-: test ( -- )
- <process>
- test-cmd >>command
- +closed+ >>stdin
- "../test-log" >>stdout
- +stdout+ >>stderr
- 240 minutes >>timeout
- try-process ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: (build-child) ( -- )
- make-clean
- make-vm status-vm on
- copy-image
- boot status-boot on
- test status-test on
- status on ;
-
-: build-child ( -- )
- "factor" set-current-directory
- [ (build-child) ] try
- ".." set-current-directory ;
\ No newline at end of file
diff --git a/extra/builder/cleanup/cleanup.factor b/extra/builder/cleanup/cleanup.factor
deleted file mode 100644
index e601506fb4..0000000000
--- a/extra/builder/cleanup/cleanup.factor
+++ /dev/null
@@ -1,26 +0,0 @@
-
-USING: kernel namespaces io.files io.launcher bootstrap.image
- builder.util builder.common ;
-
-IN: builder.cleanup
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: builder-debug
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: compress-image ( -- ) { "bzip2" my-boot-image-name } to-strings try-process ;
-
-: delete-child-factor ( -- )
- build-dir [ { "rm" "-rf" "factor" } try-process ] with-directory ;
-
-: cleanup ( -- )
- builder-debug get f =
- [
- "test-log" delete-file
- delete-child-factor
- compress-image
- ]
- when ;
-
diff --git a/extra/builder/common/common.factor b/extra/builder/common/common.factor
deleted file mode 100644
index 474606e451..0000000000
--- a/extra/builder/common/common.factor
+++ /dev/null
@@ -1,54 +0,0 @@
-
-USING: kernel namespaces sequences splitting
- io io.files io.launcher io.encodings.utf8 prettyprint
- vars builder.util ;
-
-IN: builder.common
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: upload-to-factorcode
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: builds-dir
-
-: builds ( -- path )
- builds-dir get
- home "/builds" append
- or ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: stamp
-
-: builds/factor ( -- path ) builds "factor" append-path ;
-: build-dir ( -- path ) builds stamp> append-path ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: prepare-build-machine ( -- )
- builds make-directory
- builds
- [ { "git" "clone" "git://factorcode.org/git/factor.git" } try-process ]
- with-directory ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: builds-check ( -- ) builds exists? not [ prepare-build-machine ] when ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: status-vm
-SYMBOL: status-boot
-SYMBOL: status-test
-SYMBOL: status-build
-SYMBOL: status-release
-SYMBOL: status
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: reset-status ( -- )
- { status-vm status-boot status-test status-build status-release status }
- [ off ]
- each ;
diff --git a/extra/builder/email/email.factor b/extra/builder/email/email.factor
deleted file mode 100644
index ecde47f8f7..0000000000
--- a/extra/builder/email/email.factor
+++ /dev/null
@@ -1,24 +0,0 @@
-
-USING: kernel namespaces accessors smtp builder.util builder.common ;
-
-IN: builder.email
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: builder-from
-SYMBOL: builder-recipients
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: subject-status ( -- str ) status get [ "report" ] [ "error" ] if ;
-
-: subject ( -- str ) { "builder@" host-name* ": " subject-status } to-string ;
-
-: email-report ( -- )
- <email>
- builder-from get >>from
- builder-recipients get >>to
- subject >>subject
- "report" file>string >>body
- send-email ;
-
diff --git a/extra/builder/release/archive/archive.factor b/extra/builder/release/archive/archive.factor
deleted file mode 100644
index 25153436e6..0000000000
--- a/extra/builder/release/archive/archive.factor
+++ /dev/null
@@ -1,69 +0,0 @@
-
-USING: kernel combinators system sequences io.files io.launcher prettyprint
- builder.util
- builder.common ;
-
-IN: builder.release.archive
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: base-name ( -- string )
- { "factor" [ os unparse ] cpu- stamp> } to-strings "-" join ;
-
-: extension ( -- extension )
- {
- { [ os winnt? ] [ ".zip" ] }
- { [ os macosx? ] [ ".dmg" ] }
- { [ os unix? ] [ ".tar.gz" ] }
- }
- cond ;
-
-: archive-name ( -- string ) base-name extension append ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: windows-archive-cmd ( -- cmd ) { "zip" "-r" archive-name "factor" } ;
-
-! : macosx-archive-cmd ( -- cmd )
-! { "hdiutil" "create"
-! "-srcfolder" "factor"
-! "-fs" "HFS+"
-! "-volname" "factor"
-! archive-name } ;
-
-: macosx-archive-cmd ( -- cmd )
- { "mkdir" "dmg-root" } try-process
- { "cp" "-r" "factor" "dmg-root" } try-process
- { "hdiutil" "create"
- "-srcfolder" "dmg-root"
- "-fs" "HFS+"
- "-volname" "factor"
- archive-name } to-strings try-process
- { "rm" "-rf" "dmg-root" } try-process
- { "true" } ;
-
-: unix-archive-cmd ( -- cmd ) { "tar" "-cvzf" archive-name "factor" } ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: archive-cmd ( -- cmd )
- {
- { [ os windows? ] [ windows-archive-cmd ] }
- { [ os macosx? ] [ macosx-archive-cmd ] }
- { [ os unix? ] [ unix-archive-cmd ] }
- }
- cond ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: make-archive ( -- ) archive-cmd to-strings try-process ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: releases ( -- path )
- builds "releases" append-path
- dup exists? not
- [ dup make-directory ]
- when ;
-
-: save-archive ( -- ) archive-name releases move-file-into ;
\ No newline at end of file
diff --git a/extra/builder/release/branch/branch.factor b/extra/builder/release/branch/branch.factor
deleted file mode 100644
index 6b1266bb45..0000000000
--- a/extra/builder/release/branch/branch.factor
+++ /dev/null
@@ -1,40 +0,0 @@
-
-USING: kernel system namespaces sequences prettyprint io.files io.launcher
- bootstrap.image
- builder.util
- builder.common ;
-
-IN: builder.release.branch
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: branch-name ( -- string ) "clean-" platform append ;
-
-: refspec ( -- string ) "master:" branch-name append ;
-
-: push-to-clean-branch ( -- )
- { "git" "push" "factorcode.org:/git/factor.git" refspec }
- to-strings
- try-process ;
-
-: upload-clean-image ( -- )
- {
- "scp"
- my-boot-image-name
- { "factorcode.org:/var/www/factorcode.org/newsite/images/clean/" platform }
- }
- to-strings
- try-process ;
-
-: (update-clean-branch) ( -- )
- "factor"
- [
- push-to-clean-branch
- upload-clean-image
- ]
- with-directory ;
-
-: update-clean-branch ( -- )
- upload-to-factorcode get
- [ (update-clean-branch) ]
- when ;
diff --git a/extra/builder/release/release.factor b/extra/builder/release/release.factor
deleted file mode 100644
index 28ce3e8b35..0000000000
--- a/extra/builder/release/release.factor
+++ /dev/null
@@ -1,27 +0,0 @@
-
-USING: kernel debugger system namespaces sequences splitting combinators
- io io.files io.launcher prettyprint bootstrap.image
- combinators.cleave
- builder.util
- builder.common
- builder.release.branch
- builder.release.tidy
- builder.release.archive
- builder.release.upload ;
-
-IN: builder.release
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: (release) ( -- )
- update-clean-branch
- tidy
- make-archive
- upload
- save-archive
- status-release on ;
-
-: clean-build? ( -- ? )
- { "load-everything-vocabs" "test-all-vocabs" } [ eval-file empty? ] all? ;
-
-: release ( -- ) [ clean-build? [ (release) ] when ] try ;
\ No newline at end of file
diff --git a/extra/builder/release/tidy/tidy.factor b/extra/builder/release/tidy/tidy.factor
deleted file mode 100644
index f8f27e75f2..0000000000
--- a/extra/builder/release/tidy/tidy.factor
+++ /dev/null
@@ -1,29 +0,0 @@
-
-USING: kernel system io.files io.launcher builder.util ;
-
-IN: builder.release.tidy
-
-: common-files ( -- seq )
- {
- "boot.x86.32.image"
- "boot.x86.64.image"
- "boot.macosx-ppc.image"
- "boot.linux-ppc.image"
- "vm"
- "temp"
- "logs"
- ".git"
- ".gitignore"
- "Makefile"
- "unmaintained"
- "build-support"
- } ;
-
-: remove-common-files ( -- )
- { "rm" "-rf" common-files } to-strings try-process ;
-
-: remove-factor-app ( -- )
- os macosx? not [ { "rm" "-rf" "Factor.app" } try-process ] when ;
-
-: tidy ( -- )
- "factor" [ remove-factor-app remove-common-files ] with-directory ;
diff --git a/extra/builder/release/upload/upload.factor b/extra/builder/release/upload/upload.factor
deleted file mode 100644
index 19d3936fd9..0000000000
--- a/extra/builder/release/upload/upload.factor
+++ /dev/null
@@ -1,54 +0,0 @@
-
-USING: kernel namespaces make sequences arrays io io.files
- builder.util
- builder.common
- builder.release.archive ;
-
-IN: builder.release.upload
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: upload-host
-
-SYMBOL: upload-username
-
-SYMBOL: upload-directory
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: remote-location ( -- dest )
- upload-directory get platform append ;
-
-: remote-archive-name ( -- dest )
- remote-location "/" archive-name 3append ;
-
-: temp-archive-name ( -- dest )
- remote-archive-name ".incomplete" append ;
-
-: upload-command ( -- args )
- "scp"
- archive-name
- [ upload-username get % "@" % upload-host get % ":" % temp-archive-name % ] "" make
- 3array ;
-
-: rename-command ( -- args )
- [
- "ssh" ,
- upload-host get ,
- "-l" ,
- upload-username get ,
- "mv" ,
- temp-archive-name ,
- remote-archive-name ,
- ] { } make ;
-
-: upload-temp-file ( -- )
- upload-command [ "Error uploading binary to factorcode" print ] run-or-bail ;
-
-: rename-temp-file ( -- )
- rename-command [ "Error renaming binary on factorcode" print ] run-or-bail ;
-
-: upload ( -- )
- upload-to-factorcode get
- [ upload-temp-file rename-temp-file ]
- when ;
diff --git a/extra/builder/report/report.factor b/extra/builder/report/report.factor
deleted file mode 100644
index 2ac8482a76..0000000000
--- a/extra/builder/report/report.factor
+++ /dev/null
@@ -1,35 +0,0 @@
-
-USING: kernel namespaces debugger system io io.files io.sockets
- io.encodings.utf8 prettyprint benchmark
- builder.util builder.common ;
-
-IN: builder.report
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: (report) ( -- )
-
- "Build machine: " write host-name print
- "CPU: " write cpu .
- "OS: " write os .
- "Build directory: " write build-dir print
- "git id: " write "git-id" eval-file print nl
-
- status-vm get f = [ "compile-log" cat "vm compile error" throw ] when
- status-boot get f = [ "boot-log" 100 cat-n "Boot error" throw ] when
- status-test get f = [ "test-log" 100 cat-n "Test error" throw ] when
-
- "Boot time: " write "boot-time" eval-file milli-seconds>time print
- "Load time: " write "load-time" eval-file milli-seconds>time print
- "Test time: " write "test-time" eval-file milli-seconds>time print nl
-
- "Did not pass load-everything: " print "load-everything-vocabs" cat
-
- "Did not pass test-all: " print "test-all-vocabs" cat
- "test-failures" cat
-
- "help-lint results:" print "help-lint" cat
-
- "Benchmarks: " print "benchmarks" eval-file benchmarks. ;
-
-: report ( -- ) "report" utf8 [ [ (report) ] try ] with-file-writer ;
\ No newline at end of file
diff --git a/extra/builder/test/test.factor b/extra/builder/test/test.factor
deleted file mode 100644
index 2a0769f278..0000000000
--- a/extra/builder/test/test.factor
+++ /dev/null
@@ -1,35 +0,0 @@
-
-USING: kernel namespaces assocs
- io.files io.encodings.utf8 prettyprint
- help.lint
- benchmark
- tools.time
- bootstrap.stage2
- tools.test tools.vocabs
- builder.util ;
-
-IN: builder.test
-
-: do-load ( -- )
- try-everything keys "../load-everything-vocabs" utf8 [ . ] with-file-writer ;
-
-: do-tests ( -- )
- run-all-tests
- [ keys "../test-all-vocabs" utf8 [ . ] with-file-writer ]
- [ "../test-failures" utf8 [ test-failures. ] with-file-writer ]
- bi ;
-
-: do-help-lint ( -- )
- "" run-help-lint "../help-lint" utf8 [ typos. ] with-file-writer ;
-
-: do-benchmarks ( -- )
- run-benchmarks "../benchmarks" utf8 [ . ] with-file-writer ;
-
-: do-all ( -- )
- bootstrap-time get "../boot-time" utf8 [ . ] with-file-writer
- [ do-load ] benchmark "../load-time" utf8 [ . ] with-file-writer
- [ do-tests ] benchmark "../test-time" utf8 [ . ] with-file-writer
- do-help-lint
- do-benchmarks ;
-
-MAIN: do-all
\ No newline at end of file
diff --git a/extra/builder/updates/updates.factor b/extra/builder/updates/updates.factor
deleted file mode 100644
index a8184550e0..0000000000
--- a/extra/builder/updates/updates.factor
+++ /dev/null
@@ -1,31 +0,0 @@
-
-USING: kernel io.launcher bootstrap.image bootstrap.image.download
- builder.util builder.common ;
-
-IN: builder.updates
-
-: git-pull-cmd ( -- cmd )
- {
- "git"
- "pull"
- "--no-summary"
- "git://factorcode.org/git/factor.git"
- "master"
- } ;
-
-: updates-available? ( -- ? )
- git-id
- git-pull-cmd try-process
- git-id
- = not ;
-
-: new-image-available? ( -- ? )
- my-boot-image-name need-new-image?
- [ download-my-image t ]
- [ f ]
- if ;
-
-: new-code-available? ( -- ? )
- updates-available?
- new-image-available?
- or ;
\ No newline at end of file
diff --git a/extra/builder/util/util.factor b/extra/builder/util/util.factor
deleted file mode 100644
index 32d1e45066..0000000000
--- a/extra/builder/util/util.factor
+++ /dev/null
@@ -1,106 +0,0 @@
-
-USING: kernel words namespaces classes parser continuations
- io io.files io.launcher io.sockets
- math math.parser
- system
- combinators sequences splitting quotations arrays strings tools.time
- sequences.deep accessors assocs.lib
- io.encodings.utf8
- combinators.cleave calendar calendar.format eval ;
-
-IN: builder.util
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: minutes>ms ( min -- ms ) 60 * 1000 * ;
-
-: file>string ( file -- string ) utf8 file-contents ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-DEFER: to-strings
-
-: to-string ( obj -- str )
- dup class
- {
- { \ string [ ] }
- { \ quotation [ call ] }
- { \ word [ execute ] }
- { \ fixnum [ number>string ] }
- { \ array [ to-strings concat ] }
- }
- case ;
-
-: to-strings ( seq -- str )
- dup [ string? ] all?
- [ ]
- [ [ to-string ] map flatten ]
- if ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: host-name* ( -- name ) host-name "." split first ;
-
-: datestamp ( -- string )
- now
- { year>> month>> day>> hour>> minute>> } <arr>
- [ pad-00 ] map "-" join ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: milli-seconds>time ( n -- string )
- 1000 /i 60 /mod >r 60 /mod r> 3array [ pad-00 ] map ":" join ;
-
-: eval-file ( file -- obj ) utf8 file-contents eval ;
-
-: cat ( file -- ) utf8 file-contents print ;
-
-: run-or-bail ( desc quot -- )
- [ [ try-process ] curry ]
- [ [ throw ] compose ]
- bi*
- recover ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-USING: bootstrap.image bootstrap.image.download io.streams.null ;
-
-: retrieve-image ( -- ) [ my-arch download-image ] with-null-stream ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: longer? ( seq seq -- ? ) [ length ] bi@ > ;
-
-: maybe-tail* ( seq n -- seq )
- 2dup longer?
- [ tail* ]
- [ drop ]
- if ;
-
-: cat-n ( file n -- )
- [ utf8 file-lines ] [ ] bi*
- maybe-tail*
- [ print ] each ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-USE: prettyprint
-
-: to-file ( object file -- ) utf8 [ . ] with-file-writer ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: cpu- ( -- cpu ) cpu unparse "." split "-" join ;
-
-: platform ( -- string ) { [ os unparse ] cpu- } to-strings "-" join ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: gnu-make ( -- string )
- os { freebsd openbsd netbsd } member? [ "gmake" ] [ "make" ] if ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: git-id ( -- id )
- { "git" "show" } utf8 <process-reader> [ readln ] with-input-stream
- " " split second ;
From 33a082c361e890874097ac9dfdf6e4d459c23bad Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 10 Nov 2008 02:43:16 -0600
Subject: [PATCH 07/16] Fix reference to obsolete G: word
---
core/generic/standard/standard-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/core/generic/standard/standard-docs.factor b/core/generic/standard/standard-docs.factor
index 1d98dec87c..15913b46be 100644
--- a/core/generic/standard/standard-docs.factor
+++ b/core/generic/standard/standard-docs.factor
@@ -16,7 +16,7 @@ HELP: standard-combination
{ $examples
"A generic word for append strings and characters to a sequence, dispatching on the object underneath the top of the stack:"
{ $code
- "G: build-string 1 standard-combination ;"
+ "GENERIC# build-string 1 ( elt str -- )"
"M: string build-string swap push-all ;"
"M: integer build-string push ;"
}
From 5b7d40d9b48f7abd19949db6391466f37d59b0c2 Mon Sep 17 00:00:00 2001
From: sheeple <sheeple@oberon.local>
Date: Mon, 10 Nov 2008 02:58:05 -0600
Subject: [PATCH 08/16] We need to end the basic block after the ##prologue in
the dispatch branch so that the GC check can go after the prologue
---
basis/compiler/cfg/builder/builder.factor | 1 +
basis/compiler/tests/templates.factor | 11 +++++++++++
2 files changed, 12 insertions(+)
diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor
index 93daa601fe..17a5942af2 100755
--- a/basis/compiler/cfg/builder/builder.factor
+++ b/basis/compiler/cfg/builder/builder.factor
@@ -171,6 +171,7 @@ M: #if emit-node
[
V{ } clone node-stack set
##prologue
+ begin-basic-block
emit-nodes
basic-block get [
##epilogue
diff --git a/basis/compiler/tests/templates.factor b/basis/compiler/tests/templates.factor
index de87ad8c00..0a109a15eb 100644
--- a/basis/compiler/tests/templates.factor
+++ b/basis/compiler/tests/templates.factor
@@ -219,3 +219,14 @@ TUPLE: my-tuple ;
: bad-value-bug ( a -- b ) [ 3 ] [ 3 ] if f <array> ;
[ { f f f } ] [ t bad-value-bug ] unit-test
+
+! PowerPC regression
+TUPLE: id obj ;
+
+: (gc-check-bug) ( a b -- c )
+ { [ id boa ] [ id boa ] } dispatch ;
+
+: gc-check-bug ( -- )
+ 10000000 [ "hi" 0 (gc-check-bug) drop ] times ;
+
+[ ] [ gc-check-bug ] unit-test
From ffe4bd6787125f6d94785510a480fc1d57e43067 Mon Sep 17 00:00:00 2001
From: sheeple <sheeple@oberon.local>
Date: Mon, 10 Nov 2008 03:18:58 -0600
Subject: [PATCH 09/16] Various updates
---
basis/cpu/ppc/ppc.factor | 100 +++++++++++++++++++++------------------
1 file changed, 53 insertions(+), 47 deletions(-)
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 2be46d15ee..49caae4bb8 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -4,7 +4,8 @@ USING: accessors assocs sequences kernel combinators make math
math.order math.ranges system namespaces locals layouts words
alien alien.c-types cpu.architecture cpu.ppc.assembler
compiler.cfg.registers compiler.cfg.instructions
-compiler.constants compiler.codegen compiler.codegen.fixup ;
+compiler.constants compiler.codegen compiler.codegen.fixup
+compiler.cfg.intrinsics compiler.cfg.stack-frame ;
IN: cpu.ppc
! PowerPC register assignments:
@@ -15,15 +16,19 @@ IN: cpu.ppc
! f0-f29: float vregs
! f30, f31: float scratch
+enable-float-intrinsics
+
+<< \ ##integer>float t frame-required? set-word-prop
+\ ##float>integer t frame-required? set-word-prop >>
+
M: ppc machine-registers
{
{ int-regs T{ range f 2 26 1 } }
- { double-float-regs T{ range f 0 28 1 } }
+ { double-float-regs T{ range f 0 29 1 } }
} ;
: scratch-reg 28 ; inline
-: fp-scratch-reg-1 29 ; inline
-: fp-scratch-reg-2 30 ; inline
+: fp-scratch-reg 30 ; inline
M: ppc two-operand? f ;
@@ -54,8 +59,16 @@ M: ppc %inc-d ( n -- ) ds-reg (%inc) ;
M: ppc %inc-r ( n -- ) rs-reg (%inc) ;
HOOK: reserved-area-size os ( -- n )
-HOOK: lr-save os ( -- n )
+! The start of the stack frame contains the size of this frame
+! as well as the currently executing XT
+: factor-area-size ( -- n ) 2 cells ; foldable
+: next-save ( n -- i ) cell - ;
+: xt-save ( n -- i ) 2 cells - ;
+
+! Next, we have the spill area as well as the FFI parameter area.
+! They overlap, since basic blocks with FFI calls will never
+! spill.
: param@ ( n -- x ) reserved-area-size + ; inline
: param-save-size ( -- n ) 8 cells ; foldable
@@ -63,19 +76,34 @@ HOOK: lr-save os ( -- n )
: local@ ( n -- x )
reserved-area-size param-save-size + + ; inline
-: factor-area-size ( -- n ) 2 cells ; foldable
+: spill-integer-base ( -- n )
+ stack-frame get spill-counts>> double-float-regs swap at
+ double-float-regs reg-size * ;
-: next-save ( n -- i ) cell - ;
+: spill-integer@ ( n -- offset )
+ cells spill-integer-base + param@ ;
-: xt-save ( n -- i ) 2 cells - ;
+: spill-float@ ( n -- offset )
+ double-float-regs reg-size * param@ ;
+
+! Some FP intrinsics need a temporary scratch area in the stack
+! frame, 8 bytes in size
+: scratch@ ( n -- offset )
+ stack-frame get total-size>>
+ factor-area-size -
+ param-save-size -
+ + ;
+
+! Finally we have the linkage area
+HOOK: lr-save os ( -- n )
M: ppc stack-frame-size ( stack-frame -- i )
[ spill-counts>> [ swap reg-size * ] { } assoc>map sum ]
[ params>> ]
[ return>> ]
tri + +
- reserved-area-size +
param-save-size +
+ reserved-area-size +
factor-area-size +
4 cells align ;
@@ -198,19 +226,19 @@ M: ppc %div-float FDIV ;
M:: ppc %integer>float ( dst src -- )
HEX: 4330 scratch-reg LIS
- scratch-reg 1 0 param@ STW
+ scratch-reg 1 0 scratch@ STW
scratch-reg src MR
scratch-reg dup HEX: 8000 XORIS
- scratch-reg 1 cell param@ STW
- fp-scratch-reg-2 1 0 param@ LFD
+ scratch-reg 1 4 scratch@ STW
+ dst 1 0 scratch@ LFD
scratch-reg 4503601774854144.0 %load-indirect
- fp-scratch-reg-2 scratch-reg float-offset LFD
- fp-scratch-reg-2 fp-scratch-reg-2 fp-scratch-reg-2 FSUB ;
+ fp-scratch-reg scratch-reg float-offset LFD
+ dst dst fp-scratch-reg FSUB ;
M:: ppc %float>integer ( dst src -- )
- fp-scratch-reg-1 src FCTIWZ
- fp-scratch-reg-2 1 0 param@ STFD
- dst 1 4 param@ LWZ ;
+ fp-scratch-reg src FCTIWZ
+ fp-scratch-reg 1 0 scratch@ STFD
+ dst 1 4 scratch@ LWZ ;
M: ppc %copy ( dst src -- ) MR ;
@@ -218,6 +246,10 @@ M: ppc %copy-float ( dst src -- ) FMR ;
M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
+M:: ppc %box-float ( dst src temp -- )
+ dst 16 float temp %allot
+ src dst float-offset STFD ;
+
M:: ppc %unbox-any-c-ptr ( dst src temp -- )
[
{ "is-byte-array" "end" "start" } [ define-label ] each
@@ -349,11 +381,6 @@ M: ppc %gc
"end" resolve-label ;
M: ppc %prologue ( n -- )
- #! We use a volatile register (r11) here for scratch. Because
- #! callback bodies have a prologue too, we cannot assume
- #! that c_to_factor saved all non-volatile registers, so
- #! we have to respect the C calling convention. Also, we
- #! cannot touch any param-regs either.
0 11 LOAD32 rc-absolute-ppc-2/2 rel-this
0 MFLR
1 1 pick neg ADDI
@@ -410,32 +437,11 @@ M: ppc %compare-branch (%compare) %branch ;
M: ppc %compare-imm-branch (%compare-imm) %branch ;
M: ppc %compare-float-branch (%compare-float) %branch ;
-: spill-integer-base ( stack-frame -- n )
- [ params>> ] [ return>> ] bi + ;
+M: ppc %spill-integer ( src n -- ) spill-integer@ 1 swap STW ;
+M: ppc %reload-integer ( dst n -- ) spill-integer@ 1 swap LWZ ;
-: stack@ 1 swap ; inline
-
-: spill-integer@ ( n -- reg offset )
- cells
- stack-frame get spill-integer-base
- + stack@ ;
-
-: spill-float-base ( stack-frame -- n )
- [ spill-counts>> int-regs swap at int-regs reg-size * ]
- [ params>> ]
- [ return>> ]
- tri + + ;
-
-: spill-float@ ( n -- reg offset )
- double-float-regs reg-size *
- stack-frame get spill-float-base
- + stack@ ;
-
-M: ppc %spill-integer ( src n -- ) spill-integer@ STW ;
-M: ppc %reload-integer ( dst n -- ) spill-integer@ LWZ ;
-
-M: ppc %spill-float ( src n -- ) spill-float@ STFD ;
-M: ppc %reload-float ( dst n -- ) spill-float@ LFD ;
+M: ppc %spill-float ( src n -- ) spill-float@ 1 swap STFD ;
+M: ppc %reload-float ( dst n -- ) spill-float@ 1 swap LFD ;
M: ppc %loop-entry ;
From 17be33fb013b2fd94f7d4efe7dac5ca7f39bc835 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 10 Nov 2008 03:35:21 -0600
Subject: [PATCH 10/16] ui.gadgets.labelled: Simplify '<title-bar>'
---
basis/ui/gadgets/labelled/labelled.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/ui/gadgets/labelled/labelled.factor b/basis/ui/gadgets/labelled/labelled.factor
index 8cf13c8367..37b1d251e8 100644
--- a/basis/ui/gadgets/labelled/labelled.factor
+++ b/basis/ui/gadgets/labelled/labelled.factor
@@ -39,7 +39,7 @@ M: labelled-gadget focusable-child* content>> ;
: <title-bar> ( title quot -- gadget )
<frame>
- swap dup [ <close-box> @left grid-add ] [ drop ] if
+ swap [ <close-box> @left grid-add ] when*
swap <title-label> @center grid-add ;
TUPLE: closable-gadget < frame content ;
From eeb53283d4c1ec4ed86b9b2d2ca53315a45d4ccf Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 10 Nov 2008 05:07:25 -0600
Subject: [PATCH 11/16] Update code for builder removal
---
basis/tools/test/test-docs.factor | 2 +-
{extra => unmaintained}/size-of/size-of.factor | 0
{extra => unmaintained}/update/backup/backup.factor | 0
{extra => unmaintained}/update/latest/latest.factor | 0
{extra => unmaintained}/update/update.factor | 0
5 files changed, 1 insertion(+), 1 deletion(-)
rename {extra => unmaintained}/size-of/size-of.factor (100%)
rename {extra => unmaintained}/update/backup/backup.factor (100%)
rename {extra => unmaintained}/update/latest/latest.factor (100%)
rename {extra => unmaintained}/update/update.factor (100%)
diff --git a/basis/tools/test/test-docs.factor b/basis/tools/test/test-docs.factor
index 4b2521d19c..02c0ad126d 100644
--- a/basis/tools/test/test-docs.factor
+++ b/basis/tools/test/test-docs.factor
@@ -17,7 +17,7 @@ ARTICLE: "tools.test.run" "Running unit tests"
{ $subsection test-all } ;
ARTICLE: "tools.test.failure" "Handling test failures"
-"Most of the time the words documented in " { $link "tools.test.run" } " are used because they print all test failures in human-readable form. Sometimes, you want to develop a tool which inspects the test failures and takes some kind of action instead; one example is " { $vocab-link "builder" } "."
+"Most of the time the words documented in " { $link "tools.test.run" } " are used because they print all test failures in human-readable form. Some tools inspect the test failures and takes some kind of action instead, for example, " { $vocab-link "mason" } "."
$nl
"The following words output an association list mapping vocabulary names to sequences of failures; a failure is an array having the shape " { $snippet "{ error test continuation }" } ", and the elements are as follows:"
{ $list
diff --git a/extra/size-of/size-of.factor b/unmaintained/size-of/size-of.factor
similarity index 100%
rename from extra/size-of/size-of.factor
rename to unmaintained/size-of/size-of.factor
diff --git a/extra/update/backup/backup.factor b/unmaintained/update/backup/backup.factor
similarity index 100%
rename from extra/update/backup/backup.factor
rename to unmaintained/update/backup/backup.factor
diff --git a/extra/update/latest/latest.factor b/unmaintained/update/latest/latest.factor
similarity index 100%
rename from extra/update/latest/latest.factor
rename to unmaintained/update/latest/latest.factor
diff --git a/extra/update/update.factor b/unmaintained/update/update.factor
similarity index 100%
rename from extra/update/update.factor
rename to unmaintained/update/update.factor
From d8a3439bc24a4aab986c826376eeb50f6ee4b2da Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 10 Nov 2008 05:08:30 -0600
Subject: [PATCH 12/16] Fix indentation
---
basis/ui/gadgets/scrollers/scrollers.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/ui/gadgets/scrollers/scrollers.factor b/basis/ui/gadgets/scrollers/scrollers.factor
index 8c63e15a4d..d1429c4006 100644
--- a/basis/ui/gadgets/scrollers/scrollers.factor
+++ b/basis/ui/gadgets/scrollers/scrollers.factor
@@ -73,7 +73,7 @@ scroller H{
: find-scroller* ( gadget -- scroller/f )
dup find-scroller
- { [ nip ] [ viewport>> gadget-child swap child? ] [ nip ] }
+ { [ nip ] [ viewport>> gadget-child swap child? ] [ nip ] }
2&& ;
: scroll>rect ( rect gadget -- )
From 262e9632e624edd68a9a444d8effe7aef1658ccf Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 10 Nov 2008 19:17:41 -0600
Subject: [PATCH 13/16] Remove 'unmaintained/update' (moving back to 'extra')
---
unmaintained/update/backup/backup.factor | 28 -----------
unmaintained/update/latest/latest.factor | 53 --------------------
unmaintained/update/update.factor | 64 ------------------------
3 files changed, 145 deletions(-)
delete mode 100644 unmaintained/update/backup/backup.factor
delete mode 100644 unmaintained/update/latest/latest.factor
delete mode 100644 unmaintained/update/update.factor
diff --git a/unmaintained/update/backup/backup.factor b/unmaintained/update/backup/backup.factor
deleted file mode 100644
index 0dcf853b98..0000000000
--- a/unmaintained/update/backup/backup.factor
+++ /dev/null
@@ -1,28 +0,0 @@
-
-USING: namespaces debugger io.files bootstrap.image builder.util ;
-
-IN: update.backup
-
-: backup-boot-image ( -- )
- my-boot-image-name
- { "boot." my-arch "-" [ "datestamp" get ] ".image" } to-string
- move-file ;
-
-: backup-image ( -- )
- "factor.image"
- { "factor" "-" [ "datestamp" get ] ".image" } to-string
- move-file ;
-
-: backup-vm ( -- )
- "factor"
- { "factor" "-" [ "datestamp" get ] } to-string
- move-file ;
-
-: backup ( -- )
- datestamp "datestamp" set
- [
- backup-boot-image
- backup-image
- backup-vm
- ]
- try ;
diff --git a/unmaintained/update/latest/latest.factor b/unmaintained/update/latest/latest.factor
deleted file mode 100644
index df057422f9..0000000000
--- a/unmaintained/update/latest/latest.factor
+++ /dev/null
@@ -1,53 +0,0 @@
-
-USING: kernel namespaces system io.files bootstrap.image http.client
- builder.util update update.backup ;
-
-IN: update.latest
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: git-pull-master ( -- )
- image parent-directory
- [
- { "git" "pull" "git://factorcode.org/git/factor.git" "master" }
- run-command
- ]
- with-directory ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: remote-latest-image ( -- url )
- { "http://factorcode.org/images/latest/" my-boot-image-name } to-string ;
-
-: download-latest-image ( -- ) remote-latest-image download ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: rebuild-latest ( -- )
- image parent-directory
- [
- backup
- download-latest-image
- make-clean
- make
- boot
- ]
- with-directory ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: update-latest ( -- )
- image parent-directory
- [
- git-id
- git-pull-master
- git-id
- = not
- [ rebuild-latest ]
- when
- ]
- with-directory ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-MAIN: update-latest
\ No newline at end of file
diff --git a/unmaintained/update/update.factor b/unmaintained/update/update.factor
deleted file mode 100644
index 1d25a9792e..0000000000
--- a/unmaintained/update/update.factor
+++ /dev/null
@@ -1,64 +0,0 @@
-
-USING: kernel system sequences io.files io.launcher bootstrap.image
- http.client
- builder.util builder.release.branch ;
-
-IN: update
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: run-command ( cmd -- ) to-strings try-process ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: git-pull-clean ( -- )
- image parent-directory
- [
- { "git" "pull" "git://factorcode.org/git/factor.git" branch-name }
- run-command
- ]
- with-directory ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: remote-clean-image ( -- url )
- { "http://factorcode.org/images/clean/" platform "/" my-boot-image-name }
- to-string ;
-
-: download-clean-image ( -- ) remote-clean-image download ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: make-clean ( -- ) { gnu-make "clean" } run-command ;
-: make ( -- ) { gnu-make } run-command ;
-: boot ( -- ) { "./factor" { "-i=" my-boot-image-name } } run-command ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: rebuild ( -- )
- image parent-directory
- [
- download-clean-image
- make-clean
- make
- boot
- ]
- with-directory ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: update ( -- )
- image parent-directory
- [
- git-id
- git-pull-clean
- git-id
- = not
- [ rebuild ]
- when
- ]
- with-directory ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-MAIN: update
\ No newline at end of file
From 7104cd4fe8e63f89495f5f25e3f748690c87f903 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 10 Nov 2008 19:20:08 -0600
Subject: [PATCH 14/16] Fix 'extra/update'
---
extra/update/backup/backup.factor | 28 +++++++++++++
extra/update/latest/latest.factor | 53 +++++++++++++++++++++++++
extra/update/update.factor | 66 +++++++++++++++++++++++++++++++
extra/update/util/util.factor | 62 +++++++++++++++++++++++++++++
4 files changed, 209 insertions(+)
create mode 100644 extra/update/backup/backup.factor
create mode 100644 extra/update/latest/latest.factor
create mode 100644 extra/update/update.factor
create mode 100644 extra/update/util/util.factor
diff --git a/extra/update/backup/backup.factor b/extra/update/backup/backup.factor
new file mode 100644
index 0000000000..0c7b442ffa
--- /dev/null
+++ b/extra/update/backup/backup.factor
@@ -0,0 +1,28 @@
+
+USING: namespaces debugger io.files bootstrap.image update.util ;
+
+IN: update.backup
+
+: backup-boot-image ( -- )
+ my-boot-image-name
+ { "boot." my-arch "-" [ "datestamp" get ] ".image" } to-string
+ move-file ;
+
+: backup-image ( -- )
+ "factor.image"
+ { "factor" "-" [ "datestamp" get ] ".image" } to-string
+ move-file ;
+
+: backup-vm ( -- )
+ "factor"
+ { "factor" "-" [ "datestamp" get ] } to-string
+ move-file ;
+
+: backup ( -- )
+ datestamp "datestamp" set
+ [
+ backup-boot-image
+ backup-image
+ backup-vm
+ ]
+ try ;
diff --git a/extra/update/latest/latest.factor b/extra/update/latest/latest.factor
new file mode 100644
index 0000000000..7cc2fac853
--- /dev/null
+++ b/extra/update/latest/latest.factor
@@ -0,0 +1,53 @@
+
+USING: kernel namespaces system io.files bootstrap.image http.client
+ update update.backup update.util ;
+
+IN: update.latest
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: git-pull-master ( -- )
+ image parent-directory
+ [
+ { "git" "pull" "git://factorcode.org/git/factor.git" "master" }
+ run-command
+ ]
+ with-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: remote-latest-image ( -- url )
+ { "http://factorcode.org/images/latest/" my-boot-image-name } to-string ;
+
+: download-latest-image ( -- ) remote-latest-image download ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: rebuild-latest ( -- )
+ image parent-directory
+ [
+ backup
+ download-latest-image
+ make-clean
+ make
+ boot
+ ]
+ with-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: update-latest ( -- )
+ image parent-directory
+ [
+ git-id
+ git-pull-master
+ git-id
+ = not
+ [ rebuild-latest ]
+ when
+ ]
+ with-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+MAIN: update-latest
\ No newline at end of file
diff --git a/extra/update/update.factor b/extra/update/update.factor
new file mode 100644
index 0000000000..c6a5671345
--- /dev/null
+++ b/extra/update/update.factor
@@ -0,0 +1,66 @@
+
+USING: kernel system sequences io.files io.launcher bootstrap.image
+ http.client
+ update.util ;
+
+ ! builder.util builder.release.branch ;
+
+IN: update
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: run-command ( cmd -- ) to-strings try-process ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: git-pull-clean ( -- )
+ image parent-directory
+ [
+ { "git" "pull" "git://factorcode.org/git/factor.git" branch-name }
+ run-command
+ ]
+ with-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: remote-clean-image ( -- url )
+ { "http://factorcode.org/images/clean/" platform "/" my-boot-image-name }
+ to-string ;
+
+: download-clean-image ( -- ) remote-clean-image download ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: make-clean ( -- ) { gnu-make "clean" } run-command ;
+: make ( -- ) { gnu-make } run-command ;
+: boot ( -- ) { "./factor" { "-i=" my-boot-image-name } } run-command ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: rebuild ( -- )
+ image parent-directory
+ [
+ download-clean-image
+ make-clean
+ make
+ boot
+ ]
+ with-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: update ( -- )
+ image parent-directory
+ [
+ git-id
+ git-pull-clean
+ git-id
+ = not
+ [ rebuild ]
+ when
+ ]
+ with-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+MAIN: update
\ No newline at end of file
diff --git a/extra/update/util/util.factor b/extra/update/util/util.factor
new file mode 100644
index 0000000000..b638b61528
--- /dev/null
+++ b/extra/update/util/util.factor
@@ -0,0 +1,62 @@
+
+USING: kernel classes strings quotations words math math.parser arrays
+ combinators.cleave
+ accessors
+ system prettyprint splitting
+ sequences combinators sequences.deep
+ io
+ io.launcher
+ io.encodings.utf8
+ calendar
+ calendar.format ;
+
+IN: update.util
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+DEFER: to-strings
+
+: to-string ( obj -- str )
+ dup class
+ {
+ { \ string [ ] }
+ { \ quotation [ call ] }
+ { \ word [ execute ] }
+ { \ fixnum [ number>string ] }
+ { \ array [ to-strings concat ] }
+ }
+ case ;
+
+: to-strings ( seq -- str )
+ dup [ string? ] all?
+ [ ]
+ [ [ to-string ] map flatten ]
+ if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: cpu- ( -- cpu ) cpu unparse "." split "-" join ;
+
+: platform ( -- string ) { [ os unparse ] cpu- } to-strings "-" join ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: branch-name ( -- string ) "clean-" platform append ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: gnu-make ( -- string )
+ os { freebsd openbsd netbsd } member? [ "gmake" ] [ "make" ] if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: git-id ( -- id )
+ { "git" "show" } utf8 <process-reader> [ readln ] with-input-stream
+ " " split second ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: datestamp ( -- string )
+ now
+ { year>> month>> day>> hour>> minute>> } <arr>
+ [ pad-00 ] map "-" join ;
From 78d9452b7ef05851baee92363cbc34a71cc7bd43 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 10 Nov 2008 20:05:50 -0600
Subject: [PATCH 15/16] basis/bootstrap/stage2: Show core bootstrap time in
report
---
basis/bootstrap/stage2.factor | 17 ++++++++++++++---
1 file changed, 14 insertions(+), 3 deletions(-)
diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor
index 3b6c04329c..67c6c9487d 100644
--- a/basis/bootstrap/stage2.factor
+++ b/basis/bootstrap/stage2.factor
@@ -8,6 +8,8 @@ definitions assocs compiler.errors compiler.units
math.parser generic sets debugger command-line ;
IN: bootstrap.stage2
+SYMBOL: core-bootstrap-time
+
SYMBOL: bootstrap-time
: default-image-name ( -- string )
@@ -30,7 +32,14 @@ SYMBOL: bootstrap-time
: count-words ( pred -- )
all-words swap count number>string write ;
-: print-report ( time -- )
+: print-report ( -- )
+ core-bootstrap-time get
+ 1000 /i
+ 60 /mod swap
+ "Core bootstrap completed in " write number>string write
+ " minutes and " write number>string write " seconds." print
+
+ bootstrap-time get
1000 /i
60 /mod swap
"Bootstrap completed in " write number>string write
@@ -46,7 +55,7 @@ SYMBOL: bootstrap-time
[
! We time bootstrap
- millis >r
+ millis
default-image-name "output-image" set-global
@@ -71,6 +80,8 @@ SYMBOL: bootstrap-time
[
load-components
+ millis over - core-bootstrap-time set-global
+
run-bootstrap-init
] with-compiler-errors
:errors
@@ -92,7 +103,7 @@ SYMBOL: bootstrap-time
] [ print-error 1 exit ] recover
] set-boot-quot
- millis r> - dup bootstrap-time set-global
+ millis swap - bootstrap-time set-global
print-report
"output-image" get save-image-and-exit
From 2489ac5205997307e704168d9d8b373358820ef0 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 10 Nov 2008 21:27:48 -0600
Subject: [PATCH 16/16] bootstrap.stage2: Factor out 'print-time'
---
basis/bootstrap/stage2.factor | 15 ++++++---------
1 file changed, 6 insertions(+), 9 deletions(-)
diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor
index 67c6c9487d..d25394e978 100644
--- a/basis/bootstrap/stage2.factor
+++ b/basis/bootstrap/stage2.factor
@@ -32,18 +32,15 @@ SYMBOL: bootstrap-time
: count-words ( pred -- )
all-words swap count number>string write ;
-: print-report ( -- )
- core-bootstrap-time get
+: print-time ( time -- )
1000 /i
60 /mod swap
- "Core bootstrap completed in " write number>string write
- " minutes and " write number>string write " seconds." print
+ number>string write
+ " minutes and " write number>string write " seconds." print ;
- bootstrap-time get
- 1000 /i
- 60 /mod swap
- "Bootstrap completed in " write number>string write
- " minutes and " write number>string write " seconds." print
+: print-report ( -- )
+ "Core bootstrap completed in " write core-bootstrap-time get print-time
+ "Bootstrap completed in " write bootstrap-time get print-time
[ compiled>> ] count-words " compiled words" print
[ symbol? ] count-words " symbol words" print