This is mcl-midi.c in view mode; [Download] [Up]
/*
* File: mcl-midi.c
*
* These c functions interface with the Apple Midi Manager and are part of
* the Macintosh Common Lisp v2.0px port of Common Music (CM), written by
* Rick Taube (hkt@zkm.de).
*
* Bug reports, suggestions, etc. are welcome. Please address electronic
* mail to <tkunze@mvax.kgw.tu-berlin.de>.
*
* Note: it is strongly recommended that you use MPW v3.1 or higher, if you
* need to recompile this file.
* You _will_ need MPW v3.2 or higher to run this code under System 7
* or higher.
*
* CAUTION: ALWAYS MAKE SURE THE HARDCODED OFFSETS IN midicsetup ARE IN FULL
* COMPLIANCE WITH THE ACTUALLY GENERATED CODE AFTER COMPILING!
*
* Changes:
* 15-6-93 tk - although i couldn't test it on such a machine up to now,
* the new cache flushing mechanism should now work well on
* the MC68040 line of machines (or on a machine with cache
* card).
* - invisible input queues get flushed completely before the
* code returns to normal (non-flushing) operation.
* - myInvisibleReadHook now invalidates time stamps when in
* flushing mode.
* 12-6-93 tk - fixed bug in myInvisibleReadHook that didn't recognize
* note-off messages properly.
*/
#include <midi.h>
#include <memory.h>
/* These two functions are not in the interfaces: */
void FlushCodeCache (void) = 0xA0BD;
/* MPW C 3.2 makes register-based inline calls very efficient. However,
* MPW C 3.1 and earlier, and THINK Cª should declare the function as
* ÒpascalÓ and use the same inline constants as the Pascal interface:
* pascal OSErr FlushCodeCacheRange (void *address, unsigned long count)
* = {0x225F, 0x205F, 0x7009, 0xA198, 0x3E80};
*/
#pragma parameter __D0 FlushCodeCacheRange(__A0,__A1)
OSErr FlushCodeCacheRange (void *address, unsigned long count) =
{0x7009, 0xA198};
/*
* MCL's ff-interface does not provide an A5 pointer to functions that are not
* called directly from lisp, therefore all static data has been 'hardcoded'
* right into the code itself as automatic variable declarations of the form:
*
* volatile type name=hex_data;
*
* The function midicsetup then stores all relevant data into these fields,
* thus guaranteeing that they hold their right values at interrupt time.
*/
#define channel_tag 1
#define system_tag 2
#define TRUE 1
#define FALSE 0
#define hwParamErr -502
#define noErr 0
/*--------------------------------------------------------------------------*
* Functions related to reading midi data *
*--------------------------------------------------------------------------*
* *
* Summary: *
* myReadHook is a standard readhook which calls Lisp's midi-read-hook. *
* myInvisibleReadHook gets all current packets from all buffers which *
* are allocated for the invisible input ports and which are completely *
* maintained by the MidiManager. *
* setReadHook gets called everytime a fresh invisible pair of output *
* and input ports is created to set the input port's ReadHook to *
* myInvisibleReadHook. *
* *
*--------------------------------------------------------------------------*/
/*
* myReadHook may not call lisp from within an interrupt. Therefore, it is
* set up (by setting the input_port's offset time to midiGetNothing) to
* respond only to the midiPoll(input_port,midiGetCurrent) call issued by
* midireadevent. midireadevent, in turn, is called directly from lisp and
* thus will never execute at interrupt time.
* Since lots of MidiManager error packets are waiting after our various
* output buffer overflows, return midiMorePacket to quickly flush all
* unknown message types. Also, according to 'Midi Support in Common Music',
* all pending messages are read in response to one single midireadevent call
* (see cm/doc/midi.rtf), therefore return midiMorePacket for known messages,
* too.
*/
extern pascal short myReadHook(MIDIPacketPtr packet, long myRefCon)
{
volatile void (*lisp_call_read) (int,int)=0x12345678;
int message, time;
if (((packet->flags & midiContMask)==midiNoCont) &&
((packet->flags & midiTypeMask)==midiMsgType) &&
((packet->flags & midiTimeStampMask)==midiTimeStampValid)) {
message = (((channel_tag << 26) & 0xc000000) |
((packet->len-6 << 24) & 0x03000000) |
((packet->data[0] << 16) & 0xff0000) |
((packet->data[1] << 8) & 0xff00) |
(packet->data[2] & 0xff));
time=(int)packet->tStamp;
(*(ProcPtr)lisp_call_read) (message, time) ;
return midiMorePacket;
}
return midiMorePacket;
}
/*
* The ReadHook for all invisible ports.
* This ReadHook is called whenever a future midi output stored in the
* invisible input buffer becomes current. The hook simply passes the current
* message to the real output port. However, when an output queue flushing
* is performed (by setting the offsetTime of _all_ invisible input ports to
* midiGetEverything, causing all pending messages to be dumped), the ReadHook
* checks the message type and passes only note-offs, ignoring all other
* message types. Thus, multiple notes hanging on the same channel and key
* will be turned off properly.
*/
extern pascal short myInvisibleReadHook(MIDIPacketPtr packet, long myRefCon)
{
volatile short flushing=0x1234; /* the flushing flag */
if (flushing) {
if ((packet->data[0] & 0xf0)==0x80) { /* if note-off ... */
packet->flags|=0x80; /* invalidate the time stamp! */
if (MIDIWritePacket(myRefCon, packet) == 0) /* success */
return 1; /* MIDIMorePacket 1*/
return 0; /* MIDIKeepPacket 0*/
}
else return 1; /* MIDIMorePacket 1*/
}
else if (MIDIWritePacket(myRefCon, packet) == 0) /* success */
return 1; /* MIDIMorePacket 1*/
else return 0; /* MIDIKeepPacket 0*/
}
void setReadHook(long refNum)
{
MIDISetReadHook((short)refNum,(ProcPtr)&myInvisibleReadHook);
}
/*
* if MidiPoll wouldn't be a Pascal PROCEDURE and at least return an
* OSErr value, we would be able to test for empty buffers, but ... ($^#@*!!)
*/
short midireadevent ()
{
volatile short inport=0x1234;
MIDIPoll(inport,midiGetCurrent);
return 0;
}
/*--------------------------------------------------------------------------*
* invisible ports database and handling functions *
*--------------------------------------------------------------------------*
* *
* Summary: *
* All invisible ports are held in a global inv_ports structure. Port *
* pairs are added, when %mm-make-aux-buffers calls add_port_pair. Port *
* pairs are removed at interrupt level by myTimeProc (but not yet *
* deallocated). %mm-write-message needs a function which performs a *
* rotating permutation on the port pairs; this function is called *
* cycle_port_pairs. *
* The Remove_Not field is examined by myTimeProc to prevent any removal *
* of port pairs while they are possibly accessed by a lisp function *
* that writes to them (%mm-write-message and %mm-all-notes-off). *
* *
*--------------------------------------------------------------------------*/
struct p_pair {
short outport;
short inport;
};
struct inv_ports { /* is initialized by midicsetup */
short Remove_Not; /* used as a flag (boolean) */
short last_index; /* zero-based: index of last element in array */
struct p_pair port_pair[];
} *myports;
struct rem_ports {
short nextfree; /* points to the first free place in port_pair[] */
struct p_pair port_pair[];
} *oldports;
void add_port_pair(long outport, long inport)
{
short i,j;
struct p_pair temp={(short)outport,(short)inport};
/* move every pair one place to the back... */
for (i=myports->last_index,j=i+1;i>=0;i--,j--)
myports->port_pair[j]=myports->port_pair[i];
/* ...and put the packed long [outport,inport] at position 0 */
myports->port_pair[0]=temp;
(myports->last_index)++;
}
void cycle_port_pairs(long position) /* zero-based index of the new head */
{
struct p_pair temp;
short nr_of_pairs=myports->last_index+1;
short pop_pos, push_pos, tmp;
/* save the old beginning for later appending */
temp=myports->port_pair[0];
/* cycle through the positions until position 0 is reached again */
for (pop_pos=(short)position, push_pos=0;
pop_pos>0;
push_pos=pop_pos,tmp=pop_pos+(short)position,
pop_pos=(tmp < nr_of_pairs ? tmp : tmp-nr_of_pairs))
myports->port_pair[push_pos]=myports->port_pair[pop_pos];
/* restore the temp pair to its new place */
myports->port_pair[push_pos]=temp;
}
/*--------------------------------------------------------------------------*
* see-whether-buffers-expired sniffer functions *
*--------------------------------------------------------------------------*
* *
* Summary: *
* Once CommonMusic has signed into the MidiManager, a periodic callback *
* is scheduled with a time interval of wakeUpPeriod. *
* The callback procedure myTimeProc checks whether a buffer should be *
* considered expired. It does this by looping through all outports and *
* examining their refCon field, which holds the time stamp of the last *
* message written to that port. If a time stamp is more than *
* bufIdleTimeout ms old, the whole port_pair gets moved to the r_ports *
* for later removal at non-interrupt time :-| and deleted from the list *
* of available port_pairs. *
* However, if the Remove_Not field of myports is not zero, one of the *
* midi output writing routines is possibly accessing one of the ports, *
* so we simply wait until we're called again in this case. *
* *
*--------------------------------------------------------------------------*/
extern pascal void myTimeProc(long curTime, long myRefCon)
{
volatile long bufIdleTimeout=0x12345678;
volatile struct inv_ports *i_ports=0x12345678;
volatile short main_invoutport_id=0x1234;
volatile struct rem_ports *r_ports=0x12345678;
short idx,j,l_i,tmp;
long threshold=curTime-bufIdleTimeout;
struct p_pair temp={(short)0,(short)0};
/* if there are any auxiliary buffers ... */
if ((l_i=i_ports->last_index)>0) {
if (i_ports->Remove_Not) {
return; /* do nothing, wait for the next WakeUp */
}
else {
/* look through every port_pair for older RefCon's */
for (idx=0;idx<=l_i;idx++) {
tmp=i_ports->port_pair[idx].outport;
if ((tmp!=main_invoutport_id) &&
(MIDIGetRefCon(tmp)<=threshold)) {
/* don't release them at interrupt level! instead,
* transfer their entry to r_ports */
r_ports->port_pair[r_ports->nextfree]=i_ports->port_pair[idx];
r_ports->nextfree++;
/* shift the remaining port_pairs forward one place */
for (j=idx+1;j<=l_i;j++) {
i_ports->port_pair[j-1]=i_ports->port_pair[j];
}
/* clear the last one */
i_ports->port_pair[l_i]=temp;
/* update the last_index field */
i_ports->last_index=(--l_i);
}
}
}
}
}
/*
* Sort of CLRQ.L with all field offsets of *oldports hardcoded. This function
* is called at non-interrupt level from nearly all ff-midi's %mm-siblings.
* I know this may lead to undeallocated empty buffers hanging around and
* defragmenting the mac heap until midi is closed again, but i don't want to
* mess with mcl's event dispatch or *eventhook* mechanism to queue special
* 'ports-to-remove' events. One might think about queueing an specialized
* AppleEvent some time in the future, but this means setting up a AppleEvent
* record at interrupt level and writing an AppleEvent handler...
* Anyway, since this is a rare problem and since empty ports are removed
* automatically the next time one of those functions are called, i decided to
* leave it as it is for now.
*/
void remove_ports()
{
long *baseaddress=(char *)oldports+2;
long *firstfree=baseaddress+oldports->nextfree; /* increment as (long *) */
for (;baseaddress<firstfree;baseaddress++) {
MIDIRemovePort((short)((*baseaddress)>>16));
MIDIRemovePort((short)(*baseaddress));
*baseaddress=0L;
}
/* reset nextfree to 0 */
*(short *)oldports=(short)0;
}
/*--------------------------------------------------------------------------*
* Functions related with output buffer flushing *
*--------------------------------------------------------------------------*
* *
* Summary: *
* flushAllBuffers sets the internal switch of myInvisible ReadHook to *
* its flushing state and schedules an one-time callback to switch it *
* back later again. After millisecs time, which it gets from the time *
* port, myCleanUpProc terminates flushing. *
* Again, since the MidiManager provides no way to determine whether *
* an input port's buffer is empty, this approach may lead to problems *
* if there were _huge_ amounts of future packets awaiting delivery, *
* but could not be processed within the given time. *
* To prevent those unprocessed notes from dropping out of the midi *
* device at their scheduled time again (long after midi output has been *
* flushed), myCleanUpProc also removes any unprocessed messages from *
* the (main) invisible input port's queue by calling MIDIFlush. *
* *
* Since a self-modifying code approach is used for myInvisibleReadHook, *
* FlushCodeCacheRange or FlushCodeCache are called from both, *
* flushAllBuffers and myCleanUpProc. However, FlushCodeCacheRange may *
* not be implemented for some older versions of system software that *
* are not MC68040-aware. In this case, FlushCodeCacheRange returns *
* hwParamErr (Ð502) and it is necessary to flush the entire cache *
* instead, using FlushCodeCache. If FlushCodeCacheRange succeeds it *
* returns noErr (0). *
* *
*--------------------------------------------------------------------------*/
/*
* After some time, this cleanup function simply terminates flushing, so that
* we can continue with normal playing again.
*/
extern pascal void myCleanUpProc(long curTime, long myRefCon)
{
volatile short *flushing_ptr=0x12345678;
volatile struct inv_ports *i_ports=0x12345678;
short i, inv_inport;
/* flush all invisible inports and reset their offset times to
* midiGetCurrent */
for (i=0;i<=i_ports->last_index;i++) {
inv_inport=i_ports->port_pair[i].inport;
MIDIFlush(inv_inport);
MIDISetOffsetTime(inv_inport, midiGetCurrent);
}
/* reset the flushing flag */
*flushing_ptr=(short)FALSE;
/* flush the instruction cache, but
* try to flush only the code word at flushing_ptr */
if (hwParamErr==FlushCodeCacheRange((void *)flushing_ptr,2L))
FlushCodeCache();
}
/*
* refNum is the refNum of our time port. We schedule an additional callback
* in millisecs ms (our time port runs in ms) to do any necessary cleanup.
*/
void flushAllBuffers()
{
volatile short time_port=0x1234;
volatile long flush_timeout=0x12345678;
volatile short *flushing_ptr=0x12345678;
volatile struct inv_ports *i_ports=0x12345678;
short i;
*flushing_ptr=(short)TRUE;
/* try to flush only the code word at flushing_ptr */
if (hwParamErr==FlushCodeCacheRange((void *)flushing_ptr,2L))
FlushCodeCache();
for (i=0;i<=i_ports->last_index;i++)
MIDISetOffsetTime(i_ports->port_pair[i].inport, midiGetEverything);
MIDIWakeUp(time_port, (MIDIGetCurTime(time_port)+flush_timeout),
0, (ProcPtr)&myCleanUpProc);
}
/*--------------------------------------------------------------------------*
* Initialization function *
*--------------------------------------------------------------------------*
* *
* Summary: *
* midicsetup does all initialization tasks. *
* There is no need to check for the availability of either the *
* _HwPriv or _CacheFlush traps that get called by FlushCodeCacheRange *
* or FlushCodeCache, respectively, since *
* o MCL 2.0 requires System 6.0.4, and *
* o _HwPriv is implemented in the Macintosh IIx ROMs and later, as *
* well as System 6.0.3 and later, and *
* o _HwPriv expands to a call to _CacheFlush. *
* *
*--------------------------------------------------------------------------*/
struct inv_ports *midicsetup(timeport, inputport, outputport,
invinputport, invoutputport,
lisp_c_read,
wakeupperiod, bufidletimeout, flushtimeout, ptrsize)
int timeport, inputport, outputport, invinputport, invoutputport;
void (*lisp_c_read) (int msg, int tim);
long wakeupperiod, bufidletimeout, flushtimeout, ptrsize;
{
/*
* Since mcl's ff-interface preloads all its functions into a locked block,
* the function address is a pointer to an JMP $XXXXXXXX instruction. The
* long value after the JMP instruction holds the actual address.
* So we first typecast &somefunction to be a char pointer, increment it by
* 2 ('chars': the JMP instruction takes two bytes), and then typecast it back
* to be a pointer to a long and return its contents (the address we wanted).
*/
#define real_Address(x) *(long *)(((char *)(x))+2)
long *readHookPtr=real_Address(&myReadHook);
long *InvreadHookPtr=real_Address(&myInvisibleReadHook);
long *readEventPtr=real_Address(&midireadevent);
long *timeProcPtr=real_Address(&myTimeProc);
/* long *scheduleCBPtr=real_Address(&scheduleCallBack); */
long *cleanUpPtr=real_Address(&myCleanUpProc);
long *flushBufsPtr=real_Address(&flushAllBuffers);
struct p_pair temp={(short)invoutputport,(short)invinputport};
short psize=ptrsize-4;
/***
*** CAUTION: Always make sure this and the following offsets are in full
*** compliance with the actually generated code after compiling!
*** You may use MPW's dumpobj tool to compare the offsets.
***/
/* the pointer to the flushing flag */
short *flushingptr=(short *)((char *)InvreadHookPtr+0x12);
/* allocate a block to hold both, an inv_ports and a rem_ports structure */
myports=(struct inv_ports *)NewPtrClear(ptrsize);
if (!myports)
return 0;
/* rem_ports offset to inv_ports */
oldports=(struct rem_ports *)((long)myports+((ptrsize+2)>>1));
/* initialize the structures */
myports->Remove_Not=(short)0;
myports->last_index=(short)0;
myports->port_pair[0]=temp;
/* Initialization of the hardcoded variables.
* They are located at their (real) function addresses + specific offsets:
*/
*(long *)((char *)readHookPtr + 0xe) = (long)lisp_c_read;
*flushingptr = (short)FALSE;
*(short *)((char *)readEventPtr + 0x6) = (short)inputport;
*(long *)((char *)timeProcPtr + 0xa) = (long)bufidletimeout;
*(long *)((char *)timeProcPtr + 0x12) = myports;
*(short *)((char *)timeProcPtr + 0x1a) = (short)invoutputport;
*(long *)((char *)timeProcPtr + 0x20) = oldports;
*(long *)((char *)cleanUpPtr + 0xa) = (long)flushingptr;
*(long *)((char *)cleanUpPtr + 0x12) = myports;
*(short *)((char *)flushBufsPtr + 0x8) = (short)timeport;
*(long *)((char *)flushBufsPtr + 0xe) = (long)flushtimeout;
*(long *)((char *)flushBufsPtr + 0x16) = (long)flushingptr;
*(long *)((char *)flushBufsPtr + 0x1e) = myports;
MIDISetReadHook((short)inputport,(ProcPtr)&myReadHook);
MIDISetReadHook((short)invinputport,(ProcPtr)&myInvisibleReadHook);
/* schedule a periodic callback to release empty buffers */
MIDIWakeUp((short)timeport,0,wakeupperiod,(ProcPtr)&myTimeProc);
return myports;
}
/* ------------------------------------------------------------------------*/
/* ------------------------------------------------------------------------*/
/* unused - the lisp version is just as fast */
/*
int midiwritemessage(message, qtime)
int message; int qtime;
{
MIDIPacket packet;
int byte=16;
int size=(message & 0x03000000) >> 24;
int i;
packet.flags=0;
packet.len=(unsigned)9;
packet.tStamp=(long)qtime;
message=message & 0xffffff;
for (i=0; i<size; i++) {
packet.data[i]=(char)((message >> byte) & 0xff);
byte -= 8;
}
MIDIWritePacket(output_port, (MIDIPacketPtr)&packet);
return 0;
}
*/
/*
* EOF
*/These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.