images.loader.gdiplus: fix for the call to GdipBitmapLockBits

GdipBitmapLockBits might trigger gc so the GpRect struct must be copied
to stable stack memory so that the collector doesn't move it.

diff --git a/basis/images/loader/gdiplus/gdiplus.factor b/basis/images/loader/gdiplus/gdiplus.factor
index 6ed16ba3c3cf09684649d1b7add51ba15de5cf01..81fd12b03ddf01002efdf2209b8489d4399ed2fd 100644 (file)
--- a/basis/images/loader/gdiplus/gdiplus.factor
+++ b/basis/images/loader/gdiplus/gdiplus.factor
@@ -1,7 +1,7 @@
 ! (c)2010 Joe Groff bsd license
 USING: accessors alien alien.c-types alien.data alien.enums alien.strings
 assocs byte-arrays classes.struct destructors grouping images images.loader
-io kernel locals math mime.types namespaces sequences specialized-arrays
+io kernel libc locals math mime.types namespaces sequences specialized-arrays
 system windows.com windows.gdiplus windows.streams windows.types ;
 IN: images.loader.gdiplus
 
@@ -32,9 +32,15 @@ os windows? [
     { UINT } [ GdipGetImageHeight check-gdi+-status ]
     with-out-parameters ;
 
-: gdi+-lock-bitmap ( bitmap rect mode format -- data )
-    { BitmapData } [ GdipBitmapLockBits check-gdi+-status ]
-    with-out-parameters ;
+:: gdi+-lock-bitmap ( bitmap rect mode format -- data )
+    ! Copy the rect to stack space because the gc might move it
+    ! because calling GdipBitmapLockBits triggers callbacks to Factor.
+    { BitmapData GpRect } [
+        :> ( stack-data stack-rect )
+        stack-rect rect binary-object memcpy
+        bitmap stack-rect mode format stack-data GdipBitmapLockBits
+        check-gdi+-status
+    ] with-out-parameters drop ;
 
 :: gdi+-bitmap>data ( bitmap -- w h pixels )
     bitmap [ gdi+-bitmap-width ] [ gdi+-bitmap-height ] bi :> ( w h )

diff --git a/basis/images/loader/loader-tests.factor b/basis/images/loader/loader-tests.factor
index 8691a680e6f560f71d426ab42faa72501fca227f..16da2c5435e1f7eda31923294dc1546f7a6829f2 100644 (file)
--- a/basis/images/loader/loader-tests.factor
+++ b/basis/images/loader/loader-tests.factor
@@ -57,3 +57,10 @@ os { linux windows } member? [
         "foo.png" temp-file [ save-graphic-image ] [ load-image ] bi =
     ] unit-test
 ] when
+
+! On Windows, this image didn't load due to a funny problem with a
+! callback triggering a gc causing an important pointer to be
+! moved. Only happened with tiff images too.
+{ { 1024 768 } } [
+    "vocab:gpu/demos/bunny/loading.tiff" load-image dim>>
+] unit-test