diff --git a/code/c-call.lisp b/code/c-call.lisp
index 4844c8cd9bd672a7fc87a1909e5d8be61af60aa4..3363634239d722176f2eaf7ceef8e4e4c8eee4a9 100644
--- a/code/c-call.lisp
+++ b/code/c-call.lisp
@@ -422,6 +422,8 @@
 (def-c-type long (signed-byte 32))
 (def-c-type unsigned-long (unsigned-byte 32))
 
+(def-c-pointer *char char)
+
 
 
 (defstruct (routine-info
@@ -434,6 +436,9 @@
   (name "" :type string)
   (function-name nil :type symbol)
   ;;
+  ;; List of all the doc strings.
+  docs
+  ;;
   ;; The number of words of arguments.
   (arg-size 0 :type unsigned-byte)
   ;;
@@ -499,8 +504,8 @@
       (setf (arg-info-allocation arg) :stack)
       (setf (arg-info-offset arg) offset)
       (let ((size (if (eq (arg-info-mode arg) :in)
-		      (c-sizeof 'system-area-pointer)
-		      (c-type-size (arg-info-type arg)))))
+		      (c-type-size (arg-info-type arg))
+		      (c-sizeof 'system-area-pointer))))
 	(setf offset (align-offset (+ offset size)
 				   (find-alignment size)))))
     (setf (routine-info-arg-size info) offset))
@@ -686,22 +691,27 @@
 	  (t
 	   (error "Malformed routine name specification: ~S." name)))
 
-    (let ((arg-info ()))
+    (let ((docs ())
+	  (arg-info ()))
       (dolist (spec specs)
-	(unless (and (listp spec) (>= (length spec) 2))
-	  (error "Bad argument spec: ~S." spec))
-	(let ((arg-name (first spec))
-	      (arg-type (get-c-type (second spec)))
-	      (mode (or (third spec) :in))
-	      (options (cdddr spec)))
-	  (when (oddp (length options))
-	    (error "Odd number of options in ~S." spec))
-	  (unless (symbolp arg-name)
-	    (error "Arg name is not a symbol: ~S." arg-name))
-	  (push (make-arg-info :name arg-name :type arg-type
-			       :mode mode :options options)
-		arg-info)))
-
+	(cond ((stringp spec)
+	       (push spec docs))
+	      ((and (listp spec) (>= (length spec) 2))
+	       (let ((arg-name (first spec))
+		     (arg-type (get-c-type (second spec)))
+		     (mode (or (third spec) :in))
+		     (options (cdddr spec)))
+		 (when (oddp (length options))
+		   (error "Odd number of options in ~S." spec))
+		 (unless (symbolp arg-name)
+		   (error "Arg name is not a symbol: ~S." arg-name))
+		 (push (make-arg-info :name arg-name :type arg-type
+				      :mode mode :options options)
+		       arg-info)))
+	      (t
+	       (error "Bad argument spec: ~S." spec))))
+
+      (setf (routine-info-docs info) (nreverse docs))
       (setf (routine-info-args info) (nreverse arg-info)))
 
     (unless (eq return-type 'void)
@@ -724,8 +734,11 @@
 		(funcall (routine-info-return-coerce-generator info)
 			 call-form)))
 	`(progn
-	   ,@top-level-forms
+	   (compiler-let ((*alien-eval-when* '(compile eval)))
+	     ,@top-level-forms)
 	   (defun ,(routine-info-function-name info) ,lisp-args
+	     ,@(or (routine-info-docs info)
+		   (list (make-doc-string info)))
 	     (declare (optimize (speed 3) (safety 0)))
 	     (with-stack-alien (stack ,(routine-info-stack-record info)
 				      ,(routine-info-arg-size info))
@@ -741,280 +754,6 @@
 			 `((values ,call-form
 				   ,@result-get-forms)))))))))))
 
-#|
-
-    (let ((*output-forms* ()))
-      (allocate-arguments info)
-      (multiple-value-bind (arg-names stores value-names values binds)
-			   (access-arguments info)
-	`(progn
-	   (compiler-let ((*alien-eval-when* '(compile eval)))
-	     ,@(nreverse *output-forms*))
-	   (defun ,(routine-info-function-name info) ,arg-names
-	     ,(make-doc-string info value-names)
-	     (alien-bind (,@(when (routine-info-arg-alien info)
-			      `((args ,(routine-info-arg-alien info))))
-			    ,@(when (routine-info-result-alien info)
-				`((results ,(routine-info-result-alien info)))))
-			 ,@stores
-		(let ((return-value
-		       (%primitive call-foreign
-				   ,(routine-info-code info)
-				   ,(if (routine-info-arg-alien info)
-					'(alien-sap (alien-value args)) 0)
-				   ,(truncate (+ (routine-info-arg-size info)
-						 31) 32))))
-		  return-value
-		  (let* ,binds
-		    (values
-		     ,@(when (routine-info-return-type info)
-			 `(,(coerce-from-integer (routine-info-return-type info)
-						 'return-value)))
-		     ,@values))))))))))
-
-
-;;; Allocate-Argument, Allocate-Result  --  Internal
-;;;
-;;;    Allocate storage for an argument of the specified Type for the routine
-;;; specified by Info.  Name is the name of the argument.  Stuff is pushed onto
-;;; *Output-Forms* as needed.  Allocate-Result is the same except that it
-;;; allocates stuff in the result Alien.
-;;;
-(proclaim '(ftype (function (routine-info c-type symbol) symbol)
-		  allocate-argument allocate-result))
-(defun allocate-argument (info type name)
-  (multiple-value-bind (operator size)
-		       (allocate-field (routine-info-arg-alien info)
-				       (routine-info-arg-size info)
-				       type name)
-    (setf (routine-info-arg-size info) size)
-    operator))
-;;;
-(defun allocate-result (info type name)
-  (multiple-value-bind (operator size)
-		       (allocate-field (routine-info-result-alien info)
-				       (routine-info-result-size info)
-				       type name)
-    (setf (routine-info-result-size info) size)
-    operator))
-
-;;; Allocate-Field  --  Internal
-;;;
-;;;    Pad Size up to the next 32 bit boundry, then create an operator that
-;;; accesses a field of the specified type.  We return the operator name and
-;;; the new amount of stuff allocated.
-;;;
-(proclaim '(function allocate-field (symbol unsigned-byte c-type symbol)
-		     (values symbol unsigned-byte)))
-(defun allocate-field (alien size type name)
-  (let ((base (align-offset size 32))
-	(opname (symbolicate alien "-" name))
-	(ctsize (c-type-size type)))
-    (unless ctsize
-      (error "Cannot pass variable size argument: ~S." type))
-    (if (< ctsize 32)
-	(incf base (- 32 ctsize)))
-    (push `(defoperator (,opname ,(c-type-description type))
-			((alien ,alien))
-	     `(alien-index (alien-value ,alien) ,,base
-			   ,,ctsize))
-	  *output-forms*)
-    (values opname (+ ctsize base))))
-
-
-;;; Allocate-Arguments  --  Internal
-;;;
-;;;    Allocate operators and Aliens for the arguments and results.
-;;;
-(proclaim '(function allocate-arguments (routine-info) void))
-(defun allocate-arguments (info)
-  (let ((name (routine-info-function-name info)))
-    (setf (routine-info-arg-alien info) (symbolicate name "-args"))
-    (setf (routine-info-result-alien info) (symbolicate name "-results")))
-
-  (dolist (arg (routine-info-args info))
-    (let ((type (arg-info-type arg))
-	  (name (arg-info-name arg)))
-      (setf (arg-info-operator arg)
-	    (allocate-argument info type name))
-      (ecase (arg-info-mode arg)
-	(:in)
-	((:copy :in-out :out)
-	 (unless (pointer-type-p type)
-	   (error "~S argument ~S, has non-pointer type."
-		  (arg-info-mode arg) name))
-	 (setf (arg-info-result-operator arg)
-	       (allocate-result info (pointer-type-to type) name))
-	 (push `(setf (alien-access (,(arg-info-operator arg)
-				     ,(routine-info-arg-alien info))
-				    'system-area-pointer)
-		      (alien-sap (,(arg-info-result-operator arg)
-				  ,(routine-info-result-alien info))))
-	       *output-forms*)))))
-
-  (macrolet ((foo (s n)
-	       `(cond ((zerop (,s info))
-		       (setf (,n info) nil))
-		      (t
-		       (setq *output-forms*
-			     (nconc *output-forms*
-				    `((defalien ,(,n info) ,(,n info) ,(,s info)))))))))
-    (foo routine-info-arg-size routine-info-arg-alien)
-    (foo routine-info-result-size routine-info-result-alien)))
-
-
-;;; Access-Arguments  --  Internal
-;;;
-;;;    Return stuff to access the argument in a call to the routine specified
-;;; by Info.  Values:
-;;;
-;;; 1] A list of the input argument names.
-;;; 2] A list of input arg storing forms.
-;;; 3] A list of the names of the result values.
-;;; 4] A list of result value forms.
-;;; 5] A list of let* bindings to make around the value forms.
-;;;
-(proclaim '(function access-arguments (routine-info)
-		     (values list list list list)))
-(defun access-arguments (info)
-  (let ((arg-names ())
-	(stores ())
-	(value-names ())
-	(values ())
-	(binds ()))
-    (dolist (arg (routine-info-args info))
-      (let ((mode (arg-info-mode arg)))
-	(when (eq mode :in)
-	  (multiple-value-bind (form names)
-			       (access-one-value
-				(arg-info-type arg)
-				:write
-				`(,(arg-info-operator arg) (alien-value args))
-				(arg-info-name arg))
-	    (setq arg-names (nconc arg-names names))
-	    (setq stores (nconc stores (list form)))))
-
-	(when (member mode '(:copy :in-out))
-	  (multiple-value-bind (form names)
-			       (access-one-value
-				(pointer-type-to (arg-info-type arg))
-				:write
-				`(,(arg-info-result-operator arg) (alien-value results))
-				(arg-info-name arg))
-	    (setq arg-names (nconc arg-names names))
-	    (setq stores (nconc stores (list form)))))
-
-	(when (member mode '(:out :in-out))
-	  (multiple-value-bind (forms names b)
-			       (access-one-value
-				(pointer-type-to (arg-info-type arg))
-				:read
-				`(,(arg-info-result-operator arg) (alien-value results))
-				(arg-info-name arg))
-	    (setq value-names (nconc value-names names))
-	    (setq values (nconc values forms))
-	    (setq binds (nconc binds b))))))
-
-    (values arg-names stores value-names values binds)))
-
-
-;;; Access-One-Value  --  Internal
-;;;
-;;;    Read or write an alien value that is described by a c-type.
-;;; Type	- The C-Type of the field to be accessed.
-;;; Kind	- :read or :write
-;;; Alien	- The Alien expression for the place to access.
-;;; Name	- The name of the field to access.  If :Write, this variable is
-;;;		  bound to the value to store.
-;;;
-;;; Returns values:
-;;;  1] If :read, a list of forms which are to be the values for the arg
-;;;     If :write, a form which does the store.
-;;;  2] A list of the names of the values produced or arguments used.  In
-;;;     the :read case, this is really just documentation.
-;;;  3] If :read, a list of let* binding forms to make around the code.
-;;;
-(proclaim '(function access-one-value (c-type (member :read :write) t symbol)
-		     (values list list list)))
-(defun access-one-value (type kind alien name)
-  (typecase type
-    (primitive-type
-     (values (if (eq kind :read)
-		 `((alien-access ,alien))
-		 `(setf (alien-access ,alien) ,name))
-	     `(,name)))
-    (pointer-type
-     (values (if (eq kind :read)
-		 `((alien-access ,alien 'alien))
-		 `(setf (alien-access ,alien 'system-area-pointer) ,name))
-	     `(,name)))
-    (t
-     (values (if (eq kind :read)
-		 `((copy-alien ,alien))
-		 `(alien-assign ,alien ,name))
-	     `(,name)))))
-
-
-;;; Coerce-From-Integer  --  Internal
-;;;
-;;;    Return a form that converts a 32bit signed integer into the kind of
-;;; object specified by Type.
-;;;
-(proclaim '(function coerce-from-integer (c-type t) t))
-(defun coerce-from-integer (type value)
-  (typecase type
-    (primitive-type
-     (let ((desc (c-type-description type)))
-       (if (atom desc)
-	   (case desc
-	     (port value)
-	     (boolean `(not (zerop ,value)))
-	     (string-char `(code-char ,value))
-	     (system-area-pointer `(int-sap ,value))
-	     (short-float `(int-sap
-			    (logior (ash ,value (- clc::short-float-shift-16))
-				    (ash clc::short-float-4bit-type
-					 (- 32 clc::short-float-shift-16)))))
-	     (t
-	      (error "Don't know how to hack ~S return type." desc)))
-	   (case (first desc)
-	     (signed-byte value)
-	     (unsigned-byte
-	      (if (> (second desc) 31)
-		  `(ldb (byte 32 0) ,value)
-		  value))
-	     (enumeration
-	      (let ((info (get (cadr desc) 'enumeration-info)))
-		(when (null info)
-		  (error "~S is not a defined enumeration." desc))
-		(ecase (enumeration-info-kind info)
-		  (:vector
-		   `(svref ,(enumeration-info-to info)
-			   (+ ,(enumeration-info-offset info) ,value)))
-		  (`(cdr (assoc ,value) ,(enumeration-info-to info))))))
-	     (t
-	      (error "Don't know how to hack ~S return type." desc))))))
-    (pointer-type
-     (let ((to (pointer-type-to type)))
-       (unless (c-type-size to)
-	 (error "Cannot return pointer to unknown size object."))
-       (let ((tds (c-type-description to)))
-	 (if (or (eq tds 'null-terminated-string)
-		 (and (listp tds) (eq (car (the list tds))
-				      'null-terminated-string)))
-	     `(if (eq ,value 0) NIL
-		  (let ((av (lisp::make-alien-value (int-sap ,value) 0
-						    ,(c-type-size to)
-						    ',tds)))
-		    (alien-bind ((s av ,tds))
-		      (alien-access (alien-value s)))))
-	     `(if (eq ,value 0) NIL
-		  (lisp::make-alien-value (int-sap ,value) 0 ,(c-type-size to)
-					  ',tds))))))
-    (t
-     (error "Don't know how to hack ~S return type." type))))
-
-|#
 
 
 ;;; Make-Doc-String  --  Internal
@@ -1022,10 +761,15 @@
 ;;;    Make a doc string for the interface routine described by Info.  Values
 ;;; is a list of the names of the by-reference return values.
 ;;;
-(proclaim '(function make-doc-string (routine-info list) string))
-(defun make-doc-string (info values)
+(proclaim '(function make-doc-string (routine-info) string))
+(defun make-doc-string (info)
   (let ((*print-pretty* t)
-	(*print-case* :downcase))
+	(*print-case* :downcase)
+	(values (mapcar #'arg-info-name
+			(remove-if-not #'(lambda (mode)
+					   (member mode '(:out :in-out)))
+				       (routine-info-args info)
+				       :key #'arg-info-mode))))
     (format nil "Interface to foreign routine ~S~:[; returns no values.~;~
 	    ~:*, return values:~%  ~A~]"
 	    (routine-info-name info)
@@ -1041,16 +785,38 @@
 
 (defmacro def-c-variable (name type)
   "Defines a foreign variable so that it is available from Lisp.
-  Name should be a string with the name of the foreign variable and
-  type is the foreign type of the variable."
-  (let* ((symbol (intern (string-upcase name)))
-	 (c-info (get-c-type type))
-	 (c-type (if (primitive-type-p c-info)
-		     (c-type-description c-info)
-		     type))
-	 (c-size (c-type-size c-info)))
-    `(defalien ,symbol ,c-type ,c-size
-       (%primitive c::foreign-symbol-address ',name))))
+  Name should either be a string with the name of the foreign variable or
+  a list of the string and the symbol to use as the alien variable. 
+  Type is the foreign type of the variable."
+  (multiple-value-bind
+      (symbol name)
+      (cond ((stringp name)
+	     (values (intern (string-upcase name))
+		     name))
+	    ((and (consp name) (= (length name) 2)
+		  (stringp (car name)) (symbolp (cadr name)))
+	     (values (cadr name) (car name)))
+	    (t
+	     (error "Bogus name for def-c-variable: ~S.~%~
+	     Should be either a string or a list of a string and symbol."
+		    name)))
+    (let* ((c-info (get-c-type type))
+	   (c-type (if (primitive-type-p c-info)
+		       (c-type-description c-info)
+		       type))
+	   (c-size (c-type-size c-info)))
+      `(progn
+	 (defparameter ,symbol
+	   (make-alien ',type ,size
+		       (%primitive c::foreign-symbol-address ,name)))
+	 (eval-when ,*alien-eval-when*
+	   (setf (info variable alien-value ',name)
+		 (lisp::make-ct-a-val
+		  :type ',type
+		  :size ,size
+		  :offset 0
+		  :sap '(%primitive c::foreign-symbol-addres ,name)
+		  :alien ',name)))))))
 
 #|
 ;;; Def-C-Procedure defines data structures etc. so that C can be passed