scheme-libraries/retropikzel/tls/ext-util.scm

62 lines
2.2 KiB
Scheme

;;;;;;;;; From (r6rs bytevectores) begin ;;;;;;;;;;
;;; Copyright 2015 William D Clinger.
;;;
;;; Permission to copy this software, in whole or in part, to use this
;;; software for any lawful purpose, and to redistribute this software
;;; is granted subject to the restriction that all copies made of this
;;; software must include this copyright and permission notice in full.
;;;
;;; I also request that you send me a copy of any improvements that you
;;; make to this software so that they may be incorporated within it to
;;; the benefit of the Scheme community.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax bytevector:div
(syntax-rules ()
((_ x y) (quotient x y))))
(define-syntax bytevector:mod
(syntax-rules ()
((_ x y) (remainder x y))))
(define-syntax unspecified
(syntax-rules ()
((_) (if #f #f))))
(define (bytevector-uint-ref bytevector index endness size)
(case endness
((big)
(do ((i 0 (+ i 1))
(result 0 (+ (* 256 result)
(bytevector-u8-ref bytevector (+ index i)))))
((>= i size)
result)))
((little)
(do ((i (- size 1) (- i 1))
(result 0 (+ (* 256 result)
(bytevector-u8-ref bytevector (+ index i)))))
((< i 0)
result)))
(else (error "bytevector-uint-ref error: Unknown endianness" endness))))
(define (bytevector-uint-set! bytevector index val endness size)
(case endness
((little)
(do ((i 0 (+ i 1))
(val val (bytevector:div val 256)))
((>= i size)
(unspecified))
(bytevector-u8-set! bytevector (+ index i) (bytevector:mod val 256))))
((big)
(do ((i (- size 1) (- i 1))
(val val (bytevector:div val 256)))
((< i 0)
(unspecified))
(bytevector-u8-set! bytevector (+ index i) (bytevector:mod val 256))))
(else
(bytevector-uint-set! bytevector index val (native-endianness) size))))
;;;;;;;;; From (r6rs bytevectores) end ;;;;;;;;;;