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

basis/alien/arrays/arrays.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.strings alien.c-types alien.accessors alien.structs
 arrays words sequences math kernel namespaces fry libc cpu.architecture
-io.encodings.utf8 io.encodings.utf16n ;
+io.encodings.utf8 ;
 IN: alien.arrays
 
 UNION: value-type array struct-type ;
@@ -95,5 +95,4 @@ M: string-type c-type-setter
 
 { "char*" utf8 } "char*" typedef
 "char*" "uchar*" typedef
-{ "char*" utf16n } "wchar_t*" typedef
 

basis/bootstrap/image/image.factor

@@ -448,7 +448,6 @@ M: quotation '
         array>> '
         quotation [
             emit ! array
-            f ' emit ! compiled
             f ' emit ! cached-effect
             f ' emit ! cache-counter
             0 emit ! xt

basis/bootstrap/stage2.factor

@@ -12,6 +12,16 @@ SYMBOL: core-bootstrap-time
 
 SYMBOL: bootstrap-time
 
+: strip-encodings ( -- )
+    os unix? [
+        [
+            P" resource:core/io/encodings/utf16/utf16.factor" 
+            P" resource:core/io/encodings/utf16n/utf16n.factor" [ forget ] bi@
+            "io.encodings.utf16" 
+            "io.encodings.utf16n" [ child-vocabs [ forget-vocab ] each ] bi@
+        ] with-compilation-unit
+    ] when ;
+
 : default-image-name ( -- string )
     vm file-name os windows? [ "." split1-last drop ] when
     ".image" append resource-path ;
@@ -55,6 +65,8 @@ SYMBOL: bootstrap-time
     "math compiler threads help io tools ui ui.tools unicode handbook" "include" set-global
     "" "exclude" set-global
 
+    strip-encodings
+
     (command-line) parse-command-line
 
     ! Set dll paths

basis/combinators/smart/smart.factor

@@ -11,8 +11,8 @@ MACRO: output>sequence ( quot exemplar -- newquot )
     [ dup infer out>> ] dip
     '[ @ _ _ nsequence ] ;
 
-: output>array ( quot -- newquot )
-    { } output>sequence ; inline
+MACRO: output>array ( quot -- newquot )
+    '[ _ { } output>sequence ] ;
 
 MACRO: input<sequence ( quot -- newquot )
     [ infer in>> ] keep
@@ -25,8 +25,8 @@ MACRO: input<sequence-unsafe ( quot -- newquot )
 MACRO: reduce-outputs ( quot operation -- newquot )
     [ dup infer out>> 1 [-] ] dip n*quot compose ;
 
-: sum-outputs ( quot -- n )
-    [ + ] reduce-outputs ; inline
+MACRO: sum-outputs ( quot -- n )
+    '[ _ [ + ] reduce-outputs ] ;
 
 MACRO: map-reduce-outputs ( quot mapper reducer -- newquot )
     [ dup infer out>> ] 2dip
@@ -37,5 +37,5 @@ MACRO: map-reduce-outputs ( quot mapper reducer -- newquot )
 MACRO: append-outputs-as ( quot exemplar -- newquot )
     [ dup infer out>> ] dip '[ @ _ _ nappend-as ] ;
 
-: append-outputs ( quot -- seq )
-    { } append-outputs-as ; inline
+MACRO: append-outputs ( quot -- seq )
+    '[ _ { } append-outputs-as ] ;

basis/compiler/constants/constants.factor

@@ -20,7 +20,7 @@ CONSTANT: deck-bits 18
 : underlying-alien-offset ( -- n ) bootstrap-cell alien tag-number - ; inline
 : tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ; inline
 : word-xt-offset ( -- n ) 10 bootstrap-cells \ word tag-number - ; inline
-: quot-xt-offset ( -- n ) 5 bootstrap-cells quotation tag-number - ; inline
+: quot-xt-offset ( -- n ) 4 bootstrap-cells quotation tag-number - ; inline
 : word-code-offset ( -- n ) 11 bootstrap-cells \ word tag-number - ; inline
 : array-start-offset ( -- n ) 2 bootstrap-cells array tag-number - ; inline
 : compiled-header-size ( -- n ) 4 bootstrap-cells ; inline

basis/io/backend/unix/unix.factor

@@ -173,10 +173,11 @@ M: stdin refill
         size-read-fd <fd> init-fd <input-port> >>size
         data-read-fd <fd> >>data ;
 
-M: unix (init-stdio)
+M: unix init-stdio
     <stdin> <input-port>
     1 <fd> <output-port>
-    2 <fd> <output-port> t ;
+    2 <fd> <output-port>
+    set-stdio ;
 
 ! mx io-task for embedding an fd-based mx inside another mx
 TUPLE: mx-port < port mx ;

basis/io/backend/windows/nt/nt.factor

@@ -1,9 +1,9 @@
-USING: alien alien.c-types arrays assocs combinators
-continuations destructors io io.backend io.ports io.timeouts
-io.backend.windows io.files.windows io.files.windows.nt io.files
-io.pathnames io.buffers io.streams.c libc kernel math namespaces
-sequences threads windows windows.errors windows.kernel32
-strings splitting ascii system accessors locals ;
+USING: alien alien.c-types arrays assocs combinators continuations
+destructors io io.backend io.ports io.timeouts io.backend.windows
+io.files.windows io.files.windows.nt io.files io.pathnames io.buffers
+io.streams.c io.streams.null libc kernel math namespaces sequences
+threads windows windows.errors windows.kernel32 strings splitting
+ascii system accessors locals ;
 QUALIFIED: windows.winsock
 IN: io.backend.windows.nt
 
@@ -140,7 +140,9 @@ M: winnt (wait-to-read) ( port -- )
 
 : console-app? ( -- ? ) GetConsoleWindow >boolean ;
 
-M: winnt (init-stdio)
-    console-app? [ init-c-stdio t ] [ f f f f ] if ;
+M: winnt init-stdio
+    console-app?
+    [ init-c-stdio ]
+    [ null-reader null-writer null-writer set-stdio ] if ;
 
 winnt set-io-backend

basis/io/launcher/launcher.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: system kernel namespaces strings hashtables sequences 
-assocs combinators vocabs.loader init threads continuations
-math accessors concurrency.flags destructors environment
-io io.encodings.ascii io.backend io.timeouts io.pipes
-io.pipes.private io.encodings io.streams.duplex io.ports
-debugger prettyprint summary calendar ;
+USING: system kernel namespaces strings hashtables sequences assocs
+combinators vocabs.loader init threads continuations math accessors
+concurrency.flags destructors environment io io.encodings.ascii
+io.backend io.timeouts io.pipes io.pipes.private io.encodings
+io.encodings.utf8 io.streams.duplex io.ports debugger prettyprint
+summary calendar ;
 IN: io.launcher
 
 TUPLE: process < identity-tuple
@@ -254,6 +254,21 @@ M: object run-pipeline-element
     swap [ with-stream ] dip
     wait-for-success ; inline
 
+ERROR: output-process-error { output string } { process process } ;
+
+M: output-process-error error.
+    [ "Process:" print process>> . nl ]
+    [ "Output:" print output>> print ]
+    bi ;
+
+: try-output-process ( command -- )
+    >process
+    +stdout+ >>stderr
+    +closed+ >>stdin
+    utf8 <process-reader*>
+    [ stream-contents ] [ dup wait-for-process ] bi*
+    0 = [ 2drop ] [ output-process-error ] if ;
+
 : notify-exit ( process status -- )
     >>status
     [ processes get delete-at* drop [ resume ] each ] keep

basis/tools/deploy/shaker/shaker.factor

@@ -1,10 +1,12 @@
 ! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays accessors io.backend io.streams.c init fry namespaces
-make assocs kernel parser lexer strings.parser vocabs sequences words
-memory kernel.private continuations io vocabs.loader system strings
-sets vectors quotations byte-arrays sorting compiler.units definitions
-generic generic.standard tools.deploy.config combinators classes ;
+math make assocs kernel parser lexer strings.parser vocabs sequences
+sequences.private words memory kernel.private continuations io
+vocabs.loader system strings sets vectors quotations byte-arrays
+sorting compiler.units definitions generic generic.standard
+generic.single tools.deploy.config combinators classes
+slots.private ;
 QUALIFIED: bootstrap.stage2
 QUALIFIED: command-line
 QUALIFIED: compiler.errors
@@ -38,6 +40,7 @@ IN: tools.deploy.shaker
     strip-io? [
         "io.files" init-hooks get delete-at
         "io.backend" init-hooks get delete-at
+        "io.thread" init-hooks get delete-at
     ] when
     strip-dictionary? [
         {
@@ -193,7 +196,8 @@ IN: tools.deploy.shaker
 
 : strip-compiler-classes ( -- )
     "Stripping compiler classes" show
-    "compiler" child-vocabs [ words ] map concat [ class? ] filter
+    { "compiler" "stack-checker" }
+    [ child-vocabs [ words ] map concat [ class? ] filter ] map concat
     [ dup implementors [ "methods" word-prop delete-at ] with each ] each ;
 
 : strip-default-methods ( -- )
@@ -325,12 +329,17 @@ IN: tools.deploy.shaker
     ] [ drop ] if ;
 
 : strip-c-io ( -- )
-    deploy-io get 2 = os windows? or [
+    strip-io?
+    deploy-io get 3 = os windows? not and
+    or [
         [
             c-io-backend forget
             "io.streams.c" forget-vocab
+            "io-thread-running?" "io.thread" lookup [
+                global delete-at
+            ] when*
         ] with-compilation-unit
-    ] unless ;
+    ] when ;
 
 : compress ( pred post-process string -- )
     "Compressing " prepend show
@@ -353,7 +362,7 @@ IN: tools.deploy.shaker
     #! Quotations which were formerly compiled must remain
     #! compiled.
     2dup [
-        2dup [ compiled>> ] [ compiled>> not ] bi* and
+        2dup [ quot-compiled? ] [ quot-compiled? not ] bi* and
         [ nip jit-compile ] [ 2drop ] if
     ] 2each ;
 
@@ -406,6 +415,23 @@ SYMBOL: deploy-vocab
     ] each
     "vocab:tools/deploy/shaker/next-methods.factor" run-file ;
 
+: (clear-megamorphic-cache) ( i array -- )
+    2dup 1 slot < [
+        2dup [ f ] 2dip set-array-nth
+        [ 1 + ] dip (clear-megamorphic-cache)
+    ] [ 2drop ] if ;
+
+: clear-megamorphic-cache ( array -- )
+    [ 0 ] dip (clear-megamorphic-cache) ;
+
+: find-megamorphic-caches ( -- seq )
+    "Finding megamorphic caches" show
+    [ standard-generic? ] instances [ def>> third ] map ;
+
+: clear-megamorphic-caches ( cache -- )
+    "Clearing megamorphic caches" show
+    [ clear-megamorphic-cache ] each ;
+
 : strip ( -- )
     init-stripper
     strip-libc
@@ -419,11 +445,13 @@ SYMBOL: deploy-vocab
     strip-default-methods
     f 5 setenv ! we can't use the Factor debugger or Factor I/O anymore
     deploy-vocab get vocab-main deploy-boot-quot
+    find-megamorphic-caches
     stripped-word-props
     stripped-globals strip-globals
     compress-objects
     compress-quotations
-    strip-words ;
+    strip-words
+    clear-megamorphic-caches ;
 
 : deploy-error-handler ( quot -- )
     [

basis/tools/deploy/test/test.factor

@@ -1,5 +1,5 @@
 USING: accessors arrays continuations io.directories io.files.info
-io.files.temp io.launcher kernel layouts math sequences system
+io.files.temp io.launcher io.backend kernel layouts math sequences system
 tools.deploy.backend tools.deploy.config.editor ;
 IN: tools.deploy.test
 
@@ -14,7 +14,6 @@ IN: tools.deploy.test
     [ "test.image" temp-file file-info size>> ] [ cell 4 / * ] bi* <= ;
 
 : run-temp-image ( -- )
-    vm
-    "-i=" "test.image" temp-file append
-    2array
-    <process> swap >>command +closed+ >>stdin try-process ;
+    os macosx?
+    "resource:Factor.app/Contents/MacOS/factor" normalize-path vm ?
+    "-i=" "test.image" temp-file append 2array try-output-process ;

basis/ui/gadgets/worlds/worlds.factor

@@ -4,7 +4,7 @@ USING: accessors arrays assocs continuations kernel math models
 namespaces opengl opengl.textures sequences io combinators
 combinators.short-circuit fry math.vectors math.rectangles cache
 ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
-ui.commands ui.pixel-formats destructors literals strings ;
+ui.pixel-formats destructors literals strings ;
 IN: ui.gadgets.worlds
 
 CONSTANT: default-world-pixel-format-attributes

basis/windows/types/types.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.syntax namespaces kernel words
-sequences math math.bitwise math.vectors colors ;
+sequences math math.bitwise math.vectors colors
+io.encodings.utf16n ;
 IN: windows.types
 
 TYPEDEF: char                CHAR
@@ -68,6 +69,8 @@ TYPEDEF: ulonglong   ULARGE_INTEGER
 TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER
 TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER
 
+<< { "char*" utf16n } "wchar_t*" typedef >>
+
 TYPEDEF: wchar_t*  LPCSTR
 TYPEDEF: wchar_t*  LPWSTR
 TYPEDEF: WCHAR       TCHAR

core/bootstrap/primitives.factor

@@ -211,7 +211,6 @@ bi
 
 "quotation" "quotations" create {
     { "array" { "array" "arrays" } read-only }
-    { "compiled" read-only }
     "cached-effect"
     "cache-counter"
 } define-builtin
@@ -514,6 +513,7 @@ tuple
     { "reset-inline-cache-stats" "generic.single" (( -- )) }
     { "inline-cache-stats" "generic.single" (( -- stats )) }
     { "optimized?" "words" (( word -- ? )) }
+    { "quot-compiled?" "quotations" (( quot -- ? )) }
 } [ [ first3 ] dip swap make-primitive ] each-index
 
 ! Bump build number

core/io/backend/backend.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: init kernel system namespaces io io.encodings
-io.encodings.utf8 init assocs splitting alien io.streams.null ;
+io.encodings.utf8 init assocs splitting alien ;
 IN: io.backend
 
 SYMBOL: io-backend
@@ -12,22 +12,12 @@ io-backend [ c-io-backend ] initialize
 
 HOOK: init-io io-backend ( -- )
 
-HOOK: (init-stdio) io-backend ( -- stdin stdout stderr ? )
-
-: set-stdio ( input-handle output-handle error-handle -- )
-    [ input-stream set-global ]
-    [ output-stream set-global ]
-    [ error-stream set-global ] tri* ;
-
-: init-stdio ( -- )
-    (init-stdio) [
-        [ utf8 <decoder> ]
-        [ utf8 <encoder> ]
-        [ utf8 <encoder> ] tri*
-    ] [
-        3drop
-        null-reader null-writer null-writer
-    ] if set-stdio ;
+HOOK: init-stdio io-backend ( -- )
+
+: set-stdio ( input output error -- )
+    [ utf8 <decoder> input-stream set-global ]
+    [ utf8 <encoder> output-stream set-global ]
+    [ utf8 <encoder> error-stream set-global ] tri* ;
 
 HOOK: io-multiplex io-backend ( us -- )
 

core/io/streams/c/c.factor

@@ -60,12 +60,13 @@ M: c-io-backend init-io ;
 : stdout-handle ( -- alien ) 12 getenv ;
 : stderr-handle ( -- alien ) 61 getenv ;
 
-: init-c-stdio ( -- stdin stdout stderr )
+: init-c-stdio ( -- )
     stdin-handle <c-reader>
     stdout-handle <c-writer>
-    stderr-handle <c-writer> ;
+    stderr-handle <c-writer>
+    set-stdio ;
 
-M: c-io-backend (init-stdio) init-c-stdio t ;
+M: c-io-backend init-stdio init-c-stdio ;
 
 M: c-io-backend io-multiplex 60 60 * 1000 * 1000 * or (sleep) ;
 

extra/bloom-filters/authors.txt

@@ -0,0 +1 @@
+Alec Berryman