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

* Added $port-buffer, $port-index, $port-size, $set-port-index!, and 

$set-port-size!.  Next step is removing the input/output-specific
  accessors and mutators.
This commit is contained in:
Abdulaziz Ghuloum 2007-08-25 10:49:39 -04:00
parent 33c087a867
commit c5530973d0
6 changed files with 81 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
benchmarks.larceny/results.Larceny-r6rs
View File

@ -8190,3 +8190,23 @@ Words allocated: 551809361
Words reclaimed: 0
Elapsed time...: 2246 ms (User: 2230 ms; System: 15 ms)
Elapsed GC time: 753 ms (CPU: 762 in 2105 collections.)
****************************
Benchmarking Larceny-r6rs on Sat Jul 14 07:09:21 AST 2007 under Darwin Vesuvius.local 8.9.1 Darwin Kernel Version 8.9.1: Thu Feb 22 20:55:00 PST 2007; root:xnu-792.18.15~1/RELEASE_I386 i386 i386
Testing fibfp under Larceny-r6rs
Compiling...
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
>
>
Running...
Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
>
Words allocated: 358610884
Words reclaimed: 0
Elapsed time...: 3289 ms (User: 3248 ms; System: 39 ms)
Elapsed GC time: 486 ms (CPU: 489 in 1368 collections.)

BIN
src/ikarus.boot
View File

Binary file not shown.

18
src/ikarus.compiler.ss
View File

@ -1796,19 +1796,23 @@
(define disp-code-relocsize 8)
(define disp-code-freevars 12)
(define disp-code-data 16)
(define port-tag #x3F)
(define input-port-tag #x7F)
(define output-port-tag #xBF)
(define input/output-port-tag #xFF)
(define output-port-tag #x7F)
(define input-port-tag #xBF)
;(define input/output-port-tag #xFF)
(define port-mask #x3F)
(define disp-port-handler 4)
(define disp-port-input-buffer 8)
(define disp-port-input-index 12)
(define disp-port-input-size 16)
(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 port-size 32)
(define disp-tcbucket-tconc 0)
(define disp-tcbucket-key 4)
(define disp-tcbucket-val 8)

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

@ -1,6 +1,6 @@
(library (ikarus io-ports)
(export make-input-port make-output-port make-input/output-port
(export make-input-port make-output-port ;make-input/output-port
port-handler
port-input-buffer port-output-buffer
port-input-index set-port-input-index!
@ -12,8 +12,10 @@
(ikarus system $strings)
(ikarus system $bytevectors)
(ikarus system $fx)
(except (ikarus) make-input-port make-output-port
make-input/output-port port-handler
(except (ikarus)
make-input-port make-output-port
;make-input/output-port
port-handler
port-input-buffer port-output-buffer
port-input-index set-port-input-index!
port-input-size set-port-input-size!
@ -75,21 +77,21 @@
(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)
; ($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 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)

8
src/makefile.ss
View File

@ -692,8 +692,13 @@
[$make-port/input $ports]
[$make-port/output $ports]
[$make-port/both $ports]
[$port-handler $ports]
[$port-buffer $ports]
[$port-index $ports]
[$port-size $ports]
[$set-port-index! $ports]
[$set-port-size! $ports]
[$port-input-buffer $ports]
[$port-input-index $ports]
[$port-input-size $ports]
@ -705,6 +710,7 @@
[$set-port-output-index! $ports]
[$set-port-output-size! $ports]
[$closure-code $codes]
[$code->closure $codes]
[$code-reloc-vector $codes]

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

@ -1424,10 +1424,10 @@
(define (make-port handler buf/i idx/i sz/i buf/o idx/o sz/o 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-input-buffer vector-tag)) (T buf/i))
(prm 'mset p (K (- disp-port-input-index vector-tag)) (T idx/i))
(prm 'mset p (K (- disp-port-input-size vector-tag)) (T sz/i))
(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))
@ -1437,48 +1437,55 @@
[(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)])
(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)])
(define-primop $make-port/both 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/output-port-tag)])
(define-primop $port-handler unsafe
[(V x) (prm 'mref (T x) (K (- disp-port-handler vector-tag)))])
(define-primop $port-buffer unsafe
[(V x) (prm 'mref (T x) (K (- disp-port-buffer vector-tag)))])
(define-primop $port-index unsafe
[(V x) (prm 'mref (T x) (K (- disp-port-index vector-tag)))])
(define-primop $port-size unsafe
[(V x) (prm 'mref (T x) (K (- disp-port-size vector-tag)))])
(define-primop $set-port-index! unsafe
[(E x i) (prm 'mset (T x) (K (- disp-port-index vector-tag)) (T i))])
(define-primop $set-port-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 $port-input-buffer unsafe
[(V x) (prm 'mref (T x) (K (- disp-port-input-buffer vector-tag)))])
[(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-input-index vector-tag)))])
[(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-input-size vector-tag)))])
[(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-input-index vector-tag)) (T i))])
[(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-input-index vector-tag)) (K 0))
(prm 'mset (T x) (K (- disp-port-input-size vector-tag)) (T i)))])
(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*
(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