diff --git a/scsh/generic/stdio_dep.c b/scsh/generic/stdio_dep.c index 75be4a1..4913d14 100644 --- a/scsh/generic/stdio_dep.c +++ b/scsh/generic/stdio_dep.c @@ -68,3 +68,16 @@ int fbufcount(FILE* fs) { return(fs->_cnt); } + +/* Returns true if there is no buffered data in stream FS +** (or there is no buffering, period.) +*/ + +int ibuf_empty(FILE *fs) {return fs->_cnt <= 0;} + + +/* Returns true if the buffer in stream FS is full +** (or there is no buffering, period). +*/ + +int obuf_full(FILE *fs) {return fs->_cnt <= 0;} diff --git a/scsh/network.scm b/scsh/network.scm index ed95ff5..d3a8f89 100644 --- a/scsh/network.scm +++ b/scsh/network.scm @@ -1,5 +1,5 @@ ;;; Networking for the Scheme Shell -;;; Copyright (c) 1994 by Brian D. Carlstrom. +;;; Copyright (c) 1994-1995 by Brian D. Carlstrom. ;;; Copyright (c) 1994 by Olin Shivers. ;;; Scheme48 implementation. @@ -364,7 +364,7 @@ (else (let ((s (make-string len))) (receive (nread from) - (receive-message! socket flags s 0 len) + (receive-message! socket s 0 len flags) (values (cond ((not nread) #f) ; EOF ((= nread len) s) @@ -372,21 +372,21 @@ from))))))) (define (receive-message! socket s . maybe-args) - (receive (start end flags) - (parse-optionals maybe-args 0 (string-length s) 0) - (cond ((not (socket? socket)) - (error "receive-message!: socket expected")) - ((not (or (integer? flags) - (integer? start) - (integer? end))) - (error "receive-message!: integer expected")) - ((not (string? s)) - (error "receive-message!: string expected")) - (else - (generic-receive-message! (socket->fdes socket) flags - s start end - recv-substring!/errno - (socket:family socket)))))) + (if (not (string? s)) + (error "receive-message!: string expected") + (receive (start end flags) + (parse-optionals maybe-args 0 (string-length s) 0) + (cond ((not (socket? socket)) + (error "receive-message!: socket expected")) + ((not (or (integer? flags) + (integer? start) + (integer? end))) + (error "receive-message!: integer expected")) + (else + (generic-receive-message! (socket->fdes socket) flags + s start end + recv-substring!/errno + (socket:family socket))))))) (define (generic-receive-message! sockfd flags s start end reader from) (if (bogus-substring-spec? s start end) @@ -419,26 +419,30 @@ (not (integer? len))) (error "receive-message/partial: integer expected")) (else - (let* ((s (make-string len)) - (nread (receive-message!/partial socket flags s 0 len ))) - (cond ((not nread) #f) ; EOF - ((= nread len) s) - (else (substring s 0 nread)))))))) + (let ((s (make-string len))) + (receive (nread addr) + (receive-message!/partial socket s 0 len flags) + (values + (cond ((not nread) #f) ; EOF + ((= nread len) s) + (else (substring s 0 nread))) + addr))))))) (define (receive-message!/partial socket s . maybe-args) - (receive (start end flags) - (parse-optionals maybe-args 0 (string-length s) 0) - (cond ((not (socket? socket)) - (error "receive-message!/partial: socket expected")) - ((not (integer? flags)) - (error "receive-message!/partial: integer expected")) - ((not (string? s)) - (error "receive-message!/partial: string expected")) - (else - (generic-receive-message!/partial (socket->fdes socket) flags - s start end - recv-substring!/errno - (socket:family socket)))))) + (if (not (string? s)) + (error "receive-message!/partial: string expected") + (receive (start end flags) + (parse-optionals maybe-args 0 (string-length s) 0) + (cond ((not (socket? socket)) + (error "receive-message!/partial: socket expected")) + ((not (integer? flags)) + (error "receive-message!/partial: integer expected")) + (else + (generic-receive-message!/partial (socket->fdes socket) + flags + s start end + recv-substring!/errno + (socket:family socket))))))) (define (generic-receive-message!/partial sockfd flags s start end reader from) (if (bogus-substring-spec? s start end) @@ -458,7 +462,7 @@ s start start end addr))) (values (and (not (zero? nread)) nread) - from))))))) + (make-socket-address from addr)))))))) (define-foreign recv-substring!/errno (recv_substring (integer sockfd) @@ -523,9 +527,7 @@ s start end send-substring/errno (if addr (socket-address:family addr) 0) - (and addr - (socket-address:family - addr))))))) + (if addr (socket-address:address addr))))))) (define (generic-send-message/partial sockfd flags s start end writer family addr) (if (bogus-substring-spec? s start end) @@ -534,17 +536,16 @@ s start end writer)) (if (= start end) 0 ; Vacuous request. - (let ((addr (if addr (make-addr family) ""))) - (let loop () - (receive (err nwritten) - (writer sockfd flags s start end family addr) - (if err - (case err - ((errno/intr) (loop)) - ((errno/again errno/wouldblock) 0) - (else (errno-error err sockfd flags family addr - s start start end writer))) - nwritten)))))) + (let loop () + (receive (err nwritten) + (writer sockfd flags s start end family addr) + (if err + (case err + ((errno/intr) (loop)) + ((errno/again errno/wouldblock) 0) + (else (errno-error err sockfd flags family addr + s start start end writer))) + nwritten))))) (define-foreign send-substring/errno (send_substring (integer sockfd)