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=-0.3 required=5.0 tests=BAYES_00, REPLYTO_WITHOUT_TO_CC autolearn=no autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,f58edf3a3fc00db X-Google-Attributes: gid103376,public X-Google-ArrivalTime: 2000-12-21 07:36:11 PST Path: supernews.google.com!sn-xit-02!supernews.com!newsfeed.mesh.ad.jp!newshub2.rdc1.sfba.home.com!news.home.com!enews.sgi.com!news-zh.switch.ch!newsfeed-zh.ip-plus.net!news.ip-plus.net!not-for-mail From: twolf@acm.org (Thomas Wolf) Newsgroups: comp.lang.ada Subject: Re: Interface to C; Storage_Error Date: Thu, 21 Dec 2000 15:35:46 GMT Organization: --- Message-ID: <3a422218.1843803860@paragate1> References: <91ondg$lpu$1@nnrp1.deja.com> <3a409667.1742507013@paragate1> <91qote$9cj$1@nnrp1.deja.com> <91rh14$vco$1@nnrp1.deja.com> Reply-To: twolf@acm.org NNTP-Posting-Host: kukclu.paranor.ch X-Trace: pollux.ip-plus.net 977412762 7047 195.65.4.173 (21 Dec 2000 15:32:42 GMT) X-Complaints-To: news@ip-plus.net NNTP-Posting-Date: 21 Dec 2000 15:32:42 GMT X-Newsreader: Forte Free Agent 1.11/32.235 Xref: supernews.google.com comp.lang.ada:3320 Date: 2000-12-21T15:32:42+00:00 List-Id: On Wed, 20 Dec 2000 23:57:28 GMT, Chris wrote: >After trying many different configurations, >I now seem to be making negative progress. So >I'm going back to the C code and getting my >brain out of Ada for a few moments... in case >this helps someone make sense of what I should >do, here's what the code looks like in C: > > typedef void* SRV_HANDLE; > typedef void* RSLT_HANDLE; > typedef void* CTX_HANDLE; > > > SRV_HANDLE hand = 0; > RSLT_HANDLE results; > CTX_HANDLE ctx = 0; > char name[255]; > double value = 0.0; > > status = InititalizeLibrary("config.txt", &hand); > // omitting error checking here > status = LookupResults(hand, "keystring", &results); > // reset these after every lookup > ctx = 0; > name[0] = 0; > status = GetNextVal(hand, results, &ctx, name, &value); > // this call can be repeated to get a series of name/value > // pairs. ctx is the handle to keep track of repeated > // calls, and starts at the beginning when 0. > >Clear as mud? I'm stumped, and sad that my Ada is so rusty. Try this: (It compiles, but of course I may have misunderstood something in your C code, or introduced new blunders. Use at your own risk, and don't blame me for bugs!) Let me know whether or not it works... with Interfaces.C.Strings; package Wrap_C_Code is type C_Context is private; type C_Error_Code is new Interfaces.C.Int; Success : constant C_Error_Code; procedure Initialize_Library (Ctx : in out C_Context; Name : in String; Status : out C_Error_Code); procedure Lookup_Results (Ctx : in out C_Context; Key : in String; Status : out C_Error_Code); procedure Get_Next_Value (Ctx : in out C_Context; Name : out String; Last : out Natural; Value : out Interfaces.C.Double; Status : out C_Error_Code); -- Raises Constraint_Error if 'Name' is not long enough to hold the -- full name returned by the underlying C routine. Otherwise, -- Name (Name'First .. Last) contains the name as returned by the C -- routine (without a trailing NUL character). procedure Reset_Results (Ctx : in out C_Context); private Success : constant C_Error_Code := 0; -- I'm guessing... subtype SRV_HANDLE is Interfaces.C.Strings.Chars_Ptr; subtype RSLT_HANDLE is Interfaces.C.Strings.Chars_Ptr; subtype CTX_HANDLE is Interfaces.C.Strings.Chars_Ptr; type C_Context is record Server : SRV_HANDLE := Interfaces.C.Strings.Null_Ptr; Results : RSLT_HANDLE := Interfaces.C.Strings.Null_Ptr; Current : CTX_HANDLE := Interfaces.C.Strings.Null_Ptr; end record; end Wrap_C_Code; package body Wrap_C_Code is procedure Initialize_Library (Ctx : in out C_Context; Name : in String; Status : out C_Error_Code) is procedure Init_Lib (Status : out C_Error_Code; Name : in Interfaces.C.Char_Array; Handle : in out SRV_HANDLE); pragma Import (C, Init_Lib, "InitializeLibrary"); pragma Import_Valued_Procedure (Init_Lib); begin Init_Lib (Status, Interfaces.C.To_C (Name), Ctx.Server); end Initialize_Library; procedure Lookup_Results (Ctx : in out C_Context; Key : in String; Status : out C_Error_Code) is procedure Lookup (Status : out C_Error_Code; Server : in SRV_HANDLE; Name : in Interfaces.C.Char_Array; Results : in out RSLT_HANDLE); pragma Import (C, Lookup, "LookupResults"); pragma Import_Valued_Procedure (Lookup); use type Interfaces.C.Strings.Chars_Ptr; begin if Ctx.Results /= Interfaces.C.Strings.Null_Ptr then Reset_Results (Ctx); end if; Lookup (Status, Ctx.Server, Interfaces.C.To_C (Key), Ctx.Results); end Lookup_Results; procedure Get_Next_Value (Ctx : in out C_Context; Name : out String; Last : out Natural; Value : out Interfaces.C.Double; Status : out C_Error_Code) is procedure Get_Next (Status : out C_Error_Code; Server : in SRV_HANDLE; Results : in RSLT_HANDLE; Ctx : in out CTX_HANDLE; Name : in out Interfaces.C.Char_Array; Value : out Interfaces.C.Double); pragma Import (C, Get_Next, "GetNextVal"); pragma Import_Valued_Procedure (Get_Next); C_String : Interfaces.C.Char_Array (1 .. 255); begin Get_Next (Status, Ctx.Server, Ctx.Results, Ctx.Current, C_String, Value); if Status = Success then Interfaces.C.To_Ada (C_String, Name, Last); -- Last is the number of elements set in 'Name', *not* -- necessarily the index of the last element assigned! Last := Name'First + Last - 1; -- Now it *is* the index of the last element assigned. end if; end Get_Next_Value; procedure Reset_Results (Ctx : in out C_Context) is -- I'm guessing here what "resetting" might be... begin Interfaces.C.Strings.Free (Ctx.Results); Ctx.Current := Interfaces.C.Strings.Null_Ptr; end Reset_Results; end Wrap_C_Code; -- Dr. Thomas Wolf (twolf@acm.org)