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

second attempt at forbidding self-calls, with a long explanation why its forbidden, which is actually a sketch for how to make it work...

Browse Source 
svn: r13376
This commit is contained in:
Eli Barzilay 2009-02-03 13:29:33 +00:00
parent 3d04e81fa0
commit a2537d7dc9
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/scheme/sandbox.ss
View File

@ -615,6 +615,7 @@
(define uncovered #f) (define uncovered #f)
(define input-ch (make-channel)) (define input-ch (make-channel))
(define result-ch (make-channel)) (define result-ch (make-channel))
(define busy-sema (make-semaphore 1))
(define input #f) (define input #f)
(define output #f) (define output #f)
(define error-output #f) (define error-output #f)
@ -705,16 +706,17 @@
(cond [terminated? => raise] (cond [terminated? => raise]
[(not user-thread) [(not user-thread)
(error 'sandbox "internal error (user-thread is #f)")] (error 'sandbox "internal error (user-thread is #f)")]
;; try to put the expression in, but if can't then it means that the ;; use a semaphore to know when we're currently in an evaluation, to
;; evaluator is calling itself -- there is no simple way to make this ;; prevent the evaluator from calling itself (it will deadlock, and
;; work, so throw an error ;; there is no simple way to avoid it -- will require making a stream
;; FIXME: the commented-out part creates a race, because the evaluator ;; of inputs sent to the user context, queueing them as they come in,
;; thread might not be waiting on input-ch, yet; it might be ;; and for each one register a channel for a reply -- and this will
;; in between sending the previous result and waiting for the ;; consume resources outside the user context)
;; next expression [(not (sync/timeout 0 busy-sema))
[(not (sync #|/timeout 0|# (channel-put-evt input-ch expr)))
(error 'evaluator "nested evaluator call with: ~e" expr)] (error 'evaluator "nested evaluator call with: ~e" expr)]
[else (let ([r (get-user-result)]) [else (channel-put input-ch expr)
(let ([r (get-user-result)])
(semaphore-post busy-sema)
(cond [(eof-object? r) (terminate+kill! #t #t)] (cond [(eof-object? r) (terminate+kill! #t #t)]
[(eq? (car r) 'exn) (raise (cdr r))] [(eq? (car r) 'exn) (raise (cdr r))]
[else (apply values (cdr r))]))])) [else (apply values (cdr r))]))]))