(defun show (x)
  (format nil "~A" x))

(defmacro %tagbody (&body body &aux exprs tags)
  (loop :with xs :for x :in body
        :if (consp x) :do (push x xs)
        :else :collect (nreverse xs) :into @exprs
              :and :collect (cons x (gensym (show x))) :into @tags
              :and :do (setf xs nil)
        :finally (setf exprs (nconc @exprs (list (nreverse xs)))
                       tags  @tags))
  `(macrolet ((goto (x) `(return (,(cdr (assoc x ',tags))))))
     (block nil
       (labels ,(loop :for (tc tn) :on tags :and x :in (cdr exprs)
                      :collect `(,(cdr tc) nil ,@x 
                                 ,(and tn `(goto ,(car tn)))))
         ,@(car exprs) (goto ,(caar tags))))))

(defun factorial (x &aux (f 1))
  (%tagbody
   0 (if (zerop x) (goto 4))
   1 (setf f (* f x))
   2 (decf x)
   3 (goto 0)
   4 (return-from factorial f)))

(format t "Fact(~d) -> ~d" #1=42 (factorial #1#))