diff --git a/src/c/compiler.d b/src/c/compiler.d
index 5e0e4e0ed..a8a922ab7 100644
--- a/src/c/compiler.d
+++ b/src/c/compiler.d
@@ -2885,16 +2885,15 @@ si_process_lambda(cl_object lambda)
  * VALUES(5) = allow-other-keys                 ; flag &allow-other-keys
  * VALUES(6) = (N aux1 init1 ... )              ; auxiliary variables
  *
- * 1°) The prefix "N" is an integer value denoting the number of
- * variables which are declared within this section of the lambda
- * list.
+ * 1) The prefix "N" is an integer value denoting the number of variables
+ * which are declared within this section of the lambda list.
  *
- * 2°) The INIT* arguments are lisp forms which are evaluated when
- * no value is provided.
+ * 2) The INIT* arguments are lisp forms which are evaluated when no value is
+ * provided.
  *
- * 3°) The FLAG* arguments is the name of a variable which holds a
- * boolean value in case an optional or keyword argument was
- * provided. If it is NIL, no such variable exists.
+ * 3) The FLAG* arguments is the name of a variable which holds a boolean
+ * value in case an optional or keyword argument was provided. If it is NIL,
+ * no such variable exists.
  */
 
 cl_object
@@ -3088,15 +3087,16 @@ si_process_lambda_list(cl_object org_lambda_list, cl_object context)
 
  OUTPUT:
   if ((nreq+nopt+(!Null(rest))+nkey) >= ECL_CALL_ARGUMENTS_LIMIT)
-    FEprogram_error("LAMBDA: Argument list is too long, ~S.", 1,
-                             org_lambda_list);
-  @(return CONS(ecl_make_fixnum(nreq), lists[0])
+    FEprogram_error("LAMBDA: Argument list is too long, ~S.", 1, org_lambda_list);
+
+  @(return
+    CONS(ecl_make_fixnum(nreq), lists[0])
     CONS(ecl_make_fixnum(nopt), lists[1])
     rest
     key_flag
     CONS(ecl_make_fixnum(nkey), lists[2])
     allow_other_keys
-    lists[3]);
+    CONS(ecl_make_fixnum(naux), lists[3]))
 
  ILLEGAL_LAMBDA:
   FEprogram_error("LAMBDA: Illegal lambda list ~S.", 1, org_lambda_list);
@@ -3195,7 +3195,7 @@ ecl_make_lambda(cl_env_ptr env, cl_object name, cl_object lambda) {
     }
     ECL_RPLACD(aux, names);
   }
-
+  auxs = ECL_CONS_CDR(auxs);
   while (!Null(auxs)) {                   /* Local bindings */
     cl_object var = pop(&auxs);
     cl_object value = pop(&auxs);
diff --git a/src/clos/combin.lsp b/src/clos/combin.lsp
index 93311a269..480584a60 100644
--- a/src/clos/combin.lsp
+++ b/src/clos/combin.lsp
@@ -167,294 +167,7 @@
                                       (nconc (rest around) main)))
           (if (or before after)
               (standard-main-effective-method before primary after)
-              (combine-method-functions (first primary) (rest primary))))
-      )))
-
-;; ----------------------------------------------------------------------
-;; DEFINE-METHOD-COMBINATION
-;;
-;; METHOD-COMBINATION objects are just a list
-;;      (name arg*)
-;; where NAME is the name of the method combination type defined with
-;; DEFINE-METHOD-COMBINATION, and ARG* is zero or more arguments.
-;;
-;; For each method combination type there is an associated function,
-;; and the list of all known method combination types is kept in
-;; *METHOD-COMBINATIONS* in the form of property list:
-;;      (mc-type-name1 function1 mc-type-name2 function2 ....)
-;;
-;; FUNCTIONn is the function associated to a method combination. It
-;; is of type (FUNCTION (generic-function method-list) FUNCTION),
-;; and it outputs an anonymous function which is the effective method.
-;;
-
-#+threads
-(defparameter *method-combinations-lock* (mp:make-lock :name 'find-method-combination))
-(defparameter *method-combinations* (make-hash-table :size 32 :test 'eq))
-
-(defun search-method-combination (name)
-  (mp:with-lock (*method-combinations-lock*)
-    (or (gethash name *method-combinations*)
-        (error "~A does not name a method combination" name))))
-
-(defun install-method-combination (name function)
-  (mp:with-lock (*method-combinations-lock*)
-    (setf (gethash name *method-combinations*) function))
-  name)
-
-(defun make-method-combination (name compiler options)
-  (with-early-make-instance +method-combination-slots+
-    (o (find-class 'method-combination)
-       :name name
-       :compiler compiler
-       :options options)
-    o))
-
-(defun find-method-combination (gf method-combination-type-name method-combination-options)
-  (declare (ignore gf))
-  (make-method-combination method-combination-type-name
-                           (search-method-combination method-combination-type-name)
-                           method-combination-options
-                           ))
-
-(defun define-simple-method-combination (name &key documentation
-                                         identity-with-one-argument
-                                         (operator name))
-  `(define-method-combination ,name (&optional (order :MOST-SPECIFIC-FIRST))
-     ((around (:AROUND))
-      (principal (,name) :REQUIRED t))
-     ,documentation
-     (let ((main-effective-method
-            `(,',operator ,@(mapcar #'(lambda (x) `(CALL-METHOD ,x NIL))
-                                    (if (eql order :MOST-SPECIFIC-LAST)
-                                        (reverse principal)
-                                        principal)))))
-       (cond (around
-              `(call-method ,(first around)
-                (,@(rest around) (make-method ,main-effective-method))))
-             (,(if identity-with-one-argument
-                   '(rest principal)
-                   t)
-              main-effective-method)
-             (t (second main-effective-method))))))
-
-(defun method-combination-arguments-reshuffling (mc-whole-arg mc-lambda-list gf-lambda-list body)
-  ;; Implement the reshuffling of arguments to the generic function
-  ;; into arguments for a method-combination arguments lambda list
-  ;; required for the long form of DEFINE-METHOD-COMBINATION. The
-  ;; generic function arguments are stored in the variable
-  ;; .COMBINED-METHOD-ARGS. of type STACK-FRAME. To extract the
-  ;; arguments we apply to this stack frame a function whose
-  ;; lambda-list is built below by reshaping the method-combination
-  ;; lambda-list to fit the form of the generic-function lambda-list.
-  (let ((lambda-list '())
-        (let-statements '())
-        (ignored-vars '())
-        n-gf-requireds n-gf-optionals)
-    (multiple-value-bind (mc-requireds mc-optionals mc-rest mc-key-flag mc-keywords
-                          mc-allow-other-keys mc-aux-vars)
-        (si::process-lambda-list mc-lambda-list 'function)
-      (declare (ignore mc-allow-other-keys))
-      (multiple-value-bind (gf-requireds gf-optionals)
-          (si::process-lambda-list gf-lambda-list 'function)
-        (setf n-gf-requireds (first gf-requireds)
-              n-gf-optionals (first gf-optionals))
-        (when mc-whole-arg
-          (push `(,mc-whole-arg (apply #'list .combined-method-args.))
-                let-statements))
-        (loop for r in (rest mc-requireds) by #'cdr
-              for i from 0
-              if (< i n-gf-requireds)
-                do (push r lambda-list)
-              else ; excess required args of the method-combination
-                   ; are set to nil
-              do (push `(,r nil) let-statements))
-        ;; excess required args of the generic-function are ignored
-        (loop repeat (- n-gf-requireds (first mc-requireds))
-              for v = (gensym)
-              do (push v lambda-list)
-                 (push v ignored-vars))
-        (push '&optional lambda-list)
-        (loop for o on (rest mc-optionals) by #'cdddr
-              for i from 0
-              if (< i n-gf-optionals)
-                do (push (if (third o)
-                             `(,(first o) ,(second o) ,(third o))
-                             `(,(first o) ,(second o)))
-                         lambda-list)
-              else ; excess optional args of the method-combination
-                   ; are set to their init forms
-                do (push `(,(first o) ,(second o)) let-statements)
-                   (when (third o)
-                     (push `(,(third o) nil) let-statements)))
-        ;; excess args of the generic-function are ignored
-        (loop repeat (- n-gf-optionals (first mc-optionals))
-              for v = (gensym)
-              do (push v lambda-list)
-                 (push v ignored-vars))
-        (unless mc-rest
-          (setf mc-rest (gensym))
-          (push mc-rest ignored-vars))
-        ;; rest, keyword and aux args are treated as usual
-        (push '&rest lambda-list)
-        (push mc-rest lambda-list)
-        (when mc-key-flag
-          (push '&key lambda-list)
-          (loop for k on (rest mc-keywords) by #'cddddr
-                do (push (if (fourth k)
-                             `((,(first k) ,(second k)) ,(third k) ,(fourth k))
-                             `((,(first k) ,(second k)) ,(third k)))
-                         lambda-list))
-          (push '&allow-other-keys lambda-list))
-        (when mc-aux-vars
-          (push '&aux lambda-list)
-          (loop for a on mc-aux-vars by #'cddr
-                do (push `(,(first a) ,(second a)) lambda-list)))
-        `(apply #'(lambda ,(nreverse lambda-list)
-                    (declare (ignore ,@ignored-vars))
-                    (let ,(nreverse let-statements)
-                      ,body))
-                .combined-method-args.)))))
-
-(defun process-define-method-combination-arguments-lambda-list (lambda-list generic-function body)
-  (declare (si::c-local))
-  (when (null lambda-list)
-    (return-from process-define-method-combination-arguments-lambda-list body))
-  (let ((whole (when (eq (first lambda-list) '&whole)
-                 (prog1 (second lambda-list)
-                   (setf lambda-list (cddr lambda-list))))))
-    (multiple-value-bind (requireds optionals rest key-flag keywords
-                          allow-other-keys aux-vars)
-        (si::process-lambda-list lambda-list 'function)
-      (declare (ignore allow-other-keys key-flag))
-      ;; This is a little complicated. We are constructing a form
-      ;; which when evaluated constructs another form that finally
-      ;; implements the desired destructuring of arguments supplied to
-      ;; the generic function.
-      ;;
-      ;; First evaluate the body form containing the grouping of the
-      ;; methods and the user-supplied method-combination body in a
-      ;; context in which all free variables are bound to fresh
-      ;; symbols (we use the name of the free variable itself). This
-      ;; part happens when the method combination is defined.
-      `(let ((result (let ,(mapcar #'(lambda (v) `(,v ',v))
-                                   (append (when whole (list whole))
-                                           (rest requireds)
-                                           (loop for o on (rest optionals) by #'cdddr
-                                                 collect (first o)
-                                                 when (third o) collect (third o))
-                                           (when rest (list rest))
-                                           (loop for k on (rest keywords) by #'cddddr
-                                                 collect (second k)
-                                                 when (fourth k) collect (fourth k))
-                                           (loop for a on (rest aux-vars) by #'cddr
-                                                 collect (first a))))
-                       ,body)))
-         ;; Second, construct a form which implements the required
-         ;; complex reshuffling of arguments. This part happens after
-         ;; a generic function using the method combination is
-         ;; defined.
-         (method-combination-arguments-reshuffling
-          ',whole
-          ',lambda-list
-          (generic-function-lambda-list ,generic-function)
-          result)))))
-
-(defun define-complex-method-combination (form)
-  (declare (si::c-local))
-  (flet ((syntax-error ()
-           (error "~S is not a valid DEFINE-METHOD-COMBINATION form"
-                  form)))
-    (destructuring-bind (name lambda-list method-groups &rest body &aux
-                         (group-names '())
-                         (group-checks '())
-                         (group-after '())
-                         (generic-function '.generic-function.)
-                         (method-arguments '())
-                         decls documentation arguments-lambda-list)
-        form
-      (unless (symbolp name) (syntax-error))
-      (let ((x (first body)))
-        (when (and (consp x) (eql (first x) :ARGUMENTS))
-          (setf body (rest body)
-                arguments-lambda-list (rest x))))
-      (let ((x (first body)))
-        (when (and (consp x) (eql (first x) :GENERIC-FUNCTION))
-          (setf body (rest body))
-          (unless (symbolp (setf generic-function (second x)))
-            (syntax-error))))
-      (multiple-value-setq (decls body documentation)
-        (si::find-declarations body t))
-      (dolist (group method-groups)
-        (destructuring-bind (group-name predicate &key description
-                                  (order :most-specific-first) (required nil))
-            group
-          (if (symbolp group-name)
-              (push group-name group-names)
-              (syntax-error))
-          (let ((condition
-                (cond ((eql predicate '*) 'T)
-                      ((and predicate (symbolp predicate))
-                       `(,predicate .METHOD-QUALIFIERS.))
-                      ((and (listp predicate)
-                            (let* ((q (last predicate 0))
-                                   (p (copy-list (butlast predicate 0))))
-                              (when (every #'symbolp p)
-                                (if (eql q '*)
-                                    `(every #'equal ',p .METHOD-QUALIFIERS.)
-                                    `(equal ',p .METHOD-QUALIFIERS.))))))
-                      (t (syntax-error)))))
-            (push `(,condition (push .METHOD. ,group-name)) group-checks))
-          (when required
-            (push `(unless ,group-name
-                    (error "Method combination: ~S. No methods ~
-                            in required group ~S." ',name ,group-name))
-                  group-after))
-          (case order
-            (:most-specific-first
-             (push `(setf ,group-name (nreverse ,group-name)) group-after))
-            (:most-specific-last)
-            (otherwise
-             (let ((order-var (gensym)))
-               (setf group-names (append group-names (list (list order-var order)))
-                     group-after (list* `(when (eq ,order-var :most-specific-first)
-                                           (setf ,group-name (nreverse ,group-name)))
-                                        group-after)))))))
-      `(progn
-         ,@(si::expand-set-documentation name 'method-combination documentation)
-         (install-method-combination ',name
-            (lambda (,generic-function .methods-list. ,@lambda-list)
-              (declare (ignorable ,generic-function))
-              ,@decls
-              (block ,name
-                (effective-method-function
-                 ,(process-define-method-combination-arguments-lambda-list
-                   arguments-lambda-list generic-function
-                   `(let (,@group-names)
-                      (dolist (.method. .methods-list.)
-                        (let ((.method-qualifiers. (method-qualifiers .method.)))
-                          (cond ,@(nreverse group-checks)
-                                (t (invalid-method-error .method.
-                                                         "Method qualifiers ~S are not allowed in the method-~
-                                  combination ~S." .method-qualifiers. ',name)))))
-                      ,@group-after
-                      ,@body))
-                 t))))))))
-
-(defmacro define-method-combination (name &body body)
-  (if (and body (listp (first body)))
-      (define-complex-method-combination (list* name body))
-      (apply #'define-simple-method-combination name body)))
-
-(defun method-combination-error (format-control &rest args)
-  ;; FIXME! We should emit a more detailed error!
-  (error "Method-combination error:~%~S"
-         (apply #'format nil format-control args)))
-
-(defun invalid-method-error (method format-control &rest args)
-  (error "Invalid method error for ~A~%~S"
-         method
-         (apply #'format nil format-control args)))
+              (combine-method-functions (first primary) (rest primary)))) )))
 
 ;;; ----------------------------------------------------------------------
 ;;; COMPUTE-EFFECTIVE-METHOD
@@ -496,16 +209,3 @@
 (defun compute-effective-method (gf method-combination applicable-methods)
   `(funcall ,(std-compute-effective-method gf method-combination applicable-methods)
             .combined-method-args. *next-methods*))
-
-(install-method-combination 'standard 'standard-compute-effective-method)
-(progn
-  (define-method-combination progn :identity-with-one-argument t)
-  (define-method-combination and :identity-with-one-argument t)
-  (define-method-combination max :identity-with-one-argument t)
-  (define-method-combination + :identity-with-one-argument t)
-  (define-method-combination nconc :identity-with-one-argument t)
-  (define-method-combination append :identity-with-one-argument nil)
-  (define-method-combination list :identity-with-one-argument nil)
-  (define-method-combination min :identity-with-one-argument t)
-  (define-method-combination or :identity-with-one-argument t))
-
diff --git a/src/clos/defcombin.lsp b/src/clos/defcombin.lsp
new file mode 100644
index 000000000..753018d11
--- /dev/null
+++ b/src/clos/defcombin.lsp
@@ -0,0 +1,317 @@
+;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil; Package: CLOS -*-
+;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:
+
+;;;;
+;;;;  Copyright (c) 1992, Giuseppe Attardi
+;;;;  Copyright (c) 2001, Juan Jose Garcia Ripoll
+;;;;  Copyright (c) 2023, Daniel Kochmański
+;;;;  Copyright (c) 2023, Marius Gerbershagen 
+;;;;
+;;;;    See file '../Copyright' for full details.
+;;;;
+
+(in-package "CLOS")
+
+;; ----------------------------------------------------------------------
+;; DEFINE-METHOD-COMBINATION
+;;
+;; METHOD-COMBINATION objects are just a list
+;;      (name arg*)
+;; where NAME is the name of the method combination type defined with
+;; DEFINE-METHOD-COMBINATION, and ARG* is zero or more arguments.
+;;
+;; For each method combination type there is an associated function,
+;; and the list of all known method combination types is kept in
+;; *METHOD-COMBINATIONS* in the form of property list:
+;;      (mc-type-name1 function1 mc-type-name2 function2 ....)
+;;
+;; FUNCTIONn is the function associated to a method combination. It
+;; is of type (FUNCTION (generic-function method-list) FUNCTION),
+;; and it outputs an anonymous function which is the effective method.
+;;
+
+#+threads
+(defparameter *method-combinations-lock* (mp:make-lock :name 'find-method-combination))
+(defparameter *method-combinations* (make-hash-table :size 32 :test 'eq))
+
+(defun search-method-combination (name)
+  (mp:with-lock (*method-combinations-lock*)
+    (or (gethash name *method-combinations*)
+        (error "~A does not name a method combination" name))))
+
+(defun install-method-combination (name function)
+  (mp:with-lock (*method-combinations-lock*)
+    (setf (gethash name *method-combinations*) function))
+  name)
+
+(defun make-method-combination (name compiler options)
+  (with-early-make-instance +method-combination-slots+
+    (o (find-class 'method-combination)
+       :name name
+       :compiler compiler
+       :options options)
+    o))
+
+(defun find-method-combination (gf method-combination-type-name method-combination-options)
+  (declare (ignore gf))
+  (make-method-combination method-combination-type-name
+                           (search-method-combination method-combination-type-name)
+                           method-combination-options
+                           ))
+
+(defun define-simple-method-combination (name &key documentation
+                                         identity-with-one-argument
+                                         (operator name))
+  `(define-method-combination ,name (&optional (order :MOST-SPECIFIC-FIRST))
+     ((around (:AROUND))
+      (principal (,name) :REQUIRED t))
+     ,documentation
+     (let ((main-effective-method
+            `(,',operator ,@(mapcar #'(lambda (x) `(CALL-METHOD ,x NIL))
+                                    (if (eql order :MOST-SPECIFIC-LAST)
+                                        (reverse principal)
+                                        principal)))))
+       (cond (around
+              `(call-method ,(first around)
+                (,@(rest around) (make-method ,main-effective-method))))
+             (,(if identity-with-one-argument
+                   '(rest principal)
+                   t)
+              main-effective-method)
+             (t (second main-effective-method))))))
+
+(defun method-combination-arguments-reshuffling (mc-whole-arg mc-lambda-list gf-lambda-list body)
+  ;; Implement the reshuffling of arguments to the generic function
+  ;; into arguments for a method-combination arguments lambda list
+  ;; required for the long form of DEFINE-METHOD-COMBINATION. The
+  ;; generic function arguments are stored in the variable
+  ;; .COMBINED-METHOD-ARGS. of type STACK-FRAME. To extract the
+  ;; arguments we apply to this stack frame a function whose
+  ;; lambda-list is built below by reshaping the method-combination
+  ;; lambda-list to fit the form of the generic-function lambda-list.
+  (let ((lambda-list '())
+        (let-statements '())
+        (ignored-vars '())
+        n-gf-requireds n-gf-optionals)
+    (multiple-value-bind (mc-requireds mc-optionals mc-rest mc-key-flag mc-keywords
+                          mc-allow-other-keys mc-aux-vars)
+        (si::process-lambda-list mc-lambda-list 'function)
+      (declare (ignore mc-allow-other-keys))
+      (multiple-value-bind (gf-requireds gf-optionals)
+          (si::process-lambda-list gf-lambda-list 'function)
+        (setf n-gf-requireds (first gf-requireds)
+              n-gf-optionals (first gf-optionals))
+        (when mc-whole-arg
+          (push `(,mc-whole-arg (apply #'list .combined-method-args.))
+                let-statements))
+        (loop for r in (rest mc-requireds) by #'cdr
+              for i from 0
+              if (< i n-gf-requireds)
+                do (push r lambda-list)
+              else ; excess required args of the method-combination
+                   ; are set to nil
+              do (push `(,r nil) let-statements))
+        ;; excess required args of the generic-function are ignored
+        (loop repeat (- n-gf-requireds (first mc-requireds))
+              for v = (gensym)
+              do (push v lambda-list)
+                 (push v ignored-vars))
+        (push '&optional lambda-list)
+        (loop for o on (rest mc-optionals) by #'cdddr
+              for i from 0
+              if (< i n-gf-optionals)
+                do (push (if (third o)
+                             `(,(first o) ,(second o) ,(third o))
+                             `(,(first o) ,(second o)))
+                         lambda-list)
+              else ; excess optional args of the method-combination
+                   ; are set to their init forms
+                do (push `(,(first o) ,(second o)) let-statements)
+                   (when (third o)
+                     (push `(,(third o) nil) let-statements)))
+        ;; excess args of the generic-function are ignored
+        (loop repeat (- n-gf-optionals (first mc-optionals))
+              for v = (gensym)
+              do (push v lambda-list)
+                 (push v ignored-vars))
+        (unless mc-rest
+          (setf mc-rest (gensym))
+          (push mc-rest ignored-vars))
+        ;; rest, keyword and aux args are treated as usual
+        (push '&rest lambda-list)
+        (push mc-rest lambda-list)
+        (when mc-key-flag
+          (push '&key lambda-list)
+          (loop for k on (rest mc-keywords) by #'cddddr
+                do (push (if (fourth k)
+                             `((,(first k) ,(second k)) ,(third k) ,(fourth k))
+                             `((,(first k) ,(second k)) ,(third k)))
+                         lambda-list))
+          (push '&allow-other-keys lambda-list))
+        (when mc-aux-vars
+          (push '&aux lambda-list)
+          (loop for a on (rest mc-aux-vars) by #'cddr
+                do (push `(,(first a) ,(second a)) lambda-list)))
+        `(apply #'(lambda ,(nreverse lambda-list)
+                    (declare (ignore ,@ignored-vars))
+                    (let ,(nreverse let-statements)
+                      ,body))
+                .combined-method-args.)))))
+
+(defun process-define-method-combination-arguments-lambda-list
+    (lambda-list generic-function body)
+  (declare (si::c-local))
+  (when (null lambda-list)
+    (return-from process-define-method-combination-arguments-lambda-list body))
+  (let ((whole (when (eq (first lambda-list) '&whole)
+                 (prog1 (second lambda-list)
+                   (setf lambda-list (cddr lambda-list))))))
+    (multiple-value-bind (requireds optionals rest key-flag keywords
+                          allow-other-keys aux-vars)
+        (si::process-lambda-list lambda-list 'function)
+      (declare (ignore allow-other-keys key-flag))
+      ;; This is a little complicated. We are constructing a form
+      ;; which when evaluated constructs another form that finally
+      ;; implements the desired destructuring of arguments supplied to
+      ;; the generic function.
+      ;;
+      ;; First evaluate the body form containing the grouping of the
+      ;; methods and the user-supplied method-combination body in a
+      ;; context in which all free variables are bound to fresh
+      ;; symbols (we use the name of the free variable itself). This
+      ;; part happens when the method combination is defined.
+      `(let ((result (let ,(mapcar #'(lambda (v) `(,v ',v))
+                                   (append (when whole (list whole))
+                                           (rest requireds)
+                                           (loop for o on (rest optionals) by #'cdddr
+                                                 collect (first o)
+                                                 when (third o) collect (third o))
+                                           (when rest (list rest))
+                                           (loop for k on (rest keywords) by #'cddddr
+                                                 collect (second k)
+                                                 when (fourth k) collect (fourth k))
+                                           (loop for a on (rest aux-vars) by #'cddr
+                                                 collect (first a))))
+                       ,body)))
+         ;; Second, construct a form which implements the required
+         ;; complex reshuffling of arguments. This part happens after
+         ;; a generic function using the method combination is
+         ;; defined.
+         (method-combination-arguments-reshuffling
+          ',whole
+          ',lambda-list
+          (generic-function-lambda-list ,generic-function)
+          result)))))
+
+(defmacro with-method-groups ((&rest method-groups) &body body)
+  (let (group-names matchers cleanup)
+    (flet ((parse-qualifier-pattern (pattern)
+             (cond ((eq pattern '*)   't)
+                   ((eq pattern nil)  '(null .method-qualifiers.))
+                   ((symbolp pattern) `(,pattern .method-qualifiers.))
+                   ((listp pattern)
+                    `(do ((pattern ',pattern (cdr pattern))
+                          (qualifiers .method-qualifiers. (cdr qualifiers)))
+                         ((or (eq pattern '*)
+                              (and (null pattern)
+                                   (null qualifiers)))
+                          t)
+                       (unless (and pattern qualifiers
+                                    (or (eq (car pattern) '*)
+                                        (eq (car pattern) (car qualifiers))))
+                         (return nil))))
+                   (t
+                    (error "Invalid method group pattern ~s." pattern)))))
+      (dolist (group method-groups)
+        (destructuring-bind (name pattern &key description
+                                               (order :most-specific-first)
+                                               (required nil))
+            group
+          (declare (ignore description))
+          (push name group-names)
+          (push `(,(parse-qualifier-pattern pattern) (push .method. ,name))
+                matchers)
+          (when required
+            (push `(unless ,name
+                     (error "No methods in required group ~S." ',name))
+                  cleanup))
+          (case order
+            (:most-specific-first
+             (push `(setf ,name (nreverse ,name)) cleanup))
+            (:most-specific-last)
+            (otherwise
+             (push `(when (eq ,order :most-specific-first)
+                      (setf ,name (nreverse ,name)))
+                   cleanup))))))
+    `(let ,group-names
+       (dolist (.method. .methods-list.)
+         (let ((.method-qualifiers. (method-qualifiers .method.)))
+           (declare (ignorable .method-qualifiers.))
+           (cond ,@(nreverse matchers)
+                 ,@(unless (member t matchers :key #'car)
+                     `((t (invalid-method-error
+                           .method.
+                           "Method qualifiers ~s are not allowed." .method-qualifiers.)))))))
+       ,@cleanup
+       ,@body)))
+
+(defun define-complex-method-combination (form)
+  (declare (si::c-local))
+  (flet ((syntax-error ()
+           (error "~S is not a valid DEFINE-METHOD-COMBINATION form." form)))
+    (destructuring-bind (name lambda-list method-groups &rest body
+                         &aux (generic-function '.generic-function.)
+                              (arguments nil)
+                              decls documentation)
+        form
+      (let ((x (first body)))
+        (when (and (consp x) (eql (first x) :ARGUMENTS))
+          (setf body (rest body))
+          (setf arguments (rest x))))
+      (let ((x (first body)))
+        (when (and (consp x) (eql (first x) :GENERIC-FUNCTION))
+          (setf body (rest body))
+          (setf generic-function (second x))))
+      (unless (and (symbolp name) (symbolp generic-function))
+        (error "~S is not a valid DEFINE-METHOD-COMBINATION form." form))
+      (multiple-value-setq (decls body documentation)
+        (si::find-declarations body t))
+      `(progn
+         ,@(si::expand-set-documentation name 'method-combination documentation)
+         (install-method-combination ',name
+            (lambda (,generic-function .methods-list. ,@lambda-list)
+              (declare (ignorable ,generic-function))
+              ,@decls
+              (block ,name
+                (effective-method-function
+                 ,(process-define-method-combination-arguments-lambda-list
+                   arguments generic-function
+                   `(with-method-groups ,method-groups ,@body))
+                 t))))))))
+
+(defmacro define-method-combination (name &body body)
+  (if (and body (listp (first body)))
+      (define-complex-method-combination (list* name body))
+      (apply #'define-simple-method-combination name body)))
+
+(defun method-combination-error (format-control &rest args)
+  ;; FIXME! We should emit a more detailed error!
+  (error "Method-combination error:~%~S"
+         (apply #'format nil format-control args)))
+
+(defun invalid-method-error (method format-control &rest args)
+  (error "Invalid method error for ~A~%~S"
+         method
+         (apply #'format nil format-control args)))
+
+(install-method-combination 'standard 'standard-compute-effective-method)
+(progn
+  (define-method-combination progn :identity-with-one-argument t)
+  (define-method-combination and :identity-with-one-argument t)
+  (define-method-combination max :identity-with-one-argument t)
+  (define-method-combination + :identity-with-one-argument t)
+  (define-method-combination nconc :identity-with-one-argument t)
+  (define-method-combination append :identity-with-one-argument nil)
+  (define-method-combination list :identity-with-one-argument nil)
+  (define-method-combination min :identity-with-one-argument t)
+  (define-method-combination or :identity-with-one-argument t))
diff --git a/src/clos/load.lsp.in b/src/clos/load.lsp.in
index 8fabcd346..5ce4b46aa 100644
--- a/src/clos/load.lsp.in
+++ b/src/clos/load.lsp.in
@@ -13,6 +13,7 @@
   "src:clos;kernel.lsp"
   "src:clos;method.lsp"
   "src:clos;combin.lsp"
+  "src:clos;defcombin.lsp"
   "src:clos;std-accessors.lsp"
   "src:clos;defclass.lsp"
   "src:clos;slotvalue.lsp"
diff --git a/src/cmp/cmppass1-call.lsp b/src/cmp/cmppass1-call.lsp
index 85f618868..6435629c3 100644
--- a/src/cmp/cmppass1-call.lsp
+++ b/src/cmp/cmppass1-call.lsp
@@ -353,8 +353,9 @@
     (when (and key-flag (not allow-other-keys))
       (push `(si::check-keyword ,rest ',all-keys) extra-stmts))
     ;; 7. construct body
+    (pop aux-vars)
     (loop while aux-vars
-       do (push (list (pop aux-vars) (pop aux-vars)) let-vars))
+          do (push (list (pop aux-vars) (pop aux-vars)) let-vars))
     (values (nreverse (delete-if-not #'first let-vars))
             `(,@(and apply-var `((declare (ignorable ,apply-var))))
               ,@(multiple-value-bind (decl body)
diff --git a/src/cmp/cmppass1-fun.lsp b/src/cmp/cmppass1-fun.lsp
index a20fe733c..5f4c0809d 100644
--- a/src/cmp/cmppass1-fun.lsp
+++ b/src/cmp/cmppass1-fun.lsp
@@ -303,7 +303,7 @@
           (extract-lambda-type-checks function-name requireds optionals
                                       keywords ts other-decls)
         (let* ((declarations other-decls)
-               (let-vars (loop for spec on (nconc new-auxs aux-vars)
+               (let-vars (loop for spec on (nconc new-auxs (rest aux-vars))
                             by #'cddr
                             for name = (first spec)
                             for init = (second spec)
diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp
index 4332c0ee2..614e99700 100644
--- a/src/cmp/cmputil.lsp
+++ b/src/cmp/cmputil.lsp
@@ -613,9 +613,9 @@ keyword argument, the compiler-macro declines to provide an expansion.
                   parse-forms-pass2))
           ;; 5. &aux vars: these are simply set to their initforms after
           ;; parsing of keywords has finished
-          (loop for a on auxs
-                do (push (first auxs) bindings-for-body)
-                   (push `(setf ,(first auxs) ,(second auxs)) aux-setf-forms))
+          (loop for a on (rest auxs) by #'cddr
+                do (push (first a) bindings-for-body)
+                   (push `(setf ,(first a) ,(second a)) aux-setf-forms))
           ;; 6. Finally, we are ready to create the compiler-macro definition
           `(define-compiler-macro ,name ,(nreverse new-lambda-list)
              (let* ,(nreverse bindings-for-body)
diff --git a/src/lsp/cmuutil.lsp b/src/lsp/cmuutil.lsp
index db2fddb51..fb1925041 100644
--- a/src/lsp/cmuutil.lsp
+++ b/src/lsp/cmuutil.lsp
@@ -43,7 +43,7 @@
       ,@(mapcar #'(lambda (form)
                     `(let ((,n-res (cons ,form nil)))
                        (cond (,n-tail
-                              (setf (cdr ,n-tail) ,n-res)
+                              (rplacd ,n-tail ,n-res)
                               (setq ,n-tail ,n-res))
                              (t
                               (setq ,n-tail ,n-res  ,n-value ,n-res)))))
@@ -95,7 +95,7 @@ Example:
   (let (macros binds)
     (dolist (spec collections)
       (cond ((atom spec)
-             (setf spec (list spec)))
+             (setq spec (list spec)))
             ((not (<= 1 (length spec) 3))
              (error "Malformed collection specifier: ~S." spec)))
       (let ((n-value (gensym))
@@ -150,7 +150,7 @@ Example:
                  `(progn ,@body)
                  (let ((spec (first specs)))
                    (cond ((atom spec)
-                          (setf spec (list spec spec)))
+                          (setq spec (list spec spec)))
                          ((/= (length spec) 2)
                           (error "Malformed Once-Only binding spec: ~S." spec)))
                    (let ((name (first spec))
diff --git a/src/lsp/defmacro.lsp b/src/lsp/defmacro.lsp
index cfa8f7063..212778301 100644
--- a/src/lsp/defmacro.lsp
+++ b/src/lsp/defmacro.lsp
@@ -155,7 +155,7 @@
                      (dm-v v `(if (eq ,temp 'missing-keyword) ,init ,temp))
                      (when sv (dm-v sv `(not (eq ,temp 'missing-keyword))))
                      (push k all-keywords)))
-                 (do ((l auxs (cddr l))) ((endp l))
+                 (do ((l (rest auxs) (cddr l))) ((endp l))
                    (let* ((v (first l))
                           (init (second l)))
                      (dm-v v init)))
diff --git a/src/tests/ecl-tests.asd b/src/tests/ecl-tests.asd
index 83ed00f6a..1b6fe54fb 100644
--- a/src/tests/ecl-tests.asd
+++ b/src/tests/ecl-tests.asd
@@ -13,6 +13,7 @@
                         :default-component-class asdf:cl-source-file.lsp
                         :components
                         ((:file "ansi")
+                         (:file "clos")
                          (:file "mixed")
                          (:file "compiler")
                          (:file "executable-cli")
diff --git a/src/tests/normal-tests/clos.lsp b/src/tests/normal-tests/clos.lsp
new file mode 100644
index 000000000..3ece872d6
--- /dev/null
+++ b/src/tests/normal-tests/clos.lsp
@@ -0,0 +1,52 @@
+;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil -*-
+;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:
+
+;;;; Author:   Daniel Kochmański
+;;;; Created:  2023-01-19
+;;;; Contains: CLOS tests
+
+(in-package #:cl-test)
+
+(suite 'clos)
+
+
+;;; Method combination long form
+
+;;; Check whether different types of wildcard patterns are correctly handled.
+;;; Most notably the symbol * in a pattern matches any method qualifier on
+;;; that position.
+(ext:with-clean-symbols (combin gf)
+  (test clos.0001.combin/wildcard
+    (define-method-combination combin ()
+      ((p1 (:wild :no))
+       (p2 (:wild * *))
+       (p3 (:wild . *))
+       (pr *))
+      `(list ,(length p1)
+             ,(length p2)
+             ,(length p3)
+             ,(length pr)))
+    (defgeneric gf ()
+      (:method-combination combin))
+    (finishes (defmethod gf :wild :no ()))   ; p1
+    (finishes (defmethod gf :wild :x :y ())) ; p2
+    (finishes (defmethod gf :wild ()))       ; p3
+    (finishes (defmethod gf :wild :foobar ())) ; p3
+    (finishes (defmethod gf :wild :no :a :b ())) ; p3
+    (finishes (defmethod gf :xxx :yyy 34 23 ())) ; p4
+    (is-equal '(1 1 3 1) (gf))))
+
+;;; This test checks whether define-method-combination handles arguments
+;;; :GENERIC-FUNCTION and :ARGUMENTS &WHOLE ARGS.
+(ext:with-clean-symbols (combin f1 f2)
+  (test clos.0002.combin/arguments
+    (define-method-combination combin ()
+      ((method-list *))
+      (:arguments &whole args)
+      (:generic-function gf)
+      `(list ,gf ,args))
+    (defgeneric f1 (a &key key-1)
+      (:method-combination combin)
+      (:method (a &key key-1 key-2)
+        (declare (ignore a key-1 key-2))))
+    (is-equal (list #'f1 1 :key-1 2) (f1 1 :key-1 2))))