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

more unsafe prims in ikarus.io.ss

This commit is contained in:
Abdulaziz Ghuloum 2007-12-12 23:50:05 -05:00
parent 23b71cee3c
commit 1d4db4b9c9
2 changed files with 19 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
scheme/ikarus.io.ss
View File

@ -1113,8 +1113,9 @@
(make-message-condition msg) (make-message-condition msg)
(make-i/o-filename-error id))))) (make-i/o-filename-error id)))))
(define read-size 4096) (define block-size 4096)
(define file-buffer-size (+ read-size 128)) (define input-file-buffer-size (+ block-size 128))
(define output-file-buffer-size block-size)
(define (fh->input-port fd id size transcoder close?) (define (fh->input-port fd id size transcoder close?)
(guarded-port (guarded-port
@ -1126,7 +1127,7 @@
(lambda (bv idx cnt) (lambda (bv idx cnt)
(let ([bytes (let ([bytes
(foreign-call "ikrt_read_fd" fd bv idx (foreign-call "ikrt_read_fd" fd bv idx
(fxmin read-size cnt))]) (fxmin block-size cnt))])
(when (fx< bytes 0) (io-error 'read id bytes)) (when (fx< bytes 0) (io-error 'read id bytes))
bytes)) bytes))
#f ;;; write! #f ;;; write!
@ -1151,7 +1152,7 @@
(lambda (bv idx cnt) (lambda (bv idx cnt)
(let ([bytes (let ([bytes
(foreign-call "ikrt_write_fd" fd bv idx (foreign-call "ikrt_write_fd" fd bv idx
(fxmin read-size cnt))]) (fxmin block-size cnt))])
(when (fx< bytes 0) (io-error 'write id bytes)) (when (fx< bytes 0) (io-error 'write id bytes))
bytes)) bytes))
#f ;;; get-position #f ;;; get-position
@ -1207,7 +1208,7 @@
(fh->input-port (fh->input-port
(open-input-file-handle filename 'open-file-input-port) (open-input-file-handle filename 'open-file-input-port)
filename filename
file-buffer-size input-file-buffer-size
transcoder transcoder
#t)])) #t)]))
@ -1231,7 +1232,7 @@
(open-output-file-handle filename file-options (open-output-file-handle filename file-options
'open-file-output-port) 'open-file-output-port)
filename filename
file-buffer-size output-file-buffer-size
transcoder transcoder
#t)])) #t)]))
@ -1242,7 +1243,7 @@
(open-output-file-handle filename (file-options) (open-output-file-handle filename (file-options)
'open-input-file) 'open-input-file)
filename filename
file-buffer-size output-file-buffer-size
(native-transcoder) (native-transcoder)
#t)) #t))
@ -1252,7 +1253,7 @@
(fh->input-port (fh->input-port
(open-input-file-handle filename 'open-input-file) (open-input-file-handle filename 'open-input-file)
filename filename
file-buffer-size input-file-buffer-size
(native-transcoder) (native-transcoder)
#t)) #t))
@ -1265,7 +1266,7 @@
(fh->input-port (fh->input-port
(open-input-file-handle filename 'call-with-input-file) (open-input-file-handle filename 'call-with-input-file)
filename filename
file-buffer-size input-file-buffer-size
(native-transcoder) (native-transcoder)
#t) #t)
proc)) proc))
@ -1279,7 +1280,7 @@
(fh->input-port (fh->input-port
(open-input-file-handle filename 'with-input-from-file) (open-input-file-handle filename 'with-input-from-file)
filename filename
file-buffer-size input-file-buffer-size
(native-transcoder) (native-transcoder)
#t)]) #t)])
(parameterize ([*the-input-port* p]) (parameterize ([*the-input-port* p])
@ -1297,19 +1298,19 @@
(define *the-input-port* (define *the-input-port*
(make-parameter (make-parameter
(transcoded-port (transcoded-port
(fh->input-port 0 '*stdin* file-buffer-size #f #f) (fh->input-port 0 '*stdin* input-file-buffer-size #f #f)
(native-transcoder)))) (native-transcoder))))
(define *the-output-port* (define *the-output-port*
(make-parameter (make-parameter
(transcoded-port (transcoded-port
(fh->output-port 1 '*stdout* file-buffer-size #f #f) (fh->output-port 1 '*stdout* output-file-buffer-size #f #f)
(native-transcoder)))) (native-transcoder))))
(define *the-error-port* (define *the-error-port*
(make-parameter (make-parameter
(transcoded-port (transcoded-port
(fh->output-port 2 '*stderr* file-buffer-size #f #f) (fh->output-port 2 '*stderr* output-file-buffer-size #f #f)
(native-transcoder)))) (native-transcoder))))
(define console-output-port (define console-output-port
@ -1530,6 +1531,7 @@
[else (error 'get-string-n! "count is negative" c)]))) [else (error 'get-string-n! "count is negative" c)])))
(define (get-line p) (define (get-line p)
(import UNSAFE)
(define (get-it p) (define (get-it p)
(let f ([p p] [n 0] [ac '()]) (let f ([p p] [n 0] [ac '()])
(let ([x (get-char p)]) (let ([x (get-char p)])
@ -1538,13 +1540,13 @@
(make-it n ac)] (make-it n ac)]
[(eof-object? x) [(eof-object? x)
(if (null? ac) x (make-it n ac))] (if (null? ac) x (make-it n ac))]
[else (f p (+ n 1) (cons x ac))])))) [else (f p (fx+ n 1) (cons x ac))]))))
(define (make-it n revls) (define (make-it n revls)
(let f ([s (make-string n)] [i (- n 1)] [ls revls]) (let f ([s (make-string n)] [i (fx- n 1)] [ls revls])
(cond (cond
[(pair? ls) [(pair? ls)
(string-set! s i (car ls)) (string-set! s i (car ls))
(f s (- i 1) (cdr ls))] (f s (fx- i 1) (cdr ls))]
[else s]))) [else s])))
(if (input-port? p) (if (input-port? p)
(if (textual-port? p) (if (textual-port? p)

2
scheme/last-revision
View File

@ -1 +1 @@
1233 1234