From f8c99c864b05ac79a66dc77cca5c318970983c8a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 14 Feb 2008 15:17:01 -0600
Subject: [PATCH 01/11] Loop conversion work in progress
---
core/optimizer/control/control.factor | 62 ++++++++++++++-------------
core/optimizer/optimizer-tests.factor | 22 ++++++++++
2 files changed, 55 insertions(+), 29 deletions(-)
diff --git a/core/optimizer/control/control.factor b/core/optimizer/control/control.factor
index de3aeb220a..eed69f243b 100755
--- a/core/optimizer/control/control.factor
+++ b/core/optimizer/control/control.factor
@@ -135,15 +135,6 @@ M: #call-label detect-loops*
r> [ set-node-successor ] keep ;
! ! ! Lifting code after a conditional if one branch throws
-: only-one ( seq -- elt/f )
- dup length 1 = [ first ] [ drop f ] if ;
-
-: lift-throw-tail? ( #if -- tail/? )
- dup node-successor #tail?
- [ drop f ] [ active-children only-one ] if ;
-
-: clone-node ( node -- newnode )
- clone dup [ clone ] modify-values ;
! BEFORE
!
@@ -177,7 +168,17 @@ M: #call-label detect-loops*
! the same node as (***)
!
! Note: if (**) is #return is is sound to put #terminate there,
-! but not if (**) is #values
+! but not if (**) is #
+
+: only-one ( seq -- elt/f )
+ dup length 1 = [ first ] [ drop f ] if ;
+
+: lift-throw-tail? ( #if -- tail/? )
+ dup node-successor #tail?
+ [ drop f ] [ active-children only-one ] if ;
+
+: clone-node ( node -- newnode )
+ clone dup [ clone ] modify-values ;
: lift-branch
over
@@ -196,20 +197,6 @@ M: #if optimize-node*
] if
] if ;
-: fold-dispatch-branch? dup node-in-d first tuck node-literal? ;
-
-: fold-dispatch-branch ( node value -- node' )
- dupd node-literal
- over drop-inputs >r fold-branch r>
- [ set-node-successor ] keep ;
-
-M: #dispatch optimize-node*
- dup fold-dispatch-branch? [
- fold-dispatch-branch t
- ] [
- 2drop t f
- ] if ;
-
! Loop tail hoising: code after a loop can sometimes go in the
! non-recursive branch of the loop
@@ -247,6 +234,27 @@ M: #dispatch optimize-node*
! |
! #return 1
+: find-tail
+ dup node-successor #tail?
+ [ node-successor find-tail ] unless ;
+
+: child-tails ( node -- seq )
+ node-children [ find-tail ] map ;
+
+GENERIC: add-loop-exit* ( label node -- )
+
+M: #branch add-loop-exit*
+ child-tails [ add-loop-exit* ] with each ;
+
+M: #call-label add-loop-exit* drop ;
+
+M: node add-loop-exit* node-successor add-loop-exit* , ;
+
+: find-loop-exits ( label node -- seq )
+ [ add-loop-exit* ] { } make ;
+
+! ! ! !
+
: find-final-if ( node -- #if/f )
dup [
dup #if? [
@@ -264,11 +272,7 @@ M: #dispatch optimize-node*
: lift-loop-tail? ( #label -- tail/f )
dup node-successor node-successor [
dup node-param swap node-child find-final-if dup [
- node-children [ penultimate-node ] map
- [
- dup #call-label?
- [ node-param eq? not ] [ 2drop t ] if
- ] with subset only-one
+ find-loop-exits only-one
] [ 2drop f ] if
] [ drop f ] if ;
diff --git a/core/optimizer/optimizer-tests.factor b/core/optimizer/optimizer-tests.factor
index 6a76892246..c997a6eb51 100755
--- a/core/optimizer/optimizer-tests.factor
+++ b/core/optimizer/optimizer-tests.factor
@@ -329,3 +329,25 @@ TUPLE: silly-tuple a b ;
10 [ ] lift-loop-tail-test-1 1 2 3 ;
[ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test
+
+! Make sure we don't lose
+GENERIC: generic-inline-test ( x -- y )
+M: integer generic-inline-test ;
+
+: generic-inline-test-1
+ 1
+ generic-inline-test
+ generic-inline-test
+ generic-inline-test
+ generic-inline-test
+ generic-inline-test
+ generic-inline-test
+ generic-inline-test
+ generic-inline-test
+ generic-inline-test
+ generic-inline-test ;
+
+[ { t f } ] [
+ \ generic-inline-test-1 word-def dataflow
+ [ optimize-1 , optimize-1 , drop ] { } make
+] unit-test
From 3696ce8168beb51d530d78b5d16a203e49a2bb96 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 14 Feb 2008 15:19:13 -0600
Subject: [PATCH 02/11] Clarify docs
---
core/threads/threads-docs.factor | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
mode change 100644 => 100755 core/threads/threads-docs.factor
diff --git a/core/threads/threads-docs.factor b/core/threads/threads-docs.factor
old mode 100644
new mode 100755
index 181979bfed..ece90d9a11
--- a/core/threads/threads-docs.factor
+++ b/core/threads/threads-docs.factor
@@ -9,6 +9,7 @@ $nl
{ $subsection in-thread }
{ $subsection yield }
{ $subsection sleep }
+"Threads stop either when the quotation given to " { $link in-thread } " returns, or when the following word is called:"
{ $subsection stop }
"Continuations can be added to the run queue directly:"
{ $subsection schedule-thread }
@@ -21,7 +22,8 @@ ABOUT: "threads"
HELP: run-queue
{ $values { "queue" dlist } }
-{ $description "Outputs the runnable thread queue. By convention, continuations are queued with " { $link push-front }
" and dequeued with " { $link pop-back } "." } ;
+{ $description "Outputs the runnable thread queue. By convention, continuations are queued with " { $link push-front }
+" and dequeued with " { $link pop-back } "." } ;
HELP: schedule-thread
{ $values { "continuation" "a continuation reified by " { $link callcc0 } } }
From d14ee13f64d4bfb72a502ab0c57700f1c7ad027d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 14 Feb 2008 17:46:04 -0600
Subject: [PATCH 03/11] Remove tail-dispatch? optimization since it was not
sound
---
core/compiler/tests/templates.factor | 17 ++++++++++++++++-
core/generator/generator.factor | 11 ++---------
2 files changed, 18 insertions(+), 10 deletions(-)
diff --git a/core/compiler/tests/templates.factor b/core/compiler/tests/templates.factor
index 74e5ab80a4..4be700f221 100755
--- a/core/compiler/tests/templates.factor
+++ b/core/compiler/tests/templates.factor
@@ -3,7 +3,7 @@ USING: arrays compiler kernel kernel.private math
hashtables.private math.private namespaces sequences
sequences.private tools.test namespaces.private slots.private
sequences.private byte-arrays alien alien.accessors layouts
-words definitions compiler.units ;
+words definitions compiler.units io combinators ;
IN: temporary
! Oops!
@@ -191,3 +191,18 @@ TUPLE: my-tuple ;
2 1
[ 2dup fixnum< [ >r die r> ] when ] compile-call
] unit-test
+
+! Regression
+: a-dummy drop "hi" print ;
+
+[ ] [
+ 1 [
+ dup 0 2 3dup pick >= [ >= ] [ 2drop f ] if [
+ drop - >fixnum {
+ [ a-dummy ]
+ [ a-dummy ]
+ [ a-dummy ]
+ } dispatch
+ ] [ 2drop no-case ] if
+ ] compile-call
+] unit-test
diff --git a/core/generator/generator.factor b/core/generator/generator.factor
index 8b6742e700..e6a6226afa 100755
--- a/core/generator/generator.factor
+++ b/core/generator/generator.factor
@@ -158,17 +158,10 @@ M: #if generate-node
] with-generator
] keep ;
-: tail-dispatch? ( node -- ? )
- #! Is the dispatch a jump to a tail call to a word?
- dup #call? swap node-successor #return? and ;
-
: dispatch-branches ( node -- )
node-children [
- dup tail-dispatch? [
- node-param
- ] [
- compiling-word get dispatch-branch
- ] if %dispatch-label
+ compiling-word get dispatch-branch
+ %dispatch-label
] each ;
: generate-dispatch ( node -- )
From f944f2b20c38bbf3a54f3534ea9181b775370d21 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.internal.stack-effects.com>
Date: Thu, 14 Feb 2008 17:56:47 -0600
Subject: [PATCH 04/11] Add experimental disassembler
---
core/alien/compiler/compiler.factor | 2 +-
core/words/words-docs.factor | 4 +--
extra/tools/disassembler/authors.txt | 1 +
extra/tools/disassembler/disassembler.factor | 31 ++++++++++++++++++++
extra/tools/disassembler/summary.txt | 1 +
extra/unix/unix.factor | 1 +
vm/types.c | 8 +++--
7 files changed, 42 insertions(+), 6 deletions(-)
create mode 100644 extra/tools/disassembler/authors.txt
create mode 100644 extra/tools/disassembler/disassembler.factor
create mode 100644 extra/tools/disassembler/summary.txt
diff --git a/core/alien/compiler/compiler.factor b/core/alien/compiler/compiler.factor
index 282a849c34..f68bdcf0a2 100755
--- a/core/alien/compiler/compiler.factor
+++ b/core/alien/compiler/compiler.factor
@@ -326,7 +326,7 @@ M: alien-callback-error summary
drop "Words calling ``alien-callback'' must be compiled with the optimizing compiler." ;
: callback-bottom ( node -- )
- alien-callback-xt [ word-xt <alien> ] curry
+ alien-callback-xt [ word-xt drop <alien> ] curry
recursive-state get infer-quot ;
\ alien-callback [
diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor
index 62848e46b2..91b5295427 100755
--- a/core/words/words-docs.factor
+++ b/core/words/words-docs.factor
@@ -245,8 +245,8 @@ HELP: remove-word-prop
{ $description "Removes a word property, so future lookups will output " { $link f } " until it is set again. Word property names are conventionally strings." }
{ $side-effects "word" } ;
-HELP: word-xt
-{ $values { "word" word } { "xt" "an execution token integer" } }
+HELP: word-xt ( word -- start end )
+{ $values { "word" word } { "start" "the word's start address" } { "end" "the word's end address" } }
{ $description "Outputs the machine code address of the word's definition." } ;
HELP: define-symbol
diff --git a/extra/tools/disassembler/authors.txt b/extra/tools/disassembler/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/extra/tools/disassembler/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/extra/tools/disassembler/disassembler.factor b/extra/tools/disassembler/disassembler.factor
new file mode 100644
index 0000000000..b7c88517c7
--- /dev/null
+++ b/extra/tools/disassembler/disassembler.factor
@@ -0,0 +1,31 @@
+USING: io.files io words alien kernel math.parser alien.syntax
+io.launcher system assocs arrays ;
+IN: tools.disassembler
+
+GENERIC: make-disassemble-cmd ( word -- file )
+
+M: word make-disassemble-cmd
+ word-xt 2array make-disassemble-cmd ;
+
+M: pair make-disassemble-cmd
+ "gdb.txt" resource-path [
+ [
+ "disassemble " write
+ [ number>string write bl ] each
+ ] with-file-out
+ ] keep ;
+
+: run-gdb ( cmds -- output )
+ [
+ +closed+ +stdin+ set
+ [
+ "gdb" ,
+ vm ,
+ getpid number>string ,
+ "-x" , ,
+ "-batch" ,
+ ] { } make +arguments+ set
+ ] { } make-assoc <process-stream> contents ;
+
+: disassemble ( word -- )
+ make-disassemble-cmd run-gdb write ;
diff --git a/extra/tools/disassembler/summary.txt b/extra/tools/disassembler/summary.txt
new file mode 100644
index 0000000000..f1a689c877
--- /dev/null
+++ b/extra/tools/disassembler/summary.txt
@@ -0,0 +1 @@
+Disassemble words using gdb
diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor
index 59141c1940..9d5a6122a2 100755
--- a/extra/unix/unix.factor
+++ b/extra/unix/unix.factor
@@ -125,6 +125,7 @@ FUNCTION: int futimes ( int id, timeval[2] times ) ;
FUNCTION: char* gai_strerror ( int ecode ) ;
FUNCTION: int getaddrinfo ( char* hostname, char* servname, addrinfo* hints, addrinfo** res ) ;
FUNCTION: char* getcwd ( char* buf, size_t size ) ;
+FUNCTION: pid_t getpid ;
FUNCTION: int getdtablesize ;
FUNCTION: gid_t getegid ;
FUNCTION: uid_t geteuid ;
diff --git a/vm/types.c b/vm/types.c
index 78e74535b8..fb61213385 100755
--- a/vm/types.c
+++ b/vm/types.c
@@ -70,11 +70,13 @@ DEFINE_PRIMITIVE(word)
dpush(tag_object(allot_word(vocab,name)));
}
-/* word-xt ( word -- xt ) */
+/* word-xt ( word -- start end ) */
DEFINE_PRIMITIVE(word_xt)
{
- F_WORD *word = untag_word(dpeek());
- drepl(allot_cell((CELL)word->xt));
+ F_WORD *word = untag_word(dpop());
+ F_COMPILED *code = word->code;
+ dpush(allot_cell((CELL)code + sizeof(F_COMPILED)));
+ dpush(allot_cell((CELL)code + sizeof(F_COMPILED) + code->code_length));
}
DEFINE_PRIMITIVE(wrapper)
From 15ba74aaf8f53a2ea5540bed0dc61f5c4e0f944f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.internal.stack-effects.com>
Date: Thu, 14 Feb 2008 20:27:04 -0600
Subject: [PATCH 05/11] Improved disassembler a bit
---
extra/tools/disassembler/authors.txt | 1 +
extra/tools/disassembler/disassembler.factor | 50 ++++++++++++--------
2 files changed, 32 insertions(+), 19 deletions(-)
diff --git a/extra/tools/disassembler/authors.txt b/extra/tools/disassembler/authors.txt
index 1901f27a24..ef44eb9634 100644
--- a/extra/tools/disassembler/authors.txt
+++ b/extra/tools/disassembler/authors.txt
@@ -1 +1,2 @@
Slava Pestov
+Jorge Acereda Macia
diff --git a/extra/tools/disassembler/disassembler.factor b/extra/tools/disassembler/disassembler.factor
index b7c88517c7..b74b2795cf 100644
--- a/extra/tools/disassembler/disassembler.factor
+++ b/extra/tools/disassembler/disassembler.factor
@@ -1,31 +1,43 @@
+! Copyright (C) 2008 Slava Pestov, Jorge Acereda Macia.
+! See http://factorcode.org/license.txt for BSD license.
USING: io.files io words alien kernel math.parser alien.syntax
-io.launcher system assocs arrays ;
+io.launcher system assocs arrays sequences namespaces qualified
+regexp system math ;
+QUALIFIED: unix
IN: tools.disassembler
-GENERIC: make-disassemble-cmd ( word -- file )
+: in-file "gdb-in.txt" resource-path ;
+
+: out-file "gdb-out.txt" resource-path ;
+
+GENERIC: make-disassemble-cmd ( obj -- )
M: word make-disassemble-cmd
- word-xt 2array make-disassemble-cmd ;
+ word-xt cell - 2array make-disassemble-cmd ;
M: pair make-disassemble-cmd
- "gdb.txt" resource-path [
- [
- "disassemble " write
- [ number>string write bl ] each
- ] with-file-out
- ] keep ;
+ in-file [
+ "attach " write
+ unix:getpid number>string print
-: run-gdb ( cmds -- output )
+ "disassemble " write
+ [ number>string write bl ] each
+ ] with-file-out ;
+
+: run-gdb ( -- lines )
[
+closed+ +stdin+ set
- [
- "gdb" ,
- vm ,
- getpid number>string ,
- "-x" , ,
- "-batch" ,
- ] { } make +arguments+ set
- ] { } make-assoc <process-stream> contents ;
+ out-file +stdout+ set
+ [ "gdb" , "-x" , in-file , "-batch" , ] { } make +arguments+ set
+ ] { } make-assoc run-process drop
+ out-file file-lines ;
+
+: relevant? ( line -- ? )
+ R/ 0x.*:.*/ matches? ;
+
+: tabs>spaces ( str -- str' )
+ [ dup CHAR: \t = [ drop CHAR: \s ] when ] map ;
: disassemble ( word -- )
- make-disassemble-cmd run-gdb write ;
+ make-disassemble-cmd run-gdb
+ [ relevant? ] subset [ tabs>spaces ] map [ print ] each ;
From 2a0df14200d11b3a3d568ec614f8af8fa4e909d3 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.internal.stack-effects.com>
Date: Thu, 14 Feb 2008 20:27:18 -0600
Subject: [PATCH 06/11] Control flow analysis work in progress
---
core/inference/dataflow/dataflow-docs.factor | 3 +-
core/inference/dataflow/dataflow.factor | 6 +-
core/inference/known-words/known-words.factor | 2 +-
core/optimizer/control/control-tests.factor | 88 ++++++++++++++++++-
core/optimizer/control/control.factor | 22 +++--
core/optimizer/optimizer-tests.factor | 2 +-
6 files changed, 110 insertions(+), 13 deletions(-)
diff --git a/core/inference/dataflow/dataflow-docs.factor b/core/inference/dataflow/dataflow-docs.factor
index 0f809fa2bd..66b3590253 100755
--- a/core/inference/dataflow/dataflow-docs.factor
+++ b/core/inference/dataflow/dataflow-docs.factor
@@ -1,4 +1,5 @@
-USING: inference.dataflow help.syntax help.markup ;
+USING: help.syntax help.markup ;
+IN: inference.dataflow
HELP: #return
{ $values { "label" "a word or " { $link f } } { "node" "a new " { $link node } } }
diff --git a/core/inference/dataflow/dataflow.factor b/core/inference/dataflow/dataflow.factor
index 9bca648b08..23b5343c9c 100755
--- a/core/inference/dataflow/dataflow.factor
+++ b/core/inference/dataflow/dataflow.factor
@@ -317,4 +317,8 @@ UNION: #tail
POSTPONE: f #return #tail-values #tail-merge #terminate ;
: tail-call? ( -- ? )
- node-stack get [ node-successor #tail? ] all? ;
+ #! We don't consider calls which do non-local exits to be
+ #! tail calls, because this gives better error traces.
+ node-stack get [
+ node-successor dup #tail? swap #terminate? not and
+ ] all? ;
diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor
index e6479d0c6a..9d0f959b68 100755
--- a/core/inference/known-words/known-words.factor
+++ b/core/inference/known-words/known-words.factor
@@ -345,7 +345,7 @@ M: object infer-call
\ <word> { object object } { word } <effect> set-primitive-effect
\ <word> make-flushable
-\ word-xt { word } { integer } <effect> set-primitive-effect
+\ word-xt { word } { integer integer } <effect> set-primitive-effect
\ word-xt make-flushable
\ getenv { fixnum } { object } <effect> set-primitive-effect
diff --git a/core/optimizer/control/control-tests.factor b/core/optimizer/control/control-tests.factor
index 2d52e6f45a..ab5c055fbd 100644
--- a/core/optimizer/control/control-tests.factor
+++ b/core/optimizer/control/control-tests.factor
@@ -1,6 +1,7 @@
IN: temporary
USING: tools.test optimizer.control combinators kernel
-sequences inference.dataflow math inference ;
+sequences inference.dataflow math inference classes strings
+optimizer ;
: label-is-loop? ( node word -- ? )
[
@@ -60,3 +61,88 @@ sequences inference.dataflow math inference ;
[ loop-test-3 ] dataflow dup detect-loops
\ loop-test-3 label-is-not-loop?
] unit-test
+
+: loop-test-4 ( a -- )
+ dup [
+ loop-test-4
+ ] [
+ drop
+ ] if ; inline
+
+: find-label ( node -- label )
+ dup #label? [ node-successor find-label ] unless ;
+
+: test-loop-exits
+ dataflow dup detect-loops find-label
+ dup node-param swap
+ [ node-child find-tail find-loop-exits [ class ] map ] keep
+ #label-loop? ;
+
+[ { #values } t ] [
+ [ loop-test-4 ] test-loop-exits
+] unit-test
+
+: loop-test-5 ( a -- )
+ dup [
+ dup string? [
+ loop-test-5
+ ] [
+ drop
+ ] if
+ ] [
+ drop
+ ] if ; inline
+
+[ { #values #values } t ] [
+ [ loop-test-5 ] test-loop-exits
+] unit-test
+
+: loop-test-6 ( a -- )
+ dup [
+ dup string? [
+ loop-test-6
+ ] [
+ 3 throw
+ ] if
+ ] [
+ drop
+ ] if ; inline
+
+[ { #values } t ] [
+ [ loop-test-6 ] test-loop-exits
+] unit-test
+
+[ f ] [
+ [ [ [ ] map ] map ] dataflow optimize
+ [ dup #label? swap #loop? not and ] node-exists?
+] unit-test
+
+: blah f ;
+
+DEFER: a
+
+: b ( -- )
+ blah [ b ] [ a ] if ; inline
+
+: a ( -- )
+ blah [ b ] [ a ] if ; inline
+
+[ t ] [
+ [ a ] dataflow dup detect-loops
+ \ a label-is-loop?
+] unit-test
+
+[ t ] [
+ [ a ] dataflow dup detect-loops
+ \ b label-is-loop?
+] unit-test
+
+[ t ] [
+ [ b ] dataflow dup detect-loops
+ \ a label-is-loop?
+] unit-test
+
+[ t ] [
+ [ a ] dataflow dup detect-loops
+ \ b label-is-loop?
+] unit-test
diff --git a/core/optimizer/control/control.factor b/core/optimizer/control/control.factor
index eed69f243b..c9b3458d2a 100755
--- a/core/optimizer/control/control.factor
+++ b/core/optimizer/control/control.factor
@@ -68,7 +68,7 @@ M: #label detect-loops* t swap set-#label-loop? ;
node-stack get
dup [ #label? ] find-last drop [ 1+ ] [ 0 ] if* tail
[ node-successor #tail? ] all? ;
-
+USE: io
: detect-loop ( seen-other? label node -- seen-other? continue? )
#! seen-other?: have we seen another label?
{
@@ -234,9 +234,12 @@ M: #if optimize-node*
! |
! #return 1
-: find-tail
- dup node-successor #tail?
- [ node-successor find-tail ] unless ;
+: find-tail ( node -- tail )
+ dup #terminate? [
+ dup node-successor #tail? [
+ node-successor find-tail
+ ] unless
+ ] unless ;
: child-tails ( node -- seq )
node-children [ find-tail ] map ;
@@ -246,15 +249,18 @@ GENERIC: add-loop-exit* ( label node -- )
M: #branch add-loop-exit*
child-tails [ add-loop-exit* ] with each ;
-M: #call-label add-loop-exit* drop ;
+M: #call-label add-loop-exit*
+ tuck node-param eq? [ drop ] [ node-successor , ] if ;
-M: node add-loop-exit* node-successor add-loop-exit* , ;
+M: #terminate add-loop-exit*
+ 2drop ;
+
+M: node add-loop-exit*
+ nip node-successor dup #terminate? [ drop ] [ , ] if ;
: find-loop-exits ( label node -- seq )
[ add-loop-exit* ] { } make ;
-! ! ! !
-
: find-final-if ( node -- #if/f )
dup [
dup #if? [
diff --git a/core/optimizer/optimizer-tests.factor b/core/optimizer/optimizer-tests.factor
index c997a6eb51..7092797acc 100755
--- a/core/optimizer/optimizer-tests.factor
+++ b/core/optimizer/optimizer-tests.factor
@@ -2,7 +2,7 @@ USING: arrays compiler generic hashtables inference kernel
kernel.private math optimizer prettyprint sequences sbufs
strings tools.test vectors words sequences.private quotations
optimizer.backend classes inference.dataflow tuples.private
-continuations growable optimizer.inlining ;
+continuations growable optimizer.inlining namespaces ;
IN: temporary
[ H{ { 1 5 } { 3 4 } { 2 5 } } ] [
From 53c1ff1cc8092a5007474dc886424dda33d76add Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.internal.stack-effects.com>
Date: Thu, 14 Feb 2008 20:27:25 -0600
Subject: [PATCH 07/11] Make a word inline
---
core/sequences/sequences.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 967fcbbdc8..ee38d30750 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -257,7 +257,7 @@ INSTANCE: repetition immutable-sequence
: check-copy ( src n dst -- )
over 0 < [ bounds-error ] when
- >r swap length + r> lengthen ;
+ >r swap length + r> lengthen ; inline
PRIVATE>
From 333bf9ce16094b5cd55f4e8c4eead4128b16c81d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.internal.stack-effects.com>
Date: Thu, 14 Feb 2008 20:27:34 -0600
Subject: [PATCH 08/11] Clean up math combination
---
core/generic/math/math.factor | 11 +++++------
1 file changed, 5 insertions(+), 6 deletions(-)
diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor
index 2cc28ac0d1..0b2b9fcca3 100755
--- a/core/generic/math/math.factor
+++ b/core/generic/math/math.factor
@@ -58,16 +58,15 @@ TUPLE: no-math-method left right generic ;
2drop object-method
] if ;
-: math-vtable* ( picker max quot -- quot )
+: math-vtable ( picker quot -- quot )
[
- rot , \ tag ,
- [ >r [ bootstrap-type>class ] map r> map % ] { } make ,
+ >r
+ , \ tag ,
+ num-tags get [ bootstrap-type>class ]
+ r> compose map ,
\ dispatch ,
] [ ] make ; inline
-: math-vtable ( picker quot -- quot )
- num-tags get swap math-vtable* ; inline
-
TUPLE: math-combination ;
M: math-combination make-default-method
From 9a459d3c124d223b54d6466542f7f9cd51012aa2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.internal.stack-effects.com>
Date: Thu, 14 Feb 2008 20:27:48 -0600
Subject: [PATCH 09/11] Updating unit tests
---
core/alien/structs/structs-tests.factor | 24 +++++++++++++-----------
core/compiler/tests/simple.factor | 3 +++
2 files changed, 16 insertions(+), 11 deletions(-)
diff --git a/core/alien/structs/structs-tests.factor b/core/alien/structs/structs-tests.factor
index b2da0e8392..b934cd56a3 100644
--- a/core/alien/structs/structs-tests.factor
+++ b/core/alien/structs/structs-tests.factor
@@ -9,18 +9,20 @@ C-STRUCT: bar
[ 36 ] [ "bar" heap-size ] unit-test
[ t ] [ \ <displaced-alien> "bar" c-type c-type-getter memq? ] unit-test
-C-STRUCT: align-test
- { "int" "x" }
- { "double" "y" } ;
+! This was actually only correct on Windows/x86:
-[ 16 ] [ "align-test" heap-size ] unit-test
-
-cell 4 = [
- C-STRUCT: one
- { "long" "a" } { "double" "b" } { "int" "c" } ;
-
- [ 24 ] [ "one" heap-size ] unit-test
-] when
+! C-STRUCT: align-test
+! { "int" "x" }
+! { "double" "y" } ;
+!
+! [ 16 ] [ "align-test" heap-size ] unit-test
+!
+! cell 4 = [
+! C-STRUCT: one
+! { "long" "a" } { "double" "b" } { "int" "c" } ;
+!
+! [ 24 ] [ "one" heap-size ] unit-test
+! ] when
: MAX_FOOS 30 ;
diff --git a/core/compiler/tests/simple.factor b/core/compiler/tests/simple.factor
index 1ed43120d3..6deed6c756 100755
--- a/core/compiler/tests/simple.factor
+++ b/core/compiler/tests/simple.factor
@@ -227,3 +227,6 @@ M: f single-combination-test-2 single-combination-test-4 ;
[ 3 ] [ t single-combination-test-2 ] unit-test
[ 3 ] [ 3 single-combination-test-2 ] unit-test
[ f ] [ f single-combination-test-2 ] unit-test
+
+! Regression
+[ 100 ] [ [ 100 [ [ ] times ] keep ] compile-call ] unit-test
From 1c63a443a3d5f7d499ad1e1dcace9b36ce6ae1be Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.internal.stack-effects.com>
Date: Thu, 14 Feb 2008 20:28:16 -0600
Subject: [PATCH 10/11] optimizer.debugger now shows which nodes are loops
---
extra/optimizer/debugger/debugger.factor | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/extra/optimizer/debugger/debugger.factor b/extra/optimizer/debugger/debugger.factor
index ebf14417c0..db65a678cf 100755
--- a/extra/optimizer/debugger/debugger.factor
+++ b/extra/optimizer/debugger/debugger.factor
@@ -82,7 +82,10 @@ M: #call node>quot #call>quot ;
M: #call-label node>quot #call>quot ;
M: #label node>quot
- [ "#label: " over node-param word-name append comment, ] 2keep
+ [
+ dup #label-loop? "#loop: " "#label: " ?
+ over node-param word-name append comment,
+ ] 2keep
node-child swap dataflow>quot , \ call , ;
M: #if node>quot
From d77c84be199fac59cc741d5ddb7939b8f7189788 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.internal.stack-effects.com>
Date: Thu, 14 Feb 2008 20:38:46 -0600
Subject: [PATCH 11/11] Move unicode.data:replace to sequences.lib and refactor
it
---
extra/sequences/lib/lib.factor | 3 +++
extra/tools/disassembler/disassembler.factor | 4 ++--
extra/unicode/data/data.factor | 10 ++++------
3 files changed, 9 insertions(+), 8 deletions(-)
diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor
index 1beec90b75..4c0ea04f24 100755
--- a/extra/sequences/lib/lib.factor
+++ b/extra/sequences/lib/lib.factor
@@ -205,3 +205,6 @@ PRIVATE>
: attempt-each ( seq quot -- result )
(each) iterate-prep (attempt-each-integer) ; inline
+
+: replace ( seq old new -- newseq )
+ [ pick pick = [ 2nip ] [ 2drop ] if ] 2curry map ;
diff --git a/extra/tools/disassembler/disassembler.factor b/extra/tools/disassembler/disassembler.factor
index b74b2795cf..641eae90c2 100644
--- a/extra/tools/disassembler/disassembler.factor
+++ b/extra/tools/disassembler/disassembler.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: io.files io words alien kernel math.parser alien.syntax
io.launcher system assocs arrays sequences namespaces qualified
-regexp system math ;
+regexp system math sequences.lib ;
QUALIFIED: unix
IN: tools.disassembler
@@ -36,7 +36,7 @@ M: pair make-disassemble-cmd
R/ 0x.*:.*/ matches? ;
: tabs>spaces ( str -- str' )
- [ dup CHAR: \t = [ drop CHAR: \s ] when ] map ;
+ CHAR: \t CHAR: \s replace ;
: disassemble ( word -- )
make-disassemble-cmd run-gdb
diff --git a/extra/unicode/data/data.factor b/extra/unicode/data/data.factor
index 3af3d927d7..419d3bcefd 100644
--- a/extra/unicode/data/data.factor
+++ b/extra/unicode/data/data.factor
@@ -1,6 +1,7 @@
-USING: assocs math kernel sequences io.files hashtables
-quotations splitting arrays math.parser combinators.lib hash2
-byte-arrays words namespaces words compiler.units parser ;
+USING: assocs math kernel sequences sequences.lib io.files
+hashtables quotations splitting arrays math.parser
+combinators.lib hash2 byte-arrays words namespaces words
+compiler.units parser ;
IN: unicode.data
<<
@@ -93,9 +94,6 @@ IN: unicode.data
: ascii-lower ( string -- lower )
[ dup CHAR: A CHAR: Z between? [ HEX: 20 + ] when ] map ;
-: replace ( seq old new -- newseq )
- swap rot [ 2dup = [ drop over ] when ] map 2nip ;
-
: process-names ( data -- names-hash )
1 swap (process-data)
[ ascii-lower CHAR: \s CHAR: - replace swap ] assoc-map