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.