;;;; message-digest-int.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18
;;;; Kon Lovett, Aug '17
;;;; Kon Lovett, Apr '12
;;;; Kon Lovett, May '10 (message-digest.scm)
;;;; Kon Lovett, Jan '06 (message-digest.scm)

(module message-digest-int

(;export
  message-digest-update-char-u8
  message-digest-update-char
  message-digest-update-char-be
  message-digest-update-char-le
  message-digest-update-u8
  message-digest-update-u16
  message-digest-update-u16-be
  message-digest-update-u16-le
  message-digest-update-u32
  message-digest-update-u32-be
  message-digest-update-u32-le
  message-digest-update-u64
  message-digest-update-u64-be
  message-digest-update-u64-le)

(import scheme)
(import (chicken base))
(import (chicken platform))
(import (chicken type))
(import message-digest-type)
(import message-digest-support)
(import blob-set-int)
(import (only type-checks check-integer check-char))
(import (only type-errors error-argument-type))

;; Support

;;

(include "message-digest.types")

(: get-byte-order (symbol * --> message-digest-byte-order))
(: *message-digest-update-uint (symbol message-digest number fixnum procedure -> void))
(: message-digest-update-char-u8 (message-digest char -> void))
(: message-digest-update-char-be (message-digest char -> void))
(: message-digest-update-char-le (message-digest char -> void))
(: message-digest-update-u8 (message-digest number -> void))
(: message-digest-update-u16-be (message-digest number -> void))
(: message-digest-update-u16-le (message-digest number -> void))
(: message-digest-update-u32-be (message-digest number -> void))
(: message-digest-update-u32-le (message-digest number -> void))
(: message-digest-update-u64-be (message-digest number -> void))
(: message-digest-update-u64-le (message-digest number -> void))
(: message-digest-update-char (message-digest char #!rest -> void))
(: message-digest-update-u16 (message-digest number #!rest -> void))
(: message-digest-update-u32 (message-digest number #!rest -> void))
(: message-digest-update-u64 (message-digest number #!rest -> void))

;;

(define (get-byte-order loc obj)
  (case obj
  	((big-endian be big msb)				'big-endian )
  	((little-endian le little lsb)	'little-endian )
    (else
    	(error-argument-type loc obj "symbol in {big-endian little-endian}" obj) ) ) )

;;

(define (*message-digest-update-uint loc md n size setter)
  (let (
    (blb (ensure-message-digest-buffer! (check-message-digest loc md) size)) )
  	(setter blb (check-integer loc n) 0)
  	(*message-digest-update-blob md blb size) ) )

;;; Char & Integer Update

;; Char

(define (message-digest-update-char-u8 md ch)
	(*message-digest-update-uint 'message-digest-update-char-u8
	  md
	  (char->integer (check-char 'message-digest-update-char-u8 ch))
	  1
	  *blob-set-u8!) )

(define (message-digest-update-char-be md ch)
	(*message-digest-update-uint 'message-digest-update-char-be
	  md
	  (char->integer (check-char 'message-digest-update-char ch))
	  4
	  *blob-set-u32-be!) )

(define (message-digest-update-char-le md ch)
	(*message-digest-update-uint 'message-digest-update-char-le
	  md
	  (char->integer (check-char 'message-digest-update-char ch))
	  4
	  *blob-set-u32-le!) )

;; Unsigned Integer 8, 16, 32, & 64 bits

;
(define (message-digest-update-u8 md n)
	(*message-digest-update-uint 'message-digest-update-u8 md n 1 *blob-set-u8!) )

(define (message-digest-update-u16-be md n)
	(*message-digest-update-uint 'message-digest-update-u16-be md n 2 *blob-set-u16-be!) )

(define (message-digest-update-u16-le md n)
	(*message-digest-update-uint 'message-digest-update-u16-le md n 2 *blob-set-u16-le!) )

(define (message-digest-update-u32-be md n)
	(*message-digest-update-uint 'message-digest-update-u32-be md n 4 *blob-set-u32-be!) )

(define (message-digest-update-u32-le md n)
	(*message-digest-update-uint 'message-digest-update-u32-le md n 4 *blob-set-u32-le!) )

(define (message-digest-update-u64-be md n)
	(*message-digest-update-uint 'message-digest-update-u64-be md n 8 *blob-set-u64-be!) )

(define (message-digest-update-u64-le md n)
	(*message-digest-update-uint 'message-digest-update-u64-le md n 8 *blob-set-u64-le!) )

;; Machine Byte Order w/ Char & Unsigned Integer

(define (message-digest-update-char md ch . opts)
  (let (
    (order (optional opts (machine-byte-order))) )
    (case (get-byte-order 'message-digest-update-char order)
      ((little-endian)	(message-digest-update-char-le md ch) )
      ((big-endian)			(message-digest-update-char-be md ch) ) ) ) )

(define (message-digest-update-u16 md n . opts)
  (let (
    (order (optional opts (machine-byte-order))) )
    (case (get-byte-order 'message-digest-update-u16 order)
      ((little-endian)	(message-digest-update-u16-le md n) )
      ((big-endian)			(message-digest-update-u16-be md n) ) ) ) )

(define (message-digest-update-u32 md n . opts)
  (let (
    (order (optional opts (machine-byte-order))) )
    (case (get-byte-order 'message-digest-update-u32 order)
      ((little-endian)	(message-digest-update-u32-le md n) )
      ((big-endian)			(message-digest-update-u32-be md n) ) ) ) )

(define (message-digest-update-u64 md n . opts)
  (let (
    (order (optional opts (machine-byte-order))) )
    (case (get-byte-order 'message-digest-update-u64 order)
      ((little-endian)	(message-digest-update-u64-le md n) )
      ((big-endian)			(message-digest-update-u64-be md n) ) ) ) )

) ;module message-digest-int