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

cs & io: repairs for locks & DLL errors

Browse Source
This commit is contained in:
Matthew Flatt 2018-03-23 19:20:14 -06:00
parent f048f23ade
commit 2754f22844
2 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
racket/src/cs/rumble.sls
View File

@ -677,6 +677,7 @@
(include "rumble/object-name.ss")
(include "rumble/arity.ss")
(include "rumble/intmap.ss")
(include "rumble/lock.ss")
(include "rumble/hash.ss")
(include "rumble/datum.ss")
(include "rumble/thread-cell.ss")
@ -709,7 +710,6 @@
(include "rumble/system.ss")
(include "rumble/unsafe.ss")
(include "rumble/extfl.ss")
(include "rumble/lock.ss")
(include "rumble/place.ss")
(include "rumble/foreign.ss")
(include "rumble/future.ss")

21
racket/src/io/foreign/main.rkt
View File

@ -2,6 +2,7 @@
(require "../common/check.rkt"
"../host/thread.rkt"
"../host/rktio.rkt"
"../host/error.rkt"
"../path/path.rkt"
"../file/host.rkt"
"../file/error.rkt"
@ -36,7 +37,7 @@
(raise
(exn:fail:filesystem
(string-append (symbol->string who) ": " msg
"\n system error: " (bytes->string/utf-8 err-str #\?))
"\n system error: " (->string err-str))
(current-continuation-marks)))]
[else
(raise-filesystem-error who dll msg)])])]
@ -60,7 +61,7 @@
(raise
(exn:fail:filesystem
(string-append (symbol->string who) ": " msg
"\n system error: " (bytes->string/utf-8 err-str #\?))
"\n system error: " (->string err-str))
(current-continuation-marks)))]
[else
(raise-filesystem-error who dll msg)])]
@ -70,10 +71,18 @@
(define (dll-get-error v)
(and (rktio-error? v)
(let ([p (rktio_dll_get_error rktio)])
(and p
(begin0
(rktio_to_bytes p)
(rktio_free p))))))
(cond
[(rktio-error? p)
(format-rktio-system-error-message v)]
[else
(begin0
(rktio_to_bytes p)
(rktio_free p))]))))
(define (->string s)
(if (bytes? s)
(bytes->string/utf-8 s #\?)
s))
; ----------------------------------------