0.8.0.65:
[sbcl.git] / 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