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.

95
scheme/ikarus.bytevectors.ss
View File

@ -15,42 +15,45 @@
(library (ikarus bytevectors) (library (ikarus bytevectors)
(export make-bytevector bytevector-length bytevector-s8-ref (export
bytevector-u8-ref bytevector-u8-set! bytevector-s8-set! make-bytevector bytevector-length bytevector-s8-ref
bytevector-copy! u8-list->bytevector bytevector->u8-list bytevector-u8-ref bytevector-u8-set! bytevector-s8-set!
bytevector-u16-native-ref bytevector-u16-native-set! bytevector-copy! u8-list->bytevector bytevector->u8-list
bytevector-u32-native-ref bytevector-u32-native-set! bytevector-u16-native-ref bytevector-u16-native-set!
bytevector-s32-native-ref bytevector-s32-native-set! bytevector-u32-native-ref bytevector-u32-native-set!
bytevector-u16-ref bytevector-u16-set! bytevector-s32-native-ref bytevector-s32-native-set!
bytevector-u32-ref bytevector-u32-set! bytevector-u16-ref bytevector-u16-set!
bytevector-s32-ref bytevector-s32-set! bytevector-u32-ref bytevector-u32-set!
bytevector-s16-native-ref bytevector-s16-native-set! bytevector-s32-ref bytevector-s32-set!
bytevector-s16-ref bytevector-s16-set! bytevector-s16-native-ref bytevector-s16-native-set!
bytevector-fill! bytevector-copy bytevector=? bytevector-s16-ref bytevector-s16-set!
bytevector-uint-ref bytevector-sint-ref bytevector-fill! bytevector-copy bytevector=?
bytevector-uint-set! bytevector-sint-set! bytevector-uint-ref bytevector-sint-ref
bytevector->uint-list bytevector->sint-list bytevector-uint-set! bytevector-sint-set!
uint-list->bytevector sint-list->bytevector bytevector->uint-list bytevector->sint-list
native-endianness) uint-list->bytevector sint-list->bytevector
bytevector-ieee-double-native-ref bytevector-ieee-double-native-set!
native-endianness)
(import (import
(except (ikarus) (except (ikarus)
make-bytevector bytevector-length bytevector-s8-ref 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!
bytevector-u32-native-ref bytevector-u32-native-set! bytevector-u32-native-ref bytevector-u32-native-set!
bytevector-s32-native-ref bytevector-s32-native-set! bytevector-s32-native-ref bytevector-s32-native-set!
bytevector-u16-ref bytevector-u16-set! bytevector-u16-ref bytevector-u16-set!
bytevector-u32-ref bytevector-u32-set! bytevector-u32-ref bytevector-u32-set!
bytevector-s32-ref bytevector-s32-set! bytevector-s32-ref bytevector-s32-set!
bytevector-s16-native-ref bytevector-s16-native-set! bytevector-s16-native-ref bytevector-s16-native-set!
bytevector-s16-ref bytevector-s16-set! bytevector-s16-ref bytevector-s16-set!
bytevector-fill! bytevector-copy bytevector=? bytevector-fill! bytevector-copy bytevector=?
bytevector-uint-ref bytevector-sint-ref bytevector-uint-ref bytevector-sint-ref
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
native-endianness) bytevector-ieee-double-native-ref bytevector-ieee-double-native-set!
native-endianness)
(ikarus system $fx) (ikarus system $fx)
(ikarus system $bignums) (ikarus system $bignums)
(ikarus system $pairs) (ikarus system $pairs)
@ -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]