cm 1.0.0 in MCL 3.1 (68k)

[Tobias Kunze]

[Some people seem to have run into this, so I thought it might be
worth posting the fix to the list.]

The MIDI code (mcl-midi.lisp) in the current archives breaks in the
latest (and last) 68k-version of MCL (3.1) due to an internal data
structure change in this version.  If you are running MCL 3.0.1 and
plan on upgrading to 3.1, you should replace %mm-midi-open-aux with
the code below.  I'm currently in the middle of rewriting the midi
code and there will be a new release as soon as I'm done, in about
2 weeks.


(defun %mm-midi-open-aux (int)
  (catch :midi-open-exit
    (setf %mm-close-stack%
          `(,#'(lambda ()
                 (setf %midi-open-p% nil)
                 (%update-midi-menu)
                 (values +midi-success+))))
    (%mm-sign-in)
    (push #'%mm-sign-out %mm-close-stack%)
    (%mm-add-cm-ports)
    (push #'(lambda ()
              (%mm-remove-cm-ports)
              ;; Make sure the pointers held in %inv-outports% can't be
              ;; accessed any more.
              (setf %inv-outports% nil)
              ;; Fight memory leaks and dispose the block %myports-ptr% points
              ;; to, but never dispose a dead pointer.
              (when  %myports-ptr%
                (#_disposeptr %myports-ptr%)
                (setf %myports-ptr% nil))) %mm-close-stack%)
    ;; Check for the availability of drivers and ports. This function also
    ;; sets the globals $driver-id$ and $serial-port$.
    (%mm-get-driver-and-serial-port int)
    (push #'(lambda () (setf $serial-port$ nil $driver-id$ nil))
          %mm-close-stack%)
    (%mm-connect-data $serial-port$)
    (%midi-start-time)
    ;; make sure %midi-open-p% holds the serial port variable
    (setf %midi-open-p% (verbose-find-port $serial-port$))
    (%update-midi-menu)
    (push #'%update-midi-menu %mm-close-stack%)
    ;; Initialize the c side; but close everything again, if it failed.
    (unless (midi-c-setup)
      (throw :midi-open-exit :cancel-midi-open))
    ;; Now make the data area, jump table, function code segment, and our
    ;; structures ineligible for virtual memory page swapping, because
    ;; they will be accessed at interrupt level (avoid a possible fatal
    ;; double page fault error at paging time).
    (mapcar #'(lambda (x) (#_holdmemory x (#_getptrsize x)))
            (list
             (cdr (first (last (ccl::ffenv-entries %ff-env%)))) ; data & JT
             (first (ccl::ffenv-seg-ptrs %ff-env%))             ; code segment
             %myports-ptr%))                                    ; structures
    (push #'(lambda ()
              ;; Make data & jump table, code segment, and our structures
              ;; eligible for page swapping again
              (mapcar #'(lambda (x) (#_unholdmemory x (#_getptrsize x)))
                      (list (cdr (first (last (ccl::ffenv-entries %ff-env%))))
                            (first (ccl::ffenv-seg-ptrs %ff-env%))))
              ;; ...but the structures only if their pointer is valid.
              (when %myports-ptr% (#_unholdmemory %myports-ptr%
                                   (#_getptrsize %myports-ptr%))))
          %mm-close-stack%)
    (values +midi-success+)))