;;;; blob-set-int.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18
;;;; Kon Lovett, Apr '12

;; Issues
;;
;; - Chicken uses "signed integer" but treated here as "unsigned integer"

(module blob-set-int

(;export
  blob-set-u8!
  blob-set-u16-le! blob-set-u32-le! blob-set-u64-le!
  blob-set-u16-be! blob-set-u32-be! blob-set-u64-be!
  ;
  *blob-set-u8!
  *blob-set-u16-le! *blob-set-u32-le! *blob-set-u64-le!
  *blob-set-u16-be! *blob-set-u32-be! *blob-set-u64-be!)

(import scheme
  (chicken base)
  (chicken foreign)
  (chicken type)
  (only type-checks
    check-natural-fixnum check-fixnum check-integer
    check-blob))

;;; Only Blob Bytevector, No Argument Checking

(: *blob-set-u8! ((or blob string) number fixnum -> void))
;
(define *blob-set-u8!
  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer32 u32) (int off)) "
    ((uint8_t *)bv)[off] = (uint8_t)(u32 & 0xff);"))

(: *blob-set-u16-le! ((or blob string) number fixnum -> void))
;
(define *blob-set-u16-le!
  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer32 u32) (int off)) "
    ((uint8_t *)bv)[off]   = (uint8_t)(u32 & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u32 >> 8) & 0xff);"))

(: *blob-set-u32-le! ((or blob string) number fixnum -> void))
;
(define *blob-set-u16-be!
  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer32 u32) (int off)) "
    ((uint8_t *)bv)[off]   = (uint8_t)((u32 >> 8) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)(u32 & 0xff);"))

(: *blob-set-u64-le! ((or blob string) number fixnum -> void))
;
(define *blob-set-u32-le!
  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer32 u32) (int off)) "
    ((uint8_t *)bv)[off]   = (uint8_t)(u32 & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u32 >> 8) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u32 >> 16) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u32 >> 24) & 0xff);"))

(: *blob-set-u16-be! ((or blob string) number fixnum -> void))
;
(define *blob-set-u32-be!
  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer32 u32) (int off)) "
    ((uint8_t *)bv)[off]   = (uint8_t)((u32 >> 24) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u32 >> 16) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u32 >> 8) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)(u32 & 0xff);"))

(: *blob-set-u32-be! ((or blob string) number fixnum -> void))
;
(define *blob-set-u64-le!
  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer64 u64) (int off)) "
    ((uint8_t *)bv)[off]   = (uint8_t)(u64 & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 8) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 16) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 24) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 32) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 40) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 48) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 56) & 0xff);"))

(: *blob-set-u64-be! ((or blob string) number fixnum -> void))
;
(define *blob-set-u64-be!
  (foreign-lambda* void ((nonnull-scheme-pointer bv) (unsigned-integer64 u64) (int off)) "
    ((uint8_t *)bv)[off]   = (uint8_t)((u64 >> 56) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 48) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 40) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 32) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 24) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 16) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)((u64 >> 8) & 0xff);
    ((uint8_t *)bv)[++off] = (uint8_t)(u64 & 0xff);"))

;;; Only Blob Bytevector

;; 8

(: blob-set-u8! (blob fixnum #!optional fixnum -> void))
;
(define (blob-set-u8! blb uint #!optional (off 0))
  (*blob-set-u8!
    (check-blob 'blob-set-u8! blb)
    (check-fixnum 'blob-set-u8! uint)
    (check-natural-fixnum 'blob-set-u8! off 'offset)) )

;; Little Endian 16, 32, & 64

(: blob-set-u16-le! (blob fixnum #!optional fixnum -> void))
;
(define (blob-set-u16-le! blb uint #!optional (off 0))
  (*blob-set-u16-le!
    (check-blob 'blob-set-u16-le! blb)
    (check-fixnum 'blob-set-u16-le! uint)
    (check-natural-fixnum 'blob-set-u16-le! off 'offset)) )

(: blob-set-u32-le! (blob number #!optional fixnum -> void))
;
(define (blob-set-u32-le! blb uint #!optional (off 0))
  (*blob-set-u32-le!
    (check-blob 'blob-set-u32-le! blb)
    (check-integer 'blob-set-u32-le! uint)
    (check-natural-fixnum 'blob-set-u32-le! off 'offset)) )

(: blob-set-u64-le! (blob number #!optional fixnum -> void))
;
(define (blob-set-u64-le! blb uint #!optional (off 0))
  (*blob-set-u64-le!
    (check-blob 'blob-set-u64-le! blb)
    (check-integer 'blob-set-u64-le! uint)
    (check-natural-fixnum 'blob-set-u64-le! off 'offset)) )

;; Big Endian 16, 32, & 64

(: blob-set-u16-be! (blob fixnum #!optional fixnum -> void))
;
(define (blob-set-u16-be! blb uint #!optional (off 0))
  (*blob-set-u16-be!
    (check-blob 'blob-set-u16-be! blb)
    (check-fixnum 'blob-set-u16-be! uint)
    (check-natural-fixnum 'blob-set-u16-be! off 'offset)) )

(: blob-set-u32-be! (blob number #!optional fixnum -> void))
;
(define (blob-set-u32-be! blb uint #!optional (off 0))
  (*blob-set-u32-be!
    (check-blob 'blob-set-u32-be! blb)
    (check-integer 'blob-set-u32-be! uint)
    (check-natural-fixnum 'blob-set-u32-be! off 'offset)) )

(: blob-set-u64-be! (blob number #!optional fixnum -> void))
;
(define (blob-set-u64-be! blb uint #!optional (off 0))
  (*blob-set-u64-be!
    (check-blob 'blob-set-u64-be! blb)
    (check-integer 'blob-set-u64-be! uint)
    (check-natural-fixnum 'blob-set-u64-be! off 'offset)) )

) ;module blob-set-int