conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fixing bug 210744: Interrupts and IO callbacks not interacting 

properly
This commit is contained in:
Abdulaziz Ghuloum 2008-04-02 20:28:45 -04:00
parent 30bc1b7be9
commit 8d8f6d39f7
2 changed files with 27 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
scheme/ikarus.io.ss
View File

@ -578,7 +578,9 @@
(define (reset-input-port! p) (define (reset-input-port! p)
(if (input-port? p) (if (input-port? p)
($set-port-index! p ($port-size p)) (begin
($set-port-index! p ($port-size p))
(unregister-callback p))
(die 'reset-input-port! "not an input port" p))) (die 'reset-input-port! "not an input port" p)))
(define (port-transcoder p) (define (port-transcoder p)
@ -2110,13 +2112,14 @@
(define-connector tcp-connect-nonblocking "ikrt_tcp_connect" #f) (define-connector tcp-connect-nonblocking "ikrt_tcp_connect" #f)
(define-connector udp-connect-nonblocking "ikrt_udp_connect" #f) (define-connector udp-connect-nonblocking "ikrt_udp_connect" #f)
(module (add-io-event process-events) (module (add-io-event rem-io-event process-events)
(define-struct t (fd proc type)) (define-struct t (fd proc type))
;;; callbacks ;;; callbacks
(define pending '()) (define pending '())
(define out-queue '()) (define out-queue '())
(define in-queue '()) (define in-queue '())
(define (process-events) (define (process-events)
(if (null? out-queue) (if (null? out-queue)
(if (null? in-queue) (if (null? in-queue)
@ -2137,6 +2140,12 @@
(define (add-io-event fd proc event-type) (define (add-io-event fd proc event-type)
(set! pending (set! pending
(cons (make-t fd proc event-type) pending))) (cons (make-t fd proc event-type) pending)))
(define (rem-io-event fd)
(define (p x) (eq? (t-fd x) fd))
(set! pending (remp p pending))
(set! out-queue (remp p out-queue))
(set! in-queue (remp p in-queue)))
(define (get-max-fd) (define (get-max-fd)
(assert (pair? pending)) (assert (pair? pending))
@ -2248,6 +2257,21 @@
(when (fx< rv 0) (when (fx< rv 0)
(die who "failed to shutdown"))))) (die who "failed to shutdown")))))
(define (unregister-callback what)
(define who 'unregister-callback)
(cond
[(output-port? what)
(let ([c ($port-cookie what)])
(unless (fixnum? c) (die who "not a file-based port" what))
(rem-io-event c))]
[(input-port? what)
(let ([c ($port-cookie what)])
(unless (fixnum? c) (die who "not a file-based port" what))
(rem-io-event c))]
[(tcp-server? what)
(rem-io-event (tcp-server-fd what))]
[else (die who "invalid argument" what)]))
(define (register-callback what proc) (define (register-callback what proc)
(define who 'register-callback) (define who 'register-callback)
(unless (procedure? proc) (unless (procedure? proc)

2
scheme/last-revision
View File

@ -1 +1 @@
1433 1434