comp.lang.ada
 help / color / mirror / Atom feed
From: happysegfault@yahoo.com (Happy Segfault)
Subject: Re: Minimal pragma Export (StdCall... example?
Date: 16 Mar 2004 05:54:17 -0800
Date: 2004-03-16T05:54:17-08:00	[thread overview]
Message-ID: <ed66a020.0403160554.7b8b5a94@posting.google.com> (raw)
In-Reply-To: ed66a020.0403131701.6340dd59@posting.google.com

I've got a minimal almost-working example now.  In case someone else 
goes looking for one later, I'll paste it in here.  Of course, if I'm 
doing something wrong, I'd appreciate someone pointing it out.  

There is some weirdness, however.  There is a seemingly 
GWindows-related access violation exception being thrown for some 
variations of this code.  I cannot figure it out!  

-- gw_in_a_dll.def
LIBRARY gw_in_a_dll
EXPORTS
        pop_a_window=pop_a_window@0
        pop_a_window@0
        pop_a_window_int=pop_a_window_int@4
        pop_a_window_int@4

-- makefile
PACKAGES = gw_in_a_dll call_gw_dll
 
ADAOPTS = -I../../bindings/
 
all: gw_in_a_dll call_gw_dll
 
gw_in_a_dll:
        gnatmake ${ADAOPTS} gw_in_a_dll ${POSTOPTS}
        gnatdll -egw_in_a_dll.def -dgw_in_a_dll.dll gw_in_a_dll.ali
 
call_gw_dll:
        gnatmake ${ADAOPTS} call_gw_dll ${POSTOPTS}
 
-- gw_in_a_dll.ads
-- Demonstrates using GWindows in a DLL
--
-- Modified from original GWindows version to use Stdcall calling
-- convention and to test parameter passing
--
-- This version does not work...
 
with Interfaces.C;
 
package GW_In_A_DLL is
 
   procedure Pop_A_Window;
   pragma Export (Stdcall, Pop_A_Window);
 
   procedure Pop_A_Window_Int(I : Interfaces.C.Int);
   pragma Export (Stdcall, Pop_A_Window_Int);
 
end GW_In_A_DLL;

-- gw_in_a_dll.adb
-- Demonstrates using GWindows in a DLL
--
-- Modified from original GWindows version to use Stdcall calling 
-- convention and to test parameter passing
--
-- This version does not work...
 
with Interfaces.C;
 
with GWindows.Application;
with GWindows.Windows;
with GWindows.GStrings;
 
package body GW_In_A_DLL is
 
   DLL_PROCESS_DETACH : constant := 0;
   DLL_PROCESS_ATTACH : constant := 1;
 
   procedure Adainit;
   pragma Import (C, Adainit);
 
   procedure Adafinal;
   pragma Import (C, Adafinal);
                                                                                
   function DllMain
     (hinstDLL    : Interfaces.C.long;
      fdwReason   : Interfaces.C.unsigned_short;
      lpvReserved : Integer)
     return Interfaces.C.int;
   pragma Export (StdCall, DllMain, "DllMain");
 
   -------------
   -- DllMain --
   -------------
 
   function DllMain
     (hinstDLL    : Interfaces.C.long;
      fdwReason   : Interfaces.C.unsigned_short;
      lpvReserved : Integer)
     return Interfaces.C.int
   is
      pragma Warnings (Off, lpvReserved);
   begin
      case fdwReason is
         when DLL_PROCESS_ATTACH =>
            GWindows.Application.Set_hInstance (HinstDLL);
            return 1;
         when DLL_PROCESS_DETACH =>
            Adafinal;
            return 1;
         when others =>
            return 1;
      end case;
   end DllMain;
 
   ------------------
   -- Pop_A_Window --
   ------------------
 
   procedure Pop_A_Window is
      use GWindows.Windows;
      use GWindows.GStrings;
 
      Window : Window_Type;
      J : constant Interfaces.C.Int := 2;
   begin
      Adainit;
 
      Create (Window,
   -- To_GString_From_String("Your number is " & "not here"),
   -- To_GString_From_String("Your number is not here"),
   -- To_GString_From_String("Your number defaults to " & J'Img),
   -- Any of the above will crash with an access violation                          
   "Your number is " & "not here",
   -- This line works fine!
   Width => 300, Height => 100);
      Visible (Window);
 
      GWindows.Application.Show_Modal (Window);
   end Pop_A_Window;
 
   ----------------------
   -- Pop_A_Window_Int --
   ----------------------
 
   procedure Pop_A_Window_Int(I : Interfaces.C.Int) is
      use GWindows.Windows;
      use GWindows.GStrings;
 
      Window : Window_Type;
      J : constant Interfaces.C.Int := 222;
   begin
      Adainit;
 
      Create (Window,
   -- To_GString_From_String("Your number is " & J'Img),
   To_GString_From_String("Your number is " & I'Img),
   -- To_GString_From_String("Your number is not here either"),
   -- All of the above work from call_gw_dll.exe, but this 
   -- procedure crashes Excel if I call it from Visual Basic.  
   Width => 300, Height => 100);
      Visible (Window);
 
      GWindows.Application.Show_Modal (Window);
   end Pop_A_Window_Int;
 
end GW_In_A_DLL;
 
-- call_gw_dll.adb
with Ada.Text_IO;
with Interfaces.C;
 
procedure Call_GW_DLL is
   pragma Linker_Options ("-lgw_in_a_dll");
 
   procedure Pop_A_Window;
   pragma Import (Stdcall, Pop_A_Window);
 
   procedure Pop_A_Window_Int(I : Interfaces.C.Int);
   pragma Import (Stdcall, Pop_A_Window_Int);
 
   I : constant Interfaces.C.Int := 3;
begin
   Ada.Text_IO.Put_Line("Doing Pop_A_Window");
   Pop_A_Window;
   Ada.Text_IO.Put_Line("Doing Pop_A_Window_Int(I)");
   Pop_A_Window_Int(3);
   Ada.Text_IO.Put_Line("Done!");
 
end Call_GW_DLL;



  reply	other threads:[~2004-03-16 13:54 UTC|newest]

Thread overview: 8+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2004-03-11 13:31 Minimal pragma Export (StdCall... example? Happy Segfault
2004-03-11 14:03 ` Dmitry A. Kazakov
2004-03-12 12:50   ` Happy Segfault
2004-03-12 13:36     ` Dmitry A. Kazakov
2004-03-14  1:01       ` Happy Segfault
2004-03-16 13:54         ` Happy Segfault [this message]
2004-03-11 15:00 ` Frank
2004-03-12 13:02   ` Happy Segfault
replies disabled

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox