--- a
+++ b/contrib/sb-bsd-sockets/array-data.lisp
@@ -0,0 +1,72 @@
+(in-package :sockint)
+
+;;; borrowed from CMUCL manual, lightly ported
+
+(defun array-data-address (array)
+  "Return the physical address of where the actual data of an array is
+stored.
+
+ARRAY must be a specialized array type - an array of one of these types:
+
+                  double-float
+                  single-float
+                  (unsigned-byte 32)
+                  (unsigned-byte 16)
+                  (unsigned-byte  8)
+                  (signed-byte 32)
+                  (signed-byte 16)
+                  (signed-byte  8)
+"
+  (declare (type (or (array (signed-byte 8))
+		     (array base-char)
+		     simple-base-string
+                     (array (signed-byte 16))
+                     (array (signed-byte 32))
+                     (array (unsigned-byte 8))
+                     (array (unsigned-byte 16))
+                     (array (unsigned-byte 32))
+                     (array single-float)
+                     (array double-float))
+                 array)
+           (optimize (speed 0) (debug 3) (safety 3)))
+  ;; with-array-data will get us to the actual data.  However, because
+  ;; the array could have been displaced, we need to know where the
+  ;; data starts.
+
+  (let* ((type (car (multiple-value-list (array-element-type array))))
+	 (type-size
+	  (cond ((or (equal type '(signed-byte 8))
+		     (equal type 'cl::base-char)
+		     (equal type '(unsigned-byte 8)))
+		 1)
+		((or (equal type '(signed-byte 16))
+		     (equal type '(unsigned-byte 16)))
+		 2)
+		((or (equal type '(signed-byte 32))
+		     (equal type '(unsigned-byte 32)))
+		 4)
+		((equal type 'single-float)
+		 4)
+		((equal type 'double-float)
+		 8)
+		(t (error "Unknown specialized array element type")))))
+    (with-array-data ((data array)
+		      (start)
+		      (end))
+      (declare (ignore end))
+      ;; DATA is a specialized simple-array.  Memory is laid out like this:
+      ;;
+      ;;   byte offset    Value
+      ;;        0         type code (e.g. 70 for double-float vector)
+      ;;        4         FIXNUMIZE(number of elements in vector)
+      ;;        8         1st element of vector
+      ;;      ...         ...
+      ;;
+      (let* ((addr (+ 8 (logandc1 7 (sb-kernel:get-lisp-obj-address data)))))
+	(declare (type (unsigned-byte 32) addr)
+		 (optimize (speed 3) (safety 0)))
+	(sb-sys:int-sap (the (unsigned-byte 32)
+			  (+ addr (* type-size start))))))))
+
+
+