* Added $write-byte to ikarus.io-primitives.unsafe.ss
This commit is contained in:
parent
bc41665bf3
commit
35fa003558
BIN
bin/ikarus
BIN
bin/ikarus
Binary file not shown.
|
@ -845,7 +845,12 @@ ikrt_open_output_file(ikp fname, ikp flagptr, ikpcb* pcb){
|
||||||
|
|
||||||
ikp
|
ikp
|
||||||
ikrt_write_file(ikp fd, ikp buff, ikp idx, ikpcb* pcb){
|
ikrt_write_file(ikp fd, ikp buff, ikp idx, ikpcb* pcb){
|
||||||
int bytes = write(unfix(fd), string_data(buff), unfix(idx));
|
int bytes;
|
||||||
|
if(tagof(buff) == bytevector_tag){
|
||||||
|
bytes = write(unfix(fd), buff+off_bytevector_data, unfix(idx));
|
||||||
|
} else {
|
||||||
|
bytes = write(unfix(fd), string_data(buff), unfix(idx));
|
||||||
|
}
|
||||||
return fix(bytes);
|
return fix(bytes);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -24,6 +24,19 @@
|
||||||
($write-char c p)
|
($write-char c p)
|
||||||
(error 'write-char "~s is not an output-port" p))
|
(error 'write-char "~s is not an output-port" p))
|
||||||
(error 'write-char "~s is not a character" c))]))
|
(error 'write-char "~s is not a character" c))]))
|
||||||
|
|
||||||
|
#;(define write-byte
|
||||||
|
(case-lambda
|
||||||
|
[(c)
|
||||||
|
(if (char? c)
|
||||||
|
($write-char c (current-output-port))
|
||||||
|
(error 'write-char "~s is not a character" c))]
|
||||||
|
[(c p)
|
||||||
|
(if (char? c)
|
||||||
|
(if (output-port? p)
|
||||||
|
($write-char c p)
|
||||||
|
(error 'write-char "~s is not an output-port" p))
|
||||||
|
(error 'write-char "~s is not a character" c))]))
|
||||||
;;;
|
;;;
|
||||||
(define newline
|
(define newline
|
||||||
(case-lambda
|
(case-lambda
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
|
|
||||||
(library (ikarus io-primitives unsafe)
|
(library (ikarus io-primitives unsafe)
|
||||||
(export $write-char $read-char $unread-char $peek-char
|
(export $write-char $write-byte $read-char $unread-char $peek-char
|
||||||
$reset-input-port! $flush-output-port
|
$reset-input-port! $flush-output-port
|
||||||
$close-input-port $close-output-port)
|
$close-input-port $close-output-port)
|
||||||
(import
|
(import
|
||||||
|
@ -20,6 +20,17 @@
|
||||||
($set-port-output-index! p ($fxadd1 idx)))
|
($set-port-output-index! p ($fxadd1 idx)))
|
||||||
(($port-handler p) 'write-char c p)))))
|
(($port-handler p) 'write-char c p)))))
|
||||||
|
|
||||||
|
(define $write-byte
|
||||||
|
(lambda (b p)
|
||||||
|
(let ([idx (port-output-index p)])
|
||||||
|
(if ($fx< idx ($port-output-size p))
|
||||||
|
(let ([buff ($port-output-buffer p)])
|
||||||
|
(if (string? buff)
|
||||||
|
(string-set! buff idx ($fixnum->char b))
|
||||||
|
($bytevector-set! buff idx b))
|
||||||
|
($set-port-output-index! p ($fxadd1 idx)))
|
||||||
|
(($port-handler p) 'write-byte b p)))))
|
||||||
|
|
||||||
(define $read-char
|
(define $read-char
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
(let ([idx ($port-input-index p)])
|
(let ([idx ($port-input-index p)])
|
||||||
|
|
|
@ -589,6 +589,7 @@
|
||||||
[$close-input-port $io]
|
[$close-input-port $io]
|
||||||
[$close-output-port $io]
|
[$close-output-port $io]
|
||||||
[$write-char $io]
|
[$write-char $io]
|
||||||
|
[$write-byte $io]
|
||||||
[$read-char $io]
|
[$read-char $io]
|
||||||
[$peek-char $io]
|
[$peek-char $io]
|
||||||
[$unread-char $io]
|
[$unread-char $io]
|
||||||
|
|
Loading…
Reference in New Issue