Permalink
Browse files

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

  • Loading branch information...
2 parents 462a9a4 + 1b17bca commit 92966f1423dc8ef01558d59e191ecf050eed746e @slavapestov slavapestov committed May 12, 2009
@@ -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
@@ -448,7 +448,6 @@ M: quotation '
array>> '
quotation [
emit ! array
- f ' emit ! compiled
f ' emit ! cached-effect
f ' emit ! cache-counter
0 emit ! xt
@@ -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
@@ -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 ] ;
@@ -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
@@ -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 ;
@@ -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
@@ -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
@@ -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 -- )
[
@@ -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 ;
@@ -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
@@ -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
@@ -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
@@ -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 -- )
@@ -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) ;
@@ -0,0 +1 @@
+Alec Berryman
Oops, something went wrong.

0 comments on commit 92966f1

Please sign in to comment.