How To - Using GNAT Dlls from C

It has been tested with GNAT v3.11p and MSVC 6.0 (sp1).

Simply cut & paste the files.

<----- make.bat ------------------------------------------------------->
@echo off

REM first built a relocatable Ada DLL
echo Build the Ada dll
gcc -c -O2 -mpentium -fomit-frame-pointer -s -o adadll.o adadll.adb
gnatbind -n -x adadll.ali
gnatlink -g -mdll -s -o adadll.dll adadll.ali -Xlinker
--base-file=adadll.base
dlltool --dllname adadll.dll --base-file adadll.base --output-exp
adadll.exp --def adadll.def
gnatlink -g -mdll -s -o adadll.dll adadll.ali -Xlinker
--base-file=adadll.base adadll.exp
dlltool --dllname adadll.dll --base-file adadll.base --output-exp
adadll.exp --def adadll.def
gnatlink -g -mdll -s -o adadll.dll adadll.ali -Xlinker adadll.exp

REM remove junk files
del b_adadll.c
del b_adadll.o
del adadll.o
del adadll.ali
del adadll.base
del adadll.exp

REM create a Microsoft-style import library
echo Build the import library
lib -machine:IX86 -def:adadll.def -out:adadll.lib > nul

REM remove junk files
del adadll.exp

REM compile and link the c++ client program
echo build the client program
cl /O2 client.cpp adadll.lib > nul

REM remove junk files
del client.obj

<----- adadll.def ---------------------------------------------------->
LIBRARY adadll
EXPORTS
   DllMain@12
   Junk
   Junk_2
   Junk_3

<----- client.cpp ----------------------------------------------------->
#include <stdio.h>

//  Import DLL functions
extern "C" {
   void Junk(void);
   int  Junk_2(void);
   int  Junk_3(int Value);
}

int main()
{
   // Call Junk first
   puts ("Calling 'Junk' in Ada Dll");
   Junk();

   // Call Junk_2
   puts ("Calling 'Junk_2' in Ada Dll, should return 42");
   printf("Junk_2 returned %d\n", Junk_2());

   // Call Junk_3
   puts ("Calling 'Junk_3' in Ada Dll with 50, should return 100");
   printf("Junk_3 returned %d\n", Junk_3(50));

   // done
   return 0;
}

<----- adadll.ads ---------------------------------------------------->
with System;
with Interfaces.C;

package Adadll is

   ------------------------------
   --  Win32 Type Definitions  --
   ------------------------------

   subtype BOOL      is Interfaces.C.int;
   subtype ULONG     is Interfaces.C.unsigned_long;
   subtype LPVOID    is System.Address;
   subtype HINSTANCE is System.Address;

   --------------------------
   --  DLL Initialization  --
   --------------------------

   function DllMain (hInst    : HINSTANCE;
                     Reason   : ULONG;
                     Reserved : LPVOID) return BOOL;
   --  DLL management

   -------------------
   --  Subprograms  --
   -------------------

   procedure Junk;
   --  just tell 'm we're there

   function Junk_2 return Interfaces.C.int;
   --  display message and return the answer to everything

   function Junk_3 (Value : Interfaces.C.int) return Interfaces.C.int;
   --  display the value and return the value 100

private

   -----------------
   --  Constants  --
   -----------------

   True_BOOL : constant BOOL := 1;
   --  win32 BOOL 'True' value

   DLL_PROCESS_DETACH : constant ULONG := 0;
   DLL_PROCESS_ATTACH : constant ULONG := 1;
   --  reasons for calling DllMain

   ---------------------------
   --  Export Declarations  --
   ---------------------------

   pragma Export (StdCall, DllMain, "DllMain");
   --  DllMain always uses the StdCall convention

   pragma Export (C, Junk,    "Junk");
   pragma Export (C, Junk_2,  "Junk_2");
   pragma Export (C, Junk_3,  "Junk_3");
   --  our own stuff uses the C convention

   ---------------------------
   --  Import Declarations  --
   ---------------------------

   procedure AdaInit;
   pragma Import (C, AdaInit, "adainit");
   --  initialize Ada runtime library

   procedure AdaFinal;
   pragma Import (C, AdaFinal, "adafinal");
   --  finalize Ada runtime library

end Adadll;

<----- adadll.adb ----------------------------------------------------->
with Ada.Text_IO;

package body Adadll is

   ---------------------------------------
   --  DLL initialization/finalization  --
   ---------------------------------------

   function DllMain (hInst    : HINSTANCE;
                     Reason   : ULONG;
                     Reserved : LPVOID) return BOOL is
   begin

      --  take the action for which we are called
      case Reason is

         --  a new process (_not_ thread) is attaching itself
         --  initialize the Ada runtime library for it
         when DLL_PROCESS_ATTACH =>
            AdaInit;
            return True_BOOL;

         --  a process is unloading the dll
         --  finalize the Ada runtine library for it
         when DLL_PROCESS_DETACH =>
            AdaFinal;
            return True_BOOL;

         --  in all other cases we simply return 'True'
         when others =>
            return True_BOOL;

      end case;

   end DllMain;

   --------------------------------
   --  just tell 'm we're there  --
   --------------------------------

   procedure Junk is
   begin
      Ada.Text_IO.Put_Line ("Excuting procedure 'Junk' from Dll");
   end Junk;

   -----------------------------------------------------------
   --  display message and return the answer to everything  --
   -----------------------------------------------------------

   function Junk_2 return Interfaces.C.int is
   begin
      Ada.Text_IO.Put_Line ("Now excuting function 'Junk_2' from Dll");
      return 42;
   end Junk_2;

   --------------------------------------------------
   --  display the value and return the value 100  --
   --------------------------------------------------

   function Junk_3 (Value : Interfaces.C.int) return Interfaces.C.int is
   begin
      Ada.Text_IO.Put ("function 'Junk_3' in Dll recieved the value:");
      Ada.Text_IO.Put_Line (Integer'Image (Integer (Value)));
      return 100;
   end Junk_3;

end Adadll;