diff --git a/scheme/ikarus.boot.prebuilt b/scheme/ikarus.boot.prebuilt index 480deae..7c2dadc 100644 Binary files a/scheme/ikarus.boot.prebuilt and b/scheme/ikarus.boot.prebuilt differ diff --git a/scheme/ikarus.io.ss b/scheme/ikarus.io.ss index 9203db2..c679bd7 100644 --- a/scheme/ikarus.io.ss +++ b/scheme/ikarus.io.ss @@ -70,6 +70,7 @@ accept-connection accept-connection-nonblocking close-tcp-server-socket register-callback + input-socket-buffer-size output-socket-buffer-size ) @@ -129,6 +130,7 @@ accept-connection accept-connection-nonblocking close-tcp-server-socket register-callback + input-socket-buffer-size output-socket-buffer-size )) (module UNSAFE @@ -1238,6 +1240,26 @@ (define input-file-buffer-size (+ input-block-size 128)) (define output-file-buffer-size output-block-size) + (define input-socket-buffer-size + (make-parameter (+ input-block-size 128) + (lambda (x) + (import (ikarus system $fx)) + (if (and (fixnum? x) ($fx>= x 128)) + x + (error 'input-socket-buffer-size + "buffer size should be a fixnum >= 128" + x))))) + + (define output-socket-buffer-size + (make-parameter output-block-size + (lambda (x) + (import (ikarus system $fx)) + (if (and (fixnum? x) ($fx> x 0)) + x + (error 'output-socket-buffer-size + "buffer size should be a positive fixnum" + x))))) + (define (fh->input-port fd id size transcoder close who) (letrec ([port ($make-port @@ -2110,9 +2132,9 @@ (set-fd-nonblocking socket who id)) (values (fh->output-port socket - id output-file-buffer-size #f close who) + id (output-socket-buffer-size) #f close who) (fh->input-port socket - id input-file-buffer-size #f close who))))) + id (input-socket-buffer-size) #f close who))))) (define-syntax define-connector (syntax-rules () diff --git a/scheme/last-revision b/scheme/last-revision index cd3f37d..b9f85c2 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1445 +1446 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index bb5624f..89f9e9d 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -1405,10 +1405,13 @@ [accept-connection-nonblocking i] [close-tcp-server-socket i] [register-callback i] - [&i/o-would-block i] - [make-i/o-would-block-condition i] - [i/o-would-block-condition? i] - [i/o-would-block-port i] + [input-socket-buffer-size i] + [output-socket-buffer-size i] + + ;[&i/o-would-block i] + ;[make-i/o-would-block-condition i] + ;[i/o-would-block-condition? i] + ;[i/o-would-block-port i] [ellipsis-map ] [scc-letrec i] [optimize-cp i] diff --git a/scheme/pass-specify-rep-primops.ss b/scheme/pass-specify-rep-primops.ss index 8c05c6b..c0c76dc 100644 --- a/scheme/pass-specify-rep-primops.ss +++ b/scheme/pass-specify-rep-primops.ss @@ -2170,7 +2170,7 @@ [(V x i) (prm 'sll (prm 'logand - (prm 'mref (T x) + (prm 'bref (T x) (prm 'int+ (prm 'sra (T i) (K fx-shift)) (K (- disp-code-data vector-tag)))) diff --git a/scheme/tests/bytevectors.ss b/scheme/tests/bytevectors.ss index 0f10776..d57bda4 100644 --- a/scheme/tests/bytevectors.ss +++ b/scheme/tests/bytevectors.ss @@ -373,6 +373,13 @@ (bytevector-s64-native-ref bv 8))] + [(lambda (x) (= x 73)) + (let ([sz (- (* 10 4096) 8)]) + (import (ikarus system $bytevectors)) + (let ([bv (make-bytevector sz)]) + (bytevector-u8-set! bv (- sz 1) 73) + (collect) + ($bytevector-u8-ref bv (- sz 1))))] ))