From 1f5f8393c32f5eddb2ad5a888b8e7053eb106630 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 17 Jun 2009 15:27:20 -0500
Subject: [PATCH 01/14] compiler.cfg.linear-scan: Further progress on inactive
interval handling
---
.../linear-scan/allocation/allocation.factor | 61 ++++++++++++++---
.../allocation/spilling/spilling.factor | 4 +-
.../allocation/splitting/splitting.factor | 65 ++++---------------
.../linear-scan/allocation/state/state.factor | 12 +---
.../cfg/linear-scan/linear-scan-tests.factor | 1 -
5 files changed, 69 insertions(+), 74 deletions(-)
diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
index a99fea1d24..8e6479f938 100644
--- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -1,21 +1,66 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs heaps kernel namespaces sequences
+USING: accessors assocs heaps kernel namespaces sequences fry math
+combinators arrays sorting
compiler.cfg.linear-scan.allocation.coalescing
compiler.cfg.linear-scan.allocation.spilling
compiler.cfg.linear-scan.allocation.splitting
compiler.cfg.linear-scan.allocation.state ;
IN: compiler.cfg.linear-scan.allocation
+: relevant-ranges ( new inactive -- new' inactive' )
+ ! Slice off all ranges of 'inactive' that precede the start of 'new'
+ [ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;
+
+: intersect-live-range ( range1 range2 -- n/f )
+ 2dup [ from>> ] bi@ > [ swap ] when
+ 2dup [ to>> ] [ from>> ] bi* >= [ nip from>> ] [ 2drop f ] if ;
+
+: intersect-live-ranges ( ranges1 ranges2 -- n )
+ {
+ { [ over empty? ] [ 2drop 1/0. ] }
+ { [ dup empty? ] [ 2drop 1/0. ] }
+ [
+ 2dup [ first ] bi@ intersect-live-range dup [ 2nip ] [
+ drop
+ 2dup [ first from>> ] bi@ <
+ [ [ rest-slice ] dip ] [ rest-slice ] if
+ intersect-live-ranges
+ ] if
+ ]
+ } cond ;
+
+: intersect-inactive ( new inactive -- n )
+ relevant-ranges intersect-live-ranges ;
+
+: compute-free-pos ( new -- free-pos )
+ dup vreg>>
+ [ nip reg-class>> registers get at [ 1/0. ] H{ } map>assoc ]
+ [ inactive-intervals-for [ [ reg>> swap ] keep intersect-inactive ] with H{ } map>assoc ]
+ [ nip active-intervals-for [ reg>> 0 ] H{ } map>assoc ]
+ 2tri 3array assoc-combine
+ >alist sort-values ;
+
+: no-free-registers? ( new result -- ? )
+ second 0 = ; inline
+
+: register-available? ( new result -- ? )
+ [ end>> ] [ second ] bi* < ; inline
+
+: register-available ( new result -- )
+ first >>reg add-active ;
+
+: register-partially-available ( new result -- )
+ [ second split-before-use ] keep
+ '[ _ register-available ] [ add-unhandled ] bi* ;
+
: assign-register ( new -- )
dup coalesce? [ coalesce ] [
- dup vreg>> free-registers-for [
- dup intersecting-inactive
- [ assign-blocked-register ]
- [ assign-inactive-register ]
- if-empty
- ] [ assign-free-register ]
- if-empty
+ dup compute-free-pos last {
+ { [ dup no-free-registers? ] [ drop assign-blocked-register ] }
+ { [ 2dup register-available? ] [ register-available ] }
+ [ register-partially-available ]
+ } cond
] if ;
: handle-interval ( live-interval -- )
diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
index 4981a223a4..5ed7e0f0d1 100644
--- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
@@ -39,8 +39,8 @@ IN: compiler.cfg.linear-scan.allocation.spilling
#! with the most distant use location. Spill the existing
#! interval, then process the new interval and the tail end
#! of the existing interval again.
- [ reuse-register ]
- [ nip delete-active ]
+ [ reg>> >>reg drop ]
+ [ [ add-handled ] [ delete-active ] bi* ]
[ split-and-spill [ add-handled ] [ add-unhandled ] bi* ] 2tri ;
: spill-new ( new existing -- )
diff --git a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor
index 40ee4083e4..e31fcedace 100644
--- a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor
@@ -28,9 +28,7 @@ IN: compiler.cfg.linear-scan.allocation.splitting
'[ _ <= ] partition ;
: record-split ( live-interval before after -- )
- [ >>split-next drop ]
- [ [ >>split-before ] [ >>split-after ] bi* drop ]
- 2bi ; inline
+ [ >>split-before ] [ >>split-after ] bi* drop ; inline
ERROR: splitting-too-early ;
@@ -59,62 +57,21 @@ ERROR: splitting-atomic-interval ;
HINTS: split-interval live-interval object ;
-: reuse-register ( new existing -- )
- reg>> >>reg add-active ;
-
-: relevant-ranges ( new inactive -- new' inactive' )
- ! Slice off all ranges of 'inactive' that precede the start of 'new'
- [ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;
-
-: intersect-live-range ( range1 range2 -- n/f )
- 2dup [ from>> ] bi@ > [ swap ] when
- 2dup [ to>> ] [ from>> ] bi* >= [ nip from>> ] [ 2drop f ] if ;
-
-: intersect-live-ranges ( ranges1 ranges2 -- n )
- {
- { [ over empty? ] [ 2drop 1/0. ] }
- { [ dup empty? ] [ 2drop 1/0. ] }
- [
- 2dup [ first ] bi@ intersect-live-range dup [ 2nip ] [
- drop
- 2dup [ first from>> ] bi@ <
- [ [ rest-slice ] dip ] [ rest-slice ] if
- intersect-live-ranges
- ] if
- ]
- } cond ;
-
-: intersect-inactive ( new inactive active-regs -- n/f )
- ! If the interval's register is currently in use, we cannot
- ! re-use it.
- 2dup [ reg>> ] dip key?
- [ 3drop f ] [ drop relevant-ranges intersect-live-ranges ] if ;
-
-: intersecting-inactive ( new -- live-intervals )
- dup vreg>>
- [ inactive-intervals-for ]
- [ active-intervals-for [ reg>> ] map unique ] bi
- '[ tuck _ intersect-inactive ] with { } map>assoc
- [ nip ] assoc-filter ;
+: split-between-blocks ( new n -- before after )
+ split-interval
+ 2dup [ compute-start/end ] bi@ ;
: insert-use-for-copy ( seq n -- seq' )
- [ 1array split1 ] keep [ 1 - ] keep 2array glue ;
+ dup 1 + [ nip 1array split1 ] 2keep 2array glue ;
: split-before-use ( new n -- before after )
! Find optimal split position
! Insert move instruction
- [ '[ _ insert-use-for-copy ] change-uses ] keep
- 1 - split-interval
- 2dup [ compute-start/end ] bi@ ;
-
-: assign-inactive-register ( new live-intervals -- )
- ! If there is an interval which is inactive for the entire lifetime
- ! if the new interval, reuse its vreg. Otherwise, split new so that
- ! the first half fits.
- sort-values last
- 2dup [ end>> ] [ second ] bi* < [
- first reuse-register
+ 1 -
+ 2dup swap covers? [
+ [ '[ _ insert-use-for-copy ] change-uses ] keep
+ split-between-blocks
+ 2dup >>split-next drop
] [
- [ second split-before-use ] keep
- '[ _ first reuse-register ] [ add-unhandled ] bi*
+ split-between-blocks
] if ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/linear-scan/allocation/state/state.factor b/basis/compiler/cfg/linear-scan/allocation/state/state.factor
index 2a1e87dcdd..737133aa32 100644
--- a/basis/compiler/cfg/linear-scan/allocation/state/state.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/state/state.factor
@@ -6,13 +6,7 @@ compiler.cfg.linear-scan.live-intervals ;
IN: compiler.cfg.linear-scan.allocation.state
! Mapping from register classes to sequences of machine registers
-SYMBOL: free-registers
-
-: free-registers-for ( vreg -- seq )
- reg-class>> free-registers get at ;
-
-: deallocate-register ( live-interval -- )
- [ reg>> ] [ vreg>> ] bi free-registers-for push ;
+SYMBOL: registers
! Vector of active live intervals
SYMBOL: active-intervals
@@ -47,7 +41,7 @@ SYMBOL: handled-intervals
: finished? ( n live-interval -- ? ) end>> swap < ;
: finish ( n live-interval -- keep? )
- nip [ deallocate-register ] [ add-handled ] bi f ;
+ nip add-handled f ;
SYMBOL: check-allocation?
@@ -121,7 +115,7 @@ SYMBOL: spill-counts
spill-counts get [ dup 1 + ] change-at ;
: init-allocator ( registers -- )
- [ reverse >vector ] assoc-map free-registers set
+ registers set
[ 0 ] reg-class-assoc spill-counts set
<min-heap> unhandled-intervals set
[ V{ } clone ] reg-class-assoc active-intervals set
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index 243e83445d..072da88c07 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -1410,7 +1410,6 @@ USING: math.private compiler.cfg.debugger ;
{ uses { 5 10 } }
{ ranges V{ T{ live-range f 5 10 } } }
}
- H{ }
intersect-inactive
] unit-test
From 2f15ac3c8f7504468d8b5d07c98931b20a41e9f6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Jun 2009 03:42:42 -0500
Subject: [PATCH 02/14] compiler.cfg.linear-scan: Fix a couple of bugs
---
basis/compiler/cfg/linear-scan/allocation/allocation.factor | 2 +-
.../cfg/linear-scan/allocation/spilling/spilling.factor | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
index 8e6479f938..868beee160 100644
--- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -41,7 +41,7 @@ IN: compiler.cfg.linear-scan.allocation
2tri 3array assoc-combine
>alist sort-values ;
-: no-free-registers? ( new result -- ? )
+: no-free-registers? ( result -- ? )
second 0 = ; inline
: register-available? ( new result -- ? )
diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
index 5ed7e0f0d1..caef971ab9 100644
--- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
@@ -39,7 +39,7 @@ IN: compiler.cfg.linear-scan.allocation.spilling
#! with the most distant use location. Spill the existing
#! interval, then process the new interval and the tail end
#! of the existing interval again.
- [ reg>> >>reg drop ]
+ [ reg>> >>reg add-active ]
[ [ add-handled ] [ delete-active ] bi* ]
[ split-and-spill [ add-handled ] [ add-unhandled ] bi* ] 2tri ;
From 03e956d72ed08a698f16edbeb2f5d685dea0c207 Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@rfc1149.net>
Date: Fri, 19 Jun 2009 13:01:36 +0200
Subject: [PATCH 03/14] Automatically load needed vocabularies when
deserializing words
---
basis/serialize/serialize.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor
index 4e94b6a51d..b7e395fa35 100644
--- a/basis/serialize/serialize.factor
+++ b/basis/serialize/serialize.factor
@@ -12,7 +12,7 @@ vectors byte-arrays quotations hashtables assocs help.syntax
help.markup splitting io.streams.byte-array io.encodings.string
io.encodings.utf8 io.encodings.binary combinators accessors
locals prettyprint compiler.units sequences.private
-classes.tuple.private ;
+classes.tuple.private vocabs.loader ;
IN: serialize
GENERIC: (serialize) ( obj -- )
@@ -202,7 +202,7 @@ SYMBOL: deserialized
(deserialize-string) dup intern-object ;
: deserialize-word ( -- word )
- (deserialize) (deserialize) 2dup lookup
+ (deserialize) (deserialize) 2dup [ require ] keep lookup
dup [ 2nip ] [
drop
2array unparse "Unknown word: " prepend throw
From df6ea31e1cd6d3fb61292eca094ce261f484ac98 Mon Sep 17 00:00:00 2001
From: Thomas Deniau <thomas@glamdring.nousoft.org>
Date: Fri, 19 Jun 2009 16:34:00 +0200
Subject: [PATCH 04/14] Use $CC and $CPP if provided Let the user select the
compiler he wants to use to compile Factor by using the supplied $CC and $CPP
instead of just discarding them. If not present, we default to gcc and g++
(the current behaviour).
---
Makefile | 4 ++--
build-support/factor.sh | 2 +-
2 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/Makefile b/Makefile
index 18cb7d15c7..50cef84a21 100755
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
-CC = gcc
-CPP = g++
+CC ?= gcc
+CPP ?= g++
AR = ar
LD = ld
diff --git a/build-support/factor.sh b/build-support/factor.sh
index d5b8bd5411..e059a7d84f 100755
--- a/build-support/factor.sh
+++ b/build-support/factor.sh
@@ -97,7 +97,7 @@ set_md5sum() {
set_gcc() {
case $OS in
openbsd) ensure_program_installed egcc; CC=egcc;;
- *) CC=gcc;;
+ *) CC=${CC:=gcc};;
esac
}
From c3da7ae7855b51ff6f0afb4742ea4c803e49a649 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Fri, 19 Jun 2009 12:58:17 -0500
Subject: [PATCH 05/14] fix nover, add unit test
---
basis/generalizations/generalizations-tests.factor | 5 +++++
basis/generalizations/generalizations.factor | 2 +-
2 files changed, 6 insertions(+), 1 deletion(-)
diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor
index c877acf936..b781e2a7f0 100644
--- a/basis/generalizations/generalizations-tests.factor
+++ b/basis/generalizations/generalizations-tests.factor
@@ -67,3 +67,8 @@ IN: generalizations.tests
[ 1 2 3 [ ] [ ] 3 nbi-curry ] unit-test
[ 15 3 ] [ 1 2 3 4 5 [ + + + + ] [ - - - - ] 5 nbi ] unit-test
+
+: nover-test ( -- a b c d e f g )
+ 1 2 3 4 3 nover ;
+
+[ 1 2 3 4 1 2 3 ] [ nover-test ] unit-test
diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 0ea179b52c..abcbd54cab 100644
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -40,7 +40,7 @@ MACRO: npick ( n -- )
1- [ dup ] [ '[ _ dip swap ] ] repeat ;
MACRO: nover ( n -- )
- dup '[ _ 1 + npick ] n*quot ;
+ dup 1 + '[ _ npick ] n*quot ;
MACRO: ndup ( n -- )
dup '[ _ npick ] n*quot ;
From 9c45840b5d73d7f7022e554adccb14c447211ec7 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 19 Jun 2009 14:22:39 -0500
Subject: [PATCH 06/14] use CC env var on openbsd too
---
build-support/factor.sh | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/build-support/factor.sh b/build-support/factor.sh
index e059a7d84f..05bbcfe70d 100755
--- a/build-support/factor.sh
+++ b/build-support/factor.sh
@@ -96,7 +96,7 @@ set_md5sum() {
set_gcc() {
case $OS in
- openbsd) ensure_program_installed egcc; CC=egcc;;
+ openbsd) ensure_program_installed egcc; CC=${CC:=egcc};;
*) CC=${CC:=gcc};;
esac
}
From 326202e7b7035438bfebbe51b6a13040b7f62859 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Jun 2009 14:33:43 -0500
Subject: [PATCH 07/14] Fix help-lint for models.range and histogram
---
basis/models/range/range-docs.factor | 2 +-
extra/histogram/histogram-docs.factor | 10 +++++-----
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/basis/models/range/range-docs.factor b/basis/models/range/range-docs.factor
index 1adba493b4..5f5b2f4405 100644
--- a/basis/models/range/range-docs.factor
+++ b/basis/models/range/range-docs.factor
@@ -7,7 +7,7 @@ HELP: range
{ $notes { $link "ui.gadgets.sliders" } " use range models." } ;
HELP: <range>
-{ $values { "value" real } { "page" real } { "min" real } { "max" real } { "range" range } }
+{ $values { "value" real } { "page" real } { "min" real } { "max" real } { "step" real } { "range" range } }
{ $description "Creates a new " { $link range } " model." } ;
HELP: range-model
diff --git a/extra/histogram/histogram-docs.factor b/extra/histogram/histogram-docs.factor
index d81400fc0b..0c4059fa59 100755
--- a/extra/histogram/histogram-docs.factor
+++ b/extra/histogram/histogram-docs.factor
@@ -8,7 +8,7 @@ HELP: histogram
}
{ $examples
{ $example "! Count the number of times an element appears in a sequence."
- "USING: prettyprint sets ;"
+ "USING: prettyprint histogram ;"
"\"aaabc\" histogram ."
"H{ { 97 3 } { 98 1 } { 99 1 } }"
}
@@ -22,7 +22,7 @@ HELP: histogram*
}
{ $examples
{ $example "! Count the number of times the elements of two sequences appear."
- "USING: prettyprint sets ;"
+ "USING: prettyprint histogram ;"
"\"aaabc\" histogram \"aaaaaabc\" histogram* ."
"H{ { 97 9 } { 98 2 } { 99 2 } }"
}
@@ -36,7 +36,7 @@ HELP: sequence>assoc
}
{ $examples
{ $example "! Iterate over a sequence and increment the count at each element"
- "USING: assocs prettyprint sets ;"
+ "USING: assocs prettyprint histogram ;"
"\"aaabc\" [ inc-at ] H{ } sequence>assoc ."
"H{ { 97 3 } { 98 1 } { 99 1 } }"
}
@@ -50,7 +50,7 @@ HELP: sequence>assoc*
}
{ $examples
{ $example "! Iterate over a sequence and add the counts to an existing assoc"
- "USING: assocs prettyprint sets kernel ;"
+ "USING: assocs prettyprint histogram kernel ;"
"H{ { 97 2 } { 98 1 } } clone \"aaabc\" [ inc-at ] sequence>assoc* ."
"H{ { 97 5 } { 98 2 } { 99 1 } }"
}
@@ -64,7 +64,7 @@ HELP: sequence>hashtable
}
{ $examples
{ $example "! Count the number of times an element occurs in a sequence"
- "USING: assocs prettyprint sets ;"
+ "USING: assocs prettyprint histogram ;"
"\"aaabc\" [ inc-at ] sequence>hashtable ."
"H{ { 97 3 } { 98 1 } { 99 1 } }"
}
From 1e14a83ee1f657477ab8ede7720ff8ffbab59d2e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 19 Jun 2009 14:41:48 -0500
Subject: [PATCH 08/14] allow robot-identifiers to be set for robots.txt
---
extra/robots/robots.factor | 20 +++++++++++++++-----
1 file changed, 15 insertions(+), 5 deletions(-)
diff --git a/extra/robots/robots.factor b/extra/robots/robots.factor
index 3c0eb045f7..af039ef8c4 100644
--- a/extra/robots/robots.factor
+++ b/extra/robots/robots.factor
@@ -1,15 +1,18 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors http.client kernel unicode.categories
-sequences urls splitting combinators splitting.monotonic
-combinators.short-circuit assocs unicode.case arrays
-math.parser calendar.format make fry present globs
-multiline regexp.combinators regexp ;
+USING: accessors arrays assocs calendar.format combinators
+combinators.short-circuit fry globs http.client kernel make
+math.parser multiline namespaces present regexp
+regexp.combinators sequences sets splitting splitting.monotonic
+unicode.case unicode.categories urls ;
IN: robots
! visit-time is GMT, request-rate is pages/second
! crawl-rate is seconds
+SYMBOL: robot-identities
+robot-identities [ { "FactorSpider" } ] initialize
+
TUPLE: robots site sitemap rules rules-quot ;
: <robots> ( site sitemap rules -- robots )
@@ -80,6 +83,13 @@ visit-time request-rate crawl-delay unknowns ;
derive-urls [ <glob> ] map <and> <not>
] bi 2array <or> '[ _ matches? ] ;
+: relevant-rules ( robots -- rules )
+ [
+ user-agents>> [
+ robot-identities get [ swap glob-matches? ] with any?
+ ] any?
+ ] filter ;
+
PRIVATE>
: parse-robots.txt ( string -- sitemaps rules-seq )
From a83c5a23cb61ef32a13a897eabbb3c4ecd8e3449 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Jun 2009 15:03:53 -0500
Subject: [PATCH 09/14] Revert "use CC env var on openbsd too"
This reverts commit f2af35ce5d9db44c366b3250ab550e804f3dbc2c.
---
build-support/factor.sh | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/build-support/factor.sh b/build-support/factor.sh
index 05bbcfe70d..e059a7d84f 100755
--- a/build-support/factor.sh
+++ b/build-support/factor.sh
@@ -96,7 +96,7 @@ set_md5sum() {
set_gcc() {
case $OS in
- openbsd) ensure_program_installed egcc; CC=${CC:=egcc};;
+ openbsd) ensure_program_installed egcc; CC=egcc;;
*) CC=${CC:=gcc};;
esac
}
From 8379312bba9e4f7bef8b51e06a226cac89bd5b94 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Jun 2009 15:04:06 -0500
Subject: [PATCH 10/14] Revert "Use $CC and $CPP if provided"
This reverts commit 8f9c4a78a4c8bf42b63c32917c246829836368a6.
---
Makefile | 4 ++--
build-support/factor.sh | 2 +-
2 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/Makefile b/Makefile
index 50cef84a21..18cb7d15c7 100755
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
-CC ?= gcc
-CPP ?= g++
+CC = gcc
+CPP = g++
AR = ar
LD = ld
diff --git a/build-support/factor.sh b/build-support/factor.sh
index e059a7d84f..d5b8bd5411 100755
--- a/build-support/factor.sh
+++ b/build-support/factor.sh
@@ -97,7 +97,7 @@ set_md5sum() {
set_gcc() {
case $OS in
openbsd) ensure_program_installed egcc; CC=egcc;;
- *) CC=${CC:=gcc};;
+ *) CC=gcc;;
esac
}
From 5c912504d791a3b4415aed2c42762f01611e3002 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Jun 2009 18:28:30 -0500
Subject: [PATCH 11/14] compiler.cfg.linear-scan: untangle
add-active/delete-active/add-handled calls in spilling, replace 'sort-values
last' with 'alist-max' in compiler.utilities
---
.../linear-scan/allocation/allocation.factor | 6 ++--
.../allocation/spilling/spilling.factor | 28 +++++++++----------
.../cfg/linear-scan/linear-scan-tests.factor | 12 ++++----
basis/compiler/utilities/utilities.factor | 5 +++-
4 files changed, 28 insertions(+), 23 deletions(-)
diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
index 868beee160..3dcc925d7c 100644
--- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs heaps kernel namespaces sequences fry math
-combinators arrays sorting
+combinators arrays sorting compiler.utilities
compiler.cfg.linear-scan.allocation.coalescing
compiler.cfg.linear-scan.allocation.spilling
compiler.cfg.linear-scan.allocation.splitting
@@ -39,7 +39,7 @@ IN: compiler.cfg.linear-scan.allocation
[ inactive-intervals-for [ [ reg>> swap ] keep intersect-inactive ] with H{ } map>assoc ]
[ nip active-intervals-for [ reg>> 0 ] H{ } map>assoc ]
2tri 3array assoc-combine
- >alist sort-values ;
+ >alist alist-max ;
: no-free-registers? ( result -- ? )
second 0 = ; inline
@@ -56,7 +56,7 @@ IN: compiler.cfg.linear-scan.allocation
: assign-register ( new -- )
dup coalesce? [ coalesce ] [
- dup compute-free-pos last {
+ dup compute-free-pos {
{ [ dup no-free-registers? ] [ drop assign-blocked-register ] }
{ [ 2dup register-available? ] [ register-available ] }
[ register-partially-available ]
diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
index caef971ab9..2f4130e9ad 100644
--- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
@@ -1,12 +1,24 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators fry hints kernel locals
-math sequences sets sorting splitting
+math sequences sets sorting splitting compiler.utilities
compiler.cfg.linear-scan.allocation.state
compiler.cfg.linear-scan.allocation.splitting
compiler.cfg.linear-scan.live-intervals ;
IN: compiler.cfg.linear-scan.allocation.spilling
+: find-use ( live-interval n quot -- elt )
+ [ uses>> ] 2dip curry find nip ; inline
+
+: spill-existing? ( new existing -- ? )
+ #! Test if 'new' will be used before 'existing'.
+ over start>> '[ _ [ > ] find-use -1 or ] bi@ < ;
+
+: interval-to-spill ( active-intervals current -- live-interval )
+ #! We spill the interval with the most distant use location.
+ start>> '[ dup _ [ >= ] find-use ] { } map>assoc
+ alist-max first ;
+
: split-for-spill ( live-interval n -- before after )
split-interval
[
@@ -17,14 +29,6 @@ IN: compiler.cfg.linear-scan.allocation.spilling
[ ]
2tri ;
-: find-use ( live-interval n quot -- i elt )
- [ uses>> ] 2dip curry find ; inline
-
-: interval-to-spill ( active-intervals current -- live-interval )
- #! We spill the interval with the most distant use location.
- start>> '[ dup _ [ >= ] find-use nip ] { } map>assoc
- [ ] [ [ [ second ] bi@ > ] most ] map-reduce first ;
-
: assign-spill ( before after -- before after )
#! If it has been spilled already, reuse spill location.
over reload-from>>
@@ -39,8 +43,8 @@ IN: compiler.cfg.linear-scan.allocation.spilling
#! with the most distant use location. Spill the existing
#! interval, then process the new interval and the tail end
#! of the existing interval again.
+ [ nip delete-active ]
[ reg>> >>reg add-active ]
- [ [ add-handled ] [ delete-active ] bi* ]
[ split-and-spill [ add-handled ] [ add-unhandled ] bi* ] 2tri ;
: spill-new ( new existing -- )
@@ -50,10 +54,6 @@ IN: compiler.cfg.linear-scan.allocation.spilling
#! again.
[ dup split-and-spill add-unhandled ] dip spill-existing ;
-: spill-existing? ( new existing -- ? )
- #! Test if 'new' will be used before 'existing'.
- over start>> '[ _ [ > ] find-use nip -1 or ] bi@ < ;
-
: assign-blocked-register ( new -- )
[ dup vreg>> active-intervals-for ] keep interval-to-spill
2dup spill-existing? [ spill-existing ] [ spill-new ] if ;
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index 072da88c07..b43294818b 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -79,7 +79,7 @@ check-allocation? on
{ end 10 }
{ uses V{ 0 1 3 7 10 } }
}
- 4 [ >= ] find-use nip
+ 4 [ >= ] find-use
] unit-test
[ 4 ] [
@@ -89,7 +89,7 @@ check-allocation? on
{ end 10 }
{ uses V{ 0 1 3 4 10 } }
}
- 4 [ >= ] find-use nip
+ 4 [ >= ] find-use
] unit-test
[ f ] [
@@ -99,7 +99,7 @@ check-allocation? on
{ end 10 }
{ uses V{ 0 1 3 4 10 } }
}
- 100 [ >= ] find-use nip
+ 100 [ >= ] find-use
] unit-test
[
@@ -1324,7 +1324,7 @@ USING: math.private compiler.cfg.debugger ;
! Spill slot liveness was computed incorrectly, leading to a FEP
! early in bootstrap on x86-32
-[ t ] [
+[ t t ] [
[
H{ } clone live-ins set
H{ } clone live-outs set
@@ -1349,7 +1349,9 @@ USING: math.private compiler.cfg.debugger ;
}
}
} dup 1array { { int-regs V{ 0 1 2 3 } } } (linear-scan)
- instructions>> first live-spill-slots>> empty?
+ instructions>> first
+ [ live-spill-slots>> empty? ]
+ [ live-registers>> empty? ] bi
] with-scope
] unit-test
diff --git a/basis/compiler/utilities/utilities.factor b/basis/compiler/utilities/utilities.factor
index 31faaef480..ac276b6e41 100644
--- a/basis/compiler/utilities/utilities.factor
+++ b/basis/compiler/utilities/utilities.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences sequences.private arrays vectors fry
-math.order namespaces assocs ;
+math math.order namespaces assocs ;
IN: compiler.utilities
: flattener ( seq quot -- seq vector quot' )
@@ -25,3 +25,6 @@ IN: compiler.utilities
SYMBOL: yield-hook
yield-hook [ [ ] ] initialize
+
+: alist-max ( alist -- pair )
+ [ ] [ [ [ second ] bi@ > ] most ] map-reduce ;
\ No newline at end of file
From a598030fd769e9f07c7a6599b0edfd0673066015 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 20 Jun 2009 15:14:45 -0500
Subject: [PATCH 12/14] cocoa.windows: Fix help lint
---
basis/cocoa/windows/windows-docs.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/cocoa/windows/windows-docs.factor b/basis/cocoa/windows/windows-docs.factor
index 39bd631b19..690fe9b5aa 100644
--- a/basis/cocoa/windows/windows-docs.factor
+++ b/basis/cocoa/windows/windows-docs.factor
@@ -2,11 +2,11 @@ USING: help.markup help.syntax ;
IN: cocoa.windows
HELP: <NSWindow>
-{ $values { "rect" "an " { $snippet "NSRect" } } { "window" "an " { $snippet "NSWindow" } } }
+{ $values { "rect" "an " { $snippet "NSRect" } } { "style" "a style mask" } { "class" "an Objective-C class" } { "window" "an " { $snippet "NSWindow" } } }
{ $description "Creates a new " { $snippet "NSWindow" } " with the specified dimensions." } ;
HELP: <ViewWindow>
-{ $values { "view" "an " { $snippet "NSView" } } { "rect" "an " { $snippet "NSRect" } } { "window" "an " { $snippet "NSWindow" } } }
+{ $values { "view" "an " { $snippet "NSView" } } { "rect" "an " { $snippet "NSRect" } } { "style" "a style mask" } { "window" "an " { $snippet "NSWindow" } } }
{ $description "Creates a new " { $snippet "NSWindow" } " with the specified dimensions, containing the given view." } ;
ARTICLE: "cocoa-window-utils" "Cocoa window utilities"
From c1839200dd8c4a75ecc09dc392cd9ed18ed67aec Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 20 Jun 2009 15:33:12 -0500
Subject: [PATCH 13/14] compiler.cfg.linear-scan.assignment: correctly compute
live registers at GC check points
---
basis/compiler/cfg/linear-scan/assignment/assignment.factor | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index ea918a7424..bf2a56adbd 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -102,7 +102,9 @@ M: vreg-insn assign-registers-in-insn
>>regs drop ;
: compute-live-registers ( insn -- regs )
- active-intervals register-mapping ;
+ [ active-intervals ] [ temp-vregs ] bi
+ '[ vreg>> _ memq? not ] filter
+ register-mapping ;
: compute-live-spill-slots ( -- spill-slots )
spill-slots get values [ values ] map concat
From 2e5124f0359fc9423f5a53c3a181c15bb01c9769 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 20 Jun 2009 15:35:01 -0500
Subject: [PATCH 14/14] tokyo.alien.tctdb: int32_t is not defined on Windows,
but int is the sae thing so use that instead
---
extra/tokyo/alien/tctdb/tctdb.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/tokyo/alien/tctdb/tctdb.factor b/extra/tokyo/alien/tctdb/tctdb.factor
index bb65acb2f6..e43ed9c765 100755
--- a/extra/tokyo/alien/tctdb/tctdb.factor
+++ b/extra/tokyo/alien/tctdb/tctdb.factor
@@ -76,7 +76,7 @@ FUNCTION: void tctdbdel ( TCTDB* tdb ) ;
FUNCTION: int tctdbecode ( TCTDB* tdb ) ;
FUNCTION: bool tctdbsetmutex ( TCTDB* tdb ) ;
FUNCTION: bool tctdbtune ( TCTDB* tdb, longlong bnum, char apow, char fpow, uchar opts ) ;
-FUNCTION: bool tctdbsetcache ( TCTDB* tdb, int32_t rcnum, int32_t lcnum, int32_t ncnum ) ;
+FUNCTION: bool tctdbsetcache ( TCTDB* tdb, int rcnum, int lcnum, int ncnum ) ;
FUNCTION: bool tctdbsetxmsiz ( TCTDB* tdb, longlong xmsiz ) ;
FUNCTION: bool tctdbopen ( TCTDB* tdb, char* path, int omode ) ;
FUNCTION: bool tctdbclose ( TCTDB* tdb ) ;