suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

racket/draw: fix another problem with the JPEG binding

Browse Source 
JPEG reading and writing involve callbacks that need to be
atomic, since the stack-swapping games that a Racket thread
switch plays may not be ok with the JPEG library (as exposed
by the stress test). So, the JPEG reading and writing code
must read/write a string port, instead of directly from/to
the source/destination port, since a string port can be
used in atomic mode.
This commit is contained in:
Matthew Flatt 2012-12-20 06:21:24 -07:00
parent 1fc222f135
commit c2468f1f9a
2 changed files with 27 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/racket/draw/private/bitmap.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base
(require racket/class
racket/port
racket/unsafe/ops
file/convertible
(for-syntax racket/base)
@ -368,7 +369,10 @@
(install-bytes-rows s w h rows b&w? alpha? pre? #f)
(values s b&w?))))]
[(jpeg jpeg/alpha)
(let ([d (create-decompress in)])
;; We'd like to read directly from `in', but we need to be able
;; to read in atomic mode:
(define bstr (port->bytes in))
(let ([d (create-decompress (open-input-bytes bstr))])
(dynamic-wind
void
(lambda ()
@ -587,7 +591,10 @@
proc
(cairo_surface_write_to_png_stream s proc)))])]
[(jpeg)
(let ([c (create-compress out)])
;; We'd like to write directly to `out', but we need to be able
;; to write in atomic mode:
(define sp (open-output-bytes))
(let ([c (create-compress sp)])
(dynamic-wind
void
(lambda ()
@ -615,7 +622,8 @@
(bytes-set! bstr (+ ci 2) (bytes-ref dest (+ row (+ 4i B)))))))
(jpeg_write_scanlines c samps 1))))
(jpeg_finish_compress c))
(lambda () (destroy-compress c))))]
(lambda () (destroy-compress c))))
(write-bytes (get-output-bytes sp) out)]
[else (error (method-name 'bitmap% 'save-file)
"kind saving not yet implemented: ~e"
kind)])))

25
collects/racket/draw/unsafe/jpeg.rkt
View File

@ -623,7 +623,7 @@
(define create-decompress
((allocator destroy-decompress)
(lambda (in)
(lambda (in) ;; `in' will be read in atomic mode!
(let ([m (ptr-cast (malloc _jpeg_decompress_struct 'raw) _jpeg_decompress_struct-pointer)]
[s (ptr-cast (malloc _jpeg_source_mgr 'raw) _jpeg_source_mgr-pointer)]
[e (ptr-cast (malloc sizeof_jpeg_error_mgr 'raw) _jpeg_error_mgr-pointer)]
@ -640,17 +640,21 @@
(set-jpeg_source_mgr-next_input_byte! s #f)
(set-jpeg_source_mgr-bytes_in_buffer! s 0)
(set-jpeg_source_mgr-init_source! s (cast init-source
(_fun #:keep funs _j_decompress_ptr -> _void)
(_fun #:keep funs #:atomic? #t
_j_decompress_ptr -> _void)
_fpointer))
(set-jpeg_source_mgr-fill_input_buffer! s (cast fill-input-buffer
(_fun #:keep funs _j_decompress_ptr -> _jbool)
(_fun #:keep funs #:atomic? #t
_j_decompress_ptr -> _jbool)
_fpointer))
(set-jpeg_source_mgr-skip_input_data! s (cast skip-input-data
(_fun #:keep funs _j_decompress_ptr _long -> _void)
(_fun #:keep funs #:atomic? #t
_j_decompress_ptr _long -> _void)
_fpointer))
(set-jpeg_source_mgr-resync_to_restart! s jpeg_resync_to_restart)
(set-jpeg_source_mgr-term_source! s (cast term-source
(_fun #:keep funs _j_decompress_ptr -> _void)
(_fun #:keep funs #:atomic? #t
_j_decompress_ptr -> _void)
_fpointer))
m))))
@ -665,7 +669,7 @@
(define create-compress
((allocator destroy-compress)
(lambda (out)
(lambda (out) ;; `out' will be written in atomic mode!
(let ([m (ptr-cast (malloc _jpeg_compress_struct 'raw) _jpeg_compress_struct-pointer)]
[d (ptr-cast (malloc _jpeg_destination_mgr 'raw) _jpeg_destination_mgr-pointer)]
[e (ptr-cast (malloc sizeof_jpeg_error_mgr 'raw) _jpeg_error_mgr-pointer)]
@ -682,13 +686,16 @@
(set-jpeg_destination_mgr-next_output_byte! d b)
(set-jpeg_destination_mgr-free_in_buffer! d BUFFER-SIZE)
(set-jpeg_destination_mgr-init_destination! d (cast init-destination
(_fun #:keep funs _j_compress_ptr -> _void)
(_fun #:keep funs #:atomic? #t
_j_compress_ptr -> _void)
_fpointer))
(set-jpeg_destination_mgr-empty_output_buffer! d (cast empty-output-buffer
(_fun #:keep funs _j_compress_ptr -> _jbool)
(_fun #:keep funs #:atomic? #t
_j_compress_ptr -> _jbool)
_fpointer))
(set-jpeg_destination_mgr-term_destination! d (cast term-destination
(_fun #:keep funs _j_compress_ptr -> _void)
(_fun #:keep funs #:atomic? #t
_j_compress_ptr -> _void)
_fpointer))
m))))