From 7e0674bf03ee07bbe3dce874ecc54810e98074e0 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 27 Jan 2008 22:17:11 -0800
Subject: [PATCH 01/20] 64 characters per line or death!!!!
---
extra/ui/ui.factor | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/extra/ui/ui.factor b/extra/ui/ui.factor
index 8fc7247257..0baa4df65b 100755
--- a/extra/ui/ui.factor
+++ b/extra/ui/ui.factor
@@ -120,7 +120,9 @@ SYMBOL: ui-hook
[ dup update-hand draw-world ] each ;
: notify ( gadget -- )
- dup gadget-graft-state dup first { f f } { t t } ? pick set-gadget-graft-state {
+ dup gadget-graft-state
+ dup first { f f } { t t } ?
+ pick set-gadget-graft-state {
{ { f t } [ dup activate-control graft* ] }
{ { t f } [ dup activate-control ungraft* ] }
} case ;
From 384cc60a0dc541aead6c93a3c85853b064d25226 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 29 Jan 2008 19:23:55 -0800
Subject: [PATCH 02/20] In line-art and cel-shading, do not delete opengl
resources that were not created
---
extra/cel-shading/cel-shading.factor | 8 ++++----
extra/line-art/line-art.factor | 19 ++++++++++---------
2 files changed, 14 insertions(+), 13 deletions(-)
diff --git a/extra/cel-shading/cel-shading.factor b/extra/cel-shading/cel-shading.factor
index c89fd0e244..64d23275e9 100644
--- a/extra/cel-shading/cel-shading.factor
+++ b/extra/cel-shading/cel-shading.factor
@@ -1,5 +1,5 @@
USING: arrays bunny combinators.lib io io.files kernel
- math math.functions multiline
+ math math.functions multiline continuations debugger
opengl opengl.gl opengl-demo-support
sequences ui ui.gadgets ui.render ;
IN: cel-shading
@@ -58,14 +58,14 @@ main()
<simple-gl-program> ;
M: cel-shading-gadget graft* ( gadget -- )
- "2.0" { "GL_ARB_shader_objects" } require-gl-version-or-extensions
+ [ "2.0" { "GL_ARB_shader_objects" } require-gl-version-or-extensions
0.0 0.0 0.0 1.0 glClearColor
GL_CULL_FACE glEnable
GL_DEPTH_TEST glEnable
- cel-shading-program swap set-cel-shading-gadget-program ;
+ cel-shading-program swap set-cel-shading-gadget-program ] [ ] [ :c ] cleanup ;
M: cel-shading-gadget ungraft* ( gadget -- )
- cel-shading-gadget-program delete-gl-program ;
+ cel-shading-gadget-program [ delete-gl-program ] when* ;
: cel-shading-draw-setup ( gadget -- gadget )
[ demo-gadget-set-matrices ] keep
diff --git a/extra/line-art/line-art.factor b/extra/line-art/line-art.factor
index 9eb3dc2dda..1a0ae6993f 100644
--- a/extra/line-art/line-art.factor
+++ b/extra/line-art/line-art.factor
@@ -1,6 +1,6 @@
USING: arrays bunny combinators.lib continuations io io.files kernel
math math.functions math.vectors multiline
- namespaces
+ namespaces debugger
opengl opengl.gl opengl-demo-support
prettyprint
sequences ui ui.gadgets ui.gestures ui.render ;
@@ -187,7 +187,7 @@ main()
] if ;
M: line-art-gadget graft* ( gadget -- )
- "2.0" { "GL_ARB_draw_buffers"
+ [ "2.0" { "GL_ARB_draw_buffers"
"GL_ARB_shader_objects"
"GL_ARB_multitexture"
"GL_ARB_texture_float" }
@@ -196,16 +196,17 @@ M: line-art-gadget graft* ( gadget -- )
GL_CULL_FACE glEnable
GL_DEPTH_TEST glEnable
(line-art-step1-program) over set-line-art-gadget-step1-program
- (line-art-step2-program) swap set-line-art-gadget-step2-program ;
+ (line-art-step2-program) swap set-line-art-gadget-step2-program
+ ] [ ] [ :c ] cleanup ;
M: line-art-gadget ungraft* ( gadget -- )
dup line-art-gadget-framebuffer [
- { [ line-art-gadget-step1-program delete-gl-program ]
- [ line-art-gadget-step2-program delete-gl-program ]
- [ line-art-gadget-framebuffer delete-framebuffer ]
- [ line-art-gadget-color-texture delete-texture ]
- [ line-art-gadget-normal-texture delete-texture ]
- [ line-art-gadget-depth-texture delete-texture ]
+ { [ line-art-gadget-step1-program [ delete-gl-program ] when* ]
+ [ line-art-gadget-step2-program [ delete-gl-program ] when* ]
+ [ line-art-gadget-framebuffer [ delete-framebuffer ] when* ]
+ [ line-art-gadget-color-texture [ delete-texture ] when* ]
+ [ line-art-gadget-normal-texture [ delete-texture ] when* ]
+ [ line-art-gadget-depth-texture [ delete-texture ] when* ]
[ f swap set-line-art-gadget-framebuffer-dim ]
[ f swap set-line-art-gadget-framebuffer ] } call-with
] [ drop ] if ;
From 92ebcc36199eba0f51fe08445110a72d7812b5fe Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 31 Jan 2008 12:27:37 -0600
Subject: [PATCH 03/20] New timeout implementation
---
extra/io/nonblocking/nonblocking.factor | 11 +++++++---
extra/io/unix/backend/backend.factor | 14 +++++++-----
extra/io/unix/sockets/sockets.factor | 9 ++++----
extra/io/windows/ce/sockets/sockets.factor | 25 +++++++++++-----------
extra/io/windows/nt/files/files.factor | 11 +++-------
extra/io/windows/nt/monitor/monitor.factor | 7 ++++--
extra/io/windows/nt/sockets/sockets.factor | 19 ++++++++--------
7 files changed, 53 insertions(+), 43 deletions(-)
diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor
index ca50d7063a..3588ea5d14 100755
--- a/extra/io/nonblocking/nonblocking.factor
+++ b/extra/io/nonblocking/nonblocking.factor
@@ -77,7 +77,7 @@ M: object expire-port drop ;
[ pop-back expire-port expire-timeouts ] [ drop ] if
] if ;
-: touch-port ( port -- )
+: begin-timeout ( port -- )
dup port-timeout dup zero? [
2drop
] [
@@ -85,8 +85,13 @@ M: object expire-port drop ;
dup unqueue-timeout queue-timeout
] if ;
-M: port set-timeout
- [ set-port-timeout ] keep touch-port ;
+: end-timeout ( port -- )
+ unqueue-timeout ;
+
+: with-port-timeout ( port quot -- )
+ over begin-timeout keep end-timeout ; inline
+
+M: port set-timeout set-port-timeout ;
GENERIC: (wait-to-read) ( port -- )
diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor
index 6da26b5b67..141b115ebe 100755
--- a/extra/io/unix/backend/backend.factor
+++ b/extra/io/unix/backend/backend.factor
@@ -57,7 +57,11 @@ GENERIC: wait-for-events ( ms mx -- )
M: mx register-io-task ( task mx -- )
2dup check-io-task fd/container set-at ;
-: add-io-task ( task -- ) mx get-global register-io-task ;
+: add-io-task ( task -- )
+ mx get-global register-io-task stop ;
+
+: with-port-continuation ( port quot -- port )
+ [ callcc0 ] curry with-port-timeout ; inline
M: mx unregister-io-task ( task mx -- )
fd/container delete-at drop ;
@@ -98,7 +102,6 @@ M: integer close-handle ( fd -- )
io-task-callbacks [ schedule-thread ] each ;
: handle-io-task ( mx task -- )
- dup io-task-port touch-port
dup do-io-task [ pop-callbacks ] [ 2drop ] if ;
: handle-timeout ( mx task -- )
@@ -133,7 +136,8 @@ M: read-task do-io-task
[ [ reader-eof ] [ drop ] if ] keep ;
M: input-port (wait-to-read)
- [ <read-task> add-io-task stop ] callcc0 pending-error ;
+ [ <read-task> add-io-task ] with-port-continuation
+ pending-error ;
! Writers
: write-step ( port -- ? )
@@ -151,11 +155,11 @@ M: write-task do-io-task
: add-write-io-task ( port continuation -- )
over port-handle mx get-global mx-writes at*
- [ io-task-callbacks push drop ]
+ [ io-task-callbacks push stop ]
[ drop <write-task> add-io-task ] if ;
: (wait-to-write) ( port -- )
- [ add-write-io-task stop ] callcc0 drop ;
+ [ add-write-io-task ] with-port-continuation drop ;
M: port port-flush ( port -- )
dup buffer-empty? [ drop ] [ (wait-to-write) ] if ;
diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor
index 748dbc40a7..59a9a8ac2e 100755
--- a/extra/io/unix/sockets/sockets.factor
+++ b/extra/io/unix/sockets/sockets.factor
@@ -40,7 +40,7 @@ M: connect-task do-io-task
0 < [ defer-error ] [ drop t ] if ;
: wait-to-connect ( port -- )
- [ <connect-task> add-io-task stop ] callcc0 drop ;
+ [ <connect-task> add-io-task ] with-port-continuation drop ;
M: unix-io (client) ( addrspec -- stream )
dup make-sockaddr/size >r >r
@@ -82,7 +82,7 @@ M: accept-task do-io-task
over 0 >= [ do-accept t ] [ 2drop defer-error ] if ;
: wait-to-accept ( server -- )
- [ <accept-task> add-io-task stop ] callcc0 drop ;
+ [ <accept-task> add-io-task ] with-port-continuation drop ;
USE: io.sockets
@@ -147,7 +147,7 @@ M: receive-task do-io-task
] if ;
: wait-receive ( stream -- )
- [ <receive-task> add-io-task stop ] callcc0 drop ;
+ [ <receive-task> add-io-task ] with-port-continuation drop ;
M: unix-io receive ( datagram -- packet addrspec )
dup check-datagram-port
@@ -178,7 +178,8 @@ M: send-task do-io-task
swap 0 < [ io-task-port defer-error ] [ drop t ] if ;
: wait-send ( packet sockaddr len stream -- )
- [ <send-task> add-io-task stop ] callcc0 2drop 2drop ;
+ [ <send-task> add-io-task ] with-port-continuation
+ 2drop 2drop ;
M: unix-io send ( packet addrspec datagram -- )
3dup check-datagram-send
diff --git a/extra/io/windows/ce/sockets/sockets.factor b/extra/io/windows/ce/sockets/sockets.factor
index 5f87088804..9114dceb75 100755
--- a/extra/io/windows/ce/sockets/sockets.factor
+++ b/extra/io/windows/ce/sockets/sockets.factor
@@ -42,19 +42,20 @@ M: windows-ce-io <server> ( addrspec -- duplex-stream )
] keep <server-port> ;
M: windows-ce-io accept ( server -- client )
- dup check-server-port
[
- dup touch-port
- dup port-handle win32-file-handle
- swap server-port-addr sockaddr-type heap-size
- dup <byte-array> [
- swap <int> f 0
- windows.winsock:WSAAccept
- dup windows.winsock:INVALID_SOCKET =
- [ windows.winsock:winsock-error ] when
- ] keep
- ] keep server-port-addr parse-sockaddr swap
- <win32-socket> dup handle>duplex-stream <client-stream> ;
+ dup check-server-port
+ [
+ dup port-handle win32-file-handle
+ swap server-port-addr sockaddr-type heap-size
+ dup <byte-array> [
+ swap <int> f 0
+ windows.winsock:WSAAccept
+ dup windows.winsock:INVALID_SOCKET =
+ [ windows.winsock:winsock-error ] when
+ ] keep
+ ] keep server-port-addr parse-sockaddr swap
+ <win32-socket> dup handle>duplex-stream <client-stream>
+ ] with-port-timeout ;
M: windows-ce-io <datagram> ( addrspec -- datagram )
[
diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor
index 06edd8b3ee..4a304e5ac9 100755
--- a/extra/io/windows/nt/files/files.factor
+++ b/extra/io/windows/nt/files/files.factor
@@ -24,7 +24,6 @@ M: windows-nt-io FileArgs-overlapped ( port -- overlapped )
swap buffer-consume ;
: (flush-output) ( port -- )
- dup touch-port
dup make-FileArgs
tuck setup-write WriteFile
dupd overlapped-error? [
@@ -37,7 +36,7 @@ M: windows-nt-io FileArgs-overlapped ( port -- overlapped )
] if ;
: flush-output ( port -- )
- [ (flush-output) ] with-destructors ;
+ [ [ (flush-output) ] with-port-timeout ] with-destructors ;
M: port port-flush
dup buffer-empty? [ dup flush-output ] unless drop ;
@@ -52,17 +51,13 @@ M: port port-flush
] if ;
: ((wait-to-read)) ( port -- )
- dup touch-port
dup make-FileArgs
tuck setup-read ReadFile
dupd overlapped-error? [
>r FileArgs-lpOverlapped r>
[ save-callback ] 2keep
finish-read
- ] [
- 2drop
- ] if ;
+ ] [ 2drop ] if ;
M: input-port (wait-to-read) ( port -- )
- [ ((wait-to-read)) ] with-destructors ;
-
+ [ [ ((wait-to-read)) ] with-port-timeout ] with-destructors ;
diff --git a/extra/io/windows/nt/monitor/monitor.factor b/extra/io/windows/nt/monitor/monitor.factor
index f296e859f0..a7c065b878 100755
--- a/extra/io/windows/nt/monitor/monitor.factor
+++ b/extra/io/windows/nt/monitor/monitor.factor
@@ -46,8 +46,11 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
: read-changes ( monitor -- bytes )
[
- dup begin-reading-changes swap [ save-callback ] 2keep
- get-overlapped-result
+ [
+ dup begin-reading-changes
+ swap [ save-callback ] 2keep
+ get-overlapped-result
+ ] with-port-timeout
] with-destructors ;
: parse-action-flag ( action mask symbol -- action )
diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor
index 6c7db33ee3..b9ce5aad4c 100755
--- a/extra/io/windows/nt/sockets/sockets.factor
+++ b/extra/io/windows/nt/sockets/sockets.factor
@@ -129,15 +129,16 @@ TUPLE: AcceptEx-args port
M: windows-nt-io accept ( server -- client )
[
- dup check-server-port
- dup touch-port
- \ AcceptEx-args construct-empty
- [ init-accept ] keep
- [ (accept) ] keep
- [ accept-continuation ] keep
- AcceptEx-args-port pending-error
- dup duplex-stream-in pending-error
- dup duplex-stream-out pending-error
+ [
+ dup check-server-port
+ \ AcceptEx-args construct-empty
+ [ init-accept ] keep
+ [ (accept) ] keep
+ [ accept-continuation ] keep
+ AcceptEx-args-port pending-error
+ dup duplex-stream-in pending-error
+ dup duplex-stream-out pending-error
+ ] with-port-timeout
] with-destructors ;
M: windows-nt-io <server> ( addrspec -- server )
From 6530057512f2b7306fb8dc38d1e84e8f4ea35f29 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 31 Jan 2008 20:11:46 -0600
Subject: [PATCH 04/20] Starting work on record1 strings
---
core/alien/alien.factor | 15 ++----
core/bit-arrays/bit-arrays.factor | 4 +-
core/bootstrap/image/image.factor | 1 +
core/bootstrap/primitives.factor | 58 +++++++++++++-----------
core/byte-arrays/byte-arrays.factor | 6 +--
core/compiler/constants/constants.factor | 2 +-
core/float-arrays/float-arrays.factor | 4 +-
core/strings/strings.factor | 14 ++++--
vm/debug.c | 2 +-
vm/layouts.h | 2 +
vm/types.c | 9 ++--
11 files changed, 61 insertions(+), 56 deletions(-)
diff --git a/core/alien/alien.factor b/core/alien/alien.factor
index 1c8163e2fa..317dac803e 100755
--- a/core/alien/alien.factor
+++ b/core/alien/alien.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs kernel math namespaces sequences system
-kernel.private tuples ;
+kernel.private tuples bit-arrays byte-arrays float-arrays ;
IN: alien
! Some predicate classes used by the compiler for optimization
@@ -9,16 +9,11 @@ IN: alien
PREDICATE: alien simple-alien
underlying-alien not ;
-! These mixins are not intended to be extended by user code.
-! They are not unions, because if they were we'd have a circular
-! dependency between alien and {byte,bit,float}-arrays.
-MIXIN: simple-c-ptr
-INSTANCE: simple-alien simple-c-ptr
-INSTANCE: f simple-c-ptr
+UNION: simple-c-ptr
+simple-alien POSTPONE: f byte-array bit-array float-array ;
-MIXIN: c-ptr
-INSTANCE: alien c-ptr
-INSTANCE: f c-ptr
+UNION: c-ptr
+alien POSTPONE: f byte-array bit-array float-array ;
DEFER: pinned-c-ptr?
diff --git a/core/bit-arrays/bit-arrays.factor b/core/bit-arrays/bit-arrays.factor
index 4c68d94aad..ee485d399e 100755
--- a/core/bit-arrays/bit-arrays.factor
+++ b/core/bit-arrays/bit-arrays.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: math alien kernel kernel.private sequences
+USING: math alien.accessors kernel kernel.private sequences
sequences.private ;
IN: bit-arrays
@@ -52,5 +52,3 @@ M: bit-array resize
resize-bit-array ;
INSTANCE: bit-array sequence
-INSTANCE: bit-array simple-c-ptr
-INSTANCE: bit-array c-ptr
diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor
index f7e0d483f6..c3bf18cffc 100755
--- a/core/bootstrap/image/image.factor
+++ b/core/bootstrap/image/image.factor
@@ -259,6 +259,7 @@ M: wrapper '
string type-number object tag-number [
dup length emit-fixnum
f ' emit
+ f ' emit
pack-string emit-chars
] emit-object ;
diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 4c5246e0eb..defbac6720 100755
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -40,6 +40,7 @@ call
! classes will go
{
"alien"
+ "alien.accessors"
"arrays"
"bit-arrays"
"bit-vectors"
@@ -190,6 +191,11 @@ num-types get f <array> builtins set
"length"
{ "length" "sequences" }
f
+ } {
+ { "object" "kernel" }
+ "aux"
+ { "string-aux" "strings.private" }
+ { "set-string-aux" "strings.private" }
}
} define-builtin
@@ -556,32 +562,32 @@ builtins get num-tags get tail f union-class define-class
{ "<byte-array>" "byte-arrays" }
{ "<bit-array>" "bit-arrays" }
{ "<displaced-alien>" "alien" }
- { "alien-signed-cell" "alien" }
- { "set-alien-signed-cell" "alien" }
- { "alien-unsigned-cell" "alien" }
- { "set-alien-unsigned-cell" "alien" }
- { "alien-signed-8" "alien" }
- { "set-alien-signed-8" "alien" }
- { "alien-unsigned-8" "alien" }
- { "set-alien-unsigned-8" "alien" }
- { "alien-signed-4" "alien" }
- { "set-alien-signed-4" "alien" }
- { "alien-unsigned-4" "alien" }
- { "set-alien-unsigned-4" "alien" }
- { "alien-signed-2" "alien" }
- { "set-alien-signed-2" "alien" }
- { "alien-unsigned-2" "alien" }
- { "set-alien-unsigned-2" "alien" }
- { "alien-signed-1" "alien" }
- { "set-alien-signed-1" "alien" }
- { "alien-unsigned-1" "alien" }
- { "set-alien-unsigned-1" "alien" }
- { "alien-float" "alien" }
- { "set-alien-float" "alien" }
- { "alien-double" "alien" }
- { "set-alien-double" "alien" }
- { "alien-cell" "alien" }
- { "set-alien-cell" "alien" }
+ { "alien-signed-cell" "alien.accessors" }
+ { "set-alien-signed-cell" "alien.accessors" }
+ { "alien-unsigned-cell" "alien.accessors" }
+ { "set-alien-unsigned-cell" "alien.accessors" }
+ { "alien-signed-8" "alien.accessors" }
+ { "set-alien-signed-8" "alien.accessors" }
+ { "alien-unsigned-8" "alien.accessors" }
+ { "set-alien-unsigned-8" "alien.accessors" }
+ { "alien-signed-4" "alien.accessors" }
+ { "set-alien-signed-4" "alien.accessors" }
+ { "alien-unsigned-4" "alien.accessors" }
+ { "set-alien-unsigned-4" "alien.accessors" }
+ { "alien-signed-2" "alien.accessors" }
+ { "set-alien-signed-2" "alien.accessors" }
+ { "alien-unsigned-2" "alien.accessors" }
+ { "set-alien-unsigned-2" "alien.accessors" }
+ { "alien-signed-1" "alien.accessors" }
+ { "set-alien-signed-1" "alien.accessors" }
+ { "alien-unsigned-1" "alien.accessors" }
+ { "set-alien-unsigned-1" "alien.accessors" }
+ { "alien-float" "alien.accessors" }
+ { "set-alien-float" "alien.accessors" }
+ { "alien-double" "alien.accessors" }
+ { "set-alien-double" "alien.accessors" }
+ { "alien-cell" "alien.accessors" }
+ { "set-alien-cell" "alien.accessors" }
{ "alien>char-string" "alien" }
{ "string>char-alien" "alien" }
{ "alien>u16-string" "alien" }
diff --git a/core/byte-arrays/byte-arrays.factor b/core/byte-arrays/byte-arrays.factor
index 401b151ad0..548c293e7c 100755
--- a/core/byte-arrays/byte-arrays.factor
+++ b/core/byte-arrays/byte-arrays.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private alien sequences sequences.private
-math ;
+USING: kernel kernel.private alien.accessors sequences
+sequences.private math ;
IN: byte-arrays
M: byte-array clone (clone) ;
@@ -19,5 +19,3 @@ M: byte-array resize
resize-byte-array ;
INSTANCE: byte-array sequence
-INSTANCE: byte-array simple-c-ptr
-INSTANCE: byte-array c-ptr
diff --git a/core/compiler/constants/constants.factor b/core/compiler/constants/constants.factor
index 66fc8d5789..277a64225a 100755
--- a/core/compiler/constants/constants.factor
+++ b/core/compiler/constants/constants.factor
@@ -10,7 +10,7 @@ IN: compiler.constants
! These constants must match vm/layouts.h
: header-offset object tag-number neg ;
: float-offset 8 float tag-number - ;
-: string-offset 3 bootstrap-cells object tag-number - ;
+: string-offset 4 bootstrap-cells object tag-number - ;
: profile-count-offset 7 bootstrap-cells object tag-number - ;
: byte-array-offset 2 bootstrap-cells object tag-number - ;
: alien-offset 3 bootstrap-cells object tag-number - ;
diff --git a/core/float-arrays/float-arrays.factor b/core/float-arrays/float-arrays.factor
index 445edd550a..33302572de 100755
--- a/core/float-arrays/float-arrays.factor
+++ b/core/float-arrays/float-arrays.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private alien sequences
+USING: kernel kernel.private alien.accessors sequences
sequences.private math math.private ;
IN: float-arrays
@@ -33,8 +33,6 @@ M: float-array resize
resize-float-array ;
INSTANCE: float-array sequence
-INSTANCE: float-array simple-c-ptr
-INSTANCE: float-array c-ptr
: 1float-array ( x -- array ) 1 swap <float-array> ; flushable
diff --git a/core/strings/strings.factor b/core/strings/strings.factor
index 10f38f8298..33efed11e8 100755
--- a/core/strings/strings.factor
+++ b/core/strings/strings.factor
@@ -1,14 +1,20 @@
-! Copyright (C) 2003, 2007 Slava Pestov.
+! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.private sequences kernel.private
-math sequences.private slots.private ;
+math sequences.private slots.private byte-arrays
+alien.accessors ;
IN: strings
<PRIVATE
-: string-hashcode 2 slot ; inline
+: make-string-aux ( string -- aux )
+ dup string-aux
+ [ ] [ dup length <byte-array> dup rot set-string-aux ] ?if
+ { byte-array } declare ; inline
-: set-string-hashcode 2 set-slot ; inline
+: string-hashcode 3 slot ; inline
+
+: set-string-hashcode 3 set-slot ; inline
: reset-string-hashcode f swap set-string-hashcode ; inline
diff --git a/vm/debug.c b/vm/debug.c
index 2692bdf59c..5b4320b5e9 100755
--- a/vm/debug.c
+++ b/vm/debug.c
@@ -4,7 +4,7 @@ void print_chars(F_STRING* str)
{
CELL i;
for(i = 0; i < string_capacity(str); i++)
- putchar(cget(SREF(str,i)));
+ putchar(string_nth(str,i));
}
void print_word(F_WORD* word, CELL nesting)
diff --git a/vm/layouts.h b/vm/layouts.h
index 07e22cfed0..2b8957ee66 100755
--- a/vm/layouts.h
+++ b/vm/layouts.h
@@ -106,6 +106,8 @@ typedef struct {
/* tagged num of chars */
CELL length;
/* tagged */
+ CELL aux;
+ /* tagged */
CELL hashcode;
} F_STRING;
diff --git a/vm/types.c b/vm/types.c
index 27a5b55e2b..d5e8d76abb 100755
--- a/vm/types.c
+++ b/vm/types.c
@@ -429,10 +429,11 @@ F_STRING* allot_string_internal(CELL capacity)
/* strings are null-terminated in memory, even though they also
have a length field. The null termination allows us to add
the sizeof(F_STRING) to a Factor string to get a C-style
- UCS-2 string for C library calls. */
- cput(SREF(string,capacity),(u16)'\0');
+ char* string for C library calls. */
+ set_string_nth(string,capacity,0);
string->length = tag_fixnum(capacity);
string->hashcode = F;
+ string->aux = F;
return string;
}
@@ -446,7 +447,7 @@ void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
CELL i;
for(i = start; i < capacity; i++)
- cput(SREF(string,i),fill);
+ set_string_nth(string,i,fill);
}
}
@@ -499,7 +500,7 @@ DEFINE_PRIMITIVE(resize_string)
CELL i; \
for(i = 0; i < length; i++) \
{ \
- cput(SREF(s,i),(utype)*string); \
+ set_string_nth(s,i,(utype)*string); \
string++; \
} \
return s; \
From 9d339e467748b5012366ee5920b505be1bd29315 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 31 Jan 2008 22:41:06 -0600
Subject: [PATCH 05/20] concurrency-docs fix
---
extra/concurrency/concurrency-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/concurrency/concurrency-docs.factor b/extra/concurrency/concurrency-docs.factor
index e1377f5265..f481647e1e 100644
--- a/extra/concurrency/concurrency-docs.factor
+++ b/extra/concurrency/concurrency-docs.factor
@@ -150,7 +150,7 @@ ARTICLE: { "concurrency" "exceptions" } "Exceptions"
"Exceptions are only raised in the parent when the parent does a " { $link receive } " or " { $link receive-if } ". This is because the exception is sent from the child to the parent as a message." ;
ARTICLE: { "concurrency" "futures" } "Futures"
-"A future is a placeholder for the result of a computation that is being calculated in a process. When the process has completed the computation the future can be queried to find out the result. If the computation has not completed when the future is queried them the process will block until the result is completed. <p>A future is created using " { $link future } ".\n\nThe quotation will be run in a spawned process, and a future object is immediately returned. This future object can be resolved using " { $link ?future } ".\n\nFutures are useful for starting calculations that take a long time to run but aren't needed until later in the process. When the process needs the value it can use '?future' to get the result or block until the result is available. For example:"
+"A future is a placeholder for the result of a computation that is being calculated in a process. When the process has completed the computation the future can be queried to find out the result. If the computation has not completed when the future is queried them the process will block until the result is completed. A future is created using " { $link future } ".\n\nThe quotation will be run in a spawned process, and a future object is immediately returned. This future object can be resolved using " { $link ?future } ".\n\nFutures are useful for starting calculations that take a long time to run but aren't needed until later in the process. When the process needs the value it can use '?future' to get the result or block until the result is available. For example:"
{ $code "[ 30 fib ] future\n...do stuff...\n?future" } ;
ARTICLE: { "concurrency" "promises" } "Promises"
From ee533db516ad79b85706f587847f561a7ae14662 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 31 Jan 2008 22:43:26 -0600
Subject: [PATCH 06/20] concurrency-docs fix 2
---
extra/concurrency/concurrency-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/concurrency/concurrency-docs.factor b/extra/concurrency/concurrency-docs.factor
index f481647e1e..7e76ff242a 100644
--- a/extra/concurrency/concurrency-docs.factor
+++ b/extra/concurrency/concurrency-docs.factor
@@ -127,7 +127,7 @@ ARTICLE: { "concurrency" "processes" } "Processes"
{ $code ": odd? ( n -- ? ) 2 mod 1 = ;\n1 self send 2 self send 3 self send\n\nreceive .\n => 1\n\n[ odd? ] receive-if .\n => 3\n\nreceive .\n => 2" } ;
ARTICLE: { "concurrency" "self" } "Self"
-"A process can get access to its own process object using " { $link self } " so it can pass it to other processes. This allows the other processes to send messages back. A simple example of using this gets the current processes 'self' and spawns a process which sends a message to it. We then receive the message from the original process:"
+"A process can get access to its own process object using " { $link self } " so it can pass it to other processes. This allows the other processes to send messages back. A simple example of using this gets the current process' 'self' and spawns a process which sends a message to it. We then receive the message from the original process:"
{ $code "self [ \"Hello!\" swap send ] spawn 2drop receive .\n => \"Hello!\"" } ;
ARTICLE: { "concurrency" "servers" } "Servers"
From 2ef76798b07e595ac05d281c6592575c0570068d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 31 Jan 2008 23:00:08 -0600
Subject: [PATCH 07/20] record1 strings
---
core/alien/alien-docs.factor | 3 +-
core/alien/alien-tests.factor | 6 +-
core/alien/c-types/c-types.factor | 2 +-
core/ascii/ascii-docs.factor | 51 ++++++++++++
core/ascii/ascii.factor | 27 +++++++
core/ascii/authors.txt | 1 +
core/ascii/summary.txt | 1 +
core/ascii/tags.txt | 1 +
core/bootstrap/image/image.factor | 11 +--
core/bootstrap/primitives.factor | 4 +-
core/bootstrap/stage2.factor | 2 +-
core/compiler/test/intrinsics.factor | 26 +++---
core/compiler/test/redefine.factor | 2 +-
core/compiler/test/templates.factor | 4 +-
core/cpu/ppc/intrinsics/intrinsics.factor | 24 ------
core/cpu/x86/intrinsics/intrinsics.factor | 37 ++-------
core/cpu/x86/sse2/sse2.factor | 10 +--
core/growable/growable-docs.factor | 4 +-
core/inference/known-words/known-words.factor | 29 +++----
core/math/parser/parser.factor | 34 ++++++--
core/optimizer/math/math.factor | 10 +--
core/parser/parser.factor | 3 +-
core/prettyprint/backend/backend.factor | 2 +-
core/sbufs/sbufs.factor | 2 +-
core/sbufs/tags.txt | 1 +
core/strings/strings-docs.factor | 79 ++++---------------
core/strings/strings-tests.factor | 26 +++++-
core/strings/strings.factor | 39 +--------
core/strings/tags.txt | 1 +
core/syntax/tags.txt | 0
extra/io/buffers/buffers.factor | 4 +-
extra/io/mmap/mmap.factor | 4 +-
extra/io/windows/nt/sockets/sockets.factor | 9 ++-
extra/ui/freetype/freetype.factor | 4 +-
34 files changed, 227 insertions(+), 236 deletions(-)
mode change 100644 => 100755 core/alien/alien-tests.factor
create mode 100755 core/ascii/ascii-docs.factor
create mode 100755 core/ascii/ascii.factor
create mode 100755 core/ascii/authors.txt
create mode 100755 core/ascii/summary.txt
create mode 100755 core/ascii/tags.txt
mode change 100644 => 100755 core/cpu/x86/sse2/sse2.factor
mode change 100644 => 100755 core/growable/growable-docs.factor
mode change 100644 => 100755 core/math/parser/parser.factor
mode change 100644 => 100755 core/parser/parser.factor
mode change 100644 => 100755 core/strings/strings-tests.factor
create mode 100755 core/syntax/tags.txt
diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor
index 8fee0e8c3e..19ee52b039 100755
--- a/core/alien/alien-docs.factor
+++ b/core/alien/alien-docs.factor
@@ -1,6 +1,7 @@
USING: byte-arrays arrays help.syntax help.markup
alien.syntax compiler definitions math libc
-debugger parser io io.backend system bit-arrays float-arrays ;
+debugger parser io io.backend system bit-arrays float-arrays
+alien.accessors ;
IN: alien
HELP: alien
diff --git a/core/alien/alien-tests.factor b/core/alien/alien-tests.factor
old mode 100644
new mode 100755
index aedad25906..d5133753c1
--- a/core/alien/alien-tests.factor
+++ b/core/alien/alien-tests.factor
@@ -1,7 +1,7 @@
IN: temporary
-USING: alien byte-arrays
-arrays kernel kernel.private namespaces tools.test sequences
-libc math system prettyprint ;
+USING: alien alien.accessors byte-arrays arrays kernel
+kernel.private namespaces tools.test sequences libc math system
+prettyprint ;
[ t ] [ -1 <alien> alien-address 0 > ] unit-test
diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor
index 1ecfa37ee6..88df823e5b 100755
--- a/core/alien/c-types/c-types.factor
+++ b/core/alien/c-types/c-types.factor
@@ -3,7 +3,7 @@
USING: byte-arrays arrays generator.registers assocs
kernel kernel.private libc math namespaces parser sequences
strings words assocs splitting math.parser cpu.architecture
-alien quotations system compiler.units ;
+alien alien.accessors quotations system compiler.units ;
IN: alien.c-types
TUPLE: c-type
diff --git a/core/ascii/ascii-docs.factor b/core/ascii/ascii-docs.factor
new file mode 100755
index 0000000000..1f7a56bed9
--- /dev/null
+++ b/core/ascii/ascii-docs.factor
@@ -0,0 +1,51 @@
+USING: help.markup help.syntax ;
+IN: ascii
+
+HELP: blank?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for an ASCII whitespace character." } ;
+
+HELP: letter?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for a lowercase alphabet ASCII character." } ;
+
+HELP: LETTER?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for a uppercase alphabet ASCII character." } ;
+
+HELP: digit?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for an ASCII decimal digit character." } ;
+
+HELP: Letter?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for an ASCII alphabet character, both upper and lower case." } ;
+
+HELP: alpha?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for an alphanumeric ASCII character." } ;
+
+HELP: printable?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for a printable ASCII character." } ;
+
+HELP: control?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for an ASCII control character." } ;
+
+HELP: quotable?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for characters which may appear in a Factor string literal without escaping." } ;
+
+ARTICLE: "ascii" "ASCII character classes"
+"Traditional ASCII character classes:"
+{ $subsection blank? }
+{ $subsection letter? }
+{ $subsection LETTER? }
+{ $subsection digit? }
+{ $subsection printable? }
+{ $subsection control? }
+{ $subsection quotable? }
+"Modern applications should use Unicode 5.0 instead (" { $vocab-link "unicode" } ")." ;
+
+ABOUT: "ascii"
diff --git a/core/ascii/ascii.factor b/core/ascii/ascii.factor
new file mode 100755
index 0000000000..eeb6b2d480
--- /dev/null
+++ b/core/ascii/ascii.factor
@@ -0,0 +1,27 @@
+! Copyright (C) 2005, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: sequences math kernel ;
+IN: ascii
+
+: blank? ( ch -- ? ) " \t\n\r" member? ; inline
+
+: letter? ( ch -- ? ) CHAR: a CHAR: z between? ; inline
+
+: LETTER? ( ch -- ? ) CHAR: A CHAR: Z between? ; inline
+
+: digit? ( ch -- ? ) CHAR: 0 CHAR: 9 between? ; inline
+
+: printable? ( ch -- ? ) CHAR: \s CHAR: ~ between? ; inline
+
+: control? ( ch -- ? ) "\0\e\r\n\t\u0008\u007f" member? ; inline
+
+: quotable? ( ch -- ? )
+ dup printable? [ "\"\\" member? not ] [ drop f ] if ; inline
+
+: Letter? ( ch -- ? )
+ dup letter? [ drop t ] [ LETTER? ] if ; inline
+
+: alpha? ( ch -- ? )
+ dup Letter? [ drop t ] [ digit? ] if ; inline
+
+
diff --git a/core/ascii/authors.txt b/core/ascii/authors.txt
new file mode 100755
index 0000000000..1901f27a24
--- /dev/null
+++ b/core/ascii/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/core/ascii/summary.txt b/core/ascii/summary.txt
new file mode 100755
index 0000000000..ae2ea69b8b
--- /dev/null
+++ b/core/ascii/summary.txt
@@ -0,0 +1 @@
+ASCII character classes
diff --git a/core/ascii/tags.txt b/core/ascii/tags.txt
new file mode 100755
index 0000000000..8e27be7d61
--- /dev/null
+++ b/core/ascii/tags.txt
@@ -0,0 +1 @@
+text
diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor
index c3bf18cffc..e9ee569fd6 100755
--- a/core/bootstrap/image/image.factor
+++ b/core/bootstrap/image/image.factor
@@ -17,8 +17,6 @@ IN: bootstrap.image
: image-magic HEX: 0f0e0d0c ; inline
: image-version 4 ; inline
-: char bootstrap-cell 2/ ; inline
-
: data-base 1024 ; inline
: userenv-size 40 ; inline
@@ -244,16 +242,13 @@ M: wrapper '
[ emit ] emit-object ;
! Strings
-: 16be> 0 [ swap 16 shift bitor ] reduce ;
-: 16le> <reversed> 16be> ;
-
: emit-chars ( seq -- )
- char <groups>
- big-endian get [ [ 16be> ] map ] [ [ 16le> ] map ] if
+ bootstrap-cell <groups>
+ big-endian get [ [ be> ] map ] [ [ le> ] map ] if
emit-seq ;
: pack-string ( string -- newstr )
- dup length 1+ char align 0 pad-right ;
+ dup length 1+ bootstrap-cell align 0 pad-right ;
: emit-string ( string -- ptr )
string type-number object tag-number [
diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index defbac6720..fef93e163f 100755
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -596,8 +596,8 @@ builtins get num-tags get tail f union-class define-class
{ "alien-address" "alien" }
{ "slot" "slots.private" }
{ "set-slot" "slots.private" }
- { "char-slot" "strings.private" }
- { "set-char-slot" "strings.private" }
+ { "string-nth" "strings.private" }
+ { "set-string-nth" "strings.private" }
{ "resize-array" "arrays" }
{ "resize-string" "strings" }
{ "<array>" "arrays" }
diff --git a/core/bootstrap/stage2.factor b/core/bootstrap/stage2.factor
index 8fc3435ffa..5a5a8d1c67 100755
--- a/core/bootstrap/stage2.factor
+++ b/core/bootstrap/stage2.factor
@@ -12,7 +12,7 @@ IN: bootstrap.stage2
! you can see what went wrong, instead of dealing with a
! fep
[
- vm file-name windows? [ >lower ".exe" ?tail drop ] when
+ vm file-name windows? [ "." split1 drop ] when
".image" append "output-image" set-global
"math tools help compiler ui ui.tools io" "include" set-global
diff --git a/core/compiler/test/intrinsics.factor b/core/compiler/test/intrinsics.factor
index 075961047f..1d0ad141c2 100755
--- a/core/compiler/test/intrinsics.factor
+++ b/core/compiler/test/intrinsics.factor
@@ -1,10 +1,10 @@
IN: temporary
-USING: arrays compiler kernel kernel.private math
-math.constants math.private sequences strings tools.test words
-continuations sequences.private hashtables.private byte-arrays
-strings.private system random layouts vectors.private
-sbufs.private strings.private slots.private alien alien.c-types
-alien.syntax namespaces libc combinators.private ;
+USING: arrays compiler kernel kernel.private math math.constants
+math.private sequences strings tools.test words continuations
+sequences.private hashtables.private byte-arrays strings.private
+system random layouts vectors.private sbufs.private
+strings.private slots.private alien alien.accessors
+alien.c-types alien.syntax namespaces libc combinators.private ;
! Make sure that intrinsic ops compile to correct code.
[ ] [ 1 [ drop ] compile-call ] unit-test
@@ -36,13 +36,13 @@ alien.syntax namespaces libc combinators.private ;
! Write barrier hits on the wrong value were causing segfaults
[ -3 ] [ -3 1 2 [ 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
-[ CHAR: b ] [ 1 "abc" [ char-slot ] compile-call ] unit-test
-[ CHAR: b ] [ 1 [ "abc" char-slot ] compile-call ] unit-test
-[ CHAR: b ] [ [ 1 "abc" char-slot ] compile-call ] unit-test
-
-[ "axc" ] [ CHAR: x 1 "abc" [ [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
-[ "axc" ] [ CHAR: x 1 [ "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
-[ "axc" ] [ CHAR: x [ 1 "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
+! [ CHAR: b ] [ 1 "abc" [ char-slot ] compile-call ] unit-test
+! [ CHAR: b ] [ 1 [ "abc" char-slot ] compile-call ] unit-test
+! [ CHAR: b ] [ [ 1 "abc" char-slot ] compile-call ] unit-test
+!
+! [ "axc" ] [ CHAR: x 1 "abc" [ [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
+! [ "axc" ] [ CHAR: x 1 [ "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
+! [ "axc" ] [ CHAR: x [ 1 "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
[ ] [ [ 0 getenv ] compile-call drop ] unit-test
[ ] [ 1 getenv [ 1 setenv ] compile-call ] unit-test
diff --git a/core/compiler/test/redefine.factor b/core/compiler/test/redefine.factor
index c1561f38d4..01dd27f8be 100755
--- a/core/compiler/test/redefine.factor
+++ b/core/compiler/test/redefine.factor
@@ -249,4 +249,4 @@ DEFER: defer-redefine-test-2
[ ] [ "IN: temporary : defer-redefine-test-1 2 ;" eval ] unit-test
-[ 1 ] [ defer-redefine-test-2 ] unit-test
+[ 2 1 ] [ defer-redefine-test-2 ] unit-test
diff --git a/core/compiler/test/templates.factor b/core/compiler/test/templates.factor
index 78f57efb43..08e1c98729 100755
--- a/core/compiler/test/templates.factor
+++ b/core/compiler/test/templates.factor
@@ -2,8 +2,8 @@
USING: arrays compiler kernel kernel.private math
hashtables.private math.private namespaces sequences
sequences.private tools.test namespaces.private slots.private
-combinators.private byte-arrays alien layouts words definitions
-compiler.units ;
+combinators.private byte-arrays alien alien.accessors layouts
+words definitions compiler.units ;
IN: temporary
! Oops!
diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor
index c73cd149a4..693bcdb5e4 100755
--- a/core/cpu/ppc/intrinsics/intrinsics.factor
+++ b/core/cpu/ppc/intrinsics/intrinsics.factor
@@ -93,30 +93,6 @@ IN: cpu.ppc.intrinsics
}
} define-intrinsics
-: (%char-slot)
- "offset" operand "n" operand 2 SRAWI
- "offset" operand dup "obj" operand ADD ;
-
-\ char-slot [
- (%char-slot)
- "out" operand "offset" operand string-offset LHZ
- "out" operand dup %tag-fixnum
-] H{
- { +input+ { { f "n" } { f "obj" } } }
- { +scratch+ { { f "out" } { f "offset" } } }
- { +output+ { "out" } }
-} define-intrinsic
-
-\ set-char-slot [
- (%char-slot)
- "val" operand dup %untag-fixnum
- "val" operand "offset" operand string-offset STH
-] H{
- { +input+ { { f "val" } { f "n" } { f "obj" } } }
- { +scratch+ { { f "offset" } } }
- { +clobber+ { "val" } }
-} define-intrinsic
-
: fixnum-register-op ( op -- pair )
[ "out" operand "y" operand "x" operand ] swap add H{
{ +input+ { { f "x" } { f "y" } } }
diff --git a/core/cpu/x86/intrinsics/intrinsics.factor b/core/cpu/x86/intrinsics/intrinsics.factor
index 1fc649e128..99a89eab05 100755
--- a/core/cpu/x86/intrinsics/intrinsics.factor
+++ b/core/cpu/x86/intrinsics/intrinsics.factor
@@ -1,12 +1,13 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays cpu.x86.assembler cpu.x86.allot
-cpu.x86.architecture cpu.architecture kernel kernel.private math
-math.private namespaces quotations sequences
+USING: alien alien.accessors arrays cpu.x86.assembler
+cpu.x86.allot cpu.x86.architecture cpu.architecture kernel
+kernel.private math math.private namespaces quotations sequences
words generic byte-arrays hashtables hashtables.private
generator generator.registers generator.fixup sequences.private
sbufs sbufs.private vectors vectors.private layouts system
-tuples.private strings.private slots.private compiler.constants ;
+tuples.private strings.private slots.private compiler.constants
+;
IN: cpu.x86.intrinsics
! Type checks
@@ -153,34 +154,6 @@ IN: cpu.x86.intrinsics
: small-reg-16 BX ; inline
: small-reg-32 EBX ; inline
-\ char-slot [
- small-reg PUSH
- "n" operand 2 SHR
- small-reg dup XOR
- "obj" operand "n" operand ADD
- small-reg-16 "obj" operand string-offset [+] MOV
- small-reg %tag-fixnum
- "obj" operand small-reg MOV
- small-reg POP
-] H{
- { +input+ { { f "n" } { f "obj" } } }
- { +output+ { "obj" } }
- { +clobber+ { "obj" "n" } }
-} define-intrinsic
-
-\ set-char-slot [
- small-reg PUSH
- "val" operand %untag-fixnum
- "slot" operand 2 SHR
- "obj" operand "slot" operand ADD
- small-reg "val" operand MOV
- "obj" operand string-offset [+] small-reg-16 MOV
- small-reg POP
-] H{
- { +input+ { { f "val" } { f "slot" } { f "obj" } } }
- { +clobber+ { "val" "slot" "obj" } }
-} define-intrinsic
-
! Fixnums
: fixnum-op ( op hash -- pair )
>r [ "x" operand "y" operand ] swap add r> 2array ;
diff --git a/core/cpu/x86/sse2/sse2.factor b/core/cpu/x86/sse2/sse2.factor
old mode 100644
new mode 100755
index cb8c87ed8d..98e42fa7fe
--- a/core/cpu/x86/sse2/sse2.factor
+++ b/core/cpu/x86/sse2/sse2.factor
@@ -1,10 +1,10 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays cpu.x86.assembler cpu.x86.architecture
-cpu.x86.intrinsics generic kernel kernel.private math
-math.private memory namespaces sequences words generator
-generator.registers cpu.architecture math.floats.private layouts
-quotations ;
+USING: alien alien.accessors arrays cpu.x86.assembler
+cpu.x86.architecture cpu.x86.intrinsics generic kernel
+kernel.private math math.private memory namespaces sequences
+words generator generator.registers cpu.architecture
+math.floats.private layouts quotations ;
IN: cpu.x86.sse2
: define-float-op ( word op -- )
diff --git a/core/growable/growable-docs.factor b/core/growable/growable-docs.factor
old mode 100644
new mode 100755
index 0311397a43..02f6292001
--- a/core/growable/growable-docs.factor
+++ b/core/growable/growable-docs.factor
@@ -21,7 +21,7 @@ HELP: set-fill
{ $values { "n" "a new fill pointer" } { "seq" "a resizable sequence" } }
{ $contract "Sets the fill pointer (number of occupied elements in the underlying storage) of a resizable sequence." }
{ $side-effects "seq" }
-{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is not safe. Changing the fill pointer to a negative value, or a value higher than the underlying sequence length can lead to memory corruption. User code should use " { $link set-length } " instead." } ;
+{ $warning "This word is in the " { $vocab-link "growable.private" } " vocabulary because it is not safe. Changing the fill pointer to a negative value, or a value higher than the underlying sequence length can lead to memory corruption. User code should use " { $link set-length } " instead." } ;
HELP: underlying
{ $values { "seq" "a resizable sequence" } { "underlying" "the underlying sequence" } }
@@ -30,7 +30,7 @@ HELP: underlying
HELP: set-underlying
{ $values { "underlying" "a sequence" } { "seq" "a resizable sequence" } }
{ $contract "Modifies the underlying storage of a resizable sequence." }
-{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is not safe. Setting an underlying sequence shorter than the fill pointer can lead to memory corruption." } ;
+{ $warning "This word is in the " { $vocab-link "growable.private" } " vocabulary because it is not safe. Setting an underlying sequence shorter than the fill pointer can lead to memory corruption." } ;
HELP: capacity
{ $values { "seq" "a vector or string buffer" } { "n" "the capacity of the sequence" } }
diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor
index 9a826d8e9b..6be3899acd 100755
--- a/core/inference/known-words/known-words.factor
+++ b/core/inference/known-words/known-words.factor
@@ -1,15 +1,16 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays bit-arrays byte-arrays classes
-combinators.private continuations.private effects float-arrays
-generic hashtables hashtables.private inference.state
-inference.backend inference.dataflow io io.backend io.files
-io.files.private io.streams.c kernel kernel.private math
-math.private memory namespaces namespaces.private parser
-prettyprint quotations quotations.private sbufs sbufs.private
-sequences sequences.private slots.private strings
-strings.private system threads.private tuples tuples.private
-vectors vectors.private words words.private assocs inspector ;
+USING: alien alien.accessors arrays bit-arrays byte-arrays
+classes combinators.private continuations.private effects
+float-arrays generic hashtables hashtables.private
+inference.state inference.backend inference.dataflow io
+io.backend io.files io.files.private io.streams.c kernel
+kernel.private math math.private memory namespaces
+namespaces.private parser prettyprint quotations
+quotations.private sbufs sbufs.private sequences
+sequences.private slots.private strings strings.private system
+threads.private tuples tuples.private vectors vectors.private
+words words.private assocs inspector ;
IN: inference.known-words
! Shuffle words
@@ -480,10 +481,10 @@ t over set-effect-terminated?
\ set-slot { object object fixnum } { } <effect> "inferred-effect" set-word-prop
-\ char-slot { fixnum object } { fixnum } <effect> "inferred-effect" set-word-prop
-\ char-slot make-flushable
+\ string-nth { fixnum string } { fixnum } <effect> "inferred-effect" set-word-prop
+\ string-nth make-flushable
-\ set-char-slot { fixnum fixnum object } { } <effect> "inferred-effect" set-word-prop
+\ set-string-nth { fixnum fixnum string } { } <effect> "inferred-effect" set-word-prop
\ resize-array { integer array } { array } <effect> "inferred-effect" set-word-prop
\ resize-array make-flushable
diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor
old mode 100644
new mode 100755
index 28cecc033f..7f0404812d
--- a/core/math/parser/parser.factor
+++ b/core/math/parser/parser.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.private namespaces sequences strings arrays
-combinators splitting math ;
+combinators splitting math assocs ;
IN: math.parser
DEFER: base>
@@ -11,12 +11,30 @@ DEFER: base>
2dup and [ / ] [ 2drop f ] if ;
: digit> ( ch -- n )
- {
- { [ dup digit? ] [ CHAR: 0 - ] }
- { [ dup letter? ] [ CHAR: a - 10 + ] }
- { [ dup LETTER? ] [ CHAR: A - 10 + ] }
- { [ t ] [ drop f ] }
- } cond ;
+ H{
+ { CHAR: 0 0 }
+ { CHAR: 1 1 }
+ { CHAR: 2 2 }
+ { CHAR: 3 3 }
+ { CHAR: 4 4 }
+ { CHAR: 5 5 }
+ { CHAR: 6 6 }
+ { CHAR: 7 7 }
+ { CHAR: 8 8 }
+ { CHAR: 9 9 }
+ { CHAR: A 10 }
+ { CHAR: B 11 }
+ { CHAR: C 12 }
+ { CHAR: D 13 }
+ { CHAR: E 14 }
+ { CHAR: F 15 }
+ { CHAR: a 10 }
+ { CHAR: b 11 }
+ { CHAR: c 12 }
+ { CHAR: d 13 }
+ { CHAR: e 14 }
+ { CHAR: f 15 }
+ } at ;
: digits>integer ( radix seq -- n )
0 rot [ swapd * + ] curry reduce ;
diff --git a/core/optimizer/math/math.factor b/core/optimizer/math/math.factor
index ec3c9c15da..e048e29f48 100755
--- a/core/optimizer/math/math.factor
+++ b/core/optimizer/math/math.factor
@@ -1,13 +1,13 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: optimizer.math
-USING: alien arrays generic hashtables kernel assocs math
-math.private kernel.private sequences words parser
+USING: alien alien.accessors arrays generic hashtables kernel
+assocs math math.private kernel.private sequences words parser
inference.class inference.dataflow vectors strings sbufs io
namespaces assocs quotations math.intervals sequences.private
-combinators splitting layouts math.parser classes
-generic.math optimizer.pattern-match optimizer.backend
-optimizer.def-use generic.standard system ;
+combinators splitting layouts math.parser classes generic.math
+optimizer.pattern-match optimizer.backend optimizer.def-use
+generic.standard system ;
{ + bignum+ float+ fixnum+fast } {
{ { number 0 } [ drop ] }
diff --git a/core/parser/parser.factor b/core/parser/parser.factor
old mode 100644
new mode 100755
index 31a3ceac03..1a61573bd4
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -5,7 +5,8 @@ namespaces prettyprint sequences strings vectors words
quotations inspector io.styles io combinators sorting
splitting math.parser effects continuations debugger
io.files io.streams.string io.streams.lines vocabs
-source-files classes hashtables compiler.errors compiler.units ;
+source-files classes hashtables compiler.errors compiler.units
+ascii ;
IN: parser
TUPLE: lexer text line column ;
diff --git a/core/prettyprint/backend/backend.factor b/core/prettyprint/backend/backend.factor
index 86ac6cd926..f88ab4ca2a 100755
--- a/core/prettyprint/backend/backend.factor
+++ b/core/prettyprint/backend/backend.factor
@@ -4,7 +4,7 @@ USING: arrays byte-arrays byte-vectors bit-arrays bit-vectors
generic hashtables io assocs kernel math namespaces sequences
strings sbufs io.styles vectors words prettyprint.config
prettyprint.sections quotations io io.files math.parser effects
-tuples classes float-arrays float-vectors ;
+tuples classes float-arrays float-vectors ascii ;
IN: prettyprint.backend
GENERIC: pprint* ( obj -- )
diff --git a/core/sbufs/sbufs.factor b/core/sbufs/sbufs.factor
index bcc7536e6f..9de57c0801 100755
--- a/core/sbufs/sbufs.factor
+++ b/core/sbufs/sbufs.factor
@@ -14,7 +14,7 @@ PRIVATE>
: <sbuf> ( n -- sbuf ) 0 <string> 0 string>sbuf ; inline
M: sbuf set-nth-unsafe
- underlying >r >r >fixnum r> >fixnum r> set-char-slot ;
+ underlying >r >r >fixnum r> >fixnum r> set-string-nth ;
M: sbuf new drop [ 0 <string> ] keep >fixnum string>sbuf ;
diff --git a/core/sbufs/tags.txt b/core/sbufs/tags.txt
index 42d711b32b..de2741b09f 100644
--- a/core/sbufs/tags.txt
+++ b/core/sbufs/tags.txt
@@ -1 +1,2 @@
+text
collections
diff --git a/core/strings/strings-docs.factor b/core/strings/strings-docs.factor
index d42e8cc601..e09c6da0eb 100755
--- a/core/strings/strings-docs.factor
+++ b/core/strings/strings-docs.factor
@@ -4,7 +4,11 @@ sbufs math ;
IN: strings
ARTICLE: "strings" "Strings"
-"A string is a fixed-size mutable sequence of characters. The literal syntax is covered in " { $link "syntax-strings" } "."
+"A string is a fixed-size mutable sequence of Unicode 5.0 code points."
+$nl
+"Characters are not a first-class type; they are simply represented as integers between 0 and 16777216 (2^24). Only characters up to 2097152 (2^21) have a defined meaning in Unicode."
+$nl
+"String literal syntax is covered in " { $link "syntax-strings" } "."
$nl
"String words are found in the " { $vocab-link "strings" } " vocabulary."
$nl
@@ -16,28 +20,25 @@ $nl
{ $subsection <string> }
"Creating a string from a single character:"
{ $subsection 1string }
-"Characters are not a first-class type; they are simply represented as integers between 0 and 65535. A few words operate on characters:"
-{ $subsection blank? }
-{ $subsection letter? }
-{ $subsection LETTER? }
-{ $subsection digit? }
-{ $subsection printable? }
-{ $subsection control? }
-{ $subsection quotable? }
-{ $subsection ch>lower }
-{ $subsection ch>upper } ;
+"Since strings are sequences, basic string manipulation can be performed using sequence operations (" { $link "sequences" } "). More advanced functionality can be found in other vocabularies, including but not limited to:"
+{ $list
+ { { $vocab-link "ascii" } " - traditional ASCII character classes" }
+ { { $vocab-link "unicode" } " - Unicode 5.0-aware character classes, case conversion, word breaks, ..." }
+ { { $vocab-link "regexp" } " - regular expressions" }
+ { { $vocab-link "peg" } " - parser expression grammars" }
+} ;
ABOUT: "strings"
HELP: string
{ $description "The class of fixed-length character strings. See " { $link "syntax-strings" } " for syntax and " { $link "strings" } " for general information." } ;
-HELP: char-slot ( n string -- ch )
+HELP: string-nth ( n string -- ch )
{ $values { "n" fixnum } { "string" string } { "ch" "the character at the " { $snippet "n" } "th index" } }
{ $description "Unsafe string accessor, used to define " { $link nth } " on strings." }
{ $warning "This word is in the " { $vocab-link "strings.private" } " vocabulary because it does not perform type or bounds checking. User code should call " { $link nth } " instead." } ;
-HELP: set-char-slot ( ch n string -- )
+HELP: set-string-nth ( ch n string -- )
{ $values { "ch" "a character" } { "n" fixnum } { "string" string } }
{ $description "Unsafe string mutator, used to define " { $link set-nth } " on strings." }
{ $warning "This word is in the " { $vocab-link "strings.private" } " vocabulary because it does not perform type or bounds checking. User code should call " { $link set-nth } " instead." } ;
@@ -46,58 +47,6 @@ HELP: <string> ( n ch -- string )
{ $values { "n" "a positive integer specifying string length" } { "ch" "an initial character" } { "string" string } }
{ $description "Creates a new string with the given length and all characters initially set to " { $snippet "ch" } "." } ;
-HELP: blank?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for an ASCII whitespace character." } ;
-
-HELP: letter?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for a lowercase alphabet ASCII character." } ;
-
-HELP: LETTER?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for a uppercase alphabet ASCII character." } ;
-
-HELP: digit?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for an ASCII decimal digit character." } ;
-
-HELP: Letter?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for an ASCII alphabet character, both upper and lower case." } ;
-
-HELP: alpha?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for an alphanumeric ASCII character." } ;
-
-HELP: printable?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for a printable ASCII character." } ;
-
-HELP: control?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for an ASCII control character." } ;
-
-HELP: quotable?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for characters which may appear in a Factor string literal without escaping." } ;
-
-HELP: ch>lower
-{ $values { "ch" "a character" } { "lower" "a character" } }
-{ $description "Converts a character to lowercase." } ;
-
-HELP: ch>upper
-{ $values { "ch" "a character" } { "upper" "a character" } }
-{ $description "Converts a character to uppercase." } ;
-
-HELP: >lower
-{ $values { "str" string } { "lower" string } }
-{ $description "Converts a string to lowercase." } ;
-
-HELP: >upper
-{ $values { "str" string } { "upper" string } }
-{ $description "Converts a string to uppercase." } ;
-
HELP: 1string
{ $values { "ch" "a character"} { "str" string } }
{ $description "Outputs a string of one character." } ;
diff --git a/core/strings/strings-tests.factor b/core/strings/strings-tests.factor
old mode 100644
new mode 100755
index 88f6f3e9ca..a3c49a08ba
--- a/core/strings/strings-tests.factor
+++ b/core/strings/strings-tests.factor
@@ -1,5 +1,5 @@
USING: continuations kernel math namespaces strings sbufs
-tools.test sequences vectors ;
+tools.test sequences vectors arrays ;
IN: temporary
[ CHAR: b ] [ 1 >bignum "abc" nth ] unit-test
@@ -66,3 +66,27 @@ unit-test
! Random tester found this
[ { "kernel-error" 3 12 -7 } ]
[ [ 2 -7 resize-string ] catch ] unit-test
+
+"hello world" "s" set
+
+[ ] [ HEX: 1234 1 "s" get set-nth ] unit-test
+[ ] [ HEX: 4321 3 "s" get set-nth ] unit-test
+[ ] [ HEX: 654321 5 "s" get set-nth ] unit-test
+
+[
+ {
+ CHAR: h
+ HEX: 1234
+ CHAR: l
+ HEX: 4321
+ CHAR: o
+ HEX: 654321
+ CHAR: w
+ CHAR: o
+ CHAR: r
+ CHAR: l
+ CHAR: d
+ }
+] [
+ "s" get >array
+] unit-test
diff --git a/core/strings/strings.factor b/core/strings/strings.factor
index 33efed11e8..dc1d12cec9 100755
--- a/core/strings/strings.factor
+++ b/core/strings/strings.factor
@@ -7,11 +7,6 @@ IN: strings
<PRIVATE
-: make-string-aux ( string -- aux )
- dup string-aux
- [ ] [ dup length <byte-array> dup rot set-string-aux ] ?if
- { byte-array } declare ; inline
-
: string-hashcode 3 slot ; inline
: set-string-hashcode 3 set-slot ; inline
@@ -35,43 +30,17 @@ M: string hashcode*
nip dup string-hashcode [ ]
[ dup rehash-string string-hashcode ] ?if ;
-M: string nth-unsafe >r >fixnum r> char-slot ;
+M: string nth-unsafe
+ >r >fixnum r> string-nth ;
-M: string set-nth-unsafe
+M: string set-nth-unsafe
dup reset-string-hashcode
- >r >fixnum >r >fixnum r> r> set-char-slot ;
+ >r >fixnum >r >fixnum r> r> set-string-nth ;
M: string clone (clone) ;
M: string resize resize-string ;
-! Characters
-: blank? ( ch -- ? ) " \t\n\r" member? ; inline
-: letter? ( ch -- ? ) CHAR: a CHAR: z between? ; inline
-: LETTER? ( ch -- ? ) CHAR: A CHAR: Z between? ; inline
-: digit? ( ch -- ? ) CHAR: 0 CHAR: 9 between? ; inline
-: printable? ( ch -- ? ) CHAR: \s CHAR: ~ between? ; inline
-: control? ( ch -- ? ) "\0\e\r\n\t\u0008\u007f" member? ; inline
-
-: quotable? ( ch -- ? )
- dup printable? [ "\"\\" member? not ] [ drop f ] if ; inline
-
-: Letter? ( ch -- ? )
- dup letter? [ drop t ] [ LETTER? ] if ; inline
-
-: alpha? ( ch -- ? )
- dup Letter? [ drop t ] [ digit? ] if ; inline
-
-: ch>lower ( ch -- lower )
- dup LETTER? [ HEX: 20 + ] when ; inline
-
-: ch>upper ( ch -- upper )
- dup letter? [ HEX: 20 - ] when ; inline
-
-: >lower ( str -- lower ) [ ch>lower ] map ;
-
-: >upper ( str -- upper ) [ ch>upper ] map ;
-
: 1string ( ch -- str ) 1 swap <string> ;
: >string ( seq -- str ) "" clone-like ;
diff --git a/core/strings/tags.txt b/core/strings/tags.txt
index 42d711b32b..de2741b09f 100644
--- a/core/strings/tags.txt
+++ b/core/strings/tags.txt
@@ -1 +1,2 @@
+text
collections
diff --git a/core/syntax/tags.txt b/core/syntax/tags.txt
new file mode 100755
index 0000000000..e69de29bb2
diff --git a/extra/io/buffers/buffers.factor b/extra/io/buffers/buffers.factor
index 54198a7dcc..f26fe50d79 100755
--- a/extra/io/buffers/buffers.factor
+++ b/extra/io/buffers/buffers.factor
@@ -2,8 +2,8 @@
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: io.buffers
-USING: alien alien.c-types alien.syntax kernel kernel.private
-libc math sequences strings hints ;
+USING: alien alien.accessors alien.c-types alien.syntax kernel
+kernel.private libc math sequences strings hints ;
TUPLE: buffer size ptr fill pos ;
diff --git a/extra/io/mmap/mmap.factor b/extra/io/mmap/mmap.factor
index af020e5a26..59246115cf 100755
--- a/extra/io/mmap/mmap.factor
+++ b/extra/io/mmap/mmap.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2007 Doug Coleman.
+! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: continuations io.backend kernel quotations sequences
-system alien sequences.private ;
+system alien alien.accessors sequences.private ;
IN: io.mmap
TUPLE: mapped-file length address handle closed? ;
diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor
index b9ce5aad4c..77249df9f1 100755
--- a/extra/io/windows/nt/sockets/sockets.factor
+++ b/extra/io/windows/nt/sockets/sockets.factor
@@ -1,7 +1,8 @@
-USING: alien alien.c-types byte-arrays continuations destructors
-io.nonblocking io io.sockets io.sockets.impl namespaces
-io.streams.duplex io.windows io.windows.nt.backend
-windows.winsock kernel libc math sequences threads tuples.lib ;
+USING: alien alien.accessors alien.c-types byte-arrays
+continuations destructors io.nonblocking io io.sockets
+io.sockets.impl namespaces io.streams.duplex io.windows
+io.windows.nt.backend windows.winsock kernel libc math sequences
+threads tuples.lib ;
IN: io.windows.nt.sockets
: malloc-int ( object -- object )
diff --git a/extra/ui/freetype/freetype.factor b/extra/ui/freetype/freetype.factor
index 8fc320e34c..0d7522332f 100755
--- a/extra/ui/freetype/freetype.factor
+++ b/extra/ui/freetype/freetype.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays io kernel libc math
-math.vectors namespaces opengl opengl.gl prettyprint assocs
+USING: alien alien.accessors alien.c-types arrays io kernel libc
+math math.vectors namespaces opengl opengl.gl prettyprint assocs
sequences io.files io.styles continuations freetype
ui.gadgets.worlds ui.render ui.backend byte-arrays ;
IN: ui.freetype
From d9f7acae0f1f682fe295a483953b9b7b491aa19e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 31 Jan 2008 23:03:10 -0600
Subject: [PATCH 08/20] VM changes for record1 strings
---
vm/alien.c | 0
vm/code_heap.c | 2 +-
vm/layouts.h | 3 ---
vm/primitives.c | 4 ++--
vm/run.h | 18 ++++++++++++----
vm/types.c | 55 +++++++++++++++++++++++++++++++++++++------------
vm/types.h | 25 +++++++++-------------
7 files changed, 69 insertions(+), 38 deletions(-)
mode change 100644 => 100755 vm/alien.c
diff --git a/vm/alien.c b/vm/alien.c
old mode 100644
new mode 100755
diff --git a/vm/code_heap.c b/vm/code_heap.c
index 5771725f9d..f449445eb9 100755
--- a/vm/code_heap.c
+++ b/vm/code_heap.c
@@ -176,7 +176,7 @@ void deposit_integers(CELL here, F_ARRAY *array, CELL format)
{
F_FIXNUM value = to_fixnum(array_nth(array,i));
if(format == 1)
- cput(here + i,value);
+ bput(here + i,value);
else if(format == sizeof(unsigned int))
*(unsigned int *)(here + format * i) = value;
else if(format == CELLS)
diff --git a/vm/layouts.h b/vm/layouts.h
index 2b8957ee66..ef6fb3d4ac 100755
--- a/vm/layouts.h
+++ b/vm/layouts.h
@@ -19,9 +19,6 @@ typedef signed long long s64;
#define CELLS ((signed)sizeof(CELL))
-/* must always be 16 bits */
-#define CHARS ((signed)sizeof(u16))
-
#define WORD_SIZE (CELLS*8)
#define HALF_WORD_SIZE (CELLS*4)
#define HALF_WORD_MASK (((unsigned long)1<<HALF_WORD_SIZE)-1)
diff --git a/vm/primitives.c b/vm/primitives.c
index 3b986e970a..f2f8ccf18d 100755
--- a/vm/primitives.c
+++ b/vm/primitives.c
@@ -152,8 +152,8 @@ void *primitives[] = {
primitive_alien_address,
primitive_slot,
primitive_set_slot,
- primitive_char_slot,
- primitive_set_char_slot,
+ primitive_string_nth,
+ primitive_set_string_nth,
primitive_resize_array,
primitive_resize_string,
primitive_array,
diff --git a/vm/run.h b/vm/run.h
index 976fa36337..86cf1c0e1f 100755
--- a/vm/run.h
+++ b/vm/run.h
@@ -74,14 +74,24 @@ INLINE void put(CELL where, CELL what)
*((CELL*)where) = what;
}
-INLINE u16 cget(CELL where)
+INLINE CELL cget(CELL where)
{
- return *((u16*)where);
+ return *((u16 *)where);
}
-INLINE void cput(CELL where, u16 what)
+INLINE void cput(CELL where, CELL what)
{
- *((u16*)where) = what;
+ *((u16 *)where) = what;
+}
+
+INLINE CELL bget(CELL where)
+{
+ return *((u8 *)where);
+}
+
+INLINE void bput(CELL where, CELL what)
+{
+ *((u8 *)where) = what;
}
INLINE CELL align(CELL a, CELL b)
diff --git a/vm/types.c b/vm/types.c
index d5e8d76abb..f34f5e57ca 100755
--- a/vm/types.c
+++ b/vm/types.c
@@ -419,29 +419,58 @@ DEFINE_PRIMITIVE(to_tuple)
}
/* Strings */
+CELL string_nth(F_STRING* string, CELL index)
+{
+ CELL ch = bget(SREF(string,index));
+ if(string->aux == F)
+ return ch;
+ else
+ {
+ F_BYTE_ARRAY *aux = untag_object(string->aux);
+ return (cget(BREF(aux,index * sizeof(u16))) << 8) | ch;
+ }
+}
+
+void set_string_nth(F_STRING* string, CELL index, CELL value)
+{
+ bput(SREF(string,index),value & 0xff);
+
+ if(string->aux == F)
+ {
+ if(value <= 0xff)
+ return;
+ else
+ {
+ string->aux = tag_object(allot_byte_array(
+ untag_fixnum_fast(string->length)
+ * sizeof(u16)));
+ }
+ }
+
+ F_BYTE_ARRAY *aux = untag_object(string->aux);
+ cput(BREF(aux,index * sizeof(u16)),value >> 8);
+}
/* untagged */
F_STRING* allot_string_internal(CELL capacity)
{
- F_STRING* string = allot_object(STRING_TYPE,
- sizeof(F_STRING) + (capacity + 1) * CHARS);
+ F_STRING *string = allot_object(STRING_TYPE,string_size(capacity));
/* strings are null-terminated in memory, even though they also
have a length field. The null termination allows us to add
the sizeof(F_STRING) to a Factor string to get a C-style
char* string for C library calls. */
- set_string_nth(string,capacity,0);
string->length = tag_fixnum(capacity);
string->hashcode = F;
string->aux = F;
+ set_string_nth(string,capacity,0);
return string;
}
void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
{
if(fill == 0)
- memset((void*)SREF(string,start),'\0',
- (capacity - start) * CHARS);
+ memset((void*)SREF(string,start),'\0',capacity - start);
else
{
CELL i;
@@ -466,7 +495,7 @@ DEFINE_PRIMITIVE(string)
dpush(tag_object(allot_string(length,initial)));
}
-F_STRING* reallot_string(F_STRING* string, CELL capacity, u16 fill)
+F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill)
{
CELL to_copy = string_capacity(string);
if(capacity < to_copy)
@@ -476,7 +505,7 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, u16 fill)
F_STRING *new_string = allot_string_internal(capacity);
UNREGISTER_UNTAGGED(string);
- memcpy(new_string + 1,string + 1,to_copy * CHARS);
+ memcpy(new_string + 1,string + 1,to_copy);
fill_string(new_string,to_copy,capacity,fill);
return new_string;
@@ -530,7 +559,7 @@ bool check_string(F_STRING *s, CELL max)
CELL i;
for(i = 0; i < capacity; i++)
{
- u16 ch = string_nth(s,i);
+ CELL ch = string_nth(s,i);
if(ch == '\0' || ch >= (1 << (max * 8)))
return false;
}
@@ -572,7 +601,7 @@ F_BYTE_ARRAY *allot_c_string(CELL capacity, CELL size)
} \
type *to_##type##_string(F_STRING *s, bool check) \
{ \
- if(sizeof(type) == sizeof(u16)) \
+ if(sizeof(type) == sizeof(char)) \
{ \
if(check && !check_string(s,sizeof(type))) \
general_error(ERROR_C_STRING,tag_object(s),F,NULL); \
@@ -597,16 +626,16 @@ F_BYTE_ARRAY *allot_c_string(CELL capacity, CELL size)
STRING_TO_MEMORY(char);
STRING_TO_MEMORY(u16);
-DEFINE_PRIMITIVE(char_slot)
+DEFINE_PRIMITIVE(string_nth)
{
- F_STRING* string = untag_object(dpop());
+ F_STRING *string = untag_object(dpop());
CELL index = untag_fixnum_fast(dpop());
dpush(tag_fixnum(string_nth(string,index)));
}
-DEFINE_PRIMITIVE(set_char_slot)
+DEFINE_PRIMITIVE(set_string_nth)
{
- F_STRING* string = untag_object(dpop());
+ F_STRING *string = untag_object(dpop());
CELL index = untag_fixnum_fast(dpop());
CELL value = untag_fixnum_fast(dpop());
set_string_nth(string,index,value);
diff --git a/vm/types.h b/vm/types.h
index dca54e5951..6f4234af34 100755
--- a/vm/types.h
+++ b/vm/types.h
@@ -11,7 +11,7 @@ INLINE CELL string_capacity(F_STRING* str)
INLINE CELL string_size(CELL size)
{
- return sizeof(F_STRING) + (size + 1) * CHARS;
+ return sizeof(F_STRING) + size + 1;
}
DEFINE_UNTAG(F_BYTE_ARRAY,BYTE_ARRAY_TYPE,byte_array)
@@ -83,7 +83,8 @@ INLINE CELL array_capacity(F_ARRAY* array)
return array->capacity >> TAG_BITS;
}
-#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + index * CHARS)
+#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + index)
+#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + index)
INLINE F_STRING* untag_string(CELL tagged)
{
@@ -91,16 +92,6 @@ INLINE F_STRING* untag_string(CELL tagged)
return untag_object(tagged);
}
-INLINE CELL string_nth(F_STRING* string, CELL index)
-{
- return cget(SREF(string,index));
-}
-
-INLINE void set_string_nth(F_STRING* string, CELL index, u16 value)
-{
- cput(SREF(string,index),value);
-}
-
DEFINE_UNTAG(F_QUOTATION,QUOTATION_TYPE,quotation)
DEFINE_UNTAG(F_WORD,WORD_TYPE,word)
@@ -141,7 +132,7 @@ DECLARE_PRIMITIVE(resize_float_array);
F_STRING* allot_string_internal(CELL capacity);
F_STRING* allot_string(CELL capacity, CELL fill);
DECLARE_PRIMITIVE(string);
-F_STRING *reallot_string(F_STRING *string, CELL capacity, u16 fill);
+F_STRING *reallot_string(F_STRING *string, CELL capacity, CELL fill);
DECLARE_PRIMITIVE(resize_string);
F_STRING *memory_to_char_string(const char *string, CELL length);
@@ -166,8 +157,12 @@ u16* to_u16_string(F_STRING *s, bool check);
DLLEXPORT u16 *unbox_u16_string(void);
DECLARE_PRIMITIVE(string_to_u16_alien);
-DECLARE_PRIMITIVE(char_slot);
-DECLARE_PRIMITIVE(set_char_slot);
+/* String getters and setters */
+CELL string_nth(F_STRING* string, CELL index);
+void set_string_nth(F_STRING* string, CELL index, CELL value);
+
+DECLARE_PRIMITIVE(string_nth);
+DECLARE_PRIMITIVE(set_string_nth);
F_WORD *allot_word(CELL vocab, CELL name);
DECLARE_PRIMITIVE(word);
From 5dfe21d818c7e6406e511a6520c483b309bdec38 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 31 Jan 2008 23:03:54 -0600
Subject: [PATCH 09/20] Better error reporting in planet
---
extra/webapps/planet/planet.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
mode change 100644 => 100755 extra/webapps/planet/planet.factor
diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor
old mode 100644
new mode 100755
index da6cf6dfcc..3e09b57dd1
--- a/extra/webapps/planet/planet.factor
+++ b/extra/webapps/planet/planet.factor
@@ -89,7 +89,7 @@ SYMBOL: last-update
[ set-entry-title ] keep ;
: ?fetch-feed ( triple -- feed/f )
- [ fetch-feed ] [ error. drop f ] recover ;
+ [ fetch-feed ] [ swap . error. f ] recover ;
: fetch-blogroll ( blogroll -- entries )
dup 0 <column>
From af13a47485f6f23a727e8ac0a15c64e74e165231 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 31 Jan 2008 23:04:11 -0600
Subject: [PATCH 10/20] Adding tags
---
extra/multiline/tags.txt | 1 +
extra/opengl/tags.txt | 3 +++
extra/parser-combinators/simple/tags.txt | 1 +
extra/parser-combinators/tags.txt | 1 +
extra/peg/tags.txt | 1 +
extra/prolog/tags.txt | 2 +-
extra/regexp/tags.txt | 2 ++
extra/space-invaders/resources/invaders.rom | Bin 0 -> 8192 bytes
extra/tuple-syntax/tags.txt | 2 +-
extra/unicode/breaks/tags.txt | 1 +
extra/unicode/case/tags.txt | 1 +
extra/unicode/categories/tags.txt | 1 +
extra/unicode/data/tags.txt | 1 +
extra/unicode/normalize/tags.txt | 1 +
extra/unicode/syntax/tags.txt | 1 +
extra/unicode/tags.txt | 1 +
16 files changed, 18 insertions(+), 2 deletions(-)
create mode 100755 extra/multiline/tags.txt
create mode 100755 extra/parser-combinators/simple/tags.txt
create mode 100755 extra/parser-combinators/tags.txt
create mode 100755 extra/regexp/tags.txt
create mode 100644 extra/space-invaders/resources/invaders.rom
create mode 100755 extra/unicode/breaks/tags.txt
create mode 100755 extra/unicode/case/tags.txt
create mode 100755 extra/unicode/categories/tags.txt
create mode 100755 extra/unicode/data/tags.txt
create mode 100755 extra/unicode/normalize/tags.txt
create mode 100755 extra/unicode/syntax/tags.txt
create mode 100755 extra/unicode/tags.txt
diff --git a/extra/multiline/tags.txt b/extra/multiline/tags.txt
new file mode 100755
index 0000000000..abf53a421b
--- /dev/null
+++ b/extra/multiline/tags.txt
@@ -0,0 +1 @@
+reflection
diff --git a/extra/opengl/tags.txt b/extra/opengl/tags.txt
index bb863cf9a0..5e477dbcb3 100644
--- a/extra/opengl/tags.txt
+++ b/extra/opengl/tags.txt
@@ -1 +1,4 @@
+opengl.glu
+opengl.gl
+opengl
bindings
diff --git a/extra/parser-combinators/simple/tags.txt b/extra/parser-combinators/simple/tags.txt
new file mode 100755
index 0000000000..9da56880c0
--- /dev/null
+++ b/extra/parser-combinators/simple/tags.txt
@@ -0,0 +1 @@
+parsing
diff --git a/extra/parser-combinators/tags.txt b/extra/parser-combinators/tags.txt
new file mode 100755
index 0000000000..9da56880c0
--- /dev/null
+++ b/extra/parser-combinators/tags.txt
@@ -0,0 +1 @@
+parsing
diff --git a/extra/peg/tags.txt b/extra/peg/tags.txt
index 9da56880c0..5af5dba748 100644
--- a/extra/peg/tags.txt
+++ b/extra/peg/tags.txt
@@ -1 +1,2 @@
+text
parsing
diff --git a/extra/prolog/tags.txt b/extra/prolog/tags.txt
index 458345b533..eab42feac7 100644
--- a/extra/prolog/tags.txt
+++ b/extra/prolog/tags.txt
@@ -1 +1 @@
-prolog
+languages
diff --git a/extra/regexp/tags.txt b/extra/regexp/tags.txt
new file mode 100755
index 0000000000..65bc471f6b
--- /dev/null
+++ b/extra/regexp/tags.txt
@@ -0,0 +1,2 @@
+parsing
+text
diff --git a/extra/space-invaders/resources/invaders.rom b/extra/space-invaders/resources/invaders.rom
new file mode 100644
index 0000000000000000000000000000000000000000..606ec01945d665881793becbde201b7292947a9e
GIT binary patch
literal 8192
zcmeG>|9=}*a&K3w)k?A@tu5KoN{Zh~w(Qu!m?gH8#THIV{3Xy3X!zD^FA3prC^1d~
z7u&&>orFLR3WN`EB+&B7^$uL1t;4mSkWY`MvbOel6&`V75`w~qVv5B<!lk}kxZwC!
zohRA3<A?hTnzg<2=Dm5d^JeDFdoxA|X&-nIx;S!jO8eU!j1DMUu^h*>gcP4)oT+xC
zeuW2<%aM8(8~c+{G|H4KXEAB<4Jlt?^-CDriPZCWFwsd#1`~gc$bZ^2=zAWJok;tE
zCCUJ$b|WH9#j1jp0Zb4>T3J$PMU%&er!VUWo+0?`A9H&Rsl(WLVkeR@CO5NW83R1Y
z<HA%de1B)iibHlhSrs!(i80iu2-q;9C^3N=lzgm5S>>{<Tn=fU3zYMpeq<KM1`|s>
zQ!0-;)ppz-8=OqmG2w75+?+Nn7R%ZqB%^@uZ1>=Q-N01ZG4CQ1o*@NcU9LgCv%0zw
z500q_560<i;8Mgk81?V{gz0QHC)O|ukI8msJ&4+8RHU}}wksS4Wx(_z)F)eUb9j|u
zpLv1##J;wB)YbB+TieBK92{HQGwQna(MIh>#*-wB%;P!~UR8(4M~rO7v4%9$H6*v=
z`*n~_=IcRTb7F+iC-o@9e=4)3+I#MBbGYa6u5kC`T{<5ZkzYnwQzUu0tX*Q{<sk<r
z;^0Ys5mBV$`H9~%FjMoh@N%<5;_{HTfC5?Bff=?)<}0Gy#SwJ}SaUf`9*~Bo8^=zH
zpR&H=+CrA}y0uzXcHx+j88eLJ4mR9;>%pEx7aIo6?qS2<58pX;c1rGK|L5eFlVTq7
zX*aWGF44y}nm1Q<iLPu%ZB>=FgPjZmljIGiaBaM0NZE*$2XM4T`5W9_XAajUUNKcl
zRR5)J_?qbQLsOA>L_YSZ9aR6|fn(R9(#zySAE~wuCOeAA7v9)la*;`WAAA%*JHF^l
zDJJ4zNw@HDcxzSFW<)+`rkzolM<)tQJdTExc1#Z0h7=KZPna8&eVClGl7311)<WOK
z0<p5%B^EqN-iSf*u|e&i302iGsvoyxH^Byz8pO`j4wEzWj7jS>k$ADi0;mO0*^9{y
z5^0ghQg;+71z7JkK1z0)8WcYU(r%*$kj5MWR#rS1T+kwK4(#p>c_~F=B`618TC+*4
z#Dte7$3cWKgGtVq3^r-w!muAIx!PnM7c-pkDN@6c+uf7l#o=&mE&SGo>jdc2kh`G^
zBpwwM;F87ReR669h=(VStBdgNPGun`&$-q0pjCy%x?vvE>NvR^Yp{SUSGf#}Wq#fQ
zR;YX$FX}Tkr2c}dUK4s6S3Zjug`UOgV_=q8nqd~QiHA7mQ$v0dZwZGt>yxVDR}@^i
z1o!=0;z_P5v;^y7EslOmR-4sktZc^Womkm|$p*99jR)mgocNwutnte=V1IDqN%bLW
z@BwTvad8EXeog1qeRtkAY`9WiaB8bx*@m-RR%E#}`Q;|+MT(^E#El8T4BPP`T)7Qv
zF@93K14qyNK?q=(69SldQj5*%-B+01k!7~pFR#uq0|ueHv99!E`C-i4K}c~90v<~b
zB!<lp%?wU`04Luu4~~WFkh&SX@<-+t^%y=pu5JP3$8!jnH0kGo<*G0WZNubRejK7m
z�xn@06`G^eFvC?3;nE@M2x;rCtC|kY*A$@!`efhrHT@M@@1+K9c&(d@4`r!Rn*n
znlU_}Jc`LC9xzx;0iU%jMHT>Jl!O2CFM-3U594nb<zcL6-J_j!dU}k!)N5vkU3<-(
zPlMb8MdsLGeY|hf-swry^Sa!PYiSs6=i%e>$AM4}mV0q+ZB=b;lvnz&wuv8%YcSM9
zonL#-J=eJ19csnk3t&bzF7JXsoOGJO@Pi4bnZ}N{c(9Nmq@3nDhBR2jC$lS+chiV{
ziU(hcg~N|4(A!|42*lTKd1La#x4h095EQ~7R7vt?i{VY?Sq9_$d3hg>9q3Bq2{Y_o
zvfM(By5Xz5jjXlshW4=!9AO%RCpSAdd38{{B`6(ER#?J?`H7$<raXZoXyZb7LchT<
zS(_H<d#PJ~BD<;<iFeTt9PA>Si{;*6=n1TW%)9*H3BdSyoQ+I9K8PlAVU2j9#KDmZ
z0vwl(va7=3PTVDk$0X=E!=$-nzlGmFq`Z$|cwp|Rl@SVE!l7AA%6z2C2Qf}&m|o>P
z4t;?`Q<&W8Bj*`%ks-$gB_k`D5cv=eR6|yb5Q#H{^U2*yLbGycHUt3=A{lvF08xNs
z7?WcRnAMruDv&}J5b`!6$9-^c&3K8oh}eAOf`{y}f-we@=dHw1Olqy<v_KXWlY4B*
zHi73T<qwM|c*1$L5_;l_|4!G!?}O`uGu0tDQ~NAhKimSeS1d$gHMgJ&xTVsH&uWiT
za_Uvpv$`x+iJScn2UQFR6b;B?{RbH#dQgdDH4bqo%_ZIyNYYBK^J#AgJeC9HS;>zI
za$qT#6FSeZY161lr=DXSk6u<{;K&gD<3PY;?Wo&fl1`G0a2%|9LC{6CU@C$-!K%Kq
zle{p&gF#g*HoC_vpQEv9p;bmam~R)Z3O$E)A{JF=Vmfj8s;VIB@*en_kZiR=I7wQ=
zvBRg~+*usEC^KcHrHzTZp<i4VfKWf(K%SDav+7VZqwJ?qY{n}e2pa6^u)&=U>o8xP
zh7}Hh3r<!32A`db?JDnD8;(6$-gOsTM(*#_{@J>n{M`EJ$%{^S(oQmBozA|G>!XsE
z$!bi#gip(}a5Z5|;lj|DE-?bBUs**S`Ff3})JImGG{DLBB|XwWZx`v&2ge=N{#3OQ
zOIsSc<bMc;8xw`L*ktu=SGaCTuQPSMEh^Jv5PXaCX`Dd)EY8rzJ+{Q{HaMW?tV6w_
z#g^;URSz~YIz14Ry|z|f02f)-O?s^{`2t*Ks=DCBl<&=6)Q0f{uO0=u-5}dA)=x^*
zK2b}KZDZn98`$c3n+}l{ZVu5V?L%910A7>Y*6al_^$VLbwbAQLy#+MxDu+{h-Zm#v
zA_ZLu%;&)-9GWmqn8{AxW%9O7JqL$MagBpZ{K_uQ1jzF?aVSWR*<grxym0(eg2YO@
z_@YEUvylOtc+j6~0EMWRTxrYiTo3W%s2iqGon~aX{MvI{knS<qX|VS|UlLrcayyOg
zsA)TF6;Rd|`;bzGsls+a3pOHrevi+QCyR^3y(M%PoWll6{EJ-{uaB~z73S|s$emtt
zi}ws`NojWGKnYRj#09#PT|7B2+N)mqT<)R>a%unV72gWNDmA+uwzKxKuMi1^jtJ{;
z!sfgBT-Cr;4P4d0RSjI#z*P<Wf71YY#EnL#qzUef=}=d=a46T9WH7Q0n-gX?ROWzW
zWNN4@+!dbhE_drAQdi*|(Naou<;hZK`Ca?^JVR*BPrbvf_oXcptkxopOvMTc!}*Dr
zdw#Ijt;6&oWj&q~>Ei3jH{5V_T92o%NC$oYaiwp5=03MRG}1LE(0guOEyGZ-fV@&&
zh>g=NCu%$@3)kyz<NXsoo>9JqUh?;z;5>(6WFxuPqgG;?>W1#aQ8T@h?eIW0TH}F|
z+gcl~*i3k$F2w}*RTGSAD?PFa*TyUFqq%>nJIX=l5EM!H-$5FQ9O&H-_IlnOA9dwv
zf9ZiQ{eZ0TEHi)N>eN*mhW00}cBr>0yRo*y(+%~Vfq{V?joIp>o;T{6+3V5Oe7JwU
z<B@+BB_p13-T>-++zmxe)qxcYT<}ZF=m44a4ry<A_+rS2A1s0*;4eKoHP_Uf`sVe2
zMf)FmCTSAGpn6zd#*+tAzV-AdkSsBA`9Y{>>DAd}EO&j6)2d#$`CuHhnX9iQZ!c1>
z0nu8EpsJO2je%TcSh)r=BZ|gp3#vkOOy$=&+-Jm68;YtQ34M)YN)YSy`cN(l0;NK>
zBwobQ5r37Ge5&Zgz9Q|}q9XvPL&OTmYG1Zurx(el3h{Nx;fA|wSsCxoCVTG`@quo*
z4Aa|kw!WtqX<xIl_ZmuR1IpZGd<b%5xbPqMX+N^l+<ORW8|1V*m#o5-``1O;9J-v$
z_^4d`W$i&<Hj5Jv2jrhf4z5Kye4@OVrvHKBm~ssANbo6?SX#{g9<0o>kikI_@D*J9
zUPm#l0w+6)<sXAr&?>-$Ih!qa6j#NvsSbF^E5KkMPS;GBb@fG{ezRB>B~hkTs3Rwy
zf$wO$izVeHOsA)7T4HIZ#c(BlRvcvxb`2>nVtGIC=Fihl&s8#j6E&9eL=wvM`WY5}
z)7+T)GS~_h3=2JFH77m>2FlAA)_PfdHy{^5(nD4BHso3_V<<~#pybDB>BVA!noFE#
zXkzNB5PuqQcpw9b+LTS0ITD1lBUSGuH+i)RFHB~R(Vo+giD;^K1UA7^_pm;qZo;<$
z^I_d)Wa`H{O}2KEZLP_6muZk@VT;47pnlz=Ch_6qKCha<X|D1;oY><Pp^zT>C6-5M
zA?2(#;el8JLLUWRT8+hcuFeY;{Q(TQa}0wnhp~DGPBY2F-YiVSy);9LAn*$9kc}=L
zku(D}k*ENM)4sBSn&dCAb3Cl`EGWD&>q4_@MFvo-pY$3TYYxzM;M30V=9e$jBW5
zc|oc8xujhXAg$J}^Fd+_Z>VO^r{fNb%+!i+lmG=3YGkHC`?*#AEhQp<B@xLtSE*U;
zBMm;S#RnxRZA%d>tOILl>U{7I6s^HWQ{Jb18kB{=*N^xdg}{ymQ*{CCvw!kIJ!sph
zt?>qB0j5o3aa{ISi@&owtUy;WpT~(#hlmOVM}7tH{}Ss%+Jq0m3J=V!kSR~j_@EZS
zyKV(j^)x2V`M_vL-MvO_V#cS-TXD0L9{9(2y{=T128zUdn_%J1oQY)?SC@wZUQeOR
zk)LO`TFe;<f{HnzNP12atHRCeJM|IX)LYWtSJG)ttdx4wH-3ZLhe5Bj3IUae#9B#*
zh;*onM*9b)`I!BHq|-Y6*u};!lJ-qQ)g<lIMyz!4nZpJSxL!p#P~)<LC@7DMI6Ryf
zi8$@Z%Za6tGJnJ&MglpsAi}r{3my3pN50(~@#i`t^PQ0b)**7G{<4TgxG~$F>j{)a
z7=&E(gKYPb?j`6FLIda-He=3P7r-?x7=-5+Cgj>1sHkB$l*s_)HZI%E{W^e<37Urh
zXHby)Y!2Va1I`Dzaf)Y99Dqw^Pz@>oVk+AF8vJFmh@mVIzArew(95m~A_39aO~4Rk
zmyb+bx4Te~8aK|)Zful*mN~rdfZvrt2mF9g=^eD3iI8PHF!l<_LnqkbKO!?T9jY%o
zl6?U~=8+Ou9(@AW!e2T3Ek$T)&-RDT&CHy8XnPM}@N@@{Y-(s|*mNY=oyF02nJwAg
z-$Cg+`nNC1jyt?ZIvN`qJC1lAIr={m7CM|I@bqW;DS&bV#}t|@|LVNfbZr}Ff|Uy9
zpV~~{bC#FeZ*F=_Y<2E$h&8?&?cHDQmm*GwkY89(kuw=Gc~CyfMG6sP=PFnit|=7k
z;QwtQ_m1Ug`3`re4ff4VZ@TuZ3Ax_9DYRzKO3#rSzhB19a;{kyp2Y*R1IR$7MghEA
zjlE!rg`g7)!!Vqk;Y|!<x3U6j=PWie{C|qK2sYkk$~ZG6nHw|xnaphFQs#fZ^K%LM
zvQIxylw_P{m#5~1mtOvRml;|vm$}9TFOMs09xiV|eYE$HSnQGBX#Ik`oC}4}YfZww
z#zPHtL09X&hl2Zr<$GZbkrK%-N&XTkC`qu)b*o!jTbr7isOuCs5vU*{<a@x*Vu54P
z#$ete9I!2F3J8l(Amgb1G?-WYRnS)b+n`XrKaeS363O!x6mp`sJUFk=^1yrx%u`Z&
zQ)vmn{<gNZI)Kq-%a(;G4lp{`zl=gE1V9*H(L!-S5c&b4W&Ly*v7pBoz<$9U%F+W4
zK8O0T7gM@^m%vd-`Dgh8znUz*VtFGSZ@p#ZbpRERBLc9gslTZSU~G<WFUzpKfcLX`
zEakJoEx0!TT<3DS)&cyp6>Ybz2N(rN`6IcXejbHaw6#&b%a^s?b3ed5cWFP>{?^-W
zyKNP~1q<8SngKSow60zUux?Hd*R{2+Yyf<2Ik3)<I~$jwk3Met01UbN-Be$&?ZBT=
zX)Y|yZSjJ#NTk9)heRTNsJIFF5vmsk6h?ou;@5buY#AZHfD;QNS;G9v)g`vddrK^p
zlO-8e<V-?gBsXEnAGRcJ`t#KozE5LjW}w9N5*jE0_TwRlpD#fCtO(4@5(#9v7C7An
MmIwm#39z331Jt3$sQ>@~
literal 0
HcmV?d00001
diff --git a/extra/tuple-syntax/tags.txt b/extra/tuple-syntax/tags.txt
index 71c0ff7282..abf53a421b 100644
--- a/extra/tuple-syntax/tags.txt
+++ b/extra/tuple-syntax/tags.txt
@@ -1 +1 @@
-syntax
+reflection
diff --git a/extra/unicode/breaks/tags.txt b/extra/unicode/breaks/tags.txt
new file mode 100755
index 0000000000..8e27be7d61
--- /dev/null
+++ b/extra/unicode/breaks/tags.txt
@@ -0,0 +1 @@
+text
diff --git a/extra/unicode/case/tags.txt b/extra/unicode/case/tags.txt
new file mode 100755
index 0000000000..8e27be7d61
--- /dev/null
+++ b/extra/unicode/case/tags.txt
@@ -0,0 +1 @@
+text
diff --git a/extra/unicode/categories/tags.txt b/extra/unicode/categories/tags.txt
new file mode 100755
index 0000000000..8e27be7d61
--- /dev/null
+++ b/extra/unicode/categories/tags.txt
@@ -0,0 +1 @@
+text
diff --git a/extra/unicode/data/tags.txt b/extra/unicode/data/tags.txt
new file mode 100755
index 0000000000..8e27be7d61
--- /dev/null
+++ b/extra/unicode/data/tags.txt
@@ -0,0 +1 @@
+text
diff --git a/extra/unicode/normalize/tags.txt b/extra/unicode/normalize/tags.txt
new file mode 100755
index 0000000000..8e27be7d61
--- /dev/null
+++ b/extra/unicode/normalize/tags.txt
@@ -0,0 +1 @@
+text
diff --git a/extra/unicode/syntax/tags.txt b/extra/unicode/syntax/tags.txt
new file mode 100755
index 0000000000..8e27be7d61
--- /dev/null
+++ b/extra/unicode/syntax/tags.txt
@@ -0,0 +1 @@
+text
diff --git a/extra/unicode/tags.txt b/extra/unicode/tags.txt
new file mode 100755
index 0000000000..8e27be7d61
--- /dev/null
+++ b/extra/unicode/tags.txt
@@ -0,0 +1 @@
+text
From d7c1349c8daf61875326bf3c572dcb1296e517a9 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 31 Jan 2008 23:21:06 -0600
Subject: [PATCH 11/20] Fix a bunch of load-everything hiccups
---
extra/cryptlib/streams/streams.factor | 2 +-
extra/html/elements/elements.factor | 2 +-
extra/html/html.factor | 4 ++--
extra/io/streams/null/null.factor | 2 +-
extra/tar/tar.factor | 5 ++---
extra/webapps/pastebin/pastebin.factor | 4 ++--
6 files changed, 9 insertions(+), 10 deletions(-)
diff --git a/extra/cryptlib/streams/streams.factor b/extra/cryptlib/streams/streams.factor
index 64b5ee9992..828476d2e2 100755
--- a/extra/cryptlib/streams/streams.factor
+++ b/extra/cryptlib/streams/streams.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2007 Matthew Willis
! See http://factorcode.org/license.txt for BSD license.
-USING: cryptlib cryptlib.libcl kernel alien sequences
+USING: cryptlib cryptlib.libcl kernel alien sequences continuations
byte-arrays namespaces io.buffers math generic io strings
io.streams.lines io.streams.plain io.streams.duplex combinators
alien.c-types ;
diff --git a/extra/html/elements/elements.factor b/extra/html/elements/elements.factor
index ff3e7b1283..0f76c2e91e 100644
--- a/extra/html/elements/elements.factor
+++ b/extra/html/elements/elements.factor
@@ -4,7 +4,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: io kernel namespaces prettyprint quotations
-sequences strings words xml.writer compiler.units effects ;
+sequences strings words xml.writer xml.entities compiler.units effects ;
IN: html.elements
diff --git a/extra/html/html.factor b/extra/html/html.factor
index b5d4e63930..b5b0a5e2a9 100755
--- a/extra/html/html.factor
+++ b/extra/html/html.factor
@@ -1,9 +1,9 @@
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: generic assocs help http io io.styles io.files
+USING: generic assocs help http io io.styles io.files continuations
io.streams.string kernel math math.parser namespaces
quotations assocs sequences strings words html.elements
-xml.writer sbufs ;
+xml.writer xml.entities sbufs ;
IN: html
GENERIC: browser-link-href ( presented -- href )
diff --git a/extra/io/streams/null/null.factor b/extra/io/streams/null/null.factor
index 28d1b29be8..f76b0cbce3 100755
--- a/extra/io/streams/null/null.factor
+++ b/extra/io/streams/null/null.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: io.streams.null
-USING: kernel io ;
+USING: kernel io continuations ;
TUPLE: null-stream ;
diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor
index ee312c1111..d3412568fe 100755
--- a/extra/tar/tar.factor
+++ b/extra/tar/tar.factor
@@ -1,7 +1,6 @@
-USING: combinators io io.files io.streams.duplex
+USING: combinators io io.files io.streams.duplex continuations
io.streams.string kernel math math.parser
-namespaces pack prettyprint sequences strings system ;
-USING: hexdump tools.interpreter ;
+namespaces pack prettyprint sequences strings system hexdump ;
IN: tar
: zero-checksum 256 ;
diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor
index 5ac322a952..e02e5c01f2 100755
--- a/extra/webapps/pastebin/pastebin.factor
+++ b/extra/webapps/pastebin/pastebin.factor
@@ -1,5 +1,5 @@
USING: calendar furnace furnace.validator io.files kernel
-namespaces sequences http.server.responders html math.parser rss
+namespaces sequences http.server.responders html math math.parser rss
xml.writer xmode.code2html ;
IN: webapps.pastebin
@@ -94,7 +94,7 @@ C: <annotation> annotation
: annotate-paste ( n summary author mode contents -- )
<annotation> swap get-paste
- [ paste-annotations push store save-store ] keep
+ [ paste-annotations push ] keep
paste-link permanent-redirect ;
[ "n" show-paste ]
From da1d8967c4745f91eeca43944de73710dabac9b9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 31 Jan 2008 23:48:51 -0600
Subject: [PATCH 12/20] Load fixes
---
extra/documents/documents.factor | 2 +-
extra/help/tutorial/tutorial.factor | 5 +++--
extra/io/windows/nt/backend/backend.factor | 2 +-
extra/tools/completion/completion.factor | 5 +++--
extra/ui/commands/commands.factor | 4 ++--
extra/ui/tools/search/search.factor | 2 +-
extra/ui/windows/windows.factor | 7 +++++--
7 files changed, 16 insertions(+), 11 deletions(-)
mode change 100644 => 100755 extra/ui/commands/commands.factor
diff --git a/extra/documents/documents.factor b/extra/documents/documents.factor
index 19fca8b24c..a9b696179e 100755
--- a/extra/documents/documents.factor
+++ b/extra/documents/documents.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2006, 2007 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: arrays io kernel math models namespaces sequences strings
-splitting io.streams.lines combinators ;
+splitting io.streams.lines combinators unicode.categories ;
IN: documents
: +col ( loc n -- newloc ) >r first2 r> + 2array ;
diff --git a/extra/help/tutorial/tutorial.factor b/extra/help/tutorial/tutorial.factor
index f20ca27a5f..f6b1faf385 100755
--- a/extra/help/tutorial/tutorial.factor
+++ b/extra/help/tutorial/tutorial.factor
@@ -1,6 +1,7 @@
USING: help.markup help.syntax ui.commands ui.operations
ui.tools.search ui.tools.workspace editors vocabs.loader
-kernel sequences prettyprint tools.test strings ;
+kernel sequences prettyprint tools.test strings
+unicode.categories unicode.case ;
IN: help.tutorial
ARTICLE: "first-program-start" "Creating a vocabulary for your first program"
@@ -134,7 +135,7 @@ $nl
{ $code "[ Letter? ] subset >lower" }
"This code starts with a string on the stack, removes non-alphabetical characters, and converts the result to lower case, leaving a new string on the stack. We put this code in a new word, and add the new word to " { $snippet "palindrome.factor" } ":"
{ $code ": normalize ( str -- newstr ) [ Letter? ] subset >lower ;" }
-"You will need to add " { $vocab-link "strings" } " to the vocabulary search path, so that " { $link Letter? } " can be used in the source file."
+"You will need to add " { $vocab-link "unicode.categories" } " to the vocabulary search path, so that " { $link Letter? } " can be used in the source file."
$nl
"We modify " { $snippet "palindrome?" } " to first apply " { $snippet "normalize" } " to its input:"
{ $code ": palindrome? ( str -- ? ) normalize dup reverse = ;" }
diff --git a/extra/io/windows/nt/backend/backend.factor b/extra/io/windows/nt/backend/backend.factor
index 940b1b7fee..67f2a9861c 100755
--- a/extra/io/windows/nt/backend/backend.factor
+++ b/extra/io/windows/nt/backend/backend.factor
@@ -2,7 +2,7 @@ USING: alien alien.c-types arrays assocs combinators
continuations destructors io io.backend io.nonblocking
io.windows libc kernel math namespaces sequences
threads tuples.lib windows windows.errors windows.kernel32
-strings splitting io.files qualified ;
+strings splitting io.files qualified ascii ;
QUALIFIED: windows.winsock
IN: io.windows.nt.backend
diff --git a/extra/tools/completion/completion.factor b/extra/tools/completion/completion.factor
index 539b348706..e44c3c401e 100755
--- a/extra/tools/completion/completion.factor
+++ b/extra/tools/completion/completion.factor
@@ -1,8 +1,9 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: tools.completion
USING: kernel arrays sequences math namespaces strings io
-vectors words assocs combinators sorting ;
+vectors words assocs combinators sorting unicode.case
+unicode.categories ;
: (fuzzy) ( accum ch i full -- accum i ? )
index*
diff --git a/extra/ui/commands/commands.factor b/extra/ui/commands/commands.factor
old mode 100644
new mode 100755
index e0d991e1b2..04f655853a
--- a/extra/ui/commands/commands.factor
+++ b/extra/ui/commands/commands.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays definitions kernel sequences strings math assocs
words generic namespaces assocs quotations splitting
-ui.gestures ;
+ui.gestures unicode.case unicode.categories ;
IN: ui.commands
SYMBOL: +nullary+
@@ -51,7 +51,7 @@ GENERIC: command-word ( command -- word )
update-gestures ;
: (command-name) ( string -- newstring )
- "-" split " " join unclip ch>upper add* ;
+ "-" split " " join >title ;
M: word command-name ( word -- str )
word-name
diff --git a/extra/ui/tools/search/search.factor b/extra/ui/tools/search/search.factor
index ea3fcb02eb..27ca4a165d 100755
--- a/extra/ui/tools/search/search.factor
+++ b/extra/ui/tools/search/search.factor
@@ -7,7 +7,7 @@ source-files strings tools.completion tools.crossref tuples
ui.commands ui.gadgets ui.gadgets.editors
ui.gadgets.lists ui.gadgets.scrollers ui.gadgets.tracks
ui.gestures ui.operations vocabs words vocabs.loader
-tools.browser ;
+tools.browser unicode.case ;
IN: ui.tools.search
TUPLE: live-search field list ;
diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor
index 9311a1b2a6..c3ef328b29 100755
--- a/extra/ui/windows/windows.factor
+++ b/extra/ui/windows/windows.factor
@@ -6,7 +6,7 @@ math math.vectors namespaces prettyprint sequences strings
vectors words windows.kernel32 windows.gdi32 windows.user32
windows.opengl32 windows.messages windows.types
windows.nt windows threads timers libc combinators continuations
-command-line shuffle opengl ui.render ;
+command-line shuffle opengl ui.render unicode.case ascii ;
IN: ui.windows
TUPLE: windows-ui-backend ;
@@ -140,7 +140,10 @@ SYMBOL: mouse-captured
: ctrl? ( -- ? ) left-ctrl? right-ctrl? or ;
: alt? ( -- ? ) left-alt? right-alt? or ;
: caps-lock? ( -- ? ) VK_CAPITAL GetKeyState zero? not ;
-: switch-case ( seq -- seq ) dup first CHAR: a >= [ >upper ] [ >lower ] if ;
+
+: switch-case ( seq -- seq )
+ dup first CHAR: a >= [ >upper ] [ >lower ] if ;
+
: switch-case? ( -- ? ) shift? caps-lock? xor not ;
: key-modifiers ( -- seq )
From 71bac0da210be60088eca406785cd7c5ffed610e Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jjjj.gateway.2wire.net>
Date: Thu, 31 Jan 2008 23:59:29 -0600
Subject: [PATCH 13/20] Load fixes
---
extra/io/unix/unix-tests.factor | 2 +-
extra/parser-combinators/parser-combinators.factor | 3 ++-
extra/xml/writer/writer.factor | 3 ++-
3 files changed, 5 insertions(+), 3 deletions(-)
diff --git a/extra/io/unix/unix-tests.factor b/extra/io/unix/unix-tests.factor
index ce2f052450..e49364fad3 100755
--- a/extra/io/unix/unix-tests.factor
+++ b/extra/io/unix/unix-tests.factor
@@ -1,6 +1,6 @@
USING: io.files io.sockets io kernel threads namespaces
tools.test continuations strings byte-arrays sequences
-prettyprint system ;
+prettyprint system unicode.case ;
IN: temporary
! Unix domain stream sockets
diff --git a/extra/parser-combinators/parser-combinators.factor b/extra/parser-combinators/parser-combinators.factor
index 4376aed95a..b7b62b3c2e 100755
--- a/extra/parser-combinators/parser-combinators.factor
+++ b/extra/parser-combinators/parser-combinators.factor
@@ -1,7 +1,8 @@
! Copyright (C) 2004 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: lazy-lists promises kernel sequences strings math
-arrays splitting quotations combinators namespaces ;
+arrays splitting quotations combinators namespaces
+unicode.case unicode.categories ;
IN: parser-combinators
! Parser combinator protocol
diff --git a/extra/xml/writer/writer.factor b/extra/xml/writer/writer.factor
index 95f38f3da9..8c7b51d756 100644
--- a/extra/xml/writer/writer.factor
+++ b/extra/xml/writer/writer.factor
@@ -1,7 +1,8 @@
! Copyright (C) 2005, 2006 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: hashtables kernel math namespaces sequences strings
-io io.streams.string xml.data assocs wrap xml.entities ;
+io io.streams.string xml.data assocs wrap xml.entities
+unicode.categories ;
IN: xml.writer
SYMBOL: xml-pprint?
From 3fdd01c283476c0ae8e6d3c00fed2f4fb2a5b32a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.local>
Date: Fri, 1 Feb 2008 14:40:06 -0600
Subject: [PATCH 14/20] Fix PPC bootstrap
---
core/cpu/ppc/intrinsics/intrinsics.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor
index 693bcdb5e4..91bf5ed1e3 100755
--- a/core/cpu/ppc/intrinsics/intrinsics.factor
+++ b/core/cpu/ppc/intrinsics/intrinsics.factor
@@ -1,6 +1,6 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays cpu.ppc.assembler
+USING: alien alien.accessors alien.c-types arrays cpu.ppc.assembler
cpu.ppc.architecture cpu.ppc.allot cpu.architecture kernel
kernel.private math math.private namespaces sequences words
generic quotations byte-arrays hashtables hashtables.private
From ff55f0f4cc25f75690e82fe6be48e8c324b01887 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 1 Feb 2008 15:00:02 -0600
Subject: [PATCH 15/20] New \u...... syntax; io.utf8 and io.utf16 can actually
use strings now
---
core/alien/c-types/c-types-tests.factor | 8 +++----
core/ascii/ascii.factor | 3 ++-
core/io/binary/binary-tests.factor | 4 ++--
core/io/encodings/encodings.factor | 2 +-
core/io/utf16/utf16-tests.factor | 20 ++++++++--------
core/io/utf16/utf16.factor | 1 -
core/parser/parser-tests.factor | 10 ++++----
core/parser/parser.factor | 2 +-
core/prettyprint/backend/backend-docs.factor | 2 +-
core/prettyprint/backend/backend.factor | 2 +-
core/prettyprint/prettyprint-tests.factor | 4 ++--
core/sequences/sequences-tests.factor | 2 +-
core/strings/strings-docs.factor | 2 +-
core/syntax/syntax-docs.factor | 4 ++--
extra/asn1/asn1-tests.factor | 2 +-
extra/crypto/hmac/hmac-tests.factor | 12 +++++-----
extra/crypto/sha1/sha1-tests.factor | 4 ++--
extra/io/nonblocking/nonblocking.factor | 24 +++++++++++--------
extra/io/windows/nt/backend/backend.factor | 2 +-
extra/pack/pack-tests.factor | 2 +-
extra/regexp/regexp-tests.factor | 4 ++--
extra/slides/slides.factor | 2 +-
extra/unicode/breaks/breaks-tests.factor | 6 ++---
extra/unicode/case/case-tests.factor | 10 ++++----
extra/unicode/case/case.factor | 4 ++--
.../unicode/normalize/normalize-tests.factor | 16 ++++++-------
extra/xml/char-classes/char-classes.factor | 6 ++---
{extra => unmaintained}/cabal/authors.txt | 0
{extra => unmaintained}/cabal/cabal.factor | 0
{extra => unmaintained}/cabal/summary.txt | 0
{extra => unmaintained}/cabal/ui/authors.txt | 0
{extra => unmaintained}/cabal/ui/summary.txt | 0
{extra => unmaintained}/cabal/ui/ui.factor | 0
{extra => unmaintained}/lisp/README | 0
{extra => unmaintained}/lisp/authors.txt | 0
.../lisp/lexer/lexer.factor | 0
{extra => unmaintained}/lisp/lisp.factor | 0
.../lisp/listener/listener.factor | 0
.../lisp/listener/mod/mod.factor | 0
.../lisp/parser/mod/mod.factor | 0
{extra => unmaintained}/lisp/summary.txt | 0
.../lisp/syntax/syntax.factor | 0
{extra => unmaintained}/lisp/tags.txt | 0
43 files changed, 81 insertions(+), 79 deletions(-)
mode change 100644 => 100755 core/alien/c-types/c-types-tests.factor
mode change 100644 => 100755 core/io/binary/binary-tests.factor
mode change 100644 => 100755 core/io/encodings/encodings.factor
mode change 100644 => 100755 core/io/utf16/utf16-tests.factor
mode change 100644 => 100755 core/prettyprint/backend/backend-docs.factor
mode change 100644 => 100755 extra/asn1/asn1-tests.factor
mode change 100644 => 100755 extra/crypto/hmac/hmac-tests.factor
mode change 100644 => 100755 extra/crypto/sha1/sha1-tests.factor
mode change 100644 => 100755 extra/pack/pack-tests.factor
mode change 100644 => 100755 extra/unicode/breaks/breaks-tests.factor
mode change 100644 => 100755 extra/unicode/case/case-tests.factor
mode change 100644 => 100755 extra/unicode/case/case.factor
mode change 100644 => 100755 extra/unicode/normalize/normalize-tests.factor
mode change 100644 => 100755 extra/xml/char-classes/char-classes.factor
rename {extra => unmaintained}/cabal/authors.txt (100%)
rename {extra => unmaintained}/cabal/cabal.factor (100%)
rename {extra => unmaintained}/cabal/summary.txt (100%)
rename {extra => unmaintained}/cabal/ui/authors.txt (100%)
rename {extra => unmaintained}/cabal/ui/summary.txt (100%)
rename {extra => unmaintained}/cabal/ui/ui.factor (100%)
rename {extra => unmaintained}/lisp/README (100%)
rename {extra => unmaintained}/lisp/authors.txt (100%)
rename {extra => unmaintained}/lisp/lexer/lexer.factor (100%)
rename {extra => unmaintained}/lisp/lisp.factor (100%)
rename {extra => unmaintained}/lisp/listener/listener.factor (100%)
rename {extra => unmaintained}/lisp/listener/mod/mod.factor (100%)
rename {extra => unmaintained}/lisp/parser/mod/mod.factor (100%)
rename {extra => unmaintained}/lisp/summary.txt (100%)
rename {extra => unmaintained}/lisp/syntax/syntax.factor (100%)
rename {extra => unmaintained}/lisp/tags.txt (100%)
diff --git a/core/alien/c-types/c-types-tests.factor b/core/alien/c-types/c-types-tests.factor
old mode 100644
new mode 100755
index c988446e20..3148b85782
--- a/core/alien/c-types/c-types-tests.factor
+++ b/core/alien/c-types/c-types-tests.factor
@@ -2,16 +2,16 @@ IN: temporary
USING: alien alien.syntax alien.c-types kernel tools.test
sequences system libc ;
-[ "\u00ff" ]
-[ "\u00ff" string>char-alien alien>char-string ]
+[ "\u0000ff" ]
+[ "\u0000ff" string>char-alien alien>char-string ]
unit-test
[ "hello world" ]
[ "hello world" string>char-alien alien>char-string ]
unit-test
-[ "hello\uabcdworld" ]
-[ "hello\uabcdworld" string>u16-alien alien>u16-string ]
+[ "hello\u00abcdworld" ]
+[ "hello\u00abcdworld" string>u16-alien alien>u16-string ]
unit-test
[ t ] [ f expired? ] unit-test
diff --git a/core/ascii/ascii.factor b/core/ascii/ascii.factor
index eeb6b2d480..019db5f3b2 100755
--- a/core/ascii/ascii.factor
+++ b/core/ascii/ascii.factor
@@ -13,7 +13,8 @@ IN: ascii
: printable? ( ch -- ? ) CHAR: \s CHAR: ~ between? ; inline
-: control? ( ch -- ? ) "\0\e\r\n\t\u0008\u007f" member? ; inline
+: control? ( ch -- ? )
+ "\0\e\r\n\t\u000008\u00007f" member? ; inline
: quotable? ( ch -- ? )
dup printable? [ "\"\\" member? not ] [ drop f ] if ; inline
diff --git a/core/io/binary/binary-tests.factor b/core/io/binary/binary-tests.factor
old mode 100644
new mode 100755
index 5d80443e84..69e733b55a
--- a/core/io/binary/binary-tests.factor
+++ b/core/io/binary/binary-tests.factor
@@ -1,8 +1,8 @@
USING: io.binary tools.test ;
IN: temporary
-[ "\0\0\u0004\u00d2" ] [ 1234 4 >be ] unit-test
-[ "\u00d2\u0004\0\0" ] [ 1234 4 >le ] unit-test
+[ "\0\0\u000004\u0000d2" ] [ 1234 4 >be ] unit-test
+[ "\u0000d2\u000004\0\0" ] [ 1234 4 >le ] unit-test
[ 1234 ] [ 1234 4 >be be> ] unit-test
[ 1234 ] [ 1234 4 >le le> ] unit-test
diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
old mode 100644
new mode 100755
index f363389b59..83ab576faf
--- a/core/io/encodings/encodings.factor
+++ b/core/io/encodings/encodings.factor
@@ -21,5 +21,5 @@ SYMBOL: begin
begin eq? [ decode-error ] unless drop { } like ;
: decode ( seq quot -- str )
- >r [ length <vector> 0 begin ] keep r> each
+ >r [ length <sbuf> 0 begin ] keep r> each
finish-decoding ; inline
diff --git a/core/io/utf16/utf16-tests.factor b/core/io/utf16/utf16-tests.factor
old mode 100644
new mode 100755
index 014d834016..7a4b766941
--- a/core/io/utf16/utf16-tests.factor
+++ b/core/io/utf16/utf16-tests.factor
@@ -1,15 +1,15 @@
USING: tools.test io.utf16 ;
-[ { CHAR: x } ] [ { 0 CHAR: x } decode-utf16be ] unit-test
-[ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } decode-utf16be ] unit-test
-[ { BIN: 11011111 CHAR: q } decode-utf16be ] unit-test-fails
-[ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } decode-utf16be ] unit-test-fails
+[ { CHAR: x } ] [ { 0 CHAR: x } decode-utf16be >array ] unit-test
+[ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } decode-utf16be >array ] unit-test
+[ { BIN: 11011111 CHAR: q } decode-utf16be >array ] unit-test-fails
+[ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } decode-utf16be >array ] unit-test-fails
-[ B{ 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } encode-utf16be ] unit-test
+[ B{ 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } encode-utf16be >array ] unit-test
-[ { CHAR: x } ] [ { CHAR: x 0 } decode-utf16le ] unit-test
-[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } decode-utf16le ] unit-test
-[ { 0 BIN: 11011111 } decode-utf16le ] unit-test-fails
-[ { 0 BIN: 11011011 0 0 } decode-utf16le ] unit-test-fails
+[ { CHAR: x } ] [ { CHAR: x 0 } decode-utf16le >array ] unit-test
+[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } decode-utf16le >array ] unit-test
+[ { 0 BIN: 11011111 } decode-utf16le >array ] unit-test-fails
+[ { 0 BIN: 11011011 0 0 } decode-utf16le >array ] unit-test-fails
-[ B{ 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } encode-utf16le ] unit-test
+[ B{ 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } encode-utf16le >array ] unit-test
diff --git a/core/io/utf16/utf16.factor b/core/io/utf16/utf16.factor
index 7ed27a626e..d6b160e156 100755
--- a/core/io/utf16/utf16.factor
+++ b/core/io/utf16/utf16.factor
@@ -110,4 +110,3 @@ SYMBOL: quad3
{ [ utf16be? ] [ decode-utf16be ] }
{ [ t ] [ decode-error ] }
} cond ;
-
diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index 55d43ce8e0..213f0868c0 100755
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -9,13 +9,13 @@ IN: temporary
[ 0 "abcd" next-char ] unit-test
[ 6 CHAR: \s ]
- [ 1 "\\u0020hello" next-escape ] unit-test
+ [ 1 "\\u000020hello" next-escape ] unit-test
[ 2 CHAR: \n ]
[ 1 "\\nhello" next-escape ] unit-test
[ 6 CHAR: \s ]
- [ 0 "\\u0020hello" next-char ] unit-test
+ [ 0 "\\u000020hello" next-char ] unit-test
[ 1 [ 2 [ 3 ] 4 ] 5 ]
[ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval ]
@@ -46,15 +46,13 @@ IN: temporary
! Test escapes
[ " " ]
- [ "\"\\u0020\"" eval ]
+ [ "\"\\u000020\"" eval ]
unit-test
[ "'" ]
- [ "\"\\u0027\"" eval ]
+ [ "\"\\u000027\"" eval ]
unit-test
- [ "\\u123" eval ] unit-test-fails
-
! Test EOL comments in multiline strings.
[ "Hello" ] [ "#! This calls until-eol.\n\"Hello\"" eval ] unit-test
diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index 1a61573bd4..862b266d05 100755
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -120,7 +120,7 @@ M: bad-escape summary drop "Bad escape code" ;
: next-escape ( m str -- n ch )
2dup nth CHAR: u =
- [ >r 1+ dup 4 + tuck r> subseq hex> ]
+ [ >r 1+ dup 6 + tuck r> subseq hex> ]
[ over 1+ -rot nth escape ] if ;
: next-char ( m str -- n ch )
diff --git a/core/prettyprint/backend/backend-docs.factor b/core/prettyprint/backend/backend-docs.factor
old mode 100644
new mode 100755
index 4605308a95..c7ca380fbd
--- a/core/prettyprint/backend/backend-docs.factor
+++ b/core/prettyprint/backend/backend-docs.factor
@@ -20,7 +20,7 @@ HELP: ch>ascii-escape
HELP: ch>unicode-escape
{ $values { "ch" "a character" } { "str" string } }
-{ $description "Converts a character to a Unicode escape code (" { $snippet "\\u1234"} ")." } ;
+{ $description "Converts a character to a Unicode escape code (" { $snippet "\\u123456"} ")." } ;
HELP: unparse-ch
{ $values { "ch" "a character" } }
diff --git a/core/prettyprint/backend/backend.factor b/core/prettyprint/backend/backend.factor
index f88ab4ca2a..a5d0cee6c5 100755
--- a/core/prettyprint/backend/backend.factor
+++ b/core/prettyprint/backend/backend.factor
@@ -68,7 +68,7 @@ M: f pprint* drop \ f pprint-word ;
} at ;
: ch>unicode-escape ( ch -- str )
- >hex 4 CHAR: 0 pad-left "\\u" swap append ;
+ >hex 6 CHAR: 0 pad-left "\\u" swap append ;
: unparse-ch ( ch -- )
dup quotable? [
diff --git a/core/prettyprint/prettyprint-tests.factor b/core/prettyprint/prettyprint-tests.factor
index 9c5ec885ae..7f7d946347 100755
--- a/core/prettyprint/prettyprint-tests.factor
+++ b/core/prettyprint/prettyprint-tests.factor
@@ -21,8 +21,8 @@ IN: temporary
[ "hello\\backslash" unparse ]
unit-test
-[ "\"\\u1234\"" ]
-[ "\u1234" unparse ]
+[ "\"\\u123456\"" ]
+[ "\u123456" unparse ]
unit-test
[ "\"\\e\"" ]
diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index 1509fa8c05..e988a62feb 100755
--- a/core/sequences/sequences-tests.factor
+++ b/core/sequences/sequences-tests.factor
@@ -151,7 +151,7 @@ unit-test
[ 5 ] [ 1 >bignum { 1 5 7 } nth-unsafe ] unit-test
[ 5 ] [ 1 >bignum { 1 5 7 } nth-unsafe ] unit-test
-[ 5 ] [ 1 >bignum "\u0001\u0005\u0007" nth-unsafe ] unit-test
+[ 5 ] [ 1 >bignum "\u000001\u000005\u000007" nth-unsafe ] unit-test
[ SBUF" before&after" ] [
"&" 6 11 SBUF" before and after" [ replace-slice ] keep
diff --git a/core/strings/strings-docs.factor b/core/strings/strings-docs.factor
index e09c6da0eb..d8cef5557a 100755
--- a/core/strings/strings-docs.factor
+++ b/core/strings/strings-docs.factor
@@ -58,4 +58,4 @@ HELP: >string
HELP: resize-string ( n str -- newstr )
{ $values { "n" "a non-negative integer" } { "str" string } { "newstr" string } }
-{ $description "Creates a new string " { $snippet "n" } " characters long The contents of the existing string are copied into the new string; if the new string is shorter, only an initial segment is copied, and if the new string is longer the remaining space is filled with " { $snippet "\\u0000" } "." } ;
+{ $description "Creates a new string " { $snippet "n" } " characters long The contents of the existing string are copied into the new string; if the new string is shorter, only an initial segment is copied, and if the new string is longer the remaining space is filled with " { $snippet "\\u000000" } "." } ;
diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor
index df96743e3d..2e5b41cd8d 100755
--- a/core/syntax/syntax-docs.factor
+++ b/core/syntax/syntax-docs.factor
@@ -99,9 +99,9 @@ ARTICLE: "escape" "Character escape codes"
{ { $snippet "\\e" } "escape (ASCII 27)" }
{ { $snippet "\\\"" } { $snippet "\"" } }
}
-"A Unicode character can be specified by its code number by writing " { $snippet "\\u" } " followed by a four-digit hexadecimal number. That is, the following two expressions are equivalent:"
+"A Unicode character can be specified by its code number by writing " { $snippet "\\u" } " followed by a six-digit hexadecimal number. That is, the following two expressions are equivalent:"
{ $code
- "CHAR: \\u0078"
+ "CHAR: \\u000078"
"78"
}
"While not useful for single characters, this syntax is also permitted inside strings." ;
diff --git a/extra/asn1/asn1-tests.factor b/extra/asn1/asn1-tests.factor
old mode 100644
new mode 100755
index 1277090ec7..1c9bc79d76
--- a/extra/asn1/asn1-tests.factor
+++ b/extra/asn1/asn1-tests.factor
@@ -1,7 +1,7 @@
USING: asn1 asn1.ldap io io.streams.string tools.test ;
[ 6 ] [
- "\u0002\u0001\u0006" <string-reader> [ asn-syntax read-ber ] with-stream
+ "\u000002\u000001\u000006" <string-reader> [ asn-syntax read-ber ] with-stream
] unit-test
[ "testing" ] [
diff --git a/extra/crypto/hmac/hmac-tests.factor b/extra/crypto/hmac/hmac-tests.factor
old mode 100644
new mode 100755
index ccb380e1e0..64efb96f90
--- a/extra/crypto/hmac/hmac-tests.factor
+++ b/extra/crypto/hmac/hmac-tests.factor
@@ -1,11 +1,11 @@
USING: kernel io strings sequences namespaces math parser crypto.hmac tools.test ;
IN: temporary
-[ "\u0092\u0094rz68\u00bb\u001c\u0013\u00f4\u008e\u00f8\u0015\u008b\u00fc\u009d" ] [ 16 11 <string> "Hi There" string>md5-hmac >string ] unit-test
-[ "u\u000cx>j\u00b0\u00b5\u0003\u00ea\u00a8n1\n]\u00b78" ] [ "Jefe" "what do ya want for nothing?" string>md5-hmac >string ] unit-test
-[ "V\u00be4R\u001d\u0014L\u0088\u00db\u00b8\u00c73\u00f0\u00e8\u00b3\u00f6" ] [ 16 HEX: aa <string> 50 HEX: dd <string> string>md5-hmac >string ] unit-test
+[ "\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d" ] [ 16 11 <string> "Hi There" string>md5-hmac >string ] unit-test
+[ "u\u00000cx>j\u0000b0\u0000b5\u000003\u0000ea\u0000a8n1\n]\u0000b78" ] [ "Jefe" "what do ya want for nothing?" string>md5-hmac >string ] unit-test
+[ "V\u0000be4R\u00001d\u000014L\u000088\u0000db\u0000b8\u0000c73\u0000f0\u0000e8\u0000b3\u0000f6" ] [ 16 HEX: aa <string> 50 HEX: dd <string> string>md5-hmac >string ] unit-test
-[ "g[\u000b:\eM\u00dfN\u0012Hr\u00dal/c+\u00fe\u00d9W\u00e9" ] [ 16 11 <string> "Hi There" string>sha1-hmac >string ] unit-test
-[ "\u00ef\u00fc\u00dfj\u00e5\u00eb/\u00a2\u00d2t\u0016\u00d5\u00f1\u0084\u00df\u009c%\u009a|y" ] [ "Jefe" "what do ya want for nothing?" string>sha1-hmac >string ] unit-test
-[ "\u00d70YM\u0016~5\u00d5\u0095o\u00d8\0=\r\u00b3\u00d3\u00f4m\u00c7\u00bb" ] [ 16 HEX: aa <string> 50 HEX: dd <string> string>sha1-hmac >string ] unit-test
+[ "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9" ] [ 16 11 <string> "Hi There" string>sha1-hmac >string ] unit-test
+[ "\u0000ef\u0000fc\u0000dfj\u0000e5\u0000eb/\u0000a2\u0000d2t\u000016\u0000d5\u0000f1\u000084\u0000df\u00009c%\u00009a|y" ] [ "Jefe" "what do ya want for nothing?" string>sha1-hmac >string ] unit-test
+[ "\u0000d70YM\u000016~5\u0000d5\u000095o\u0000d8\0=\r\u0000b3\u0000d3\u0000f4m\u0000c7\u0000bb" ] [ 16 HEX: aa <string> 50 HEX: dd <string> string>sha1-hmac >string ] unit-test
diff --git a/extra/crypto/sha1/sha1-tests.factor b/extra/crypto/sha1/sha1-tests.factor
old mode 100644
new mode 100755
index c4f06800c8..795ee4971d
--- a/extra/crypto/sha1/sha1-tests.factor
+++ b/extra/crypto/sha1/sha1-tests.factor
@@ -7,8 +7,8 @@ USING: arrays kernel math namespaces sequences tools.test crypto.sha1 ;
10 swap <array> concat string>sha1str ] unit-test
[
- ";\u009b\u00fd\u00cdK\u00a3^s\u00d0*\u00e3\\\u00b5\u0013<\u00e8wA\u00b2\u0083\u00d20\u00f1\u00e6\u00cc\u00d8\u001e\u009c\u0004\u00d7PT]\u00ce,\u0001\u0012\u0080\u0096\u0099"
+ ";\u00009b\u0000fd\u0000cdK\u0000a3^s\u0000d0*\u0000e3\\\u0000b5\u000013<\u0000e8wA\u0000b2\u000083\u0000d20\u0000f1\u0000e6\u0000cc\u0000d8\u00001e\u00009c\u000004\u0000d7PT]\u0000ce,\u000001\u000012\u000080\u000096\u000099"
] [
- "\u0066\u0053\u00f1\u000c\u001a\u00fa\u00b5\u004c\u0061\u00c8\u0025\u0075\u00a8\u004a\u00fe\u0030\u00d8\u00aa\u001a\u003a\u0096\u0096\u00b3\u0018\u0099\u0092\u00bf\u00e1\u00cb\u007f\u00a6\u00a7"
+ "\u000066\u000053\u0000f1\u00000c\u00001a\u0000fa\u0000b5\u00004c\u000061\u0000c8\u000025\u000075\u0000a8\u00004a\u0000fe\u000030\u0000d8\u0000aa\u00001a\u00003a\u000096\u000096\u0000b3\u000018\u000099\u000092\u0000bf\u0000e1\u0000cb\u00007f\u0000a6\u0000a7"
string>sha1-interleave
] unit-test
diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor
index 3588ea5d14..5dbd3d1490 100755
--- a/extra/io/nonblocking/nonblocking.factor
+++ b/extra/io/nonblocking/nonblocking.factor
@@ -67,14 +67,14 @@ timeout-queue global [ [ <dlist> ] unless* ] change-at
dup timeout-queue get-global push-front*
swap set-port-timeout-entry ;
-HOOK: expire-port io-backend ( port -- )
+HOOK: cancel-io io-backend ( port -- )
-M: object expire-port drop ;
+M: object cancel-io drop ;
: expire-timeouts ( -- )
timeout-queue get-global dup dlist-empty? [ drop ] [
dup peek-back timeout?
- [ pop-back expire-port expire-timeouts ] [ drop ] if
+ [ pop-back cancel-io expire-timeouts ] [ drop ] if
] if ;
: begin-timeout ( port -- )
@@ -193,14 +193,18 @@ GENERIC: port-flush ( port -- )
M: output-port stream-flush ( port -- )
dup port-flush pending-error ;
+: close-port ( port type -- )
+ output-port eq? [ dup port-flush ] when
+ dup cancel-io
+ dup port-handle close-handle
+ dup delegate [ buffer-free ] when*
+ f swap set-delegate ;
+
M: port dispose
- dup port-type closed eq? [
- dup port-type >r closed over set-port-type r>
- output-port eq? [ dup port-flush ] when
- dup port-handle close-handle
- dup delegate [ buffer-free ] when*
- f over set-delegate
- ] unless drop ;
+ dup port-type closed eq?
+ [ drop ]
+ [ dup port-type >r closed over set-port-type r> close-port ]
+ if ;
TUPLE: server-port addr client ;
diff --git a/extra/io/windows/nt/backend/backend.factor b/extra/io/windows/nt/backend/backend.factor
index 67f2a9861c..88e7cdf84a 100755
--- a/extra/io/windows/nt/backend/backend.factor
+++ b/extra/io/windows/nt/backend/backend.factor
@@ -122,7 +122,7 @@ M: windows-nt-io add-completion ( handle -- )
: drain-overlapped ( timeout -- )
handle-overlapped [ 0 drain-overlapped ] unless ;
-M: windows-nt-io expire-port
+M: windows-nt-io cancel-io
port-handle win32-file-handle CancelIo drop ;
M: windows-nt-io io-multiplex ( ms -- )
diff --git a/extra/pack/pack-tests.factor b/extra/pack/pack-tests.factor
old mode 100644
new mode 100755
index b2fdc8ab0d..7a88881189
--- a/extra/pack/pack-tests.factor
+++ b/extra/pack/pack-tests.factor
@@ -43,5 +43,5 @@ USING: io io.streams.string kernel namespaces pack strings tools.test ;
[ "FRAM" ] [ "FRAM\0" [ read-c-string ] string-in ] unit-test
[ f ] [ "" [ read-c-string ] string-in ] unit-test
-[ 5 ] [ "FRAM\0\u0005\0\0\0\0\0\0\0" [ read-c-string drop read-u64 ] string-in ] unit-test
+[ 5 ] [ "FRAM\0\u000005\0\0\0\0\0\0\0" [ read-c-string drop read-u64 ] string-in ] unit-test
diff --git a/extra/regexp/regexp-tests.factor b/extra/regexp/regexp-tests.factor
index 823e7c7f36..9c0ed5bd81 100755
--- a/extra/regexp/regexp-tests.factor
+++ b/extra/regexp/regexp-tests.factor
@@ -158,8 +158,8 @@ IN: regexp-tests
[ t ] [ "SXY" "\\0123XY" f <regexp> matches? ] unit-test
[ t ] [ "x" "\\x78" f <regexp> matches? ] unit-test
[ f ] [ "y" "\\x78" f <regexp> matches? ] unit-test
-[ t ] [ "x" "\\u0078" f <regexp> matches? ] unit-test
-[ f ] [ "y" "\\u0078" f <regexp> matches? ] unit-test
+[ t ] [ "x" "\\u000078" f <regexp> matches? ] unit-test
+[ f ] [ "y" "\\u000078" f <regexp> matches? ] unit-test
[ t ] [ "ab" "a+b" f <regexp> matches? ] unit-test
[ f ] [ "b" "a+b" f <regexp> matches? ] unit-test
diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor
index ba423699c3..a0065d6fe3 100755
--- a/extra/slides/slides.factor
+++ b/extra/slides/slides.factor
@@ -33,7 +33,7 @@ IN: slides
{ list-style
H{ { table-gap { 10 20 } } }
}
- { bullet "\u00b7" }
+ { bullet "\u0000b7" }
} ;
: $title ( string -- )
diff --git a/extra/unicode/breaks/breaks-tests.factor b/extra/unicode/breaks/breaks-tests.factor
old mode 100644
new mode 100755
index 26f419ff0e..77ba0e82fa
--- a/extra/unicode/breaks/breaks-tests.factor
+++ b/extra/unicode/breaks/breaks-tests.factor
@@ -1,7 +1,7 @@
USING: tools.test unicode.breaks sequences math kernel ;
-[ "\u1112\u1161\u11abA\u0300a\r\r\n" ]
-[ "\r\n\raA\u0300\u1112\u1161\u11ab" string-reverse ] unit-test
+[ "\u001112\u001161\u0011abA\u000300a\r\r\n" ]
+[ "\r\n\raA\u000300\u001112\u001161\u0011ab" string-reverse ] unit-test
[ "dcba" ] [ "abcd" string-reverse ] unit-test
-[ 3 ] [ "\u1112\u1161\u11abA\u0300a"
+[ 3 ] [ "\u001112\u001161\u0011abA\u000300a"
dup last-grapheme head last-grapheme ] unit-test
diff --git a/extra/unicode/case/case-tests.factor b/extra/unicode/case/case-tests.factor
old mode 100644
new mode 100755
index 0ac074cfae..531fa2faab
--- a/extra/unicode/case/case-tests.factor
+++ b/extra/unicode/case/case-tests.factor
@@ -1,14 +1,14 @@
USING: unicode.case tools.test namespaces ;
[ "Hello How Are You? I'M Good" ] [ "hEllo how ARE yOU? I'm good" >title ] unit-test
-[ "FUSS" ] [ "Fu\u00DF" >upper ] unit-test
-[ "\u03C3\u03C2" ] [ "\u03A3\u03A3" >lower ] unit-test
+[ "FUSS" ] [ "Fu\u0000DF" >upper ] unit-test
+[ "\u0003C3\u0003C2" ] [ "\u0003A3\u0003A3" >lower ] unit-test
[ t ] [ "hello how are you?" lower? ] unit-test
[
"tr" locale set
- [ "i\u0131i \u0131jj" ] [ "i\u0131I\u0307 IJj" >lower ] unit-test
-! [ "I\u307\u0131i Ijj" ] [ "i\u0131I\u0307 IJj" >title ] unit-test
- [ "I\u0307II\u0307 IJJ" ] [ "i\u0131I\u0307 IJj" >upper ] unit-test
+ [ "i\u000131i \u000131jj" ] [ "i\u000131I\u000307 IJj" >lower ] unit-test
+! [ "I\u00307\u000131i Ijj" ] [ "i\u000131I\u000307 IJj" >title ] unit-test
+ [ "I\u000307II\u000307 IJJ" ] [ "i\u000131I\u000307 IJj" >upper ] unit-test
"lt" locale set
! Lithuanian casing tests
] with-scope
diff --git a/extra/unicode/case/case.factor b/extra/unicode/case/case.factor
old mode 100644
new mode 100755
index 5f142297ef..96ae9a790b
--- a/extra/unicode/case/case.factor
+++ b/extra/unicode/case/case.factor
@@ -13,7 +13,7 @@ SYMBOL: locale ! Just casing locale, or overall?
: lithuanian? ( -- ? ) locale get "lt" = ;
-: dot-over ( -- ch ) CHAR: \u0307 ;
+: dot-over ( -- ch ) HEX: 307 ;
: lithuanian-ch>upper ( ? next ch -- ? )
rot [ 2drop f ]
@@ -46,7 +46,7 @@ SYMBOL: locale ! Just casing locale, or overall?
{ [ rot ] [ 2drop f ] }
{ [ dup CHAR: I = ] [
drop dot-over =
- dup CHAR: i CHAR: \u0131 ? ,
+ dup CHAR: i HEX: 131 ? ,
] }
{ [ t ] [ , drop f ] }
} cond ;
diff --git a/extra/unicode/normalize/normalize-tests.factor b/extra/unicode/normalize/normalize-tests.factor
old mode 100644
new mode 100755
index d98aec6170..ca2701f728
--- a/extra/unicode/normalize/normalize-tests.factor
+++ b/extra/unicode/normalize/normalize-tests.factor
@@ -1,18 +1,18 @@
USING: unicode.normalize kernel tools.test sequences ;
-[ "ab\u0323\u0302cd" ] [ "ab\u0302" "\u0323cd" string-append ] unit-test
+[ "ab\u000323\u000302cd" ] [ "ab\u000302" "\u000323cd" string-append ] unit-test
-[ "ab\u064b\u034d\u034e\u0347\u0346" ] [ "ab\u0346\u0347\u064b\u034e\u034d" dup reorder ] unit-test
+[ "ab\u00064b\u00034d\u00034e\u000347\u000346" ] [ "ab\u000346\u000347\u00064b\u00034e\u00034d" dup reorder ] unit-test
[ "hello" "hello" ] [ "hello" [ nfd ] keep nfkd ] unit-test
-[ "\uFB012\u2075\u017F\u0323\u0307" "fi25s\u0323\u0307" ]
-[ "\uFB012\u2075\u1E9B\u0323" [ nfd ] keep nfkd ] unit-test
+[ "\u00FB012\u002075\u00017F\u000323\u000307" "fi25s\u000323\u000307" ]
+[ "\u00FB012\u002075\u001E9B\u000323" [ nfd ] keep nfkd ] unit-test
-[ "\u1E69" "s\u0323\u0307" ] [ "\u1E69" [ nfc ] keep nfd ] unit-test
-[ "\u1E0D\u0307" ] [ "\u1E0B\u0323" nfc ] unit-test
+[ "\u001E69" "s\u000323\u000307" ] [ "\u001E69" [ nfc ] keep nfd ] unit-test
+[ "\u001E0D\u000307" ] [ "\u001E0B\u000323" nfc ] unit-test
[ 54620 ] [ 4370 4449 4523 jamo>hangul ] unit-test
[ 4370 4449 4523 ] [ 54620 hangul>jamo first3 ] unit-test
[ t ] [ 54620 hangul? ] unit-test
[ f ] [ 0 hangul? ] unit-test
-[ "\u1112\u1161\u11ab" ] [ "\ud55c" nfd ] unit-test
-[ "\ud55c" ] [ "\u1112\u1161\u11ab" nfc ] unit-test
+[ "\u001112\u001161\u0011ab" ] [ "\u00d55c" nfd ] unit-test
+[ "\u00d55c" ] [ "\u001112\u001161\u0011ab" nfc ] unit-test
diff --git a/extra/xml/char-classes/char-classes.factor b/extra/xml/char-classes/char-classes.factor
old mode 100644
new mode 100755
index d5254ed3f7..ddf935a30b
--- a/extra/xml/char-classes/char-classes.factor
+++ b/extra/xml/char-classes/char-classes.factor
@@ -3,16 +3,16 @@
USING: kernel sequences unicode.syntax math ;
IN: xml.char-classes
-CATEGORY: 1.0name-start* Ll Lu Lo Lt Nl \u0559\u06E5\u06E6_ ;
+CATEGORY: 1.0name-start* Ll Lu Lo Lt Nl \u000559\u0006E5\u0006E6_ ;
: 1.0name-start? ( char -- ? )
dup 1.0name-start*? [ drop t ]
[ HEX: 2BB HEX: 2C1 between? ] if ;
-CATEGORY: 1.0name-char Ll Lu Lo Lt Nl Mc Me Mn Lm Nd _-.\u0387 ;
+CATEGORY: 1.0name-char Ll Lu Lo Lt Nl Mc Me Mn Lm Nd _-.\u000387 ;
CATEGORY: 1.1name-start Ll Lu Lo Lm Ln Nl _ ;
-CATEGORY: 1.1name-char Ll Lu Lo Lm Ln Nl Mc Mn Nd Pc Cf _-.\u00b7 ;
+CATEGORY: 1.1name-char Ll Lu Lo Lm Ln Nl Mc Mn Nd Pc Cf _-.\u0000b7 ;
: name-start? ( 1.0? char -- ? )
swap [ 1.0name-start? ] [ 1.1name-start? ] if ;
diff --git a/extra/cabal/authors.txt b/unmaintained/cabal/authors.txt
similarity index 100%
rename from extra/cabal/authors.txt
rename to unmaintained/cabal/authors.txt
diff --git a/extra/cabal/cabal.factor b/unmaintained/cabal/cabal.factor
similarity index 100%
rename from extra/cabal/cabal.factor
rename to unmaintained/cabal/cabal.factor
diff --git a/extra/cabal/summary.txt b/unmaintained/cabal/summary.txt
similarity index 100%
rename from extra/cabal/summary.txt
rename to unmaintained/cabal/summary.txt
diff --git a/extra/cabal/ui/authors.txt b/unmaintained/cabal/ui/authors.txt
similarity index 100%
rename from extra/cabal/ui/authors.txt
rename to unmaintained/cabal/ui/authors.txt
diff --git a/extra/cabal/ui/summary.txt b/unmaintained/cabal/ui/summary.txt
similarity index 100%
rename from extra/cabal/ui/summary.txt
rename to unmaintained/cabal/ui/summary.txt
diff --git a/extra/cabal/ui/ui.factor b/unmaintained/cabal/ui/ui.factor
similarity index 100%
rename from extra/cabal/ui/ui.factor
rename to unmaintained/cabal/ui/ui.factor
diff --git a/extra/lisp/README b/unmaintained/lisp/README
similarity index 100%
rename from extra/lisp/README
rename to unmaintained/lisp/README
diff --git a/extra/lisp/authors.txt b/unmaintained/lisp/authors.txt
similarity index 100%
rename from extra/lisp/authors.txt
rename to unmaintained/lisp/authors.txt
diff --git a/extra/lisp/lexer/lexer.factor b/unmaintained/lisp/lexer/lexer.factor
similarity index 100%
rename from extra/lisp/lexer/lexer.factor
rename to unmaintained/lisp/lexer/lexer.factor
diff --git a/extra/lisp/lisp.factor b/unmaintained/lisp/lisp.factor
similarity index 100%
rename from extra/lisp/lisp.factor
rename to unmaintained/lisp/lisp.factor
diff --git a/extra/lisp/listener/listener.factor b/unmaintained/lisp/listener/listener.factor
similarity index 100%
rename from extra/lisp/listener/listener.factor
rename to unmaintained/lisp/listener/listener.factor
diff --git a/extra/lisp/listener/mod/mod.factor b/unmaintained/lisp/listener/mod/mod.factor
similarity index 100%
rename from extra/lisp/listener/mod/mod.factor
rename to unmaintained/lisp/listener/mod/mod.factor
diff --git a/extra/lisp/parser/mod/mod.factor b/unmaintained/lisp/parser/mod/mod.factor
similarity index 100%
rename from extra/lisp/parser/mod/mod.factor
rename to unmaintained/lisp/parser/mod/mod.factor
diff --git a/extra/lisp/summary.txt b/unmaintained/lisp/summary.txt
similarity index 100%
rename from extra/lisp/summary.txt
rename to unmaintained/lisp/summary.txt
diff --git a/extra/lisp/syntax/syntax.factor b/unmaintained/lisp/syntax/syntax.factor
similarity index 100%
rename from extra/lisp/syntax/syntax.factor
rename to unmaintained/lisp/syntax/syntax.factor
diff --git a/extra/lisp/tags.txt b/unmaintained/lisp/tags.txt
similarity index 100%
rename from extra/lisp/tags.txt
rename to unmaintained/lisp/tags.txt
From 8dd333cbb54bc827bb9fa4a7b4cecbad4aae786a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.local>
Date: Fri, 1 Feb 2008 16:02:02 -0600
Subject: [PATCH 16/20] Fix unit tests and fix string clone
---
core/ascii/ascii-tests.factor | 15 +++++++++++++
core/parser/parser-tests.factor | 4 ++--
core/sequences/sequences-tests.factor | 16 +++++++-------
core/strings/strings-tests.factor | 22 +++++++++----------
core/strings/strings.factor | 3 ++-
extra/io/unix/unix-tests.factor | 6 ++---
.../parser-combinators-tests.factor | 3 +--
extra/ui/gadgets/buttons/buttons-tests.factor | 2 +-
8 files changed, 42 insertions(+), 29 deletions(-)
create mode 100644 core/ascii/ascii-tests.factor
diff --git a/core/ascii/ascii-tests.factor b/core/ascii/ascii-tests.factor
new file mode 100644
index 0000000000..ec76d89d7c
--- /dev/null
+++ b/core/ascii/ascii-tests.factor
@@ -0,0 +1,15 @@
+IN: temporary
+USING: ascii tools.test sequences kernel math ;
+
+[ t ] [ CHAR: a letter? ] unit-test
+[ f ] [ CHAR: A letter? ] unit-test
+[ f ] [ CHAR: a LETTER? ] unit-test
+[ t ] [ CHAR: A LETTER? ] unit-test
+[ t ] [ CHAR: 0 digit? ] unit-test
+[ f ] [ CHAR: x digit? ] unit-test
+
+
+[ 4 ] [
+ 0 "There are Four Upper Case characters"
+ [ LETTER? [ 1+ ] when ] each
+] unit-test
diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index 213f0868c0..b00e8e26b4 100755
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -8,13 +8,13 @@ IN: temporary
[ 1 CHAR: a ]
[ 0 "abcd" next-char ] unit-test
- [ 6 CHAR: \s ]
+ [ 8 CHAR: \s ]
[ 1 "\\u000020hello" next-escape ] unit-test
[ 2 CHAR: \n ]
[ 1 "\\nhello" next-escape ] unit-test
- [ 6 CHAR: \s ]
+ [ 8 CHAR: \s ]
[ 0 "\\u000020hello" next-char ] unit-test
[ 1 [ 2 [ 3 ] 4 ] 5 ]
diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index e988a62feb..73ae4737ba 100755
--- a/core/sequences/sequences-tests.factor
+++ b/core/sequences/sequences-tests.factor
@@ -235,12 +235,12 @@ unit-test
[ 11 10 nth ] unit-test-fails
[ -1./0. 0 delete-nth ] unit-test-fails
-[ "" ] [ "" [ blank? ] trim ] unit-test
-[ "" ] [ "" [ blank? ] left-trim ] unit-test
-[ "" ] [ "" [ blank? ] right-trim ] unit-test
-[ "" ] [ " " [ blank? ] left-trim ] unit-test
-[ "" ] [ " " [ blank? ] right-trim ] unit-test
-[ "asdf" ] [ " asdf " [ blank? ] trim ] unit-test
-[ "asdf " ] [ " asdf " [ blank? ] left-trim ] unit-test
-[ " asdf" ] [ " asdf " [ blank? ] right-trim ] unit-test
+[ "" ] [ "" [ CHAR: \s = ] trim ] unit-test
+[ "" ] [ "" [ CHAR: \s = ] left-trim ] unit-test
+[ "" ] [ "" [ CHAR: \s = ] right-trim ] unit-test
+[ "" ] [ " " [ CHAR: \s = ] left-trim ] unit-test
+[ "" ] [ " " [ CHAR: \s = ] right-trim ] unit-test
+[ "asdf" ] [ " asdf " [ CHAR: \s = ] trim ] unit-test
+[ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test
+[ " asdf" ] [ " asdf " [ CHAR: \s = ] right-trim ] unit-test
diff --git a/core/strings/strings-tests.factor b/core/strings/strings-tests.factor
index a3c49a08ba..5ab7f1dffe 100755
--- a/core/strings/strings-tests.factor
+++ b/core/strings/strings-tests.factor
@@ -28,23 +28,11 @@ IN: temporary
[ "end" ] [ "Beginning and end" 14 tail ] unit-test
-[ t ] [ CHAR: a letter? ] unit-test
-[ f ] [ CHAR: A letter? ] unit-test
-[ f ] [ CHAR: a LETTER? ] unit-test
-[ t ] [ CHAR: A LETTER? ] unit-test
-[ t ] [ CHAR: 0 digit? ] unit-test
-[ f ] [ CHAR: x digit? ] unit-test
-
[ t ] [ "abc" "abd" <=> 0 < ] unit-test
[ t ] [ "z" "abd" <=> 0 > ] unit-test
[ f ] [ [ 0 10 "hello" subseq ] catch not ] unit-test
-[ 4 ] [
- 0 "There are Four Upper Case characters"
- [ LETTER? [ 1+ ] when ] each
-] unit-test
-
[ "Replacing+spaces+with+plus" ]
[
"Replacing spaces with plus"
@@ -67,6 +55,7 @@ unit-test
[ { "kernel-error" 3 12 -7 } ]
[ [ 2 -7 resize-string ] catch ] unit-test
+! Make sure 24-bit strings work
"hello world" "s" set
[ ] [ HEX: 1234 1 "s" get set-nth ] unit-test
@@ -90,3 +79,12 @@ unit-test
] [
"s" get >array
] unit-test
+
+! Make sure we clear aux vector when storing octets
+[ "\u123456hi" ] [ "ih\u123456" clone dup reverse-here ] unit-test
+
+! Make sure aux vector is not shared
+[ "\udeadbe" ] [
+ "\udeadbe" clone
+ CHAR: \u123456 over clone set-first
+] unit-test
diff --git a/core/strings/strings.factor b/core/strings/strings.factor
index dc1d12cec9..50c75d784e 100755
--- a/core/strings/strings.factor
+++ b/core/strings/strings.factor
@@ -37,7 +37,8 @@ M: string set-nth-unsafe
dup reset-string-hashcode
>r >fixnum >r >fixnum r> r> set-string-nth ;
-M: string clone (clone) ;
+M: string clone
+ (clone) dup string-aux clone over set-string-aux ;
M: string resize resize-string ;
diff --git a/extra/io/unix/unix-tests.factor b/extra/io/unix/unix-tests.factor
index e49364fad3..8a621f8f48 100755
--- a/extra/io/unix/unix-tests.factor
+++ b/extra/io/unix/unix-tests.factor
@@ -1,6 +1,6 @@
USING: io.files io.sockets io kernel threads namespaces
tools.test continuations strings byte-arrays sequences
-prettyprint system unicode.case ;
+prettyprint system ;
IN: temporary
! Unix domain stream sockets
@@ -56,7 +56,7 @@ yield
"Receive 2" print
- "d" get receive >r >upper r>
+ "d" get receive >r " world" append r>
"Send 1" print
dup .
@@ -98,7 +98,7 @@ client-addr <datagram>
"d" get send
] unit-test
-[ "HELLO" t ] [
+[ "hello world" t ] [
"d" get receive
server-addr =
>r >string r>
diff --git a/extra/parser-combinators/parser-combinators-tests.factor b/extra/parser-combinators/parser-combinators-tests.factor
index 8d55cc5770..fc8cec770b 100644
--- a/extra/parser-combinators/parser-combinators-tests.factor
+++ b/extra/parser-combinators/parser-combinators-tests.factor
@@ -1,8 +1,7 @@
! Copyright (C) 2005 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
-!
USING: kernel lazy-lists tools.test strings math
-sequences parser-combinators arrays math.parser ;
+sequences parser-combinators arrays math.parser unicode.categories ;
IN: scratchpad
! Testing <&>
diff --git a/extra/ui/gadgets/buttons/buttons-tests.factor b/extra/ui/gadgets/buttons/buttons-tests.factor
index a2786ea878..77dfd30d96 100755
--- a/extra/ui/gadgets/buttons/buttons-tests.factor
+++ b/extra/ui/gadgets/buttons/buttons-tests.factor
@@ -17,7 +17,7 @@ TUPLE: foo-gadget ;
T{ foo-gadget } <toolbar> "t" set
[ 2 ] [ "t" get gadget-children length ] unit-test
-[ "Foo a" ] [ "t" get gadget-child gadget-child label-string ] unit-test
+[ "Foo A" ] [ "t" get gadget-child gadget-child label-string ] unit-test
[ ] [
2 <model> {
From 27ebd08b99f54c55a5dfb84f3885cdd19d16e4b0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 1 Feb 2008 16:21:42 -0600
Subject: [PATCH 17/20] Encodings fix
---
core/io/encodings/encodings.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
index 83ab576faf..5bc679cd27 100755
--- a/core/io/encodings/encodings.factor
+++ b/core/io/encodings/encodings.factor
@@ -18,7 +18,7 @@ SYMBOL: begin
over push 0 begin ;
: finish-decoding ( buf ch state -- str )
- begin eq? [ decode-error ] unless drop { } like ;
+ begin eq? [ decode-error ] unless drop "" like ;
: decode ( seq quot -- str )
>r [ length <sbuf> 0 begin ] keep r> each
From f710d192f7e14ab4037ad35ef0269d95534bf627 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 1 Feb 2008 17:13:57 -0600
Subject: [PATCH 18/20] Fix inaccurate notifications in io.monitor on Windows
---
extra/io/monitor/monitor-docs.factor | 33 ++++++++++------------
extra/io/monitor/monitor.factor | 9 +++---
extra/io/windows/launcher/launcher.factor | 11 ++++++--
extra/io/windows/nt/monitor/monitor.factor | 32 ++++++++-------------
extra/windows/kernel32/kernel32.factor | 6 ++++
5 files changed, 46 insertions(+), 45 deletions(-)
diff --git a/extra/io/monitor/monitor-docs.factor b/extra/io/monitor/monitor-docs.factor
index 56fd203bde..de649f48e7 100755
--- a/extra/io/monitor/monitor-docs.factor
+++ b/extra/io/monitor/monitor-docs.factor
@@ -8,35 +8,32 @@ $nl
"Not all operating systems support recursive monitors; if recursive monitoring is not available, an error is thrown and the caller must implement alternative logic for monitoring subdirectories." } ;
HELP: next-change
-{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changes" "a sequence of change descriptors" } }
-{ $description "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is a sequence containing at least one change descriptor; see " { $link "io.monitor.descriptors" } "." } ;
+{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changes" "a change descriptor" } }
+{ $description "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is aq sequence of symbols documented in " { $link "io.monitor.descriptors" } "." } ;
HELP: with-monitor
{ $values { "path" "a pathname string" } { "recursive?" "a boolean" } { "quot" "a quotation with stack effect " { $snippet "( monitor -- )" } } }
{ $description "Opens a file system change monitor and passes it to the quotation. Closes the monitor after the quotation returns or throws an error." } ;
-HELP: +change-file+
-{ $description "Indicates that the contents of the file have changed." } ;
+HELP: +add-file+
+{ $description "Indicates that the file has been added to the directory." } ;
-HELP: +change-name+
-{ $description "Indicates that the file name has changed." } ;
+HELP: +remove-file+
+{ $description "Indicates that the file has been removed from the directory." } ;
-HELP: +change-size+
-{ $description "Indicates that the file size has changed." } ;
+HELP: +modify-file+
+{ $description "Indicates that the file contents have changed." } ;
-HELP: +change-attributes+
-{ $description "Indicates that file attributes has changed. Attributes are operating system-specific but may include the creation time and permissions." } ;
-
-HELP: +change-modified+
-{ $description "Indicates that the last modification time of the file has changed." } ;
+HELP: +rename-file+
+{ $description "Indicates that file has been renamed." } ;
ARTICLE: "io.monitor.descriptors" "File system change descriptors"
"Change descriptors output by " { $link next-change } ":"
-{ $subsection +change-file+ }
-{ $subsection +change-name+ }
-{ $subsection +change-size+ }
-{ $subsection +change-attributes+ }
-{ $subsection +change-modified+ } ;
+{ $subsection +add-file+ }
+{ $subsection +remove-file+ }
+{ $subsection +modify-file+ }
+{ $subsection +rename-file+ }
+{ $subsection +add-file+ } ;
ARTICLE: "io.monitor" "File system change monitors"
"File system change monitors listen for changes to file names, attributes and contents under a specified directory. They can optionally be recursive, in which case subdirectories are also monitored."
diff --git a/extra/io/monitor/monitor.factor b/extra/io/monitor/monitor.factor
index 044fa9572b..4dc5081513 100755
--- a/extra/io/monitor/monitor.factor
+++ b/extra/io/monitor/monitor.factor
@@ -7,11 +7,10 @@ HOOK: <monitor> io-backend ( path recursive? -- monitor )
HOOK: next-change io-backend ( monitor -- path changes )
-SYMBOL: +change-file+
-SYMBOL: +change-name+
-SYMBOL: +change-size+
-SYMBOL: +change-attributes+
-SYMBOL: +change-modified+
+SYMBOL: +add-file+
+SYMBOL: +remove-file+
+SYMBOL: +modify-file+
+SYMBOL: +rename-file+
: with-monitor ( path recursive? quot -- )
>r <monitor> r> with-disposal ; inline
diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor
index 8f1d1c6756..ec53d9152c 100755
--- a/extra/io/windows/launcher/launcher.factor
+++ b/extra/io/windows/launcher/launcher.factor
@@ -119,8 +119,15 @@ TUPLE: CreateProcess-args
drop STD_ERROR_HANDLE GetStdHandle ;
: redirect-stderr ( args -- handle )
- +stderr+ get GENERIC_WRITE CREATE_ALWAYS redirect
- swap inherited-stderr ?closed ;
+ +stderr+ get
+ dup +stdout+ eq? [
+ drop
+ CreateProcess-args-lpStartupInfo
+ STARTUPINFO-hStdOutput
+ ] [
+ GENERIC_WRITE CREATE_ALWAYS redirect
+ swap inherited-stderr ?closed
+ ] if ;
: inherited-stdin ( args -- handle )
CreateProcess-args-stdin-pipe
diff --git a/extra/io/windows/nt/monitor/monitor.factor b/extra/io/windows/nt/monitor/monitor.factor
index a7c065b878..8e0e63923d 100755
--- a/extra/io/windows/nt/monitor/monitor.factor
+++ b/extra/io/windows/nt/monitor/monitor.factor
@@ -4,7 +4,7 @@ USING: alien.c-types destructors io.windows
io.windows.nt.backend kernel math windows windows.kernel32
windows.types libc assocs alien namespaces continuations
io.monitor io.nonblocking io.buffers io.files io sequences
-hashtables sorting arrays ;
+hashtables sorting arrays combinators ;
IN: io.windows.nt.monitor
TUPLE: monitor path recursive? queue closed? ;
@@ -53,25 +53,17 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
] with-port-timeout
] with-destructors ;
-: parse-action-flag ( action mask symbol -- action )
- >r over bitand 0 > [ r> , ] [ r> drop ] if ;
+: parse-action ( action -- changed )
+ {
+ { [ dup FILE_ACTION_ADDED = ] [ +add-file+ ] }
+ { [ dup FILE_ACTION_REMOVED = ] [ +remove-file+ ] }
+ { [ dup FILE_ACTION_MODIFIED = ] [ +modify-file+ ] }
+ { [ dup FILE_ACTION_RENAMED_OLD_NAME = ] [ +rename-file+ ] }
+ { [ dup FILE_ACTION_RENAMED_NEW_NAME = ] [ +rename-file+ ] }
+ { [ t ] [ +modify-file+ ] }
+ } cond nip ;
-: parse-action ( action -- changes )
- [
- FILE_NOTIFY_CHANGE_FILE +change-file+ parse-action-flag
- FILE_NOTIFY_CHANGE_DIR_NAME +change-name+ parse-action-flag
- FILE_NOTIFY_CHANGE_ATTRIBUTES +change-attributes+ parse-action-flag
- FILE_NOTIFY_CHANGE_SIZE +change-size+ parse-action-flag
- FILE_NOTIFY_CHANGE_LAST_WRITE +change-modified+ parse-action-flag
- FILE_NOTIFY_CHANGE_LAST_ACCESS +change-attributes+ parse-action-flag
- FILE_NOTIFY_CHANGE_EA +change-attributes+ parse-action-flag
- FILE_NOTIFY_CHANGE_CREATION +change-attributes+ parse-action-flag
- FILE_NOTIFY_CHANGE_SECURITY +change-attributes+ parse-action-flag
- FILE_NOTIFY_CHANGE_FILE_NAME +change-name+ parse-action-flag
- drop
- ] { } make ;
-
-: changed-file ( directory buffer -- changes path )
+: changed-file ( directory buffer -- changed path )
{
FILE_NOTIFY_INFORMATION-FileName
FILE_NOTIFY_INFORMATION-FileNameLength
@@ -79,7 +71,7 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
} get-slots >r memory>u16-string path+ r> parse-action swap ;
: (changed-files) ( directory buffer -- )
- 2dup changed-file namespace [ append ] change-at
+ 2dup changed-file namespace [ swap add ] change-at
dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
[ 3drop ] [ swap <displaced-alien> (changed-files) ] if ;
diff --git a/extra/windows/kernel32/kernel32.factor b/extra/windows/kernel32/kernel32.factor
index 15bdcd3e37..77c7666bfd 100755
--- a/extra/windows/kernel32/kernel32.factor
+++ b/extra/windows/kernel32/kernel32.factor
@@ -83,6 +83,12 @@ IN: windows.kernel32
: FILE_NOTIFY_CHANGE_FILE_NAME HEX: 200 ; inline
: FILE_NOTIFY_CHANGE_ALL HEX: 3ff ; inline
+: FILE_ACTION_ADDED 1 ; inline
+: FILE_ACTION_REMOVED 2 ; inline
+: FILE_ACTION_MODIFIED 3 ; inline
+: FILE_ACTION_RENAMED_OLD_NAME 4 ; inline
+: FILE_ACTION_RENAMED_NEW_NAME 5 ; inline
+
C-STRUCT: FILE_NOTIFY_INFORMATION
{ "DWORD" "NextEntryOffset" }
{ "DWORD" "Action" }
From 3917a9472a4f8ee66f145e1de5c60cc3e45919d7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 1 Feb 2008 17:14:10 -0600
Subject: [PATCH 19/20] Implement default_vm_path() on netbsd
---
vm/os-netbsd.c | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
mode change 100644 => 100755 vm/os-netbsd.c
diff --git a/vm/os-netbsd.c b/vm/os-netbsd.c
old mode 100644
new mode 100755
index b9238b7877..c33b4ad69c
--- a/vm/os-netbsd.c
+++ b/vm/os-netbsd.c
@@ -1,6 +1,11 @@
#include "master.h"
+extern int main();
+
const char *vm_executable_path(void)
{
- return NULL;
+ static Dl_info info = {0};
+ if (!info.dli_fname)
+ dladdr(main, &info);
+ return info.dli_fname;
}
From 4b7034384c10f437090775b44a3b40bcb7f036af Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 1 Feb 2008 17:48:29 -0600
Subject: [PATCH 20/20] Eliminate core ascii dependency
---
core/parser/parser.factor | 15 +++++++-------
core/prettyprint/backend/backend.factor | 25 +++++++++---------------
{core => extra}/ascii/ascii-docs.factor | 0
{core => extra}/ascii/ascii-tests.factor | 0
{core => extra}/ascii/ascii.factor | 2 --
{core => extra}/ascii/authors.txt | 0
{core => extra}/ascii/summary.txt | 0
{core => extra}/ascii/tags.txt | 0
8 files changed, 16 insertions(+), 26 deletions(-)
rename {core => extra}/ascii/ascii-docs.factor (100%)
rename {core => extra}/ascii/ascii-tests.factor (100%)
rename {core => extra}/ascii/ascii.factor (96%)
rename {core => extra}/ascii/authors.txt (100%)
rename {core => extra}/ascii/summary.txt (100%)
rename {core => extra}/ascii/tags.txt (100%)
diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index 862b266d05..8b6ea57833 100755
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -1,12 +1,11 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays definitions generic assocs kernel math
namespaces prettyprint sequences strings vectors words
quotations inspector io.styles io combinators sorting
splitting math.parser effects continuations debugger
io.files io.streams.string io.streams.lines vocabs
-source-files classes hashtables compiler.errors compiler.units
-ascii ;
+source-files classes hashtables compiler.errors compiler.units ;
IN: parser
TUPLE: lexer text line column ;
@@ -55,8 +54,9 @@ t parser-notes set-global
0 over set-lexer-column
dup lexer-line 1+ swap set-lexer-line ;
-: skip ( i seq quot -- n )
- over >r find* drop
+: skip ( i seq ? -- n )
+ over >r
+ [ swap CHAR: \s eq? xor ] curry find* drop
[ r> drop ] [ r> length ] if* ; inline
: change-column ( lexer quot -- )
@@ -67,14 +67,13 @@ t parser-notes set-global
GENERIC: skip-blank ( lexer -- )
M: lexer skip-blank ( lexer -- )
- [ [ blank? not ] skip ] change-column ;
+ [ t skip ] change-column ;
GENERIC: skip-word ( lexer -- )
M: lexer skip-word ( lexer -- )
[
- 2dup nth CHAR: " =
- [ drop 1+ ] [ [ blank? ] skip ] if
+ 2dup nth CHAR: " = [ drop 1+ ] [ f skip ] if
] change-column ;
: still-parsing? ( lexer -- ? )
diff --git a/core/prettyprint/backend/backend.factor b/core/prettyprint/backend/backend.factor
index a5d0cee6c5..e64295cc0c 100755
--- a/core/prettyprint/backend/backend.factor
+++ b/core/prettyprint/backend/backend.factor
@@ -4,7 +4,7 @@ USING: arrays byte-arrays byte-vectors bit-arrays bit-vectors
generic hashtables io assocs kernel math namespaces sequences
strings sbufs io.styles vectors words prettyprint.config
prettyprint.sections quotations io io.files math.parser effects
-tuples classes float-arrays float-vectors ascii ;
+tuples classes float-arrays float-vectors ;
IN: prettyprint.backend
GENERIC: pprint* ( obj -- )
@@ -58,24 +58,17 @@ M: f pprint* drop \ f pprint-word ;
! Strings
: ch>ascii-escape ( ch -- str )
H{
- { CHAR: \e "\\e" }
- { CHAR: \n "\\n" }
- { CHAR: \r "\\r" }
- { CHAR: \t "\\t" }
- { CHAR: \0 "\\0" }
- { CHAR: \\ "\\\\" }
- { CHAR: \" "\\\"" }
+ { CHAR: \e CHAR: \\e }
+ { CHAR: \n CHAR: \\n }
+ { CHAR: \r CHAR: \\r }
+ { CHAR: \t CHAR: \\t }
+ { CHAR: \0 CHAR: \\0 }
+ { CHAR: \\ CHAR: \\\\ }
+ { CHAR: \" CHAR: \\\" }
} at ;
-: ch>unicode-escape ( ch -- str )
- >hex 6 CHAR: 0 pad-left "\\u" swap append ;
-
: unparse-ch ( ch -- )
- dup quotable? [
- ,
- ] [
- dup ch>ascii-escape [ ] [ ch>unicode-escape ] ?if %
- ] if ;
+ dup ch>ascii-escape [ ] [ ] ?if , ;
: do-string-limit ( str -- trimmed )
string-limit get [
diff --git a/core/ascii/ascii-docs.factor b/extra/ascii/ascii-docs.factor
similarity index 100%
rename from core/ascii/ascii-docs.factor
rename to extra/ascii/ascii-docs.factor
diff --git a/core/ascii/ascii-tests.factor b/extra/ascii/ascii-tests.factor
similarity index 100%
rename from core/ascii/ascii-tests.factor
rename to extra/ascii/ascii-tests.factor
diff --git a/core/ascii/ascii.factor b/extra/ascii/ascii.factor
similarity index 96%
rename from core/ascii/ascii.factor
rename to extra/ascii/ascii.factor
index 019db5f3b2..e4a365cd1b 100755
--- a/core/ascii/ascii.factor
+++ b/extra/ascii/ascii.factor
@@ -24,5 +24,3 @@ IN: ascii
: alpha? ( ch -- ? )
dup Letter? [ drop t ] [ digit? ] if ; inline
-
-
diff --git a/core/ascii/authors.txt b/extra/ascii/authors.txt
similarity index 100%
rename from core/ascii/authors.txt
rename to extra/ascii/authors.txt
diff --git a/core/ascii/summary.txt b/extra/ascii/summary.txt
similarity index 100%
rename from core/ascii/summary.txt
rename to extra/ascii/summary.txt
diff --git a/core/ascii/tags.txt b/extra/ascii/tags.txt
similarity index 100%
rename from core/ascii/tags.txt
rename to extra/ascii/tags.txt