Lazarus / FreePascal problem on 64 bit machines.

I ported some open source MIDI handler code from Delphi to Lazarus. This was originally working on a 32 bit Windows machine but when I compiled and ran it on my Windows 64 bit machine I got a Segment Violation error when opening the input MIDI port.

I tracked the error down to the system unit called “mmSystem”. This defines interfaces to the windows multimedia DLL –  “winmm.dll”. The offending interface was a function called “midiInOpen”.

The function has a parameter for the address of a callback function. The current “mmSystem” unit defines this as 32 bit and not 64 bit as it should be if the code is compiled for a 64 bit machine. The unit needs to be upgraded to handle both cases.

In the mean time, I hacked my (open source) MIDI driver code to handle both cases:

I used the compiler conditional expressions to determine when I am compiling a 32bit or 64 bit system.

I have defined an alternative interface for midiInOpen call midiInOpenX which has a 64bit parameter (int64) for the callback address.

Seems to do the trick…

 

// X64 hack
{$IFDEF WIN64}
Function midiInOpenX(x1: LPHMIDIIN; x2: UINT; x3: int64; x4: DWORD; x5: DWORD): MMRESULT;stdcall; external 'winmm.dll' name 'midiInOpen';
{$ENDIF}

procedure TMidiInput.Open(const aDeviceIndex: integer);
var
lHandle: THandle;
lResult: MMResult;

begin
inherited;
if assigned( fDevices.Objects[ aDeviceIndex ] ) then Exit;

{$IFDEF WIN64}
lResult := midiInOpenX( @lHandle, aDeviceIndex, int64(@midiCallback), aDeviceIndex, CALLBACK_FUNCTION );
{$ENDIF}

{$IFDEF WIN32}
lResult := midiInOpen( @lHandle, aDeviceIndex, longword(@midiCallback), aDeviceIndex, CALLBACK_FUNCTION );
{$ENDIF}

if lResult <> MMSYSERR_NOERROR then
raise exception.Create( GetLastErrorText );
midiInStart(lHandle);

fDevices.Objects[ aDeviceIndex ] := TObject( lHandle );
end;

Leave a Reply