scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added fake set-port-buffering which produces a warning 

Added error-output-port, but not yet as deprecated-proc
set $current-noise-port to null-output
%move-fdport now returns #f on success, just like 0.5.1
This commit is contained in:
marting 1999-10-08 16:43:39 +00:00
parent 38dd943bf7
commit 734daac16f
1 changed files with 13 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
scsh/newports.scm
View File

@ -33,9 +33,6 @@
(if (fdport-data:revealed fdport*) (if (fdport-data:revealed fdport*)
(vector-set! fdports ch-number fdport) (vector-set! fdports ch-number fdport)
(weak-vector-set! fdports ch-number fdport)))) (weak-vector-set! fdports ch-number fdport))))
; (add-finalizer!
; fdport
; (lambda (the-port) (close-fdport* (fdport-data the-port))))))
(define (maybe-fdes->port fdes) (define (maybe-fdes->port fdes)
(weak-vector-ref fdports fdes)) (weak-vector-ref fdports fdes))
@ -43,7 +40,7 @@
;Hmm... these shouldn't be necessary. But still. ;Hmm... these shouldn't be necessary. But still.
;Fake defrec routines for backwards compatibility. ;Fake defrec routines for backwards compatibility.
(define (fdport-data:fd fdport*) (define (fdport-data:fd fdport*)
(channel-os-index (channel-cell-ref (fdport-data:channel fdport*)))) (channel-os-index (fdport-data:channel fdport*)))
(define (fdport-data:closed? fdport*) (define (fdport-data:closed? fdport*)
(eq? (channel-status (fdport-data:channel fdport*)) (eq? (channel-status (fdport-data:channel fdport*))
@ -143,6 +140,9 @@
(define fdport-data port-data) (define fdport-data port-data)
; That was easy. ; That was easy.
(define (set-port-buffering port policy . maybe-size)
(warn "JMG: use of set-port-buffering"))
;;; Open & Close ;;; Open & Close
;;; ------------ ;;; ------------
@ -265,6 +265,11 @@
;;; Initialise the system ;;; Initialise the system
;;; --------------------- ;;; ---------------------
;;; JMG: should be deprecated-proc
(define error-output-port
current-error-port)
(define old-inport #f) ; Just because. (define old-inport #f) ; Just because.
(define old-outport #f) (define old-outport #f)
(define old-errport #f) (define old-errport #f)
@ -279,8 +284,8 @@
(set-fluid! $current-input-port (channel-port->input-fdport (current-input-port))) (set-fluid! $current-input-port (channel-port->input-fdport (current-input-port)))
(set-fluid! $current-output-port (channel-port->output-fdport (current-output-port))) (set-fluid! $current-output-port (channel-port->output-fdport (current-output-port)))
(set-fluid! $current-error-port (channel-port->output-fdport (current-error-port)))) (set-fluid! $current-error-port (channel-port->output-fdport (current-error-port)))
(set-fluid! $current-noise-port (make-null-output-port)))
;;; Generic port operations ;;; Generic port operations
;;; ----------------------- ;;; -----------------------
@ -322,7 +327,8 @@
((if (input-port? port) make-input-fdchannel make-output-fdchannel) fd)) ((if (input-port? port) make-input-fdchannel make-output-fdchannel) fd))
(vector-set! fdports fd old-vector-ref) (vector-set! fdports fd old-vector-ref)
(%set-cloexec fd (not new-revealed))) (%set-cloexec fd (not new-revealed)))
(release-port-lock port)) (release-port-lock port)
#f) ; JMG: It used to return #f on succes in 0.5.1, so we do the same
(define (close-fdes fd) (define (close-fdes fd)
(evict-ports fd) (evict-ports fd)