diff --git a/scsh/newports.scm b/scsh/newports.scm index 1f1aeae..09e0ecd 100644 --- a/scsh/newports.scm +++ b/scsh/newports.scm @@ -949,3 +949,49 @@ (values n-read-ready n-write-ready 0))))))))) + +(define (wait-ports timeout . ports) + (let ((read-list (filter input-port? ports)) + (write-list (filter output-port? ports))) + + ((structure-ref interrupts disable-interrupts!)) + + (for-each input-port/fdes-check-unlocked read-list) + (for-each output-port/fdes-check-unlocked write-list) + + (let ((any-read (any-input-ready read-list)) + (any-write (any-output-ready write-list))) + + (if (or (pair? any-read) (pair? any-write)) + (begin + ((structure-ref interrupts enable-interrupts!)) + (append any-read any-write)) + + ;; we need to block + (let ((read-channels (map port/fdes->input-channel read-list)) + (write-channels (map port/fdes->output-channel write-list))) + + (for-each (lambda (channel) + (add-pending-channel channel #t)) + read-channels) + + (for-each (lambda (channel) + (add-pending-channel channel #f)) + write-channels) + + (call-with-values + (lambda () + (wait-for-channels read-channels write-channels timeout)) + ;; re-enables interrupts + (lambda (ready-read-channels ready-write-channels) + (append (filter (lambda (read-port) + (any (lambda (read-channel) + (eq? read-channel + (port/fdes->input-channel read-port))) + ready-read-channels)) + read-list) + (filter (lambda (write-port) + (any (lambda (write-channel) + (eq? write-channel + (port/fdes->output-channel write-port))))) + write-list))))))))) diff --git a/scsh/scsh-interfaces.scm b/scsh/scsh-interfaces.scm index 0341940..dfefc62 100644 --- a/scsh/scsh-interfaces.scm +++ b/scsh/scsh-interfaces.scm @@ -140,9 +140,6 @@ seek/delta seek/end -; select -; select! - flush-all-ports flush-all-ports-no-threads y-or-n? @@ -224,6 +221,7 @@ read-string!/partial select select! + wait-ports (write-string (proc (:string &opt :value :exact-integer :exact-integer) :unspecific)) write-string/partial))) diff --git a/scsh/scsh-package.scm b/scsh/scsh-package.scm index d8b94ed..d5e8a5c 100644 --- a/scsh/scsh-package.scm +++ b/scsh/scsh-package.scm @@ -187,7 +187,7 @@ bitwise signals conditions - (subset srfi-1 (filter reverse! fold delete)) + (subset srfi-1 (filter reverse! fold delete any)) scsh-utilities handle fluids thread-fluids @@ -252,7 +252,6 @@ scheme) ; For accessing the normal I/O operators. (files syntax syscalls -; select fname rw newports