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

* Removed $port-input-index, $port-input-size, 

$set-port-input-index! and $set-port-input-size!
This commit is contained in:
Abdulaziz Ghuloum 2007-08-25 11:06:30 -04:00
parent c5530973d0
commit 023d0831d7
6 changed files with 38 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

16
src/ikarus.io-ports.ss
View File

@ -102,19 +102,19 @@
(define port-input-buffer
(lambda (x)
(if (input-port? x)
($port-input-buffer x)
($port-buffer x)
(error 'port-input-buffer "~s is not an input-port" x))))
;;;
(define port-input-index
(lambda (x)
(if (input-port? x)
($port-input-index x)
($port-index x)
(error 'port-input-index "~s is not an input-port" x))))
;;;
(define port-input-size
(lambda (x)
(if (input-port? x)
($port-input-size x)
($port-size x)
(error 'port-input-size "~s is not an input-port" x))))
;;;
(define port-output-buffer
@ -140,8 +140,8 @@
(if (input-port? p)
(if (fixnum? i)
(if ($fx>= i 0)
(if ($fx<= i ($port-input-size p))
($set-port-input-index! p i)
(if ($fx<= i ($port-size p))
($set-port-index! p i)
(error 'set-port-input-index! "index ~s is too big" i))
(error 'set-port-input-index! "index ~s is negative" i))
(error 'set-port-input-index! "~s is not a valid index" i))
@ -152,10 +152,10 @@
(if (input-port? p)
(if (fixnum? i)
(if ($fx>= i 0)
(if ($fx<= i ($bytevector-length ($port-input-buffer p)))
(if ($fx<= i ($bytevector-length ($port-buffer p)))
(begin
($set-port-input-index! p 0)
($set-port-input-size! p i))
($set-port-index! p 0)
($set-port-size! p i))
(error 'set-port-input-size! "size ~s is too big" i))
(error 'set-port-input-size! "size ~s is negative" i))
(error 'set-port-input-size! "~s is not a valid size" i))

24
src/ikarus.io-primitives.unsafe.ss
View File

@ -50,21 +50,21 @@
(define $read-char
(lambda (p)
(let ([idx ($port-input-index p)])
(if ($fx< idx ($port-input-size p))
(let ([b ($bytevector-u8-ref ($port-input-buffer p) idx)])
(let ([idx ($port-index p)])
(if ($fx< idx ($port-size p))
(let ([b ($bytevector-u8-ref ($port-buffer p) idx)])
(cond
[($fx<= b 127)
($set-port-input-index! p ($fxadd1 idx))
($set-port-index! p ($fxadd1 idx))
($fixnum->char b)]
[else (($port-handler p) 'read-char p)]))
(($port-handler p) 'read-char p)))))
(define $peek-char
(lambda (p)
(let ([idx ($port-input-index p)])
(if ($fx< idx ($port-input-size p))
(let ([b ($bytevector-u8-ref ($port-input-buffer p) idx)])
(let ([idx ($port-index p)])
(if ($fx< idx ($port-size p))
(let ([b ($bytevector-u8-ref ($port-buffer p) idx)])
(cond
[($fx<= b 127)
($fixnum->char b)]
@ -73,19 +73,19 @@
(define $unread-char
(lambda (c p)
(let ([idx ($fxsub1 ($port-input-index p))]
(let ([idx ($fxsub1 ($port-index p))]
[b ($char->fixnum c)])
(if (and ($fx<= b 127)
($fx>= idx 0)
($fx< idx ($port-input-size p)))
($fx< idx ($port-size p)))
(begin
($set-port-input-index! p idx)
($bytevector-set! ($port-input-buffer p) idx b))
($set-port-index! p idx)
($bytevector-set! ($port-buffer p) idx b))
(($port-handler p) 'unread-char c p)))))
(define $reset-input-port!
(lambda (p)
($set-port-input-size! p 0)))
($set-port-size! p 0)))
(define $close-input-port
(lambda (p)

36
src/ikarus.io.input-files.ss
View File

@ -52,19 +52,19 @@
(define read-multibyte-char
(lambda (p b0)
(let ([idx ($port-input-index p)]
[size ($port-input-size p)])
(let ([idx ($port-index p)]
[size ($port-size p)])
(cond
[($fx= ($fxlogand b0 #b11100000) #b11000000)
;;; 2-byte utf8 sequence
(unless ($fx< ($fx+ idx 1) size)
(refill-buffer! p 1))
(let ([b1 ($bytevector-u8-ref
($port-input-buffer p)
($port-buffer p)
($fxadd1 idx))])
(unless ($fx= ($fxlogand b1 #b11000000) #b10000000)
(error 'read-char "invalid utf8 sequence ~a ~a" b0 b1))
($set-port-input-index! p ($fx+ idx 2))
($set-port-index! p ($fx+ idx 2))
($fixnum->char
($fx+ ($fxsll ($fxlogand b0 #b11111) 6)
($fxlogand b1 #b111111))))]
@ -87,21 +87,21 @@
[(read-char p)
(unless (input-port? p)
(error 'read-char "~s is not an input port" p))
(let ([idx ($port-input-index p)])
(if ($fx< idx ($port-input-size p))
(let ([b ($bytevector-u8-ref ($port-input-buffer p) idx)])
(let ([idx ($port-index p)])
(if ($fx< idx ($port-size p))
(let ([b ($bytevector-u8-ref ($port-buffer p) idx)])
(cond
[($fx< b 128)
($set-port-input-index! p ($fxadd1 idx))
($set-port-index! p ($fxadd1 idx))
($fixnum->char b)]
[else (read-multibyte-char p b)]))
(if open?
(let ([bytes
(foreign-call "ikrt_read"
fd ($port-input-buffer p))])
fd ($port-buffer p))])
(cond
[($fx> bytes 0)
($set-port-input-size! p bytes)
($set-port-size! p bytes)
($read-char p)]
[($fx= bytes 0)
(eof-object)]
@ -112,9 +112,9 @@
[(peek-char p)
(unless (input-port? p)
(error 'peek-char "~s is not an input port" p))
(let ([idx ($port-input-index p)])
(if ($fx< idx ($port-input-size p))
(let ([b ($bytevector-u8-ref ($port-input-buffer p) idx)])
(let ([idx ($port-index p)])
(if ($fx< idx ($port-size p))
(let ([b ($bytevector-u8-ref ($port-buffer p) idx)])
(cond
[($fx< b 128) ($fixnum->char b)]
[else (peek-multibyte-char p)]))
@ -129,21 +129,21 @@
[($fx= bytes 0)
(eof-object)]
[else
($set-port-input-size! p bytes)
($set-port-size! p bytes)
($peek-char p)]))
(error 'peek-char "port ~s is closed" p))))]
[(unread-char c p)
(unless (input-port? p)
(error 'unread-char "~s is not an input port" p))
(let ([idx ($fxsub1 ($port-input-index p))]
(let ([idx ($fxsub1 ($port-index p))]
[b (if (char? c)
($char->fixnum c)
(error 'unread-char "~s is not a char" c))])
(if (and ($fx>= idx 0)
($fx< idx ($port-input-size p)))
($fx< idx ($port-size p)))
(cond
[($fx< b 128)
($set-port-input-index! p idx)]
($set-port-index! p idx)]
[else (unread-multibyte-char c p)])
(if open?
(error 'unread-char "port ~s is closed" p)
@ -153,7 +153,7 @@
(unless (input-port? p)
(error 'close-input-port "~s is not an input port" p))
(when open?
($set-port-input-size! p 0)
($set-port-size! p 0)
(set! open? #f)
(unless (foreign-call "ikrt_close_file" fd)
(error 'close-input-port "cannot close ~s" port-name)))]

5
src/makefile.ss
View File

@ -699,14 +699,9 @@
[$set-port-index! $ports]
[$set-port-size! $ports]
[$port-input-buffer $ports]
[$port-input-index $ports]
[$port-input-size $ports]
[$port-output-buffer $ports]
[$port-output-index $ports]
[$port-output-size $ports]
[$set-port-input-index! $ports]
[$set-port-input-size! $ports]
[$set-port-output-index! $ports]
[$set-port-output-size! $ports]

13
src/pass-specify-rep-primops.ss
View File

@ -1459,27 +1459,14 @@
(prm 'mset (T x) (K (- disp-port-index vector-tag)) (K 0))
(prm 'mset (T x) (K (- disp-port-size vector-tag)) (T i)))])
(define-primop $port-input-buffer unsafe
[(V x) (prm 'mref (T x) (K (- disp-port-buffer vector-tag)))])
(define-primop $port-input-index unsafe
[(V x) (prm 'mref (T x) (K (- disp-port-index vector-tag)))])
(define-primop $port-input-size unsafe
[(V x) (prm 'mref (T x) (K (- disp-port-size vector-tag)))])
(define-primop $port-output-buffer unsafe
[(V x) (prm 'mref (T x) (K (- disp-port-output-buffer vector-tag)))])
(define-primop $port-output-index unsafe
[(V x) (prm 'mref (T x) (K (- disp-port-output-index vector-tag)))])
(define-primop $port-output-size unsafe
[(V x) (prm 'mref (T x) (K (- disp-port-output-size vector-tag)))])
(define-primop $set-port-input-index! unsafe
[(E x i) (prm 'mset (T x) (K (- disp-port-index vector-tag)) (T i))])
(define-primop $set-port-output-index! unsafe
[(E x i) (prm 'mset (T x) (K (- disp-port-output-index vector-tag)) (T i))])
(define-primop $set-port-input-size! unsafe
[(E x i)
(seq*
(prm 'mset (T x) (K (- disp-port-index vector-tag)) (K 0))
(prm 'mset (T x) (K (- disp-port-size vector-tag)) (T i)))])
(define-primop $set-port-output-size! unsafe
[(E x i)
(seq*