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

diff --git a/basis/alien/complex/complex-tests.factor b/basis/alien/complex/complex-tests.factor
index 7bf826d87e10f191bb1dfa5ab6d52cfddce4027d..87f0c98b474336e1bb43b236ded6f29435703467 100644 (file)
--- a/basis/alien/complex/complex-tests.factor
+++ b/basis/alien/complex/complex-tests.factor
@@ -16,6 +16,6 @@ STRUCT: complex-holder
 
 [ C{ 1.0 2.0 } ] [ "h" get z>> ] unit-test
 
-[ number ] [ "complex-float" c-type-boxed-class ] unit-test
+[ complex ] [ "complex-float" c-type-boxed-class ] unit-test
 
-[ number ] [ "complex-double" c-type-boxed-class ] unit-test
+[ complex ] [ "complex-double" c-type-boxed-class ] unit-test

diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index 63f2ad282eb4b1c30dca09a00d5401f474c0bf53..beddf07dd5ea565fc143ca74a15282517b9fead1 100755 (executable)
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -27,9 +27,10 @@ PREDICATE: struct-class < tuple-class
 
 M: struct-class valid-superclass? drop f ;
 
-GENERIC: struct-slots ( struct-class -- slots )
+SLOT: fields
 
-M: struct-class struct-slots "struct-slots" word-prop ;
+: struct-slots ( struct-class -- slots )
+    "c-type" word-prop fields>> ;
 
 ! struct allocation
 
@@ -175,16 +176,15 @@ M: struct-c-type c-struct? drop t ;
     [ \ clone-underlying swap literalize \ memory>struct [ ] 3sequence ] bi
     define-inline-method ;
 
-: c-type-for-class ( class -- c-type )
-    struct-c-type new swap {
-        [ drop byte-array >>class ]
-        [ >>boxed-class ]
-        [ struct-slots >>fields ]
-        [ "struct-size" word-prop >>size ]
-        [ "struct-align" word-prop >>align ]
-        [ (unboxer-quot) >>unboxer-quot ]
-        [ (boxer-quot) >>boxer-quot ]
-    } cleave ;
+:: c-type-for-class ( class slots size align -- c-type )
+    struct-c-type new
+        byte-array >>class
+        class >>boxed-class
+        slots >>fields
+        size >>size
+        align >>align
+        class (unboxer-quot) >>unboxer-quot
+        class (boxer-quot)   >>boxer-quot ;
     
 : align-offset ( offset class -- offset' )
     c-type-align align ;
@@ -221,7 +221,7 @@ M: struct binary-zero?
 
 : make-struct-prototype ( class -- prototype )
     dup struct-needs-prototype? [
-        [ "struct-size" word-prop <byte-array> ]
+        [ "c-type" word-prop size>> <byte-array> ]
         [ memory>struct ]
         [ struct-slots ] tri
         [
@@ -236,35 +236,26 @@ M: struct binary-zero?
     [ (define-clone-method) ]
     bi ;
 
-: (struct-word-props) ( class slots size align -- )
-    [
-        [ "struct-slots" set-word-prop ]
-        [ define-accessors ] 2bi
-    ]
-    [ "struct-size" set-word-prop ]
-    [ "struct-align" set-word-prop ] tri-curry*
-    [ tri ] 3curry
-    [ dup make-struct-prototype "prototype" set-word-prop ]
-    [ (struct-methods) ] tri ;
-
 : check-struct-slots ( slots -- )
     [ type>> c-type drop ] each ;
 
 : redefine-struct-tuple-class ( class -- )
     [ dup class? [ forget-class ] [ drop ] if ] [ struct f define-tuple-class ] bi ;
 
-: (define-struct-class) ( class slots offsets-quot -- )
-    [ 
-        empty?
-        [ struct-must-have-slots ]
-        [ redefine-struct-tuple-class ] if
-    ]
-    swap '[
-        make-slots dup
-        [ check-struct-slots ] _ [ struct-align [ align ] keep ] tri
-        (struct-word-props)
-    ]
-    [ drop [ c-type-for-class ] keep typedef ] 2tri ; inline
+:: (define-struct-class) ( class slots offsets-quot -- )
+    slots empty? [ struct-must-have-slots ] when
+    class redefine-struct-tuple-class
+    slots make-slots dup check-struct-slots :> slot-specs
+    slot-specs struct-align :> alignment
+    slot-specs offsets-quot call alignment align :> size
+
+    class  slot-specs  size  alignment  c-type-for-class :> c-type
+
+    c-type class typedef
+    class slot-specs define-accessors
+    class size "struct-size" set-word-prop
+    class dup make-struct-prototype "prototype" set-word-prop
+    class (struct-methods) ; inline
 PRIVATE>
 
 : define-struct-class ( class slots -- )

diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor
index badcac5cdb4965d877e80577b5017050e53feefd..585f23dde37f99525de52b662fa54b99928b63eb 100644 (file)
--- a/basis/cocoa/views/views.factor
+++ b/basis/cocoa/views/views.factor
@@ -40,7 +40,9 @@ CONSTANT: NSOpenGLPFAScreenMask 84
 CONSTANT: NSOpenGLPFAPixelBuffer 90
 CONSTANT: NSOpenGLPFAAllowOfflineRenderers 96
 CONSTANT: NSOpenGLPFAVirtualScreenCount 128
+
 CONSTANT: NSOpenGLCPSwapInterval 222
+CONSTANT: NSOpenGLCPSurfaceOpacity 236
 
 : <GLView> ( class dim pixel-format -- view )
     [ -> alloc ]

diff --git a/basis/cocoa/windows/windows.factor b/basis/cocoa/windows/windows.factor
index ed2c2d51bd6fbcc948422d35e3119276dbd26538..a4b1b7f210f5c5bb81188ad8015640029e2b60d1 100644 (file)
--- a/basis/cocoa/windows/windows.factor
+++ b/basis/cocoa/windows/windows.factor
@@ -5,11 +5,12 @@ sequences math.bitwise ;
 IN: cocoa.windows
 
 ! Window styles
-CONSTANT: NSBorderlessWindowMask     0
-CONSTANT: NSTitledWindowMask         1
-CONSTANT: NSClosableWindowMask       2
-CONSTANT: NSMiniaturizableWindowMask 4
-CONSTANT: NSResizableWindowMask      8
+CONSTANT: NSBorderlessWindowMask           0
+CONSTANT: NSTitledWindowMask               1
+CONSTANT: NSClosableWindowMask             2
+CONSTANT: NSMiniaturizableWindowMask       4
+CONSTANT: NSResizableWindowMask            8
+CONSTANT: NSTexturedBackgroundWindowMask 256
 
 ! Additional panel-only styles 
 CONSTANT: NSUtilityWindowMask       16
@@ -26,7 +27,7 @@ CONSTANT: NSBackingStoreBuffered    2
     -> initWithContentRect:styleMask:backing:defer: ;
 
 : class-for-style ( style -- NSWindow/NSPanel )
-    HEX: 1ff0 bitand zero? NSWindow NSPanel ? ;
+    HEX: 1ef0 bitand zero? NSWindow NSPanel ? ;
 
 : <ViewWindow> ( view rect style -- window )
     dup class-for-style <NSWindow> [ swap -> setContentView: ] keep

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index f67c73e2e950978bda7f7eb13dcb14d0f9faad94..7e1060cbb9a9a5984e9943e759bfeef5444e87bd 100644 (file)
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -338,6 +338,8 @@ M: ppc %abs-vector-reps { } ;
 M: ppc %and-vector-reps { } ;
 M: ppc %or-vector-reps { } ;
 M: ppc %xor-vector-reps { } ;
+M: ppc %shl-vector-reps { } ;
+M: ppc %shr-vector-reps { } ;
 
 M: ppc %unbox-alien ( dst src -- )
     alien-offset LWZ ;

diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 7a7d1befd92ff42fe6116a6775622e1770e13445..34d508fcf2677635e3451941ee0a5d044a94acdf 100755 (executable)
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -40,6 +40,7 @@ M:: x86.32 %dispatch ( src temp -- )
 ! Registers for fastcall
 M: x86.32 param-reg-1 EAX ;
 M: x86.32 param-reg-2 EDX ;
+M: x86.32 param-reg-3 ECX ;
 
 M: x86.32 pic-tail-reg EBX ;
 

diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index c33368fc91cb38d4ab7838f61af0bebb0843ade2..8363f7a18b1e2a2e028d9bafd66b39f487199004 100644 (file)
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -38,7 +38,7 @@ M:: x86.64 %dispatch ( src temp -- )
 
 M: x86.64 param-reg-1 int-regs param-regs first ;
 M: x86.64 param-reg-2 int-regs param-regs second ;
-: param-reg-3 ( -- reg ) int-regs param-regs third ; inline
+M: x86.64 param-reg-3 int-regs param-regs third ;
 
 M: x86.64 pic-tail-reg RBX ;
 

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 8585dfa697cea2d67c4447800838fb2f5faea915..25dca527f600732b756b2bcbade9dd8b58ba7bf7 100644 (file)
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -55,6 +55,7 @@ HOOK: temp-reg cpu ( -- reg )
 ! Fastcall calling convention
 HOOK: param-reg-1 cpu ( -- reg )
 HOOK: param-reg-2 cpu ( -- reg )
+HOOK: param-reg-3 cpu ( -- reg )
 
 HOOK: pic-tail-reg cpu ( -- reg )
 
@@ -832,8 +833,10 @@ M:: x86 %call-gc ( gc-root-count -- )
     param-reg-1 gc-root-base param@ LEA
     ! Pass number of roots as second parameter
     param-reg-2 gc-root-count MOV
+    ! Pass vm as third argument
+    param-reg-3 0 MOV rc-absolute-cell rt-vm rel-fixup
     ! Call GC
-    "inline_gc" %vm-invoke-3rd-arg ; 
+    "inline_gc" f %alien-invoke ; 
 
 M: x86 %alien-global ( dst symbol library -- )
     [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;    

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 2b4c38beaf8d9f7ac15f4154b68377e520f02fc2..825b6f9c54cf31b71c3a4b9eacc70fb8340d9318 100755 (executable)
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -198,7 +198,7 @@ IN: tools.deploy.shaker
         ] when
         
         deploy-c-types? get [
-            { "c-type" "struct-slots" "struct-size" "struct-align" } %
+            { "c-type" "struct-slots" "struct-align" } %
         ] unless
     ] { } make ;
 

diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor
index 111e20aea20c7187168064794615a9aae5d56fda..0213b8433c900d01ed84d2dc71d8cef14a43541b 100755 (executable)
--- a/basis/ui/backend/cocoa/cocoa.factor
+++ b/basis/ui/backend/cocoa/cocoa.factor
@@ -7,7 +7,7 @@ cocoa.views cocoa.windows combinators command-line
 core-foundation core-foundation.run-loop core-graphics
 core-graphics.types destructors fry generalizations io.thread
 kernel libc literals locals math math.bitwise math.rectangles memory
-namespaces sequences threads ui
+namespaces sequences threads ui colors
 ui.backend ui.backend.cocoa.views ui.clipboards ui.gadgets
 ui.gadgets.worlds ui.pixel-formats ui.pixel-formats.private
 ui.private words.symbol ;
@@ -117,14 +117,21 @@ CONSTANT: window-control>styleMask
         { resize-handles $ NSResizableWindowMask }
         { small-title-bar $[ NSTitledWindowMask NSUtilityWindowMask bitor ] }
         { normal-title-bar $ NSTitledWindowMask }
+        { textured-background $ NSTexturedBackgroundWindowMask }
     }
 
 : world>styleMask ( world -- n )
     window-controls>> window-control>styleMask symbols>flags ;
 
+: make-context-transparent ( view -- )
+    -> openGLContext
+    0 <int> NSOpenGLCPSurfaceOpacity -> setValues:forParameter: ;
+
 M:: cocoa-ui-backend (open-window) ( world -- )
     world [ [ dim>> ] dip <FactorView> ]
     with-world-pixel-format :> view
+    world window-controls>> textured-background swap memq?
+    [ view make-context-transparent ] when
     view world [ world>NSRect ] [ world>styleMask ] bi <ViewWindow> :> window
     view -> release
     world view register-window

diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor
index a49d22735d08741d2ed45df95ee19160a43b5647..9577696314480d4d1f7e8863fa92b5d06350b940 100644 (file)
--- a/basis/ui/backend/cocoa/views/views.factor
+++ b/basis/ui/backend/cocoa/views/views.factor
@@ -399,6 +399,12 @@ CLASS: {
     ]
 }
 
+{ "isOpaque" "char" { "id" "SEL" }
+    [
+        2drop 0
+    ]
+}
+
 { "dealloc" "void" { "id" "SEL" }
     [
         drop

diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 1e01f889dc3cbc76fb0bc81a93e032dfdb3e97d5..0e07ff6611cac616fc2ac496c01e325db5f690ff 100755 (executable)
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -5,14 +5,14 @@ USING: alien alien.c-types alien.strings arrays assocs ui
 ui.private ui.gadgets ui.gadgets.private ui.backend
 ui.clipboards ui.gadgets.worlds ui.gestures ui.event-loop io
 kernel math math.vectors namespaces make sequences strings
-vectors words windows.kernel32 windows.gdi32 windows.user32
-windows.opengl32 windows.messages windows.types
-windows.offscreen windows.nt threads libc combinators fry
-combinators.short-circuit continuations command-line shuffle
+vectors words windows.dwmapi system-info.windows windows.kernel32
+windows.gdi32 windows.user32 windows.opengl32 windows.messages
+windows.types windows.offscreen windows.nt threads libc combinators
+fry combinators.short-circuit continuations command-line shuffle
 opengl ui.render math.bitwise locals accessors math.rectangles
 math.order calendar ascii sets io.encodings.utf16n
 windows.errors literals ui.pixel-formats
-ui.pixel-formats.private memoize classes
+ui.pixel-formats.private memoize classes colors
 specialized-arrays classes.struct alien.data ;
 SPECIALIZED-ARRAY: POINT
 IN: ui.backend.windows
@@ -230,6 +230,7 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ;
 CONSTANT: window-control>style
     H{
         { close-button 0 }
+        { textured-background 0 }
         { minimize-button $ WS_MINIMIZEBOX }
         { maximize-button $ WS_MAXIMIZEBOX }
         { resize-handles $ WS_THICKFRAME }
@@ -240,6 +241,7 @@ CONSTANT: window-control>style
 CONSTANT: window-control>ex-style
     H{
         { close-button 0 }
+        { textured-background 0 }
         { minimize-button 0 }
         { maximize-button 0 }
         { resize-handles $ WS_EX_WINDOWEDGE }
@@ -531,6 +533,21 @@ SYMBOL: nc-buttons
     #! message sent if mouse leaves main application 
     4drop forget-rollover ;
 
+: system-background-color ( -- color )
+    COLOR_BTNFACE GetSysColor RGB>color ;
+
+: ?make-glass ( world hwnd -- )
+    over window-controls>> textured-background swap memq? [
+        composition-enabled? [
+            full-window-margins DwmExtendFrameIntoClientArea drop
+            T{ rgba f 0.0 0.0 0.0 0.0 }
+        ] [ drop system-background-color ] if >>background-color
+        drop
+    ] [ 2drop ] if ;
+
+: handle-wm-dwmcompositionchanged ( hWnd uMsg wParam lParam -- )
+    3drop [ window ] keep ?make-glass ;
+
 SYMBOL: wm-handlers
 
 H{ } clone wm-handlers set-global
@@ -560,6 +577,7 @@ H{ } clone wm-handlers set-global
 [ handle-wm-buttonup 0   ] WM_LBUTTONUP   add-wm-handler
 [ handle-wm-buttonup 0   ] WM_MBUTTONUP   add-wm-handler
 [ handle-wm-buttonup 0   ] WM_RBUTTONUP   add-wm-handler
+[ handle-wm-dwmcompositionchanged 0   ] WM_DWMCOMPOSITIONCHANGED add-wm-handler
 
 [ 4dup handle-wm-ncbutton DefWindowProc ]
 { WM_NCLBUTTONDOWN WM_NCMBUTTONDOWN WM_NCRBUTTONDOWN
@@ -688,8 +706,9 @@ M: windows-ui-backend (open-window) ( world -- )
     [
         dup
         [ ] [ world>style ] [ world>ex-style ] tri create-window
+        [ ?make-glass ]
         [ ?disable-close-button ]
-        [ [ f f ] dip f f <win> >>handle setup-gl ] 2bi
+        [ [ f f ] dip f f <win> >>handle setup-gl ] 2tri
     ]
     [ dup handle>> hWnd>> register-window ]
     [ handle>> hWnd>> show-window ] tri ;

diff --git a/basis/ui/backend/x11/x11.factor b/basis/ui/backend/x11/x11.factor
index aab7fd4c340cf54c276989f3937402eb41b39103..56bc3364ac6ea09e6b732a1ea6c637539cb5022b 100755 (executable)
--- a/basis/ui/backend/x11/x11.factor
+++ b/basis/ui/backend/x11/x11.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2009 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays ascii assocs
+USING: accessors alien.c-types arrays ascii assocs colors
 classes.struct combinators io.encodings.ascii
 io.encodings.string io.encodings.utf8 kernel literals math
 namespaces sequences strings ui ui.backend ui.clipboards

diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index 91666c4e7a786164412a48d0d14a8e71a1084902..b736c3f74f377247ef27e3f3d121415ec32399e3 100755 (executable)
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs continuations kernel math models
-namespaces opengl opengl.textures sequences io combinators
+namespaces opengl opengl.textures sequences io colors combinators
 combinators.short-circuit fry math.vectors math.rectangles cache
 ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
 ui.pixel-formats destructors literals strings ;
@@ -13,10 +13,15 @@ SYMBOLS:
     maximize-button
     resize-handles
     small-title-bar
-    normal-title-bar ;
+    normal-title-bar
+    textured-background ;
 
 CONSTANT: default-world-pixel-format-attributes
-    { windowed double-buffered T{ depth-bits { value 16 } } }
+    {
+        windowed
+        double-buffered
+        T{ depth-bits { value 16 } }
+    }
 
 CONSTANT: default-world-window-controls
     {
@@ -34,6 +39,7 @@ TUPLE: world < track
     text-handle handle images
     window-loc
     pixel-format-attributes
+    background-color
     window-controls
     window-resources ;
 
@@ -113,12 +119,18 @@ M: world request-focus-on ( child gadget -- )
         f >>grab-input?
         V{ } clone >>window-resources ;
 
+: initial-background-color ( attributes -- color )
+    window-controls>> textured-background swap memq?
+    [ T{ rgba f 0.0 0.0 0.0 0.0 } ]
+    [ T{ rgba f 1.0 1.0 1.0 1.0 } ] if ;
+
 : apply-world-attributes ( world attributes -- world )
     {
         [ title>> >>title ]
         [ status>> >>status ]
         [ pixel-format-attributes>> >>pixel-format-attributes ]
         [ window-controls>> >>window-controls ]
+        [ initial-background-color >>background-color ]
         [ grab-input?>> >>grab-input? ]
         [ gadgets>> [ 1 track-add ] each ]
     } cleave ;

diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor
index c4e6f5688639d1b21a125a237e6895070495f45f..8ce90742258768bab3a321969611561cab977b36 100755 (executable)
--- a/basis/ui/render/render.factor
+++ b/basis/ui/render/render.factor
@@ -27,18 +27,20 @@ SYMBOL: viewport-translation
     [ clip set ] bi
     do-clip ;
 
-: init-gl ( clip-rect -- )
+SLOT: background-color
+
+: init-gl ( world -- )
     GL_SMOOTH glShadeModel
     GL_SCISSOR_TEST glEnable
     GL_BLEND glEnable
     GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
     GL_VERTEX_ARRAY glEnableClientState
     init-matrices
-    init-clip
-    ! white gl-clear is broken w.r.t window resizing
-    ! Linux/PPC Radeon 9200
-    COLOR: white gl-color
-    { 0 0 } clip get dim>> gl-fill-rect ;
+    [ init-clip ]
+    [
+        background-color>> >rgba-components glClearColor
+        GL_COLOR_BUFFER_BIT glClear
+    ] bi ;
 
 GENERIC: draw-gadget* ( gadget -- )
 

diff --git a/basis/ui/ui-docs.factor b/basis/ui/ui-docs.factor
index 43dd22cde7e0a4116e0ba4ff57286aa53962c689..6072cbc65f4af92864105ad72c2de0056970ec18 100644 (file)
--- a/basis/ui/ui-docs.factor
+++ b/basis/ui/ui-docs.factor
@@ -290,6 +290,9 @@ HELP: small-title-bar
 HELP: normal-title-bar
 { $description "Asks for a window to have a title bar. Without a title bar, the " { $link close-button } ", " { $link minimize-button } ", and " { $link maximize-button } " controls will not be available." } ;
 
+HELP: textured-background
+{ $description "Asks for a window to have a background that blends seamlessly with the window frame. Factor will leave the window background transparent and pass mouse button gestures not handled directly by a gadget through to the window system so that the window can be dragged from anywhere on its background." } ;
+
 ARTICLE: "ui.gadgets.worlds-window-controls" "Window controls"
 "The following window controls can be placed in a " { $link world } " window:"
 { $subsection close-button }
@@ -298,4 +301,5 @@ ARTICLE: "ui.gadgets.worlds-window-controls" "Window controls"
 { $subsection resize-handles }
 { $subsection small-title-bar }
 { $subsection normal-title-bar }
+{ $subsection textured-background }
 "Provide a sequence of these values in the " { $snippet "window-controls" } " slot of the " { $link world-attributes } " tuple you pass to " { $link open-window } "." ;

diff --git a/basis/unix/statfs/freebsd/freebsd.factor b/basis/unix/statfs/freebsd/freebsd.factor
index d1e7949a54a34e7035a0af38278d609ed55691ed..f8c8257a4e9351d305b3ed02bd981ced537b8ab7 100644 (file)
--- a/basis/unix/statfs/freebsd/freebsd.factor
+++ b/basis/unix/statfs/freebsd/freebsd.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax unix.types unix.stat classes.struct ;
+USING: alien.syntax alien.c-types unix.types unix.stat classes.struct ;
 IN: unix.statfs.freebsd
 
 CONSTANT: MFSNAMELEN      16            ! length of type name including null */

diff --git a/basis/windows/dwmapi/dwmapi.factor b/basis/windows/dwmapi/dwmapi.factor
index e7e0b4b8efc9e89f882a21cfd14cea313f07a028..998846ebc2bbe272ab9a9abb8cc029ad1b87ee88 100755 (executable)
--- a/basis/windows/dwmapi/dwmapi.factor
+++ b/basis/windows/dwmapi/dwmapi.factor
@@ -1,5 +1,6 @@
 ! (c)2009 Joe Groff bsd license
-USING: alien.c-types alien.libraries alien.syntax classes.struct windows.types ;
+USING: alien.c-types alien.data alien.libraries alien.syntax
+classes.struct kernel math system-info.windows windows.types ;
 IN: windows.dwmapi
 
 STRUCT: MARGINS
@@ -26,3 +27,11 @@ LIBRARY: dwmapi
 
 FUNCTION: HRESULT DwmExtendFrameIntoClientArea ( HWND hWnd, MARGINS* pMarInset ) ;
 FUNCTION: HRESULT DwmEnableBlurBehindWindow ( HWND hWnd, DWM_BLURBEHIND* pBlurBehind ) ;
+FUNCTION: HRESULT DwmIsCompositionEnabled ( BOOL* pfEnabled ) ;
+
+CONSTANT: WM_DWMCOMPOSITIONCHANGED HEX: 31E
+
+: composition-enabled? ( -- ? )
+    windows-major 6 >=
+    [ 0 <int> [ DwmIsCompositionEnabled drop ] keep *int c-bool> ]
+    [ f ] if ;

diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index 6275f2d3c95a9007e43b1b358e099a25b71a0a15..f3455fbb0f830802c1ada71885a8c9a0a7f84f8a 100755 (executable)
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -378,9 +378,15 @@ TYPEDEF: DWORD* LPCOLORREF
 
 : RGB ( r g b -- COLORREF )
     { 16 8 0 } bitfield ; inline
+: >RGB< ( COLORREF -- r g b )
+    [           HEX: ff bitand ]
+    [  -8 shift HEX: ff bitand ]
+    [ -16 shift HEX: ff bitand ] tri ;
 
 : color>RGB ( color -- COLORREF )
     >rgba-components drop [ 255 * >integer ] tri@ RGB ;
+: RGB>color ( COLORREF -- color )
+    >RGB< [ 1/255. * >float ] tri@ 1.0 <rgba> ;
 
 STRUCT: TEXTMETRICW
     { tmHeight LONG }

diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor
index 4c39385ce5b239c7c513929d312705efd694971c..43b59d613b03843733f1ffe5fe6404fe0701b897 100755 (executable)
--- a/basis/windows/user32/user32.factor
+++ b/basis/windows/user32/user32.factor
@@ -998,7 +998,7 @@ FUNCTION: int GetPriorityClipboardFormat ( UINT* paFormatPriorityList, int cForm
 ! FUNCTION: GetScrollRange
 ! FUNCTION: GetShellWindow
 ! FUNCTION: GetSubMenu
-! FUNCTION: GetSysColor
+FUNCTION: COLORREF GetSysColor ( int nIndex ) ;
 FUNCTION: HBRUSH GetSysColorBrush ( int nIndex ) ;
 FUNCTION: HMENU GetSystemMenu ( HWND hWnd, BOOL bRevert ) ;
 ! FUNCTION: GetSystemMetrics

diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor
index 49287ed1126847f7cbdee4e37f8324dff924a186..0a5572e5308e67ba9a2abd8e3902c0473aa4c4af 100644 (file)
--- a/core/strings/parser/parser.factor
+++ b/core/strings/parser/parser.factor
@@ -74,7 +74,7 @@ name>char-hook [
 
 <PRIVATE
 
-: lexer-before ( i -- before )
+: lexer-subseq ( i -- before )
     [
         [
             lexer get
@@ -84,11 +84,6 @@ name>char-hook [
         lexer get (>>column)
     ] bi ;
 
-: find-next-token ( ch -- i elt )
-    CHAR: \ 2array
-    [ lexer get [ column>> ] [ line-text>> ] bi ] dip
-    [ member? ] curry find-from ;
-
 : rest-of-line ( lexer -- seq )
     [ line-text>> ] [ column>> ] bi tail-slice ;
 
@@ -107,11 +102,7 @@ ERROR: escaped-char-expected ;
         escaped-char-expected
     ] if ;
 
-: next-line% ( lexer -- )
-    [ rest-of-line % ]
-    [ next-line "\n" % ] bi ;
-
-: rest-begins? ( string -- ? )
+: lexer-head? ( string -- ? )
     [
         lexer get [ line-text>> ] [ column>> ] bi tail-slice
     ] dip head? ;
@@ -119,6 +110,15 @@ ERROR: escaped-char-expected ;
 : advance-lexer ( n -- )
     [ lexer get ] dip [ + ] curry change-column drop ; inline
 
+: find-next-token ( ch -- i elt )
+    CHAR: \ 2array
+    [ lexer get [ column>> ] [ line-text>> ] bi ] dip
+    [ member? ] curry find-from ;
+
+: next-line% ( lexer -- )
+    [ rest-of-line % ]
+    [ next-line "\n" % ] bi ;
+
 : take-double-quotes ( -- string )
     lexer get dup current-char CHAR: " = [
         [ ] [ column>> ] [ line-text>> ] tri
@@ -138,29 +138,29 @@ ERROR: escaped-char-expected ;
         lexer get advance-char
     ] if ;
 
-DEFER: (parse-long-string)
+DEFER: (parse-multiline-string)
 
 : parse-found-token ( i string token -- )
-    [ lexer-before % ] dip
+    [ lexer-subseq % ] dip
     CHAR: \ = [
-        lexer get [ next-char , ] [ next-char , ] bi (parse-long-string)
+        lexer get [ next-char , ] [ next-char , ] bi (parse-multiline-string)
     ] [
-        dup rest-begins? [
+        dup lexer-head? [
             end-string-parse
         ] [
-            lexer get next-char , (parse-long-string)
+            lexer get next-char , (parse-multiline-string)
         ] if
     ] if ;
 
 ERROR: trailing-characters string ;
 
-: (parse-long-string) ( string -- )
+: (parse-multiline-string) ( string -- )
     lexer get still-parsing? [
         dup first find-next-token [
             parse-found-token
         ] [
             drop lexer get next-line%
-            (parse-long-string)
+            (parse-multiline-string)
         ] if*
     ] [
         unexpected-eof
@@ -168,13 +168,10 @@ ERROR: trailing-characters string ;
 
 PRIVATE>
 
-: parse-long-string ( string -- string' )
-    [ (parse-long-string) ] "" make ;
-
 : parse-multiline-string ( -- string )
     lexer get rest-of-line "\"\"" head? [
         lexer get [ 2 + ] change-column drop
         "\"\"\""
     ] [
         "\""
-    ] if parse-long-string unescape-string ;
+    ] if [ (parse-multiline-string) ] "" make unescape-string ;

diff --git a/extra/benchmark/e-decimals/authors.txt b/extra/benchmark/e-decimals/authors.txt
new file mode 100644 (file)
index 0000000..b4bd0e7
--- /dev/null
+++ b/extra/benchmark/e-decimals/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file

diff --git a/extra/benchmark/e-decimals/e-decimals.factor b/extra/benchmark/e-decimals/e-decimals.factor
new file mode 100644 (file)
index 0000000..d202e5f
--- /dev/null
+++ b/extra/benchmark/e-decimals/e-decimals.factor
@@ -0,0 +1,14 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: decimals kernel locals math math.combinatorics math.ranges
+sequences ;
+IN: benchmark.e-decimals
+
+:: calculate-e-decimals ( n -- e )
+    n [1,b] [ factorial 0 <decimal> D: 1 swap n D/ ] map
+    D: 1 [ D+ ] reduce ;
+
+: calculate-e-decimals-benchmark ( -- )
+    5 [ 800 calculate-e-decimals drop ] times ;
+
+MAIN: calculate-e-decimals-benchmark

diff --git a/extra/benchmark/e-ratios/authors.txt b/extra/benchmark/e-ratios/authors.txt
new file mode 100644 (file)
index 0000000..b4bd0e7
--- /dev/null
+++ b/extra/benchmark/e-ratios/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file

diff --git a/extra/benchmark/e-ratios/e-ratios.factor b/extra/benchmark/e-ratios/e-ratios.factor
new file mode 100644 (file)
index 0000000..4957822
--- /dev/null
+++ b/extra/benchmark/e-ratios/e-ratios.factor
@@ -0,0 +1,12 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.combinatorics math.ranges sequences ;
+IN: benchmark.e-ratios
+
+: calculate-e-ratios ( n -- e )
+    iota [ factorial recip ] sigma ;
+
+: calculate-e-ratios-benchmark ( -- )
+    5 [ 300 calculate-e-ratios drop ] times ;
+
+MAIN: calculate-e-ratios-benchmark

diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor
index f7aadb9a54fec6dfc36151601527a7daea296383..9867038ef15d8de02ce4833d952a73ca58765314 100644 (file)
--- a/extra/webapps/mason/mason.factor
+++ b/extra/webapps/mason/mason.factor
@@ -139,14 +139,14 @@ CONSTANT: cpus
             { "macosx" "Mac OS X 10.5 Leopard" }
             { "linux" "Ubuntu Linux 9.04 (other distributions may also work)" }
             { "freebsd" "FreeBSD 7.0" }
-            { "netbsd" "NetBSD 4.0" }
+            { "netbsd" "NetBSD 5.0" }
             { "openbsd" "OpenBSD 4.4" }
         } at
     ] [
         dup cpu>> "x86.32" = [
             os>> {
-                { [ dup { "winnt" "linux" "freebsd" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] }
-                { [ dup { "netbsd" "openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] }
+                { [ dup { "winnt" "linux" "freebsd"  "netbsd" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] }
+                { [ dup {"openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] }
                 { [ t ] [ drop f ] }
             } cond
         ] [ drop f ] if

diff --git a/extra/window-controls-demo/window-controls-demo.factor b/extra/window-controls-demo/window-controls-demo.factor
index 89e4c7001f9389daea04c9b8b39f075f7e4ec3f7..72811a2c7b18e275702ee1276b47ebb2358f84f2 100755 (executable)
--- a/extra/window-controls-demo/window-controls-demo.factor
+++ b/extra/window-controls-demo/window-controls-demo.factor
@@ -13,6 +13,7 @@ CONSTANT: window-control-sets-to-test
         { "Minimize button" { normal-title-bar minimize-button } }
         { "Close, minimize, and maximize buttons" { normal-title-bar close-button minimize-button maximize-button } }
         { "Resizable" { normal-title-bar close-button minimize-button maximize-button resize-handles } }
+        { "Textured background" { normal-title-bar close-button minimize-button maximize-button resize-handles textured-background } }
     }
 
 TUPLE: window-controls-demo-world < world

diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S
index 3a5907cc78cafe6b8c80ce436459a603f089cc7b..3eeb7980933ee2b809770a1c175b0e780ed0edbc 100644 (file)
--- a/vm/cpu-x86.32.S
+++ b/vm/cpu-x86.32.S
@@ -94,12 +94,10 @@ DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
        jmp *QUOT_XT_OFFSET(ARG0)
 
 DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
-       mov ARG1,NV_TEMP_REG         /* stash vm ptr */
+       mov ARG1,ARG2
        mov STACK_REG,ARG1           /* Save stack pointer */
        sub $STACK_PADDING,STACK_REG
-       push NV_TEMP_REG             /* push vm ptr as arg3 */
        call MANGLE(lazy_jit_compile_impl)
-       pop NV_TEMP_REG
        mov RETURN_REG,ARG0          /* No-op on 32-bit */
        add $STACK_PADDING,STACK_REG
     jmp *QUOT_XT_OFFSET(ARG0)    /* Call the quotation */

diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S
index 93c1da6430482b6df2ce2c634d8eee3352ec98b6..e9116f8f65530de5f403a3d4beeb992261b9cc8f 100644 (file)
--- a/vm/cpu-x86.S
+++ b/vm/cpu-x86.S
@@ -48,9 +48,7 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
        
        /* Save stack pointer */
        lea -CELL_SIZE(STACK_REG),ARG0
-       push ARG1  /* save vm ptr */
        call MANGLE(save_callstack_bottom)
-       pop ARG1
        
        /* Call quot-xt */
        mov NV_TEMP_REG,ARG0

diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp
index 8766cc8c7c60a744d0ad69c8efc3763c55350eaf..590000611a5907cb76d5ec16d805a7544bd4dd4d 100755 (executable)
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@@ -681,7 +681,7 @@ void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
                gc_locals.pop_back();
 }
 
-VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm)
+VM_ASM_API_OVERFLOW void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm)
 {
        ASSERTVM();
        VM_PTR->inline_gc(gc_roots_base,gc_roots_size);

diff --git a/vm/data_gc.hpp b/vm/data_gc.hpp
index 411c4d19fe2383a82319b756a4fe3114b9c4267f..4ef89c23272f8e4bcd6f0ba338ea481b88c52352 100755 (executable)
--- a/vm/data_gc.hpp
+++ b/vm/data_gc.hpp
@@ -20,6 +20,6 @@ PRIMITIVE(gc_stats);
 PRIMITIVE(clear_gc_stats);
 PRIMITIVE(become);
 struct factor_vm;
-VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm);
+VM_ASM_API_OVERFLOW void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm);
 
 }

diff --git a/vm/quotations.cpp b/vm/quotations.cpp
index 34412149db775bce16d24bfcff794c7926603b4f..5580d8a67e9396163fbfe16e37d8ad0116297340 100755 (executable)
--- a/vm/quotations.cpp
+++ b/vm/quotations.cpp
@@ -369,7 +369,7 @@ cell factor_vm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
        return quot.value();
 }
 
-VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm *myvm)
+VM_ASM_API_OVERFLOW cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm *myvm)
 {
        ASSERTVM();
        return VM_PTR->lazy_jit_compile_impl(quot_,stack);

diff --git a/vm/quotations.hpp b/vm/quotations.hpp
index 3dc8fa585157d17ce2e9ffedba67253e9706aeac..b9b25b8ff34d20cba4b8d6bb5a5e6c5dd879bdc7 100755 (executable)
--- a/vm/quotations.hpp
+++ b/vm/quotations.hpp
@@ -28,7 +28,7 @@ PRIMITIVE(jit_compile);
 PRIMITIVE(array_to_quotation);
 PRIMITIVE(quotation_xt);
 
-VM_ASM_API cell lazy_jit_compile_impl(cell quot, stack_frame *stack, factor_vm *myvm);
+VM_ASM_API_OVERFLOW cell lazy_jit_compile_impl(cell quot, stack_frame *stack, factor_vm *myvm);
 
 PRIMITIVE(quot_compiled_p);