cm 1.0.0 in MCL 3.1 (68k)
Tobias Kunze
t@ulysses.Stanford.EDU
Sat, 11 Jan 1997 15:29:14 -0800
[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+)))