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

* Added endianness and native-endianness

This commit is contained in:
Abdulaziz Ghuloum 2007-09-10 15:15:20 -04:00
parent 64b06d698b
commit 009a25ad30
5 changed files with 25 additions and 8 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.

17
src/ikarus.bytevectors.ss
View File

@ -11,7 +11,8 @@
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)
(import (import
(except (ikarus) (except (ikarus)
make-bytevector bytevector-length bytevector-s8-ref make-bytevector bytevector-length bytevector-s8-ref
@ -25,12 +26,16 @@
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)
(ikarus system $fx) (ikarus system $fx)
(ikarus system $bignums) (ikarus system $bignums)
(ikarus system $pairs) (ikarus system $pairs)
(ikarus system $bytevectors)) (ikarus system $bytevectors))
(define (native-endianness) 'big) ;;; HARDCODED
(define ($bytevector-fill x i j fill) (define ($bytevector-fill x i j fill)
(cond (cond
[($fx= i j) x] [($fx= i j) x]
@ -101,7 +106,7 @@
(error 'bytevector-u8-set! "invalid index ~s for ~s" i x)) (error 'bytevector-u8-set! "invalid index ~s for ~s" i x))
(error 'bytevector-u8-set! "~s is not a bytevector" x)))) (error 'bytevector-u8-set! "~s is not a bytevector" x))))
(define bytevector-u16-native-ref (define bytevector-u16-native-ref ;;; HARDCODED
(lambda (x i) (lambda (x i)
(if (bytevector? x) (if (bytevector? x)
(if (and (fixnum? i) (if (and (fixnum? i)
@ -114,7 +119,7 @@
(error 'bytevector-u16-native-ref "invalid index ~s" i)) (error 'bytevector-u16-native-ref "invalid index ~s" i))
(error 'bytevector-u16-native-ref "~s is not a bytevector" x)))) (error 'bytevector-u16-native-ref "~s is not a bytevector" x))))
(define bytevector-u16-native-set! (define bytevector-u16-native-set! ;;; HARDCODED
(lambda (x i n) (lambda (x i n)
(if (bytevector? x) (if (bytevector? x)
(if (and (fixnum? n) (if (and (fixnum? n)
@ -132,7 +137,7 @@
(error 'bytevector-u16-native-set! "~s is not a bytevector" x)))) (error 'bytevector-u16-native-set! "~s is not a bytevector" x))))
(define bytevector-s16-native-set! (define bytevector-s16-native-set! ;;; HARDCODED
(lambda (x i n) (lambda (x i n)
(if (bytevector? x) (if (bytevector? x)
(if (and (fixnum? n) (if (and (fixnum? n)
@ -149,7 +154,7 @@
(error 'bytevector-s16-native-set! "invalid value ~s" n)) (error 'bytevector-s16-native-set! "invalid value ~s" n))
(error 'bytevector-s16-native-set! "~s is not a bytevector" x)))) (error 'bytevector-s16-native-set! "~s is not a bytevector" x))))
(define bytevector-s16-native-ref (define bytevector-s16-native-ref ;;; HARDCODED
(lambda (x i) (lambda (x i)
(if (bytevector? x) (if (bytevector? x)
(if (and (fixnum? i) (if (and (fixnum? i)

9
src/ikarus.syntax.ss
View File

@ -810,6 +810,14 @@
[(_ expr) [(_ expr)
(bless `(unless ,expr (bless `(unless ,expr
(error 'assert "~s failed" ',expr)))]))) (error 'assert "~s failed" ',expr)))])))
(define endianness-macro
(lambda (stx)
(syntax-match stx ()
[(_ e)
(case (syntax->datum e)
[(little) (bless `'little)]
[(big) (bless `'big)]
[else (stx-error stx "endianness must be big or little")])])))
(define identifier-syntax-macro (define identifier-syntax-macro
(lambda (stx) (lambda (stx)
(syntax-match stx () (syntax-match stx ()
@ -1658,6 +1666,7 @@
[(time) time-macro] [(time) time-macro]
[(delay) delay-macro] [(delay) delay-macro]
[(assert) assert-macro] [(assert) assert-macro]
[(endianness) endianness-macro]
[(... => _ else unquote unquote-splicing [(... => _ else unquote unquote-splicing
unsyntax unsyntax-splicing) unsyntax unsyntax-splicing)
incorrect-usage-macro] incorrect-usage-macro]

3
src/makefile.ss
View File

@ -114,6 +114,7 @@
[or (macro . or)] [or (macro . or)]
[time (macro . time)] [time (macro . time)]
[delay (macro . delay)] [delay (macro . delay)]
[endianness (macro . endianness)]
[assert (macro . assert)] [assert (macro . assert)]
[... (macro . ...)] [... (macro . ...)]
[=> (macro . =>)] [=> (macro . =>)]
@ -251,6 +252,7 @@
[or i r ne] [or i r ne]
[time i] [time i]
[delay i ne] [delay i ne]
[endianness i ]
[assert i r] [assert i r]
[... i r ne] [... i r ne]
[=> i r ne] [=> i r ne]
@ -415,6 +417,7 @@
[sint-list->bytevector i] [sint-list->bytevector i]
[string->utf8-bytevector i] [string->utf8-bytevector i]
[utf8-bytevector->string i] [utf8-bytevector->string i]
[native-endianness i]
[for-each i r] [for-each i r]
[map i r] [map i r]

4
src/todo-r6rs.ss
View File

@ -398,8 +398,8 @@
[bytevector-uint-set! C bv] [bytevector-uint-set! C bv]
[bytevector=? C bv] [bytevector=? C bv]
[bytevector? C bv] [bytevector? C bv]
[endianness S bv] [endianness C bv]
[native-endianness S bv] [native-endianness C bv]
[sint-list->bytevector C bv] [sint-list->bytevector C bv]
[string->utf16 S bv] [string->utf16 S bv]
[string->utf32 S bv] [string->utf32 S bv]