* Re: ALR unable to get many packages
@ 2023-08-06 23:29 2% ` Kenneth Wolcott
0 siblings, 0 replies; 200+ results
From: Kenneth Wolcott @ 2023-08-06 23:29 UTC (permalink / raw)
Hi Simon;
An attempt to "get" aws follows along with all of my openssl installed packages from MacPorts.
alr --no-color get aws
Warning:
Warning: New solution is incomplete.
Warning: +i gnat 13.1.0 (new,installed,gnat_external)
Warning: + gnatcoll 23.0.0 (new)
Warning: + libgpr 23.0.0 (new,indirect)
Warning: + make 3.81.0 (new)
Warning: +~ openssl * (new,external)
Warning: + xmlada 23.0.0 (new)
Warning:
Warning: Could not find a complete solution for aws=23.0.0
Build will fail unless externals are made available, do you want to continue?
[Y] Yes [N] No (default is No) y
Note: Deploying aws=23.0.0...
########################################################################################################################### 100.0%
warn: Generating possibly incomplete environment because of missing dependencies
Note: Deploying make=3.81.0...
Note: Deploying xmlada=23.0.0...
-=O#- # # #
Note: Running post_fetch actions for xmlada=23.0.0...
checking build system type... aarch64-apple-darwin22.6.0
checking host system type... aarch64-apple-darwin22.6.0
checking target system type... aarch64-apple-darwin22.6.0
checking whether gnat can build shared libs... yes
checking for a BSD-compatible install... /opt/local/bin/ginstall -c
checking whether ln -s works... yes
configure: creating ./config.status
config.status: creating xmlada_shared.gpr
config.status: creating Makefile
config.status: creating tests/dom/default.gpr
Note: Deploying libgpr=23.0.0...
-=O#- # # #
Note: Deploying gnatcoll=23.0.0...
-=#=- # # #
Note: Running post_fetch actions for aws=23.0.0...
sed: illegal option -- s
usage: sed script [-Ealnru] [-i extension] [file ...]
sed [-Ealnu] [-i extension] [-e script] ... [-f script_file] ... [file ...]
sed: illegal option -- s
usage: sed script [-Ealnru] [-i extension] [file ...]
sed [-Ealnu] [-i extension] [-e script] ... [-f script_file] ... [file ...]
Bind
[gprbind] xoscons.bexch
[Ada] xoscons.ali
Link
[link] xoscons.adb
Setup OS specific definitions
aws-os_lib-tmplt.c:324:24: error: invalid operand for inline asm constraint 'i'
/*NOGEN*/ asm volatile("\n->CND:%0:" "SIN_FAMILY_OFFSET" ":%1:" "sin_family offset in record" : : "i" (324), "i" ((int) (uintptr_t)((uintptr_t)&sa.sin_family - (uintptr_t)&sa)));;
^
aws-os_lib-tmplt.c:343:24: error: invalid operand for inline asm constraint 'i'
/*NOGEN*/ asm volatile("\n->CND:%0:" "AI_FAMILY_OFFSET" ":%1:" "???" : : "i" (343), "i" ((int) (uintptr_t)((uintptr_t)&ai.ai_family - (uintptr_t)&ai)));;
^
aws-os_lib-tmplt.c:344:24: error: invalid operand for inline asm constraint 'i'
/*NOGEN*/ asm volatile("\n->CND:%0:" "AI_CANONNAME_OFFSET" ":%1:" "???" : : "i" (344), "i" ((int) (uintptr_t)((uintptr_t)&ai.ai_canonname - (uintptr_t)&ai)));;
^
aws-os_lib-tmplt.c:345:24: error: invalid operand for inline asm constraint 'i'
/*NOGEN*/ asm volatile("\n->CND:%0:" "AI_ADDR_OFFSET" ":%1:" "???" : : "i" (345), "i" ((int) (uintptr_t)((uintptr_t)&ai.ai_addr - (uintptr_t)&ai)));;
^
aws-os_lib-tmplt.c:233:17: error: unexpected token at start of statement
asm volatile("\n->TXT:%0:" "-- This is the version for " "arm64-apple-darwin22.6.0" : : "i" (233));
^
<inline asm>:2:1: note: instantiated into assembly here
->TXT:233:-- This is the version for arm64-apple-darwin22.6.0
^
aws-os_lib-tmplt.c:234:17: error: unexpected token at start of statement
asm volatile("\n->TXT:%0:" "" : : "i" (234));
^
<inline asm>:2:1: note: instantiated into assembly here
->TXT:234:
^
aws-os_lib-tmplt.c:240:17: error: unexpected token at start of statement
asm volatile("\n->TXT:%0:" "with Interfaces.C.Strings;" : : "i" (240));
^
<inline asm>:2:1: note: instantiated into assembly here
->TXT:240:with Interfaces.C.Strings;
^
aws-os_lib-tmplt.c:241:17: error: unexpected token at start of statement
asm volatile("\n->TXT:%0:" "with System;" : : "i" (241));
^
<inline asm>:2:1: note: instantiated into assembly here
->TXT:241:with System;
^
aws-os_lib-tmplt.c:243:17: error: unexpected token at start of statement
asm volatile("\n->TXT:%0:" "with GNAT.OS_Lib;" : : "i" (243));
^
<inline asm>:2:1: note: instantiated into assembly here
->TXT:243:with GNAT.OS_Lib;
^
aws-os_lib-tmplt.c:272:17: error: unexpected token at start of statement
asm volatile("\n->C:%0:" "Target_OS" ":" "OS_Type" ":" "Other_OS" ":" "" : : "i" (272));
^
<inline asm>:2:1: note: instantiated into assembly here
->C:272:Target_OS:OS_Type:Other_OS:
^
aws-os_lib-tmplt.c:281:17: error: unexpected token at start of statement
asm volatile("\n->C:%0:" "Target_Name" ":" "String" ":" "arm64-apple-darwin22.6.0" ":" "" : : "i" (281));
^
<inline asm>:2:1: note: instantiated into assembly here
->C:281:Target_Name:String:arm64-apple-darwin22.6.0:
^
aws-os_lib-tmplt.c:310:17: error: unexpected token at start of statement
asm volatile("\n->CND:%0:" "SIZEOF_unsigned_int" ":%1:" "Size of unsigned int" : : "i" (310), "i" ((int) sizeof (unsigned int)));
^
<inline asm>:2:1: note: instantiated into assembly here
->CND:310:SIZEOF_unsigned_int:4:Size of unsigned int
^
aws-os_lib-tmplt.c:313:17: error: unexpected token at start of statement
asm volatile("\n->CND:%0:" "SIZEOF_fd_set" ":%1:" "fd_set" : : "i" (313), "i" ((int) (sizeof (fd_set))));;
^
<inline asm>:2:1: note: instantiated into assembly here
->CND:313:SIZEOF_fd_set:128:fd_set
^
aws-os_lib-tmplt.c:314:17: error: unexpected token at start of statement
asm volatile("\n->CND:%0:" "FD_SETSIZE" ":%1:" "Max fd value" : : "i" (314), "i" ((int) 1024));;
^
<inline asm>:2:1: note: instantiated into assembly here
->CND:314:FD_SETSIZE:1024:Max fd value
^
aws-os_lib-tmplt.c:320:17: error: unexpected token at start of statement
asm volatile("\n->CND:%0:" "SIZEOF_sin_family" ":%1:" "Size of sa.sin_family" : : "i" (320), "i" ((int) sizeof (sa.sin_family) * 8));;
^
<inline asm>:2:1: note: instantiated into assembly here
->CND:320:SIZEOF_sin_family:8:Size of sa.sin_family
^
aws-os_lib-tmplt.c:353:17: error: unexpected token at start of statement
asm volatile("\n->CND:%0:" "SIZEOF_nfds_t" ":%1:" "Size of nfds_t" : : "i" (353), "i" ((int) sizeof (nfds_t) * 8));;
^
<inline asm>:2:1: note: instantiated into assembly here
->CND:353:SIZEOF_nfds_t:32:Size of nfds_t
^
aws-os_lib-tmplt.c:362:17: error: unexpected token at start of statement
asm volatile("\n->CND:%0:" "SIZEOF_pollfd_events" ":%1:" "Size of pollfd.events" : : "i" (362), "i" ((int) sizeof (v_pollfd.events) * 8));;
^
<inline asm>:2:1: note: instantiated into assembly here
->CND:362:SIZEOF_pollfd_events:16:Size of pollfd.events
^
aws-os_lib-tmplt.c:373:17: error: unexpected token at start of statement
asm volatile("\n->CND:%0:" "SIZEOF_fd_type" ":%1:" "Size of socket fd" : : "i" (373), "i" ((int) sizeof (v_pollfd.fd) * 8));;
^
<inline asm>:2:1: note: instantiated into assembly here
->CND:373:SIZEOF_fd_type:32:Size of socket fd
^
aws-os_lib-tmplt.c:381:17: error: unexpected token at start of statement
asm volatile("\n->CND:%0:" "SIZEOF_socklen_t" ":%1:" "Size of socklen_t" : : "i" (381), "i" ((int) sizeof (socklen_t) * 8));;
^
<inline asm>:2:1: note: instantiated into assembly here
->CND:381:SIZEOF_socklen_t:32:Size of socklen_t
^
fatal error: too many errors emitted, stopping now [-ferror-limit=]
20 errors generated.
raised raised ADA.IO_EXCEPTIONS.NAME_ERROR : aws-os_lib-tmplt.s: No such file or directory
make[1]: *** [../.build/arm64-apple-darwin22.6.0/debug/../setup/src/aws-os_lib.ads] Error 1
make: *** [config_setup] Error 2
ERROR: A post-fetch action failed, re-run with -vv -d for details
-----------------------------------------------
port installed | grep openssl
openssl @3_8
openssl @3_9
openssl @3_9+universal
openssl @3_10+universal
openssl @3_10
openssl @3_11
openssl @3_12 (active)
openssl3 @3.0.7_0+legacy
openssl3 @3.0.7_2+legacy
openssl3 @3.0.8_1+legacy
openssl3 @3.0.8_1+legacy+universal
openssl3 @3.1.0_0+universal
openssl3 @3.1.0_1
openssl3 @3.1.0_1+universal
openssl3 @3.1.0_2+universal
openssl3 @3.1.0_3+universal
openssl3 @3.1.0_3
openssl3 @3.1.1_0
openssl3 @3.1.2_0 (active)
openssl10 @1.0.2u_4 (active)
openssl11 @1.1.1s_0
openssl11 @1.1.1t_0
openssl11 @1.1.1t_1
openssl11 @1.1.1u_1
openssl11 @1.1.1v_1 (active)
py310-openssl @21.0.0_0
py310-openssl @22.1.0_0
py310-openssl @23.0.0_0
py310-openssl @23.2.0_0 (active)
py311-openssl @23.0.0_0
py311-openssl @23.2.0_0 (active)
qt5-qtbase @5.15.6_1+openssl
qt5-qtbase @5.15.8_0+openssl
qt5-qtbase @5.15.8_1+openssl
qt5-qtbase @5.15.9_0+openssl
qt5-qtbase @5.15.10_0+openssl (active)
qt6-qtbase @6.4.3_1+openssl (active)
-----------------------------------------------
That reminds me, I need to uninstall those "universal" packages...
Thanks,
Ken
^ permalink raw reply [relevance 2%]
* Re: New compiler error with new compiler
@ 2022-12-06 11:36 2% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2022-12-06 11:36 UTC (permalink / raw)
On 2022-12-06 12:13, Jerry wrote:
> As mentioned in a recent post, I changed from a 2015 GNAT on Mac Intel to 2022 compiler on Mac ARM.
>
> I don't know if this is of interest but I am now getting a compiler error that I never got before. It is in the Ada bindings to MPFR https://www.mpfr.org/. The problematic code is in this SVN checkout that I have never laid eyes on but which worked well in the past, certainly without compiler errors.
>
> The error that I am now getting is
>
> mpfr-floats.adb:788:27: error: duplication of choice value: 15 at line 787
>
> Here are lines around the referenced lines from that file. The first line (function...) is numbered 783.
>
> function Generic_Round (X : MPFR_Float) return F
> is begin
> case F'Base'Digits is
> when Float'Digits => return F(mpfr_get_flt(X.Value, default_rounding_mode));
> when Long_Float'Digits => return F(mpfr_get_d (X.Value, default_rounding_mode));
> when Long_Long_Float'Digits => eturn F(mpfr_get_ld (X.Value, default_rounding_mode));
> when others => raise Constraint_Error;
> end case;
> end Generic_Round;
>
> When I comment out line 788 the error does not appear. I have not used this binding for a long time and have not tested it today so I don't know the effect of this modification. The file is several years old and I don't know if the current code base for the bindings is the same--my concern here is the new Ada compiler complaint.
Looks like Long_Long_Float has at least same mantissa as Long_Float.
What are the actual values of Long_Float'Digits and Long_Long_Float'Digits?
Anyway it is all permitted:
ARM 3.5.7(16):
"An implementation is allowed to provide additional predefined floating
point types, declared in the visible part of Standard, whose
(unconstrained) first subtypes have names of the form Short_Float,
Long_Float, Short_Short_Float, Long_Long_Float, etc. Different
predefined floating point types are allowed to have the same base
decimal precision. However, the precision of Float should be no greater
than that of Long_Float. Similarly, the precision of Short_Float (if
provided) should be no greater than Float. Corresponding recommendations
apply to any other predefined floating point types. There need not be a
named floating point type corresponding to each distinct base decimal
precision supported by an implementation."
But bindings look very strange to me:
1. Long_Long_Float may not exist at all.
2. When dealing with a C library, use C types defined in Interfaces.C!
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 2%]
* Re: MS going to rust (and Linux too)
@ 2022-09-24 20:38 2% ` Luke A. Guest
0 siblings, 0 replies; 200+ results
From: Luke A. Guest @ 2022-09-24 20:38 UTC (permalink / raw)
On 24/09/2022 18:49, G.B. wrote:
> On 24.09.22 15:05, Luke A. Guest wrote:
>> On 24/09/2022 12:41, G.B. wrote:
>>
>>> Write a really good driver for Linux using Ada 2012 and do not use
>>> capital letters in the source text, at least where Linux doesn't.
>>> Be silent about the language. Can an Adaist do that, to save the
>>> language?
>>
>> The biggest problem is that the compiled runtime is compiler version
>> dependent and the pain of making a runtime for linux kernel dev
>> available for each and every compiler version, remember these things
>> can also change on a version change too.
>
> Won't the Ada run-time need very little?
You would need to generate bindings to the linux header files per release.
1) I guarantee you he will have a hissy fit over having to have a
bootstrap compiler.
2) Likely another hissy fit because gcc's binding generator has a
propensity for stripping out names and replacing them with useless
"arg*" type identifiers.
There are likely some small parts you might want, maybe a small
secondary stack? Partial interfaces.c packages.
^ permalink raw reply [relevance 2%]
* Re: max line length
@ 2022-04-19 6:38 3% ` Niklas Holsti
0 siblings, 0 replies; 200+ results
From: Niklas Holsti @ 2022-04-19 6:38 UTC (permalink / raw)
On 2022-04-19 0:58, Thomas wrote:
> hi :-)
>
>
> how do you set your max line length?
>
> using indentations a lot, i find that 80 is short.
I limit lines to 80 characters, because I very often want to use a
side-by-side diff of file versions, which means having a window wider
than two line-lengths. Text in a 170-character-wide window is still
readable, but wider ones are not, for me as an older guy with stiff
eye-lenses.
To make do with 80-character lines, I often use local or partial
use-clauses, and I divide long calls across many lines, usually having
only one parameter per line. By a "partial use clause" I mean, for
example, "use Interfaces", when I really need to use Interfaces.C, so I
still have to qualify with "C.zzz" but not with "Interfaces.C.zzz".
I also group subsystems into package families (parent and child
packages) which means that the children can directly use parent-declared
identifiers without qualification.
Other means to keep lines short include using a small indentation step
(I now use 3 spaces, but I'm considering changing to 2 spaces) and
keeping subprograms short, which also helps the readability.
^ permalink raw reply [relevance 3%]
* Re: Plugin with controlled variable for initialization.
2022-02-02 17:21 2% Plugin with controlled variable for initialization hreba
@ 2022-02-02 18:05 3% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2022-02-02 18:05 UTC (permalink / raw)
On 2022-02-02 18:21, hreba wrote:
> For the plugin scheme in my actual program I worked along the
> corresponding gnat example, but while the original works, mine doesn't.
> So I boiled it down to a minimum.
>
> plugin.ads
> ----------
>
> package Plugin is
> procedure Empty;
> end Plugin;
>
> plugin.adb
> ----------
> with Ada.Finalization;
> with Ada.Text_IO;
>
> package body Plugin is
>
> type Life_Controller is new Ada.Finalization.Limited_Controlled with
> null record;
> overriding procedure Initialize (lc: in out Life_Controller);
> overriding procedure Finalize (lc: in out Life_Controller);
>
> procedure Empty is
> begin
> null;
> end Empty;
>
> overriding procedure Initialize (lc: in out Life_Controller) is
> begin
> Ada.Text_IO.Put_Line("Hello world!");
> end Initialize;
>
> overriding procedure Finalize (lc: in out Life_Controller) is
> begin
> Ada.Text_IO.Put_Line("Bye world!");
> end Finalize;
>
> lc: Life_Controller;
>
> end Plugin;
>
> main.adb
> --------
> with System;
> with Interfaces.C.Strings;
> with Ada.Text_IO;
>
> procedure Main is
>
> use type System.Address;
> RTLD_LAZY: constant := 1;
> handle: System.Address;
>
> function dlopen (Lib_Name: String; Mode: Interfaces.C.int)
> return System.Address;
> pragma Import (C, dlopen, "dlopen");
>
> begin
> handle:= dlopen ("../Plugin/lib/libplugin.so" & ASCII.NUL, RTLD_LAZY);
> if handle = System.Null_Address then
> Ada.Text_IO.Put_Line("unable to load plugin");
> end if;
> end Main;
>
>
> Main executes without any output. My understanding is the following:
>
> - When plugin loading with dlopen fails, I get an error message.
> - Otherwise, the controlled variable lc in plugin.adb comes to life and
> I get an output from the Initialize procedure.
>
> Where is my misconception?
Probably, you do not have automatic initialization of the Ada run-time.
for Library_Auto_Init use "False";
Which is good, because under Windows would deadlock.
What you should do is:
1. Add an entry point to the library. Call it in order to return the
expected minimum version of Main. It would add resilience. The
implementation must be simple and not to require initialization. E.g.
function get_required_version return Interfaces.C.unsigned;
pragma Convention (C, get_required_version);
Use dlsym to get the address:
type get_required_version_ptr is
function return Interfaces.C.unsigned;
pragma Convention (C, get_required_version_ptr);
function dlsym
( handle : System.Address;
symbol : char_array := "get_required_version" & NUL
) return get_required_version_ptr;
pragma Import (C, dlsym);
2. Add another entry point like My_DLL_Init to call after version check.
From there first call to Ada run-time initialization. I believe it is named
<library-name>init
After that you could do plug-in bookkeeping, calling registering
subprograms etc.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 3%]
* Plugin with controlled variable for initialization.
@ 2022-02-02 17:21 2% hreba
2022-02-02 18:05 3% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: hreba @ 2022-02-02 17:21 UTC (permalink / raw)
For the plugin scheme in my actual program I worked along the
corresponding gnat example, but while the original works, mine doesn't.
So I boiled it down to a minimum.
plugin.ads
----------
package Plugin is
procedure Empty;
end Plugin;
plugin.adb
----------
with Ada.Finalization;
with Ada.Text_IO;
package body Plugin is
type Life_Controller is new Ada.Finalization.Limited_Controlled with
null record;
overriding procedure Initialize (lc: in out Life_Controller);
overriding procedure Finalize (lc: in out Life_Controller);
procedure Empty is
begin
null;
end Empty;
overriding procedure Initialize (lc: in out Life_Controller) is
begin
Ada.Text_IO.Put_Line("Hello world!");
end Initialize;
overriding procedure Finalize (lc: in out Life_Controller) is
begin
Ada.Text_IO.Put_Line("Bye world!");
end Finalize;
lc: Life_Controller;
end Plugin;
main.adb
--------
with System;
with Interfaces.C.Strings;
with Ada.Text_IO;
procedure Main is
use type System.Address;
RTLD_LAZY: constant := 1;
handle: System.Address;
function dlopen (Lib_Name: String; Mode: Interfaces.C.int)
return System.Address;
pragma Import (C, dlopen, "dlopen");
begin
handle:= dlopen ("../Plugin/lib/libplugin.so" & ASCII.NUL, RTLD_LAZY);
if handle = System.Null_Address then
Ada.Text_IO.Put_Line("unable to load plugin");
end if;
end Main;
Main executes without any output. My understanding is the following:
- When plugin loading with dlopen fails, I get an error message.
- Otherwise, the controlled variable lc in plugin.adb comes to life and
I get an output from the Initialize procedure.
Where is my misconception?
--
Frank Hrebabetzky, Kronach +49 / 9261 / 950 0565
^ permalink raw reply [relevance 2%]
* Re: C time_t 2038 problem s-os_lib.ads
@ 2021-09-25 10:22 2% ` G.B.
0 siblings, 0 replies; 200+ results
From: G.B. @ 2021-09-25 10:22 UTC (permalink / raw)
On 25.09.21 00:54, Keith Thompson wrote:
>
> It's *seems* almost obvious that Ada's types
> Character
> Short_Integer
> Integer
> Long_Integer
> Long_Long_Integer
> should correspond to the similarly named C types, but it's not required.
> (I don't know whether GNAT does so consistently or not.)
It might turn out as an advantage if Ada programs don't to use
types named like that.
First, the standard says an implementation MAY provide them.
Second, if Ada programs call C functions that take C int arguments,
then argument types taken from Interfaces.C seem to be the obvious
choice.
Just state what's needed in the type's definition in your program,
referring to "externally defined" types as required.
^ permalink raw reply [relevance 2%]
* Help: Ada in NetBSD
@ 2021-08-29 11:06 1% Fernando Oleo Blanco
0 siblings, 0 replies; 200+ results
From: Fernando Oleo Blanco @ 2021-08-29 11:06 UTC (permalink / raw)
Dear All,
I have been trying for the past few months to make GCC/Ada work in
NetBSD. I am writing this message to you since I have been stuck in a
roadblock for far too long and without concrete answers.
Long story short: JMarino, within the Aurora project, already ported
GCC/Ada to a lot of systems, namely FreeBSD, DragonflyBSD, NetBSD and
Solaris. The last version that works without friction in NetBSD/pkgsrc
is GCC v6. I wanted to update GCC to v10 (10.3.0).
So, one can compile GCC v10 with C, C++ and Ada support with v6 without
any issues. The biggest problem is that the RT (RunTime Files) had no
configuration for NetBSD (see the original Makefile.rtl in the gcc/ada
directory). I fixed it by copying the FreeBSD support files and
modifying a imported C function to be POSIX compilant, since NetBSD did
not had the function that FreeBSD used (related to pthreads).
The results of compiling GCC v10 with this "small" change are documented
in a blog entry I did:
https://www.irvise.xyz/Projects%20&%20Engineering/updating-gcc-ada-pkgsrc.html
TL;DR: GCC v10 compiles and can generate binaries!!! :D But...
The tasking system is not working correctly (I have been testing the
compiler with the ACATS test suite provided by Simon). The linker
complains about some C functions not being correctly imported within Ada
files. And the programs where the linker complains, once compiled, tend
to get blocked or die. Here is one such example:
/usr/bin/ld:
/home/fernando/mysandboxfolder/usr/pkg/gcc10/lib/gcc/x86_64--netbsd/10.3.0/adalib/libgnat.a(s-osprim.o):
in function `system__os_primitives__clock':
/usr/pkgsrc/wip/gcc10-aux/work/build/gcc/ada/rts/s-osprim.adb:91:
warning: warning: reference to compatibility gettimeofday(); include
<sys/time.h> to generate correct reference
As you can see, the linker says that, in this case, gettimeofday() is
not correctly referenced and that I should include <sys/time.h>. Notice,
it is complaining that the file s-osprim.adb, and Ada file, is at fault
here. This happens to all files that use the tasking system in one way
or another, so, in summary, all large projects, such as GPRBuild.
I thought that an #include <sys/time.h> may have been missing from a C
source file that is required to build the Ada compiler. After all, there
were some defined (__NetBSD__) missing from the Ada sources.
I added those. Nothing. I took a really good look at JMarino's patches:
http://cvsweb.netbsd.org/bsdweb.cgi/pkgsrc/lang/gcc6-aux/files/diff-ada?rev=1.1&content-type=text/x-cvsweb-markup
I applied some extra changes (the configure/configure.ac patches are
failing to apply). Still nothing, it keeps failing.
I have been looking for the "missing" #include files, they are <time.h>,
<sys/time.h> and <signal.h>. I searched through the code, there are few
occurrences of them and, for example, <sys/time.h> only appears in a
legacy system.
I checked the C signature files to make sure that they were also correct
in the Ada sources, and they seem to match.
I am out of ideas.
How come the linker complains about those functions and not the other
imported C ones? These files are automatically included with -lc.
How could I go about fixing this issue? Any ideas, pointers?
Below are the patches that I have created.
If you are wondering why am I doing this: I like alternative systems,
Ada is portable on paper, but what about in reality? And my end goal
would be to see Ada everywhere and upstream these fixes to GCC.
Thank you for your time,
-------
--- gcc/ada/adaint.c.orig 2021-08-28 18:39:27.509714592 +0000
+++ gcc/ada/adaint.c 2021-08-28 18:40:44.190149364 +0000
@@ -817,7 +817,8 @@
}
#if defined (_WIN32) || defined (__linux__) || defined (__sun__) \
- || defined (__FreeBSD__) || defined(__DragonFly__) || defined (__QNX__)
+ || defined (__FreeBSD__) || defined(__DragonFly__) || defined (__QNX__) \
+ || defined (__NetBSD__)
#define HAS_TARGET_WCHAR_T
#endif
--- gcc/ada/cstreams.c.orig 2021-08-28 18:42:21.323680378 +0000
+++ gcc/ada/cstreams.c 2021-08-28 18:43:48.045445919 +0000
@@ -188,7 +188,8 @@
*p = '\\';
}
-#elif defined (__FreeBSD__) || defined (__DragonFly__) || defined
(__OpenBSD__)
+#elif defined (__FreeBSD__) || defined (__DragonFly__) \
+ || defined (__OpenBSD__) || defined (__NetBSD__)
/* Use realpath function which resolves links and references to . and ..
on those Unix systems that support it. Note that GNU/Linux
provides it but
@@ -270,7 +271,7 @@
}
#elif defined (__linux__) || defined (__sun__) || defined (__FreeBSD__) \
- || defined (__APPLE__)
+ || defined (__APPLE__) || defined (__NetBSD__)
/* section for platforms having ftello/fseeko */
__int64
--- gcc/ada/init.c.orig 2021-08-28 20:28:13.261558335 +0000
+++ gcc/ada/init.c 2021-08-28 20:29:48.573288829 +0000
@@ -2183,6 +2183,8 @@
#include <signal.h>
#include <unistd.h>
+#include <time.h>
+#include <sys/time.h>
static void
__gnat_error_handler (int sig)
--- gcc/ada/s-oscons-tmplt.c.orig 2021-08-28 18:50:50.086632028 +0000
+++ gcc/ada/s-oscons-tmplt.c 2021-08-28 18:53:35.037358487 +0000
@@ -406,9 +406,11 @@
*/
-/* ioctl(2) requests are "int" in UNIX, but "unsigned long" on FreeBSD */
+/* ioctl(2) requests are "int" in UNIX, but "unsigned long" on FreeBSD
+ and NetBSD
+*/
-#if defined (__FreeBSD__) || defined (__DragonFly__)
+#if defined (__FreeBSD__) || defined (__DragonFly__) || defined
(__NetBSD__)
# define CNI CNU
# define IOCTL_Req_T "Interfaces.C.unsigned"
#else
@@ -1020,7 +1022,8 @@
*/
-#if defined (__FreeBSD__) || defined (__linux__) || defined (__DragonFly__)
+#if defined (__FreeBSD__) || defined (__linux__) || defined
(__DragonFly__) \
+ || defined (__NetBSD__)
# define PTY_Library "-lutil"
#else
# define PTY_Library ""
@@ -1833,7 +1836,8 @@
#if defined(__linux__) || defined(__FreeBSD__) \
|| (defined(_AIX) && defined(_AIXVERSION_530)) \
- || defined(__DragonFly__) || defined(__QNX__)
+ || defined(__DragonFly__) || defined(__QNX__) \
+ || defined (__NetBSD__)
/** On these platforms use system provided monotonic clock instead of
** the default CLOCK_REALTIME. We then need to set up cond var attributes
** appropriately (see thread.c).
--- gcc/ada/sysdep.c.orig 2021-08-28 13:11:25.681014624 +0000
+++ gcc/ada/sysdep.c 2021-08-28 13:21:14.748176113 +0000
@@ -320,7 +320,7 @@
|| (defined (__svr4__) && defined (__i386__)) || defined (__Lynx__) \
|| defined (__CYGWIN__) || defined (__FreeBSD__) || defined
(__OpenBSD__) \
|| defined (__GLIBC__) || defined (__APPLE__) || defined
(__DragonFly__) \
- || defined (__QNX__)
+ || defined (__QNX__) || defined (__NetBSD__)
# ifdef __MINGW32__
# if OLD_MINGW
@@ -373,7 +373,7 @@
|| defined (_AIX) || (defined (__svr4__) && defined (__i386__)) \
|| defined (__Lynx__) || defined (__FreeBSD__) || defined
(__OpenBSD__) \
|| defined (__GLIBC__) || defined (__APPLE__) || defined
(__DragonFly__) \
- || defined (__QNX__)
+ || defined (__QNX__) || defined (__NetBSD__)
char c;
int nread;
int good_one = 0;
@@ -394,7 +394,7 @@
|| defined (_AIX) || (defined (__svr4__) && defined (__i386__)) \
|| defined (__Lynx__) || defined (__FreeBSD__) || defined
(__OpenBSD__) \
|| defined (__GLIBC__) || defined (__APPLE__) || defined
(__DragonFly__) \
- || defined (__QNX__)
+ || defined (__QNX__) || defined (__NetBSD__)
eof_ch = termios_rec.c_cc[VEOF];
/* If waiting (i.e. Get_Immediate (Char)), set MIN = 1 and wait for
@@ -831,7 +831,7 @@
#elif defined (__APPLE__) || defined (__FreeBSD__) || defined
(__linux__) \
|| defined (__GLIBC__) || defined (__DragonFly__) || defined
(__OpenBSD__) \
- || defined (__DJGPP__) || defined (__QNX__)
+ || defined (__DJGPP__) || defined (__QNX__) || defined (__NetBSD__)
{
localtime_r (timer, &tp);
*off = tp.tm_gmtoff;
-------
--
Fernando Oleo Blanco
https://irvise.xyz
^ permalink raw reply [relevance 1%]
* Re: Building the 2021 source release of GnatStudio
@ 2021-07-31 12:29 2% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2021-07-31 12:29 UTC (permalink / raw)
On 2021-07-31 13:58, Stéphane Rivière wrote:
>> The HAC script must take Argument, call Square (accessible via the
>> module), return the result of Square (Argument).
>
> API HAC has Argument, Argument_Count and Set_Exit_Status, and the result
> can be piped.
Whatever, you could post a complete example, when ready (:-)).
E.g. here is a lesser sample in Julia, an Ada subprogram is called from
Julia back when Julia is called from Ada:
----------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces.C; use Interfaces.C;
with Julia; use Julia;
procedure Ada_Call is
Bin : constant String := "D:\Julia-1.2.0\bin";
begin
Load (Bin & "\libjulia.dll"); -- Load library
Init_With_Image (Bin); -- Initialize environment
declare
function Increment (X : Double) return Double;
pragma Convention (C, Increment);
function Increment (X : Double) return Double is
begin
return X + 1.0;
end Increment;
begin
Eval_String
( "println(ccall("
& CCall_Address (Increment'Address)
& ",Cdouble,(Cdouble,),10.0))"
);
end;
AtExit_Hook; -- Finalize environment
end Ada_Call;
Note, there is only one process!
-----------------------------------------------------------
> However, I do not state HAC is production ready for GNATStudio... But
> HAC is well written and easily hackable (I speak for Gautier ;)
That is not the point. The point is that AFAIK it cannot be used for
scripting unless examples as above provided.
>> What AdaCore *must* do is to remove static linking to Python. The GPS
>> user should choose the script language per preferences that would look
>> for the corresponding script run-time e.g. Python or HAC or whatever.
>
> Freedom choice. I agree. But I guess Adacore ressources are limited and
> this is like reinventing the wheel.
It is a minimal requirement to replace static linking with dynamic.
Moreover, whatever resources AdaCore has it does not make any sense to
call internal GPS functions implemented in Ada from Ada code via Python
scripts! So, no work involved.
> The biggest complaint I had about GNATStudio was its instability. I
> think that Adacore has made great progress now. It's now a pleasure to
> work with.
Yes, but each new version of GTK can change that. GTK is unstable on
both Windows and Linux, it is just as it is. AdaCore can at best work
around GTK bugs.
Though Python is 100% self-inflicted damage. AdaCore could easily
implement some Ada script, again, not to confuse with shell. They did it
partially with GPR. The GPR compiler could be extended to support a
larger variety of expressions.
Customers wanting Python will use Eclipse instead of GPS anyway, so that
is not an argument either.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 2%]
* Re: converting pointer to value
@ 2021-03-05 14:00 2% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2021-03-05 14:00 UTC (permalink / raw)
On 2021-03-05 12:57, Björn Lundin wrote:
> Den 2021-03-05 kl. 12:02, skrev Björn Lundin:
>
>>
>> SQLParamData1.2: 4790608
>>
>>
>> I'm thinking that I may be dealing with a pointer to a pointer here?
>> hmm, needs more testing. I changed the expected value from 5 to 7.
>> Still a bit off...
>>
>
> The way I put the value 5 or 7 into the API is
>
> procedure Bind_Parameter(Statement : in out Statement_Type;
> Column_Index : in Positive;
> Value : in CLOB;
> Null_Value : in Boolean := False) is
> A : Bind_Parameter_Type;
> L : Sqlulen := Sqlulen(Length(Value));
> Rc : Sqlreturn := 0;
> Local_Length : Sqllen ;
> begin
>
> Local_Length := Sqllen(Sqllen(-100) -Sqllen(L));
> --Sqllen'(SQL_LEN_DATA_AT_EXEC_OFFSET - L);
>
> A.String_Pointer := new String'(To_String(Value) & Ascii.Nul);
>
> if Null_Value then
> A.Length_Pointer := new Sqllen'(Sql_Null_Data);
> else
> A.Length_Pointer := new Sqllen'(Local_Length);
> end if;
>
> Rc := gnu.Db.Sqlcli.Sqlbindparameter
> (Statementhandle => Statement.Get_Handle,
> Parameternumber => Sql_Parameter_Number (Column_Index),
> Inputoutputtype => Sql_Param_Input,
> Valuetype => Sql_C_Char,
> Parametertype => Sql_Char,
> Columnsize => L,
> Decimaldigits => 0,
> Value => 7, --<-- here
> Bufferlength => 0,
> Strlen_Or_Indptr => A.Length_Pointer);
>
> exception
> when Gnu.Db.Sqlcli.Table_Not_Found => raise Sql.No_Such_Object;
> end Bind_Parameter;
>
>
> where Bind_parameter_Type contains
> Length_Pointer : aliased PTR_SQLLEN := null;
> String_Pointer : aliased PTR_STRING := null;
>
>
> and PTR_types defined as
> type PTR_STRING is access all String;
> Type PTR_SQLLEN is access all SQLLEN;
>
> and SQLLEN is a signed 64-bit integer
>
> and SQLBindParameter looks like
>
>
> function SQLBindParameter (StatementHandle : in SQLHSTMT;
> ParameterNumber : in SQL_Parameter_Number;
> InputOutputType : in SQL_Parameter_Type;
> ValueType : in SQL_C_DATA_TYPE;
> ParameterType : in SQL_DATA_TYPE;
> ColumnSize : in SQLULEN;
> DecimalDigits : in SQLSMALLINT;
> Value : in SQLINTEGER;
This looks wrong because SQLINTEGER is 32-bit. Why do not you use
Package System.Storage_Elements.Integer_Address instead, in order to
place an integer there? It must be SQL_DATA_AT_EXEC which is -1, not 7.
Alternatively you could use ptrdiff_t from Interfaces.C, because ARM is
kind of ambiguous whether Integer_Address is signed.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 2%]
* SweetAda 0.1h released
@ 2021-01-05 17:37 1% Gabriele Galeotti
0 siblings, 0 replies; 200+ results
From: Gabriele Galeotti @ 2021-01-05 17:37 UTC (permalink / raw)
Hi all.
I've just released SweetAda 0.1h.
SweetAda is lightweight development framework to create Ada systems on a wide range
of machines. Please refer to https://www.sweetada.org.
Release notes
-------------
- There is now a primitive SFP (Small-FootPrint) runtime, does nothing very interesting
so far, only allows non-trivial exception declarations and floating-point validation;
when I will implement the Secondary Stack, things should start to be far better
- RTS and PROFILE items are now lowercased, as well as RTS directory names
- RTS for MIPS* targets is tuned with -G0, you should use this in your target compiler
setup
- RTS for SH* targets is tuned with -fno-leading-underscore, you should use this in
your target compiler setup
- the Bits library unit now exposes BigEndian and LittleEndian static booleans
- new procedure Print (Interfaces.C.char) in Console library unit
- Tcl will be the default scripting language for complex tasks, it is strongly advised
to install it in your machine (Windows users could download the tcltk.zip package)
since script files will be gradually replaced, at least those too heavy for a shell
- as just said, the "createtxtrecord" tool in S/390 and the scripts for the creation of
bootable PC floppy/hard disk images are now written quick-and-dirty in Tcl, but they
should be widely usable and requires no external OS utilities support
- IDE driver sets LBA mode, and FAT (read-only) works with LBA logical sectors
- MBR library unit to recognize partitions (very minimal, only 1st partition detected)
- menu.bat now shows automatically an usage if an incorrect action was supplied
- libutils provides a createsymlink shell script to create symbolic (soft) links in
an OS-transparent way, use it by referencing $(CREATESYMLINK) in the Makefiles; this
substitutes a physical copy of files in non-Linux machines during subplatform-specific
installation; however, in Windows machines it requires PowerShell elevation rights
in order to avoid bloated warning messages, so adjust your OS settings; the good news
are that is now possible to edit subplatform-specific files without lose your changes
whenever you restart from scratch with a "createkernelcfg" build cycle
- Makefile cleanups, there are no scattered shell-dependent bloated constructs,
except for the trivial ones, and they are now concentrated logically in few places;
the build system should tolerate even spaces in pathnames (very bad practice, though)
- delete unnecessary functions and variables in Makefiles
- reordering of gnat1 debug switches in Makefile.tc.in, corrected -gnatdt switch
description
- reordering of configuration dump in Makefile
- reordering/deletion/tuning of compiler switches in various platforms
- new target MSP432P401R, very minimal, only blinks the on-board LED
- DE10-Lite NiosII target now performs stack setup and calls the low-level adainit
function in startup.S, so that proper runtime elaboration happens
- AVR targets can now use aggregates (see explanation below)
- ArduinoUno does not specify the path to AVRDUDE executable, this is now
delegated to the run script
- the S/390 target specifies a correct emulation mode in linking objects so that
there are no more problems during processing
- typos, cosmetics and minor adjustments
Quick notes
-----------
As the release notes outlined, SweetAda should run on a bare 64-bit host system which
supports, dependently on your target CPU setup, symbolic (soft) links and (optionally)
Tcl/Tk. This is normal for Linux, Windows and OS X, so no concerns should arise. If you
do not want to install the tcltk package I am providing from the SweetAda site, then
download a package from your vendor, and specify the path to the tclsh executable in
the top-level configuration.in.
The reason behind this is promptly understood: Tcl is a long-time HL language used in
industrial automation and is currently used as a scripting tool in large applications
like Xilinx Vivado, Altera Quartus and others. Also OpenOCD uses an embedded version
that drives its user interface, so it is at least adviseable to have a look, especially if
you are working with SoC, embedded softcores or you are playing with JTAG programming
on the bare metal.
To use SFP, please change settings in the top-level configuration.in:
RTS := sfp
PROFILE := sfp
USE_LIBADA := Y
Remember, you can change RTS at your will after a "make clean" or "menu.[sh|bat] clean".
Please do not rely on low-level layout of the filesystem hierarchies. When SFP runtime
will be (hopefully) working, many files could be symlinks or separate units in order to
switch between ZFP and SFPs. More precisely, low-level subprograms could start to declare
private exceptions and interrupt-related RTS units, and this will prevent the use of a ZFP
(which does NOT use anything from the compiler library, and this requires absolute care).
About aggregates in AVR targets. The problem is, aggregates could be Ada static RO objects,
and so the back-end can legitimately allocates them in the .rodata section. Historically,
.rodata section is quite often linked together with the .text, but unfortunately, AVR is an
Harvard machine with separate address spaces, and the .rodata section should stay together
with data sections in an executable image. Relocating Flash ROM .rodata in RAM during
startup obviously is a no-op. Placing .rodata in RAM prevents the read-only behaviour, though.
The ideal solutions could be to place .rodata in EEPROM, but this introduces a level of
complexity that I see of little concernment so far. So the current decision is to place
.rodata in RAM, and warn you about try to overwrite static data (it will require intimate
knowledge of dereferencing machine-code objects, furthermore, objects are nevertheless hardly
traceable, and this a very esotic, non-Ada, non-sense bad practice, so trying to do that
implies hugely problems in other areas).
Last thing, as I've updated toolchains (without change timestamps), you are encouraged to
re-download them, since exists the possibility that previous targets have problems in the
GNAT/GCC wrappers, and do not emit compilation messages of dependent units during "brief",
non-VERBOSE mode, as well as not generating Ada intermediate files nor assembler listing
thereof. If you don't care about visual outputs or assembler analysis, simply ignore this.
As usual, download the three packages core, RTS and LibGGC (since many changes are
system-wide), and please save your work before overwrite the filesystem.
Happy new year.
G
^ permalink raw reply [relevance 1%]
* Re: Messing with access types...
2020-12-28 11:43 2% ` Marek
@ 2020-12-28 13:56 3% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2020-12-28 13:56 UTC (permalink / raw)
On 2020-12-28 12:43, Marek wrote:
> On 28.12.2020 11:14, Dmitry A. Kazakov wrote:
>>
>> What are you trying to achieve? Because the code does not make much
>> sense to me.
>>
>> P.S. If you are trying to do some C bindings flat arrays are easier
>> choice than Interfaces.C.Pointers. C has no arrays, but pointers. Ada's
>> arrays are never compatible with any pointers, except when flat.
>> Therefore using access to String would be wrong in most, if not all, cases.
>
> Code is a fragment some plugin framework for host written in C. When
> plugin is initialized it receives pointer to host features. Then I can
> scan them to find concrete feature (Id) and retrieve data.
> Problem is with instantiation generic function Get_Data, more precisely
> in line:
>
> return T_Access (ATA.To_Pointer (F.Data));
You should never convert access types, because to do so, you must first
learn the accessibility rules. No man can do that while keeping sanity.
So, just do this:
return ATA.To_Pointer (F.Data).all'Unchecked_Access;
-- Mind your business, COMPILER!
> OK, some changes to code to clear view:
>
> with System;
>
> package Util is
>
> type Feature is record
> Id : Integer;
> Data : System.Address;
> end record;
type Feature is record
Id : Interfaces.C.int; -- If that is int
Data : System.Address; -- Could be a named access type [*]
end record;
pragma Convention (C, Feature);
> type Feature_Access is access all Feature;
>
> Null_Feature : constant Feature := (0, System.Null_Address);
> type Feature_Array is array (Natural range <>) of aliased Feature;
type Feature_Array is array (size_t) of aliased Feature; -- Flat
pragma Convention (C, Feature_Array);
type Feature_Array_Ptr is access all Feature_Array;
pragma Convention (C, Feature_Array_Ptr);
function Get_Me_Features return Feature_Array_Ptr;
pragma Import (C, Get_Me_features, "???");
That should be all necessary to do this:
List : Feature_Array renames Get_Me_Features.all;
begin
for I in size_t'Range loop
exit when List (I) = Null_Feature;
declare
Data : Whatever_C_Type;
for Data'Address use List (I).Data;
pragma Import (Ada, Data);
begin
...
end;
end loop;
-------------------------------------
* Here is a variant without using addresses
type Whatever_C_Type is record
...
end record;
pragma Convention (C, Whatever_C_Type);
type Whatever_C_Type_Ptr is access all Whatever_C_Type;
pragma Convention (C, Whatever_C_Type_Ptr);
type Feature is record
Id : Interfaces.C.int;
Data : Whatever_Ptr;
end record;
pragma Convention (C, Feature);
...
for I in size_t'Range loop
exit when List (I) = Null_Feature;
declare
Data : Whatever_C_Type renames List (I).Data.all;
begin
...
end;
end loop;
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 3%]
* Re: Messing with access types...
2020-12-28 10:14 2% ` Dmitry A. Kazakov
@ 2020-12-28 11:43 2% ` Marek
2020-12-28 13:56 3% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Marek @ 2020-12-28 11:43 UTC (permalink / raw)
On 28.12.2020 11:14, Dmitry A. Kazakov wrote:
>
> What are you trying to achieve? Because the code does not make much
> sense to me.
>
> P.S. If you are trying to do some C bindings flat arrays are easier
> choice than Interfaces.C.Pointers. C has no arrays, but pointers. Ada's
> arrays are never compatible with any pointers, except when flat.
> Therefore using access to String would be wrong in most, if not all, cases.
>
Code is a fragment some plugin framework for host written in C. When
plugin is initialized it receives pointer to host features. Then I can
scan them to find concrete feature (Id) and retrieve data.
Problem is with instantiation generic function Get_Data, more precisely
in line:
return T_Access (ATA.To_Pointer (F.Data));
OK, some changes to code to clear view:
with System;
package Util is
type Feature is record
Id : Integer;
Data : System.Address;
end record;
type Feature_Access is access all Feature;
Null_Feature : constant Feature := (0, System.Null_Address);
type Feature_Array is array (Natural range <>) of aliased Feature;
generic
type T is private;
type T_Access is access all T;
function Get_Data (H : access Feature; Id : Integer) return T_Access;
generic
type T is private;
type T_Access is access all T;
function Get_Query
(H : access Feature; Id : Integer; Data : in out T_Access;
Required : Boolean) return Integer;
end Util;
------------------------
pragma Ada_2012;
with Interfaces.C.Pointers;
with System.Address_To_Access_Conversions;
package body Util is
package Ptr is new Interfaces.C.Pointers
(Index => Natural,
Element => Feature,
Element_Array => Feature_Array,
Default_Terminator => Null_Feature);
use Ptr;
--------------
-- Get_Data --
--------------
function Get_Data (H : access Feature; Id : Integer) return T_Access
is
Pointer : Ptr.Pointer := Ptr.Pointer (H);
package ATA is new System.Address_To_Access_Conversions (T);
begin
if H /= null then
loop
declare
F : access Feature := Pointer;
begin
if Id = F.Id then
return T_Access (ATA.To_Pointer (F.Data));
end if;
end;
Ptr.Increment (Pointer);
exit when Pointer = null;
end loop;
end if;
return null;
end Get_Data;
---------------
-- Get_Query --
---------------
function Get_Query
(H : access Feature; Id : Integer; Data : in out T_Access;
Required : Boolean) return Integer
is
function Get is new Get_Data (T, T_Access);
begin
Data := Get (H, Id);
if Required and (Data /= null) then
return Id;
end if;
return 0;
end Get_Query;
end Util;
^ permalink raw reply [relevance 2%]
* Re: Messing with access types...
2020-12-28 9:44 2% Messing with access types Marek
@ 2020-12-28 10:14 2% ` Dmitry A. Kazakov
2020-12-28 11:43 2% ` Marek
0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2020-12-28 10:14 UTC (permalink / raw)
On 2020-12-28 10:44, Marek wrote:
> I have some code:
[...]
> When I try to compile test.adb I get some warnings:
>
> Compile
> [Ada] test.adb
> test.adb:20:04: warning: in instantiation at util.adb:34
> test.adb:20:04: warning: in instantiation at util.adb:56
> test.adb:20:04: warning: accessibility check failure
> test.adb:20:04: warning: "Program_Error" will be raised at run time
> test.adb:20:04: warning: in instantiation at util.adb:34
> test.adb:20:04: warning: in instantiation at util.adb:56
> test.adb:20:04: warning: cannot convert local pointer to non-local
> access type
> test.adb:20:04: warning: Program_Error will be raised at run time
> [Ada] util.adb
> Bind
> [gprbind] test.bexch
> [Ada] test.ali
> Link
> [link] test.adb
> [2020-12-28 10:30:50] process terminated successfully, elapsed time: 00.92s
>
> I tried also to move every local (to Test procedure) variables to global
> scope but result is the same.
>
> What is going on? Can you explain where is the problem?
What are you trying to achieve? Because the code does not make much
sense to me.
P.S. If you are trying to do some C bindings flat arrays are easier
choice than Interfaces.C.Pointers. C has no arrays, but pointers. Ada's
arrays are never compatible with any pointers, except when flat.
Therefore using access to String would be wrong in most, if not all, cases.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 2%]
* Messing with access types...
@ 2020-12-28 9:44 2% Marek
2020-12-28 10:14 2% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Marek @ 2020-12-28 9:44 UTC (permalink / raw)
Hello,
I have some code:
- util.ads:
with System;
package Util is
type Handle is record
Str : access String;
Data : System.Address;
end record;
type Handle_Access is access all Handle;
Null_Handle : constant Handle := (null, System.Null_Address);
type Handle_Array is array (Natural range <>) of aliased Handle;
generic
type T is private;
type T_Access is access all T;
function Get_Data (H : access Handle; Str : access String) return
T_Access;
generic
type T is private;
type T_Access is access all T;
function Get_Query
(H : access Handle; Str : access String; Data : in out T_Access;
Required : Boolean) return access String;
end Util;
- util.adb
pragma Ada_2012;
with Interfaces.C.Pointers;
with System.Address_To_Access_Conversions;
package body Util is
package Ptr is new Interfaces.C.Pointers
(Index => Natural,
Element => Handle,
Element_Array => Handle_Array,
Default_Terminator => Null_Handle);
use Ptr;
--------------
-- Get_Data --
--------------
function Get_Data (H : access Handle; Str : access String) return
T_Access
is
Pointer : Ptr.Pointer := Ptr.Pointer (H);
package ATA is new System.Address_To_Access_Conversions (T);
begin
if H /= null then
loop
declare
F : access Handle := Pointer;
begin
if Str.all = F.Str.all then
return T_Access (ATA.To_Pointer (F.Data));
end if;
end;
Ptr.Increment (Pointer);
exit when Pointer = null;
end loop;
end if;
return null;
end Get_Data;
---------------
-- Get_Query --
---------------
function Get_Query
(H : access Handle; Str : access String; Data : in out T_Access;
Required : Boolean) return access String
is
function Get is new Get_Data (T, T_Access);
begin
Data := Get (H, Str);
if Required and (Data /= null) then
return Str;
end if;
return null;
end Get_Query;
end Util;
- test.adb
pragma Ada_2012;
with Util;
procedure Test is
use Util;
type Some_Record is record
Foo : Integer;
end record;
type Some_Record_Access is access all Some_Record;
Test_Record : Some_Record_Access;
H : access Handle := null;
Str : access String := new String'("Test");
function Query is new Get_Query (Some_Record, Some_Record_Access);
Result : access String := Query (H, Str, Test_Record, False);
begin
null;
end Test;
When I try to compile test.adb I get some warnings:
Compile
[Ada] test.adb
test.adb:20:04: warning: in instantiation at util.adb:34
test.adb:20:04: warning: in instantiation at util.adb:56
test.adb:20:04: warning: accessibility check failure
test.adb:20:04: warning: "Program_Error" will be raised at run time
test.adb:20:04: warning: in instantiation at util.adb:34
test.adb:20:04: warning: in instantiation at util.adb:56
test.adb:20:04: warning: cannot convert local pointer to non-local
access type
test.adb:20:04: warning: Program_Error will be raised at run time
[Ada] util.adb
Bind
[gprbind] test.bexch
[Ada] test.ali
Link
[link] test.adb
[2020-12-28 10:30:50] process terminated successfully, elapsed time: 00.92s
I tried also to move every local (to Test procedure) variables to global
scope but result is the same.
What is going on? Can you explain where is the problem?
thanks in advance
Marek
^ permalink raw reply [relevance 2%]
* Easiest way to use redular expressions?
@ 2020-12-27 8:20 3% reinert
0 siblings, 0 replies; 200+ results
From: reinert @ 2020-12-27 8:20 UTC (permalink / raw)
Hello,
I made the following hack to match a string with a regular expression
(using a named pipe and grep under linux):
procedure to_os (str : String) is
package c renames Interfaces.C;
procedure system_rk (source : in c.char_array);
pragma Import (c, system_rk, "system");
begin
system_rk (Interfaces.C.To_C (str));
end to_os;
function match1(S,P : String) return boolean is
cfile1 : constant String := "regexp_pipe0";
file1 : File_Type;
str1 : constant String := "echo " & S & "| grep -ic " & P;
begin
to_os(str1 & " > regexp_pipe0 &" );
Open(file1,In_File,cfile1);
return b : constant boolean := Natural'Value(get_line(file1)) > 0 do
Close(file1);
end return;
end match1;
-----------------------------------------
OK, I assume it somehow breaks the philosophy on Ada and security/reliability. Could someone therefore show a better and more simple way to do this? gnat.expect?
reinert
^ permalink raw reply [relevance 3%]
* Easiest way to use regular expressions?
@ 2020-12-27 8:14 3% reinert
0 siblings, 0 replies; 200+ results
From: reinert @ 2020-12-27 8:14 UTC (permalink / raw)
Hello,
I made the following hack to match a string with a regular expression
(using a named pipe and grep under linux):
procedure to_os (str : String) is
package c renames Interfaces.C;
procedure system_rk (source : in c.char_array);
pragma Import (c, system_rk, "system");
begin
system_rk (Interfaces.C.To_C (str));
end to_os;
function match1(S : String; P : String) return boolean is
cfile1 : constant String := "regexp_pipe0";
file1 : File_Type;
str1 : constant String := "echo " & S & "| grep -ic " & P;
begin
to_os(str1 & " > regexp_pipe0 &" );
Open(file1,In_File,cfile1);
return b : constant boolean := Natural'Value(get_line(file1)) > 0 do
Close(file1);
end return;
end match1;
-----------------------------------------
OK, I assume it somehow breaks the philosophy on Ada and security/reliability. Could someone therefore show a better and more simple way to do this? gnat.expect?
reinert
^ permalink raw reply [relevance 3%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 11:31 3% How can I get this data into the .data section of the binary? Luke A. Guest
` (2 preceding siblings ...)
2020-09-19 14:08 0% ` erchetan33
@ 2020-09-28 11:36 0% ` yhumina stir
3 siblings, 0 replies; 200+ results
From: yhumina stir @ 2020-09-28 11:36 UTC (permalink / raw)
On Tuesday, 16 June 2020 at 17:02:13 UTC+5:30, Luke A. Guest wrote:
> Hi,
>
> I'm trying to get some static data tables into the data section rather
> than be elaborated at runtime. I can see no reason why this particular
> set of types, records and aggregates cannot go into the data section.
>
> I've searched for use of pragma Static_Elaboration_Desired, but there is
> very little information.
>
> Here's the full modified source from SDL minus the header:
>
> pragma Restrictions (No_Implicit_Loops);
> with Ada.Characters.Latin_1;
> with Ada.Unchecked_Conversion;
> with Interfaces;
> with Interfaces.C;
> with SDL.Video.Palettes;
>
> package SDL.Video.Pixel_Formats is
> package C renames Interfaces.C;
>
> type Pixel_Types is
> (Unknown,
> Index_1,
> Index_4,
> Index_8,
> Packed_8,
> Packed_16,
> Packed_32,
> Array_U8,
> Array_U16,
> Array_U32,
> Array_F16,
> Array_F32) with
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Types);
>
> -- Bitmap pixel order, high bit -> low bit.
> type Bitmap_Pixel_Order is (None, Little_Endian, Big_Endian) with
> Convention => C;
> pragma Static_Elaboration_Desired (Bitmap_Pixel_Order);
>
> -- Packed component order, high bit -> low bit.
> type Packed_Component_Order is
> (None,
> XRGB,
> RGBX,
> ARGB,
> RGBA,
> XBGR,
> BGRX,
> ABGR,
> BGRA) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Order);
>
> -- Array component order, low byte -> high byte.
> type Array_Component_Order is (None, RGB, RGBA, ARGB, BGR, BGRA, ABGR);
> pragma Static_Elaboration_Desired (Array_Component_Order);
>
> -- Describe how the components are laid out in bit form.
> type Packed_Component_Layout is
> (None,
> Bits_332,
> Bits_4444,
> Bits_1555,
> Bits_5551,
> Bits_565,
> Bits_8888,
> Bits_2101010,
> Bits_1010102) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Layout);
>
> type Bits_Per_Pixels is range 0 .. 32 with
> Static_Predicate => Bits_Per_Pixels in 0 | 1 | 4 | 8 | 12 | 15 | 16
> | 24 | 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Bits_Per_Pixels);
>
> Bits_Per_Pixel_Error : constant Bits_Per_Pixels := 0;
>
> type Bytes_Per_Pixels is range 0 .. 4 with
> Convention => C;
> pragma Static_Elaboration_Desired (Bytes_Per_Pixels);
>
> Bytes_Per_Pixel_Error : constant Bytes_Per_Pixels :=
> Bytes_Per_Pixels'First;
>
> -- 29 28 24 20 16 8 0
> -- 000 1 ptpt popo llll bibibibi bybybyby
> --
> -- or
> --
> -- 24 16 8 0
> -- DDDDDDDD CCCCCCCC BBBBBBBB AAAAAAAA
>
> type Index_Order_Padding is range 0 .. 1 with
> Convention => C;
> pragma Static_Elaboration_Desired (Index_Order_Padding);
>
> type Pixel_Orders (Pixel_Type : Pixel_Types := Unknown) is
> record
> case Pixel_Type is
> when Index_1 | Index_4 | Index_8 =>
> Indexed_Order : Bitmap_Pixel_Order;
> Indexed_Pad : Index_Order_Padding;
>
> when Packed_8 | Packed_16 | Packed_32 =>
> Packed_Order : Packed_Component_Order;
>
> when Array_U8 | Array_U16 | Array_U32 | Array_F16 | Array_F32 =>
> Array_Order : Array_Component_Order;
>
> when others =>
> null;
> end case;
> end record with
> Unchecked_Union => True,
> Convention => C,
> Size => 4;
>
> pragma Warnings (Off, "no component clause given");
> for Pixel_Orders use
> record
> Indexed_Order at 0 range 0 .. 2; -- This was 2 as that is the
> max size required but it causes a bit set bug!
> Indexed_Pad at 0 range 3 .. 3;
> Packed_Order at 0 range 0 .. 3;
> Array_Order at 0 range 0 .. 3;
> end record;
> pragma Static_Elaboration_Desired (Pixel_Orders);
> pragma Warnings (On, "no component clause given");
>
> type Planar_Pixels is
> record
> A : Character;
> B : Character;
> C : Character;
> D : Character;
> end record with
> Size => 32,
> Convention => C;
>
> for Planar_Pixels use
> record
> A at 0 range 0 .. 7;
> B at 0 range 8 .. 15;
> C at 0 range 16 .. 23;
> D at 0 range 24 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Planar_Pixels);
>
> type Non_Planar_Pixel_Padding is range 0 .. 7 with
> Convention => C;
> pragma Static_Elaboration_Desired (Non_Planar_Pixel_Padding);
>
> type Non_Planar_Pixels is
> record
> Bytes_Per_Pixel : Bytes_Per_Pixels;
> Bits_Per_Pixel : Bits_Per_Pixels;
> Layout : Packed_Component_Layout;
> Pixel_Order : Pixel_Orders;
> Pixel_Type : Pixel_Types;
> Flag : Boolean;
> Padding : Non_Planar_Pixel_Padding;
> end record with
> Size => 32,
> Convention => C;
>
> for Non_Planar_Pixels use
> record
> Bytes_Per_Pixel at 0 range 0 .. 7;
> Bits_Per_Pixel at 0 range 8 .. 15;
> Layout at 0 range 16 .. 19;
> Pixel_Order at 0 range 20 .. 23;
> Pixel_Type at 0 range 24 .. 27;
> Flag at 0 range 28 .. 28;
> Padding at 0 range 29 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Non_Planar_Pixels);
>
> type Pixel_Format_Names (Planar : Boolean := False) is
> record
> case Planar is
> when True =>
> Planar_Format : Planar_Pixels;
> when False =>
> Non_Planar_Format : Non_Planar_Pixels;
> end case;
> end record with
> Unchecked_Union => True,
> Size => 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Format_Names);
>
> Pixel_Format_Unknown : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (others => Ada.Characters.Latin_1.NUL));
> pragma Static_Elaboration_Desired (Pixel_Format_Unknown);
>
> Pixel_Format_Index_1_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_LSB);
>
> Pixel_Format_Index_1_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_MSB);
>
> Pixel_Format_Index_4_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_LSB);
>
> Pixel_Format_Index_4_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_MSB);
>
> Pixel_Format_Index_8 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_8,
> Indexed_Order => None,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_8);
>
> Pixel_Format_RGB_332 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_8,
> Packed_Order => XRGB),
> Layout => Bits_332,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_332);
>
> Pixel_Format_RGB_444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 12,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_444);
>
> Pixel_Format_RGB_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_555);
>
> Pixel_Format_BGR_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_555);
>
> Pixel_Format_ARGB_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_4444);
>
> Pixel_Format_RGBA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_4444);
>
> Pixel_Format_ABGR_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_4444);
>
> Pixel_Format_BGRA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_4444);
>
> Pixel_Format_ARGB_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_1555);
>
> Pixel_Format_RGBA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_5551);
>
> Pixel_Format_ABGR_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_1555);
>
> Pixel_Format_BGRA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_5551);
>
> Pixel_Format_RGB_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_565);
>
> Pixel_Format_BGR_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_565);
>
> Pixel_Format_RGB_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => RGB),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_24);
>
> Pixel_Format_BGR_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => BGR),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_24);
>
> Pixel_Format_RGB_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XRGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_888);
>
> Pixel_Format_RGBX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBX_8888);
>
> Pixel_Format_BGR_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XBGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_888);
>
> Pixel_Format_BGRX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRX_8888);
>
> Pixel_Format_ARGB_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_8888);
>
> Pixel_Format_RGBA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_8888);
>
> Pixel_Format_ABGR_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ABGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_8888);
>
> Pixel_Format_BGRA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_8888);
>
> Pixel_Format_ARGB_2101010 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_2101010,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_2101010);
>
> Pixel_Format_YV_12 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => '1',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YV_12);
>
> Pixel_Format_IYUV : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'I',
> B => 'Y',
> C => 'U',
> D => 'V'));
> pragma Static_Elaboration_Desired (Pixel_Format_IYUV);
>
> Pixel_Format_YUY_2 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'U',
> C => 'Y',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YUY_2);
>
> Pixel_Format_UYVY : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'U',
> B => 'Y',
> C => 'V',
> D => 'Y'));
> pragma Static_Elaboration_Desired (Pixel_Format_UYVY);
>
> Pixel_Format_YVYU : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => 'Y',
> D => 'U'));
> pragma Static_Elaboration_Desired (Pixel_Format_YVYU);
>
> type Colour_Mask is mod 2 ** 32 with
> Convention => C;
>
> type Private_Pixel_Format is private;
>
> type Pixel_Format is
> record
> Format : Pixel_Format_Names;
> Palette : Palettes.Palette_Access;
> Bits : Bits_Per_Pixels;
> Bytes : Bytes_Per_Pixels;
> Padding : Interfaces.Unsigned_16;
> Red_Mask : Colour_Mask;
> Green_Mask : Colour_Mask;
> Blue_Mask : Colour_Mask;
> Alpha_Mask : Colour_Mask;
>
> -- This is mainly padding to make sure the record size matches
> what is expected from C.
> Private_Part : Private_Pixel_Format;
> end record with
> Convention => C;
>
> -- TODO: Possibly change this to a controlled type.
> type Pixel_Format_Access is access all Pixel_Format with
> Convention => C;
>
> function Create (Format : in Pixel_Format_Names) return
> Pixel_Format_Access with
> Import => True,
> Convention => C,
> External_Name => "SDL_AllocFormat";
>
> procedure Free (Format : in Pixel_Format_Access) with
> Import => True,
> Convention => C,
> External_Name => "SDL_FreeFormat";
>
> function Image (Format : in Pixel_Format_Names) return String;
> -- Import => True,
> -- Convention => C,
> -- External_Name => "SDL_GetPixelFormatName";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGB";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component;
> Alpha : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGBA";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGB";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component;
> Alpha : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGBA";
>
> function To_Colour (Pixel : in Interfaces.Unsigned_32; Format : in
> Pixel_Format_Access) return Palettes.Colour with
> Inline => True;
>
> function To_Pixel (Colour : in Palettes.Colour; Format : in
> Pixel_Format_Access) return Interfaces.Unsigned_32 with
> Inline => True;
>
> function To_Name
> (Bits : in Bits_Per_Pixels;
> Red_Mask : in Colour_Mask;
> Green_Mask : in Colour_Mask;
> Blue_Mask : in Colour_Mask;
> Alpha_Mask : in Colour_Mask) return Pixel_Format_Names with
> Import => True,
> Convention => C,
> External_Name => "SDL_MasksToPixelFormatEnum";
>
> function To_Masks
> (Format : in Pixel_Format_Names;
> Bits : out Bits_Per_Pixels;
> Red_Mask : out Colour_Mask;
> Green_Mask : out Colour_Mask;
> Blue_Mask : out Colour_Mask;
> Alpha_Mask : out Colour_Mask) return Boolean with
> Inline => True;
>
> -- Gamma
> type Gamma_Value is mod 2 ** 16 with
> Convention => C;
>
> type Gamma_Ramp is array (Integer range 1 .. 256) of Gamma_Value with
> Convention => C;
>
> procedure Calculate (Gamma : in Float; Ramp : out Gamma_Ramp) with
> Import => True,
> Convention => C,
> External_Name => "SDL_CalculateGammaRamp";
> private
> -- The following fields are defined as "internal use" in the SDL docs.
> type Private_Pixel_Format is
> record
> Rred_Loss : Interfaces.Unsigned_8;
> Green_Loss : Interfaces.Unsigned_8;
> Blue_Loss : Interfaces.Unsigned_8;
> Alpha_Loss : Interfaces.Unsigned_8;
> Red_Shift : Interfaces.Unsigned_8;
> Green_Shift : Interfaces.Unsigned_8;
> Blue_Shift : Interfaces.Unsigned_8;
> Alpha_Shift : Interfaces.Unsigned_8;
> Ref_Count : C.int;
> Next : Pixel_Format_Access;
> end record with
> Convention => C;
> end SDL.Video.Pixel_Formats;
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 11:31 3% How can I get this data into the .data section of the binary? Luke A. Guest
2020-09-03 10:32 0% ` c+
2020-09-13 13:36 0% ` patelchetan1111992
@ 2020-09-19 14:08 0% ` erchetan33
2020-09-28 11:36 0% ` yhumina stir
3 siblings, 0 replies; 200+ results
From: erchetan33 @ 2020-09-19 14:08 UTC (permalink / raw)
On Tuesday, June 16, 2020 at 5:02:13 PM UTC+5:30, Luke A. Guest wrote:
> Hi,
>
> I'm trying to get some static data tables into the data section rather
> than be elaborated at runtime. I can see no reason why this particular
> set of types, records and aggregates cannot go into the data section.
>
> I've searched for use of pragma Static_Elaboration_Desired, but there is
> very little information.
>
> Here's the full modified source from SDL minus the header:
>
> pragma Restrictions (No_Implicit_Loops);
> with Ada.Characters.Latin_1;
> with Ada.Unchecked_Conversion;
> with Interfaces;
> with Interfaces.C;
> with SDL.Video.Palettes;
>
> package SDL.Video.Pixel_Formats is
> package C renames Interfaces.C;
>
> type Pixel_Types is
> (Unknown,
> Index_1,
> Index_4,
> Index_8,
> Packed_8,
> Packed_16,
> Packed_32,
> Array_U8,
> Array_U16,
> Array_U32,
> Array_F16,
> Array_F32) with
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Types);
>
> -- Bitmap pixel order, high bit -> low bit.
> type Bitmap_Pixel_Order is (None, Little_Endian, Big_Endian) with
> Convention => C;
> pragma Static_Elaboration_Desired (Bitmap_Pixel_Order);
>
> -- Packed component order, high bit -> low bit.
> type Packed_Component_Order is
> (None,
> XRGB,
> RGBX,
> ARGB,
> RGBA,
> XBGR,
> BGRX,
> ABGR,
> BGRA) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Order);
>
> -- Array component order, low byte -> high byte.
> type Array_Component_Order is (None, RGB, RGBA, ARGB, BGR, BGRA, ABGR);
> pragma Static_Elaboration_Desired (Array_Component_Order);
>
> -- Describe how the components are laid out in bit form.
> type Packed_Component_Layout is
> (None,
> Bits_332,
> Bits_4444,
> Bits_1555,
> Bits_5551,
> Bits_565,
> Bits_8888,
> Bits_2101010,
> Bits_1010102) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Layout);
>
> type Bits_Per_Pixels is range 0 .. 32 with
> Static_Predicate => Bits_Per_Pixels in 0 | 1 | 4 | 8 | 12 | 15 | 16
> | 24 | 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Bits_Per_Pixels);
>
> Bits_Per_Pixel_Error : constant Bits_Per_Pixels := 0;
>
> type Bytes_Per_Pixels is range 0 .. 4 with
> Convention => C;
> pragma Static_Elaboration_Desired (Bytes_Per_Pixels);
>
> Bytes_Per_Pixel_Error : constant Bytes_Per_Pixels :=
> Bytes_Per_Pixels'First;
>
> -- 29 28 24 20 16 8 0
> -- 000 1 ptpt popo llll bibibibi bybybyby
> --
> -- or
> --
> -- 24 16 8 0
> -- DDDDDDDD CCCCCCCC BBBBBBBB AAAAAAAA
>
> type Index_Order_Padding is range 0 .. 1 with
> Convention => C;
> pragma Static_Elaboration_Desired (Index_Order_Padding);
>
> type Pixel_Orders (Pixel_Type : Pixel_Types := Unknown) is
> record
> case Pixel_Type is
> when Index_1 | Index_4 | Index_8 =>
> Indexed_Order : Bitmap_Pixel_Order;
> Indexed_Pad : Index_Order_Padding;
>
> when Packed_8 | Packed_16 | Packed_32 =>
> Packed_Order : Packed_Component_Order;
>
> when Array_U8 | Array_U16 | Array_U32 | Array_F16 | Array_F32 =>
> Array_Order : Array_Component_Order;
>
> when others =>
> null;
> end case;
> end record with
> Unchecked_Union => True,
> Convention => C,
> Size => 4;
>
> pragma Warnings (Off, "no component clause given");
> for Pixel_Orders use
> record
> Indexed_Order at 0 range 0 .. 2; -- This was 2 as that is the
> max size required but it causes a bit set bug!
> Indexed_Pad at 0 range 3 .. 3;
> Packed_Order at 0 range 0 .. 3;
> Array_Order at 0 range 0 .. 3;
> end record;
> pragma Static_Elaboration_Desired (Pixel_Orders);
> pragma Warnings (On, "no component clause given");
>
> type Planar_Pixels is
> record
> A : Character;
> B : Character;
> C : Character;
> D : Character;
> end record with
> Size => 32,
> Convention => C;
>
> for Planar_Pixels use
> record
> A at 0 range 0 .. 7;
> B at 0 range 8 .. 15;
> C at 0 range 16 .. 23;
> D at 0 range 24 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Planar_Pixels);
>
> type Non_Planar_Pixel_Padding is range 0 .. 7 with
> Convention => C;
> pragma Static_Elaboration_Desired (Non_Planar_Pixel_Padding);
>
> type Non_Planar_Pixels is
> record
> Bytes_Per_Pixel : Bytes_Per_Pixels;
> Bits_Per_Pixel : Bits_Per_Pixels;
> Layout : Packed_Component_Layout;
> Pixel_Order : Pixel_Orders;
> Pixel_Type : Pixel_Types;
> Flag : Boolean;
> Padding : Non_Planar_Pixel_Padding;
> end record with
> Size => 32,
> Convention => C;
>
> for Non_Planar_Pixels use
> record
> Bytes_Per_Pixel at 0 range 0 .. 7;
> Bits_Per_Pixel at 0 range 8 .. 15;
> Layout at 0 range 16 .. 19;
> Pixel_Order at 0 range 20 .. 23;
> Pixel_Type at 0 range 24 .. 27;
> Flag at 0 range 28 .. 28;
> Padding at 0 range 29 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Non_Planar_Pixels);
>
> type Pixel_Format_Names (Planar : Boolean := False) is
> record
> case Planar is
> when True =>
> Planar_Format : Planar_Pixels;
> when False =>
> Non_Planar_Format : Non_Planar_Pixels;
> end case;
> end record with
> Unchecked_Union => True,
> Size => 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Format_Names);
>
> Pixel_Format_Unknown : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (others => Ada.Characters.Latin_1.NUL));
> pragma Static_Elaboration_Desired (Pixel_Format_Unknown);
>
> Pixel_Format_Index_1_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_LSB);
>
> Pixel_Format_Index_1_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_MSB);
>
> Pixel_Format_Index_4_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_LSB);
>
> Pixel_Format_Index_4_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_MSB);
>
> Pixel_Format_Index_8 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_8,
> Indexed_Order => None,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_8);
>
> Pixel_Format_RGB_332 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_8,
> Packed_Order => XRGB),
> Layout => Bits_332,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_332);
>
> Pixel_Format_RGB_444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 12,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_444);
>
> Pixel_Format_RGB_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_555);
>
> Pixel_Format_BGR_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_555);
>
> Pixel_Format_ARGB_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_4444);
>
> Pixel_Format_RGBA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_4444);
>
> Pixel_Format_ABGR_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_4444);
>
> Pixel_Format_BGRA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_4444);
>
> Pixel_Format_ARGB_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_1555);
>
> Pixel_Format_RGBA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_5551);
>
> Pixel_Format_ABGR_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_1555);
>
> Pixel_Format_BGRA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_5551);
>
> Pixel_Format_RGB_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_565);
>
> Pixel_Format_BGR_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_565);
>
> Pixel_Format_RGB_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => RGB),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_24);
>
> Pixel_Format_BGR_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => BGR),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_24);
>
> Pixel_Format_RGB_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XRGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_888);
>
> Pixel_Format_RGBX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBX_8888);
>
> Pixel_Format_BGR_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XBGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_888);
>
> Pixel_Format_BGRX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRX_8888);
>
> Pixel_Format_ARGB_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_8888);
>
> Pixel_Format_RGBA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_8888);
>
> Pixel_Format_ABGR_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ABGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_8888);
>
> Pixel_Format_BGRA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_8888);
>
> Pixel_Format_ARGB_2101010 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_2101010,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_2101010);
>
> Pixel_Format_YV_12 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => '1',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YV_12);
>
> Pixel_Format_IYUV : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'I',
> B => 'Y',
> C => 'U',
> D => 'V'));
> pragma Static_Elaboration_Desired (Pixel_Format_IYUV);
>
> Pixel_Format_YUY_2 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'U',
> C => 'Y',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YUY_2);
>
> Pixel_Format_UYVY : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'U',
> B => 'Y',
> C => 'V',
> D => 'Y'));
> pragma Static_Elaboration_Desired (Pixel_Format_UYVY);
>
> Pixel_Format_YVYU : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => 'Y',
> D => 'U'));
> pragma Static_Elaboration_Desired (Pixel_Format_YVYU);
>
> type Colour_Mask is mod 2 ** 32 with
> Convention => C;
>
> type Private_Pixel_Format is private;
>
> type Pixel_Format is
> record
> Format : Pixel_Format_Names;
> Palette : Palettes.Palette_Access;
> Bits : Bits_Per_Pixels;
> Bytes : Bytes_Per_Pixels;
> Padding : Interfaces.Unsigned_16;
> Red_Mask : Colour_Mask;
> Green_Mask : Colour_Mask;
> Blue_Mask : Colour_Mask;
> Alpha_Mask : Colour_Mask;
>
> -- This is mainly padding to make sure the record size matches
> what is expected from C.
> Private_Part : Private_Pixel_Format;
> end record with
> Convention => C;
>
> -- TODO: Possibly change this to a controlled type.
> type Pixel_Format_Access is access all Pixel_Format with
> Convention => C;
>
> function Create (Format : in Pixel_Format_Names) return
> Pixel_Format_Access with
> Import => True,
> Convention => C,
> External_Name => "SDL_AllocFormat";
>
> procedure Free (Format : in Pixel_Format_Access) with
> Import => True,
> Convention => C,
> External_Name => "SDL_FreeFormat";
>
> function Image (Format : in Pixel_Format_Names) return String;
> -- Import => True,
> -- Convention => C,
> -- External_Name => "SDL_GetPixelFormatName";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGB";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component;
> Alpha : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGBA";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGB";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component;
> Alpha : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGBA";
>
> function To_Colour (Pixel : in Interfaces.Unsigned_32; Format : in
> Pixel_Format_Access) return Palettes.Colour with
> Inline => True;
>
> function To_Pixel (Colour : in Palettes.Colour; Format : in
> Pixel_Format_Access) return Interfaces.Unsigned_32 with
> Inline => True;
>
> function To_Name
> (Bits : in Bits_Per_Pixels;
> Red_Mask : in Colour_Mask;
> Green_Mask : in Colour_Mask;
> Blue_Mask : in Colour_Mask;
> Alpha_Mask : in Colour_Mask) return Pixel_Format_Names with
> Import => True,
> Convention => C,
> External_Name => "SDL_MasksToPixelFormatEnum";
>
> function To_Masks
> (Format : in Pixel_Format_Names;
> Bits : out Bits_Per_Pixels;
> Red_Mask : out Colour_Mask;
> Green_Mask : out Colour_Mask;
> Blue_Mask : out Colour_Mask;
> Alpha_Mask : out Colour_Mask) return Boolean with
> Inline => True;
>
> -- Gamma
> type Gamma_Value is mod 2 ** 16 with
> Convention => C;
>
> type Gamma_Ramp is array (Integer range 1 .. 256) of Gamma_Value with
> Convention => C;
>
> procedure Calculate (Gamma : in Float; Ramp : out Gamma_Ramp) with
> Import => True,
> Convention => C,
> External_Name => "SDL_CalculateGammaRamp";
> private
> -- The following fields are defined as "internal use" in the SDL docs.
> type Private_Pixel_Format is
> record
> Rred_Loss : Interfaces.Unsigned_8;
> Green_Loss : Interfaces.Unsigned_8;
> Blue_Loss : Interfaces.Unsigned_8;
> Alpha_Loss : Interfaces.Unsigned_8;
> Red_Shift : Interfaces.Unsigned_8;
> Green_Shift : Interfaces.Unsigned_8;
> Blue_Shift : Interfaces.Unsigned_8;
> Alpha_Shift : Interfaces.Unsigned_8;
> Ref_Count : C.int;
> Next : Pixel_Format_Access;
> end record with
> Convention => C;
> end SDL.Video.Pixel_Formats;
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 11:31 3% How can I get this data into the .data section of the binary? Luke A. Guest
2020-09-03 10:32 0% ` c+
@ 2020-09-13 13:36 0% ` patelchetan1111992
2020-09-19 14:08 0% ` erchetan33
2020-09-28 11:36 0% ` yhumina stir
3 siblings, 0 replies; 200+ results
From: patelchetan1111992 @ 2020-09-13 13:36 UTC (permalink / raw)
On Tuesday, June 16, 2020 at 5:02:13 PM UTC+5:30, Luke A. Guest wrote:
> Hi,
>
> I'm trying to get some static data tables into the data section rather
> than be elaborated at runtime. I can see no reason why this particular
> set of types, records and aggregates cannot go into the data section.
>
> I've searched for use of pragma Static_Elaboration_Desired, but there is
> very little information.
>
> Here's the full modified source from SDL minus the header:
>
> pragma Restrictions (No_Implicit_Loops);
> with Ada.Characters.Latin_1;
> with Ada.Unchecked_Conversion;
> with Interfaces;
> with Interfaces.C;
> with SDL.Video.Palettes;
>
> package SDL.Video.Pixel_Formats is
> package C renames Interfaces.C;
>
> type Pixel_Types is
> (Unknown,
> Index_1,
> Index_4,
> Index_8,
> Packed_8,
> Packed_16,
> Packed_32,
> Array_U8,
> Array_U16,
> Array_U32,
> Array_F16,
> Array_F32) with
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Types);
>
> -- Bitmap pixel order, high bit -> low bit.
> type Bitmap_Pixel_Order is (None, Little_Endian, Big_Endian) with
> Convention => C;
> pragma Static_Elaboration_Desired (Bitmap_Pixel_Order);
>
> -- Packed component order, high bit -> low bit.
> type Packed_Component_Order is
> (None,
> XRGB,
> RGBX,
> ARGB,
> RGBA,
> XBGR,
> BGRX,
> ABGR,
> BGRA) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Order);
>
> -- Array component order, low byte -> high byte.
> type Array_Component_Order is (None, RGB, RGBA, ARGB, BGR, BGRA, ABGR);
> pragma Static_Elaboration_Desired (Array_Component_Order);
>
> -- Describe how the components are laid out in bit form.
> type Packed_Component_Layout is
> (None,
> Bits_332,
> Bits_4444,
> Bits_1555,
> Bits_5551,
> Bits_565,
> Bits_8888,
> Bits_2101010,
> Bits_1010102) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Layout);
>
> type Bits_Per_Pixels is range 0 .. 32 with
> Static_Predicate => Bits_Per_Pixels in 0 | 1 | 4 | 8 | 12 | 15 | 16
> | 24 | 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Bits_Per_Pixels);
>
> Bits_Per_Pixel_Error : constant Bits_Per_Pixels := 0;
>
> type Bytes_Per_Pixels is range 0 .. 4 with
> Convention => C;
> pragma Static_Elaboration_Desired (Bytes_Per_Pixels);
>
> Bytes_Per_Pixel_Error : constant Bytes_Per_Pixels :=
> Bytes_Per_Pixels'First;
>
> -- 29 28 24 20 16 8 0
> -- 000 1 ptpt popo llll bibibibi bybybyby
> --
> -- or
> --
> -- 24 16 8 0
> -- DDDDDDDD CCCCCCCC BBBBBBBB AAAAAAAA
>
> type Index_Order_Padding is range 0 .. 1 with
> Convention => C;
> pragma Static_Elaboration_Desired (Index_Order_Padding);
>
> type Pixel_Orders (Pixel_Type : Pixel_Types := Unknown) is
> record
> case Pixel_Type is
> when Index_1 | Index_4 | Index_8 =>
> Indexed_Order : Bitmap_Pixel_Order;
> Indexed_Pad : Index_Order_Padding;
>
> when Packed_8 | Packed_16 | Packed_32 =>
> Packed_Order : Packed_Component_Order;
>
> when Array_U8 | Array_U16 | Array_U32 | Array_F16 | Array_F32 =>
> Array_Order : Array_Component_Order;
>
> when others =>
> null;
> end case;
> end record with
> Unchecked_Union => True,
> Convention => C,
> Size => 4;
>
> pragma Warnings (Off, "no component clause given");
> for Pixel_Orders use
> record
> Indexed_Order at 0 range 0 .. 2; -- This was 2 as that is the
> max size required but it causes a bit set bug!
> Indexed_Pad at 0 range 3 .. 3;
> Packed_Order at 0 range 0 .. 3;
> Array_Order at 0 range 0 .. 3;
> end record;
> pragma Static_Elaboration_Desired (Pixel_Orders);
> pragma Warnings (On, "no component clause given");
>
> type Planar_Pixels is
> record
> A : Character;
> B : Character;
> C : Character;
> D : Character;
> end record with
> Size => 32,
> Convention => C;
>
> for Planar_Pixels use
> record
> A at 0 range 0 .. 7;
> B at 0 range 8 .. 15;
> C at 0 range 16 .. 23;
> D at 0 range 24 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Planar_Pixels);
>
> type Non_Planar_Pixel_Padding is range 0 .. 7 with
> Convention => C;
> pragma Static_Elaboration_Desired (Non_Planar_Pixel_Padding);
>
> type Non_Planar_Pixels is
> record
> Bytes_Per_Pixel : Bytes_Per_Pixels;
> Bits_Per_Pixel : Bits_Per_Pixels;
> Layout : Packed_Component_Layout;
> Pixel_Order : Pixel_Orders;
> Pixel_Type : Pixel_Types;
> Flag : Boolean;
> Padding : Non_Planar_Pixel_Padding;
> end record with
> Size => 32,
> Convention => C;
>
> for Non_Planar_Pixels use
> record
> Bytes_Per_Pixel at 0 range 0 .. 7;
> Bits_Per_Pixel at 0 range 8 .. 15;
> Layout at 0 range 16 .. 19;
> Pixel_Order at 0 range 20 .. 23;
> Pixel_Type at 0 range 24 .. 27;
> Flag at 0 range 28 .. 28;
> Padding at 0 range 29 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Non_Planar_Pixels);
>
> type Pixel_Format_Names (Planar : Boolean := False) is
> record
> case Planar is
> when True =>
> Planar_Format : Planar_Pixels;
> when False =>
> Non_Planar_Format : Non_Planar_Pixels;
> end case;
> end record with
> Unchecked_Union => True,
> Size => 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Format_Names);
>
> Pixel_Format_Unknown : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (others => Ada.Characters.Latin_1.NUL));
> pragma Static_Elaboration_Desired (Pixel_Format_Unknown);
>
> Pixel_Format_Index_1_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_LSB);
>
> Pixel_Format_Index_1_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_MSB);
>
> Pixel_Format_Index_4_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_LSB);
>
> Pixel_Format_Index_4_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_MSB);
>
> Pixel_Format_Index_8 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_8,
> Indexed_Order => None,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_8);
>
> Pixel_Format_RGB_332 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_8,
> Packed_Order => XRGB),
> Layout => Bits_332,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_332);
>
> Pixel_Format_RGB_444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 12,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_444);
>
> Pixel_Format_RGB_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_555);
>
> Pixel_Format_BGR_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_555);
>
> Pixel_Format_ARGB_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_4444);
>
> Pixel_Format_RGBA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_4444);
>
> Pixel_Format_ABGR_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_4444);
>
> Pixel_Format_BGRA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_4444);
>
> Pixel_Format_ARGB_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_1555);
>
> Pixel_Format_RGBA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_5551);
>
> Pixel_Format_ABGR_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_1555);
>
> Pixel_Format_BGRA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_5551);
>
> Pixel_Format_RGB_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_565);
>
> Pixel_Format_BGR_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_565);
>
> Pixel_Format_RGB_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => RGB),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_24);
>
> Pixel_Format_BGR_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => BGR),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_24);
>
> Pixel_Format_RGB_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XRGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_888);
>
> Pixel_Format_RGBX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBX_8888);
>
> Pixel_Format_BGR_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XBGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_888);
>
> Pixel_Format_BGRX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRX_8888);
>
> Pixel_Format_ARGB_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_8888);
>
> Pixel_Format_RGBA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_8888);
>
> Pixel_Format_ABGR_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ABGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_8888);
>
> Pixel_Format_BGRA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_8888);
>
> Pixel_Format_ARGB_2101010 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_2101010,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_2101010);
>
> Pixel_Format_YV_12 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => '1',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YV_12);
>
> Pixel_Format_IYUV : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'I',
> B => 'Y',
> C => 'U',
> D => 'V'));
> pragma Static_Elaboration_Desired (Pixel_Format_IYUV);
>
> Pixel_Format_YUY_2 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'U',
> C => 'Y',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YUY_2);
>
> Pixel_Format_UYVY : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'U',
> B => 'Y',
> C => 'V',
> D => 'Y'));
> pragma Static_Elaboration_Desired (Pixel_Format_UYVY);
>
> Pixel_Format_YVYU : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => 'Y',
> D => 'U'));
> pragma Static_Elaboration_Desired (Pixel_Format_YVYU);
>
> type Colour_Mask is mod 2 ** 32 with
> Convention => C;
>
> type Private_Pixel_Format is private;
>
> type Pixel_Format is
> record
> Format : Pixel_Format_Names;
> Palette : Palettes.Palette_Access;
> Bits : Bits_Per_Pixels;
> Bytes : Bytes_Per_Pixels;
> Padding : Interfaces.Unsigned_16;
> Red_Mask : Colour_Mask;
> Green_Mask : Colour_Mask;
> Blue_Mask : Colour_Mask;
> Alpha_Mask : Colour_Mask;
>
> -- This is mainly padding to make sure the record size matches
> what is expected from C.
> Private_Part : Private_Pixel_Format;
> end record with
> Convention => C;
>
> -- TODO: Possibly change this to a controlled type.
> type Pixel_Format_Access is access all Pixel_Format with
> Convention => C;
>
> function Create (Format : in Pixel_Format_Names) return
> Pixel_Format_Access with
> Import => True,
> Convention => C,
> External_Name => "SDL_AllocFormat";
>
> procedure Free (Format : in Pixel_Format_Access) with
> Import => True,
> Convention => C,
> External_Name => "SDL_FreeFormat";
>
> function Image (Format : in Pixel_Format_Names) return String;
> -- Import => True,
> -- Convention => C,
> -- External_Name => "SDL_GetPixelFormatName";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGB";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component;
> Alpha : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGBA";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGB";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component;
> Alpha : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGBA";
>
> function To_Colour (Pixel : in Interfaces.Unsigned_32; Format : in
> Pixel_Format_Access) return Palettes.Colour with
> Inline => True;
>
> function To_Pixel (Colour : in Palettes.Colour; Format : in
> Pixel_Format_Access) return Interfaces.Unsigned_32 with
> Inline => True;
>
> function To_Name
> (Bits : in Bits_Per_Pixels;
> Red_Mask : in Colour_Mask;
> Green_Mask : in Colour_Mask;
> Blue_Mask : in Colour_Mask;
> Alpha_Mask : in Colour_Mask) return Pixel_Format_Names with
> Import => True,
> Convention => C,
> External_Name => "SDL_MasksToPixelFormatEnum";
>
> function To_Masks
> (Format : in Pixel_Format_Names;
> Bits : out Bits_Per_Pixels;
> Red_Mask : out Colour_Mask;
> Green_Mask : out Colour_Mask;
> Blue_Mask : out Colour_Mask;
> Alpha_Mask : out Colour_Mask) return Boolean with
> Inline => True;
>
> -- Gamma
> type Gamma_Value is mod 2 ** 16 with
> Convention => C;
>
> type Gamma_Ramp is array (Integer range 1 .. 256) of Gamma_Value with
> Convention => C;
>
> procedure Calculate (Gamma : in Float; Ramp : out Gamma_Ramp) with
> Import => True,
> Convention => C,
> External_Name => "SDL_CalculateGammaRamp";
> private
> -- The following fields are defined as "internal use" in the SDL docs.
> type Private_Pixel_Format is
> record
> Rred_Loss : Interfaces.Unsigned_8;
> Green_Loss : Interfaces.Unsigned_8;
> Blue_Loss : Interfaces.Unsigned_8;
> Alpha_Loss : Interfaces.Unsigned_8;
> Red_Shift : Interfaces.Unsigned_8;
> Green_Shift : Interfaces.Unsigned_8;
> Blue_Shift : Interfaces.Unsigned_8;
> Alpha_Shift : Interfaces.Unsigned_8;
> Ref_Count : C.int;
> Next : Pixel_Format_Access;
> end record with
> Convention => C;
> end SDL.Video.Pixel_Formats;
^ permalink raw reply [relevance 0%]
* Re: How can I get this data into the .data section of the binary?
2020-06-16 11:31 3% How can I get this data into the .data section of the binary? Luke A. Guest
@ 2020-09-03 10:32 0% ` c+
2020-09-13 13:36 0% ` patelchetan1111992
` (2 subsequent siblings)
3 siblings, 0 replies; 200+ results
From: c+ @ 2020-09-03 10:32 UTC (permalink / raw)
On Tuesday, 16 June 2020 17:02:13 UTC+5:30, Luke A. Guest wrote:
> Hi,
>
> I'm trying to get some static data tables into the data section rather
> than be elaborated at runtime. I can see no reason why this particular
> set of types, records and aggregates cannot go into the data section.
>
> I've searched for use of pragma Static_Elaboration_Desired, but there is
> very little information.
>
> Here's the full modified source from SDL minus the header:
>
> pragma Restrictions (No_Implicit_Loops);
> with Ada.Characters.Latin_1;
> with Ada.Unchecked_Conversion;
> with Interfaces;
> with Interfaces.C;
> with SDL.Video.Palettes;
>
> package SDL.Video.Pixel_Formats is
> package C renames Interfaces.C;
>
> type Pixel_Types is
> (Unknown,
> Index_1,
> Index_4,
> Index_8,
> Packed_8,
> Packed_16,
> Packed_32,
> Array_U8,
> Array_U16,
> Array_U32,
> Array_F16,
> Array_F32) with
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Types);
>
> -- Bitmap pixel order, high bit -> low bit.
> type Bitmap_Pixel_Order is (None, Little_Endian, Big_Endian) with
> Convention => C;
> pragma Static_Elaboration_Desired (Bitmap_Pixel_Order);
>
> -- Packed component order, high bit -> low bit.
> type Packed_Component_Order is
> (None,
> XRGB,
> RGBX,
> ARGB,
> RGBA,
> XBGR,
> BGRX,
> ABGR,
> BGRA) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Order);
>
> -- Array component order, low byte -> high byte.
> type Array_Component_Order is (None, RGB, RGBA, ARGB, BGR, BGRA, ABGR);
> pragma Static_Elaboration_Desired (Array_Component_Order);
>
> -- Describe how the components are laid out in bit form.
> type Packed_Component_Layout is
> (None,
> Bits_332,
> Bits_4444,
> Bits_1555,
> Bits_5551,
> Bits_565,
> Bits_8888,
> Bits_2101010,
> Bits_1010102) with
> Convention => C;
> pragma Static_Elaboration_Desired (Packed_Component_Layout);
>
> type Bits_Per_Pixels is range 0 .. 32 with
> Static_Predicate => Bits_Per_Pixels in 0 | 1 | 4 | 8 | 12 | 15 | 16
> | 24 | 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Bits_Per_Pixels);
>
> Bits_Per_Pixel_Error : constant Bits_Per_Pixels := 0;
>
> type Bytes_Per_Pixels is range 0 .. 4 with
> Convention => C;
> pragma Static_Elaboration_Desired (Bytes_Per_Pixels);
>
> Bytes_Per_Pixel_Error : constant Bytes_Per_Pixels :=
> Bytes_Per_Pixels'First;
>
> -- 29 28 24 20 16 8 0
> -- 000 1 ptpt popo llll bibibibi bybybyby
> --
> -- or
> --
> -- 24 16 8 0
> -- DDDDDDDD CCCCCCCC BBBBBBBB AAAAAAAA
>
> type Index_Order_Padding is range 0 .. 1 with
> Convention => C;
> pragma Static_Elaboration_Desired (Index_Order_Padding);
>
> type Pixel_Orders (Pixel_Type : Pixel_Types := Unknown) is
> record
> case Pixel_Type is
> when Index_1 | Index_4 | Index_8 =>
> Indexed_Order : Bitmap_Pixel_Order;
> Indexed_Pad : Index_Order_Padding;
>
> when Packed_8 | Packed_16 | Packed_32 =>
> Packed_Order : Packed_Component_Order;
>
> when Array_U8 | Array_U16 | Array_U32 | Array_F16 | Array_F32 =>
> Array_Order : Array_Component_Order;
>
> when others =>
> null;
> end case;
> end record with
> Unchecked_Union => True,
> Convention => C,
> Size => 4;
>
> pragma Warnings (Off, "no component clause given");
> for Pixel_Orders use
> record
> Indexed_Order at 0 range 0 .. 2; -- This was 2 as that is the
> max size required but it causes a bit set bug!
> Indexed_Pad at 0 range 3 .. 3;
> Packed_Order at 0 range 0 .. 3;
> Array_Order at 0 range 0 .. 3;
> end record;
> pragma Static_Elaboration_Desired (Pixel_Orders);
> pragma Warnings (On, "no component clause given");
>
> type Planar_Pixels is
> record
> A : Character;
> B : Character;
> C : Character;
> D : Character;
> end record with
> Size => 32,
> Convention => C;
>
> for Planar_Pixels use
> record
> A at 0 range 0 .. 7;
> B at 0 range 8 .. 15;
> C at 0 range 16 .. 23;
> D at 0 range 24 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Planar_Pixels);
>
> type Non_Planar_Pixel_Padding is range 0 .. 7 with
> Convention => C;
> pragma Static_Elaboration_Desired (Non_Planar_Pixel_Padding);
>
> type Non_Planar_Pixels is
> record
> Bytes_Per_Pixel : Bytes_Per_Pixels;
> Bits_Per_Pixel : Bits_Per_Pixels;
> Layout : Packed_Component_Layout;
> Pixel_Order : Pixel_Orders;
> Pixel_Type : Pixel_Types;
> Flag : Boolean;
> Padding : Non_Planar_Pixel_Padding;
> end record with
> Size => 32,
> Convention => C;
>
> for Non_Planar_Pixels use
> record
> Bytes_Per_Pixel at 0 range 0 .. 7;
> Bits_Per_Pixel at 0 range 8 .. 15;
> Layout at 0 range 16 .. 19;
> Pixel_Order at 0 range 20 .. 23;
> Pixel_Type at 0 range 24 .. 27;
> Flag at 0 range 28 .. 28;
> Padding at 0 range 29 .. 31;
> end record;
> pragma Static_Elaboration_Desired (Non_Planar_Pixels);
>
> type Pixel_Format_Names (Planar : Boolean := False) is
> record
> case Planar is
> when True =>
> Planar_Format : Planar_Pixels;
> when False =>
> Non_Planar_Format : Non_Planar_Pixels;
> end case;
> end record with
> Unchecked_Union => True,
> Size => 32,
> Convention => C;
> pragma Static_Elaboration_Desired (Pixel_Format_Names);
>
> Pixel_Format_Unknown : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (others => Ada.Characters.Latin_1.NUL));
> pragma Static_Elaboration_Desired (Pixel_Format_Unknown);
>
> Pixel_Format_Index_1_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_LSB);
>
> Pixel_Format_Index_1_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_1,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_1,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 1,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_1_MSB);
>
> Pixel_Format_Index_4_LSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Little_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_LSB);
>
> Pixel_Format_Index_4_MSB : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_4,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_4,
> Indexed_Order => Big_Endian,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 4,
> Bytes_Per_Pixel => 0));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_4_MSB);
>
> Pixel_Format_Index_8 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Index_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Index_8,
> Indexed_Order => None,
> Indexed_Pad => Index_Order_Padding'First),
> Layout => None,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_Index_8);
>
> Pixel_Format_RGB_332 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_8,
> Packed_Order => XRGB),
> Layout => Bits_332,
> Bits_Per_Pixel => 8,
> Bytes_Per_Pixel => 1));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_332);
>
> Pixel_Format_RGB_444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 12,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_444);
>
> Pixel_Format_RGB_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_555);
>
> Pixel_Format_BGR_555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 15,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_555);
>
> Pixel_Format_ARGB_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_4444);
>
> Pixel_Format_RGBA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_4444);
>
> Pixel_Format_ABGR_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_4444);
>
> Pixel_Format_BGRA_4444 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_4444,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_4444);
>
> Pixel_Format_ARGB_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ARGB),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_1555);
>
> Pixel_Format_RGBA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => RGBA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_5551);
>
> Pixel_Format_ABGR_1555 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => ABGR),
> Layout => Bits_1555,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_1555);
>
> Pixel_Format_BGRA_5551 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => BGRA),
> Layout => Bits_5551,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_5551);
>
> Pixel_Format_RGB_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XRGB),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_565);
>
> Pixel_Format_BGR_565 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_16,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_16,
> Packed_Order => XBGR),
> Layout => Bits_565,
> Bits_Per_Pixel => 16,
> Bytes_Per_Pixel => 2));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_565);
>
> Pixel_Format_RGB_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => RGB),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_24);
>
> Pixel_Format_BGR_24 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Array_U8,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Array_U8,
> Array_Order => BGR),
> Layout => None,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 3));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_24);
>
> Pixel_Format_RGB_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XRGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGB_888);
>
> Pixel_Format_RGBX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBX_8888);
>
> Pixel_Format_BGR_888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => XBGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGR_888);
>
> Pixel_Format_BGRX_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRX),
> Layout => Bits_8888,
> Bits_Per_Pixel => 24,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRX_8888);
>
> Pixel_Format_ARGB_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_8888);
>
> Pixel_Format_RGBA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => RGBA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_RGBA_8888);
>
> Pixel_Format_ABGR_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ABGR),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ABGR_8888);
>
> Pixel_Format_BGRA_8888 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => BGRA),
> Layout => Bits_8888,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_BGRA_8888);
>
> Pixel_Format_ARGB_2101010 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => False,
> Non_Planar_Format => Non_Planar_Pixels'
> (Padding =>
> Non_Planar_Pixel_Padding'First,
> Flag => True,
> Pixel_Type => Packed_32,
> Pixel_Order => Pixel_Orders'
> (Pixel_Type => Packed_32,
> Packed_Order => ARGB),
> Layout => Bits_2101010,
> Bits_Per_Pixel => 32,
> Bytes_Per_Pixel => 4));
> pragma Static_Elaboration_Desired (Pixel_Format_ARGB_2101010);
>
> Pixel_Format_YV_12 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => '1',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YV_12);
>
> Pixel_Format_IYUV : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'I',
> B => 'Y',
> C => 'U',
> D => 'V'));
> pragma Static_Elaboration_Desired (Pixel_Format_IYUV);
>
> Pixel_Format_YUY_2 : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'U',
> C => 'Y',
> D => '2'));
> pragma Static_Elaboration_Desired (Pixel_Format_YUY_2);
>
> Pixel_Format_UYVY : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'U',
> B => 'Y',
> C => 'V',
> D => 'Y'));
> pragma Static_Elaboration_Desired (Pixel_Format_UYVY);
>
> Pixel_Format_YVYU : constant Pixel_Format_Names :=
> Pixel_Format_Names'(Planar => True,
> Planar_Format => Planar_Pixels'
> (A => 'Y',
> B => 'V',
> C => 'Y',
> D => 'U'));
> pragma Static_Elaboration_Desired (Pixel_Format_YVYU);
>
> type Colour_Mask is mod 2 ** 32 with
> Convention => C;
>
> type Private_Pixel_Format is private;
>
> type Pixel_Format is
> record
> Format : Pixel_Format_Names;
> Palette : Palettes.Palette_Access;
> Bits : Bits_Per_Pixels;
> Bytes : Bytes_Per_Pixels;
> Padding : Interfaces.Unsigned_16;
> Red_Mask : Colour_Mask;
> Green_Mask : Colour_Mask;
> Blue_Mask : Colour_Mask;
> Alpha_Mask : Colour_Mask;
>
> -- This is mainly padding to make sure the record size matches
> what is expected from C.
> Private_Part : Private_Pixel_Format;
> end record with
> Convention => C;
>
> -- TODO: Possibly change this to a controlled type.
> type Pixel_Format_Access is access all Pixel_Format with
> Convention => C;
>
> function Create (Format : in Pixel_Format_Names) return
> Pixel_Format_Access with
> Import => True,
> Convention => C,
> External_Name => "SDL_AllocFormat";
>
> procedure Free (Format : in Pixel_Format_Access) with
> Import => True,
> Convention => C,
> External_Name => "SDL_FreeFormat";
>
> function Image (Format : in Pixel_Format_Names) return String;
> -- Import => True,
> -- Convention => C,
> -- External_Name => "SDL_GetPixelFormatName";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGB";
>
> procedure To_Components
> (Pixel : in Interfaces.Unsigned_32;
> Format : in Pixel_Format_Access;
> Red : out Palettes.Colour_Component;
> Green : out Palettes.Colour_Component;
> Blue : out Palettes.Colour_Component;
> Alpha : out Palettes.Colour_Component) with
> Import => True,
> Convention => C,
> External_Name => "SDL_GetRGBA";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGB";
>
> function To_Pixel
> (Format : in Pixel_Format_Access;
> Red : in Palettes.Colour_Component;
> Green : in Palettes.Colour_Component;
> Blue : in Palettes.Colour_Component;
> Alpha : in Palettes.Colour_Component) return
> Interfaces.Unsigned_32 with
> Import => True,
> Convention => C,
> External_Name => "SDL_MapRGBA";
>
> function To_Colour (Pixel : in Interfaces.Unsigned_32; Format : in
> Pixel_Format_Access) return Palettes.Colour with
> Inline => True;
>
> function To_Pixel (Colour : in Palettes.Colour; Format : in
> Pixel_Format_Access) return Interfaces.Unsigned_32 with
> Inline => True;
>
> function To_Name
> (Bits : in Bits_Per_Pixels;
> Red_Mask : in Colour_Mask;
> Green_Mask : in Colour_Mask;
> Blue_Mask : in Colour_Mask;
> Alpha_Mask : in Colour_Mask) return Pixel_Format_Names with
> Import => True,
> Convention => C,
> External_Name => "SDL_MasksToPixelFormatEnum";
>
> function To_Masks
> (Format : in Pixel_Format_Names;
> Bits : out Bits_Per_Pixels;
> Red_Mask : out Colour_Mask;
> Green_Mask : out Colour_Mask;
> Blue_Mask : out Colour_Mask;
> Alpha_Mask : out Colour_Mask) return Boolean with
> Inline => True;
>
> -- Gamma
> type Gamma_Value is mod 2 ** 16 with
> Convention => C;
>
> type Gamma_Ramp is array (Integer range 1 .. 256) of Gamma_Value with
> Convention => C;
>
> procedure Calculate (Gamma : in Float; Ramp : out Gamma_Ramp) with
> Import => True,
> Convention => C,
> External_Name => "SDL_CalculateGammaRamp";
> private
> -- The following fields are defined as "internal use" in the SDL docs.
> type Private_Pixel_Format is
> record
> Rred_Loss : Interfaces.Unsigned_8;
> Green_Loss : Interfaces.Unsigned_8;
> Blue_Loss : Interfaces.Unsigned_8;
> Alpha_Loss : Interfaces.Unsigned_8;
> Red_Shift : Interfaces.Unsigned_8;
> Green_Shift : Interfaces.Unsigned_8;
> Blue_Shift : Interfaces.Unsigned_8;
> Alpha_Shift : Interfaces.Unsigned_8;
> Ref_Count : C.int;
> Next : Pixel_Format_Access;
> end record with
> Convention => C;
> end SDL.Video.Pixel_Formats;
^ permalink raw reply [relevance 0%]
* How can I get this data into the .data section of the binary?
@ 2020-06-16 11:31 3% Luke A. Guest
2020-09-03 10:32 0% ` c+
` (3 more replies)
0 siblings, 4 replies; 200+ results
From: Luke A. Guest @ 2020-06-16 11:31 UTC (permalink / raw)
Hi,
I'm trying to get some static data tables into the data section rather
than be elaborated at runtime. I can see no reason why this particular
set of types, records and aggregates cannot go into the data section.
I've searched for use of pragma Static_Elaboration_Desired, but there is
very little information.
Here's the full modified source from SDL minus the header:
pragma Restrictions (No_Implicit_Loops);
with Ada.Characters.Latin_1;
with Ada.Unchecked_Conversion;
with Interfaces;
with Interfaces.C;
with SDL.Video.Palettes;
package SDL.Video.Pixel_Formats is
package C renames Interfaces.C;
type Pixel_Types is
(Unknown,
Index_1,
Index_4,
Index_8,
Packed_8,
Packed_16,
Packed_32,
Array_U8,
Array_U16,
Array_U32,
Array_F16,
Array_F32) with
Convention => C;
pragma Static_Elaboration_Desired (Pixel_Types);
-- Bitmap pixel order, high bit -> low bit.
type Bitmap_Pixel_Order is (None, Little_Endian, Big_Endian) with
Convention => C;
pragma Static_Elaboration_Desired (Bitmap_Pixel_Order);
-- Packed component order, high bit -> low bit.
type Packed_Component_Order is
(None,
XRGB,
RGBX,
ARGB,
RGBA,
XBGR,
BGRX,
ABGR,
BGRA) with
Convention => C;
pragma Static_Elaboration_Desired (Packed_Component_Order);
-- Array component order, low byte -> high byte.
type Array_Component_Order is (None, RGB, RGBA, ARGB, BGR, BGRA, ABGR);
pragma Static_Elaboration_Desired (Array_Component_Order);
-- Describe how the components are laid out in bit form.
type Packed_Component_Layout is
(None,
Bits_332,
Bits_4444,
Bits_1555,
Bits_5551,
Bits_565,
Bits_8888,
Bits_2101010,
Bits_1010102) with
Convention => C;
pragma Static_Elaboration_Desired (Packed_Component_Layout);
type Bits_Per_Pixels is range 0 .. 32 with
Static_Predicate => Bits_Per_Pixels in 0 | 1 | 4 | 8 | 12 | 15 | 16
| 24 | 32,
Convention => C;
pragma Static_Elaboration_Desired (Bits_Per_Pixels);
Bits_Per_Pixel_Error : constant Bits_Per_Pixels := 0;
type Bytes_Per_Pixels is range 0 .. 4 with
Convention => C;
pragma Static_Elaboration_Desired (Bytes_Per_Pixels);
Bytes_Per_Pixel_Error : constant Bytes_Per_Pixels :=
Bytes_Per_Pixels'First;
-- 29 28 24 20 16 8 0
-- 000 1 ptpt popo llll bibibibi bybybyby
--
-- or
--
-- 24 16 8 0
-- DDDDDDDD CCCCCCCC BBBBBBBB AAAAAAAA
type Index_Order_Padding is range 0 .. 1 with
Convention => C;
pragma Static_Elaboration_Desired (Index_Order_Padding);
type Pixel_Orders (Pixel_Type : Pixel_Types := Unknown) is
record
case Pixel_Type is
when Index_1 | Index_4 | Index_8 =>
Indexed_Order : Bitmap_Pixel_Order;
Indexed_Pad : Index_Order_Padding;
when Packed_8 | Packed_16 | Packed_32 =>
Packed_Order : Packed_Component_Order;
when Array_U8 | Array_U16 | Array_U32 | Array_F16 | Array_F32 =>
Array_Order : Array_Component_Order;
when others =>
null;
end case;
end record with
Unchecked_Union => True,
Convention => C,
Size => 4;
pragma Warnings (Off, "no component clause given");
for Pixel_Orders use
record
Indexed_Order at 0 range 0 .. 2; -- This was 2 as that is the
max size required but it causes a bit set bug!
Indexed_Pad at 0 range 3 .. 3;
Packed_Order at 0 range 0 .. 3;
Array_Order at 0 range 0 .. 3;
end record;
pragma Static_Elaboration_Desired (Pixel_Orders);
pragma Warnings (On, "no component clause given");
type Planar_Pixels is
record
A : Character;
B : Character;
C : Character;
D : Character;
end record with
Size => 32,
Convention => C;
for Planar_Pixels use
record
A at 0 range 0 .. 7;
B at 0 range 8 .. 15;
C at 0 range 16 .. 23;
D at 0 range 24 .. 31;
end record;
pragma Static_Elaboration_Desired (Planar_Pixels);
type Non_Planar_Pixel_Padding is range 0 .. 7 with
Convention => C;
pragma Static_Elaboration_Desired (Non_Planar_Pixel_Padding);
type Non_Planar_Pixels is
record
Bytes_Per_Pixel : Bytes_Per_Pixels;
Bits_Per_Pixel : Bits_Per_Pixels;
Layout : Packed_Component_Layout;
Pixel_Order : Pixel_Orders;
Pixel_Type : Pixel_Types;
Flag : Boolean;
Padding : Non_Planar_Pixel_Padding;
end record with
Size => 32,
Convention => C;
for Non_Planar_Pixels use
record
Bytes_Per_Pixel at 0 range 0 .. 7;
Bits_Per_Pixel at 0 range 8 .. 15;
Layout at 0 range 16 .. 19;
Pixel_Order at 0 range 20 .. 23;
Pixel_Type at 0 range 24 .. 27;
Flag at 0 range 28 .. 28;
Padding at 0 range 29 .. 31;
end record;
pragma Static_Elaboration_Desired (Non_Planar_Pixels);
type Pixel_Format_Names (Planar : Boolean := False) is
record
case Planar is
when True =>
Planar_Format : Planar_Pixels;
when False =>
Non_Planar_Format : Non_Planar_Pixels;
end case;
end record with
Unchecked_Union => True,
Size => 32,
Convention => C;
pragma Static_Elaboration_Desired (Pixel_Format_Names);
Pixel_Format_Unknown : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => True,
Planar_Format => Planar_Pixels'
(others => Ada.Characters.Latin_1.NUL));
pragma Static_Elaboration_Desired (Pixel_Format_Unknown);
Pixel_Format_Index_1_LSB : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Index_1,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Index_1,
Indexed_Order => Little_Endian,
Indexed_Pad => Index_Order_Padding'First),
Layout => None,
Bits_Per_Pixel => 1,
Bytes_Per_Pixel => 0));
pragma Static_Elaboration_Desired (Pixel_Format_Index_1_LSB);
Pixel_Format_Index_1_MSB : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Index_1,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Index_1,
Indexed_Order => Big_Endian,
Indexed_Pad => Index_Order_Padding'First),
Layout => None,
Bits_Per_Pixel => 1,
Bytes_Per_Pixel => 0));
pragma Static_Elaboration_Desired (Pixel_Format_Index_1_MSB);
Pixel_Format_Index_4_LSB : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Index_4,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Index_4,
Indexed_Order => Little_Endian,
Indexed_Pad => Index_Order_Padding'First),
Layout => None,
Bits_Per_Pixel => 4,
Bytes_Per_Pixel => 0));
pragma Static_Elaboration_Desired (Pixel_Format_Index_4_LSB);
Pixel_Format_Index_4_MSB : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Index_4,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Index_4,
Indexed_Order => Big_Endian,
Indexed_Pad => Index_Order_Padding'First),
Layout => None,
Bits_Per_Pixel => 4,
Bytes_Per_Pixel => 0));
pragma Static_Elaboration_Desired (Pixel_Format_Index_4_MSB);
Pixel_Format_Index_8 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Index_8,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Index_8,
Indexed_Order => None,
Indexed_Pad => Index_Order_Padding'First),
Layout => None,
Bits_Per_Pixel => 8,
Bytes_Per_Pixel => 1));
pragma Static_Elaboration_Desired (Pixel_Format_Index_8);
Pixel_Format_RGB_332 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_8,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_8,
Packed_Order => XRGB),
Layout => Bits_332,
Bits_Per_Pixel => 8,
Bytes_Per_Pixel => 1));
pragma Static_Elaboration_Desired (Pixel_Format_RGB_332);
Pixel_Format_RGB_444 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => XRGB),
Layout => Bits_4444,
Bits_Per_Pixel => 12,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_RGB_444);
Pixel_Format_RGB_555 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => XRGB),
Layout => Bits_1555,
Bits_Per_Pixel => 15,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_RGB_555);
Pixel_Format_BGR_555 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => XBGR),
Layout => Bits_1555,
Bits_Per_Pixel => 15,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_BGR_555);
Pixel_Format_ARGB_4444 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => ARGB),
Layout => Bits_4444,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_ARGB_4444);
Pixel_Format_RGBA_4444 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => RGBA),
Layout => Bits_4444,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_RGBA_4444);
Pixel_Format_ABGR_4444 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => ABGR),
Layout => Bits_4444,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_ABGR_4444);
Pixel_Format_BGRA_4444 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => BGRA),
Layout => Bits_4444,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_BGRA_4444);
Pixel_Format_ARGB_1555 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => ARGB),
Layout => Bits_1555,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_ARGB_1555);
Pixel_Format_RGBA_5551 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => RGBA),
Layout => Bits_5551,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_RGBA_5551);
Pixel_Format_ABGR_1555 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => ABGR),
Layout => Bits_1555,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_ABGR_1555);
Pixel_Format_BGRA_5551 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => BGRA),
Layout => Bits_5551,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_BGRA_5551);
Pixel_Format_RGB_565 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => XRGB),
Layout => Bits_565,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_RGB_565);
Pixel_Format_BGR_565 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_16,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_16,
Packed_Order => XBGR),
Layout => Bits_565,
Bits_Per_Pixel => 16,
Bytes_Per_Pixel => 2));
pragma Static_Elaboration_Desired (Pixel_Format_BGR_565);
Pixel_Format_RGB_24 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Array_U8,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Array_U8,
Array_Order => RGB),
Layout => None,
Bits_Per_Pixel => 24,
Bytes_Per_Pixel => 3));
pragma Static_Elaboration_Desired (Pixel_Format_RGB_24);
Pixel_Format_BGR_24 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Array_U8,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Array_U8,
Array_Order => BGR),
Layout => None,
Bits_Per_Pixel => 24,
Bytes_Per_Pixel => 3));
pragma Static_Elaboration_Desired (Pixel_Format_BGR_24);
Pixel_Format_RGB_888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => XRGB),
Layout => Bits_8888,
Bits_Per_Pixel => 24,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_RGB_888);
Pixel_Format_RGBX_8888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => RGBX),
Layout => Bits_8888,
Bits_Per_Pixel => 24,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_RGBX_8888);
Pixel_Format_BGR_888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => XBGR),
Layout => Bits_8888,
Bits_Per_Pixel => 24,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_BGR_888);
Pixel_Format_BGRX_8888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => BGRX),
Layout => Bits_8888,
Bits_Per_Pixel => 24,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_BGRX_8888);
Pixel_Format_ARGB_8888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => ARGB),
Layout => Bits_8888,
Bits_Per_Pixel => 32,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_ARGB_8888);
Pixel_Format_RGBA_8888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => RGBA),
Layout => Bits_8888,
Bits_Per_Pixel => 32,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_RGBA_8888);
Pixel_Format_ABGR_8888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => ABGR),
Layout => Bits_8888,
Bits_Per_Pixel => 32,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_ABGR_8888);
Pixel_Format_BGRA_8888 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => BGRA),
Layout => Bits_8888,
Bits_Per_Pixel => 32,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_BGRA_8888);
Pixel_Format_ARGB_2101010 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => False,
Non_Planar_Format => Non_Planar_Pixels'
(Padding =>
Non_Planar_Pixel_Padding'First,
Flag => True,
Pixel_Type => Packed_32,
Pixel_Order => Pixel_Orders'
(Pixel_Type => Packed_32,
Packed_Order => ARGB),
Layout => Bits_2101010,
Bits_Per_Pixel => 32,
Bytes_Per_Pixel => 4));
pragma Static_Elaboration_Desired (Pixel_Format_ARGB_2101010);
Pixel_Format_YV_12 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => True,
Planar_Format => Planar_Pixels'
(A => 'Y',
B => 'V',
C => '1',
D => '2'));
pragma Static_Elaboration_Desired (Pixel_Format_YV_12);
Pixel_Format_IYUV : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => True,
Planar_Format => Planar_Pixels'
(A => 'I',
B => 'Y',
C => 'U',
D => 'V'));
pragma Static_Elaboration_Desired (Pixel_Format_IYUV);
Pixel_Format_YUY_2 : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => True,
Planar_Format => Planar_Pixels'
(A => 'Y',
B => 'U',
C => 'Y',
D => '2'));
pragma Static_Elaboration_Desired (Pixel_Format_YUY_2);
Pixel_Format_UYVY : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => True,
Planar_Format => Planar_Pixels'
(A => 'U',
B => 'Y',
C => 'V',
D => 'Y'));
pragma Static_Elaboration_Desired (Pixel_Format_UYVY);
Pixel_Format_YVYU : constant Pixel_Format_Names :=
Pixel_Format_Names'(Planar => True,
Planar_Format => Planar_Pixels'
(A => 'Y',
B => 'V',
C => 'Y',
D => 'U'));
pragma Static_Elaboration_Desired (Pixel_Format_YVYU);
type Colour_Mask is mod 2 ** 32 with
Convention => C;
type Private_Pixel_Format is private;
type Pixel_Format is
record
Format : Pixel_Format_Names;
Palette : Palettes.Palette_Access;
Bits : Bits_Per_Pixels;
Bytes : Bytes_Per_Pixels;
Padding : Interfaces.Unsigned_16;
Red_Mask : Colour_Mask;
Green_Mask : Colour_Mask;
Blue_Mask : Colour_Mask;
Alpha_Mask : Colour_Mask;
-- This is mainly padding to make sure the record size matches
what is expected from C.
Private_Part : Private_Pixel_Format;
end record with
Convention => C;
-- TODO: Possibly change this to a controlled type.
type Pixel_Format_Access is access all Pixel_Format with
Convention => C;
function Create (Format : in Pixel_Format_Names) return
Pixel_Format_Access with
Import => True,
Convention => C,
External_Name => "SDL_AllocFormat";
procedure Free (Format : in Pixel_Format_Access) with
Import => True,
Convention => C,
External_Name => "SDL_FreeFormat";
function Image (Format : in Pixel_Format_Names) return String;
-- Import => True,
-- Convention => C,
-- External_Name => "SDL_GetPixelFormatName";
procedure To_Components
(Pixel : in Interfaces.Unsigned_32;
Format : in Pixel_Format_Access;
Red : out Palettes.Colour_Component;
Green : out Palettes.Colour_Component;
Blue : out Palettes.Colour_Component) with
Import => True,
Convention => C,
External_Name => "SDL_GetRGB";
procedure To_Components
(Pixel : in Interfaces.Unsigned_32;
Format : in Pixel_Format_Access;
Red : out Palettes.Colour_Component;
Green : out Palettes.Colour_Component;
Blue : out Palettes.Colour_Component;
Alpha : out Palettes.Colour_Component) with
Import => True,
Convention => C,
External_Name => "SDL_GetRGBA";
function To_Pixel
(Format : in Pixel_Format_Access;
Red : in Palettes.Colour_Component;
Green : in Palettes.Colour_Component;
Blue : in Palettes.Colour_Component) return
Interfaces.Unsigned_32 with
Import => True,
Convention => C,
External_Name => "SDL_MapRGB";
function To_Pixel
(Format : in Pixel_Format_Access;
Red : in Palettes.Colour_Component;
Green : in Palettes.Colour_Component;
Blue : in Palettes.Colour_Component;
Alpha : in Palettes.Colour_Component) return
Interfaces.Unsigned_32 with
Import => True,
Convention => C,
External_Name => "SDL_MapRGBA";
function To_Colour (Pixel : in Interfaces.Unsigned_32; Format : in
Pixel_Format_Access) return Palettes.Colour with
Inline => True;
function To_Pixel (Colour : in Palettes.Colour; Format : in
Pixel_Format_Access) return Interfaces.Unsigned_32 with
Inline => True;
function To_Name
(Bits : in Bits_Per_Pixels;
Red_Mask : in Colour_Mask;
Green_Mask : in Colour_Mask;
Blue_Mask : in Colour_Mask;
Alpha_Mask : in Colour_Mask) return Pixel_Format_Names with
Import => True,
Convention => C,
External_Name => "SDL_MasksToPixelFormatEnum";
function To_Masks
(Format : in Pixel_Format_Names;
Bits : out Bits_Per_Pixels;
Red_Mask : out Colour_Mask;
Green_Mask : out Colour_Mask;
Blue_Mask : out Colour_Mask;
Alpha_Mask : out Colour_Mask) return Boolean with
Inline => True;
-- Gamma
type Gamma_Value is mod 2 ** 16 with
Convention => C;
type Gamma_Ramp is array (Integer range 1 .. 256) of Gamma_Value with
Convention => C;
procedure Calculate (Gamma : in Float; Ramp : out Gamma_Ramp) with
Import => True,
Convention => C,
External_Name => "SDL_CalculateGammaRamp";
private
-- The following fields are defined as "internal use" in the SDL docs.
type Private_Pixel_Format is
record
Rred_Loss : Interfaces.Unsigned_8;
Green_Loss : Interfaces.Unsigned_8;
Blue_Loss : Interfaces.Unsigned_8;
Alpha_Loss : Interfaces.Unsigned_8;
Red_Shift : Interfaces.Unsigned_8;
Green_Shift : Interfaces.Unsigned_8;
Blue_Shift : Interfaces.Unsigned_8;
Alpha_Shift : Interfaces.Unsigned_8;
Ref_Count : C.int;
Next : Pixel_Format_Access;
end record with
Convention => C;
end SDL.Video.Pixel_Formats;
^ permalink raw reply [relevance 3%]
* Re: Coding access to a C's pointer - pointer
2020-06-06 17:34 2% ` Bob Goddard
@ 2020-06-06 18:48 0% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2020-06-06 18:48 UTC (permalink / raw)
On 06/06/2020 19:34, Bob Goddard wrote:
> On Saturday, 6 June 2020 18:01:41 UTC+1, Dmitry A. Kazakov wrote:
> [...]
>>> Would I need to drop into C and handle it there?
>>
>> P.S. Why do not you implement SNMP instead of using alien library? SNMP
>> is not rocket science.
>
> I think everyone feels my pain, and at the moment, life is too short to re-implement snmp. Net-snmp code can only be describe as how not to write an application and how not to write documentation.
And that is the reason to believe the rest of it is fine?
> Anyways... I had already done the following and created the pdu record:
> function SNMP_Synch_Response (Session : access snmp_Session; PDU : access snmp_pdu; Response : System.Address) return Interfaces.C.int;
> pragma Import (C, SNMP_Synch_Response, "snmp_synch_response");
No need in access, C records are always passed by reference. No need in
Address, use access to a named access:
Session : snmp_Session;
PDU : snmp_pdu;
Response : access snmp_pdu_Ptr
or (in Ada 2012 with function out parameters support)
Response : out snmp_pdu_Ptr
The rules of thumb when writing C bindings:
Type Mode Ada C
non-scalar any T *T
scalar in T T
scalar out T *T
scalar in out T *T
So, if you want **T, define a named access type with C convention:
type T_Ptr is access all T;
pragma Convention (C, T_Ptr);
This is a scalar type, so **T would be
Response : out T_Ptr
or
Response : access T_Ptr
or you can declare a yet another access type:
type T_Ptr_Ptr is access all T_Ptr;
pragma Convention (C, T_Ptr_Ptr);
and then use
Response : T_Ptr_Ptr
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Coding access to a C's pointer - pointer
@ 2020-06-06 17:34 2% ` Bob Goddard
2020-06-06 18:48 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Bob Goddard @ 2020-06-06 17:34 UTC (permalink / raw)
On Saturday, 6 June 2020 18:01:41 UTC+1, Dmitry A. Kazakov wrote:
[...]
> > Would I need to drop into C and handle it there?
>
> P.S. Why do not you implement SNMP instead of using alien library? SNMP
> is not rocket science.
I think everyone feels my pain, and at the moment, life is too short to re-implement snmp. Net-snmp code can only be describe as how not to write an application and how not to write documentation.
Anyways... I had already done the following and created the pdu record:
function SNMP_Synch_Response (Session : access snmp_Session; PDU : access snmp_pdu; Response : System.Address) return Interfaces.C.int;
pragma Import (C, SNMP_Synch_Response, "snmp_synch_response");
I'll still look...
^ permalink raw reply [relevance 2%]
* Ann: HAC v.0.07, LEA 0.71
@ 2020-06-05 20:34 2% gautier_niouzes
0 siblings, 0 replies; 200+ results
From: gautier_niouzes @ 2020-06-05 20:34 UTC (permalink / raw)
In a nutshell:
- HAC (the HAC Ada Compiler) has now an exception system, with messages and trace-backs.
Details here:
https://gautiersblog.blogspot.com/2020/06/hac-v007-exceptions-and-trace-backs.html
- LEA (a Lightweight Editor for Ada) leverages trace-backs in its navigation system.
Details here:
https://gautiersblog.blogspot.com/2020/06/lea-071-with-exception-trace-back.html
HAC is pure Ada (*).
LEA is Windows only (although the LEA_Common part is pure Ada), but runs seamlessly on the Wine emulator for instance.
Enjoy!
__
(*) ... except for the following bit which should be easy to adapt if you build HAC with another compiler than GNAT:
-- Here is the non-Ada-standard stuff in HAC_Pack.
package Non_Standard is
function Sys (Arg : Interfaces.C.char_array) return Integer;
pragma Import(C, Sys, "system");
Directory_Separator : constant Character;
pragma Import (C, Directory_Separator, "__gnat_dir_separator");
end Non_Standard;
^ permalink raw reply [relevance 2%]
* Re: Any good package for mathematical function in Ada?
@ 2020-06-01 10:19 3% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2020-06-01 10:19 UTC (permalink / raw)
On 01/06/2020 10:24, reinert wrote:
> Anybody having a simple (complete - runable) code example using GSL from Ada?
Assuming Windows.
Install MSYS2 if you did not already. [64-bit, GNAT GPL is not available
for 32-bit anymore.]
Install GSL mingw-w64-x86_64-gsl under MSYS.
Now, assuming that MSYS2 is under C:\MSYS64\MinGW, here you go:
---gsl.gpr--------------
project GSL is
for Main use ("test.adb");
package Linker is
for Default_Switches ("ada")
use ("-L/c/msys64/mingw/lib", "-lgsl");
end Linker;
end GSL;
---gsl.ads-------------
with Interfaces.C; use Interfaces.C;
package GSL is
function Bessel_J0 (X : double) return double;
private
pragma Import (C, Bessel_J0, "gsl_sf_bessel_J0");
end GSL;
---test.adb------------>
with Ada.Text_IO; use Ada.Text_IO;
with GSL; use GSL;
with Interfaces.C; use Interfaces.C;
procedure Test is
begin
Put_Line ("J0(1)=" & double'Image (Bessel_J0 (1.0)));
end Test;
-----------------------
The test produces:
J0(1)= 7.65197686557967E-01
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 3%]
* Re: How can one record component be local and another not?
2020-05-05 19:08 0% ` Niklas Holsti
@ 2020-05-06 19:31 2% ` hreba
0 siblings, 0 replies; 200+ results
From: hreba @ 2020-05-06 19:31 UTC (permalink / raw)
On 5/5/20 9:08 PM, Niklas Holsti wrote:
>
> I don't understand -- System.Address is not an access type; why do you
> need to use an access type to produce this parameter? Do you need a
> pointer to the "params" component?
>
> Perhaps you can show a bit more of the actual code that has the problem?
>
Ok, I'll try to make it comprehensible without throwing a lot of code at
you.
I am writing a thick binding to the GSL library odeiv2 for numerically
integrating ODEs (ordinary differential equations). I already have the
thin binding gsl_odeiv2_h.ads. For initialization, I have to call the
following subprogram of the thin binding:
function gsl_odeiv2_driver_alloc_y_new
(sys : access constant gsl_odeiv2_system;
T : access constant gsl_odeiv2_step_type;
hstart : double;
epsabs : double;
epsrel : double) return access gsl_odeiv2_driver;
pragma Import (C, gsl_odeiv2_driver_alloc_y_new,
"gsl_odeiv2_driver_alloc_y_new");
Parameter sys defines the ODE; its type is
type gsl_odeiv2_system is record
c_function : access function
(arg1 : double;
arg2 : access double;
arg3 : access double;
arg4 : System.Address) return int;
jacobian : access function
(arg1 : double;
arg2 : access double;
arg3 : access double;
arg4 : access double;
arg5 : System.Address) return int;
dimension : aliased size_t;
params : System.Address;
end record;
pragma Convention (C_Pass_By_Copy, gsl_odeiv2_system);
Later, during integration, c_function() and jacobian() will be called
with parameters of type System.Address (arg4 and arg5 resp.). These
parameters must be passed as params inside sys to
gsl_odeiv2_driver_alloc_y_new().
Now to my own code (most of the thin binding was created automatically
with g++ -c -fdump-ada-spec-slim). Dglsys_P corresponds to c_function in
the thin binding, The package is essentially
generic
dim: Positive;
type Float is digits<>;
package odeiv2 is
err_noInit, -- Init_Solve() has not been called
err_Precision, -- precision of C.double used in GSL not sufficient
err_Method, -- integration method not implemented
err_SolveAgain: -- Solve_Again() call without former Solve()
Exception;
type Float_Array is array (1..dim) of Float;
type Float_Matrix is array (1..dim, 1..dim) of Float;
type Par_Array is array (Positive range <>) of Float;
type Method is (RK8PD);
type Solver is limited private;
type Dglsys_P is not null access procedure
(t: Float; -- independent variable
y: Float_Array; -- dependent variables at t
dydt: out Float_Array; -- 1. ordinary derivatives at t
params: Par_Array -- any parameters
);
-- omitted: type Jacobi_P is access procedure...
procedure Init_Solve
-- Init. a dglsys, must be called once before calling
-- (once or repeatedly) Solve() or Solve_Again().
-- The resulting sol must be an access type because of the internal
-- interface to the GSL library.
(Dglsys: Dglsys_P; -- the system of diff. equ.
Jacobi: Jacobi_P; -- the jacobi calc., if avail.
pars: access constant Par_Array; -- the parameters
met: Method; -- the solve method
h_start: Float; -- initial step size
epsabs: Float; -- absolute error tolerance
epsrel: Float; -- relative error tolerance
sol: aliased in out Solver
);
private
package C renames Interfaces.C;
package Ode renames gsl_odeiv2_h;
type C_Array is array (Integer range <>) of aliased C.double;
pragma Convention (C, C_Array);
type Parameters is record
dglpars: access constant Par_Array; -- pars of dglsys
Dglsys: Dglsys_P; -- dglsys calc.
Jacobi: Jacobi_P; -- Jacobi calc.
end record;
pragma Convention (C, Parameters);
type Parameters_Ptr is access all Parameters;
package Parameters_Conv is new
System.Address_To_Access_Conversions (Parameters);
type Solver is limited record
initialized: Boolean:= false; -- Init_Solve() has been called
firstcall_done: Boolean; -- first call done
store_y: Boolean; -- copy y to ya
ya: C_Array (1..dim); -- values of last Solve call
sys: aliased Ode.gsl_odeiv2_system;
driver: access Ode.gsl_odeiv2_driver;
all_pars: aliased Parameters;
all_pp: Parameters_Conv.Object_Pointer;
end record;
end odeiv2;
In the package body I have to define the c_function above (thin binding
spec.), which will call the corresponding function of type Dglsys_P
(thick binding), and it finds this in the parameters. then I define the
initialization subprogram.
package body odeiv2 is
package C_Arrays is new
Interfaces.C.Pointers (Integer, C.double, C_Array, 0.0);
function func (t: C.double; y,f: access C.double; params:
System.Address) return C.int;
pragma Convention (C, func);
function func (t: C.double; y,f: access C.double; params:
System.Address) return C.int
-- GSL version of Dglsys
is
use type System.Address;
all_pars: Parameters_Conv.Object_Pointer;
yf, dydt: Float_Array;
y0: C_Arrays.Pointer:= C_Arrays.Pointer(y);
f0: C_Arrays.Pointer:= C_Arrays.Pointer(f);
begin
all_pars:= Parameters_Conv.To_Pointer (params);
for i in 1..dim loop
yf(i):= Float(y0.all);
C_Arrays.Increment (y0);
end loop;
all_pars.Dglsys (Float(t), yf, dydt, all_pars.dglpars.all);
for i in 1..dim loop
f0.all:= C.double(dydt(i));
C_Arrays.Increment (f0);
end loop;
return gsl_errno_h.GSL_SUCCESS;
end func;
procedure Init_Solve
(Dglsys: Dglsys_P; -- the system of diff.equ.
Jacobi: Jacobi_P; -- jacobi calc., if available
pars: access constant Par_Array; -- the parameters
met: Method; -- the solve method
h_start: Float; -- initial step size
epsabs: Float; -- absolute error tolerance
epsrel: Float; -- relative error tolerance
sol: aliased in out Solver
)
is
gsl_met: access constant Ode.gsl_odeiv2_step_type;
begin
-- set all_pars
-- sol: flags for calling logic
sol.Initialized:= true;
sol.firstcall_done:= false;
sol.store_y:= true;
sol.all_pars.dglpars:= pars;
sol.all_pars.Dglsys:= Dglsys;
sol.all_pars.Jacobi:= Jacobi;
-- transform integration method to GSL format
case met is
when RK8PD => gsl_met:= Ode.gsl_odeiv2_step_rk8pd;
when others =>
raise err_Method
with "forgot to implement integration method";
end case;
-- build sys and driver
sol.all_pp:= sol.all_pars'Unchecked_Access;
sol.sys:=
(func'Access, jac'Access, C.size_t(dim),
Parameters_Conv.To_Address (sol.all_pp));
sol.driver:= Ode.gsl_odeiv2_driver_alloc_y_new
(sol.sys'Access, gsl_met,
C.double(h_start), C.double(epsabs), C.double(epsrel));
end Init_Solve;
-- %< -------------
end odeiv2;
The above version compiles. At first I didn't have the Solver component
all_pp, but passed app_pars'Address to the call of
gsl_odeiv2_driver_alloc_y_new at the end of Init_Solve. It too compiled.
But whatever I try, I don't get rid of the runtime error
raised CONSTRAINT_ERROR : odeiv2.ads:92:4 access check failed
It accuses the line
type Parameters is record
--
Frank Hrebabetzky, Kronach +49 / 9261 / 950 0565
^ permalink raw reply [relevance 2%]
* Re: How can one record component be local and another not?
2020-05-05 17:17 0% ` hreba
2020-05-05 19:08 0% ` Niklas Holsti
2020-05-05 19:19 0% ` Jere
@ 2020-05-06 6:42 0% ` Mark Lorenzen
2 siblings, 0 replies; 200+ results
From: Mark Lorenzen @ 2020-05-06 6:42 UTC (permalink / raw)
On Tuesday, May 5, 2020 at 7:17:42 PM UTC+2, hreba wrote:
> On 5/5/20 5:45 PM, Jeffrey R. Carter wrote:
> > On 5/5/20 1:04 PM, hreba wrote:
> >>
> >> (The reason for the above construction is the need to pass a pointer
> >> to a C library function.)
> >
> > Most likely you do not need to pass a pointer to your C function. For
> > example, given the C function
> >
> > void f (int* i);
> >
> > You can do
> >
> > procedure F (I : in out Interfaces.C.int) with Import, Convention => C,
> > ...;
> >
> > and the compiler will call the C function correctly.
> >
>
> It is more complicated, unfortunately. I got
>
> type gsl_odeiv2_system is record
> c_function : access function
> (arg1 : double;
> arg2 : access double;
> arg3 : access double;
> arg4 : System.Address) return int; --
> /usr/include/gsl/gsl_odeiv2.h:58
> jacobian : access function
> (arg1 : double;
> arg2 : access double;
> arg3 : access double;
> arg4 : access double;
> arg5 : System.Address) return int; --
> /usr/include/gsl/gsl_odeiv2.h:60
> dimension : aliased size_t; -- /usr/include/gsl/gsl_odeiv2.h:61
> params : System.Address; -- /usr/include/gsl/gsl_odeiv2.h:62
> end record;
> pragma Convention (C_Pass_By_Copy, gsl_odeiv2_system); --
> /usr/include/gsl/gsl_odeiv2.h:64
>
> and I have to pass a variable
> sys: access gsl_odeiv2_system
> to the initialization function of that C library, and the
>
> params: System.Address;
>
> component in the record, which internally is then passed to c_function()
> and jacobian(), posed the problem.
>
> --
> Frank Hrebabetzky, Kronach +49 / 9261 / 950 0565
You need to step back and try to get an overview of what you are trying to achieve - not blindly copy some low-level C construct. Figure out why those C functions take parameters of an access type. Are they in/out or out parameters? Then define the Ada equivalent of those function access types e.g:
type C_Function_Access is access
function (Arg1 : double; Arg2 : in out double; Arg3 : in out double; Arg4 : in System.Address) return int with Convention => C;
Note that in Ada 2012 functions are unfortunately allowed to have in/out-mode and out-mode parameters. In previous revisions, functions were only allowed to have in-mode parameters.
As explained by Jeffrey R. Carter above, Convention => C guarantees that in/out-mode and out-mode parameters are passed by value.
Your record type then becomes something like:
type GSL_Odeiv2_System is record
C_Function : C_Function_Access;
...
end record
with Convention C_Pass_By_Copy;
You are trying to create an Ada interface to C, but you are dragging the low-level nature of C into your Ada. When you encounter access types and addresses in Ada, then step back and try to get an overview of what needs to be achieved - not how it is done in C and thus mechanically copied in the auto-generated Ada code.
Regards,
Mark L
^ permalink raw reply [relevance 0%]
* Re: How can one record component be local and another not?
2020-05-05 17:17 0% ` hreba
2020-05-05 19:08 0% ` Niklas Holsti
@ 2020-05-05 19:19 0% ` Jere
2020-05-06 6:42 0% ` Mark Lorenzen
2 siblings, 0 replies; 200+ results
From: Jere @ 2020-05-05 19:19 UTC (permalink / raw)
On Tuesday, May 5, 2020 at 1:17:42 PM UTC-4, hreba wrote:
> On 5/5/20 5:45 PM, Jeffrey R. Carter wrote:
> > On 5/5/20 1:04 PM, hreba wrote:
> >>
> >> (The reason for the above construction is the need to pass a pointer
> >> to a C library function.)
> >
> > Most likely you do not need to pass a pointer to your C function. For
> > example, given the C function
> >
> > void f (int* i);
> >
> > You can do
> >
> > procedure F (I : in out Interfaces.C.int) with Import, Convention => C,
> > ...;
> >
> > and the compiler will call the C function correctly.
> >
>
> It is more complicated, unfortunately. I got
>
> type gsl_odeiv2_system is record
> c_function : access function
> (arg1 : double;
> arg2 : access double;
> arg3 : access double;
> arg4 : System.Address) return int; --
> /usr/include/gsl/gsl_odeiv2.h:58
> jacobian : access function
> (arg1 : double;
> arg2 : access double;
> arg3 : access double;
> arg4 : access double;
> arg5 : System.Address) return int; --
> /usr/include/gsl/gsl_odeiv2.h:60
> dimension : aliased size_t; -- /usr/include/gsl/gsl_odeiv2.h:61
> params : System.Address; -- /usr/include/gsl/gsl_odeiv2.h:62
> end record;
> pragma Convention (C_Pass_By_Copy, gsl_odeiv2_system); --
> /usr/include/gsl/gsl_odeiv2.h:64
>
> and I have to pass a variable
> sys: access gsl_odeiv2_system
> to the initialization function of that C library, and the
>
> params: System.Address;
>
> component in the record, which internally is then passed to c_function()
> and jacobian(), posed the problem.
>
> --
> Frank Hrebabetzky, Kronach +49 / 9261 / 950 0565
This isn't so much a question for you directly...maybe more for
those more experienced with the RM, but I was curious about the
implications of having an "aliased" parameter inside a record with
a C convention specified. For some reason, I thought that the
aliased keyword implied a certain alignment in Ada (not necessarily
in C) and didn't know if specifying the convention undid that
alignment or if there is a risk of the record not always being
the same layout/alignment as the expected C struct for the aliased
parameter.
^ permalink raw reply [relevance 0%]
* Re: How can one record component be local and another not?
2020-05-05 17:17 0% ` hreba
@ 2020-05-05 19:08 0% ` Niklas Holsti
2020-05-06 19:31 2% ` hreba
2020-05-05 19:19 0% ` Jere
2020-05-06 6:42 0% ` Mark Lorenzen
2 siblings, 1 reply; 200+ results
From: Niklas Holsti @ 2020-05-05 19:08 UTC (permalink / raw)
On 2020-05-05 20:17, hreba wrote:
> On 5/5/20 5:45 PM, Jeffrey R. Carter wrote:
>> On 5/5/20 1:04 PM, hreba wrote:
>>>
>>> (The reason for the above construction is the need to pass a pointer
>>> to a C library function.)
>>
>> Most likely you do not need to pass a pointer to your C function. For
>> example, given the C function
>>
>> void f (int* i);
>>
>> You can do
>>
>> procedure F (I : in out Interfaces.C.int) with Import, Convention =>
>> C, ...;
>>
>> and the compiler will call the C function correctly.
>>
>
> It is more complicated, unfortunately. I got
>
> type gsl_odeiv2_system is record
> c_function : access function
> (arg1 : double;
> arg2 : access double;
> arg3 : access double;
> arg4 : System.Address) return int; --
> /usr/include/gsl/gsl_odeiv2.h:58
> jacobian : access function
> (arg1 : double;
> arg2 : access double;
> arg3 : access double;
> arg4 : access double;
> arg5 : System.Address) return int; --
> /usr/include/gsl/gsl_odeiv2.h:60
> dimension : aliased size_t; -- /usr/include/gsl/gsl_odeiv2.h:61
> params : System.Address; -- /usr/include/gsl/gsl_odeiv2.h:62
> end record;
> pragma Convention (C_Pass_By_Copy, gsl_odeiv2_system); --
> /usr/include/gsl/gsl_odeiv2.h:64
>
> and I have to pass a variable
> sys: access gsl_odeiv2_system
> to the initialization function of that C library, and the
>
> params: System.Address;
>
> component in the record, which internally is then passed to c_function()
> and jacobian(), posed the problem.
I don't understand -- System.Address is not an access type; why do you
need to use an access type to produce this parameter? Do you need a
pointer to the "params" component?
Perhaps you can show a bit more of the actual code that has the problem?
--
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
. @ .
^ permalink raw reply [relevance 0%]
* Re: How can one record component be local and another not?
2020-05-05 15:45 2% ` Jeffrey R. Carter
@ 2020-05-05 17:17 0% ` hreba
2020-05-05 19:08 0% ` Niklas Holsti
` (2 more replies)
0 siblings, 3 replies; 200+ results
From: hreba @ 2020-05-05 17:17 UTC (permalink / raw)
On 5/5/20 5:45 PM, Jeffrey R. Carter wrote:
> On 5/5/20 1:04 PM, hreba wrote:
>>
>> (The reason for the above construction is the need to pass a pointer
>> to a C library function.)
>
> Most likely you do not need to pass a pointer to your C function. For
> example, given the C function
>
> void f (int* i);
>
> You can do
>
> procedure F (I : in out Interfaces.C.int) with Import, Convention => C,
> ...;
>
> and the compiler will call the C function correctly.
>
It is more complicated, unfortunately. I got
type gsl_odeiv2_system is record
c_function : access function
(arg1 : double;
arg2 : access double;
arg3 : access double;
arg4 : System.Address) return int; --
/usr/include/gsl/gsl_odeiv2.h:58
jacobian : access function
(arg1 : double;
arg2 : access double;
arg3 : access double;
arg4 : access double;
arg5 : System.Address) return int; --
/usr/include/gsl/gsl_odeiv2.h:60
dimension : aliased size_t; -- /usr/include/gsl/gsl_odeiv2.h:61
params : System.Address; -- /usr/include/gsl/gsl_odeiv2.h:62
end record;
pragma Convention (C_Pass_By_Copy, gsl_odeiv2_system); --
/usr/include/gsl/gsl_odeiv2.h:64
and I have to pass a variable
sys: access gsl_odeiv2_system
to the initialization function of that C library, and the
params: System.Address;
component in the record, which internally is then passed to c_function()
and jacobian(), posed the problem.
--
Frank Hrebabetzky, Kronach +49 / 9261 / 950 0565
^ permalink raw reply [relevance 0%]
* Re: How can one record component be local and another not?
@ 2020-05-05 15:45 2% ` Jeffrey R. Carter
2020-05-05 17:17 0% ` hreba
0 siblings, 1 reply; 200+ results
From: Jeffrey R. Carter @ 2020-05-05 15:45 UTC (permalink / raw)
On 5/5/20 1:04 PM, hreba wrote:
>
> (The reason for the above construction is the need to pass a pointer to a C
> library function.)
Most likely you do not need to pass a pointer to your C function. For example,
given the C function
void f (int* i);
You can do
procedure F (I : in out Interfaces.C.int) with Import, Convention => C, ...;
and the compiler will call the C function correctly.
--
Jeff Carter
"[T]he Musgroves had had the ill fortune
of a very troublesome, hopeless son, and
the good fortune to lose him before he
reached his twentieth year ..."
Persuasion
154
^ permalink raw reply [relevance 2%]
* Re: Getting the 3 letter time zone abbreviation
2020-04-30 21:11 3% ` Dmitry A. Kazakov
@ 2020-05-02 12:46 4% ` Bob Goddard
0 siblings, 0 replies; 200+ results
From: Bob Goddard @ 2020-05-02 12:46 UTC (permalink / raw)
Here goes...
On Linux and the various BSD's, the tm structure has been extended to include:
long int tm_gmtoff; /* Seconds east of UTC. */
const char *tm_zone; /* Timezone abbreviation. */
When you make a call to localtime_r, these are filled in with the correct into, at least on Linux.
The other big iron Unix's do not have this extension, and neither does Windows.
Windows also does not have localtime_r, instead it has localtime_s plus its 32 & 64 versions.
On the other Unix's & Windows, a call made to tzset (_tzset on Windows), which fills in tzname (_tzname under Windows). This should contain 2 record for non-saving & saving timezone name. and the correct entry can be garnered by way of tm_isdst.
To set another timezone, external var TZ should be set.
And don't test an example time of 1234 seconds past epoch for the UK expecting GMT. The UK was in fact in daylight saving time and double time (I think) for a few years. In my defence, I was only about 7yo and totally forgot about it.
There, clear as mud.
This works on Linux, the tm_zone is filled in by the call automatically...
with System;
with Interfaces;
with Interfaces.C;
with Interfaces.C.Strings;
package Unix is
type tm is record
tm_sec : Interfaces.C.int;
tm_min : Interfaces.C.int;
tm_hour : Interfaces.C.int;
tm_day : Interfaces.C.int;
tm_mon : Interfaces.C.int;
tm_year : Interfaces.C.int;
tm_wday : Interfaces.C.int;
tm_yday : Interfaces.C.int;
tm_isdst : Interfaces.C.int;
tm_gmtoff : Interfaces.C.long;
tm_zone : Interfaces.C.Strings.chars_ptr;
end record;
pragma Convention (C_Pass_By_Copy, tm);
procedure localtime_r (T : System.Address; TM_Struct : System.Address);
pragma Import (C, localtime_r, "localtime_r");
end Unix;
^ permalink raw reply [relevance 4%]
* Re: Getting the 3 letter time zone abbreviation
@ 2020-04-30 21:11 3% ` Dmitry A. Kazakov
2020-05-02 12:46 4% ` Bob Goddard
0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2020-04-30 21:11 UTC (permalink / raw)
On 2020-04-30 20:59, Bob Goddard wrote:
> On Wednesday, 29 April 2020 20:53:11 UTC+1, Dmitry A. Kazakov wrote:
>> On 2020-04-29 21:20, Bob Goddard wrote:
>>
>>> Seems easier just to import strftime and call it requesting just "%Z". This is on Linux, but MS suggests it should also work on Windows.
>>
>> An interesting idea. Did you try it under Windows? (There is a
>> suspicious remark that it depends on the setlocale)
>
> 'Fraid not, I'm a Linux user. I just noticed that Windows does have it.
OK, I tested it. As expected it does not work. For example this one:
---------------------------
with Ada.Command_Line; use Ada.Command_Line;
with Interfaces.C; use Interfaces.C;
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;
with System;
procedure Strftime_Test is
type tm is record
tm_sec : int;
tm_min : int;
tm_hour : int;
tm_mday : int;
tm_mon : int;
tm_year : int;
tm_wday : int;
tm_yday : int;
tm_isdst : int;
end record;
pragma Convention (C, tm);
type tm_Ptr is access all tm;
pragma Convention (C, tm_Ptr);
type time_t is new Interfaces.Unsigned_64;
function localtime (timep : access time_t) return tm_Ptr;
pragma Import (C, localtime);
function time (destTime : System.Address := System.Null_Address)
return time_t;
pragma Import (C, time, "_time64");
function strftime
( strDest : char_array;
maxsize : size_t;
format : char_array;
timeptr : access tm
) return size_t;
pragma Import (C, strftime);
Result : size_t;
Buffer : char_array (1..200);
Now : aliased time_t := 0;
Local_Ptr : tm_Ptr;
begin
Now := time;
Put_Line ("Time=" & time_t'Image (Now));
Local_Ptr := localtime (Now'Access);
if Local_Ptr /= null then
declare
Local : tm renames localtime (Now'Access).all;
begin
Put_Line
( int'Image (Local.tm_year)
& " -"
& int'Image (Local.tm_mon)
& " -"
& int'Image (Local.tm_mday)
& " "
& int'Image (Local.tm_hour)
& " :"
& int'Image (Local.tm_min)
& " :"
& int'Image (Local.tm_sec)
);
Result := strftime
( Buffer,
Buffer'Length,
To_C ("%#Z"),
Local'Access
);
Put_Line ("Result=" & To_Ada (Buffer (1..Result), False));
end;
end if;
Set_Exit_Status (0);
exception
when Error : Status_Error | Data_Error =>
Put_Line (Exception_Message (Error));
Set_Exit_Status (1);
when Error : others =>
Put_Line ("Fault: " & Exception_Information (Error));
Set_Exit_Status (2);
end Strftime_Test;
----------------------------------
Gives the output on my Windows machine:
Result=W. Europe Daylight Time
instead of
CEST
Windows POSIX layer relies on Windows API. If the API does something
wrong, so would whatever POSIX function.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 3%]
* Re: Running a simple Python from Ada program
2020-04-03 19:19 3% ` Rego, P.
2020-04-03 20:06 0% ` Dmitry A. Kazakov
@ 2020-04-04 1:48 0% ` Dennis Lee Bieber
1 sibling, 0 replies; 200+ results
From: Dennis Lee Bieber @ 2020-04-04 1:48 UTC (permalink / raw)
On Fri, 3 Apr 2020 12:19:44 -0700 (PDT), "Rego, P." <pvrego@gmail.com>
declaimed the following:
>
>So I will try to simplify a bit the question. I want to do the equivalent of this
>
> #include <stdio.h>
> #include <stdlib.h>
> int main(){
> system("python testpy.py ddddd");
> return 0;
> }
>In this case it does not block the testpy.py printouts.
>
>But I am doing this
> with Interfaces.C; use Interfaces.C;
> procedure systest2 is
> function Sys (Arg : Char_Array) return Integer;
> pragma Import(C, Sys, "system");
> Ret_Val : Integer;
> begin
> Ret_Val := Sys(To_C("python testpy.py arg1 arg2"));
> end systest2;
>which blocks the testpy.py script until its end. This should not happen. So, please, how could I fix this?
system() block until the invoked command completes... That happens for
both C and via the Ada definition.
However, output via python print() might be getting buffered if the
spawned command does not see stdout as a console -- which might be a result
of not having the C I/O environment initialized...
Try adding the -u option to the invocation
https://docs.python.org/3/using/cmdline.html#miscellaneous-options
"""
-u
Force the stdout and stderr streams to be unbuffered. This option has
no effect on the stdin stream.
See also PYTHONUNBUFFERED.
Changed in version 3.7: The text layer of the stdout and stderr streams
now is unbuffered.
"""
EG: "python -u testpy.py arg1 arg2"
--
Wulfraed Dennis Lee Bieber AF6VN
wlfraed@ix.netcom.com http://wlfraed.microdiversity.freeddns.org/
^ permalink raw reply [relevance 0%]
* Re: Running a simple Python from Ada program
2020-04-03 19:19 3% ` Rego, P.
@ 2020-04-03 20:06 0% ` Dmitry A. Kazakov
2020-04-04 1:48 0% ` Dennis Lee Bieber
1 sibling, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2020-04-03 20:06 UTC (permalink / raw)
On 2020-04-03 21:19, Rego, P. wrote:
>>> Do not do that. There exist Python C API, which you should use:
>>> https://docs.python.org/3/c-api/index.html
>> You mean that the problem is with the Python "print" ?
>
> I tested with a very simple C code. If the Python print is blocked, it should be blocked also from a C call, I presume (ok someone will contest, anyway). Any case, from the C call, it does not block.
>
> So I will try to simplify a bit the question. I want to do the equivalent of this
>
> #include <stdio.h>
> #include <stdlib.h>
> int main(){
> system("python testpy.py ddddd");
> return 0;
> }
> In this case it does not block the testpy.py printouts.
>
> But I am doing this
> with Interfaces.C; use Interfaces.C;
> procedure systest2 is
> function Sys (Arg : Char_Array) return Integer;
> pragma Import(C, Sys, "system");
> Ret_Val : Integer;
> begin
> Ret_Val := Sys(To_C("python testpy.py arg1 arg2"));
> end systest2;
> which blocks the testpy.py script until its end. This should not happen.
It must, actually:
https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/system-wsystem?view=vs-2019
> So, please, how could I fix this?
You need spawn python in an asynchronous process or else a batch script
with something like "call python test.py ddddd" inside.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Running a simple Python from Ada program
@ 2020-04-03 19:19 3% ` Rego, P.
2020-04-03 20:06 0% ` Dmitry A. Kazakov
2020-04-04 1:48 0% ` Dennis Lee Bieber
0 siblings, 2 replies; 200+ results
From: Rego, P. @ 2020-04-03 19:19 UTC (permalink / raw)
> > Do not do that. There exist Python C API, which you should use:
> > https://docs.python.org/3/c-api/index.html
> You mean that the problem is with the Python "print" ?
I tested with a very simple C code. If the Python print is blocked, it should be blocked also from a C call, I presume (ok someone will contest, anyway). Any case, from the C call, it does not block.
So I will try to simplify a bit the question. I want to do the equivalent of this
#include <stdio.h>
#include <stdlib.h>
int main(){
system("python testpy.py ddddd");
return 0;
}
In this case it does not block the testpy.py printouts.
But I am doing this
with Interfaces.C; use Interfaces.C;
procedure systest2 is
function Sys (Arg : Char_Array) return Integer;
pragma Import(C, Sys, "system");
Ret_Val : Integer;
begin
Ret_Val := Sys(To_C("python testpy.py arg1 arg2"));
end systest2;
which blocks the testpy.py script until its end. This should not happen. So, please, how could I fix this?
^ permalink raw reply [relevance 3%]
* Re: Running a simple Python from Ada program
2020-04-03 16:57 3% Running a simple Python from Ada program Rego, P.
@ 2020-04-03 17:35 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2020-04-03 17:35 UTC (permalink / raw)
On 2020-04-03 18:57, Rego, P. wrote:
> Does someone would have a simplest as possible way to run a Python script from the Ada project?
There is no simple way doing that. Python has serious issues.
> The Python script in this case only has a print in a loop, with a sleep, so each iteration it should print the arguments.
Yes, this is what I am doing. I also keep state between iterations so
that the called Python script could update an object and then get it
back on the next iteration.
> The Python script I'm using is
> import sys
> import time
>
> for index in range(10):
> print(sys.argv)
> time.sleep(1)
>
> On approach I am trying is running this one as a batch script, so using
> import sys
> import time
>
> with Text_IO;
> with Interfaces.C; use Interfaces.C;
> procedure systest2 is
> function Sys (Arg : Char_Array) return Integer;
> pragma Import(C, Sys, "system");
> Ret_Val : Integer;
> begin
> Ret_Val := Sys(To_C("python testpy.py arg1 arg2"));
>
> end systest2;
>
> The problem is that the execution blocks the script, meaning that the Python printouts are only printed at the end of the execution, at once.
Do not do that. There exist Python C API, which you should use:
https://docs.python.org/3/c-api/index.html
> I know that there is a solution (to run Python from Ada) based on GNATCOLL, but I couldn't find any example to run it.
Well, as an alternative, you could take a look how MAX! Home Automation
runs Python scripts.
http://www.dmitry-kazakov.de/ada/max_home_automation.htm#5.1
It:
1. Loads Python DLL dynamically
2. Initializes Python environment
3. Compiles script file an loads it as a module into the Python environment
4. Calls a function from the module (in a loop)
5. Handles exceptions from Python
6. Makes some Ada subroutines callable from the Python script
I must warn you, it is complicated. The files py.ads/adb are Python
bindings. Subdirectories Linux and Windows contain OS-dependent bodies
of Python library loader py-load_python_library.adb.
py-elv_max_cube.ads/adb is a module of Ada subroutines callable from Python.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Running a simple Python from Ada program
@ 2020-04-03 16:57 3% Rego, P.
2020-04-03 17:35 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Rego, P. @ 2020-04-03 16:57 UTC (permalink / raw)
Does someone would have a simplest as possible way to run a Python script from the Ada project?
The Python script in this case only has a print in a loop, with a sleep, so each iteration it should print the arguments.
The Python script I'm using is
import sys
import time
for index in range(10):
print(sys.argv)
time.sleep(1)
On approach I am trying is running this one as a batch script, so using
import sys
import time
with Text_IO;
with Interfaces.C; use Interfaces.C;
procedure systest2 is
function Sys (Arg : Char_Array) return Integer;
pragma Import(C, Sys, "system");
Ret_Val : Integer;
begin
Ret_Val := Sys(To_C("python testpy.py arg1 arg2"));
end systest2;
The problem is that the execution blocks the script, meaning that the Python printouts are only printed at the end of the execution, at once.
I know that there is a solution (to run Python from Ada) based on GNATCOLL, but I couldn't find any example to run it.
Tnx
^ permalink raw reply [relevance 3%]
* Re: Is this actually possible?
2019-12-11 16:43 2% Is this actually possible? Lucretia
@ 2019-12-11 19:59 0% ` Randy Brukardt
0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2019-12-11 19:59 UTC (permalink / raw)
"Lucretia" <laguest9000@googlemail.com> wrote in message
news:36d45c82-2a6b-4c60-baeb-1a4aef5189c7@googlegroups.com...
...
> So, I tried a few things, including Holders, which I never knew existed,
> but this is where I am currently:
>
> with Interfaces.C;
> -- with Ada.Containers.Bounded_Holders;
There no Bounded_Holders in Ada (any version). Perhaps your compiler has
invented it (they're allowed to add containers).
Ada 202x has Bounded_Indefinite_Holders.
Randy.
^ permalink raw reply [relevance 0%]
* Is this actually possible?
@ 2019-12-11 16:43 2% Lucretia
2019-12-11 19:59 0% ` Randy Brukardt
0 siblings, 1 reply; 200+ results
From: Lucretia @ 2019-12-11 16:43 UTC (permalink / raw)
Hi,
I was thinking about extensible records recently (not tagged types), and thought to try to export a tagged type to C, not C++. It compiles, but the results aren't quite right, so wondering if it's possible or not.
The idea is to export an array of tagged types as a C array to either a function or a variable / struct element. i.e.
struct Blah {
My_Array *Array;
};
or in this case (Array below):
#include <stdio.h>
typedef struct {
int One;
float Two;
} Packet;
void Dump (int First, int Last, Packet *Array) {
printf ("Dump (%d .. %d)\n", First, Last);
printf ("Array => %p\n", Array);
for (int I = First; I < Last + 1; I++) {
printf ("\tOne => %d\n", Array[I].One);
printf ("\tTwo => %f\n", Array[I].Two);
}
}
So, I tried a few things, including Holders, which I never knew existed, but this is where I am currently:
with Interfaces.C;
-- with Ada.Containers.Bounded_Holders;
with System;
package Datums is
package C renames Interfaces.C;
-- Force a size, we kind of want a variant like array of records, but with unknown element types, but always of
-- the same number and size of elements.
type Root_Packet is abstract tagged null record with
Size => C.int'Size + C.C_float'Size;
-- package Root_Holders is new Ada.Containers.Bounded_Holders (Element_Type => Root_Packet'Class);
type Storage_Element is mod 2 ** System.Storage_Unit with
Convention => C;
type Storage_Array is array (Positive range <>) of Storage_Element with
Convention => C;
type Root_Holder is
record
Data : Storage_Array (1 .. Root_Packet'Max_Size_In_Storage_Elements);
end record with
Convention => C;
type Packet_Array is array (C.size_t range <>) of aliased Root_Holder with -- Root_Holders.Holder with
Convention => C;
type Packet_Array_Ptr is access all Packet_Array with
Convention => C;
type Packet_1 is new Root_Packet with
record
One : C.int;
Two : C.C_float;
end record with
Convention => C;
type Packet_2 is new Root_Packet with
record
Banana : C.int;
Mango : C.C_float;
end record with
Convention => C;
end Datums;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Conversion;
with System.Address_Image;
with Datums; use Datums;
procedure Testing is
-- use Root_Holders;
function To_Holder is new Ada.Unchecked_Conversion (Source => Packet_1, Target => Root_Holder);
function To_Holder is new Ada.Unchecked_Conversion (Source => Packet_2, Target => Root_Holder);
A : aliased Packet_Array := (1 => To_Holder (Packet_1'(One => 10, Two => 3.14)),
2 => To_Holder (Packet_2'(Banana => 50, Mango => 4.5)));
procedure Dump (First, Last : in C.int; Data : in Packet_Array_Ptr) with
Convention => C,
Import => True,
External_Name => "Dump";
begin
Put_Line ("A'Address => " & System.Address_Image (A'Address));
Dump (C.int (A'First), C.int (A'Last), A'Unchecked_Access);
end Testing;
project T is
for Source_Dirs use (".");
for Languages use ("C", "Ada");
for Main use ("testing.adb");
package Compiler is
for Default_Switches ("Ada") use ("-g");
for Default_Switches ("C") use ("-g");
end Compiler;
end T;
^ permalink raw reply [relevance 2%]
* libcurl with Ada - how to HTTP POST transfer with large file upload
@ 2019-09-13 3:28 1% Matt Borchers
0 siblings, 0 replies; 200+ results
From: Matt Borchers @ 2019-09-13 3:28 UTC (permalink / raw)
A recent situation has caused some previously working code (written in Ada 95 era) to stop working. What has changed is updating from using a very old compiler (GNAT 6.3.0) and AWS (Ada Web Server) v2.3.0 to the latest available.
We are using libcurl v7.19.6 (quite old) to transfer files using unauthenticated HTTP. I have tried to build with the latest available libcurl library files. Although the executable builds, the executable will not run. So for now, at least, I am stuck with the v7.19.6.
We are also using the AdaCurl binding by Andreas Almroth that is dated 2005-05-24. I have found a few errors with this binding recently in my investigation of how to fix my problem.
The files we transfer can be small to very large. The old mechanism that was in place was this: We set up a libcurl EASY session with PUT. If the file size was less than 512MB then a buffer was created in memory and that buffer written to disk. If the file was larger then we read the message body directly from the socket and wrote that data to disk.
The message body can no longer be read directly from the socket when using the new AWS. I am told that in order to avoid a memory buffer that I should send the file as an attachment to a POST request.
My goal is to transfer any file with libcurl to AWS in the fastest way possible while avoiding a temporary memory buffer.
I have tried many things over the past week and have had no luck in getting libcurl to perform how I want it to so that AWS can retrieve the data from the message body. The libcurl documentation and its debug routine option is lackluster in that it does not go in-depth enough to help people understand how to correct what is wrong. I have tried coding up the many examples available but the examples don't work. I undertand that when it is working properly the file will be written directly to disk and the HTTP response handler will be provided with the filename as a FORM parameter.
Does anybody have a working example of using libcurl with or without AWS as I described? Perhaps a better alternative to libcurl for my situation? Below is the latest code I have which I've read is on the right track. I don't really understand the adacurl.multi package which is used below with the adacurl.easy package.
Thank you for any assistance.
Matt
declare
hndl : CURL_P;
mhndl : CURLM_P;
mc : CURLMcode;
still_run : aliased INTERFACES.C.INT := 0;
u32_str : STRING := UNSIGNED_32'Image( u32 );
ca : aliased CHAR_ARRAY := to_c( "http://.../database/" & u32_str(2..u32_str'Last) );
continue : aliased CHAR_ARRAY := to_c( "Expect:" );
rcode : aliased LONG := 0;
s500 : constant := 500;
form,
ftail : CURL_HTTPPOST_P;
fcode : CURLFORMcode;
dbid : aliased CHAR_ARRAY := to_c( u32_str(2..u32_str'Last) );
sendfile : aliased CHAR_ARRAY := to_c( "sendfile" );
filename : aliased CHAR_ARRAY := to_c( "filename" );
submit : aliased CHAR_ARRAY := to_c( "submit" );
send : aliased CHAR_ARRAY := to_c( "send" );
begin
hndl := curl_easy_init;
if hndl = NULL then
text_io.put_line( "Curl failed to initialize" );
return;
end if;
mhndl := curl_multi_init;
if mhndl = NULL then
text_io.put_line( "Curl-Multi failed to initialize" );
return;
end if;
code := curl_easy_setopt( hndl, CURLOPT_VERBOSE, LONG(1) );
code := curl_easy_setopt( hndl, CURLOPT_DEBUGFUNCTION, curl_debug'Unrestricted_Access );
code := curl_easy_setopt( hndl, CURLOPT_ERRORBUFFER, to_chars_ptr( errbuf'Unrestricted_Access ) );
code := curl_easy_setopt( hndl, CURLOPT_READDATA, fd'Address );
code := curl_easy_setopt( hndl, CURLOPT_READFUNCTION, wrap_fread'Unrestricted_Access );
code := curl_easy_setopt( hndl, CURLOPT_WRITEFUNCTION, ignore_response'Unrestricted_Access );
code := curl_easy_setopt( hndl, CURLOPT_POST, LONG(1) );
code := curl_easy_setopt( hndl, CURLOPT_URL, to_chars_ptr( ca'Unrestricted_Access ) );
if code /= CURLE_OK then
text_io.put_line( "Failed to set url, code is " & CURLCODE'Image( code ) );
return;
end if;
headers := curl_slist_append( headers, to_chars_ptr( continue'Unrestricted_Access ) );
code := curl_easy_setopt( hndl, CURLOPT_HTTPHEADER, headers.all'Address );
fcode := curl_formadd( form'Unrestricted_Access, ftail'Unrestricted_Access,
CURLFORM_COPYNAME, to_chars_ptr( sendfile'Unrestricted_Access ),
CURLFORM_FILE, to_chars_ptr( dbid'Unrestricted_Access ),
CURLFORM_END );
fcode := curl_formadd( form'Unrestricted_Access, ftail'Unrestricted_Access,
CURLFORM_COPYNAME, to_chars_ptr( filename'Unrestricted_Access ),
CURLFORM_COPYCONTENTS, to_chars_ptr( dbid'Unrestricted_Access ),
CURLFORM_END );
fcode := curl_formadd( form'Unrestricted_Access, ftail'Unrestricted_Access,
CURLFORM_COPYNAME, to_chars_ptr( submit'Unrestricted_Access ),
CURLFORM_COPYCONTENTS, to_chars_ptr( send'Unrestricted_Access ),
CURLFORM_END );
code := curl_easy_setopt( hndl, CURLOPT_HTTPPOST, form.all'Address );
mc := curl_multi_add_handle( mhndl, hndl );
mc := curl_multi_perform( mhndl, still_run'Unrestricted_Access );
while still_run /= 0 loop
declare
fdread,
fdwrite,
fdexcep : aliased FD_SET := (others => 0);
maxfd : aliased INTERFACES.C.INT := -1;
begin
mc := curl_multi_fdset( mhndl, fdread'Unrestricted_Access,
fdwrite'Unrestricted_Access,
fdexcep'Unrestricted_Access,
maxfd'Unrestricted_Access );
if mc /= CURLM_OK then
text_io.put_line( "curl_multi_fdset() failed, code =" & mc'imaage );
exit;
end if;
delay 0.1;
mc := curl_multi_perform( mhndl, still_run'Unrestricted_Access );
if mc = CURLM_OK then
code := CURLE_OK;
else
code := CURL_LAST;
end if;
end;
end loop;
if code = CURLE_OK then
code := curl_easy_getinfo( hndl, CURLINFO_RESPONSE_CODE, rcode'Access );
if code = CURLE_OK and then rcode >= s500 then
text_io.put_line( "Server error executing curl for PUT_FILE response code :" & rcode'Image );
code := CURLE_SEND_ERROR;
end if;
end if;
mc := curl_multi_cleanup( mhndl );
curl_formfree( form );
curl_slist_free_all( headers );
curl_easy_cleanup( hndl );
end;
^ permalink raw reply [relevance 1%]
* Re: How to make Ada popular. Get rid of ";" at end of statement.
2019-07-25 7:26 3% ` Maciej Sobczak
@ 2019-07-26 19:16 0% ` Niklas Holsti
0 siblings, 0 replies; 200+ results
From: Niklas Holsti @ 2019-07-26 19:16 UTC (permalink / raw)
On 19-07-25 10:26 , Maciej Sobczak wrote:
>> The one concrete reason I've ever heard for using C or C++ instead
>> of Modula-2 or Ada is that C/C++ allow you to perform pointer
>> arithmetic
>
> Really? I would never consider that reason myself. But I have two
> others that I consider important:
>
> 1. C or C++ allow to reuse the existing C or C++ libraries, of which
> there are too many to ignore them. In fact, in some areas like
> embedded systems (which is where Ada tries to compete) those
> libraries are essential to get anything done.
Well, that depends. It may be true for short, small projects, but IME
for longer projects one can well do without the libraries. Of course it
also depends on the nature of the project, for example whether some
network connectivity is needed (which was not the case in most of my
projects).
> Chips are too complex
> to program them via their register-level interfaces and vendors
> deliver only C libraries for their products. No, the Ada's
> Interfaces.C does not even come close to be reasonably useful. It can
> be used only with those C interfaces that were specifically designed
> to facilitate such use.
That, again, depends. A colleague successfully used the GNAT "dump Ada
specs" function to create an Ada API for a large customer-supplied C
library of "driver" functions and linked it to an Ada application with
very few problems.
When I tried it on another C library, the result was very ugly, partly
because the library aimed to provide register-level access in addition
to some higher-level functions, and partly because the names of the C
entities used various prefixing and suffixing schemes to compensate for
the lack of a module system in C, and so the corresponding
package-qualified Ada names were really ugly... Instead, we wrote our
own HW register definitions and higher-level functions (and as a side
effect found and reported some errors in the HW documentation) giving a
pure Ada solution that, in addition, is portable between the big-endian
SPARC target and little-endian x86 development systems.
For ARM Cortex chips I believe there is a standard HW register
description language and a tool to generate the corresponding Ada
declarations.
> This is another source of misconception. Critical systems (not only
> automotive, but also medical, aviation, etc.) do not rely on
> programming languages to achieve reliability. They rely on
> independent verification processes, which also happen to account for
> most (like in >95%) of expenses. And Ada does nothing to make these
> processes any easier, because while belonging to the same family of
> programming technologies (3rd gen, imperative, etc.), its required
> verification technology is essentially the same. So why bother?
Hmm. I recall that the developers of SPARK wrote, somewhere, that they
tried to develop a similar tool for C, but gave up because the
properties of C where so much less amenable to formal analysis and proof
than the properties of Ada. Now it may be that advances in proof
systems, C "sanitizers" and lint-like tools have reduced this prooblem,
but it would surprise me if there would be no difference left.
And of course there is the well-know empirical evidence that development
in Ada, rather than C, leads to fewer errors and errors that are less
costly to fix.
--
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
. @ .
^ permalink raw reply [relevance 0%]
* Re: How to make Ada popular. Get rid of ";" at end of statement.
@ 2019-07-25 7:26 3% ` Maciej Sobczak
2019-07-26 19:16 0% ` Niklas Holsti
0 siblings, 1 reply; 200+ results
From: Maciej Sobczak @ 2019-07-25 7:26 UTC (permalink / raw)
> The one concrete reason I've ever heard for using C or C++ instead of Modula-2 or Ada is that C/C++ allow you to perform pointer arithmetic
Really? I would never consider that reason myself.
But I have two others that I consider important:
1. C or C++ allow to reuse the existing C or C++ libraries, of which there are too many to ignore them. In fact, in some areas like embedded systems (which is where Ada tries to compete) those libraries are essential to get anything done. Chips are too complex to program them via their register-level interfaces and vendors deliver only C libraries for their products.
No, the Ada's Interfaces.C does not even come close to be reasonably useful. It can be used only with those C interfaces that were specifically designed to facilitate such use. With others it is too much trouble.
2. Again with regard to embedded systems, hardware vendors provide their own IDEs. It's not just about libraries, see above, it's about the whole integrated approach to use the hardware from configuration to synthesis to programming. These IDEs are oriented towards C and C++ and with each new generation using any other language is more and more difficult. That is, it is genuinely *easier* to use C and C++.
> I had a conversation with a computer science professor the other day about security in automobiles, where a lot of people are using C or C++.
This is another source of misconception. Critical systems (not only automotive, but also medical, aviation, etc.) do not rely on programming languages to achieve reliability. They rely on independent verification processes, which also happen to account for most (like in >95%) of expenses. And Ada does nothing to make these processes any easier, because while belonging to the same family of programming technologies (3rd gen, imperative, etc.), its required verification technology is essentially the same. So why bother?
I would never consider semicolons or pointer arithmetic to be the decision-making points, but the above two subjects are killing the prospects for making Ada more popular in my domain.
--
Maciej Sobczak * http://www.inspirel.com
^ permalink raw reply [relevance 3%]
* Re: differences between Ada and C in gnat forcing me to use C instead of Ada
@ 2019-04-04 0:51 3% ` matthewbrentmccarty
0 siblings, 0 replies; 200+ results
From: matthewbrentmccarty @ 2019-04-04 0:51 UTC (permalink / raw)
Hi all:
OK! I was looking at this again with fresh eyes and with a little tweaking, I got Dmitry's example working with the following code:
with Text_Io; use Text_io;
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
procedure foo3 is
subtype SANE_Word is int; -- /usr/include/sane/sane.h:43
subtype SANE_Bool is SANE_Word; -- /usr/include/sane/sane.h:44
type SANE_Status is
(SANE_STATUS_GOOD,
SANE_STATUS_UNSUPPORTED,
SANE_STATUS_CANCELLED,
SANE_STATUS_DEVICE_BUSY,
SANE_STATUS_INVAL,
SANE_STATUS_EOF,
SANE_STATUS_JAMMED,
SANE_STATUS_NO_DOCS,
SANE_STATUS_COVER_OPEN,
SANE_STATUS_IO_ERROR,
SANE_STATUS_NO_MEM,
SANE_STATUS_ACCESS_DENIED);
pragma Convention (C, SANE_Status); -- /usr/include/sane/sane.h:71
subtype SANE_Char is char; -- /usr/include/sane/sane.h:46
subtype SANE_Int is SANE_Word; -- /usr/include/sane/sane.h:45
type SANE_String_Const is access all SANE_Char; -- /usr/include/sane/sane.h:48
type SANE_Auth_Callback is access procedure
(arg1 : SANE_String_Const;
arg2 : access SANE_Char;
arg3 : access SANE_Char);
pragma Convention (C, SANE_Auth_Callback); -- /usr/include/sane/sane.h:214
type SANE_Device is record
name : chars_ptr;
vendor : chars_ptr;
model : chars_ptr;
c_type : chars_ptr;
end record;
pragma Convention (C, SANE_Device);
type SANE_Device_Ptr is access all SANE_Device;
pragma Convention (C, SANE_Device_Ptr);
-- Flat array of devices
type SANE_Device_Array is array (size_t) of SANE_Device_Ptr;
pragma Convention (C, SANE_Device_Array);
type SANE_Device_Array_Ptr is access all SANE_Device_Array;
pragma Convention (C, SANE_Device_Array_Ptr);
function sane_get_devices
( device_list : in out SANE_Device_Array_Ptr;
local_only : SANE_Bool
) return SANE_Status;
pragma Import (C, sane_get_devices, "sane_get_devices");
function sane_init (version_code : access SANE_Int; authorize : SANE_Auth_Callback) return SANE_Status; -- /usr/include/sane/sane.h:218
pragma Import (C, sane_init, "sane_init");
procedure sane_exit; -- /usr/include/sane/sane.h:220
pragma Import (C, sane_exit, "sane_exit");
---------------------------------
List_Ptr : SANE_Device_Array_Ptr;
stat : SANE_Status := SANE_STATUS_GOOD;
version_code : access SANE_Int := new SANE_Int;
begin
stat := sane_init(version_code, null);
stat := sane_get_devices (List_Ptr, 0);
declare
List : SANE_Device_Array renames List_Ptr.all;
begin
for Index in List'Range loop -- "Infinite" loop
exit when List (Index) = null; -- Null-terminated
Text_Io.Put_Line ("Name: " & Value (List (Index).name));
Text_Io.Put_Line ("Vendor: " & Value (List (Index).vendor));
Text_Io.Put_Line ("Model: " & Value (List (Index).model));
Text_Io.Put_Line ("C_Type: " & Value (List (Index).c_type));
end loop;
end;
sane_exit;
end Foo3;
Now, if I knew that it was possible to interface to C using "sane_get_devices" with a parameter of "device_list : in out SANE_Device_Array_Ptr;" instead of the generated "System.Address" parameter, then I would have been delighted to use that method instead of the generated version from "%g++ -c -fdump-ada-spec-slim". For some reason, I thought the generated version was more accurate. But I much rather use the SANE_Device_Array_Ptr version since it more accurately matches the documented API calls as explained in the manual. I had to remove the "not null" on the parameter since it was causing "raised CONSTRAINT_ERROR : foo3.adb:74 access check failed" and it is null when you first call it. And I still get garbage when passing the 'Address of the first element of my array in my version of the code. Thanks for the assistance!
Regards,
Matthew McCarty
^ permalink raw reply [relevance 3%]
* Re: differences between Ada and C in gnat forcing me to use C instead of Ada
2019-03-25 5:46 3% differences between Ada and C in gnat forcing me to use C instead of Ada matthewbrentmccarty
2019-03-25 5:58 0% ` Jere
2019-03-25 8:25 0% ` Dmitry A. Kazakov
@ 2019-03-25 14:09 2% ` matthewbrentmccarty
3 siblings, 0 replies; 200+ results
From: matthewbrentmccarty @ 2019-03-25 14:09 UTC (permalink / raw)
Hi all:
"gnat-gps" on my machine Windows 10 (debian subsystem for Linux) (see https://docs.microsoft.com/en-us/windows/wsl/install-win10 ) gives me "raised STORAGE_ERROR : s-intman.adb:139 explicit raise" yet the same software works fine on my "real" debian machine. The compiler works but gant-gps doesn't.
For some reason when I call sane_get_devices as in:
type Sane_Device_Ptr is access all sane_sane_h.SANE_Device;
for Sane_Device_Ptr'Size use Standard'Address_Size;
pragma Convention (C, Sane_Device_Ptr);
type Device_Array is array (Integer range <>) of aliased Sane_Device_Ptr;
pragma Convention (C, Device_Array);
...
devices : aliased Device_Array (1..5);
Status := sane_sane_h.sane_get_devices (devices(1)'Address, sane_sane_h.SANE_Bool(SANE_TRUE));
I get back garbage but in C, it works. Oh, now that makes sense about 'Size returning bits and sizeof in C returning bytes. 256 bits is indeed 32 bytes. I wonder why I'm getting back garbage. InterfaceS.C.Strings.chars_ptr'Size=64 and sizeof(char *)=8 are equivalent.
Thanks. I guess I got some more digging to do as to my garbage.
Regards,
Matthew McCarty
^ permalink raw reply [relevance 2%]
* Re: differences between Ada and C in gnat forcing me to use C instead of Ada
2019-03-25 5:46 3% differences between Ada and C in gnat forcing me to use C instead of Ada matthewbrentmccarty
2019-03-25 5:58 0% ` Jere
@ 2019-03-25 8:25 0% ` Dmitry A. Kazakov
2019-03-25 14:09 2% ` matthewbrentmccarty
3 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2019-03-25 8:25 UTC (permalink / raw)
On 2019-03-25 06:46, matthewbrentmccarty@gmail.com wrote:
> Basically, I wanted to interface with my scanner using SANE (Scanner Access Now Easy). Using my "real" Debian machine since gnat doesn't work under Windows 10 (Debian subsystem for Linux),
No idea what you mean under "subsystem", but GNAT works under Windows
virtual machine.
> with Interfaces.C; use Interfaces.C;
> ...
> ...
> subtype SANE_Char is char; -- /usr/include/sane/sane.h:46
> ...
> type SANE_String is access all SANE_Char; -- /usr/include/sane/sane.h:47
> ...
> -- unique device name
> type SANE_Device is record
> name : SANE_String_Const; -- /usr/include/sane/sane.h:104
> vendor : SANE_String_Const; -- /usr/include/sane/sane.h:105
> model : SANE_String_Const; -- /usr/include/sane/sane.h:106
> c_type : SANE_String_Const; -- /usr/include/sane/sane.h:107
> end record;
> pragma Convention (C_Pass_By_Copy, SANE_Device); -- /usr/include/sane/sane.h:109
type SANE_Device is record
name : chars_ptr;
vendor : chars_ptr;
model : chars_ptr;
c_type : chars_ptr;
end record;
pragma Convention (C, SANE_Device);
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: differences between Ada and C in gnat forcing me to use C instead of Ada
2019-03-25 5:46 3% differences between Ada and C in gnat forcing me to use C instead of Ada matthewbrentmccarty
@ 2019-03-25 5:58 0% ` Jere
2019-03-25 8:25 0% ` Dmitry A. Kazakov
` (2 subsequent siblings)
3 siblings, 0 replies; 200+ results
From: Jere @ 2019-03-25 5:58 UTC (permalink / raw)
On Monday, March 25, 2019 at 1:46:07 AM UTC-4, matthewbr...@gmail.com wrote:
> Hi all:
>
> I really want to use Ada. But gnat is forcing me to use C. Basically, I wanted to interface with my scanner using SANE (Scanner Access Now Easy). Using my "real" Debian machine since gnat doesn't work under Windows 10 (Debian subsystem for Linux), I created the ada specs from the C headers and the sizes in C and Ada are different. For example:
>
> In C, this code:
> printf("sizeof(char *)=%d\n", sizeof(char *));
>
> prints "sizeof(char *)=8"
>
>
> and this code:
> printf("sizeof(SANE_Device)=%d\n", sizeof(SANE_Device));
>
> prints "sizeof(SANE_Device)=32". In C, the header defines it this way:
>
> typedef char SANE_Char;
> typedef const SANE_Char *SANE_String_Const;
>
> typedef struct
> {
> SANE_String_Const name; /* unique device name */
> SANE_String_Const vendor; /* device vendor string */
> SANE_String_Const model; /* device model name */
> SANE_String_Const type; /* device type (e.g., "flatbed scanner") */
> }
> SANE_Device;
>
> which makes sense to me since 8*4 = 32 (sizeof(char *) * 4 elements in the record. But on the Ada side, I get the following code:
>
> Text_Io.Put_Line ("sane_sane_h.SANE_Device'Size=>" &
> Integer'Image (sane_sane_h.SANE_Device'Size));
>
> to print "sane_sane_h.SANE_Device'Size=> 256"
>
> And sure enough "Integer'Image (InterfaceS.C.Strings.chars_ptr'Size))" prints out 64. Now, how can we interface to a C library passing around the 'Address of an array of pointers to records if the elements in the record are different sizes. No wonder, I get back garbage when calling sane_get_devices. How is it that "sizeof(char *) is 8 in C and InterfaceS.C.Strings.chars_ptr'Size is 64 in Ada. When I try to rep spec it, I get
So when you do sizeof() in C it returns the number of bytes. When
you do 'Size in Ada, it gives the number of bits. 8bits * 8bytes
is 64 bits, so everything looks correct. They are returning the same
effective size in both C and Ada.
^ permalink raw reply [relevance 0%]
* differences between Ada and C in gnat forcing me to use C instead of Ada
@ 2019-03-25 5:46 3% matthewbrentmccarty
2019-03-25 5:58 0% ` Jere
` (3 more replies)
0 siblings, 4 replies; 200+ results
From: matthewbrentmccarty @ 2019-03-25 5:46 UTC (permalink / raw)
Hi all:
I really want to use Ada. But gnat is forcing me to use C. Basically, I wanted to interface with my scanner using SANE (Scanner Access Now Easy). Using my "real" Debian machine since gnat doesn't work under Windows 10 (Debian subsystem for Linux), I created the ada specs from the C headers and the sizes in C and Ada are different. For example:
In C, this code:
printf("sizeof(char *)=%d\n", sizeof(char *));
prints "sizeof(char *)=8"
and this code:
printf("sizeof(SANE_Device)=%d\n", sizeof(SANE_Device));
prints "sizeof(SANE_Device)=32". In C, the header defines it this way:
typedef char SANE_Char;
typedef const SANE_Char *SANE_String_Const;
typedef struct
{
SANE_String_Const name; /* unique device name */
SANE_String_Const vendor; /* device vendor string */
SANE_String_Const model; /* device model name */
SANE_String_Const type; /* device type (e.g., "flatbed scanner") */
}
SANE_Device;
which makes sense to me since 8*4 = 32 (sizeof(char *) * 4 elements in the record. But on the Ada side, I get the following code:
Text_Io.Put_Line ("sane_sane_h.SANE_Device'Size=>" &
Integer'Image (sane_sane_h.SANE_Device'Size));
to print "sane_sane_h.SANE_Device'Size=> 256"
And sure enough "Integer'Image (InterfaceS.C.Strings.chars_ptr'Size))" prints out 64. Now, how can we interface to a C library passing around the 'Address of an array of pointers to records if the elements in the record are different sizes. No wonder, I get back garbage when calling sane_get_devices. How is it that "sizeof(char *) is 8 in C and InterfaceS.C.Strings.chars_ptr'Size is 64 in Ada. When I try to rep spec it, I get
--size for "SANE_String_Const" too small, minimum allowed is 64
--
--for SANE_String_Const'Size use 8;
and
--for SANE_Device'Size use 32;
-- causes compiler error "size for "SANE_Device" too small, minimum allowed is 256
-- for SANE_Device use record
-- name at 0 range 0 .. 7;
-- vendor at 1 range 0 .. 7;
-- model at 2 range 0 .. 7;
-- c_type at 3 range 0 .. 7;
-- end record;
And sure enough Standard'Address_Size is 64. Sorry to be so long winded. I guess I'll write C code. Arggggh!
Regards,
Matthew McCarty
PS: Here are the steps.
So, I installed the development libraries using:
%apt-get install sane sane-utils libsane-extras xsane
which gave me
/usr/include/sane/sane.h
I then ran
%g++ -c -fdump-ada-spec -C /usr/include/sane/sane.h
which includes the following types and record:
with Interfaces.C; use Interfaces.C;
...
...
subtype SANE_Char is char; -- /usr/include/sane/sane.h:46
...
type SANE_String is access all SANE_Char; -- /usr/include/sane/sane.h:47
...
-- unique device name
type SANE_Device is record
name : SANE_String_Const; -- /usr/include/sane/sane.h:104
vendor : SANE_String_Const; -- /usr/include/sane/sane.h:105
model : SANE_String_Const; -- /usr/include/sane/sane.h:106
c_type : SANE_String_Const; -- /usr/include/sane/sane.h:107
end record;
pragma Convention (C_Pass_By_Copy, SANE_Device); -- /usr/include/sane/sane.h:109
function sane_get_devices (device_list : System.Address; local_only : SANE_Bool) return SANE_Status; -- /usr/include/sane/sane.h:221
pragma Import (C, sane_get_devices, "sane_get_devices");
^ permalink raw reply [relevance 3%]
* Re: How to bind this properly, C ** which is an array
@ 2019-03-01 22:02 3% ` Per Sandberg
0 siblings, 0 replies; 200+ results
From: Per Sandberg @ 2019-03-01 22:02 UTC (permalink / raw)
From the source provided i would guss that the folowing is a correct
spec-file.
------------------------------------------------------------
pragma Ada_2012;
pragma Style_Checks (Off);
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings;
package xx_h is
type mpc_state_ti is record
null;
end record
with Convention => C_Pass_By_Copy; -- xx.h:1
subtype mpc_state_t is mpc_state_ti; -- xx.h:1
type mpc_ast_t;
type mpc_ast_t_access is access all mpc_ast_t;
type mpc_ast_t is record
tag : Interfaces.C.Strings.chars_ptr; -- xx.h:4
contents : Interfaces.C.Strings.chars_ptr; -- xx.h:5
state : aliased mpc_state_t; -- xx.h:6
children_num : aliased int; -- xx.h:7
children : access mpc_ast_t_access; -- xx.h:8
end record
with Convention => C_Pass_By_Copy; -- xx.h:3
end xx_h;
------------------------------------------------------------
/P
On 3/1/19 9:25 PM, Lucretia wrote:
> On Friday, 1 March 2019 19:57:17 UTC, Per Sandberg wrote:
>> Well i would start with:
>>
>> gcc -c -fdump-ada-spec ${headerfile} [-fada-spec-parent=${a-good-root}]
>>
>> to have the compiler do all the tricky work, if the headers are "bad"
>> you might need to do som touch-ups but that could usually be done with
>> some simple sed-scripts.
>
> I already did, it just generates what I originally had, Address.
>
^ permalink raw reply [relevance 3%]
* Re: Ada x <whatever> Datagram Sockets
2019-02-08 20:35 3% ` Rego, P.
2019-02-08 21:26 0% ` Jeffrey R. Carter
@ 2019-02-08 21:38 0% ` Dmitry A. Kazakov
1 sibling, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2019-02-08 21:38 UTC (permalink / raw)
On 2019-02-08 21:35, Rego, P. wrote:
>> What the OP needs to do is
>>
>> 1. Get Length, the length of the data.
>> 2. Create C : Interfaces.C.char_array (1 .. Length)
>> 3. Transfer the data into C
>> 4. Use Interfaces.C.To_Ada (C) to transform C into an Ada String
>
> Simple enough, would you know how transfer the data into this C? I am trying in this path
>
> loop
> -- Receive and print message from client Ping
> Channel := SOCKETS.Stream (Socket, Address);
>
> Text_IO.Put_Line (Integer'Image (Channel'Size));
>
> declare
> Channel_Size : Integer := Integer (Channel'Size);
> type Buffer_Type is new Interfaces.C.char_array (1 .. Interfaces.C.size_t (Channel_Size));
> type Stream_Buffer_Type is new String (1 .. Integer (Channel_Size));
>
> function Copy_Arr is new Ada.Unchecked_Conversion (Buffer_Type, Stream_Buffer_Type);
>
> --Buffer : Buffer_Type;
> Stream_Buffer : Stream_Buffer_Type;
>
> begin
> --Buffer := String'Input (Channel);
>
> --!!!! Stream_Buffer := Stream_Buffer_Type (String'Input (Channel));
> end;
> end loop;
declare
Packet : Stream_Element_Array (1..Max_Size);
Last : Stream_Element_Offset;
From : Sock_Addr_Type;
loop
Receive_Socket (Socket, Packet, Last, From); -- UDP from anyone
declare
Text : String (1..Natural (Last));
begin
for Index in 1..Last loop
Text (Integer (Index)) := Character'Val (Packet (Index));
end loop;
Put_Line (Image (From) & ">|" & Text & "|");
end;
end loop;
For UDP there is no need to have packet length because packet=frame.
For TCP, you read the header first which usually determine the length.
Then you read the length stream elements. After that you start to decode.
P.S. It is good practice to keep framing (packet I/O) separate from
payload encoding/decoding.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Ada x <whatever> Datagram Sockets
2019-02-08 20:35 3% ` Rego, P.
@ 2019-02-08 21:26 0% ` Jeffrey R. Carter
2019-02-08 21:38 0% ` Dmitry A. Kazakov
1 sibling, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2019-02-08 21:26 UTC (permalink / raw)
On 2/8/19 9:35 PM, Rego, P. wrote:
>> What the OP needs to do is
>>
>> 1. Get Length, the length of the data.
>> 2. Create C : Interfaces.C.char_array (1 .. Length)
>> 3. Transfer the data into C
>> 4. Use Interfaces.C.To_Ada (C) to transform C into an Ada String
Now that I look at it in more detail, it's probably better to do something like
function To_String (Buffer : Ada.Streams.Stream_Element_Array) return String is
Result : String (1 .. Buffer'Length);
Last : Natural := 0;
begin -- To_String
Convert : for I in Buffer'range loop
exit Convert when Buffer (I) = 0; -- If NUL terminated
Last := Last + 1;
Result (Last) := Character'Val (Buffer (I) );
end loop Convert;
return Result (1 .. Last);
end To_String;
Buffer : Ada.Streams.Stream_Element_Array (1 .. Big_Enough);
Last : Ada.Streams.Stream_Element_Offset;
...
Receive_Socket (Socket => Socket, Item => Buffer, Last => Last);
Do_Something (To => To_String (Buffer (1 .. Last) ) );
--
Jeff Carter
"I've seen projects fail miserably for blindly
applying the Agile catechism: we're Agile, we
don't need to stop and think, we just go ahead
and code!"
Bertrand Meyer
150
^ permalink raw reply [relevance 0%]
* Re: Ada x <whatever> Datagram Sockets
2019-02-07 18:00 3% ` Jeffrey R. Carter
@ 2019-02-08 20:35 3% ` Rego, P.
2019-02-08 21:26 0% ` Jeffrey R. Carter
2019-02-08 21:38 0% ` Dmitry A. Kazakov
0 siblings, 2 replies; 200+ results
From: Rego, P. @ 2019-02-08 20:35 UTC (permalink / raw)
> What the OP needs to do is
>
> 1. Get Length, the length of the data.
> 2. Create C : Interfaces.C.char_array (1 .. Length)
> 3. Transfer the data into C
> 4. Use Interfaces.C.To_Ada (C) to transform C into an Ada String
Simple enough, would you know how transfer the data into this C? I am trying in this path
loop
-- Receive and print message from client Ping
Channel := SOCKETS.Stream (Socket, Address);
Text_IO.Put_Line (Integer'Image (Channel'Size));
declare
Channel_Size : Integer := Integer (Channel'Size);
type Buffer_Type is new Interfaces.C.char_array (1 .. Interfaces.C.size_t (Channel_Size));
type Stream_Buffer_Type is new String (1 .. Integer (Channel_Size));
function Copy_Arr is new Ada.Unchecked_Conversion (Buffer_Type, Stream_Buffer_Type);
--Buffer : Buffer_Type;
Stream_Buffer : Stream_Buffer_Type;
begin
--Buffer := String'Input (Channel);
--!!!! Stream_Buffer := Stream_Buffer_Type (String'Input (Channel));
end;
end loop;
^ permalink raw reply [relevance 3%]
* Re: Ada x <whatever> Datagram Sockets
@ 2019-02-07 18:00 3% ` Jeffrey R. Carter
2019-02-08 20:35 3% ` Rego, P.
0 siblings, 1 reply; 200+ results
From: Jeffrey R. Carter @ 2019-02-07 18:00 UTC (permalink / raw)
On 2/7/19 12:47 PM, Jere wrote:
>
> In Ada you are telling it to receive:
>
> <length byte 1..4> <data byte 1..length>
Wrong. According to ARM 13.13.2(26/3) says, "If T is an array type, S'Output
first writes the bounds, and S'Input first reads the bounds." Ada arrays do not
necessarily have a lower bound of 1.
So String'Input will first try to read 2 integers, the lower and upper bounds of
the array. Presumably it runs out of data while reading the 2nd, leading to the
exception.
What the OP needs to do is
1. Get Length, the length of the data.
2. Create C : Interfaces.C.char_array (1 .. Length)
3. Transfer the data into C
4. Use Interfaces.C.To_Ada (C) to transform C into an Ada String
--
Jeff Carter
"Now go away or I shall taunt you a second time."
Monty Python & the Holy Grail
07
^ permalink raw reply [relevance 3%]
* Re: Least Dangerous Way to Do This ?
2018-10-17 0:09 2% ` patrick
@ 2018-10-17 20:49 0% ` Shark8
0 siblings, 0 replies; 200+ results
From: Shark8 @ 2018-10-17 20:49 UTC (permalink / raw)
On Tuesday, October 16, 2018 at 6:09:49 PM UTC-6, pat...@spellingbeewinnars.org wrote:
> Hi Shark8
>
> I am actually pretty familiar with the interface to cobol package. I actually don't trust it. I am thinking about trying to improve it but in it's current condition, it could be a liability.
>
> So Ada83 was pretty cool already but if we had Ada68 or Ada78 they would have sucked large. COBOL68 and COBOL73 suck and the language is still haunted by criticism from this time.
>
> When I first started with GnuCOBOL(called Open-Cobol at the time) I thought it was awesome and that the critics must all be insane and then I saw code from 68 and 73 revisions. One program(like a procedure) was almost 10000 lines long. All identifiers were limited to 8 characters. There was not a single comment in it. So yes old COBOL is terrible. The thing is that the interfaces cobol package appears to be for this old code and not the current stuff.
Interesting.
>
> In COBOL we have pointers, procedures(called programs) and functions. The spec file in the interfaces cobol package makes all kinds of false statements.
I'm rather looking forward to seeing your improved COBOL interface.
(We might even be able to replace Interfaces.COBOL, or perhaps add a new child-package like Interfaces.COBOL.ISO_1989_2014.)
>
> GnuCOBOL generates intermediate C, so I can inspect it and see what is happening. At the moment I am better off with the interfaces C package.
Hm, are you going to use that as a bit of a feedback-loop in your design of a [new] COBOL interfacing package?
> I have wondered the same thing. People can write very reliable COBOL code but there are some topics related to calling other procedures(programs) that could be a concern for the most critical portions, this is where Ada would really shine in banking, yet it doesn't.
>
>
> Ada has much better facilities for organizing huge amounts of code yet COBOL likely has far larger code bases. I think one bank has something like 130 million lines of COBOL, I could borrow the library book I read this in, to get the exact amount if your interested but the point is that organizing this much code in COBOL is very hard.
Indeed, and code-organization is one area that Ada really shines [IMO].
>
> I hope you don't mind a bit of a rant but I think Ada has serious-serious advocacy issues. Adacore has done a horrible job and we could improve more as a community too. Catering to existing Adacore customers does not move the language forward. Adacore did not move to microcontrollers for the longest time and it has staff that go around telling people not to use Ada for webservers or telephony systems when this would actually be good things to do and so on.
I'm not bothered by your rant -- it actually mirrors a lot of the criticisms the Ada-community as-a-whole has. While I'm glad that AdaCore has interests in Ada, and does some good work, there are some big problems that "only one [viable, opensource] implementation" entails which isn't good for the language as-a-whole.
>
> Books are terrible. You can read hundreds and hundreds of pages were all that is being demonstrated is some language feature you are never going to use and text_io displaying something. I have 53lbs of Ada books(and counting) and in all this I think I have 2 or 3 pages that deal with interfacing with real hardware and there is next to no information about interfacing with other languages. How many new application these days are going to be in pure Ada, it's crazy to cover features from Ada2005 and Ada2012 and not providing any examples of interfacing with other languages. What are you actually going to do with interfaces in a new code base that has no contact with other languages ? isn't it more important to understand procedures, function and packages and how to use Ada with other languages?
Interesting critique.
I've heard it said that the problem is that there's no "entry/introductory level" books, rather than books as-a-whole.
>
> Today is a special day for me. I realized something super-awesome about Ada that no one told me about and that I did not read about and this really should not have happened. It's so simple in hindsight but I didn't realize that you could use Ada packages with other languages without "with"ing them into an Ada program. I patched byteswap with pragma export and called it from COBOL. I can now use an Ada library directly from COBOL without writing any Ada code. Fortran and C people could do the same, with some simple patching.
Hm?
Are you referring to simply compiling a package and linking to the resultant OBJ file? Or am I misunderstanding you?
> Please see this site(it is a lot of material on one page and can be slow to load):
> https://open-cobol.sourceforge.io/faq/index.html
>
> This will give a good overview of the language. There is a small part that touches on Ada. However look at this code, it's almost all using C libraries. GnuCOBOL has lots of facilities for interfacing with C, especially matching types but we still have to jump though some hoops such as appending nul bytes and so on.
Interesting, I'll take a look.
>
> I am planning on patching as many Ada libraries as I can so that they can be used from GnuCOBOL. There is so much functionality that we don't have in our community. Imagine if this ends up being used by existing COBOL code bases... Maybe even banks will see the value if I can do this, I write up lots of documentation and I can actually try to promote these concepts.
>
I, for one, would love to see this.
There's a lot of value to be had here: keeping your main-system organized, proven (where possible), and ensuring that your main reporting/processing isn't being handed garbage is a big win.
> If one company is entrusted to promote Ada and all they want to do is service existing customers, the language will die out when there old customers finally switch to C++/Java etc..
Yep.
This is a big problem, in part because existing customers develop work-arounds for flaws and issues that they never voice (that's just how things are), whereas new customers will have different needs and ideas [and expectations] which often at least shed some light on issues.
>
> There is so much to promote and so much value to be had but Ada instruction books and Adacore are not going to get the word out, we need to !
I try.
^ permalink raw reply [relevance 0%]
* Re: Least Dangerous Way to Do This ?
@ 2018-10-17 0:09 2% ` patrick
2018-10-17 20:49 0% ` Shark8
0 siblings, 1 reply; 200+ results
From: patrick @ 2018-10-17 0:09 UTC (permalink / raw)
Hi Shark8
I am actually pretty familiar with the interface to cobol package. I actually don't trust it. I am thinking about trying to improve it but in it's current condition, it could be a liability.
So Ada83 was pretty cool already but if we had Ada68 or Ada78 they would have sucked large. COBOL68 and COBOL73 suck and the language is still haunted by criticism from this time.
When I first started with GnuCOBOL(called Open-Cobol at the time) I thought it was awesome and that the critics must all be insane and then I saw code from 68 and 73 revisions. One program(like a procedure) was almost 10000 lines long. All identifiers were limited to 8 characters. There was not a single comment in it. So yes old COBOL is terrible. The thing is that the interfaces cobol package appears to be for this old code and not the current stuff.
In COBOL we have pointers, procedures(called programs) and functions. The spec file in the interfaces cobol package makes all kinds of false statements.
GnuCOBOL generates intermediate C, so I can inspect it and see what is happening. At the moment I am better off with the interfaces C package.
I have wondered the same thing. People can write very reliable COBOL code but there are some topics related to calling other procedures(programs) that could be a concern for the most critical portions, this is where Ada would really shine in banking, yet it doesn't.
Ada has much better facilities for organizing huge amounts of code yet COBOL likely has far larger code bases. I think one bank has something like 130 million lines of COBOL, I could borrow the library book I read this in, to get the exact amount if your interested but the point is that organizing this much code in COBOL is very hard.
I hope you don't mind a bit of a rant but I think Ada has serious-serious advocacy issues. Adacore has done a horrible job and we could improve more as a community too. Catering to existing Adacore customers does not move the language forward. Adacore did not move to microcontrollers for the longest time and it has staff that go around telling people not to use Ada for webservers or telephony systems when this would actually be good things to do and so on.
People using Ada for fun like on AVRs and on the Raspberry Pi are doing good work. We really need to show people what can be done with it and done with it for fun.
Books are terrible. You can read hundreds and hundreds of pages were all that is being demonstrated is some language feature you are never going to use and text_io displaying something. I have 53lbs of Ada books(and counting) and in all this I think I have 2 or 3 pages that deal with interfacing with real hardware and there is next to no information about interfacing with other languages. How many new application these days are going to be in pure Ada, it's crazy to cover features from Ada2005 and Ada2012 and not providing any examples of interfacing with other languages. What are you actually going to do with interfaces in a new code base that has no contact with other languages ? isn't it more important to understand procedures, function and packages and how to use Ada with other languages?
Today is a special day for me. I realized something super-awesome about Ada that no one told me about and that I did not read about and this really should not have happened. It's so simple in hindsight but I didn't realize that you could use Ada packages with other languages without "with"ing them into an Ada program. I patched byteswap with pragma export and called it from COBOL. I can now use an Ada library directly from COBOL without writing any Ada code. Fortran and C people could do the same, with some simple patching.
So I can't verify that any of this is true but according to MicroFocus, a company with a vested interest in COBOL(and that sued a city here in Canada for having too many copies of their software) the cost to replace COBOL in the USA would be over 1 trillion. They say that there is hundreds of billions of lines of code in use. Others have said that there is more COBOL code than all other languages combined. Again, I am not saying that all of this is true, it could be fanboy propaganda but certainly there is mountains of it.
Please see this site(it is a lot of material on one page and can be slow to load):
https://open-cobol.sourceforge.io/faq/index.html
This will give a good overview of the language. There is a small part that touches on Ada. However look at this code, it's almost all using C libraries. GnuCOBOL has lots of facilities for interfacing with C, especially matching types but we still have to jump though some hoops such as appending nul bytes and so on.
Ada and COBOL are much closer then COBOL and C and Ada has tons of facilities for working with other languages, such as it's type system and strings.fixed to match COBOL's and so on, they are just poorly documented.
I am planning on patching as many Ada libraries as I can so that they can be used from GnuCOBOL. There is so much functionality that we don't have in our community. Imagine if this ends up being used by existing COBOL code bases... Maybe even banks will see the value if I can do this, I write up lots of documentation and I can actually try to promote these concepts.
If one company is entrusted to promote Ada and all they want to do is service existing customers, the language will die out when there old customers finally switch to C++/Java etc..
There is so much to promote and so much value to be had but Ada instruction books and Adacore are not going to get the word out, we need to !
^ permalink raw reply [relevance 2%]
* Re: Interface To C Struct That Includes An Array
2018-09-18 8:19 0% ` rakusu_klein
@ 2018-09-18 11:54 0% ` rogermc
0 siblings, 0 replies; 200+ results
From: rogermc @ 2018-09-18 11:54 UTC (permalink / raw)
On Tuesday, 18 September 2018 18:19:30 UTC+10, rakusu...@fastmail.jp wrote:
> Probably you pass a link to the whole record somewhere where expected only a link to the data field. The other explanation of binary garbage in the string is that you get somwhere a raw uncutted data, because the aiGetMaterialString cuts the 32-bit prefix and corrects the length in aiString field by itself.
>
> понедельник, 17 сентября 2018 г., 15:01:43 UTC+3 пользователь rog...@iinet.net.au написал:
> > pragma Convention (C_Pass_By_Copy, API_String);
> It doesn't seems to be a good idea for me to copy a kilobyte of data on every call.
I agree but I don't know how to avoid it.
Would pragma Convention (C, API_String) be OK?
Also, I'm not sure that API_String is ever actually copied as all the interfacing is by pointers?
>
> > The returned Assimp_Path is Length: 16, Data: B000phoenix.pcx0000
> > in which B is a series of four small zeros inside a rectangle.
> > I haven't been able to find a syntactical explanation for the four small zeros inside a rectangle.
> As I can remember, this icon stays for nonprintable characters.
I've since discovered that its actually 000B inside the rectangle, the B obviously being hex for 11 which is the ASCII code for an unprintable character (VT) so its actually (VT)000phoenix.pcx0. The final three zeros above are an error in my report.
>
> > function API_Get_Material_Texture (aMaterial : access API_Material_Tex;
> > Tex_Type : AI_Texture_Type;
> > Index : Interfaces.C.unsigned;
> > Path : access Assimp_Types.API_String := null;
> > Mapping : access AI_Texture_Mapping := null;
> > UV_Index : access Interfaces.C.unsigned := null;
> > Blend : access Interfaces.C.C_float := null;
> > Op : access AI_Texture_Op := null;
> > Map_Mode : access AI_Texture_Map_Mode := null)
> > return Assimp_Types.API_Return;
> I also notice, that you forget the last argument "unsigned int * flags".
Yes, I seem to have inadvertently used the declaration of GetTexture instead of aiGetMaterialTexture.
Thanks for that observation. I'll add flags to my declaration of API_Get_Material_Texture.
^ permalink raw reply [relevance 0%]
* Re: Interface To C Struct That Includes An Array
2018-09-17 12:01 3% Interface To C Struct That Includes An Array rogermc
2018-09-17 12:11 0% ` rogermc
2018-09-17 15:24 0% ` Lucretia
@ 2018-09-18 8:19 0% ` rakusu_klein
2018-09-18 11:54 0% ` rogermc
2 siblings, 1 reply; 200+ results
From: rakusu_klein @ 2018-09-18 8:19 UTC (permalink / raw)
Probably you pass a link to the whole record somewhere where expected only a link to the data field. The other explanation of binary garbage in the string is that you get somwhere a raw uncutted data, because the aiGetMaterialString cuts the 32-bit prefix and corrects the length in aiString field by itself.
понедельник, 17 сентября 2018 г., 15:01:43 UTC+3 пользователь rog...@iinet.net.au написал:
> pragma Convention (C_Pass_By_Copy, API_String);
It doesn't seems to be a good idea for me to copy a kilobyte of data on every call.
> The returned Assimp_Path is Length: 16, Data: B000phoenix.pcx0000
> in which B is a series of four small zeros inside a rectangle.
> I haven't been able to find a syntactical explanation for the four small zeros inside a rectangle.
As I can remember, this icon stays for nonprintable characters.
> function API_Get_Material_Texture (aMaterial : access API_Material_Tex;
> Tex_Type : AI_Texture_Type;
> Index : Interfaces.C.unsigned;
> Path : access Assimp_Types.API_String := null;
> Mapping : access AI_Texture_Mapping := null;
> UV_Index : access Interfaces.C.unsigned := null;
> Blend : access Interfaces.C.C_float := null;
> Op : access AI_Texture_Op := null;
> Map_Mode : access AI_Texture_Map_Mode := null)
> return Assimp_Types.API_Return;
I also notice, that you forget the last argument "unsigned int * flags".
^ permalink raw reply [relevance 0%]
* Re: Interface To C Struct That Includes An Array
2018-09-17 15:24 0% ` Lucretia
@ 2018-09-17 23:06 3% ` Roger
0 siblings, 0 replies; 200+ results
From: Roger @ 2018-09-17 23:06 UTC (permalink / raw)
On Tuesday, September 18, 2018 at 1:24:09 AM UTC+10, Lucretia wrote:
> On Monday, 17 September 2018 13:01:43 UTC+1, rog...@iinet.net.au wrote:
> > I'm having problems interfacing the following record to C.
> >
> > type API_String is record
> > Length : Interfaces.C.size_t := 0;
> > Data : API_String_Data_Array := (others => Interfaces.C.char'Val (0));
> > end record;
> > pragma Convention (C_Pass_By_Copy, API_String);
>
> Variable length things in Ada are problematic no matter what really.
>
> What does the type definition of API_String_Data_Array look like? Is it also Convention => C?
I've replaced API_String_Data_Array with its original declaration which was
subtype API_String_Data_Array is char_array (0 .. Max_Length - 1):= (others => Interfaces.C.char'Val (0));
-- This declaration has been checked OK for Key data. DON'T CHANGE
type API_String is record
Length : Interfaces.C.size_t := 0;
Data : char_array (0 .. Max_Length - 1):= (others => Interfaces.C.char'Val (0));
end record;
pragma Convention (C_Pass_By_Copy, API_String);
but the same problem remains
^ permalink raw reply [relevance 3%]
* Re: Interface To C Struct That Includes An Array
2018-09-17 12:01 3% Interface To C Struct That Includes An Array rogermc
2018-09-17 12:11 0% ` rogermc
@ 2018-09-17 15:24 0% ` Lucretia
2018-09-17 23:06 3% ` Roger
2018-09-18 8:19 0% ` rakusu_klein
2 siblings, 1 reply; 200+ results
From: Lucretia @ 2018-09-17 15:24 UTC (permalink / raw)
On Monday, 17 September 2018 13:01:43 UTC+1, rog...@iinet.net.au wrote:
> I'm having problems interfacing the following record to C.
>
> type API_String is record
> Length : Interfaces.C.size_t := 0;
> Data : API_String_Data_Array := (others => Interfaces.C.char'Val (0));
> end record;
> pragma Convention (C_Pass_By_Copy, API_String);
Variable length things in Ada are problematic no matter what really.
What does the type definition of API_String_Data_Array look like? Is it also Convention => C?
^ permalink raw reply [relevance 0%]
* Re: Interface To C Struct That Includes An Array
2018-09-17 12:01 3% Interface To C Struct That Includes An Array rogermc
@ 2018-09-17 12:11 0% ` rogermc
2018-09-17 15:24 0% ` Lucretia
2018-09-18 8:19 0% ` rakusu_klein
2 siblings, 0 replies; 200+ results
From: rogermc @ 2018-09-17 12:11 UTC (permalink / raw)
On Monday, 17 September 2018 22:01:43 UTC+10, rog...@iinet.net.au wrote:
> I'm having problems interfacing the following record to C.
>
> type API_String is record
> Length : Interfaces.C.size_t := 0;
> Data : API_String_Data_Array := (others => Interfaces.C.char'Val (0));
> end record;
> pragma Convention (C_Pass_By_Copy, API_String);
>
> In general it seems OK, however, the following function in which Assimp_Path'Access is returned
> from a C function produces a strange result
>
> Result := API_Get_Material_Texture (Material'Access, Tex_Type, unsigned (Tex_Index), Assimp_Path'Access);
>
> The returned Assimp_Path is Length: 16, Data: B000phoenix.pcx0000
> in which B is a series of four small zeros inside a rectangle.
> I haven't been able to find a syntactical explanation for the four small zeros inside a rectangle.
>
> The expected Assimp_Path is Length: 11, Data: phoenix.pcx
> Memory inspection indicates that the Length 16 includes both the expected length and character string.
>
> (gdb) print Assimp_Path
> $8 = (length => 16, data => (0 => 11, 0, 0, 0, 112, 104, 111, 101, 110, 105, 120, 46, 112, 99, 120, 0 <repeats 1009 times>)
>
CORRECTION:
> If I shift the Data characters left by four places and change Length to 12, the resultant Assimp_Path is
> Length: 12, Data: Bphoenix.pcx
>
> The C interface is:
>
> function API_Get_Material_Texture (aMaterial : access API_Material_Tex;
> Tex_Type : AI_Texture_Type;
> Index : Interfaces.C.unsigned;
> Path : access Assimp_Types.API_String := null;
> Mapping : access AI_Texture_Mapping := null;
> UV_Index : access Interfaces.C.unsigned := null;
> Blend : access Interfaces.C.C_float := null;
> Op : access AI_Texture_Op := null;
> Map_Mode : access AI_Texture_Map_Mode := null)
> return Assimp_Types.API_Return;
> pragma Import (C, API_Get_Material_Texture, "aiGetMaterialTexture");
>
> Any positive advice or explanation will be appreciated.
> Roger
^ permalink raw reply [relevance 0%]
* Interface To C Struct That Includes An Array
@ 2018-09-17 12:01 3% rogermc
2018-09-17 12:11 0% ` rogermc
` (2 more replies)
0 siblings, 3 replies; 200+ results
From: rogermc @ 2018-09-17 12:01 UTC (permalink / raw)
I'm having problems interfacing the following record to C.
type API_String is record
Length : Interfaces.C.size_t := 0;
Data : API_String_Data_Array := (others => Interfaces.C.char'Val (0));
end record;
pragma Convention (C_Pass_By_Copy, API_String);
In general it seems OK, however, the following function in which Assimp_Path'Access is returned
from a C function produces a strange result
Result := API_Get_Material_Texture (Material'Access, Tex_Type, unsigned (Tex_Index), Assimp_Path'Access);
The returned Assimp_Path is Length: 16, Data: \vB000phoenix.pcx0000
in which B is a series of four small zeros inside a rectangle.
I haven't been able to find a syntactical explanation for the four small zeros inside a rectangle.
The expected Assimp_Path is Length: 11, Data: phoenix.pcx
Memory inspection indicates that the Length 16 includes both the expected length and character string.
(gdb) print Assimp_Path
$8 = (length => 16, data => (0 => 11, 0, 0, 0, 112, 104, 111, 101, 110, 105, 120, 46, 112, 99, 120, 0 <repeats 1009 times>)
If I shift the Data characters left by four places and change Length to 12, the resultant Assimp_Path is
Length: 16, Data: \vBphoenix.pcx
The C interface is:
function API_Get_Material_Texture (aMaterial : access API_Material_Tex;
Tex_Type : AI_Texture_Type;
Index : Interfaces.C.unsigned;
Path : access Assimp_Types.API_String := null;
Mapping : access AI_Texture_Mapping := null;
UV_Index : access Interfaces.C.unsigned := null;
Blend : access Interfaces.C.C_float := null;
Op : access AI_Texture_Op := null;
Map_Mode : access AI_Texture_Map_Mode := null)
return Assimp_Types.API_Return;
pragma Import (C, API_Get_Material_Texture, "aiGetMaterialTexture");
Any positive advice or explanation will be appreciated.
Roger
^ permalink raw reply [relevance 3%]
* Re: file descriptor of a serial port
2018-08-21 7:19 0% ` jan.de.kruyf
@ 2018-08-22 7:03 0% ` jan.de.kruyf
0 siblings, 0 replies; 200+ results
From: jan.de.kruyf @ 2018-08-22 7:03 UTC (permalink / raw)
On Tuesday, August 21, 2018 at 9:19:36 AM UTC+2, jan.de...@gmail.com wrote:
> On Monday, August 20, 2018 at 9:52:28 PM UTC+2, Per Sandberg wrote:
> > Why don't patch your own "GNAT.Serial_Communications" and put in your
> > own projects sources.
> > --------------------------------------------------------------------
> > package GNAT.Serial_Communications is
> > ...
> > type Data_Rate is
> > (B75, B110, B150, B300, B600, B1200, B2400, B4800, B9600,
> > B19200, B38400, B57600, B100000, B115200);
> > ...
> > private
> > ...
> > Data_Rate_Value : constant array (Data_Rate) of
> > Interfaces.C.unsigned ...
> > B57600 => 57_600,
> > B100000 => 100_000,
> > B115200 => 115_200);
> >
> > end GNAT.Serial_Communications;
> > --------------------------------------------------------------------
> > package body GNAT.Serial_Communications is
> > ...
> > C_Data_Rate : constant array (Data_Rate) of unsigned :=
> > ...
> > B57600 => OSC.B57600,
> > B100000 => 0010010, --<<bits/termios.h:162
> > B115200 => OSC.B115200);
> > ...
> > end GNAT.Serial_Communications;
> > --------------------------------------------------------------------
> > project Serial_Mess is
> > for Source_Dirs use ("src");
> > for Object_Dir use ".obj";
> > for Main use ("main.adb");
> >
> > package Compiler is
> > for Switches ("g-sercom.adb") use ("-gnatg");
> > end Compiler;
> > end Serial_Mess;
> > --------------------------------------------------------------------
> > And you are done.
> >
> > Did the same thing some years ago for B75 before it was implemented in
> > the distributed Run-times.
> > /P
> >
> >
> >
> > On 08/20/18 15:56, jan.....com wrote:
> > > Hallo,
> > >
> > > I try to set up a custom baudrate on a serial port, which I believe is done with the C ioctl procedure.
> > >
> > > However, for that I need the fd of the serial port which is hidden in the private part of GNAT.Serial_Communications.
> > >
> > > I tried to construct a child package of GNAT.Serial_Communications but the compiler does not like that, since it does not actually compile that package.
> > >
> > > Has anybody any idea?
> > >
> > > Thanks,
> > >
> > > Jan de Kruijf.
> > >
>
> Per,
> Yes, it is not as simple as you make it, but that I will do. The whole issue comes about because I need to read a serial port at 100kBaud which Linux does not handle by normal means. You need to give a custom divider (i.e. not preset in the serial driver) with ioctl
>
> See here:
> stackoverflow.com/questions/3192478/specifying-non-standard-baud-rate-for-ftdi-virtual-serial-port-under-linux#
>
> Enjoy your day.
>
> j.
Rejoice with me, the stackoverflow.com recipe works.
I get 100kBaud now.
The code is here for anybody who might ever need it.
Thanks for all the help.
j.
^ permalink raw reply [relevance 0%]
* Re: file descriptor of a serial port
2018-08-20 19:52 2% ` Per Sandberg
@ 2018-08-21 7:19 0% ` jan.de.kruyf
2018-08-22 7:03 0% ` jan.de.kruyf
0 siblings, 1 reply; 200+ results
From: jan.de.kruyf @ 2018-08-21 7:19 UTC (permalink / raw)
On Monday, August 20, 2018 at 9:52:28 PM UTC+2, Per Sandberg wrote:
> Why don't patch your own "GNAT.Serial_Communications" and put in your
> own projects sources.
> --------------------------------------------------------------------
> package GNAT.Serial_Communications is
> ...
> type Data_Rate is
> (B75, B110, B150, B300, B600, B1200, B2400, B4800, B9600,
> B19200, B38400, B57600, B100000, B115200);
> ...
> private
> ...
> Data_Rate_Value : constant array (Data_Rate) of
> Interfaces.C.unsigned ...
> B57600 => 57_600,
> B100000 => 100_000,
> B115200 => 115_200);
>
> end GNAT.Serial_Communications;
> --------------------------------------------------------------------
> package body GNAT.Serial_Communications is
> ...
> C_Data_Rate : constant array (Data_Rate) of unsigned :=
> ...
> B57600 => OSC.B57600,
> B100000 => 0010010, --<<bits/termios.h:162
> B115200 => OSC.B115200);
> ...
> end GNAT.Serial_Communications;
> --------------------------------------------------------------------
> project Serial_Mess is
> for Source_Dirs use ("src");
> for Object_Dir use ".obj";
> for Main use ("main.adb");
>
> package Compiler is
> for Switches ("g-sercom.adb") use ("-gnatg");
> end Compiler;
> end Serial_Mess;
> --------------------------------------------------------------------
> And you are done.
>
> Did the same thing some years ago for B75 before it was implemented in
> the distributed Run-times.
> /P
>
>
>
> On 08/20/18 15:56, jan.....com wrote:
> > Hallo,
> >
> > I try to set up a custom baudrate on a serial port, which I believe is done with the C ioctl procedure.
> >
> > However, for that I need the fd of the serial port which is hidden in the private part of GNAT.Serial_Communications.
> >
> > I tried to construct a child package of GNAT.Serial_Communications but the compiler does not like that, since it does not actually compile that package.
> >
> > Has anybody any idea?
> >
> > Thanks,
> >
> > Jan de Kruijf.
> >
Per,
Yes, it is not as simple as you make it, but that I will do. The whole issue comes about because I need to read a serial port at 100kBaud which Linux does not handle by normal means. You need to give a custom divider (i.e. not preset in the serial driver) with ioctl
See here:
stackoverflow.com/questions/3192478/specifying-non-standard-baud-rate-for-ftdi-virtual-serial-port-under-linux#
Enjoy your day.
j.
^ permalink raw reply [relevance 0%]
* Re: file descriptor of a serial port
@ 2018-08-20 19:52 2% ` Per Sandberg
2018-08-21 7:19 0% ` jan.de.kruyf
0 siblings, 1 reply; 200+ results
From: Per Sandberg @ 2018-08-20 19:52 UTC (permalink / raw)
Why don't patch your own "GNAT.Serial_Communications" and put in your
own projects sources.
--------------------------------------------------------------------
package GNAT.Serial_Communications is
...
type Data_Rate is
(B75, B110, B150, B300, B600, B1200, B2400, B4800, B9600,
B19200, B38400, B57600, B100000, B115200);
...
private
...
Data_Rate_Value : constant array (Data_Rate) of
Interfaces.C.unsigned ...
B57600 => 57_600,
B100000 => 100_000,
B115200 => 115_200);
end GNAT.Serial_Communications;
--------------------------------------------------------------------
package body GNAT.Serial_Communications is
...
C_Data_Rate : constant array (Data_Rate) of unsigned :=
...
B57600 => OSC.B57600,
B100000 => 0010010, --<<bits/termios.h:162
B115200 => OSC.B115200);
...
end GNAT.Serial_Communications;
--------------------------------------------------------------------
project Serial_Mess is
for Source_Dirs use ("src");
for Object_Dir use ".obj";
for Main use ("main.adb");
package Compiler is
for Switches ("g-sercom.adb") use ("-gnatg");
end Compiler;
end Serial_Mess;
--------------------------------------------------------------------
And you are done.
Did the same thing some years ago for B75 before it was implemented in
the distributed Run-times.
/P
On 08/20/18 15:56, jan.de.kruyf@gmail.com wrote:
> Hallo,
>
> I try to set up a custom baudrate on a serial port, which I believe is done with the C ioctl procedure.
>
> However, for that I need the fd of the serial port which is hidden in the private part of GNAT.Serial_Communications.
>
> I tried to construct a child package of GNAT.Serial_Communications but the compiler does not like that, since it does not actually compile that package.
>
> Has anybody any idea?
>
> Thanks,
>
> Jan de Kruijf.
>
^ permalink raw reply [relevance 2%]
* Re: Can Ada print coloured/styled text to the terminal? (ANSI escape sequences?)
2018-08-16 12:29 3% ` Aurele Vitali
@ 2018-08-16 12:52 0% ` alby.gamper
0 siblings, 0 replies; 200+ results
From: alby.gamper @ 2018-08-16 12:52 UTC (permalink / raw)
On Thursday, August 16, 2018 at 10:29:11 PM UTC+10, Aurele Vitali wrote:
> Very nice Alex, and remember if you prefer a fullscreen mood (just like an actual VT100 terminal), simply insert a "SetConsoleDisplayMode" API call with the "CONSOLE_FULLSCREEN_MODE" flag set. You might also want to write your own thin Win32 spec. Just include something like this:
>
> function SetConsoleDisplayMode (
> ConOut_Ref : access System.Address;
> Flags : Interfaces.C.unsigned_long;
> Buffer_Ref : Coord_Ref
> )
> return Interfaces.C.int
>
> with Import => True,
> Convention => StdCall,
> External_Name => "SetConsoleDisplayMode";
>
> Also, Windows 10 supports two screen buffers (see Alternate Screen Buffer in my first link): The main buffer has scroll bars, the other has none. Have fun!
Thanks Aurele, I hadn't thought of testing against Vt100 full screen mode, and
I will try (time permitting) to update the sample code accordingly
^ permalink raw reply [relevance 0%]
* Re: Can Ada print coloured/styled text to the terminal? (ANSI escape sequences?)
@ 2018-08-16 12:29 3% ` Aurele Vitali
2018-08-16 12:52 0% ` alby.gamper
0 siblings, 1 reply; 200+ results
From: Aurele Vitali @ 2018-08-16 12:29 UTC (permalink / raw)
Very nice Alex, and remember if you prefer a fullscreen mood (just like an actual VT100 terminal), simply insert a "SetConsoleDisplayMode" API call with the "CONSOLE_FULLSCREEN_MODE" flag set. You might also want to write your own thin Win32 spec. Just include something like this:
function SetConsoleDisplayMode (
ConOut_Ref : access System.Address;
Flags : Interfaces.C.unsigned_long;
Buffer_Ref : Coord_Ref
)
return Interfaces.C.int
with Import => True,
Convention => StdCall,
External_Name => "SetConsoleDisplayMode";
Also, Windows 10 supports two screen buffers (see Alternate Screen Buffer in my first link): The main buffer has scroll bars, the other has none. Have fun!
^ permalink raw reply [relevance 3%]
* Re: AdaCore Community 2018 Bugs
2018-08-12 16:37 3% ` Simon Wright
2018-08-13 2:02 2% ` Roger
@ 2018-08-13 2:54 0% ` Roger
1 sibling, 0 replies; 200+ results
From: Roger @ 2018-08-13 2:54 UTC (permalink / raw)
On Monday, August 13, 2018 at 2:37:52 AM UTC+10, Simon Wright wrote:
> Roger <rogermcm2@gmail.com> writes:
>
> > On Sunday, August 12, 2018 at 5:33:35 PM UTC+10, Simon Wright wrote:
> >> Roger <rogermcm2@gmail.com> writes:
> >>
> >> > As it now occurs even with GCC 6.1.0 I'm thinking it most likely has
> >> > to do with recent OSX changes.
> >>
> >> Since it occurs on Debian Stretch, GCC 6.3.0, it can't be just macOS.
> >>
> >> The actual error reported can change with successive compilations
> >> (sometimes it says something like 'undeclared variable ""', seems to
> >> settle on the CE), a surefire symptom of bad memory handling.
> >>
> >> > This problem doesn't occur for compile only.
> >> > It occurs when I Build All from GPS
> >>
> >> The error is a crash in the compiler, doesn't matter how you get there.
> >
> > I Have cut most of the code out of the test program but the crash
> > still occurs. However, I am making progress on tracking back to the
> > minimal code where the crash first occurs.
>
> The problem is in the packages Morph.Mesh_Morph_Value_Pointers,
> Mesh_Morph_Weight_Pointers.
>
> You say
>
> package Mesh_Morph_Value_Pointers is new Interfaces.C.Pointers
> (Interfaces.C.unsigned, API_Morph_Value, API_Morph_Values_Array,
> API_Morph_Value'(others => <>));
>
> but
>
> type API_Morph_Value is new Interfaces.C.unsigned;
>
> so others => <> isn't a legal expression for an API_Morph_Value; you
> should say
>
> API_Morph_Value'(0));
>
>
> There is still a bug, which ought to be fixed, but it's that GNAT has
> failed to recognise the actual problem and has got fatally confused.
Thanks, very much appreciated.
I now have my main program building without crashing GNAT.
I'll also update my bug report with this information.
^ permalink raw reply [relevance 0%]
* Re: AdaCore Community 2018 Bugs
2018-08-12 16:37 3% ` Simon Wright
@ 2018-08-13 2:02 2% ` Roger
2018-08-13 2:54 0% ` Roger
1 sibling, 0 replies; 200+ results
From: Roger @ 2018-08-13 2:02 UTC (permalink / raw)
On Monday, August 13, 2018 at 2:37:52 AM UTC+10, Simon Wright wrote:
> Roger <rogermcm2@gmail.com> writes:
>
> > On Sunday, August 12, 2018 at 5:33:35 PM UTC+10, Simon Wright wrote:
> >> Roger <rogermcm2@gmail.com> writes:
> >>
> >> > As it now occurs even with GCC 6.1.0 I'm thinking it most likely has
> >> > to do with recent OSX changes.
> >>
> >> Since it occurs on Debian Stretch, GCC 6.3.0, it can't be just macOS.
> >>
> >> The actual error reported can change with successive compilations
> >> (sometimes it says something like 'undeclared variable ""', seems to
> >> settle on the CE), a surefire symptom of bad memory handling.
> >>
> >> > This problem doesn't occur for compile only.
> >> > It occurs when I Build All from GPS
> >>
> >> The error is a crash in the compiler, doesn't matter how you get there.
> >
> > I Have cut most of the code out of the test program but the crash
> > still occurs. However, I am making progress on tracking back to the
> > minimal code where the crash first occurs.
>
> The problem is in the packages Morph.Mesh_Morph_Value_Pointers,
> Mesh_Morph_Weight_Pointers.
>
> You say
>
> package Mesh_Morph_Value_Pointers is new Interfaces.C.Pointers
> (Interfaces.C.unsigned, API_Morph_Value, API_Morph_Values_Array,
> API_Morph_Value'(others => <>));
>
> but
>
> type API_Morph_Value is new Interfaces.C.unsigned;
>
> so others => <> isn't a legal expression for an API_Morph_Value; you
> should say
>
> API_Morph_Value'(0));
>
>
> There is still a bug, which ought to be fixed, but it's that GNAT has
> failed to recognise the actual problem and has got fatally confused.
Thanks, very much appreciated.
I have made the change but still get the problem in my main program.
I'll check all my other new Interfaces.C.Pointers packages for similar errors.
I'll also update my bug report with this information.
^ permalink raw reply [relevance 2%]
* Re: AdaCore Community 2018 Bugs
@ 2018-08-12 16:37 3% ` Simon Wright
2018-08-13 2:02 2% ` Roger
2018-08-13 2:54 0% ` Roger
0 siblings, 2 replies; 200+ results
From: Simon Wright @ 2018-08-12 16:37 UTC (permalink / raw)
Roger <rogermcm2@gmail.com> writes:
> On Sunday, August 12, 2018 at 5:33:35 PM UTC+10, Simon Wright wrote:
>> Roger <rogermcm2@gmail.com> writes:
>>
>> > As it now occurs even with GCC 6.1.0 I'm thinking it most likely has
>> > to do with recent OSX changes.
>>
>> Since it occurs on Debian Stretch, GCC 6.3.0, it can't be just macOS.
>>
>> The actual error reported can change with successive compilations
>> (sometimes it says something like 'undeclared variable ""', seems to
>> settle on the CE), a surefire symptom of bad memory handling.
>>
>> > This problem doesn't occur for compile only.
>> > It occurs when I Build All from GPS
>>
>> The error is a crash in the compiler, doesn't matter how you get there.
>
> I Have cut most of the code out of the test program but the crash
> still occurs. However, I am making progress on tracking back to the
> minimal code where the crash first occurs.
The problem is in the packages Morph.Mesh_Morph_Value_Pointers,
Mesh_Morph_Weight_Pointers.
You say
package Mesh_Morph_Value_Pointers is new Interfaces.C.Pointers
(Interfaces.C.unsigned, API_Morph_Value, API_Morph_Values_Array,
API_Morph_Value'(others => <>));
but
type API_Morph_Value is new Interfaces.C.unsigned;
so others => <> isn't a legal expression for an API_Morph_Value; you
should say
API_Morph_Value'(0));
There is still a bug, which ought to be fixed, but it's that GNAT has
failed to recognise the actual problem and has got fatally confused.
^ permalink raw reply [relevance 3%]
* Re: Kernel Syscall from Ada?
2016-06-23 8:36 2% Kernel Syscall from Ada? Diogenes
2016-06-23 10:58 0% ` Björn Lundin
2018-07-11 22:38 0% ` alexgrantbenedict
@ 2018-07-12 1:32 0% ` Dan'l Miller
2 siblings, 0 replies; 200+ results
From: Dan'l Miller @ 2018-07-12 1:32 UTC (permalink / raw)
On Thursday, June 23, 2016 at 3:36:21 AM UTC-5, Diogenes wrote:
> Is there a simple way to make a direct (Linux)Kernel syscall from Ada without using the system C library? i.e. Make a direct call as in Assembler?
>
> I'm asking because I've found a way to strip about 80k from a statically linked executable by not including Interfaces.C in the runtime.
>
> I've gotten my code to work reasonably well (no segfaults or memory errors) using inline Assembler. But it seems like there should be an Abstract or Generic "syscall" feature as part of the System library that we could use for doing our own Kernel calls. Same thing for the vDSO.
>
> Any tips?
>
> Diogenes
Well, coming at the topic top down from the momentum of ISO/IEEE standardization, for system calls in POSIX.2 (C API) there does exist an analogous POSIX.5 (Ada API). Whenever possible this should be utilized (and extended/maintained where stale).
front-matter preview:
https://webstore.iec.ch/preview/info_isoiec14519%7Bed2.0%7Den.pdf
available for purchase in each major national standards body, such as for $232 in the USA:
https://webstore.ansi.org/RecordDetail.aspx?sku=ISO%2FIEC%2014519:2001&source=preview
Coming at the topic bottom up from Linux kernel space, the C-language system calls could be augmented with a wholesale rethink of all the system calls into Ada-speak as a new Ada-centric distribution of Linux.
https://www.kernel.org/doc/html/v4.10/process/adding-syscalls.html
^ permalink raw reply [relevance 0%]
* Re: Kernel Syscall from Ada?
2016-06-23 8:36 2% Kernel Syscall from Ada? Diogenes
2016-06-23 10:58 0% ` Björn Lundin
@ 2018-07-11 22:38 0% ` alexgrantbenedict
2018-07-12 1:32 0% ` Dan'l Miller
2 siblings, 0 replies; 200+ results
From: alexgrantbenedict @ 2018-07-11 22:38 UTC (permalink / raw)
On Thursday, June 23, 2016 at 2:36:21 AM UTC-6, Diogenes wrote:
> Is there a simple way to make a direct (Linux)Kernel syscall from Ada without using the system C library? i.e. Make a direct call as in Assembler?
>
> I'm asking because I've found a way to strip about 80k from a statically linked executable by not including Interfaces.C in the runtime.
>
> I've gotten my code to work reasonably well (no segfaults or memory errors) using inline Assembler. But it seems like there should be an Abstract or Generic "syscall" feature as part of the System library that we could use for doing our own Kernel calls. Same thing for the vDSO.
>
> Any tips?
>
> Diogenes
I did something similar for a work thing a while back, I posted it to github https://github.com/abenedic/ada-raw-linux-syscalls . It still needs to be cleaned up though.
^ permalink raw reply [relevance 0%]
* Re: GNAT/Ada on Raspberry Pi 3
@ 2018-07-08 13:20 4% ` Björn Lundin
0 siblings, 0 replies; 200+ results
From: Björn Lundin @ 2018-07-08 13:20 UTC (permalink / raw)
On 2018-07-06 23:15, dontspam@dontspam.no wrote:
> Hi!
> I have a Raspberry Pi 3 with
> Linux 4.4.34-v7 armv7l / Raspbian GNU/Linux 8.0 (jessie)
>
> I have successfully installed GNAT 4.9.2 and I have created and executed a "Hello World" program on the device.
>
> From Python it is very convenient to operate the GPIOs but I haven't found something for Ada. Does it exists some package/library that can do this from Ada? It is not very important if it requires a different distro.
>
> Frank
>
It's easy to bind to the most comon c-api - http://wiringpi.com/
below is not the full api - just enough to write to a pin
call setup once first, then set pin-mode out, then write to it.
To read, set pin-mode in, and call read (which is not in the package yet)
http://wiringpi.com/ has good documentation
---spec
with Interfaces.C; use Interfaces.C;
package Gpio is
-- wiringPi modes
Wpi_Mode_Pins : constant Interfaces.C.Int := 0;
Wpi_Mode_Gpio : constant Interfaces.C.Int := 1;
Wpi_Mode_Gpio_Sys : constant Interfaces.C.Int := 2;
Wpi_Mode_Phys : constant Interfaces.C.Int := 3;
Wpi_Mode_Piface : constant Interfaces.C.Int := 4;
Wpi_Mode_Uninitialised : constant Interfaces.C.Int := -1;
-- Pin modes
Input : constant Interfaces.C.Int := 0;
Output : constant Interfaces.C.Int := 1;
Pwm_Output : constant Interfaces.C.Int := 2;
Gpio_Clock : constant Interfaces.C.Int := 3;
Soft_Pwm_Output : constant Interfaces.C.Int := 4;
Soft_Tone_Output : constant Interfaces.C.Int := 5;
Pwm_Tone_Output : constant Interfaces.C.Int := 6;
Low : constant Interfaces.C.Int := 0;
High : constant Interfaces.C.Int := 1;
-- Pull up/down/none
Pud_Off : constant Interfaces.C.Int := 0;
Pud_Down : constant Interfaces.C.Int := 1;
Pud_Up : constant Interfaces.C.Int := 2;
-- PWM
Pwm_Mode_Ms : constant Interfaces.C.Int := 0;
Pwm_Mode_Bal : constant Interfaces.C.Int := 1;
-- Interrupt levels
Int_Edge_Setup : constant Interfaces.C.Int := 0;
Int_Edge_Falling : constant Interfaces.C.Int := 1;
Int_Edge_Rising : constant Interfaces.C.Int := 2;
Int_Edge_Both : constant Interfaces.C.Int := 3;
Bad_Gpio_Call : exception;
procedure Setup ;
procedure Pin_Mode(Pin : Interfaces.C.Int ; Mode : Interfaces.C.Int) ;
procedure Digital_Write(Pin : Interfaces.C.Int; Value : Boolean);
private
pragma Import(C, Pin_Mode, "pinMode");
end Gpio;
----------
--body
with Ada.Environment_Variables;
package body Gpio is
---------------------------------------------------------
procedure Setup is
R : Int := 0;
function Wiring_Pi_Setup_Gpio return Interfaces.C.Int ;
pragma Import(C, Wiring_Pi_Setup_Gpio, "wiringPiSetupGpio");
begin --http://wiringpi.com/reference/setup/
-- If you want to restore the v1 behaviour, then you need to set the
environment variable: WIRINGPI_CODES
-- to any value
Ada.Environment_Variables.Set("WIRINGPI_CODES","1");
R := Wiring_Pi_Setup_Gpio;
if R /= 0 then
raise Bad_Gpio_Call with "Wiring_Pi_Setup_Gpio" & R'Img;
end if;
end Setup;
---------------------------------------------------------
procedure Digital_Write(Pin : Interfaces.C.Int; Value : Boolean) is
procedure Digital_Write(Pin : Interfaces.C.Int; Value
:Interfaces.C.Int);
pragma Import(C, Digital_Write, "digitalWrite");
begin
if Value then
Digital_Write(Pin, High);
else
Digital_Write(Pin, Low);
end if;
end Digital_Write;
------------------------------------------------------
end Gpio;
----------
--
--
Björn
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-05-31 22:25 3% ` Randy Brukardt
@ 2018-06-05 12:42 4% ` Alejandro R. Mosteo
0 siblings, 0 replies; 200+ results
From: Alejandro R. Mosteo @ 2018-06-05 12:42 UTC (permalink / raw)
On 01/06/2018 00:25, Randy Brukardt wrote:
> "Alejandro R. Mosteo" <alejandro@mosteo.com> wrote in message
> news:peoj3f$8ti$1@dont-email.me...
>> On 30/05/2018 21:56, Randy Brukardt wrote:
> ...
>>>> Is the in-place built limited tagged type guaranteed to live during the
>>>> call to the C function? (In other words, is the pointer safe (as long as
>>>> the C side does not make a copy, of course)?
>>>
>>> That depends on the master of the parameter. I believe that the master of
>>> a
>>> parameter is that of the call (each call being it's own master for the
>>> parameters) -- you'd have to look in 7.6.1 to be sure. So they stay
>>> around
>>> as long as the call.
>>
>> Might that be 6.4.1? 7 deals with packages (in 2012).
>
> No. The rules for masters are defined with finalization in 7.6, and
> specifically in 7.6.1(3/2). The single middle sentence in that paragraph (a
> classic RM run-on sentence) defines completely where every object in an Ada
> program is finalized -- and also defines large parts of the accessibility
> and tasking models (which mainly follow the same master rules).
I was a bit thrown off by the use of finalization in the non-controlled
sense.
>> Although it was too dense for me anyway :(
>
> That's why I didn't want to give you a definitive answer. It takes a lot of
> mental effort to do that, and I need to save that effort for things people
> pay me to do. ;-)
>
> ...
>>> Foo (Bar (Ugh (...))
>>>
>>> The result of Ugh is finalized when the call to Bar ends, so if it is
>>> somehow in the result of Bar, you could get trouble in Foo. You can avoid
>>> that by declaring the parameter "aliased" (those belong to the *result*
>>> of
>>> the function, so they stick around longer).
>>
>> The parameter is actually aliased already. So I hope your impressions are
>> right and I'm on firm ground then, a pleasant surprise.
>
> Turns out I was wrong: 7.6.1(3/2) says that only the outer function call is
> a master. So there is no problem in even the case I suggested.
Thanks again. And for doing it for free ;-)
Alex.
>
> Randy.
>
>
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-06-04 7:06 4% ` Dmitry A. Kazakov
@ 2018-06-04 7:47 4% ` ytomino
0 siblings, 0 replies; 200+ results
From: ytomino @ 2018-06-04 7:47 UTC (permalink / raw)
On Monday, June 4, 2018 at 4:06:56 PM UTC+9, Dmitry A. Kazakov wrote:
> On 2018-06-03 10:03 PM, ytomino wrote:
> > On Monday, June 4, 2018 at 4:33:20 AM UTC+9, Dmitry A. Kazakov wrote:
> >> On 2018-06-03 20:31, ytomino wrote:
> >>> Perhaps, malloc is better than New_String in this case.
> >>>
> >>> function malloc (s : Interfaces.C.size_t) return Interfaces.C.Strings.chars_ptr
> >>> with Import, Convention => C;
> >>
> >> I had a case when that caused the application crashed.
> >>
> >> I guess it was because of mixed Visual Studio and GCC run-times. The
> >> pointer returned by the malloc from one was freed in a third-party C
> >> library by another.
> >>
> >> --
> >> Regards,
> >> Dmitry A. Kazakov
> >> http://www.dmitry-kazakov.de
> >
> > What!?
> >
> > New_String calls malloc in the end, too, in mingw runtime.
> > (It calls Memory_Alloc, Memory_Alloc is _gnat_malloc, and __gnat_malloc calls malloc.)
> > https://gcc.gnu.org/svn/gcc/trunk/gcc/ada/libgnat/i-cstrin.adb
> > https://gcc.gnu.org/svn/gcc/trunk/gcc/ada/libgnat/s-parame.ads
> > https://gcc.gnu.org/svn/gcc/trunk/gcc/ada/libgnat/s-memory__mingw.adb
> >
> > If Interfaces.C.Strings.Free (malloc) is crashed, New_String would be same.
>
> No, not this free but the one called from the third-party library
> because the pointer was passed there to handle.
>
> Of course it is safe to call malloc-free or New_String-Free pairs. Other
> combinations can be unsafe.
>
> --
> Regards,
> Dmitry A. Kazakov
> http://www.dmitry-kazakov.de
> Of course it is safe to call malloc-free or New_String-Free pairs. Other
> combinations can be unsafe.
That is only talking on the standard, probably is not the cause of the crash.
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-06-03 20:03 6% ` ytomino
@ 2018-06-04 7:06 4% ` Dmitry A. Kazakov
2018-06-04 7:47 4% ` ytomino
0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2018-06-04 7:06 UTC (permalink / raw)
On 2018-06-03 10:03 PM, ytomino wrote:
> On Monday, June 4, 2018 at 4:33:20 AM UTC+9, Dmitry A. Kazakov wrote:
>> On 2018-06-03 20:31, ytomino wrote:
>>> Perhaps, malloc is better than New_String in this case.
>>>
>>> function malloc (s : Interfaces.C.size_t) return Interfaces.C.Strings.chars_ptr
>>> with Import, Convention => C;
>>
>> I had a case when that caused the application crashed.
>>
>> I guess it was because of mixed Visual Studio and GCC run-times. The
>> pointer returned by the malloc from one was freed in a third-party C
>> library by another.
>>
>> --
>> Regards,
>> Dmitry A. Kazakov
>> http://www.dmitry-kazakov.de
>
> What!?
>
> New_String calls malloc in the end, too, in mingw runtime.
> (It calls Memory_Alloc, Memory_Alloc is _gnat_malloc, and __gnat_malloc calls malloc.)
> https://gcc.gnu.org/svn/gcc/trunk/gcc/ada/libgnat/i-cstrin.adb
> https://gcc.gnu.org/svn/gcc/trunk/gcc/ada/libgnat/s-parame.ads
> https://gcc.gnu.org/svn/gcc/trunk/gcc/ada/libgnat/s-memory__mingw.adb
>
> If Interfaces.C.Strings.Free (malloc) is crashed, New_String would be same.
No, not this free but the one called from the third-party library
because the pointer was passed there to handle.
Of course it is safe to call malloc-free or New_String-Free pairs. Other
combinations can be unsafe.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 4%]
* Re: Trying to execute a command from inside of Ada
2018-06-04 3:17 2% Trying to execute a command from inside of Ada John Smith
@ 2018-06-04 4:42 0% ` ytomino
0 siblings, 0 replies; 200+ results
From: ytomino @ 2018-06-04 4:42 UTC (permalink / raw)
On Monday, June 4, 2018 at 12:17:32 PM UTC+9, John Smith wrote:
> Hello,
>
> I found the following example:
>
> http://rosettacode.org/wiki/Execute_a_system_command#Ada
>
> And this is how I tried to adapt it to Linux:
>
>
>
>
>
> with Interfaces.C;
>
> with Ada.Text_IO; use Ada.Text_IO;
> with GNAT.OS_Lib; use GNAT.OS_Lib;
>
> procedure Sys_Command is
> Result : Integer;
> Arguments : Argument_List :=
> ( 1=> new String'("bash"),
> 2=> new String'("ls -l ~")
> );
> begin
> Spawn
> ( Program_Name => "bash",
> Args => Arguments,
> Output_File_Descriptor => Standout,
> Return_Code => Result
> );
> for Index in Arguments'Range loop
> Free (Arguments (Index)); -- Free the argument list
> end loop;
> end Sys_Command;
>
>
>
>
> The problem is that 'ls -l ~' is not executed correctly. I don't see any out put at all. What am I doing wrong?
"-c" switch is needed for bash to pass the subcommand.
Try to compare them in your interactive shell.
$ bash "ls -l ~"
$ bash -c "ls -l ~"
^ permalink raw reply [relevance 0%]
* Trying to execute a command from inside of Ada
@ 2018-06-04 3:17 2% John Smith
2018-06-04 4:42 0% ` ytomino
0 siblings, 1 reply; 200+ results
From: John Smith @ 2018-06-04 3:17 UTC (permalink / raw)
Hello,
I found the following example:
http://rosettacode.org/wiki/Execute_a_system_command#Ada
And this is how I tried to adapt it to Linux:
with Interfaces.C;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.OS_Lib; use GNAT.OS_Lib;
procedure Sys_Command is
Result : Integer;
Arguments : Argument_List :=
( 1=> new String'("bash"),
2=> new String'("ls -l ~")
);
begin
Spawn
( Program_Name => "bash",
Args => Arguments,
Output_File_Descriptor => Standout,
Return_Code => Result
);
for Index in Arguments'Range loop
Free (Arguments (Index)); -- Free the argument list
end loop;
end Sys_Command;
The problem is that 'ls -l ~' is not executed correctly. I don't see any out put at all. What am I doing wrong?
^ permalink raw reply [relevance 2%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-06-03 19:33 4% ` Dmitry A. Kazakov
2018-06-03 20:03 6% ` ytomino
@ 2018-06-03 20:37 4% ` ytomino
1 sibling, 0 replies; 200+ results
From: ytomino @ 2018-06-03 20:37 UTC (permalink / raw)
On Monday, June 4, 2018 at 4:33:20 AM UTC+9, Dmitry A. Kazakov wrote:
> On 2018-06-03 20:31, ytomino wrote:
> > Perhaps, malloc is better than New_String in this case.
> >
> > function malloc (s : Interfaces.C.size_t) return Interfaces.C.Strings.chars_ptr
> > with Import, Convention => C;
>
> I had a case when that caused the application crashed.
>
> I guess it was because of mixed Visual Studio and GCC run-times. The
> pointer returned by the malloc from one was freed in a third-party C
> library by another.
>
> --
> Regards,
> Dmitry A. Kazakov
> http://www.dmitry-kazakov.de
By my intuition, the crash is caused by not free but Update.
Because malloc does not set NUL.
So maybe is the length-checking in Update crashed?
If that is so, "Check => False" should be inserted into the first Update.
Update (..., Check => False);
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-06-03 19:33 4% ` Dmitry A. Kazakov
@ 2018-06-03 20:03 6% ` ytomino
2018-06-04 7:06 4% ` Dmitry A. Kazakov
2018-06-03 20:37 4% ` ytomino
1 sibling, 1 reply; 200+ results
From: ytomino @ 2018-06-03 20:03 UTC (permalink / raw)
On Monday, June 4, 2018 at 4:33:20 AM UTC+9, Dmitry A. Kazakov wrote:
> On 2018-06-03 20:31, ytomino wrote:
> > Perhaps, malloc is better than New_String in this case.
> >
> > function malloc (s : Interfaces.C.size_t) return Interfaces.C.Strings.chars_ptr
> > with Import, Convention => C;
>
> I had a case when that caused the application crashed.
>
> I guess it was because of mixed Visual Studio and GCC run-times. The
> pointer returned by the malloc from one was freed in a third-party C
> library by another.
>
> --
> Regards,
> Dmitry A. Kazakov
> http://www.dmitry-kazakov.de
What!?
New_String calls malloc in the end, too, in mingw runtime.
(It calls Memory_Alloc, Memory_Alloc is _gnat_malloc, and __gnat_malloc calls malloc.)
https://gcc.gnu.org/svn/gcc/trunk/gcc/ada/libgnat/i-cstrin.adb
https://gcc.gnu.org/svn/gcc/trunk/gcc/ada/libgnat/s-parame.ads
https://gcc.gnu.org/svn/gcc/trunk/gcc/ada/libgnat/s-memory__mingw.adb
If Interfaces.C.Strings.Free (malloc) is crashed, New_String would be same.
^ permalink raw reply [relevance 6%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-06-03 18:31 7% ` ytomino
@ 2018-06-03 19:33 4% ` Dmitry A. Kazakov
2018-06-03 20:03 6% ` ytomino
2018-06-03 20:37 4% ` ytomino
0 siblings, 2 replies; 200+ results
From: Dmitry A. Kazakov @ 2018-06-03 19:33 UTC (permalink / raw)
On 2018-06-03 20:31, ytomino wrote:
> Perhaps, malloc is better than New_String in this case.
>
> function malloc (s : Interfaces.C.size_t) return Interfaces.C.Strings.chars_ptr
> with Import, Convention => C;
I had a case when that caused the application crashed.
I guess it was because of mixed Visual Studio and GCC run-times. The
pointer returned by the malloc from one was freed in a third-party C
library by another.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-05-25 22:22 3% Interfaces.C.Strings chars_ptr memory management strategy NiGHTS
2018-05-26 2:52 4% ` Shark8
2018-05-30 13:10 3% ` Alejandro R. Mosteo
@ 2018-06-03 18:31 7% ` ytomino
2018-06-03 19:33 4% ` Dmitry A. Kazakov
2 siblings, 1 reply; 200+ results
From: ytomino @ 2018-06-03 18:31 UTC (permalink / raw)
Perhaps, malloc is better than New_String in this case.
function malloc (s : Interfaces.C.size_t) return Interfaces.C.Strings.chars_ptr
with Import, Convention => C;
^ permalink raw reply [relevance 7%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-05-31 10:34 4% ` Alejandro R. Mosteo
@ 2018-05-31 22:25 3% ` Randy Brukardt
2018-06-05 12:42 4% ` Alejandro R. Mosteo
0 siblings, 1 reply; 200+ results
From: Randy Brukardt @ 2018-05-31 22:25 UTC (permalink / raw)
"Alejandro R. Mosteo" <alejandro@mosteo.com> wrote in message
news:peoj3f$8ti$1@dont-email.me...
> On 30/05/2018 21:56, Randy Brukardt wrote:
...
>>> Is the in-place built limited tagged type guaranteed to live during the
>>> call to the C function? (In other words, is the pointer safe (as long as
>>> the C side does not make a copy, of course)?
>>
>> That depends on the master of the parameter. I believe that the master of
>> a
>> parameter is that of the call (each call being it's own master for the
>> parameters) -- you'd have to look in 7.6.1 to be sure. So they stay
>> around
>> as long as the call.
>
> Might that be 6.4.1? 7 deals with packages (in 2012).
No. The rules for masters are defined with finalization in 7.6, and
specifically in 7.6.1(3/2). The single middle sentence in that paragraph (a
classic RM run-on sentence) defines completely where every object in an Ada
program is finalized -- and also defines large parts of the accessibility
and tasking models (which mainly follow the same master rules).
> Although it was too dense for me anyway :(
That's why I didn't want to give you a definitive answer. It takes a lot of
mental effort to do that, and I need to save that effort for things people
pay me to do. ;-)
...
>> Foo (Bar (Ugh (...))
>>
>> The result of Ugh is finalized when the call to Bar ends, so if it is
>> somehow in the result of Bar, you could get trouble in Foo. You can avoid
>> that by declaring the parameter "aliased" (those belong to the *result*
>> of
>> the function, so they stick around longer).
>
> The parameter is actually aliased already. So I hope your impressions are
> right and I'm on firm ground then, a pleasant surprise.
Turns out I was wrong: 7.6.1(3/2) says that only the outer function call is
a master. So there is no problem in even the case I suggested.
Randy.
^ permalink raw reply [relevance 3%]
* Re: Header-only Ada libraries...
@ 2018-05-31 13:34 3% ` Jeffrey R. Carter
0 siblings, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2018-05-31 13:34 UTC (permalink / raw)
On 05/31/2018 02:18 PM, joakimds@kth.se wrote:
>
> A trick that is GNAT specific that I use in the Ada binding to Wayland (https://github.com/joakim-strandberg/wayland_ada_binding) on Linux (and which might work on other platforms too when using GNAT) is using the standard String type where the input argument is char*. In the C code the function wl_display_connect has the following signature:
I don't think it's GNAT specific. This is implementation advice in ARM B.3. But
I would recommend using the types in Interfaces.C whenever possible when
interfacing with C. In this case, that would be Interfaces.C.char_array.
When there is no suitable type in Interfaces.C, I recommend only using types
that have been declared with convention C.
--
Jeff Carter
"If a sperm is wasted, God gets quite irate."
Monty Python's the Meaning of Life
56
^ permalink raw reply [relevance 3%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-05-30 19:56 3% ` Randy Brukardt
@ 2018-05-31 10:34 4% ` Alejandro R. Mosteo
2018-05-31 22:25 3% ` Randy Brukardt
0 siblings, 1 reply; 200+ results
From: Alejandro R. Mosteo @ 2018-05-31 10:34 UTC (permalink / raw)
On 30/05/2018 21:56, Randy Brukardt wrote:
> "Alejandro R. Mosteo" <alejandro@mosteo.com> wrote in message
> news:pem7s0$go4$1@dont-email.me...
>> On 26/05/2018 00:22, NiGHTS wrote:
>>> I am creating a binding to a C library that requires me to repeat the
>>> same function but with a string parameter that changes on each call. I
>>> don't want to have to keep creating and destroying string memory for all
>>> of these function calls. I would like to create the memory for the string
>>> once, allocate enough space so it doesn't need to grow, and reuse that
>>> memory for the function call every time I need to pass a new string to
>>> it.
>>
>> I'm currently using this:
>>
>> https://github.com/mosteo/cstrings
>>
>> which is not what you want since it allocates on every instance (although
>> on the stack). Still, it might give you some ideas.
>>
>> I'm still unsure if that's 100% guaranteed to be safe; for the experts out
>> here, the question is, in a call to a C function like this:
>>
>> Call_To_C_Function
>> (Function_That_Returns_A_Limited_Tagged_Type (...)
>> .Subprogram_That_Returns_A_C_Pointer_To_Data_In_The_Tagged_Type);
>>
>> Is the in-place built limited tagged type guaranteed to live during the
>> call to the C function? (In other words, is the pointer safe (as long as
>> the C side does not make a copy, of course)?
>
> That depends on the master of the parameter. I believe that the master of a
> parameter is that of the call (each call being it's own master for the
> parameters) -- you'd have to look in 7.6.1 to be sure. So they stay around
> as long as the call.
Might that be 6.4.1? 7 deals with packages (in 2012).
Although it was too dense for me anyway :(
> If that wasn't true, passing an aggregate could have the temporary object
> freed/finalized before the call ended, which would be a disaster.
>
>> My suspicion is that once the subprogram returns the pointer, the limited
>> type can be optimized away before the call to the C side. It's not what
>> I'm seeing now, but I don't want to depend on an erroneous assumption.
>
> Don't think this is a problem in general -- and the result of a function
> does *not* belong to the master of the call but rather the enclosing one
> (else you couldn't use it before it went away). You might be able to get it
> with nested calls:
>
> Foo (Bar (Ugh (...))
>
> The result of Ugh is finalized when the call to Bar ends, so if it is
> somehow in the result of Bar, you could get trouble in Foo. You can avoid
> that by declaring the parameter "aliased" (those belong to the *result* of
> the function, so they stick around longer).
The parameter is actually aliased already. So I hope your impressions are
right and I'm on firm ground then, a pleasant surprise.
Thanks,
Alex.
>
> Randy.
>
>
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-05-30 13:10 3% ` Alejandro R. Mosteo
@ 2018-05-30 19:56 3% ` Randy Brukardt
2018-05-31 10:34 4% ` Alejandro R. Mosteo
0 siblings, 1 reply; 200+ results
From: Randy Brukardt @ 2018-05-30 19:56 UTC (permalink / raw)
"Alejandro R. Mosteo" <alejandro@mosteo.com> wrote in message
news:pem7s0$go4$1@dont-email.me...
> On 26/05/2018 00:22, NiGHTS wrote:
>> I am creating a binding to a C library that requires me to repeat the
>> same function but with a string parameter that changes on each call. I
>> don't want to have to keep creating and destroying string memory for all
>> of these function calls. I would like to create the memory for the string
>> once, allocate enough space so it doesn't need to grow, and reuse that
>> memory for the function call every time I need to pass a new string to
>> it.
>
> I'm currently using this:
>
> https://github.com/mosteo/cstrings
>
> which is not what you want since it allocates on every instance (although
> on the stack). Still, it might give you some ideas.
>
> I'm still unsure if that's 100% guaranteed to be safe; for the experts out
> here, the question is, in a call to a C function like this:
>
> Call_To_C_Function
> (Function_That_Returns_A_Limited_Tagged_Type (...)
> .Subprogram_That_Returns_A_C_Pointer_To_Data_In_The_Tagged_Type);
>
> Is the in-place built limited tagged type guaranteed to live during the
> call to the C function? (In other words, is the pointer safe (as long as
> the C side does not make a copy, of course)?
That depends on the master of the parameter. I believe that the master of a
parameter is that of the call (each call being it's own master for the
parameters) -- you'd have to look in 7.6.1 to be sure. So they stay around
as long as the call.
If that wasn't true, passing an aggregate could have the temporary object
freed/finalized before the call ended, which would be a disaster.
> My suspicion is that once the subprogram returns the pointer, the limited
> type can be optimized away before the call to the C side. It's not what
> I'm seeing now, but I don't want to depend on an erroneous assumption.
Don't think this is a problem in general -- and the result of a function
does *not* belong to the master of the call but rather the enclosing one
(else you couldn't use it before it went away). You might be able to get it
with nested calls:
Foo (Bar (Ugh (...))
The result of Ugh is finalized when the call to Bar ends, so if it is
somehow in the result of Bar, you could get trouble in Foo. You can avoid
that by declaring the parameter "aliased" (those belong to the *result* of
the function, so they stick around longer).
Randy.
^ permalink raw reply [relevance 3%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-05-25 22:22 3% Interfaces.C.Strings chars_ptr memory management strategy NiGHTS
2018-05-26 2:52 4% ` Shark8
@ 2018-05-30 13:10 3% ` Alejandro R. Mosteo
2018-05-30 19:56 3% ` Randy Brukardt
2018-06-03 18:31 7% ` ytomino
2 siblings, 1 reply; 200+ results
From: Alejandro R. Mosteo @ 2018-05-30 13:10 UTC (permalink / raw)
On 26/05/2018 00:22, NiGHTS wrote:
> I am creating a binding to a C library that requires me to repeat the same function but with a string parameter that changes on each call. I don't want to have to keep creating and destroying string memory for all of these function calls. I would like to create the memory for the string once, allocate enough space so it doesn't need to grow, and reuse that memory for the function call every time I need to pass a new string to it.
I'm currently using this:
https://github.com/mosteo/cstrings
which is not what you want since it allocates on every instance (although
on the stack). Still, it might give you some ideas.
I'm still unsure if that's 100% guaranteed to be safe; for the experts
out here, the question is, in a call to a C function like this:
Call_To_C_Function
(Function_That_Returns_A_Limited_Tagged_Type (...)
.Subprogram_That_Returns_A_C_Pointer_To_Data_In_The_Tagged_Type);
Is the in-place built limited tagged type guaranteed to live during the
call to the C function? (In other words, is the pointer safe (as long as
the C side does not make a copy, of course)?
My suspicion is that once the subprogram returns the pointer, the limited
type can be optimized away before the call to the C side. It's not what
I'm seeing now, but I don't want to depend on an erroneous assumption.
Alex.
>
> The trick here is that whatever strategy I use must be compatible with C, so for instance using a storage pool would not be directly compatible with the C binding.
>
> Here is just a quick and sloppy idea I had on how to tackle my problem.
>
> str : chars_ptr := New_String (" ");
> ...
> Update (Item => str, Offset => 0, Str => "Some Param");
> ...
> Update (Item => str, Offset => 0, Str => "Some Other Param");
> ...
> Free (str);
>
> I find the first line quite ugly. I'm sure there is an easier way to create a large empty string but I can't seem to come up with an elegant way to do it.
>
> As far as the Update commands, will it act like strcpy() in C? If so I'd guess that this is an efficient technique.
>
> Thanks for your help!
>
^ permalink raw reply [relevance 3%]
* Re: Strings with discriminated records
2018-05-27 22:44 0% ` NiGHTS
2018-05-28 7:29 3% ` Dmitry A. Kazakov
@ 2018-05-28 7:42 2% ` Simon Wright
1 sibling, 0 replies; 200+ results
From: Simon Wright @ 2018-05-28 7:42 UTC (permalink / raw)
NiGHTS <nights@unku.us> writes:
> I confirmed with an Ada.Text_IO.Put_Line() that Finalize was called
> three times. I then disabled Finalize and created an explicitly called
> Finalize2 function and it worked fine. It's weird though because my
> program only elaborated the object once, so why did it finalize three
> times?
You need to read ARM7.6, in particular (17):
http://www.ada-auth.org/standards/rm12_w_tc1/html/RM-7-6.html#p17
Disregarding for the moment any "assignment" that might happen in
computing the result of Create, & looking at
declare
M : Nights.Message := Nights.Create ("Hello World");
begin
null;
end;
First, the Create call makes an anonymous object.
Then, M is in theory finalized, but this is likely optimised away.
Then, the bits of the anonymous object are copied into M. This is a
"shallow copy". [***]
Then, the anonymous object is finalized, which frees
<anonymous>.Cstr. HOWEVER, M.Cstr still contains the same value, which
means it's pointing to deallocated memory.
Then, on exit from the declare block, M is finalized, and Finalize tries
to free M.Cstr again. Oops.
This is always going to happen if you make a shallow copy of something
which contains plain allocated memory.
As Dmitry said upthread, you need an Adjust, which makes a deep copy of
the plain allocated memory, immediately after [***] above:
procedure Adjust (M : in out Message) is
use Interfaces.C.Strings;
begin
M.Cstr := New_Char_Array (Value (M.Cstr));
end Adjust;
> I tried wrapping the body of finalize in a condition to force it to
> run only once, yet it still managed to run it again ignoring the
> boolean.
If the boolean was in Message, the same argument as above applies.
> I'm perplexed. Not sure if I should ever trust
> Ada.Finalization.Controlled.
As with most things, not until you know how to use it.
^ permalink raw reply [relevance 2%]
* Re: Strings with discriminated records
2018-05-27 22:44 0% ` NiGHTS
@ 2018-05-28 7:29 3% ` Dmitry A. Kazakov
2018-05-28 7:42 2% ` Simon Wright
1 sibling, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2018-05-28 7:29 UTC (permalink / raw)
On 2018-05-28 00:44, NiGHTS wrote:
> I confirmed with an Ada.Text_IO.Put_Line() that Finalize was called three times.
It is called for three different objects.
> I then disabled Finalize and created an explicitly called Finalize2 function and it worked fine. It's weird though because my program only elaborated the object once, so why did it finalize three times?
Because you have three copies of the controlled object. Here is a fixed
implementation with Adjust:
-------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with Ada.Finalization;
procedure Test is
package P is
type C_String is new Ada.Finalization.Controlled with private;
function Create (Text : String) return C_String;
overriding procedure Adjust (Text : in out C_String);
overriding procedure Finalize (Text : in out C_String);
private
type C_String is new Ada.Finalization.Controlled with record
Ptr : chars_ptr;
end record;
end P;
package body P is
function Create (Text : String) return C_String is
begin
Put_Line ("Creating:" & Text);
return (Ada.Finalization.Controlled with New_String (Text));
end Create;
procedure Adjust (Text : in out C_String) is
begin
if Text.Ptr = Null_Ptr then
Put_Line ("Copying null string:");
else
Put_Line ("Copying:" & Value (Text.Ptr));
Text.Ptr := New_String (Value (Text.Ptr));
end if;
end Adjust;
procedure Finalize (Text : in out C_String) is
begin
if Text.Ptr = Null_Ptr then
Put_Line ("Finalizing null string:");
else
Put_Line ("Finalizing:" & Value (Text.Ptr));
Free (Text.Ptr);
end if;
end Finalize;
end P;
use P;
S1 : C_String := Create ("Hello");
begin
null;
end Test;
-------------------------------------------------
It prints:
Creating:Hello
Copying:Hello
Finalizing:Hello
Copying:Hello
Finalizing:Hello
Finalizing:Hello
Now the meaning of this:
Creating:Hello -- Create
Copying:Hello -- Copy local object (aggregate?) in Create
Finalizing:Hello -- Finalize the local object in Create
Copying:Hello -- Copy result of Create to S1
Finalizing:Hello -- Finalize the result of Create
Finalizing:Hello -- Finalize S1
> I tried wrapping the body of finalize in a condition to force it to run only once, yet it still managed to run it again ignoring the boolean. I'm perplexed. Not sure if I should ever trust Ada.Finalization.Controlled.
Yes, see the example.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 3%]
* Re: Strings with discriminated records
2018-05-28 1:44 0% ` Jere
@ 2018-05-28 3:05 0% ` NiGHTS
0 siblings, 0 replies; 200+ results
From: NiGHTS @ 2018-05-28 3:05 UTC (permalink / raw)
On Sunday, May 27, 2018 at 9:44:22 PM UTC-4, Jere wrote:
> On Sunday, May 27, 2018 at 7:08:03 PM UTC-4, NiGHTS wrote:
> > On Sunday, May 27, 2018 at 2:07:37 PM UTC-4, Simon Wright wrote:
> > >
> > > > I've expanded my example to include a strange run-time crash I am getting.
> > > >
> > > > Type Message (Length : Positive) is new Ada.Finalization.Controlled with record
> > > > Text : String (1 .. Length);
> > > > Cstr : Interfaces.C.Strings.chars_ptr;
> > > > end record;
> > > >
> > > > function Create (Value : String) return Message is
> > > > begin
> > > > return (
> > > > Ada.Finalization.Controlled with Length => Value'Length,
> > > > Text => Value,
> > > > Cstr => Interfaces.C.Strings.New_String (Value)
> > > > );
> > > > end Create;
> > > >
> > > > procedure Finalize (
> > > > M : in out Message
> > > > ) is
> > > > begin
> > > > Interfaces.C.Strings.Free ( M.Cstr ); -- Crashes here
> > > > end;
> > > >
> > > > declare
> > > > M : Message := Create ("Hello World");
> > > > begin
> > > > null;
> > > > end;
> > > >
> > > > Why does my program crash on Finalization?
> > >
> > > Maybe Finalize is getting called twice? You should set M.Cstr to
> > > Null_Ptr after freeing it.
> >
> > It doesn't work. On each automatic call of Finalize, the object data is reset. Its very strange.
>
> It won't work unless you have an appropriate Adjust. Since your object is
> controlled (and not limited controlled), the compiler is making temporaries,
> each with their own copy of the pointer (someone else mentioned this above).
> Each temporary will be finalized and each will have their own copy of
> the pointer, so nulling it only nulls that objects copy and not the others.
>
> As stated above by someone else, you'll either have to do a clone with
> separately allocated memory or some sort of reference count that only
> allows finalize to call free when the last copy calls finalize (and
> ignores the others calls).
>
> Dmitry has an example of how to do this with an intrusive reference
> count with his handles/objects library (see his website).
>
> Making the type limited controlled is also a solution since it cannot
> make temporaries for one like it can a regular controlled object.
Yes, I understand now. I will do some tests and see what works for me. Thank you.
^ permalink raw reply [relevance 0%]
* Re: Strings with discriminated records
2018-05-27 23:08 0% ` NiGHTS
@ 2018-05-28 1:44 0% ` Jere
2018-05-28 3:05 0% ` NiGHTS
0 siblings, 1 reply; 200+ results
From: Jere @ 2018-05-28 1:44 UTC (permalink / raw)
On Sunday, May 27, 2018 at 7:08:03 PM UTC-4, NiGHTS wrote:
> On Sunday, May 27, 2018 at 2:07:37 PM UTC-4, Simon Wright wrote:
> >
> > > I've expanded my example to include a strange run-time crash I am getting.
> > >
> > > Type Message (Length : Positive) is new Ada.Finalization.Controlled with record
> > > Text : String (1 .. Length);
> > > Cstr : Interfaces.C.Strings.chars_ptr;
> > > end record;
> > >
> > > function Create (Value : String) return Message is
> > > begin
> > > return (
> > > Ada.Finalization.Controlled with Length => Value'Length,
> > > Text => Value,
> > > Cstr => Interfaces.C.Strings.New_String (Value)
> > > );
> > > end Create;
> > >
> > > procedure Finalize (
> > > M : in out Message
> > > ) is
> > > begin
> > > Interfaces.C.Strings.Free ( M.Cstr ); -- Crashes here
> > > end;
> > >
> > > declare
> > > M : Message := Create ("Hello World");
> > > begin
> > > null;
> > > end;
> > >
> > > Why does my program crash on Finalization?
> >
> > Maybe Finalize is getting called twice? You should set M.Cstr to
> > Null_Ptr after freeing it.
>
> It doesn't work. On each automatic call of Finalize, the object data is reset. Its very strange.
It won't work unless you have an appropriate Adjust. Since your object is
controlled (and not limited controlled), the compiler is making temporaries,
each with their own copy of the pointer (someone else mentioned this above).
Each temporary will be finalized and each will have their own copy of
the pointer, so nulling it only nulls that objects copy and not the others.
As stated above by someone else, you'll either have to do a clone with
separately allocated memory or some sort of reference count that only
allows finalize to call free when the last copy calls finalize (and
ignores the others calls).
Dmitry has an example of how to do this with an intrusive reference
count with his handles/objects library (see his website).
Making the type limited controlled is also a solution since it cannot
make temporaries for one like it can a regular controlled object.
^ permalink raw reply [relevance 0%]
* Re: Strings with discriminated records
2018-05-27 18:07 0% ` Simon Wright
@ 2018-05-27 23:08 0% ` NiGHTS
2018-05-28 1:44 0% ` Jere
0 siblings, 1 reply; 200+ results
From: NiGHTS @ 2018-05-27 23:08 UTC (permalink / raw)
On Sunday, May 27, 2018 at 2:07:37 PM UTC-4, Simon Wright wrote:
>
> > I've expanded my example to include a strange run-time crash I am getting.
> >
> > Type Message (Length : Positive) is new Ada.Finalization.Controlled with record
> > Text : String (1 .. Length);
> > Cstr : Interfaces.C.Strings.chars_ptr;
> > end record;
> >
> > function Create (Value : String) return Message is
> > begin
> > return (
> > Ada.Finalization.Controlled with Length => Value'Length,
> > Text => Value,
> > Cstr => Interfaces.C.Strings.New_String (Value)
> > );
> > end Create;
> >
> > procedure Finalize (
> > M : in out Message
> > ) is
> > begin
> > Interfaces.C.Strings.Free ( M.Cstr ); -- Crashes here
> > end;
> >
> > declare
> > M : Message := Create ("Hello World");
> > begin
> > null;
> > end;
> >
> > Why does my program crash on Finalization?
>
> Maybe Finalize is getting called twice? You should set M.Cstr to
> Null_Ptr after freeing it.
It doesn't work. On each automatic call of Finalize, the object data is reset. Its very strange.
^ permalink raw reply [relevance 0%]
* Re: Strings with discriminated records
2018-05-27 18:25 0% ` Dmitry A. Kazakov
@ 2018-05-27 22:44 0% ` NiGHTS
2018-05-28 7:29 3% ` Dmitry A. Kazakov
2018-05-28 7:42 2% ` Simon Wright
0 siblings, 2 replies; 200+ results
From: NiGHTS @ 2018-05-27 22:44 UTC (permalink / raw)
On Sunday, May 27, 2018 at 2:25:02 PM UTC-4, Dmitry A. Kazakov wrote:
> On 2018-05-27 19:11, NiGHTS wrote:
> > I've expanded my example to include a strange run-time crash I am getting.
> >
> > Type Message (Length : Positive) is new Ada.Finalization.Controlled with record
> > Text : String (1 .. Length);
> > Cstr : Interfaces.C.Strings.chars_ptr;
> > end record;
> >
> > function Create (Value : String) return Message is
> > begin
> > return (
> > Ada.Finalization.Controlled with Length => Value'Length,
> > Text => Value,
> > Cstr => Interfaces.C.Strings.New_String (Value)
> > );
> > end Create;
> >
> > procedure Finalize (
> > M : in out Message
> > ) is
> > begin
> > Interfaces.C.Strings.Free ( M.Cstr ); -- Crashes here
> > end;
> >
> > declare
> > M : Message := Create ("Hello World");
> > begin
> > null;
> > end;
> >
> > Why does my program crash on Finalization?
>
> Because it is wrong.
>
> You have a controlled object which gets copied all the time. It means
> that the pointer Cstr is shared by all copies and is freed multiple
> times. Either
>
> 1. You must override Adjust and make a new string for the result.
>
> or
>
> 2. You could deploy some reference counting schema cloning the content
> when the string at the pointer is updated. This is how dynamic strings
> are usually implemented.
>
> P.S. If you want C-compatible strings use char_array, it is exactly the
> thing you need.
>
> --
> Regards,
> Dmitry A. Kazakov
> http://www.dmitry-kazakov.de
I confirmed with an Ada.Text_IO.Put_Line() that Finalize was called three times. I then disabled Finalize and created an explicitly called Finalize2 function and it worked fine. It's weird though because my program only elaborated the object once, so why did it finalize three times?
I tried wrapping the body of finalize in a condition to force it to run only once, yet it still managed to run it again ignoring the boolean. I'm perplexed. Not sure if I should ever trust Ada.Finalization.Controlled.
^ permalink raw reply [relevance 0%]
* Re: Strings with discriminated records
2018-05-27 17:11 3% ` NiGHTS
2018-05-27 18:07 0% ` Simon Wright
@ 2018-05-27 18:25 0% ` Dmitry A. Kazakov
2018-05-27 22:44 0% ` NiGHTS
1 sibling, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2018-05-27 18:25 UTC (permalink / raw)
On 2018-05-27 19:11, NiGHTS wrote:
> I've expanded my example to include a strange run-time crash I am getting.
>
> Type Message (Length : Positive) is new Ada.Finalization.Controlled with record
> Text : String (1 .. Length);
> Cstr : Interfaces.C.Strings.chars_ptr;
> end record;
>
> function Create (Value : String) return Message is
> begin
> return (
> Ada.Finalization.Controlled with Length => Value'Length,
> Text => Value,
> Cstr => Interfaces.C.Strings.New_String (Value)
> );
> end Create;
>
> procedure Finalize (
> M : in out Message
> ) is
> begin
> Interfaces.C.Strings.Free ( M.Cstr ); -- Crashes here
> end;
>
> declare
> M : Message := Create ("Hello World");
> begin
> null;
> end;
>
> Why does my program crash on Finalization?
Because it is wrong.
You have a controlled object which gets copied all the time. It means
that the pointer Cstr is shared by all copies and is freed multiple
times. Either
1. You must override Adjust and make a new string for the result.
or
2. You could deploy some reference counting schema cloning the content
when the string at the pointer is updated. This is how dynamic strings
are usually implemented.
P.S. If you want C-compatible strings use char_array, it is exactly the
thing you need.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Strings with discriminated records
2018-05-27 17:11 3% ` NiGHTS
@ 2018-05-27 18:07 0% ` Simon Wright
2018-05-27 23:08 0% ` NiGHTS
2018-05-27 18:25 0% ` Dmitry A. Kazakov
1 sibling, 1 reply; 200+ results
From: Simon Wright @ 2018-05-27 18:07 UTC (permalink / raw)
NiGHTS <nights@unku.us> writes:
> I've expanded my example to include a strange run-time crash I am getting.
>
> Type Message (Length : Positive) is new Ada.Finalization.Controlled with record
> Text : String (1 .. Length);
> Cstr : Interfaces.C.Strings.chars_ptr;
> end record;
>
> function Create (Value : String) return Message is
> begin
> return (
> Ada.Finalization.Controlled with Length => Value'Length,
> Text => Value,
> Cstr => Interfaces.C.Strings.New_String (Value)
> );
> end Create;
>
> procedure Finalize (
> M : in out Message
> ) is
> begin
> Interfaces.C.Strings.Free ( M.Cstr ); -- Crashes here
> end;
>
> declare
> M : Message := Create ("Hello World");
> begin
> null;
> end;
>
> Why does my program crash on Finalization?
Maybe Finalize is getting called twice? You should set M.Cstr to
Null_Ptr after freeing it.
^ permalink raw reply [relevance 0%]
* Re: Strings with discriminated records
@ 2018-05-27 17:11 3% ` NiGHTS
2018-05-27 18:07 0% ` Simon Wright
2018-05-27 18:25 0% ` Dmitry A. Kazakov
0 siblings, 2 replies; 200+ results
From: NiGHTS @ 2018-05-27 17:11 UTC (permalink / raw)
I've expanded my example to include a strange run-time crash I am getting.
Type Message (Length : Positive) is new Ada.Finalization.Controlled with record
Text : String (1 .. Length);
Cstr : Interfaces.C.Strings.chars_ptr;
end record;
function Create (Value : String) return Message is
begin
return (
Ada.Finalization.Controlled with Length => Value'Length,
Text => Value,
Cstr => Interfaces.C.Strings.New_String (Value)
);
end Create;
procedure Finalize (
M : in out Message
) is
begin
Interfaces.C.Strings.Free ( M.Cstr ); -- Crashes here
end;
declare
M : Message := Create ("Hello World");
begin
null;
end;
Why does my program crash on Finalization?
^ permalink raw reply [relevance 3%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-05-26 12:44 4% ` NiGHTS
@ 2018-05-26 13:56 4% ` Shark8
0 siblings, 0 replies; 200+ results
From: Shark8 @ 2018-05-26 13:56 UTC (permalink / raw)
On Saturday, May 26, 2018 at 6:45:01 AM UTC-6, NiGHTS wrote:
> On Friday, May 25, 2018 at 10:52:55 PM UTC-4, Shark8 wrote:
> > On Friday, May 25, 2018 at 4:22:13 PM UTC-6, NiGHTS wrote:
> > >
> > > Here is just a quick and sloppy idea I had on how to tackle my problem.
> > >
> > > str : chars_ptr := New_String (" ");
> > >
> > > I find the first line quite ugly. I'm sure there is an easier way to create a large empty string but I can't seem to come up with an elegant way to do it.
> >
> >
> > Something like this?
> > Big_String : chars_ptr := New_String( (1..200 => ' ') );
>
> Thanks, It was on the tip of my brain I just for some reason couldn't put it together quite right.
It happens.
If you're going to be using this a lot I'd recommend a generic-wrapper something like:
GENERIC
Max_Size : Natural;
FUNCTION Buffer_String Return Chars_Ptr;
FUNCTION Buffer_String Return Chars_Ptr IS
( New_String( (1..Max_Size => ' ') ) );
Or maybe a package.
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-05-26 2:52 4% ` Shark8
@ 2018-05-26 12:44 4% ` NiGHTS
2018-05-26 13:56 4% ` Shark8
0 siblings, 1 reply; 200+ results
From: NiGHTS @ 2018-05-26 12:44 UTC (permalink / raw)
On Friday, May 25, 2018 at 10:52:55 PM UTC-4, Shark8 wrote:
> On Friday, May 25, 2018 at 4:22:13 PM UTC-6, NiGHTS wrote:
> >
> > Here is just a quick and sloppy idea I had on how to tackle my problem.
> >
> > str : chars_ptr := New_String (" ");
> >
> > I find the first line quite ugly. I'm sure there is an easier way to create a large empty string but I can't seem to come up with an elegant way to do it.
>
>
> Something like this?
> Big_String : chars_ptr := New_String( (1..200 => ' ') );
Thanks, It was on the tip of my brain I just for some reason couldn't put it together quite right.
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C.Strings chars_ptr memory management strategy
2018-05-25 22:22 3% Interfaces.C.Strings chars_ptr memory management strategy NiGHTS
@ 2018-05-26 2:52 4% ` Shark8
2018-05-26 12:44 4% ` NiGHTS
2018-05-30 13:10 3% ` Alejandro R. Mosteo
2018-06-03 18:31 7% ` ytomino
2 siblings, 1 reply; 200+ results
From: Shark8 @ 2018-05-26 2:52 UTC (permalink / raw)
On Friday, May 25, 2018 at 4:22:13 PM UTC-6, NiGHTS wrote:
>
> Here is just a quick and sloppy idea I had on how to tackle my problem.
>
> str : chars_ptr := New_String (" ");
>
> I find the first line quite ugly. I'm sure there is an easier way to create a large empty string but I can't seem to come up with an elegant way to do it.
Something like this?
Big_String : chars_ptr := New_String( (1..200 => ' ') );
^ permalink raw reply [relevance 4%]
* Interfaces.C.Strings chars_ptr memory management strategy
@ 2018-05-25 22:22 3% NiGHTS
2018-05-26 2:52 4% ` Shark8
` (2 more replies)
0 siblings, 3 replies; 200+ results
From: NiGHTS @ 2018-05-25 22:22 UTC (permalink / raw)
I am creating a binding to a C library that requires me to repeat the same function but with a string parameter that changes on each call. I don't want to have to keep creating and destroying string memory for all of these function calls. I would like to create the memory for the string once, allocate enough space so it doesn't need to grow, and reuse that memory for the function call every time I need to pass a new string to it.
The trick here is that whatever strategy I use must be compatible with C, so for instance using a storage pool would not be directly compatible with the C binding.
Here is just a quick and sloppy idea I had on how to tackle my problem.
str : chars_ptr := New_String (" ");
...
Update (Item => str, Offset => 0, Str => "Some Param");
...
Update (Item => str, Offset => 0, Str => "Some Other Param");
...
Free (str);
I find the first line quite ugly. I'm sure there is an easier way to create a large empty string but I can't seem to come up with an elegant way to do it.
As far as the Update commands, will it act like strcpy() in C? If so I'd guess that this is an efficient technique.
Thanks for your help!
^ permalink raw reply [relevance 3%]
* Re: ANN: Cortex GNAT RTS 20180419
2018-04-29 11:50 1% ` Simon Wright
@ 2018-05-01 23:47 0% ` Jere
0 siblings, 0 replies; 200+ results
From: Jere @ 2018-05-01 23:47 UTC (permalink / raw)
On Sunday, April 29, 2018 at 7:51:02 AM UTC-4, Simon Wright wrote:
> Jere writes:
>
> > On Saturday, April 28, 2018 at 12:13:14 PM UTC-4, Simon Wright wrote:
> >> There are three parallel releases at Github[1], for
> >>
> >> * GNAT GPL 2016/GCC 6
> >> * GCC 7
> >> * GNAT GPL 2017
> >>
> >> (three, because of changes to the interface between the compiler and the
> >> RTS).
> >>
> >> There's not much user-visible change from the last GCC 7 release[2],
> >> except that all but 2k of free store is available for the heap (the 2k
> >> is used for startup and interrupt stack).
> >>
> >> [1] https://github.com/simonjwright/cortex-gnat-rts/releases
> >> [2] https://github.com/simonjwright/cortex-gnat-rts/releases/tag/r20171016
> >
> > Thank you so much for keeping these up to date. Question:
> > Do you have any suggestions for pulling out a ZFP from this repo? I know
> > it isn't setup for that, but was curious if you had any tips for what
> > to mainly look for. I'm not so much worried about changing the ada files,
> > but I am more interested in what types of changes (if any) should I be
> > looking to do to the ld file, the gpr file, the xml file, etc. So mostly
> > the build system. I'm probably gonna try and mod the ardiuno one as it
> > is closest to my chip (an M0+). Right now, I have been pulling from one
> > of your older revisions where the ZFP was still available.
>
> One you haven't mentioned is system.ads.
>
> The barebones site https://wiki.osdev.org/Ada_Bare_bones wants you to
> put the restrictions in gnat.adc; personally I've put them in
> system.ads, that way you don't need to worry about whether your own code
> will see the restrictions.
>
> SNIPPED...
>
> You could change this to do byte-by-byte copy (AdaCore's RTSs do this in
> assembly) but of course your own code (and even libgnat) might use the
> libc functions (Interfaces.C uses memcpy), and there is no way I can see
> to tell GCC not to do this.
>
> Of course you could build your own, but I've got round this by using
> newlib. ISTR writing up how to build newlib for GNAT GPL, but where...?
> Anyway, I'm currently using newlib 2.5.0 and building as in [2]. I
> _think_ the gpl branch would do the job. FYI, newlib works out what cpu
> versions to build from the compiler capabilities, as reported by e.g.
> arm-eabi-gcc -print-multi-lib.
>
> [1] https://docs.adacore.com/gnathie_ug-docs/html/gnathie_ug/gnathie_ug/using_gnat_pro_features_relevant_to_high_integrity.html#array-and-record-assignments-and-the-high-integrity-profiles
> [2] https://sourceforge.net/u/simonjwright/buildingarmeabi/code/ci/default/tree/
Thank you very much. I currently supply the byte by byte copy. I don't have
any experience using newlib, but I'll take a look. Thanks again for all your
hard work.
^ permalink raw reply [relevance 0%]
* Re: ANN: Cortex GNAT RTS 20180419
@ 2018-04-29 11:50 1% ` Simon Wright
2018-05-01 23:47 0% ` Jere
0 siblings, 1 reply; 200+ results
From: Simon Wright @ 2018-04-29 11:50 UTC (permalink / raw)
Jere <jhb.chat@gmail.com> writes:
> On Saturday, April 28, 2018 at 12:13:14 PM UTC-4, Simon Wright wrote:
>> There are three parallel releases at Github[1], for
>>
>> * GNAT GPL 2016/GCC 6
>> * GCC 7
>> * GNAT GPL 2017
>>
>> (three, because of changes to the interface between the compiler and the
>> RTS).
>>
>> There's not much user-visible change from the last GCC 7 release[2],
>> except that all but 2k of free store is available for the heap (the 2k
>> is used for startup and interrupt stack).
>>
>> [1] https://github.com/simonjwright/cortex-gnat-rts/releases
>> [2] https://github.com/simonjwright/cortex-gnat-rts/releases/tag/r20171016
>
> Thank you so much for keeping these up to date. Question:
> Do you have any suggestions for pulling out a ZFP from this repo? I know
> it isn't setup for that, but was curious if you had any tips for what
> to mainly look for. I'm not so much worried about changing the ada files,
> but I am more interested in what types of changes (if any) should I be
> looking to do to the ld file, the gpr file, the xml file, etc. So mostly
> the build system. I'm probably gonna try and mod the ardiuno one as it
> is closest to my chip (an M0+). Right now, I have been pulling from one
> of your older revisions where the ZFP was still available.
One you haven't mentioned is system.ads.
The barebones site https://wiki.osdev.org/Ada_Bare_bones wants you to
put the restrictions in gnat.adc; personally I've put them in
system.ads, that way you don't need to worry about whether your own code
will see the restrictions.
The ld script will need changing to match your board's memory map; also,
maybe, the ENTRY symbol. Not sure about the EXTERNs either.
You'll need to change runtime.xml to specify the right compiler switches
(when I give GCC8 -mcpu=cortex-m0plus it adds -mfloat-abi=soft -mthumb
-march=armv6-m automatically (from inspection of the .ali)).
build_runtime.gpr clearly won't need to reference FreeRTOS! and the
Source_Dirs will clearly change.
> Also, 2 other questions:
> If I do get something working, do I use your licensing statement in the
> files as is, or should I modify it if I modify the files? I do plan
> on modifying quite a few of the ada ones to fit with my chip, but I had
> noticed you seemed to use the vanilla FSF copyright in your license
> statement, even though I assume you wrote some of the code in the file.
I used the FSF copyright because I've assigned copyright to the FSF
(#1016382). If you change something, I believe you can add your
copyright, so long as you redistribute on the same terms.
> It looks like you most likely use gcc for some intrinsics like memcpy.
> Do I need to worry about licensing issues if I build with GNAT GPL 2017
> using a modified version of your RTS if it links in functions like memcpy?
> I can supply my own if so, they just won't be as efficient if I do.
libgcc is used for things such as long addition, multiplication etc not
supported by the hardware.
GCC uses functions normally supplied by libc as discussed in [1]. The
only part of the RTS that this affects is Startup, in
-- Copy data to SRAM
Data_In_Sram := Data_In_Flash;
-- Initialize BSS in SRAM
Bss := (others => 0);
(the second array assignment uses memset()).
You could change this to do byte-by-byte copy (AdaCore's RTSs do this in
assembly) but of course your own code (and even libgnat) might use the
libc functions (Interfaces.C uses memcpy), and there is no way I can see
to tell GCC not to do this.
Of course you could build your own, but I've got round this by using
newlib. ISTR writing up how to build newlib for GNAT GPL, but where...?
Anyway, I'm currently using newlib 2.5.0 and building as in [2]. I
_think_ the gpl branch would do the job. FYI, newlib works out what cpu
versions to build from the compiler capabilities, as reported by e.g.
arm-eabi-gcc -print-multi-lib.
[1] https://docs.adacore.com/gnathie_ug-docs/html/gnathie_ug/gnathie_ug/using_gnat_pro_features_relevant_to_high_integrity.html#array-and-record-assignments-and-the-high-integrity-profiles
[2] https://sourceforge.net/u/simonjwright/buildingarmeabi/code/ci/default/tree/
^ permalink raw reply [relevance 1%]
* Re: non-local pointer cannot point to local object
2018-02-23 8:54 3% non-local pointer cannot point to local object artium
@ 2018-02-23 9:22 0% ` J-P. Rosen
0 siblings, 0 replies; 200+ results
From: J-P. Rosen @ 2018-02-23 9:22 UTC (permalink / raw)
Le 23/02/2018 à 09:54, artium@nihamkin.com a écrit :
> Can someone explain why I get "non-local pointer cannot point to
> local object" error, even though it looks like "Arr" and "Arr_Access"
> have the same accessibility level?
> Can I overcome the problem without dynamically allocating memory and without using "Unchecked_Access"?
>
> with Interfaces.C;
> with Interfaces.C.Strings;
>
> procedure X is
>
> type Integer_Access is access all Integer;
>
> Arr_Access : Interfaces.C.Strings.char_array_access;
> Arr : aliased Interfaces.C.char_array := Interfaces.C.To_C ("From");
>
> A : Integer_Access;
> I : aliased Integer := 6;
>
> begin
>
> Arr_Access := Arr'Access;
> A := I'Access;
>
> end X;
>
What counts for accessibility is the place where the type of the object
is declared, not where the object itself is declared. In your case,
char_array_access is a global type, therefore you cannot assign a
pointer to a local variable. Otherwise, Arr_Access could later be
assigned to some global variable, and you would end up with a global
variable pointing to a local object. Using Unchecked_Access means that
you swear that you don't do such evil things.
Ada has this nice property that no object can survive to its type (no,
it's not obvious; I think this is not guaranteed by C++ - can anyone
confirm?). Therefore, when you exit the scope of an access type, you are
guaranteed that there is no more value of this type hanging around.
--
J-P. Rosen
Adalog
2 rue du Docteur Lombard, 92441 Issy-les-Moulineaux CEDEX
Tel: +33 1 45 29 21 52, Fax: +33 1 45 29 25 00
http://www.adalog.fr
^ permalink raw reply [relevance 0%]
* non-local pointer cannot point to local object
@ 2018-02-23 8:54 3% artium
2018-02-23 9:22 0% ` J-P. Rosen
0 siblings, 1 reply; 200+ results
From: artium @ 2018-02-23 8:54 UTC (permalink / raw)
I am cross costing a question from SO since it looks like all the Ada experts are here and not there :)
https://stackoverflow.com/questions/48939845/non-local-pointer-cannot-point-to-local-object
Can someone explain why I get "non-local pointer cannot point to local object" error, even though it looks like "Arr" and "Arr_Access" have the same accessibility level?
Can I overcome the problem without dynamically allocating memory and without using "Unchecked_Access"?
with Interfaces.C;
with Interfaces.C.Strings;
procedure X is
type Integer_Access is access all Integer;
Arr_Access : Interfaces.C.Strings.char_array_access;
Arr : aliased Interfaces.C.char_array := Interfaces.C.To_C ("From");
A : Integer_Access;
I : aliased Integer := 6;
begin
Arr_Access := Arr'Access;
A := I'Access;
end X;
Thank you,
Artium
^ permalink raw reply [relevance 3%]
* Re: Convert between C "void*" pointer and an access
2017-10-11 23:12 3% ` Victor Porton
@ 2017-10-12 1:01 2% ` Victor Porton
0 siblings, 0 replies; 200+ results
From: Victor Porton @ 2017-10-12 1:01 UTC (permalink / raw)
Victor Porton wrote:
> Victor Porton wrote:
>
>> Victor Porton wrote:
>>
>>> What is the right way to convert between C "void*" pointer and an access
>>> to a tagged or class-wide type?
>>>
>>> Ada.Unchecked_Conversion seems to be what I need, but the access type
>>> may be "fat" and thus have another format than void*.
>>>
>>> I caught myself doing such unchecked conversions, but now I feel I did
>>> an error.
>>>
>>> For example, let
>>>
>>> type X_Type is abstract tagged null record;
>>>
>>> How to store X_Type'Class pointer in "void*" and convert them back and
>>> forth?
>>
>> It seems I've found a right solution of my problem. (Check if Ada RM
>> warrants that it works with every compiler!)
>>
>> Well, why it is not a standard package?! Why I need to invent something
>> "smart" every time I need to code?
>
> The package body was with a bug. Here there is corrected code:
[snip] (see code above in the thread)
Now I will prove that it works without errors with every conforming
compilers.
The below will describe how my package Convert_Void works. If in doubt,
consult the package source code.
First I should formulate the problem exactly:
Having an Ada object (we can restrict to tagged and class-wide types and
benefit from the fact that such objects 'Address "should produce a useful
result" (RM 13.3.16)), we need to transform it to C void pointer and pass to
C code; the C code should be able to call Ada code (e.g. through subprogram
access) and pass the pointer back and the Ada code should be able to work
with the original Ada object.
In other words, we need to define two functions: To_Pointer which converts
all access values for a certain type (tagged or class-wide, at least) into
void pointers and To_Access which converts void pointers obtained by
To_Pointer back into the original access value.
In other words, we need two mutually inverse bijections between every set of
values of 'Unchecked_Access of values of a type (tagged or class-wide, at
least) and a subset of C void pointers.
We also need map null access to NULL pointer and vice versa.
We will use chars_ptr from Interfaces.C.Strings to represent void pointers.
It is valid because C11, 6.2.5, 28 (draft N1548): "A pointer to void shall
have the same representation and alignment requirements as a pointer to a
character type."
This problem is solved in my generic package Convert_Void:
-- "with" and "use" skipped
generic
type Object(<>) is limited private;
package Convert_Void is
package Address_Conversions is new
System.Address_To_Access_Conversions(Object);
subtype Object_Pointer is Address_Conversions.Object_Pointer;
function To_Access (Void_Pointer: chars_ptr) return Object_Pointer;
function To_C_Pointer (Pointer: Object_Pointer) return chars_ptr;
end Convert_Void;
We define in Convert_Void body:
type My_Char_Pointer is access all char with Convention=>C;
package Char_Address_Conversions is new
System.Address_To_Access_Conversions(char);
One of the steps of implementing the functions To_Pointer and To_Access is
to convert between chars_ptr and My_Char_Pointer. This is trivially done
with Ada.Unchecked_Conversion because they are by definition the same C type
char* and thus have the same representation.
So our task is reduced to conversion between My_Char_Pointer an Ada object
access.
We do this conversion (in both directions) like:
Char_Address_Conversions.To_Pointer(Address_Conversions.To_Address(...))
Address_Conversions.To_Pointer(Char_Address_Conversions.To_Address(...))
The thing to prove is that this is an injective function from object
pointers to My_Char_Pointer values and that backward conversion is really
its inversion.
But it is just my understanding of "The To_Pointer and To_Address
subprograms convert back and forth between values of types Object_Pointer
and Address." (RM 13.7.2 5/2)
That null access are mapped into NULL pointers and vice versa is left as an
exercise to the reader.
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 2%]
* Re: Convert between C "void*" pointer and an access
2017-10-11 22:58 3% ` Victor Porton
@ 2017-10-11 23:12 3% ` Victor Porton
2017-10-12 1:01 2% ` Victor Porton
0 siblings, 1 reply; 200+ results
From: Victor Porton @ 2017-10-11 23:12 UTC (permalink / raw)
Victor Porton wrote:
> Victor Porton wrote:
>
>> What is the right way to convert between C "void*" pointer and an access
>> to a tagged or class-wide type?
>>
>> Ada.Unchecked_Conversion seems to be what I need, but the access type may
>> be "fat" and thus have another format than void*.
>>
>> I caught myself doing such unchecked conversions, but now I feel I did an
>> error.
>>
>> For example, let
>>
>> type X_Type is abstract tagged null record;
>>
>> How to store X_Type'Class pointer in "void*" and convert them back and
>> forth?
>
> It seems I've found a right solution of my problem. (Check if Ada RM
> warrants that it works with every compiler!)
>
> Well, why it is not a standard package?! Why I need to invent something
> "smart" every time I need to code?
The package body was with a bug. Here there is corrected code:
with System.Address_To_Access_Conversions;
with Interfaces.C.Strings; use Interfaces.C.Strings;
-- C11, 6.2.5, 28 (draft N1548):
-- A pointer to void shall have the same representation and alignment requirements as a pointer to a character type.
-- So we can use chars_ptr to mean void pointer in C.
generic
type Object(<>) is limited private;
package Convert_Void is
package Address_Conversions is new System.Address_To_Access_Conversions(Object);
subtype Object_Pointer is Address_Conversions.Object_Pointer;
function To_Access (Void_Pointer: chars_ptr) return Object_Pointer;
function To_C_Pointer (Pointer: Object_Pointer) return chars_ptr;
end Convert_Void;
with Ada.Unchecked_Conversion;
package body Convert_Void is
type My_Char_Pointer is access all char with Convention=>C;
function From_My_Char_Pointer is new Ada.Unchecked_Conversion(My_Char_Pointer, chars_ptr);
function From_Chars_Ptr is new Ada.Unchecked_Conversion(chars_ptr, My_Char_Pointer);
package Char_Address_Conversions is new System.Address_To_Access_Conversions(char);
function To_Access (Void_Pointer: chars_ptr) return Object_Pointer is
P: constant My_Char_Pointer := From_Chars_Ptr(Void_Pointer);
A: constant System.Address :=
Char_Address_Conversions.To_Address(Char_Address_Conversions.Object_Pointer(P));
begin
return Address_Conversions.To_Pointer(A);
end;
function To_C_Pointer (Pointer: Object_Pointer) return chars_ptr is
A: constant System.Address := Address_Conversions.To_Address(Pointer);
P: constant My_Char_Pointer :=
My_Char_Pointer(Char_Address_Conversions.To_Pointer(A));
begin
return From_My_Char_Pointer(P);
end;
end Convert_Void;
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 3%]
* Re: Convert between C "void*" pointer and an access
@ 2017-10-11 22:58 3% ` Victor Porton
2017-10-11 23:12 3% ` Victor Porton
0 siblings, 1 reply; 200+ results
From: Victor Porton @ 2017-10-11 22:58 UTC (permalink / raw)
Victor Porton wrote:
> What is the right way to convert between C "void*" pointer and an access
> to a tagged or class-wide type?
>
> Ada.Unchecked_Conversion seems to be what I need, but the access type may
> be "fat" and thus have another format than void*.
>
> I caught myself doing such unchecked conversions, but now I feel I did an
> error.
>
> For example, let
>
> type X_Type is abstract tagged null record;
>
> How to store X_Type'Class pointer in "void*" and convert them back and
> forth?
It seems I've found a right solution of my problem. (Check if Ada RM
warrants that it works with every compiler!)
Well, why it is not a standard package?! Why I need to invent something
"smart" every time I need to code?
with System.Address_To_Access_Conversions;
with Interfaces.C.Strings; use Interfaces.C.Strings;
-- C11, 6.2.5, 28 (draft N1548):
-- A pointer to void shall have the same representation and alignment requirements as a pointer to a character type.
-- So we can use chars_ptr to mean void pointer in C.
generic
type Object(<>) is limited private;
package Convert_Void is
package Address_Conversions is new System.Address_To_Access_Conversions(Object);
subtype Object_Pointer is Address_Conversions.Object_Pointer;
function To_Access (Void_Pointer: chars_ptr) return Object_Pointer;
function To_C_Pointer (Pointer: Object_Pointer) return chars_ptr;
end Convert_Void;
with Ada.Unchecked_Conversion;
package body Convert_Void is
type My_Char_Pointer is access all char with Convention=>C;
function From_My_Char_Pointer is new Ada.Unchecked_Conversion(My_Char_Pointer, chars_ptr);
function From_Chars_Ptr is new Ada.Unchecked_Conversion(chars_ptr, My_Char_Pointer);
package Char_Address_Conversions is new System.Address_To_Access_Conversions(char);
function To_Access (Void_Pointer: chars_ptr) return Object_Pointer is
begin
return Address_Conversions.To_Pointer(From_Chars_Ptr(Void_Pointer)'Address);
end;
function To_C_Pointer (Pointer: Object_Pointer) return chars_ptr is
A: constant System.Address := Address_Conversions.To_Address(Pointer);
P: constant My_Char_Pointer :=
My_Char_Pointer(Char_Address_Conversions.To_Pointer(A));
begin
return From_My_Char_Pointer(P);
end;
end Convert_Void;
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 3%]
* Re: Ada.Strings.Unbounded vs Ada.Containers.Indefinite_Holders
@ 2017-09-23 9:16 2% ` Jeffrey R. Carter
0 siblings, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2017-09-23 9:16 UTC (permalink / raw)
On 09/23/2017 10:09 AM, Dmitry A. Kazakov wrote:
> On 2017-09-23 00:15, Victor Porton wrote:
>>
>> In my opinion, it would be better to change RM phrasing from "null string"
>> to "empty string", because in some other languages (notably C) NULL means
>> something other. It is just confusing.
>
> The adjective null and the noun null are distinct parts of speech. C's noun null
> is an abbreviation of null pointer. If pointers can be null so strings can.
Another way to look at it: Ada has the formal concepts of:
* null access value ARM 4.2(9)
* null array 3.6.1(7)
* null constraint 3.2(7/2)
* null_exclusion 3.10(5.1/2)
* null extension 3.9.1(4.1/2)
* null procedure 6.7(3/3)
* null range 3.5(4)
* null record 3.8(15)
* null slice 4.1.2(7)
* null string literal 2.6(6)
* null value (of an access type) 3.10(13/2)
* null_statement 5.1(6)
not to mention the language-defined identifiers
Null_Address
in System 13.7(12)
Null_Bounded_String
in Ada.Strings.Bounded A.4.4(7)
Null_Id
in Ada.Exceptions 11.4.1(2/2)
Null_Occurrence
in Ada.Exceptions 11.4.1(3/2)
Null_Ptr
in Interfaces.C.Strings B.3.1(7)
Null_Set
in Ada.Strings.Maps A.4.2(5)
in Ada.Strings.Wide_Maps A.4.7(5)
in Ada.Strings.Wide_Wide_Maps A.4.8(5/2)
Null_Task_Id
in Ada.Task_Identification C.7.1(2/2)
Null_Unbounded_String
in Ada.Strings.Unbounded A.4.5(5)
(Just look under N in the index.)
It's called overloading. Many of these cases refer to things that can have
components and mean one with zero components: a null record has no components, a
null array has no components ('Length = 0), a null string literal has no
characters, a null set has no members, ... It should not be confusing.
--
Jeff Carter
"You cheesy lot of second-hand electric donkey-bottom biters."
Monty Python & the Holy Grail
14
^ permalink raw reply [relevance 2%]
* Re: Community Input for the Maintenance and Revision of the Ada Programming Language
2017-08-31 12:49 2% ` Jacob Sparre Andersen
2017-08-31 13:16 2% ` Dmitry A. Kazakov
@ 2017-08-31 23:54 0% ` Randy Brukardt
1 sibling, 0 replies; 200+ results
From: Randy Brukardt @ 2017-08-31 23:54 UTC (permalink / raw)
"Jacob Sparre Andersen" <jacob@jacob-sparre.dk> wrote in message
news:87val3aoly.fsf@jacob-sparre.dk...
...
> The places I expect to see trouble is if some source text assumes that
> Standard.Character and Interfaces.C.char are the the same.
Any rep. clause that assumed that Standard.Character was 8 bits (that is,
essentially all of them) would fail. Any code that assumed that
Standard.Character has 256 enumeration values would fail. It would be wildly
incompatible, and at least some of that incompatibility would be at runtime
(code would silently change behavior -- the worst kind).
Randy.
^ permalink raw reply [relevance 0%]
* Re: Community Input for the Maintenance and Revision of the Ada Programming Language
2017-08-31 12:49 2% ` Jacob Sparre Andersen
@ 2017-08-31 13:16 2% ` Dmitry A. Kazakov
2017-08-31 23:54 0% ` Randy Brukardt
1 sibling, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2017-08-31 13:16 UTC (permalink / raw)
On 31/08/2017 14:49, Jacob Sparre Andersen wrote:
> Dmitry A. Kazakov wrote:
>
>> You need a view of a string as an array of code points / unicode
>> characters *and* another view as an array of encoding items,
>> e.g. octet for UTF-8 or word for UTF-16 etc.
>
> But the encoding stuff is (mostly) on the out-side of the application.
Not really. E.g. parsing is done in octets for obvious reasons. That was
the reason why UTF-8 was designed this way.
> I don't mind having routines for mapping to and from various encodings,
> but the encoded types should not have character or string literals, they
> should just be arrays of octets with certain characteristics.
I don't understand this. What is the use of a string type without
literals? Unbounded_String is a perfect example why this does not work.
It is all about having an ability to choose a representation (encoding)
rather than getting it enforced upon you by the language. It is no
solution if you simply create yet another type with the required
representation losing the original type's interface and forced to
convert forth and back between two types all over the place. This mess
does not deserve consideration. We have it aplenty: String, Wide_String,
Unbounded_String, char_array, chars_ptr ad infinitum.
> Don't worry so much about the encoding-view. Push the encoding troubles
> to the edge of your application, and work in a consistent form inside
> the application.
Many, if not most, applications never care about code points.
Applications deal with substrings starting and ending at the boundary of
a code point. For them it is no matter if the substring is a chain of
code points or a chain of encoding items.
>> You cannot handle this in present Ada.
>
> You can, if you harmonize to a single encoding for the character and
> string view, and only see specific encodings as serializations of
> (subsets of) the general character and string types.
>
> The places I expect to see trouble is if some source text assumes that
> Standard.Character and Interfaces.C.char are the the same.
It should assume Standard.Octet and Interfaces.C.char same. You simply
cannot drop either encoding items or code points. It would never work.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 2%]
* Re: Community Input for the Maintenance and Revision of the Ada Programming Language
@ 2017-08-31 12:49 2% ` Jacob Sparre Andersen
2017-08-31 13:16 2% ` Dmitry A. Kazakov
2017-08-31 23:54 0% ` Randy Brukardt
0 siblings, 2 replies; 200+ results
From: Jacob Sparre Andersen @ 2017-08-31 12:49 UTC (permalink / raw)
Dmitry A. Kazakov wrote:
> You need a view of a string as an array of code points / unicode
> characters *and* another view as an array of encoding items,
> e.g. octet for UTF-8 or word for UTF-16 etc.
But the encoding stuff is (mostly) on the out-side of the application.
I don't mind having routines for mapping to and from various encodings,
but the encoded types should not have character or string literals, they
should just be arrays of octets with certain characteristics.
> UTF-16 and UTF-8 strings are equivalent types in the view of code
> point arrays. UCS-2 is a constrained subtype of both. ASCII string is
> a constrained subtype of any.
Yes.
> In the second view ASCII string is a subtype of only UTF-8 string. It
> is an unrelated type to UCS-2 and UTF-16.
Don't worry so much about the encoding-view. Push the encoding troubles
to the edge of your application, and work in a consistent form inside
the application.
> You cannot handle this in present Ada.
You can, if you harmonize to a single encoding for the character and
string view, and only see specific encodings as serializations of
(subsets of) the general character and string types.
The places I expect to see trouble is if some source text assumes that
Standard.Character and Interfaces.C.char are the the same.
Greetings,
Jacob
--
"In space, no-one can press CTRL-ALT-DEL"
-- An Ada programmer
^ permalink raw reply [relevance 2%]
* Re: win32 interfacing check (SetClipboardData)
@ 2017-08-31 1:41 3% ` Randy Brukardt
0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2017-08-31 1:41 UTC (permalink / raw)
> On 29/08/2017 22:28, Xavier Petit wrote:
>> Hi, I would like to know if this win32 code is "correct" from your PoV or
>> could be written in a better way, especially this block :
>>
>> declare
>> Tmp : Wide_String (1 .. Source'Length + 1) with Address => AMem;
>> begin
>> Tmp := Source & Wide_Character'First;
>> end;
>
> It looks OK.
For me, using an address clause for anything other than interfacing to
hardware is wrong. We certainly didn't do anything like this in Claw when
implementing the clipboard operations. We used instances of
Unchecked_Conversion to get a pointer of the right type, and then assigned
into that. (Nowdays, I might use an instance of
Address_to_Access_Conversions.)
The code that converts a String parameter into a value in the clipboard list
looks like:
procedure Append_Copy(Item : in String;
List : in out Representation_List_Type;
Kind : in Text_Kinds := Text) is
use type Claw.Win32.HGlobal;
Mem : Claw.Win32.HGlobal;
subtype C_String_Type is Interfaces.C.Char_Array(0 .. Item'length);
type Target_Pointer is access all C_String_Type;
function Convert is new Ada.Unchecked_Conversion
(Source => Claw.Win32.HGlobal,
Target => Target_Pointer);
N : Interfaces.C.Size_T;
begin
Mem := Claw.Low_Level.Miscellaneous.Global_Alloc (
Claw.Low_Level.Miscellaneous.GMEM_FIXED,
DWord(C_String_Type'Length*(Interfaces.C.Char'Size/8)));
if Mem = Claw.Win32.NULL_HGLOBAL then
Claw.Raise_Windows_Error;
end if;
Interfaces.C.To_C(Item, Convert(Mem).all, N);
Append((Handle => Mem, Format => Text_Kind_Format(Kind),
Delayed_Renderer => null), List);
end Append_Copy;
"Append" here adds "Mem" to the Representation_List, giving ownership of the
handle to the List.
A Wide_String version would work the same way, using the appropriate
Interfaces.C types.
Note that we were trying for maximum portability (to any sane Ada 95
compiler for Windows); there's no real need to use the Interfaces.C types on
GNAT (if that's all you care about).
Randy.
^ permalink raw reply [relevance 3%]
* Re: gcc-7 breaks unsized C array bindings
2017-08-25 8:03 3% gcc-7 breaks unsized C array bindings ytomino
2017-08-27 7:16 0% ` Shark8
@ 2017-08-30 21:27 0% ` Simon Wright
1 sibling, 0 replies; 200+ results
From: Simon Wright @ 2017-08-30 21:27 UTC (permalink / raw)
ytomino <aghia05@gmail.com> writes:
> C header:
>
> extern int unsized_C_array[];
>
> Ada binding:
>
> unsized_C_array : array (Interfaces.C.size_t) of Interfaces.C.int
> with Import, Convention => C, External_Name => "unsized_C_array";
>
> gcc-7 treats this common idiom as a runtime error. Moreover, it
> reports no message on compile-time. This behavior is very malicious
> mischief. (I have already reported it as
> https://gcc.gnu.org/bugzilla/show_bug.cgi?id=81961 )
Still present in GCC 8.0.0 (20170820).
^ permalink raw reply [relevance 0%]
* Re: gcc-7 breaks unsized C array bindings
2017-08-27 7:16 0% ` Shark8
@ 2017-08-27 7:57 0% ` Jeffrey R. Carter
0 siblings, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2017-08-27 7:57 UTC (permalink / raw)
On 08/27/2017 09:16 AM, Shark8 wrote:
> On Friday, August 25, 2017 at 2:03:08 AM UTC-6, ytomino wrote:
>>
>> Ada binding:
>>
>> unsized_C_array : array (Interfaces.C.size_t) of Interfaces.C.int
>> with Import, Convention => C, External_Name => "unsized_C_array";
>
> This creates an array of exactly 0..size_t'last elements -- where size_t'last is at least Integer'Pred(2**16) -- this is quite obviously /NOT/ what you want, and the source of your Storage_Error (as each unsized_C_array takes up so much space).
No, because of Import, it should expect the object to be created by something
else and should simply make this another name for it. If it is allocating space
for this object, then that should be a compiler error.
I've done more interfacing with C than I would like, but I've never encountered
this construct, so I've been reluctant to comment. A lot will depend on how the
construct is used in the Ada. Is it simply passed to C functions, or are
components actually accessed by indices?
--
Jeff Carter
"No one is to stone anyone until I blow this whistle,
do you understand? Even--and I want to make this
absolutely clear--even if they do say, 'Jehovah.'"
Monty Python's Life of Brian
74
^ permalink raw reply [relevance 0%]
* Re: gcc-7 breaks unsized C array bindings
2017-08-25 8:03 3% gcc-7 breaks unsized C array bindings ytomino
@ 2017-08-27 7:16 0% ` Shark8
2017-08-27 7:57 0% ` Jeffrey R. Carter
2017-08-30 21:27 0% ` Simon Wright
1 sibling, 1 reply; 200+ results
From: Shark8 @ 2017-08-27 7:16 UTC (permalink / raw)
On Friday, August 25, 2017 at 2:03:08 AM UTC-6, ytomino wrote:
>
> Ada binding:
>
> unsized_C_array : array (Interfaces.C.size_t) of Interfaces.C.int
> with Import, Convention => C, External_Name => "unsized_C_array";
This creates an array of exactly 0..size_t'last elements -- where size_t'last is at least Integer'Pred(2**16) -- this is quite obviously /NOT/ what you want, and the source of your Storage_Error (as each unsized_C_array takes up so much space).
If I did more interfacing with C I could point you in the right direction, but I can't so someone else will have to weigh in on what a good solution would be.
^ permalink raw reply [relevance 0%]
* gcc-7 breaks unsized C array bindings
@ 2017-08-25 8:03 3% ytomino
2017-08-27 7:16 0% ` Shark8
2017-08-30 21:27 0% ` Simon Wright
0 siblings, 2 replies; 200+ results
From: ytomino @ 2017-08-25 8:03 UTC (permalink / raw)
Hello.
I'm upgrading my code from gcc-6 to 7, and noticed mysterious Storage_Error in some C bindings.
The cause is array (size_t) for importing unsized C arrays, like below.
C header:
extern int unsized_C_array[];
Ada binding:
unsized_C_array : array (Interfaces.C.size_t) of Interfaces.C.int
with Import, Convention => C, External_Name => "unsized_C_array";
gcc-7 treats this common idiom as a runtime error. Moreover, it reports no message on compile-time. This behavior is very malicious mischief.
(I have already reported it as https://gcc.gnu.org/bugzilla/show_bug.cgi?id=81961 )
Therefore; some bindings are broken now. One way is array (0 .. 0) and pragma Suppress (Index_Check), but I feel it's not smart.
What is better replacement how to rewrite them?
^ permalink raw reply [relevance 3%]
* Re: Please evaluate tiny binding that does not use Interfaces.C
2017-08-18 13:05 5% ` patrick
@ 2017-08-18 15:41 4% ` patrick
0 siblings, 0 replies; 200+ results
From: patrick @ 2017-08-18 15:41 UTC (permalink / raw)
Sorry for answering my own post. I just wanted to add that in the above example WINDOW is a pointer to a null record but it is not really a null pointer. I would not be able to pass other pointer types to functions expecting WINDOW so is it not type safe in fact?
Why create records to match C structs, a pointer declared of that type can only be used to pass addresses of that struct's type and accomplishes the same thing with far less clutter no?
Have we all been giving -fdump-ada-spec a free pass without evaluating it's logic or am I the one being illogical ?
^ permalink raw reply [relevance 4%]
* Re: Please evaluate tiny binding that does not use Interfaces.C
2017-08-18 5:18 3% ` Per Sandberg
@ 2017-08-18 13:05 5% ` patrick
2017-08-18 15:41 4% ` patrick
0 siblings, 1 reply; 200+ results
From: patrick @ 2017-08-18 13:05 UTC (permalink / raw)
Hi Per
Thanks for answering my post!
Do you like friendly debates? If we were in the same room you would see that I have a smile on my face and I am not trying to be argumentative or hostile in any way, it's just that I seem to be thinking differently then most Ada people right now and I would love to have my sanity checked. Please don't be offended by this, please help me test my logic......
Here is some background.
I bought/printed 53 lbs of Ada books in 2012. I studied every night. I basically failed. I wanted to use Ada instead of C but every where i turned I needed a binding to C. GTK-Ada was very confusing and I struggled badly with it and eventually gave up on Ada.
I actually went to GnuCOBOL(call open-cobol as the time). I loved it and still do. I learned a lot more about C and I have had a great time mixing GnuCOBOL and C.
I have come back to Ada a few times. I used Interfaces.COBOL. I can use it well but the code required to blend COBOL and Ada is IMHO as gross as the code to mix C and Ada, when using Intefaces.C.
I have read extensively about Interfaces.C and Interfaces.C. Most examples will use some simple C target. In reality people will often want to interface with massive C/C++ libraries.
I know it would be nice if all Ada bindings were thick but is it not in fact fair to say that most are thin, we don't have large communities to support them and to look for bugs, we don't have many bindings relative to let's say Python and writing good Ada bindings is non-trivial to begin with.
My feeling right now is that the expertise needed to use bindings like GTK-Ada is of such a high degree that the programmer might just be better off studying C and writing shim code to that C and binding to it or directly to the C library on an as-needed basis rather then trying to write a whole binding to share with the community.
I am really sorry for writing the above, I know how hard it is to write a binding and I don't want to discourage people but I think it's also important to speak honestly about the language, I think lots of people stop by to see what it's about but move on. I think if it was easier to interface with other languages, Ada could start off as library code to support other languages at first and then could win over people's hearts and become more central or in fact "the" central language of the given application.
With the approach taken above, I am sure I can interface with COBOL without having actually tried this but what about other ELF compatible languages from GCC or elsewhere, this would open the door to interfacing with Java and Objective-C. Lots of languages have C interfaces or compile to intermediate C. Ada could be mixed with Haskell, Vala or dozens more.
I remember back in 2012 being to desperate to have -fdump-ada-spec that I switched distros. I remember using it inn stupid ways, like running it on the whole C library not just the header and trying to bind to internal functions and such.
In almost all cases Interfaces.C isn't doing anything but to someone that was struggling like I was, it adds a layer of magic that hides a much simpler truth.
I also question -fdump's decisions. As per the first post, why recreate a C struct and all of it's nested structs only to create a pointer of the correct type? Yes void pointers are dangerous but mountains of code that do not need to be there is also dangerous.
Simple short code is easier to debug and maintain and a lack of maintenance or worse yet, a poor understanding of code is IMHO worse than the danger of a void pointer.
Why use Interfaces.X if Ada already has the built in types to interface. Having to cast back and forth only makes for more code and less code clarity and at the end of the day, we are still calling into C and more code to check for actual C dangers seems like a better idea to me than using Interfaces.X which offers no protection anyways.
Thanks for reading
^ permalink raw reply [relevance 5%]
* Re: Please evaluate tiny binding that does not use Interfaces.C
2017-08-18 2:23 6% Please evaluate tiny binding that does not use Interfaces.C patrick
@ 2017-08-18 5:18 3% ` Per Sandberg
2017-08-18 13:05 5% ` patrick
0 siblings, 1 reply; 200+ results
From: Per Sandberg @ 2017-08-18 5:18 UTC (permalink / raw)
Hi
The proper way to generate bindings to libraries with interfaces defined
in C/C++ is to use the compiler-switch -fdump-ada-spec. To trust a human
to get all the bits and pieces correct only works if the interface is
trivial.
The way I usually does it is:
* generate valid a C/C++ file including all required headers.
* compile the file with gcc -c -fdfump-ada-spec ${file}
* If required, edit in the file using some script tool such as sed.
By using the above method you could regenerate the bindings when the
underlying library evolves and you will get a correct binding every time.
Of corse if you want to use one and only one simple method from a
foreign library its always possible to just do a simple "import" in the
code.
/P
Den 2017-08-18 kl. 04:23, skrev patrick@spellingbeewinnars.org:
> Hi Everyone
>
> It seems like everyone uses Interfaces.C when creating a C binding. I realize that this makes the binding more portable.
>
> However, is there something to be said for small, easy to read code too?
>
> It seems that most bindings attempt to recreate C structs with records and then create pointers to those records. Meanwhile, the binding does not access any members of that C struct directly. Those structs often have other structs as members too and the process goes on and on.
>
> I realize that void pointers are dangerous but C is dangerous and I am wondering if my use is within good practices?
>
> My code is small and contains no exception handling and likely has lots of other things missing like a gpr files and such but is the basic interfacing between C and Ada okay? Do you see any pitfalls, aside from the fact that it is calling C ?
>
> I personally find this very easy to write and read, I am hoping that this will work out. Please let me know what you think
>
> -----------------------------------------------------------------
> build.sh
>
> gnatmake -c terminal_app.adb
> gnatmake -c ncurses_glue
>
> gcc-4.6 -c ncurses_glue.c
>
> gnatbind terminal_app.ali ncurses_glue.ali
>
> gnatmake -c b~terminal_app.adb
> gcc-4.6 terminal_app.o b~terminal_app.o ncurses_glue.o -o terminal_app -gnatwa -lncursesw -lgnat -gnato
>
> -----------------------------------------------------------------
> -- test to see if library without interfaces.c will work out
> --
> --
> with ncurses_glue ;
> with ada.strings.fixed ;
>
> procedure terminal_app is
>
> package ng renames ncurses_glue ;
> package sf renames ada.strings.fixed ;
>
> stdscr : access ng.WINDOW ;
> ret : integer ;
> str : string := "test 㐴 " & ASCII.NUL ;
>
> begin
>
> stdscr := ng.initscr_plus ;
> ret := ng.addstr(str) ;
> ret := ng.refresh ;
> delay 2.0 ;
> ret := ng.endwin ;
>
> end terminal_app ;
>
> -----------------------------------------------------------------
>
> package ncurses_glue is
>
> type null_record is null record ;
>
> type WINDOW is access null_record ;
>
> function initscr_plus
> return Access WINDOW;
> pragma Import (C, initscr_plus, "initscr_plus");
>
> function addstr (arg1 : string)
> return integer ;
> pragma Import (C, addstr, "addstr");
>
> function refresh
> return integer;
> pragma Import (C, refresh, "refresh") ;
>
> function endwin
> return integer;
> pragma Import (C, endwin, "endwin") ;
>
> end ncurses_glue ;
> -----------------------------------------------------------------
> #include <ncursesw/ncurses.h>
> #include <locale.h>
>
> void * initscr_plus() {
> setlocale(LC_CTYPE,"");
> initscr() ;
> return stdscr ;
> }
>
^ permalink raw reply [relevance 3%]
* Please evaluate tiny binding that does not use Interfaces.C
@ 2017-08-18 2:23 6% patrick
2017-08-18 5:18 3% ` Per Sandberg
0 siblings, 1 reply; 200+ results
From: patrick @ 2017-08-18 2:23 UTC (permalink / raw)
Hi Everyone
It seems like everyone uses Interfaces.C when creating a C binding. I realize that this makes the binding more portable.
However, is there something to be said for small, easy to read code too?
It seems that most bindings attempt to recreate C structs with records and then create pointers to those records. Meanwhile, the binding does not access any members of that C struct directly. Those structs often have other structs as members too and the process goes on and on.
I realize that void pointers are dangerous but C is dangerous and I am wondering if my use is within good practices?
My code is small and contains no exception handling and likely has lots of other things missing like a gpr files and such but is the basic interfacing between C and Ada okay? Do you see any pitfalls, aside from the fact that it is calling C ?
I personally find this very easy to write and read, I am hoping that this will work out. Please let me know what you think
-----------------------------------------------------------------
build.sh
gnatmake -c terminal_app.adb
gnatmake -c ncurses_glue
gcc-4.6 -c ncurses_glue.c
gnatbind terminal_app.ali ncurses_glue.ali
gnatmake -c b~terminal_app.adb
gcc-4.6 terminal_app.o b~terminal_app.o ncurses_glue.o -o terminal_app -gnatwa -lncursesw -lgnat -gnato
-----------------------------------------------------------------
-- test to see if library without interfaces.c will work out
--
--
with ncurses_glue ;
with ada.strings.fixed ;
procedure terminal_app is
package ng renames ncurses_glue ;
package sf renames ada.strings.fixed ;
stdscr : access ng.WINDOW ;
ret : integer ;
str : string := "test 㐴 " & ASCII.NUL ;
begin
stdscr := ng.initscr_plus ;
ret := ng.addstr(str) ;
ret := ng.refresh ;
delay 2.0 ;
ret := ng.endwin ;
end terminal_app ;
-----------------------------------------------------------------
package ncurses_glue is
type null_record is null record ;
type WINDOW is access null_record ;
function initscr_plus
return Access WINDOW;
pragma Import (C, initscr_plus, "initscr_plus");
function addstr (arg1 : string)
return integer ;
pragma Import (C, addstr, "addstr");
function refresh
return integer;
pragma Import (C, refresh, "refresh") ;
function endwin
return integer;
pragma Import (C, endwin, "endwin") ;
end ncurses_glue ;
-----------------------------------------------------------------
#include <ncursesw/ncurses.h>
#include <locale.h>
void * initscr_plus() {
setlocale(LC_CTYPE,"");
initscr() ;
return stdscr ;
}
^ permalink raw reply [relevance 6%]
* Re: Community Input for the Maintenance and Revision of the Ada Programming Language
2017-08-10 14:43 2% ` Lucretia
@ 2017-08-11 1:24 0% ` Randy Brukardt
0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2017-08-11 1:24 UTC (permalink / raw)
"Lucretia" <laguest9000@googlemail.com> wrote in message
news:085872f2-2876-401d-9661-4ca5c82bb7ea@googlegroups.com...
...
> 9) Update the Interfaces.C package to include new types in the newer C
> specs.
That most likely will get done at some point before Ada 2020 gets done. But
it might be best to send a comment so it gets an agenda item; it would be
useful to know which new types you find relevant.
...
> 11) Including bindings to other languages that are starting to appear?
As I previously noted, we can only reference languages that have ISO/IEC
standards (there might be a few other kinds of standards that are
acceptable, but most aren't). That reduces the universe of what we could do
quite a bit.
It's the same reason that we can't name Windows or Linux in the standard,
which is why Ada.Directories.Information is defined as
"implementation-defined" and Windows and Linux versions are given in an AARM
note.
Moral: not everything can be done in the language standard. You need an
implementer focused on mobile applications if you're going to see much
progress in that field. Etc. The downside of having one dominant vendor is
that they're going to set the agenda in many ways, and that agenda is thus
safety-critical embedded systems.
Randy.
^ permalink raw reply [relevance 0%]
* Re: Community Input for the Maintenance and Revision of the Ada Programming Language
@ 2017-08-10 14:43 2% ` Lucretia
2017-08-11 1:24 0% ` Randy Brukardt
0 siblings, 1 reply; 200+ results
From: Lucretia @ 2017-08-10 14:43 UTC (permalink / raw)
On Wednesday, 9 August 2017 22:12:34 UTC+1, Luke A. Guest wrote:
> Luke A. Guest <me@me dot com> wrote:
> > Additions I'd like to see:
>
> > 8) networking support packages.
> >
9) Update the Interfaces.C package to include new types in the newer C specs.
10) Standardised C++ binding, what the compiler does underneath shouldn't matter as long as the interface specifying the binding is consistent and has a way to add platform specific changes, i.e. DLL binding for Windows, standard binding for other OSes.
11) Including bindings to other languages that are starting to appear?
^ permalink raw reply [relevance 2%]
* ANN: Cortex GNAT RTS 2017-08-08
@ 2017-08-08 13:04 2% Simon Wright
0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2017-08-08 13:04 UTC (permalink / raw)
This release is available at Github[1] - note the move from Sourceforge.
The main motivation for the last two releases has been to support
AdaCore's Certyflie[2], or at least my fork at [3].
There have been compiler interface changes, so some patching will be
required[4] if you're using GNAT GPL 2016 or 2017.
New features:
* Ada.Numerics.* (except random numbers).
* Interfaces.C.Extensions.
* Ada.Real_Time.Timing_Events.
* All free store (bar a 2048-byte allowance for startup and interrupts)
is available for heap allocation.
* Sequential elaboration (with the configuration pragma
Partition_Elaboration_Policy (Sequential)) is supported.
* type'Image() and object'Img are supported.
[1] https://github.com/simonjwright/cortex-gnat-rts/releases
[2] https://github.com/AdaCore/Certyflie
[3] https://github.com/simonjwright/Certyflie
[4] https://github.com/simonjwright/cortex-gnat-rts/blob/master/INSTALL.md#compatibility
^ permalink raw reply [relevance 2%]
* Re: Convert an access to constant to access to variable
@ 2017-08-07 23:16 3% ` Randy Brukardt
0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2017-08-07 23:16 UTC (permalink / raw)
"Victor Porton" <porton@narod.ru> wrote in message
news:om500e$3iv$1@gioia.aioe.org...
...
> I need chars_ptr for interfacing with C.
>
> There is no constant_chars_ptr.
>
> (I need to generate chars_ptr from a char_array or rather from constant
> char_array.)
We did all of this sort of stuff just using Interfaces.C.To_Ada and various
types with convention C. I don't think I've ever used Interfaces.C.Strings
and Interfaces.C.Pointers outside of testing them. I think you are seeing
why...
Randy.
^ permalink raw reply [relevance 3%]
* Re: Need a way to convert a constant to a variable
2017-08-05 13:41 3% Need a way to convert a constant to a variable Victor Porton
2017-08-05 14:48 0% ` Dmitry A. Kazakov
2017-08-05 15:41 3% ` Jeffrey R. Carter
@ 2017-08-05 17:59 0% ` Per Sandberg
2 siblings, 0 replies; 200+ results
From: Per Sandberg @ 2017-08-05 17:59 UTC (permalink / raw)
????
A constant shall never ever change its value since the compiler is free
to use the value in compile time to optimize the code if possible.
So the whole suggestion is screaming "I want to do a very bad design".
/P
Den 2017-08-05 kl. 15:41, skrev Victor Porton:
> I've sent the following email to ada-comment mailing list. I duplicate it
> here.
>
> !topic Need a way to convert a constant to a variable
> !reference Ada 2012 RM
> !from Victor Porton 17-08-05
> !keywords constant, variable, view, conversion
> !discussion
>
> Sometimes one needs to convert a constant view into variable view (I am
> fully conscious that after this the programmer should take care not to
> change the object of the view).
>
> In the following (not compilable with GNAT 7.1.0) code I present my
> best attempt to solve the following problem:
>
> Write a function with an "in" indefinite holder with a string, return
> chars_ptr corresponding to the string.
>
> It looks like there is no solution of this in Ada 2012 :-(
>
> with Interfaces.C; use Interfaces.C;
> with Interfaces.C.Strings; use Interfaces.C.Strings;
> with Ada.Containers.Indefinite_Holders;
>
> procedure Conv is
>
> package Char_Array_Holders is
> new Ada.Containers.Indefinite_Holders(char_array);
>
> type C_String_Holder is new Char_Array_Holders.Holder
> with null record;
>
> function To_C_String (Object: C_String_Holder) return chars_ptr is
> Value: char_array renames Constant_Reference(Object).Element.all;
> Value2: aliased Char_Array(Value'Range) with Import;
> for Value2'Address use Value'Address;
> begin
> return To_Chars_Ptr(Char_Array_Access'(Value2'Access));
> end;
> begin
> null;
> end;
>
> $ gnatgcc -c conv.adb -c conv.adb
> conv.adb:13:07: warning: aliased object has explicit bounds
> conv.adb:13:07: warning: declare without bounds (and with explicit
> initialization)
> conv.adb:13:07: warning: for use with unconstrained access
> conv.adb:16:46: object subtype must statically match designated subtype
>
> My current workaround is to define my own "indefinite holder" type to
> use it in my software instead of Ada.Containers.Indefinite_Holders.
>
> I propose the following language change:
>
> Please add 'Unchecked_Variable attribute.
>
> There are two possible meanings (of which we should choose one) of the
> attribute:
>
> 1. C'Unchecked_Variable returns a variable view of a constant C.
>
> 2. A'Unchecked_Variable returns the corresponding access to a variable
> for an access A to constant.
>
> Both variants seem to solve the trouble.
>
> Can any problem with different representation of constant and variables
> appear?
>
^ permalink raw reply [relevance 0%]
* Re: Need a way to convert a constant to a variable
2017-08-05 15:41 3% ` Jeffrey R. Carter
@ 2017-08-05 16:25 0% ` Victor Porton
0 siblings, 0 replies; 200+ results
From: Victor Porton @ 2017-08-05 16:25 UTC (permalink / raw)
Jeffrey R. Carter wrote:
> On 08/05/2017 03:41 PM, Victor Porton wrote:
>>
>> Write a function with an "in" indefinite holder with a string, return
>> chars_ptr corresponding to the string.
>
> Your requirements are for an indefinite holder with a string, but your
> attempted solution is for an indefinite holder with a char_array. I will
> assume you meant an indefinite holder with a char_array.
Yes, my typo. I am about an indefinite holder with a char_array.
>> It looks like there is no solution of this in Ada 2012 :-(
>
> with Ada.Containers.Indefinite_Holders;
> with Interfaces.C.Strings;
>
> package Conv is
> package C_Str_Holders is new Ada.Containers.Indefinite_Holders
> (Element_Type => Interfaces.C.Char_Array, "=" => Interfaces.C."=");
>
> function To_Chars_Ptr (Item : C_Str_Holders.Holder)
> return Interfaces.C.Strings.Chars_Ptr is
> (Interfaces.C.Strings.New_Char_Array (Item.Element) );
> end Conv;
>
> This compiles fine, so clearly there is a way to do this without a
> language change.
Your code allocates a new string which requires to be freed later.
I want a function, which would return a pointer to the (not necessarily nul-
terminated) string hold in the indefinite holder, so that deallocation would
be not required and code would be more efficient (not requiring to copy the
char_array).
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 0%]
* Re: Need a way to convert a constant to a variable
2017-08-05 13:41 3% Need a way to convert a constant to a variable Victor Porton
2017-08-05 14:48 0% ` Dmitry A. Kazakov
@ 2017-08-05 15:41 3% ` Jeffrey R. Carter
2017-08-05 16:25 0% ` Victor Porton
2017-08-05 17:59 0% ` Per Sandberg
2 siblings, 1 reply; 200+ results
From: Jeffrey R. Carter @ 2017-08-05 15:41 UTC (permalink / raw)
On 08/05/2017 03:41 PM, Victor Porton wrote:
>
> Write a function with an "in" indefinite holder with a string, return
> chars_ptr corresponding to the string.
Your requirements are for an indefinite holder with a string, but your attempted
solution is for an indefinite holder with a char_array. I will assume you meant
an indefinite holder with a char_array.
> It looks like there is no solution of this in Ada 2012 :-(
with Ada.Containers.Indefinite_Holders;
with Interfaces.C.Strings;
package Conv is
package C_Str_Holders is new Ada.Containers.Indefinite_Holders
(Element_Type => Interfaces.C.Char_Array, "=" => Interfaces.C."=");
function To_Chars_Ptr (Item : C_Str_Holders.Holder)
return Interfaces.C.Strings.Chars_Ptr is
(Interfaces.C.Strings.New_Char_Array (Item.Element) );
end Conv;
This compiles fine, so clearly there is a way to do this without a language change.
--
Jeff Carter
"He didn't get that nose from playing ping-pong."
Never Give a Sucker an Even Break
110
---
This email has been checked for viruses by AVG.
http://www.avg.com
^ permalink raw reply [relevance 3%]
* Re: Need a way to convert a constant to a variable
2017-08-05 14:48 0% ` Dmitry A. Kazakov
@ 2017-08-05 15:11 0% ` Victor Porton
0 siblings, 0 replies; 200+ results
From: Victor Porton @ 2017-08-05 15:11 UTC (permalink / raw)
Dmitry A. Kazakov wrote:
> On 2017-08-05 15:41, Victor Porton wrote:
>> I've sent the following email to ada-comment mailing list. I duplicate it
>> here.
>>
>> !topic Need a way to convert a constant to a variable
>> !reference Ada 2012 RM
>> !from Victor Porton 17-08-05
>> !keywords constant, variable, view, conversion
>> !discussion
>>
>> Sometimes one needs to convert a constant view into variable view (I am
>> fully conscious that after this the programmer should take care not to
>> change the object of the view).
>>
>> In the following (not compilable with GNAT 7.1.0) code I present my
>> best attempt to solve the following problem:
>>
>> Write a function with an "in" indefinite holder with a string, return
>> chars_ptr corresponding to the string.
>>
>> It looks like there is no solution of this in Ada 2012 :-(
>>
>> with Interfaces.C; use Interfaces.C;
>> with Interfaces.C.Strings; use Interfaces.C.Strings;
>> with Ada.Containers.Indefinite_Holders;
>>
>> procedure Conv is
>>
>> package Char_Array_Holders is
>> new Ada.Containers.Indefinite_Holders(char_array);
>>
>> type C_String_Holder is new Char_Array_Holders.Holder
>> with null record;
>>
>> function To_C_String (Object: C_String_Holder) return chars_ptr is
>> Value: char_array renames Constant_Reference(Object).Element.all;
>> Value2: aliased Char_Array(Value'Range) with Import;
>> for Value2'Address use Value'Address;
>> begin
>> return To_Chars_Ptr(Char_Array_Access'(Value2'Access));
>> end;
>> begin
>> null;
>> end;
>
> AFAIK, Ada.Containers.Indefinite_Holders was designed in a way to
> prevent specifically what you want.
>
>> Can any problem with different representation of constant and variables
>> appear?
>
> 1. Don't use Ada.Containers.Indefinite_Holders?
>
> 2. Don't use char_array. It has restricted use when interfacing C. You
> probably need chars_ptr put into a controlled type if you want safe C
> strings. This is basically same as Holder internally is, except that you
> are in full control.
I do use char_array for interfacing with C.
It is a pity that I need to reimplement Indefinite_Holders for this task.
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 0%]
* Re: Need a way to convert a constant to a variable
2017-08-05 13:41 3% Need a way to convert a constant to a variable Victor Porton
@ 2017-08-05 14:48 0% ` Dmitry A. Kazakov
2017-08-05 15:11 0% ` Victor Porton
2017-08-05 15:41 3% ` Jeffrey R. Carter
2017-08-05 17:59 0% ` Per Sandberg
2 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2017-08-05 14:48 UTC (permalink / raw)
On 2017-08-05 15:41, Victor Porton wrote:
> I've sent the following email to ada-comment mailing list. I duplicate it
> here.
>
> !topic Need a way to convert a constant to a variable
> !reference Ada 2012 RM
> !from Victor Porton 17-08-05
> !keywords constant, variable, view, conversion
> !discussion
>
> Sometimes one needs to convert a constant view into variable view (I am
> fully conscious that after this the programmer should take care not to
> change the object of the view).
>
> In the following (not compilable with GNAT 7.1.0) code I present my
> best attempt to solve the following problem:
>
> Write a function with an "in" indefinite holder with a string, return
> chars_ptr corresponding to the string.
>
> It looks like there is no solution of this in Ada 2012 :-(
>
> with Interfaces.C; use Interfaces.C;
> with Interfaces.C.Strings; use Interfaces.C.Strings;
> with Ada.Containers.Indefinite_Holders;
>
> procedure Conv is
>
> package Char_Array_Holders is
> new Ada.Containers.Indefinite_Holders(char_array);
>
> type C_String_Holder is new Char_Array_Holders.Holder
> with null record;
>
> function To_C_String (Object: C_String_Holder) return chars_ptr is
> Value: char_array renames Constant_Reference(Object).Element.all;
> Value2: aliased Char_Array(Value'Range) with Import;
> for Value2'Address use Value'Address;
> begin
> return To_Chars_Ptr(Char_Array_Access'(Value2'Access));
> end;
> begin
> null;
> end;
AFAIK, Ada.Containers.Indefinite_Holders was designed in a way to
prevent specifically what you want.
> Can any problem with different representation of constant and variables
> appear?
1. Don't use Ada.Containers.Indefinite_Holders?
2. Don't use char_array. It has restricted use when interfacing C. You
probably need chars_ptr put into a controlled type if you want safe C
strings. This is basically same as Holder internally is, except that you
are in full control.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Need a way to convert a constant to a variable
@ 2017-08-05 13:41 3% Victor Porton
2017-08-05 14:48 0% ` Dmitry A. Kazakov
` (2 more replies)
0 siblings, 3 replies; 200+ results
From: Victor Porton @ 2017-08-05 13:41 UTC (permalink / raw)
I've sent the following email to ada-comment mailing list. I duplicate it
here.
!topic Need a way to convert a constant to a variable
!reference Ada 2012 RM
!from Victor Porton 17-08-05
!keywords constant, variable, view, conversion
!discussion
Sometimes one needs to convert a constant view into variable view (I am
fully conscious that after this the programmer should take care not to
change the object of the view).
In the following (not compilable with GNAT 7.1.0) code I present my
best attempt to solve the following problem:
Write a function with an "in" indefinite holder with a string, return
chars_ptr corresponding to the string.
It looks like there is no solution of this in Ada 2012 :-(
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with Ada.Containers.Indefinite_Holders;
procedure Conv is
package Char_Array_Holders is
new Ada.Containers.Indefinite_Holders(char_array);
type C_String_Holder is new Char_Array_Holders.Holder
with null record;
function To_C_String (Object: C_String_Holder) return chars_ptr is
Value: char_array renames Constant_Reference(Object).Element.all;
Value2: aliased Char_Array(Value'Range) with Import;
for Value2'Address use Value'Address;
begin
return To_Chars_Ptr(Char_Array_Access'(Value2'Access));
end;
begin
null;
end;
$ gnatgcc -c conv.adb -c conv.adb
conv.adb:13:07: warning: aliased object has explicit bounds
conv.adb:13:07: warning: declare without bounds (and with explicit
initialization)
conv.adb:13:07: warning: for use with unconstrained access
conv.adb:16:46: object subtype must statically match designated subtype
My current workaround is to define my own "indefinite holder" type to
use it in my software instead of Ada.Containers.Indefinite_Holders.
I propose the following language change:
Please add 'Unchecked_Variable attribute.
There are two possible meanings (of which we should choose one) of the
attribute:
1. C'Unchecked_Variable returns a variable view of a constant C.
2. A'Unchecked_Variable returns the corresponding access to a variable
for an access A to constant.
Both variants seem to solve the trouble.
Can any problem with different representation of constant and variables
appear?
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 3%]
* Re: Convert chars_ptr to Ada String
2017-07-10 12:41 3% ` Mark Lorenzen
@ 2017-07-10 14:24 2% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2017-07-10 14:24 UTC (permalink / raw)
On 10/07/2017 14:41, Mark Lorenzen wrote:
> On Monday, July 10, 2017 at 11:48:29 AM UTC+2, Dmitry A. Kazakov wrote:
>> On 10/07/2017 11:31, Victor Porton wrote:
>>
>>> Read description of Value() carefully. It stops at first NUL.
>>
>> if Ptr = Null_Ptr then
>> return "";
>> else
>> return To_Ada (Value (Ptr, Length), False);
>> end if;
>
> I don't think that it will work as (if I understand it correctly) the
> string the OP tries to convert may contain NULL characters that are
> not to be interpreted as string terminators.
I see, it seems that Value is broken in ARM B.3.1(35). The semantics
specified is:
"If Item = Null_Ptr, then Value propagates Dereference_Error. Otherwise,
Value returns the shorter of two arrays, either the first Length chars
pointed to by Item, or Value(Item). The lower bound of the result is 0.
If Length is 0, then Value propagates Constraint_Error."
which is if not useless then incomplete. There must be Trim_Nul or
Ignore_Nul parameter as in To_Ada and Length=0 must be OK.
> I think the problem is, that the OP is confused about the difference
> between C strings and C arrays of characters and tries to use
> Interfaces.C.Strings to manipulate C arrays of characters thar are not
> be interpreted as C strings but as simple arrays of characters.
There is no such difference. Some C functions use NUL some ignore it.
The OP's request is absolutely reasonable.
> Maybe Interfaces.C.Pointers is more appropriate?
Yes. There seems no way other than to use Interfaces.C.Pointers and
convert each character individually.
I would suggest the OP to post a change request to ARG.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 2%]
* Re: Convert chars_ptr to Ada String
@ 2017-07-10 12:41 3% ` Mark Lorenzen
2017-07-10 14:24 2% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Mark Lorenzen @ 2017-07-10 12:41 UTC (permalink / raw)
On Monday, July 10, 2017 at 11:48:29 AM UTC+2, Dmitry A. Kazakov wrote:
> On 10/07/2017 11:31, Victor Porton wrote:
>
> > Read description of Value() carefully. It stops at first NUL.
>
> if Ptr = Null_Ptr then
> return "";
> else
> return To_Ada (Value (Ptr, Length), False);
> end if;
>
> --
> Regards,
> Dmitry A. Kazakov
> http://www.dmitry-kazakov.de
I don't think that it will work as (if I understand it correctly) the string the OP tries to convert may contain NULL characters that are not to be interpreted as string terminators.
I think the problem is, that the OP is confused about the difference between C strings and C arrays of characters and tries to use Interfaces.C.Strings to manipulate C arrays of characters thar are not be interpreted as C strings but as simple arrays of characters.
Maybe Interfaces.C.Pointers is more appropriate?
Regards,
Mark L
^ permalink raw reply [relevance 3%]
* Re: Convert chars_ptr to Ada String
2017-07-10 4:58 2% ` Anh Vo
@ 2017-07-10 9:31 0% ` Victor Porton
0 siblings, 1 reply; 200+ results
From: Victor Porton @ 2017-07-10 9:31 UTC (permalink / raw)
Anh Vo wrote:
> On Saturday, July 8, 2017 at 11:49:34 PM UTC-7, Victor Porton wrote:
>> Anh Vo wrote:
>>
>> > On Friday, July 7, 2017 at 3:49:20 PM UTC-7, Victor Porton wrote:
>> >> Anh Vo wrote:
>> >>
>> >> > On Friday, July 7, 2017 at 2:03:32 PM UTC-7, Victor Porton wrote:
>> >> >> Remind me how to convert a pair of Ptr: chars_ptr and Size: size_t
>> >> >> to an Ada string.
>> >> >>
>> >> >> Ptr may contain NULs and this should not influence the length of
>> >> >> the resulting string.
>> >> >
>> >> > Look at APIs defined in package Interfaces.C.Strings.
>> >>
>> >> I've done it:
>> >>
>> >> https://github.com/vporton/redland-bindings/blob/ada2012/ada/src/rdf-auxiliary-convert.adb
>> >>
>> >> It requires not only Interfaces.C.Strings but also
>> >> Interfaces.C.Pointers to make things more confusing.
>> >
>> > Why make it more confusing while it is actually simpler as shown below.
>> >
>> > with Interfaces.C.Strings; use Interfaces.C.Strings;
>> >
>> > package body RDF.Auxiliary.Convert is
>> >
>> > function Value_With_Possible_NULs (Item:
>> > RDF.Auxiliary.C_Pointers.Pointer; Length: size_t) return String is
>> > begin
>> > return To_Ada(Item, Length);
>>
>> I see no such two-argument To_Ada in Interfaces.C.
>>
>> Or where to import such To_Ada from?
>
> Oops! I meant function value which is defined in Interfaces.C.Strings.
Read description of Value() carefully. It stops at first NUL.
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 0%]
* Re: Convert chars_ptr to Ada String
2017-07-09 6:49 2% ` Victor Porton
@ 2017-07-10 4:58 2% ` Anh Vo
2017-07-10 9:31 0% ` Victor Porton
0 siblings, 1 reply; 200+ results
From: Anh Vo @ 2017-07-10 4:58 UTC (permalink / raw)
On Saturday, July 8, 2017 at 11:49:34 PM UTC-7, Victor Porton wrote:
> Anh Vo wrote:
>
> > On Friday, July 7, 2017 at 3:49:20 PM UTC-7, Victor Porton wrote:
> >> Anh Vo wrote:
> >>
> >> > On Friday, July 7, 2017 at 2:03:32 PM UTC-7, Victor Porton wrote:
> >> >> Remind me how to convert a pair of Ptr: chars_ptr and Size: size_t to
> >> >> an Ada string.
> >> >>
> >> >> Ptr may contain NULs and this should not influence the length of the
> >> >> resulting string.
> >> >
> >> > Look at APIs defined in package Interfaces.C.Strings.
> >>
> >> I've done it:
> >>
> >> https://github.com/vporton/redland-bindings/blob/ada2012/ada/src/rdf-auxiliary-convert.adb
> >>
> >> It requires not only Interfaces.C.Strings but also Interfaces.C.Pointers
> >> to make things more confusing.
> >
> > Why make it more confusing while it is actually simpler as shown below.
> >
> > with Interfaces.C.Strings; use Interfaces.C.Strings;
> >
> > package body RDF.Auxiliary.Convert is
> >
> > function Value_With_Possible_NULs (Item:
> > RDF.Auxiliary.C_Pointers.Pointer; Length: size_t) return String is
> > begin
> > return To_Ada(Item, Length);
>
> I see no such two-argument To_Ada in Interfaces.C.
>
> Or where to import such To_Ada from?
Oops! I meant function value which is defined in Interfaces.C.Strings.
^ permalink raw reply [relevance 2%]
* Re: Convert chars_ptr to Ada String
2017-07-07 23:14 3% ` Anh Vo
@ 2017-07-09 6:49 2% ` Victor Porton
2017-07-10 4:58 2% ` Anh Vo
0 siblings, 1 reply; 200+ results
From: Victor Porton @ 2017-07-09 6:49 UTC (permalink / raw)
Anh Vo wrote:
> On Friday, July 7, 2017 at 3:49:20 PM UTC-7, Victor Porton wrote:
>> Anh Vo wrote:
>>
>> > On Friday, July 7, 2017 at 2:03:32 PM UTC-7, Victor Porton wrote:
>> >> Remind me how to convert a pair of Ptr: chars_ptr and Size: size_t to
>> >> an Ada string.
>> >>
>> >> Ptr may contain NULs and this should not influence the length of the
>> >> resulting string.
>> >
>> > Look at APIs defined in package Interfaces.C.Strings.
>>
>> I've done it:
>>
>> https://github.com/vporton/redland-bindings/blob/ada2012/ada/src/rdf-auxiliary-convert.adb
>>
>> It requires not only Interfaces.C.Strings but also Interfaces.C.Pointers
>> to make things more confusing.
>
> Why make it more confusing while it is actually simpler as shown below.
>
> with Interfaces.C.Strings; use Interfaces.C.Strings;
>
> package body RDF.Auxiliary.Convert is
>
> function Value_With_Possible_NULs (Item:
> RDF.Auxiliary.C_Pointers.Pointer; Length: size_t) return String is
> begin
> return To_Ada(Item, Length);
I see no such two-argument To_Ada in Interfaces.C.
Or where to import such To_Ada from?
> end;
>
> end RDF.Auxiliary.Convert;
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 2%]
* Re: Convert chars_ptr to Ada String
2017-07-07 22:48 3% ` Victor Porton
@ 2017-07-07 23:14 3% ` Anh Vo
2017-07-09 6:49 2% ` Victor Porton
0 siblings, 1 reply; 200+ results
From: Anh Vo @ 2017-07-07 23:14 UTC (permalink / raw)
On Friday, July 7, 2017 at 3:49:20 PM UTC-7, Victor Porton wrote:
> Anh Vo wrote:
>
> > On Friday, July 7, 2017 at 2:03:32 PM UTC-7, Victor Porton wrote:
> >> Remind me how to convert a pair of Ptr: chars_ptr and Size: size_t to an
> >> Ada string.
> >>
> >> Ptr may contain NULs and this should not influence the length of the
> >> resulting string.
> >
> > Look at APIs defined in package Interfaces.C.Strings.
>
> I've done it:
>
> https://github.com/vporton/redland-bindings/blob/ada2012/ada/src/rdf-auxiliary-convert.adb
>
> It requires not only Interfaces.C.Strings but also Interfaces.C.Pointers
> to make things more confusing.
Why make it more confusing while it is actually simpler as shown below.
with Interfaces.C.Strings; use Interfaces.C.Strings;
package body RDF.Auxiliary.Convert is
function Value_With_Possible_NULs (Item: RDF.Auxiliary.C_Pointers.Pointer; Length: size_t) return String is
begin
return To_Ada(Item, Length);
end;
end RDF.Auxiliary.Convert;
^ permalink raw reply [relevance 3%]
* Re: Convert chars_ptr to Ada String
2017-07-07 22:23 2% ` Anh Vo
@ 2017-07-07 22:48 3% ` Victor Porton
2017-07-07 23:14 3% ` Anh Vo
0 siblings, 1 reply; 200+ results
From: Victor Porton @ 2017-07-07 22:48 UTC (permalink / raw)
Anh Vo wrote:
> On Friday, July 7, 2017 at 2:03:32 PM UTC-7, Victor Porton wrote:
>> Remind me how to convert a pair of Ptr: chars_ptr and Size: size_t to an
>> Ada string.
>>
>> Ptr may contain NULs and this should not influence the length of the
>> resulting string.
>
> Look at APIs defined in package Interfaces.C.Strings.
I've done it:
https://github.com/vporton/redland-bindings/blob/ada2012/ada/src/rdf-auxiliary-convert.adb
It requires not only Interfaces.C.Strings but also Interfaces.C.Pointers
to make things more confusing.
--
Victor Porton - http://portonvictor.org
^ permalink raw reply [relevance 3%]
* Re: Convert chars_ptr to Ada String
@ 2017-07-07 22:23 2% ` Anh Vo
2017-07-07 22:48 3% ` Victor Porton
0 siblings, 1 reply; 200+ results
From: Anh Vo @ 2017-07-07 22:23 UTC (permalink / raw)
On Friday, July 7, 2017 at 2:03:32 PM UTC-7, Victor Porton wrote:
> Remind me how to convert a pair of Ptr: chars_ptr and Size: size_t to an Ada
> string.
>
> Ptr may contain NULs and this should not influence the length of the
> resulting string.
Look at APIs defined in package Interfaces.C.Strings.
Anh Vo
^ permalink raw reply [relevance 2%]
* Ann: ArchiCheck v0.1
@ 2017-06-07 22:06 1% Lionel Draghi
0 siblings, 0 replies; 200+ results
From: Lionel Draghi @ 2017-06-07 22:06 UTC (permalink / raw)
Hi all,
Archicheck is a simple tool to describe and enforce architecture/design
decision that are not easily checked by languages and compilers.
This code was written twelve years ago, and even announced on
comp.lang.ada
(http://groups.google.com/group/comp.lang.ada/browse_thread/thread/4a195a443fce793e/41bb2cb527464bab?q=comp.lang.ada+example+of+layered+software#41bb2cb527464bab)
in November 2005, but never released.
Here it is, essentially as it was in 2005, build in the same environment
(Darcs, Gnat, NaturalDocs, Dia, OpenToken, etc.).
This tool was written because of my frustration that simple design
decision where not complied with.
A classical and recurring case was that for a bug fix, someone adds a
“with” in the code, that created a visibility to a package supposed to
be in an upper layer.
(Refer to slides 5 to 8 in this 2004 (!) pdf :
http://lionel.draghi.free.fr/ArchiCheck/Doc/Archicheck Overview.pdf for
a graphical view of this).
Few month of such a code spaghettization resulted in subtle elaboration
order problems, and obviously in code degradation.
Another classical design decision not so easy to verify is to forbid any
dependencies on OS specific code, except in an appointed “portability”
package.
Ada couldn’t prevent this (not to mention other languages), and I found
no external tools able to verify it.
This is why I started the Archicheck project, as a tool that read a text
file containing in simple statements the architecture description, and
check the code compliance.
Consider the my_rules.txt file :
Presentation_Layer contains A B C packages
Application_Layer contains D E F packages
Domain_Layer contains G H I packages
Presentation_Layer is a layer over Application_Layer
Application_Layer is a layer over Domain_Layer
Only Hardware_Abstraction_Layer can use Interfaces.C
Just put
archicheck my_rules.txt –I ./my_src
in your make file, and that’s it.
This is a POC, the code is not at all robust, or even well tested, and
it check only Layer rules at this stage (cf. Tests section here :
http://lionel.draghi.free.fr/Archicheck/index.html).
Any feedback or comment is welcomed (even on the tool’s name!).
More info on http://lionel.draghi.free.fr/Archicheck/index.html
Lionel
^ permalink raw reply [relevance 1%]
* Re: Example Ada calling Gnu Scientific Library (GSL)
2017-04-10 15:39 3% ` hreba
@ 2017-04-10 17:16 0% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2017-04-10 17:16 UTC (permalink / raw)
On 2017-04-10 17:39, hreba wrote:
> On 04/10/2017 11:47 AM, Dmitry A. Kazakov wrote:
>>
>> You also seem confuse project to build and project to use a library.
>> They are not same! For a bindings library you need both.
>>
>
> I don't understand that. From the discussions here on the list I thought:
>
> 1. Thin binding is just an interface module which allows to call the C
> library functions from an Ada program, using all the parameters of the C
> prototype and some types from Interfaces.C.
> Library project.
Yes, plus conversion of some elementary types. It is considered thin to
convert char * to String and int!=0 to Boolean.
> 2. Thick binding: Specification and implementation of Ada subprograms
> which call subprograms of the thin binding. Interfaces.C types can be
> avoided in the specifications. Specification of exported subprograms
> usually differ from corresponding imported C prototypes, because this is
> what you want from thick bindings.
> Library project, because there is no executable.
Yes.
> 3. Application calls subprograms from the thick binding and defines
> executable(s) (Main).
> Non-library project because executables are generated.
AFAIK relocatable library counts as executable, but yes.
> What is wrong here, why do i need both types of projects for a bindings
> library?
It is how gprbuild works. I am not happy with that design but it is how
it is.
You need:
1. C library project [or package Linker / Library_Options]
2.a. Ada thin bindings library build project that with-es #1
2.b. Ada thin bindings library use project that with-es #1
3.a. Ada think bindings library build project that with-es #2.b
3.b. Ada think bindings library use project that with-es #2.b
4. Application build project that with-es #3.b
You can ditch #1 and then:
for #2.a you use package Linker to link to C library
for #2.b you use Linker_Options to instruct future users of the library
that they also must link to the C library
To summarize: for building application or library you use different
options from when you use already built library in another project.
Of course, 2 and 3 are normally merged together. There is little reason
to keep them in separate libraries.
> And is that documented anywhere?
Sure, you can find hints in:
https://docs.adacore.com/gprbuild-docs/html/gprbuild_ug/gnat_project_manager.html
P.S. For an example of thin and thick bindings smaller than GtkAda you
can look at ODBC bindings:
http://www.dmitry-kazakov.de/ada/components.htm#ODBC_Bindings
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: Example Ada calling Gnu Scientific Library (GSL)
@ 2017-04-10 15:39 3% ` hreba
2017-04-10 17:16 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: hreba @ 2017-04-10 15:39 UTC (permalink / raw)
On 04/10/2017 11:47 AM, Dmitry A. Kazakov wrote:
>
> You also seem confuse project to build and project to use a library.
> They are not same! For a bindings library you need both.
>
I don't understand that. From the discussions here on the list I thought:
1. Thin binding is just an interface module which allows to call the C
library functions from an Ada program, using all the parameters of the C
prototype and some types from Interfaces.C.
Library project.
2. Thick binding: Specification and implementation of Ada subprograms
which call subprograms of the thin binding. Interfaces.C types can be
avoided in the specifications. Specification of exported subprograms
usually differ from corresponding imported C prototypes, because this is
what you want from thick bindings.
Library project, because there is no executable.
3. Application calls subprograms from the thick binding and defines
executable(s) (Main).
Non-library project because executables are generated.
What is wrong here, why do i need both types of projects for a bindings
library?
And is that documented anywhere?
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 3%]
* Re: Example Ada calling Gnu Scientific Library (GSL)
2017-03-29 20:07 0% ` Randy Brukardt
@ 2017-04-04 21:25 0% ` hreba
0 siblings, 1 reply; 200+ results
From: hreba @ 2017-04-04 21:25 UTC (permalink / raw)
On 03/29/2017 10:07 PM, Randy Brukardt wrote:
> "hreba" <f_hreba@yahoo.com.br> wrote in message
> news:ek15faF6958U1@mid.individual.net...
>> On 03/29/2017 03:29 AM, Leo Brewin wrote:
>>> Hi Folks,
>>>
>>> I've been following the discussion about the thin bindings to the GSL
>>> library (and thanks to all for the useful information).
>>>
>>
>> Thanks for the example. Nevertheless, I think it is only a first step,
>> because I would prefer an interface to the C library where the client does
>> not have to use the type Interfaces.C.double, or even import Interfaces.
>
> Surely. But the point is that you can use these steps to relatively easily
> make a working thin binding. You then write your intended interface (the
> thick binding) by directly using the thin binding in Ada. That should work
> without stressing the Ada compiler and causing weird failures. (That's how
> the best Ada bindings are built; you have a direct thin binding and then a
> thicker binding that makes the thin binding more appropriate for Ada by
> introducing exceptions, generics, default parameters, sensible Ada naming
> (no camel case!), and so on.)
>
> Randy.
>
Ok, I did this and now I am struggling with the project files. The first
one handles the thin binding:
library project GSL_Raw is
for Source_Dirs use ("src");
for Library_Dir use ".";
for Library_Name use "gsl_raw";
for Library_Kind use "static";
for Externally_Built use "true";
end GSL_Raw;
Directory src contains the output from g++ -c -fdump-ada-spec -C...
There is another directory, obj, which holds the result from
gcc -c -gnat05 ../src/*.ads.
Then there is the project of the thick binding in another directory:
with "GSL_Raw/gsl_raw";
library project GSL is
for Source_Dirs use ("src");
for Library_Name use "gsl";
for Library_Dir use ".";
for Object_Dir use "obj";
for Library_Interface use ("gsl");
for Library_Kind use "static";
for externally_built use "false";
package Compiler is
for Default_Switches ("Ada") use ("-g", "-gnat05");
end Compiler;
end GSL;
Now when a 3. project, for an executable program, imports project GSL I get:
error: "gsl_gsl_integration_h.ali" not found,
"gsl_gsl_integration_h.ads" must be compiled
The missing file is present in the directory obj mentioned above, but
how/where do I specify this?
I included the line
for Object_Dir use "obj";
in the GSL_Raw project, but to no avail.
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 0%]
* Re: Interfaces.C + generics: stack overflow
2017-03-27 7:21 4% ` Dmitry A. Kazakov
@ 2017-03-30 17:12 3% ` Robert Eachus
0 siblings, 0 replies; 200+ results
From: Robert Eachus @ 2017-03-30 17:12 UTC (permalink / raw)
On Monday, March 27, 2017 at 3:21:19 AM UTC-4, Dmitry A. Kazakov wrote:
>
> I never got Storage_Error otherwise than in infinite recursion calls.
> The most frequent case lies outside Ada when interfacing C.
Dave and I worked at MITRE, mostly on software embedded in radar systems. Since these systems were hard real time (a late answer is worse than wrong) virtual memory was used only on software development systems. Debugging on real hardware usually cramped the actual software by using up any "spare" memory to load the debugger. So not only did Storage_Error indicate a problem somewhere, but the site where Storage_Error was raised often had nothing to do with the "real" error where some component of the system used more than its allocated amount of memory.
On virtual memory systems, Storage_Error should occur only in two cases. One where the limited assets allocate for some purpose are exhausted. (Overflowing a task stack is the most usual, and pushing up the stack size the obvious fix.) The other is where you exhaust the virtual address space. Those usually occur where array dimensions were not constrained. (Notice that today, on 64-bit systems allocating a (2**31 byte) string when allocating the max for unbounded objects may sail right along. ;-)
^ permalink raw reply [relevance 3%]
* Re: Example Ada calling Gnu Scientific Library (GSL)
2017-03-29 7:19 3% ` hreba
@ 2017-03-29 20:07 0% ` Randy Brukardt
2017-04-04 21:25 0% ` hreba
0 siblings, 1 reply; 200+ results
From: Randy Brukardt @ 2017-03-29 20:07 UTC (permalink / raw)
"hreba" <f_hreba@yahoo.com.br> wrote in message
news:ek15faF6958U1@mid.individual.net...
> On 03/29/2017 03:29 AM, Leo Brewin wrote:
>> Hi Folks,
>>
>> I've been following the discussion about the thin bindings to the GSL
>> library (and thanks to all for the useful information).
>>
>
> Thanks for the example. Nevertheless, I think it is only a first step,
> because I would prefer an interface to the C library where the client does
> not have to use the type Interfaces.C.double, or even import Interfaces.
Surely. But the point is that you can use these steps to relatively easily
make a working thin binding. You then write your intended interface (the
thick binding) by directly using the thin binding in Ada. That should work
without stressing the Ada compiler and causing weird failures. (That's how
the best Ada bindings are built; you have a direct thin binding and then a
thicker binding that makes the thin binding more appropriate for Ada by
introducing exceptions, generics, default parameters, sensible Ada naming
(no camel case!), and so on.)
Randy.
^ permalink raw reply [relevance 0%]
* Re: Example Ada calling Gnu Scientific Library (GSL)
2017-03-29 1:29 4% Example Ada calling Gnu Scientific Library (GSL) Leo Brewin
@ 2017-03-29 7:19 3% ` hreba
2017-03-29 20:07 0% ` Randy Brukardt
0 siblings, 1 reply; 200+ results
From: hreba @ 2017-03-29 7:19 UTC (permalink / raw)
On 03/29/2017 03:29 AM, Leo Brewin wrote:
> Hi Folks,
>
> I've been following the discussion about the thin bindings to the GSL library (and thanks to all for the useful information).
>
Thanks for the example. Nevertheless, I think it is only a first step,
because I would prefer an interface to the C library where the client
does not have to use the type Interfaces.C.double, or even import
Interfaces.
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 3%]
* Example Ada calling Gnu Scientific Library (GSL)
@ 2017-03-29 1:29 4% Leo Brewin
2017-03-29 7:19 3% ` hreba
0 siblings, 1 reply; 200+ results
From: Leo Brewin @ 2017-03-29 1:29 UTC (permalink / raw)
Hi Folks,
I've been following the discussion about the thin bindings to the GSL library (and thanks to all for the useful information).
I decided to follow the suggestion by Per Sandberg (Mar 19) to use gcc to create the header files. After a small amount of fiddling I got things working. And I'm very impressed with just how painless the whole process was. So here is a short summary of what I did.
1. Created a simple C-file, "integral.c"
#include <gsl/gsl_integration.h>
int main (void) {}
2. Run "gcc -fdump-ada-spec integral.c"
3. Replace "limited with" by "with" on line 6 of gsl_gsl_integration_h.ads
4. Used the generated headers to glean the required Ada syntax to create the
thin binding needed for a simple GSL example. Here is the main program
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces.C; use Interfaces.C;
with gsl_gsl_math_h;
with gsl_gsl_integration_h;
with sys_utypes_usize_t_h;
with fun; -- function to integerate, must be in a separate pacakge
procedure GSL_Test is
a,b : Interfaces.C.double;
epsabs : Interfaces.C.double;
epsrel : Interfaces.C.double;
abserr : aliased Interfaces.C.double;
result : aliased Interfaces.C.double;
limit : sys_utypes_usize_t_h.size_t;
key : Interfaces.C.int;
return_code : Interfaces.C.int;
integrand : aliased gsl_gsl_math_h.gsl_function;
alpha : Interfaces.C.double := 4.0;
workspace : access gsl_gsl_integration_h.gsl_integration_workspace;
size : aliased sys_utypes_usize_t_h.size_t;
level : access sys_utypes_usize_t_h.size_t;
begin
a := 0.0; -- lower limit
b := 1.0; -- upper limit
epsabs := 1.0e-25; -- target actual error
epsrel := 1.0e-13; -- target relative error, 1.0e-14 gives a GSL error
limit := 1000; -- maximum number of sub-intervals
key := 5; -- which integration method to use, range from 1 to 6
integrand.c_function := fun.f'access; -- the function to integrate
integrand.params := alpha'address; -- parameters for the function
workspace := gsl_gsl_integration_h.gsl_integration_workspace_alloc (limit);
return_code := gsl_gsl_integration_h.gsl_integration_qag
(integrand'access,a,b,epsabs,epsrel,limit,key,workspace,result'access,abserr'access);
put ("Intgeral (qag) = ");
put (Interfaces.C.double'Image(result));
new_line;
return_code := gsl_gsl_integration_h.gsl_integration_qags
(integrand'access,a,b,epsabs,epsrel,limit,workspace,result'access,abserr'access);
put ("Intgeral (qags) = ");
put (Interfaces.C.double'Image(result));
new_line;
size := workspace.size;
level := workspace.level;
put ("Workspace size = ");
put (sys_utypes_usize_t_h.size_t'Image(size));
new_line;
put ("Workspace level = ");
put (sys_utypes_usize_t_h.size_t'Image(level.all));
new_line;
gsl_gsl_integration_h.gsl_integration_workspace_free (workspace);
end GSL_Test;
5. The integrand is in a separate package, here is the spec file (fun.ads)
with Interfaces.C; use Interfaces.C;
with System;
package fun is
function f (x : Interfaces.C.double; params : System.Address) return Interfaces.C.double;
pragma Convention (C, f);
end fun;
6. And here is the body, fun.adb
with Ada.Numerics.Generic_Elementary_Functions;
package body fun is
package GSL_Maths is new Ada.Numerics.Generic_Elementary_Functions (Interfaces.C.double); use GSL_Maths;
function f (x : Interfaces.C.double; params : System.Address) return Interfaces.C.double is
alpha : Interfaces.C.double;
for alpha'address use params;
begin
return log(alpha*x) / sqrt(x);
end f;
end fun;
7. The code can be compiled using the "-lgsl" linker option (assuming GSL has been installed
in the standard locations. I used "homebrew" on my macOS, "brew install gsl").
8. The output from the above code was
Intgeral (qag) = -1.22741127776022E+00
Intgeral (qags) = -1.22741127776022E+00
Workspace size = 12
Workspace level = 11
I hope this helps (sorry for the long code listing).
But I do have a question. If I chose the target relative error (epsrel) to be 1.0e-14 the GSL code fails to meet that accuracy and the Ada code crashes with a PROGRAM_ERROR. I tried to catch this with an exception block (around the call to the gsl code) but that didn't work. The exception is raised within the GSL library -- is there any way I can catch this? The GSL documentation states that even when the code fails, it returns the best answer. So I'd rather have an answer even if it didn't meet my too stringent error request.
One further note. On experiments with the GSL Bessel library I found that the GSL code uses the case sensitive nature of C to provide different versions of the Bessel functions. This is a problem for Ada which is cases insenstive. The solution is to add some unique descriptor to selected function names in the Ada headers to avoid the ambiguities.
Cheers,
Leo
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C + generics: stack overflow
2017-03-26 22:34 3% ` Robert Eachus
@ 2017-03-27 7:21 4% ` Dmitry A. Kazakov
2017-03-30 17:12 3% ` Robert Eachus
0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2017-03-27 7:21 UTC (permalink / raw)
On 27/03/2017 00:34, Robert Eachus wrote:
> On Saturday, March 25, 2017 at 11:21:41 AM UTC-4, hreba wrote:
>
>> It works finally, I just don't know the reason. All I did is take
>> Dmitrys suggestion, and move the package instantiation from the main
>> program to package Integ_Aux (that is where the function to be passed to
>> the C-library-integrator is defined.)
>
> I'm glad you found a solution. Dave Emery used to call Storage_Error
> a parachute that opened on impact. (Think Roadrunner cartoons.) Things
> have gotten a lot better, and GNAT in particular tries to identify all
> cases where Storage_Error will always be raised (as warnings). But the
> real issue is that it is in general not possible to create a stack frame
> or allocate an object after an occurrence of Storage_Error.
I never got Storage_Error otherwise than in infinite recursion calls.
The most frequent case lies outside Ada when interfacing C.
> It would be nice if there was a parameter which identified where in
> that particular compiler the Storage_Error came from.
Stack and local memory should be a part of the contract. E.g. "I don't
raise Storage_Error when there is more than X storage elements free."
> Yes, Storage_Error
> is raised during execution, but the generated code or sometimes even the
> run-time library code has no clue you can use during debugging. I wonder
> how much could be done with Exception_Message.
Probably nothing because in most cases the information necessary is
already lost.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C + generics: stack overflow
2017-03-25 15:21 4% ` hreba
@ 2017-03-26 22:34 3% ` Robert Eachus
2017-03-27 7:21 4% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: Robert Eachus @ 2017-03-26 22:34 UTC (permalink / raw)
On Saturday, March 25, 2017 at 11:21:41 AM UTC-4, hreba wrote:
> It works finally, I just don't know the reason. All I did is take
> Dmitrys suggestion, and move the package instantiation from the main
> program to package Integ_Aux (that is where the function to be passed to
> the C-library-integrator is defined.)
I'm glad you found a solution. Dave Emery used to call Storage_Error a parachute that opened on impact. (Think Roadrunner cartoons.) Things have gotten a lot better, and GNAT in particular tries to identify all cases where Storage_Error will always be raised (as warnings). But the real issue is that it is in general not possible to create a stack frame or allocate an object after an occurrence of Storage_Error.
It would be nice if there was a parameter which identified where in that particular compiler the Storage_Error came from. Yes, Storage_Error is raised during execution, but the generated code or sometimes even the run-time library code has no clue you can use during debugging. I wonder how much could be done with Exception_Message. If the compiler had a collection of strings to be returned, there would be no need to allocate space for a string after the Storage_Error..
^ permalink raw reply [relevance 3%]
* Re: Interfaces.C + generics: stack overflow
2017-03-25 14:17 4% ` hreba
2017-03-25 15:21 4% ` hreba
@ 2017-03-25 15:23 6% ` Dmitry A. Kazakov
1 sibling, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2017-03-25 15:23 UTC (permalink / raw)
On 2017-03-25 15:17, hreba wrote:
> On 03/24/2017 11:03 PM, Dmitry A. Kazakov wrote:
>
> Thanks for your convincing suggestions and the detailed code. I changed
> my program accordingly - still STORAGE_ERROR.
>
> Then I followed the advice from Randy, transferring the exported
> function of the C library to another, non-generic package, changing the
> first parameter from
>
> function gsl_integration_qng
> (f: in out GSL_Function; ...
> to
> function gsl_integration_qng
> (f: System.Address; ...
>
> Result - STORAGE_ERROR
1. You could try to replace out T with access T. Especially because you
apply a conversion to the argument.
2. You should also read the library documentation for memory allocation
issues. Storage_Error is a usual result when an Ada allocated object is
passed where a C malloc result expected. If some of the arguments are
allocated by callee to be freed by the caller or conversely you must use
Interfaces.C.Pointers to deal with these.
3. And you could debug it to get an idea where it fails. If the stack
frame becomes corrupted, that means wrong call convention. An error in
the heap indicates an allocator issue as above etc.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 6%]
* Re: Interfaces.C + generics: stack overflow
2017-03-25 14:17 4% ` hreba
@ 2017-03-25 15:21 4% ` hreba
2017-03-26 22:34 3% ` Robert Eachus
2017-03-25 15:23 6% ` Dmitry A. Kazakov
1 sibling, 1 reply; 200+ results
From: hreba @ 2017-03-25 15:21 UTC (permalink / raw)
On 03/25/2017 03:17 PM, hreba wrote:
>
> To be continued ...
>
It works finally, I just don't know the reason. All I did is take
Dmitrys suggestion, and move the package instantiation from the main
program to package Integ_Aux (that is where the function to be passed to
the C-library-integrator is defined.)
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C + generics: stack overflow
2017-03-24 22:03 2% ` Dmitry A. Kazakov
@ 2017-03-25 14:17 4% ` hreba
2017-03-25 15:21 4% ` hreba
2017-03-25 15:23 6% ` Dmitry A. Kazakov
0 siblings, 2 replies; 200+ results
From: hreba @ 2017-03-25 14:17 UTC (permalink / raw)
On 03/24/2017 11:03 PM, Dmitry A. Kazakov wrote:
Thanks for your convincing suggestions and the detailed code. I changed
my program accordingly - still STORAGE_ERROR.
Then I followed the advice from Randy, transferring the exported
function of the C library to another, non-generic package, changing the
first parameter from
function gsl_integration_qng
(f: in out GSL_Function; ...
to
function gsl_integration_qng
(f: System.Address; ...
Result - STORAGE_ERROR
To be continued ...
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C + generics: stack overflow
2017-03-24 12:42 6% ` hreba
2017-03-24 20:13 3% ` Randy Brukardt
@ 2017-03-24 22:03 2% ` Dmitry A. Kazakov
2017-03-25 14:17 4% ` hreba
1 sibling, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2017-03-24 22:03 UTC (permalink / raw)
On 2017-03-24 13:42, hreba wrote:
> generic
> type Real is digits <>;
> type Parameters is private; -- for future use
> package GSL is
>
> gsl_Ex: Exception;
> error_code: Integer; -- of the last operation
>
> type Real_Function is access function (x: Real) return Real;
[...]
Your design looks wrong to me.
An important objection is that the code is not re-entrant. You store
data in the package body during the call.
Another issue is that you forgot C convention for GSL_Function.
If you want to pass an Ada function to the integrator you must use a C
wrapper for it. An alternative would be to use C convention for
Real_Function, but let us put that aside.
Now the Params component is just for this case. What you should do is to
pass a pointer to the Ada function via Params plus parameter for the
function if any. E.g.
type Arguments is record
Func : Real_Function;
Params : Parameters; -- You can use parameters later
end record;
type Arguments_Ptr is access all Arguments;
pragma Convention (C, Arguments_Ptr);
type GSL_Inner_Function is
access function
( x : C.double;
params : Arguments_Ptr
) return C.double;
pragma Convention (C, GSL_Inner_Function);
type GSL_Function is record
func : GSL_Inner_Function;
params : Arguments_Ptr;
end record;
pragma Convention (C, GSL_Function); -- Do not forget this!
function C_Func (X : C.double; Params : Arguments_Ptr)
return C.double;
pragma Convention (C, C_Func);
function C_Func (X : C.double; Params : Arguments_Ptr)
return C.double is
begin -- Params is pointer to Ada function + its parameters
return C.double (Params.Func (Real (x)));
exception
when others => -- You never propagate Ada exceptions from C
return 0.0; -- code! Do tracing here if you want or call
end C_Func; -- Exit() to kill the program
function gsl_integration_qng
( f : in out GSL_Function;
a, b, epsabs, epsrel : C.double;
result, abserr : out C.double;
neval : out C.size_t
) return C.int;
pragma Import (C, gsl_integration_qng, "gsl_integration_qng");
procedure Integration_QNG
( f : Real_Function;
a, b, epsabs, epsrel : Real;
result, abserr : out Real;
neval : out Natural
) is
use type C.int;
Ada_Data : aliased Arguments;
C_Data : GSL_Function :=
(C_Func'Access, Ada_Data'Unchecked_Access);
status : C.int;
res, ae : C.double;
ne : C.size_t;
begin
Ada_Data.Func := f;
status :=
gsl_integration_qng
( C_Data,
C.double (a),
C.double (b),
C.double (epsabs),
C.double (epsrel),
res, ae, ne
);
...
No data stored in the package body.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 2%]
* Re: Interfaces.C + generics: stack overflow
2017-03-24 12:42 6% ` hreba
@ 2017-03-24 20:13 3% ` Randy Brukardt
2017-03-24 22:03 2% ` Dmitry A. Kazakov
1 sibling, 0 replies; 200+ results
From: Randy Brukardt @ 2017-03-24 20:13 UTC (permalink / raw)
I don't see anything obviously wrong with your code (Janus/Ada can't compile
it for various reasons, including that it doesn't yet support "in out"
parameters on functions, so I didn't learn much from that attempt.)
What I would suggest is moving all of the actual C interface stuff out of
the generic, making the generic part of the think binding rather than trying
to do it all in one. That's likely to get rid of any bugs and make the code
more portable.
The body of the generic would use type conversions (and if necessary,
Unchecked_Conversion) to match up the formal types with the types of the
thin binding. As I noted yesterday, that would make it a lot more portable
to compilers that support some form of code sharing (which can't, in
general, support C interfacing in a generic body).
Hope the above gives you some suggestions to try.
Randy.
"hreba" <f_hreba@yahoo.com.br> wrote in message
news:ejkigvFlkjbU1@mid.individual.net...
> On 03/23/2017 09:03 PM, Randy Brukardt wrote:
>> I agree with Jeff, there's not enough detail here to even see if there is
>> a
>> bug or your mistake. We need to know how/where the generic is
>> instantiated,
>> where/how the access-to-function value is created, and probably more.
>>
> The complete code follows below. The suggestion from Jeffrey is already
> realized. The packages are:
> - GSL wrapper for the C library
> - Test_Integration main program, instantiates GSL
> - Integ_Aux defines the function to be handed over
>
>> But let me say that the rules for access-to-subprogram types are
>> different
>> inside of generics than they are in normal packages, in order to allow
>> for
>> the possibility of generic sharing. That ought to manifest as
>> compile-time
>> errors and/or the raising of Program_Error, so it seems that there might
>> be
>> a compiler bug in your code. But to find that, one needs to see the whole
>> thing, not just a little corner.
>>
>> If you really want to write portable interfacing code, you would not use
>> any
>> generics in the raw interface. (Have the generics call non-generic
>> interface
>> code with appropriate type conversions.) Janus/Ada doesn't allow any
>> convention C stuff in generic units, because it is incompatible with the
>> extra dope needed to implemented universal generic sharing. I'd expect
>> something similar to happen for any implementation that supports almost
>> any
>> form of generic sharing. (If you only care about GNAT, do what ever you
>> want.)
>>
> I am not writing this program only for its result, but also as an exercise
> in Ada programming. So I want to do it the right way. So far I know
> basically the book from John Barnes, where this topic is not treated, so
> thanks for your comments, I will modify my program accordingly.
>
> ---------------------------------------------------------------------------
> generic
> type Real is digits <>;
> type Parameters is private; -- for future use
> package GSL is
>
> gsl_Ex: Exception;
> error_code: Integer; -- of the last operation
>
> type Real_Function is access function (x: Real) return Real;
>
> procedure Integration_QNG
> (f: Real_Function;
> a, b, epsabs, epsrel: Real;
> result, abserr: out Real;
> neval: out Natural);
>
> end GSL;
> -----------------------------------------------------------------------------
> with Interfaces.C; use Interfaces;
>
> package body GSL is
>
> type Void_Ptr is access all Parameters;
> pragma Convention (C, Void_Ptr);
>
> type GSL_Inner_Function is
> access function (x: C.double; params: Void_Ptr) return C.double;
> pragma Convention (C, GSL_Inner_Function);
>
> type GSL_Function is record
> func: GSL_Inner_Function;
> params: Void_Ptr;
> end record;
>
> real_func: Real_Function;
>
> ---------------------------------------------------------------------
> -- Auxiliary Subprograms
> ---------------------------------------------------------------------
>
> function func (x: C.double; params: Void_Ptr) return C.double;
> pragma Convention (C, func);
>
> function func (x: C.double; params: Void_Ptr) return C.double is
> begin return C.double (real_func (Real(x)));
> end func;
>
>
> function gsl_integration_qng
> (f: in out GSL_Function;
> a, b, epsabs, epsrel: C.double;
> result, abserr: out C.double;
> neval: out C.size_t)
> return C.int;
> pragma Import (C, gsl_integration_qng, "gsl_integration_qng");
>
>
> ---------------------------------------------------------------------
> -- Exported Subprograms
> ---------------------------------------------------------------------
>
> procedure Integration_QNG
> (f: Real_Function;
> a, b, epsabs, epsrel: Real;
> result, abserr: out Real;
> neval: out Natural)
> is
> use type C.int;
> gslf: GSL_Function;
> status: C.int;
> res, ae: C.double;
> ne: C.size_t;
> begin
> real_func:= f;
> gslf.func:= func'Access;
> gslf.params:= null;
> status:= gsl_integration_qng -- <-- STORAGE_ERROR occurs here
> (gslf,
> C.double(a), C.double(b), C.double(epsabs), C.double(epsrel),
> res, ae, ne);
> if status /= 0 then
> error_code:= Integer (status);
> raise gsl_Ex with
> "gsl_integration_qng() returns error code " &
> C.int'Image(status);
> end if;
> result:= Real(res);
> abserr:= Real(ae);
> neval:= Natural(ne);
> end Integration_QNG;
>
> end GSL;
> ------------------------------------------------------------------------------
> with Ada.Text_IO; use Ada.Text_IO;
> with GSL;
> with Integ_Aux;
>
> procedure Test_Integration
> is
> package GSL_Test is new GSL (Integ_Aux.Real, Integer);
> use type Integ_Aux.Real;
> a, abserr: Integ_Aux.Real;
> neval: Natural;
> begin
> GSL_Test.Integration_QNG
> (Integ_Aux.Circle'Access, 0.0, 1.0, 0.001, 0.001, a, abserr, neval);
> Put_Line("4*int_0^1 sqrt(1-x^2) dx = " & Integ_Aux.Real'Image(4.0*a));
> Put_Line(Natural'Image(neval) & " function evaluations, " &
> Integ_Aux.Real'Image(abserr) & " abs. error");
> end Test_Integration;
> ------------------------------------------------------------------------------
> with Interfaces;
>
> package Integ_Aux is
>
> type Real is new Interfaces.IEEE_Float_32;
> function Circle (x: Real) return Real;
>
> end Integ_Aux;
> ------------------------------------------------------------------------------
> with Ada.Numerics.Generic_Elementary_Functions;
>
> package body Integ_Aux is
>
> package Functions is new
> Ada.Numerics.Generic_Elementary_Functions (Real);
>
> function Circle (x: Real) return Real is
> begin return Functions.Sqrt(abs(1.0-x*x));
> end Circle;
>
> end Integ_Aux;
> -------------------------------------------------------------------------------
> --
> Frank Hrebabetzky +49 / 6355 / 989 5070
>
^ permalink raw reply [relevance 3%]
* Re: Interfaces.C + generics: stack overflow
2017-03-23 20:03 3% ` Randy Brukardt
@ 2017-03-24 12:42 6% ` hreba
2017-03-24 20:13 3% ` Randy Brukardt
2017-03-24 22:03 2% ` Dmitry A. Kazakov
0 siblings, 2 replies; 200+ results
From: hreba @ 2017-03-24 12:42 UTC (permalink / raw)
On 03/23/2017 09:03 PM, Randy Brukardt wrote:
> I agree with Jeff, there's not enough detail here to even see if there is a
> bug or your mistake. We need to know how/where the generic is instantiated,
> where/how the access-to-function value is created, and probably more.
>
The complete code follows below. The suggestion from Jeffrey is already
realized. The packages are:
- GSL wrapper for the C library
- Test_Integration main program, instantiates GSL
- Integ_Aux defines the function to be handed over
> But let me say that the rules for access-to-subprogram types are different
> inside of generics than they are in normal packages, in order to allow for
> the possibility of generic sharing. That ought to manifest as compile-time
> errors and/or the raising of Program_Error, so it seems that there might be
> a compiler bug in your code. But to find that, one needs to see the whole
> thing, not just a little corner.
>
> If you really want to write portable interfacing code, you would not use any
> generics in the raw interface. (Have the generics call non-generic interface
> code with appropriate type conversions.) Janus/Ada doesn't allow any
> convention C stuff in generic units, because it is incompatible with the
> extra dope needed to implemented universal generic sharing. I'd expect
> something similar to happen for any implementation that supports almost any
> form of generic sharing. (If you only care about GNAT, do what ever you
> want.)
>
I am not writing this program only for its result, but also as an
exercise in Ada programming. So I want to do it the right way. So far I
know basically the book from John Barnes, where this topic is not
treated, so thanks for your comments, I will modify my program accordingly.
---------------------------------------------------------------------------
generic
type Real is digits <>;
type Parameters is private; -- for future use
package GSL is
gsl_Ex: Exception;
error_code: Integer; -- of the last operation
type Real_Function is access function (x: Real) return Real;
procedure Integration_QNG
(f: Real_Function;
a, b, epsabs, epsrel: Real;
result, abserr: out Real;
neval: out Natural);
end GSL;
-----------------------------------------------------------------------------
with Interfaces.C; use Interfaces;
package body GSL is
type Void_Ptr is access all Parameters;
pragma Convention (C, Void_Ptr);
type GSL_Inner_Function is
access function (x: C.double; params: Void_Ptr) return C.double;
pragma Convention (C, GSL_Inner_Function);
type GSL_Function is record
func: GSL_Inner_Function;
params: Void_Ptr;
end record;
real_func: Real_Function;
---------------------------------------------------------------------
-- Auxiliary Subprograms
---------------------------------------------------------------------
function func (x: C.double; params: Void_Ptr) return C.double;
pragma Convention (C, func);
function func (x: C.double; params: Void_Ptr) return C.double is
begin return C.double (real_func (Real(x)));
end func;
function gsl_integration_qng
(f: in out GSL_Function;
a, b, epsabs, epsrel: C.double;
result, abserr: out C.double;
neval: out C.size_t)
return C.int;
pragma Import (C, gsl_integration_qng, "gsl_integration_qng");
---------------------------------------------------------------------
-- Exported Subprograms
---------------------------------------------------------------------
procedure Integration_QNG
(f: Real_Function;
a, b, epsabs, epsrel: Real;
result, abserr: out Real;
neval: out Natural)
is
use type C.int;
gslf: GSL_Function;
status: C.int;
res, ae: C.double;
ne: C.size_t;
begin
real_func:= f;
gslf.func:= func'Access;
gslf.params:= null;
status:= gsl_integration_qng -- <-- STORAGE_ERROR occurs here
(gslf,
C.double(a), C.double(b), C.double(epsabs), C.double(epsrel),
res, ae, ne);
if status /= 0 then
error_code:= Integer (status);
raise gsl_Ex with
"gsl_integration_qng() returns error code " &
C.int'Image(status);
end if;
result:= Real(res);
abserr:= Real(ae);
neval:= Natural(ne);
end Integration_QNG;
end GSL;
------------------------------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with GSL;
with Integ_Aux;
procedure Test_Integration
is
package GSL_Test is new GSL (Integ_Aux.Real, Integer);
use type Integ_Aux.Real;
a, abserr: Integ_Aux.Real;
neval: Natural;
begin
GSL_Test.Integration_QNG
(Integ_Aux.Circle'Access, 0.0, 1.0, 0.001, 0.001, a, abserr, neval);
Put_Line("4*int_0^1 sqrt(1-x^2) dx = " & Integ_Aux.Real'Image(4.0*a));
Put_Line(Natural'Image(neval) & " function evaluations, " &
Integ_Aux.Real'Image(abserr) & " abs. error");
end Test_Integration;
------------------------------------------------------------------------------
with Interfaces;
package Integ_Aux is
type Real is new Interfaces.IEEE_Float_32;
function Circle (x: Real) return Real;
end Integ_Aux;
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Elementary_Functions;
package body Integ_Aux is
package Functions is new
Ada.Numerics.Generic_Elementary_Functions (Real);
function Circle (x: Real) return Real is
begin return Functions.Sqrt(abs(1.0-x*x));
end Circle;
end Integ_Aux;
-------------------------------------------------------------------------------
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 6%]
* Re: Interfaces.C + generics: stack overflow
2017-03-23 17:45 4% ` Jeffrey R. Carter
@ 2017-03-24 12:20 4% ` hreba
0 siblings, 0 replies; 200+ results
From: hreba @ 2017-03-24 12:20 UTC (permalink / raw)
On 03/23/2017 06:45 PM, Jeffrey R. Carter wrote:
> On 03/23/2017 08:43 AM, hreba wrote:
>>
>> Now when pass the type real as a generic parameter:
>>
>> ---------------------------------------------------------------------
>> generic
>> type Real is digits <>;
>> package GSL is
>> ...
>> ---------------------------------------------------------------------
>>
>> and instanciate GSL with exactly the same type as above, I get a
>> STORAGE_ERROR : stack overflow or erroneous memory access.
>
> Where do you instantiate the package? Where do you declare the function
> you pass to Integration_QNG?
>
>> function gsl_integration_qng
>> (f: access GSL_Function;
>
> This should not need to be an access parameter. It should be passed by
> reference as an "in" parameter. You can make it "in out" if you want.
>
Did as you suggested. Clearly better. Unfortunately the stack overflow
persists. For the complete code please see my answer to Randy.
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C + generics: stack overflow
2017-03-23 7:43 6% Interfaces.C + generics: stack overflow hreba
2017-03-23 7:46 4% ` hreba
2017-03-23 17:45 4% ` Jeffrey R. Carter
@ 2017-03-23 20:03 3% ` Randy Brukardt
2017-03-24 12:42 6% ` hreba
2 siblings, 1 reply; 200+ results
From: Randy Brukardt @ 2017-03-23 20:03 UTC (permalink / raw)
"hreba" <f_hreba@yahoo.com.br> wrote in message
news:ejhckeF1tg7U1@mid.individual.net...
> My last posting was buried deep inside the thread and somewhat lengthy, so
> here in a compact form. What works is (everything compiles and test
> application executes):
I agree with Jeff, there's not enough detail here to even see if there is a
bug or your mistake. We need to know how/where the generic is instantiated,
where/how the access-to-function value is created, and probably more.
But let me say that the rules for access-to-subprogram types are different
inside of generics than they are in normal packages, in order to allow for
the possibility of generic sharing. That ought to manifest as compile-time
errors and/or the raising of Program_Error, so it seems that there might be
a compiler bug in your code. But to find that, one needs to see the whole
thing, not just a little corner.
If you really want to write portable interfacing code, you would not use any
generics in the raw interface. (Have the generics call non-generic interface
code with appropriate type conversions.) Janus/Ada doesn't allow any
convention C stuff in generic units, because it is incompatible with the
extra dope needed to implemented universal generic sharing. I'd expect
something similar to happen for any implementation that supports almost any
form of generic sharing. (If you only care about GNAT, do what ever you
want.)
Randy.
^ permalink raw reply [relevance 3%]
* Re: Interfaces.C + generics: stack overflow
2017-03-23 7:43 6% Interfaces.C + generics: stack overflow hreba
2017-03-23 7:46 4% ` hreba
@ 2017-03-23 17:45 4% ` Jeffrey R. Carter
2017-03-24 12:20 4% ` hreba
2017-03-23 20:03 3% ` Randy Brukardt
2 siblings, 1 reply; 200+ results
From: Jeffrey R. Carter @ 2017-03-23 17:45 UTC (permalink / raw)
On 03/23/2017 08:43 AM, hreba wrote:
>
> Now when pass the type real as a generic parameter:
>
> ---------------------------------------------------------------------
> generic
> type Real is digits <>;
> package GSL is
> ...
> ---------------------------------------------------------------------
>
> and instanciate GSL with exactly the same type as above, I get a
> STORAGE_ERROR : stack overflow or erroneous memory access.
Where do you instantiate the package? Where do you declare the function you pass
to Integration_QNG?
> function gsl_integration_qng
> (f: access GSL_Function;
This should not need to be an access parameter. It should be passed by reference
as an "in" parameter. You can make it "in out" if you want.
--
Jeff Carter
"My little plum, I am like Robin Hood. I take from
the rich, and I give to the poor. ... Us poor."
Poppy
96
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C + generics: stack overflow
2017-03-23 7:43 6% Interfaces.C + generics: stack overflow hreba
@ 2017-03-23 7:46 4% ` hreba
2017-03-23 17:45 4% ` Jeffrey R. Carter
2017-03-23 20:03 3% ` Randy Brukardt
2 siblings, 0 replies; 200+ results
From: hreba @ 2017-03-23 7:46 UTC (permalink / raw)
On 03/23/2017 08:43 AM, hreba wrote:
> when not used.
Please disconsider this line.
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 4%]
* Interfaces.C + generics: stack overflow
@ 2017-03-23 7:43 6% hreba
2017-03-23 7:46 4% ` hreba
` (2 more replies)
0 siblings, 3 replies; 200+ results
From: hreba @ 2017-03-23 7:43 UTC (permalink / raw)
My last posting was buried deep inside the thread and somewhat lengthy,
so here in a compact form. What works is (everything compiles and test
application executes):
--------------------------------------------------------------------
with Interfaces;
package GSL is
subtype Real is Interfaces.IEEE_Float_32;
gsl_Ex: Exception;
error_code: Integer; -- of the last operation
type Real_Function is access function (x: Real) return Real;
procedure Integration_QNG
(f: Real_Function;
a, b, epsabs, epsrel: Real;
result, abserr: out Real;
neval: out Natural);
end GSL;
---------------------------------------------------------------------
Now when pass the type real as a generic parameter:
---------------------------------------------------------------------
generic
type Real is digits <>;
when not used.
package GSL is
...
---------------------------------------------------------------------
and instanciate GSL with exactly the same type as above, I get a
STORAGE_ERROR : stack overflow or erroneous memory access.
I wrote a simpler example too, where just a function (gsl_bessl_j0) is
called from the C library, and no function reference is passed as a
parameter. This worked in the non-generic as well in the generic version.
For completeness, here follows the body of GSL
----------------------------------------------------------------------
with Interfaces.C; use Interfaces;
package body GSL is
type Void_Ptr is access all Integer;
pragma Convention (C, Void_Ptr);
type GSL_Inner_Function is
access function (x: C.double; params: Void_Ptr) return C.double;
pragma Convention (C, GSL_Inner_Function);
type GSL_Function is record
func: GSL_Inner_Function;
params: Void_Ptr;
end record;
real_func: Real_Function;
---------------------------------------------------------------------
-- Auxiliary Subprograms
---------------------------------------------------------------------
function func (x: C.double; params: Void_Ptr) return C.double;
pragma Convention (C, func);
function func (x: C.double; params: Void_Ptr) return C.double is
begin return C.double (real_func (Real(x)));
end func;
function gsl_integration_qng
(f: access GSL_Function;
a, b, epsabs, epsrel: C.double;
result, abserr: out C.double;
neval: out C.size_t)
return C.int;
pragma Import (C, gsl_integration_qng, "gsl_integration_qng");
---------------------------------------------------------------------
-- Exported Subprograms
---------------------------------------------------------------------
procedure Integration_QNG
(f: Real_Function;
a, b, epsabs, epsrel: Real;
result, abserr: out Real;
neval: out Natural)
is
use type C.int;
gslf: aliased GSL_Function;
status: C.int;
res, ae: C.double;
ne: C.size_t;
begin
real_func:= f;
gslf.func:= func'Access;
gslf.params:= null;
status:= gsl_integration_qng
(gslf'Access,
C.double(a), C.double(b), C.double(epsabs), C.double(epsrel),
res, ae, ne);
if status /= 0 then
error_code:= Integer (status);
raise gsl_Ex with
"gsl_integration_qng() returns error code " & C.int'Image(status);
end if;
result:= Real(res);
abserr:= Real(ae);
neval:= Natural(ne);
end Integration_QNG;
----------------------------------------------------------------------
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 6%]
* Re: Interfaces.C questions
2017-03-21 21:31 4% ` Simon Wright
@ 2017-03-22 20:35 4% ` Randy Brukardt
0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2017-03-22 20:35 UTC (permalink / raw)
"Simon Wright" <simon@pushface.org> wrote in message
news:lyvar2co6i.fsf@pushface.org...
> "Michael B." <michaelb@example.com> writes:
>
>> On 17.03.2017 23:24, Dmitry A. Kazakov wrote:
>>> P.S. For convention C assume this:
>>>
>>> 1. out T, in out T, access T are equivalent
>>>
>>> 2. in T and access T are equivalent when T is non-scalar (you can pass
>>> int, array, or record, the compiler will sort that out)
>>>
>>
>> Is this GNAT specific or true for all Ada compilers?
>
> See ARM B.3(63)[1]ff for the ARM on this subject.
>
> [1] http://www.ada-auth.org/standards/rm12_w_tc1/html/RM-B-3.html#p63
Keep in mind that this is Implementation Advice, not a requirement.
Implementations are supposed to document variations from IA, but how that's
done (and how useful it is) varies wildly. Our experience with Claw says
that implementors try to follow it pretty closely. The only deviations that
wehad in Janus/Ada was in cases where the advice made no sense (and those
have been cleaned up in the years since).
Randy.
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C questions
2017-03-20 14:04 6% ` hreba
@ 2017-03-22 11:21 4% ` hreba
0 siblings, 0 replies; 200+ results
From: hreba @ 2017-03-22 11:21 UTC (permalink / raw)
On 03/20/2017 03:04 PM, hreba wrote:
> My posting earlier was too fast: the program compiles, but terminates
> with a
> STORAGE_ERROR : stack overflow or erroneous memory access.
> This happens right at the call of gsl_integration_qng(), the function
> exported from the C library.
>
> If somebody has an idea what could be wrong ...
>
> My wrapper is package GSL:
>
> ----------------------------------------------------------------------
> generic
> type Real is digits <>;
> type Parameters is private;
> package GSL is
>
> gsl_Ex: Exception;
> error_code: Integer; -- of the last operation
>
> type Real_Function is access function (x: Real) return Real;
>
> procedure Integration_QNG
> (f: Real_Function;
> a, b, epsabs, epsrel: Real;
> result, abserr: out Real;
> neval: out Natural);
>
> end GSL;
> -----------------------------------------------------------------------
> -----------------------------------------------------------------------
> with Interfaces.C; use Interfaces;
>
> package body GSL is
>
> type Void_Ptr is access all Parameters;
> pragma Convention (C, Void_Ptr);
>
> type GSL_Inner_Function is
> access function (x: C.double; params: Void_Ptr) return C.double;
> pragma Convention (C, GSL_Inner_Function);
>
> type GSL_Function is record
> func: GSL_Inner_Function;
> params: Void_Ptr;
> end record;
>
> real_func: Real_Function;
>
> ---------------------------------------------------------------------
> -- Auxiliary Subprograms
> ---------------------------------------------------------------------
>
> function func (x: C.double; params: Void_Ptr) return C.double;
> pragma Convention (C, func);
>
> function func (x: C.double; params: Void_Ptr) return C.double is
> begin return C.double (real_func (Real(x)));
> end func;
>
>
> function gsl_integration_qng
> (f: access GSL_Function;
> a, b, epsabs, epsrel: C.double;
> result, abserr: out C.double;
> neval: out C.size_t)
> return C.int;
> pragma Import (C, gsl_integration_qng, "gsl_integration_qng");
>
>
> ---------------------------------------------------------------------
> -- Exported Subprograms
> ---------------------------------------------------------------------
>
> procedure Integration_QNG
> (f: Real_Function;
> a, b, epsabs, epsrel: Real;
> result, abserr: out Real;
> neval: out Natural)
> is
> use type C.int;
> gslf: aliased GSL_Function;
> status: C.int;
> res, ae: C.double;
> ne: C.size_t;
> begin
> real_func:= f;
> gslf.func:= func'Access;
> gslf.params:= null;
> status:= gsl_integration_qng -- <-- STORAGE_ERROR occurs here
> (gslf'Access,
> C.double(a), C.double(b), C.double(epsabs), C.double(epsrel),
> res, ae, ne);
> if status /= 0 then
> error_code:= Integer (status);
> raise gsl_Ex with
> "gsl_integration_qng() returns error code " & C.int'Image(status);
> end if;
> result:= Real(res);
> abserr:= Real(ae);
> neval:= Natural(ne);
> end Integration_QNG;
>
> end GSL;
> -------------------------------------------------------------------------
>
> The test application is
>
> -------------------------------------------------------------------------
> with Ada.Text_IO; use Ada.Text_IO;
> with GSL;
> with Integ_Aux;
>
> procedure Test_Integration
> is
> package GSL_Test is new GSL (Integ_Aux.Real, Integer);
> use type Integ_Aux.Real;
> a, abserr: Integ_Aux.Real;
> neval: Natural;
> begin
> GSL_Test.Integration_QNG
> (Integ_Aux.Circle'Access, 0.0, 1.0, 0.001, 0.001, a, abserr, neval);
> Put_Line("4*int_0^1 sqrt(1-x^2) dx = " & Integ_Aux.Real'Image(4.0*a));
> Put_Line(Natural'Image(neval) & " function evaluations, " &
> Integ_Aux.Real'Image(abserr) & " abs. error");
> end Test_Integration;
> ---------------------------------------------------------------------------
>
> which imports also
>
> ---------------------------------------------------------------------------
> with Interfaces;
>
> package Integ_Aux is
>
> type Real is new Interfaces.IEEE_Float_32;
> function Circle (x: Real) return Real;
>
> end Integ_Aux;
> ---------------------------------------------------------------------------
> ---------------------------------------------------------------------------
> with Ada.Numerics.Generic_Elementary_Functions;
>
> package body Integ_Aux is
>
> package Functions is new
> Ada.Numerics.Generic_Elementary_Functions (Real);
>
> function Circle (x: Real) return Real is
> begin return Functions.Sqrt(abs(1.0-x*x));
> end Circle;
>
> end Integ_Aux;
> ------------------------------------------------------------------------------
>
>
I experimented a little. When I delete the formal type parameter "Real"
from the "generic" specification of package GSL, and declare a subtype
"Real" inside it, then it works as expected.
I wrote a simpler example too, where just a function (gsl_bessl_j0) is
called from the C library, and no function reference is passed as a
parameter. This worked in the non-generic as well in the generic version.
If somebody could have a look ...
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C questions
2017-03-21 21:08 4% ` Michael B.
2017-03-21 21:28 4% ` Dmitry A. Kazakov
@ 2017-03-21 21:31 4% ` Simon Wright
2017-03-22 20:35 4% ` Randy Brukardt
1 sibling, 1 reply; 200+ results
From: Simon Wright @ 2017-03-21 21:31 UTC (permalink / raw)
"Michael B." <michaelb@example.com> writes:
> On 17.03.2017 23:24, Dmitry A. Kazakov wrote:
>> P.S. For convention C assume this:
>>
>> 1. out T, in out T, access T are equivalent
>>
>> 2. in T and access T are equivalent when T is non-scalar (you can pass
>> int, array, or record, the compiler will sort that out)
>>
>
> Is this GNAT specific or true for all Ada compilers?
See ARM B.3(63)[1]ff for the ARM on this subject.
[1] http://www.ada-auth.org/standards/rm12_w_tc1/html/RM-B-3.html#p63
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C questions
2017-03-21 21:08 4% ` Michael B.
@ 2017-03-21 21:28 4% ` Dmitry A. Kazakov
2017-03-21 21:31 4% ` Simon Wright
1 sibling, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2017-03-21 21:28 UTC (permalink / raw)
On 2017-03-21 22:08, Michael B. wrote:
> On 17.03.2017 23:24, Dmitry A. Kazakov wrote:
>> P.S. For convention C assume this:
>>
>> 1. out T, in out T, access T are equivalent
>>
>> 2. in T and access T are equivalent when T is non-scalar (you can pass
>> int, array, or record, the compiler will sort that out)
>>
>
> Is this GNAT specific or true for all Ada compilers?
AFAIK it is not GNAT specific.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C questions
2017-03-17 22:24 8% ` Dmitry A. Kazakov
@ 2017-03-21 21:08 4% ` Michael B.
2017-03-21 21:28 4% ` Dmitry A. Kazakov
2017-03-21 21:31 4% ` Simon Wright
0 siblings, 2 replies; 200+ results
From: Michael B. @ 2017-03-21 21:08 UTC (permalink / raw)
On 17.03.2017 23:24, Dmitry A. Kazakov wrote:
> P.S. For convention C assume this:
>
> 1. out T, in out T, access T are equivalent
>
> 2. in T and access T are equivalent when T is non-scalar (you can pass
> int, array, or record, the compiler will sort that out)
>
Is this GNAT specific or true for all Ada compilers?
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C questions
2017-03-19 23:53 7% ` Simon Wright
2017-03-20 11:12 4% ` hreba
@ 2017-03-20 14:04 6% ` hreba
2017-03-22 11:21 4% ` hreba
1 sibling, 1 reply; 200+ results
From: hreba @ 2017-03-20 14:04 UTC (permalink / raw)
My posting earlier was too fast: the program compiles, but terminates with a
STORAGE_ERROR : stack overflow or erroneous memory access.
This happens right at the call of gsl_integration_qng(), the function
exported from the C library.
If somebody has an idea what could be wrong ...
My wrapper is package GSL:
----------------------------------------------------------------------
generic
type Real is digits <>;
type Parameters is private;
package GSL is
gsl_Ex: Exception;
error_code: Integer; -- of the last operation
type Real_Function is access function (x: Real) return Real;
procedure Integration_QNG
(f: Real_Function;
a, b, epsabs, epsrel: Real;
result, abserr: out Real;
neval: out Natural);
end GSL;
-----------------------------------------------------------------------
-----------------------------------------------------------------------
with Interfaces.C; use Interfaces;
package body GSL is
type Void_Ptr is access all Parameters;
pragma Convention (C, Void_Ptr);
type GSL_Inner_Function is
access function (x: C.double; params: Void_Ptr) return C.double;
pragma Convention (C, GSL_Inner_Function);
type GSL_Function is record
func: GSL_Inner_Function;
params: Void_Ptr;
end record;
real_func: Real_Function;
---------------------------------------------------------------------
-- Auxiliary Subprograms
---------------------------------------------------------------------
function func (x: C.double; params: Void_Ptr) return C.double;
pragma Convention (C, func);
function func (x: C.double; params: Void_Ptr) return C.double is
begin return C.double (real_func (Real(x)));
end func;
function gsl_integration_qng
(f: access GSL_Function;
a, b, epsabs, epsrel: C.double;
result, abserr: out C.double;
neval: out C.size_t)
return C.int;
pragma Import (C, gsl_integration_qng, "gsl_integration_qng");
---------------------------------------------------------------------
-- Exported Subprograms
---------------------------------------------------------------------
procedure Integration_QNG
(f: Real_Function;
a, b, epsabs, epsrel: Real;
result, abserr: out Real;
neval: out Natural)
is
use type C.int;
gslf: aliased GSL_Function;
status: C.int;
res, ae: C.double;
ne: C.size_t;
begin
real_func:= f;
gslf.func:= func'Access;
gslf.params:= null;
status:= gsl_integration_qng -- <-- STORAGE_ERROR occurs here
(gslf'Access,
C.double(a), C.double(b), C.double(epsabs), C.double(epsrel),
res, ae, ne);
if status /= 0 then
error_code:= Integer (status);
raise gsl_Ex with
"gsl_integration_qng() returns error code " & C.int'Image(status);
end if;
result:= Real(res);
abserr:= Real(ae);
neval:= Natural(ne);
end Integration_QNG;
end GSL;
-------------------------------------------------------------------------
The test application is
-------------------------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with GSL;
with Integ_Aux;
procedure Test_Integration
is
package GSL_Test is new GSL (Integ_Aux.Real, Integer);
use type Integ_Aux.Real;
a, abserr: Integ_Aux.Real;
neval: Natural;
begin
GSL_Test.Integration_QNG
(Integ_Aux.Circle'Access, 0.0, 1.0, 0.001, 0.001, a, abserr, neval);
Put_Line("4*int_0^1 sqrt(1-x^2) dx = " & Integ_Aux.Real'Image(4.0*a));
Put_Line(Natural'Image(neval) & " function evaluations, " &
Integ_Aux.Real'Image(abserr) & " abs. error");
end Test_Integration;
---------------------------------------------------------------------------
which imports also
---------------------------------------------------------------------------
with Interfaces;
package Integ_Aux is
type Real is new Interfaces.IEEE_Float_32;
function Circle (x: Real) return Real;
end Integ_Aux;
---------------------------------------------------------------------------
---------------------------------------------------------------------------
with Ada.Numerics.Generic_Elementary_Functions;
package body Integ_Aux is
package Functions is new
Ada.Numerics.Generic_Elementary_Functions (Real);
function Circle (x: Real) return Real is
begin return Functions.Sqrt(abs(1.0-x*x));
end Circle;
end Integ_Aux;
------------------------------------------------------------------------------
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 6%]
* Re: Interfaces.C questions
2017-03-19 23:53 7% ` Simon Wright
@ 2017-03-20 11:12 4% ` hreba
2017-03-20 14:04 6% ` hreba
1 sibling, 0 replies; 200+ results
From: hreba @ 2017-03-20 11:12 UTC (permalink / raw)
On 03/20/2017 12:53 AM, Simon Wright wrote:
>
> function func (x: C.double; params: Void_Ptr) return C.Double;
> pragma Convention (C, func);
>
> function func (x: C.double; params: Void_Ptr) return C.double is
> begin
> return C.double (real_func (Real(x)));
> end func;
>
That's it. Apparently the correct sequence is declare - pragma - define.
I didn't declare. Thanks for the hint, it works now.
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C questions
2017-03-19 12:17 5% ` hreba
@ 2017-03-20 9:44 4% ` Leo Brewin
0 siblings, 0 replies; 200+ results
From: Leo Brewin @ 2017-03-20 9:44 UTC (permalink / raw)
Hi Frank,
Many thanks for sharing that code. I've wanted to play with GSL for a while but couldn't make sense of the C parameters and how to connect them back to Ada. Thanks again.
Cheers,
Leo
On Sunday, March 19, 2017 at 11:17:37 PM UTC+11, hreba wrote:
> On 03/19/2017 12:24 AM, Leo Brewin wrote:
> > Hi Frank,
> >
> > I'd be really interested to see a minimal working example once you've got it running.
> > I'd like to be able to use GSL in my own codes.
> >
> > Cheers,
> > Leo
> >
>
> Ok, below follows my first working example, numerical quadrature. Any
> critics is welcome. Some remarks:
>
> 'void * params' in C can be a pointer to just anything, a number, an
> array, a record. The best solution probably would be a generic package
> where the actual type is passed as parameter (see type Element in
> Interfaces.C.Pointers). The quadrature algorithm I chose makes no use of
> these parameters, so in my example I translate the type to 'access all
> Integer' and pass null as value.
>
> As I am beginning to build a numerics library, I will now
>
> - make the package generic, with 2 type parameters, one for the reals
> (digits <>) and one for the parameters (private),
> - write wrappers so that the client needs no Interfaces.C, and that he
> can pass a function of
> 'type Real_Function is access function (x: Real) return Real;'
> to the quadrature procedure instead of a record.
>
> So here comes my example. The interface package is (no body):
>
> -----------------------------------------------------------------------
> with Interfaces.C;
>
> package GSL is
>
> package C renames Interfaces.C;
>
> type Void_Ptr is access all Integer;
> type GSL_Function_Ptr is access
> function (x: C.double; params: Void_Ptr) return C.double;
> type GSL_Function is record
> func: GSL_Function_Ptr;
> params: Void_Ptr;
> end record;
>
>
> function Integration_QNG
> (f: access GSL_Function;
> a, b, epsabs, epsrel: C.double;
> result, abserr: out C.double;
> neval: out C.size_t)
> return C.int;
>
> private
>
> pragma Import (C, Integration_QNG, "gsl_integration_qng");
> pragma Convention (C, Void_Ptr);
> pragma Convention (C, GSL_Function_Ptr);
> pragma Convention (C, GSL_Function);
>
> end GSL;
> -----------------------------------------------------------------------------
>
> The main subprogram (client) is
>
> -----------------------------------------------------------------------------
> with Ada.Text_IO; use Ada.Text_IO;
> with GSL;
> with Integ_Aux;
>
> procedure Test_Integration
> is
> use type GSL.C.double;
> a: GSL.C.double;
> abserr: GSL.C.double;
> neval: GSL.C.size_t;
> res: GSL.C.int;
> gslf: aliased GSL.GSL_Function;
>
> begin
> gslf.func:= Integ_Aux.Circle'Access;
> gslf.params:= null;
> res:= GSL.Integration_QNG
> (gslf'Access, 0.0, 1.0, 0.001, 0.001, a, abserr, neval);
> Put_Line("4*int_0^1 sqrt(1-x^2) dx = " & GSL.C.double'Image(4.0*a));
> Put_Line(GSL.C.size_t'Image(neval) & " function evaluations, " &
> GSL.C.double'Image(abserr) & " abs. error");
> end Test_Integration;
> ------------------------------------------------------------------------------
> Because an access is passed to the function to be integrated it has to
> be in a separated package:
> ------------------------------------------------------------------------------
> with GSL;
>
> package Integ_Aux is
> function Circle (x: GSL.C.double; pars: GSL.Void_Ptr) return
> GSL.C.double;
>
> private
> pragma Convention (C, Circle);
> end Integ_Aux;
> -------------------------------------------------------------------------------
> -------------------------------------------------------------------------------
> with Ada.Numerics.Generic_Elementary_Functions;
> with GSL;
>
> package body Integ_Aux is
>
> package Functions is new
> Ada.Numerics.Generic_Elementary_Functions (GSL.C.double);
>
> function Circle (x: GSL.C.double; pars: GSL.Void_Ptr) return
> GSL.C.double is
> use type GSL.C.double;
> begin return Functions.Sqrt(abs(1.0-x*x));
> end Circle;
>
> end Integ_Aux;
> --------------------------------------------------------------------------------
> The project files of the interface package are
> --------------------------------------------------------------------------------
> -- External library "Gnu Scientific Library"
>
> with "gslcblas";
>
> Project GSL is
>
> type OS_Type is ("linux", "linux-gnu", "windows", "unknown");
> act_os: OS_Type:= external ("OSTYPE");
> -- act_os: OS_Type:= external ("OS_TYPE");
>
> For externally_built use "true";
> For library_dir use "/usr/lib";
> case act_os is
> when "linux"|"linux-gnu" => for library_dir use "/usr/lib";
> when "windows" => for library_dir use "/Lib/GSL";
> when "unknown" => for Source_Dirs use ("/"); -- just anything
> end case;
> For library_name use "gsl";
> For source_dirs use (); -- no sources.
> -- For library_kind use "static";
> -- if it is a static lib .a
>
> for library_kind use "dynamic";
> -- if it is an so.
>
> end GSL;
> -------------------------------------------------------------------------
> -------------------------------------------------------------------------
> -- External library "Gnu Scientific Library"
>
>
> Project GSLCBLAS is
>
> type OS_Type is ("linux", "linux-gnu", "windows", "unknown");
> act_os: OS_Type:= external ("OSTYPE");
> -- act_os: OS_Type:= external ("OS_TYPE");
>
> For externally_built use "true";
> case act_os is
> when "linux"|"linux-gnu" => for library_dir use "/usr/lib";
> when "windows" => for library_dir use "/Lib/GSL";
> when "unknown" => for Source_Dirs use ("/"); -- just anything
> end case;
> For library_name use "gslcblas";
> For source_dirs use (); -- no sources.
> -- For library_kind use "static";
> -- if it is a static lib .a
>
> for library_kind use "dynamic";
> -- if it is an so.
>
> end GSLCBLAS;
> -----------------------------------------------------------------------------
> I tried to make these projects platform independent (Linux and Windows
> so far); only tested on Linux so far. The environment variable OSTYPE
> must exist. If you don't want to do this, just type
> for library_dir use "/usr/lib";
> instead of the 'case' construct (on Linux).
> Finally the project file for the main program:
> -----------------------------------------------------------------------------
> with "../../gsl.gpr";
>
> project Test_Integration is
>
> for Source_Dirs use (".", "../../src"); -- test and interface sources
> for Object_Dir use "../obj";
> for Exec_Dir use ".";
> for Main use ("test_integration.adb");
>
> package Compiler is
> for Default_Switches ("ada") use ("-g", "-gnatf", "-gnat2012");
> end Compiler;
>
> package Linker is
> for Default_Switches ("ada") use ("-g");
> end Linker;
>
> package Builder is
> for Default_Switches ("ada") use ("-g");
> end Builder;
>
> end Test_Integration;
> ------------------------------------------------------------------------------
> The result is an approximation of the unit circle area, pi.
>
> --
> Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C questions
2017-03-19 19:49 4% ` hreba
@ 2017-03-19 23:53 7% ` Simon Wright
2017-03-20 11:12 4% ` hreba
2017-03-20 14:04 6% ` hreba
0 siblings, 2 replies; 200+ results
From: Simon Wright @ 2017-03-19 23:53 UTC (permalink / raw)
hreba <f_hreba@yahoo.com.br> writes:
> On 03/19/2017 08:22 PM, Simon Wright wrote:
>> hreba <f_hreba@yahoo.com.br> writes:
>>
>>> function func (x: C.double; params: Void_Ptr) return C.double is
>>> begin
>>> return C.double (real_func (Real(x)));
>>> end func;
>>> pragma Convention (C, func); -- this is line 37
>>
>> Try
>>
>> function func (x: C.double; params: Void_Ptr) return C.double;
>> pragma Convention (C, func);
>> function func (x: C.double; params: Void_Ptr) return C.double is
>> begin
>> return C.double (real_func (Real(x)));
>> end func;
>>
>> You have to have a spec, but there's nothing stopping it being declared
>> right before the body.
>>
>> Of course, in most cases you'd prefer to do that earlier.
>>
>
> Did that. Now I get:
>
> gsl.adb:35:26: pragma "CONVENTION" argument must be in same declarative part
This compiles for me (with a warning, 'variable "real_func" is read but
never assigned'):
generic
type Real is digits <>;
type Parameters is private;
package GSL with Elaborate_Body is
type Real_Function is access function (x: Real) return Real;
end Gsl;
with Interfaces.C;
package body Gsl is
use Interfaces;
type Void_Ptr is access all Integer;
pragma Convention (C, Void_Ptr);
type GSL_Function is record
func: access
function (x: C.double; params: Void_Ptr) return C.double;
params: Void_Ptr;
end record;
pragma Convention (C, GSL_Function);
real_func: Real_Function;
function func (x: C.double; params: Void_Ptr) return C.Double;
pragma Convention (C, func);
function func (x: C.double; params: Void_Ptr) return C.double is
begin
return C.double (real_func (Real(x)));
end func;
procedure P is
gslf: aliased GSL_Function;
begin
gslf.func:= func'Access;
end P;
end Gsl;
^ permalink raw reply [relevance 7%]
* Re: Interfaces.C questions
2017-03-19 19:22 4% ` Simon Wright
@ 2017-03-19 19:49 4% ` hreba
2017-03-19 23:53 7% ` Simon Wright
0 siblings, 1 reply; 200+ results
From: hreba @ 2017-03-19 19:49 UTC (permalink / raw)
On 03/19/2017 08:22 PM, Simon Wright wrote:
> hreba <f_hreba@yahoo.com.br> writes:
>
>> function func (x: C.double; params: Void_Ptr) return C.double is
>> begin
>> return C.double (real_func (Real(x)));
>> end func;
>> pragma Convention (C, func); -- this is line 37
>
> Try
>
> function func (x: C.double; params: Void_Ptr) return C.double;
> pragma Convention (C, func);
> function func (x: C.double; params: Void_Ptr) return C.double is
> begin
> return C.double (real_func (Real(x)));
> end func;
>
> You have to have a spec, but there's nothing stopping it being declared
> right before the body.
>
> Of course, in most cases you'd prefer to do that earlier.
>
Did that. Now I get:
gsl.adb:35:26: pragma "CONVENTION" argument must be in same declarative part
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C questions
2017-03-19 18:39 3% ` hreba
@ 2017-03-19 19:22 4% ` Simon Wright
2017-03-19 19:49 4% ` hreba
0 siblings, 1 reply; 200+ results
From: Simon Wright @ 2017-03-19 19:22 UTC (permalink / raw)
hreba <f_hreba@yahoo.com.br> writes:
> function func (x: C.double; params: Void_Ptr) return C.double is
> begin
> return C.double (real_func (Real(x)));
> end func;
> pragma Convention (C, func); -- this is line 37
Try
function func (x: C.double; params: Void_Ptr) return C.double;
pragma Convention (C, func);
function func (x: C.double; params: Void_Ptr) return C.double is
begin
return C.double (real_func (Real(x)));
end func;
You have to have a spec, but there's nothing stopping it being declared
right before the body.
Of course, in most cases you'd prefer to do that earlier.
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C questions
2017-03-17 21:12 7% Interfaces.C questions hreba
` (6 preceding siblings ...)
2017-03-19 12:05 4% ` Per Sandberg
@ 2017-03-19 18:39 3% ` hreba
2017-03-19 19:22 4% ` Simon Wright
7 siblings, 1 reply; 200+ results
From: hreba @ 2017-03-19 18:39 UTC (permalink / raw)
A crude, pure interface version for a GSL quadrature function works. Now
I have unexpected difficulties with a wrapper, which is a generic package:
generic
type Real is digits <>;
type Parameters is private;
package GSL is
type Real_Function is access function (x: Real) return Real;
...
The package body contains the following lines, everything on library level:
type GSL_Function is record
func: access -- this is line 21
function (x: C.double; params: Void_Ptr) return C.double;
params: Void_Ptr;
end record;
pragma Convention (C, GSL_Function);
real_func: Real_Function;
----%<----------------------------------------------------------
function func (x: C.double; params: Void_Ptr) return C.double is
begin
return C.double (real_func (Real(x)));
end func;
pragma Convention (C, func); -- this is line 37
Later, within a procedure body:
gslf: aliased GSL_Function;
begin
gslf.func:= func'Access; -- this is line 66
...
I get the following compiler messages and understand nothing:
gsl.adb:37:04: pragma "CONVENTION" requires separate spec and must come
before body
gsl.adb:66:19: subprogram "func" has wrong convention
gsl.adb:66:19: does not match access to subprogram declared at line 21
- Separate spec? How?
Before body? All my other CONVENTION pragmas come after the
subprogram body, without any problem.
- No match? Where is the difference?
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 3%]
* Re: Interfaces.C questions
2017-03-18 23:24 4% ` Leo Brewin
@ 2017-03-19 12:17 5% ` hreba
2017-03-20 9:44 4% ` Leo Brewin
0 siblings, 1 reply; 200+ results
From: hreba @ 2017-03-19 12:17 UTC (permalink / raw)
On 03/19/2017 12:24 AM, Leo Brewin wrote:
> Hi Frank,
>
> I'd be really interested to see a minimal working example once you've got it running.
> I'd like to be able to use GSL in my own codes.
>
> Cheers,
> Leo
>
Ok, below follows my first working example, numerical quadrature. Any
critics is welcome. Some remarks:
'void * params' in C can be a pointer to just anything, a number, an
array, a record. The best solution probably would be a generic package
where the actual type is passed as parameter (see type Element in
Interfaces.C.Pointers). The quadrature algorithm I chose makes no use of
these parameters, so in my example I translate the type to 'access all
Integer' and pass null as value.
As I am beginning to build a numerics library, I will now
- make the package generic, with 2 type parameters, one for the reals
(digits <>) and one for the parameters (private),
- write wrappers so that the client needs no Interfaces.C, and that he
can pass a function of
'type Real_Function is access function (x: Real) return Real;'
to the quadrature procedure instead of a record.
So here comes my example. The interface package is (no body):
-----------------------------------------------------------------------
with Interfaces.C;
package GSL is
package C renames Interfaces.C;
type Void_Ptr is access all Integer;
type GSL_Function_Ptr is access
function (x: C.double; params: Void_Ptr) return C.double;
type GSL_Function is record
func: GSL_Function_Ptr;
params: Void_Ptr;
end record;
function Integration_QNG
(f: access GSL_Function;
a, b, epsabs, epsrel: C.double;
result, abserr: out C.double;
neval: out C.size_t)
return C.int;
private
pragma Import (C, Integration_QNG, "gsl_integration_qng");
pragma Convention (C, Void_Ptr);
pragma Convention (C, GSL_Function_Ptr);
pragma Convention (C, GSL_Function);
end GSL;
-----------------------------------------------------------------------------
The main subprogram (client) is
-----------------------------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with GSL;
with Integ_Aux;
procedure Test_Integration
is
use type GSL.C.double;
a: GSL.C.double;
abserr: GSL.C.double;
neval: GSL.C.size_t;
res: GSL.C.int;
gslf: aliased GSL.GSL_Function;
begin
gslf.func:= Integ_Aux.Circle'Access;
gslf.params:= null;
res:= GSL.Integration_QNG
(gslf'Access, 0.0, 1.0, 0.001, 0.001, a, abserr, neval);
Put_Line("4*int_0^1 sqrt(1-x^2) dx = " & GSL.C.double'Image(4.0*a));
Put_Line(GSL.C.size_t'Image(neval) & " function evaluations, " &
GSL.C.double'Image(abserr) & " abs. error");
end Test_Integration;
------------------------------------------------------------------------------
Because an access is passed to the function to be integrated it has to
be in a separated package:
------------------------------------------------------------------------------
with GSL;
package Integ_Aux is
function Circle (x: GSL.C.double; pars: GSL.Void_Ptr) return
GSL.C.double;
private
pragma Convention (C, Circle);
end Integ_Aux;
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
with Ada.Numerics.Generic_Elementary_Functions;
with GSL;
package body Integ_Aux is
package Functions is new
Ada.Numerics.Generic_Elementary_Functions (GSL.C.double);
function Circle (x: GSL.C.double; pars: GSL.Void_Ptr) return
GSL.C.double is
use type GSL.C.double;
begin return Functions.Sqrt(abs(1.0-x*x));
end Circle;
end Integ_Aux;
--------------------------------------------------------------------------------
The project files of the interface package are
--------------------------------------------------------------------------------
-- External library "Gnu Scientific Library"
with "gslcblas";
Project GSL is
type OS_Type is ("linux", "linux-gnu", "windows", "unknown");
act_os: OS_Type:= external ("OSTYPE");
-- act_os: OS_Type:= external ("OS_TYPE");
For externally_built use "true";
For library_dir use "/usr/lib";
case act_os is
when "linux"|"linux-gnu" => for library_dir use "/usr/lib";
when "windows" => for library_dir use "/Lib/GSL";
when "unknown" => for Source_Dirs use ("/"); -- just anything
end case;
For library_name use "gsl";
For source_dirs use (); -- no sources.
-- For library_kind use "static";
-- if it is a static lib .a
for library_kind use "dynamic";
-- if it is an so.
end GSL;
-------------------------------------------------------------------------
-------------------------------------------------------------------------
-- External library "Gnu Scientific Library"
Project GSLCBLAS is
type OS_Type is ("linux", "linux-gnu", "windows", "unknown");
act_os: OS_Type:= external ("OSTYPE");
-- act_os: OS_Type:= external ("OS_TYPE");
For externally_built use "true";
case act_os is
when "linux"|"linux-gnu" => for library_dir use "/usr/lib";
when "windows" => for library_dir use "/Lib/GSL";
when "unknown" => for Source_Dirs use ("/"); -- just anything
end case;
For library_name use "gslcblas";
For source_dirs use (); -- no sources.
-- For library_kind use "static";
-- if it is a static lib .a
for library_kind use "dynamic";
-- if it is an so.
end GSLCBLAS;
-----------------------------------------------------------------------------
I tried to make these projects platform independent (Linux and Windows
so far); only tested on Linux so far. The environment variable OSTYPE
must exist. If you don't want to do this, just type
for library_dir use "/usr/lib";
instead of the 'case' construct (on Linux).
Finally the project file for the main program:
-----------------------------------------------------------------------------
with "../../gsl.gpr";
project Test_Integration is
for Source_Dirs use (".", "../../src"); -- test and interface sources
for Object_Dir use "../obj";
for Exec_Dir use ".";
for Main use ("test_integration.adb");
package Compiler is
for Default_Switches ("ada") use ("-g", "-gnatf", "-gnat2012");
end Compiler;
package Linker is
for Default_Switches ("ada") use ("-g");
end Linker;
package Builder is
for Default_Switches ("ada") use ("-g");
end Builder;
end Test_Integration;
------------------------------------------------------------------------------
The result is an approximation of the unit circle area, pi.
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 5%]
* Re: Interfaces.C questions
2017-03-17 21:12 7% Interfaces.C questions hreba
` (5 preceding siblings ...)
2017-03-19 7:00 6% ` Keith Thompson
@ 2017-03-19 12:05 4% ` Per Sandberg
2017-03-19 18:39 3% ` hreba
7 siblings, 0 replies; 200+ results
From: Per Sandberg @ 2017-03-19 12:05 UTC (permalink / raw)
Why not use the compiler to generate the low-level bindings ??
gcc -fdump-ada-spec
It works great takes 95% of the c headers, after generation its usually
enough with some simple sed-scripts.
That way the binding generation could be 100% automated.
Have done that for some fairly large libraries 250 header-files that
contains approx 18K ";" and 100K lines including blanks and comments.
/Per
Den 2017-03-17 kl. 22:12, skrev hreba:
> These are my first steps with Interfaces.C:
>
> ----------------------------------------------------------------------
> with Interfaces.C;
>
> package GSL is
>
> package C renames Interfaces.C;
>
> type size_t is new C.int;
> type Real_Function is access function (x: C.double) return C.double;
>
> function Bessel_J0 (x: C.double) return C.double;
>
> function Integration_QNG
> (f: Real_Function;
> a, b, epsabs, epsrel: C.double;
> result, abserr: out C.double;
> neval: out size_t)
> return C.int;
>
> private
>
> pragma Import (C, Bessel_J0, "gsl_sf_bessel_J0");
> pragma Import (C, Integration_QNG, "gsl_integration_qng");
>
> end GSL;
> ------------------------------------------------------------------------
>
> No problem with function Bessel_J0. But Integration_QNG gets me:
>
> gsl.ads:19:07: functions can only have "in" parameters.
>
> The C prototype of this function is:
>
> int gsl_integration_qng (const gsl function * f , double a , double b ,
> double epsabs , double epsrel , double * result , double * abserr , size
> t * neval )
>
> So my questions are:
>
> 1. How do I translate C functions which return non-void and which
> additionally use pointers for out parameters? Do I have to use pointers
> in my Ada program?
>
> 2. On my platform size_t is C.int. How can I define size_t in a
> platform-independent way?
>
> 3. The C function above needs a pointer to a function as parameter. Is
> my translation to Ada correct?
>
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C questions
2017-03-18 15:46 4% ` hreba
2017-03-18 16:26 7% ` Jeffrey R. Carter
2017-03-18 16:27 7% ` Jeffrey R. Carter
@ 2017-03-19 7:03 4% ` Keith Thompson
2 siblings, 0 replies; 200+ results
From: Keith Thompson @ 2017-03-19 7:03 UTC (permalink / raw)
hreba <f_hreba@yahoo.com.br> writes:
[...]
> struct gsl_function_struct
> {
> double (* function) (double x, void * params);
> void * params;
> };
> typedef struct gsl_function_struct gsl_function ;
>
> Can anybody please tell me how to translate this into Ada? I have no
> idea how to handle the void pointers.
Ada's closest equivalent to C's void* is probably either
"System.Address" or "access unsigned_char".
--
Keith Thompson (The_Other_Keith) kst-u@mib.org <http://www.ghoti.net/~kst>
Working, but not speaking, for JetHead Development, Inc.
"We must do something. This is something. Therefore, we must do this."
-- Antony Jay and Jonathan Lynn, "Yes Minister"
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C questions
2017-03-17 21:12 7% Interfaces.C questions hreba
` (4 preceding siblings ...)
2017-03-18 23:24 4% ` Leo Brewin
@ 2017-03-19 7:00 6% ` Keith Thompson
2017-03-19 12:05 4% ` Per Sandberg
2017-03-19 18:39 3% ` hreba
7 siblings, 0 replies; 200+ results
From: Keith Thompson @ 2017-03-19 7:00 UTC (permalink / raw)
hreba <f_hreba@yahoo.com.br> writes:
[...]
> 2. On my platform size_t is C.int. How can I define size_t in a
> platform-independent way?
No, it isn't. C's size_t type is an unsigned type; int is a signed
type. (As others have said, you should just use Interfaces.C.size_t.)
[...]
--
Keith Thompson (The_Other_Keith) kst-u@mib.org <http://www.ghoti.net/~kst>
Working, but not speaking, for JetHead Development, Inc.
"We must do something. This is something. Therefore, we must do this."
-- Antony Jay and Jonathan Lynn, "Yes Minister"
^ permalink raw reply [relevance 6%]
* Re: Interfaces.C questions
2017-03-17 21:12 7% Interfaces.C questions hreba
` (3 preceding siblings ...)
2017-03-18 15:46 4% ` hreba
@ 2017-03-18 23:24 4% ` Leo Brewin
2017-03-19 12:17 5% ` hreba
2017-03-19 7:00 6% ` Keith Thompson
` (2 subsequent siblings)
7 siblings, 1 reply; 200+ results
From: Leo Brewin @ 2017-03-18 23:24 UTC (permalink / raw)
Hi Frank,
I'd be really interested to see a minimal working example once you've got it running.
I'd like to be able to use GSL in my own codes.
Cheers,
Leo
On Saturday, March 18, 2017 at 8:12:28 AM UTC+11, hreba wrote:
> These are my first steps with Interfaces.C:
>
> ----------------------------------------------------------------------
> with Interfaces.C;
>
> package GSL is
>
> package C renames Interfaces.C;
>
> type size_t is new C.int;
> type Real_Function is access function (x: C.double) return C.double;
>
> function Bessel_J0 (x: C.double) return C.double;
>
> function Integration_QNG
> (f: Real_Function;
> a, b, epsabs, epsrel: C.double;
> result, abserr: out C.double;
> neval: out size_t)
> return C.int;
>
> private
>
> pragma Import (C, Bessel_J0, "gsl_sf_bessel_J0");
> pragma Import (C, Integration_QNG, "gsl_integration_qng");
>
> end GSL;
> ------------------------------------------------------------------------
>
> No problem with function Bessel_J0. But Integration_QNG gets me:
>
> gsl.ads:19:07: functions can only have "in" parameters.
>
> The C prototype of this function is:
>
> int gsl_integration_qng (const gsl function * f , double a , double b ,
> double epsabs , double epsrel , double * result , double * abserr , size
> t * neval )
>
> So my questions are:
>
> 1. How do I translate C functions which return non-void and which
> additionally use pointers for out parameters? Do I have to use pointers
> in my Ada program?
>
> 2. On my platform size_t is C.int. How can I define size_t in a
> platform-independent way?
>
> 3. The C function above needs a pointer to a function as parameter. Is
> my translation to Ada correct?
>
> --
> Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C questions
2017-03-18 15:46 4% ` hreba
2017-03-18 16:26 7% ` Jeffrey R. Carter
@ 2017-03-18 16:27 7% ` Jeffrey R. Carter
2017-03-19 7:03 4% ` Keith Thompson
2 siblings, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2017-03-18 16:27 UTC (permalink / raw)
On 03/18/2017 04:46 PM, hreba wrote:
>
> struct gsl_function_struct
> {
> double (* function) (double x, void * params);
> void * params;
> };
> typedef struct gsl_function_struct gsl_function ;
>
> Can anybody please tell me how to translate this into Ada? I have no idea how to
> handle the void pointers.
Presuming that this is C's equivalent of a private type, and all allocation will
be handled by the library, then the equivalent of void* is any convention-C
access type. I'd probably write
type Void_Ptr is access all Integer;
pragma Convention (C, Void_Ptr);
type GSL_Function_Ptr is access
function (X : Interfaces.C.Double; Params : Void_Ptr)
return Interfaces.C.Double;
pragma Convention (C, GSL_Function_Ptr);
type GSL_Function is record
Func : GSL_Function_Ptr;
Params : Void_Ptr;
end record;
pragma Convention (C, GSL_Function);
--
Jeff Carter
"Pray that there's intelligent life somewhere up in
space, 'cause there's bugger all down here on earth."
Monty Python's Meaning of Life
61
^ permalink raw reply [relevance 7%]
* Re: Interfaces.C questions
2017-03-18 15:46 4% ` hreba
@ 2017-03-18 16:26 7% ` Jeffrey R. Carter
2017-03-18 16:27 7% ` Jeffrey R. Carter
2017-03-19 7:03 4% ` Keith Thompson
2 siblings, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2017-03-18 16:26 UTC (permalink / raw)
On 03/18/2017 04:46 PM, hreba wrote:
>
> struct gsl_function_struct
> {
> double (* function) (double x, void * params);
> void * params;
> };
> typedef struct gsl_function_struct gsl_function ;
>
> Can anybody please tell me how to translate this into Ada? I have no idea how to
> handle the void pointers.
Presuming that this is C's equivalent of a private type, and all allocation will
be handled by the library, then the equivalent of void* is any convention-C
access type. I'd probably write
type Void_Ptr is access all Integer;
pragma Convention (C, Void_Ptr);
type GSL_Function_Ptr is access
function (X : Interfaces.C.Double; Params : Void_Ptr)
return Interfaces.C.Double;
pragma Convention (C, GSL_Function_Ptr);
type GSL_Function is record
Func : GSL_Function_Ptr;
Params : Void_Ptr;
end record;
pragma Convention (C, GSL_Function);
--
Jeff Carter
"Pray that there's intelligent life somewhere up in
space, 'cause there's bugger all down here on earth."
Monty Python's Meaning of Life
61
^ permalink raw reply [relevance 7%]
* Re: Interfaces.C questions
2017-03-17 21:12 7% Interfaces.C questions hreba
` (2 preceding siblings ...)
2017-03-17 22:24 8% ` Dmitry A. Kazakov
@ 2017-03-18 15:46 4% ` hreba
2017-03-18 16:26 7% ` Jeffrey R. Carter
` (2 more replies)
2017-03-18 23:24 4% ` Leo Brewin
` (3 subsequent siblings)
7 siblings, 3 replies; 200+ results
From: hreba @ 2017-03-18 15:46 UTC (permalink / raw)
Instead of answering individually to each of you, I respond to my own
posting. Thanks to your help I was able to compile the corrected version
of my program. Execution generated a stack overflow. Reason was my wild
guess about the C type "gsl_function". In the GSL (GNU Scientific
Library) reference manual it is explained only through examples. Finally
I found its definition in the header file gsl_math.h:
struct gsl_function_struct
{
double (* function) (double x, void * params);
void * params;
};
typedef struct gsl_function_struct gsl_function ;
Can anybody please tell me how to translate this into Ada? I have no
idea how to handle the void pointers.
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 4%]
* Re: Interfaces.C questions
2017-03-17 21:12 7% Interfaces.C questions hreba
2017-03-17 21:57 6% ` Niklas Holsti
2017-03-17 22:14 6% ` Jeffrey R. Carter
@ 2017-03-17 22:24 8% ` Dmitry A. Kazakov
2017-03-21 21:08 4% ` Michael B.
2017-03-18 15:46 4% ` hreba
` (4 subsequent siblings)
7 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2017-03-17 22:24 UTC (permalink / raw)
On 2017-03-17 22:12, hreba wrote:
> These are my first steps with Interfaces.C:
>
> ----------------------------------------------------------------------
> with Interfaces.C;
>
> package GSL is
>
> package C renames Interfaces.C;
Renaming packages is a bad idea. Either use fully-qualified names
"Interfaces.C.size_t" or else do use-clause "size_t". Renaming lacks
advantages of either approach inheriting their corresponding disadvantages.
> type size_t is new C.int;
size_t is defined in Interfaces.C.
> type Real_Function is access function (x: C.double) return C.double;
pragma Convention (C, Real_Function);
> function Bessel_J0 (x: C.double) return C.double;
>
> function Integration_QNG
> (f: Real_Function;
> a, b, epsabs, epsrel: C.double;
> result, abserr: out C.double;
> neval: out size_t)
> return C.int;
function Integration_QNG
(f: Real_Function;
a, b, epsabs, epsrel: Interfaces.C.double;
result, abserr: access Interfaces.C.double;
neval: access Interfaces.C.size_t)
return Interfaces.C.int;
P.S. For convention C assume this:
1. out T, in out T, access T are equivalent
2. in T and access T are equivalent when T is non-scalar (you can pass
int, array, or record, the compiler will sort that out)
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 8%]
* Re: Interfaces.C questions
2017-03-17 21:12 7% Interfaces.C questions hreba
2017-03-17 21:57 6% ` Niklas Holsti
@ 2017-03-17 22:14 6% ` Jeffrey R. Carter
2017-03-17 22:24 8% ` Dmitry A. Kazakov
` (5 subsequent siblings)
7 siblings, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2017-03-17 22:14 UTC (permalink / raw)
On 03/17/2017 10:12 PM, hreba wrote:
>
> 1. How do I translate C functions which return non-void and which additionally
> use pointers for out parameters? Do I have to use pointers in my Ada program?
Ada before Ada 12 only allows "in" parameters for functions. If using such a
compiler, you'll have to use pointers on the Ada side as well. If you have an
Ada-12 compiler (currently only GNAT), then functions can have "in out" and
"out" parameters, which are better for this case.
> 2. On my platform size_t is C.int. How can I define size_t in a
> platform-independent way?
Use Interfaces.C.size_t.
> 3. The C function above needs a pointer to a function as parameter. Is my
> translation to Ada correct?
You should declare that your access type is convention C:
pragma Convention (C, Real_Function);
--
Jeff Carter
"Apart from the sanitation, the medicine, education, wine,
public order, irrigation, roads, the fresh water system,
and public health, what have the Romans ever done for us?"
Monty Python's Life of Brian
80
^ permalink raw reply [relevance 6%]
* Re: Interfaces.C questions
2017-03-17 21:12 7% Interfaces.C questions hreba
@ 2017-03-17 21:57 6% ` Niklas Holsti
2017-03-17 22:14 6% ` Jeffrey R. Carter
` (6 subsequent siblings)
7 siblings, 0 replies; 200+ results
From: Niklas Holsti @ 2017-03-17 21:57 UTC (permalink / raw)
On 17-03-17 23:12 , hreba wrote:
> These are my first steps with Interfaces.C:
>
> ----------------------------------------------------------------------
> with Interfaces.C;
>
> package GSL is
>
> package C renames Interfaces.C;
>
> type size_t is new C.int;
> type Real_Function is access function (x: C.double) return C.double;
>
> function Bessel_J0 (x: C.double) return C.double;
>
> function Integration_QNG
> (f: Real_Function;
> a, b, epsabs, epsrel: C.double;
> result, abserr: out C.double;
> neval: out size_t)
> return C.int;
>
> private
>
> pragma Import (C, Bessel_J0, "gsl_sf_bessel_J0");
> pragma Import (C, Integration_QNG, "gsl_integration_qng");
>
> end GSL;
> ------------------------------------------------------------------------
>
> No problem with function Bessel_J0. But Integration_QNG gets me:
>
> gsl.ads:19:07: functions can only have "in" parameters.
>
> The C prototype of this function is:
>
> int gsl_integration_qng (const gsl function * f , double a , double b ,
> double epsabs , double epsrel , double * result , double * abserr , size
> t * neval )
>
> So my questions are:
>
> 1. How do I translate C functions which return non-void and which
> additionally use pointers for out parameters? Do I have to use pointers
> in my Ada program?
Using pointers is possible, but functions with "out" or "in out"
parameters are allowed in the Ada 2012 standard. Check your compiler; it
may by default use the Ada 2005 rules and may need a command-line option
(perhaps -gnat2012) to use Ada 2012 rules.
> 2. On my platform size_t is C.int. How can I define size_t in a
> platform-independent way?
Don't define it; use Interfaces.C.size_t.
> 3. The C function above needs a pointer to a function as parameter. Is
> my translation to Ada correct?
Looks ok to me, but you didn't show the C prototype of the function (the
gsl_function type?) so I can't compare the two.
--
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
. @ .
^ permalink raw reply [relevance 6%]
* Interfaces.C questions
@ 2017-03-17 21:12 7% hreba
2017-03-17 21:57 6% ` Niklas Holsti
` (7 more replies)
0 siblings, 8 replies; 200+ results
From: hreba @ 2017-03-17 21:12 UTC (permalink / raw)
These are my first steps with Interfaces.C:
----------------------------------------------------------------------
with Interfaces.C;
package GSL is
package C renames Interfaces.C;
type size_t is new C.int;
type Real_Function is access function (x: C.double) return C.double;
function Bessel_J0 (x: C.double) return C.double;
function Integration_QNG
(f: Real_Function;
a, b, epsabs, epsrel: C.double;
result, abserr: out C.double;
neval: out size_t)
return C.int;
private
pragma Import (C, Bessel_J0, "gsl_sf_bessel_J0");
pragma Import (C, Integration_QNG, "gsl_integration_qng");
end GSL;
------------------------------------------------------------------------
No problem with function Bessel_J0. But Integration_QNG gets me:
gsl.ads:19:07: functions can only have "in" parameters.
The C prototype of this function is:
int gsl_integration_qng (const gsl function * f , double a , double b ,
double epsabs , double epsrel , double * result , double * abserr , size
t * neval )
So my questions are:
1. How do I translate C functions which return non-void and which
additionally use pointers for out parameters? Do I have to use pointers
in my Ada program?
2. On my platform size_t is C.int. How can I define size_t in a
platform-independent way?
3. The C function above needs a pointer to a function as parameter. Is
my translation to Ada correct?
--
Frank Hrebabetzky +49 / 6355 / 989 5070
^ permalink raw reply [relevance 7%]
* Re: Ada and C
2016-11-21 15:06 2% ` G.B.
@ 2016-11-21 20:52 0% ` jan van katwijk
0 siblings, 0 replies; 200+ results
From: jan van katwijk @ 2016-11-21 20:52 UTC (permalink / raw)
Op maandag 21 november 2016 16:06:43 UTC+1 schreef G.B.:
> On 21.11.16 12:44, Mr. Man-wai Chang wrote:
> > On 21/11/2016 7:43 PM, Luke A. Guest wrote:
> >> Mr. Man-wai Chang <toylet.toylet@gmail.com> wrote:
> >>>
> >>> Does Adata... sorry... Ada interact with C?
> >>>
> >>
> >> If you want it to
> >
> > Talking about physical reality *examples*!
>
> One example is an Ada program that calls POSIX routines
> as implemented for GNU/Linux, another is one that calls
> Windows™ GUI's functions (Win32).
> That, as well as the fact that the Ada standard specifies how
> Ada and C should interact (in LRM B.3, Interfaces.C), should
> answer the question not just by particular example but for
> every compiler on any supported system.
You could take a look at https://github.com/JvanKatwijk/ada-dab
which contains source for a DAB decoder and is using a number of C libraries
a.o it interfaces to C libraries for sdr input devices and soundcard output using a number of callbacks as well.
j
^ permalink raw reply [relevance 0%]
* Re: Ada and C
@ 2016-11-21 15:06 2% ` G.B.
2016-11-21 20:52 0% ` jan van katwijk
0 siblings, 1 reply; 200+ results
From: G.B. @ 2016-11-21 15:06 UTC (permalink / raw)
On 21.11.16 12:44, Mr. Man-wai Chang wrote:
> On 21/11/2016 7:43 PM, Luke A. Guest wrote:
>> Mr. Man-wai Chang <toylet.toylet@gmail.com> wrote:
>>>
>>> Does Adata... sorry... Ada interact with C?
>>>
>>
>> If you want it to
>
> Talking about physical reality *examples*!
One example is an Ada program that calls POSIX routines
as implemented for GNU/Linux, another is one that calls
Windows™ GUI's functions (Win32).
That, as well as the fact that the Ada standard specifies how
Ada and C should interact (in LRM B.3, Interfaces.C), should
answer the question not just by particular example but for
every compiler on any supported system.
^ permalink raw reply [relevance 2%]
* Re: feedback asked on dab-decoder software in Ada
2016-09-24 17:45 0% ` jan van katwijk
@ 2016-09-24 18:38 0% ` jan van katwijk
0 siblings, 0 replies; 200+ results
From: jan van katwijk @ 2016-09-24 18:38 UTC (permalink / raw)
Op zaterdag 24 september 2016 19:45:26 UTC+2 schreef jan van katwijk:
> Op donderdag 15 september 2016 11:00:10 UTC+2 schreef Jacob Sparre Andersen:
> > Jan van Katwijk wrote:
> >
> > > This summer I wanted to learn Ada (again, after a period of well over
> > > 20 years) and I made a reimplementation of the DAB software in Ada.
> >
> > Sounds like an ambitious project.
> >
> > > I would like to get some feedback on the use of the Ada language.
> >
> > Some comments and questions:
> >
> > + It would make it easier to get contributions from other Ada
> > developers, if you switched source style to something closer
> > to what is suggested by the Ada Quality and Style Guide [1].
> >
> > + Why do you put the package specifications in a separate directory?
> >
> > + You might benefit from running your compiler with more warnings
> > enabled.
> >
> > + A package body doesn't have to "with" itself.
> >
> > + There are no guarantees that "Integer" in Ada is the same as "int" in
> > C. If you need a C "int", you should use "Interfaces.C.int".
> >
> > + Are you sure you need as many access types as you declare? (It looks
> > - understandably - a bit like you are writing C in Ada.)
> >
> > + It looks like you aren't getting as much out of the type system as you
> > could. (A length should probably not be able to contain negative
> > values. - Just to take a single example.)
> >
> > > Any feedback and suggestions for improvement (it definitely runs
> > > slower than the C++ version) is welcome
> >
> > I would suggest that you postpone the performance improvements a bit,
> > and focus on getting more out of Ada.
> >
> > Greetings,
> >
> > Jacob
> >
> > [1] http://www.adaic.org/resources/add_content/docs/95style/html/cover.html
> > --
> > "For there are only two reasons why war is made against a
> > republic: The one, to become lord over her: the other, the
> > fear of being occupied by her." -- Nicolo Machiavelli
>
> Thanks for the comments. In the meantime I tried to apply some guideline rules, and the gnat compiler does not complain anymore on the layout.
> Wrt identifiers: I am not impressed very much by the guidelines, to me Is_Running is not better readable than isRunning, Has_Property not than hasProperty.
>
> First of all: the ada implementation of DAB is derived from the existing C++ implementation, all algorithms were extensively tried and tested in C++, so the complexity was more on using C libraries (I use several C libraries), some of them with callbacks. That all went pretty smooth, however, handling the GUI turned out to be more difficult than hndling the much more complex GUI in C++ (GtkAda vs Qt)
>
> The code and coding style is obviously influenced by having programmed in C++ for the last 10 years. Wrt access types, I really have to look at it, most likely it follows from the C++ background.
>
> Anyway, thanks for the advices, I'll continue to make it more "Ada-style"
>
> jan
I looked into the abundant use of access types. In the front end (i.e. the ofdm processing part) some access varaibles could be eliminated and replaced by "normal" variables. In the backend, however, quite some dynamic choices determine which part of the program should be active (e.g. MP2 decoding or MP4 decoding).
jan
^ permalink raw reply [relevance 0%]
* Re: feedback asked on dab-decoder software in Ada
2016-09-15 9:00 2% ` Jacob Sparre Andersen
@ 2016-09-24 17:45 0% ` jan van katwijk
2016-09-24 18:38 0% ` jan van katwijk
0 siblings, 1 reply; 200+ results
From: jan van katwijk @ 2016-09-24 17:45 UTC (permalink / raw)
Op donderdag 15 september 2016 11:00:10 UTC+2 schreef Jacob Sparre Andersen:
> Jan van Katwijk wrote:
>
> > This summer I wanted to learn Ada (again, after a period of well over
> > 20 years) and I made a reimplementation of the DAB software in Ada.
>
> Sounds like an ambitious project.
>
> > I would like to get some feedback on the use of the Ada language.
>
> Some comments and questions:
>
> + It would make it easier to get contributions from other Ada
> developers, if you switched source style to something closer
> to what is suggested by the Ada Quality and Style Guide [1].
>
> + Why do you put the package specifications in a separate directory?
>
> + You might benefit from running your compiler with more warnings
> enabled.
>
> + A package body doesn't have to "with" itself.
>
> + There are no guarantees that "Integer" in Ada is the same as "int" in
> C. If you need a C "int", you should use "Interfaces.C.int".
>
> + Are you sure you need as many access types as you declare? (It looks
> - understandably - a bit like you are writing C in Ada.)
>
> + It looks like you aren't getting as much out of the type system as you
> could. (A length should probably not be able to contain negative
> values. - Just to take a single example.)
>
> > Any feedback and suggestions for improvement (it definitely runs
> > slower than the C++ version) is welcome
>
> I would suggest that you postpone the performance improvements a bit,
> and focus on getting more out of Ada.
>
> Greetings,
>
> Jacob
>
> [1] http://www.adaic.org/resources/add_content/docs/95style/html/cover.html
> --
> "For there are only two reasons why war is made against a
> republic: The one, to become lord over her: the other, the
> fear of being occupied by her." -- Nicolo Machiavelli
Thanks for the comments. In the meantime I tried to apply some guideline rules, and the gnat compiler does not complain anymore on the layout.
Wrt identifiers: I am not impressed very much by the guidelines, to me Is_Running is not better readable than isRunning, Has_Property not than hasProperty.
First of all: the ada implementation of DAB is derived from the existing C++ implementation, all algorithms were extensively tried and tested in C++, so the complexity was more on using C libraries (I use several C libraries), some of them with callbacks. That all went pretty smooth, however, handling the GUI turned out to be more difficult than hndling the much more complex GUI in C++ (GtkAda vs Qt)
The code and coding style is obviously influenced by having programmed in C++ for the last 10 years. Wrt access types, I really have to look at it, most likely it follows from the C++ background.
Anyway, thanks for the advices, I'll continue to make it more "Ada-style"
jan
^ permalink raw reply [relevance 0%]
* Re: feedback asked on dab-decoder software in Ada
@ 2016-09-15 9:00 2% ` Jacob Sparre Andersen
2016-09-24 17:45 0% ` jan van katwijk
0 siblings, 1 reply; 200+ results
From: Jacob Sparre Andersen @ 2016-09-15 9:00 UTC (permalink / raw)
Jan van Katwijk wrote:
> This summer I wanted to learn Ada (again, after a period of well over
> 20 years) and I made a reimplementation of the DAB software in Ada.
Sounds like an ambitious project.
> I would like to get some feedback on the use of the Ada language.
Some comments and questions:
+ It would make it easier to get contributions from other Ada
developers, if you switched source style to something closer
to what is suggested by the Ada Quality and Style Guide [1].
+ Why do you put the package specifications in a separate directory?
+ You might benefit from running your compiler with more warnings
enabled.
+ A package body doesn't have to "with" itself.
+ There are no guarantees that "Integer" in Ada is the same as "int" in
C. If you need a C "int", you should use "Interfaces.C.int".
+ Are you sure you need as many access types as you declare? (It looks
- understandably - a bit like you are writing C in Ada.)
+ It looks like you aren't getting as much out of the type system as you
could. (A length should probably not be able to contain negative
values. - Just to take a single example.)
> Any feedback and suggestions for improvement (it definitely runs
> slower than the C++ version) is welcome
I would suggest that you postpone the performance improvements a bit,
and focus on getting more out of Ada.
Greetings,
Jacob
[1] http://www.adaic.org/resources/add_content/docs/95style/html/cover.html
--
"For there are only two reasons why war is made against a
republic: The one, to become lord over her: the other, the
fear of being occupied by her." -- Nicolo Machiavelli
^ permalink raw reply [relevance 2%]
* Re: is type String from Ada Binary-Safe ?
@ 2016-09-14 13:12 2% ` Dmitry A. Kazakov
0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2016-09-14 13:12 UTC (permalink / raw)
On 14/09/2016 14:51, Daniel Norte Moraes wrote:
> Type String from Ada is Binary-Safe ?
>
> I want use it with a 'recfrom()' from C with udp .
1. No array with dynamic bounds is. You need a flat array without
bounds, e.g. a string subtype or object.
2. Whether Character'Size = 8, AFAIK there is no requirement for that in
Ada.
3. Whether String is packed is not mandated either.
For recfrom the safe choice is to use flat char_array or chars_ptr, see
the package Interfaces.C.
BTW, Why don't you use GNAT.Sockets?
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 2%]
* Re: Kernel Syscall from Ada?
2016-06-23 10:58 0% ` Björn Lundin
@ 2016-06-23 16:28 0% ` Per Sandberg
0 siblings, 0 replies; 200+ results
From: Per Sandberg @ 2016-06-23 16:28 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 823 bytes --]
The attached makefile may provide some initial directions in addition to
"pragma import".
/Per
Den 2016-06-23 kl. 12:58, skrev Björn Lundin:
> On 2016-06-23 10:36, Diogenes wrote:
>> Is there a simple way to make a direct (Linux)Kernel syscall from Ada without using the system C library? i.e. Make a direct call as in Assembler?
>>
>> I'm asking because I've found a way to strip about 80k from a statically linked executable by not including Interfaces.C in the runtime.
>>
>> I've gotten my code to work reasonably well (no segfaults or memory errors) using inline Assembler. But it seems like there should be an Abstract or Generic "syscall" feature as part of the System library that we could use for doing our own Kernel calls. Same thing for the vDSO.
>>
>> Any tips?
>>
>> Diogenes
>>
>
>
> pragma import ?
>
>
[-- Attachment #2: Makefile --]
[-- Type: text/plain, Size: 220 bytes --]
all:
rm -f *.ads *.ali *.o *.d
(cd /usr/include ; find sys -type f) | grep -v -e vm86.h -e elf.h | sed -e "s-^-#include <-" -e "s-\$$->-" >gen.c
gcc -c gen.c -fdump-ada-spec -fada-spec-parent=kernel
rm -f *.c *.o
^ permalink raw reply [relevance 0%]
* Re: Kernel Syscall from Ada?
2016-06-23 8:36 2% Kernel Syscall from Ada? Diogenes
@ 2016-06-23 10:58 0% ` Björn Lundin
2016-06-23 16:28 0% ` Per Sandberg
2018-07-11 22:38 0% ` alexgrantbenedict
2018-07-12 1:32 0% ` Dan'l Miller
2 siblings, 1 reply; 200+ results
From: Björn Lundin @ 2016-06-23 10:58 UTC (permalink / raw)
On 2016-06-23 10:36, Diogenes wrote:
> Is there a simple way to make a direct (Linux)Kernel syscall from Ada without using the system C library? i.e. Make a direct call as in Assembler?
>
> I'm asking because I've found a way to strip about 80k from a statically linked executable by not including Interfaces.C in the runtime.
>
> I've gotten my code to work reasonably well (no segfaults or memory errors) using inline Assembler. But it seems like there should be an Abstract or Generic "syscall" feature as part of the System library that we could use for doing our own Kernel calls. Same thing for the vDSO.
>
> Any tips?
>
> Diogenes
>
pragma import ?
--
--
Björn
^ permalink raw reply [relevance 0%]
* Kernel Syscall from Ada?
@ 2016-06-23 8:36 2% Diogenes
2016-06-23 10:58 0% ` Björn Lundin
` (2 more replies)
0 siblings, 3 replies; 200+ results
From: Diogenes @ 2016-06-23 8:36 UTC (permalink / raw)
Is there a simple way to make a direct (Linux)Kernel syscall from Ada without using the system C library? i.e. Make a direct call as in Assembler?
I'm asking because I've found a way to strip about 80k from a statically linked executable by not including Interfaces.C in the runtime.
I've gotten my code to work reasonably well (no segfaults or memory errors) using inline Assembler. But it seems like there should be an Abstract or Generic "syscall" feature as part of the System library that we could use for doing our own Kernel calls. Same thing for the vDSO.
Any tips?
Diogenes
^ permalink raw reply [relevance 2%]
* Re: How to use/obtain output from system commands (in an Ada program) ?
2016-06-19 7:23 0% ` Dmitry A. Kazakov
@ 2016-06-20 8:34 0% ` reinkor
0 siblings, 0 replies; 200+ results
From: reinkor @ 2016-06-20 8:34 UTC (permalink / raw)
Thanks a lot,
any hint about rpm/repository for gtkada on OpenSuse (Leap) ?
reinert
On Sunday, June 19, 2016 at 9:24:16 AM UTC+2, Dmitry A. Kazakov wrote:
> On 2016-06-19 08:08, reinkor wrote:
>
> > I am looking for a simple way to obtain output from "xmessage"
> > (or dialog/kdialog) in my Ada program. Any good hints?
>
> The package System.OS_Lib has procedures Spawn that are much more
> comfortable to use than system().
>
> If you use GtkAda you can start xmessage or any other process with
> pipe-lined input/output/error. Then you will have callbacks to process
> them. It is also possible to use Gtk_Text_Buffer instead of callbacks.
>
> http://www.dmitry-kazakov.de/ada/gtkada_contributions.htm#10.1
>
> > A trivial way is to output to a file like in this test procedure:
> >
> > with Interfaces.C;
> > with Interfaces.C.Strings;
> > with Ada.Text_IO, Text_IO;
> >
> > procedure Test7 is
> > package C renames Interfaces.C;
> > use type C.char_array;
> > procedure system (Source : in C.char_array);
> > pragma Import(C, system, "system");
> > use Ada.Text_IO, Text_IO;
> > file1 : File_Type;
> > begin
> > system("xmessage -center Box1 -buttons label1:X,label2:y -print > choice_file1");
>
> Add terminating ASCII NUL here.
>
> --
> Regards,
> Dmitry A. Kazakov
> http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* Re: How to use/obtain output from system commands (in an Ada program) ?
2016-06-19 6:08 3% How to use/obtain output from system commands (in an Ada program) ? reinkor
@ 2016-06-19 7:23 0% ` Dmitry A. Kazakov
2016-06-20 8:34 0% ` reinkor
0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2016-06-19 7:23 UTC (permalink / raw)
On 2016-06-19 08:08, reinkor wrote:
> I am looking for a simple way to obtain output from "xmessage"
> (or dialog/kdialog) in my Ada program. Any good hints?
The package System.OS_Lib has procedures Spawn that are much more
comfortable to use than system().
If you use GtkAda you can start xmessage or any other process with
pipe-lined input/output/error. Then you will have callbacks to process
them. It is also possible to use Gtk_Text_Buffer instead of callbacks.
http://www.dmitry-kazakov.de/ada/gtkada_contributions.htm#10.1
> A trivial way is to output to a file like in this test procedure:
>
> with Interfaces.C;
> with Interfaces.C.Strings;
> with Ada.Text_IO, Text_IO;
>
> procedure Test7 is
> package C renames Interfaces.C;
> use type C.char_array;
> procedure system (Source : in C.char_array);
> pragma Import(C, system, "system");
> use Ada.Text_IO, Text_IO;
> file1 : File_Type;
> begin
> system("xmessage -center Box1 -buttons label1:X,label2:y -print > choice_file1");
Add terminating ASCII NUL here.
--
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de
^ permalink raw reply [relevance 0%]
* How to use/obtain output from system commands (in an Ada program) ?
@ 2016-06-19 6:08 3% reinkor
2016-06-19 7:23 0% ` Dmitry A. Kazakov
0 siblings, 1 reply; 200+ results
From: reinkor @ 2016-06-19 6:08 UTC (permalink / raw)
Hi,
I am looking for a simple way to obtain output from "xmessage"
(or dialog/kdialog) in my Ada program. Any good hints?
A trivial way is to output to a file like in this test procedure:
with Interfaces.C;
with Interfaces.C.Strings;
with Ada.Text_IO, Text_IO;
procedure Test7 is
package C renames Interfaces.C;
use type C.char_array;
procedure system (Source : in C.char_array);
pragma Import(C, system, "system");
use Ada.Text_IO, Text_IO;
file1 : File_Type;
begin
system("xmessage -center Box1 -buttons label1:X,label2:y -print > choice_file1");
Open(file1,In_File,"choice_file1");
declare
A : String := Get_Line(file1);
begin
Put(" Choice: " & A);
end;
Close(file1);
end Test7;
Are there more direct/better ways?
** By the way: when I run this program on Raspberry Pi
(lastest Raspbian jessie) i get, as expected, created the file "choice_file1".
Under OpenSuse Leap 42.1, gnat-5, i get produced a file named:
"choice_file1choice_file1test7.adb". Strange?
reinert
^ permalink raw reply [relevance 3%]
* Re: no code generation for c strings
@ 2016-06-04 6:31 3% ` Georg Bauhaus
0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2016-06-04 6:31 UTC (permalink / raw)
On 03.06.16 19:00, Lucretia wrote:
> On Friday, 3 June 2016 15:27:59 UTC+1, G.B. wrote:
>
>> If "&" will be become a function call, then
>>
>> S : constant char_array := ('h', 'e', 'l', 'l', 'o', nul);
>
> I want to avoid having to spell out all these function names like that thanks, and not really sure what you mean about the & there.
>
By RM4.9(6) and RM4.9(20), "&" might be a static function. I'm not sure.
In any case, for S to become static, adding constraints seems to be sufficient:
package Static is
S : constant char_array := "hello" & nul;
S1 : constant Char_Array (0 .. 5) := "hello" & nul;
X : constant := S'Length;
X1 : constant := S1'Length;
end Static;
1. with Interfaces.C; use Interfaces.C;
2.
3. package Static is
4. S : constant char_array := "hello" & nul;
5. S1 : constant Char_Array (0 .. 5) := "hello" & nul;
6.
7. X : constant := S'Length;
|
>>> non-static expression used in number declaration
>>> prefix is non-static array (RM 4.9(8))
8. X1 : constant := S1'Length;
9. end Static;
--
"HOTDOGS ARE NOT BOOKMARKS"
Springfield Elementary teaching staff
^ permalink raw reply [relevance 3%]
* Re: no code generation for c strings
2016-06-03 16:30 4% ` Simon Wright
@ 2016-06-03 17:04 4% ` Lucretia
0 siblings, 0 replies; 200+ results
From: Lucretia @ 2016-06-03 17:04 UTC (permalink / raw)
On Friday, 3 June 2016 17:30:14 UTC+1, Simon Wright wrote:
> "Dmitry A. Kazakov" writes:
>
> > On 03/06/2016 10:14, Luke A. Guest wrote:
> >
> >> What I would like to have is have the compiler recognise that I've declared
> >> a static char_array and just not generate a call to the secondary stack to
> >> allocate a new string. Is this actually possible? -O2/3 still generate the
> >> call.
> >>
> >> S : constant char_array := to_c ("hello" & nul);
> >
> > S : constant char_array := "hello" & char'val (0);
>
> GCC 6.1.0:
>
> with Interfaces.C;
> package Char_Arrays is
> use type Interfaces.C.char;
> use type Interfaces.C.char_array;
> S : constant Interfaces.C.char_array :=
> "hello" & Interfaces.C.char'Val (0);
> end Char_Arrays;
>
> generates (x86_64-apple-darwin15)
>
> .globl _char_arrays__s
> .const
> .align 3
> _char_arrays__s:
> .ascii "hello\0"
> .space 2
> .globl _char_arrays_E
> .data
> .align 1
> _char_arrays_E:
> .space 2
> .subsections_via_symbols
>
> & similar for arm-eabi.
Interesting, I tried this and dumped the asm, similar there, but as soon as you add more code, it just gets confusing, because it never references the actual label for the string anywhere.
with Interfaces.C;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Text_Io; use Ada.Text_Io;
procedure C_Str is
package C renames Interfaces.C;
use type Interfaces.C.char;
use type Interfaces.C.char_array;
-- S1 : constant Interfaces.C.char_array := Interfaces.C.To_C ("hello" & Nul, Append_Nul => False);
-- S2 : constant C.char_array := C.To_C ("hello");
S3 : constant C.char_array := "hello" & C.char'Val (0);
begin
-- Put_Line (C.To_Ada (S3));
null;
end C_Str;
gnatmake -gnatG c_str.adb -cargs -S
gcc -c -gnatG -S c_str.adb
Source recreated from tree for C_Str (body)
-------------------------------------------
with ada;
with ada;
with ada.ada__characters;
with interfaces;
with interfaces.interfaces__c;
with ada.ada__characters.ada__characters__latin_1;
use ada.ada__characters.ada__characters__latin_1;
with ada.ada__text_io;
use ada.ada__text_io;
procedure c_str is
c___XRP_interfaces__c___XE : _renaming_type;
package c renames interfaces.interfaces__c;
use type interfaces.interfaces__c.interfaces__c__char;
use type interfaces.interfaces__c.interfaces__c__char_array;
subtype c_str__Ts3S is interfaces__c__char_array (0 .. 5);
s3 : constant interfaces__c__char_array (0 .. 5) := "hello["00"]";
begin
null;
return;
end c_str;
gnatmake: "c_str.ali" WARNING: ALI or object file not found after compile
gnatmake: "c_str.adb" compilation error
.file "c_str.adb"
.text
.globl _ada_c_str
.type _ada_c_str, @function
_ada_c_str:
.LFB1:
.cfi_startproc
pushq %rbp
.cfi_def_cfa_offset 16
.cfi_offset 6, -16
movq %rsp, %rbp
.cfi_def_cfa_register 6
nop
nop
popq %rbp
.cfi_def_cfa 7, 8
ret
.cfi_endproc
.LFE1:
.size _ada_c_str, .-_ada_c_str
.section .rodata
.align 8
.type s3.3058, @object
.size s3.3058, 8
s3.3058:
.string "hello"
.zero 2
.ident "GCC: (GNU) 4.9.2"
.section .note.GNU-stack,"",@progbits
^ permalink raw reply [relevance 4%]
* Re: no code generation for c strings
@ 2016-06-03 16:30 4% ` Simon Wright
2016-06-03 17:04 4% ` Lucretia
1 sibling, 1 reply; 200+ results
From: Simon Wright @ 2016-06-03 16:30 UTC (permalink / raw)
"Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> writes:
> On 03/06/2016 10:14, Luke A. Guest wrote:
>
>> What I would like to have is have the compiler recognise that I've declared
>> a static char_array and just not generate a call to the secondary stack to
>> allocate a new string. Is this actually possible? -O2/3 still generate the
>> call.
>>
>> S : constant char_array := to_c ("hello" & nul);
>
> S : constant char_array := "hello" & char'val (0);
GCC 6.1.0:
with Interfaces.C;
package Char_Arrays is
use type Interfaces.C.char;
use type Interfaces.C.char_array;
S : constant Interfaces.C.char_array :=
"hello" & Interfaces.C.char'Val (0);
end Char_Arrays;
generates (x86_64-apple-darwin15)
.globl _char_arrays__s
.const
.align 3
_char_arrays__s:
.ascii "hello\0"
.space 2
.globl _char_arrays_E
.data
.align 1
_char_arrays_E:
.space 2
.subsections_via_symbols
& similar for arm-eabi.
^ permalink raw reply [relevance 4%]
* ANN: Cortex GNAT RTS 20160522
@ 2016-05-22 14:20 2% Simon Wright
0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2016-05-22 14:20 UTC (permalink / raw)
Available at
https://sourceforge.net/projects/cortex-gnat-rts/files/20160522/
This release includes GNAT Ada Run Time Systems (RTSs) based
on FreeRTOS (http://www.freertos.org) and targeted at boards with
Cortex-M3, -M4, -M4F MCUs (Arduino Due from http://www.arduino.org,
the STM32F4-series evaluation boards from STMicroelectronics at
http://www.st.com).
In each case, the board support for the RTS (configuration for size
and location of Flash, RAM; clock initialization; interrupt naming) is
in $RTS/adainclude. Support for the on-chip peripherals is also
included, in Ada spec files generated by SVD2Ada
(https://github.com/AdaCore/svd2ada).
The Ada source is either original or based on FSF GCC (mainly 4.9.1,
some later releases too).
(1) arduino-due is a Ravenscar-style RTOS based on FreeRTOS from
http://www.freertos.org for the Arduino Due.
See arduino-due/COPYING* for licensing terms.
On-chip peripheral support in atsam3x8e/.
Tests in test-arduino-due/.
(2) stm32f4 is a Ravenscar-style RTOS based on FreeRTOS from
http://www.freertos.org for the STM32F4-DISC* board.
See stm32f4/COPYING* for licensing terms.
On-chip peripheral support in stm32f40x/.
Tests in test-stm32f4/.
(3) stm32f429i is a Ravenscar-style RTOS based on FreeRTOS from
http://www.freertos.org for the STM32F429I-DISC* board.
See stm32f429i/COPYING* for licensing terms.
On-chip peripheral support in stm32f429x/.
Tests in test-stm32f429i/.
In this release,
* There is no longer any dependence on the STMicroelectronics'
STM32Cube package.
* The support for on-chip peripherals is limited to the
SVD2Ada-generated spec files. The AdaCore 'bareboard' software
(currently https://github.com/AdaCore/bareboard, but a name change
is under consideration) supports the STM32 line.
* Tasking no longer requires an explicit start
(https://sourceforge.net/p/cortex-gnat-rts/tickets/5/).
* Locking in interrupt-handling protected objects no longer inhibits
all interrupts, only those of equal or lower priority
(https://sourceforge.net/p/cortex-gnat-rts/tickets/18/).
The standard packages included (there are more, implementation-specific,
ones) are:
Ada
Ada.Containers
Ada.Containers.Bounded_Hashed_Maps
Ada.Containers.Bounded_Vectors
Ada.Exceptions
Ada.IO_Exceptions
Ada.Interrupts
Ada.Interrupts.Names
Ada.Iterator_Interfaces
Ada.Real_Time
Ada.Streams
Ada.Synchronous_Task_Control
Ada.Tags
Ada.Task_Identification
Interfaces
Interfaces.C
Interfaces.C.Strings
System
System.Assertions
System.Address_To_Access_Conversions
System.Storage_Elements
GNAT
GNAT.Source_Info
^ permalink raw reply [relevance 2%]
* Re: ANN: Introducing AdaBase - Thick database bindings for Ada
@ 2016-05-21 7:01 0% ` jrmarino
0 siblings, 0 replies; 200+ results
From: jrmarino @ 2016-05-21 7:01 UTC (permalink / raw)
On Saturday, May 21, 2016 at 3:13:00 AM UTC+2, Jeffrey R. Carter wrote:
> If it's one word, then it should be Adabase. CamelCase is antithetical to some
> basic Ada concepts, case insensitivity being one. Remember that many of us use
> language-sensitive editors that will recapitalize identifiers when we load a
> file. Resulting identifiers like Tisokeywords will be difficult to figure out
> and understand. Enough of them may make it difficult enough to use your library
> that people won't.
Artistic licence. I can call it (AdaBase) whatever I want and stylize however I like. I'll take a look at the types at the top of the package and see if underscores makes sense although I don't see why "Tisokeywords" would case an invasive automatic code-reformatting editor to have fits, unless you mean it must also be all lower case.
> I doubt if you can find 2 Ada developers who agree completely on matters of Ada
> formatting, but there is a very broad consensus on something similar to the
> formatting used in the ARM. (Even there you'll find all-lower-case identifiers
> in Interfaces.C.) Differing significantly from it will get you some flak and
> some people who will presume that it indicates that you're not very good at
> using the language.
Their loss due to poor evaluating skills based on way too little information, no? A style thoughout a project should be consistent (and looking through it now I can see AdaBase can improve in this regard, but there was a several month lag in development that helps explain it), but I don't think the style has to mimick ARM which I don't think is particularly great, only consistent.
> I wouldn't advocate that, though apparently Martin does. While I find some of
> your formatting irritating, I have used libraries with much worse formatting
> (based on looking only at package Adabase). Primarily I was trying to show you
> what Martin had objected to. (But I would, if defining the language, make
> CamelCase an error.)
Then you'd define that language as case-sensitive, something Ada is not, and that's the major flaw in people objection to how capitals are used. While some people might use weird editors, they also might be in the great minority.
> > 2) Suggesting to rename types and enumerations to break all programs
> > currently using the library is a much bigger deal and what's the benefit?
>
> I wouldn't suggest that. I would suggest in future using a style closer to the
> community consensus and putting a little more thought into your names to make
> them clearer and the code easier to read. As you have seen, it would lead to
> greater acceptance of your libraries by others.
I seriously doubt anyone beyond beginner would have the slighly issue understanding the code or understanding the purpose of the variables or types based on the names. I'll give you the style could be more uniform, and I'll give you I had no idea of the level of anal-retentiveness about things, but I will not concede that the quality or readability of the actual code is affected. It seems this situation is the equivalent of moving Rafael Nadal's water bottles out of their perfect alignment before he serves -- something that shouldn't make a bit of differences but is crippling to somebody with OCD. :)
^ permalink raw reply [relevance 0%]
Results 1-200 of ~2000 next (older) | reverse | options above
-- pct% links below jump to the message on this page, permalinks otherwise --
2016-05-13 20:37 ANN: Introducing AdaBase - Thick database bindings for Ada jrmarino
2016-05-20 15:18 ` Martin
2016-05-20 17:44 ` jrmarino
2016-05-20 20:36 ` Jeffrey R. Carter
2016-05-20 23:44 ` jrmarino
2016-05-21 1:12 ` Jeffrey R. Carter
2016-05-21 7:01 0% ` jrmarino
2016-05-22 14:20 2% ANN: Cortex GNAT RTS 20160522 Simon Wright
2016-06-03 8:14 no code generation for c strings Luke A. Guest
2016-06-03 8:25 ` Dmitry A. Kazakov
2016-06-03 9:23 ` Luke A. Guest
2016-06-03 9:37 ` Dmitry A. Kazakov
2016-06-03 14:27 ` G.B.
2016-06-03 17:00 ` Lucretia
2016-06-04 6:31 3% ` Georg Bauhaus
2016-06-03 16:30 4% ` Simon Wright
2016-06-03 17:04 4% ` Lucretia
2016-06-19 6:08 3% How to use/obtain output from system commands (in an Ada program) ? reinkor
2016-06-19 7:23 0% ` Dmitry A. Kazakov
2016-06-20 8:34 0% ` reinkor
2016-06-23 8:36 2% Kernel Syscall from Ada? Diogenes
2016-06-23 10:58 0% ` Björn Lundin
2016-06-23 16:28 0% ` Per Sandberg
2018-07-11 22:38 0% ` alexgrantbenedict
2018-07-12 1:32 0% ` Dan'l Miller
2016-08-18 9:00 feedback asked on dab-decoder software in Ada jan van katwijk
2016-09-15 9:00 2% ` Jacob Sparre Andersen
2016-09-24 17:45 0% ` jan van katwijk
2016-09-24 18:38 0% ` jan van katwijk
2016-09-14 12:51 is type String from Ada Binary-Safe ? Daniel Norte Moraes
2016-09-14 13:12 2% ` Dmitry A. Kazakov
2016-11-21 11:39 Ada and C Mr. Man-wai Chang
2016-11-21 11:43 ` Luke A. Guest
2016-11-21 11:44 ` Mr. Man-wai Chang
2016-11-21 15:06 2% ` G.B.
2016-11-21 20:52 0% ` jan van katwijk
2017-03-17 21:12 7% Interfaces.C questions hreba
2017-03-17 21:57 6% ` Niklas Holsti
2017-03-17 22:14 6% ` Jeffrey R. Carter
2017-03-17 22:24 8% ` Dmitry A. Kazakov
2017-03-21 21:08 4% ` Michael B.
2017-03-21 21:28 4% ` Dmitry A. Kazakov
2017-03-21 21:31 4% ` Simon Wright
2017-03-22 20:35 4% ` Randy Brukardt
2017-03-18 15:46 4% ` hreba
2017-03-18 16:26 7% ` Jeffrey R. Carter
2017-03-18 16:27 7% ` Jeffrey R. Carter
2017-03-19 7:03 4% ` Keith Thompson
2017-03-18 23:24 4% ` Leo Brewin
2017-03-19 12:17 5% ` hreba
2017-03-20 9:44 4% ` Leo Brewin
2017-03-19 7:00 6% ` Keith Thompson
2017-03-19 12:05 4% ` Per Sandberg
2017-03-19 18:39 3% ` hreba
2017-03-19 19:22 4% ` Simon Wright
2017-03-19 19:49 4% ` hreba
2017-03-19 23:53 7% ` Simon Wright
2017-03-20 11:12 4% ` hreba
2017-03-20 14:04 6% ` hreba
2017-03-22 11:21 4% ` hreba
2017-03-23 7:43 6% Interfaces.C + generics: stack overflow hreba
2017-03-23 7:46 4% ` hreba
2017-03-23 17:45 4% ` Jeffrey R. Carter
2017-03-24 12:20 4% ` hreba
2017-03-23 20:03 3% ` Randy Brukardt
2017-03-24 12:42 6% ` hreba
2017-03-24 20:13 3% ` Randy Brukardt
2017-03-24 22:03 2% ` Dmitry A. Kazakov
2017-03-25 14:17 4% ` hreba
2017-03-25 15:21 4% ` hreba
2017-03-26 22:34 3% ` Robert Eachus
2017-03-27 7:21 4% ` Dmitry A. Kazakov
2017-03-30 17:12 3% ` Robert Eachus
2017-03-25 15:23 6% ` Dmitry A. Kazakov
2017-03-29 1:29 4% Example Ada calling Gnu Scientific Library (GSL) Leo Brewin
2017-03-29 7:19 3% ` hreba
2017-03-29 20:07 0% ` Randy Brukardt
2017-04-04 21:25 0% ` hreba
2017-04-05 16:29 ` Simon Wright
2017-04-05 20:21 ` hreba
2017-04-06 7:30 ` Simon Wright
2017-04-07 18:45 ` hreba
2017-04-08 8:28 ` Simon Wright
2017-04-09 10:57 ` hreba
2017-04-09 15:17 ` Simon Wright
2017-04-10 8:53 ` hreba
2017-04-10 9:47 ` Dmitry A. Kazakov
2017-04-10 15:39 3% ` hreba
2017-04-10 17:16 0% ` Dmitry A. Kazakov
2017-06-07 22:06 1% Ann: ArchiCheck v0.1 Lionel Draghi
2017-07-07 21:03 Convert chars_ptr to Ada String Victor Porton
2017-07-07 22:23 2% ` Anh Vo
2017-07-07 22:48 3% ` Victor Porton
2017-07-07 23:14 3% ` Anh Vo
2017-07-09 6:49 2% ` Victor Porton
2017-07-10 4:58 2% ` Anh Vo
2017-07-10 9:31 0% ` Victor Porton
2017-07-10 9:48 ` Dmitry A. Kazakov
2017-07-10 12:41 3% ` Mark Lorenzen
2017-07-10 14:24 2% ` Dmitry A. Kazakov
2017-08-03 5:45 Community Input for the Maintenance and Revision of the Ada Programming Language Randy Brukardt
2017-08-03 12:06 ` Lucretia
2017-08-03 12:52 ` Lucretia
2017-08-09 21:08 ` Luke A. Guest
2017-08-09 21:12 ` Luke A. Guest
2017-08-10 14:43 2% ` Lucretia
2017-08-11 1:24 0% ` Randy Brukardt
2017-08-10 5:41 ` G.B.
2017-08-10 14:41 ` Lucretia
2017-08-11 14:42 ` Justin Sq
2017-08-11 14:48 ` jsquirek
2017-08-11 17:10 ` Luke A. Guest
2017-08-11 17:24 ` Justin Sq
2017-08-11 20:09 ` Dmitry A. Kazakov
2017-08-11 21:13 ` Randy Brukardt
2017-08-18 21:06 ` Robert Eachus
2017-08-31 7:36 ` Jacob Sparre Andersen
2017-08-31 9:52 ` Dmitry A. Kazakov
2017-08-31 12:49 2% ` Jacob Sparre Andersen
2017-08-31 13:16 2% ` Dmitry A. Kazakov
2017-08-31 23:54 0% ` Randy Brukardt
2017-08-04 22:17 Convert an access to constant to access to variable Victor Porton
2017-08-05 17:27 ` Stephen Leake
2017-08-05 17:41 ` Victor Porton
2017-08-07 23:16 3% ` Randy Brukardt
2017-08-05 13:41 3% Need a way to convert a constant to a variable Victor Porton
2017-08-05 14:48 0% ` Dmitry A. Kazakov
2017-08-05 15:11 0% ` Victor Porton
2017-08-05 15:41 3% ` Jeffrey R. Carter
2017-08-05 16:25 0% ` Victor Porton
2017-08-05 17:59 0% ` Per Sandberg
2017-08-08 13:04 2% ANN: Cortex GNAT RTS 2017-08-08 Simon Wright
2017-08-18 2:23 6% Please evaluate tiny binding that does not use Interfaces.C patrick
2017-08-18 5:18 3% ` Per Sandberg
2017-08-18 13:05 5% ` patrick
2017-08-18 15:41 4% ` patrick
2017-08-25 8:03 3% gcc-7 breaks unsized C array bindings ytomino
2017-08-27 7:16 0% ` Shark8
2017-08-27 7:57 0% ` Jeffrey R. Carter
2017-08-30 21:27 0% ` Simon Wright
2017-08-29 20:28 win32 interfacing check (SetClipboardData) Xavier Petit
2017-08-30 16:04 ` Dmitry A. Kazakov
2017-08-31 1:41 3% ` Randy Brukardt
2017-09-21 18:14 Ada.Strings.Unbounded vs Ada.Containers.Indefinite_Holders Victor Porton
2017-09-21 21:30 ` AdaMagica
2017-09-22 12:16 ` Victor Porton
2017-09-22 19:25 ` Simon Wright
2017-09-22 22:15 ` Victor Porton
2017-09-23 8:09 ` Dmitry A. Kazakov
2017-09-23 9:16 2% ` Jeffrey R. Carter
2017-10-11 21:52 Convert between C "void*" pointer and an access Victor Porton
2017-10-11 22:58 3% ` Victor Porton
2017-10-11 23:12 3% ` Victor Porton
2017-10-12 1:01 2% ` Victor Porton
2018-02-23 8:54 3% non-local pointer cannot point to local object artium
2018-02-23 9:22 0% ` J-P. Rosen
2018-04-28 16:13 ANN: Cortex GNAT RTS 20180419 Simon Wright
2018-04-28 21:01 ` Jere
2018-04-29 11:50 1% ` Simon Wright
2018-05-01 23:47 0% ` Jere
2018-05-25 22:22 3% Interfaces.C.Strings chars_ptr memory management strategy NiGHTS
2018-05-26 2:52 4% ` Shark8
2018-05-26 12:44 4% ` NiGHTS
2018-05-26 13:56 4% ` Shark8
2018-05-30 13:10 3% ` Alejandro R. Mosteo
2018-05-30 19:56 3% ` Randy Brukardt
2018-05-31 10:34 4% ` Alejandro R. Mosteo
2018-05-31 22:25 3% ` Randy Brukardt
2018-06-05 12:42 4% ` Alejandro R. Mosteo
2018-06-03 18:31 7% ` ytomino
2018-06-03 19:33 4% ` Dmitry A. Kazakov
2018-06-03 20:03 6% ` ytomino
2018-06-04 7:06 4% ` Dmitry A. Kazakov
2018-06-04 7:47 4% ` ytomino
2018-06-03 20:37 4% ` ytomino
2018-05-26 21:43 Strings with discriminated records NiGHTS
2018-05-27 17:11 3% ` NiGHTS
2018-05-27 18:07 0% ` Simon Wright
2018-05-27 23:08 0% ` NiGHTS
2018-05-28 1:44 0% ` Jere
2018-05-28 3:05 0% ` NiGHTS
2018-05-27 18:25 0% ` Dmitry A. Kazakov
2018-05-27 22:44 0% ` NiGHTS
2018-05-28 7:29 3% ` Dmitry A. Kazakov
2018-05-28 7:42 2% ` Simon Wright
2018-05-31 11:14 Header-only Ada libraries Alejandro R. Mosteo
2018-05-31 12:18 ` joakimds
2018-05-31 13:34 3% ` Jeffrey R. Carter
2018-06-04 3:17 2% Trying to execute a command from inside of Ada John Smith
2018-06-04 4:42 0% ` ytomino
2018-07-06 21:15 GNAT/Ada on Raspberry Pi 3 dontspam@dontspam.no
2018-07-08 13:20 4% ` Björn Lundin
2018-08-04 1:37 Can Ada print coloured/styled text to the terminal? (ANSI escape sequences?) Hazz
2018-08-07 0:01 ` Aurele
2018-08-12 20:56 ` Matt Borchers
2018-08-13 10:23 ` Aurele Vitali
2018-08-16 9:58 ` alby.gamper
2018-08-16 12:29 3% ` Aurele Vitali
2018-08-16 12:52 0% ` alby.gamper
2018-08-11 1:06 AdaCore Community 2018 Bugs Roger
2018-08-11 8:42 ` Jeffrey R. Carter
2018-08-11 12:19 ` Roger
2018-08-11 17:20 ` Simon Wright
2018-08-12 1:50 ` Roger
2018-08-12 7:33 ` Simon Wright
2018-08-12 11:45 ` Roger
2018-08-12 16:37 3% ` Simon Wright
2018-08-13 2:02 2% ` Roger
2018-08-13 2:54 0% ` Roger
2018-08-20 13:56 file descriptor of a serial port jan.de.kruyf
2018-08-20 19:52 2% ` Per Sandberg
2018-08-21 7:19 0% ` jan.de.kruyf
2018-08-22 7:03 0% ` jan.de.kruyf
2018-09-17 12:01 3% Interface To C Struct That Includes An Array rogermc
2018-09-17 12:11 0% ` rogermc
2018-09-17 15:24 0% ` Lucretia
2018-09-17 23:06 3% ` Roger
2018-09-18 8:19 0% ` rakusu_klein
2018-09-18 11:54 0% ` rogermc
2018-10-15 13:42 Least Dangerous Way to Do This ? patrick
2018-10-15 16:05 ` Simon Wright
2018-10-15 19:28 ` patrick
2018-10-15 19:36 ` patrick
2018-10-16 16:07 ` Shark8
2018-10-17 0:09 2% ` patrick
2018-10-17 20:49 0% ` Shark8
2019-02-06 23:10 Ada x <whatever> Datagram Sockets Rego, P.
2019-02-07 0:42 ` Jere
2019-02-07 5:28 ` Rego, P.
2019-02-07 6:00 ` Egil H H
2019-02-07 6:41 ` Rego, P.
2019-02-07 11:47 ` Jere
2019-02-07 18:00 3% ` Jeffrey R. Carter
2019-02-08 20:35 3% ` Rego, P.
2019-02-08 21:26 0% ` Jeffrey R. Carter
2019-02-08 21:38 0% ` Dmitry A. Kazakov
2019-03-01 13:48 How to bind this properly, C ** which is an array Lucretia
2019-03-01 19:57 ` Per Sandberg
2019-03-01 20:25 ` Lucretia
2019-03-01 22:02 3% ` Per Sandberg
2019-03-25 5:46 3% differences between Ada and C in gnat forcing me to use C instead of Ada matthewbrentmccarty
2019-03-25 5:58 0% ` Jere
2019-03-25 8:25 0% ` Dmitry A. Kazakov
2019-03-25 14:09 2% ` matthewbrentmccarty
2019-03-25 16:42 ` matthewbrentmccarty
2019-03-25 18:18 ` Dmitry A. Kazakov
2019-04-04 0:51 3% ` matthewbrentmccarty
2019-07-19 21:41 How to make Ada popular. Get rid of ";" at end of statement Nasser M. Abbasi
2019-07-23 21:58 ` Ingo M.
2019-07-24 14:06 ` John Perry
2019-07-25 7:26 3% ` Maciej Sobczak
2019-07-26 19:16 0% ` Niklas Holsti
2019-09-13 3:28 1% libcurl with Ada - how to HTTP POST transfer with large file upload Matt Borchers
2019-12-11 16:43 2% Is this actually possible? Lucretia
2019-12-11 19:59 0% ` Randy Brukardt
2020-04-03 16:57 3% Running a simple Python from Ada program Rego, P.
2020-04-03 17:35 0% ` Dmitry A. Kazakov
2020-04-03 19:05 ` Rego, P.
2020-04-03 19:19 3% ` Rego, P.
2020-04-03 20:06 0% ` Dmitry A. Kazakov
2020-04-04 1:48 0% ` Dennis Lee Bieber
2020-04-29 8:46 Getting the 3 letter time zone abbreviation Bob Goddard
2020-04-29 9:09 ` Dmitry A. Kazakov
2020-04-29 19:20 ` Bob Goddard
2020-04-29 19:53 ` Dmitry A. Kazakov
2020-04-30 18:59 ` Bob Goddard
2020-04-30 21:11 3% ` Dmitry A. Kazakov
2020-05-02 12:46 4% ` Bob Goddard
2020-05-05 11:04 How can one record component be local and another not? hreba
2020-05-05 15:45 2% ` Jeffrey R. Carter
2020-05-05 17:17 0% ` hreba
2020-05-05 19:08 0% ` Niklas Holsti
2020-05-06 19:31 2% ` hreba
2020-05-05 19:19 0% ` Jere
2020-05-06 6:42 0% ` Mark Lorenzen
2020-05-31 10:46 Any good package for mathematical function in Ada? reinert
2020-05-31 23:25 ` Jerry
2020-06-01 8:24 ` reinert
2020-06-01 10:19 3% ` Dmitry A. Kazakov
2020-06-05 20:34 2% Ann: HAC v.0.07, LEA 0.71 gautier_niouzes
2020-06-06 16:23 Coding access to a C's pointer - pointer Bob Goddard
2020-06-06 17:01 ` Dmitry A. Kazakov
2020-06-06 17:34 2% ` Bob Goddard
2020-06-06 18:48 0% ` Dmitry A. Kazakov
2020-06-16 11:31 3% How can I get this data into the .data section of the binary? Luke A. Guest
2020-09-03 10:32 0% ` c+
2020-09-13 13:36 0% ` patelchetan1111992
2020-09-19 14:08 0% ` erchetan33
2020-09-28 11:36 0% ` yhumina stir
2020-12-27 8:14 3% Easiest way to use regular expressions? reinert
2020-12-27 8:20 3% Easiest way to use redular expressions? reinert
2020-12-28 9:44 2% Messing with access types Marek
2020-12-28 10:14 2% ` Dmitry A. Kazakov
2020-12-28 11:43 2% ` Marek
2020-12-28 13:56 3% ` Dmitry A. Kazakov
2021-01-05 17:37 1% SweetAda 0.1h released Gabriele Galeotti
2021-03-04 15:59 converting pointer to value Björn Lundin
2021-03-04 16:55 ` Shark8
2021-03-04 17:35 ` Dmitry A. Kazakov
2021-03-05 11:02 ` Björn Lundin
2021-03-05 11:57 ` Björn Lundin
2021-03-05 14:00 2% ` Dmitry A. Kazakov
2021-07-28 9:25 Building the 2021 source release of GnatStudio Rod Kay
2021-07-29 0:49 ` Randy Brukardt
2021-07-29 7:49 ` Luke A. Guest
2021-07-29 8:41 ` Dmitry A. Kazakov
2021-07-29 11:33 ` Stéphane Rivière
2021-07-29 11:58 ` Dmitry A. Kazakov
2021-07-30 11:29 ` Stéphane Rivière
2021-07-31 10:30 ` Dmitry A. Kazakov
2021-07-31 11:58 ` Stéphane Rivière
2021-07-31 12:29 2% ` Dmitry A. Kazakov
2021-08-29 11:06 1% Help: Ada in NetBSD Fernando Oleo Blanco
2021-09-23 10:42 C time_t 2038 problem s-os_lib.ads Kevin Chadwick
2021-09-23 14:26 ` Jeffrey R. Carter
2021-09-23 15:01 ` Kevin Chadwick
2021-09-23 15:08 ` Joakim Strandberg
2021-09-23 19:52 ` Keith Thompson
2021-09-24 9:32 ` Joakim Strandberg
2021-09-24 22:54 ` Keith Thompson
2021-09-25 10:22 2% ` G.B.
2022-02-02 17:21 2% Plugin with controlled variable for initialization hreba
2022-02-02 18:05 3% ` Dmitry A. Kazakov
2022-04-18 21:58 max line length Thomas
2022-04-19 6:38 3% ` Niklas Holsti
2022-09-24 7:52 MS going to rust (and Linux too) Dmitry A. Kazakov
2022-09-24 8:50 ` Luke A. Guest
2022-09-24 9:13 ` Dmitry A. Kazakov
2022-09-24 11:41 ` G.B.
2022-09-24 13:05 ` Luke A. Guest
2022-09-24 17:49 ` G.B.
2022-09-24 20:38 2% ` Luke A. Guest
2022-12-06 11:13 New compiler error with new compiler Jerry
2022-12-06 11:36 2% ` Dmitry A. Kazakov
2023-08-04 20:09 ALR unable to get many packages Kenneth Wolcott
2023-08-05 7:28 ` Simon Wright
2023-08-05 21:02 ` Kenneth Wolcott
2023-08-05 22:12 ` Simon Wright
2023-08-05 22:41 ` Kenneth Wolcott
2023-08-06 11:30 ` Simon Wright
2023-08-06 23:20 ` Kenneth Wolcott
2023-08-06 23:29 2% ` Kenneth Wolcott
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox