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

* Added bytevector-ieee-double-native-ref/set!

This commit is contained in:
Abdulaziz Ghuloum 2007-11-06 21:08:52 -05:00
parent 7783cef318
commit bcd96a8dd4
7 changed files with 3363 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3271
benchmarks/timelog
View File

File diff suppressed because it is too large Load Diff

BIN
scheme/ikarus.boot.orig
View File

Binary file not shown.

29
scheme/ikarus.bytevectors.ss
View File

@ -15,7 +15,8 @@
(library (ikarus bytevectors) (library (ikarus bytevectors)
(export make-bytevector bytevector-length bytevector-s8-ref (export
make-bytevector bytevector-length bytevector-s8-ref
bytevector-u8-ref bytevector-u8-set! bytevector-s8-set! bytevector-u8-ref bytevector-u8-set! bytevector-s8-set!
bytevector-copy! u8-list->bytevector bytevector->u8-list bytevector-copy! u8-list->bytevector bytevector->u8-list
bytevector-u16-native-ref bytevector-u16-native-set! bytevector-u16-native-ref bytevector-u16-native-set!
@ -31,6 +32,7 @@
bytevector-uint-set! bytevector-sint-set! bytevector-uint-set! bytevector-sint-set!
bytevector->uint-list bytevector->sint-list bytevector->uint-list bytevector->sint-list
uint-list->bytevector sint-list->bytevector uint-list->bytevector sint-list->bytevector
bytevector-ieee-double-native-ref bytevector-ieee-double-native-set!
native-endianness) native-endianness)
(import (import
(except (ikarus) (except (ikarus)
@ -50,6 +52,7 @@
bytevector-uint-set! bytevector-sint-set! bytevector-uint-set! bytevector-sint-set!
bytevector->uint-list bytevector->sint-list bytevector->uint-list bytevector->sint-list
uint-list->bytevector sint-list->bytevector uint-list->bytevector sint-list->bytevector
bytevector-ieee-double-native-ref bytevector-ieee-double-native-set!
native-endianness) native-endianness)
(ikarus system $fx) (ikarus system $fx)
(ikarus system $bignums) (ikarus system $bignums)
@ -969,6 +972,30 @@
(make-xint-list->bytevector (make-xint-list->bytevector
'sint-list->bytevector bytevector-sint-set!))) 'sint-list->bytevector bytevector-sint-set!)))
(define (bytevector-ieee-double-native-ref bv i)
(if (bytevector? bv)
(if (and (fixnum? i)
($fx>= i 0)
($fxzero? ($fxlogand i 3))
($fx< i ($bytevector-length bv)))
($bytevector-ieee-double-native-ref bv i)
(error 'bytevector-ieee-double-native-ref "invalid index" i))
(error 'bytevector-ieee-double-native-ref "not a bytevector" bv)))
(define (bytevector-ieee-double-native-set! bv i x)
(if (bytevector? bv)
(if (and (fixnum? i)
($fx>= i 0)
($fxzero? ($fxlogand i 3))
($fx< i ($bytevector-length bv)))
(if (flonum? x)
($bytevector-ieee-double-native-set! bv i x)
(error 'bytevector-ieee-double-native-ref "not a flonum" x))
(error 'bytevector-ieee-double-native-ref "invalid index" i))
(error 'bytevector-ieee-double-native-ref "not a bytevector" bv)))
) )

6
scheme/makefile.ss
View File

@ -408,6 +408,8 @@
[$bytevector-s8-ref $bytes] [$bytevector-s8-ref $bytes]
[$bytevector-u8-ref $bytes] [$bytevector-u8-ref $bytes]
[$bytevector-set! $bytes] [$bytevector-set! $bytes]
[$bytevector-ieee-double-native-ref $bytes]
[$bytevector-ieee-double-native-set! $bytes]
[$flonum-u8-ref $flonums] [$flonum-u8-ref $flonums]
[$make-flonum $flonums] [$make-flonum $flonums]
[$flonum-set! $flonums] [$flonum-set! $flonums]
@ -860,8 +862,8 @@
[bytevector-copy i r bv] [bytevector-copy i r bv]
[bytevector-copy! i r bv] [bytevector-copy! i r bv]
[bytevector-fill! i r bv] [bytevector-fill! i r bv]
[bytevector-ieee-double-native-ref r bv] [bytevector-ieee-double-native-ref i r bv]
[bytevector-ieee-double-native-set! r bv] [bytevector-ieee-double-native-set! i r bv]
[bytevector-ieee-double-ref r bv] [bytevector-ieee-double-ref r bv]
[bytevector-ieee-single-native-ref r bv] [bytevector-ieee-single-native-ref r bv]
[bytevector-ieee-single-native-set! r bv] [bytevector-ieee-single-native-set! r bv]

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

@ -1364,6 +1364,25 @@
(K (- disp-bytevector-data bytevector-tag))) (K (- disp-bytevector-data bytevector-tag)))
(prm 'sll (T c) (K (- 8 fx-shift))))])])]) (prm 'sll (T c) (K (- 8 fx-shift))))])])])
(define-primop $bytevector-ieee-double-native-ref unsafe
[(V bv i)
(with-tmp ([x (prm 'alloc (K (align flonum-size)) (K vector-tag))])
(prm 'mset x (K (- vector-tag)) (K flonum-tag))
(prm 'fl:load
(prm 'int+ (T bv) (prm 'sra (T i) (K fixnum-shift)))
(K (- disp-bytevector-data bytevector-tag)))
(prm 'fl:store x (K (- disp-flonum-data vector-tag)))
x)])
(define-primop $bytevector-ieee-double-native-set! unsafe
[(E bv i x)
(seq*
(prm 'fl:load (T x) (K (- disp-flonum-data vector-tag)))
(prm 'fl:store
(prm 'int+ (T bv) (prm 'sra (T i) (K fixnum-shift)))
(K (- disp-bytevector-data bytevector-tag))))])
/section) /section)
(section ;;; strings (section ;;; strings

4
scheme/tests/bytevectors.ss
View File

@ -277,6 +277,10 @@
(bytevector-s32-set! v 0 -12345 'big) (bytevector-s32-set! v 0 -12345 'big)
(bytevector-s32-ref v 0 'big))] (bytevector-s32-ref v 0 'big))]
[(lambda (x) (= x 17.0))
(let ([v (make-bytevector 8)])
(bytevector-ieee-double-native-set! v 0 17.0)
(bytevector-ieee-double-native-ref v 0))]

6
scheme/todo-r6rs.ss
View File

@ -375,12 +375,14 @@
[bytevector-copy C bv] [bytevector-copy C bv]
[bytevector-copy! C bv] [bytevector-copy! C bv]
[bytevector-fill! C bv] [bytevector-fill! C bv]
[bytevector-ieee-double-native-ref S bv] [bytevector-ieee-double-native-ref C bv]
[bytevector-ieee-double-native-set! S bv] [bytevector-ieee-double-native-set! C bv]
[bytevector-ieee-double-ref S bv] [bytevector-ieee-double-ref S bv]
[bytevector-ieee-double-set! S bv]
[bytevector-ieee-single-native-ref S bv] [bytevector-ieee-single-native-ref S bv]
[bytevector-ieee-single-native-set! S bv] [bytevector-ieee-single-native-set! S bv]
[bytevector-ieee-single-ref S bv] [bytevector-ieee-single-ref S bv]
[bytevector-ieee-single-set! S bv]
[bytevector-length C bv] [bytevector-length C bv]
[bytevector-s16-native-ref C bv] [bytevector-s16-native-ref C bv]
[bytevector-s16-native-set! C bv] [bytevector-s16-native-set! C bv]