Generate functions at compile-time - ada

Is there any way to generate functions at compile-time in Ada? I want to generate an opcode table that stores function pointers. My current solution is to store objects containing a procedure that can be executed, but I'd rather not allocate if possible.

No.
But there's nothing wrong with having a domain-specific language (DSL) from which you generate Ada. That happens regularly.

You can use a generic procedure to have a generic body and just supply whatever unique parameters you need to it
with Ada.Text_IO; use Ada.Text_IO;
procedure Hello is
generic
-- some sort of parameters
Value : Integer;
procedure Do_Op;
procedure Do_Op is
begin
Put_Line(Integer'Image(Value));
end Do_Op;
procedure Op1 is new Do_Op(1);
procedure Op2 is new Do_Op(2);
procedure Op3 is new Do_Op(3);
begin
Put_Line("Hello, world!");
Op1;
Op2;
Op3;
end Hello;

Related

Ada: Declaration & assignment overhead

I'm curious about the initialization within Ada procedures:
Suppose I have the following procedure:
procedure Foo (Bar : Integer) is
Another_Bar : Integer := Bar;
begin
...
end Foo;
Should the assignment to Another_Bar have the same overhead as
procedure Foo2 (Bar : Integer) is
Another_Bar : Integer;
begin
Another_Bar := Bar;
...
end Foo;
My question is essentially if both assignments generate the same assembly instructions and thus are equal in speed? (without detailing the target machine)
Based on the Ada language standard, there is no general reason why those two forms of code should have different performance. It would all depend on the target machine and the compiler being used. Depending on the rest of the code in the procedure, some compilers could even completely optimize away the Another_Bar variable.
However, there is a semantic difference, which could be important if the subtypes of Bar and Another_Bar were different -- for example, if Another_Bar were declared as Positive instead of Integer. Namely, in the first form any exception raised by the initialization of Another_Bar (say, because Bar has a negative value) is not handled by the possible exception handlers in the procedure itself, but is propagated to the caller. In the second form, where Another_Bar is assigned after the begin, exceptions from that assignment can be handled by the procedure's own exception handlers.

Problem calling procedure in protected object using access type

Consider attached code showing three different calls to the same procedure. It compiles good but hangs up in execution time. I suspect about some kind of lock but I can not understand why.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Exceptions; use Ada.Exceptions;
procedure Main is
type A_Proc is access protected procedure (B: in out Integer);
protected Obj is
procedure Inc (B: in out Integer);
procedure Test (B: in out Integer);
end Obj;
protected body Obj is
procedure Inc (B: in out Integer) is
begin
B:=B+1;
end Inc;
procedure Test (B: in out Integer) is
Proc : A_Proc:=Inc'Access;
begin
Proc.all (B);
end Test;
end Obj;
B : Integer:=1;
Proc : A_Proc:=Obj.Inc'Access;
begin
Put_Line(B'Image);
Obj.Inc (B);
Put_Line(B'Image);
Proc.all (B);
Put_Line(B'Image);
Obj.Test (B);
Put_Line(B'Image);
Put_Line("The End");
end Main;
In ARM 9.5.1(3), we find
For the execution of a call on a protected subprogram, [...] If the call is an internal call (see 9.5), the body of the subprogram is executed as for a normal subprogram call. If the call is an external call, then the body of the subprogram is executed as part of a new protected action on the target protected object
and in ARM 9.5(2,3),
When a name or prefix denotes an entry, protected subprogram, [...] the name or prefix determines a target object, as follows:
If it is a direct_name or expanded name that denotes the declaration (or body) of the operation, then the target object is implicitly specified to be the current instance of the task or protected unit immediately enclosing the operation; a call using such a name is defined to be an internal call
but, in (5),
If the name or prefix is a dereference (implicit or explicit) of an access-to-protected-subprogram value, then the target object is determined by the prefix of the Access attribute_reference that produced the access value originally; a call using such a name is defined to be an external call
so I’m afraid that the ARM explicitly warns against what you’re trying to do; Obj is locked on entry to Obj.Test, and the external call via Proc attempts to take the lock again. See DeeDee’s answer.
As an addendum to the answer by Simon Wright, I think that ARM 9.5.1 (15) ,
During a protected action, it is a bounded error to invoke an operation that is potentially blocking. The following are defined to be potentially blocking operations:
[...]
an external call on a protected subprogram (or an external requeue) with the same target object as that of the protected action;
and ARM 9.5.1 (17),
If the bounded error is detected, Program_Error is raised. If not detected, the bounded error might result in deadlock or a (nested) protected action on the same target object.
also apply. If so, then performing an external call on a protected subprogram might result in a deadlock, but it might also result in the program continue to run (or a Program_Error to be raised).
I executed the program on GNAT CE 2018 both Windows and Linux (Debian). The program on Windows runs till the end, but hangs on Linux after printing 3.
To elaborate on the comments below: you may use the configuration pragma Detect_Blocking to make the Ada run time check for these potentially blocking calls (see ARM H.5).
If you use GPRbuild, then you can enable the detection by putting pragma Detect_Blocking; into a file (typically named gnat.adc) and reference this configuration file in you're project file by adding the Local_Configuration_Pragmas attribute to the compiler package (see also here and here):
project Default is
for Source_Dirs use ("src");
for Object_Dir use "obj";
for Main use ("main.adb");
package Compiler is
for Local_Configuration_Pragmas use "gnat.adc";
end Compiler;
end Default;

Extending a Variable's Lifetime

To be fair, I cannot be entirely sure the title correctly describes the problem I am having, as it merely mirrors my current understanding of Ada as it is.
The Problem
I have a function:
function Make_Option (Title : String) return Access_Option is
O : aliased Option := (
Title_Len => Title'Length,
Title => Title);
begin -- Make_Option
return O'Unrestricted_Access;
end Make_Option;
This function is supposed to create a new menu option for the user, that may in turn be inserted into a menu (one that you might see in a terminal-based environment). You are all probably sighing, as quite evidently, the O variable would be deallocated at the end of this function (from my current understanding). As such, using the Unrestricted_Access here is just plain stupidity, but it mirrors the result of what it is I am trying to accomplish (as this code indeed does compile successfully).
The Access_Option is defined as following:
type Access_Option is access all Option;
The idea is that with an access to the option, which in turn is a discriminated record, is that we can store it within an array-like structure (as the object itself varies in size).
Beyond doubt, it would be nice if we could instead use the Access attribute for this, as the compiler would then make sure the lifetime is long enough of the O variable we are referencing, but as the lifetime as a matter of fact only exists til the end of the Make_Option function, we are presented with the following:
non-local pointer cannot point to local object
What I am then asking, is: how would I go about having a function to create Access_Options for me? Is such a thing even possible, or am I doing it all wrong? To clarify, what I am trying to do is create a neat way for filling an array with references to discriminated records, that I can then dereference and use.
Thought Process
I personally have not tried too many things, more than think about solutions that may be plausible for the problem. And, frankly, rather than going crazy of working makeshift solutions, it would be nice to have a solution that works for large-scale applications too, without messing up the code base to bad.
Would you perhaps have some sort of object queue to handle it? Does Ada even deallocate resources automatically in the first place? Gah. I am confused.
Would it, in fact, be possible to somehow place the O variable outside of the scope for deallocation to then manually deallocate it later?
Given the example you show above a much simpler approach is to simply make an array of Unbounded_String:
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO; use Ada.Text_Io;
procedure Str_Arrays is
type Arr is array(1..10) of Unbounded_String;
A : Arr;
begin
for S of A loop
S := To_Unbounded_String("Hello World!");
end loop;
for S of A loop
Put_Line(To_String(S));
end loop;
end Str_arrays;
Don't try that.
There are two alternative options:
1) Use Ada.Containers.Indefinite_Vectors instead of a plain array.
2) Give your record discriminant a default value. Then you can store it in a plain array.
You seem to be reinventing the bounded string. Alternatives include
Using an instantiation of Ada.Strings.Bounded.Generic_Bounded_Length
Using Ada.Strings.Unbounded
Using an indefinite container (Ada.Containers.Indefinite_*) to hold type String

What is the 'Address of an Ada subprogram passed as an access parameter?

Compiling the following program without optimization, and then running it, I see Program_Error,
raised PROGRAM_ERROR : addreq.adb:16 explicit raise
or, updating in view of Simon Wright's answer,
raised PROGRAM_ERROR : using address
This happens when using GNAT GPL 2014 on either Mac OS X or on GNU/Linux x84_64, on Linux, strangely, only for my program. Other versions of GNAT produce code that doesn't raise, older compilers do not accept (access-to-function parameters being more recent, I'm not surprised). Since my program needs to identify addresses of subprograms, I was hoping for a definitive statement in the RM; 13.3 (11) has ramifications that grow waivers, IINM. So, referring to the program below, would
Yes_no.all'Address = No'Adress
be a true statement if interpreted by the LRM? Legit? Is Yes_No.all actually a proper way to refer to the function No (if taking the 'Address)? As there is indirection through different pointer types, one having deeper accessibility, does this change the picture? I was thinking that Yes_No.all should yield the same 'Address as No, but apparently not, with some compilers.
with System;
procedure Addreq is
function No (Ignored : Integer) return Boolean is
begin
return False;
end No;
procedure Taking
(Yes_No : access function (N : Integer) return Boolean)
is
use type System.Address;
begin
if Yes_No.all'Address /= No'Address then
raise Program_Error;
end if;
end Taking;
begin
Taking (No'Access);
end Addreq;
One more update: if I make Addreq a package and have another subprogram call Taking, thus
with Addreq; -- now a package
procedure Driver is
use Addreq;
begin
Taking (No'Access);
end Driver;
then no exception is raised.
I think it must depend on your OS and compiler. Using FSF GCC 5.1.0 on Mac OS X, your code doesn’t raise the exception.
That said, I think it’d be more natural to avoid .all’Address (I was told by one of the Ada 95 Distinguished Reviewers that he’d got into the habit of saying .all’Access when what was really needed was an appropriate type conversion). This extension of your code doesn’t raise the exception for either case.
with Ada.Text_IO; use Ada.Text_IO;
with System;
procedure Addreq is
function No (Ignored : Integer) return Boolean is
begin
return False;
end No;
procedure Taking
(Yes_No : access function (N : Integer) return Boolean)
is
use type System.Address;
begin
if Yes_No.all'Address /= No'Address then
raise Program_Error with "using address";
end if;
Put_Line ("using address was OK");
if Yes_No /= No'Access then
raise Program_Error with "using access";
end if;
Put_Line ("using access was OK");
end Taking;
begin
Taking (No'Access);
end Addreq;
(later)
I rewrote this to not use exceptions ...
with Ada.Text_IO; use Ada.Text_IO;
with System;
procedure Addreq is
function No (Ignored : Integer) return Boolean is
begin
return False;
end No;
procedure Taking
(Yes_No : access function (N : Integer) return Boolean)
is
use type System.Address;
begin
Put_Line
((if Yes_No.all'Address /= No'Address
then "using address failed"
else "using address was OK"));
Put_Line
((if Yes_No /= No'Access
then "using access failed"
else "using access was OK"));
end Taking;
begin
Taking (No'Access);
end Addreq;
With GNAT GPL 2014 on Mac OS X, this gives
$ ./addreq
using address failed
using access was OK
If Yes_No.all'Address is not equal to No'Address, then most likely Yes_No.all'Address is the address of some kind of wrapper code.
No is a function nested inside a procedure. If you say No'access, the compiler generally cannot simply create a one-word pointer whose value is the address of No. The reason is that when the code makes an indirect call through the access value, the code has to do something special so that No can access local variables belonging to addreq, which will be somewhere on the stack. For example, one way to provide this access is to pass a static link as a parameter to No; this is an extra pointer that points to addreq's stack frame, which will contain its local variables (or something along those lines). Thus, when an indirect call is made through the access, the caller has to know what the static link is. One solution is to make nested access-to-function types dope vectors, that contain the function address and the static link. Another is to generate wrapper code. The wrapper code is responsible for calling the called subprogram with the static link parameter, and the access value is then simply a one-word pointer, which is the address of the wrapper code. I believe GNAT takes this approach. The advantage is that it makes it possible to pass My_Function'access as a parameter to a C function, for use as a callback. When the C code calls through the function pointer, it calls the wrapper function which then calls the nested function with the correct static link. There is a significant amount of public Ada code that depends on this mechanism. (GtkAda relies heavily on it.)
However, if the access value points to a wrapper, instead of the actual function, then The_Access.all'Address won't return what you think it should. When the code executes The_Access.all'Address, if The_Access is a single word with an address in it, that's all the attribute can return--the address in the pointer.
More: I don't know whether the original code is part of a larger example or just a test to see what the compiler does. But comparing 'Address values to see if a subprogram-access parameter refers to a specific subprogram strikes me a poor design, and comparing 'Access is no better. I would avoid doing that even in C. There's likely to be a more object-oriented solution to the problem (note that you can use tagged types to cause indirect subprogram calls to take place, because tagged type operations are dispatching). E.g.
type Boolean_Function_Object is abstract tagged null record;
function Apply (Obj : Boolean_Function_Object; N : Integer) return boolean;
function Is_Constant_False (Obj : Boolean_Function_Object) return boolean;
type No_Function is new Boolean_Function_Object with null record;
overriding
function Apply (Obj : No_Function; N : Integer) return boolean is (False);
overriding
function Is_Constant_False (Obj : No_Function) return boolean is (True);
procedure Taking (Func : Boolean_Function_Object) is
begin
if not Func.Is_Constant_False then
raise Program_Error;
end if;
end Taking;
Might not be the best design in all cases, but something like this should be considered if there seems to be a need to check a subprogram address to a particular subprogram. For one thing, this is more flexible; a programmer can define another derived type where Apply always return False but does something else, such as writing the argument to a log file.

How to stop execution in my program

Without copy-pasting my code here, how can I stop my ADA program from executing anymore lines of code during run-time if it calculates a certain value to 'X'?
something like:
variable_name := variable_name +4;
if variable_name >1 then
// END program here and dont execute any lines under this one
end if
I am not new to programming but new to ADA so finding the correct syntax is a pain. Any help?
There isn’t any specific syntax for this.
If you are in the main procedure, a simple return will do.
An Ada83-compatible answer is here on SO.
Both those are OK so long as you don’t have any tasks.
There’s an Ada95 Rosetta Code solution, which will work whether you have tasks or not:
with Ada.Task_Identification; use Ada.Task_Identification;
procedure Main is
-- Create as many task objects as your program needs
begin
-- whatever logic is required in your Main procedure
if some_condition then
Abort_Task (Current_Task);
end if;
end Main;
and a GNAT-specific solution, also OK with tasks:
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.OS_Lib;
procedure Stopping is
procedure P is
begin
GNAT.OS_Lib.OS_Exit (0);
end P;
begin
Put_Line ("starting");
P;
Put_Line ("shouldn't have got here");
end Stopping;
if variable_name >1 then
raise PROGRAM_ERROR with "Aborted because ...";
end if;
will do what you ask. Whether that's what you want is another matter, you haven't given us enough context to guess at that.
The "abort" statement might also be usable, but its normal role is terminating tasks within a multi-tasking program.
Raising an exception is probably easiest, and if you don't like the standard ones, you can always declare your own. With an exception you can also do any tidying up (such as closing files if you need to) in your own exception handler. See the Wikibook for more details.

Resources