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

* Added port-mode and set-port-mode! primitives. A port mode is 

either the symbol ikarus-mode or the symbol r6rs-mode.
This commit is contained in:
Abdulaziz Ghuloum 2007-11-18 19:28:59 -05:00
parent 442eb1ca00
commit 543d59313b
5 changed files with 37 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.orig
View File

Binary file not shown.

6
scheme/ikarus.compiler.ss
View File

@ -1985,9 +1985,9 @@
(define disp-port-index 8)
(define disp-port-size 12)
(define disp-port-handler 16)
(define disp-port-unused1 20)
(define disp-port-unused2 24)
(define disp-port-unused3 28)
(define disp-port-attributes 20)
(define disp-port-unused1 24)
(define disp-port-unused2 28)
(define port-size 32)

28
scheme/ikarus.io-ports.ss
View File

@ -21,7 +21,8 @@
port-input-index set-port-input-index!
port-input-size set-port-input-size!
port-output-index set-port-output-index!
port-output-size set-port-output-size!)
port-output-size set-port-output-size!
port-mode set-port-mode!)
(import
(ikarus system $ports)
(ikarus system $strings)
@ -34,7 +35,8 @@
port-input-index set-port-input-index!
port-input-size set-port-input-size!
port-output-index set-port-output-index!
port-output-size set-port-output-size!))
port-output-size set-port-output-size!
port-mode set-port-mode!))
;;; GENERIC PORTS: BASIC PRIMITIVES
;;;
;;; Exports:
@ -173,7 +175,27 @@
(error 'set-port-output-size! "size is too big" i))
(error 'set-port-output-size! "size is negative" i))
(error 'set-port-output-size! "not a valid size" i))
(error 'set-port-output-size! "not an output-port" p)))))
(error 'set-port-output-size! "not an output-port" p))))
(define (port-mode p)
(if (port? p)
(let ([attr ($port-attributes p)])
(case (fxand attr 1)
[(0) 'ikarus-mode]
[else 'r6rs-mode]))
(error 'port-mode "not a port" p)))
(define (set-port-mode! p m)
(if (port? p)
(let ([attr ($port-attributes p)])
($set-port-attributes! p
(case m
[(ikarus-mode) (fxand attr (fxnot 1))]
[(r6rs-mode) (fxior attr 1)]
[else (error 'set-port-mode! "invalid mode" m)])))
(error 'port-mode "not a port" p)))
)

4
scheme/makefile.ss
View File

@ -332,6 +332,8 @@
[port-name i]
[input-port-name i]
[output-port-name i]
[port-mode i]
[set-port-mode! i]
[with-input-from-string i]
[open-output-string i]
[open-input-string i r]
@ -496,6 +498,8 @@
[$port-size $ports]
[$set-port-index! $ports]
[$set-port-size! $ports]
[$port-attributes $ports]
[$set-port-attributes! $ports]
[$closure-code $codes]
[$code->closure $codes]
[$code-reloc-vector $codes]

6
scheme/pass-specify-rep-primops.ss
View File

@ -1727,9 +1727,9 @@
(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-attributes vector-tag)) (K 0))
(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
@ -1755,6 +1755,10 @@
(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 $port-attributes unsafe
[(V x) (prm 'mref (T x) (K (- disp-port-attributes vector-tag)))])
(define-primop $set-port-attributes! unsafe
[(E x i) (prm 'mset (T x) (K (- disp-port-attributes vector-tag)) (T i))])
/section)