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

Fixes bug 184959: get-bytevector-some missing

This commit is contained in:
Abdulaziz Ghuloum 2008-01-22 10:59:04 -05:00
parent 92d02e8e52
commit a33269daa7
5 changed files with 63 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
scheme/ikarus.io.ss
View File

@ -669,30 +669,31 @@
;(define-rrr port-has-set-port-position!?)
;(define-rrr set-port-position!)
(define (refill-bv-buffer p who)
(when ($port-closed? p) (die who "port is closed" p))
(let ([bv ($port-buffer p)] [i ($port-index p)] [j ($port-size p)])
(let ([c0 (fx- j i)])
(unless (fx= c0 0) (bytevector-copy! bv i bv 0 c0))
(let ([pos ($port-position p)])
(when pos
($set-port-position! p (fx+ pos i))))
(let* ([max (fx- (bytevector-length bv) c0)]
[c1 (($port-read! p) bv c0 max)])
(unless (fixnum? c1)
(die who "invalid return value from read! procedure" c1))
(cond
[(fx>= j 0)
(unless (fx<= j max)
(die who "read! returned a value out of range" j))
($set-port-index! p c0)
($set-port-size! p (fx+ c1 c0))
c1]
[else
(die who "read! returned a value out of range" c1)])))))
;;; ----------------------------------------------------------
(module (read-char get-char lookahead-char)
(import UNSAFE)
(define (refill-bv-buffer p who)
(when ($port-closed? p) (die who "port is closed" p))
(let ([bv ($port-buffer p)] [i ($port-index p)] [j ($port-size p)])
(let ([c0 (fx- j i)])
(unless (fx= c0 0) (bytevector-copy! bv i bv 0 c0))
(let ([pos ($port-position p)])
(when pos
($set-port-position! p (fx+ pos i))))
(let* ([max (fx- (bytevector-length bv) c0)]
[c1 (($port-read! p) bv c0 max)])
(unless (fixnum? c1)
(die who "invalid return value from read! procedure" c1))
(cond
[(fx>= j 0)
(unless (fx<= j max)
(die who "read! returned a value out of range" j))
($set-port-index! p c0)
($set-port-size! p (fx+ c1 c0))
c1]
[else
(die who "read! returned a value out of range" c1)])))))
(define (get-char-latin-mode p who inc)
(let ([n (refill-bv-buffer p who)])
(cond
@ -1594,7 +1595,32 @@
[($fx= c 0) 0]
[else (die 'get-bytevector-n! "count is negative" c)])))
(define-rrr get-bytevector-some)
(define (get-bytevector-some p)
(define who 'get-bytevector-some)
; (import UNSAFE)
(let ([m ($port-fast-attrs p)])
(cond
[(eq? m fast-get-byte-tag)
(let ([i ($port-index p)] [j ($port-size p)])
(let ([cnt (fx- j i)])
(cond
[(fx> cnt 0)
(let f ([bv (make-bytevector cnt)]
[buf ($port-buffer p)]
[i i] [j j] [idx 0])
(cond
[(fx= i j)
($set-port-index! p j)
bv]
[else
(bytevector-u8-set! bv idx (bytevector-u8-ref buf i))
(f bv buf (fx+ i 1) j (fx+ idx 1))]))]
[else
(refill-bv-buffer p who)
(if (fx= ($port-index p) ($port-size p))
(eof-object)
(get-bytevector-some p))])))]
[else (die who "invalid port argument" p)])))
(define (get-bytevector-all p)
(define (get-it p)

10
scheme/ikarus.numerics.ss
View File

@ -2497,11 +2497,17 @@
)
(library (ikarus complexnums)
(export real-part imag-part)
(import (except (ikarus) real-part imag-part))
(export real-part imag-part magnitude)
(import (except (ikarus) real-part imag-part magnitude))
;;; stub implementation since we don't have a way of
;;; constructing complex numbers yet.
(define magnitude
(lambda (x)
(if (number? x)
(abs x)
(die 'magnitude "not a number" x))))
(define real-part
(lambda (x)
(if (number? x)

2
scheme/last-revision
View File

@ -1 +1 @@
1361
1362

8
scheme/makefile.ss
View File

@ -673,7 +673,7 @@
[floor i r ba se]
[for-each i r ba se]
[gcd i r ba se]
[imag-part r ba se]
[imag-part i r ba se]
[inexact i r ba]
[inexact? i r ba se]
[infinite? i r ba]
@ -689,7 +689,7 @@
[list-tail i r ba se]
[list? i r ba se]
[log i r ba se]
[magnitude r ba se]
[magnitude i r ba se]
[make-polar r ba se]
[make-rectangular r ba se]
[make-string i r ba se]
@ -711,7 +711,7 @@
[rational-valued? i r ba]
[rational? i r ba se]
[rationalize i r ba se]
[real-part r ba se]
[real-part i r ba se]
[real-valued? i r ba]
[real? i r ba se]
[reverse i r ba se]
@ -1056,7 +1056,7 @@
[get-bytevector-all i r ip]
[get-bytevector-n i r ip]
[get-bytevector-n! i r ip]
[get-bytevector-some r ip]
[get-bytevector-some i r ip]
[get-char i r ip]
[get-datum i r ip]
[get-line i r ip]

4
scheme/todo-r6rs.ss
View File

@ -185,7 +185,7 @@
[list-tail C ba se]
[list? C ba se]
[log C ba se]
[magnitude S ba se]
[magnitude C ba se]
[make-polar S ba se]
[make-rectangular S ba se]
[make-string C ba se]
@ -567,7 +567,7 @@
[get-bytevector-all C ip]
[get-bytevector-n C ip]
[get-bytevector-n! C ip]
[get-bytevector-some S ip]
[get-bytevector-some C ip]
[get-char C ip]
[get-datum C ip]
[get-line C ip]