Add recommended targets to debian/rules

[kmrcl.git] / io.lisp

diff --git a/io.lisp b/io.lisp
index 851c3718eae62f98c828b812fefbc691c70db937..7f06bd9b51b2f97ef6e62f791a09260c28ecd139 100644 (file)
--- a/io.lisp
+++ b/io.lisp
@@ -7,8 +7,6 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id$
-;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
 ;;;;
 ;;;; KMRCL users are granted the rights to distribute and use this software
@@ -327,3 +325,72 @@
       ((zerop pos))
     (write-sequence buf out :end pos)))
 
+
+(defmacro def-unsigned-int-io (len r-name w-name &key (big-endian nil))
+  "Defines read and write functions for an unsigned integer with LEN bytes from STREAM."
+  (when (< len 1)
+    (error "Number of bytes must be greater than 0.~%"))
+  (let ((endian-string (if big-endian "big" "little")))
+    `(eval-when (:compile-toplevel :load-toplevel :execute)
+       (defun ,r-name (stream)
+         ,(format nil "Reads an ~A byte unsigned integer (~A-endian)."
+                  len endian-string)
+         (declare (optimize (speed 3) (compilation-speed 0) (safety 0)
+                            (space 0) (debug 0))
+                  (type stream stream))
+         (let ((val 0))
+           (declare (type
+                     ,(if (< (expt 256 len) most-positive-fixnum)
+                          'fixnum
+                          `(integer 0 ,(1- (expt 256 len))))
+                     val))
+           ,@(loop for i from 1 upto len
+                collect
+                  `(setf (ldb (byte 8 ,(* (if big-endian (1- i) (- len i))
+                                          8)) val) (read-byte stream)))
+           val))
+       (defun ,w-name (val stream &key (bounds-check t))
+         ,(format nil "Writes an ~A byte unsigned integer as binary to STREAM (~A-endian)."
+                  len endian-string)
+         (declare (optimize (speed 3) (compilation-speed 0) (safety 0)
+                            (space 0) (debug 0))
+                  (type stream stream)
+                  ,(if (< (expt 256 len) most-positive-fixnum)
+                       '(type fixnum val)
+                       '(type integer val)))
+         (when bounds-check
+           (when (>= val ,(expt 256 len))
+             (error "Number ~D is too large to fit in ~D bytes.~%" val ,len))
+           (when (minusp val)
+             (error "Number ~D can't be written as unsigned integer." val)))
+         (locally (declare (type (integer 0 ,(1- (expt 256 len))) val))
+           ,@(loop for i from 1 upto len
+                collect
+                  `(write-byte (ldb (byte 8 ,(* (if big-endian (1- i) (- len i))
+                                                8)) val) stream)))
+         val)
+       nil)))
+
+(defmacro make-unsigned-int-io-fn (len)
+  "Makes reader and writer functions for unsigned byte input/output of
+LEN bytes with both little and big endian order. Function names are in the
+form of {READ,WRITE}-UINT<LEN>-{be,le}."
+  `(progn
+     (def-unsigned-int-io
+         ,len
+         ,(intern (format nil "~A~D-~A" (symbol-name '#:read-uint) len (symbol-name '#:le)))
+       ,(intern (format nil "~A~D-~A" (symbol-name '#:write-uint) len (symbol-name '#:le)))
+       :big-endian nil)
+     (def-unsigned-int-io
+         ,len
+         ,(intern (format nil "~A~D-~A" (symbol-name '#:read-uint) len (symbol-name '#:be)))
+       ,(intern (format nil "~A~D-~A" (symbol-name '#:write-uint) len (symbol-name '#:be)))
+       :big-endian t)))
+
+(make-unsigned-int-io-fn 2)
+(make-unsigned-int-io-fn 3)
+(make-unsigned-int-io-fn 4)
+(make-unsigned-int-io-fn 5)
+(make-unsigned-int-io-fn 6)
+(make-unsigned-int-io-fn 7)
+(make-unsigned-int-io-fn 8)