diff --git a/src/cmp/cmpbackend-cxx/cmpc-mach.lsp b/src/cmp/cmpbackend-cxx/cmpc-mach.lsp
index b79c57bc4..b55ba45b2 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-mach.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-mach.lsp
@@ -62,6 +62,30 @@
        (when (subtypep type (rep-type-lisp-type record))
          (return-from lisp-type->rep-type (rep-type-name record)))))))
 
+(defun c-number-rep-type-p (rep-type)
+  (let ((r (rep-type-record-unsafe rep-type)))
+    (and r (rep-type-numberp r))))
+
+(defun c-integer-rep-type-p (rep-type)
+  (let ((r (rep-type-record-unsafe rep-type)))
+    (and r (rep-type-integerp r))))
+
+(defun c-integer-rep-type-bits (rep-type)
+  (let ((r (rep-type-record-unsafe rep-type)))
+    (and r (rep-type-bits r))))
+
+(defun c-number-type-p (type)
+  (c-number-rep-type-p (lisp-type->rep-type type)))
+
+(defun c-integer-type-p (type)
+  (c-integer-rep-type-p (lisp-type->rep-type type)))
+
+(defun c-integer-type-bits (type)
+  (c-number-rep-type-bits (lisp-type->rep-type type)))
+
+(defun rep-type->c-name (type)
+  (rep-type-c-name (rep-type-record type)))
+
 ;; These types can be used by ECL to unbox data They are sorted from
 ;; the most specific, to the least specific one.  All functions must
 ;; be declared in external.h (not internal.h) header file.
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
index 34b4cd8a4..5bed4952f 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
@@ -72,7 +72,8 @@
 (defun tail-recursion-possible ()
   (dolist (ue *unwind-exit*
               (baboon :format-control "tail-recursion-possible: should never return."))
-    (cond ((eq ue 'TAIL-RECURSION-MARK) (return t))
+    (cond ((eq ue 'TAIL-RECURSION-MARK)
+           (return t))
           ((or (numberp ue) (eq ue 'BDS-BIND) (eq ue 'FRAME))
            (return nil))
           ((or (consp ue) (eq ue 'JUMP) (eq ue 'IHS-ENV)))
@@ -230,58 +231,4 @@
               function-p t)))
   `(CALL-INDIRECT ,loc ,(coerce-locs args) ,fname ,function-p))
 
-
-;;; wt routines
 
-(defun wt-call (fun args &optional fname env)
-  (if env
-      (progn
-        (setf *aux-closure* t)
-        (wt "(aux_closure.env="env",cl_env_copy->function=(cl_object)&aux_closure,")
-        (wt-call fun args)
-        (wt ")"))
-      (progn
-        (wt fun "(")
-        (let ((comma ""))
-          (dolist (arg args)
-            (wt comma arg)
-            (setf comma ", ")))
-        (wt ")")))
-  (when fname (wt-comment fname)))
-
-(defun wt-call-indirect (fun-loc args fname function-p)
-  (let ((narg (length args)))
-    (if function-p
-        (wt "(cl_env_copy->function=" fun-loc ")->cfun.entry(" narg)
-        (wt "ecl_function_dispatch(cl_env_copy," fun-loc ")(" narg))
-    (dolist (arg args)
-      (wt ", " arg))
-    (wt ")")
-    (when fname (wt-comment fname))))
-
-(defun wt-call-normal (fun args type)
-  (declare (ignore type))
-  (unless (fun-cfun fun)
-    (baboon "Function without a C name: ~A" (fun-name fun)))
-  (let* ((minarg (fun-minarg fun))
-         (maxarg (fun-maxarg fun))
-         (fun-c-name (fun-cfun fun))
-         (fun-lisp-name (fun-name fun))
-         (narg (length args))
-         (env nil))
-    (case (fun-closure fun)
-      (CLOSURE
-       (when (plusp *max-env*)
-         (setf env (environment-accessor fun))))
-      (LEXICAL
-       (let ((lex-lvl (fun-level fun)))
-         (dotimes (n lex-lvl)
-           (let* ((j (- lex-lvl n 1))
-                  (x (lex-env-var-name j)))
-             (push x args))))))
-    (unless (<= minarg narg maxarg)
-      (cmperr "Wrong number of arguments for function ~S"
-              (or fun-lisp-name 'ANONYMOUS)))
-    (when (fun-needs-narg fun)
-      (push narg args))
-    (wt-call fun-c-name args nil env)))
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp b/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp
index bc36c7140..555f155a8 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp
@@ -15,170 +15,6 @@
 
 (in-package "COMPILER")
 
-(defun c-number-rep-type-p (rep-type)
-  (let ((r (rep-type-record-unsafe rep-type)))
-    (and r (rep-type-numberp r))))
-
-(defun c-integer-rep-type-p (rep-type)
-  (let ((r (rep-type-record-unsafe rep-type)))
-    (and r (rep-type-integerp r))))
-
-(defun c-integer-rep-type-bits (rep-type)
-  (let ((r (rep-type-record-unsafe rep-type)))
-    (and r (rep-type-bits r))))
-
-(defun c-number-type-p (type)
-  (c-number-rep-type-p (lisp-type->rep-type type)))
-
-(defun c-integer-type-p (type)
-  (c-integer-rep-type-p (lisp-type->rep-type type)))
-
-(defun c-integer-type-bits (type)
-  (c-number-rep-type-bits (lisp-type->rep-type type)))
-
-(defun rep-type->c-name (type)
-  (rep-type-c-name (rep-type-record type)))
-
-(defun wt-to-object-conversion (loc-rep-type loc)
-  (when (and (consp loc) (member (first loc)
-                                 '(single-float-value
-                                   double-float-value
-                                   long-float-value
-                                   csfloat-value
-                                   cdfloat-value
-                                   clfloat-value)))
-    (wt (third loc)) ;; VV index
-    (return-from wt-to-object-conversion))
-  (let ((record (rep-type-record loc-rep-type)))
-    (unless record
-      (cmperr "Cannot coerce C variable of type ~A to lisp object" loc-rep-type))
-    (wt (rep-type-to-lisp record) "(" loc ")")))
-
-(defun wt-from-object-conversion (dest-type loc-type rep-type loc)
-  (let* ((record (rep-type-record rep-type))
-         (coercer (and record (rep-type-from-lisp record))))
-    (unless coercer
-      (cmperr "Cannot coerce lisp object to C type ~A" rep-type))
-    (wt (if (or (policy-assume-no-errors)
-                (subtypep loc-type dest-type))
-            (rep-type-from-lisp-unsafe record)
-            coercer)
-        "(" loc ")")))
-
-(defun wt-coerce-loc (dest-rep-type loc)
-  (setq dest-rep-type (lisp-type->rep-type dest-rep-type))
-                                        ;(print dest-rep-type)
-                                        ;(print loc)
-  (let* ((dest-type (rep-type->lisp-type dest-rep-type))
-         (loc-type (loc-type loc))
-         (loc-rep-type (loc-representation-type loc)))
-    (labels ((coercion-error ()
-               (cmpwarn "Unable to coerce lisp object from type (~S,~S)~%~
-                        to C/C++ type (~S,~S)"
-                        loc-type loc-rep-type dest-type dest-rep-type))
-             (ensure-valid-object-type (a-lisp-type)
-               (when (subtypep `(AND ,loc-type ,a-lisp-type) NIL)
-                 (coercion-error))))
-      (when (eq dest-rep-type loc-rep-type)
-        (wt loc)
-        (return-from wt-coerce-loc))
-      (case dest-rep-type
-        ((:char :unsigned-char :wchar)
-         (case loc-rep-type
-           ((:char :unsigned-char :wchar)
-            (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")"))
-           ((:object)
-            (ensure-valid-object-type dest-type)
-            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
-           (otherwise
-            (coercion-error))))
-        ((:float :double :long-double)
-         (cond
-           ((c-number-rep-type-p loc-rep-type)
-            (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")"))
-           ((eq loc-rep-type :object)
-            ;; We relax the check a bit, because it is valid in C to coerce
-            ;; between floats of different types.
-            (ensure-valid-object-type 'FLOAT)
-            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
-           (t
-            (coercion-error))))
-        ((:csfloat :cdfloat :clfloat)
-         (cond
-           ((c-number-rep-type-p loc-rep-type)
-            (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")"))
-           ((eq loc-rep-type :object)
-            ;; We relax the check a bit, because it is valid in C to coerce
-            ;; between COMPLEX floats of different types.
-            (ensure-valid-object-type 'SI:COMPLEX-FLOAT)
-            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
-           (t
-            (coercion-error))))
-        ((:bool)
-         (cond
-           ((c-number-rep-type-p loc-rep-type)
-            (wt "1"))
-           ((eq loc-rep-type :object)
-            (wt "(" loc ")!=ECL_NIL"))
-           (t
-            (coercion-error))))
-        ((:object)
-         (case loc-rep-type
-           ((:int-sse-pack :float-sse-pack :double-sse-pack)
-            (when (>= (cmp-env-optimization 'speed) 1)
-              (cmpwarn-style "Boxing a value of type ~S - performance degraded."
-                             loc-rep-type))))
-         (wt-to-object-conversion loc-rep-type loc))
-        ((:pointer-void)
-         (case loc-rep-type
-           ((:object)
-            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
-           ((:cstring)
-            (wt "(char *)(" loc ")"))
-           (otherwise
-            (coercion-error))))
-        ((:cstring)
-         (coercion-error))
-        ((:char*)
-         (case loc-rep-type
-           ((:object)
-            (wt "ecl_base_string_pointer_safe(" loc ")"))
-           ((:pointer-void)
-            (wt "(char *)(" loc ")"))
-           (otherwise
-            (coercion-error))))
-        ((:int-sse-pack :float-sse-pack :double-sse-pack)
-         (case loc-rep-type
-           ((:object)
-            (wt-from-object-conversion 'ext:sse-pack loc-type dest-rep-type loc))
-           ;; Implicitly cast between SSE subtypes
-           ((:int-sse-pack :float-sse-pack :double-sse-pack)
-            (wt (ecase dest-rep-type
-                  (:int-sse-pack (ecase loc-rep-type
-                                   (:float-sse-pack "_mm_castps_si128")
-                                   (:double-sse-pack "_mm_castpd_si128")))
-                  (:float-sse-pack (ecase loc-rep-type
-                                     (:int-sse-pack "_mm_castsi128_ps")
-                                     (:double-sse-pack "_mm_castpd_ps")))
-                  (:double-sse-pack (ecase loc-rep-type
-                                      (:int-sse-pack "_mm_castsi128_pd")
-                                      (:float-sse-pack "_mm_castps_pd"))))
-                "(" loc ")"))
-           (otherwise
-            (coercion-error))))
-        (t
-         ;; At this point we only have coercions to integers
-         (cond
-           ((not (c-integer-rep-type-p dest-rep-type))
-            (coercion-error))
-           ((c-number-rep-type-p loc-rep-type)
-            (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")"))
-           ((eq :object loc-rep-type)
-            (ensure-valid-object-type dest-type)
-            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
-           (t
-            (coercion-error))))))))
-
 ;;; ----------------------------------------------------------------------
 ;;; C/C++ DECLARATIONS AND HEADERS
 ;;;
@@ -341,45 +177,6 @@
               (t
                `(COERCE-LOC ,rep-type ,loc)))))
 
-(defun wt-c-inline-loc (output-rep-type c-expression coerced-arguments side-effects output-vars)
-  (declare (ignore output-rep-type side-effects))
-  (with-input-from-string (s c-expression)
-    (when (and output-vars (not (eq output-vars 'VALUES)))
-      (wt-nl))
-    (do ((c (read-char s nil nil)
-            (read-char s nil nil)))
-        ((null c))
-      (case c
-        (#\@
-         (let ((object (read s)))
-           (cond ((and (consp object) (equal (first object) 'RETURN))
-                  (if (eq output-vars 'VALUES)
-                      (cmperr "User @(RETURN ...) in a C-INLINE form with no output values")
-                      (let ((ndx (or (second object) 0))
-                            (l (length output-vars)))
-                        (if (< ndx l)
-                            (wt (nth ndx output-vars))
-                            (cmperr "Used @(RETURN ~D) in a C-INLINE form with ~D output values"
-                                    ndx l)))))
-                 (t
-                  (when (and (consp object) (eq (first object) 'QUOTE))
-                    (setq object (second object)))
-                  (wt (add-object object :permanent t))))))
-        (#\#
-         (let* ((k (read-char s))
-                (next-char (peek-char nil s nil nil))
-                (index (digit-char-p k 36)))
-           (cond ((eq k #\#)
-                  (wt #\#))
-                 ((or (null index) (and next-char (alphanumericp next-char)))
-                  (wt #\# k))
-                 ((< index (length coerced-arguments))
-                  (wt (nth index coerced-arguments)))
-                 (t
-                  (cmperr "C-INLINE: Variable code exceeds number of arguments")))))
-        (otherwise
-         (write-char c *compiler-output1*))))))
-
 (defun c-inline-safe-string (constant-string)
   ;; Produce a text representation of a string that can be used
   ;; in a C-INLINE form, without triggering the @ or # escape
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
index 14525bc63..f1d371eec 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
@@ -5,17 +5,18 @@
 ;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
 ;;;;  Copyright (c) 1990, Giuseppe Attardi.
 ;;;;
-;;;;    This program is free software; you can redistribute it and/or
-;;;;    modify it under the terms of the GNU Library General Public
-;;;;    License as published by the Free Software Foundation; either
-;;;;    version 2 of the License, or (at your option) any later version.
+;;;;    See the file 'LICENSE' for the copyright details.
 ;;;;
-;;;;    See file '../Copyright' for full details.
 
-;;;; CMPLOC  Set-loc and Wt-loc.
+;;;; Set-loc and Wt-loc.
 
 (in-package "COMPILER")
 
+
+;;;
+;;; Mundane locs
+;;;
+
 (defun wt-loc (loc)
   (cond ((consp loc)
          (let ((fd (gethash (car loc) *wt-loc-dispatch-table*)))
@@ -37,8 +38,9 @@
          (unknown-location 'wt-loc loc))))
 
 (defun wt-lcl (lcl)
-  (unless (numberp lcl) (baboon :format-control "wt-lcl: ~s NaN"
-                                :format-arguments (list lcl)))
+  (unless (numberp lcl)
+    (baboon :format-control "wt-lcl: ~s NaN"
+            :format-arguments (list lcl)))
   (wt "v" lcl))
 
 (defun wt-lcl-loc (lcl &optional type name)
@@ -79,14 +81,326 @@
   ;; 'char' which have sign problems
   (wt value))
 
-(defun wt-value (i) (wt "cl_env_copy->values[" i "]"))
+(defun wt-value (i)
+  (wt "cl_env_copy->values[" i "]"))
 
-(defun wt-keyvars (i) (wt "keyvars[" i "]"))
+(defun wt-keyvars (i)
+  (wt "keyvars[" i "]"))
 
 (defun wt-the (type loc)
   (declare (ignore type))
   (wt-loc loc))
 
+
+;;;
+;;; CALL-LOC
+;;;
+
+(defun wt-call (fun args &optional fname env)
+  (if env
+      (progn
+        (setf *aux-closure* t)
+        (wt "(aux_closure.env="env",cl_env_copy->function=(cl_object)&aux_closure,")
+        (wt-call fun args)
+        (wt ")"))
+      (progn
+        (wt fun "(")
+        (let ((comma ""))
+          (dolist (arg args)
+            (wt comma arg)
+            (setf comma ", ")))
+        (wt ")")))
+  (when fname (wt-comment fname)))
+
+(defun wt-call-indirect (fun-loc args fname function-p)
+  (let ((narg (length args)))
+    (if function-p
+        (wt "(cl_env_copy->function=" fun-loc ")->cfun.entry(" narg)
+        (wt "ecl_function_dispatch(cl_env_copy," fun-loc ")(" narg))
+    (dolist (arg args)
+      (wt ", " arg))
+    (wt ")")
+    (when fname (wt-comment fname))))
+
+(defun wt-call-normal (fun args type)
+  (declare (ignore type))
+  (unless (fun-cfun fun)
+    (baboon "Function without a C name: ~A" (fun-name fun)))
+  (let* ((minarg (fun-minarg fun))
+         (maxarg (fun-maxarg fun))
+         (fun-c-name (fun-cfun fun))
+         (fun-lisp-name (fun-name fun))
+         (narg (length args))
+         (env nil))
+    (case (fun-closure fun)
+      (CLOSURE
+       (when (plusp *max-env*)
+         (setf env (environment-accessor fun))))
+      (LEXICAL
+       (let ((lex-lvl (fun-level fun)))
+         (dotimes (n lex-lvl)
+           (let* ((j (- lex-lvl n 1))
+                  (x (lex-env-var-name j)))
+             (push x args))))))
+    (unless (<= minarg narg maxarg)
+      (cmperr "Wrong number of arguments for function ~S"
+              (or fun-lisp-name 'ANONYMOUS)))
+    (when (fun-needs-narg fun)
+      (push narg args))
+    (wt-call fun-c-name args nil env)))
+
+
+;;;
+;;; FDEFINITION, MAKE-CLOSURE
+;;; 
+(defun wt-fdefinition (fun-name)
+  (let* ((name (si::function-block-name fun-name))
+         (package (symbol-package name))
+         (safe (or (not (safe-compile))
+                   (and (or (eq package (find-package "CL"))
+                            (eq package (find-package "CLOS"))
+                            (eq package (find-package "SI")))
+                        (fboundp fun-name)
+                        (functionp (fdefinition fun-name))))))
+    (if (eq name fun-name)
+        ;; #'symbol
+        (let ((vv (add-symbol name)))
+          (if safe
+              (wt "(" vv "->symbol.gfdef)")
+              (wt "ecl_fdefinition(" vv ")")))
+        ;; #'(SETF symbol)
+        (if safe
+            #+(or)
+            (let ((set-loc (assoc name *setf-definitions*)))
+              (unless set-loc
+                (let* ((setf-vv (data-empty-loc))
+                       (name-vv (add-symbol name))
+                       (setf-form-vv (add-object fun-name)))
+                  (setf set-loc (list name setf-vv name-vv setf-form-vv))
+                  (push set-loc *setf-definitions*)))
+              (wt "ECL_SETF_DEFINITION(" (second set-loc) "," (fourth set-loc) ")"))
+            (let ((set-loc (assoc name *setf-definitions*)))
+              (unless set-loc
+                (let* ((setf-vv (data-empty-loc))
+                       (name-vv (add-symbol name)))
+                  (setf set-loc (list name setf-vv name-vv))
+                  (push set-loc *setf-definitions*)))
+              (wt "ECL_CONS_CAR(" (second set-loc) ")"))
+            (let ((vv (add-symbol fun-name)))
+              (wt "ecl_fdefinition(" vv ")"))))))
+
+(defun environment-accessor (fun)
+  (let* ((env-var (env-var-name *env-lvl*))
+         (expected-env-size (fun-env fun)))
+    (if (< expected-env-size *env*)
+        (format nil "ecl_nthcdr(~D,~A)" (- *env* expected-env-size) env-var)
+        env-var)))
+
+(defun wt-make-closure (fun &aux (cfun (fun-cfun fun)))
+  (declare (type fun fun))
+  (let* ((closure (fun-closure fun))
+         narg)
+    (cond ((eq closure 'CLOSURE)
+           (wt "ecl_make_cclosure_va((cl_objectfn)" cfun ","
+               (environment-accessor fun)
+               ",Cblock," (min (fun-minarg fun) si:c-arguments-limit) ")"))
+          ((eq closure 'LEXICAL)
+           (baboon :format-control "wt-make-closure: lexical closure detected."))
+          ((setf narg (fun-fixed-narg fun)) ; empty environment fixed number of args
+           (wt "ecl_make_cfun((cl_objectfn_fixed)" cfun ",ECL_NIL,Cblock," narg ")"))
+          (t ; empty environment variable number of args
+           (wt "ecl_make_cfun_va((cl_objectfn)" cfun ",ECL_NIL,Cblock,"
+               (min (fun-minarg fun) si:c-arguments-limit) ")")))))
+
+;;;
+;;; COERCE-LOC
+;;;
+
+(defun wt-to-object-conversion (loc-rep-type loc)
+  (when (and (consp loc) (member (first loc)
+                                 '(single-float-value
+                                   double-float-value
+                                   long-float-value
+                                   csfloat-value
+                                   cdfloat-value
+                                   clfloat-value)))
+    (wt (third loc)) ;; VV index
+    (return-from wt-to-object-conversion))
+  (let ((record (rep-type-record loc-rep-type)))
+    (unless record
+      (cmperr "Cannot coerce C variable of type ~A to lisp object" loc-rep-type))
+    (wt (rep-type-to-lisp record) "(" loc ")")))
+
+(defun wt-from-object-conversion (dest-type loc-type rep-type loc)
+  (let* ((record (rep-type-record rep-type))
+         (coercer (and record (rep-type-from-lisp record))))
+    (unless coercer
+      (cmperr "Cannot coerce lisp object to C type ~A" rep-type))
+    (wt (if (or (policy-assume-no-errors)
+                (subtypep loc-type dest-type))
+            (rep-type-from-lisp-unsafe record)
+            coercer)
+        "(" loc ")")))
+
+(defun wt-coerce-loc (dest-rep-type loc)
+  (setq dest-rep-type (lisp-type->rep-type dest-rep-type))
+                                        ;(print dest-rep-type)
+                                        ;(print loc)
+  (let* ((dest-type (rep-type->lisp-type dest-rep-type))
+         (loc-type (loc-type loc))
+         (loc-rep-type (loc-representation-type loc)))
+    (labels ((coercion-error ()
+               (cmpwarn "Unable to coerce lisp object from type (~S,~S)~%~
+                        to C/C++ type (~S,~S)"
+                        loc-type loc-rep-type dest-type dest-rep-type))
+             (ensure-valid-object-type (a-lisp-type)
+               (when (subtypep `(AND ,loc-type ,a-lisp-type) NIL)
+                 (coercion-error))))
+      (when (eq dest-rep-type loc-rep-type)
+        (wt loc)
+        (return-from wt-coerce-loc))
+      (case dest-rep-type
+        ((:char :unsigned-char :wchar)
+         (case loc-rep-type
+           ((:char :unsigned-char :wchar)
+            (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")"))
+           ((:object)
+            (ensure-valid-object-type dest-type)
+            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
+           (otherwise
+            (coercion-error))))
+        ((:float :double :long-double)
+         (cond
+           ((c-number-rep-type-p loc-rep-type)
+            (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")"))
+           ((eq loc-rep-type :object)
+            ;; We relax the check a bit, because it is valid in C to coerce
+            ;; between floats of different types.
+            (ensure-valid-object-type 'FLOAT)
+            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
+           (t
+            (coercion-error))))
+        ((:csfloat :cdfloat :clfloat)
+         (cond
+           ((c-number-rep-type-p loc-rep-type)
+            (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")"))
+           ((eq loc-rep-type :object)
+            ;; We relax the check a bit, because it is valid in C to coerce
+            ;; between COMPLEX floats of different types.
+            (ensure-valid-object-type 'SI:COMPLEX-FLOAT)
+            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
+           (t
+            (coercion-error))))
+        ((:bool)
+         (cond
+           ((c-number-rep-type-p loc-rep-type)
+            (wt "1"))
+           ((eq loc-rep-type :object)
+            (wt "(" loc ")!=ECL_NIL"))
+           (t
+            (coercion-error))))
+        ((:object)
+         (case loc-rep-type
+           ((:int-sse-pack :float-sse-pack :double-sse-pack)
+            (when (>= (cmp-env-optimization 'speed) 1)
+              (cmpwarn-style "Boxing a value of type ~S - performance degraded."
+                             loc-rep-type))))
+         (wt-to-object-conversion loc-rep-type loc))
+        ((:pointer-void)
+         (case loc-rep-type
+           ((:object)
+            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
+           ((:cstring)
+            (wt "(char *)(" loc ")"))
+           (otherwise
+            (coercion-error))))
+        ((:cstring)
+         (coercion-error))
+        ((:char*)
+         (case loc-rep-type
+           ((:object)
+            (wt "ecl_base_string_pointer_safe(" loc ")"))
+           ((:pointer-void)
+            (wt "(char *)(" loc ")"))
+           (otherwise
+            (coercion-error))))
+        ((:int-sse-pack :float-sse-pack :double-sse-pack)
+         (case loc-rep-type
+           ((:object)
+            (wt-from-object-conversion 'ext:sse-pack loc-type dest-rep-type loc))
+           ;; Implicitly cast between SSE subtypes
+           ((:int-sse-pack :float-sse-pack :double-sse-pack)
+            (wt (ecase dest-rep-type
+                  (:int-sse-pack (ecase loc-rep-type
+                                   (:float-sse-pack "_mm_castps_si128")
+                                   (:double-sse-pack "_mm_castpd_si128")))
+                  (:float-sse-pack (ecase loc-rep-type
+                                     (:int-sse-pack "_mm_castsi128_ps")
+                                     (:double-sse-pack "_mm_castpd_ps")))
+                  (:double-sse-pack (ecase loc-rep-type
+                                      (:int-sse-pack "_mm_castsi128_pd")
+                                      (:float-sse-pack "_mm_castps_pd"))))
+                "(" loc ")"))
+           (otherwise
+            (coercion-error))))
+        (t
+         ;; At this point we only have coercions to integers
+         (cond
+           ((not (c-integer-rep-type-p dest-rep-type))
+            (coercion-error))
+           ((c-number-rep-type-p loc-rep-type)
+            (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")"))
+           ((eq :object loc-rep-type)
+            (ensure-valid-object-type dest-type)
+            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
+           (t
+            (coercion-error))))))))
+
+
+;;;
+;;; INLINE-LOC
+;;;
+
+(defun wt-c-inline-loc (output-rep-type c-expression coerced-arguments side-effects output-vars)
+  (declare (ignore output-rep-type side-effects))
+  (with-input-from-string (s c-expression)
+    (when (and output-vars (not (eq output-vars 'VALUES)))
+      (wt-nl))
+    (do ((c (read-char s nil nil)
+            (read-char s nil nil)))
+        ((null c))
+      (case c
+        (#\@
+         (let ((object (read s)))
+           (cond ((and (consp object) (equal (first object) 'RETURN))
+                  (if (eq output-vars 'VALUES)
+                      (cmperr "User @(RETURN ...) in a C-INLINE form with no output values")
+                      (let ((ndx (or (second object) 0))
+                            (l (length output-vars)))
+                        (if (< ndx l)
+                            (wt (nth ndx output-vars))
+                            (cmperr "Used @(RETURN ~D) in a C-INLINE form with ~D output values"
+                                    ndx l)))))
+                 (t
+                  (when (and (consp object) (eq (first object) 'QUOTE))
+                    (setq object (second object)))
+                  (wt (add-object object :permanent t))))))
+        (#\#
+         (let* ((k (read-char s))
+                (next-char (peek-char nil s nil nil))
+                (index (digit-char-p k 36)))
+           (cond ((eq k #\#)
+                  (wt #\#))
+                 ((or (null index) (and next-char (alphanumericp next-char)))
+                  (wt #\# k))
+                 ((< index (length coerced-arguments))
+                  (wt (nth index coerced-arguments)))
+                 (t
+                  (cmperr "C-INLINE: Variable code exceeds number of arguments")))))
+        (otherwise
+         (write-char c *compiler-output1*))))))
+
+
 ;;;
 ;;; SET-LOC
 ;;;
@@ -113,7 +427,8 @@
              (if fd
                  (apply fd loc (rest destination))
                  (progn
-                   (wt-nl) (wt-loc destination) (wt " = ")
+                   (wt-nl)
+                   (wt-loc destination) (wt " = ")
                    (wt-coerce-loc (loc-representation-type *destination*) loc)
                    (wt ";"))))))))
 
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-special.lsp b/src/cmp/cmpbackend-cxx/cmppass2-special.lsp
index 35f364375..d649804cb 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-special.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-special.lsp
@@ -22,7 +22,7 @@
   (declare (ignore c1form funob))
   (case kind
     (GLOBAL
-     (unwind-exit (list 'FDEFINITION fun)))
+     (unwind-exit `(FDEFINITION ,fun)))
     (CLOSURE
      ;; XXX: we have some code after baboon – is CLOSURE legal or not?
      (baboon :format-control "c2function: c1form is of unexpected kind.")
@@ -44,77 +44,4 @@
            (fun-env fun) 0))
     (otherwise
      (setf (fun-env fun) 0 (fun-level fun) 0)))
-  (let ((previous
-         nil
-         #+(or)
-         (dolist (old *local-funs*)
-           (when (similar fun old)
-             (return old)))))
-    (if previous
-        (progn
-          (if (eq (fun-closure fun) 'CLOSURE)
-              (cmpnote "Sharing code for closure")
-              (cmpnote "Sharing code for local function ~A" (fun-name fun)))
-          (setf (fun-cfun fun) (fun-cfun previous)
-                (fun-lambda fun) nil)
-          previous)
-        (push fun *local-funs*))))
-
-(defun wt-fdefinition (fun-name)
-  (let* ((name (si::function-block-name fun-name))
-         (package (symbol-package name))
-         (safe (or (not (safe-compile))
-                   (and (or (eq package (find-package "CL"))
-                            (eq package (find-package "CLOS"))
-                            (eq package (find-package "SI")))
-                        (fboundp fun-name)
-                        (functionp (fdefinition fun-name))))))
-    (if (eq name fun-name)
-        ;; #'symbol
-        (let ((vv (add-symbol name)))
-          (if safe
-              (wt "(" vv "->symbol.gfdef)")
-              (wt "ecl_fdefinition(" vv ")")))
-        ;; #'(SETF symbol)
-        (if safe
-            #+(or)
-            (let ((set-loc (assoc name *setf-definitions*)))
-              (unless set-loc
-                (let* ((setf-vv (data-empty-loc))
-                       (name-vv (add-symbol name))
-                       (setf-form-vv (add-object fun-name)))
-                  (setf set-loc (list name setf-vv name-vv setf-form-vv))
-                  (push set-loc *setf-definitions*)))
-              (wt "ECL_SETF_DEFINITION(" (second set-loc) "," (fourth set-loc) ")"))
-            (let ((set-loc (assoc name *setf-definitions*)))
-              (unless set-loc
-                (let* ((setf-vv (data-empty-loc))
-                       (name-vv (add-symbol name)))
-                  (setf set-loc (list name setf-vv name-vv))
-                  (push set-loc *setf-definitions*)))
-              (wt "ECL_CONS_CAR(" (second set-loc) ")"))
-            (let ((vv (add-symbol fun-name)))
-              (wt "ecl_fdefinition(" vv ")"))))))
-
-(defun environment-accessor (fun)
-  (let* ((env-var (env-var-name *env-lvl*))
-         (expected-env-size (fun-env fun)))
-    (if (< expected-env-size *env*)
-        (format nil "ecl_nthcdr(~D,~A)" (- *env* expected-env-size) env-var)
-        env-var)))
-
-(defun wt-make-closure (fun &aux (cfun (fun-cfun fun)))
-  (declare (type fun fun))
-  (let* ((closure (fun-closure fun))
-         narg)
-    (cond ((eq closure 'CLOSURE)
-           (wt "ecl_make_cclosure_va((cl_objectfn)" cfun ","
-               (environment-accessor fun)
-               ",Cblock," (min (fun-minarg fun) si:c-arguments-limit) ")"))
-          ((eq closure 'LEXICAL)
-           (baboon :format-control "wt-make-closure: lexical closure detected."))
-          ((setf narg (fun-fixed-narg fun)) ; empty environment fixed number of args
-           (wt "ecl_make_cfun((cl_objectfn_fixed)" cfun ",ECL_NIL,Cblock," narg ")"))
-          (t ; empty environment variable number of args
-           (wt "ecl_make_cfun_va((cl_objectfn)" cfun ",ECL_NIL,Cblock,"
-               (min (fun-minarg fun) si:c-arguments-limit) ")")))))
+  (push fun *local-funs*))