From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,64a6ad02ec510120,start X-Google-Attributes: gid103376,public X-Google-ArrivalTime: 2002-11-01 07:37:57 PST Path: archiver1.google.com!news1.google.com!newsfeed.stanford.edu!logbridge.uoregon.edu!snoopy.risq.qc.ca!newsfeed.news2me.com!newsfeed2.earthlink.net!newsfeed.earthlink.net!stamper.news.pas.earthlink.net!newsread2.prod.itd.earthlink.net.POSTED!not-for-mail From: "Eric G. Miller" Subject: Interfacing to C library... User-Agent: Pan/0.13.0 (The whole remains beautiful (Debian GNU/Linux)) Message-ID: Newsgroups: comp.lang.ada MIME-Version: 1.0 Content-Type: text/plain; charset=ISO-8859-1 Date: Fri, 01 Nov 2002 15:38:04 GMT NNTP-Posting-Host: 216.119.3.36 X-Complaints-To: abuse@earthlink.net X-Trace: newsread2.prod.itd.earthlink.net 1036165084 216.119.3.36 (Fri, 01 Nov 2002 07:38:04 PST) NNTP-Posting-Date: Fri, 01 Nov 2002 07:38:04 PST Organization: EarthLink Inc. -- http://www.EarthLink.net Xref: archiver1.google.com comp.lang.ada:30285 Date: 2002-11-01T15:38:04+00:00 List-Id: I'm working on building an interface to a C library where most of the functions are defined as returning a long integer containing the various error codes returned by each function and data is passed back from the "functions" via pointer arguments to [usually] structures. Below is something of a demonstration of what I've come up with, but I'd appreciate pointers to better approaches. Eventually, I'd like to hide the access type and handle the error codes another way (exceptions maybe...). /************************* "cfuncs.h" **************************/ #ifndef CFUNCS_H #define CFUNCS_H /* error codes, might be multiples via |= */ #define NO_PROBLEMS 0x0000 #define DID_NOT_WORK 0x0001 #define FAILED_MISERABLY 0x0002 #define NASAL_DEMONS 0x0004 typedef struct scores_structure { long wins; long losses; } Score_Type; typedef enum game_names_enum { Pin_the_Tail_on_the_Donkey, Hop_Scotch, Dodge_Ball, Television_Tag, Kill_the_Man } Game_Name_Type; typedef struct game_play_structure { Game_Name_Type game; Score_Type scores; } Game_Type; long Initialize_Game (Game_Type *Game /* (in out) The game keeper */ ,Game_Name_Type Type /* (in) The game type */ ); long Play_Game (Game_Type *Game); /* (in out) Plays the game */ #endif /*****************************************************************/ /*************************** "cfuncs.c" **************************/ #include #include #include "cfuncs.h" long Initialize_Game (Game_Type *Game /* (out) The game keeper */ ,Game_Name_Type Type /* (in) The game type */ ) { long status = NO_PROBLEMS; if (!Game) { status |= NASAL_DEMONS; } else if (Type < Pin_the_Tail_on_the_Donkey || Type > Kill_the_Man) { status |= FAILED_MISERABLY; } else { srand (time(NULL)); Game->game = Type; Game->scores.wins = 0; Game->scores.losses = 0; } return status; } long Play_Game (Game_Type *Game) /* (in out) Plays the game */ { long status = NO_PROBLEMS; if (!Game) { status |= NASAL_DEMONS; } else { int number = rand(); number >>= 4; if (number & 1) Game->scores.wins++; else Game->scores.losses++; } return status; } /*****************************************************************/ -- cfuncs.ads -- -- Interface to cfuncs "game" package c_funcs is -- Error Type type Error_Code is mod 2**32; -- Error codes No_Problems : constant Error_Code := 16#0000#; Did_Not_Work : constant Error_Code := 16#0001#; Failed_Miserably : constant Error_Code := 16#0002#; Nasal_Demons : constant Error_Code := 16#0004#; type Game_Name_Type is ( Pin_the_Tail_on_the_Donkey, Hop_Scotch, Dodge_Ball, Television_Tag, Kill_the_Man ); pragma Convention (Convention => C, Entity => Game_Name_Type); type Score_Type is record Wins : Long_Integer; Losses : Long_Integer; end record; pragma Convention (Convention => C, Entity => Score_Type); type Game_Type is record Game : Game_Name_Type; Scores : Score_Type; end record; type Game_Type_Ptr is access all Game_Type; pragma Convention (Convention => C, Entity => Game_Type); function Initialize_Game ( Game : Game_Type_Ptr; Name : Game_Name_Type ) return Error_Code; function Play_Game ( Game : Game_Type_Ptr ) return Error_Code; pragma Import (Convention => C, Entity => Initialize_Game, External_Name => "Initialize_Game"); pragma Import (Convention => C, Entity => Play_Game, External_Name => "Play_Game"); end c_funcs; -- funky_test.adb with Ada.Text_Io; use Ada.Text_Io; with C_Funcs; use C_Funcs; procedure Funky_Test is Game : Game_Type_Ptr; Error : Error_Code; procedure Check_Errors (Error : Error_Code) is begin if (Error and Did_Not_Work) /= 0 then Put_Line ("Got 'Did_Not_Work' Error!"); end if; if (Error and Failed_Miserably) /= 0 then Put_Line ("Got 'Failed_Miserably' Error!"); end if; if (Error and Nasal_Demons) /= 0 then Put_Line ("Got 'Nasal_Demons' Error!"); end if; if Error /= No_Problems then raise Program_Error; end if; end Check_Errors; procedure Print_Scores (Game : in Game_Type_Ptr) is begin Put_Line (Game_Name_Type'Image(Game.Game) & ": Won " & Long_Integer'Image(Game.Scores.Wins) & ": Lost " & Long_Integer'Image(Game.Scores.Losses)); end Print_Scores; begin Game := new Game_Type; Error := Initialize_Game (Game => Game, Name => Pin_the_Tail_on_the_Donkey); Check_Errors (Error); Error := Play_Game (Game); Check_Errors (Error); Error := Play_Game (Game); Check_Errors (Error); Error := Play_Game (Game); Check_Errors (Error); Error := Play_Game (Game); Check_Errors (Error); Error := Play_Game (Game); Check_Errors (Error); Error := Play_Game (Game); Check_Errors (Error); Error := Play_Game (Game); Check_Errors (Error); Print_Scores (Game); Error := Initialize_Game (Game => Game, Name => Dodge_Ball); Check_Errors (Error); Error := Play_Game (Game); Check_Errors (Error); Error := Play_Game (Game); Check_Errors (Error); Error := Play_Game (Game); Check_Errors (Error); Error := Play_Game (Game); Check_Errors (Error); Print_Scores (Game); end Funky_Test;