Interfacing access-to-subprograms into a C program

Interfacing access-to-subprograms into a C program

[martin.m.dowie]

I'm writing to provide a C binding for an Ada program but am having
trouble getting a good binding for an access-to-subprogram parameter.

My current solution isn't particularly good as it would leave open the
possibility of blocking another thread (possibly forever!).


Here's what I have:

with Interfaces.C.Strings;

package DLL_Test is

   type An_Action is
     access procedure (Item :     String;
                       Quit : out Boolean);

   package C is
      type A_C_Boolean is new Boolean;
      pragma Export (C, A_C_Boolean, "dllTestBoolean");

      type A_C_Action is
         access procedure (Item :     Interfaces.C.Strings.Chars_Ptr;
                           Quit : out A_C_Boolean);
      pragma Export (C, A_C_Action, "dllTestAction");

   end C;

   procedure Do_Action (Action : An_Action);

private

   package Private_C is

      procedure C_Do_Action (Action : Dll_Test.C.A_C_Action);
      pragma Export (C, C_Do_Action, "dllTestDoAction");

   end Private_C;

end DLL_Test;

package body DLL_Test is

   procedure Do_Action (Action : An_Action) is
   begin
      null;
   end Do_Action;

   package Lock is
      procedure Seize;
      procedure Release;
   end Lock;

   package body Private_C is

      C_Action : Dll_Test.C.A_C_Action;

      procedure Do_Ada_Action (Item :     String;
                               Quit : out Boolean) is
      begin
         C_Action (Item => Interfaces.C.Strings.New_String (Str => Item),
                   Quit => Dll_Test.C.A_C_Boolean (Quit));
      end Do_Ada_Action;

      procedure C_Do_Action (Action : Dll_Test.C.A_C_Action) is
      begin
         Lock.Seize;
         C_Action := Action;
         Do_Action (Action => Do_Ada_Action'Access);
         Lock.Release;
      end C_Do_Action;

   end Private_C;

   -- Not real yet
   package body Lock is
      procedure Seize is begin null; end;
      procedure Release is begin null; end;
   end Lock;

end DLL_Test;