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

* $port-output-index, $port-output-size, $set-port-output-index! and 

$set-port-output-size! are gone.
This commit is contained in:
Abdulaziz Ghuloum 2007-08-25 11:24:05 -04:00
parent 023d0831d7
commit d8b81869c9
8 changed files with 42 additions and 82 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.

7
src/ikarus.compiler.ss
View File

@ -1800,15 +1800,14 @@
(define port-tag #x3F)
(define output-port-tag #x7F)
(define input-port-tag #xBF)
;(define input/output-port-tag #xFF)
(define port-mask #x3F)
(define disp-port-buffer 4)
(define disp-port-index 8)
(define disp-port-size 12)
(define disp-port-handler 16)
(define disp-port-output-buffer 20)
(define disp-port-output-index 24)
(define disp-port-output-size 28)
(define disp-port-unused1 20)
(define disp-port-unused2 24)
(define disp-port-unused3 28)
(define port-size 32)

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

@ -55,7 +55,7 @@
;;;
(define $make-input-port
(lambda (handler buffer)
($make-port/input handler buffer 0 ($bytevector-length buffer) #f 0 0)))
($make-port/input handler buffer 0 ($bytevector-length buffer))))
;;;
(define make-input-port
(lambda (handler buffer)
@ -67,7 +67,7 @@
;;;
(define $make-output-port
(lambda (handler buffer)
($make-port/output handler #f 0 0 buffer 0 ($bytevector-length buffer))))
($make-port/output handler buffer 0 ($bytevector-length buffer))))
;;;
(define make-output-port
(lambda (handler buffer)
@ -77,22 +77,6 @@
(error 'make-output-port "~s is not a bytevector" buffer))
(error 'make-output-port "~s is not a procedure" handler))))
;;;
;(define $make-input/output-port
; (lambda (handler input-buffer output-buffer)
; ($make-port/both handler
; input-buffer 0 ($bytevector-length input-buffer)
; output-buffer 0 ($bytevector-length output-buffer))))
;;;
;(define make-input/output-port
; (lambda (handler input-buffer output-buffer)
; (if (procedure? handler)
; (if (bytevector? input-buffer)
; (if (bytevector? output-buffer)
; ($make-input/output-port handler input-buffer output-buffer)
; (error 'make-input/output-port "~s is not a bytevector" output-buffer))
; (error 'make-input/output-port "~s is not a bytevector" input-buffer))
; (error 'make-input/output-port "~s is not a procedure" handler))))
;;;
(define port-handler
(lambda (x)
(if (port? x)
@ -120,19 +104,19 @@
(define port-output-buffer
(lambda (x)
(if (output-port? x)
($port-output-buffer x)
($port-buffer x)
(error 'port-output-buffer "~s is not an output-port" x))))
;;;
(define port-output-index
(lambda (x)
(if (output-port? x)
($port-output-index x)
($port-index x)
(error 'port-output-index "~s is not an output-port" x))))
;;;
(define port-output-size
(lambda (x)
(if (output-port? x)
($port-output-size x)
($port-size x)
(error 'port-output-size "~s is not an output-port" x))))
;;;
(define set-port-input-index!
@ -166,8 +150,8 @@
(if (output-port? p)
(if (fixnum? i)
(if ($fx>= i 0)
(if ($fx<= i ($port-output-size p))
($set-port-output-index! p i)
(if ($fx<= i ($port-size p))
($set-port-index! p i)
(error 'set-port-output-index! "index ~s is too big" i))
(error 'set-port-output-index! "index ~s is negative" i))
(error 'set-port-output-index! "~s is not a valid index" i))
@ -178,10 +162,10 @@
(if (output-port? p)
(if (fixnum? i)
(if ($fx>= i 0)
(if ($fx<= i ($bytevector-length ($port-output-buffer p)))
(if ($fx<= i ($bytevector-length ($port-buffer p)))
(begin
($set-port-output-index! p 0)
($set-port-output-size! p i))
($set-port-index! p 0)
($set-port-size! p i))
(error 'set-port-output-size! "size ~s is too big" i))
(error 'set-port-output-size! "size ~s is negative" i))
(error 'set-port-output-size! "~s is not a valid size" i))

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

@ -42,10 +42,10 @@
(define $write-byte
(lambda (b p)
(let ([idx (port-output-index p)])
(if ($fx< idx ($port-output-size p))
(if ($fx< idx ($port-size p))
(begin
($bytevector-set! ($port-output-buffer p) idx b)
($set-port-output-index! p ($fxadd1 idx)))
($bytevector-set! ($port-buffer p) idx b)
($set-port-index! p ($fxadd1 idx)))
(($port-handler p) 'write-byte b p)))))
(define $read-char

20
src/ikarus.io.output-files.ss
View File

@ -76,15 +76,15 @@
[(write-byte b p)
(if (and (fixnum? b) ($fx<= 0 b) ($fx<= b 255))
(if (output-port? p)
(let ([idx ($port-output-index p)])
(if ($fx< idx ($port-output-size p))
(let ([idx ($port-index p)])
(if ($fx< idx ($port-size p))
(begin
($bytevector-set! ($port-output-buffer p) idx b)
($set-port-output-index! p ($fxadd1 idx)))
($bytevector-set! ($port-buffer p) idx b)
($set-port-index! p ($fxadd1 idx)))
(if open?
(let ([bytes (do-write-buffer fd port-name
($port-output-buffer p) idx 'write-char)])
($set-port-output-index! p 0)
($port-buffer p) idx 'write-char)])
($set-port-index! p 0)
($write-byte b p))
(error 'write-byte "port ~s is closed" p))))
(error 'write-byte "~s is not an output-port" p))
@ -102,16 +102,16 @@
(if (output-port? p)
(if open?
(let ([bytes (do-write-buffer fd port-name
($port-output-buffer p)
($port-output-index p)
($port-buffer p)
($port-index p)
'flush-output-port)])
($set-port-output-index! p 0))
($set-port-index! p 0))
(error 'flush-output-port "port ~s is closed" p))
(error 'flush-output-port "~s is not an output-port" p))]
[(close-port p)
(when open?
(flush-output-port p)
($set-port-output-size! p 0)
($set-port-size! p 0)
(set! open? #f)
(unless (foreign-call "ikrt_close_file" fd)
(error 'close-output-port "cannot close ~s" port-name)))]

16
src/ikarus.io.output-strings.ss
View File

@ -112,16 +112,16 @@
[(write-byte b p)
(if (and (fixnum? b) ($fx<= 0 b) ($fx<= b 255))
(if (output-port? p)
(let ([idx ($port-output-index p)])
(if ($fx< idx ($port-output-size p))
(let ([idx ($port-index p)])
(if ($fx< idx ($port-size p))
(begin
($bytevector-set! ($port-output-buffer p) idx b)
($set-port-output-index! p ($fxadd1 idx)))
($bytevector-set! ($port-buffer p) idx b)
($set-port-index! p ($fxadd1 idx)))
(if open?
(let ([buff ($port-output-buffer p)])
(let ([buff ($port-buffer p)])
(set! buffer-list (cons (bv-copy buff) buffer-list))
($bytevector-set! buff 0 b)
($set-port-output-index! p 1))
($set-port-index! p 1))
(error 'write-byte "port ~s is closed" p))))
(error 'write-byte "~s is not an output-port" p))
(error 'write-byte "~s is not a byte" b))]
@ -142,8 +142,8 @@
[(get-output-string p)
(utf8-bytevector->string
(concat
($port-output-buffer p)
($port-output-index p)
($port-buffer p)
($port-index p)
buffer-list))]
[else (error 'output-handler
"unhandled message ~s" (cons msg args))])))

7
src/makefile.ss
View File

@ -699,13 +699,6 @@
[$set-port-index! $ports]
[$set-port-size! $ports]
[$port-output-buffer $ports]
[$port-output-index $ports]
[$port-output-size $ports]
[$set-port-output-index! $ports]
[$set-port-output-size! $ports]
[$closure-code $codes]
[$code->closure $codes]
[$code-reloc-vector $codes]

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

@ -1421,27 +1421,25 @@
[(P x) (sec-tag-test (T x) vector-mask vector-tag #f output-port-tag)]
[(E x) (nop)])
(define (make-port handler buf/i idx/i sz/i buf/o idx/o sz/o tag)
(define (make-port handler buf/i idx/i sz/i tag)
(with-tmp ([p (prm 'alloc (K (align port-size)) (K vector-tag))])
(prm 'mset p (K (- vector-tag)) (K tag))
(prm 'mset p (K (- disp-port-buffer vector-tag)) (T buf/i))
(prm 'mset p (K (- disp-port-index vector-tag)) (T idx/i))
(prm 'mset p (K (- disp-port-size vector-tag)) (T sz/i))
(prm 'mset p (K (- disp-port-handler vector-tag)) (T handler))
(prm 'mset p (K (- disp-port-output-buffer vector-tag)) (T buf/o))
(prm 'mset p (K (- disp-port-output-index vector-tag)) (T idx/o))
(prm 'mset p (K (- disp-port-output-size vector-tag)) (T sz/o))
(prm 'mset p (K (- disp-port-unused1 vector-tag)) (K 0))
(prm 'mset p (K (- disp-port-unused2 vector-tag)) (K 0))
(prm 'mset p (K (- disp-port-unused3 vector-tag)) (K 0))
p))
(define-primop $make-port/input unsafe
[(V handler buf/i idx/i sz/i buf/o idx/o sz/o)
(make-port handler buf/i idx/i sz/i buf/o idx/o sz/o
input-port-tag)])
[(V handler buf/i idx/i sz/i)
(make-port handler buf/i idx/i sz/i input-port-tag)])
(define-primop $make-port/output unsafe
[(V handler buf/i idx/i sz/i buf/o idx/o sz/o)
(make-port handler buf/i idx/i sz/i buf/o idx/o sz/o
output-port-tag)])
[(V handler buf/o idx/o sz/o)
(make-port handler buf/o idx/o sz/o output-port-tag)])
(define-primop $port-handler unsafe
[(V x) (prm 'mref (T x) (K (- disp-port-handler vector-tag)))])
@ -1459,20 +1457,6 @@
(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-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-output-index! unsafe
[(E x i) (prm 'mset (T x) (K (- disp-port-output-index vector-tag)) (T i))])
(define-primop $set-port-output-size! unsafe
[(E x i)
(seq*
(prm 'mset (T x) (K (- disp-port-output-index vector-tag)) (K 0))
(prm 'mset (T x) (K (- disp-port-output-size vector-tag)) (T i)))])
/section)
(section ;;; interrupts-and-engines