diff --git a/src/new-cmp/cmpblock.lsp b/src/new-cmp/cmpblock.lsp
index 1f28fe07f..a71a72a3e 100644
--- a/src/new-cmp/cmpblock.lsp
+++ b/src/new-cmp/cmpblock.lsp
@@ -90,8 +90,8 @@
                       output (nconc prefix
                                     val
                                     cleanup
-                                    (c1jmp exit-tag)
-                                    postfix)))))
+                                    postfix
+                                    (c1jmp exit-tag))))))
 	(setf (blk-type blk) (values-type-or (blk-type blk) type)
               (blk-ref blk) (1+ (blk-ref blk)))
         output))))
diff --git a/src/new-cmp/cmpc-data.lsp b/src/new-cmp/cmpc-data.lsp
new file mode 100644
index 000000000..7223e4430
--- /dev/null
+++ b/src/new-cmp/cmpc-data.lsp
@@ -0,0 +1,154 @@
+;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
+;;;;
+;;;;  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 file '../Copyright' for full details.
+
+;;;; CMPC-DATA -- Dump data used by code in a textual representation
+
+(in-package "C-BACKEND")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; DUMP TEXTUAL DATA
+;;;
+;;; Dumps data that has to be parsed by read_VV() when initializing
+;;; this file.
+
+(defun data-dump (stream &key init-name &aux must-close)
+  (etypecase stream
+    (null (return-from data-dump))
+    ((or pathname string)
+     (setf stream (open stream :direction :output :if-does-not-exist :create
+			:if-exists :supersede :external-format :default)
+	   must-close stream))
+    (stream))
+  (si::with-ecl-io-syntax
+    (extract-static-constants stream)
+    (adjust-data-indices *permanent-objects*)
+    (adjust-data-indices *temporary-objects*)
+    (let ((output nil))
+      (cond (*compiler-constants*
+             (format stream "~%#define compiler_data_text NULL~%#define compiler_data_text_size 0~%")
+             (setf output (concatenate 'vector (data-get-all-objects))))
+            ((plusp (data-size))
+             (wt-data-begin stream)
+             (wt-filtered-data
+              (subseq (prin1-to-string (data-get-all-objects)) 1)
+              stream)
+             (wt-data-end stream)))
+      (when must-close
+        (close must-close))
+      (data-init)
+      output)))
+
+(defun adjust-data-indices (array)
+  (loop for last-index from 0
+     for record across array
+     for location = (second record)
+     do (setf (second location) last-index
+              (third record) last-index)))
+
+(defun wt-data-begin (stream)
+  (setq *wt-string-size* 0)
+  (setq *wt-data-column* 80)
+  (princ "static const char compiler_data_text[] = " stream)
+  nil)
+
+(defun wt-data-end (stream)
+  (princ #\; stream)
+  (format stream "~%#define compiler_data_text_size ~D~%" *wt-string-size*)
+  (setf *wt-string-size* 0))
+
+;;; This routine converts lisp data into C-strings. We have to take
+;;; care of escaping special characteres with backslashes. We also have
+;;; to split long lines using  the fact that multiple strings are joined
+;;; together by the compiler.
+;;;
+(defun wt-filtered-data (string stream &optional one-liner)
+  (let ((N (length string))
+	(wt-data-column 80))
+    (incf *wt-string-size* (1+ N)) ; 1+ accounts for a blank space
+    (format stream (if one-liner "\"" "~%\""))
+    (dotimes (i N)
+      (decf wt-data-column)
+      (when (< wt-data-column 0)
+	(format stream "\"~% \"")
+	(setq wt-data-column 79))
+      (let ((x (aref string i)))
+	(cond
+	  ((or (< (char-code x) 32)
+	       (> (char-code x) 127))
+	   (case x
+	     ; We avoid a trailing backslash+newline because some preprocessors
+	     ; remove them.
+	     (#\Newline (princ "\\n" stream))
+	     (#\Tab (princ "\\t" stream))
+	     (t (format stream "\\~3,'0o" (char-code x)))))
+	  ((char= x #\\)
+	   (princ "\\\\" stream))
+	  ((char= x #\")
+	   (princ "\\\"" stream))
+	  (t (princ x stream)))))
+    (princ (if one-liner "\""  " \"") stream)
+    string))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; DUMP STATIC DATA
+;;;
+
+
+(defun static-base-string-builder (name value stream)
+  (format stream "ecl_def_ct_base_string(~A," name)
+  (wt-filtered-data value stream t)
+  (format stream ",~D,static,const);" (length value)))
+
+(defun static-single-float-builder (name value stream)
+  (let* ((*read-default-float-format* 'single-float)
+         (*print-readably* t))
+    (format stream "ecl_def_ct_single_float(~A,~S,static,const);" name value stream)))
+
+(defun static-double-float-builder (name value stream)
+  (let* ((*read-default-float-format* 'double-float)
+         (*print-readably* t))
+    (format stream "ecl_def_ct_single_float(~A,~S,static,const);" name value stream)))
+
+(defun static-constant-builder (format value)
+  (lambda (name stream)
+    (format stream format name value)))
+
+(defun static-constant-expression (object)
+  (typecase object
+    (base-string #'static-base-string-builder)
+    ;;(single-float #'static-single-float-builder)
+    ;;(double-float #'static-double-float-builder)
+    (t nil)))
+
+(defun static-data-dump (stream)
+  (loop for (object c-name) in *static-constants*
+     for function = (static-constant-expression object)
+     do (funcall function c-name object stream)))
+
+(defun extract-static-constants (stream)
+  (unless (or *compiler-constants* (not *use-static-constants-p*))
+    (let ((static-constants 0))
+      (flet ((turned-static-p (record)
+               (destructuring-bind (object (&whole location vv-tag index object-copy))
+                   (let ((builder (static-constant-expression object)))
+                     (when builder
+                       (let* ((next-index (incf static-constants))
+                              (name (format nil "_ecl_static_~D" next-index)))
+                         (setf (second location) name)
+                         (funcall name object sream)
+                         t))))))
+        (setf *permanent-objects*
+              (delete-if #'turned-static-p *permanent-objects*)
+              *temporary-objects*
+              (delete-if #'turned-static-p *temporary-objects*))))))
diff --git a/src/new-cmp/cmploc.lsp b/src/new-cmp/cmpc-loc.lsp
similarity index 56%
rename from src/new-cmp/cmploc.lsp
rename to src/new-cmp/cmpc-loc.lsp
index dc5c8d450..8741a9764 100644
--- a/src/new-cmp/cmploc.lsp
+++ b/src/new-cmp/cmpc-loc.lsp
@@ -2,6 +2,7 @@
 ;;;;
 ;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
 ;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;  Copyright (c) 2009, Juan Jose Garcia-Ripoll.
 ;;;;
 ;;;;    This program is free software; you can redistribute it and/or
 ;;;;    modify it under the terms of the GNU Library General Public
@@ -10,9 +11,9 @@
 ;;;;
 ;;;;    See file '../Copyright' for full details.
 
-;;;; CMPLOC  Set-loc and Wt-loc.
+;;;; CMPC-LOC	Write locations as C expressions
 
-(in-package "COMPILER")
+(in-package "C-BACKEND")
 
 ;;; Valid locations are:
 ;;;	NIL
@@ -60,12 +61,17 @@
 ;;;	( BIND var alternative )	Alternative is optional
 ;;;	( JUMP-TRUE label )
 ;;;	( JUMP-FALSE label )
+;;;	( JUMP-ZERO label )
+;;;	( JUMP-NONZERO label )
 
-(defun tmp-destination (loc)
-  (case loc
-    (VALUES 'VALUES)
-    (TRASH 'TRASH)
-    (T 'RETURN)))
+(defun locative-type-from-var-kind (kind)
+  (cdr (assoc kind
+              '((:object . "_ecl_object_loc")
+                (:fixnum . "_ecl_fixnum_loc")
+                (:char . "_ecl_base_char_loc")
+                (:float . "_ecl_float_loc")
+                (:double . "_ecl_double_loc")
+                ((special global closure replaced discarded lexical) . NIL)))))
 
 (defun loc-has-side-effects (loc)
   (if (atom loc)
@@ -82,7 +88,8 @@
         (FDEFINITION (policy-global-function-checking))
         (otherwise nil))))
 
-;;; ------------------------------------------------------------------
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
 ;;; WRITING C/C++ REPRESENTATIONS LOCATIONS
 ;;;
 
@@ -110,11 +117,6 @@
 
 (defun wt-cl-va-arg-loc () (wt "(narg--,cl_va_arg(cl_args))"))
 
-(defun last-call-p ()
-  (member *exit*
-          '(RETURN RETURN-FIXNUM RETURN-CHARACTER RETURN-SINGLE-FLOAT
-            RETURN-DOUBLE-FLOAT RETURN-LONG-FLOAT RETURN-OBJECT)))
-
 (defun wt-car (loc) (wt "CAR(" loc ")"))
 
 (defun wt-cdr (loc) (wt "CDR(" loc ")"))
@@ -157,92 +159,6 @@
 
 (defun wt-keyvars (i) (wt "keyvars[" i "]"))
 
-(defun loc-refers-to-special (loc)
-  (cond ((var-p loc)
-	 (member (var-kind loc) '(SPECIAL GLOBAL)))
-	((atom loc)
-	 nil)
-	((eq (setf loc (first loc)) 'BIND)
-	 t)
-	((eq loc 'C-INLINE)
-	 t) ; We do not know, so guess yes
-	(t nil)))
-
-(defun values-loc (n)
-  (list 'VALUE n))
-
 (defun wt-the-loc (type loc)
   (wt-loc loc))
 
-;;; ------------------------------------------------------------------
-;;; ASSIGNING TO LOCATIONS
-;;;
-
-(defun uses-values (loc)
-  (and (consp loc)
-       (or (member (car loc) '(CALL CALL-NORMAL CALL-INDIRECT) :test #'eq)
-           (and (eq (car loc) 'C-INLINE)
-                (eq (sixth loc) 'VALUES)))))
-
-(defun set-loc (loc destination)
-  (unless (eql destination loc)
-    (cond ((var-p destination)
-           (set-var loc destination))
-          ((atom destination)
-           (let ((fd (gethash destination +c2-set-loc-table+)))
-             (cond (fd
-                    (funcall fd loc))
-                   ((setq fd (gethash destination +c2-wt-loc-table+))
-                    (wt-nl) (funcall fd) (wt "= ")
-                    (wt-coerce-loc (loc-representation-type destination) loc)
-                    (wt ";"))
-                   (t
-                    (error "No known way to assign to location ~A"
-                           destination)))))
-          (t
-           (let* ((name (first destination))
-                  (fd (gethash name +c2-set-loc-table+)))
-             (cond (fd
-                    (apply fd loc (rest destination)))
-                   ((setq fd (gethash name +c2-wt-loc-table+))
-                    (wt-nl) (apply fd (rest destination)) (wt "= ")
-                    (wt-coerce-loc (loc-representation-type destination) loc)
-                    (wt ";"))
-                   (t
-                    (error "No known way to assign to location ~A"
-                           destination))))))))
-
-(defun set-values-loc (loc)
-  (cond ((eq loc 'VALUES))
-        ((uses-values loc)
-         (wt-nl "cl_env_copy->values[0]=") (wt-coerce-loc :object loc) (wt ";"))
-        (t
-         (wt-nl "cl_env_copy->values[0]=") (wt-coerce-loc :object loc)
-         (wt ";")
-         (wt-nl "cl_env_copy->nvalues=1;"))))
-
-(defun set-values+value0-loc (loc)
-  (cond ((eq loc 'VALUES)
-         (wt-nl "value0=cl_env_copy->values[0];"))
-        ((uses-values loc)
-         (wt-nl "value0=")(wt-coerce-loc :object loc) (wt ";"))
-        (t
-         (wt-nl "value0=") (wt-coerce-loc :object loc) (wt ";")
-         (wt-nl "cl_env_copy->nvalues=1;"))))
-
-(defun set-value0-loc (loc)
-  (wt-nl "value0=") (wt-coerce-loc :object loc) (wt ";"))
-
-(defun set-return-loc (loc)
-  (set-values+value0-loc loc))
-
-(defun set-actual-return-loc (loc)
-  (set-loc loc 'VALUES+VALUE0)
-  (wt-nl "return value0;"))
-
-(defun set-trash-loc (loc)
-  (when (loc-has-side-effects loc)
-    (wt-nl loc ";")))
-
-(defun set-the-loc (value type loc)
-  (set-loc value loc))
diff --git a/src/new-cmp/cmpbackend.lsp b/src/new-cmp/cmpc-ops.lsp
similarity index 97%
rename from src/new-cmp/cmpbackend.lsp
rename to src/new-cmp/cmpc-ops.lsp
index e1b66a6fd..24926ab18 100644
--- a/src/new-cmp/cmpbackend.lsp
+++ b/src/new-cmp/cmpc-ops.lsp
@@ -9,7 +9,7 @@
 ;;;;
 ;;;;    See file '../Copyright' for full details.
 
-(in-package "COMPILER")
+(in-package "C-BACKEND")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -800,3 +800,26 @@
       (error "Wrong value of environment size ~A" *env*))
     (close-all-c-blocks)))
 
+;;;
+;;; FSET FIXME! UNUSED!
+;;;
+
+(defun c2fset (fun fname macro pprint c1forms)
+  (when (fun-no-entry fun)
+    (wt-nl "(void)0; /* No entry created for "
+	   (format nil "~A" (fun-name fun))
+	   " */")
+    ;; FIXME! Look at c2function!
+    (new-local fun)
+    (return-from c2fset))
+  (when (fun-closure fun)
+    (return-from c2fset (c2call-global destination 'SI:FSET c1forms)))
+  (let ((*inline-blocks* 0)
+	(loc (data-empty-loc)))
+    (push (list loc fname fun) *global-cfuns-array*)
+    ;; FIXME! Look at c2function!
+    (new-local fun)
+    (wt-nl (if macro "ecl_cmp_defmacro(" "ecl_cmp_defun(")
+	   loc ");")
+    (close-inline-blocks)))
+
diff --git a/src/new-cmp/cmpc-set.lsp b/src/new-cmp/cmpc-set.lsp
new file mode 100644
index 000000000..8efd765c6
--- /dev/null
+++ b/src/new-cmp/cmpc-set.lsp
@@ -0,0 +1,88 @@
+;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
+;;;;
+;;;;  Copyright (c) 2009, Juan Jose Garcia-Ripoll.
+;;;;
+;;;;    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 file '../Copyright' for full details.
+
+;;;; CMPC-SET	Set locations
+
+(in-package "C-BACKEND")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; ASSIGNING TO LOCATIONS
+;;;
+
+(defun uses-values (loc)
+  (and (consp loc)
+       (or (member (car loc) '(CALL CALL-NORMAL CALL-INDIRECT) :test #'eq)
+           (and (eq (car loc) 'C-INLINE)
+                (eq (sixth loc) 'VALUES)))))
+
+(defun set-loc (loc destination)
+  (unless (eql destination loc)
+    (cond ((var-p destination)
+           (set-var loc destination))
+          ((atom destination)
+           (let ((fd (gethash destination +c2-set-loc-table+)))
+             (cond (fd
+                    (funcall fd loc))
+                   ((setq fd (gethash destination +c2-wt-loc-table+))
+                    (wt-nl) (funcall fd) (wt "= ")
+                    (wt-coerce-loc (loc-representation-type destination) loc)
+                    (wt ";"))
+                   (t
+                    (error "No known way to assign to location ~A"
+                           destination)))))
+          (t
+           (let* ((name (first destination))
+                  (fd (gethash name +c2-set-loc-table+)))
+             (cond (fd
+                    (apply fd loc (rest destination)))
+                   ((setq fd (gethash name +c2-wt-loc-table+))
+                    (wt-nl) (apply fd (rest destination)) (wt "= ")
+                    (wt-coerce-loc (loc-representation-type destination) loc)
+                    (wt ";"))
+                   (t
+                    (error "No known way to assign to location ~A"
+                           destination))))))))
+
+(defun set-values-loc (loc)
+  (cond ((eq loc 'VALUES))
+        ((uses-values loc)
+         (wt-nl "cl_env_copy->values[0]=") (wt-coerce-loc :object loc) (wt ";"))
+        (t
+         (wt-nl "cl_env_copy->values[0]=") (wt-coerce-loc :object loc)
+         (wt ";")
+         (wt-nl "cl_env_copy->nvalues=1;"))))
+
+(defun set-values+value0-loc (loc)
+  (cond ((eq loc 'VALUES)
+         (wt-nl "value0=cl_env_copy->values[0];"))
+        ((uses-values loc)
+         (wt-nl "value0=")(wt-coerce-loc :object loc) (wt ";"))
+        (t
+         (wt-nl "value0=") (wt-coerce-loc :object loc) (wt ";")
+         (wt-nl "cl_env_copy->nvalues=1;"))))
+
+(defun set-value0-loc (loc)
+  (wt-nl "value0=") (wt-coerce-loc :object loc) (wt ";"))
+
+(defun set-return-loc (loc)
+  (set-values+value0-loc loc))
+
+(defun set-actual-return-loc (loc)
+  (set-loc loc 'VALUES+VALUE0)
+  (wt-nl "return value0;"))
+
+(defun set-trash-loc (loc)
+  (when (loc-has-side-effects loc)
+    (wt-nl loc ";")))
+
+(defun set-the-loc (value type loc)
+  (set-loc value loc))
diff --git a/src/new-cmp/cmpc-tables.lsp b/src/new-cmp/cmpc-tables.lsp
new file mode 100644
index 000000000..1d5862fda
--- /dev/null
+++ b/src/new-cmp/cmpc-tables.lsp
@@ -0,0 +1,145 @@
+;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
+;;;;
+;;;;  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 file '../Copyright' for full details.
+;;;;
+;;;;  CMPC-TABLES -- Dispatch tables for the C/C++ backend
+;;;;
+
+(in-package "C-BACKEND")
+
+(defparameter +c2-dispatch-table+
+ (make-dispatch-table
+  '(
+    (set . c2set)
+    (set-mv . c2set-mv)
+    (values . c2values-op)
+    (bind . c2bind)
+    (bind-special . c2bind-special)
+    (progv . c2progv-op)
+    (unbind . c2unbind)
+    (progv-exit . c2progv-exit-op)
+    (frame-pop . c2frame-pop)
+    (frame-set . c2frame-set)
+    (frame-save-next . c2frame-save-next)
+    (frame-jmp-next . c2frame-jmp-next)
+    (frame-id . c2frame-id)
+    (jmp . c2jmp)
+
+    (function-prologue . c2function-prologue)
+    (function-epilogue . c2function-epilogue)
+    
+    (bind-requireds . c2bind-requireds)
+    (varargs-bind . c2varargs-bind-op)
+    (varargs-pop . c2varargs-pop-op)
+    (varargs-rest . c2varargs-rest-op)
+    (varargs-unbind . c2varargs-unbind-op)
+
+    (stack-frame-open . c2stack-frame-open)
+    (stack-frame-push . c2stack-frame-push)
+    (stack-frame-push-values . c2stack-frame-push-values)
+    (stack-frame-pop-values . c2stack-frame-pop-values)
+    (stack-frame-apply . c2stack-frame-apply)
+    (stack-frame-close . c2stack-frame-close)
+
+    (throw . c2throw-op)
+    (return-from . c2return-from-op)
+    (go . c2go-op)
+    (funcall . c2funcall-op)
+    (call-local . c2call-local)
+    (call-global . c2call-global)
+
+    (debug-env-open . c2debug-env-open)
+    (debug-env-close . c2debug-env-close)
+    (debug-env-push-vars . c2debug-env-push-vars)
+    (debug-env-pop-vars . c2debug-env-pop-vars)
+
+    ;; cmpffi.lsp
+    (ffi:c-inline . c2c-inline)
+    
+    ;; cmpflet.lsp
+    (do-flet/labels . c2do-flet/labels)
+
+    ;; cmpstructures.lsp
+    ;; (sys:structure-ref . c2structure-ref)
+    ;; (sys:structure-set . c2structure-set)
+
+    ;; cmptop.lsp
+    (si:fset . c2fset)
+    )))
+
+(defparameter +c2-wt-loc-table+
+ (make-dispatch-table
+  '(
+    ;; cmploc.lsp
+    (temp . wt-temp)
+    (lcl . wt-lcl-loc)
+    (vv . wt-vv)
+    (vv-temp . wt-vv-temp)
+    (car . wt-car)
+    (cdr . wt-cdr)
+    (cadr . wt-cadr)
+    (fixnum-value . wt-number)
+    (character-value . wt-character)
+    (long-float-value . wt-number)
+    (double-float-value . wt-number)
+    (single-float-value . wt-number)
+    (value . wt-value)
+    (keyvars . wt-keyvars)
+    (the . wt-the-loc)
+
+    (nil . wt-nil-loc)
+    (t . wt-t-loc)
+    (value0 . wt-value0-loc)
+    (return . wt-value0-loc)
+    (values+value0 . wt-value0-loc)
+    (values . wt-values-loc)
+    (va-arg . wt-va-arg-loc)
+    (cl-va-arg . wt-cl-va-arg-loc)
+
+    ;; cmpbackend.lsp
+    (call . wt-call)
+    (call-normal . wt-call-normal)
+    (call-indirect . wt-call-indirect)
+
+    ;; cmpffi.lsp
+    (ffi:c-inline . wt-c-inline-loc)
+    (coerce-loc . wt-coerce-loc)
+
+    ;; cmpspecial.ls
+    (fdefinition . wt-fdefinition)
+    (make-cclosure . wt-make-closure)
+
+    ;; cmpstructures.lsp
+    (sys:structure-ref . wt-structure-ref)
+    )))
+
+(defparameter +c2-set-loc-table+
+ (make-dispatch-table
+  '(
+    ;; cmpbind.lsp
+    (bind . bind)
+
+    ;; cmploc.lsp
+    (values . set-values-loc)
+    (values+value0 . set-values+value0-loc)
+    (value0 . set-value0-loc)
+    (return . set-return-loc)
+    (actual-return . set-actual-return-loc)
+    (trash . set-trash-loc)
+    (the . set-the-loc)
+
+    ;; cmpbackend.lsp
+    (jmp-true . set-loc-jmp-true)
+    (jmp-false . set-loc-jmp-false)
+    (jmp-zero . set-loc-jmp-zero)
+    (jmp-nonzero . set-loc-jmp-nonzero)
+    )))
+
diff --git a/src/new-cmp/cmpc-top.lsp b/src/new-cmp/cmpc-top.lsp
new file mode 100644
index 000000000..0d9446bfd
--- /dev/null
+++ b/src/new-cmp/cmpc-top.lsp
@@ -0,0 +1,168 @@
+;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
+;;;;
+;;;;  Copyright (c) 2009, Juan Jose Garcia-Ripoll
+;;;;
+;;;;    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 file '../Copyright' for full details.
+;;;;
+;;;;  CMPC-TOP -- Dump all lisp forms and data
+;;;;
+
+(in-package "C-BACKEND")
+
+(defparameter +init-function-name+ (gensym "ENTRY-POINT"))
+
+(defun ctop-write (name h-pathname data-pathname
+                   &key shared-data
+                   &aux def top-output-string
+                   (*volatile* "volatile "))
+
+  (wt-nl1 "#include \"" (si::coerce-to-filename h-pathname) "\"")
+  ;; All lines from CLINES statements are grouped at the beginning of the header
+  ;; Notice that it does not make sense to guarantee that c-lines statements
+  ;; are produced in-between the function definitions, because two functions
+  ;; might be collapsed into one, or we might not produce that function at all
+  ;; and rather inline it.
+  (do ()
+      ((null *clines-string-list*))
+    (wt-nl-h (pop *clines-string-list*)))
+  (wt-nl-h "#ifdef __cplusplus")
+  (wt-nl-h "extern \"C\" {")
+  (wt-nl-h "#endif")
+  (when si::*compiler-constants*
+    (wt-nl-h "#include <string.h>"))
+  ;;; Initialization function.
+  (let* ((c-output-file *compiler-output1*)
+	 (*compiler-output1* (make-string-output-stream))
+	 (*compiler-declared-globals* (make-hash-table)))
+    (unless shared-data
+      (wt-nl1 "#include \"" (si::coerce-to-filename data-pathname) "\""))
+
+    ;; Type propagation phase
+    (when *do-type-propagation*
+      (setq *compiler-phase* 'p1propagate)
+      (dolist (form *top-level-forms*)
+        (p1propagate form nil))
+      (dolist (fun *local-funs*)
+        (propagate-function-types fun)))
+
+    (setq *compiler-phase* 't2)
+
+    ;; Optimization passes
+    (c-backend-passes)
+
+    ;; Emit entry function
+    (let ((*compile-to-linking-call* nil))
+      (t3local-fun *top-level-forms*))
+
+    ;; Now emit the rest
+    (let ((*compiler-output1* c-output-file))
+      (emit-local-funs *top-level-forms*))
+
+    (setq top-output-string (get-output-stream-string *compiler-output1*)))
+
+  ;; Declarations in h-file.
+  (wt-nl-h "static cl_object Cblock;")
+  (let ((num-objects (data-size)))
+    (if (zerop num-objects)
+	(progn
+	  (wt-nl-h "#undef ECL_DYNAMIC_VV")
+	  (wt-nl-h "#define compiler_data_text \"\"")
+	  (wt-nl-h "#define compiler_data_text_size 0")
+	  (wt-nl-h "#define VM 0")
+	  (wt-nl-h "#define VMtemp 0")
+	  (wt-nl-h "#define VV NULL"))
+	(progn
+	  (wt-nl-h "#define VM " (data-permanent-storage-size))
+	  (wt-nl-h "#define VMtemp "  (data-temporary-storage-size))
+	  (wt-nl-h "#ifdef ECL_DYNAMIC_VV")
+	  (wt-nl-h "static cl_object *VV;")
+	  (wt-nl-h "#else")
+	  (wt-nl-h "static cl_object VV[VM];")
+	  (wt-nl-h "#endif"))))
+
+  (dolist (l *linking-calls*)
+    (let* ((c-name (fourth l))
+	   (var-name (fifth l)))
+      (wt-nl-h "static cl_object " c-name "(cl_narg, ...);")
+      (wt-nl-h "static cl_object (*" var-name ")(cl_narg, ...)=" c-name ";")))
+
+  ;;; Initial functions for linking calls.
+  (dolist (l *linking-calls*)
+    (let* ((var-name (fifth l))
+	   (c-name (fourth l))
+	   (lisp-name (third l)))
+      (wt-nl1 "static cl_object " c-name "(cl_narg narg, ...)"
+	      "{TRAMPOLINK(narg," lisp-name ",&" var-name ",Cblock);}")))
+
+  (wt-nl-h "#ifdef __cplusplus")
+  (wt-nl-h "}")
+  (wt-nl-h "#endif")
+
+  (output-cfuns *compiler-output2*)
+
+  (setq *compiler-phase* 't3)
+
+  ;;; Callbacks
+  (when *callbacks*
+    (wt-nl-h "#include <ecl/internal.h>")
+    (dolist (x *callbacks*)
+      (apply #'t3-defcallback x)))
+
+  (wt-nl top-output-string))
+
+(defun output-cfuns (stream)
+  (let ((n-cfuns (length *global-cfuns-array*)))
+    (wt-nl-h "/*")
+    (wt-nl-h " * Exported Lisp functions")
+    (wt-nl-h " */")
+    (wt-nl-h "#define compiler_cfuns_size " n-cfuns)
+    (if (zerop n-cfuns)
+        (wt-nl-h "#define compiler_cfuns NULL")
+        (progn
+          (format stream "~%static const struct ecl_cfun compiler_cfuns[] = {~
+~%~t/*t,m,narg,padding,name,block,entry*/");
+          (loop for (loc fname-loc fun) in (nreverse *global-cfuns-array*)
+                do (let* ((cfun (fun-cfun fun))
+                          (minarg (fun-minarg fun))
+                          (maxarg (fun-maxarg fun))
+                          (narg (if (= minarg maxarg) maxarg nil)))
+                     (format stream "~%{0,0,~D,0,MAKE_FIXNUM(~D),MAKE_FIXNUM(~D),(cl_objectfn)~A,Cnil,MAKE_FIXNUM(~D)},"
+                             (or narg -1) (second loc) (second fname-loc)
+                             cfun (fun-file-position fun))))
+          (format stream "~%};")))))
+
+(defun emit-local-funs (fun)
+  (loop with *compile-time-too* = nil
+     with *compile-toplevel* = nil
+     with emitted-local-funs = (make-hash-table :test #'eql)
+     with pending = (fun-child-funs fun)
+     while pending
+     do (let ((f (pop pending)))
+          (when (gethash f emitted-local-funs)
+            (error "Doubly emitted function ~A" f))
+          (t3local-fun f)
+          (setf (gethash f emitted-local-funs) t
+                pending (append (fun-child-funs f) pending)))))
+
+(defun t3local-fun (fun)
+  (print-emitting fun)
+  (let* ((*current-function* fun)
+         (*lcl* (fun-last-lcl fun))
+         (*last-label* (fun-last-label fun))
+	 (*lex* 0)
+         (*max-lex* 0)
+	 (*env* (fun-env fun))		; continue growing env
+	 (*max-env* *env*)
+         (*env-lvl* 0)
+	 (*level* (if (eq (fun-closure fun) 'LEXICAL)
+                      (fun-level fun)
+                      0))
+         (*volatile* (if (fun-volatile-p fun) "volatile " ""))
+         (*permanent-data* t))
+    (c2translate (fun-lambda fun))))
+
diff --git a/src/new-cmp/cmpc-wt.lsp b/src/new-cmp/cmpc-wt.lsp
new file mode 100644
index 000000000..05d4e6622
--- /dev/null
+++ b/src/new-cmp/cmpc-wt.lsp
@@ -0,0 +1,76 @@
+;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
+;;;;
+;;;;  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 file '../Copyright' for full details.
+
+;;;; CMPWT -- Routines for writing code to C files.
+
+(in-package "C-BACKEND")
+
+(defvar *wt-string-size* 0)
+
+(defun wt-label (label)
+  (wt-nl1 "L" label ":;"))
+
+(defun wt-filtered-comment (text stream single-line)
+  (declare (string text))
+  (if single-line
+      (progn
+	(fresh-line stream)
+	(princ "/*	" stream))
+      (format stream "~50T/*  "))
+  (let* ((l (1- (length text))))
+    (declare (fixnum l))
+    (dotimes (n l)
+      (let ((c (schar text n)))
+	(princ c stream)
+	(when (and (char= c #\*) (char= (schar text (1+ n)) #\/))
+	  (princ #\\ stream))))
+    (princ (schar text l) stream))
+  (format stream "~70T*/")
+  )
+
+(defun do-wt-comment (message-or-format args single-line-p)
+  (unless (and (symbolp message-or-format) (not (symbol-package message-or-format)))
+    (wt-filtered-comment (if (stringp message-or-format)
+                             (if args
+                                 (apply #'format nil message-or-format args)
+                                 message-or-format)
+                             (princ-to-string message-or-format))
+                         *compiler-output1*
+                         single-line-p)))
+
+(defun wt-comment (message &rest extra)
+  (do-wt-comment message extra nil))
+
+(defun wt-comment-nl (message &rest extra)
+  (do-wt-comment message extra t))
+
+(defun wt1 (form)
+  (typecase form
+    ((or STRING INTEGER CHARACTER)
+     (princ form *compiler-output1*))
+    ((or DOUBLE-FLOAT SINGLE-FLOAT)
+     (format *compiler-output1* "~10,,,,,,'eG" form))
+    (LONG-FLOAT
+     (format *compiler-output1* "~,,,,,,'eEl" form))
+    (VAR (wt-var form))
+    (t (wt-loc form)))
+  nil)
+
+(defun wt-h1 (form)
+  (if (consp form)
+      (let ((fun (get-sysprop (car form) 'wt-loc)))
+	(if fun
+	    (let ((*compiler-output1* *compiler-output2*))
+	      (apply fun (cdr form)))
+	    (cmperr "The location ~s is undefined." form)))
+      (princ form *compiler-output2*))
+  nil)
diff --git a/src/new-cmp/cmpdata.lsp b/src/new-cmp/cmpdata.lsp
new file mode 100644
index 000000000..c8909f111
--- /dev/null
+++ b/src/new-cmp/cmpdata.lsp
@@ -0,0 +1,123 @@
+;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
+;;;;
+;;;;  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 file '../Copyright' for full details.
+
+;;;; CMPDATA     Collect data used in lisp code
+
+(in-package "COMPILER")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; DATA DATABASE
+;;;
+;;; Each lisp compiled file consists on code and a data section. Among
+;;; other optimizations Whenever an #'in-package toplevel form is
+;;; found, a read-time evaluated expression is inserted in the data
+;;; section which changes the current package for the rest of it. This
+;;; way it is possible to save some space by writing the symbol's
+;;; package only when it does not belong to the current package.
+
+(defun data-permanent-storage-size ()
+  (length *permanent-objects*))
+
+(defun data-temporary-storage-size ()
+  (length *temporary-objects*))
+
+(defun data-size ()
+  (+ (data-permanent-storage-size)
+     (data-temporary-storage-size)))
+
+(defun data-init (&optional filename)
+  (if (and filename (probe-file filename))
+      (with-open-file (s filename :direction :input)
+	(setf *permanent-objects* (read s)
+	      *temporary-objects* (read s)))
+      (setf *permanent-objects* (make-array 128 :adjustable t :fill-pointer 0)
+	    *temporary-objects* (make-array 128 :adjustable t :fill-pointer 0))))
+
+(defun data-get-all-objects ()
+  ;; We collect all objects that are to be externalized, but filter out
+  ;; those which will be created by a lisp form.
+  (loop for i in (nconc (map 'list #'first *permanent-objects*)
+			(map 'list #'first *temporary-objects*))
+	collect (if (gethash i *load-objects*)
+		    0
+		    i)))
+
+(defun data-empty-loc ()
+  (add-object 0 :duplicate t :permanent t))
+
+(defun add-load-form (object location)
+  (when (clos::need-to-make-load-form-p object)
+    (if (not (eq *compiler-phase* 't1))
+	(cmperr "Unable to internalize complex object ~A in ~a phase"
+                object *compiler-phase*)
+	(multiple-value-bind (make-form init-form) (make-load-form object)
+	  (setf (gethash object *load-objects*) location)
+          (setf *make-forms*
+                (nconc *make-forms*
+                       (and make-form (c1translate location make-form))
+                       (and init-form (c1translate location init-form))))))))
+
+(defun add-object (object &key (duplicate nil)
+		   (permanent (or (symbolp object) *permanent-data*)))
+  ;; FIXME! Currently we have two data vectors and, when compiling
+  ;; files, it may happen that a constant is duplicated and stored
+  ;; both in VV and VVtemp. This would not be a problem if the
+  ;; constant were readable, but due to using MAKE-LOAD-FORM we may
+  ;; end up having two non-EQ objects created for the same value.
+  (let* ((test (if *compiler-constants* 'eq 'equal))
+	 (array (if permanent *permanent-objects* *temporary-objects*))
+	 (vv (if permanent 'VV 'VV-temp))
+	 (x (or (and (not permanent)
+		     (find object *permanent-objects* :test test
+			   :key #'first))
+		(find object array :test test :key #'first)))
+	 (next-ndx (length array))
+	 found)
+    (cond ((and x duplicate)
+	   (setq x (list* vv next-ndx (if (eq 0 object) nil (list object))))
+	   (vector-push-extend (list object x next-ndx) array)
+	   x)
+	  (x
+	   (second x))
+	  ((and (not duplicate)
+		(symbolp object)
+		(multiple-value-setq (found x) (si::mangle-name object)))
+	   x)
+	  (t
+	   (setq x (list* vv next-ndx (if (eq 0 object) nil (list object))))
+	   (vector-push-extend (list object x next-ndx) array)
+	   (unless *compiler-constants*
+	     (add-load-form object x))
+	   x))))
+
+(defun add-symbol (symbol)
+  (add-object symbol :duplicate nil :permanent t))
+
+(defun add-keywords (keywords)
+  ;; We have to build, in the vector VV[], a sequence with all
+  ;; the keywords that this function uses. It does not matter
+  ;; whether each keyword has appeared separately before, because
+  ;; cl_parse_key() needs the whole list. However, we can reuse
+  ;; keywords lists from other functions when they coincide with ours.
+  ;; We search for keyword lists that are similar. However, the list
+  ;; *OBJECTS* contains elements in decreasing order!!!
+  (let ((x (search keywords *permanent-objects*
+		   :test #'(lambda (k record) (eq k (first record))))))
+    (if x
+	(progn
+	  (cmpnote "~@<Reusing keywords lists for ~_~A~@:>" keywords)
+	  (second (elt *permanent-objects* x)))
+	(prog1
+	    (add-object (pop keywords) :duplicate t :permanent t)
+	  (dolist (k keywords)
+	    (add-object k :duplicate t :permanent t))))))
diff --git a/src/new-cmp/cmpdefs.lsp b/src/new-cmp/cmpdefs.lsp
index d4ecaaa55..e623f1c75 100644
--- a/src/new-cmp/cmpdefs.lsp
+++ b/src/new-cmp/cmpdefs.lsp
@@ -45,6 +45,10 @@
 		"*COMPILER-CONSTANTS*" "REGISTER-GLOBAL" "CMP-ENV-REGISTER-MACROLET"
 		"COMPILER-LET"))
 
+(defpackage "C-BACKEND"
+  (:use "FFI" "CL" #+threads "MP" "C")
+  (:export "DUMP-ALL"))
+
 (in-package "COMPILER")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -505,8 +509,6 @@ lines are inserted, but the order is preserved")
 
 (defvar *use-static-constants-p* nil)   ; T/NIL flag to determine whether one may
                                         ; generate lisp constant values as C structs
-(defvar *static-constants* nil)		; constants that can be built as C values
-                                        ; holds { ( object c-variable constant ) }*
 
 (defvar *compiler-constants* nil)	; a vector with all constants
 					; only used in COMPILE
diff --git a/src/new-cmp/cmpeval.lsp b/src/new-cmp/cmpeval.lsp
index bc61a0a3f..23849c616 100644
--- a/src/new-cmp/cmpeval.lsp
+++ b/src/new-cmp/cmpeval.lsp
@@ -96,12 +96,6 @@
                     (c1call-global-op destination fname temps)
                     postfix))))))
 
-(defun c1progn (destination forms)
-  (or (loop for fl on forms
-         append (t1/c1expr (if (rest fl) 'TRASH destination)
-                           (first fl)))
-      (t1/c1expr destination 'NIL)))
-
 ;;; ----------------------------------------------------------------------
 
 (defvar *compiler-temps*
diff --git a/src/new-cmp/cmpexit.lsp b/src/new-cmp/cmpexit.lsp
deleted file mode 100644
index f7d2f7ca3..000000000
--- a/src/new-cmp/cmpexit.lsp
+++ /dev/null
@@ -1,186 +0,0 @@
-;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
-;;;;
-;;;;  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 file '../Copyright' for full details.
-
-;;;; CMPEXIT  Exit manager.
-
-(in-package "COMPILER")
-
-(defun unwind-bds (bds-lcl bds-bind stack-frame ihs-p)
-  (declare (fixnum bds-bind))
-  (when stack-frame
-    (if (stringp stack-frame)
-	(wt-nl "ecl_stack_frame_close(" stack-frame ");")
-	(wt-nl "ECL_STACK_SET_INDEX(cl_env_copy," stack-frame ");")))
-  (when bds-lcl
-    (wt-nl "ecl_bds_unwind(cl_env_copy," bds-lcl ");"))
-  (if (< bds-bind 4)
-      (dotimes (n bds-bind)
-	(declare (fixnum n))
-	(wt-nl "ecl_bds_unwind1(cl_env_copy);"))
-      (wt-nl "ecl_bds_unwind_n(cl_env_copy," bds-bind ");"))
-  (case ihs-p
-    (IHS (wt-nl "ecl_ihs_pop(cl_env_copy);"))
-    (IHS-ENV (wt-nl "ihs.lex_env = _ecl_debug_env;"))))
-
-(defun unwind-exit (loc &optional (jump-p nil) &aux (bds-lcl nil) (bds-bind 0) (stack-frame nil) (ihs-p nil))
-  (declare (fixnum bds-bind))
-  (when (consp *destination*)
-    (case (car *destination*)
-      (JUMP-TRUE
-       (set-jump-true loc (second *destination*))
-       (when (eq loc t) (return-from unwind-exit)))
-      (JUMP-FALSE
-       (set-jump-false loc (second *destination*))
-       (when (eq loc nil) (return-from unwind-exit)))))
-  (dolist (ue *unwind-exit* (baboon))
-    ;; perform all unwind-exit's which precede *exit*
-    (cond
-      ((consp ue)		    ; ( label# . ref-flag )| (STACK n) |(LCL n)
-       (cond ((eq (car ue) 'STACK)
-	      (setf stack-frame (second ue)))
-	     ((eq (car ue) 'LCL)
-	      (setq bds-lcl ue bds-bind 0))
-	     ((eq ue *exit*)
-	      ;; all body forms except the last (returning) are dealt here
-	      (cond ((and (consp *destination*)
-			  (or (eq (car *destination*) 'JUMP-TRUE)
-			      (eq (car *destination*) 'JUMP-FALSE)))
-		     (unwind-bds bds-lcl bds-bind stack-frame ihs-p))
-		    ((not (or bds-lcl (plusp bds-bind) stack-frame))
-		     (set-loc loc))
-		    ;; Save the value if LOC may possibly refer
-		    ;; to special binding.
-		    ((or (loc-refers-to-special loc)
-			 (loc-refers-to-special *destination*))
-		     (let* ((*temp* *temp*)
-			    (temp (make-temp-var)))
-		       (let ((*destination* temp))
-			 (set-loc loc)) ; temp <- loc
-		       (unwind-bds bds-lcl bds-bind stack-frame ihs-p)
-		       (set-loc temp))) ; *destination* <- temp
-		    (t
-		     (set-loc loc)
-		     (unwind-bds bds-lcl bds-bind stack-frame ihs-p)))
-	      (when jump-p (wt-nl) (wt-go *exit*))
-	      (return))
-	     (t (setq jump-p t))))
-      ((numberp ue) (baboon)
-       (setq bds-lcl ue bds-bind 0))
-      (t (case ue
-	   (IHS (setf ihs-p ue))
-           (IHS-ENV (setf ihs-p (or ihs-p ue)))
-	   (BDS-BIND (incf bds-bind))
-	   (RETURN
-	     (unless (eq *exit* 'RETURN) (baboon))
-	     ;; *destination* must be either RETURN or TRASH.
-	     (cond ((eq loc 'VALUES)
-		    ;; from multiple-value-prog1 or values
-		    (unwind-bds bds-lcl bds-bind stack-frame ihs-p)
-		    (wt-nl "return cl_env_copy->values[0];"))
-		   ((eq loc 'RETURN)
-		    ;; from multiple-value-prog1 or values
-		    (unwind-bds bds-lcl bds-bind stack-frame ihs-p)
-		    (wt-nl "return value0;"))      
-		   (t
-		    (let* ((*destination* 'RETURN))
-		      (set-loc loc))
-		    (unwind-bds bds-lcl bds-bind stack-frame ihs-p)
-		    (wt-nl "return value0;")))
-	     (return))
-	   ((RETURN-FIXNUM RETURN-CHARACTER RETURN-DOUBLE-FLOAT
-	     RETURN-SINGLE-FLOAT RETURN-OBJECT)
-	    (when (eq *exit* ue)
-	      ;; *destination* must be RETURN-FIXNUM
-	      (setq loc (list 'COERCE-LOC
-			      (getf '(RETURN-FIXNUM :fixnum
-				      RETURN-CHARACTER :char
-				      RETURN-SINGLE-FLOAT :float
-				      RETURN-DOUBLE-FLOAT :double
-				      RETURN-OBJECT :object)
-				    ue)
-			      loc))
-	      (if (or bds-lcl (plusp bds-bind))
-		  (let ((lcl (make-lcl-var :type (second loc))))
-		    (wt-nl "{cl_fixnum " lcl "= " loc ";")
-		    (unwind-bds bds-lcl bds-bind stack-frame ihs-p)
-		    (wt-nl "return(" lcl ");}"))
-		  (progn
-		    (wt-nl "return(" loc ");")))
-	      (return)))
-	   (FRAME
-	    (let ((*destination* (tmp-destination *destination*)))
-	      (set-loc loc)
-	      (setq loc *destination*))
-	    (wt-nl "ecl_frs_pop(cl_env_copy);"))
-	   (TAIL-RECURSION-MARK)
-	   (JUMP (setq jump-p t))
-	   (t (baboon))))))
-  ;;; Never reached
-  )
-
-(defun unwind-no-exit (exit &aux (bds-lcl nil) (bds-bind 0) (stack-frame nil) (ihs-p nil))
-  (declare (fixnum bds-bind))
-  (dolist (ue *unwind-exit* (baboon))
-    (cond
-       ((consp ue)
-	(cond ((eq ue exit)
-	       (unwind-bds bds-lcl bds-bind stack-frame ihs-p)
-	       (return))
-	      ((eq (first ue) 'STACK)
-	       (setf stack-frame (second ue)))))
-       ((numberp ue) (setq bds-lcl ue bds-bind 0))
-       ((eq ue 'BDS-BIND) (incf bds-bind))
-       ((member ue '(RETURN RETURN-OBJECT RETURN-FIXNUM RETURN-CHARACTER
-                            RETURN-DOUBLE-FLOAT RETURN-SINGLE-FLOAT))
-        (if (eq exit ue)
-          (progn (unwind-bds bds-lcl bds-bind stack-frame ihs-p)
-                 (return))
-          (baboon))
-        ;;; Never reached
-        )
-       ((eq ue 'FRAME) (wt-nl "ecl_frs_pop(cl_env_copy);"))
-       ((eq ue 'TAIL-RECURSION-MARK)
-        (if (eq exit 'TAIL-RECURSION-MARK)
-          (progn (unwind-bds bds-lcl bds-bind stack-frame ihs-p)
-                 (return))
-          (baboon))
-        ;;; Never reached
-        )
-       ((eq ue 'JUMP))
-       ((eq ue 'IHS-ENV)
-        (setf ihs-p ue))
-       (t (baboon))
-       ))
-  ;;; Never reached
-  )
-
-;;; Tail-recursion optimization for a function F is possible only if
-;;;	1. F receives only required parameters, and
-;;;	2. no required parameter of F is enclosed in a closure.
-;;;
-;;; A recursive call (F e1 ... en) may be replaced by a loop only if
-;;;	1. F is not declared as NOTINLINE,
-;;;	2. n is equal to the number of required parameters of F,
-;;;	3. the form is a normal function call (i.e. args are not ARGS-PUSHED),
-;;;	4. (F e1 ... en) is not surrounded by a form that causes dynamic
-;;;	   binding (such as LET, LET*, PROGV),
-;;;	5. (F e1 ... en) is not surrounded by a form that that pushes a frame
-;;;	   onto the frame-stack (such as BLOCK and TAGBODY whose tags are
-;;;	   enclosed in a closure, and CATCH),
-
-(defun tail-recursion-possible ()
-  (dolist (ue *unwind-exit* (baboon))
-    (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)))
-          (t (baboon)))))
diff --git a/src/new-cmp/cmpflet.lsp b/src/new-cmp/cmpflet.lsp
index 13b7f61ed..580fd3340 100644
--- a/src/new-cmp/cmpflet.lsp
+++ b/src/new-cmp/cmpflet.lsp
@@ -194,30 +194,6 @@
 	    (setf recompute t finish nil))))
       t)))
 
-(defun c1locally (destination args)
-  (multiple-value-bind (body ss ts is other-decl)
-      (c1body args t)
-    (let ((*cmp-env* (cmp-env-copy)))
-      (c1declare-specials ss)
-      (check-vdecl nil ts is)
-      (c1decl-body destination other-decl body))))
-
-(defun c1macrolet (destination args)
-  (check-args-number 'MACROLET args 1)
-  (let ((*cmp-env* (cmp-env-copy)))
-    (cmp-env-register-macrolet (first args) *cmp-env*)
-    (c1locally destination (cdr args))))
-
-(defun c1symbol-macrolet (destination args)
-  (check-args-number 'SYMBOL-MACROLET args 1)
-  (let ((*cmp-env* (cmp-env-copy)))
-    (dolist (def (car args))
-      (let ((name (first def)))	    
-	(cmpck (or (endp def) (not (symbolp name)) (endp (cdr def)))
-	     "The symbol-macro definition ~s is illegal." def)
-	(cmp-env-register-symbol-macro name (second def))))
-    (c1locally destination (cdr args))))
-
 (defun local-function-ref (fname &optional build-object)
   (multiple-value-bind (fun ccb clb unw)
       (cmp-env-search-function fname)
diff --git a/src/new-cmp/cmplam.lsp b/src/new-cmp/cmplam.lsp
index 5e032691a..b27941a74 100644
--- a/src/new-cmp/cmplam.lsp
+++ b/src/new-cmp/cmplam.lsp
@@ -433,6 +433,17 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts."
                  (loop for pair in (nreverse pairs)
                     collect `(optional-check-type ,@pair)))))))
 
+(defun exported-fname (name)
+  (let (cname)
+    (if (and (symbolp name)
+             (not (member name *notinline*))
+             (setf cname (get-sysprop name 'Lfun)))
+        (values cname t)
+        (values (next-cfun "L~D~A" name) nil))))
+
+(defun new-defun (new &optional no-entry)
+  (push new *global-funs*))
+
 #| Steps:
  1. defun creates declarations for requireds + va_alist
  2. c2lambda-expr adds declarations for:
diff --git a/src/new-cmp/cmpmain.lsp b/src/new-cmp/cmpmain.lsp
index e74e9b3d2..23c9fe534 100644
--- a/src/new-cmp/cmpmain.lsp
+++ b/src/new-cmp/cmpmain.lsp
@@ -390,7 +390,7 @@ static cl_object VV[VM];
 #endif
 #define ECL_SHARED_DATA_FILE 1
 " (data-permanent-storage-size))
-	   (data-dump c-file))
+	   (c-backend::data-dump c-file))
 	  (t
 	   (format c-file "
 #define compiler_data_text NULL
@@ -582,8 +582,8 @@ compiled successfully, returns the pathname of the compiled file"
                       :input-designator (namestring input-pathname))
 
       (if shared-data-file
-	  (data-dump shared-data-pathname t)
-	  (data-dump data-pathname))
+	  (c-backend::data-dump shared-data-pathname t)
+	  (c-backend::data-dump data-pathname))
 
       (let ((o-pathname (if system-p
                             output-file
@@ -796,10 +796,10 @@ from the C language code.  NIL means \"do not create the file\"."
 	     (data-init)
              (with-t1expr (init-name)
                (t1expr disassembled-form))
-	     (ctop-write init-name
-			 (if h-file h-file "")
-			 (if data-file data-file ""))
-	     (data-dump data-file))
+	     (c-backend::ctop-write init-name
+                                    (if h-file h-file "")
+                                    (if data-file data-file ""))
+	     (c-backend::data-dump data-file))
 	(setf (symbol-function 'T3LOCAL-FUN) t3local-fun)
 	(when h-file (close *compiler-output2*)))))
   nil)
@@ -816,10 +816,10 @@ from the C language code.  NIL means \"do not create the file\"."
     (wt-comment-nl "Source: ~A" input-designator)
     (with-open-file (*compiler-output2* h-pathname :direction :output)
       (wt-nl1 "#include " *cmpinclude*)
-      (catch *cmperr-tag* (ctop-write init-name
-				      h-pathname
-				      data-pathname
-				      :shared-data shared-data))
+      (catch *cmperr-tag* (c-backend::ctop-write init-name
+                                                 h-pathname
+                                                 data-pathname
+                                                 :shared-data shared-data))
       (terpri *compiler-output1*)
       (terpri *compiler-output2*))))
 
diff --git a/src/new-cmp/cmptables.lsp b/src/new-cmp/cmptables.lsp
index d4995d9b9..9e3669d7b 100644
--- a/src/new-cmp/cmptables.lsp
+++ b/src/new-cmp/cmptables.lsp
@@ -136,136 +136,3 @@
    ))
 
 (defparameter +c1-dispatch-table+ (make-dispatch-table +c1-dispatch-data+))
-
-;;; ------------------------------------------------------------------
-;;; C/C++ BACKEND
-;;;
-
-(defparameter +c2-dispatch-table+
- (make-dispatch-table
-  '(
-    (set . c2set)
-    (set-mv . c2set-mv)
-    (values . c2values-op)
-    (bind . c2bind)
-    (bind-special . c2bind-special)
-    (progv . c2progv-op)
-    (unbind . c2unbind)
-    (progv-exit . c2progv-exit-op)
-    (frame-pop . c2frame-pop)
-    (frame-set . c2frame-set)
-    (frame-save-next . c2frame-save-next)
-    (frame-jmp-next . c2frame-jmp-next)
-    (frame-id . c2frame-id)
-    (jmp . c2jmp)
-
-    (function-prologue . c2function-prologue)
-    (function-epilogue . c2function-epilogue)
-    
-    (bind-requireds . c2bind-requireds)
-    (varargs-bind . c2varargs-bind-op)
-    (varargs-pop . c2varargs-pop-op)
-    (varargs-rest . c2varargs-rest-op)
-    (varargs-unbind . c2varargs-unbind-op)
-
-    (stack-frame-open . c2stack-frame-open)
-    (stack-frame-push . c2stack-frame-push)
-    (stack-frame-push-values . c2stack-frame-push-values)
-    (stack-frame-pop-values . c2stack-frame-pop-values)
-    (stack-frame-apply . c2stack-frame-apply)
-    (stack-frame-close . c2stack-frame-close)
-
-    (throw . c2throw-op)
-    (return-from . c2return-from-op)
-    (go . c2go-op)
-    (funcall . c2funcall-op)
-    (call-local . c2call-local)
-    (call-global . c2call-global)
-
-    (debug-env-open . c2debug-env-open)
-    (debug-env-close . c2debug-env-close)
-    (debug-env-push-vars . c2debug-env-push-vars)
-    (debug-env-pop-vars . c2debug-env-pop-vars)
-
-    ;; cmpffi.lsp
-    (ffi:c-inline . c2c-inline)
-    
-    ;; cmpflet.lsp
-    (do-flet/labels . c2do-flet/labels)
-
-    ;; cmpstructures.lsp
-    ;; (sys:structure-ref . c2structure-ref)
-    ;; (sys:structure-set . c2structure-set)
-
-    ;; cmptop.lsp
-    (si:fset . c2fset)
-    )))
-
-(defparameter +c2-wt-loc-table+
- (make-dispatch-table
-  '(
-    ;; cmploc.lsp
-    (temp . wt-temp)
-    (lcl . wt-lcl-loc)
-    (vv . wt-vv)
-    (vv-temp . wt-vv-temp)
-    (car . wt-car)
-    (cdr . wt-cdr)
-    (cadr . wt-cadr)
-    (fixnum-value . wt-number)
-    (character-value . wt-character)
-    (long-float-value . wt-number)
-    (double-float-value . wt-number)
-    (single-float-value . wt-number)
-    (value . wt-value)
-    (keyvars . wt-keyvars)
-    (the . wt-the-loc)
-
-    (nil . wt-nil-loc)
-    (t . wt-t-loc)
-    (value0 . wt-value0-loc)
-    (return . wt-value0-loc)
-    (values+value0 . wt-value0-loc)
-    (values . wt-values-loc)
-    (va-arg . wt-va-arg-loc)
-    (cl-va-arg . wt-cl-va-arg-loc)
-
-    ;; cmpbackend.lsp
-    (call . wt-call)
-    (call-normal . wt-call-normal)
-    (call-indirect . wt-call-indirect)
-
-    ;; cmpffi.lsp
-    (ffi:c-inline . wt-c-inline-loc)
-    (coerce-loc . wt-coerce-loc)
-
-    ;; cmpspecial.ls
-    (fdefinition . wt-fdefinition)
-    (make-cclosure . wt-make-closure)
-
-    ;; cmpstructures.lsp
-    (sys:structure-ref . wt-structure-ref)
-    )))
-
-(defparameter +c2-set-loc-table+
- (make-dispatch-table
-  '(
-    ;; cmpbind.lsp
-    (bind . bind)
-
-    ;; cmploc.lsp
-    (values . set-values-loc)
-    (values+value0 . set-values+value0-loc)
-    (value0 . set-value0-loc)
-    (return . set-return-loc)
-    (actual-return . set-actual-return-loc)
-    (trash . set-trash-loc)
-    (the . set-the-loc)
-
-    ;; cmpbackend.lsp
-    (jmp-true . set-loc-jmp-true)
-    (jmp-false . set-loc-jmp-false)
-    (jmp-zero . set-loc-jmp-zero)
-    (jmp-nonzero . set-loc-jmp-nonzero)
-    )))
-
diff --git a/src/new-cmp/cmptop.lsp b/src/new-cmp/cmptop.lsp
index 7dd2cd127..865f32f96 100644
--- a/src/new-cmp/cmptop.lsp
+++ b/src/new-cmp/cmptop.lsp
@@ -25,8 +25,6 @@
                  ,@body))
            ,init-name))
 
-(defparameter +init-function-name+ (gensym "ENTRY-POINT"))
-
 (defun t1loop (body init-name)
   (let* ((only-argument (make-var :name (gensym "CBLOCK")
                                   :type T
@@ -91,131 +89,11 @@
 	(t
 	 (t1expr* destination form))))	
 
-(defun emit-local-funs (fun)
-  (loop with *compile-time-too* = nil
-     with *compile-toplevel* = nil
-     with emitted-local-funs = (make-hash-table :test #'eql)
-     with pending = (fun-child-funs fun)
-     while pending
-     do (let ((f (pop pending)))
-          (when (gethash f emitted-local-funs)
-            (error "Doubly emitted function ~A" f))
-          (t3local-fun f)
-          (setf (gethash f emitted-local-funs) t
-                pending (append (fun-child-funs f) pending)))))
-
-(defun ctop-write (name h-pathname data-pathname
-		        &key shared-data
-			&aux def top-output-string
-			(*volatile* "volatile "))
-
-  ;(let ((*print-level* 3)) (pprint *top-level-forms*))
-  (wt-nl1 "#include \"" (si::coerce-to-filename h-pathname) "\"")
-  ;; All lines from CLINES statements are grouped at the beginning of the header
-  ;; Notice that it does not make sense to guarantee that c-lines statements
-  ;; are produced in-between the function definitions, because two functions
-  ;; might be collapsed into one, or we might not produce that function at all
-  ;; and rather inline it.
-  (do ()
-      ((null *clines-string-list*))
-    (wt-nl-h (pop *clines-string-list*)))
-  (wt-nl-h "#ifdef __cplusplus")
-  (wt-nl-h "extern \"C\" {")
-  (wt-nl-h "#endif")
-  (when si::*compiler-constants*
-    (wt-nl-h "#include <string.h>"))
-  ;;; Initialization function.
-  (let* ((c-output-file *compiler-output1*)
-	 (*compiler-output1* (make-string-output-stream))
-	 (*compiler-declared-globals* (make-hash-table)))
-    (unless shared-data
-      (wt-nl1 "#include \"" (si::coerce-to-filename data-pathname) "\""))
-
-    ;; Type propagation phase
-    (when *do-type-propagation*
-      (setq *compiler-phase* 'p1propagate)
-      (dolist (form *top-level-forms*)
-        (p1propagate form nil))
-      (dolist (fun *local-funs*)
-        (propagate-function-types fun)))
-
-    (setq *compiler-phase* 't2)
-
-    ;; Optimization passes
-    (execute-pass 'pass-consistency)
-    (execute-pass 'pass-delete-no-side-effects)
-    (execute-pass 'pass-delete-unused-bindings)
-    (execute-pass 'pass-decide-var-rep-types)
-    (execute-pass 'pass-assign-labels)
-
-    ;; Emit entry function
-    (let ((*compile-to-linking-call* nil))
-      (t3local-fun *top-level-forms*))
-
-    ;; Now emit the rest
-    (let ((*compiler-output1* c-output-file))
-      (emit-local-funs *top-level-forms*))
-
-    (setq top-output-string (get-output-stream-string *compiler-output1*)))
-
-  ;; Declarations in h-file.
-  (wt-nl-h "static cl_object Cblock;")
-  (let ((num-objects (data-size)))
-    (if (zerop num-objects)
-	(progn
-	  (wt-nl-h "#undef ECL_DYNAMIC_VV")
-	  (wt-nl-h "#define compiler_data_text \"\"")
-	  (wt-nl-h "#define compiler_data_text_size 0")
-	  (wt-nl-h "#define VM 0")
-	  (wt-nl-h "#define VMtemp 0")
-	  (wt-nl-h "#define VV NULL"))
-	(progn
-	  (wt-nl-h "#define VM " (data-permanent-storage-size))
-	  (wt-nl-h "#define VMtemp "  (data-temporary-storage-size))
-	  (wt-nl-h "#ifdef ECL_DYNAMIC_VV")
-	  (wt-nl-h "static cl_object *VV;")
-	  (wt-nl-h "#else")
-	  (wt-nl-h "static cl_object VV[VM];")
-	  (wt-nl-h "#endif"))))
-
-  (dolist (l *linking-calls*)
-    (let* ((c-name (fourth l))
-	   (var-name (fifth l)))
-      (wt-nl-h "static cl_object " c-name "(cl_narg, ...);")
-      (wt-nl-h "static cl_object (*" var-name ")(cl_narg, ...)=" c-name ";")))
-
-  ;;; Initial functions for linking calls.
-  (dolist (l *linking-calls*)
-    (let* ((var-name (fifth l))
-	   (c-name (fourth l))
-	   (lisp-name (third l)))
-      (wt-nl1 "static cl_object " c-name "(cl_narg narg, ...)"
-	      "{TRAMPOLINK(narg," lisp-name ",&" var-name ",Cblock);}")))
-
-  (wt-nl-h "#ifdef __cplusplus")
-  (wt-nl-h "}")
-  (wt-nl-h "#endif")
-
-  (when (and (listp *static-constants*)
-             (setf *static-constants* (nreverse *static-constants*)))
-    (wt-nl-h "/*")
-    (wt-nl-h " * Statically defined constants")
-    (wt-nl-h " */")
-    (loop for (value name builder) in (reverse *static-constants*)
-          do (terpri *compiler-output2*)
-          do (funcall builder name value *compiler-output2*)))
-
-  (output-cfuns *compiler-output2*)
-
-  (setq *compiler-phase* 't3)
-
-  ;;; Callbacks
-  (when *callbacks*
-    (wt-nl-h "#include <ecl/internal.h>")
-    (dolist (x *callbacks*)
-      (apply #'t3-defcallback x)))
-
-  (wt-nl top-output-string))
+(defun c1progn (destination forms)
+  (or (loop for fl on forms
+         append (t1/c1expr (if (rest fl) 'TRASH destination)
+                           (first fl)))
+      (t1/c1expr destination 'NIL)))
 
 (defun c1eval-when (destination args)
   (check-args-number 'EVAL-WHEN args 1)
@@ -243,29 +121,6 @@
 	  (t
 	   (c1progn destination 'NIL)))))
 
-(defun exported-fname (name)
-  (let (cname)
-    (if (and (symbolp name)
-             (not (member name *notinline*))
-             (setf cname (get-sysprop name 'Lfun)))
-        (values cname t)
-        (values (next-cfun "L~D~A" name) nil))))
-
-(defun new-defun (new &optional no-entry)
-  (push new *global-funs*))
-
-(defun print-function (x)
-  (format t "~%<a FUN: ~A, CLOSURE: ~A, LEVEL: ~A, ENV: ~A>"
-	  (fun-name x) (fun-closure x) (fun-level x) (fun-env x)))
-
-(defun rep-type (type)
-  (case type
-    (FIXNUM "cl_fixnum ")
-    (CHARACTER "unsigned char ")
-    (SINGLE-FLOAT "float ")
-    (DOUBLE-FLOAT "double ")
-    (otherwise "cl_object ")))
-
 (defun t1ordinary (destination form)
   (when *compile-time-too* (cmp-eval form))
   (let* ((*compile-toplevel* nil)
@@ -296,48 +151,29 @@
 	   (setf loc (add-object (cmp-eval form)))))
     (c1set-loc destination loc)))
 
-(defun parse-cvspecs (x &aux (cvspecs nil))
-  (dolist (cvs x (nreverse cvspecs))
-    (cond ((symbolp cvs)
-           (push (list :OBJECT (string-downcase (symbol-name cvs))) cvspecs))
-          ((stringp cvs) (push (list :OBJECT cvs) cvspecs))
-          ((and (consp cvs)
-                (member (car cvs) '(OBJECT CHAR INT FLOAT DOUBLE)))
-           (dolist (name (cdr cvs))
-             (push (list (car cvs)
-                         (cond ((symbolp name)
-                                (string-downcase (symbol-name name)))
-                               ((stringp name) name)
-                               (t (cmperr "The C variable name ~s is illegal."
-                                          name))))
-                   cvspecs)))
-          (t (cmperr "The C variable specification ~s is illegal." cvs)))))
+(defun c1locally (destination args)
+  (multiple-value-bind (body ss ts is other-decl)
+      (c1body args t)
+    (let ((*cmp-env* (cmp-env-copy)))
+      (c1declare-specials ss)
+      (check-vdecl nil ts is)
+      (c1decl-body destination other-decl body))))
 
-(defun locative-type-from-var-kind (kind)
-  (cdr (assoc kind
-              '((:object . "_ecl_object_loc")
-                (:fixnum . "_ecl_fixnum_loc")
-                (:char . "_ecl_base_char_loc")
-                (:float . "_ecl_float_loc")
-                (:double . "_ecl_double_loc")
-                ((special global closure replaced discarded lexical) . NIL)))))
+(defun c1macrolet (destination args)
+  (check-args-number 'MACROLET args 1)
+  (let ((*cmp-env* (cmp-env-copy)))
+    (cmp-env-register-macrolet (first args) *cmp-env*)
+    (c1locally destination (cdr args))))
 
-(defun t3local-fun (fun)
-  (print-emitting fun)
-  (let* ((*current-function* fun)
-         (*lcl* (fun-last-lcl fun))
-         (*last-label* (fun-last-label fun))
-	 (*lex* 0)
-         (*max-lex* 0)
-	 (*env* (fun-env fun))		; continue growing env
-	 (*max-env* *env*)
-         (*env-lvl* 0)
-	 (*level* (if (eq (fun-closure fun) 'LEXICAL)
-                      (fun-level fun)
-                      0))
-         (*volatile* (if (fun-volatile-p fun) "volatile " ""))
-         (*permanent-data* t))
-    (c2translate (fun-lambda fun))))
+(defun c1symbol-macrolet (destination args)
+  (check-args-number 'SYMBOL-MACROLET args 1)
+  (let ((*cmp-env* (cmp-env-copy)))
+    (dolist (def (car args))
+      (let ((name (first def)))	    
+	(cmpck (or (endp def) (not (symbolp name)) (endp (cdr def)))
+	     "The symbol-macro definition ~s is illegal." def)
+	(cmp-env-register-symbol-macro name (second def))))
+    (c1locally destination (cdr args))))
 
 ;;; ----------------------------------------------------------------------
 ;;; Optimizer for FSET. Removes the need for a special handling of DEFUN as a
@@ -381,46 +217,6 @@
                                  unoptimized))))
           unoptimized))))
 
-(defun c2fset (fun fname macro pprint c1forms)
-  (when (fun-no-entry fun)
-    (wt-nl "(void)0; /* No entry created for "
-	   (format nil "~A" (fun-name fun))
-	   " */")
-    ;; FIXME! Look at c2function!
-    (new-local fun)
-    (return-from c2fset))
-  (when (fun-closure fun)
-    (return-from c2fset (c2call-global destination 'SI:FSET c1forms)))
-  (let ((*inline-blocks* 0)
-	(loc (data-empty-loc)))
-    (push (list loc fname fun) *global-cfuns-array*)
-    ;; FIXME! Look at c2function!
-    (new-local fun)
-    (wt-nl (if macro "ecl_cmp_defmacro(" "ecl_cmp_defun(")
-	   loc ");")
-    (close-inline-blocks)))
-
-(defun output-cfuns (stream)
-  (let ((n-cfuns (length *global-cfuns-array*)))
-    (wt-nl-h "/*")
-    (wt-nl-h " * Exported Lisp functions")
-    (wt-nl-h " */")
-    (wt-nl-h "#define compiler_cfuns_size " n-cfuns)
-    (if (zerop n-cfuns)
-        (wt-nl-h "#define compiler_cfuns NULL")
-        (progn
-          (format stream "~%static const struct ecl_cfun compiler_cfuns[] = {~
-~%~t/*t,m,narg,padding,name,block,entry*/");
-          (loop for (loc fname-loc fun) in (nreverse *global-cfuns-array*)
-                do (let* ((cfun (fun-cfun fun))
-                          (minarg (fun-minarg fun))
-                          (maxarg (fun-maxarg fun))
-                          (narg (if (= minarg maxarg) maxarg nil)))
-                     (format stream "~%{0,0,~D,0,MAKE_FIXNUM(~D),MAKE_FIXNUM(~D),(cl_objectfn)~A,Cnil,MAKE_FIXNUM(~D)},"
-                             (or narg -1) (second loc) (second fname-loc)
-                             cfun (fun-file-position fun))))
-          (format stream "~%};")))))
-
 ;;; ----------------------------------------------------------------------
 
 ;;; Pass 1 top-levels.
diff --git a/src/new-cmp/cmpwt.lsp b/src/new-cmp/cmpwt.lsp
deleted file mode 100644
index 35c62c157..000000000
--- a/src/new-cmp/cmpwt.lsp
+++ /dev/null
@@ -1,298 +0,0 @@
-;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
-;;;;
-;;;;  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 file '../Copyright' for full details.
-
-;;;; CMPWT  Output routines.
-
-(in-package "COMPILER")
-
-(defvar *wt-string-size* 0)
-
-;;; Each lisp compiled file consists on code and a data section. Whenever an
-;;; #'in-package toplevel form is found, a read-time evaluated expression is
-;;; inserted in the data section which changes the current package for the
-;;; rest of it. This way it is possible to save some space by writing the
-;;; symbol's package only when it does not belong to the current package.
-
-(defun wt-label (label)
-  (wt-nl1 "L" label ":;"))
-
-(defun wt-filtered-comment (text stream single-line)
-  (declare (string text))
-  (if single-line
-      (progn
-	(fresh-line stream)
-	(princ "/*	" stream))
-      (format stream "~50T/*  "))
-  (let* ((l (1- (length text))))
-    (declare (fixnum l))
-    (dotimes (n l)
-      (let ((c (schar text n)))
-	(princ c stream)
-	(when (and (char= c #\*) (char= (schar text (1+ n)) #\/))
-	  (princ #\\ stream))))
-    (princ (schar text l) stream))
-  (format stream "~70T*/")
-  )
-
-(defun do-wt-comment (message-or-format args single-line-p)
-  (unless (and (symbolp message-or-format) (not (symbol-package message-or-format)))
-    (wt-filtered-comment (if (stringp message-or-format)
-                             (if args
-                                 (apply #'format nil message-or-format args)
-                                 message-or-format)
-                             (princ-to-string message-or-format))
-                         *compiler-output1*
-                         single-line-p)))
-
-(defun wt-comment (message &rest extra)
-  (do-wt-comment message extra nil))
-
-(defun wt-comment-nl (message &rest extra)
-  (do-wt-comment message extra t))
-
-(defun wt1 (form)
-  (typecase form
-    ((or STRING INTEGER CHARACTER)
-     (princ form *compiler-output1*))
-    ((or DOUBLE-FLOAT SINGLE-FLOAT)
-     (format *compiler-output1* "~10,,,,,,'eG" form))
-    (LONG-FLOAT
-     (format *compiler-output1* "~,,,,,,'eEl" form))
-    (VAR (wt-var form))
-    (t (wt-loc form)))
-  nil)
-
-(defun wt-h1 (form)
-  (if (consp form)
-      (let ((fun (get-sysprop (car form) 'wt-loc)))
-	(if fun
-	    (let ((*compiler-output1* *compiler-output2*))
-	      (apply fun (cdr form)))
-	    (cmperr "The location ~s is undefined." form)))
-      (princ form *compiler-output2*))
-  nil)
-
-;;; This routine converts lisp data into C-strings. We have to take
-;;; care of escaping special characteres with backslashes. We also have
-;;; to split long lines using  the fact that multiple strings are joined
-;;; together by the compiler.
-;;;
-(defun wt-filtered-data (string stream &optional one-liner)
-  (let ((N (length string))
-	(wt-data-column 80))
-    (incf *wt-string-size* (1+ N)) ; 1+ accounts for a blank space
-    (format stream (if one-liner "\"" "~%\""))
-    (dotimes (i N)
-      (decf wt-data-column)
-      (when (< wt-data-column 0)
-	(format stream "\"~% \"")
-	(setq wt-data-column 79))
-      (let ((x (aref string i)))
-	(cond
-	  ((or (< (char-code x) 32)
-	       (> (char-code x) 127))
-	   (case x
-	     ; We avoid a trailing backslash+newline because some preprocessors
-	     ; remove them.
-	     (#\Newline (princ "\\n" stream))
-	     (#\Tab (princ "\\t" stream))
-	     (t (format stream "\\~3,'0o" (char-code x)))))
-	  ((char= x #\\)
-	   (princ "\\\\" stream))
-	  ((char= x #\")
-	   (princ "\\\"" stream))
-	  (t (princ x stream)))))
-    (princ (if one-liner "\""  " \"") stream)
-    string))
-
-;;; ======================================================================
-;;;
-;;; DATA FILES
-;;;
-
-(defun data-permanent-storage-size ()
-  (length *permanent-objects*))
-
-(defun data-temporary-storage-size ()
-  (length *temporary-objects*))
-
-(defun data-size ()
-  (+ (data-permanent-storage-size)
-     (data-temporary-storage-size)))
-
-(defun data-init (&optional filename)
-  (if (and filename (probe-file filename))
-      (with-open-file (s filename :direction :input)
-	(setf *permanent-objects* (read s)
-	      *temporary-objects* (read s)))
-      (setf *permanent-objects* (make-array 128 :adjustable t :fill-pointer 0)
-	    *temporary-objects* (make-array 128 :adjustable t :fill-pointer 0))))
-
-(defun data-get-all-objects ()
-  ;; We collect all objects that are to be externalized, but filter out
-  ;; those which will be created by a lisp form.
-  (loop for i in (nconc (map 'list #'first *permanent-objects*)
-			(map 'list #'first *temporary-objects*))
-	collect (if (gethash i *load-objects*)
-		    0
-		    i)))
-
-(defun data-dump (stream &key as-lisp-file init-name &aux must-close)
-  (etypecase stream
-    (null (return-from data-dump))
-    ((or pathname string)
-     (setf stream (open stream :direction :output :if-does-not-exist :create
-			:if-exists :supersede :external-format :default)
-	   must-close stream))
-    (stream))
-  (si::with-ecl-io-syntax
-    (let ((output nil))
-      (cond (as-lisp-file
-             (print *permanent-objects* stream)
-             (print *temporary-objects* stream))
-            (*compiler-constants*
-             (format stream "~%#define compiler_data_text NULL~%#define compiler_data_text_size 0~%")
-             (setf output (concatenate 'vector (data-get-all-objects))))
-            ((plusp (data-size))
-             (wt-data-begin stream)
-             (wt-filtered-data
-              (subseq (prin1-to-string (data-get-all-objects)) 1)
-              stream)
-             (wt-data-end stream)))
-      (when must-close
-        (close must-close))
-      (data-init)
-      output)))
-
-(defun wt-data-begin (stream)
-  (setq *wt-string-size* 0)
-  (setq *wt-data-column* 80)
-  (princ "static const char compiler_data_text[] = " stream)
-  nil)
-
-(defun wt-data-end (stream)
-  (princ #\; stream)
-  (format stream "~%#define compiler_data_text_size ~D~%" *wt-string-size*)
-  (setf *wt-string-size* 0))
-
-(defun data-empty-loc ()
-  (add-object 0 :duplicate t :permanent t))
-
-(defun add-load-form (object location)
-  (when (clos::need-to-make-load-form-p object)
-    (if (not (eq *compiler-phase* 't1))
-	(cmperr "Unable to internalize complex object ~A in ~a phase"
-                object *compiler-phase*)
-	(multiple-value-bind (make-form init-form) (make-load-form object)
-	  (setf (gethash object *load-objects*) location)
-          (setf *make-forms*
-                (nconc *make-forms*
-                       (and make-form (c1translate location make-form))
-                       (and init-form (c1translate location init-form))))))))
-
-(defun add-object (object &key (duplicate nil)
-		   (permanent (or (symbolp object) *permanent-data*)))
-  ;; FIXME! Currently we have two data vectors and, when compiling
-  ;; files, it may happen that a constant is duplicated and stored
-  ;; both in VV and VVtemp. This would not be a problem if the
-  ;; constant were readable, but due to using MAKE-LOAD-FORM we may
-  ;; end up having two non-EQ objects created for the same value.
-  (let* ((test (if *compiler-constants* 'eq 'equal))
-	 (array (if permanent *permanent-objects* *temporary-objects*))
-	 (vv (if permanent 'VV 'VV-temp))
-	 (x (or (and (not permanent)
-		     (find object *permanent-objects* :test test
-			   :key #'first))
-		(find object array :test test :key #'first)))
-	 (next-ndx (length array))
-	 found)
-    (cond ((add-static-constant object))
-          ((and x duplicate)
-	   (setq x (list* vv next-ndx (if (eq 0 object) nil (list object))))
-	   (vector-push-extend (list object x next-ndx) array)
-	   x)
-	  (x
-	   (second x))
-	  ((and (not duplicate)
-		(symbolp object)
-		(multiple-value-setq (found x) (si::mangle-name object)))
-	   x)
-	  (t
-	   (setq x (list* vv next-ndx (if (eq 0 object) nil (list object))))
-	   (vector-push-extend (list object x next-ndx) array)
-	   (unless *compiler-constants*
-	     (add-load-form object x))
-	   x))))
-
-(defun add-symbol (symbol)
-  (add-object symbol :duplicate nil :permanent t))
-
-(defun add-keywords (keywords)
-  ;; We have to build, in the vector VV[], a sequence with all
-  ;; the keywords that this function uses. It does not matter
-  ;; whether each keyword has appeared separately before, because
-  ;; cl_parse_key() needs the whole list. However, we can reuse
-  ;; keywords lists from other functions when they coincide with ours.
-  ;; We search for keyword lists that are similar. However, the list
-  ;; *OBJECTS* contains elements in decreasing order!!!
-  (let ((x (search keywords *permanent-objects*
-		   :test #'(lambda (k record) (eq k (first record))))))
-    (if x
-	(progn
-	  (cmpnote "~@<Reusing keywords lists for ~_~A~@:>" keywords)
-	  (second (elt *permanent-objects* x)))
-	(prog1
-	    (add-object (pop keywords) :duplicate t :permanent t)
-	  (dolist (k keywords)
-	    (add-object k :duplicate t :permanent t))))))
-
-;;; ======================================================================
-;;;
-;;; STATIC CONSTANTS
-;;;
-
-(defun static-base-string-builder (name value stream)
-  (format stream "ecl_def_ct_base_string(~A," name)
-  (wt-filtered-data value stream t)
-  (format stream ",~D,static,const);" (length value)))
-
-(defun static-single-float-builder (name value stream)
-  (let* ((*read-default-float-format* 'single-float)
-         (*print-readably* t))
-    (format stream "ecl_def_ct_single_float(~A,~S,static,const);" name value stream)))
-
-(defun static-double-float-builder (name value stream)
-  (let* ((*read-default-float-format* 'double-float)
-         (*print-readably* t))
-    (format stream "ecl_def_ct_single_float(~A,~S,static,const);" name value stream)))
-
-(defun static-constant-builder (format value)
-  (lambda (name stream)
-    (format stream format name value)))
-
-(defun static-constant-expression (object)
-  (typecase object
-    (base-string #'static-base-string-builder)
-    ;;(single-float #'static-single-float-builder)
-    ;;(double-float #'static-double-float-builder)
-    (t nil)))
-
-(defun add-static-constant (object)
-  (unless (or *compiler-constants* (not (listp *static-constants*)))
-    (let ((record (find object *static-constants* :key #'first :test #'equal)))
-      (if record
-          (second record)
-          (let ((builder (static-constant-expression object)))
-            (when builder
-              (let* ((c-name (format nil "_ecl_static_~D" (length *static-constants*))))
-                (push (list object c-name builder) *static-constants*)
-                `(VV ,c-name ,object))))))))
diff --git a/src/new-cmp/load.lsp.in b/src/new-cmp/load.lsp.in
index b50704415..49048fee6 100644
--- a/src/new-cmp/load.lsp.in
+++ b/src/new-cmp/load.lsp.in
@@ -40,7 +40,13 @@
   "src:new-cmp;cmpstructures.lsp"
   "src:new-cmp;cmparray.lsp"
   "src:new-cmp;cmppass.lsp"
-  "src:new-cmp;cmpbackend.lsp"
+  "src:new-cmp;cmpc-data.lsp"
+  "src:new-cmp;cmpc-wt.lsp"
+  "src:new-cmp;cmpc-loc.lsp"
+  "src:new-cmp;cmpc-set.lsp"
+  "src:new-cmp;cmpc-ops.lsp"
+  "src:new-cmp;cmpc-tables.lsp"
+  "src:new-cmp;cmpc-top.lsp"
   "src:new-cmp;cmpmain.lsp"))
 
 (let ((si::*keep-documentation* nil))