Merge branch 'master' of git://factorcode.org/git/factor

core/alien/alien.factor

@@ -28,12 +28,6 @@ M: f expired? drop t ;
 : <alien> ( address -- alien )
     f <displaced-alien> { simple-c-ptr } declare ; inline
 
-: alien>native-string ( alien -- string )
-    os windows? [ alien>u16-string ] [ alien>char-string ] if ;
-
-: dll-path ( dll -- string )
-    (dll-path) alien>native-string ;
-
 M: alien equal?
     over alien? [
         2dup [ expired? ] either? [

core/alien/arrays/arrays-docs.factor

@@ -18,7 +18,6 @@ ARTICLE: "c-arrays-factor" "Converting C arrays to and from Factor arrays"
 { $subsection >c-ushort-array    }
 { $subsection >c-void*-array     }
 { $subsection c-bool-array>      }
-{ $subsection c-char*-array>     }
 { $subsection c-char-array>      }
 { $subsection c-double-array>    }
 { $subsection c-float-array>     }
@@ -30,7 +29,6 @@ ARTICLE: "c-arrays-factor" "Converting C arrays to and from Factor arrays"
 { $subsection c-uint-array>      }
 { $subsection c-ulong-array>     }
 { $subsection c-ulonglong-array> }
-{ $subsection c-ushort*-array>   }
 { $subsection c-ushort-array>    }
 { $subsection c-void*-array>     } ;
 
@@ -61,9 +59,7 @@ ARTICLE: "c-arrays-get/set" "Reading and writing elements in C arrays"
 { $subsection double-nth }
 { $subsection set-double-nth }
 { $subsection void*-nth }
-{ $subsection set-void*-nth }
+{ $subsection set-void*-nth } ;
-{ $subsection char*-nth }
-{ $subsection ushort*-nth } ;
 
 ARTICLE: "c-arrays" "C arrays"
 "C arrays are allocated in the same manner as other C data; see " { $link "c-byte-arrays" } " and " { $link "malloc" } "."

core/alien/arrays/arrays.factor

@@ -1,8 +1,7 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays alien.c-types alien.structs
-sequences math kernel generator.registers
+sequences math kernel namespaces libc cpu.architecture ;
-namespaces libc ;
 IN: alien.arrays
 
 UNION: value-type array struct-type ;
@@ -27,7 +26,9 @@ M: array stack-size drop "void*" stack-size ;
 
 M: value-type c-type-reg-class drop int-regs ;
 
-M: value-type c-type-prep drop f ;
+M: value-type c-type-boxer-quot drop f ;
+
+M: value-type c-type-unboxer-quot drop f ;
 
 M: value-type c-type-getter
     drop [ swap <displaced-alien> ] ;

core/alien/c-types/c-types-docs.factor

@@ -62,28 +62,6 @@ HELP: <c-object>
 
 { <c-object> malloc-object } related-words
 
-HELP: string>char-alien ( string -- array )
-{ $values { "string" string } { "array" byte-array } }
-{ $description "Copies the string to a new byte array, converting it to 8-bit ASCII and adding a trailing null byte." }
-{ $errors "Throws an error if the string contains null characters, or characters beyond the 8-bit range." } ;
-
-{ string>char-alien alien>char-string malloc-char-string } related-words
-
-HELP: alien>char-string ( c-ptr -- string )
-{ $values { "c-ptr" c-ptr } { "string" string } }
-{ $description "Reads a null-terminated 8-bit C string from the specified address." } ;
-
-HELP: string>u16-alien ( string -- array )
-{ $values { "string" string } { "array" byte-array } }
-{ $description "Copies the string to a new byte array in UCS-2 format with a trailing null byte." }
-{ $errors "Throws an error if the string contains null characters." } ;
-
-{ string>u16-alien alien>u16-string malloc-u16-string } related-words
-
-HELP: alien>u16-string ( c-ptr -- string )
-{ $values { "c-ptr" c-ptr } { "string" string } }
-{ $description "Reads a null-terminated UCS-2 string from the specified address." } ;
-
 HELP: memory>byte-array
 { $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
 { $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ;
@@ -111,18 +89,6 @@ HELP: malloc-byte-array
 { $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
 { $errors "Throws an error if memory allocation fails." } ;
 
-HELP: malloc-char-string
-{ $values { "string" string } { "alien" c-ptr } }
-{ $description "Allocates an unmanaged memory block, and stores a string in 8-bit ASCII encoding with a trailing null byte to the block." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if memory allocation fails." } ;
-
-HELP: malloc-u16-string
-{ $values { "string" string } { "alien" c-ptr } }
-{ $description "Allocates an unmanaged memory block, and stores a string in UCS2 encoding with a trailing null character to the block." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if memory allocation fails." } ;
-
 HELP: define-nth
 { $values { "name" "a word name" } { "vocab" "a vocabulary name" } }
 { $description "Defines a word " { $snippet { $emphasis "name" } "-nth" } " with stack effect " { $snippet "( n c-ptr -- value )" } " for reading the value with C type " { $snippet "name" } " stored at an alien pointer, displaced by a multiple of the C type's size." }
@@ -202,8 +168,6 @@ $nl
 { $subsection *float }
 { $subsection *double }
 { $subsection *void* }
-{ $subsection *char* }
-{ $subsection *ushort* }
 "Note that while structure and union types do not get these words defined for them, there is no loss of generality since " { $link <void*> } " and " { $link *void* } " may be used." ;
 
 ARTICLE: "c-types-specs" "C type specifiers"
@@ -267,26 +231,6 @@ $nl
 "A wrapper for temporarily allocating a block of memory:"
 { $subsection with-malloc } ;
 
-ARTICLE: "c-strings" "C strings"
-"The C library interface defines two types of C strings:"
-{ $table
-    { "C type" "Notes" }
-    { { $snippet "char*" } "8-bit per character null-terminated ASCII" }
-    { { $snippet "ushort*" } "16-bit per character null-terminated UCS-2" }
-}
-"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function. If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
-"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
-{ $subsection string>char-alien }
-{ $subsection string>u16-alien }
-{ $subsection malloc-char-string }
-{ $subsection malloc-u16-string }
-"The first two allocate " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
-$nl
-"Finally, a set of words can be used to read and write " { $snippet "char*" } " and " { $snippet "ushort*" } " strings at arbitrary addresses:"
-{ $subsection alien>char-string }
-{ $subsection alien>u16-string }
-"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ;
-
 ARTICLE: "c-data" "Passing data between Factor and C"
 "Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers."
 $nl

core/alien/c-types/c-types-tests.factor

@@ -1,30 +1,6 @@
 IN: alien.c-types.tests
 USING: alien alien.syntax alien.c-types kernel tools.test
-sequences system libc ;
+sequences system libc alien.strings io.encodings.utf8 ;
-
-[ "\u0000ff" ]
-[ "\u0000ff" string>char-alien alien>char-string ]
-unit-test
-
-[ "hello world" ]
-[ "hello world" string>char-alien alien>char-string ]
-unit-test
-
-[ "hello\u00abcdworld" ]
-[ "hello\u00abcdworld" string>u16-alien alien>u16-string ]
-unit-test
-
-[ t ] [ f expired? ] unit-test
-
-[ "hello world" ] [
-    "hello world" malloc-char-string
-    dup alien>char-string swap free
-] unit-test
-
-[ "hello world" ] [
-    "hello world" malloc-u16-string
-    dup alien>u16-string swap free
-] unit-test
 
 : foo ( -- n ) "fdafd" f dlsym [ 123 ] unless* ;
 
@@ -67,7 +43,7 @@ TYPEDEF: int* MyIntArray
 
 TYPEDEF: uchar* MyLPBYTE
 
-[ t ] [ "char*" c-type "MyLPBYTE" c-type eq? ] unit-test
+[ t ] [ { "char*" utf8 } c-type "MyLPBYTE" c-type = ] unit-test
 
 [
     0 B{ 1 2 3 4 } <displaced-alien> <void*>

core/alien/c-types/c-types.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: bit-arrays byte-arrays float-arrays arrays
-generator.registers assocs kernel kernel.private libc math
+assocs kernel kernel.private libc math
 namespaces parser sequences strings words assocs splitting
 math.parser cpu.architecture alien alien.accessors quotations
 layouts system compiler.units io.files io.encodings.binary
@@ -14,7 +14,7 @@ DEFER: *char
 : little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
 
 TUPLE: c-type
-boxer prep unboxer
+boxer boxer-quot unboxer unboxer-quot
 getter setter
 reg-class size align stack-align? ;
 
@@ -149,23 +149,12 @@ M: float-array byte-length length "double" heap-size * ;
 : malloc-byte-array ( byte-array -- alien )
     dup length dup malloc [ -rot memcpy ] keep ;
 
-: malloc-char-string ( string -- alien )
-    string>char-alien malloc-byte-array ;
-
-: malloc-u16-string ( string -- alien )
-    string>u16-alien malloc-byte-array ;
-
 : memory>byte-array ( alien len -- byte-array )
     dup <byte-array> [ -rot memcpy ] keep ;
 
 : byte-array>memory ( byte-array base -- )
     swap dup length memcpy ;
 
-DEFER: >c-ushort-array
-
-: string>u16-memory ( string base -- )
-    >r >c-ushort-array r> byte-array>memory ;
-
 : (define-nth) ( word type quot -- )
     >r heap-size [ rot * ] swap prefix r> append define-inline ;
 
@@ -378,7 +367,7 @@ M: long-long-type box-return ( type -- )
         "box_float" >>boxer
         "to_float" >>unboxer
         single-float-regs >>reg-class
-        [ >float ] >>prep
+        [ >float ] >>unboxer-quot
     "float" define-primitive-type
 
     <c-type>
@@ -389,30 +378,8 @@ M: long-long-type box-return ( type -- )
         "box_double" >>boxer
         "to_double" >>unboxer
         double-float-regs >>reg-class
-        [ >float ] >>prep
+        [ >float ] >>unboxer-quot
     "double" define-primitive-type
 
-    <c-type>
-        [ alien-cell alien>char-string ] >>getter
-        [ set-alien-cell ] >>setter
-        bootstrap-cell >>size
-        bootstrap-cell >>align
-        "box_char_string" >>boxer
-        "alien_offset" >>unboxer
-        [ string>char-alien ] >>prep
-    "char*" define-primitive-type
-
-    "char*" "uchar*" typedef
-
-    <c-type>
-        [ alien-cell alien>u16-string ] >>getter
-        [ set-alien-cell ] >>setter
-        4 >>size
-        4 >>align
-        "box_u16_string" >>boxer
-        "alien_offset" >>unboxer
-        [ string>u16-alien ] >>prep
-    "ushort*" define-primitive-type
-
     os winnt? cpu x86.64? and "longlong" "long" ? "ptrdiff_t" typedef
 ] with-compilation-unit

core/alien/compiler/compiler-tests.factor

@@ -364,6 +364,10 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
         + + 1+
     ] alien-callback ;
 
+FUNCTION: void ffi_test_36_point_5 ( ) ;
+
+[ ] [ ffi_test_36_point_5 ] unit-test
+
 FUNCTION: int ffi_test_37 ( void* func ) ;
 
 [ 1 ] [ callback-9 ffi_test_37 ] unit-test

core/alien/compiler/compiler.factor

@@ -3,10 +3,11 @@
 USING: arrays generator generator.registers generator.fixup
 hashtables kernel math namespaces sequences words
 inference.state inference.backend inference.dataflow system
-math.parser classes alien.arrays alien.c-types alien.structs
+math.parser classes alien.arrays alien.c-types alien.strings
-alien.syntax cpu.architecture alien inspector quotations assocs
+alien.structs alien.syntax cpu.architecture alien inspector
-kernel.private threads continuations.private libc combinators
+quotations assocs kernel.private threads continuations.private
-compiler.errors continuations layouts accessors ;
+libc combinators compiler.errors continuations layouts accessors
+;
 IN: alien.compiler
 
 TUPLE: #alien-node < node return parameters abi ;
@@ -20,9 +21,7 @@ TUPLE: #alien-invoke < #alien-node library function ;
 : large-struct? ( ctype -- ? )
     dup c-struct? [
         heap-size struct-small-enough? not
-    ] [
+    ] [ drop f ] if ;
-        drop f
-    ] if ;
 
 : alien-node-parameters* ( node -- seq )
     dup parameters>>
@@ -162,17 +161,16 @@ M: long-long-type flatten-value-type ( type -- )
     dup return>> "void" = 0 1 ?
     swap produce-values ;
 
-: (make-prep-quot) ( parameters -- )
+: (param-prep-quot) ( parameters -- )
     dup empty? [
         drop
     ] [
-        unclip c-type c-type-prep %
+        unclip c-type c-type-unboxer-quot %
-        \ >r , (make-prep-quot) \ r> ,
+        \ >r , (param-prep-quot) \ r> ,
     ] if ;
 
-: make-prep-quot ( node -- quot )
+: param-prep-quot ( node -- quot )
-    parameters>>
+    parameters>> [ <reversed> (param-prep-quot) ] [ ] make ;
-    [ <reversed> (make-prep-quot) ] [ ] make ;
 
 : unbox-parameters ( offset node -- )
     parameters>> [
@@ -200,6 +198,20 @@ M: long-long-type flatten-value-type ( type -- )
 : box-return* ( node -- )
     return>> [ ] [ box-return ] if-void ;
 
+: (return-prep-quot) ( parameters -- )
+    dup empty? [
+        drop
+    ] [
+        unclip c-type c-type-boxer-quot %
+        \ >r , (return-prep-quot) \ r> ,
+    ] if ;
+
+: callback-prep-quot ( node -- quot )
+    parameters>> [ <reversed> (return-prep-quot) ] [ ] make ;
+
+: return-prep-quot ( node -- quot )
+    [ return>> [ ] [ 1array (return-prep-quot) ] if-void ] [ ] make ;
+
 M: alien-invoke-error summary
     drop
     "Words calling ``alien-invoke'' must be compiled with the optimizing compiler." ;
@@ -258,15 +270,15 @@ M: no-such-symbol compiler-error-type
     pop-literal nip >>library
     pop-literal nip >>return
     ! Quotation which coerces parameters to required types
-    dup make-prep-quot recursive-state get infer-quot
+    dup param-prep-quot f infer-quot
     ! Set ABI
-    dup library>>
+    dup library>> library [ abi>> ] [ "cdecl" ] if* >>abi
-    library [ abi>> ] [ "cdecl" ] if*
-    >>abi
     ! Add node to IR
     dup node,
     ! Magic #: consume exactly the number of inputs
-    0 alien-invoke-stack
+    dup 0 alien-invoke-stack
+    ! Quotation which coerces return value to required type
+    return-prep-quot f infer-quot
 ] "infer" set-word-prop
 
 M: #alien-invoke generate-node
@@ -294,11 +306,13 @@ M: alien-indirect-error summary
     pop-parameters >>parameters
     pop-literal nip >>return
     ! Quotation which coerces parameters to required types
-    dup make-prep-quot [ dip ] curry recursive-state get infer-quot
+    dup param-prep-quot [ dip ] curry f infer-quot
     ! Add node to IR
     dup node,
     ! Magic #: consume the function pointer, too
-    1 alien-invoke-stack
+    dup 1 alien-invoke-stack
+    ! Quotation which coerces return value to required type
+    return-prep-quot f infer-quot
 ] "infer" set-word-prop
 
 M: #alien-indirect generate-node
@@ -331,7 +345,7 @@ M: alien-callback-error summary
 
 : callback-bottom ( node -- )
     xt>> [ word-xt drop <alien> ] curry
-    recursive-state get infer-quot ;
+    f infer-quot ;
 
 \ alien-callback [
     4 ensure-values
@@ -371,16 +385,18 @@ TUPLE: callback-context ;
     slip
     wait-to-return ; inline
 
-: prepare-callback-return ( ctype -- quot )
+: callback-return-quot ( ctype -- quot )
     return>> {
         { [ dup "void" = ] [ drop [ ] ] }
         { [ dup large-struct? ] [ heap-size [ memcpy ] curry ] }
-        [ c-type c-type-prep ]
+        [ c-type c-type-unboxer-quot ]
     } cond ;
 
 : wrap-callback-quot ( node -- quot )
     [
-        [ quot>> ] [ prepare-callback-return ] bi append ,
+        [ callback-prep-quot ]
+        [ quot>> ]
+        [ callback-return-quot ] tri 3append ,
         [ callback-context new do-callback ] %
     ] [ ] make ;
 
@@ -405,9 +421,10 @@ TUPLE: callback-context ;
         init-templates
         %prologue-later
         dup alien-stack-frame [
-            dup registers>objects
+            [ registers>objects ]
-            dup wrap-callback-quot %alien-callback
+            [ wrap-callback-quot %alien-callback ]
-            %callback-return
+            [ %callback-return ]
+            tri
         ] with-stack-frame
     ] with-generator ;
 

core/alien/remote-control/remote-control.factor

@@ -1,12 +1,12 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types parser threads words kernel.private
+USING: alien alien.c-types alien.strings parser threads words
-kernel ;
+kernel.private kernel io.encodings.utf8 ;
 IN: alien.remote-control
 
 : eval-callback
     "void*" { "char*" } "cdecl"
-    [ eval>string malloc-char-string ] alien-callback ;
+    [ eval>string utf8 malloc-string ] alien-callback ;
 
 : yield-callback
     "void" { } "cdecl" [ yield ] alien-callback ;

core/alien/strings/strings-docs.factor

@@ -0,0 +1,52 @@
+USING: help.markup help.syntax strings byte-arrays alien libc
+debugger ;
+IN: alien.strings
+
+HELP: string>alien
+{ $values { "string" string } { "encoding" "an encoding descriptor" } { "array" byte-array } }
+{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated byte array." }
+{ $errors "Throws an error if the string contains null characters, or characters not representable in the given encoding." } ;
+
+{ string>alien alien>string malloc-string } related-words
+
+HELP: alien>string
+{ $values { "c-ptr" c-ptr } { "encoding" "an encoding descriptor" } { "string" string } }
+{ $description "Reads a null-terminated C string from the specified address with the given encoding." } ;
+
+HELP: malloc-string
+{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
+{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if one of the following conditions occurs:"
+    { $list
+        "the string contains null code points"
+        "the string contains characters not representable using the encoding specified"
+        "memory allocation fails"
+    }
+} ;
+
+HELP: string>symbol
+{ $values { "str" string } { "alien" alien } }
+{ $description "Converts the string to a format which is a valid symbol name for the Factor VM's compiled code linker. By performing this conversion ahead of time, the image loader can run without allocating memory."
+$nl
+"On Windows CE, symbols are represented as UCS2 strings, and on all other platforms they are ASCII strings." } ;
+
+HELP: utf16n
+{ $class-description "The encoding descriptor for UTF-16 without a byte order mark in native endian order. This is useful mostly for FFI calls which take input of strings of the type wchar_t*" }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "c-strings" "C strings"
+"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
+$nl
+"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function. If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
+$nl
+"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
+{ $subsection string>alien }
+{ $subsection malloc-string }
+"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
+$nl
+"A word to read strings from arbitrary addresses:"
+{ $subsection alien>string }
+"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ;
+
+ABOUT: "c-strings"

core/alien/strings/strings-tests.factor

@@ -0,0 +1,30 @@
+USING: alien.strings tools.test kernel libc
+io.encodings.8-bit io.encodings.utf8 io.encodings.utf16
+io.encodings.ascii alien ;
+IN: alien.strings.tests
+
+[ "\u0000ff" ]
+[ "\u0000ff" latin1 string>alien latin1 alien>string ]
+unit-test
+
+[ "hello world" ]
+[ "hello world" latin1 string>alien latin1 alien>string ]
+unit-test
+
+[ "hello\u00abcdworld" ]
+[ "hello\u00abcdworld" utf16le string>alien utf16le alien>string ]
+unit-test
+
+[ t ] [ f expired? ] unit-test
+
+[ "hello world" ] [
+    "hello world" ascii malloc-string
+    dup ascii alien>string swap free
+] unit-test
+
+[ "hello world" ] [
+    "hello world" utf16n malloc-string
+    dup utf16n alien>string swap free
+] unit-test
+
+[ f ] [ f utf8 alien>string ] unit-test

core/alien/strings/strings.factor

@@ -0,0 +1,111 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays sequences kernel accessors math alien.accessors
+alien.c-types byte-arrays words io io.encodings
+io.streams.byte-array io.streams.memory io.encodings.utf8
+io.encodings.utf16 system alien strings cpu.architecture ;
+IN: alien.strings
+
+GENERIC# alien>string 1 ( alien encoding -- string/f )
+
+M: c-ptr alien>string
+    >r <memory-stream> r> <decoder>
+    "\0" swap stream-read-until drop ;
+
+M: f alien>string
+    drop ;
+
+ERROR: invalid-c-string string ;
+
+: check-string ( string -- )
+    0 over memq? [ invalid-c-string ] [ drop ] if ;
+
+GENERIC# string>alien 1 ( string encoding -- byte-array )
+
+M: c-ptr string>alien drop ;
+
+M: string string>alien
+    over check-string
+    <byte-writer>
+    [ stream-write ]
+    [ 0 swap stream-write1 ]
+    [ stream>> >byte-array ]
+    tri ;
+
+: malloc-string ( string encoding -- alien )
+    string>alien malloc-byte-array ;
+
+PREDICATE: string-type < pair
+    first2 [ "char*" = ] [ word? ] bi* and ;
+
+M: string-type c-type ;
+
+M: string-type heap-size
+    drop "void*" heap-size ;
+
+M: string-type c-type-align
+    drop "void*" c-type-align ;
+
+M: string-type c-type-stack-align?
+    drop "void*" c-type-stack-align? ;
+
+M: string-type unbox-parameter
+    drop "void*" unbox-parameter ;
+
+M: string-type unbox-return
+    drop "void*" unbox-return ;
+
+M: string-type box-parameter
+    drop "void*" box-parameter ;
+
+M: string-type box-return
+    drop "void*" box-return ;
+
+M: string-type stack-size
+    drop "void*" stack-size ;
+
+M: string-type c-type-reg-class
+    drop int-regs ;
+
+M: string-type c-type-boxer
+    drop "void*" c-type-boxer ;
+
+M: string-type c-type-unboxer
+    drop "void*" c-type-unboxer ;
+
+M: string-type c-type-boxer-quot
+    second [ alien>string ] curry [ ] like ;
+
+M: string-type c-type-unboxer-quot
+    second [ string>alien ] curry [ ] like ;
+
+M: string-type c-type-getter
+    drop [ alien-cell ] ;
+
+M: string-type c-type-setter
+    drop [ set-alien-cell ] ;
+
+TUPLE: utf16n ;
+
+! Native-order UTF-16
+
+: utf16n ( -- descriptor )
+    little-endian? utf16le utf16be ? ; foldable
+
+M: utf16n <decoder> drop utf16n <decoder> ;
+
+M: utf16n <encoder> drop utf16n <encoder> ;
+
+: alien>native-string ( alien -- string )
+    os windows? [ utf16n ] [ utf8 ] if alien>string ;
+
+: dll-path ( dll -- string )
+    (dll-path) alien>native-string ;
+
+: string>symbol ( str -- alien )
+    [ os wince? [ utf16n ] [ utf8 ] if string>alien ]
+    over string? [ call ] [ map ] if ;
+
+{ "char*" utf8 } "char*" typedef
+{ "char*" utf16n } "wchar_t*" typedef
+"char*" "uchar*" typedef

core/alien/structs/structs-tests.factor

@@ -1,6 +1,6 @@
 IN: alien.structs.tests
 USING: alien alien.syntax alien.c-types kernel tools.test
-sequences system libc words vocabs namespaces ;
+sequences system libc words vocabs namespaces layouts ;
 
 C-STRUCT: bar
     { "int" "x" }
@@ -9,20 +9,20 @@ C-STRUCT: bar
 [ 36 ] [ "bar" heap-size ] unit-test
 [ t ] [ \ <displaced-alien> "bar" c-type c-type-getter memq? ] unit-test
 
-! This was actually only correct on Windows/x86:
+C-STRUCT: align-test
+    { "int" "x" }
+    { "double" "y" } ;
 
-! C-STRUCT: align-test
+os winnt? cpu x86? and [
-!     { "int" "x" }
+    [ 16 ] [ "align-test" heap-size ] unit-test
-!     { "double" "y" } ;
+    
-! 
+    cell 4 = [
-! [ 16 ] [ "align-test" heap-size ] unit-test
+        C-STRUCT: one
-! 
+        { "long" "a" } { "double" "b" } { "int" "c" } ;
-! cell 4 = [
+    
-!     C-STRUCT: one
+        [ 24 ] [ "one" heap-size ] unit-test
-!     { "long" "a" } { "double" "b" } { "int" "c" } ;
+    ] when
-! 
+] when
-!     [ 24 ] [ "one" heap-size ] unit-test
-! ] when
 
 : MAX_FOOS 30 ;
 

core/alien/structs/structs.factor

@@ -20,14 +20,19 @@ IN: alien.structs
 
 : define-getter ( type spec -- )
     [ set-reader-props ] keep
-    dup slot-spec-reader
+    [ ]
-    over slot-spec-type c-getter
+    [ slot-spec-reader ]
+    [
+        slot-spec-type
+        [ c-getter ] [ c-type c-type-boxer-quot ] bi append
+    ] tri
     define-struct-slot-word ;
 
 : define-setter ( type spec -- )
     [ set-writer-props ] keep
-    dup slot-spec-writer
+    [ ]
-    over slot-spec-type c-setter
+    [ slot-spec-writer ]
+    [ slot-spec-type c-setter ] tri
     define-struct-slot-word ;
 
 : define-field ( type spec -- )

core/alien/syntax/syntax.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2005, 2008 Slava Pestov, Alex Chapman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays alien alien.c-types alien.structs alien.arrays
-kernel math namespaces parser sequences words quotations
+alien.strings kernel math namespaces parser sequences words
-math.parser splitting effects prettyprint prettyprint.sections
+quotations math.parser splitting effects prettyprint
-prettyprint.backend assocs combinators ;
+prettyprint.sections prettyprint.backend assocs combinators ;
 IN: alien.syntax
 
 <PRIVATE

core/bootstrap/primitives.factor

@@ -638,10 +638,6 @@ tuple
     { "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" }
-    { "string>u16-alien" "alien" }
     { "(throw)" "kernel.private" }
     { "alien-address" "alien" }
     { "slot" "slots.private" }

core/classes/tuple/tuple-tests.factor

@@ -3,7 +3,8 @@ math.constants parser sequences tools.test words assocs
 namespaces quotations sequences.private classes continuations
 generic.standard effects classes.tuple classes.tuple.private
 arrays vectors strings compiler.units accessors classes.algebra
-calendar prettyprint io.streams.string splitting inspector ;
+calendar prettyprint io.streams.string splitting inspector
+columns ;
 IN: classes.tuple.tests
 
 TUPLE: rect x y w h ;

core/compiler/tests/intrinsics.factor

@@ -4,8 +4,8 @@ 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
+alien.accessors alien.c-types alien.syntax alien.strings
-sequences.private ;
+namespaces libc sequences.private io.encodings.ascii ;
 
 ! Make sure that intrinsic ops compile to correct code.
 [ ] [ 1 [ drop ] compile-call ] unit-test
@@ -361,11 +361,11 @@ cell 8 = [
     [ ] [ "b" get free ] unit-test
 ] when
 
-[ ] [ "hello world" malloc-char-string "s" set ] unit-test
+[ ] [ "hello world" ascii malloc-string "s" set ] unit-test
 
 "s" get [
-    [ "hello world" ] [ "s" get <void*> [ { byte-array } declare *void* ] compile-call alien>char-string ] unit-test
+    [ "hello world" ] [ "s" get <void*> [ { byte-array } declare *void* ] compile-call ascii alien>string ] unit-test
-    [ "hello world" ] [ "s" get <void*> [ { c-ptr } declare *void* ] compile-call alien>char-string ] unit-test
+    [ "hello world" ] [ "s" get <void*> [ { c-ptr } declare *void* ] compile-call ascii alien>string ] unit-test
 
     [ ] [ "s" get free ] unit-test
 ] when

core/compiler/tests/templates-early.factor

@@ -2,7 +2,8 @@
 IN: compiler.tests
 USING: compiler generator generator.registers
 generator.registers.private tools.test namespaces sequences
-words kernel math effects definitions compiler.units accessors ;
+words kernel math effects definitions compiler.units accessors
+cpu.architecture ;
 
 : <int-vreg> ( n -- vreg ) int-regs <vreg> ;
 

core/cpu/architecture/architecture.factor

@@ -1,10 +1,17 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic kernel kernel.private math memory
 namespaces sequences layouts system hashtables classes alien
 byte-arrays bit-arrays float-arrays combinators words sets ;
 IN: cpu.architecture
 
+! Register classes
+SINGLETON: int-regs
+SINGLETON: single-float-regs
+SINGLETON: double-float-regs
+UNION: float-regs single-float-regs double-float-regs ;
+UNION: reg-class int-regs float-regs ;
+
 ! A pseudo-register class for parameters spilled on the stack
 SINGLETON: stack-params
 

core/generator/fixup/fixup-docs.factor

@@ -13,12 +13,6 @@ HELP: add-literal
 { $values { "obj" object } { "n" integer } }
 { $description "Adds a literal to the " { $link literal-table } ", if it is not already there, and outputs the index of the literal in the table. This literal can then be used as an argument for a " { $link rt-literal } " relocation with " { $link rel-fixup } "." } ;
 
-HELP: string>symbol
-{ $values { "str" string } { "alien" alien } }
-{ $description "Converts the string to a format which is a valid symbol name for the Factor VM's compiled code linker. By performing this conversion ahead of time, the image loader can run without allocating memory."
-$nl
-"On Windows CE, symbols are represented as UCS2 strings, and on all other platforms they are ASCII strings." } ;
-
 HELP: rel-dlsym
 { $values { "name" string } { "dll" "a " { $link dll } " or " { $link f } } { "class" "a relocation class" } }
 { $description "Records that the most recently assembled instruction contains a reference to the " { $snippet "name" } " symbol from " { $snippet "dll" } ". The correct " { $snippet "class" } " to use depends on instruction formats."

core/generator/fixup/fixup.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic assocs hashtables
 kernel kernel.private math namespaces sequences words
-quotations strings alien layouts system combinators
+quotations strings alien.strings layouts system combinators
 math.bitfields words.private cpu.architecture ;
 IN: generator.fixup
 
@@ -110,10 +110,6 @@ SYMBOL: literal-table
 
 : add-literal ( obj -- n ) literal-table get push-new* ;
 
-: string>symbol ( str -- alien )
-    [ os wince? [ string>u16-alien ] [ string>char-alien ] if ]
-    over string? [ call ] [ map ] if ;
-
 : add-dlsym-literals ( symbol dll -- )
     >r string>symbol r> 2array literal-table get push-all ;
 

core/generator/generator.factor

@@ -73,6 +73,7 @@ GENERIC: generate-node ( node -- next )
 : word-dataflow ( word -- effect dataflow )
     [
         dup "no-effect" word-prop [ no-effect ] when
+        dup "no-compile" word-prop [ no-effect ] when
         dup specialized-def over dup 2array 1array infer-quot
         finish-word
     ] with-infer ;

core/generator/registers/registers.factor

@@ -13,13 +13,6 @@ SYMBOL: +scratch+
 SYMBOL: +clobber+
 SYMBOL: known-tag
 
-! Register classes
-SINGLETON: int-regs
-SINGLETON: single-float-regs
-SINGLETON: double-float-regs
-UNION: float-regs single-float-regs double-float-regs ;
-UNION: reg-class int-regs float-regs ;
-
 <PRIVATE
 
 ! Value protocol

core/generic/standard/standard-tests.factor

@@ -3,7 +3,7 @@ USING: tools.test math math.functions math.constants
 generic.standard strings sequences arrays kernel accessors
 words float-arrays byte-arrays bit-arrays parser namespaces
 quotations inference vectors growable hashtables sbufs
-prettyprint ;
+prettyprint byte-vectors bit-vectors float-vectors ;
 
 GENERIC: lo-tag-test
 

core/inference/known-words/known-words.factor

@@ -92,6 +92,8 @@ M: object infer-call
     peek-d infer-call
 ] "infer" set-word-prop
 
+\ call t "no-compile" set-word-prop
+
 \ execute [
     1 ensure-values
     pop-literal nip
@@ -471,18 +473,6 @@ set-primitive-effect
 
 \ set-alien-cell { c-ptr c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien>char-string { c-ptr } { string } <effect> set-primitive-effect
-\ alien>char-string make-flushable
-
-\ string>char-alien { string } { byte-array } <effect> set-primitive-effect
-\ string>char-alien make-flushable
-
-\ alien>u16-string { c-ptr } { string } <effect> set-primitive-effect
-\ alien>u16-string make-flushable
-
-\ string>u16-alien { string } { byte-array } <effect> set-primitive-effect
-\ string>u16-alien make-flushable
-
 \ alien-address { alien } { integer } <effect> set-primitive-effect
 \ alien-address make-flushable
 

core/io/encodings/encodings-docs.factor

@@ -41,12 +41,13 @@ $low-level-note ;
 
 ARTICLE: "encodings-descriptors" "Encoding descriptors"
 "An encoding descriptor is something which can be used for input or output streams to encode or decode files. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:"
-{ $vocab-subsection "ASCII" "io.encodings.ascii" }
+{ $subsection "io.encodings.binary" }
-{ $vocab-subsection "Binary" "io.encodings.binary" }
+{ $subsection "io.encodings.utf8" }
+{ $subsection "io.encodings.utf16" }
 { $vocab-subsection "Strict encodings" "io.encodings.strict" }
+"Legacy encodings:"
 { $vocab-subsection "8-bit encodings" "io.encodings.8-bit" }
-{ $vocab-subsection "UTF-8" "io.encodings.utf8" }
+{ $vocab-subsection "ASCII" "io.encodings.ascii" }
-{ $vocab-subsection "UTF-16" "io.encodings.utf16" }
 { $see-also "encodings-introduction" } ;
 
 ARTICLE: "encodings-protocol" "Encoding protocol"

core/io/encodings/utf16/utf16-docs.factor

@@ -5,8 +5,7 @@ ARTICLE: "io.encodings.utf16" "UTF-16"
 "The UTF-16 encoding is a variable-width encoding. Unicode code points are encoded as 2 or 4 byte sequences. There are three encoding descriptor classes for working with UTF-16, depending on endianness or the presence of a BOM:"
 { $subsection utf16 }
 { $subsection utf16le }
-{ $subsection utf16be }
+{ $subsection utf16be } ;
-{ $subsection utf16n } ;
 
 ABOUT: "io.encodings.utf16"
 
@@ -22,8 +21,4 @@ HELP: utf16
 { $class-description "The encoding descriptor for UTF-16, that is, UTF-16 with a byte order mark. This is the most useful for general input and output in UTF-16. Streams can be made which read or write wth this encoding." }
 { $see-also "encodings-introduction" } ;
 
-HELP: utf16n
+{ utf16 utf16le utf16be } related-words
-{ $class-description "The encoding descriptor for UTF-16 without a byte order mark in native endian order. This is useful mostly for FFI calls which take input of strings of the type wchar_t*" }
-{ $see-also "encodings-introduction" } ;
-
-{ utf16 utf16le utf16be utf16n } related-words

core/io/encodings/utf16/utf16-tests.factor

@@ -1,6 +1,6 @@
 USING: kernel tools.test io.encodings.utf16 arrays sbufs
 io.streams.byte-array sequences io.encodings io unicode
-io.encodings.string alien.c-types accessors classes ;
+io.encodings.string alien.c-types alien.strings accessors classes ;
 IN: io.encodings.utf16.tests
 
 [ { CHAR: x } ] [ { 0 CHAR: x } utf16be decode >array ] unit-test

core/io/encodings/utf16/utf16.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2006, 2008 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math kernel sequences sbufs vectors namespaces io.binary
-io.encodings combinators splitting io byte-arrays inspector
+io.encodings combinators splitting io byte-arrays inspector ;
-alien.c-types ;
 IN: io.encodings.utf16
 
 TUPLE: utf16be ;
@@ -11,8 +10,6 @@ TUPLE: utf16le ;
 
 TUPLE: utf16 ;
 
-TUPLE: utf16n ;
-
 <PRIVATE
 
 ! UTF-16BE decoding
@@ -124,13 +121,4 @@ M: utf16 <decoder> ( stream utf16 -- decoder )
 M: utf16 <encoder> ( stream utf16 -- encoder )
     drop bom-le over stream-write utf16le <encoder> ;
 
-! Native-order UTF-16
-
-: native-utf16 ( -- descriptor )
-    little-endian? utf16le utf16be ? ;
-
-M: utf16n <decoder> drop native-utf16 <decoder> ;
-
-M: utf16n <encoder> drop native-utf16 <encoder> ;
-
 PRIVATE>

core/io/streams/memory/memory.factor

@@ -0,0 +1,13 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors alien.accessors math io ;
+IN: io.streams.memory
+
+TUPLE: memory-stream alien index ;
+
+: <memory-stream> ( alien -- stream )
+    0 memory-stream boa ;
+
+M: memory-stream stream-read1
+    [ [ alien>> ] [ index>> ] bi alien-unsigned-1 ]
+    [ [ 1+ ] change-index drop ] bi ;

core/prettyprint/config/config.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2003, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: prettyprint.config
-USING: alien arrays generic assocs io kernel math
+USING: arrays generic assocs io kernel math
 namespaces sequences strings io.styles vectors words
 continuations ;
 

core/prettyprint/prettyprint.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: prettyprint
-USING: alien arrays generic generic.standard assocs io kernel
+USING: arrays generic generic.standard assocs io kernel
 math namespaces sequences strings io.styles io.streams.string
 vectors words prettyprint.backend prettyprint.sections
 prettyprint.config sorting splitting math.parser vocabs

core/prettyprint/sections/sections.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays generic hashtables io kernel math assocs
+USING: arrays generic hashtables io kernel math assocs
 namespaces sequences strings io.styles vectors words
 prettyprint.config splitting classes continuations
 io.streams.nested accessors ;

extra/benchmark/binary-trees/binary-trees.factor

@@ -0,0 +1,55 @@
+USING: kernel math accessors prettyprint io locals sequences
+math.ranges ;
+IN: benchmark.binary-trees
+
+TUPLE: tree-node item left right ;
+
+C: <tree-node> tree-node
+
+: bottom-up-tree ( item depth -- tree )
+    dup 0 > [
+        1 -
+        [ drop ]
+        [ >r 2 * 1 - r> bottom-up-tree ]
+        [ >r 2 *     r> bottom-up-tree ] 2tri
+    ] [
+        drop f f
+    ] if <tree-node> ;
+
+GENERIC: item-check ( node -- n )
+
+M: tree-node item-check
+    [ item>> ] [ left>> ] [ right>> ] tri [ item-check ] bi@ - + ;
+
+M: f item-check drop 0 ;
+
+: min-depth 4 ; inline
+
+: stretch-tree ( max-depth -- )
+    1 + 0 over bottom-up-tree item-check
+    [ "stretch tree of depth " write pprint ]
+    [ "\t check: " write . ] bi* ;
+
+:: long-lived-tree ( max-depth -- )
+    0 max-depth bottom-up-tree
+
+    min-depth max-depth 2 <range> [| depth |
+        max-depth depth - min-depth + 2^ [
+            [1,b] 0 [
+                dup neg
+                [ depth bottom-up-tree item-check + ] bi@
+            ] reduce
+        ]
+        [ 2 * ] bi
+        pprint "\t trees of depth " write depth pprint
+        "\t check: " write .
+    ] each
+
+    "long lived tree of depth " write max-depth pprint
+    "\t check: " write item-check . ;
+
+: binary-trees ( n -- )
+    min-depth 2 + max [ stretch-tree ] [ long-lived-tree ] bi ;
+
+: binary-trees-main ( -- )
+    16 binary-trees ;

extra/benchmark/spectral-norm/spectral-norm.factor

@@ -1,48 +1,44 @@
 ! Factor port of
 ! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
 USING: float-arrays kernel math math.functions math.vectors
-sequences sequences.private prettyprint words tools.time hints ;
+sequences sequences.private prettyprint words
+hints locals ;
 IN: benchmark.spectral-norm
 
-: fast-truncate >fixnum >float ; inline
+:: inner-loop ( u n quot -- seq )
+    n [| i |
+        n 0.0 [| j |
+            u i j quot call +
+        ] reduce
+    ] F{ } map-as ; inline
 
 : eval-A ( i j -- n )
     [ >float ] bi@
-    dupd + dup 1+ * 2 /f fast-truncate + 1+
+    [ drop ] [ + [ ] [ 1 + ] bi * 0.5 * ] 2bi
-    recip ; inline
+    + 1 + recip ; inline
 
 : (eval-A-times-u) ( u i j -- x )
-    tuck eval-A >r swap nth-unsafe r> * ; inline
+    tuck [ swap nth-unsafe ] [ eval-A ] 2bi* * ; inline
 
 : eval-A-times-u ( n u -- seq )
-    over [
+    [ (eval-A-times-u) ] inner-loop ; inline
-        pick 0.0 [
-            swap >r >r 2dup r> (eval-A-times-u) r> +
-        ] reduce nip
-    ] F{ } map-as { float-array } declare 2nip ; inline
 
 : (eval-At-times-u) ( u i j -- x )
-    tuck swap eval-A >r swap nth-unsafe r> * ; inline
+    tuck [ swap nth-unsafe ] [ swap eval-A ] 2bi* * ; inline
 
-: eval-At-times-u ( n u -- seq )
+: eval-At-times-u ( u n -- seq )
-    over [
+    [ (eval-At-times-u) ] inner-loop ; inline
-        pick 0.0 [
-            swap >r >r 2dup r> (eval-At-times-u) r> +
-        ] reduce nip
-    ] F{ } map-as { float-array } declare 2nip ; inline
 
-: eval-AtA-times-u ( n u -- seq )
+: eval-AtA-times-u ( u n -- seq )
-    dupd eval-A-times-u eval-At-times-u ; inline
+    [ eval-A-times-u ] [ eval-At-times-u ] bi ; inline
 
-: u/v ( n -- u v )
+:: u/v ( n -- u v )
-    dup 1.0 <float-array> dup
+    n 1.0 <float-array> dup
     10 [
         drop
-        dupd eval-AtA-times-u
+        n eval-AtA-times-u
-        2dup eval-AtA-times-u
+        [ n eval-AtA-times-u ] keep
-        swap
+    ] times ; inline
-    ] times
-    rot drop ; inline
 
 : spectral-norm ( n -- norm )
     u/v [ v. ] keep norm-sq /f sqrt ;
@@ -50,6 +46,6 @@ IN: benchmark.spectral-norm
 HINTS: spectral-norm fixnum ;
 
 : spectral-norm-main ( -- )
-    2000 spectral-norm . ;
+    5500 spectral-norm . ;
 
 MAIN: spectral-norm-main

extra/bit-vectors/bit-vectors.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel kernel.private math sequences
 sequences.private growable bit-arrays prettyprint.backend
-parser ;
+parser accessors ;
 IN: bit-vectors
 
 TUPLE: bit-vector underlying fill ;
@@ -44,7 +44,7 @@ M: bit-array new-resizable drop <bit-vector> ;
 
 INSTANCE: bit-vector growable
 
-: ?V \ } [ >bit-vector ] parse-literal ; parsing
+: ?V{ \ } [ >bit-vector ] parse-literal ; parsing
 
 M: bit-vector >pprint-sequence ;
 

extra/cocoa/messages/messages.factor

@@ -1,10 +1,10 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.compiler
+USING: alien alien.c-types alien.strings alien.compiler
 arrays assocs combinators compiler inference.transforms kernel
 math namespaces parser prettyprint prettyprint.sections
 quotations sequences strings words cocoa.runtime io macros
-memoize debugger ;
+memoize debugger io.encodings.ascii ;
 IN: cocoa.messages
 
 : make-sender ( method function -- quot )
@@ -104,7 +104,7 @@ MACRO: (send) ( selector super? -- quot )
 : method-arg-type ( method i -- type )
     f <void*> 0 <int> over
     >r method_getArgumentInfo drop
-    r> *char* ;
+    r> *void* ascii alien>string ;
 
 SYMBOL: objc>alien-types
 

extra/cocoa/subclassing/subclassing.factor

@@ -1,14 +1,15 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays assocs combinators compiler
+USING: alien alien.c-types alien.strings arrays assocs
-hashtables kernel libc math namespaces parser sequences words
+combinators compiler hashtables kernel libc math namespaces
-cocoa.messages cocoa.runtime compiler.units ;
+parser sequences words cocoa.messages cocoa.runtime
+compiler.units io.encodings.ascii ;
 IN: cocoa.subclassing
 
 : init-method ( method alien -- )
     >r first3 r>
     [ >r execute r> set-objc-method-imp ] keep
-    [ >r malloc-char-string r> set-objc-method-types ] keep
+    [ >r ascii malloc-string r> set-objc-method-types ] keep
     >r sel_registerName r> set-objc-method-name ;
 
 : <empty-method-list> ( n -- alien )
@@ -26,7 +27,7 @@ IN: cocoa.subclassing
 : <objc-class> ( name info -- class )
     "objc-class" malloc-object
     [ set-objc-class-info ] keep
-    [ >r malloc-char-string r> set-objc-class-name ] keep ;
+    [ >r ascii malloc-string r> set-objc-class-name ] keep ;
 
 : <protocol-list> ( name -- protocol-list )
     "objc-protocol-list" malloc-object

extra/core-foundation/core-foundation.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.syntax kernel math sequences ;
+USING: alien alien.c-types alien.strings alien.syntax kernel
+math sequences io.encodings.utf16 ;
 IN: core-foundation
 
 TYPEDEF: void* CFAllocatorRef
@@ -31,7 +32,7 @@ FUNCTION: CFURLRef CFURLCreateWithString ( CFAllocatorRef allocator, CFStringRef
 
 FUNCTION: CFURLRef CFURLCopyFileSystemPath ( CFURLRef url, int pathStyle ) ;
 
-FUNCTION: CFStringRef CFStringCreateWithCharacters ( CFAllocatorRef allocator, ushort* cStr, CFIndex numChars ) ;
+FUNCTION: CFStringRef CFStringCreateWithCharacters ( CFAllocatorRef allocator, wchar_t* cStr, CFIndex numChars ) ;
 
 FUNCTION: CFIndex CFStringGetLength ( CFStringRef theString ) ;
 
@@ -57,7 +58,7 @@ FUNCTION: void CFRelease ( void* cf ) ;
 : CF>string ( alien -- string )
     dup CFStringGetLength 1+ "ushort" <c-array> [
         >r 0 over CFStringGetLength r> CFStringGetCharacters
-    ] keep alien>u16-string ;
+    ] keep utf16n alien>string ;
 
 : CF>string-array ( alien -- seq )
     CF>array [ CF>string ] map ;

extra/core-foundation/fsevents/fsevents.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.syntax kernel math sequences
+USING: alien alien.c-types alien.strings alien.syntax kernel
-namespaces assocs init accessors continuations combinators
+math sequences namespaces assocs init accessors continuations
-core-foundation core-foundation.run-loop ;
+combinators core-foundation core-foundation.run-loop
+io.encodings.utf8 ;
 IN: core-foundation.fsevents
 
 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
@@ -165,7 +166,7 @@ SYMBOL: event-stream-callbacks
 : >event-triple ( n eventPaths eventFlags eventIds -- triple )
     [
         >r >r >r dup dup
-        r> char*-nth ,
+        r> void*-nth utf8 alien>string ,
         r> int-nth ,
         r> longlong-nth ,
     ] { } make ;

extra/float-vectors/float-vectors.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel kernel.private math sequences
 sequences.private growable float-arrays prettyprint.backend
-parser ;
+parser accessors ;
 IN: float-vectors
 
 TUPLE: float-vector underlying fill ;

extra/hardware-info/macosx/macosx.factor

@@ -1,6 +1,7 @@
-USING: alien alien.c-types alien.syntax byte-arrays kernel
+USING: alien alien.c-types alien.strings alien.syntax
-namespaces sequences unix hardware-info.backend system
+byte-arrays kernel namespaces sequences unix
-io.unix.backend ;
+hardware-info.backend system io.unix.backend io.encodings.ascii
+;
 IN: hardware-info.macosx
 
 ! See /usr/include/sys/sysctl.h for constants
@@ -19,7 +20,7 @@ FUNCTION: int sysctl ( int* name, uint namelen, void* oldp, size_t* oldlenp, voi
     [ <byte-array> ] [ <uint> ] bi (sysctl-query) ;
 
 : sysctl-query-string ( seq -- n )
-    4096 sysctl-query alien>char-string ;
+    4096 sysctl-query ascii malloc-string ;
 
 : sysctl-query-uint ( seq -- n )
     4 sysctl-query *uint ;

extra/hardware-info/windows/nt/nt.factor

@@ -1,4 +1,4 @@
-USING: alien alien.c-types
+USING: alien alien.c-types alien.strings
 kernel libc math namespaces hardware-info.backend
 windows windows.advapi32 windows.kernel32 system ;
 IN: hardware-info.windows.nt
@@ -35,12 +35,14 @@ M: winnt total-virtual-mem ( -- n )
 M: winnt available-virtual-mem ( -- n )
     memory-status MEMORYSTATUSEX-ullAvailVirtual ;
 
+: pull-win32-string [ utf16n alien>string ] keep free ;
+
 : computer-name ( -- string )
     MAX_COMPUTERNAME_LENGTH 1+ [ malloc ] keep
     <int> dupd GetComputerName zero? [
         free win32-error f
     ] [
-        [ alien>u16-string ] keep free
+        pull-win32-string
     ] if ;
  
 : username ( -- string )
@@ -48,5 +50,5 @@ M: winnt available-virtual-mem ( -- n )
     <int> dupd GetUserName zero? [
         free win32-error f
     ] [
-        [ alien>u16-string ] keep free
+        pull-win32-string
     ] if ;

extra/hardware-info/windows/windows.factor

@@ -36,7 +36,7 @@ IN: hardware-info.windows
     os-version OSVERSIONINFO-dwPlatformId ;
 
 : windows-service-pack ( -- string )
-    os-version OSVERSIONINFO-szCSDVersion alien>u16-string ;
+    os-version OSVERSIONINFO-szCSDVersion utf16n alien>string ;
 
 : feature-present? ( n -- ? )
     IsProcessorFeaturePresent zero? not ;
@@ -52,7 +52,7 @@ IN: hardware-info.windows
 
 : get-directory ( word -- str )
     >r MAX_UNICODE_PATH [ <u16-string-object> ] keep dupd r>
-    execute win32-error=0/f alien>u16-string ; inline
+    execute win32-error=0/f utf16n alien>string ; inline
 
 : windows-directory ( -- str )
     \ GetWindowsDirectory get-directory ;

extra/help/handbook/handbook.factor

@@ -163,7 +163,7 @@ ARTICLE: "collections" "Collections"
 { $subsection "buffers" } ;
 
 USING: io.sockets io.launcher io.mmap io.monitors
-io.encodings.utf8 io.encodings.binary io.encodings.ascii io.files ;
+io.encodings.utf8 io.encodings.utf16 io.encodings.binary io.encodings.ascii io.files ;
 
 ARTICLE: "encodings-introduction" "An introduction to encodings"
 "In order to express text in terms of binary, some sort of encoding has to be used. In a modern context, this is understood as a two-way mapping between Unicode code points (characters) and some amount of binary. Since English isn't the only language in the world, ASCII is not sufficient as a mapping from binary to Unicode; it can't even express em-dashes or curly quotes. Unicode was designed as a universal character set that could potentially represent everything." $nl

extra/http/server/boilerplate/boilerplate.factor

@@ -1,7 +1,8 @@
 ! Copyright (c) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel namespaces boxes sequences strings
-io io.streams.string
+io io.streams.string arrays
+html.elements
 http
 http.server
 http.server.templating ;
@@ -28,6 +29,18 @@ SYMBOL: style
 : write-style ( -- )
     style get >string write ;
 
+SYMBOL: atom-feed
+
+: set-atom-feed ( title url -- )
+    2array atom-feed get >box ;
+
+: write-atom-feed ( -- )
+    atom-feed get value>> [
+        <link "alternate" =rel "application/atom+xml" =type
+        [ first =title ] [ second =href ] bi
+        link/>
+    ] when* ;
+
 SYMBOL: nested-template?
 
 SYMBOL: next-template
@@ -40,6 +53,7 @@ M: f call-template drop call-next-template ;
 : with-boilerplate ( body template -- )
     [
         title get [ <box> title set ] unless
+        atom-feed get [ <box> atom-feed set ] unless
         style get [ SBUF" " clone style set ] unless
 
         [
@@ -54,5 +68,8 @@ M: f call-template drop call-next-template ;
     ] with-scope ; inline
 
 M: boilerplate call-responder
-    [ responder>> call-responder clone ] [ template>> ] bi
+    tuck responder>> call-responder
-    [ [ with-boilerplate ] 2curry ] curry change-body ;
+    dup "content-type" header "text/html" = [
+        clone swap template>>
+        [ [ with-boilerplate ] 2curry ] curry change-body
+    ] [ nip ] if ;

extra/http/server/components/components-tests.factor

@@ -129,3 +129,5 @@ TUPLE: test-tuple text number more-text ;
 [ t ] [ "wake up sheeple" dup "n" <text> validate = ] unit-test
 
 [ ] [ "password" <password> "p" set ] unit-test
+
+[ ] [ "pub-date" <date> "d" set ] unit-test

extra/http/server/components/components.factor

@@ -1,9 +1,10 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: html.elements http.server.validators accessors namespaces
+USING: accessors namespaces kernel io math.parser assocs classes
-kernel io math.parser assocs classes words classes.tuple arrays
+words classes.tuple arrays sequences splitting mirrors
-sequences splitting mirrors hashtables fry combinators
+hashtables fry combinators continuations math
-continuations math ;
+calendar.format html.elements
+http.server.validators ;
 IN: http.server.components
 
 ! Renderer protocol
@@ -59,9 +60,14 @@ SYMBOL: values
 
 : values-tuple values get mirror-object ;
 
+: render-view-or-summary ( component -- value renderer )
+    [ id>> value ] [ component-string ] [ renderer>> ] tri ;
+
 : render-view ( component -- )
-    [ id>> value ] [ component-string ] [ renderer>> ] tri
+    render-view-or-summary render-view* ;
-    render-view* ;
+
+: render-summary ( component -- )
+    render-view-or-summary render-summary* ;
 
 <PRIVATE
 
@@ -147,6 +153,17 @@ TUPLE: email < string ;
 M: email validate*
     call-next-method dup empty? [ v-email ] unless ;
 
+! URL fields
+TUPLE: url < string ;
+
+: <url> ( id -- component )
+    url new-string
+        5 >>min-length
+        60 >>max-length ;
+
+M: url validate*
+    call-next-method dup empty? [ v-url ] unless ;
+
 ! Don't send passwords back to the user
 TUPLE: password-renderer < field ;
 
@@ -206,20 +223,20 @@ M: captcha validate*
     drop v-captcha ;
 
 ! Text areas
-TUPLE: textarea-renderer rows cols ;
+TUPLE: text-renderer rows cols ;
 
-: new-textarea-renderer ( class -- renderer )
+: new-text-renderer ( class -- renderer )
     new
         60 >>cols
         20 >>rows ;
 
-: <textarea-renderer> ( -- renderer )
+: <text-renderer> ( -- renderer )
-    textarea-renderer new-textarea-renderer ;
+    text-renderer new-text-renderer ;
 
-M: textarea-renderer render-view*
+M: text-renderer render-view*
     drop write ;
 
-M: textarea-renderer render-edit*
+M: text-renderer render-edit*
     <textarea
         [ rows>> [ number>string =rows ] when* ]
         [ cols>> [ number>string =cols ] when* ] bi
@@ -234,11 +251,35 @@ TUPLE: text < string ;
 : new-text ( id class -- component )
     new-string
         f >>one-line
-        <textarea-renderer> >>renderer ;
+        <text-renderer> >>renderer ;
 
 : <text> ( id -- component )
     text new-text ;
 
+! HTML text component
+TUPLE: html-text-renderer < text-renderer ;
+
+: <html-text-renderer> ( -- renderer )
+    html-text-renderer new-text-renderer ;
+
+M: html-text-renderer render-view*
+    drop write ;
+
+TUPLE: html-text < text ;
+
+: <html-text> ( id -- component )
+    html-text new-text
+        <html-text-renderer> >>renderer ;
+
+! Date component
+TUPLE: date < string ;
+
+: <date> ( id -- component )
+    date new-string ;
+
+M: date component-string
+    drop timestamp>string ;
+
 ! List components
 SYMBOL: +plain+
 SYMBOL: +ordered+
@@ -248,21 +289,27 @@ TUPLE: list-renderer component type ;
 
 C: <list-renderer> list-renderer
 
-: render-list ( value component -- )
+: render-plain-list ( seq quot component -- )
-    [ render-summary* ] curry each ;
+    swap '[ , @ ] each ; inline
 
-: render-ordered-list ( value component -- )
+: render-ordered-list ( seq quot component -- )
-    [ <li> render-summary* </li> ] curry each ;
+    swap <ol> '[ <li> , @ </li> ] each </ol> ; inline
 
-: render-unordered-list ( value component -- )
+: render-unordered-list ( seq quot component -- )
-    [ <li> render-summary* </li> ] curry each ;
+    swap <ul> '[ <li> , @ </li> ] each </ul> ; inline
+
+: render-list ( value renderer quot -- )
+    swap [ component>> ] [ type>> ] bi {
+        { +plain+     [ render-plain-list ] }
+        { +ordered+   [ render-ordered-list ] }
+        { +unordered+ [ render-unordered-list ] }
+    } case ; inline
 
 M: list-renderer render-view*
-    [ component>> ] [ type>> ] bi {
+    [ render-view* ] render-list ;
-        { +plain+ [ render-list ] }
+
-        { +ordered+ [ <ol> render-ordered-list </ol> ] }
+M: list-renderer render-summary*
-        { +unordered+ [ <ul> render-unordered-list </ul> ] }
+    [ render-summary* ] render-list ;
-    } case ;
 
 TUPLE: list < component ;
 

extra/http/server/components/farkup/farkup.factor

@@ -4,10 +4,10 @@ USING: splitting kernel io sequences farkup accessors
 http.server.components ;
 IN: http.server.components.farkup
 
-TUPLE: farkup-renderer < textarea-renderer ;
+TUPLE: farkup-renderer < text-renderer ;
 
-: <farkup-renderer>
+: <farkup-renderer> ( -- renderer )
-    farkup-renderer new-textarea-renderer ;
+    farkup-renderer new-text-renderer ;
 
 M: farkup-renderer render-view*
     drop string-lines "\n" join convert-farkup write ;

extra/http/server/forms/forms.factor

@@ -15,7 +15,8 @@ components ;
 M: form init V{ } clone >>components ;
 
 : <form> ( id -- form )
-    form f new-component ;
+    form f new-component
+        dup >>renderer ;
 
 : add-field ( form component -- form )
     dup id>> pick components>> set-at ;
@@ -68,6 +69,8 @@ M: form init V{ } clone >>components ;
         tri*
     ] with-scope ;
 
+M: form component-string drop ;
+
 M: form render-summary*
     dup summary-template>> render-form ;
 

extra/http/server/templating/chloe/chloe.factor

@@ -1,6 +1,6 @@
 USING: accessors kernel sequences combinators kernel namespaces
 classes.tuple assocs splitting words arrays
-io.files io.encodings.utf8 html.elements unicode.case
+io io.files io.encodings.utf8 html.elements unicode.case
 tuple-syntax xml xml.data xml.writer xml.utilities
 http.server
 http.server.auth
@@ -54,6 +54,19 @@ SYMBOL: tags
 : write-style-tag ( tag -- )
     drop <style> write-style </style> ;
 
+: atom-tag ( tag -- )
+    [ "title" required-attr ]
+    [ "href" required-attr ]
+    bi set-atom-feed ;
+
+: write-atom-tag ( tag -- )
+    drop
+    "head" tags get member? [
+        write-atom-feed
+    ] [
+        atom-feed get value>> second write
+    ] if ;
+
 : component-attr ( tag -- name )
     "component" required-attr ;
 
@@ -63,15 +76,20 @@ SYMBOL: tags
 : edit-tag ( tag -- )
     component-attr component render-edit ;
 
+: summary-tag ( tag -- )
+    component-attr component render-summary ;
+
 : parse-query-attr ( string -- assoc )
     dup empty?
     [ drop f ] [ "," split [ dup value ] H{ } map>assoc ] if ;
 
 : a-start-tag ( tag -- )
     <a
-    [ "href" required-attr ]
+    dup "value" optional-attr [ value f ] [
-    [ "query" optional-attr parse-query-attr ]
+        [ "href" required-attr ]
-    bi link>string =href
+        [ "query" optional-attr parse-query-attr ]
+        bi
+    ] ?if link>string =href
     a> ;
 
 : process-tag-children ( tag -- )
@@ -126,8 +144,11 @@ SYMBOL: tags
         { "write-title" [ write-title-tag ] }
         { "style" [ style-tag ] }
         { "write-style" [ write-style-tag ] }
+        { "atom" [ atom-tag ] }
+        { "write-atom" [ write-atom-tag ] }
         { "view" [ view-tag ] }
         { "edit" [ edit-tag ] }
+        { "summary" [ summary-tag ] }
         { "a" [ a-tag ] }
         { "form" [ form-tag ] }
         { "error" [ error-tag ] }

extra/http/server/validators/validators-tests.factor

@@ -21,3 +21,9 @@ accessors ;
 
 [ "slava@factorcodeorg" v-email ]
 [ "invalid e-mail" = ] must-fail-with
+
+[ "http://www.factorcode.org" ]
+[ "http://www.factorcode.org" v-url ] unit-test
+
+[ "http:/www.factorcode.org" v-url ]
+[ "invalid URL" = ] must-fail-with

extra/http/server/validators/validators.factor

@@ -65,7 +65,12 @@ C: <validation-error> validation-error
 : v-email ( str -- str )
     #! From http://www.regular-expressions.info/email.html
     "e-mail"
-    R/ [A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}/i
+    R' [A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}'i
+    v-regexp ;
+
+: v-url ( str -- str )
+    "URL"
+    R' (ftp|http|https)://(\w+:?\w*@)?(\S+)(:[0-9]+)?(/|/([\w#!:.?+=&%@!\-/]))?'
     v-regexp ;
 
 : v-captcha ( str -- str )

extra/io/sockets/impl/impl.factor

@@ -1,8 +1,9 @@
-! Copyright (C) 2007 Doug Coleman, Slava Pestov
+! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays byte-arrays io.backend io.binary io.sockets
-kernel math math.parser sequences splitting system
+io.encodings.ascii kernel math math.parser sequences splitting
-alien.c-types combinators namespaces alien parser ;
+system alien.c-types alien.strings alien combinators namespaces
+parser ;
 IN: io.sockets.impl
 
 << {
@@ -130,4 +131,4 @@ M: object resolve-host ( host serv passive? -- seq )
 M: object host-name ( -- name )
     256 <byte-array> dup dup length gethostname
     zero? [ "gethostname failed" throw ] unless
-    alien>char-string ;
+    ascii alien>string ;

extra/io/unix/linux/monitors/monitors.factor

@@ -2,9 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel io.backend io.monitors io.monitors.recursive
 io.files io.buffers io.monitors io.nonblocking io.timeouts
-io.unix.backend io.unix.select unix.linux.inotify assocs
+io.unix.backend io.unix.select io.encodings.utf8
-namespaces threads continuations init math math.bitfields sets
+unix.linux.inotify assocs namespaces threads continuations init
-alien.c-types alien vocabs.loader accessors system hashtables ;
+math math.bitfields sets alien alien.strings alien.c-types
+vocabs.loader accessors system hashtables ;
 IN: io.unix.linux.monitors
 
 TUPLE: linux-monitor < monitor wd ;
@@ -79,7 +80,7 @@ M: linux-monitor dispose ( monitor -- )
     dup inotify-event-mask ignore-flags? [
         drop f f
     ] [
-        [ inotify-event-name alien>char-string ]
+        [ inotify-event-name utf8 alien>string ]
         [ inotify-event-mask parse-action ] bi
     ] if ;
 

extra/io/unix/sockets/sockets.factor

@@ -1,13 +1,15 @@
 ! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov. 
 ! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types alien.strings generic kernel math
+namespaces threads sequences byte-arrays io.nonblocking
+io.binary io.unix.backend io.streams.duplex io.sockets.impl
+io.backend io.files io.files.private io.encodings.utf8
+math.parser continuations libc combinators system accessors
+qualified unix ;
+
+EXCLUDE: io => read write close ;
+EXCLUDE: io.sockets => accept ;
 
-! We need to fiddle with the exact search order here, since
-! unix::accept shadows streams::accept.
-USING: alien alien.c-types generic io kernel math namespaces
-io.nonblocking parser threads unix sequences
-byte-arrays io.sockets io.binary io.unix.backend
-io.streams.duplex io.sockets.impl math.parser continuations libc
-combinators io.backend io.files io.files.private system accessors ;
 IN: io.unix.sockets
 
 : pending-init-error ( port -- )
@@ -36,7 +38,7 @@ TUPLE: connect-task < output-task ;
     connect-task <io-task> ;
 
 M: connect-task do-io-task
-    io-task-port dup port-handle f 0 write
+    port>> dup handle>> f 0 write
     0 < [ defer-error ] [ drop t ] if ;
 
 : wait-to-connect ( port -- )
@@ -56,8 +58,6 @@ M: unix ((client)) ( addrspec -- client-in client-out )
     ] if ;
 
 ! Server sockets - TCP and Unix domain
-USE: unix
-
 : init-server-socket ( fd -- )
     SOL_SOCKET SO_REUSEADDR sockopt ;
 
@@ -83,8 +83,6 @@ M: accept-task do-io-task
 : wait-to-accept ( server -- )
     [ <accept-task> add-io-task ] with-port-continuation drop ;
 
-USE: io.sockets
-
 : server-fd ( addrspec type -- fd )
     >r dup protocol-family r>  socket-fd
     dup init-server-socket
@@ -187,12 +185,12 @@ M: local protocol-family drop PF_UNIX ;
 M: local sockaddr-type drop "sockaddr-un" c-type ;
 
 M: local make-sockaddr
-    local-path cwd prepend-path
+    path>> (normalize-path)
     dup length 1 + max-un-path > [ "Path too long" throw ] when
     "sockaddr-un" <c-object>
     AF_UNIX over set-sockaddr-un-family
-    dup sockaddr-un-path rot string>char-alien dup length memcpy ;
+    dup sockaddr-un-path rot utf8 string>alien dup length memcpy ;
 
 M: local parse-sockaddr
     drop
-    sockaddr-un-path alien>char-string <local> ;
+    sockaddr-un-path utf8 alien>string <local> ;

extra/io/windows/nt/files/files.factor

@@ -9,7 +9,7 @@ IN: io.windows.nt.files
 M: winnt cwd
     MAX_UNICODE_PATH dup "ushort" <c-array>
     [ GetCurrentDirectory win32-error=0/f ] keep
-    alien>u16-string ;
+    utf16n alien>string ;
 
 M: winnt cd
     SetCurrentDirectory win32-error=0/f ;

extra/locals/backend/backend.factor

@@ -35,3 +35,8 @@ IN: locals.backend
     [ infer-r> ]
     [ { } <effect> infer-shuffle ] bi
 ] "infer" set-word-prop
+
+<<
+{ load-locals get-local drop-locals }
+[ t "no-compile" set-word-prop ] each
+>>

extra/math/ranges/ranges.factor

@@ -1,4 +1,5 @@
-USING: kernel layouts math namespaces sequences sequences.private ;
+USING: kernel layouts math namespaces sequences
+sequences.private accessors ;
 IN: math.ranges
 
 TUPLE: range from length step ;
@@ -9,10 +10,10 @@ TUPLE: range from length step ;
     range boa ;
 
 M: range length ( seq -- n )
-    range-length ;
+    length>> ;
 
 M: range nth-unsafe ( n range -- obj )
-    [ range-step * ] keep range-from + ;
+    [ step>> * ] keep from>> + ;
 
 INSTANCE: range immutable-sequence
 
@@ -37,10 +38,10 @@ INSTANCE: range immutable-sequence
 : [0,b) ( b -- range ) 0 swap [a,b) ;
 
 : range-increasing? ( range -- ? )
-    range-step 0 > ;
+    step>> 0 > ;
 
 : range-decreasing? ( range -- ? )
-    range-step 0 < ;
+    step>> 0 < ;
 
 : first-or-peek ( seq head? -- elt )
     [ first ] [ peek ] if ;
@@ -52,7 +53,7 @@ INSTANCE: range immutable-sequence
     dup range-decreasing? first-or-peek ;
 
 : clamp-to-range ( n range -- n )
-    tuck range-min max swap range-max min ;
+    [ range-min max ] [ range-max min ] bi ;
 
 : sequence-index-range  ( seq -- range )
     length [0,b) ;

extra/odbc/odbc.factor

@@ -1,10 +1,11 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel alien alien.syntax combinators alien.c-types
+USING: kernel alien alien.strings alien.syntax combinators
-       strings sequences namespaces words math threads ;
+alien.c-types strings sequences namespaces words math threads
+io.encodings.ascii ;
 IN: odbc
 
-"odbc" "odbc32.dll" "stdcall" add-library
+<< "odbc" "odbc32.dll" "stdcall" add-library >>
 
 LIBRARY: odbc
 
@@ -150,7 +151,7 @@ FUNCTION: SQLRETURN SQLGetData ( SQLHSTMT statementHandle, SQLUSMALLINT columnNu
   SQL-HANDLE-STMT swap alloc-handle ;
 
 : temp-string ( length -- byte-array length )
-  [ CHAR: \space  <string> string>char-alien ] keep ;
+  [ CHAR: \space  <string> ascii string>alien ] keep ;
 
 : odbc-init ( -- env )
   alloc-env-handle
@@ -192,7 +193,7 @@ C: <column> column
 
 : odbc-describe-column ( statement n -- column )
   dup >r
-  1024 CHAR: \space <string> string>char-alien dup >r
+  1024 CHAR: \space <string> ascii string>alien dup >r
   1024
   0 <short>
   0 <short> dup >r
@@ -204,7 +205,7 @@ C: <column> column
     r> *short
     r> *uint
     r> *short convert-sql-type
-    r> alien>char-string
+    r> ascii alien>string
     r> <column>
   ] [
     r> drop r> drop r> drop r> drop r> drop r> drop
@@ -213,12 +214,12 @@ C: <column> column
 
 : dereference-type-pointer ( byte-array column -- object )
   column-type {
-    { SQL-CHAR [ alien>char-string ] }
+    { SQL-CHAR [ ascii alien>string ] }
-    { SQL-VARCHAR [ alien>char-string ] }
+    { SQL-VARCHAR [ ascii alien>string ] }
-    { SQL-LONGVARCHAR [ alien>char-string ] }
+    { SQL-LONGVARCHAR [ ascii alien>string ] }
-    { SQL-WCHAR [ alien>char-string ] }
+    { SQL-WCHAR [ ascii alien>string ] }
-    { SQL-WCHARVAR [ alien>char-string ] }
+    { SQL-WCHARVAR [ ascii alien>string ] }
-    { SQL-WLONGCHARVAR [ alien>char-string ] }
+    { SQL-WLONGCHARVAR [ ascii alien>string ] }
     { SQL-SMALLINT [ *short ] }
     { SQL-INTEGER [ *long ] }
     { SQL-REAL [ *float ] }
@@ -236,7 +237,7 @@ C: <field> field
 : odbc-get-field ( statement column -- field )
   dup column? [ dupd odbc-describe-column ] unless dup >r column-number
   SQL-C-DEFAULT
-  8192 CHAR: \space <string> string>char-alien dup >r
+  8192 CHAR: \space <string> ascii string>alien dup >r
   8192
   f SQLGetData succeeded? [
     r> r> [ dereference-type-pointer ] keep <field>

extra/opengl/shaders/shaders.factor

@@ -1,14 +1,12 @@
 ! Copyright (C) 2008 Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel opengl.gl alien.c-types continuations namespaces
-assocs alien libc opengl math sequences combinators
+assocs alien alien.strings libc opengl math sequences combinators
-combinators.lib macros arrays ;
+combinators.lib macros arrays io.encodings.ascii ;
 IN: opengl.shaders
 
 : with-gl-shader-source-ptr ( string quot -- )
-    swap string>char-alien malloc-byte-array [
+    swap ascii malloc-string [ <void*> swap call ] keep free ; inline
-        <void*> swap call
-    ] keep free ; inline
 
 : <gl-shader> ( source kind -- shader )
     glCreateShader dup rot
@@ -47,7 +45,7 @@ IN: opengl.shaders
 : gl-shader-info-log ( shader -- log )
     dup gl-shader-info-log-length dup [
         [ 0 <int> swap glGetShaderInfoLog ] keep
-        alien>char-string
+        ascii alien>string
     ] with-malloc ;
 
 : check-gl-shader ( shader -- shader )
@@ -82,7 +80,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
 : gl-program-info-log ( program -- log )
     dup gl-program-info-log-length dup [
         [ 0 <int> swap glGetProgramInfoLog ] keep
-        alien>char-string
+        ascii alien>string
     ] with-malloc ;
 
 : check-gl-program ( program -- program )

extra/openssl/openssl-tests.factor

@@ -1,6 +1,7 @@
-USING: alien alien.c-types assocs bit-arrays hashtables io io.files
+USING: alien alien.c-types alien.strings assocs bit-arrays
-io.sockets kernel mirrors openssl.libcrypto openssl.libssl
+hashtables io io.files io.encodings.ascii io.sockets kernel
-namespaces math math.parser openssl prettyprint sequences tools.test ;
+mirrors openssl.libcrypto openssl.libssl namespaces math
+math.parser openssl prettyprint sequences tools.test ;
 
 ! =========================================================
 ! Some crypto functions (still to be turned into words)
@@ -31,7 +32,7 @@ namespaces math math.parser openssl prettyprint sequences tools.test ;
 ! TODO: debug 'Memory protection fault at address 6c'
 ! get-ctx 1024 "char" malloc-array 1024 0 f password-cb set-default-passwd
 
-[ ] [ get-ctx "password" string>char-alien set-default-passwd-userdata ] unit-test
+[ ] [ get-ctx "password" ascii string>alien set-default-passwd-userdata ] unit-test
 
 ! Enter PEM pass phrase: password
 [ ] [ get-ctx "extra/openssl/test/server.pem" resource-path

extra/openssl/openssl.factor

@@ -3,8 +3,9 @@
 !
 ! Tested with OpenSSL 0.9.8a_0 on Mac OS X 10.4.9 PowerPC
 
-USING: alien alien.c-types assocs kernel libc namespaces
+USING: alien alien.c-types alien.strings assocs kernel libc
-openssl.libcrypto openssl.libssl sequences ;
+namespaces openssl.libcrypto openssl.libssl sequences
+io.encodings.ascii ;
 
 IN: openssl
 
@@ -21,7 +22,7 @@ SYMBOL: rsa
 
 : password-cb ( -- alien )
     "int" { "char*" "int" "int" "void*" } "cdecl"
-    [ 3drop "password" string>char-alien 1023 memcpy
+    [ 3drop "password" ascii string>alien 1023 memcpy
     "password" length ] alien-callback ;
 
 ! =========================================================

extra/oracle/oracle.factor

@@ -4,8 +4,9 @@
 ! Adapted from oci.h and ociap.h
 ! Tested with Oracle version - 10.1.0.3 Instant Client
 
-USING: alien alien.c-types combinators kernel math namespaces oracle.liboci
+USING: alien alien.c-types alien.strings combinators kernel math
-prettyprint sequences ;
+namespaces oracle.liboci prettyprint sequences
+io.encodings.ascii ;
 
 IN: oracle
 
@@ -31,7 +32,7 @@ C: <connection> connection
 : get-oci-error ( object -- * )
     1 f "uint*" <c-object> dup >r 512 "uchar" <c-array> dup >r
     512 OCI_HTYPE_ERROR OCIErrorGet r> r> *uint drop
-    alien>char-string throw ;
+    ascii alien>string throw ;
 
 : check-result ( result -- )
     {
@@ -101,9 +102,9 @@ C: <connection> connection
 
 : oci-log-on ( -- )
     env get err get svc get 
-    con get connection-username dup length swap malloc-char-string swap 
+    con get connection-username dup length swap ascii malloc-string swap 
-    con get connection-password dup length swap malloc-char-string swap
+    con get connection-password dup length swap ascii malloc-string swap
-    con get connection-db dup length swap malloc-char-string swap
+    con get connection-db dup length swap ascii malloc-string swap
     OCILogon check-result ;
 
 ! =========================================================
@@ -118,11 +119,11 @@ C: <connection> connection
     svc get OCI_HTYPE_SVCCTX srv get 0 OCI_ATTR_SERVER err get OCIAttrSet check-result ;
 
 : set-username-attribute ( -- )
-    ses get OCI_HTYPE_SESSION con get connection-username dup length swap malloc-char-string swap 
+    ses get OCI_HTYPE_SESSION con get connection-username dup length swap ascii malloc-string swap 
     OCI_ATTR_USERNAME err get OCIAttrSet check-result ;
 
 : set-password-attribute ( -- )
-    ses get OCI_HTYPE_SESSION con get connection-password dup length swap malloc-char-string swap 
+    ses get OCI_HTYPE_SESSION con get connection-password dup length swap ascii malloc-string swap 
     OCI_ATTR_PASSWORD err get OCIAttrSet check-result ;
 
 : set-attributes ( -- )
@@ -150,7 +151,7 @@ C: <connection> connection
     check-result *void* stm set ;
 
 : prepare-statement ( statement -- )
-    >r stm get err get r> dup length swap malloc-char-string swap
+    >r stm get err get r> dup length swap ascii malloc-string swap
     OCI_NTV_SYNTAX OCI_DEFAULT OCIStmtPrepare check-result ;
 
 : calculate-size ( type -- size )
@@ -222,7 +223,7 @@ C: <connection> connection
 
 : server-version ( -- )
     srv get err get 512 "uchar" malloc-array dup >r 512 OCI_HTYPE_SERVER
-    OCIServerVersion check-result r> alien>char-string . ;
+    OCIServerVersion check-result r> ascii alien>string . ;
 
 ! =========================================================
 ! Public routines
@@ -236,13 +237,13 @@ C: <connection> connection
 
 : fetch-each ( object -- object )
     fetch-statement [
-        buf get alien>char-string res get swap suffix res set
+        buf get ascii alien>string res get swap suffix res set
         fetch-each
     ] [ ] if ;
 
 : run-query ( object -- object )
     execute-statement [
-        buf get alien>char-string res get swap suffix res set
+        buf get ascii alien>string res get swap suffix res set
         fetch-each
     ] [ ] if ;
 

extra/ui/gadgets/scrollers/scrollers.factor

@@ -1,10 +1,9 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays ui.gadgets
+USING: accessors arrays ui.gadgets ui.gadgets.viewports
-ui.gadgets.viewports ui.gadgets.frames ui.gadgets.grids
+ui.gadgets.frames ui.gadgets.grids ui.gadgets.theme
-ui.gadgets.theme ui.gadgets.sliders ui.gestures kernel math
+ui.gadgets.sliders ui.gestures kernel math namespaces sequences
-namespaces sequences models combinators math.vectors
+models combinators math.vectors classes.tuple ;
-classes.tuple ;
 IN: ui.gadgets.scrollers
 
 TUPLE: scroller viewport x y follows ;
@@ -133,3 +132,13 @@ M: scroller focusable-child*
 
 M: scroller model-changed
     nip f swap set-scroller-follows ;
+
+TUPLE: limited-scroller dim ;
+
+: <limited-scroller> ( gadget -- scroller )
+    <scroller>
+    limited-scroller new
+    [ set-gadget-delegate ] keep ;
+
+M: limited-scroller pref-dim*
+    dim>> ;

extra/ui/gadgets/worlds/worlds.factor

@@ -48,9 +48,6 @@ M: world request-focus-on ( child gadget -- )
 
 M: world hashcode* drop world hashcode* ;
 
-M: world pref-dim*
-    delegate pref-dim* [ >fixnum ] map { 1024 768 } vmin ;
-
 M: world layout*
     dup delegate layout*
     dup world-glass [

extra/ui/tools/listener/listener.factor

@@ -24,19 +24,10 @@ TUPLE: listener-gadget input output stack ;
 : <listener-input> ( listener -- gadget )
     listener-gadget-output <pane-stream> <interactor> ;
 
-TUPLE: input-scroller ;
-
-: <input-scroller> ( interactor -- scroller )
-    <scroller>
-    input-scroller new
-    [ set-gadget-delegate ] keep ;
-
-M: input-scroller pref-dim*
-    drop { 0 100 } ;
-
 : listener-input, ( -- )
     g <listener-input> g-> set-listener-gadget-input
-    <input-scroller> "Input" <labelled-gadget> f track, ;
+    <limited-scroller> { 0 100 } >>dim
+    "Input" <labelled-gadget> f track, ;
 
 : welcome. ( -- )
    "If this is your first time with Factor, please read the " print

extra/ui/tools/workspace/workspace.factor

@@ -5,7 +5,7 @@ sequences ui ui.backend ui.tools.debugger ui.gadgets
 ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
 ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks
 ui.gadgets.worlds ui.gadgets.presentations ui.gadgets.status-bar
-ui.commands ui.gestures assocs arrays namespaces ;
+ui.commands ui.gestures assocs arrays namespaces accessors ;
 IN: ui.tools.workspace
 
 TUPLE: workspace book listener popup ;
@@ -49,7 +49,10 @@ M: gadget tool-scroller drop f ;
     get-workspace find-tool nip ;
 
 : help-window ( topic -- )
-    [ <pane> [ [ help ] with-pane ] keep <scroller> ] keep
+    [
+        <pane> [ [ help ] with-pane ] keep
+        <limited-scroller> { 550 700 } >>dim
+    ] keep
     article-title open-window ;
 
 : hide-popup ( workspace -- )

extra/ui/windows/windows.factor

@@ -1,13 +1,14 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
+! Portions copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays assocs ui ui.gadgets
+USING: alien alien.c-types alien.strings arrays assocs ui
-ui.backend ui.clipboards ui.gadgets.worlds ui.gestures io kernel
+ui.gadgets ui.backend ui.clipboards ui.gadgets.worlds
-math math.vectors namespaces prettyprint sequences strings
+ui.gestures io kernel math math.vectors namespaces prettyprint
-vectors words windows.kernel32 windows.gdi32 windows.user32
+sequences strings vectors words windows.kernel32 windows.gdi32
-windows.opengl32 windows.messages windows.types windows.nt
+windows.user32 windows.opengl32 windows.messages windows.types
-windows threads libc combinators continuations command-line
+windows.nt windows threads libc combinators continuations
-shuffle opengl ui.render unicode.case ascii math.bitfields
+command-line shuffle opengl ui.render unicode.case ascii
-locals symbols accessors ;
+math.bitfields locals symbols accessors ;
 IN: ui.windows
 
 SINGLETON: windows-ui-backend
@@ -36,14 +37,14 @@ SINGLETON: windows-ui-backend
             CF_UNICODETEXT GetClipboardData dup win32-error=0/f
             dup GlobalLock dup win32-error=0/f
             GlobalUnlock win32-error=0/f
-            alien>u16-string
+            utf16n alien>string
         ] if
     ] with-clipboard
     crlf>lf ;
 
 : copy ( str -- )
     lf>crlf [
-        string>u16-alien
+        utf16n string>alien
         EmptyClipboard win32-error=0/f
         GMEM_MOVEABLE over length 1+ GlobalAlloc
             dup win32-error=0/f
@@ -409,7 +410,7 @@ SYMBOL: trace-messages?
         0 over set-WNDCLASSEX-cbClsExtra
         0 over set-WNDCLASSEX-cbWndExtra
         f GetModuleHandle over set-WNDCLASSEX-hInstance
-        f GetModuleHandle "fraptor" string>u16-alien LoadIcon
+        f GetModuleHandle "fraptor" utf16n string>alien LoadIcon
         over set-WNDCLASSEX-hIcon
         f IDC_ARROW LoadCursor over set-WNDCLASSEX-hCursor
 
@@ -447,7 +448,7 @@ SYMBOL: trace-messages?
 : init-win32-ui ( -- )
     V{ } clone nc-buttons set-global
     "MSG" malloc-object msg-obj set-global
-    "Factor-window" malloc-u16-string class-name-ptr set-global
+    "Factor-window" utf16n malloc-string class-name-ptr set-global
     register-wndclassex drop
     GetDoubleClickTime double-click-timeout set-global ;
 
@@ -492,7 +493,7 @@ M: windows-ui-backend raise-window* ( world -- )
 M: windows-ui-backend set-title ( string world -- )
     world-handle
     dup win-title [ free ] when*
-    >r malloc-u16-string r>
+    >r utf16n malloc-string r>
     2dup set-win-title
     win-hWnd WM_SETTEXT 0 roll alien-address SendMessage drop ;
 

extra/ui/x11/x11.factor

@@ -1,11 +1,12 @@
 ! Copyright (C) 2005, 2007 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays ui ui.gadgets ui.gestures
-ui.backend ui.clipboards ui.gadgets.worlds assocs kernel math
+ui.backend ui.clipboards ui.gadgets.worlds ui.render assocs
-namespaces opengl sequences strings x11.xlib x11.events x11.xim
+kernel math namespaces opengl sequences strings x11.xlib
-x11.glx x11.clipboard x11.constants x11.windows io.encodings.string
+x11.events x11.xim x11.glx x11.clipboard x11.constants
+x11.windows io.encodings.string io.encodings.ascii
 io.encodings.utf8 combinators debugger command-line qualified
-ui.render math.vectors classes.tuple opengl.gl threads ;
+math.vectors classes.tuple opengl.gl threads ;
 QUALIFIED: system
 IN: ui.x11
 
@@ -137,8 +138,8 @@ M: world selection-notify-event
     } cond ;
 
 : encode-clipboard ( string type -- bytes )
-    XSelectionRequestEvent-target XA_UTF8_STRING =
+    XSelectionRequestEvent-target
-    [ utf8 encode ] [ string>char-alien ] if ;
+    XA_UTF8_STRING = utf8 ascii ? encode ;
 
 : set-selection-prop ( evt -- )
     dpy get swap

extra/unix/linux/ifreq/ifreq.factor

@@ -10,7 +10,7 @@ IN: unix.linux.ifreq
 
 : set-if-addr ( name addr -- )
   "struct-ifreq" <c-object>
-  rot  string>char-alien        over set-struct-ifreq-ifr-ifrn
+  rot  ascii string>alien       over set-struct-ifreq-ifr-ifrn
   swap 0 <inet4> make-sockaddr  over set-struct-ifreq-ifr-ifru
 
   AF_INET SOCK_DGRAM 0 socket SIOCSIFADDR rot ioctl drop ;
@@ -19,7 +19,7 @@ IN: unix.linux.ifreq
 
 : set-if-flags ( name flags -- )
   "struct-ifreq" <c-object>
-  rot  string>char-alien over set-struct-ifreq-ifr-ifrn
+  rot  ascii string>alien over set-struct-ifreq-ifr-ifrn
   swap <short>		 over set-struct-ifreq-ifr-ifru
 
   AF_INET SOCK_DGRAM 0 socket SIOCSIFFLAGS rot ioctl drop ;
@@ -28,7 +28,7 @@ IN: unix.linux.ifreq
 
 : set-if-dst-addr ( name addr -- )
   "struct-ifreq" <c-object>
-  rot  string>char-alien        over set-struct-ifreq-ifr-ifrn
+  rot  ascii string>alien       over set-struct-ifreq-ifr-ifrn
   swap 0 <inet4> make-sockaddr  over set-struct-ifreq-ifr-ifru
 
   AF_INET SOCK_DGRAM 0 socket SIOCSIFDSTADDR rot ioctl drop ;
@@ -37,7 +37,7 @@ IN: unix.linux.ifreq
 
 : set-if-brd-addr ( name addr -- )
   "struct-ifreq" <c-object>
-  rot  string>char-alien        over set-struct-ifreq-ifr-ifrn
+  rot  ascii string>alien       over set-struct-ifreq-ifr-ifrn
   swap 0 <inet4> make-sockaddr  over set-struct-ifreq-ifr-ifru
 
   AF_INET SOCK_DGRAM 0 socket SIOCSIFBRDADDR rot ioctl drop ;
@@ -46,7 +46,7 @@ IN: unix.linux.ifreq
 
 : set-if-netmask ( name addr -- )
   "struct-ifreq" <c-object>
-  rot  string>char-alien        over set-struct-ifreq-ifr-ifrn
+  rot  ascii string>alien       over set-struct-ifreq-ifr-ifrn
   swap 0 <inet4> make-sockaddr  over set-struct-ifreq-ifr-ifru
 
   AF_INET SOCK_DGRAM 0 socket SIOCSIFNETMASK rot ioctl drop ;

extra/unix/process/process.factor

@@ -1,7 +1,6 @@
-USING: kernel alien.c-types sequences math unix
+USING: kernel alien.c-types alien.strings sequences math unix
-vectors kernel namespaces continuations
+vectors kernel namespaces continuations threads assocs vectors
-threads assocs vectors io.unix.backend ;
+io.unix.backend io.encodings.utf8 ;
-
 IN: unix.process
 
 ! Low-level Unix process launching utilities. These are used
@@ -9,16 +8,16 @@ IN: unix.process
 ! io.launcher instead.
 
 : >argv ( seq -- alien )
-    [ malloc-char-string ] map f suffix >c-void*-array ;
+    [ utf8 malloc-string ] map f suffix >c-void*-array ;
 
 : exec ( pathname argv -- int )
-    [ malloc-char-string ] [ >argv ] bi* execv ;
+    [ utf8 malloc-string ] [ >argv ] bi* execv ;
 
 : exec-with-path ( filename argv -- int )
-    [ malloc-char-string ] [ >argv ] bi* execvp ;
+    [ utf8 malloc-string ] [ >argv ] bi* execvp ;
 
 : exec-with-env ( filename argv envp -- int )
-    [ malloc-char-string ] [ >argv ] [ >argv ] tri* execve ;
+    [ utf8 malloc-string ] [ >argv ] [ >argv ] tri* execve ;
 
 : exec-args ( seq -- int )
     [ first ] [ ] bi exec ;

extra/webapps/planet/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/webapps/planet/blog-summary.xml

@@ -0,0 +1,7 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:a href="view-blog" query="id"><t:view component="name" /></t:a>
+
+</t:chloe>

extra/webapps/planet/edit-blog.xml

@@ -0,0 +1,40 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:title>Edit Blog</t:title>
+
+	<t:form action="edit-blog">
+
+		<t:edit component="id" />
+
+		<table>
+
+			<tr>
+				<th class="field-label">Blog name:</th>
+				<td><t:edit component="name" /></td>
+			</tr>
+
+			<tr>
+				<th class="field-label">Home page:</th>
+				<td><t:edit component="www-url" /></td>
+			</tr>
+
+			<tr>
+				<th class="field-label">Atom feed:</th>
+				<td><t:edit component="atom-url" /></td>
+			</tr>
+
+		</table>
+
+		<input type="SUBMIT" value="Done" />
+
+	</t:form>
+
+	<t:a href="view" query="id">View</t:a>
+	|
+	<t:form action="delete-blog" class="inline">
+		<t:edit component="id" />
+		<button type="submit" class="link-button link">Delete</button>
+	</t:form>
+</t:chloe>

extra/webapps/planet/entry-summary.xml

@@ -0,0 +1,10 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<p class="news">
+		<strong><t:view component="title" /></strong> <br/>
+		<t:a value="link" class="more">Read More...</t:a>
+	</p>
+
+</t:chloe>

extra/webapps/planet/entry.xml

@@ -0,0 +1,9 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<h2 class="posting-title"><t:view component="title" /></h2>
+	<p class="posting-body"> <t:view component="description" /> </p>
+	<p class="posting-date"> <t:view component="pub-date" /> </p>
+
+</t:chloe>

extra/webapps/planet/mini-planet.xml

@@ -0,0 +1,7 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:summary component="postings" />
+
+</t:chloe>

extra/webapps/planet/page.xml

@@ -0,0 +1,64 @@
+<?xml version='1.0' ?>
+
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+	"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+
+<html xmlns="http://www.w3.org/1999/xhtml">
+
+	<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+		<head>
+			<t:write-title />
+
+			<t:write-atom />
+
+			<t:style>
+				.link-button {
+					padding: 0px;
+					background: none;
+					border: none;
+				}
+
+				.inline {
+					display: inline;
+				}
+
+				body, button {
+					font:9pt "Lucida Grande", "Lucida Sans Unicode", verdana, geneva, sans-serif;
+					color:#444;
+				}
+
+				a, .link {
+					color: #222;
+					border-bottom:1px dotted #666;
+					text-decoration:none;
+				}
+
+				h1 a {
+					border: none;
+				}
+
+				a:hover, .link:hover {
+					border-bottom:1px solid #66a;
+				}
+
+				.error { color: #a00; }
+				
+				.field-label {
+					text-align: right;
+				}
+			</t:style>
+
+			<t:write-style />
+		</head>
+
+		<body>
+
+			<h1><t:a href="planet"><t:write-title /></t:a></h1>
+
+			<t:call-next-template />
+		</body>
+
+	</t:chloe>
+
+</html>

extra/webapps/planet/planet.css

@@ -0,0 +1,30 @@
+h1.planet-title {
+	font-size:300%;
+}
+
+.posting-title {
+	background-color:#f5f5f5;
+}
+
+pre, code {
+	color:#000000;
+	font-size:120%;
+}
+
+.infobox {
+	border-left: 1px solid #C1DAD7;
+}
+
+.posting-date {
+	text-align: right;
+	font-size:90%;
+}
+
+a.more {
+	display:block;
+	padding:0 0 5px 0;
+	color:#333;
+	text-decoration:none;
+	text-align:right;
+	border:none;
+}

extra/webapps/planet/planet.factor

@@ -0,0 +1,174 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors sequences sorting locals math
+calendar alarms logging concurrency.combinators
+db.types db.tuples db
+rss xml.writer
+http.server
+http.server.crud
+http.server.forms
+http.server.actions
+http.server.boilerplate
+http.server.templating.chloe
+http.server.components ;
+IN: webapps.planet
+
+TUPLE: blog id name www-url atom-url ;
+
+blog "BLOGS"
+{
+    { "id" "ID" INTEGER +native-id+ }
+    { "name" "NAME" { VARCHAR 256 } +not-null+ }
+    { "www-url" "WWWURL" { VARCHAR 256 } +not-null+ }
+    { "atom-url" "ATOMURL" { VARCHAR 256 } +not-null+ }
+} define-persistent
+
+: init-blog-table blog ensure-table ;
+
+: <blog> ( id -- todo )
+    blog new
+        swap >>id ;
+
+: planet-template ( name -- template )
+    "resource:extra/webapps/planet/" swap ".xml" 3append <chloe> ;
+
+: <entry-form> ( -- form )
+    "entry" <form>
+        "entry" planet-template >>view-template
+        "entry-summary" planet-template >>summary-template
+        "title" <string> add-field
+        "description" <html-text> add-field
+        "pub-date" <date> add-field ;
+
+: <blog-form> ( -- form )
+    "blog" <form>
+        "edit-blog" planet-template >>edit-template
+        "view-blog" planet-template >>view-template
+        "blog-summary" planet-template >>summary-template
+        "id" <integer>
+            hidden >>renderer
+            add-field
+        "name" <string>
+            t >>required
+            add-field
+        "www-url" <url>
+            t >>required
+            add-field
+        "atom-url" <url>
+            t >>required
+            add-field ;
+
+: <planet-factor-form> ( -- form )
+    "planet-factor" <form>
+        "planet" planet-template >>view-template
+        "mini-planet" planet-template >>summary-template
+        "postings" <entry-form> +plain+ <list> add-field
+        "blogroll" <blog-form> +unordered+ <list> add-field ;
+
+: blogroll ( -- seq )
+    f <blog> select-tuples [ [ name>> ] compare ] sort ;
+
+TUPLE: planet-factor < dispatcher postings ;
+
+:: <planet-action> ( planet -- action )
+    [let | form [ <planet-factor-form> ] |
+        <action>
+            [
+                blank-values
+
+                planet postings>> "postings" set-value
+                blogroll "blogroll" set-value
+
+                form view-form
+            ] >>display
+    ] ;
+
+: safe-head ( seq n -- seq' )
+    over length min head ;
+
+:: planet-feed ( planet -- feed )
+    feed new
+        "[ planet-factor ]" >>title
+        "http://planet.factorcode.org" >>link
+        planet postings>> 30 safe-head >>entries ;
+
+:: <feed-action> ( planet -- action )
+    <action>
+        [
+            "text/xml" <content>
+            [ planet planet-feed feed>xml write-xml ] >>body
+        ] >>display ;
+
+: <posting> ( name entry -- entry' )
+    clone [ ": " swap 3append ] change-title ;
+
+: fetch-feed ( url -- feed )
+    download-feed entries>> ;
+
+\ fetch-feed DEBUG add-error-logging
+
+: fetch-blogroll ( blogroll -- entries )
+    dup
+    [ atom-url>> fetch-feed ] parallel-map
+    [ >r name>> r> [ <posting> ] with map ] 2map concat ;
+
+: sort-entries ( entries -- entries' )
+    [ [ pub-date>> ] compare ] sort <reversed> ;
+
+: update-cached-postings ( planet -- )
+    "webapps.planet" [
+        blogroll fetch-blogroll sort-entries >>postings drop
+    ] with-logging ;
+
+:: <update-action> ( planet -- action )
+    <action>
+        [
+            planet update-cached-postings
+            "" f <temporary-redirect>
+        ] >>display ;
+
+: start-update-task ( planet -- )
+    [ update-cached-postings ] curry 10 minutes every drop ;
+
+:: <planet-factor> ( -- responder )
+    [let | blog-form [ <blog-form> ]
+           blog-ctor [ [ <blog> ] ] |
+        planet-factor new-dispatcher
+            dup <planet-action> >>default
+            dup <feed-action> "feed.xml" add-responder
+            dup <update-action> "update" add-responder
+
+            ! Administrative CRUD
+                      blog-ctor ""          <delete-action> "delete-blog" add-responder
+            blog-form blog-ctor             <view-action>   "view-blog"   add-responder
+            blog-form blog-ctor "view-blog" <edit-action>   "edit-blog"   add-responder
+    ] ;
+
+USING: namespaces io.files io.sockets
+db.sqlite smtp
+http.server.db
+http.server.sessions
+http.server.auth.login
+http.server.auth.providers.db
+http.server.sessions.storage.db ;
+
+: test-db "planet.db" resource-path sqlite-db ;
+
+: <planet-app> ( -- responder )
+    <planet-factor>
+    <boilerplate>
+        "page" planet-template >>template
+    ! <url-sessions>
+    !     sessions-in-db >>sessions
+    test-db <db-persistence> ;
+
+: init-planet ( -- )
+    ! test-db [
+    !     init-blog-table
+        ! init-users-table
+        ! init-sessions-table
+    ! ] with-db
+
+    <dispatcher>
+        <planet-app> "planet" add-responder
+    main-responder set-global ;

extra/webapps/planet/planet.xml

@@ -0,0 +1,37 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:title>Planet Factor</t:title>
+
+	<t:atom title="Planet Factor - Atom" href="feed.xml" />
+
+	<t:style include="resource:extra/webapps/planet/planet.css" />
+
+	<table width="100%" cellpadding="10">
+		<tr>
+			<td> <t:view component="postings" /> </td>
+
+			<td valign="top" width="25%" class="infobox">
+				<p>
+					<strong>planet-factor</strong> is an Atom feed aggregator that collects the
+					contents of <a href="http://factorcode.org/">Factor</a>-related blogs. It was inspired by
+					<a href="http://planet.lisp.org">Planet Lisp</a>.
+				</p>
+				<p>
+					<img src="http://planet.lisp.org/feed-icon-14x14.png" />
+					<a href="feed.xml"> Syndicate </a>
+				</p>
+
+				<h2>Blogroll</h2>
+
+				<t:summary component="blogroll" />
+
+				Admin: <t:a href="edit-blog">Add Blog</t:a>
+				|
+				<t:a href="update">Update</t:a>
+			</td>
+		</tr>
+	</table>
+
+</t:chloe>

extra/webapps/planet/view-blog.xml

@@ -0,0 +1,41 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:title>View Blog</t:title>
+
+	<table>
+
+		<tr>
+			<th class="field-label">Blog name:</th>
+			<td><t:view component="name" /></td>
+		</tr>
+
+		<tr>
+			<th class="field-label">Home page:</th>
+			<td>
+				<t:a value="www-url">
+					<t:view component="www-url" />
+				</t:a>
+			</td>
+		</tr>
+
+		<tr>
+			<th class="field-label">Atom feed:</th>
+			<td>
+				<t:a value="atom-url">
+					<t:view component="atom-url" />
+				</t:a>
+			</td>
+		</tr>
+
+	</table>
+
+	<t:a href="edit-blog" query="id">Edit</t:a>
+	|
+	<t:form action="delete-blog" class="inline">
+		<t:edit component="id" />
+		<button type="submit" class="link-button link">Delete</button>
+	</t:form>
+
+</t:chloe>

extra/webapps/todo/todo-list.xml

@@ -6,7 +6,7 @@
 
 	<table class="todo-list">
 		<tr><th>Summary</th><th>Priority</th><th>View</th><th>Edit</th></tr>
-		<t:view component="list" />
+		<t:summary component="list" />
 	</table>
 
 </t:chloe>

extra/windows/ole32/ole32.factor

@@ -12,8 +12,8 @@ C-STRUCT: GUID
 
 TYPEDEF: void* REFGUID
 TYPEDEF: void* LPUNKNOWN
-TYPEDEF: ushort* LPOLESTR
+TYPEDEF: wchar_t* LPOLESTR
-TYPEDEF: ushort* LPCOLESTR
+TYPEDEF: wchar_t* LPCOLESTR
 
 TYPEDEF: REFGUID REFIID
 TYPEDEF: REFGUID REFCLSID
@@ -52,8 +52,8 @@ FUNCTION: HRESULT CLSIDFromString ( LPOLESTR lpsz, REFGUID out_rguid ) ;
     "{01234567-89ab-cdef-0123-456789abcdef}" length ; inline
 
 : string>guid ( string -- guid )
-    string>u16-alien "GUID" <c-object> [ CLSIDFromString ole32-error ] keep ;
+    utf16n string>alien "GUID" <c-object> [ CLSIDFromString ole32-error ] keep ;
 : guid>string ( guid -- string )
     GUID-STRING-LENGTH 1+ [ "ushort" <c-array> ] keep
-    [ StringFromGUID2 drop ] { 2 } multikeep alien>u16-string ;
+    [ StringFromGUID2 drop ] { 2 } multikeep utf16n alien>string ;
 

extra/windows/shell32/shell32.factor

@@ -91,7 +91,7 @@ FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFi
 : shell32-directory ( n -- str )
     f swap f SHGFP_TYPE_DEFAULT
     MAX_UNICODE_PATH "ushort" <c-array>
-    [ SHGetFolderPath shell32-error ] keep alien>u16-string ;
+    [ SHGetFolderPath shell32-error ] keep utf16n alien>string ;
 
 : desktop ( -- str )
     CSIDL_DESKTOPDIRECTORY shell32-directory ;

extra/windows/types/types.factor

@@ -66,9 +66,8 @@ TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER
 
 TYPEDEF: WCHAR       TCHAR
 TYPEDEF: TCHAR       TBYTE
-! TYPEDEF: uchar*  LPCSTR
+TYPEDEF: wchar_t*  LPCSTR
-TYPEDEF: ushort*  LPCSTR
+TYPEDEF: wchar_t*  LPWSTR
-TYPEDEF: ushort*  LPWSTR
 
 
 
@@ -126,10 +125,10 @@ TYPEDEF: WCHAR*              LPCWSTR
 ! TYPEDEF: WCHAR*              LPWSTR
 
 TYPEDEF: WCHAR*               LPSTR
-TYPEDEF: ushort* LPCTSTR
+TYPEDEF: wchar_t* LPCTSTR
-TYPEDEF: ushort* LPWTSTR
+TYPEDEF: wchar_t* LPWTSTR
 
-TYPEDEF: ushort*       LPTSTR
+TYPEDEF: wchar_t*       LPTSTR
 TYPEDEF: LPCSTR      PCTSTR
 TYPEDEF: LPSTR       PTSTR
 

extra/windows/windows.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax alien.c-types arrays combinators
+USING: alien alien.syntax alien.c-types alien.strings arrays
-kernel math namespaces parser prettyprint sequences
+combinators kernel math namespaces parser prettyprint sequences
 windows.errors windows.types windows.kernel32 words ;
 IN: windows
 
@@ -14,7 +14,7 @@ FUNCTION: void* error_message ( DWORD id ) ;
 
 : (win32-error-string) ( n -- string )
     error_message
-    dup alien>u16-string
+    dup utf16n alien>string
     swap LocalFree drop ;
 
 : win32-error-string ( -- str )

extra/windows/winsock/winsock.factor

@@ -397,7 +397,7 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi
 : (winsock-error-string) ( n -- str )
     ! #! WSAStartup returns the error code 'n' directly
     dup winsock-expected-error?
-    [ drop f ] [ error_message alien>u16-string ] if ;
+    [ drop f ] [ error_message utf16n alien>string ] if ;
 
 : winsock-error-string ( -- string/f )
     WSAGetLastError (winsock-error-string) ;

extra/x/x.factor

@@ -1,7 +1,8 @@
 
-USING: kernel io alien alien.c-types namespaces threads
+USING: kernel io alien alien.c-types alien.strings namespaces threads
        arrays sequences assocs math vars combinators.lib
-       x11.constants x11.events x11.xlib mortar slot-accessors geom.rect ;
+       x11.constants x11.events x11.xlib mortar slot-accessors geom.rect
+       io.encodings.ascii ;
 
 IN: x
 
@@ -29,7 +30,7 @@ define-independent-class
 
 <display> "create" !( name <display> -- display ) [
   new-empty swap >>name
-  dup $name dup [ string>char-alien ] [ ] if XOpenDisplay
+  dup $name dup [ ascii string>alien ] [ ] if XOpenDisplay
   dup [ >>ptr ] [ "XOpenDisplay error" throw ] if
   dup $ptr XDefaultScreen >>default-screen
   dup $ptr XDefaultRootWindow dupd <window> new >>default-root
@@ -433,7 +434,7 @@ add-method
 
 <window> "fetch-name" !( window -- name-or-f )
   [ <- raw f <void*> dup >r   XFetchName drop   r>
-    dup *void* alien-address 0 = [ drop f ] [ *char* ] if ]
+    dup *void* [ drop f ] [ *void* ascii alien>string ] if ]
 add-method
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

extra/x11/clipboard/clipboard.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2006, 2007 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.syntax arrays kernel math
+USING: alien alien.c-types alien.strings alien.syntax arrays
-namespaces sequences io.encodings.string io.encodings.utf8 x11.xlib
+kernel math namespaces sequences io.encodings.string
-x11.constants ;
+io.encodings.utf8 io.encodings.ascii x11.xlib x11.constants ;
 IN: x11.clipboard
 
 ! This code was based on by McCLIM's Backends/CLX/port.lisp
@@ -25,7 +25,7 @@ TUPLE: x-clipboard atom contents ;
     CurrentTime XConvertSelection drop ;
 
 : snarf-property ( prop-return -- string )
-    dup *void* [ *char* ] [ drop f ] if ;
+    dup *void* [ *void* ascii alien>string ] [ drop f ] if ;
 
 : window-property ( win prop delete? -- string )
     >r dpy get -rot 0 -1 r> AnyPropertyType

extra/x11/xlib/xlib.factor

@@ -11,8 +11,9 @@
 ! modify, just find the function or data structure in the manual
 ! and note the section.
 
-USING: kernel arrays alien alien.c-types alien.syntax
+USING: kernel arrays alien alien.c-types alien.strings
-math math.bitfields words sequences namespaces continuations ;
+alien.syntax math math.bitfields words sequences namespaces
+continuations io.encodings.ascii ;
 IN: x11.xlib
 
 LIBRARY: xlib
@@ -1372,7 +1373,7 @@ SYMBOL: root
 
 : initialize-x ( display-string -- )
     init-locale
-    dup [ string>char-alien ] when
+    dup [ ascii string>alien ] when
     XOpenDisplay check-display dpy set-global
     dpy get XDefaultScreen scr set-global
     dpy get scr get XRootWindow root set-global ;

vm/ffi_test.c

@@ -251,10 +251,18 @@ double ffi_test_36(struct test_struct_12 x)
 	return x.x;
 }
 
+static int global_var;
+
+void ffi_test_36_point_5(void)
+{
+	printf("int_ffi_test_36_point_5\n");
+	global_var = 0;
+}
+
 int ffi_test_37(int (*f)(int, int, int))
 {
-	static int global_var = 0;
 	printf("ffi_test_37\n");
+	printf("global_var is %d\n",global_var);
 	global_var = f(global_var,global_var * 2,global_var * 3);
 	printf("global_var is %d\n",global_var);
 	fflush(stdout);

vm/ffi_test.h

@@ -62,6 +62,8 @@ struct test_struct_12 { int a; double x; };
 
 DLLEXPORT double ffi_test_36(struct test_struct_12 x);
 
+DLLEXPORT void int_ffi_test_36_point_5(void);
+
 DLLEXPORT int ffi_test_37(int (*f)(int, int, int));
 
 DLLEXPORT unsigned long long ffi_test_38(unsigned long long x, unsigned long long y);

vm/primitives.c

@@ -139,10 +139,6 @@ void *primitives[] = {
 	primitive_set_alien_double,
 	primitive_alien_cell,
 	primitive_set_alien_cell,
-	primitive_alien_to_char_string,
-	primitive_string_to_char_alien,
-	primitive_alien_to_u16_string,
-	primitive_string_to_u16_alien,
 	primitive_throw,
 	primitive_alien_address,
 	primitive_slot,