;;; lowlevel.lisp -- lowlevel network
;;;
;;; Author: Eric Marsden <emarsden>
;;; Time-stamp: <2005-07-17 emarsden>


(in-package :postgresql)


;; read an integer in network byte order
(defun %read-net-int8 (stream)
  "Reads an integer BYTES bytes long from the STREAM.
The signed integer is presumed to be in network order.
Returns the integer."
  (let ((result (read-byte stream)))
    (when (= 1 (ldb (byte 1 7) result))
      ;; negative
      (setf result (-
		    (1+ (logxor result
				#xFF)))))
    result))

(defun %read-net-int16 (stream)
  "Reads an integer BYTES bytes long from the STREAM.
The signed integer is presumed to be in network order.
Returns the integer."
  (let ((result (+ (* 256 (read-byte stream))
		   (read-byte stream))))
    (when (= 1 (ldb (byte 1 15) result))
      ;; negative
      (setf result (-
		    (1+ (logxor result
				#xFFFF)))))
    result))

(defun %read-net-int32 (stream)
  "Reads an integer BYTES bytes long from the STREAM.
The signed integer is presumed to be in network order.
Returns the integer."
  (let ((result (+ (* 256 256 256 (read-byte stream))
		   (* 256 256 (read-byte stream))
		   (* 256 (read-byte stream))
		   (read-byte stream))))
    (when (= 1 (ldb (byte 1 31) result))
      ;; negative
      (setf result (-
		    (1+ (logxor result
				#xFFFFFFFF)))))
    result))

#-cmu
(defun %read-bytes (stream howmany)
  "Reads HOWMANY bytes from the STREAM.
Returns the array of "
  (declare (type stream stream))
  (let ((v (make-array howmany :element-type '(unsigned-byte 8))))
    (read-sequence v stream)
    v))

;; There is a bug in CMUCL's implementation of READ-SEQUENCE on
;; network streams, which can return without reading to the end of the
;; sequence when it has to wait for data. It confuses the end-of-file
;; condition with no-more-data-currently-available. This workaround is
;; thanks to Wayne Iba.
#+cmu
(defun %read-bytes (stream howmany)
  "Reads HOWMANY bytes from the STREAM.
Returns the array of "
  (declare (type stream stream))
  (let ((v (make-array howmany :element-type '(unsigned-byte 8))))
    (do ((continue-at (read-sequence v stream :start 0 :end howmany)
		      (read-sequence v stream :start continue-at :end howmany)))
	((= continue-at howmany))
      )
    v))

(defun %read-chars (stream howmany)
  (declare (type fixnum howmany))
  (let ((bytes (%read-bytes stream howmany))
        (str (make-string howmany)))
    (dotimes (i howmany)
      (setf (aref str i) (code-char (aref bytes i))))
    str))

(defun %read-cstring (stream maxbytes)
  "Read a null-terminated string from CONNECTION."
  (declare (type fixnum maxbytes))
  (let ((chars nil))
    (do ((b (read-byte stream nil nil) (read-byte stream nil nil))
         (i 0 (+ i 1)))
        ((or (= i maxbytes)             ; reached allowed length
             (null b)                   ; eof
             (zerop b))                 ; end of string
         (concatenate 'string (nreverse chars)))
      (push (code-char b) chars))))

;; read an integer in network byte order
(defun read-net-int (connection bytes)
  (do ((i bytes (- i 1))
       (stream (pgcon-stream connection))
       (accum 0))
      ((zerop i) accum)
    (setq accum (+ (* 256 accum) (read-byte stream)))))


(defun send-string (connection str &optional pad-to)
  (let* ((stream (pgcon-stream connection))
         (len (length str))
         (v (make-array len :element-type '(unsigned-byte 8))))
    ;; convert the string to a vector of bytes
    (dotimes (i len)
      (setf (aref v i) (char-code (aref str i))))
    (write-sequence v stream)
    ;; pad if necessary
    (when pad-to
      (write-sequence (make-array (- pad-to len)
                                  :initial-element 0
                                  :element-type '(unsigned-byte 8))
                      stream))))

(defun send-octets (connection buffer)
  (declare (type (vector (unsigned-byte 8) *) buffer))
  (write-sequence buffer (pgcon-stream connection)))

;; highest order bits first
(defun send-int (connection int bytes)
  (declare (type fixnum int bytes))
  (let ((v (make-array bytes :element-type '(unsigned-byte 8)))
        (stream (pgcon-stream connection)))
    (do ((i (- bytes 1) (- i 1)))
        ((< i 0))
      (setf (aref v i) (rem int 256))
      (setq int (floor int 256)))
    (write-sequence v stream)))

(defun %send-net-int (stream int bytes)
  (declare (type stream stream)
           (type fixnum int bytes))
  (let ((v (make-array bytes :element-type '(unsigned-byte 8))))
    (loop for offset from (* 8 (1- bytes)) downto 0 by 8
	  for data = (ldb (byte 8 offset) int)
	  for i from 0
	  do
	  (setf (aref v i) data))
    #+debug
    (format t "~&writing: ~S~%" v)
    (write-sequence v stream)))

(defun %send-cstring (stream str)
  "Sends a null-terminated string to CONNECTION"
  (let* ((len (length str))
         (v (make-array len :element-type '(unsigned-byte 8))))
    ;; convert the string to a vector of bytes
    (dotimes (i len)
      (setf (aref v i) (char-code (aref str i))))
    (write-sequence v stream)
    (write-byte 0 stream)))

(declaim (inline %flush))
(defun %flush (connection)
  (force-output (pgcon-stream connection)))


;; EOF
