diff --git a/src/cmp/cmpbind.lsp b/src/cmp/cmpbind.lsp
index 40dbf6453..bee4a9d21 100644
--- a/src/cmp/cmpbind.lsp
+++ b/src/cmp/cmpbind.lsp
@@ -93,5 +93,3 @@
 	 (wt ");")))
   (push 'BDS-BIND *unwind-exit*)
   (wt-comment (var-name var)))
-
-(put-sysprop 'BIND 'SET-LOC 'bind)
diff --git a/src/cmp/cmpblock.lsp b/src/cmp/cmpblock.lsp
index 4bf352aae..b56753b5f 100644
--- a/src/cmp/cmpblock.lsp
+++ b/src/cmp/cmpblock.lsp
@@ -115,11 +115,3 @@
 	     (*exit* (blk-exit blk)))
 	 (c2expr val))))
   )
-
-;;; ----------------------------------------------------------------------
-
-(put-sysprop 'BLOCK 'C1SPECIAL 'c1block)
-(put-sysprop 'BLOCK 'C2 'c2block)
-
-(put-sysprop 'RETURN-FROM 'C1SPECIAL 'c1return-from)
-(put-sysprop 'RETURN-FROM 'C2 'c2return-from)
diff --git a/src/cmp/cmpc-wt.lsp b/src/cmp/cmpc-wt.lsp
index 1659412b8..9052a93db 100644
--- a/src/cmp/cmpc-wt.lsp
+++ b/src/cmp/cmpc-wt.lsp
@@ -28,7 +28,7 @@
 
 (defun wt-h1 (form)
   (if (consp form)
-      (let ((fun (get-sysprop (car form) 'wt-loc)))
+      (let ((fun (gethash (car form) *wt-loc-dispatch-table*)))
 	(if fun
 	    (let ((*compiler-output1* *compiler-output2*))
 	      (apply fun (cdr form)))
diff --git a/src/cmp/cmpcall.lsp b/src/cmp/cmpcall.lsp
index a418b8d94..a2386d9c6 100644
--- a/src/cmp/cmpcall.lsp
+++ b/src/cmp/cmpcall.lsp
@@ -273,13 +273,3 @@
     (when (fun-needs-narg fun)
       (push narg args))
     (wt-call fun-c-name args fun-lisp-name env)))
-
-;;; ----------------------------------------------------------------------
-
-(put-sysprop 'funcall 'C1 'c1funcall)
-(put-sysprop 'funcall 'c2 'c2funcall)
-(put-sysprop 'call-global 'c2 'c2call-global)
-
-(put-sysprop 'CALL 'WT-LOC #'wt-call)
-(put-sysprop 'CALL-NORMAL 'WT-LOC #'wt-call-normal)
-(put-sysprop 'CALL-INDIRECT 'WT-LOC #'wt-call-indirect)
diff --git a/src/cmp/cmpcatch.lsp b/src/cmp/cmpcatch.lsp
index 3e25a23c3..202de5562 100644
--- a/src/cmp/cmpcatch.lsp
+++ b/src/cmp/cmpcatch.lsp
@@ -97,12 +97,3 @@
        (let ((*destination* loc)) (c2expr* tag))))
   (let ((*destination* 'VALUES)) (c2expr* val))
   (wt-nl "cl_throw(" loc ");"))
-
-;;; ----------------------------------------------------------------------
-
-(put-sysprop 'CATCH 'C1SPECIAL 'c1catch)
-(put-sysprop 'CATCH 'C2 'c2catch)
-(put-sysprop 'UNWIND-PROTECT 'C1SPECIAL 'c1unwind-protect)
-(put-sysprop 'UNWIND-PROTECT 'C2 'c2unwind-protect)
-(put-sysprop 'THROW 'C1SPECIAL 'c1throw)
-(put-sysprop 'THROW 'C2 'c2throw)
diff --git a/src/cmp/cmpcbk.lsp b/src/cmp/cmpcbk.lsp
index dca2cd00f..15d13249d 100644
--- a/src/cmp/cmpcbk.lsp
+++ b/src/cmp/cmpcbk.lsp
@@ -133,5 +133,3 @@
 	     (foreign-elt-type-code return-type) ",aux);")
       (wt-nl "return output;"))
     (wt-nl1 "}")))
-
-(put-sysprop 'FFI:DEFCALLBACK 'C1 #'c1-defcallback)
diff --git a/src/cmp/cmpeval.lsp b/src/cmp/cmpeval.lsp
index 66d655afe..2539e9537 100644
--- a/src/cmp/cmpeval.lsp
+++ b/src/cmp/cmpeval.lsp
@@ -48,14 +48,9 @@
 (defun c1t () *c1t*)
 
 (defun c1call-symbol (fname args &aux fd)
-  (cond ((setq fd (get-sysprop fname 'c1special)) (funcall fd args))
-	((c1call-local fname args))
-	((and (setq fd (get-sysprop fname 'C1))
-	      (inline-possible fname))
+  (cond ((setq fd (gethash fname *c1-dispatch-table*))
 	 (funcall fd args))
-	((and (setq fd (get-sysprop fname 'C1CONDITIONAL))
-	      (inline-possible fname)
-	      (funcall fd args)))
+	((c1call-local fname args))
 	((and (setq fd (compiler-macro-function fname))
 	      (inline-possible fname)
 	      (let ((success nil))
@@ -118,7 +113,7 @@
   (with-c1form-env (form form)
     (let* ((name (c1form-name form))
            (args (c1form-args form))
-           (dispatch (get-sysprop name 'C2)))
+           (dispatch (gethash name *c2-dispatch-table*)))
       (if (or (eq name 'LET) (eq name 'LET*))
           (let ((*volatile* (c1form-volatile* form)))
             (declare (special *volatile*))
@@ -191,10 +186,3 @@
       `(progn
 	 (defun ,name ,vars ,@body)
 	 (define-compiler-macro ,name ,temps (list* 'LET ,binding ',body))))))
-
-;;; ----------------------------------------------------------------------
-
-(put-sysprop 'PROGN 'C1SPECIAL 'c1progn)
-(put-sysprop 'PROGN 'C2 'c2progn)
-(put-sysprop 'EXT:WITH-BACKEND 'C1SPECIAL 'c1with-backend)
-(put-sysprop 'EXT:WITH-BACKEND 'T1 'c1with-backend)
diff --git a/src/cmp/cmpffi.lsp b/src/cmp/cmpffi.lsp
index 289144764..3feb08108 100644
--- a/src/cmp/cmpffi.lsp
+++ b/src/cmp/cmpffi.lsp
@@ -563,9 +563,3 @@
 		  (cmperr "C-INLINE: Variable code exceeds number of arguments")))))
 	(otherwise
 	 (write-char c *compiler-output1*))))))
-
-(put-sysprop 'FFI:CLINES 'C1SPECIAL #'c1clines)
-(put-sysprop 'FFI:C-INLINE 'C1SPECIAL #'c1c-inline)
-(put-sysprop 'FFI:C-INLINE 'C2 #'c2c-inline)
-(put-sysprop 'FFI:C-INLINE 'WT-LOC #'wt-c-inline-loc)
-(put-sysprop 'COERCE-LOC 'WT-LOC #'wt-coerce-loc)
diff --git a/src/cmp/cmpflet.lsp b/src/cmp/cmpflet.lsp
index c6c331a1c..a5c16eb9b 100644
--- a/src/cmp/cmpflet.lsp
+++ b/src/cmp/cmpflet.lsp
@@ -263,16 +263,3 @@
           (*temp* *temp*))
       (unwind-exit (list 'CALL-NORMAL fun (coerce-locs (inline-args args))))
       (close-inline-blocks))))
-
-;;; ----------------------------------------------------------------------
-
-(put-sysprop 'FLET 'C1SPECIAL 'c1flet)
-(put-sysprop 'LABELS 'C1SPECIAL 'c1labels)
-(put-sysprop 'LOCALLY 'C1SPECIAL 'c1locally)
-(put-sysprop 'MACROLET 'C1SPECIAL 'c1macrolet)
-(put-sysprop 'SYMBOL-MACROLET 'C1SPECIAL 'c1symbol-macrolet)
-
-(put-sysprop 'LOCALS 'c2 'c2locals)	; replaces both c2flet and c2lables
-;;; c2macrolet is not defined, because MACROLET is replaced by PROGN
-;;; during Pass 1.
-(put-sysprop 'CALL-LOCAL 'C2 'c2call-local)
diff --git a/src/cmp/cmpfun.lsp b/src/cmp/cmpfun.lsp
index f8d622f61..1f7fa52c4 100644
--- a/src/cmp/cmpfun.lsp
+++ b/src/cmp/cmpfun.lsp
@@ -104,39 +104,6 @@
     (unwind-exit x)
     (close-inline-blocks)))
 
-(defun co1nth (args)
-  (and (not (endp args))
-       (not (endp (cdr args)))
-       (endp (cddr args))
-       (numberp (car args))
-       (<= 0 (car args) 7)
-       (c1expr (case (car args)
-		     (0 (cons 'CAR (cdr args)))
-		     (1 (cons 'CADR (cdr args)))
-		     (2 (cons 'CADDR (cdr args)))
-		     (3 (cons 'CADDDR (cdr args)))
-		     (4 (list 'CAR (cons 'CDDDDR (cdr args))))
-		     (5 (list 'CADR (cons 'CDDDDR (cdr args))))
-		     (6 (list 'CADDR (cons 'CDDDDR (cdr args))))
-		     (7 (list 'CADDDR (cons 'CDDDDR (cdr args))))
-		     ))))
-
-(defun co1nthcdr (args)
-  (and (not (endp args))
-       (not (endp (cdr args)))
-       (endp (cddr args))
-       (numberp (car args))
-       (<= 0 (car args) 7)
-       (c1expr (case (car args)
-		 (0 (second args))
-		 (1 (cons 'CDR (cdr args)))
-		 (2 (cons 'CDDR (cdr args)))
-		 (3 (cons 'CDDDR (cdr args)))
-		 (4 (cons 'CDDDDR (cdr args)))
-		 (5 (list 'CDR (cons 'CDDDDR (cdr args))))
-		 (6 (list 'CDDR (cons 'CDDDDR (cdr args))))
-		 (7 (list 'CDDDR (cons 'CDDDDR (cdr args))))))))
-
 ;;----------------------------------------------------------------------
 ;; We transform BOOLE into the individual operations, which have
 ;; inliners
@@ -165,41 +132,6 @@
 
 ;----------------------------------------------------------------------
 
-(defun co1coerce (args &aux expr type (info (make-info)))
-  (and args (cdr args) (endp (cddr args))
-       (let ((expr (first args))
-	     (type (second args)))
-	 (and (listp type)
-	      (eq (car type) 'QUOTE)
-	      (case (second type)
-		((CHARACTER BASE-CHAR) (c1expr `(CHARACTER ,expr)))
-		(FLOAT (c1expr `(FLOAT ,expr)))
-		(SHORT-FLOAT (c1expr `(FLOAT ,expr 0.0S0)))
-		(SINGLE-FLOAT (c1expr `(FLOAT ,expr 0.0F0)))
-		(DOUBLE-FLOAT (c1expr `(FLOAT ,expr 0.0D0)))
-		(LONG-FLOAT (c1expr `(FLOAT ,expr 0.0L0)))
-                )))))
-
-;----------------------------------------------------------------------
-;; turn repetitious cons's into a list*
-
-(defun co1cons (args &aux temp)
-  (labels ((cons-to-lista (x)
-	     (let ((tem (last x)))
-	       (if (and (consp tem)
-			(consp (car tem))
-			(eq (caar tem) 'CONS)
-			(eql (length (cdar tem)) 2))
-		   (cons-to-lista (append (butlast x) (cdar tem)))
-		   x))))
-    (and (eql (length args) 2)
-	 (not (eq args (setq temp (cons-to-lista args))))
-	 (c1expr (if (equal '(nil) (last temp))
-		     (cons 'LIST (butlast temp))
-		     (cons 'LIST* temp))))))
-
-;----------------------------------------------------------------------
-
 ;; Return the most particular type we can EASILY obtain from x.  
 (defun result-type (x)
   (cond ((symbolp x)
@@ -210,34 +142,3 @@
 	 (second x))
 	(t t)))
 
-;----------------------------------------------------------------------
-
-;;; Look for inline expansion of LDB1 in sysfun.lsp
-
-(defun co1ldb (args &aux (arg1 (first args))
-		    (len (integer-length most-positive-fixnum))
-		    size pos)
-    (and (consp arg1)
-	 (eq 'BYTE (car arg1))
-	 (integerp (setq size (second arg1)))
-	 (integerp (setq pos (third arg1)))
-	 (<= (+ size pos) len)
-	 (subtypep (result-type (second args)) 'FIXNUM)
-	 (c1expr `(the fixnum (ldb1 ,size ,pos ,(second args))))))
-
-;;; ----------------------------------------------------------------------
-
-(put-sysprop 'princ 'C1 'c1princ)
-(put-sysprop 'c2princ 'C2 'c2princ)
-(put-sysprop 'terpri 'C1 'c1terpri)
-
-(put-sysprop 'apply 'C1 'c1apply)
-
-(put-sysprop 'rplacd 'C1 'c1rplacd)
-(put-sysprop 'rplacd 'C2 'c2rplacd)
-
-(put-sysprop 'nth 'C1CONDITIONAL 'co1nth)
-(put-sysprop 'nthcdr 'C1CONDITIONAL 'co1nthcdr)
-
-(put-sysprop 'cons 'C1CONDITIONAL 'co1cons)
-(put-sysprop 'ldb 'C1CONDITIONAL 'co1ldb)
diff --git a/src/cmp/cmpif.lsp b/src/cmp/cmpif.lsp
index f95072907..c555f8e34 100644
--- a/src/cmp/cmpif.lsp
+++ b/src/cmp/cmpif.lsp
@@ -197,16 +197,3 @@
           (t
            (unwind-no-exit label)
            (wt-nl) (wt-go label)))))
-
-;;; ----------------------------------------------------------------------
-
-(put-sysprop 'if 'c1special 'c1if)
-(put-sysprop 'if 'c2 'c2if)
-(put-sysprop 'not 'c1 'c1not)
-(put-sysprop 'fmla-not 'c2 'c2fmla-not)
-(put-sysprop 'and 'c1 'c1and)
-(put-sysprop 'fmla-and 'c2 'c2fmla-and)
-(put-sysprop 'or 'c1 'c1or)
-(put-sysprop 'fmla-or 'c2 'c2fmla-or)
-(put-sysprop 'jump-true 'set-loc 'set-jump-true)
-(put-sysprop 'jump-false 'set-loc 'set-jump-false)
diff --git a/src/cmp/cmpinline.lsp b/src/cmp/cmpinline.lsp
index 40341ce08..6fd155a4a 100644
--- a/src/cmp/cmpinline.lsp
+++ b/src/cmp/cmpinline.lsp
@@ -168,7 +168,7 @@
   ;; Those functions that use INLINE-FUNCTION must rebind
   ;; the variable *INLINE-BLOCKS*.
   (and (inline-possible fname)
-       (not (get-sysprop fname 'C2))
+       (not (gethash fname *c2-dispatch-table*))
        (let* ((dest-rep-type (loc-representation-type *destination*))
               (dest-type (rep-type->lisp-type dest-rep-type))
               (ii (get-inline-info fname arg-types return-type return-rep-type)))
diff --git a/src/cmp/cmplet.lsp b/src/cmp/cmplet.lsp
index 4c84aeb1f..f9a6c9e68 100644
--- a/src/cmp/cmplet.lsp
+++ b/src/cmp/cmplet.lsp
@@ -328,9 +328,3 @@
 		    (and (member (var-kind v2) '(SPECIAL GLOBAL))
 			 (eql (var-name v1) (var-name v2)))))
 	(member var list))))
-
-;;; ----------------------------------------------------------------------
-
-(put-sysprop 'LET 'C1SPECIAL 'c1let)
-(put-sysprop 'LET* 'C1SPECIAL 'c1let*)
-(put-sysprop 'LET* 'C2 'c2let*)
diff --git a/src/cmp/cmploc.lsp b/src/cmp/cmploc.lsp
index f5ba6d9ba..9401fc087 100644
--- a/src/cmp/cmploc.lsp
+++ b/src/cmp/cmploc.lsp
@@ -148,14 +148,15 @@
         ((or (not (consp *destination*))
              (not (symbolp (car *destination*))))
          (baboon))
-        ((setq fd (get-sysprop (car *destination*) 'SET-LOC))
+        ((setq fd (gethash (car *destination*) *set-loc-dispatch-table*))
          (apply fd loc (cdr *destination*)))
-        ((setq fd (get-sysprop (car *destination*) 'WT-LOC))
+        ((setq fd (gethash (car *destination*) *wt-loc-dispatch-table*))
          (wt-nl) (apply fd (cdr *destination*)) (wt "= ")
 	 (wt-coerce-loc (loc-representation-type *destination*) loc)
 	 (wt ";"))
-        (t (baboon)))))
-  )
+        (t (baboon :format-control "Unknown location found in SET-LOC~%~S"
+		   :format-arguments (list loc)))))))
+
 
 (defun wt-loc (loc &aux fd)
   (cond ((eq loc nil) (wt "Cnil"))
@@ -174,11 +175,12 @@
 	 (wt-var loc))
         ((or (not (consp loc))
              (not (symbolp (car loc))))
-         (baboon))
-        ((setq fd (get-sysprop (car loc) 'WT-LOC))
+         (baboon :format-control "Unknown location found in WT-LOC~%~S"
+		 :format-arguments (list loc)))
+        ((setq fd (gethash (car loc) *wt-loc-dispatch-table*))
 	 (apply fd (cdr loc)))
-	(t (baboon)))
-  )
+	(t (baboon :format-control "Unknown location found in WT-LOC~%~S"
+		   :format-arguments (list loc)))))
 
 (defun last-call-p ()
   (member *exit*
@@ -234,20 +236,3 @@
 
 (defun values-loc (n)
   (list 'VALUE n))
-
-;;; -----------------------------------------------------------------
-
-(put-sysprop 'TEMP 'WT-LOC #'wt-temp)
-(put-sysprop 'LCL 'WT-LOC #'wt-lcl-loc)
-(put-sysprop 'VV 'WT-LOC #'wt-vv)
-(put-sysprop 'VV-temp 'WT-LOC #'wt-vv-temp)
-(put-sysprop 'CAR 'WT-LOC #'wt-car)
-(put-sysprop 'CDR 'WT-LOC #'wt-cdr)
-(put-sysprop 'CADR 'WT-LOC #'wt-cadr)
-(put-sysprop 'FIXNUM-VALUE 'WT-LOC #'wt-number)
-(put-sysprop 'CHARACTER-VALUE 'WT-LOC #'wt-character)
-(put-sysprop 'LONG-FLOAT-VALUE 'WT-LOC #'wt-number)
-(put-sysprop 'DOUBLE-FLOAT-VALUE 'WT-LOC #'wt-number)
-(put-sysprop 'SINGLE-FLOAT-VALUE 'WT-LOC #'wt-number)
-(put-sysprop 'VALUE 'WT-LOC #'wt-value)
-(put-sysprop 'KEYVARS 'WT-LOC #'wt-keyvars)
diff --git a/src/cmp/cmpmulti.lsp b/src/cmp/cmpmulti.lsp
index 094252653..29992ab38 100644
--- a/src/cmp/cmpmulti.lsp
+++ b/src/cmp/cmpmulti.lsp
@@ -298,15 +298,3 @@
     (wt "}"))
   )
 
-;;; ----------------------------------------------------------------------
-
-(put-sysprop 'multiple-value-call 'c1special 'c1multiple-value-call)
-(put-sysprop 'multiple-value-call 'c2 'c2multiple-value-call)
-(put-sysprop 'multiple-value-prog1 'c1special 'c1multiple-value-prog1)
-(put-sysprop 'multiple-value-prog1 'c2 'c2multiple-value-prog1)
-(put-sysprop 'values 'c1 'c1values)
-(put-sysprop 'values 'c2 'c2values)
-(put-sysprop 'multiple-value-setq 'c1 'c1multiple-value-setq)
-(put-sysprop 'multiple-value-setq 'c2 'c2multiple-value-setq)
-(put-sysprop 'multiple-value-bind 'c1 'c1multiple-value-bind)
-(put-sysprop 'multiple-value-bind 'c2 'c2multiple-value-bind)
diff --git a/src/cmp/cmpopt-bits.lsp b/src/cmp/cmpopt-bits.lsp
new file mode 100644
index 000000000..da8078f0c
--- /dev/null
+++ b/src/cmp/cmpopt-bits.lsp
@@ -0,0 +1,33 @@
+;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
+;;;;
+;;;;  Copyright (c) 2010, 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.
+;;;;
+;;;;  CMPOPT-BITS  -- Optimize operations acting on bits
+;;;;
+
+(in-package "COMPILER")
+
+;;;
+;;; LDB
+;;; Look for inline expansion of LDB1 in sysfun.lsp
+;;;
+
+(define-compiler-macro ldb (&whole whole &rest args)
+  (let ((arg1 (first args))
+	(len (integer-length most-positive-fixnum))
+	size pos)
+    (if (and (consp arg1)
+	     (eq 'BYTE (car arg1))
+	     (integerp (setq size (second arg1)))
+	     (integerp (setq pos (third arg1)))
+	     (<= (+ size pos) len)
+	     (subtypep (result-type (second args)) 'FIXNUM))
+	`(the fixnum (ldb1 ,size ,pos ,(second args)))
+	whole)))
diff --git a/src/cmp/cmpopt-cons.lsp b/src/cmp/cmpopt-cons.lsp
index acbc5a2b8..4afdb7b8b 100644
--- a/src/cmp/cmpopt-cons.lsp
+++ b/src/cmp/cmpopt-cons.lsp
@@ -44,6 +44,28 @@
   `(ffi:c-inline (,x) (:object) :object "ECL_CONS_CDR(#0)"
                  :one-liner t :side-effects nil))
 ;;;
+;;; CONS
+;;; turn repetitious cons's into a list*
+;;;
+
+(define-compiler-macro cons (&whole whole &rest args)
+  (labels ((cons-to-lista (x)
+	     (let ((tem (last x)))
+	       (if (and (consp tem)
+			(consp (car tem))
+			(eq (caar tem) 'CONS)
+			(eql (length (cdar tem)) 2))
+		   (cons-to-lista (append (butlast x) (cdar tem)))
+		   x))))
+    (let (temp)
+      (if (and (eql (length args) 2)
+	       (not (eq args (setq temp (cons-to-lista args)))))
+	  (if (equal '(nil) (last temp))
+	      (cons 'LIST (butlast temp))
+	      (cons 'LIST* temp))
+	  whole))))
+
+;;;
 ;;; RPLACA / RPLACD
 ;;;
 
@@ -57,3 +79,44 @@
 (define-simple-optimizer rplacd ((c cons) value)
   (:object :object) :object
   "@0;(ECL_CONS_CDR(#0)=#1,#0)" :one-liner t)
+
+;;;
+;;; NTH / NTHCDR
+;;;
+
+(define-compiler-macro nth (&whole whole &rest args)
+  (if (and (not (endp args))
+	   (not (endp (cdr args)))
+	   (endp (cddr args))
+	   (numberp (car args))
+	   (<= 0 (car args) 7))
+      (case (car args)
+	(0 (cons 'CAR (cdr args)))
+	(1 (cons 'CADR (cdr args)))
+	(2 (cons 'CADDR (cdr args)))
+	(3 (cons 'CADDDR (cdr args)))
+	(4 (list 'CAR (cons 'CDDDDR (cdr args))))
+	(5 (list 'CADR (cons 'CDDDDR (cdr args))))
+	(6 (list 'CADDR (cons 'CDDDDR (cdr args))))
+	(7 (list 'CADDDR (cons 'CDDDDR (cdr args))))
+	(t whole))
+      whole))
+
+(define-compiler-macro nthcdr (&whole whole &rest args)
+  (if (and (not (endp args))
+	   (not (endp (cdr args)))
+	   (endp (cddr args))
+	   (numberp (car args))
+	   (<= 0 (car args) 7))
+      (case (car args)
+	(0 (second args))
+	(1 (cons 'CDR (cdr args)))
+	(2 (cons 'CDDR (cdr args)))
+	(3 (cons 'CDDDR (cdr args)))
+	(4 (cons 'CDDDDR (cdr args)))
+	(5 (list 'CDR (cons 'CDDDDR (cdr args))))
+	(6 (list 'CDDR (cons 'CDDDDR (cdr args))))
+	(7 (list 'CDDDR (cons 'CDDDDR (cdr args))))
+	(t whole))
+      whole))
+
diff --git a/src/cmp/cmpopt-type.lsp b/src/cmp/cmpopt-type.lsp
index 0718b1f34..b25b548f8 100644
--- a/src/cmp/cmpopt-type.lsp
+++ b/src/cmp/cmpopt-type.lsp
@@ -46,5 +46,3 @@
                   (declare ,@declarations)
                   ,body)))
            ,@output)))))
-
-(put-sysprop 'EXT:COMPILER-TYPECASE 'C1SPECIAL 'C1COMPILER-TYPECASE)
diff --git a/src/cmp/cmpprop.lsp b/src/cmp/cmpprop.lsp
index 2c6416806..a4d803c9b 100644
--- a/src/cmp/cmpprop.lsp
+++ b/src/cmp/cmpprop.lsp
@@ -1,7 +1,6 @@
 ;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
 ;;;;
-;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
-;;;;  Copyright (c) 1990, Giuseppe Attardi.
+;;;;  Copyright (c) 2010, 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
@@ -181,20 +180,6 @@ of the occurrences in those lists."
   (let ((type (p1propagate body assumptions)))
     (values type assumptions)))
 
-(defun p1let (c1form base-assumptions vars forms body)
-  (let ((new-assumptions base-assumptions))
-    (loop for v in vars
-       for f in forms
-       do (multiple-value-bind (type ass)
-              (p1propagate f base-assumptions)
-            (setf new-assumptions (p1expand-assumptions v type new-assumptions))))
-    (multiple-value-bind (type assumptions)
-        (p1propagate body new-assumptions)
-      (loop for v in vars
-         do (revise-var-type v assumptions base-assumptions))
-      (values (setf (c1form-type c1form) type)
-              assumptions))))
-
 (defun p1let* (c1form base-assumptions vars forms body)
   (let ((assumptions base-assumptions))
     (loop for v in vars
@@ -307,7 +292,6 @@ as 2^*tagbody-limit* in the worst cases.")
 (put-sysprop 'decl-body 'p1propagate 'p1decl-body)
 (put-sysprop 'if 'p1propagate #'p1if)
 (put-sysprop 'LAMBDA 'P1PROPAGATE 'p1lambda)
-(put-sysprop 'LET 'P1PROPAGATE 'p1let)
 (put-sysprop 'LET* 'P1PROPAGATE 'p1let*)
 (put-sysprop 'LOCALS 'p1propagate 'p1locals)
 (put-sysprop 'MULTIPLE-VALUE-BIND 'p1propagate 'p1multiple-value-bind)
diff --git a/src/cmp/cmpspecial.lsp b/src/cmp/cmpspecial.lsp
index 050e17acd..67bc14ed3 100644
--- a/src/cmp/cmpspecial.lsp
+++ b/src/cmp/cmpspecial.lsp
@@ -148,18 +148,3 @@
 	   (wt "ecl_make_cfun((cl_objectfn_fixed)" cfun ",Cnil,Cblock," narg ")"))
 	  (t ; empty environment variable number of args
 	   (wt "ecl_make_cfun_va((cl_objectfn)" cfun ",Cnil,Cblock)")))))
-
-
-;;; ----------------------------------------------------------------------
-
-(put-sysprop 'quote 'c1special 'c1quote)
-(put-sysprop 'function 'c1special 'c1function)
-(put-sysprop 'function 'c2 'c2function)
-(put-sysprop 'the 'c1special 'c1the)
-(put-sysprop 'eval-when 'c1special 'c1eval-when)
-(put-sysprop 'declare 'c1special 'c1declare)
-(put-sysprop 'ext:compiler-let 'c1special 'c1compiler-let)
-(put-sysprop 'ext:compiler-let 'c2 'c2compiler-let)
-
-(put-sysprop 'fdefinition 'wt-loc 'wt-fdefinition)
-(put-sysprop 'make-cclosure 'wt-loc 'wt-make-closure)
diff --git a/src/cmp/cmpstack.lsp b/src/cmp/cmpstack.lsp
index f78016c06..15bf1a072 100644
--- a/src/cmp/cmpstack.lsp
+++ b/src/cmp/cmpstack.lsp
@@ -79,12 +79,3 @@
   (c1expr `(c-inline ,args (t t) (values &rest t)
 		     "cl_env_copy->values[0]=ecl_apply_from_stack_frame(#0,#1);"
 		     :one-liner nil :side-effects t)))
-
-(put-sysprop 'with-stack 'C1 #'c1with-stack)
-(put-sysprop 'with-stack 'c2 #'c2with-stack)
-(put-sysprop 'innermost-stack-frame 'C1 #'c1innermost-stack-frame)
-(put-sysprop 'stack-push 'C1 #'c1stack-push)
-(put-sysprop 'stack-push-values 'C1 #'c1stack-push-values)
-(put-sysprop 'stack-push-values 'C2 #'c2stack-push-values)
-(put-sysprop 'stack-pop 'C1 #'c1stack-pop)
-(put-sysprop 'si::apply-from-stack-frame 'c1 #'c1apply-from-stack-frame)
\ No newline at end of file
diff --git a/src/cmp/cmpstructures.lsp b/src/cmp/cmpstructures.lsp
index 7c4e3f1c8..fe2a25838 100644
--- a/src/cmp/cmpstructures.lsp
+++ b/src/cmp/cmpstructures.lsp
@@ -142,9 +142,3 @@
         (wt-nl "(" x ")->str.self[" index "]= " y ";"))
     (unwind-exit y)
     (close-inline-blocks)))
-
-(put-sysprop 'SYS:STRUCTURE-REF 'C1 'c1structure-ref)
-(put-sysprop 'SYS:STRUCTURE-REF 'C2 'c2structure-ref)
-(put-sysprop 'SYS:STRUCTURE-REF 'WT-LOC 'wt-structure-ref)
-(put-sysprop 'SYS:STRUCTURE-SET 'C1 'c1structure-set)
-(put-sysprop 'SYS:STRUCTURE-SET 'C2 'c2structure-set)
diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp
new file mode 100644
index 000000000..657a40376
--- /dev/null
+++ b/src/cmp/cmptables.lsp
@@ -0,0 +1,206 @@
+;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
+;;;;
+;;;;  Copyright (c) 2010, 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.
+
+;;;; CMPPROP Type propagation.
+
+(in-package "COMPILER")
+
+(defconstant +c1-dispatch-alist+
+  '((block . c1block) ; c1special
+    (return-from . c1return-from) ; c1special
+    (funcall . c1funcall) ; c1
+    (catch . c1catch) ; c1special
+    (unwind-protect . c1unwind-protect) ; c1special
+    (throw . c1throw) ; c1special
+    (ffi:defcallback . c1-defcallback) ; c1
+    (progn . c1progn) ; c1special
+    (ext:with-backend . c1with-backend) ; c1special
+    (ffi:clines . c1clines) ; c1special
+    (ffi:c-inline . c1c-inline) ; c1special
+    (flet . c1flet) ; c1special
+    (labels . c1labels) ; c1special
+    (locally . c1locally) ; c1special
+    (macrolet . c1macrolet) ; c1special
+    (symbol-macrolet . c1symbol-macrolet) ; c1special
+
+    (if . c1if) ; c1special
+    (not . c1not) ; c1special
+    (and . c1and) ; c1special
+    (or . c1or) ; c1special
+
+    (let . c1let) ; c1special
+    (let* . c1let*) ; c1special
+
+    (multiple-value-call . c1multiple-value-call) ; c1special
+    (multiple-value-prog1 . c1multiple-value-prog1) ; c1special
+    (values . c1values) ; c1
+    (multiple-value-setq . c1multiple-value-setq) ; c1
+    (multiple-value-bind . c1multiple-value-bind) ; c1
+
+    (ext:compiler-typecase . c1compiler-typecase) ; c1special
+
+    (quote . c1quote) ; c1special
+    (function . c1function) ; c1special
+    (the . c1the) ; c1special
+    (eval-when . c1eval-when) ; c1special
+    (declare . c1declare) ; c1special
+    (ext:compiler-let . c1compiler-let) ; c1special
+
+    (with-stack . c1with-stack) ; c1
+    (innermost-stack-frame . c1innermost-stack-frame) ; c1
+    (stack-push . c1stack-push) ; c1
+    (stack-push-values . c1stack-push-values) ; c1
+    (stack-pop . c1stack-pop) ; c1
+    (si::apply-from-stack-frame . c1apply-from-stack-frame) ; c1
+
+    (tagbody . c1tagbody) ; c1special
+    (go . c1go) ; c1special
+
+    (setq . c1setq) ; c1special
+    (progv . c1progv) ; c1special
+    (psetq . c1psetq) ; c1special
+
+    (sys:structure-ref . c1structure-ref) ; c1
+    (sys:structure-set . c1structure-set) ; c1
+
+    (load-time-value . c1load-time-value) ; c1
+    (si:fset . c1fset) ; c1
+
+    (princ . c1princ) ; c1
+    (terpri . c1terpri) ; c1
+    (apply . c1apply) ; c1
+    (rplacd . c1rplacd) ; c1
+    ))
+
+(defconstant +t1-dispatch-alist+
+  '((ext:with-backend . c1with-backend) ; t1
+
+    (defmacro . t1defmacro)
+    (compiler-let . c1compiler-let)
+    (eval-when . c1eval-when)
+    (progn . c1progn)
+    (macrolet . c1macrolet)
+    (locally . c1locally)
+    (symbol-macrolet . c1symbol-macrolet)
+    ))
+
+(defconstant +set-loc-dispatch-alist+
+  '((bind . bind)
+    (jump-true . set-jump-true)
+    (jump-false . set-jump-false)
+    ))
+
+(defconstant +wt-loc-dispatch-alist+
+  '((call . wt-call)
+    (call-normal . wt-call-normal)
+    (call-indirect . wt-call-indirect)
+    (ffi:c-inline . wt-c-inline-loc)
+    (coerce-loc . wt-coerce-loc)
+
+    (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)
+    (long-float-value . wt-number)
+    (double-float-value . wt-number)
+    (single-float-value . wt-number)
+    (short-float-value . wt-number)
+    (character-value . wt-character)
+    (value . wt-value)
+    (keyvars . wt-keyvars)
+
+    (fdefinition . wt-fdefinition)
+    (make-cclosure . wt-make-closure)
+
+    (structure-ref . wt-structure-ref)
+    ))
+
+(defconstant +c2-dispatch-alist+
+  '((block . c2block) ; c2
+    (return-from . c2return-from) ; c2
+    (funcall . c2funcall) ; c2
+    (call-global . c2call-global) ; c2
+    (catch . c2catch) ; c2
+    (unwind-protect . c2unwind-protect) ; c2
+    (throw . c2throw) ; c2
+    (progn . c2progn) ; c2
+    (ffi:c-inline . c2c-inline) ; c2
+    (locals . c2locals) ; c2
+    (call-local . c2call-local) ; c2
+
+    (if . c2if)
+    (fmla-not . c2fmla-not)
+    (fmla-and . c2fmla-and)
+    (fmla-or . c2fmla-or)
+
+    (let* . c2let*)
+
+    (multiple-value-call . c2multiple-value-call) ; c2
+    (multiple-value-prog1 . c2multiple-value-prog1) ; c2
+    (values . c2values) ; c2
+    (multiple-value-setq . c2multiple-value-setq) ; c2
+    (multiple-value-bind . c2multiple-value-bind) ; c2
+
+    (function . c2function) ; c2
+    (ext:compiler-let . c2compiler-let) ; c2
+
+    (with-stack . c2with-stack) ; c2
+    (stack-push-values . c2stack-push-values) ; c2
+
+    (tagbody . c2tagbody) ; c2
+    (go . c2go) ; c2
+
+    (var . c2var) ; c2
+    (location . c2location) ; c2
+    (setq . c2setq) ; c2
+    (progv . c2progv) ; c2
+    (psetq . c2psetq) ; c2
+
+    (si:fset . c2fset) ; c2
+
+    (sys:structure-ref . c2structure-ref) ; c2
+    (sys:structure-set . c2structure-set) ; c2
+
+    (c2princ . c2princ) ; c2
+    (rplacd . c2rplacd) ; c2
+    ))
+
+(defconstant +t2-dispatch-alist+
+  '((compiler-let . t2compiler-let)
+    (progn . t2progn)
+    (ordinary . t2ordinary)
+    (load-time-value . t2load-time-value)
+    (make-form . t2make-form)
+    (init-form . t2init-form)
+    ))
+
+(defun make-dispatch-table (alist)
+  (loop with hash = (make-hash-table :size (max 128 (* 2 (length alist)))
+				     :test #'eq)
+     for (name . function) in alist
+     do (setf (gethash name hash) function)
+     finally (return hash)))
+
+(defparameter *c1-dispatch-table* (make-dispatch-table +c1-dispatch-alist+))
+
+(defparameter *t1-dispatch-table* (make-dispatch-table +t1-dispatch-alist+))
+
+(defparameter *c2-dispatch-table* (make-dispatch-table +c2-dispatch-alist+))
+
+(defparameter *set-loc-dispatch-table* (make-dispatch-table +set-loc-dispatch-alist+))
+
+(defparameter *wt-loc-dispatch-table* (make-dispatch-table +wt-loc-dispatch-alist+))
+
+(defparameter *t2-dispatch-table* (make-dispatch-table +t2-dispatch-alist+))
diff --git a/src/cmp/cmptag.lsp b/src/cmp/cmptag.lsp
index 04164a293..cd6604db0 100644
--- a/src/cmp/cmptag.lsp
+++ b/src/cmp/cmptag.lsp
@@ -217,11 +217,3 @@
       (progn
 	(unwind-no-exit (tag-unwind-exit tag))
 	(wt-nl) (wt-go (tag-label tag)))))
-
-;;; ------------------------------------------------------------
-
-(put-sysprop 'tagbody 'c1special 'c1tagbody)
-(put-sysprop 'tagbody 'c2 'c2tagbody)
-
-(put-sysprop 'go 'c1special 'c1go)
-(put-sysprop 'go 'c2 'c2go)
diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp
index 7f001a7af..bf757e995 100644
--- a/src/cmp/cmptop.lsp
+++ b/src/cmp/cmptop.lsp
@@ -41,9 +41,9 @@
 	     (cmperr "~s is illegal function." fun))
 	    ((eq fun 'QUOTE)
 	     (t1ordinary 'NIL))
-	    ((setq fd (get-sysprop fun 'T1))
+	    ((setq fd (gethash fun *t1-dispatch-table*))
 	     (funcall fd args))
-	    ((or (get-sysprop fun 'C1) (get-sysprop fun 'C1SPECIAL))
+	    ((gethash fun *c1-dispatch-table*)
              (t1ordinary form))
 	    ((and (setq fd (compiler-macro-function fun))
 		  (inline-possible fun)
@@ -69,7 +69,7 @@
 
 (defun t2expr (form)
   (when form
-    (let* ((def (get-sysprop (c1form-name form) 'T2)))
+    (let* ((def (gethash (c1form-name form) *t2-dispatch-table*)))
       (if def
           (let ((*compile-file-truename* (c1form-file form))
                 (*compile-file-position* (c1form-file-position form))
@@ -812,29 +812,7 @@
 
 ;;; ----------------------------------------------------------------------
 
-;;; Pass 1 top-levels.
-
-(put-sysprop 'DEFMACRO 'T1 't1defmacro)
-(put-sysprop 'COMPILER-LET 'T1 'c1compiler-let)
-(put-sysprop 'EVAL-WHEN 'T1 'c1eval-when)
-(put-sysprop 'PROGN 'T1 'c1progn)
-(put-sysprop 'MACROLET 'T1 'c1macrolet)
-(put-sysprop 'LOCALLY 'T1 'c1locally)
-(put-sysprop 'SYMBOL-MACROLET 'T1 'c1symbol-macrolet)
-(put-sysprop 'LOAD-TIME-VALUE 'C1 'c1load-time-value)
-(put-sysprop 'SI:FSET 'C1 'c1fset)
-
 ;;; Pass 1 1/2 type propagation
 
 (put-sysprop 'ORDINARY 'P1PROPAGATE 'p1ordinary)
 (put-sysprop 'SI:FSET 'P1PROPAGATE 'p1fset)
-
-;;; Pass 2 initializers.
-
-(put-sysprop 'COMPILER-LET 'T2 't2compiler-let)
-(put-sysprop 'PROGN 'T2 't2progn)
-(put-sysprop 'ORDINARY 'T2 't2ordinary)
-(put-sysprop 'LOAD-TIME-VALUE 'T2 't2load-time-value)
-(put-sysprop 'MAKE-FORM 'T2 't2make-form)
-(put-sysprop 'INIT-FORM 'T2 't2init-form)
-(put-sysprop 'SI:FSET 'C2 'c2fset)
diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp
index 5ae88a3cb..2911c1bad 100644
--- a/src/cmp/cmpvar.lsp
+++ b/src/cmp/cmpvar.lsp
@@ -448,14 +448,3 @@
   (dotimes (i blocks) (wt "}"))
   (unwind-exit nil)
   )
-
-;;; ----------------------------------------------------------------------
-
-(put-sysprop 'VAR 'C2 'c2var)
-(put-sysprop 'LOCATION 'C2 'c2location)
-(put-sysprop 'SETQ 'c1special 'c1setq)
-(put-sysprop 'SETQ 'C2 'c2setq)
-(put-sysprop 'PROGV 'c1special 'c1progv)
-(put-sysprop 'PROGV 'C2 'c2progv)
-(put-sysprop 'PSETQ 'c1 'c1psetq)
-(put-sysprop 'PSETQ 'C2 'c2psetq)
diff --git a/src/cmp/load.lsp.in b/src/cmp/load.lsp.in
index 413b8a26e..d94b408ca 100644
--- a/src/cmp/load.lsp.in
+++ b/src/cmp/load.lsp.in
@@ -7,6 +7,7 @@
   "build:cmp;cmpdefs.lsp"
   "src:cmp;cmpmac.lsp"
   "src:cmp;cmpform.lsp"
+  "src:cmp;cmptables.lsp"
   "src:cmp;cmpc-wt.lsp"
   "src:cmp;cmpinline.lsp"
   "src:cmp;cmputil.lsp"
@@ -45,6 +46,7 @@
   "src:cmp;cmpnum.lsp"
   "src:cmp;cmpname.lsp"
   "src:cmp;cmpopt.lsp"
+  "src:cmp;cmpopt-bits.lsp"
   "src:cmp;cmpopt-constant.lsp"
   "src:cmp;cmpopt-cons.lsp"
   "src:cmp;cmpopt-sequence.lsp"