Faster binary IO, please?

[Mario Lang <mlang@delysid.org>]

Hi.

Through the last 4 years of Emacs Lisp coding, I've come across the need
to read and/or write binary data from time to time.  Mostly when doing
network process IO, but recently also reading binary data from a buffer.
I've managed to solve all obstacles so far, and wrote the necessary
utility functions to read all sorts of binary data types.  However,
these tricks in elisp space imply slow code, and since these are IO
functions, the slowness really counts.  This mail is basically a plea
for some improvement in Emacs regarding binary IO.  I know we operate
on textual data 99% of the time, but at times, it is just necessary
to operate on binary data if one wants to keep Emacs as the wonderful
and generic working environment that it is.

Below are all the binary data IO functions I've had to write so far.
If you could have a look please and:
 1. possibly suggest a speedup in the functions as they are now
or
 2. implement some of them as a primitive in C

that would be just great!

Note that I've also seen the n-byte integer read/write functions in other
projects duplicated, so it is not just me that would benefit from an
improvement in that area.  I specifically remember Gnus using such code
in dns.el.  hexl-mode could also be rewritten to do all its thing in elisp space.

(defsubst smf-read-byte ()
  "Read one byte from the current buffer and advance point."
  ;; Strangely enough, I found no direct primitive for consuming a char
  ;; from a stream.
  (forward-char 1) (preceding-char))

(defun smf-read-bytes (count)
  "Read COUNT bytes as big endian integer and advance point."
  (let ((val 0))
    (dotimes (i count val)
      (setq val (logior (lsh val 8) (smf-read-byte))))))

(defun smf-read-varlen ()
  "Read a variable quantity from the current buffer and advance point."
  ;; If bit 8 is set, shift and continue, if not end reading and return value.
  ;; This allows for values with arbitrary size and uses minimal space for
  ;; small values.  Used in MIDI files, I dont know off hand if any other
  ;; format uses this
  (do* ((b (smf-read-byte)) (n (logand b #B01111111)))
      ((/= (logand b #B10000000) #B10000000) n)
    (setq b (smf-read-byte) n (logior (ash n 7) (logand b #B01111111)))))

(defun smf-read-string ()
  "Read a MIDI file string and advance point over it."
  (let ((length (smf-read-varlen)))
    (buffer-substring (point) (progn (forward-char length) (point)))))

(defun smf-write-bytes (value count)
  "Write VALUE as COUNT bytes in big endian to current buffer."
  (let (bytes)
    (dotimes (i count (apply #'insert bytes))
      (push (logand value '#XFF) bytes)
      (setq value (ash value -8)))))

(defun smf-write-varlen (value)
  "Write VALUE as variable quantity to the current buffer."
  ;; Add bit 8 as long as needed
  (loop for bits from 21 downto 7 by 7
	when (>= value (expt 2 bits))
	do (insert-char (logior (logand (ash value (- bits)) 127) 128) 1))
  (insert-char (logand value 127) 1))

(defun smf-write-string (string)
  "Write STRING as MIDI file string to the current buffer."
  (smf-write-varlen (length string))
  (insert string))

(defun osc-insert-float32 (value)
  ;; A IEEE 32bit float, should really be easier to do this!
  (let (s (e 0) f)
    (cond
     ((string= (format "%f" value) (format "%f" -0.0))
      (setq s 1 f 0))
     ((string= (format "%f" value) (format "%f" 0.0))
      (setq s 0 f 0))
     ((= value 1.0e+INF)
      (setq s 0 e 255 f (1- (expt 2 23))))
     ((= value -1.0e+INF)
      (setq s 1 e 255 f (1- (expt 2 23))))
     ((string= (format "%f" value) (format "%f" 0.0e+NaN))
      (setq s 0 e 255 f 1))
     (t
      (setq s (if (>= value 0.0)
		  (progn (setq f value) 0)
		(setq f (* -1 value)) 1))
      (while (>= (* f (expt 2.0 e)) 2.0) (setq e (1- e)))
      (if (= e 0) (while (< (* f (expt 2.0 e)) 1.0) (setq e (1+ e))))
      (setq f (round (* (1- (* f (expt 2.0 e))) (expt 2 23)))
	    e (+ (* -1 e) 127))))
    (insert (+ (lsh s 7) (lsh (logand e #XFE) -1))
	    (+ (lsh (logand e #X01) 7) (lsh (logand f #X7F0000) -16))
	    (lsh (logand f #XFF00) -8)
	    (logand f #XFF))))

(defun osc-read-float32 ()
  (let ((s (lsh (logand (following-char) #X80) -7))
	(e (+ (lsh (logand (following-char) #X7F) 1)
	      (lsh (logand (progn (forward-char) (following-char)) #X80) -7)))
	(f (+ (lsh (logand (following-char) #X7F) 16)
	      (lsh (progn (forward-char) (following-char)) 8)
	      (prog1 (progn (forward-char) (following-char)) (forward-char)))))
    (cond
     ((and (= e 0) (= f 0))
      (* 0.0 (expt -1 s)))
     ((and (= e 255) (or (= f (1- (expt 2 23))) (= f 0)))
      (* 1.0e+INF (expt -1 s)))
     ((and (= e 255) (not (or (= f 0) (= f (1- (expt 2 23))))))
      0.0e+NaN)
     (t
      (* (expt -1 s)
	 (expt 2.0 (- e 127))
	 (1+ (/ f (expt 2.0 23))))))))


-- 
CYa,
  Mario