From 5fb227926c4a20145999ff0eec28626f1cf4bb99 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 26 Oct 2007 03:59:36 -0400
Subject: [PATCH 1/9] Fix odd hashtable growing behavior
---
core/hashtables/hashtables.factor | 12 ++++++------
1 file changed, 6 insertions(+), 6 deletions(-)
diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor
index 4761dcd88f..0eec1d6293 100644
--- a/core/hashtables/hashtables.factor
+++ b/core/hashtables/hashtables.factor
@@ -69,10 +69,10 @@ IN: hashtables
: hash-deleted+ ( hash -- )
dup hash-deleted 1+ swap set-hash-deleted ; inline
-: (set-hash) ( value key hash -- )
+: (set-hash) ( value key hash -- new? )
2dup new-key@
- [ rot hash-count+ ] [ rot drop ] if
- set-nth-pair ; inline
+ [ rot hash-count+ set-nth-pair t ]
+ [ rot drop set-nth-pair f ] if ; inline
: find-pair-next >r 2 fixnum+fast r> ; inline
@@ -94,10 +94,10 @@ IN: hashtables
: find-pair ( array quot -- key value ? ) 0 rot (find-pair) ; inline
: (rehash) ( hash array -- )
- [ swap pick (set-hash) f ] find-pair 2drop 2drop ;
+ [ swap pick (set-hash) drop f ] find-pair 2drop 2drop ;
: hash-large? ( hash -- ? )
- dup hash-count 1 fixnum+fast 3 fixnum*fast
+ dup hash-count 3 fixnum*fast
swap hash-array array-capacity > ;
: hash-stale? ( hash -- ? )
@@ -149,7 +149,7 @@ M: hashtable assoc-size ( hash -- n )
(rehash) ;
M: hashtable set-at ( value key hash -- )
- dup ?grow-hash (set-hash) ;
+ dup >r (set-hash) [ r> ?grow-hash ] [ r> drop ] if ;
: associate ( value key -- hash )
2 <hashtable> [ set-at ] keep ;
From 5cf331a345e2d696634eb8340304a35894156165 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 27 Oct 2007 14:43:17 -0400
Subject: [PATCH 2/9] Cleanup
---
core/io/buffers/buffers.factor | 11 +++++++----
core/optimizer/known-words/known-words.factor | 2 +-
2 files changed, 8 insertions(+), 5 deletions(-)
diff --git a/core/io/buffers/buffers.factor b/core/io/buffers/buffers.factor
index 7bca0678c6..cb897c26d8 100644
--- a/core/io/buffers/buffers.factor
+++ b/core/io/buffers/buffers.factor
@@ -51,12 +51,11 @@ TUPLE: buffer size ptr fill pos ;
: buffer>> ( buffer -- string )
dup (buffer>>) 0 rot buffer-reset ;
-: (buffer-until) ( start end alien separators -- n )
+: search-buffer-until ( start end alien separators -- n )
[ >r swap alien-unsigned-1 r> memq? ] 2curry find* drop ;
-: buffer-until ( separators buffer -- string separator )
- tuck { buffer-pos buffer-fill buffer-ptr } get-slots roll
- (buffer-until) [
+: finish-buffer-until ( buffer n -- string separator )
+ [
over buffer-pos -
over buffer>
swap buffer-pop
@@ -64,6 +63,10 @@ TUPLE: buffer size ptr fill pos ;
buffer>> f
] if* ;
+: buffer-until ( separators buffer -- string separator )
+ tuck { buffer-pos buffer-fill buffer-ptr } get-slots roll
+ search-buffer-until finish-buffer-until ;
+
: buffer-length ( buffer -- n )
dup buffer-fill swap buffer-pos - ;
diff --git a/core/optimizer/known-words/known-words.factor b/core/optimizer/known-words/known-words.factor
index 8ca92c05a3..dffe18e630 100755
--- a/core/optimizer/known-words/known-words.factor
+++ b/core/optimizer/known-words/known-words.factor
@@ -149,4 +149,4 @@ float-arrays combinators.private ;
\ >be { { fixnum bignum } fixnum } "specializer" set-word-prop
-\ (buffer-until) { fixnum fixnum simple-alien string } "specializer" set-word-prop
+\ search-buffer-until { fixnum fixnum simple-alien string } "specializer" set-word-prop
From 5a797c83ee10fef1537b575342bc797e32279c5f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 27 Oct 2007 14:43:30 -0400
Subject: [PATCH 3/9] tools.completion no longer depends on number tower
---
extra/tools/completion/completion.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/extra/tools/completion/completion.factor b/extra/tools/completion/completion.factor
index caa2eb42f1..4c19bbc8db 100644
--- a/extra/tools/completion/completion.factor
+++ b/extra/tools/completion/completion.factor
@@ -39,7 +39,7 @@ vectors words assocs combinators sorting ;
: score ( full fuzzy -- n )
dup [
- [ [ length ] 2apply - 15 swap [-] 3 / ] 2keep
+ [ [ length ] 2apply - 15 swap [-] 3 /f ] 2keep
runs [
[ 0 [ pick score-1 max ] reduce nip ] keep
length * +
@@ -50,7 +50,7 @@ vectors words assocs combinators sorting ;
: rank-completions ( results -- newresults )
sort-keys <reversed>
- [ 0 [ first max ] reduce 3 / ] keep
+ [ 0 [ first max ] reduce 3 /f ] keep
[ first < ] curry* subset
[ second ] map ;
From 748cb2c3184c7456ffb2f1ab26700cfa8d840e49 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 28 Oct 2007 00:28:46 -0400
Subject: [PATCH 4/9] Fix bug in match
---
extra/match/match-tests.factor | 2 ++
extra/match/match.factor | 9 ++++++---
2 files changed, 8 insertions(+), 3 deletions(-)
mode change 100644 => 100755 extra/match/match-tests.factor
mode change 100644 => 100755 extra/match/match.factor
diff --git a/extra/match/match-tests.factor b/extra/match/match-tests.factor
old mode 100644
new mode 100755
index 6761557cbe..d9162ae286
--- a/extra/match/match-tests.factor
+++ b/extra/match/match-tests.factor
@@ -5,6 +5,8 @@ IN: temporary
MATCH-VARS: ?a ?b ;
+[ f ] [ { ?a ?a } { 1 2 } match ] unit-test
+
[ H{ { ?a 1 } { ?b 2 } } ] [
{ ?a ?b } { 1 2 } match
] unit-test
diff --git a/extra/match/match.factor b/extra/match/match.factor
old mode 100644
new mode 100755
index 296bcf778b..0b4b2f1a0d
--- a/extra/match/match.factor
+++ b/extra/match/match.factor
@@ -3,7 +3,7 @@
!
! Based on pattern matching code from Paul Graham's book 'On Lisp'.
USING: parser kernel words namespaces sequences tuples
-combinators macros ;
+combinators macros assocs ;
IN: match
SYMBOL: _
@@ -22,10 +22,13 @@ SYMBOL: _
: match-var? ( symbol -- bool )
dup word? [ "match-var" word-prop ] [ drop f ] if ;
+: set-match-var ( value var -- ? )
+ dup namespace key? [ get = ] [ set t ] if ;
+
: (match) ( value1 value2 -- matched? )
{
- { [ dup match-var? ] [ set t ] }
- { [ over match-var? ] [ swap set t ] }
+ { [ dup match-var? ] [ set-match-var ] }
+ { [ over match-var? ] [ swap set-match-var ] }
{ [ 2dup = ] [ 2drop t ] }
{ [ 2dup [ _ eq? ] either? ] [ 2drop t ] }
{ [ 2dup [ sequence? ] both? ] [
From 4a2a214cb028469af54e20ab0612a530ca59f34f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 28 Oct 2007 00:42:36 -0400
Subject: [PATCH 5/9] Another fix
---
extra/match/match.factor | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/extra/match/match.factor b/extra/match/match.factor
index 0b4b2f1a0d..527d7f2465 100755
--- a/extra/match/match.factor
+++ b/extra/match/match.factor
@@ -61,4 +61,6 @@ MACRO: match-cond ( assoc -- )
} cond ;
: match-replace ( object pattern1 pattern2 -- result )
- -rot match [ replace-patterns ] bind ;
+ -rot
+ match [ "Pattern does not match" throw ] unless*
+ [ replace-patterns ] bind ;
From 346937a31a7b5b3e2afc0ee7cd370c35bb810bcd Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 28 Oct 2007 01:19:19 -0400
Subject: [PATCH 6/9] Fix stack effect error in com-back
---
extra/ui/tools/walker/walker.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
mode change 100644 => 100755 extra/ui/tools/walker/walker.factor
diff --git a/extra/ui/tools/walker/walker.factor b/extra/ui/tools/walker/walker.factor
old mode 100644
new mode 100755
index fabdf26818..3ff9b284e5
--- a/extra/ui/tools/walker/walker.factor
+++ b/extra/ui/tools/walker/walker.factor
@@ -39,7 +39,7 @@ TUPLE: walker model interpreter history ;
: com-back ( walker -- )
dup walker-history
- dup empty? [ drop ] [ pop swap call-tool* ] if ;
+ dup empty? [ 2drop ] [ pop swap call-tool* ] if ;
: reset-walker ( walker -- )
<interpreter> over set-walker-interpreter
From 738672be9fec87e073d77b85d736b3c2c4c24947 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 28 Oct 2007 01:19:33 -0400
Subject: [PATCH 7/9] ui.windows cleanup
---
extra/ui/windows/windows.factor | 13 +++++--------
1 file changed, 5 insertions(+), 8 deletions(-)
diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor
index bbcf96e0b2..cba9c427b7 100755
--- a/extra/ui/windows/windows.factor
+++ b/extra/ui/windows/windows.factor
@@ -14,21 +14,18 @@ TUPLE: windows-ui-backend ;
: crlf>lf CHAR: \r swap remove ;
: lf>crlf [ [ dup CHAR: \n = [ CHAR: \r , ] when , ] each ] "" make ;
-: (enum-clipboard) ( n -- n )
- EnumClipboardFormats win32-error dup 0 > [ dup , (enum-clipboard) ] when ;
-
: enum-clipboard ( -- seq )
- [ 0 (enum-clipboard) ] { } make nip ;
+ 0 [ EnumClipboardFormats win32-error dup dup 0 > ] [ ]
+ { } unfold nip ;
: with-clipboard ( quot -- )
f OpenClipboard win32-error=0/f
call
CloseClipboard win32-error=0/f ; inline
-
: paste ( -- str )
[
- CF_UNICODETEXT IsClipboardFormatAvailable 0 = [
+ CF_UNICODETEXT IsClipboardFormatAvailable zero? [
! nothing to paste
""
] [
@@ -132,7 +129,7 @@ SYMBOL: mouse-captured
} ;
: key-state-down?
- GetKeyState 1 16 shift bitand 0 > ;
+ GetKeyState 16 bit? ;
: left-shift? ( -- ? ) VK_LSHIFT key-state-down? ;
: left-ctrl? ( -- ? ) VK_LCONTROL key-state-down? ;
@@ -319,7 +316,7 @@ SYMBOL: hWnd
! Keyboard events
{ [ dup WM_KEYDOWN = over WM_SYSKEYDOWN = or ]
- [ drop 4dup handle-wm-keydown DefWindowProc ] }
+ [ drop 4dup handle-wm-keydown DefWindowProc ] }
{ [ dup WM_CHAR = over WM_SYSCHAR = or ]
[ drop 4dup handle-wm-char DefWindowProc ] }
{ [ dup WM_KEYUP = over WM_SYSKEYUP = or ]
From da4c77b445a0e228854fad72187c8f98f96c972b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 28 Oct 2007 01:21:26 -0400
Subject: [PATCH 8/9] Remove commented-out code
---
extra/ui/windows/windows.factor | 3 ---
1 file changed, 3 deletions(-)
diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor
index cba9c427b7..6b19085a1c 100755
--- a/extra/ui/windows/windows.factor
+++ b/extra/ui/windows/windows.factor
@@ -306,8 +306,6 @@ SYMBOL: hWnd
"uint" { "void*" "uint" "long" "long" } "stdcall" [
[
pick
- ! "Message: " write dup get-windows-message-name write
- ! " " write dup unparse print flush
{
{ [ dup WM_CLOSE = ] [ drop handle-wm-close 0 ] }
{ [ dup WM_PAINT = ]
@@ -340,7 +338,6 @@ SYMBOL: hWnd
{ [ t ] [ drop DefWindowProc ] }
} cond
] ui-try
- ! "finished handling message" print .s flush
] alien-callback ;
: do-events ( -- )
From d69ad235f6ffc740cb0bbf7d4b7da82d317e52e6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 28 Oct 2007 01:21:37 -0400
Subject: [PATCH 9/9] Remove non-working Windows CE SEH code
---
vm/Config.windows.ce.arm | 1 -
vm/os-windows-ce.c | 4 ++--
2 files changed, 2 insertions(+), 3 deletions(-)
mode change 100644 => 100755 vm/Config.windows.ce.arm
diff --git a/vm/Config.windows.ce.arm b/vm/Config.windows.ce.arm
old mode 100644
new mode 100755
index 1026968674..98e08e8f61
--- a/vm/Config.windows.ce.arm
+++ b/vm/Config.windows.ce.arm
@@ -1,5 +1,4 @@
CC = arm-wince-mingw32ce-gcc
DLL_SUFFIX=-ce
EXE_SUFFIX=-ce
-PLAF_DLL_OBJS += vm/os-windows-ce-arm.o
include vm/Config.windows.ce vm/Config.arm
diff --git a/vm/os-windows-ce.c b/vm/os-windows-ce.c
index 7113cd4498..e6ef8b1108 100755
--- a/vm/os-windows-ce.c
+++ b/vm/os-windows-ce.c
@@ -37,7 +37,7 @@ char *getenv(char *name)
return 0; /* unreachable */
}
-long exception_handler(PEXCEPTION_RECORD rec, void *frame, void *ctx, void *dispatch)
+void c_to_factor_toplevel(CELL quot)
{
- return 0;
+ c_to_factor(quot);
}