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

basis/alien/arrays/arrays.factor

@@ -26,7 +26,7 @@ M: array box-return drop "void*" box-return ;
 
 M: array stack-size drop "void*" stack-size ;
 
-M: array c-type-boxer-quot drop f ;
+M: array c-type-boxer-quot drop [ ] ;
 
 M: array c-type-unboxer-quot drop [ >c-ptr ] ;
 

basis/alien/c-types/c-types.factor

@@ -4,7 +4,7 @@ USING: byte-arrays arrays assocs kernel kernel.private libc math
 namespaces make parser sequences strings words assocs splitting
 math.parser cpu.architecture alien alien.accessors quotations
 layouts system compiler.units io.files io.encodings.binary
-accessors combinators effects continuations fry call ;
+accessors combinators effects continuations fry call classes ;
 IN: alien.c-types
 
 DEFER: <int>
@@ -13,18 +13,20 @@ DEFER: *char
 : little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
 
 TUPLE: c-type
-class
+{ class class initial: object }
-boxer boxer-quot unboxer unboxer-quot
+boxer
-getter setter
+{ boxer-quot callable }
-reg-class size align stack-align? ;
+unboxer
-
+{ unboxer-quot callable }
-: new-c-type ( class -- type )
+{ getter callable }
-    new
+{ setter callable }
-        int-regs >>reg-class
+{ reg-class initial: int-regs }
-        object >>class ; inline
+size
+align
+stack-align? ;
 
 : <c-type> ( -- type )
-    \ c-type new-c-type ;
+    \ c-type new ;
 
 SYMBOL: c-types
 
@@ -224,7 +226,7 @@ M: f byte-length drop 0 ;
 TUPLE: long-long-type < c-type ;
 
 : <long-long-type> ( -- type )
-    long-long-type new-c-type ;
+    long-long-type new ;
 
 M: long-long-type unbox-parameter ( n type -- )
     c-type-unboxer %unbox-long-long ;

basis/alien/structs/structs-tests.factor

@@ -42,3 +42,18 @@ C-UNION: barx
     [ ] [ \ foox-x "help" get execute ] unit-test
     [ ] [ \ set-foox-x "help" get execute ] unit-test
 ] when
+
+C-STRUCT: nested
+    { "int" "x" } ;
+
+C-STRUCT: nested-2
+    { "nested" "y" } ;
+
+[ 4 ] [
+    "nested-2" <c-object>
+    "nested" <c-object>
+    4 over set-nested-x
+    over set-nested-2-y
+    nested-2-y
+    nested-x
+] unit-test

basis/alien/structs/structs.factor

@@ -2,10 +2,18 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs generic hashtables kernel kernel.private
 math namespaces parser sequences strings words libc fry
-alien.c-types alien.structs.fields cpu.architecture math.order ;
+alien.c-types alien.structs.fields cpu.architecture math.order
+quotations ;
 IN: alien.structs
 
-TUPLE: struct-type size align fields boxer-quot unboxer-quot getter setter ;
+TUPLE: struct-type
+size
+align
+fields
+{ boxer-quot callable }
+{ unboxer-quot callable }
+{ getter callable }
+{ setter callable } ;
 
 M: struct-type heap-size size>> ;
 

basis/io/launcher/windows/nt/nt-tests.factor

@@ -37,11 +37,12 @@ IN: io.launcher.windows.nt.tests
     "out.txt" temp-file ascii file-lines first
 ] unit-test
 
-[ ] [
+[ "( scratchpad ) " ] [
     <process>
         console-vm "-run=listener" 2array >>command
         +closed+ >>stdin
-    try-process
+        +stdout+ >>stderr
+    ascii [ input-stream get contents ] with-process-reader
 ] unit-test
 
 : launcher-test-path ( -- str )
@@ -162,3 +163,5 @@ IN: io.launcher.windows.nt.tests
    
     "append-test" temp-file ascii file-contents
 ] unit-test
+
+

basis/tools/deploy/backend/backend.factor

@@ -11,8 +11,8 @@ tools.deploy.config.editor bootstrap.image io.encodings.utf8
 destructors accessors ;
 IN: tools.deploy.backend
 
-: copy-vm ( executable bundle-name extension -- vm )
+: copy-vm ( executable bundle-name -- vm )
-    [ prepend-path ] dip append vm over copy-file ;
+    prepend-path vm over copy-file ;
 
 : copy-fonts ( name dir -- )
     deploy-ui? get [

basis/tools/deploy/macosx/macosx.factor

@@ -54,7 +54,7 @@ IN: tools.deploy.macosx
         } cleave
     ]
     [ create-app-plist ]
-    [ "Contents/MacOS/" append-path "" copy-vm ] 2tri
+    [ "Contents/MacOS/" append-path copy-vm ] 2tri
     dup OCT: 755 set-file-permissions ;
 
 : deploy.app-image ( vocab bundle-name -- str )

basis/tools/deploy/unix/unix.factor

@@ -8,7 +8,7 @@ IN: tools.deploy.unix
 
 : create-app-dir ( vocab bundle-name -- vm )
     dup "" copy-fonts
-    "" copy-vm
+    copy-vm
     dup OCT: 755 set-file-permissions ;
 
 : bundle-name ( -- str )

basis/tools/deploy/windows/windows.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io io.files io.directories kernel namespaces sequences system
+USING: io io.files io.pathnames io.directories kernel namespaces
-tools.deploy.backend tools.deploy.config
+sequences locals system splitting tools.deploy.backend
-tools.deploy.config.editor assocs hashtables prettyprint
+tools.deploy.config tools.deploy.config.editor assocs hashtables
-combinators windows.shell32 windows.user32 ;
+prettyprint combinators windows.shell32 windows.user32 ;
 IN: tools.deploy.windows
 
 : copy-dll ( bundle-name -- )
@@ -15,13 +15,18 @@ IN: tools.deploy.windows
         "resource:zlib1.dll"
     } swap copy-files-into ;
 
+:: copy-vm ( executable bundle-name extension -- vm )
+    vm "." split1-last drop extension append
+    bundle-name executable ".exe" append append-path
+    [ copy-file ] keep ;
+
 : create-exe-dir ( vocab bundle-name -- vm )
     dup copy-dll
     deploy-ui? get [
-        dup copy-freetype
+        [ copy-freetype ]
-        dup "" copy-fonts
+        [ "" copy-fonts ]
-    ] when
+        [ ".exe" copy-vm ] tri
-    ".exe" copy-vm ;
+    ] [ ".com" copy-vm ] if ;
 
 M: winnt deploy*
     "resource:" [

core/slots/slots.factor

@@ -151,6 +151,7 @@ M: class initial-value* no-initial-value ;
         { [ array bootstrap-word over class<= ] [ { } ] }
         { [ byte-array bootstrap-word over class<= ] [ B{ } ] }
         { [ simple-alien bootstrap-word over class<= ] [ <bad-alien> ] }
+        { [ quotation bootstrap-word over class<= ] [ [ ] ] }
         [ dup initial-value* ]
     } cond nip ;