1;;; 2;;; srfi-74 - Octet-addressed binary blocks 3;;; 4 5;; On Gauche, a blob is just an u8vector. 6 7(define-module srfi-74 8 (use gauche.uvector) 9 (use gauche.generator) 10 (use binary.io) 11 (export endianness blob? make-blob blob-length 12 blob-u8-ref blob-u8-set! 13 blob-s8-ref blob-s8-set! 14 blob-u16-ref blob-u16-set! 15 blob-u16-native-ref blob-u16-native-set! 16 blob-s16-ref blob-s16-set! 17 blob-s16-native-ref blob-s16-native-set! 18 blob-u32-ref blob-u32-set! 19 blob-u32-native-ref blob-u32-native-set! 20 blob-s32-ref blob-s32-set! 21 blob-s32-native-ref blob-s32-native-set! 22 blob-u64-ref blob-u64-set! 23 blob-u64-native-ref blob-u64-native-set! 24 blob-s64-ref blob-s64-set! 25 blob-s64-native-ref blob-s64-native-set! 26 blob-uint-ref blob-uint-set! 27 blob-sint-ref blob-sint-set! 28 blob=? blob-copy! blob-copy 29 blob->u8-list u8-list->blob 30 blob->uint-list uint-list->blob 31 blob->sint-list sint-list->blob)) 32(select-module srfi-74) 33 34(define-constant native (native-endian)) 35 36(define-syntax endianness 37 (syntax-rules (big little native) 38 [(_ big) 'big-endian] 39 [(_ little) 'little-endian] 40 [(_ native) native] 41 [(_ x) (syntax-error "Unknown endianness:" x)])) 42 43(define blob? u8vector?) 44 45(define (make-blob k) (make-u8vector k)) 46 47(define (blob-length blob) (u8vector-length blob)) 48 49(define (blob-u8-ref blob k) (get-u8 blob k)) 50(define (blob-u8-set! blob k v) (put-u8! blob k v)) 51(define (blob-s8-ref blob k) (get-s8 blob k)) 52(define (blob-s8-set! blob k v) (put-s8! blob k v)) 53 54(define (blob-u16-ref endi blob k) (get-u16 blob k endi)) 55(define (blob-u16-native-ref blob k) (get-u16 blob k native)) 56(define (blob-u16-set! endi blob k v) (put-u16! blob k endi)) 57(define (blob-u16-native-set! blob k v) (put-u16! blob k native)) 58 59(define (blob-s16-ref endi blob k) (get-s16 blob k endi)) 60(define (blob-s16-native-ref blob k) (get-s16 blob k native)) 61(define (blob-s16-set! endi blob k v) (put-s16! blob k endi)) 62(define (blob-s16-native-set! blob k v) (put-s16! blob k native)) 63 64(define (blob-u32-ref endi blob k) (get-u32 blob k endi)) 65(define (blob-u32-native-ref blob k) (get-u32 blob k native)) 66(define (blob-u32-set! endi blob k v) (put-u32! blob k endi)) 67(define (blob-u32-native-set! blob k v) (put-u32! blob k native)) 68 69(define (blob-s32-ref endi blob k) (get-s32 blob k endi)) 70(define (blob-s32-native-ref blob k) (get-s32 blob k native)) 71(define (blob-s32-set! endi blob k v) (put-s32! blob k endi)) 72(define (blob-s32-native-set! blob k v) (put-s32! blob k native)) 73 74(define (blob-u64-ref endi blob k) (get-u64 blob k endi)) 75(define (blob-u64-native-ref blob k) (get-u64 blob k native)) 76(define (blob-u64-set! endi blob k v) (put-u64! blob k endi)) 77(define (blob-u64-native-set! blob k v) (put-u64! blob k native)) 78 79(define (blob-s64-ref endi blob k) (get-s64 blob k endi)) 80(define (blob-s64-native-ref blob k) (get-s64 blob k native)) 81(define (blob-s64-set! endi blob k v) (put-s64! blob k endi)) 82(define (blob-s64-native-set! blob k v) (put-s64! blob k native)) 83 84(define (blob-uint-ref size endi blob k) 85 (assume-type blob <u8vector>) 86 (get-uint size blob k endi)) 87 88(define (blob-sint-ref size endi blob k) 89 (assume-type blob <u8vector>) 90 (get-sint size blob k endi)) 91 92(define (blob-uint-set! size endi blob k v) 93 (assume-type blob <u8vector>) 94 (put-uint! size blob k v endi)) 95 96(define (blob-sint-set! size endi blob k v) 97 (assume-type blob <u8vector>) 98 (put-sint! size blob k v endi)) 99 100(define (blob=? a b) (u8vector=? a b)) 101 102(define (blob-copy! src src-start target target-start n) 103 (u8vector-copy! target target-start src src-start (+ src-start n))) 104 105(define (blob-copy blob) (u8vector-copy blob)) 106 107(define blob->u8-list u8vector->list) 108(define u8-list->blob list->u8vector) 109 110(define (blob->uint-list size endi blob) 111 (generator->list (gmap (cut blob-uint-ref size endi blob <>) 112 (grange 0 (blob-length blob) size)))) 113(define (blob->sint-list size endi blob) 114 (generator->list (gmap (cut blob-sint-ref size endi blob <>) 115 (grange 0 (blob-length blob) size)))) 116 117(define (uint-list->blob size endi lis) 118 (rlet1 v (make-u8vector (* size (length lis))) 119 (do ([k 0 (+ k size)] 120 [lis lis (cdr lis)]) 121 [(null? lis)] 122 (blob-uint-set! size endi v k (car lis))))) 123(define (sint-list->blob size endi lis) 124 (rlet1 v (make-u8vector (* size (length lis))) 125 (do ([k 0 (+ k size)] 126 [lis lis (cdr lis)]) 127 [(null? lis)] 128 (blob-sint-set! size endi v k (car lis))))) 129