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

basis/checksums/md5/md5.factor

@@ -14,7 +14,7 @@ IN: checksums.md5
 SYMBOLS: a b c d old-a old-b old-c old-d ;
 
 : T ( N -- Y )
-    sin abs 4294967296 * >integer ; foldable
+    sin abs 32 2^ * >integer ; foldable
 
 : initialize-md5 ( -- )
     0 bytes-read set

basis/io/mmap/functor/functor.factor

@@ -9,13 +9,14 @@ SLOT: length
 
 : mapped-file>direct ( mapped-file type -- alien length )
     [ [ address>> ] [ length>> ] bi ] dip
-    heap-size [ 1- + ] keep /i ;
+    heap-size [ 1 - + ] keep /i ;
 
 FUNCTOR: define-mapped-array ( T -- )
 
-<mapped-A>         DEFINES <mapped-${T}-array>
-<A>                IS      <direct-${T}-array>
-with-mapped-A-file DEFINES with-mapped-${T}-file
+<mapped-A>                DEFINES <mapped-${T}-array>
+<A>                       IS      <direct-${T}-array>
+with-mapped-A-file        DEFINES with-mapped-${T}-file
+with-mapped-A-file-reader DEFINES with-mapped-${T}-file-reader
 
 WHERE
 
@@ -25,4 +26,7 @@ WHERE
 : with-mapped-A-file ( path quot -- )
     '[ <mapped-A> @ ] with-mapped-file ; inline
 
+: with-mapped-A-file-reader ( path quot -- )
+    '[ <mapped-A> @ ] with-mapped-file-reader ; inline
+
 ;FUNCTOR

basis/io/mmap/mmap-docs.factor

@@ -18,7 +18,13 @@ HELP: <mapped-file>
 
 HELP: with-mapped-file
 { $values { "path" "a pathname string" } { "quot" { $quotation "( mmap -- )" } } }
-{ $contract "Opens a file and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
+{ $contract "Opens a file for read/write access and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
+{ $notes "This is a low-level word, because " { $link mapped-file } " objects simply expose their base address and length. Most applications should use " { $link "io.mmap.arrays" } " instead." }
+{ $errors "Throws an error if a memory mapping could not be established." } ;
+
+HELP: with-mapped-file-reader
+{ $values { "path" "a pathname string" } { "quot" { $quotation "( mmap -- )" } } }
+{ $contract "Opens a file for read-only access and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
 { $notes "This is a low-level word, because " { $link mapped-file } " objects simply expose their base address and length. Most applications should use " { $link "io.mmap.arrays" } " instead." }
 { $errors "Throws an error if a memory mapping could not be established." } ;
 

basis/io/mmap/mmap-tests.factor

@@ -7,6 +7,7 @@ IN: io.mmap.tests
 [ ] [ "12345" "mmap-test-file.txt" temp-file ascii set-file-contents ] unit-test
 [ ] [ "mmap-test-file.txt" temp-file [ CHAR: 2 0 pick set-nth drop ] with-mapped-char-file ] unit-test
 [ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file ] unit-test
+[ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file-reader ] unit-test
 [ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test
 [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
 

basis/io/mmap/mmap.factor

@@ -8,14 +8,27 @@ IN: io.mmap
 
 TUPLE: mapped-file address handle length disposed ;
 
-HOOK: (mapped-file) os ( path length -- address handle )
+HOOK: (mapped-file-reader) os ( path length -- address handle )
+HOOK: (mapped-file-r/w) os ( path length -- address handle )
 
 ERROR: bad-mmap-size path size ;
 
-: <mapped-file> ( path -- mmap )
+<PRIVATE
+
+: prepare-mapped-file ( path -- path' n )
     [ normalize-path ] [ file-info size>> ] bi
-    dup 0 <= [ bad-mmap-size ] when
-    [ (mapped-file) ] keep
+    dup 0 <= [ bad-mmap-size ] when ;
+
+PRIVATE>
+
+: <mapped-file-reader> ( path -- mmap )
+    prepare-mapped-file
+    [ (mapped-file-reader) ] keep
+    f mapped-file boa ;
+
+: <mapped-file> ( path -- mmap )
+    prepare-mapped-file
+    [ (mapped-file-r/w) ] keep
     f mapped-file boa ;
 
 HOOK: close-mapped-file io-backend ( mmap -- )
@@ -25,6 +38,9 @@ M: mapped-file dispose* ( mmap -- ) close-mapped-file ;
 : with-mapped-file ( path quot -- )
     [ <mapped-file> ] dip with-disposal ; inline
 
+: with-mapped-file-reader ( path quot -- )
+    [ <mapped-file-reader> ] dip with-disposal ; inline
+
 {
     { [ os unix? ] [ "io.mmap.unix" require ] }
     { [ os winnt? ] [ "io.mmap.windows" require ] }

basis/io/mmap/unix/unix.factor

@@ -4,21 +4,23 @@ USING: alien io io.files kernel math math.bitwise system unix
 io.backend.unix io.ports io.mmap destructors locals accessors ;
 IN: io.mmap.unix
 
-: open-r/w ( path -- fd ) O_RDWR file-mode open-file ;
-
-:: mmap-open ( path length prot flags -- alien fd )
+:: mmap-open ( path length prot flags open-mode -- alien fd )
     [
         f length prot flags
-        path open-r/w [ <fd> |dispose drop ] keep
+        path open-mode file-mode open-file [ <fd> |dispose drop ] keep
         [ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep
     ] with-destructors ;
 
-M: unix (mapped-file)
+M: unix (mapped-file-r/w)
     { PROT_READ PROT_WRITE } flags
     { MAP_FILE MAP_SHARED } flags
-    mmap-open ;
+    O_RDWR mmap-open ;
+
+M: unix (mapped-file-reader)
+    { PROT_READ } flags
+    { MAP_FILE MAP_SHARED } flags
+    O_RDONLY mmap-open ;
 
 M: unix close-mapped-file ( mmap -- )
     [ [ address>> ] [ length>> ] bi munmap io-error ]
-    [ handle>> close-file ]
-    bi ;
+    [ handle>> close-file ] bi ;

basis/io/mmap/windows/windows.factor

@@ -28,7 +28,7 @@ M: win32-mapped-file dispose
 
 C: <win32-mapped-file> win32-mapped-file
 
-M: windows (mapped-file)
+M: windows (mapped-file-r/w)
     [
         { GENERIC_WRITE GENERIC_READ } flags
         OPEN_ALWAYS
@@ -37,6 +37,15 @@ M: windows (mapped-file)
         -rot <win32-mapped-file>
     ] with-destructors ;
 
+M: windows (mapped-file-reader)
+    [
+        GENERIC_READ
+        OPEN_ALWAYS
+        { PAGE_READONLY SEC_COMMIT } flags
+        FILE_MAP_READ mmap-open
+        -rot <win32-mapped-file>
+    ] with-destructors ;
+
 M: windows close-mapped-file ( mapped-file -- )
     [
         [ handle>> &dispose drop ]

basis/math/blas/config/config.factor

@@ -18,7 +18,7 @@ blas-fortran-abi [
         { [ os netbsd?  cpu x86.64? and ] [ g95-abi        ] }
         { [ os windows? cpu x86.64? and ] [ gfortran-abi   ] }
         { [ os freebsd?                 ] [ gfortran-abi   ] }
-        { [ os linux?   cpu x86.32? and ] [ gfortran-abi   ] }
+        { [ os linux?                   ] [ gfortran-abi   ] }
         [ f2c-abi ]
     } cond
 ] initialize

extra/id3/id3.factor

@@ -6,7 +6,7 @@ combinators math.ranges unicode.categories byte-arrays
 io.encodings.string io.encodings.utf16 assocs math.parser
 combinators.short-circuit fry namespaces combinators.smart
 splitting io.encodings.ascii arrays io.files.info unicode.case
-io.directories.search literals math.functions ;
+io.directories.search literals math.functions continuations ;
 IN: id3
 
 <PRIVATE
@@ -205,7 +205,9 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
         drop
     ] if ;
 
-: (mp3>id3) ( path -- id3v2/f )
+PRIVATE>
+
+: mp3>id3 ( path -- id3/f )
     [
         [ <id3> ] dip
         {
@@ -213,12 +215,7 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
             [ dup id3v1+? [ read-v1+-tags merge-id3v1 ] [ drop ] if ]
             [ dup id3v2? [ read-v2-tags ] [ drop ] if ]
         } cleave
-    ] with-mapped-uchar-file ;
-
-PRIVATE>
-
-: mp3>id3 ( path -- id3/f )
-    dup file-info size>> 0 <= [ drop f ] [ (mp3>id3) ] if ;
+    ] with-mapped-uchar-file-reader ;
 
 : find-id3-frame ( id3 name -- obj/f )
     swap frames>> at* [ data>> ] when ;
@@ -239,8 +236,14 @@ PRIVATE>
 : find-mp3s ( path -- seq )
     [ >lower ".mp3" tail? ] find-all-files ;
 
+ERROR: id3-parse-error path error ;
+
+: (mp3-paths>id3s) ( seq -- seq' )
+    [ dup [ mp3>id3 ] [ \ id3-parse-error boa ] recover ] { } map>assoc ;
+
 : mp3-paths>id3s ( seq -- seq' )
-    [ dup mp3>id3 ] { } map>assoc ;
+    (mp3-paths>id3s)
+    [ dup second id3-parse-error? [ f over set-second ] when ] map ;
 
 : parse-mp3-directory ( path -- seq )
     find-mp3s mp3-paths>id3s ;

extra/images/viewer/viewer.factor

@@ -2,33 +2,26 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors images images.loader io.pathnames kernel namespaces
 opengl opengl.gl opengl.textures sequences strings ui ui.gadgets
-ui.gadgets.panes ui.render ;
+ui.gadgets.panes ui.render ui.images ;
 IN: images.viewer
 
-TUPLE: image-gadget < gadget { image image } ;
+TUPLE: image-gadget < gadget image-name ;
 
 M: image-gadget pref-dim*
-    image>> dim>> ;
-
-: draw-image ( image -- )
-    0 0 glRasterPos2i 1.0 -1.0 glPixelZoom
-    [ dim>> first2 ] [ component-order>> component-order>format ] [ bitmap>> ] tri
-    glDrawPixels ;
+    image-name>> image-dim ;
 
 M: image-gadget draw-gadget* ( gadget -- )
-    image>> draw-image ;
+    image-name>> draw-image ;
 
-: <image-gadget> ( image -- gadget )
+: <image-gadget> ( image-name -- gadget )
     \ image-gadget new
-        swap >>image ;
+        swap >>image-name ;
 
 : image-window ( path -- gadget )
-    [ load-image <image-gadget> dup ] [ open-window ] bi ;
+    [ <image-name> <image-gadget> dup ] [ open-window ] bi ;
 
 GENERIC: image. ( object -- )
 
-M: string image. ( image -- ) load-image image. ;
+M: string image. ( image -- ) <image-name> <image-gadget> gadget. ;
 
-M: pathname image. ( image -- ) load-image image. ;
-
-M: image image. ( image -- ) <image-gadget> gadget. ;
+M: pathname image. ( image -- ) <image-name> <image-gadget> gadget. ;

extra/mason/notify/notify.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays accessors io io.sockets io.encodings.utf8 io.files
 io.launcher kernel make mason.config mason.common mason.email
-mason.twitter namespaces sequences ;
+mason.twitter namespaces sequences prettyprint ;
 IN: mason.notify
 
 : status-notify ( input-file args -- )
@@ -38,7 +38,7 @@ IN: mason.notify
     f { "test" } status-notify ;
 
 : notify-report ( status -- )
-    [ "Build finished with status: " write print flush ]
+    [ "Build finished with status: " write . flush ]
     [
         [ "report" utf8 file-contents ] dip email-report
         "report" { "report" } status-notify

extra/mason/report/report.factor

@@ -28,7 +28,7 @@ IN: mason.report
         common-report
         _ call( -- xml )
         [XML <html><body><-><-></body></html> XML]
-        pprint-xml
+        write-xml
     ] with-file-writer ; inline
 
 :: failed-report ( error file what -- status )