utils.lisp

   1 (in-package :m68k-assembler)
   2
   3 ;;;; LISTS
   4
   5 (defun carat (x)
   6   "If X is a cons, return the car of it.  Otherwise, return X."
   7   (if (consp x) (car x) x))
   8
   9
  10 ;;;; BINARY DATA, STREAMS
  11
  12 (defun bit-vector->int (vector)
  13   "Converts a bit-vector to an integer, assuming that array indices
  14 correspond to bit places in the integer.  (For example, index 0 in
  15 VECTOR corresponds to the least-significant bit of the return value.)"
  16   (do ((value 0 (+ (ash value 1) (aref vector i)))
  17        (i (1- (length vector)) (1- i)))
  18       ((< i 0) value)))
  19
  20 ;;; XXX probably totally fucked in this modern world of Unicode.
  21 (defun string->int (string)
  22   "Converts a string to an integer, assuming that character elements
  23 correspond to bytes, that they are limited in range from 0 to 255, and
  24 that they are stored from greatest value to least (big-endian)."
  25   (do ((value 0 (+ (ash value 8) (char-code (char string i))))
  26        (i 0 (1+ i)))
  27       ((>= i (length string)) value)))
  28
  29 (defun read-big-endian-data (stream length)
  30   "Read LENGTH bits of data encoded big-endian from STREAM, returning
  31 an integer.  LENGTH must be a multiple of 8."
  32   (assert (zerop (logand length 7)))
  33   (do ((pos (- length 8) (- pos 8))
  34        (value (read-byte stream) (logior (read-byte stream)
  35                                          (ash value 8))))
  36       ((<= pos 0) value)))
  37
  38 (defun write-big-endian-data (stream data length)
  39   "Write LENGTH bits of the integer DATA to STREAM, in big-endian
  40 order.  LENGTH must be a multiple of 8."
  41   (assert (zerop (logand length 7)))
  42   (do ((pos (- length 8) (- pos 8)))
  43       ((< pos 0))
  44     (write-byte (ldb (byte 8 pos) data) stream)))
  45
  46 (defun copy-stream-contents (source destination
  47                              &key (element-type 'unsigned-byte))
  48   "Copy all data from open stream SOURCE to open stream DESTINATION.
  49 SOURCE is positioned at its beginning, and read until it reaches the
  50 end of file."
  51   (file-position source 0)
  52   (let ((buffer (make-array '(4096) :element-type element-type)))
  53     (do ((bytes #1=(read-sequence buffer source) #1#))
  54         ((= bytes 0))
  55       (write-sequence buffer destination :end bytes))))