;;
;; An I/O port that supports different endian formats.
;;
;; Copyright 2005-2008 Ivan Raikov and the Georgia Institute of Technology
;; Ported to Chicken 4 by Shawn Rutledge s@ecloud.org
;;
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; A full copy of the GPL license can be found at
;; <http://www.gnu.org/licenses/>.
;;

(module endian-port
	(make-endian-port 
	 endian-port?
	 endian-port-fileno 
	 endian-port-filename 
	 endian-port-byte-order
	 close-endian-port
	 open-endian-port
	 port->endian-port 
	 endian-port-set-bigendian! 
	 endian-port-set-littlendian! 
	 endian-port-setpos
	 endian-port-pos 
	 endian-port-eof? 
	 endian-port-read-int1
	 endian-port-read-int2
	 endian-port-read-int4
	 endian-port-read-uint1
	 endian-port-read-uint2
	 endian-port-read-uint4
	 endian-port-read-ieee-float32
	 endian-port-read-ieee-float64
	 endian-port-read-bit-vector
	 endian-port-read-byte-vector
	 endian-port-write-int1	
	 endian-port-write-int2
	 endian-port-write-int4
	 endian-port-write-uint1	
	 endian-port-write-uint2
	 endian-port-write-uint4
	 endian-port-write-ieee-float32	
	 endian-port-write-ieee-float64
	 endian-port-write-bit-vector
	 endian-port-write-byte-vector)

(import chicken scheme posix iset srfi-4 endian-blob byte-blob)

(use endian-blob)

;------------------------------------
;  Endian port data structures
;

; Structure: endian-port
;
;  * fileno:  file handle corresponding to the port
;  * filename:  file name corresponding to the port
;  * byte-order: can be MSB or LSB (type defined in unit endian-blob) 
;

(define-record endian-port fileno filename byte-order)


;------------------------------------
;  Constants re-used from endian-blob
;
;(define MSB MSB)
;(define LSB LSB)

;------------------------------------
;  Endian port routines
;


; Procedure: 
; close-endian-port:: ENDIAN-PORT -> UNDEFINED
;
; Closes the endian port.
;
(define (close-endian-port eport)
  (file-close (endian-port-fileno eport)))

; Procedure: 
; open-endian-port MODE FILENAME -> ENDIAN-PORT
;
; Opens an endian port to the specified file. Mode can be one of 'read
; or 'write. In write mode, the file is created if it doesn't exist,
; otherwise the new data is appended to its end. The default
; endianness of the newly created endian port is MSB.
;
(define (open-endian-port mode filename)
  (cond ((eq? mode 'read)
	 (let ((fd (file-open filename (bitwise-ior open/read open/binary))))
	   (if (< fd 0)
	       (error 'endian-port  "unable to open file: " filename)
	       (make-endian-port fd filename MSB))))
	(else 
	 (let ((fd (file-open filename (bitwise-ior open/append open/creat open/binary))))
	   (if (< fd 0)
	       (error 'endian-port  "unable to open file: " filename)
	       (make-endian-port fd filename MSB))))))

; Procedure: 
; port->endian-port:: PORT -> ENDIAN-PORT
;
; Creates an endian port to the file specified by the given port. The
; default endianness of the newly created endian port is MSB. 
;
(define (port->endian-port port)
  (make-endian-port (port->fileno port) (port-name port) MSB))


; Procedure:
; endian-port-set-bigendian!:: EPORT -> UNSPECIFIED
;
; Sets the endianness of the given endian port to MSB.
;
(define (endian-port-set-bigendian! eport)
  (endian-port-byte-order-set! eport MSB))

; Procedure:
; endian-port-set-littlendian!:: EPORT -> UNSPECIFIED
;
; Sets the endianness of the given endian port to LSB.
;
(define (endian-port-set-littlendian! eport)
  (endian-port-byte-order-set! eport LSB))


; Procedure:
; endian-port-setpos:: EPORT INTEGER [WHENCE] -> UNSPECIFIED
;
; Sets the file position of the given endian port to the specified
; position. The optional argument WHENCE is one of seek/set, seek/cur,
; seek/end. The default is seek/set (current position).
;
(define (endian-port-setpos eport pos . rest)
  (let-optionals rest ((whence #f))
		 (cond ((not whence)
			(set-file-position! (endian-port-fileno eport) pos seek/set))
		       (else (set-file-position! (endian-port-fileno eport) pos whence)))))
		       

; Procedure:
;  endian-port-pos:: EPORT  -> INTEGER
;
; Returns the current file position of the given endian port, relative
; to the beginning of the file.
;
(define (endian-port-pos eport)
  (file-position  (endian-port-fileno eport)))
		       

; Procedure:
;  endian-port-eof?:: EPORT  -> BOOLEAN
;
; Returns true if the current file position of the given endian port
; is at the end of the file, false otherwise.
;
(define (endian-port-eof? eport)
  (zero? (- (file-size  (endian-port-fileno eport))
	    (file-position  (endian-port-fileno eport)))))
		       

; Procedure:
; endian-port-read-uint1:: EPORT [* BYTE-ORDER] -> UINTEGER
;
; Reads an unsigned integer of size 1 byte. Optional argument
; BYTE-ORDER is one of MSB or LSB. If byte order is not specified,
; then use the byte order setting of the given endian port.
; 
(define (endian-port-read-uint1 eport . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (make-blob 1)]
				[ret (file-read (endian-port-fileno eport) 1 buf)])
			(and (eq? (cadr ret) 1) (endian-blob->uint1 (byte-blob->endian-blob 
					(blob->byte-blob (car ret)) byte-order) ) ))))


; Procedure:
; endian-port-read-uint2:: EPORT [* BYTE-ORDER] -> UINTEGER. 
;
; Reads an unsigned integer of size 2 bytes. Optional argument
; BYTE-ORDER is one of MSB or LSB. If byte order is not specified,
; then use the byte order setting of the given endian port.
; 
(define (endian-port-read-uint2 eport . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (make-blob 2)]
				[ret (file-read (endian-port-fileno eport) 2 buf)])
			(and (eq? (cadr ret) 2) (endian-blob->uint2 (byte-blob->endian-blob 
					(blob->byte-blob (car ret)) byte-order) ) ))))


; Procedure:
; endian-port-read-uint4:: EPORT [* BYTE-ORDER] -> UINTEGER
;
; Reads an unsigned integer of size 4 bytes. Optional argument
; BYTE-ORDER is one of MSB or LSB. If byte order is not specified,
; then use the byte order setting of the given endian port.
; 
(define (endian-port-read-uint4 eport . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (make-blob 4)]
				[ret (file-read (endian-port-fileno eport) 4 buf)])
			(and (eq? (cadr ret) 4) (endian-blob->uint4 (byte-blob->endian-blob 
					(blob->byte-blob (car ret)) byte-order) ) ))))

; Procedure:
; endian-port-read-int1:: EPORT [* BYTE-ORDER] -> INTEGER
;
; Reads a signed integer of size 1 byte. Optional argument
; BYTE-ORDER is one of MSB or LSB. If byte order is not specified,
; then use the byte order setting of the given endian port.
; 
(define (endian-port-read-int1 eport . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (make-blob 1)]
				[ret (file-read (endian-port-fileno eport) 1 buf)])
			(and (eq? (cadr ret) 1) (endian-blob->sint1 (byte-blob->endian-blob 
					(blob->byte-blob (car ret)) byte-order) ) ))))


; Procedure:
; endian-port-read-int2:: EPORT [* BYTE-ORDER] -> INTEGER. 
;
; Reads a signed integer of size 2 bytes. Optional argument
; BYTE-ORDER is one of MSB or LSB. If byte order is not specified,
; then use the byte order setting of the given endian port.
; 
(define (endian-port-read-int2 eport . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (make-blob 2)]
				[ret (file-read (endian-port-fileno eport) 2 buf)])
			(and (eq? (cadr ret) 2) (endian-blob->sint2 (byte-blob->endian-blob 
					(blob->byte-blob (car ret)) byte-order) ) ))))


; Procedure:
; endian-port-read-int4:: EPORT [* BYTE-ORDER] -> INTEGER
;
; Reads a signed integer of size 4 bytes. Optional argument
; BYTE-ORDER is one of MSB or LSB. If byte order is not specified,
; then use the byte order setting of the given endian port.
; 
(define (endian-port-read-int4 eport . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (make-blob 4)]
				[ret (file-read (endian-port-fileno eport) 4 buf)])
			(and (eq? (cadr ret) 4) (endian-blob->sint4 (byte-blob->endian-blob 
					(blob->byte-blob (car ret)) byte-order) ) ))))

; Procedure: 
;
; endian-port-read-ieee-float32:: EPORT [* BYTE-ORDER] -> REAL
;
; Reads an IEEE 754 single precision floating-point number. Optional
; argument BYTE-ORDER is one of MSB or LSB. If byte order is not
; specified, then use the byte order setting of the given endian port.
; 
(define (endian-port-read-ieee-float32 eport . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (make-blob 4)]
				[ret (file-read (endian-port-fileno eport) 4 buf)])
			(and (eq? (cadr ret) 4) (endian-blob->ieee_float32 (byte-blob->endian-blob 
					(blob->byte-blob (car ret)) byte-order) ) ))))

; Procedure: 
;
; endian-port-read-ieee-float32:: EPORT [* BYTE-ORDER] -> REAL
;
; Reads an IEEE 754 double precision floating-point number. Optional
; argument BYTE-ORDER is one of MSB or LSB. If byte order is not
; specified, then use the byte order setting of the given endian port.
; 
(define (endian-port-read-ieee-float64 eport . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (make-blob 8)]
				[ret (file-read (endian-port-fileno eport) 8 buf)])
			(and (eq? (cadr ret) 8) (endian-blob->ieee_float64 (byte-blob->endian-blob 
					(blob->byte-blob (car ret)) byte-order) ) ))))


; Procedure:
; set-bv!
;
; Helper function for endian-port-read-bit-vector below
; *  set len bits in vector bv starting at position pos, 
;    according to the bits set in vector b
;
; *  len may not be larger than 8
;
(define (set-bv! bv b pos len)
   (let loop ((i (- len 1))  (j 0))
     (begin
       (bit-vector-set! bv (- pos j)  (bit-vector-ref b i))
       (if (= i 0)  bv  (loop (- i 1) (+ j 1))))))


; Procedure:
; endian-port-read-bit-vector:: PORT * SIZE (in bits) [* BYTE-ORDER] -> BIT-VECTOR
;
; Reads a bit vector of the specified size (in bits) and returns an
; iset bit vector (see module iset). Optional argument BYTE-ORDER is
; one of MSB or LSB. If byte order is not specified, then use the
; byte order setting of the given endian port.
;
(define (endian-port-read-bit-vector eport size . rest)
  (let-optionals
   rest ((byte-order #f))
   (let ((nb  (inexact->exact (ceiling (/ size 8))))
	 (bv  (make-bit-vector size))
	 (byte-order  (if byte-order byte-order (endian-port-byte-order eport)))) 
     (cond 
      ((eq? byte-order MSB)
       ;; if big engian, we start with the most significant bit
       (let loop ((b    (integer->bit-vector (endian-port-read-int1 eport)))
		  (bi   (- nb 1))
		  (pos  (- size 1))
		  (rem  size))
	 (begin
	   (set-bv! bv b pos (min rem 8))
	   (if (= bi 0)   bv
	       (loop (integer->bit-vector (endian-port-read-int1 eport))
		     (- bi 1)
		     (- pos 8)
		     (- rem 8))))))
      (else
       ;; if little endian, we start with the least significant bit
       (let loop ((b    (integer->bit-vector (endian-port-read-int1 eport)))
		  (bi   (- nb 1))
		  (pos  7)
		  (rem  size))
	 (begin
	   (set-bv! bv b pos (min rem 8))
	   (if (= bi 0)   bv
	       (loop (integer->bit-vector (endian-port-read-int1 eport))
		     (- bi 1)
		     (+ pos 8)
		     (- rem 8))))))))))

; Procedure:  
; endian-port-read-byte-vector:: PORT * SIZE [* BYTE-ORDER]  -> BYTE-VECTOR
;
; Reads an unsigned byte vector of the specified size and returns a Scheme byte
; vector. Optional argument BYTE-ORDER is one of MSB or LSB. If
; byte order is not specified, then use the byte order setting of the
; given endian port.
;
(define (endian-port-read-byte-vector  eport size . rest)
  (let-optionals rest ((byte-order #f))
		 (let ((byte-order (if byte-order byte-order
				       (endian-port-byte-order eport))))
		   (let loop ((size size) (data '()))
		     (if (> size 0)
			 (let ((b  (endian-port-read-int1 eport)))
			   (loop (- size 1) (cons b data)))
			 (if (eq? byte-order MSB)
			     (u8vector->blob (list->u8vector (reverse data)))
			     (u8vector->blob (list->u8vector data))))))))



; Procedure:
; endian-port-write-uint1:: EPORT * WORD [* BYTE-ORDER] -> UINTEGER
;
; Writes an unsigned integer of size 1 byte. Returns the number of
; bytes written (always 1). Optional argument BYTE-ORDER is one of
; MSB or LSB. If byte order is not specified, then use the byte
; order setting of the given endian port.
; 
(define (endian-port-write-uint1 eport word . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (u8vector->blob (endian-blob->u8vector (uint1->endian-blob word byte-order)))])
			(file-write (endian-port-fileno eport) buf))))

; Procedure:
; endian-port-write-uint2:: EPORT * WORD [* BYTE-ORDER] -> UINTEGER
;
; Writes an unsigned integer of size 2 bytes. Returns the number of
; bytes written (always 2). Optional argument BYTE-ORDER is one of
; MSB or LSB. If byte order is not specified, then use the byte
; order setting of the given endian port.
; 
(define (endian-port-write-uint2 eport word . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (u8vector->blob (endian-blob->u8vector (uint2->endian-blob word byte-order)))])
			(file-write (endian-port-fileno eport) buf))))

; Procedure:
; endian-port-write-uint4:: EPORT * WORD [* BYTE-ORDER] -> UINTEGER
;
; Writes an unsigned integer of size 4 bytes. Returns the number of
; bytes written (always 4). Optional argument BYTE-ORDER is one of
; MSB or LSB. If byte order is not specified, then use the byte
; order setting of the given endian port.
; 
(define (endian-port-write-uint4 eport word . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (u8vector->blob (endian-blob->u8vector (uint4->endian-blob word byte-order)))])
			(file-write (endian-port-fileno eport) buf))))

; Procedure:
; Procedure:
; endian-port-write-int1:: EPORT * WORD [* BYTE-ORDER] -> INTEGER
;
; Writes a signed integer of size 1 byte. Returns the number of
; bytes written (always 1). Optional argument BYTE-ORDER is one of
; MSB or LSB. If byte order is not specified, then use the byte
; order setting of the given endian port.
; 
(define (endian-port-write-int1 eport word . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (u8vector->blob (endian-blob->u8vector (sint1->endian-blob word byte-order)))])
			(file-write (endian-port-fileno eport) buf))))

; Procedure:
; endian-port-write-int2:: EPORT * WORD [* BYTE-ORDER] -> INTEGER
;
; Writes a signed integer of size 2 bytes. Returns the number of
; bytes written (always 2). Optional argument BYTE-ORDER is one of
; MSB or LSB. If byte order is not specified, then use the byte
; order setting of the given endian port.
; 
(define (endian-port-write-int2 eport word . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (u8vector->blob (endian-blob->u8vector (sint2->endian-blob word byte-order)))])
			(file-write (endian-port-fileno eport) buf))))

; Procedure:
; endian-port-write-int4:: EPORT * WORD [* BYTE-ORDER] -> INTEGER
;
; Writes a signed integer of size 4 bytes. Returns the number of
; bytes written (always 4). Optional argument BYTE-ORDER is one of
; MSB or LSB. If byte order is not specified, then use the byte
; order setting of the given endian port.
; 
(define (endian-port-write-int4 eport word . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (u8vector->blob (endian-blob->u8vector (sint4->endian-blob word byte-order)))])
			(file-write (endian-port-fileno eport) buf))))

; Procedure:
; endian-port-write-ieee-float32:: EPORT * WORD [* BYTE-ORDER] -> UINTEGER
;
; Writes an IEEE 754 single precision floating-point number. Returns
; the number of bytes written (always 4). Optional argument BYTE-ORDER
; is one of MSB or LSB. If byte order is not specified, then use
; the byte order setting of the given endian port.
; 
(define (endian-port-write-ieee-float32 eport word . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (u8vector->blob (endian-blob->u8vector (ieee_float32->endian-blob word byte-order)))])
;(let ([testval (endian-blob->ieee_float32 (byte-blob->endian-blob (blob->byte-blob buf) byte-order)) ])
;	(unless (eq? testval word) (printf "trying to write float ~a, but after conversions it turns out as ~a~%" word testval) ) )
			(file-write (endian-port-fileno eport) buf))))

; Procedure:
; endian-port-write-ieee-float64:: EPORT * WORD [* BYTE-ORDER] -> UINTEGER
;
; Writes an IEEE 754 double precision floating-point number. Returns
; the number of bytes written (always 8). Optional argument BYTE-ORDER
; is one of MSB or LSB. If byte order is not specified, then use
; the byte order setting of the given endian port.
; 
(define (endian-port-write-ieee-float64 eport word . rest)
  (let-optionals rest ([byte-order (endian-port-byte-order eport)])
		(let* (	[buf (u8vector->blob (endian-blob->u8vector (ieee_float64->endian-blob word byte-order)))])
(printf "trying to write float ~a, but after conversions it turns out as ~a~%" word
	(endian-blob->ieee_float64 (byte-blob->endian-blob (blob->byte-blob buf) byte-order) ) )
			(file-write (endian-port-fileno eport) buf))))

; Procedure:
; endian-port-write-byte-vector:: PORT * BYTE-VECTOR [* BYTE-ORDER] -> UINTEGER
;
; Writes the given unsigned byte vector and returns the number of bytes
; written. The argument must be a byte vector object. Optional
; argument BYTE-ORDER is one of MSB or LSB. If byte order is not
; specified, then use the byte order setting of the given endian port.
;
(define (endian-port-write-byte-vector  eport vect . rest)
  (let-optionals rest ((byte-order #f))
	(let* ([u8vect (cond [(blob? vect) (blob->u8vector vect)]
						[(u8vector? vect) vect]
						[(endian-blob? vect) (endian-blob->u8vector vect)])]
		   [len (u8vector-length u8vect)]
	       [byte-order (if byte-order byte-order
				       (endian-port-byte-order eport))])
		   (if (eq? byte-order MSB)
		       (let loop ((i 0) (bytes 0))
				 (if (< i len)
				     (loop (+ i 1) (+ bytes (endian-port-write-int1 eport (u8vector-ref u8vect i))))
				     bytes))
		       (let loop ((i (- len 1)) (bytes 0))
				 (if (positive? i)
				     (loop (- i 1) (+ bytes (endian-port-write-int1 eport (u8vector-ref u8vect i))))
				     bytes))))))

;
; Procedure:
; endian-port-write-bit-vector:: PORT * BIT-VECTOR [* BIT-ORDER] -> UINTEGER
;
; Writes the given bit vector and returns the number of bytes
; written. The argument must be a bit vector as defined in the iset
; module. Optional argument BIT-ORDER is one of MSB or LSB.  If
; bit order is not specified, then use the byte order setting of the
; given endian port. 
;
; Note that here the "byte order" type is interpreted as bit order:
; i.e. the bits are ordered in MSB or LSB order, not the bytes that
; comprise the bit vector.
;
(define (endian-port-write-bit-vector eport bv . rest)
  (let-optionals  rest ((byte-order #f))
		 (let ((len (bit-vector-length bv))
		       (byte-order (if byte-order byte-order
				       (endian-port-byte-order eport))))
		   (if (eq? byte-order LSB)
		       (let loop ((i 0) (bytes 0))
			 (if (< i len)
			     (let ((byte  (bitwise-ior (if (bit-vector-ref i bv)       #b10000000 0)
						       (if (bit-vector-ref (+ i 1) bv) #b01000000 0)
						       (if (bit-vector-ref (+ i 2) bv) #b00100000 0)
						       (if (bit-vector-ref (+ i 3) bv) #b00010000 0)
						       (if (bit-vector-ref (+ i 4) bv) #b00001000 0)
						       (if (bit-vector-ref (+ i 5) bv) #b00000100 0)
						       (if (bit-vector-ref (+ i 6) bv) #b00000010 0)
						       (if (bit-vector-ref (+ i 7) bv) #b00000001 0))))
			       (loop (+ i 8) (+ bytes (endian-port-write-int1 eport byte))))
			       bytes))
		       (let loop ((i (- len 1)) (bytes 0))
			 (if (positive? i)
			     (let ((byte  (bitwise-ior (if (bit-vector-ref i bv)       #b00000001 0)
						       (if (bit-vector-ref (- i 1) bv) #b00000010 0)
						       (if (bit-vector-ref (- i 2) bv) #b00000100 0)
						       (if (bit-vector-ref (- i 3) bv) #b00001000 0)
						       (if (bit-vector-ref (- i 4) bv) #b00010000 0)
						       (if (bit-vector-ref (- i 5) bv) #b00100000 0)
						       (if (bit-vector-ref (- i 6) bv) #b01000000 0)
						       (if (bit-vector-ref (- i 7) bv) #b10000000 0))))
			       (loop (- i 8) (+ bytes (endian-port-write-int1 eport byte)))
			       bytes)))))))
) ;; end of module