(defmacro mein-trace (ausdruck)
  ( list ( quote  quote )( trace ( list ( quote  progn ) ausdruck ) 0 )))

(defun trace ( Tausdruck  Tn  &aux  Ti  Tj  Tliste  Terstes )
   ( cond (( atom Tausdruck )( space  Tn )
            ( princ  "evaluiere "  Tausdruck  " zu " ( eval Tausdruck ))
            ( terpri )( eval  Tausdruck ))
          ( t ( setq  Terstes ( eval ( car Tausdruck )))
              ( cond (( listp  Terstes )( space  Tn )
                      ( cond (( eq ( car Terstes )( quote  lambda ))
                              ( princ  "FUNKTION " ))
                             ( t ( princ  "MACRO " )))
              (princ (car  Tausdruck ) " aufgerufen :" )( terpri )
              (eval (cons ( list 'quote (list (car Terstes)(cadr Terstes)
                (list 'trace (list 'quote (cons 'progn (cdr (cdr Terstes))))
                ( + Tn  1 ))))( cdr  Tausdruck ))))
          (( eq  Terstes  progn )
           ( setq  Ti  1 )
           ( while ( not ( null ( nth ( +  Ti  1 ) Tausdruck )))
             ( trace ( nth ( setq  Ti ( +  Ti  1 )) Tausdruck ) Tn )))
          (( eq  Terstes  quote )( space  Tn )
           ( princ  "werte" ( cdr  Tausdruck ) "nicht aus" )( terpri )
           ( cdr  Tausdruck ))
          (( or ( eq Terstes  setq )( eq  Terstes  killq ))
           ( space  Tn )( princ  "berechne " Tausdruck  ":" )( terpri )
           ( set ( cadr  Tausdruck )( trace ( nth  3 Tausdruck )
                                            ( +  Tn  1 ))))
          (( eq  Terstes  defun )( space  Tn )
           ( princ "definiere Funktion " ( cadr  Tausdruck ))( terpri )
           ( eval  Tausdruck ))
          (( eq Terstes  defmacro )( space  Tn )
           ( princ  "definiere Macro " ( cadr Tausdruck ))( terpri )
           ( eval  Tausdruck ))
          (( eq  Terstes  count )( setq  Ti (eval ( cadr  Tausdruck )))
           ( space  Tn )
           ( princ  "werte Zählschleife bei "  Ti "Durchläufen aus :" )
           ( terpri )
           ( count  Ti ( setq  Tj  2 )
            ( while ( not (null ( nth ( setq  Tj ( +  Tj  1 )) Tausdruck )))
             ( trace ( nth  Tj  Tausdruck)( +  Tn  1 )))))
          (( or ( eq  Terstes  while )( eq  Terstes  do ))
           ( space  Tn)
           ( cond (( eq  Terstes  while ) ( princ  "WHILE-SCHLEIFE :" ))
                  ( t ( princ "DO-SCHLEIFE :" ))) ( terpri )
           ( eval ( list 'while ( list 'trace
                    ( list 'quote ( cadr  Tausdruck ))( +  Tn  1 ))
                    ( list 'trace ( list 'quote ( cons 'progn
                    ( cdr ( cdr  Tausdruck))))( +  Tn  1 )))))
          (( eq  Terstes  cond )( space  Tn )
           ( princ "COND-VERZWEIGUNG :" )( terpri )
           ( eval ( cons 'cond ( Tcond ( cdr Tausdruck )( +  Tn  1 )))))
          ( t ( space  Tn )( princ  "werte"  Tausdruck  "aus :" )( terpri )
           ( setq  Tliste ( list ( car  Tausdruck )))( setq  Ti  1 )
           (while ( not ( null ( nth ( setq  Ti ( +  Ti  1 )) Tausdruck )))
            ( setq  Tliste ( append  Tliste ( list ( list 'quote
                     ( trace ( nth  Ti  Tausdruck)( +  Tn  1 )))))))
           ( cond (( eq  Terstes  princ )( eval  Tliste )
                   ( princ  " [AUSGABE]" )( terpri ))
                  (( eq  Terstes  terpri )( space  Tn )
                   ( princ "[ZEILENVORSCHUB]" )( terpri ))
                  ( t ( setq  Ti ( eval  Tliste ))( space  Tn )
                   (princ  "Ergebnis : "  Ti )( terpri ) Ti )))))))

(defun space ( n )( count  n ( princ  " " )))

(defun Tcond ( liste  n )
  ( cond (( null  liste )())
         ( t (cons (list ( list 'trace (list 'quote (car (car  liste ))) n )
                         ( list 'trace ( list 'quote ( cons 'progn
                                           ( cdr ( car  liste )))) n ))
                   ( Tcond ( cdr  liste ) n )))))
