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;
NOTE: (From Craig
Spannring)
When a DLL is loaded by a thread in a process, Windows prevents all other threads from running until the one thread has exited DllMain. This causes problems if AdaInit tries to start a task. AdaInit will wait until the task is initialized, but Windows never gives the thread any CPU time, therefore, AdaInit will never complete.