Changeset 38917 in project


Ignore:
Timestamp:
08/30/20 04:13:29 (4 weeks ago)
Author:
Kon Lovett
Message:

add -strict-types, fix pack-integer single-byte error (arg order), group types

Location:
release/5/blob-utils/trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • release/5/blob-utils/trunk/blob-hexadecimal.scm

    r38412 r38917  
    2424
    2525(: blob->hex (blob #!optional fixnum (or fixnum boolean) -> string))
    26 ;
     26
     27;;
     28
    2729(define (blob->hex blb #!optional (start 0) (end #f))
    2830  (check-blob 'blob->hex blb)
  • release/5/blob-utils/trunk/blob-set-int.scm

    r38412 r38917  
    2626  check-blob))
    2727
    28 ;;; Only Blob Bytevector, No Argument Checking
     28;;
    2929
    3030(: *blob-set-u8! ((or blob string) number fixnum -> void))
    31 ;
     31(: *blob-set-u16-le! ((or blob string) number fixnum -> void))
     32(: *blob-set-u32-le! ((or blob string) number fixnum -> void))
     33(: *blob-set-u64-le! ((or blob string) number fixnum -> void))
     34(: *blob-set-u16-be! ((or blob string) number fixnum -> void))
     35(: *blob-set-u32-be! ((or blob string) number fixnum -> void))
     36(: *blob-set-u64-be! ((or blob string) number fixnum -> void))
     37(: blob-set-u8! (blob fixnum #!optional fixnum -> void))
     38(: blob-set-u16-le! (blob fixnum #!optional fixnum -> void))
     39(: blob-set-u32-le! (blob number #!optional fixnum -> void))
     40(: blob-set-u64-le! (blob number #!optional fixnum -> void))
     41(: blob-set-u16-be! (blob fixnum #!optional fixnum -> void))
     42(: blob-set-u32-be! (blob number #!optional fixnum -> void))
     43(: blob-set-u64-be! (blob number #!optional fixnum -> void))
     44
     45;; Only Blob Bytevector, No Argument Checking
     46
    3247(define *blob-set-u8!
    3348  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer32 u32) (int off)) "
    3449    ((uint8_t *)bv)[off] = (uint8_t)(u32 & 0xff);"))
    3550
    36 (: *blob-set-u16-le! ((or blob string) number fixnum -> void))
    37 ;
    3851(define *blob-set-u16-le!
    3952  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer32 u32) (int off)) "
     
    4154    ((uint8_t *)bv)[++off] = (uint8_t)((u32 >> 8) & 0xff);"))
    4255
    43 (: *blob-set-u32-le! ((or blob string) number fixnum -> void))
    44 ;
    4556(define *blob-set-u16-be!
    4657  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer32 u32) (int off)) "
     
    4859    ((uint8_t *)bv)[++off] = (uint8_t)(u32 & 0xff);"))
    4960
    50 (: *blob-set-u64-le! ((or blob string) number fixnum -> void))
    51 ;
    5261(define *blob-set-u32-le!
    5362  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer32 u32) (int off)) "
     
    5766    ((uint8_t *)bv)[++off] = (uint8_t)((u32 >> 24) & 0xff);"))
    5867
    59 (: *blob-set-u16-be! ((or blob string) number fixnum -> void))
    60 ;
    6168(define *blob-set-u32-be!
    6269  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer32 u32) (int off)) "
     
    6673    ((uint8_t *)bv)[++off] = (uint8_t)(u32 & 0xff);"))
    6774
    68 (: *blob-set-u32-be! ((or blob string) number fixnum -> void))
    69 ;
    7075(define *blob-set-u64-le!
    7176  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer64 u64) (int off)) "
     
    7984    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 56) & 0xff);"))
    8085
    81 (: *blob-set-u64-be! ((or blob string) number fixnum -> void))
    82 ;
    8386(define *blob-set-u64-be!
    8487  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer64 u64) (int off)) "
     
    9295    ((uint8_t *)bv)[++off] = (uint8_t)(u64 & 0xff);"))
    9396
    94 ;;; Only Blob Bytevector
     97;; Only Blob Bytevector
    9598
    9699;; 8
    97100
    98 (: blob-set-u8! (blob fixnum #!optional fixnum -> void))
    99 ;
    100101(define (blob-set-u8! blb uint #!optional (off 0))
    101102  (*blob-set-u8!
     
    106107;; Little Endian 16, 32, & 64
    107108
    108 (: blob-set-u16-le! (blob fixnum #!optional fixnum -> void))
    109 ;
    110109(define (blob-set-u16-le! blb uint #!optional (off 0))
    111110  (*blob-set-u16-le!
     
    114113    (check-natural-fixnum 'blob-set-u16-le! off 'offset)) )
    115114
    116 (: blob-set-u32-le! (blob number #!optional fixnum -> void))
    117 ;
    118115(define (blob-set-u32-le! blb uint #!optional (off 0))
    119116  (*blob-set-u32-le!
     
    122119    (check-natural-fixnum 'blob-set-u32-le! off 'offset)) )
    123120
    124 (: blob-set-u64-le! (blob number #!optional fixnum -> void))
    125 ;
    126121(define (blob-set-u64-le! blb uint #!optional (off 0))
    127122  (*blob-set-u64-le!
     
    132127;; Big Endian 16, 32, & 64
    133128
    134 (: blob-set-u16-be! (blob fixnum #!optional fixnum -> void))
    135 ;
    136129(define (blob-set-u16-be! blb uint #!optional (off 0))
    137130  (*blob-set-u16-be!
     
    140133    (check-natural-fixnum 'blob-set-u16-be! off 'offset)) )
    141134
    142 (: blob-set-u32-be! (blob number #!optional fixnum -> void))
    143 ;
    144135(define (blob-set-u32-be! blb uint #!optional (off 0))
    145136  (*blob-set-u32-be!
     
    148139    (check-natural-fixnum 'blob-set-u32-be! off 'offset)) )
    149140
    150 (: blob-set-u64-be! (blob number #!optional fixnum -> void))
    151 ;
    152141(define (blob-set-u64-be! blb uint #!optional (off 0))
    153142  (*blob-set-u64-be!
  • release/5/blob-utils/trunk/blob-utils.egg

    r38412 r38917  
    66 (author "[[kon lovett]]")
    77 (license "BSD")
    8  (version "2.0.1")
    9  (dependencies
    10         (string-utils "2.0.5")  ;to-hex
    11         (check-errors "3.1.0"))
     8 (version "2.0.2")
     9 (dependencies string-utils check-errors)
    1210 (test-dependencies test)
    1311 (components
    1412  (extension blob-set-int
    1513    (types-file)
    16     (csc-options "-O3" "-d1" "-no-procedure-checks" "-no-argc-checks" "-no-bound-checks") )
     14    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-argc-checks" "-no-bound-checks") )
    1715  (extension pack-integer
    1816    (types-file)
    1917    (component-dependencies blob-set-int)
    20     (csc-options "-O3" "-d1" "-no-procedure-checks" "-no-bound-checks") )
     18    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") )
    2119  (extension blob-hexadecimal
    2220    (types-file)
    23     (csc-options "-O3" "-d1" "-no-procedure-checks" "-no-bound-checks") )
     21    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") )
    2422  (extension blob-utils
    2523    (types-file)
    2624    (component-dependencies blob-hexadecimal blob-set-int)
    27     (csc-options "-O3" "-d1" "-no-procedure-checks" "-no-bound-checks") ) ) )
     25    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") ) ) )
  • release/5/blob-utils/trunk/blob-utils.scm

    r38412 r38917  
    3535(define-type bytevector (or blob string srfi-4-vector))
    3636
     37(: bytes->hexstring (bytevector #!optional fixnum fixnum -> string))
     38(: bytes-set-u8! (bytevector fixnum fixnum -> void))
     39(: bytes-set-s8! (bytevector fixnum fixnum -> void))
     40(: bytes-set-u16! (bytevector fixnum fixnum -> void))
     41(: bytes-set-s16! (bytevector fixnum fixnum -> void))
     42(: bytes-set-u32! (bytevector fixnum number -> void))
     43(: bytes-set-s32! (bytevector fixnum number -> void))
     44(: bytes-set-u64! (bytevector fixnum number -> void))
     45(: bytes-set-s64! (bytevector fixnum number -> void))
     46
    3747;;
    3848
     
    6979;;
    7080
    71 (: bytes->hexstring (bytevector #!optional fixnum fixnum -> string))
    72 ;
    7381(define (bytes->hexstring bv #!optional (start 0) (end #f))
    7482  (blob->hex (get-bv 'bytes->hexstring bv) start end) )
     
    7684;; 8
    7785
    78 (: bytes-set-u8! (bytevector fixnum fixnum -> void))
    79 ;
    8086(define (bytes-set-u8! bv idx uint)
    8187        (*blob-set-u8! (get-bv-alias 'bytes-set-u8! bv) uint idx) )
    8288
    83 (: bytes-set-s8! (bytevector fixnum fixnum -> void))
    84 ;
    8589(define (bytes-set-s8! bv idx int)
    8690        (*blob-set-u8! (get-bv-alias 'bytes-set-u8! bv) int idx) )
     
    9094(define-inline (get-byte-order loc obj)
    9195  (case obj
    92         ((big-endian be big msb)
    93           'big-endian )
    94         ((little-endian le little lsb)
    95           'little-endian )
     96        ((big-endian be big msb)        'big-endian )
     97        ((little-endian le little lsb)  'little-endian )
    9698    (else
    9799        (error-argument-type loc obj "symbol in {big-endian be big msb little-endian le little lsb}" obj) ) ) )
     
    99101;;
    100102
    101 (: bytes-set-u16! (bytevector fixnum fixnum -> void))
    102 ;
    103103(define (bytes-set-u16! bv idx uint #!optional (order (machine-byte-order)))
    104104        (let ((bv (get-bv-alias 'bytes-set-u16! bv)))
     
    109109                          (*blob-set-u16-be! bv uint idx) ) ) ) )
    110110
    111 (: bytes-set-s16! (bytevector fixnum fixnum -> void))
    112 ;
    113111(define (bytes-set-s16! bv idx int #!optional (order (machine-byte-order)))
    114112        (let ((bv (get-bv-alias 'bytes-set-s16! bv)))
     
    120118
    121119
    122 (: bytes-set-u32! (bytevector fixnum number -> void))
    123 ;
    124120(define (bytes-set-u32! bv idx uint #!optional (order (machine-byte-order)))
    125121        (let ((bv (get-bv-alias 'bytes-set-u32! bv)))
     
    130126                          (*blob-set-u32-be! bv uint idx) ) ) ) )
    131127
    132 (: bytes-set-s32! (bytevector fixnum number -> void))
    133 ;
    134128(define (bytes-set-s32! bv idx int #!optional (order (machine-byte-order)))
    135129        (let ((bv (get-bv-alias 'bytes-set-s32! bv)))
     
    140134                          (*blob-set-u32-be! bv int idx) ) ) ) )
    141135
    142 (: bytes-set-u64! (bytevector fixnum number -> void))
    143 ;
    144136(define (bytes-set-u64! bv idx uint #!optional (order (machine-byte-order)))
    145137        (let ((bv (get-bv-alias 'bytes-set-u64! bv)))
     
    150142                          (*blob-set-u64-be! bv uint idx) ) ) ) )
    151143
    152 (: bytes-set-s64! (bytevector fixnum number -> void))
    153 ;
    154144(define (bytes-set-s64! bv idx int #!optional (order (machine-byte-order)))
    155145        (let ((bv (get-bv-alias 'bytes-set-s64! bv)))
  • release/5/blob-utils/trunk/pack-integer.scm

    r38412 r38917  
    7777;;; Integer Packing Utilities
    7878
     79
     80;;
     81
     82(define-type buffer-type (or string blob u8vector))
     83
     84(: byte-order? (* -> boolean : byte-order))
     85(: ensure-byte-buffer (symbol fixnum (or symbol buffer-type) fixnum -> symbol buffer-type))
     86(: *pack-u8 (symbol fixnum (or symbol buffer-type) fixnum -> buffer-type))
     87(: pack-u8 (fixnum #!rest -> buffer-type))
     88(: *pack-integer (symbol integer (or symbol buffer-type) fixnum symbol fixnum -> buffer-type))
     89(: pack-u16 (fixnum #!rest -> buffer-type))
     90(: pack-u32 (integer #!rest -> buffer-type))
     91(: pack-u64 (integer #!rest -> buffer-type))
     92(: pack-integer (integer #!rest -> buffer-type))
     93
    7994;;
    8095
     
    141156(define-type byte-order symbol)
    142157
    143 (: byte-order? (* -> boolean : byte-order))
    144 ;
    145158(define (byte-order? obj)
    146159  (not (zero? (byte-order->direction obj))) )
     
    148161(define-check+error-type byte-order byte-order? "symbol in {big-endian be big little-endian le little}")
    149162
    150 (define-type buffer-type (or string blob u8vector))
    151 
    152163(define-error-type byte-buffer-kind "symbol in {u8vector blob string}")
    153164(define-error-type byte-buffer "u8vector, blob, string")
    154165
    155 (: ensure-byte-buffer (symbol fixnum (or symbol buffer-type) fixnum -> symbol buffer-type))
    156 ;
    157166(define (ensure-byte-buffer loc size kind start)
    158167  (check-natural-fixnum loc size 'size)
     
    186195;;
    187196
    188 (: *pack-u8 (symbol fixnum (or symbol buffer-type) fixnum -> buffer-type))
    189 ;
    190197(define (*pack-u8 loc n kind start)
    191198  (check-fixnum loc n)
     
    201208    obj ) )
    202209
    203 (: pack-u8 (fixnum #!rest -> buffer-type))
    204 ;
    205210(define (pack-u8 n #!key (kind 'string) (start 0))
    206211  (*pack-u8 'pack-u8 n kind start) )
     
    208213;;
    209214
    210 (: *pack-integer (symbol integer (or symbol buffer-type) fixnum symbol fixnum -> buffer-type))
    211 ;
    212215(define (*pack-integer loc n kind size order start)
    213216  (check-integer loc n)
     
    228231;;
    229232
    230 (: pack-u16 (fixnum #!rest -> buffer-type))
    231 ;
    232233(define (pack-u16 n #!key (kind 'string) (start 0) (order (machine-byte-order)))
    233234  (*pack-integer 'pack-u16 n kind 2 order start) )
     
    235236;;
    236237
    237 (: pack-u32 (integer #!rest -> buffer-type))
    238 ;
    239238(define (pack-u32 n #!key (kind 'string) (start 0) (order (machine-byte-order)))
    240239  (*pack-integer 'pack-u32 n kind 4 order start) )
     
    242241;;
    243242
    244 (: pack-u64 (integer #!rest -> buffer-type))
    245 ;
    246243(define (pack-u64 n #!key (kind 'string) (start 0) (order (machine-byte-order)))
    247244  (*pack-integer 'pack-u64 n kind 8 order start) )
     
    249246;;
    250247
    251 (: pack-integer (integer #!rest -> buffer-type))
    252 ;
    253248(define (pack-integer n #!key (kind 'string) (start 0) (order (machine-byte-order)) (size 4))
    254249  (let (
     
    257252      (let-values (
    258253        ((knd obj) (ensure-byte-buffer 'pack-integer size kind start)) )
    259         (*blob-set-u8! n obj start) )
     254        (*blob-set-u8! obj n start) )
    260255      (*pack-integer 'pack-integer n kind size order start) ) ) )
    261256
Note: See TracChangeset for help on using the changeset viewer.