* added directories

    {arch}/sbcl/sbcl--alien
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@void.at--home-archive
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@void.at--home-archive/patch-log

* removed files

    contrib/sb-grovel/.arch-ids/array-data.lisp.id
    contrib/sb-grovel/array-data.lisp

* added files

    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log/base-0
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log/patch-1
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log/patch-10
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log/patch-11
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log/patch-12
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log/patch-2
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log/patch-3
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log/patch-4
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log/patch-5
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log/patch-6
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log/patch-7
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log/patch-8
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2003m/patch-log/patch-9
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log/base-0
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log/patch-1
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log/patch-10
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log/patch-11
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log/patch-12
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log/patch-2
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log/patch-3
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log/patch-4
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log/patch-5
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log/patch-6
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log/patch-7
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log/patch-8
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@boinkor.net--2004h/patch-log/patch-9
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@void.at--home-archive/patch-log/base-0
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@void.at--home-archive/patch-log/patch-1
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@void.at--home-archive/patch-log/patch-2
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@void.at--home-archive/patch-log/patch-3
    {arch}/sbcl/sbcl--alien/sbcl--alien--0.8/asf@void.at--home-archive/patch-log/patch-4

* modified files

--- orig/contrib/sb-bsd-sockets/constants.lisp
+++ mod/contrib/sb-bsd-sockets/constants.lisp
@@ -104,23 +104,27 @@
  (buf (* t))))
  |#
  (:structure protoent ("struct protoent"
-                       ((* t) name "char *" "p_name")
+                       (c-string-pointer name "char *" "p_name")
                        ((* (* t)) aliases "char **" "p_aliases")
 		       (integer proto "int" "p_proto")))
  (:function getprotobyname ("getprotobyname" (* t)
 					     (name c-string)))
  (:integer inaddr-any "INADDR_ANY")
  (:structure in-addr ("struct in_addr"
-		      ((array (unsigned 8) 4) addr "u_int32_t" "s_addr")))
+		      ((array (unsigned 8)) addr "u_int32_t" "s_addr")))
  (:structure sockaddr-in ("struct sockaddr_in"
                           (integer family "sa_family_t" "sin_family")
-                          ((array (unsigned 8) 2) port "u_int16_t" "sin_port")
-                          ((array (unsigned 8) 4) addr "struct in_addr" "sin_addr")))
+			  ;; These two could be in-port-t and
+			  ;; in-addr-t, but then we'd throw away the
+			  ;; convenience (and byte-order agnosticism)
+			  ;; of the old sb-grovel scheme.
+                          ((array (unsigned 8)) port "u_int16_t" "sin_port")
+                          ((array (unsigned 8)) addr "struct in_addr" "sin_addr")))
  (:structure sockaddr-un ("struct sockaddr_un"
                           (integer family "sa_family_t" "sun_family")
-                          ((array (unsigned 8) 108) path "char" "sun_path")))
+                          (c-string path "char" "sun_path")))
  (:structure hostent ("struct hostent"
-                      ((* t) name "char *" "h_name")
+                      (c-string-pointer name "char *" "h_name")
                       ((* c-string) aliases "char **" "h_aliases")
                       (integer type "int" "h_addrtype")
                       (integer length "int" "h_length")
@@ -131,26 +135,26 @@
                     (protocol integer)))
  (:function bind ("bind" integer
                   (sockfd integer)
-                  (my-addr (* t))
+                  (my-addr (* t))  ; KLUDGE: sockaddr-in or sockaddr-un?
                   (addrlen integer)))
  (:function listen ("listen" integer
                     (socket integer)
                     (backlog integer)))
  (:function accept ("accept" integer
                     (socket integer)
-                    (my-addr (* t))
+                    (my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
                     (addrlen integer :in-out)))
  (:function getpeername ("getpeername" integer
                          (socket integer)
-                         (her-addr (* t))
+                         (her-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
                          (addrlen integer :in-out)))
  (:function getsockname ("getsockname" integer
                          (socket integer)
-                         (my-addr (* t))
+                         (my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
                          (addrlen integer :in-out)))
  (:function connect ("connect" integer
                     (socket integer)
-                    (his-addr (* t))
+                    (his-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
                     (addrlen integer )))
  
  (:function close ("close" integer
@@ -160,10 +164,10 @@
 				 (buf (* t))
 				 (len integer)
 				 (flags integer)
-				 (sockaddr (* t))
+				 (sockaddr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
 				 (socklen (* integer))))
- (:function gethostbyname ("gethostbyname" (* t ) (name c-string)))
- (:function gethostbyaddr ("gethostbyaddr" (* t )
+ (:function gethostbyname ("gethostbyname" (* hostent) (name c-string)))
+ (:function gethostbyaddr ("gethostbyaddr" (* hostent)
 					   (addr (* t))
 					   (len integer)
 					   (af integer)))
@@ -182,5 +186,5 @@
                         (level integer)
                         (optname integer)
                         (optval (* t))
-                        (optlen integer :in-out))))
+                        (optlen (* integer)))))
 )


--- orig/contrib/sb-bsd-sockets/inet.lisp
+++ mod/contrib/sb-bsd-sockets/inet.lisp
@@ -26,10 +26,9 @@
 (defun make-inet-address (dotted-quads)
   "Return a vector of octets given a string DOTTED-QUADS in the format
 \"127.0.0.1\""
-  (coerce
-   (mapcar #'parse-integer
-           (split dotted-quads nil '(#\.)))
-   'vector))
+  (map 'vector
+       #'parse-integer
+       (split dotted-quads nil '(#\.))))
 
 ;;; getprotobyname only works in the internet domain, which is why this
 ;;; is here
@@ -38,37 +37,33 @@
 using getprotobyname(2) which typically looks in NIS or /etc/protocols"
   ;; for extra brownie points, could return canonical protocol name
   ;; and aliases as extra values
-  (let ((ent (sb-grovel::foreign-vector (sockint::getprotobyname name) 1
-				        sockint::size-of-protoent)))
+  (let ((ent (sockint::getprotobyname name)))
     (sockint::protoent-proto ent)))
 
-
-;;; sockaddr protocol
-;;; (1) sockaddrs are represented as the semi-foreign array-of-octets
-;;; thing
-;;; (2) a protocol provides make-sockaddr-for, size-of-sockaddr,
+;;; a protocol provides make-sockaddr-for, size-of-sockaddr,
 ;;; bits-of-sockaddr
 
 (defmethod make-sockaddr-for ((socket inet-socket) &optional sockaddr &rest address &aux (host (first address)) (port (second address)))
   (let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-in))))
     (when (and host port)
+      (setf host (coerce host '(simple-array (unsigned-byte 8) (4))))
       ;; port and host are represented in C as "network-endian" unsigned
       ;; integers of various lengths.  This is stupid.  The value of the
       ;; integer doesn't matter (and will change depending on your
       ;; machine's endianness); what the bind(2) call is interested in
       ;; is the pattern of bytes within that integer.
-      
+
       ;; We have no truck with such dreadful type punning.  Octets to
       ;; octets, dust to dust.
       
       (setf (sockint::sockaddr-in-family sockaddr) sockint::af-inet)
-      (setf (sockint::sockaddr-in-port sockaddr 0) (ldb (byte 8 8) port))
-      (setf (sockint::sockaddr-in-port sockaddr 1) (ldb (byte 8 0) port))
-      
-      (setf (sockint::sockaddr-in-addr sockaddr 0) (elt host 0))
-      (setf (sockint::sockaddr-in-addr sockaddr 1) (elt host 1))
-      (setf (sockint::sockaddr-in-addr sockaddr 2) (elt host 2))
-      (setf (sockint::sockaddr-in-addr sockaddr 3) (elt host 3)))
+      (setf (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 0) (ldb (byte 8 8) port))
+      (setf (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1) (ldb (byte 8 0) port))
+
+      (setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 0) (elt host 0))
+      (setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 1) (elt host 1))
+      (setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 2) (elt host 2))
+      (setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 3) (elt host 3)))
     sockaddr))
 
 (defmethod size-of-sockaddr ((socket inet-socket))
@@ -77,13 +72,11 @@
 (defmethod bits-of-sockaddr ((socket inet-socket) sockaddr)
   "Returns address and port of SOCKADDR as multiple values"
   (values
-   (vector
-    (sockint::sockaddr-in-addr sockaddr 0) 
-    (sockint::sockaddr-in-addr sockaddr 1) 
-    (sockint::sockaddr-in-addr sockaddr 2) 
-    (sockint::sockaddr-in-addr sockaddr 3))
-   (+ (* 256 (sockint::sockaddr-in-port sockaddr 0))
-      (sockint::sockaddr-in-port sockaddr 1))))  
+   (coerce (loop for i from 0 below 4
+		 collect (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) i))
+	   '(vector (unsigned-byte 8) 4))
+   (+ (* 256 (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 0))
+      (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1))))
    
 (defun make-inet-socket (type protocol)
   "Make an INET socket.  Deprecated in favour of make-instance"


--- orig/contrib/sb-bsd-sockets/local.lisp
+++ mod/contrib/sb-bsd-sockets/local.lisp
@@ -19,13 +19,7 @@
   (let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-un))))
     (setf (sockint::sockaddr-un-family sockaddr) sockint::af-local)
     (when filename
-      (loop for c across filename
-	    ;; XXX magic constant ew ew ew.  should grovel this from
-	    ;; system headers
-	    for i from 0 to (min 107 (1- (length filename)))
-	    do (setf (sockint::sockaddr-un-path sockaddr i) (char-code c))
-	    finally
-	    (setf (sockint::sockaddr-un-path sockaddr (1+ i)) 0)))
+      (setf (sockint::sockaddr-un-path sockaddr) filename))
     sockaddr))
 
 (defmethod size-of-sockaddr ((socket local-socket))
@@ -33,8 +27,6 @@
 
 (defmethod bits-of-sockaddr ((socket local-socket) sockaddr)
   "Return the file name of the local socket address SOCKADDR."
-  (let ((name (sb-c-call::%naturalize-c-string
-	       (sb-sys:sap+ (sb-grovel::array-data-address sockaddr)
-			    sockint::offset-of-sockaddr-un-path))))
+  (let ((name (sockint::sockaddr-un-path sockaddr)))
     (if (zerop (length name)) nil name)))
 


--- orig/contrib/sb-bsd-sockets/name-service.lisp
+++ mod/contrib/sb-bsd-sockets/name-service.lisp
@@ -31,44 +31,42 @@
   "Returns a HOST-ENT instance for HOST-NAME or throws some kind of condition.
 HOST-NAME may also be an IP address in dotted quad notation or some other
 weird stuff - see gethostbyname(3) for grisly details."
-  (let ((h (sockint::gethostbyname host-name)))
-    (make-host-ent h)))
+  (make-host-ent (sockint::gethostbyname host-name)))
 
 (defun get-host-by-address (address)
   "Returns a HOST-ENT instance for ADDRESS, which should be a vector of
-(integer 0 255), or throws some kind of error.  See gethostbyaddr(3) for
+ (integer 0 255), or throws some kind of error.  See gethostbyaddr(3) for
 grisly details."
-  (let ((packed-addr (sockint::allocate-in-addr)))
-    (loop for i from 0 to 3 
-	  do (setf (sockint::in-addr-addr packed-addr i) (elt address i)))
-    (make-host-ent
-     (sb-sys:with-pinned-objects (packed-addr)
-      (sockint::gethostbyaddr (sb-grovel::array-data-address packed-addr)
-			      4
-			      sockint::af-inet)))))
+  (let ((packed-addr (sockint::allocate-in-addr))
+	(addr-vector (coerce address 'vector)))
+    (loop for i from 0 below (length addr-vector)
+	  do (setf (sb-alien:deref (sockint::in-addr-addr packed-addr) i)
+		   (elt addr-vector i)))
+    (make-host-ent (sockint::gethostbyaddr packed-addr
+					   4
+					   sockint::af-inet))))
 
 (defun make-host-ent (h)
   (if (sb-grovel::foreign-nullp h) (name-service-error "gethostbyname"))
-  (let* ((local-h (sb-grovel::foreign-vector h 1 sockint::size-of-hostent))
-	 (length (sockint::hostent-length local-h))
-	 (aliases 
-	  (loop for i = 0 then (1+ i)
-		for al = (sb-sys:sap-ref-sap
-			  (sb-sys:int-sap (sockint::hostent-aliases local-h))
-			  (* i 4))
-		until (= (sb-sys:sap-int al) 0) 
-		collect (sb-c-call::%naturalize-c-string al)))
-	 (address0 (sb-sys:sap-ref-sap (sb-sys:int-sap (sockint::hostent-addresses local-h)) 0))
+  (let* ((length (sockint::hostent-length h))
+	 (aliases (loop for i = 0 then (1+ i)
+			for al = (sb-alien:deref (sockint::hostent-aliases h) i)
+			while al
+			collect al))
+	 (address0 (sockint::hostent-addresses h))
 	 (addresses 
-	  (loop for i = 0 then (+ length i)
-		for ad = (sb-sys:sap-ref-32 address0 i)
-		while (> ad 0)
-		collect
-		(sb-grovel::foreign-vector (sb-sys:sap+ address0 i) 1 length))))
+	  (loop for i = 0 then (1+ i)
+		for ad = (sb-alien:deref address0 i)
+		until (sb-alien:null-alien ad)
+		collect (ecase (sockint::hostent-type h)
+			  (#.sockint::af-inet
+			   (loop for i from 0 below length
+				 collect (sb-alien:deref ad i)))
+			  (#.sockint::af-local
+			   (sb-alien:cast ad sb-alien:c-string))))))
     (make-instance 'host-ent
-                   :name (sb-c-call::%naturalize-c-string
-			  (sb-sys:int-sap (sockint::hostent-name local-h)))
-		   :type (sockint::hostent-type local-h)
+                   :name (sockint::hostent-name h)
+		   :type (sockint::hostent-type h)
                    :aliases aliases
                    :addresses addresses)))
 
@@ -143,4 +141,3 @@
   (defun get-name-service-error-message (num)
   (hstrerror num))
 )
-


--- orig/contrib/sb-bsd-sockets/sockets.lisp
+++ mod/contrib/sb-bsd-sockets/sockets.lisp
@@ -62,10 +62,9 @@
 (defmethod socket-bind ((socket socket)
                         &rest address)
   (let ((sockaddr (apply #'make-sockaddr-for socket nil address)))
-    (if (= (sb-sys:with-pinned-objects (sockaddr)
-	    (sockint::bind (socket-file-descriptor socket)
-			   (sb-grovel::array-data-address sockaddr)
-			   (size-of-sockaddr socket)))
+    (if (= (sockint::bind (socket-file-descriptor socket)
+			  sockaddr
+			  (size-of-sockaddr socket))
            -1)
         (socket-error "bind"))))
 
@@ -77,19 +76,18 @@
   
 (defmethod socket-accept ((socket socket))
   (let ((sockaddr (make-sockaddr-for socket)))
-    (sb-sys:with-pinned-objects (sockaddr)
-      (let ((fd (sockint::accept (socket-file-descriptor socket)
-				 (sb-grovel::array-data-address sockaddr)
-				 (size-of-sockaddr socket))))
-	(apply #'values
-	       (if (= fd -1)
-		   (socket-error "accept")
-		   (let ((s (make-instance (class-of socket)
-					   :type (socket-type socket)
-					   :protocol (socket-protocol socket)
-					   :descriptor fd)))
-		     (sb-ext:finalize s (lambda () (sockint::close fd)))))
-	       (multiple-value-list (bits-of-sockaddr socket sockaddr)))))))
+    (let ((fd (sockint::accept (socket-file-descriptor socket)
+			       sockaddr
+			       (size-of-sockaddr socket))))
+      (apply #'values
+	     (if (= fd -1)
+		 (socket-error "accept")
+		 (let ((s (make-instance (class-of socket)
+			     :type (socket-type socket)
+			     :protocol (socket-protocol socket)
+			     :descriptor fd)))
+		   (sb-ext:finalize s (lambda () (sockint::close fd)))))
+	     (multiple-value-list (bits-of-sockaddr socket sockaddr))))))
     
 (defgeneric socket-connect (socket &rest address)
   (:documentation "Perform the connect(2) call to connect SOCKET to a
@@ -97,12 +95,11 @@
 
 (defmethod socket-connect ((socket socket) &rest peer)
   (let* ((sockaddr (apply #'make-sockaddr-for socket nil peer)))
-    (if (= (sb-sys:with-pinned-objects (sockaddr)
-	    (sockint::connect (socket-file-descriptor socket)
-			      (sb-grovel::array-data-address sockaddr)
-			      (size-of-sockaddr socket)))
+    (if (= (sockint::connect (socket-file-descriptor socket)
+			     sockaddr
+			     (size-of-sockaddr socket))
 	   -1)
-	(socket-error "connect") )))
+	(socket-error "connect"))))
 
 (defgeneric socket-peername (socket)
   (:documentation "Return the socket's peer; depending on the address
@@ -110,10 +107,9 @@
   
 (defmethod socket-peername ((socket socket))
   (let* ((sockaddr (make-sockaddr-for socket)))
-    (when (= (sb-sys:with-pinned-objects (sockaddr)
-	      (sockint::getpeername (socket-file-descriptor socket)
-				    (sb-grovel::array-data-address sockaddr)
-				    (size-of-sockaddr socket)))
+    (when (= (sockint::getpeername (socket-file-descriptor socket)
+				    sockaddr
+				    (size-of-sockaddr socket))
 	     -1)
       (socket-error "getpeername"))
     (bits-of-sockaddr socket sockaddr)))
@@ -124,10 +120,9 @@
 
 (defmethod socket-name ((socket socket))
   (let* ((sockaddr (make-sockaddr-for socket)))
-    (when (= (sb-sys:with-pinned-objects (sockaddr)
-	      (sockint::getsockname (socket-file-descriptor socket)
-				    (sb-grovel::array-data-address sockaddr)
-				    (size-of-sockaddr socket)))
+    (when (= (sockint::getsockname (socket-file-descriptor socket)
+				   sockaddr
+				   (size-of-sockaddr socket))
 	     -1)
       (socket-error "getsockname"))
     (bits-of-sockaddr socket sockaddr)))
@@ -152,34 +147,38 @@
 small"))
   
 (defmethod socket-receive ((socket socket) buffer length
-			 &key
-			 oob peek waitall
-			 (element-type 'character))
+			   &key
+			   oob peek waitall
+			   (element-type 'character))
   (let ((flags
 	 (logior (if oob sockint::MSG-OOB 0)
 		 (if peek sockint::MSG-PEEK 0)
 		 (if waitall sockint::MSG-WAITALL 0)
-		 sockint::MSG-NOSIGNAL	;don't send us SIGPIPE
+		 #+linux sockint::MSG-NOSIGNAL ;don't send us SIGPIPE
 		 (if (eql (socket-type socket) :datagram)
 		     sockint::msg-TRUNC 0)))
 	(sockaddr (make-sockaddr-for socket)))
     (unless (or buffer length)
       (error "Must supply at least one of BUFFER or LENGTH"))
-    (unless buffer
-      (setf buffer (make-array length :element-type element-type)))
-    (sb-alien:with-alien ((sa-len (array (sb-alien:unsigned 32) 2)))
-      (setf (sb-alien:deref sa-len 0) (size-of-sockaddr socket))
-      (sb-sys:with-pinned-objects (buffer sockaddr) 
-       (let ((len
-	      (sockint::recvfrom (socket-file-descriptor socket)
-				 (sb-grovel::array-data-address buffer)
-				 (or length (length buffer))
-				 flags
-				 (sb-grovel::array-data-address sockaddr)
-				 (sb-alien:cast sa-len (* integer)))))
-	 (when (= len -1) (socket-error "recvfrom"))
-	 (apply #'values buffer len (multiple-value-list
-				     (bits-of-sockaddr socket sockaddr))))))))
+    (unless length
+      (setf length (length buffer)))
+    (let ((copy-buffer (sb-alien:make-alien (array sb-alien:unsigned 1) length)))
+      (unwind-protect
+	  (sb-alien:with-alien ((sa-len (array (sb-alien:unsigned 32) 2)))
+	    (setf (sb-alien:deref sa-len 0) (size-of-sockaddr socket))
+	    (let ((len
+		   (sockint::recvfrom (socket-file-descriptor socket)
+				      copy-buffer
+				      length
+				      flags
+				      sockaddr
+				      (sb-alien:cast sa-len (* integer)))))
+	      (when (= len -1) (socket-error "recvfrom"))
+	      (loop for i from 0 below len
+		    do (setf (elt buffer i) (sb-alien:deref copy-buffer i)))
+	      (apply #'values buffer len (multiple-value-list
+					  (bits-of-sockaddr socket sockaddr)))))
+	(sb-alien:free-alien copy-buffer)))))
 
 
 


--- orig/contrib/sb-bsd-sockets/sockopt.lisp
+++ mod/contrib/sb-bsd-sockets/sockopt.lisp
@@ -20,7 +20,7 @@
 fact that most of these take different data types - some are integers,
 some are booleans, some are foreign struct instances, etc etc
 
-(define-socket-option lisp-name level number mangle-arg size mangle-return)
+ (define-socket-option lisp-name level number mangle-arg size mangle-return)
 
 macro-expands to two functions that define lisp-name and (setf ,lisp-name)
 and calls the functions mangle-arg and mangle-return on outgoing and incoming
@@ -41,15 +41,15 @@
 
 Code for options that not every system has should be conditionalised:
 
-(if (boundp 'sockint::IP_RECVIF)
-    (define-socket-option so-receive-interface (getprotobyname "ip")
-      sockint::IP_RECVIF  ...  ))
+ (if (boundp 'sockint::IP_RECVIF)
+     (define-socket-option so-receive-interface (getprotobyname "ip")
+       sockint::IP_RECVIF  ...  ))
 
 
 |#
 
 (defmacro define-socket-option
-  (lisp-name level number mangle-arg size mangle-return)
+  (lisp-name level number buffer-type mangle-arg mangle-return mangle-setf-buffer)
   (let ((find-level
 	 (if (numberp (eval level))
 	     level
@@ -57,48 +57,36 @@
     `(progn
       (export ',lisp-name)
       (defun ,lisp-name (socket &aux (fd (socket-file-descriptor socket)))
-	(let ((buf (make-array sockint::size-of-int
-			       :element-type '(unsigned-byte 8)
-			       :initial-element 0)))
-	  (sb-sys:with-pinned-objects (buf)
-	    (if (= -1 (sockint::getsockopt
-		       fd ,find-level ,number (sb-grovel::array-data-address buf) ,size))
-		(socket-error "getsockopt")
-		(,mangle-return buf ,size)))))
+	(sb-alien:with-alien ((size sb-alien:integer)
+			      (buffer ,buffer-type))
+	  (setf size (sb-alien:alien-size ,buffer-type :bytes))
+	  (if (= -1 (sockint::getsockopt fd ,find-level ,number
+					 (sb-alien:addr buffer)
+					 (sb-alien:addr size)))
+	      (socket-error "getsockopt")
+	      (,mangle-return buffer size))))
       (defun (setf ,lisp-name) (new-val socket
 				&aux (fd (socket-file-descriptor socket)))
-	(if (= -1
-	       (sb-sys:without-gcing
-		(sockint::setsockopt
-		 fd ,find-level ,number (funcall (function ,mangle-arg) new-val ,size)
-		 ,size)))
-	    (socket-error "setsockopt"))))))
+	(sb-alien:with-alien ((buffer ,buffer-type))
+	  (setf buffer ,(if mangle-arg
+			    `(,mangle-arg new-val)
+			    `new-val))
+	  (when (= -1 (sockint::setsockopt fd ,find-level ,number
+					   (,mangle-setf-buffer buffer)
+					   ,(if (eql buffer-type 'sb-alien:c-string)
+						`(length new-val)
+						`(sb-alien:alien-size ,buffer-type))))
+	    (socket-error "setsockopt")))))))
 
 ;;; sockopts that have integer arguments
 
-(defun int-to-foreign (x size)
-  ;; can't use with-alien, as the variables it creates only have
-  ;; dynamic scope.  can't use the passed-in size because sap-alien
-  ;; is a macro and evaluates its second arg at read time
-  (let* ((v (make-array size :element-type '(unsigned-byte 8)
-			:initial-element 0))
-	 (d (sb-grovel::array-data-address v))
-	 (alien (sb-alien:sap-alien
-		 d; (sb-sys:int-sap d)
-		 (* (sb-alien:signed #.(* 8 sockint::size-of-int))))))
-    (setf (sb-alien:deref alien 0) x)
-    alien))
-
-(defun buffer-to-int (x size)
-  (declare (ignore size))
-  (let ((alien (sb-alien:sap-alien
-		(sb-grovel::array-data-address x)
-		(* (sb-alien:signed #.(* 8 sockint::size-of-int))))))
-    (sb-alien:deref alien)))
+(defun foreign-int-to-integer (buffer size)
+  (assert (= size (sb-alien:alien-size sb-alien:integer :bytes)))
+  buffer)
 
 (defmacro define-socket-option-int (name level number)
   `(define-socket-option ,name ,level ,number
-     int-to-foreign sockint::size-of-int buffer-to-int))
+     sb-alien:integer nil foreign-int-to-integer sb-alien:addr))
 
 (define-socket-option-int
   sockopt-receive-low-water sockint::sol-socket sockint::so-rcvlowat)
@@ -110,20 +98,22 @@
   sockopt-send-buffer sockint::sol-socket sockint::so-sndbuf)
 (define-socket-option-int
   sockopt-receive-buffer sockint::sol-socket sockint::so-rcvbuf)
-(define-socket-option-int
+#+linux(define-socket-option-int
   sockopt-priority sockint::sol-socket sockint::so-priority)
 
 ;;; boolean options are integers really
 
-(defun bool-to-foreign (x size)
-  (int-to-foreign (if x 1 0) size))
+(defun foreign-int-to-bool (x size)
+  (if (zerop (foreign-int-to-integer x size))
+      nil
+      t))
 
-(defun buffer-to-bool (x size)
-  (not (= (buffer-to-int x size) 0)))
+(defun bool-to-foreign-int (val)
+  (if val 1 0))
 
 (defmacro define-socket-option-bool (name level number)
   `(define-socket-option ,name ,level ,number
-     bool-to-foreign sockint::size-of-int buffer-to-bool))
+     sb-alien:integer bool-to-foreign-int foreign-int-to-bool sb-alien:addr))
 
 (define-socket-option-bool
   sockopt-reuse-address sockint::sol-socket sockint::so-reuseaddr)
@@ -131,9 +121,9 @@
   sockopt-keep-alive sockint::sol-socket sockint::so-keepalive)
 (define-socket-option-bool
   sockopt-oob-inline sockint::sol-socket sockint::so-oobinline)
-(define-socket-option-bool
+#+linux(define-socket-option-bool
   sockopt-bsd-compatible sockint::sol-socket sockint::so-bsdcompat)
-(define-socket-option-bool
+#+linux(define-socket-option-bool
   sockopt-pass-credentials sockint::sol-socket sockint::so-passcred)
 (define-socket-option-bool
   sockopt-debug sockint::sol-socket sockint::so-debug)
@@ -144,19 +134,12 @@
 
 (define-socket-option-bool sockopt-tcp-nodelay :tcp sockint::tcp-nodelay)
 
-(defun string-to-foreign (string size)
-  (declare (ignore size))
-  (let ((data (sb-grovel::array-data-address string)))
-    (sb-alien:sap-alien data (* t))))
-                                                         
-(defun buffer-to-string (x size)
-  (declare (ignore size))
-  (sb-c-call::%naturalize-c-string
-   (sb-grovel::array-data-address x)))
-
-(define-socket-option sockopt-bind-to-device sockint::sol-socket
-  sockint::so-bindtodevice string-to-foreign sockint::ifnamsiz
-  buffer-to-string)
+(defun identity-1 (x &rest args)
+  (declare (ignore args))
+  x)
+
+#+linux(define-socket-option sockopt-bind-to-device sockint::sol-socket
+  sockint::so-bindtodevice sb-alien:c-string identity identity-1 identity)
 
 ;;; other kinds of socket option
 


--- orig/contrib/sb-grovel/def-to-lisp.lisp
+++ mod/contrib/sb-grovel/def-to-lisp.lisp
@@ -1,77 +1,115 @@
-(in-package :SB-GROVEL)
-(defvar *export-symbols* nil)
+(in-package #:sb-grovel)
 
-(defun c-for-structure (stream lisp-name c-struct)
-  (destructuring-bind (c-name &rest elements) c-struct
-    (format stream "printf(\"(sb-grovel::define-c-struct ~A %d)\\n\",sizeof (~A));~%" lisp-name c-name)
+(defvar *default-c-stream* nil)
+
+(defun escape-for-string (string)
+  (c-escape string))
+
+(defun c-escape (string &optional (dangerous-chars '(#\")) (escape-char #\\))
+  "Escape DANGEROUS-CHARS in STRING, with ESCAPE-CHAR."
+  (coerce (loop for c across string
+	        if (member c dangerous-chars) collect escape-char
+  	        collect c)
+	  'string))
+
+(defun as-c (&rest args)
+  "Pretty-print ARGS into the C source file, separated by #\Space"
+  (format *default-c-stream* "~A~{ ~A~}~%" (first args) (rest args)))
+
+(defun printf (formatter &rest args)
+  "Emit C code to printf the quoted code, via FORMAT.
+The first argument is the C string that should be passed to
+printf.
+
+The rest of the arguments are consumed by FORMAT clauses, until
+there are no more FORMAT clauses to fill. If there are more
+arguments, they are emitted as printf arguments.
+
+There is no error checking done, unless you pass too few FORMAT
+clause args. I recommend using this formatting convention in
+code:
+
+ (printf \"string ~A ~S %d %d\" format-arg-1 format-arg-2
+         printf-arg-1 printf-arg-2)"
+  (let ((*print-pretty* nil))
+    (apply #'format *default-c-stream*
+	   "    printf (\"~@?\\n\"~@{, ~A~});~%"
+	   (c-escape formatter)
+	   args)))
+
+(defun c-for-structure (lispname cstruct)
+  (destructuring-bind (cname &rest elements) cstruct
+    (printf "(cl:eval-when (:compile-toplevel :load-toplevel :execute) (sb-grovel::define-c-struct ~A %d" lispname
+	    (format nil "sizeof(~A)" cname))
     (dolist (e elements)
       (destructuring-bind (lisp-type lisp-el-name c-type c-el-name &key distrust-length) e
-	;; FIXME: this format string doesn't actually guarantee
-	;; non-multilined-string-constantness, it just makes it more
-	;; likely.  Sort out the required behaviour (and maybe make
-	;; the generated C more readable, while we're at it...) --
-	;; CSR, 2003-05-27
-        (format stream "printf(\"(sb-grovel::define-c-accessor ~A-~A\\n\\~%  ~
-                        ~A ~A \");~%"
-                lisp-name lisp-el-name lisp-name lisp-type)
-        ;; offset
-        (format stream "{ ~A t;printf(\"%d \",((unsigned long)&(t.~A)) - ((unsigned long)&(t)) ); }~%"
-                c-name c-el-name)
-        ;; length
+	(printf " (~A ~A \"~A\"" lisp-el-name lisp-type c-type)
+	;; offset
+	(as-c "{" cname "t;")
+	(printf "  %d"
+		(format nil "((unsigned long)&(t.~A)) - ((unsigned long)&(t))" c-el-name))
+	(as-c "}")
+	;; length
 	(if distrust-length
-	    (format stream "printf(\"|CL|:|NIL|\");")
-	    (format stream "{ ~A t;printf(\"%d\",(sizeof t.~A));}~%"
-		    c-name c-el-name))
-        (format stream "printf(\")\\n\");~%")))))
-
-(defun c-for-function (stream lisp-name alien-defn)
-  (destructuring-bind (c-name &rest definition) alien-defn
-    (format stream "printf(\"(cl:declaim (cl:inline ~A))\\n\");~%" lisp-name)
-    (format stream
-	    "printf(\"(sb-grovel::define-foreign-routine (\\\"~A\\\" ~A)\\n\\~%~
-            ~{  ~W~^\\n\\~%~})\\n\");~%"
-	    c-name lisp-name definition)))
+	    (printf "  0)")
+	    (progn
+	      (as-c "{" cname "t;")
+	      (printf "  %d)"
+		      (format nil "sizeof(t.~A)" c-el-name))
+	      (as-c "}")))))
+    (printf "))")))
 
 (defun print-c-source (stream headers definitions package-name)
-  (let ((*print-right-margin* nil))
-    (format stream "#define SIGNEDP(x) (((x)-1)<0)~%")
-    (format stream "#define SIGNED_(x) (SIGNEDP(x)?\"\":\"un\")~%")
+  (declare (ignorable definitions package-name))
+  (let ((*default-c-stream* stream)
+	(*print-right-margin* nil))
     (loop for i in (cons "stdio.h" headers)
           do (format stream "#include <~A>~%" i))
-    (format stream "main() { ~%
-printf(\"(in-package ~S)\\\n\");~%" package-name)  
-    (format stream "printf(\"(cl:deftype int () '(%ssigned-byte %d))\\\n\",SIGNED_(int),8*sizeof (int));~%")
-    (format stream "printf(\"(cl:deftype char () '(%ssigned-byte %d))\\\n\",SIGNED_(char),8*sizeof (char));~%")
-    (format stream "printf(\"(cl:deftype long () '(%ssigned-byte %d))\\\n\",SIGNED_(long),8*sizeof (long));~%")
-    (format stream "printf(\"(cl:defconstant size-of-int %d)\\\n\",sizeof (int));~%")
-    (format stream "printf(\"(cl:defconstant size-of-char %d)\\\n\",sizeof (char));~%")
-    (format stream "printf(\"(cl:defconstant size-of-long %d)\\\n\",sizeof (long));~%")
+    (as-c "#define SIGNEDP(x) (((x)-1)<0)")
+    (as-c "#define SIGNED_(x) (SIGNEDP(x)?\"\":\"un\")")
+    (as-c "int main() {")
+    (printf "(cl:in-package #:~A)" package-name)
+    (printf "(cl:eval-when (:compile-toplevel)")
+    (printf "  (cl:defparameter *integer-sizes* (cl:make-hash-table))")
+    (dolist (type '("char" "short" "long" "int"
+		    #+nil"long long" ; TODO: doesn't exist in sb-alien yet
+		    ))
+      (printf "  (cl:setf (cl:gethash %d *integer-sizes*) 'sb-alien:~A)" (substitute #\- #\Space type)
+	      (format nil "sizeof(~A)" type)))
+    (printf ")")
     (dolist (def definitions)
-      (destructuring-bind (type lispname cname &optional doc) def
-        (cond ((eq type :integer)
-               (format stream
-                       "#ifdef ~A~%~
-                        printf(\"(cl:defconstant ~A %d \\\"~A\\\")\\\n\",~A);~%~
-                        #else~%~
-                        printf(\"(sb-int:style-warn \\\"Couln't grovel definition for ~A (unknown to the C compiler).\\\")\\n\");~%~
-                        #endif~%"
-                       cname lispname doc cname cname))
-	      ((eq type :type)
-	       (format stream
-                       "printf(\"(sb-alien:define-alien-type ~A (sb-alien:%ssigned %d))\\\n\",SIGNED_(~A),8*(sizeof(~A)));~%"
-		       lispname cname cname))
-              ((eq type :string)
-               (format stream
-                       "printf(\"(cl:defvar ~A %S \\\"~A\\\")\\\n\",~A);~%"
-                     lispname doc cname))
-              ((eq type :function)
-               (c-for-function stream lispname cname))
-              ((eq type :structure)
-               (c-for-structure stream lispname cname))
-              (t
-               (format stream
-                       "printf(\";; Non hablo Espagnol, Monsieur~%")))))
-    (format stream "exit(0);~%}~%")))
+      (destructuring-bind (type lispname cname &optional doc dont-export) def
+	(case type
+	  (:integer
+	   (as-c "#ifdef" cname)
+	   (printf "(cl:defconstant ~A %d \"~A\")" lispname doc
+		   cname)
+	   ;; XXX: do this?
+	   (unless dont-export
+	     (printf "(cl:export '~A)" lispname))
+	   (as-c "#else")
+	   (printf "(sb-int:style-warn \"Couldn't grovel for ~A (unknown to the C compiler).\")" cname)
+	   (as-c "#endif"))
+	  (:type
+	   (printf "(cl:eval-when (:compile-toplevel :load-toplevel :execute) (sb-alien:define-alien-type ~A (sb-alien:%ssigned %d)))" lispname
+		   (format nil "SIGNED_(~A)" cname)
+		   (format nil "(8*sizeof(~A))" cname)))
+	  (:string
+	   (printf "(cl:defparameter ~A %s \"~A\"" lispname doc
+		   cname))
+	  (:function
+	   (printf "(cl:declaim (cl:inline ~A))" lispname)
+	   (destructuring-bind (f-cname &rest definition) cname
+	     (printf "(sb-grovel::define-foreign-routine (\"~A\" ~A)" f-cname lispname)
+	     (printf "~{  ~W~^\\n~})" definition)))
+	  (:structure
+	   (c-for-structure lispname cname))
+	  (otherwise
+	   ;; should we really not sprechen espagnol, monsieurs?
+	   (error "Unknown grovel keyword encountered: ~A" type))
+	)))
+    (as-c "return 0;")
+    (as-c "}")))
 
 (defun c-constants-extract  (filename output-file package)
   (with-open-file (f output-file :direction :output :if-exists :supersede)
@@ -114,4 +152,3 @@
 			   (namestring tmp-a-dot-out)
 			   (namestring tmp-constants)) 0)
      (compile-file tmp-constants :output-file output-file))))
-


--- orig/contrib/sb-grovel/foreign-glue.lisp
+++ mod/contrib/sb-grovel/foreign-glue.lisp
@@ -13,149 +13,374 @@
   (&whole it (c-name lisp-name) return-type &rest args)
   (declare (ignorable c-name lisp-name return-type args))
   `(define-alien-routine ,@(cdr it)))
-#||
-(define-c-accessor FOO-PORT SOCKADDR-IN (ARRAY (UNSIGNED 8) 2) 2 2)
-(define-c-accessor SOCKADDR-IN-FAMILY SOCKADDR-IN INTEGER 6 2)
-||#
-;;; define-c-accessor makes us a setter and a getter for changing
-;;; memory at the appropriate offset
-
-;;;    (define-c-accessor STAT-ATIME STAT (INTEGER 32) 56 4)
-
-(defmacro define-c-accessor (el structure type offset length)
-  (declare (ignore structure))
-  (let* ((ty (cond
-	       ((eql type (intern "INTEGER"))
-		`(,type ,(* 8 length)))
-	       ((and (consp type) (eql (car type) (intern "*"))) ; pointer
-		`(unsigned ,(* 8 length)))
-	       ((eql type (intern "C-STRING")) ; c-string as array
-		`(base-char 8))
-	       ((and (consp type) (eql (car type) (intern "ARRAY")))
-		(cadr type))
-	       ((let ((type (sb-alien-internals:unparse-alien-type
-			     (sb-alien-internals:parse-alien-type type nil))))
-		  (cond
-		    ((consp type)
-		     (case (car type)
-		       (signed `(integer ,(cadr type)))
-		       (unsigned type)))
-		    (t (error "foo")))))))
-	 (sap-ref-? (intern (format nil "~ASAP-REF-~A"
-				    (if (member (car ty) '(INTEGER SIGNED))
-					"SIGNED-" "")
-				    (cadr ty))
-			    (find-package "SB-SYS"))))
-    (labels
-	((template (before after)
-	   `(let* ((addr
-		    (the (unsigned-byte ,sb-vm:n-machine-word-bits)
-		      (+ #.(ash 1 sb-vm:n-lowtag-bits)
-			 (logandc1 #.(1- (ash 1 sb-vm:n-lowtag-bits))
-				   (sb-kernel:get-lisp-obj-address ptr)))))
-		   (sap (sb-sys:int-sap
-			 (the (unsigned-byte ,sb-vm:n-machine-word-bits)
-			   (+ addr ,offset)))))
-		 (,before (,sap-ref-? sap index) ,after))))
-      `(progn
-	 ;;(declaim (inline ,el (setf ,el)))
-	 (defun ,el (ptr &optional (index 0))
-	   (declare (optimize (speed 3) (safety 0)))
-	   (sb-sys:without-gcing 
-	    ,(if (eql type (intern "C-STRING"))
-		 `(naturalize-bounded-c-string ptr ,offset ,length)
-		 (template 'prog1 nil))))
-	 (defconstant ,(intern (format nil "OFFSET-OF-~A" el)) ,offset)
-	 (defun (setf ,el) (newval ptr &optional (index 0))
-	   (declare (optimize (speed 3) (safety 0)))
-	   (sb-sys:without-gcing 
-	    ,(if (eql type (intern "C-STRING"))
-		 `(set-bounded-c-string ptr ,offset ,length newval)
-		 (template 'setf 'newval))))))))
-
-
-;;; make memory allocator for appropriately-sized block of memory, and
-;;; a constant to tell us how big it was anyway
-(defmacro define-c-struct (name size)
-  (labels ((p (x) (intern (concatenate 'string x (symbol-name name))
-			  (symbol-package name))))
+
+
+
+;;; strctures
+
+#| C structs need: the with-... interface.
+|#
+
+;;; global XXXs:
+#|
+ XXX: :distrust-length t fields are dangerous. they should only be at
+      the end of the structure (they mess up offset/size calculations)
+|#
+
+(defun reintern (symbol &optional (package *package*))
+  (if (symbolp symbol)
+      (intern (symbol-name symbol) package)
+      symbol))
+
+(defparameter alien-type-table (make-hash-table :test 'eql))
+(defparameter lisp-type-table (make-hash-table :test 'eql))
+
+(macrolet ((define-alien-types ((type size) &rest defns)
+	       `(progn
+		  ,@(loop for defn in defns
+			  collect (destructuring-bind (expected-type c-type lisp-type) defn
+				    `(progn
+				       (setf (gethash ',expected-type alien-type-table)
+					     (lambda (,type ,size)
+					       (declare (ignorable type size))
+					       ,c-type))
+				       (setf (gethash ',expected-type lisp-type-table)
+					     (lambda (,type ,size)
+					       (declare (ignorable type size))
+					       ,lisp-type))))))))
+  (define-alien-types (type size)
+      (integer (or (gethash size (symbol-value (intern "*INTEGER-SIZES*")))
+		   `(integer ,(* 8 size)))
+	       `(unsigned-byte ,(* 8 size)))
+      (unsigned `(unsigned ,(* 8 size))
+		`(unsigned-byte ,(* 8 size)))
+      (signed `(signed ,(* 8 size))
+	      `(signed-byte ,(* 8 size)))
+      (c-string `(array char ,size) 'cl:simple-string)
+      (c-string-pointer 'c-string 'cl:simple-string)
+      ;; TODO: multi-dimensional arrays, if they are ever needed.
+      (array (destructuring-bind (array-tag elt-type &optional array-size) type
+	       (declare (ignore array-tag))
+	       ;; XXX: use of EVAL.  alien-size is a macro,
+	       ;; unfortunately; and it will only accept unquoted type
+	       ;; forms.
+	       `(sb-alien:array ,elt-type ,(or array-size
+				  (/ size (eval `(sb-alien:alien-size ,elt-type :bytes))))))
+	     `(vector t))))
+
+(defun retrieve-type-for (type size table)
+  (multiple-value-bind (type-fn found)
+      (gethash (reintern (typecase type
+			   (list (first type))
+			   (t    type))
+			 (find-package '#:sb-grovel))
+	       table)
+    (values
+     (if found
+	 (funcall (the function type-fn) type size)
+	 type)
+     found)))
+
+(defun alien-type-for (type size)
+  (reintern (retrieve-type-for type size alien-type-table)))
+
+(defun lisp-type-for (type size)
+  (multiple-value-bind (val found)
+      (retrieve-type-for type size lisp-type-table)
+    (if found
+	val
+	t)))
+
+
+(defun mk-padding (len offset)
+  (make-instance 'padding
+		 :type `(array char ,len)
+		 :offset offset
+		 :size len
+		 :name (gensym "PADDING")))
+(defun mk-struct (offset &rest children)
+  (make-instance 'struct :name (gensym "STRUCT")
+		 :children (remove nil children)
+		 :offset offset))
+(defun mk-union (offset &rest children)
+  (make-instance 'union :name (gensym "UNION")
+		 :children (remove nil children)
+		 :offset offset))
+(defun mk-val (name type h-type offset size)
+  (declare (ignore h-type))
+  (make-instance 'value-slot :name name
+		 :size size
+		 :offset offset
+		 :type type))
+
+;;; struct tree classes
+
+(defclass slot ()
+  ((offset :initarg :offset :reader offset)
+   (name :initarg :name :reader name)))
+
+(defclass structured-type (slot)
+  ((children :initarg :children :accessor children)))
+
+(defclass union (structured-type)
+  ())
+
+(defclass struct (structured-type)
+  ())
+
+(defclass value-slot (slot)
+  ((size :initarg :size :reader size)
+   (type :initarg :type :reader type)))
+
+(defclass padding (value-slot)
+  ())
+
+(defmethod print-object ((o value-slot) s)
+  (print-unreadable-object (o s :type t)
+    (format s "~S ~A+~A=~A" (name o) (offset o) (size o) (slot-end o))))
+
+(defmethod print-object ((o structured-type) s)
+  (print-unreadable-object (o s :type t)
+    (format s "~S ~A" (name o) (children o))))
+
+(defmethod size ((slot structured-type))
+  (let ((min-offset (offset slot)))
+    (if (null (children slot))
+	0
+	(reduce #'max (mapcar (lambda (child)
+				(+ (- (offset child) min-offset) (size child)))
+			      (children slot))
+		:initial-value 0))))
+
+(defgeneric slot-end (slot))
+(defmethod slot-end ((slot slot))
+  (+ (offset slot) (size slot)))
+
+(defun overlap-p (elt1 elt2)
+  (unless (or (zerop (size elt1))
+	      (zerop (size elt2)))
+    (or
+     (and (<= (offset elt1)
+	      (offset elt2))
+	  (< (offset elt2)
+	     (slot-end elt1)))
+     (and (<= (offset elt2)
+	      (offset elt1))
+	  (< (offset elt1)
+	     (slot-end elt2))))))
+
+(defgeneric find-overlaps (root new-element))
+(defmethod find-overlaps ((root structured-type) new-element)
+  (when (overlap-p root new-element)
+    (let ((overlapping-elts (loop for child in (children root)
+				  for overlap = (find-overlaps child new-element)
+				  when overlap
+				     return overlap)))
+      (cons root overlapping-elts))))
+
+(defmethod find-overlaps ((root value-slot) new-element)
+  (when (overlap-p root new-element)
+    (list root)))
+
+(defgeneric pad-to-offset-of (to-pad parent))
+  (macrolet ((skel (end-form)
+	     `(let* ((end ,end-form)
+		     (len (abs (- (offset to-pad) end))))
+		(cond
+		  ((= end (offset to-pad)) ; we are at the right offset.
+		   nil)
+		  (t		        ; we have to pad between the
+					; old slot's end and the new
+					; slot's offset
+		   (mk-padding len end))))))
+  
+  (defmethod pad-to-offset-of (to-pad (parent struct))
+    (skel (if (null (children parent))
+	      0
+	      (+ (size parent) (offset parent)))))
+  (defmethod pad-to-offset-of (to-pad (parent union))
+    (skel (if (null (children parent))
+	      (offset to-pad)
+	      (offset parent)))))
+
+(defgeneric replace-by-union (in-st element new-element))
+(defmethod replace-by-union ((in-st struct) elt new-elt)
+  (setf (children in-st) (remove elt (children in-st)))
+  (let ((padding (pad-to-offset-of new-elt in-st)))
+    (setf (children in-st)
+	  (nconc (children in-st)
+		 (list (mk-union (offset elt)
+				 elt
+				 (if padding
+				     (mk-struct (offset elt)
+						padding
+						new-elt)
+				     new-elt)))))))
+
+(defmethod replace-by-union ((in-st union) elt new-elt)
+  (let ((padding (pad-to-offset-of new-elt in-st)))
+    (setf (children in-st)
+	  (nconc (children in-st)
+		 (list (if padding
+			   (mk-struct (offset in-st)
+				      padding
+				      new-elt)
+			   new-elt))))))
+
+(defgeneric insert-element (root new-elt))
+(defmethod insert-element ((root struct) (new-elt slot))
+  (let ((overlaps (find-overlaps root new-elt)))
+    (cond
+      (overlaps (let ((last-structure (first (last overlaps 2)))
+		      (last-val (first (last overlaps))))
+		  (replace-by-union last-structure last-val new-elt)
+		  root))
+      (t
+       (let ((padding (pad-to-offset-of new-elt root)))
+	 (setf (children root)
+	       (nconc (children root)
+		      (when padding (list padding))
+		      (list new-elt)))))))
+  root)
+
+(defun sane-slot (alien-var &rest slots)
+  "Emulates the SB-ALIEN:SLOT interface, with useful argument order for
+deeply nested structures."
+  (labels ((rewriter (slots)
+	     (if (null slots)
+		 alien-var
+		 `(sb-alien:slot ,(rewriter (rest slots))
+				 ',(first slots)))))
+    (rewriter slots)))
+
+(defgeneric accessor-modifier-for (element-type accessor-type))
+
+(defun identity-1 (thing &rest ignored)
+  (declare (ignore ignored))
+  thing)
+(defun (setf identity-1) (new-thing place &rest ignored)
+  (declare (ignore ignored))
+  (setf place new-thing))
+
+(defmethod accessor-modifier-for (element-type (accessor-type (eql :getter)))
+  'identity-1)
+(defmethod accessor-modifier-for ((element-type (eql 'C-STRING))
+				  (accessor-type (eql :getter)))
+  'c-string->lisp-string)
+(defmethod accessor-modifier-for (element-type (accessor-type (eql :setter)))
+  nil)
+(defmethod accessor-modifier-for ((element-type (eql 'C-STRING))
+				  (accessor-type (eql :setter)))
+  'c-string->lisp-string)
+(defmethod accessor-modifier-for ((element-type (eql 'C-STRING))
+				  (accessor-type (eql :getter)))
+  'c-string->lisp-string)
+
+(defun c-string->lisp-string (string &optional limit)
+  (declare (ignore limit))
+  (cast string c-string))
+
+(defun (setf c-string->lisp-string) (new-string alien &optional limit)
+  (declare (string new-string))
+  (let* ((upper-bound (or limit (1+ (length new-string))))
+	 (last-elt (min (1- upper-bound) (length new-string))))
+    (loop for i upfrom 0 below last-elt
+	  for char across new-string
+	  do (setf (deref alien i) (char-code char)))
+    (setf (deref alien last-elt) 0)
+    (subseq new-string 0 last-elt)))
+
+(defgeneric accessors-for (struct-name element path))
+(defmethod accessors-for (struct-name (root structured-type) path)
+  nil)
+
+
+(defmethod accessors-for (struct-name (root value-slot) path)
+  (let ((rpath (reverse path))
+	(accessor-name (format nil "~A-~A"
+			       (symbol-name struct-name)
+			       (symbol-name (name root)))))
+    (labels ((accessor (root rpath)
+	       (apply #'sane-slot 'struct (mapcar 'name (append (rest rpath) (list root))))))
+      `((defun ,(intern accessor-name) (struct)
+	  (declare (type (alien ,struct-name) struct)
+		   (optimize (speed 3)))
+	  (,(accessor-modifier-for (reintern (type root) (find-package :sb-grovel))
+				   :getter)
+	    ,(accessor root rpath) ,(size root)))
+	(defun (setf ,(intern accessor-name)) (new-val struct)
+	  (declare (type (alien ,struct-name) struct)
+		   (type ,(lisp-type-for (type root) (size root)) new-val)
+		   (optimize (speed 3)))
+	  ,(let* ((accessor-modifier (accessor-modifier-for (reintern (type root)
+								      (find-package :sb-grovel))
+							    :setter))
+		  (modified-accessor (if accessor-modifier
+					 `(,accessor-modifier ,(accessor root rpath) ,(size root))
+					 (accessor root rpath))))
+	     
+	     `(setf ,modified-accessor new-val)))
+	(defconstant ,(intern (format nil "OFFSET-OF-~A" accessor-name))
+	  ,(offset root))))))
+
+
+
+(defmethod accessors-for (struct (root padding) path)
+  nil)
+
+(defgeneric generate-struct-definition (struct-name root path))
+(defmethod generate-struct-definition (struct-name (root structured-type) path)
+  (let ((naccessors (accessors-for struct-name root path))
+	(nslots nil))
+    (dolist (child (children root))
+      (multiple-value-bind (slots accessors)
+	  (generate-struct-definition struct-name child (cons root path))
+	(setf nslots (nconc nslots slots))
+	(setf naccessors (nconc naccessors accessors))))
+    (values `((,(name root) (,(type-of root) ,(name root) ,@nslots)))
+	    naccessors)))
+
+(defmethod generate-struct-definition (struct-name (root value-slot) path)
+  (values `((,(name root) ,(alien-type-for (type root) (size root))))
+	  (accessors-for struct-name root path)))
+
+(defmacro define-c-struct (name size &rest elements)
+  (multiple-value-bind (struct-elements accessors)
+      (let* ((root (make-instance 'struct :name name :children nil :offset 0)))
+	(loop for e in (sort elements #'< :key #'fourth)
+	      do (insert-element root (apply 'mk-val e))
+	      finally (return root))
+	(setf (children root)
+	      (nconc (children root)
+		     (list
+		      (mk-padding (max 0 (- size
+					    (size root)))
+				  (size root)))))
+	(generate-struct-definition name root nil))
     `(progn
-      (defun ,(p "ALLOCATE-") () (make-array ,size :initial-element 0
-					     :element-type '(unsigned-byte 8)))
-      (defconstant ,(p "SIZE-OF-") ,size)
-      (deftype ,name () '(simple-array (unsigned-byte 8) (,size)))
-      (defun ,(p "FREE-" ) (p) (declare (ignore p)))
-      (defmacro ,(p "WITH-") (var (&rest field-values) &body body)
+       (eval-when (:compile-toplevel :load-toplevel :execute)
+	 (sb-alien:define-alien-type ,@(first struct-elements)))
+       ,@accessors
+       (defmacro ,(intern (format nil "WITH-~A" name)) (var (&rest field-values) &body body)
 	(labels ((field-name (x)
 			     (intern (concatenate 'string
 						  (symbol-name ',name) "-"
 						  (symbol-name x))
 				     ,(symbol-package name))))
-	  (append `(let ((,var ,'(,(p "ALLOCATE-")))))
-		  (mapcar (lambda (pair)
-			    `(setf (,(field-name (car pair)) ,var) ,(cadr pair)))
-			  field-values)
-		  body))))))
+	  `(let ((,var ,'(,(intern (format nil "ALLOCATE-~A" name)))))
+	     (unwind-protect
+		 (progn
+		   (progn ,@(mapcar (lambda (pair)
+				      `(setf (,(field-name (first pair)) ,var) ,(second pair)))
+				    field-values))
+		   ,@body)
+	       (funcall ',',(intern (format nil "FREE-~A" name)) ,var)))))
+       (defconstant ,(intern (format nil "SIZE-OF-~A" name)) ,size)
+       (defun ,(intern (format nil "ALLOCATE-~A" name)) ()
+	 (sb-alien:make-alien ,name))
+       (defun ,(intern (format nil "FREE-~A" name)) (o)
+	 (sb-alien:free-alien o)))))
 
 (defun foreign-nullp (c)
   "C is a pointer to 0?"
-  (= 0 (sb-sys:sap-int (sb-alien:alien-sap  c))))
-
-;;; this could be a lot faster if I cared enough to think about it
-(defun foreign-vector (pointer size length)
-  "Compose a vector of the words found in foreign memory starting at
-POINTER.  Each word is SIZE bytes long; LENGTH gives the number of
-elements of the returned vector.  See also FOREIGN-VECTOR-UNTIL-ZERO"
-  (assert (= size 1))
-  (let ((ptr
-	 (typecase pointer
-	   (sb-sys:system-area-pointer
-	    (sap-alien pointer (* (sb-alien:unsigned 8))))
-	   (t
-	    (sb-alien:cast pointer (* (sb-alien:unsigned 8))))))
-	(result (make-array length :element-type '(unsigned-byte 8))))
-    (loop for i from 0 to (1- length) by size
-	  do (setf (aref result i) (sb-alien:deref ptr i)))
-    result))
-
-(defun naturalize-bounded-c-string (pointer offset &optional max-length)
-  "Return the 0-terminated string starting at (+ POINTER OFFSET) with
-maximum length MAX-LENGTH, as a lisp object."
-  (let* ((ptr
-	  (typecase pointer
-	    (sb-sys:system-area-pointer
-	     (sap-alien (sb-sys:sap+ pointer offset) (* sb-alien:char)))
-	    (t
-	     (sap-alien (sb-sys:sap+ (alien-sap pointer) offset) (* sb-alien:char)))))
-	 (length (loop for i upfrom 0
- 		       until (or (and max-length
-				      (= i (1- max-length)))
-				 (= (sb-alien:deref ptr i) 0))
- 		       finally (return i)))
-	 (result (make-string length
-			      :element-type 'base-char)))
-    (sb-kernel:copy-from-system-area (alien-sap ptr) 0
-				     result (* sb-vm:vector-data-offset
-					       sb-vm:n-word-bits)
-				     (* length sb-vm:n-byte-bits))
-    result))
-
-(defun set-bounded-c-string (pointer offset max-length value)
-  "Set the range from POINTER + OFFSET to at most POINTER + OFFSET +
-MAX-LENGTH to the string contained in VALUE."
-  (assert (numberp max-length) nil
-	  "Structure field must have a grovelable maximum length.")
-  (assert (< (length value) max-length))
-  (let* ((ptr
-	  (typecase pointer
-	    (sb-sys:system-area-pointer
-	     (sap-alien (sb-sys:sap+ pointer offset) (* sb-alien:char)))
-	    (t
-	     (sap-alien (sb-sys:sap+ (alien-sap pointer) offset) (* sb-alien:char)))))
-	 (length (length value)))
-    (sb-kernel:copy-to-system-area value (* sb-vm:vector-data-offset
-					     sb-vm:n-word-bits)
-				   (alien-sap ptr) 0
-				   (* length sb-vm:n-byte-bits))
-    (setf (sb-alien:deref ptr length) 0)
-    value))
+  (null-alien c))
\ No newline at end of file


--- orig/contrib/sb-grovel/sb-grovel.asd
+++ mod/contrib/sb-grovel/sb-grovel.asd
@@ -9,8 +9,7 @@
     #+sb-building-contrib "SYS:CONTRIB;SB-GROVEL;"
     :components ((:file "defpackage")
 		 (:file "def-to-lisp" :depends-on ("defpackage"))
-		 (:file "foreign-glue" :depends-on ("defpackage"))
-		 (:file "array-data" :depends-on ("defpackage"))))
+		 (:file "foreign-glue" :depends-on ("defpackage"))))
 
 (defmethod perform :after ((o load-op) (c (eql (find-system :sb-grovel))))
   (provide 'sb-grovel))


--- orig/contrib/sb-posix/constants.lisp
+++ mod/contrib/sb-posix/constants.lisp
@@ -303,10 +303,7 @@
 	      (tcflag-t oflag "tcflag_t" "c_oflag")
 	      (tcflag-t cflag "tcflag_t" "c_cflag")
 	      (tcflag-t lflag "tcflag_t" "c_lflag")
-	      ;; Uh, so what's the point of grovelling CC-T if I can't
-	      ;; use it here?  the c_cc field is an array of NCCS
-	      ;; elements of type cc_t.  FIXME
-	      ((array (unsigned 8)) cc "cc_t" "c_cc")))
+	      ((array cc-t) cc "cc_t" "c_cc")))
  
  (:integer veof "VEOF")
  (:integer veol "VEOL")


--- orig/contrib/sb-posix/interface.lisp
+++ mod/contrib/sb-posix/interface.lisp
@@ -74,7 +74,7 @@
       (fcntl-without-arg fd cmd)))
 
 (define-call "opendir" (* t) null-alien (pathname filename))
-(define-call "readdir" (* t)
+(define-call "readdir" sb-posix::dirent
   ;; readdir() has the worst error convention in the world.  It's just
   ;; too painful to support.  (return is NULL _and_ errno "unchanged"
   ;; is not an error, it's EOF).
@@ -148,31 +148,25 @@
       (export ',lisp-name :sb-posix)
       (declaim (inline ,lisp-name))
       (defun ,lisp-name (,arg &optional stat)
-	(declare (type (or null sb-posix::stat) stat))
+	(declare (type (or null (sb-alien:alien (* sb-posix::stat))) stat))
 	(unless stat
 	  (setq stat (sb-posix::allocate-stat)))
 	;; FIXME: Hmm.  WITH-PINNED-OBJECTS/WITHOUT-GCING or something
 	;; is probably needed round here.
-	(let* ((s (sb-sys:int-sap
-		   ;; FIXME: WILL NOT WORK ON 64-BIT LISP.  VECTOR-SAP
-		   ;; would be better if the STAT object were
-		   ;; guaranteed to be a vector, but it's not (and may
-		   ;; well turn into an alien soon).
-		   (+ 8 (logandc2 (sb-kernel:get-lisp-obj-address stat) 7))))
-	       (r (alien-funcall
-		   (extern-alien ,name ,type)
-		   (,designator-fun ,arg)
-		   s)))
+	(let ((r (alien-funcall
+		  (extern-alien ,name ,type)
+		  (,designator-fun ,arg)
+		  stat)))
 	  (when (minusp r)
 	    (syscall-error)))
-	stat))))
+	  stat))))
+
 (define-stat-call "stat" pathname sb-posix::filename
-		  ;; FIXME: (* T)?  Ew.  (* STAT) would be preferable
-		  (function int c-string (* t)))
+		  (function int c-string (* sb-posix::stat)))
 (define-stat-call "lstat" pathname sb-posix::filename
-		  (function int c-string (* t)))
+		  (function int c-string (* sb-posix::stat)))
 (define-stat-call "fstat" fd sb-posix::file-descriptor
-		  (function int int (* t)))
+		  (function int int (* sb-posix::stat)))
 
 
 ;;; mode flags
@@ -202,16 +196,9 @@
 (declaim (inline sb-posix::tcsetattr))
 (defun sb-posix::tcsetattr (fd actions termios)
   (let ((fd (sb-posix::file-descriptor fd)))
-    (let* ((s (sb-sys:int-sap
-	       ;; FIXME: WILL NOT WORK ON 64-BIT LISP.  VECTOR-SAP would
-	       ;; be better if the STAT object were guaranteed to be a
-	       ;; vector, but it's not (and may well turn into an alien
-	       ;; soon).
-	       (+ 8 (logandc2 (sb-kernel:get-lisp-obj-address termios) 7))))
-	   (r (alien-funcall
-	       ;; it's the old (* T) problem again :-(
-	       (extern-alien "tcsetattr" (function int int int (* t)))
-	       fd actions s)))
+    (let* ((r (alien-funcall
+	       (extern-alien "tcsetattr" (function int int int sb-posix::termios))
+	       fd actions termios)))
       (when (minusp r)
 	(syscall-error)))
     (values)))
@@ -220,18 +207,10 @@
 (defun sb-posix::tcgetattr (fd &optional termios)
   (unless termios
     (setq termios (sb-posix::allocate-termios)))
-  	;; FIXME: Hmm.  WITH-PINNED-OBJECTS/WITHOUT-GCING or something
-	;; is probably needed round here.
-  (let* ((s (sb-sys:int-sap
-	     ;; FIXME: WILL NOT WORK ON 64-BIT LISP.  VECTOR-SAP would
-	     ;; be better if the STAT object were guaranteed to be a
-	     ;; vector, but it's not (and may well turn into an alien
-	     ;; soon).
-	     (+ 8 (logandc2 (sb-kernel:get-lisp-obj-address termios) 7))))
-	 (r (alien-funcall
-	     (extern-alien "tcgetattr" (function int int (* t)))
-	     (sb-posix::file-descriptor fd)
-	     s)))
+  (let ((r (alien-funcall
+	    (extern-alien "tcgetattr" (function int int sb-posix::termios))
+	    (sb-posix::file-descriptor fd)
+	    termios)))
     (when (minusp r)
       (syscall-error)))
   termios)



