Prev: Timing code blocks
Next: Reporting bugs (was: Timing code blocks)
From: John McCabe on 9 Mar 2010 16:00
Guys

Thought I might as well add it to this thread, but I'm now having a
slight problem running with Win32Ada.

The basis of the code I'm using is in my "please review my code"
thread.

Essentially I've got the code shown below the double dashed line
(well, that's most of it).

When I run it, the Read_And_Print_Patches call _before_ outputting the
output device information is fine, but the same call _after_
outputting the output device information fails. Sometimes it just
prints the "1" prior to the Ada.Text_IO.Open call, and sometimes I get
PROGRAM_ERROR EXCEPTION_ACCESS_VIOLATION.

Now, if I change the declarations of Midi_In_Caps and Midi_Out_Caps
to:

Midi_In_Caps : aliased Win32.Mmsystem.MIDIINCAPS;
Midi_Out_Caps : aliased Win32.Mmsystem.MIDIOUTCAPS;

and use 'Unchecked_Access in the calls to midiInGetDevCaps and
midiOutGetDevCaps for those objects (and dispose of the Free calls) it
seems to work ok. That sounds like some memory isn't being allocated
properly somehow. I can't see that I'm doing anything wrong but if you
can please let me know.

One thing I noticed though is that in mmsystem.h (in the
i686-pc-mingw32 folder) the declaration of MIDIINCAPS (well,
MIDIINCAPSA as it's non-Unicode) is:

typedef struct tagMIDIINCAPSA {
WORD wMid;
WORD wPid;
MMVERSION vDriverVersion;
CHAR szPname[MAXPNAMELEN];
DWORD dwSupport;
} MIDIINCAPSA,*PMIDIINCAPSA,*LPMIDIINCAPSA;

However in win32-mmsystem.ads, the corresponding definition is:

type MIDIINCAPSA is -- mmsystem.h:835
record
wMid : Win32.WORD; -- mmsystem.h:836
wPid : Win32.WORD; -- mmsystem.h:837
vDriverVersion : MMVERSION; -- mmsystem.h:838
szPname : Win32.CHAR_Array (0 .. 31); -- mmsystem.h:839
end record;

Now call me stupid if you like, but does it not look like there's
something missing there? (i.e. the dwSupport field).

If anyone can be bothered to check this out and see what they think
your comments would be appreciated, especially if you can spot that
I've done something stupid.

Do you think this is a bug that AdaCore should know about if they
don't already?

Obviously I could go down the route of not using dynamic memory
because, as I mentioned, it seems to work that way, but I don't like
not knowing why it didn't work the other way!

=================================
-- File: MidiDevs.adb
with Ada.Text_IO;
with Ada.Unchecked_Deallocation;

with Interfaces.C;
use type Interfaces.C.Unsigned;

with Win32.Mmsystem;
use type Win32.Mmsystem.MMRESULT;

with TestFileRead;

procedure MidiDevs is
Num_Input_Devices : Win32.UINT;
Num_Output_Devices : Win32.UINT;

res : Win32.Mmsystem.MMRESULT;
Midi_In_Caps : Win32.Mmsystem.LPMIDIINCAPS;
Midi_Out_Caps : Win32.Mmsystem.LPMIDIOUTCAPS;

procedure Free is new
Ada.Unchecked_Conversion(Win32.Mmsystem.LPMIDIINCAPS,
Win32.Mmsystem.MIDIINCAPS);
procedure Free is new
Ada.Unchecked_Conversion(Win32.Mmsystem.LPMIDIOUTCAPS,
Win32.Mmsystem.MIDIOUTCAPS);

package UINT_Text_IO is new
Ada.Text_IO.Modular_IO(Win32.UINT);
package MM_Text_IO is new
Ada.Text_IO.Modular_IO(Win32.Mmsystem.MMRESULT);

begin
Num_Input_Devices := Win32.Mmsystem.midiInGetNumDevs;
Num_Output_Devices := Win32.Mmsystem.midiOutGetNumDevs;

Ada.Text_IO.Put("There are ");
UINT_Text_IO.Put(Num_Input_Devices, 0);
Ada.Text_IO.Put(" input devices available, and ");
UINT_Text_IO.Put(Num_Output_Devices, 0);
Ada.Text_IO.Put_Line(" output devices available.");

Midi_In_Caps := new Win32.Mmsystem.MIDIINCAPS;
Midi_Out_Caps := new Win32.Mmsystem.MIDIOUTCAPS;

if Num_Input_Devices > 0
then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put("The ");
UINT_Text_IO.Put(Num_Input_Devices, 0);
Ada.Text_IO.Put_Line(" input devices are:");
Ada.Text_IO.New_Line;

for Device_ID in Win32.UINT range 0..(Num_Input_Devices - 1)
loop
res := Win32.Mmsystem.midiInGetDevCaps(Device_ID,
Midi_In_Caps,

Win32.Mmsystem.MIDIINCAPS'size
* Win32.BYTE'size);
UINT_Text_IO.Put(Device_ID, 0);
Ada.Text_IO.Put(") ");
if res = Win32.Mmsystem.MMSYSERR_NOERROR
then
Ada.Text_IO.Put("szPname = ");

Ada.Text_IO.Put_Line(Interfaces.C.To_Ada(Win32.To_C(Midi_In_Caps.szPname)));
else
Ada.Text_IO.Put("Query Failed. Returned ");
MM_Text_IO.Put(res, 0);
end if;
Ada.Text_IO.New_Line;
end loop;
end if;

-- Try reading in the file
TestFileRead.Read_And_Print_Patches;
Ada.Text_IO.New_Line;

if Num_Output_Devices > 0
then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put("The ");
UINT_Text_IO.Put(Num_Output_Devices, 0);
Ada.Text_IO.Put_Line(" output devices are:");
Ada.Text_IO.New_Line;

for Device_ID in Win32.UINT range 0..(Num_Output_Devices - 1)
loop
res := Win32.Mmsystem.midiOutGetDevCaps(Device_ID,
Midi_Out_Caps,

Win32.Mmsystem.MIDIOUTCAPS'size
* Win32.BYTE'size);
UINT_Text_IO.Put(Device_ID, 0);
Ada.Text_IO.Put(") ");
if res = Win32.Mmsystem.MMSYSERR_NOERROR
then
Ada.Text_IO.Put("szPname = ");

Ada.Text_IO.Put_Line(Interfaces.C.To_Ada(Win32.To_C(Midi_Out_Caps.szPname)));
else
Ada.Text_IO.Put("Query Failed. Returned ");
MM_Text_IO.Put(res, 0);
end if;
Ada.Text_IO.New_Line;
end loop;
end if;

-- Try reading in the file
TestFileRead.Read_And_Print_Patches;
Ada.Text_IO.New_Line;

Free(Midi_In_Caps);
Free(Midi_Out_Caps);

end MidiDevs;
===================
=================================
-- File: TestFileRead.ads
package TestFileRead is
procedure Read_And_Print_Patches;
end TestFileRead;
===================
=================================
-- File: TestFileRead.adb
with Ada.Text_IO;

package body TestFileRead is
----------------------------
-- Read_And_Print_Patches --
----------------------------
procedure Read_And_Print_Patches is
Input_File : Ada.Text_IO.File_Type;
begin
Ada.Text_IO.Put_Line("1");
-- Note: You need a file that exists
Ada.Text_IO.Open(SysEx_File,
Ada.Text_IO.In_File,
"FILENAME.TXT");
Ada.Text_IO.Put_Line("2");
Ada.Text_IO.Close(Input_File);
Ada.Text_IO.Put_Line("3");
end Read_And_Print_Patches;

end TestFileRead;
===========

From: John McCabe on 9 Mar 2010 16:37
John McCabe <john(a)nospam.assen.demon.co.uk.nospam> wrote:

Couple of corrections....

1) I've put Unchecked_Conversion where it should be
Unchecked_Deallocation. Replace:

> procedure Free is new
> Ada.Unchecked_Conversion(Win32.Mmsystem.LPMIDIINCAPS,
> Win32.Mmsystem.MIDIINCAPS);
> procedure Free is new
> Ada.Unchecked_Conversion(Win32.Mmsystem.LPMIDIOUTCAPS,
> Win32.Mmsystem.MIDIOUTCAPS);

With

procedure Free is new
Ada.Unchecked_Deallocation(Win32.Mmsystem.MIDIINCAPS,
Win32.Mmsystem.LPMIDIINCAPS);

procedure Free is new
Ada.Unchecked_Deallocation(Win32.Mmsystem.MIDIOUTCAPS,
Win32.Mmsystem.LPMIDIOUTCAPS);


2) In face, the replacing with aliased Win32.Mmsystem.MIDIINCAPS etc
and use of Unchecked_Access DOESN'T WORK. It stops the file open from
failing, but the calls to midiIn/OutGetDevCaps return MMRESULT value
11 whish is Invalid Parameter.

Ah well.

I've done some more searching, and it looks to me like basically the
Win32Ada binding that AdaCore are allowing people to download are a
minimum of 11 years old. Apparently the last intermetrics version
(3.0) was released in 1999. The win32-mmsystem.ads has an Intermetrics
copyright date of 1995.

This is rather unfortunate. I'd hope this would be very useful for
what I wanted to do but, to be honest, it looks like the idea is
doomed as I really don't want to have to re-create a whole set of
Win32 Ada bindings based on the existing MinGW versions of these files
(that also appear to be out of date compared to the definitions of the
types you can find on Microsoft's website).

Disappointing.
John
From: tmoran on 9 Mar 2010 21:32
> One thing I noticed though is that in mmsystem.h (in the
> i686-pc-mingw32 folder) the declaration of MIDIINCAPS (well,
> MIDIINCAPSA as it's non-Unicode) is:
>
> typedef struct tagMIDIINCAPSA {
> WORD wMid;
> WORD wPid;
> MMVERSION vDriverVersion;
> CHAR szPname[MAXPNAMELEN];
> DWORD dwSupport;
> } MIDIINCAPSA,*PMIDIINCAPSA,*LPMIDIINCAPSA;
>
> However in win32-mmsystem.ads, the corresponding definition is:
>
> type MIDIINCAPSA is -- mmsystem.h:835
> record
> wMid : Win32.WORD; -- mmsystem.h:836
> wPid : Win32.WORD; -- mmsystem.h:837
> vDriverVersion : MMVERSION; -- mmsystem.h:838
> szPname : Win32.CHAR_Array (0 .. 31); -- mmsystem.h:839
> end record;

> I've done some more searching, and it looks to me like basically the
> Win32Ada binding that AdaCore are allowing people to download are a
> minimum of 11 years old. Apparently the last intermetrics version
> (3.0) was released in 1999. The win32-mmsystem.ads has an Intermetrics
> copyright date of 1995.

Looking at an mmsystem.h dated 8/21/96 I see

typedef struct tagMIDIINCAPSA {
WORD wMid; /* manufacturer ID */
WORD wPid; /* product ID */
MMVERSION vDriverVersion; /* version of the driver */
CHAR szPname[MAXPNAMELEN]; /* product name (NULL terminated string) */
#if (WINVER >= 0x0400)
DWORD dwSupport; /* functionality supported by driver */
#endif
} MIDIINCAPSA,*PMIDIINCAPSA,*LPMIDIINCAPSA;

Do you need to access dwSupport? If not, do you need to allocate space for
a record of this type, or do you just use pointers to a record allocated
by mmsystem?
From: John McCabe on 10 Mar 2010 03:05
John McCabe <john(a)nospam.assen.demon.co.uk.nospam> wrote:

>Guys

<..snip..>

>Now call me stupid if you like, <..snip..>

You're stupid - glad it was me who spotted it though :-) Sudden flash
of inspiration at ~6:00am....

> res := Win32.Mmsystem.midiInGetDevCaps(Device_ID,
> Midi_In_Caps,
>
>Win32.Mmsystem.MIDIINCAPS'size
> * Win32.BYTE'size);

It would probably help if I wasn't asking for the Midi_In_Caps
structure to be filled in with 64x the amount it should be. I should
be dividing by Win32.BYTE'Size here, not multiplying.

Still doesn't get round the issue with win32-mmsystem,h but, in answer
to Tom (later), I don't need the dwSupport field on the IN side as
it's always zero.

John
First  |  Prev  | 
Pages: 1 2
Prev: Timing code blocks
Next: Reporting bugs (was: Timing code blocks)