From bada2176bc6af9bd3cd736aaaf639dcd01bbad1b Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 25 Apr 2009 21:21:15 -0500
Subject: [PATCH 1/8] use new locals syntax in calendar, add routine for
 calculating easter

---
 basis/calendar/calendar-tests.factor |  9 +++-
 basis/calendar/calendar.factor       | 64 +++++++++++++++++++---------
 2 files changed, 52 insertions(+), 21 deletions(-)

diff --git a/basis/calendar/calendar-tests.factor b/basis/calendar/calendar-tests.factor
index 256b4e1b42..8d1071122d 100644
--- a/basis/calendar/calendar-tests.factor
+++ b/basis/calendar/calendar-tests.factor
@@ -1,5 +1,5 @@
 USING: arrays calendar kernel math sequences tools.test
-continuations system math.order threads ;
+continuations system math.order threads accessors ;
 IN: calendar.tests
 
 [ f ] [ 2004 12 32 0   0  0 instant <timestamp> valid-timestamp? ] unit-test
@@ -163,3 +163,10 @@ IN: calendar.tests
 [ t ] [ now 50 milliseconds sleep now before? ] unit-test
 [ t ] [ now 50 milliseconds sleep now swap after? ] unit-test
 [ t ] [ now 50 milliseconds sleep now 50 milliseconds sleep now swapd between? ] unit-test
+
+[ 4 12 ] [ 2009 easter [ month>> ] [ day>> ] bi ] unit-test
+[ 4 2 ] [ 1961 easter [ month>> ] [ day>> ] bi ] unit-test
+
+[ f ] [ now dup midnight eq? ] unit-test
+[ f ] [ now dup easter eq? ] unit-test
+[ f ] [ now dup beginning-of-year eq? ] unit-test
diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor
index 7a03fe4408..4b58b1b496 100644
--- a/basis/calendar/calendar.factor
+++ b/basis/calendar/calendar.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays classes.tuple combinators combinators.short-circuit
-    kernel locals math math.functions math.order namespaces sequences strings
-    summary system threads vocabs.loader ;
+USING: accessors arrays classes.tuple combinators
+combinators.short-circuit kernel locals math math.functions
+math.order sequences summary system threads vocabs.loader ;
 IN: calendar
 
 HOOK: gmt-offset os ( -- hours minutes seconds )
@@ -94,26 +94,50 @@ CONSTANT: day-abbreviations3
 :: julian-day-number ( year month day -- n )
     #! Returns a composite date number
     #! Not valid before year -4800
-    [let* | a [ 14 month - 12 /i ]
-            y [ year 4800 + a - ]
-            m [ month 12 a * + 3 - ] |
-        day 153 m * 2 + 5 /i + 365 y * +
-        y 4 /i + y 100 /i - y 400 /i + 32045 -
-    ] ;
+    14 month - 12 /i :> a
+    year 4800 + a - :> y
+    month 12 a * + 3 - :> m
+
+    day 153 m * 2 + 5 /i + 365 y * +
+    y 4 /i + y 100 /i - y 400 /i + 32045 - ;
 
 :: julian-day-number>date ( n -- year month day )
     #! Inverse of julian-day-number
-    [let* | a [ n 32044 + ]
-            b [ 4 a * 3 + 146097 /i ]
-            c [ a 146097 b * 4 /i - ]
-            d [ 4 c * 3 + 1461 /i ]
-            e [ c 1461 d * 4 /i - ]
-            m [ 5 e * 2 + 153 /i ] |
-        100 b * d + 4800 -
-        m 10 /i + m 3 +
-        12 m 10 /i * -
-        e 153 m * 2 + 5 /i - 1+
-    ] ;
+    n 32044 + :> a
+    4 a * 3 + 146097 /i :> b
+    a 146097 b * 4 /i - :> c
+    4 c * 3 + 1461 /i :> d
+    c 1461 d * 4 /i - :> e
+    5 e * 2 + 153 /i :> m
+
+    100 b * d + 4800 -
+    m 10 /i + m 3 +
+    12 m 10 /i * -
+    e 153 m * 2 + 5 /i - 1+ ;
+
+GENERIC: easter ( obj -- obj' )
+
+:: easter-month-day ( year -- month day )
+    year 19 mod :> a
+    year 100 /mod :> c :> b
+    b 4 /mod :> e :> d
+    b 8 + 25 /i :> f
+    b f - 1 + 3 /i :> g
+    19 a * b + d - g - 15 + 30 mod :> h
+    c 4 /mod :> k :> i
+    32 2 e * + 2 i * + h - k - 7 mod :> l
+    a 11 h * + 22 l * + 451 /i :> m
+
+    h l + 7 m * - 114 + 31 /mod 1 + :> day :> month
+    month day ;
+
+M: integer easter ( year -- timestamp )
+    dup easter-month-day <date> ;
+
+M: timestamp easter ( timestamp -- timestamp )
+    clone
+    dup year>> easter-month-day
+    swapd >>day swap >>month ;
 
 : >date< ( timestamp -- year month day )
     [ year>> ] [ month>> ] [ day>> ] tri ;

From cdb17b74333d3cd13f6516cb46ea4d60d4b2dc99 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sun, 26 Apr 2009 00:45:03 -0500
Subject: [PATCH 2/8] make fasta work again

---
 extra/benchmark/fasta/fasta.factor | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor
index 2ae5ada8a1..f457b90c30 100755
--- a/extra/benchmark/fasta/fasta.factor
+++ b/extra/benchmark/fasta/fasta.factor
@@ -46,8 +46,8 @@ CONSTANT: homo-sapiens
     }
 
 : make-cumulative ( freq -- chars floats )
-    dup keys >byte-array
-    swap values >double-array unclip [ + ] accumulate swap suffix ;
+    [ keys >byte-array ]
+    [ values >double-array ] bi unclip [ + ] accumulate swap suffix ;
 
 :: select-random ( seed chars floats -- seed elt )
     floats seed random -rot
@@ -55,7 +55,7 @@ CONSTANT: homo-sapiens
     chars nth-unsafe ; inline
 
 : make-random-fasta ( seed len chars floats -- seed )
-    [ rot drop select-random ] 2curry B{ } map-as print ; inline
+    [ rot drop select-random ] 2curry "" map-as print ; inline
 
 : write-description ( desc id -- )
     ">" write write bl print ; inline
@@ -71,7 +71,7 @@ CONSTANT: homo-sapiens
 
 :: make-repeat-fasta ( k len alu -- k' )
     [let | kn [ alu length ] |
-        len [ k + kn mod alu nth-unsafe ] B{ } map-as print
+        len [ k + kn mod alu nth-unsafe ] "" map-as print
         k len +
     ] ; inline
 

From a25376278b4cf396fb81c9fbe8b4f36cd112a12c Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sun, 26 Apr 2009 00:45:14 -0500
Subject: [PATCH 3/8] set error-summary? to true by default

---
 basis/listener/listener.factor | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor
index d96e0df6c1..68777f2f73 100644
--- a/basis/listener/listener.factor
+++ b/basis/listener/listener.factor
@@ -62,6 +62,8 @@ SYMBOL: max-stack-items
 
 SYMBOL: error-summary?
 
+t error-summary? set-global
+
 <PRIVATE
 
 : title. ( string -- )

From acd312ab19b44a50acb2b22b6d65762805859bb9 Mon Sep 17 00:00:00 2001
From: erg <erg@ubuntubox.(none)>
Date: Sun, 26 Apr 2009 00:51:47 -0500
Subject: [PATCH 4/8] fix IN: for compiler tests

---
 basis/compiler/tests/alien.factor            | 2 +-
 basis/compiler/tests/codegen.factor          | 4 ++--
 basis/compiler/tests/curry.factor            | 2 +-
 basis/compiler/tests/float.factor            | 2 +-
 basis/compiler/tests/folding.factor          | 2 +-
 basis/compiler/tests/intrinsics.factor       | 2 +-
 basis/compiler/tests/optimizer.factor        | 2 +-
 basis/compiler/tests/peg-regression-2.factor | 4 ++--
 basis/compiler/tests/peg-regression.factor   | 2 +-
 basis/compiler/tests/redefine0.factor        | 2 +-
 basis/compiler/tests/redefine1.factor        | 2 +-
 basis/compiler/tests/redefine10.factor       | 2 +-
 basis/compiler/tests/redefine11.factor       | 2 +-
 basis/compiler/tests/redefine15.factor       | 2 +-
 basis/compiler/tests/redefine2.factor        | 2 +-
 basis/compiler/tests/redefine3.factor        | 2 +-
 basis/compiler/tests/redefine4.factor        | 2 +-
 basis/compiler/tests/redefine5.factor        | 2 +-
 basis/compiler/tests/redefine6.factor        | 2 +-
 basis/compiler/tests/redefine7.factor        | 2 +-
 basis/compiler/tests/redefine8.factor        | 2 +-
 basis/compiler/tests/redefine9.factor        | 2 +-
 basis/compiler/tests/reload.factor           | 2 +-
 basis/compiler/tests/simple.factor           | 2 +-
 basis/compiler/tests/spilling.factor         | 2 +-
 basis/compiler/tests/stack-trace.factor      | 2 +-
 basis/compiler/tests/tuples.factor           | 2 +-
 27 files changed, 29 insertions(+), 29 deletions(-)

diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index 4d7882ad08..42ed90d64a 100755
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -5,7 +5,7 @@ continuations effects namespaces.private io io.streams.string
 memory system threads tools.test math accessors combinators
 specialized-arrays.float alien.libraries io.pathnames
 io.backend ;
-IN: compiler.tests
+IN: compiler.tests.alien
 
 <<
 : libfactor-ffi-tests-path ( -- string )
diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor
index 2e02e5476c..c746fdfb45 100644
--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@@ -4,7 +4,7 @@ sequences sequences.private tools.test namespaces.private
 slots.private sequences.private byte-arrays alien
 alien.accessors layouts words definitions compiler.units io
 combinators vectors grouping make ;
-IN: compiler.tests
+IN: compiler.tests.codegen
 
 ! Originally, this file did black box testing of templating
 ! optimization. We now have a different codegen, but the tests
@@ -281,4 +281,4 @@ TUPLE: cucumber ;
 
 M: cucumber equal? "The cucumber has no equal" throw ;
 
-[ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test
\ No newline at end of file
+[ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test
diff --git a/basis/compiler/tests/curry.factor b/basis/compiler/tests/curry.factor
index 2d1f15b9a8..32611ba87a 100644
--- a/basis/compiler/tests/curry.factor
+++ b/basis/compiler/tests/curry.factor
@@ -1,6 +1,6 @@
 USING: tools.test quotations math kernel sequences
 assocs namespaces make compiler.units compiler ;
-IN: compiler.tests
+IN: compiler.tests.curry
 
 [ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test
 [ 3 ] [ [ 5 [ 2 - ] curry call ] compile-call ] unit-test
diff --git a/basis/compiler/tests/float.factor b/basis/compiler/tests/float.factor
index b439b5f6a4..1a604dbd8e 100644
--- a/basis/compiler/tests/float.factor
+++ b/basis/compiler/tests/float.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.float
 USING: compiler.units compiler kernel kernel.private memory math
 math.private tools.test math.floats.private ;
 
diff --git a/basis/compiler/tests/folding.factor b/basis/compiler/tests/folding.factor
index fe2f801de2..5050ce1950 100644
--- a/basis/compiler/tests/folding.factor
+++ b/basis/compiler/tests/folding.factor
@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel classes.mixin arrays ;
-IN: compiler.tests
+IN: compiler.tests.folding
 
 ! Calls to generic words were not folded away.
 
diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor
index 93860db924..a6e827ea33 100644
--- a/basis/compiler/tests/intrinsics.factor
+++ b/basis/compiler/tests/intrinsics.factor
@@ -6,7 +6,7 @@ sbufs strings.private slots.private alien math.order
 alien.accessors alien.c-types alien.syntax alien.strings
 namespaces libc sequences.private io.encodings.ascii
 classes compiler ;
-IN: compiler.tests
+IN: compiler.tests.intrinsics
 
 ! Make sure that intrinsic ops compile to correct code.
 [ ] [ 1 [ drop ] compile-call ] unit-test
diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor
index 99bdb18812..bd7008f909 100644
--- a/basis/compiler/tests/optimizer.factor
+++ b/basis/compiler/tests/optimizer.factor
@@ -5,7 +5,7 @@ quotations classes classes.algebra classes.tuple.private
 continuations growable namespaces hints alien.accessors
 compiler.tree.builder compiler.tree.optimizer sequences.deep
 compiler ;
-IN: optimizer.tests
+IN: compiler.tests.optimizer
 
 GENERIC: xyz ( obj -- obj )
 M: array xyz xyz ;
diff --git a/basis/compiler/tests/peg-regression-2.factor b/basis/compiler/tests/peg-regression-2.factor
index 1efadba3aa..7929d9e6f6 100644
--- a/basis/compiler/tests/peg-regression-2.factor
+++ b/basis/compiler/tests/peg-regression-2.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.peg-regression-2
 USING: peg.ebnf strings tools.test ;
 
 GENERIC: <times> ( times -- term' )
@@ -12,4 +12,4 @@ Regexp = Times:t => [[ t <times> ]]
 
 ;EBNF
 
-[ "foo" ] [ "a" parse-regexp ] unit-test
\ No newline at end of file
+[ "foo" ] [ "a" parse-regexp ] unit-test
diff --git a/basis/compiler/tests/peg-regression.factor b/basis/compiler/tests/peg-regression.factor
index 56a4021eed..e107135305 100644
--- a/basis/compiler/tests/peg-regression.factor
+++ b/basis/compiler/tests/peg-regression.factor
@@ -5,7 +5,7 @@
 ! end of a compilation unit.
 
 USING: kernel accessors peg.ebnf ;
-IN: compiler.tests
+IN: compiler.tests.peg-regression
 
 TUPLE: pipeline-expr background ;
 
diff --git a/basis/compiler/tests/redefine0.factor b/basis/compiler/tests/redefine0.factor
index 87b63aa029..3d7a05a74b 100644
--- a/basis/compiler/tests/redefine0.factor
+++ b/basis/compiler/tests/redefine0.factor
@@ -104,4 +104,4 @@ quot global delete-at
         \ test-11 forget
         \ quot forget
     ] with-compilation-unit
-] unit-test
\ No newline at end of file
+] unit-test
diff --git a/basis/compiler/tests/redefine1.factor b/basis/compiler/tests/redefine1.factor
index a28b183fb6..af0fd52a47 100644
--- a/basis/compiler/tests/redefine1.factor
+++ b/basis/compiler/tests/redefine1.factor
@@ -1,7 +1,7 @@
 USING: accessors compiler compiler.units tools.test math parser
 kernel sequences sequences.private classes.mixin generic
 definitions arrays words assocs eval strings ;
-IN: compiler.tests
+IN: compiler.tests.redefine1
 
 GENERIC: method-redefine-generic-1 ( a -- b )
 
diff --git a/basis/compiler/tests/redefine10.factor b/basis/compiler/tests/redefine10.factor
index faae7b8ed1..66edd75097 100644
--- a/basis/compiler/tests/redefine10.factor
+++ b/basis/compiler/tests/redefine10.factor
@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine10
 
 ! Mixin redefinition did not recompile all necessary words.
 
diff --git a/basis/compiler/tests/redefine11.factor b/basis/compiler/tests/redefine11.factor
index 57f9f9caf0..dbec57e3d5 100644
--- a/basis/compiler/tests/redefine11.factor
+++ b/basis/compiler/tests/redefine11.factor
@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel classes.mixin arrays ;
-IN: compiler.tests
+IN: compiler.tests.redefine11
 
 ! Mixin redefinition did not recompile all necessary words.
 
diff --git a/basis/compiler/tests/redefine15.factor b/basis/compiler/tests/redefine15.factor
index 797460a411..33aa080bac 100644
--- a/basis/compiler/tests/redefine15.factor
+++ b/basis/compiler/tests/redefine15.factor
@@ -17,4 +17,4 @@ DEFER: word-1
 
 [ \ word-3 [ [ 2 + ] bi@ ] (( a b -- c d )) define-declared ] with-compilation-unit
 
-[ 2 3 ] [ 0 word-4 ] unit-test
\ No newline at end of file
+[ 2 3 ] [ 0 word-4 ] unit-test
diff --git a/basis/compiler/tests/redefine2.factor b/basis/compiler/tests/redefine2.factor
index 6a7b7a6941..f74ba46fd4 100644
--- a/basis/compiler/tests/redefine2.factor
+++ b/basis/compiler/tests/redefine2.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.redefine2
 USING: compiler compiler.units tools.test math parser kernel
 sequences sequences.private classes.mixin generic definitions
 arrays words assocs eval words.symbol ;
diff --git a/basis/compiler/tests/redefine3.factor b/basis/compiler/tests/redefine3.factor
index 87ab100879..a5962ff91a 100644
--- a/basis/compiler/tests/redefine3.factor
+++ b/basis/compiler/tests/redefine3.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.redefine3
 USING: accessors compiler compiler.units tools.test math parser
 kernel sequences sequences.private classes.mixin generic
 definitions arrays words assocs eval ;
diff --git a/basis/compiler/tests/redefine4.factor b/basis/compiler/tests/redefine4.factor
index 88b40f0c5a..5e0c6c0270 100644
--- a/basis/compiler/tests/redefine4.factor
+++ b/basis/compiler/tests/redefine4.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.redefine4
 USING: io.streams.string kernel tools.test eval ;
 
 : declaration-test-1 ( -- a ) 3 ; flushable
diff --git a/basis/compiler/tests/redefine5.factor b/basis/compiler/tests/redefine5.factor
index c390f9a1ec..7613987852 100644
--- a/basis/compiler/tests/redefine5.factor
+++ b/basis/compiler/tests/redefine5.factor
@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine5
 
 ! Regression: if dispatch was eliminated but method was not inlined,
 ! compiled usage information was not recorded.
diff --git a/basis/compiler/tests/redefine6.factor b/basis/compiler/tests/redefine6.factor
index 7f1be973e7..fdf3e7edbb 100644
--- a/basis/compiler/tests/redefine6.factor
+++ b/basis/compiler/tests/redefine6.factor
@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine6
 
 ! Mixin redefinition did not recompile all necessary words.
 
diff --git a/basis/compiler/tests/redefine7.factor b/basis/compiler/tests/redefine7.factor
index d6dfdf20fd..cfe29603f9 100644
--- a/basis/compiler/tests/redefine7.factor
+++ b/basis/compiler/tests/redefine7.factor
@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine7
 
 ! Mixin redefinition did not recompile all necessary words.
 
diff --git a/basis/compiler/tests/redefine8.factor b/basis/compiler/tests/redefine8.factor
index 3499c5070a..a79bfb5af5 100644
--- a/basis/compiler/tests/redefine8.factor
+++ b/basis/compiler/tests/redefine8.factor
@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine8
 
 ! Mixin redefinition did not recompile all necessary words.
 
diff --git a/basis/compiler/tests/redefine9.factor b/basis/compiler/tests/redefine9.factor
index 25ed5f15db..2598246472 100644
--- a/basis/compiler/tests/redefine9.factor
+++ b/basis/compiler/tests/redefine9.factor
@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel generic.math ;
-IN: compiler.tests
+IN: compiler.tests.redefine9
 
 ! Mixin redefinition did not recompile all necessary words.
 
diff --git a/basis/compiler/tests/reload.factor b/basis/compiler/tests/reload.factor
index b2b65b5868..62c7c31bc2 100644
--- a/basis/compiler/tests/reload.factor
+++ b/basis/compiler/tests/reload.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.reload
 USE: vocabs.loader
 
 ! "parser" reload
diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor
index 11b27979d5..82cc97e0f6 100644
--- a/basis/compiler/tests/simple.factor
+++ b/basis/compiler/tests/simple.factor
@@ -1,7 +1,7 @@
 USING: compiler compiler.units tools.test kernel kernel.private
 sequences.private math.private math combinators strings alien
 arrays memory vocabs parser eval ;
-IN: compiler.tests
+IN: compiler.tests.simple
 
 ! Test empty word
 [ ] [ [ ] compile-call ] unit-test
diff --git a/basis/compiler/tests/spilling.factor b/basis/compiler/tests/spilling.factor
index 4092352fd5..2ec6fbde95 100644
--- a/basis/compiler/tests/spilling.factor
+++ b/basis/compiler/tests/spilling.factor
@@ -1,6 +1,6 @@
 USING: math.private kernel combinators accessors arrays
 generalizations tools.test ;
-IN: compiler.tests
+IN: compiler.tests.spilling
 
 : float-spill-bug ( a -- b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b )
     {
diff --git a/basis/compiler/tests/stack-trace.factor b/basis/compiler/tests/stack-trace.factor
index b317ed3eb5..1cb11571ef 100755
--- a/basis/compiler/tests/stack-trace.factor
+++ b/basis/compiler/tests/stack-trace.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.stack-trace
 USING: compiler tools.test namespaces sequences
 kernel.private kernel math continuations continuations.private
 words splitting grouping sorting accessors ;
diff --git a/basis/compiler/tests/tuples.factor b/basis/compiler/tests/tuples.factor
index caa214b70c..fc249d99db 100644
--- a/basis/compiler/tests/tuples.factor
+++ b/basis/compiler/tests/tuples.factor
@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.tuples
 USING: kernel tools.test compiler.units compiler ;
 
 TUPLE: color red green blue ;

From dd15bd0fee3df59f137754361cb8647b198a561a Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sun, 26 Apr 2009 01:25:19 -0500
Subject: [PATCH 5/8] fix morse for characters that don't exist like "\n". 
 "resource:core/kernel/kernel.factor" utf8 file-contents play-as-morse  listen
 to factor!

---
 extra/morse/morse-tests.factor |  1 +
 extra/morse/morse.factor       | 11 +++++++----
 2 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/extra/morse/morse-tests.factor b/extra/morse/morse-tests.factor
index fd52df1c4d..13818a06a0 100644
--- a/extra/morse/morse-tests.factor
+++ b/extra/morse/morse-tests.factor
@@ -41,3 +41,4 @@ IN: morse.tests
     MORSE] ] unit-test
 ! [ ] [ "sos" 0.075 play-as-morse* ] unit-test
 ! [ ] [ "Factor rocks!" play-as-morse ] unit-test
+! [ ] [ "\n" play-as-morse ] unit-test
diff --git a/extra/morse/morse.factor b/extra/morse/morse.factor
index ef4b9d4b88..20989f2f2f 100644
--- a/extra/morse/morse.factor
+++ b/extra/morse/morse.factor
@@ -3,13 +3,15 @@
 USING: accessors ascii assocs biassocs combinators hashtables kernel lists literals math namespaces make multiline openal parser sequences splitting strings synth synth.buffers ;
 IN: morse
 
+ERROR: no-morse-code ch ;
+
 <PRIVATE
 
 CONSTANT: dot-char CHAR: .
 CONSTANT: dash-char CHAR: -
 CONSTANT: char-gap-char CHAR: \s
 CONSTANT: word-gap-char CHAR: /
-CONSTANT: unknown-char CHAR: ?
+CONSTANT: unknown-char "?"
 
 PRIVATE>
 
@@ -74,10 +76,10 @@ CONSTANT: morse-code-table $[
 ]
 
 : ch>morse ( ch -- morse )
-    ch>lower morse-code-table at [ unknown-char ] unless* ;
+    ch>lower morse-code-table at unknown-char or ;
 
 : morse>ch ( str -- ch )
-    morse-code-table value-at [ char-gap-char ] unless* ;
+    morse-code-table value-at char-gap-char or ;
     
 <PRIVATE
     
@@ -148,12 +150,13 @@ CONSTANT: beep-freq 880
         source get source-play
     ] with-scope ; inline
 
-: play-char ( ch -- )
+: play-char ( string -- )
     [ intra-char-gap ] [
         {
             { dot-char [ dot ] }
             { dash-char [ dash ] }
             { word-gap-char [ intra-char-gap ] }
+            [ drop intra-char-gap ]
         } case
     ] interleave ;
 

From 28cacc8d610cec9d605f47c9daba3a47d1bf0fac Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sun, 26 Apr 2009 02:23:33 -0500
Subject: [PATCH 6/8] fix some compiler tests

---
 basis/compiler/tests/redefine1.factor | 4 ++--
 basis/compiler/tests/redefine2.factor | 2 +-
 basis/compiler/tests/redefine3.factor | 2 +-
 basis/compiler/tests/redefine4.factor | 2 +-
 4 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/basis/compiler/tests/redefine1.factor b/basis/compiler/tests/redefine1.factor
index af0fd52a47..6bb623cac4 100644
--- a/basis/compiler/tests/redefine1.factor
+++ b/basis/compiler/tests/redefine1.factor
@@ -11,7 +11,7 @@ M: integer method-redefine-generic-1 3 + ;
 
 [ 6 ] [ method-redefine-test-1 ] unit-test
 
-[ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-generic-1 4 + ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine1 USE: math M: fixnum method-redefine-generic-1 4 + ;" eval( -- ) ] unit-test
 
 [ 7 ] [ method-redefine-test-1 ] unit-test
 
@@ -27,7 +27,7 @@ M: integer method-redefine-generic-2 3 + ;
 
 [ 6 ] [ method-redefine-test-2 ] unit-test
 
-[ ] [ "IN: compiler.tests USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine1 USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" eval( -- ) ] unit-test
 
 [ 7 ] [ method-redefine-test-2 ] unit-test
 
diff --git a/basis/compiler/tests/redefine2.factor b/basis/compiler/tests/redefine2.factor
index f74ba46fd4..9112a1e1af 100644
--- a/basis/compiler/tests/redefine2.factor
+++ b/basis/compiler/tests/redefine2.factor
@@ -5,7 +5,7 @@ arrays words assocs eval words.symbol ;
 
 DEFER: redefine2-test
 
-[ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval( -- ) ] unit-test
+[ ] [ "USE: sequences USE: kernel IN: compiler.tests.redefine2 TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval( -- ) ] unit-test
 
 [ t ] [ \ redefine2-test symbol? ] unit-test
 
diff --git a/basis/compiler/tests/redefine3.factor b/basis/compiler/tests/redefine3.factor
index a5962ff91a..51ce33c1bd 100644
--- a/basis/compiler/tests/redefine3.factor
+++ b/basis/compiler/tests/redefine3.factor
@@ -18,7 +18,7 @@ M: empty-mixin sheeple drop "wake up" ;
 [ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
 [ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
 
-[ ] [ "IN: compiler.tests USE: arrays INSTANCE: array empty-mixin" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine3 USE: arrays INSTANCE: array empty-mixin" eval( -- ) ] unit-test
 
 [ "wake up" ] [ sheeple-test ] unit-test
 [ f ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
diff --git a/basis/compiler/tests/redefine4.factor b/basis/compiler/tests/redefine4.factor
index 5e0c6c0270..2320f64af6 100644
--- a/basis/compiler/tests/redefine4.factor
+++ b/basis/compiler/tests/redefine4.factor
@@ -7,6 +7,6 @@ USING: io.streams.string kernel tools.test eval ;
 
 [ "" ] [ [ declaration-test ] with-string-writer ] unit-test
 
-[ ] [ "IN: compiler.tests USE: io : declaration-test-1 ( -- a ) \"X\" write f ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine4 USE: io : declaration-test-1 ( -- a ) \"X\" write f ;" eval( -- ) ] unit-test
 
 [ "X" ] [ [ declaration-test ] with-string-writer ] unit-test

From fc8b04466a70e6729b964976945d4438979bd588 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sun, 26 Apr 2009 03:26:15 -0500
Subject: [PATCH 7/8] fix morse unit test

---
 extra/morse/morse-tests.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/morse/morse-tests.factor b/extra/morse/morse-tests.factor
index 13818a06a0..f1da7ce139 100644
--- a/extra/morse/morse-tests.factor
+++ b/extra/morse/morse-tests.factor
@@ -3,7 +3,7 @@
 USING: arrays morse strings tools.test ;
 IN: morse.tests
 
-[ CHAR: ? ] [ CHAR: \\ ch>morse ] unit-test
+[ "?" ] [ CHAR: \\ ch>morse ] unit-test
 [ "..." ] [ CHAR: s ch>morse ] unit-test
 [ CHAR: s ] [ "..." morse>ch ] unit-test
 [ CHAR: \s ] [ "..--..--.." morse>ch ] unit-test

From 5f756a8019c208e268737282d5a3b93b08a2b658 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 26 Apr 2009 09:15:58 -0500
Subject: [PATCH 8/8] Code GC: segregated free list for faster allocation,
 combine unmark/build free list/update literals passes into one pass for
 faster deallocation

---
 vm/code_gc.c | 166 ++++++++++++++++++++++++++++++++-------------------
 vm/code_gc.h |  14 ++++-
 vm/data_gc.c |   9 +--
 3 files changed, 119 insertions(+), 70 deletions(-)

diff --git a/vm/code_gc.c b/vm/code_gc.c
index c3c5bc9a10..e7fcfd3289 100755
--- a/vm/code_gc.c
+++ b/vm/code_gc.c
@@ -1,5 +1,10 @@
 #include "master.h"
 
+static void clear_free_list(F_HEAP *heap)
+{
+	memset(&heap->free,0,sizeof(F_HEAP_FREE_LIST));
+}
+
 /* This malloc-style heap code is reasonably generic. Maybe in the future, it
 will be used for the data heap too, if we ever get incremental
 mark/sweep/compact GC. */
@@ -8,17 +13,23 @@ void new_heap(F_HEAP *heap, CELL size)
 	heap->segment = alloc_segment(align_page(size));
 	if(!heap->segment)
 		fatal_error("Out of memory in new_heap",size);
-	heap->free_list = NULL;
+
+	clear_free_list(heap);
 }
 
-/* If there is no previous block, next_free becomes the head of the free list,
-else its linked in */
-INLINE void update_free_list(F_HEAP *heap, F_FREE_BLOCK *prev, F_FREE_BLOCK *next_free)
+void add_to_free_list(F_HEAP *heap, F_FREE_BLOCK *block)
 {
-	if(prev)
-		prev->next_free = next_free;
+	if(block->block.size < FREE_LIST_COUNT * BLOCK_SIZE_INCREMENT)
+	{
+		int index = block->block.size / BLOCK_SIZE_INCREMENT;
+		block->next_free = heap->free.small[index];
+		heap->free.small[index] = block;
+	}
 	else
-		heap->free_list = next_free;
+	{
+		block->next_free = heap->free.large;
+		heap->free.large = block;
+	}
 }
 
 /* Called after reading the code heap from the image file, and after code GC.
@@ -28,7 +39,11 @@ compiling.limit. */
 void build_free_list(F_HEAP *heap, CELL size)
 {
 	F_BLOCK *prev = NULL;
-	F_FREE_BLOCK *prev_free = NULL;
+
+	clear_free_list(heap);
+
+	size = (size + BLOCK_SIZE_INCREMENT - 1) & ~(BLOCK_SIZE_INCREMENT - 1);
+
 	F_BLOCK *scan = first_block(heap);
 	F_FREE_BLOCK *end = (F_FREE_BLOCK *)(heap->segment->start + size);
 
@@ -38,8 +53,7 @@ void build_free_list(F_HEAP *heap, CELL size)
 		switch(scan->status)
 		{
 		case B_FREE:
-			update_free_list(heap,prev_free,(F_FREE_BLOCK *)scan);
-			prev_free = (F_FREE_BLOCK *)scan;
+			add_to_free_list(heap,(F_FREE_BLOCK *)scan);
 			break;
 		case B_ALLOCATED:
 			break;
@@ -58,10 +72,9 @@ void build_free_list(F_HEAP *heap, CELL size)
 	{
 		end->block.status = B_FREE;
 		end->block.size = heap->segment->end - (CELL)end;
-		end->next_free = NULL;
 
 		/* add final free block */
-		update_free_list(heap,prev_free,end);
+		add_to_free_list(heap,end);
 	}
 	/* This branch is taken if the newly loaded image fits exactly, or
 	after code GC */
@@ -70,63 +83,88 @@ void build_free_list(F_HEAP *heap, CELL size)
 		/* even if there's no room at the end of the heap for a new
 		free block, we might have to jigger it up by a few bytes in
 		case prev + prev->size */
-		if(prev)
-			prev->size = heap->segment->end - (CELL)prev;
-
-		/* this is the last free block */
-		update_free_list(heap,prev_free,NULL);
+		if(prev) prev->size = heap->segment->end - (CELL)prev;
 	}
 
 }
 
+static void assert_free_block(F_FREE_BLOCK *block)
+{
+	if(block->block.status != B_FREE)
+		critical_error("Invalid block in free list",(CELL)block);
+}
+		
+F_FREE_BLOCK *find_free_block(F_HEAP *heap, CELL size)
+{
+	CELL attempt = size;
+
+	while(attempt < FREE_LIST_COUNT * BLOCK_SIZE_INCREMENT)
+	{
+		int index = attempt / BLOCK_SIZE_INCREMENT;
+		F_FREE_BLOCK *block = heap->free.small[index];
+		if(block)
+		{
+			assert_free_block(block);
+			heap->free.small[index] = block->next_free;
+			return block;
+		}
+
+		attempt *= 2;
+	}
+
+	F_FREE_BLOCK *prev = NULL;
+	F_FREE_BLOCK *block = heap->free.large;
+
+	while(block)
+	{
+		assert_free_block(block);
+		if(block->block.size >= size)
+		{
+			if(prev)
+				prev->next_free = block->next_free;
+			else
+				heap->free.large = block->next_free;
+			return block;
+		}
+
+		prev = block;
+		block = block->next_free;
+	}
+
+	return NULL;
+}
+
+F_FREE_BLOCK *split_free_block(F_HEAP *heap, F_FREE_BLOCK *block, CELL size)
+{
+	if(block->block.size != size )
+	{
+		/* split the block in two */
+		F_FREE_BLOCK *split = (F_FREE_BLOCK *)((CELL)block + size);
+		split->block.status = B_FREE;
+		split->block.size = block->block.size - size;
+		split->next_free = block->next_free;
+		block->block.size = size;
+		add_to_free_list(heap,split);
+	}
+
+	return block;
+}
+
 /* Allocate a block of memory from the mark and sweep GC heap */
 F_BLOCK *heap_allot(F_HEAP *heap, CELL size)
 {
-	F_FREE_BLOCK *prev = NULL;
-	F_FREE_BLOCK *scan = heap->free_list;
+	size = (size + BLOCK_SIZE_INCREMENT - 1) & ~(BLOCK_SIZE_INCREMENT - 1);
 
-	size = (size + 31) & ~31;
-
-	while(scan)
+	F_FREE_BLOCK *block = find_free_block(heap,size);
+	if(block)
 	{
-		if(scan->block.status != B_FREE)
-			critical_error("Invalid block in free list",(CELL)scan);
+		block = split_free_block(heap,block,size);
 
-		if(scan->block.size < size)
-		{
-			prev = scan;
-			scan = scan->next_free;
-			continue;
-		}
-
-		/* we found a candidate block */
-		F_FREE_BLOCK *next_free;
-
-		if(scan->block.size - size <= sizeof(F_BLOCK) * 2)
-		{
-			/* too small to be split */
-			next_free = scan->next_free;
-		}
-		else
-		{
-			/* split the block in two */
-			F_FREE_BLOCK *split = (F_FREE_BLOCK *)((CELL)scan + size);
-			split->block.status = B_FREE;
-			split->block.size = scan->block.size - size;
-			split->next_free = scan->next_free;
-			scan->block.size = size;
-			next_free = split;
-		}
-
-		/* update the free list */
-		update_free_list(heap,prev,next_free);
-
-		/* this is our new block */
-		scan->block.status = B_ALLOCATED;
-		return &scan->block;
+		block->block.status = B_ALLOCATED;
+		return &block->block;
 	}
-
-	return NULL;
+	else
+		return NULL;
 }
 
 void mark_block(F_BLOCK *block)
@@ -162,8 +200,10 @@ void unmark_marked(F_HEAP *heap)
 
 /* After code GC, all referenced code blocks have status set to B_MARKED, so any
 which are allocated and not marked can be reclaimed. */
-void free_unmarked(F_HEAP *heap)
+void free_unmarked(F_HEAP *heap, HEAP_ITERATOR iter)
 {
+	clear_free_list(heap);
+
 	F_BLOCK *prev = NULL;
 	F_BLOCK *scan = first_block(heap);
 
@@ -183,10 +223,15 @@ void free_unmarked(F_HEAP *heap)
 		case B_FREE:
 			if(prev && prev->status == B_FREE)
 				prev->size += scan->size;
+			else
+				prev = scan;
 			break;
 		case B_MARKED:
+			if(prev && prev->status == B_FREE)
+				add_to_free_list(heap,(F_FREE_BLOCK *)prev);
 			scan->status = B_ALLOCATED;
 			prev = scan;
+			iter(scan);
 			break;
 		default:
 			critical_error("Invalid scan->status",(CELL)scan);
@@ -195,7 +240,8 @@ void free_unmarked(F_HEAP *heap)
 		scan = next_block(heap,scan);
 	}
 
-	build_free_list(heap,heap->segment->size);
+	if(prev && prev->status == B_FREE)
+		add_to_free_list(heap,(F_FREE_BLOCK *)prev);
 }
 
 /* Compute total sum of sizes of free blocks, and size of largest free block */
diff --git a/vm/code_gc.h b/vm/code_gc.h
index cc2c42f120..9b1e768a7b 100644
--- a/vm/code_gc.h
+++ b/vm/code_gc.h
@@ -1,14 +1,24 @@
+#define FREE_LIST_COUNT 16
+#define BLOCK_SIZE_INCREMENT 32
+
+typedef struct {
+	F_FREE_BLOCK *small[FREE_LIST_COUNT];
+	F_FREE_BLOCK *large;
+} F_HEAP_FREE_LIST;
+
 typedef struct {
 	F_SEGMENT *segment;
-	F_FREE_BLOCK *free_list;
+	F_HEAP_FREE_LIST free;
 } F_HEAP;
 
+typedef void (*HEAP_ITERATOR)(F_BLOCK *compiled);
+
 void new_heap(F_HEAP *heap, CELL size);
 void build_free_list(F_HEAP *heap, CELL size);
 F_BLOCK *heap_allot(F_HEAP *heap, CELL size);
 void mark_block(F_BLOCK *block);
 void unmark_marked(F_HEAP *heap);
-void free_unmarked(F_HEAP *heap);
+void free_unmarked(F_HEAP *heap, HEAP_ITERATOR iter);
 void heap_usage(F_HEAP *heap, CELL *used, CELL *total_free, CELL *max_free);
 CELL heap_size(F_HEAP *heap);
 CELL compute_heap_forwarding(F_HEAP *heap);
diff --git a/vm/data_gc.c b/vm/data_gc.c
index 50f38bc881..3ab2055d82 100755
--- a/vm/data_gc.c
+++ b/vm/data_gc.c
@@ -416,13 +416,6 @@ void end_gc(CELL gc_elapsed)
 		reset_generations(NURSERY,collecting_gen);
 	}
 
-	if(collecting_gen == TENURED)
-	{
-		/* now that all reachable code blocks have been marked,
-		deallocate the rest */
-		free_unmarked(&code_heap);
-	}
-
 	collecting_aging_again = false;
 }
 
@@ -491,7 +484,7 @@ void garbage_collection(CELL gen,
 		code_heap_scans++;
 
 		if(collecting_gen == TENURED)
-			update_code_heap_roots();
+			free_unmarked(&code_heap,(HEAP_ITERATOR)update_literal_references);
 		else
 			copy_code_heap_roots();