help-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

need help debugging edebug (Common lisp problem?)


From: rusi
Subject: need help debugging edebug (Common lisp problem?)
Date: Mon, 13 Dec 2010 22:00:57 -0800 (PST)
User-agent: G2/1.0

The following function (from http://delysid.org/emacs/midi.el )
crashes edebug.
It gives

edebug-syntax-error: Invalid read syntax: "Failed matching",
([&optional ["named" symbolp]] [&rest &or ["repeat" form] loop-for-as
loop-with loop-initial-final] [&rest loop-clause])

Note: It loads correctly (or rather silently) if edebug is turned off

I have a feeling its in the loop (cl) macro. Can someone who knows CL
better have a look?

(defun smf-read-mtrk (length)
  "Read one MTrk chunk.
NoteOn/NoteOff and NoteOn/NoteOn(vel=0) event
pairs are unified into a Note event with a certain duration."
  (let ((end (+ (point) length))
        (notes (make-vector 16 nil))
        (ticks 0) (running-status 0))
    (dotimes (i 16) (aset notes i (make-vector 128 nil)))
    (loop while (< (point) end)
          do (incf ticks (smf-read-varlen))
          for event =
          (let ((status (following-char)))
            (if (/= (logand status #B10000000 ) #B10000000 )
                (if (= running-status 0)
                    (error "Seen data byte without running status")
                  (setq status running-status))
              (forward-char 1))
            (unless (= status #XFF ) (setq running-status status))
            (let ((lower (logand status #X0F )))
              (case (ash status -4)
                (8  (let* ((note (smf-read-byte)) (vel (smf-read-byte))
                           (old-note (aref (aref notes lower) note)))
                      (if (not old-note)
                          (list 'NoteOff lower note vel)
                        (setcar (cdr old-note) 'Note)
                        (setcdr (nthcdr 4 old-note)
                                (list (- ticks (car old-note)) vel))
                        (aset (aref notes lower) note nil))))
                (9  (let* ((note (smf-read-byte)) (vel (smf-read-byte))
                           (data (cons ticks (list 'NoteOn lower note vel))))
                      (if (= vel 0)
                          (let ((old-note (aref (aref notes lower) note)))
                            (if (not old-note)
                                (cdr data)
                              (setcar (cdr old-note) 'Note)
                              (setcdr (nthcdr 4 old-note)
                                      (list (- ticks (car old-note))))
                              (aset (aref notes lower) note nil)))
                        (cdr (aset (aref notes lower) note data)))))
                (10 (list 'At lower (smf-read-byte) (smf-read-byte)))
                (11 (list 'CC lower (smf-read-byte) (smf-read-byte)))
                (12 (list 'PC lower (smf-read-byte)))
                (13 (list 'CP lower (smf-read-byte)))
                (14 (list 'PW lower (logior (smf-read-byte)
                                            (lsh (smf-read-byte) 7))))
                (15 (case lower
                      (0  (append (list 'SysEx)
                                  (loop repeat (smf-read-varlen) collect
                                        (smf-read-byte))))
                      (2  (let ((value (logior (smf-read-byte)
                                               (lsh (smf-read-byte) 7))))
                            (list 'SongPosition value)))
                      (3  (list 'SongSelect (smf-read-byte)))
                      (6  (list 'TuneRequest))
                      (8  (list 'Clock))
                      (9  (list 'Tick))
                      (10 (list 'Start))
                      (11 (list 'Continue))
                      (12 (list 'Stop))
                      (14 (list 'ActiveSense))
                      (15 (smf-read-meta-event))
                      (t (error "Unknown stuff")))))))
          until (eq event t) when event collect (cons ticks event))))


reply via email to

[Prev in Thread] Current Thread [Next in Thread]