contrib/sb-bsd-sockets/array-data.lisp

   1 (in-package :sockint)
   2
   3 ;;; borrowed from CMUCL manual, lightly ported
   4
   5 (defun array-data-address (array)
   6   "Return the physical address of where the actual data of an array is
   7 stored.
   8
   9 ARRAY must be a specialized array type - an array of one of these types:
  10
  11                   double-float
  12                   single-float
  13                   (unsigned-byte 32)
  14                   (unsigned-byte 16)
  15                   (unsigned-byte  8)
  16                   (signed-byte 32)
  17                   (signed-byte 16)
  18                   (signed-byte  8)
  19 "
  20   (declare (type (or (array (signed-byte 8))
  21                      (array base-char)
  22                      simple-base-string
  23                      (array (signed-byte 16))
  24                      (array (signed-byte 32))
  25                      (array (unsigned-byte 8))
  26                      (array (unsigned-byte 16))
  27                      (array (unsigned-byte 32))
  28                      (array single-float)
  29                      (array double-float))
  30                  array)
  31            (optimize (speed 0) (debug 3) (safety 3)))
  32   ;; with-array-data will get us to the actual data.  However, because
  33   ;; the array could have been displaced, we need to know where the
  34   ;; data starts.
  35
  36   (let* ((type (car (multiple-value-list (array-element-type array))))
  37          (type-size
  38           (cond ((or (equal type '(signed-byte 8))
  39                      (equal type 'cl::base-char)
  40                      (equal type '(unsigned-byte 8)))
  41                  1)
  42                 ((or (equal type '(signed-byte 16))
  43                      (equal type '(unsigned-byte 16)))
  44                  2)
  45                 ((or (equal type '(signed-byte 32))
  46                      (equal type '(unsigned-byte 32)))
  47                  4)
  48                 ((equal type 'single-float)
  49                  4)
  50                 ((equal type 'double-float)
  51                  8)
  52                 (t (error "Unknown specialized array element type")))))
  53     (with-array-data ((data array)
  54                       (start)
  55                       (end))
  56       (declare (ignore end))
  57       ;; DATA is a specialized simple-array.  Memory is laid out like this:
  58       ;;
  59       ;;   byte offset    Value
  60       ;;        0         type code (e.g. 70 for double-float vector)
  61       ;;        4         FIXNUMIZE(number of elements in vector)
  62       ;;        8         1st element of vector
  63       ;;      ...         ...
  64       ;;
  65       (let* ((addr (+ 8 (logandc1 7 (sb-kernel:get-lisp-obj-address data)))))
  66         (declare (type (unsigned-byte 32) addr)
  67                  (optimize (speed 3) (safety 0)))
  68         (sb-sys:int-sap (the (unsigned-byte 32)
  69                           (+ addr (* type-size start))))))))
  70
  71
  72