utils.lisp

   1 (in-package :m68k-assembler)
   2
   3 ;;;; STRINGS
   4
   5 (defun munge-modifier (string)
   6   "Chops off the period-delimited extension of STRING, and returns the
   7 new string without the extension as well as the extension, or NIL if
   8 such an extension could not be found."
   9   (let ((modifier nil))
  10     (awhen (position #\. string :from-end t)
  11       (setf modifier (subseq string (1+ it)))
  12       (setf string (subseq string 0 it)))
  13     (values string modifier)))
  14
  15 ;;;; LISTS
  16
  17 (defun carat (x)
  18   "If X is a cons, return the car of it.  Otherwise, return X."
  19   (if (consp x) (car x) x))
  20
  21 (defun tree-find-if (predicate tree)
  22   (redirect-find-if (lambda (x) (tree-find-if predicate x))
  23                     #'consp predicate tree))
  24
  25 (defun redirect-find-if (redirect-fn redirect-predicate predicate tree)
  26   (dolist (x tree)
  27     (if (funcall redirect-predicate x)
  28         (awhen (funcall redirect-fn x) (return it))
  29         (when (funcall predicate x) (return x)))))
  30
  31
  32 ;;;; BINARY DATA, STREAMS
  33
  34 (defun bit-vector->int (vector)
  35   "Converts a bit-vector to an integer, assuming that array indices
  36 correspond to bit places in the integer.  (For example, index 0 in
  37 VECTOR corresponds to the least-significant bit of the return value.)"
  38   (do ((value 0 (+ (ash value 1) (aref vector i)))
  39        (i (1- (length vector)) (1- i)))
  40       ((< i 0) value)))
  41
  42 ;;; XXX probably totally fucked in this modern world of Unicode.
  43 (defun string->int (string)
  44   "Converts a string to an integer, assuming that character elements
  45 correspond to bytes, that they are limited in range from 0 to 255, and
  46 that they are stored from greatest value to least (big-endian)."
  47   (do ((value 0 (+ (ash value 8) (char-code (char string i))))
  48        (i 0 (1+ i)))
  49       ((>= i (length string)) value)))
  50
  51 (defun read-big-endian-data (stream length)
  52   "Read LENGTH bits of data encoded big-endian from STREAM, returning
  53 an integer.  LENGTH must be a multiple of 8."
  54   (assert (zerop (logand length 7)))
  55   (do ((pos (- length 8) (- pos 8))
  56        (value (read-byte stream) (logior (read-byte stream)
  57                                          (ash value 8))))
  58       ((<= pos 0) value)))
  59
  60 (defun write-big-endian-data (stream data length)
  61   "Write LENGTH bits of the integer DATA to STREAM, in big-endian
  62 order.  LENGTH must be a multiple of 8."
  63   (assert (zerop (logand length 7)))
  64   (do ((pos (- length 8) (- pos 8)))
  65       ((< pos 0))
  66     (write-byte (ldb (byte 8 pos) data) stream)))
  67
  68 (defun copy-stream-contents (source destination
  69                              &key (element-type 'unsigned-byte))
  70   "Copy all data from open stream SOURCE to open stream DESTINATION.
  71 SOURCE is positioned at its beginning, and read until it reaches the
  72 end of file."
  73   (file-position source 0)
  74   (let ((buffer (make-array '(4096) :element-type element-type)))
  75     (do ((bytes #1=(read-sequence buffer source) #1#))
  76         ((= bytes 0))
  77       (write-sequence buffer destination :end bytes))))