I want to print the address of an access variable (pointer) for debugging purposes.
type Node is private;
type Node_Ptr is access Node;
procedure foo(n: in out Node_Ptr) is
package Address_Node is new System.Address_To_Access_Conversions(Node);
use Address_Node;
begin
Put_Line("node at address " & System.Address_Image(To_Address(n)));
end foo;
Address_Image returns the string representation of an address.
System.Address_To_Access_Conversions is a generic package to convert between addresses and access types (see ARM 13.7.2), defined as follows:
generic
type Object(<>) is limited private;
package System.Address_To_Access_Conversions is
-- [...]
type Object_Pointer is access all Object;
-- [...]
function To_Address(Value : Object_Pointer) return Address;
-- [...]
end System.Address_To_Access_Conversions;
gnat gives me the following errors for procedure foo defined above:
expected type "System.Address_To_Access_Conversions.Object_Pointer" from instance at line...
found type "Node_Ptr" defined at ...
Object_Pointer ist definied as access all Object. From my understanding the type Object is Node, therefore Object_Ptr is access all Node. What is gnat complaining about?
I guess my understanding of Ada generics is flawed and I am not using System.Address_To_Access_Conversions correctly.
EDIT:
I compiled my code with "gnatmake -gnatG" to see the generic instantiation:
package address_node is
subtype btree__clear__address_node__object__2 is btree__node;
type btree__clear__address_node__object_pointer__2 is access
all btree__clear__address_node__object__2;
function to_address (value :
btree__clear__address_node__object_pointer__2) return
system__address;
end address_node;
btree__node is the mangled name of the type Node as defined above, so I really think the parameter type for to_address() is correct, yet gnat is complaining (see above).
I don't have a compiler in front of me at the moment, but doesn't this work?
procedure foo(n: in out Node_Ptr) is
begin
Put_Line("node at address " & System.Address_Image(n.all'address)); --'
end foo;
Ok, explicit type conversion does the trick:
procedure Foo(n: in out Node_Ptr) is
package Address_Node is new System.Address_To_Access_Conversions(Node);
use Address_Node;
p : Address_Node.Object_Pointer;
begin
p := Address_Node.Object_Pointer(n);
Put_Line("node at address " & System.Address_Image(To_Address(p)));
end Foo;
Takes some time getting used to Ada... ;-)
Related
In my test code below, I am trying to modify a variable by passing it as system.address to another procedure.
with Ada.Text_IO;
with System;
with System.Storage_Elements;
procedure Main is
procedure Modify ( Var : in out System.Address) is
use System.Storage_Elements;
begin
Var := Var + 10;
end Modify;
My_Var : Integer := 10;
begin
-- Insert code here.
Modify (My_Var'Address);
Ada.Text_IO.Put_Line("My_Var is:" & Integer(My_Var)'Image );
end Main;
Compiler is returning an error as below,
17:17 actual for "Var" must be a variable
I could not understand the reason as My_Var(actual for Var) is clearly a variable. What should I change to modify My_Var with system.address?
Note: The context of this trail is that I am trying to understand an interface module in an existing legacy project. While there could be better ways to achieve what I need, I want to understand if it is possible to modify a variable with above method.
It would be helpful if you could show the relevant part of the legacy interface module -- it would help us understand what you need and want to do.
That said, first note that passing a parameter by reference is not usually done in Ada by explicitly passing the 'Address of the actual variable. As you say, there are other and better ways.
If you pass a System.Address value, and then want to read or write whatever data resides at that address, you have to do the read/write through a variable that you force to have that address, or through an access value (the Ada equivalent of "pointer") that you force to point at that addressed location. In both cases, you are responsible for ensuring that the type of the variable, or of the access value, matches the actual type of the data that you want to read or write.
To create an access value that points to memory at a given address, you should use the predefined package System.Address_To_Access_Conversions. That requires some understanding of access values and generics, so I won't show an example here.
To force a variable to have a given address, you declare the variable with the Address aspect set to the given address. The code below shows how that can be done for this example. Note the declaration of the local variable Modify.Var (and note that I changed the name of the parameter from Var to Var_Addr).
with Ada.Text_IO;
with System;
procedure Mod_By_Addr is
procedure Modify (Var_Addr : in System.Address) is
Var : Integer with Address => Var_Addr;
begin
Var := Var + 10;
end Modify;
My_Var : aliased Integer := 10;
begin
Modify (My_Var'Address);
Ada.Text_IO.Put_Line("My_Var is:" & Integer(My_Var)'Image );
end Mod_By_Addr;
Since the Var_Addr parameter is not modified in the Modify procedure, it can be declared with the "in" mode, and so the actual parameter can be an expression (My_Var'Address).
HTH
You modify the address and not the variable. Try to change parameter to Addr : in System.Address and declare Var : Integer with Address => Addr in Modify.
Another way of modifying the variable I have understood using address_to_Access_Conversions is shown below,
with Ada.Text_IO;
with System.Address_To_Access_Conversions;
with System.Storage_Elements;
procedure Main is
procedure Modify ( Var : in System.Address) is
use System.Storage_Elements;
package Convert is new System.Address_To_Access_Conversions (Integer);
begin
Ada.Text_IO.Put_Line(Convert.To_Pointer (Var).all'Img);
end Modify;
My_Var : Integer := 10;
begin
Modify (My_Var'Address);
Ada.Text_IO.Put_Line("My_Var is:" & Integer(My_Var)'Image );
end Main;
I'm kinda new with Ada and recently got an error that I don't seem to know how to solve.
I have the following code:
data.ads
with Text_IO; use text_io;
with ada.Integer_Text_IO; use ada.Integer_Text_IO;
package data is
type file is private;
type file_set is array (Integer range <>) of file;
procedure file_Print (T : in out file); --Not used
private
type file is record
start, deadline : integer;
end record;
end data;
Main.adb
with ada.Integer_Text_IO; use ada.Integer_Text_IO;
procedure Main is
Num_files: integer:=3;
Files:file_set(1..Num_files);
begin
Files(1):=(2,10); -- Expected private type "file" defined at data.ads
for i in 1..Num_Files loop
Put(integer'Image(i));
New_Line;
data.File_Print(Files(i));
But I'm getting this error Expected private type "file" defined at data.ads
How can I access the file type and declare a new array of values in main?
That's right - you don't get to see or manipulate what's inside a private type. That would be breaking encapsulation. Bugs and security risks follow.
You can only interact with a private type via its methods : functions and procedures declared in the package where it's declared.
Now file_set is NOT a private type (you might consider making it private later, for better encapsulation, but for now ....) you can index it to access a file within it (using one of those procedures).
Files(1):=(2,10);
As you want to create a file here, you need a method to create a file ... a bit similar to a constructor in C++, but really more like the Object Factory design pattern. Add this to the package:
function new_file(start, deadline : integer) return file;
And implement it in the package body:
package body data is
function new_file(start, deadline : integer) return file is
begin
-- check these values are valid so we can guarantee a proper file
-- I have NO idea what start, deadline mean, so write your own checks!
-- also there are better ways, using preconditions in Ada-2012
-- without writing explicit checks, but this illustrates the idea
if deadline < NOW or start < 0 then
raise Program_Error;
end if;
return (start => start, deadline => deadline);
end new_file;
procedure file_Print (T : in out file) is ...
end package body;
and that gives the users of your package permission to write
Files(1):= new_file(2,10);
Files(2):= new_file(start => 3, deadline => 15);
but if they attempt to create garbage to exploit your system
Files(3):= new_file(-99,-10); -- Oh no you don't!
this is the ONLY way to create a file, so they can't bypass your checks.
I'm attempting to pass a structure from (x86) assembler to Ada on the stack. I've been able to successfully use this pattern in C to accept to wrap a large number of arguments passed from assembly inside a struct and I'm wondering if this will work in a similar way in Ada.
Here is a (contrived, minimal) example:
When I do this, debugging the callee shows that the passed record contains uninitialised data. It appears that Ada is interpreting the C calling convention differently despite the export directive.
The RM contains information about passing structs from Ada to C, saying that it will automatically pass a record as a pointer type, but the inverse does not appear to be true. If you accept a single access type it will simply be filled with the first value on the stack, as one would expect from cdecl.
( Please excuse any minor errors, this isn't my actual code. )
#####################################################################
# Caller
#
# This pushes the values onto the stack and calls the Ada function
#####################################################################
.global __example_function
.type __example_function, #function
__example_function:
push $1
push $2
push $3
push $4
call accepts_struct
ret
----------------------------------------------------------------------------
-- Accepts_Struct
--
-- Purpose:
-- Attempts to accept arguments pass on the stack as a struct.
----------------------------------------------------------------------------
procedure Accepts_Struct (
Struct : Struct_Passed_On_Stack
)
with Export,
Convention => C,
External_Name => "accepts_struct";
----------------------------------------------------------------------------
-- Ideally the four variables passed on the stack would be accepted as
-- the values of this struct.
----------------------------------------------------------------------------
type Struct_Passed_On_Stack is
record
A : Unsigned_32;
B : Unsigned_32;
C : Unsigned_32;
D : Unsigned_32;
end record
with Convention => C;
On the other hand, this works just fine:
procedure Accepts_Struct (
A : Unsigned_32;
B : Unsigned_32;
C : Unsigned_32;
D : Unsigned_32
)
with Export,
Convention => C,
External_Name => "accepts_struct";
That's not a big deal in this minimal case, but if I'm passing 16 or more variables it gets a bit onerous. If you're wondering why I'm doing this, it's an exception handler where the processor automatically passes variables onto the stack to show register states.
Any help here would be greatly appreciated.
The record version does not work because a record is not stored on the stack. Instead 4 Unsigned_32 elements are stored on the stack. If you really want to work with a record instead of four separate unsigned integer values you can assign the four values to the members of your record within the call to "accepts_struct".
Ada expects the first entry in the stack to be a record, not an unsigned_32.
The Ada LRM, section 6.4.1 states:
For the evaluation of a parameter_association: The actual parameter is
first evaluated. For an access parameter, the access_definition is
elaborated, which creates the anonymous access type. For a parameter
(of any mode) that is passed by reference (see 6.2), a view conversion
of the actual parameter to the nominal subtype of the formal parameter
is evaluated, and the formal parameter denotes that conversion. For an
in or in out parameter that is passed by copy (see 6.2), the formal
parameter object is created, and the value of the actual parameter is
converted to the nominal subtype of the formal parameter and assigned
to the formal.
Furthermore, the passing mode for parameters is described in section 6.2:
6.2 Formal Parameter Modes
A parameter_specification declares a formal parameter of mode in, in
out, or out. Static Semantics
A parameter is passed either by copy or by reference. When a parameter
is passed by copy, the formal parameter denotes a separate object from
the actual parameter, and any information transfer between the two
occurs only before and after executing the subprogram. When a
parameter is passed by reference, the formal parameter denotes (a view
of) the object denoted by the actual parameter; reads and updates of
the formal parameter directly reference the actual parameter object.
A type is a by-copy type if it is an elementary type, or if it is a
descendant of a private type whose full type is a by-copy type. A
parameter of a by-copy type is passed by copy, unless the formal
parameter is explicitly aliased.
A type is a by-reference type if it is a descendant of one of the
following:
a tagged type;
a task or protected type;
an explicitly limited record type;
a composite type with a subcomponent of a by-reference type;
a private type whose full type is a by-reference type.
A parameter of a by-reference type is passed by reference, as is an
explicitly aliased parameter of any type. Each value of a by-reference
type has an associated object. For a parenthesized expression,
qualified_expression, or type_conversion, this object is the one
associated with the operand. For a conditional_expression, this object
is the one associated with the evaluated dependent_expression.
For other parameters, it is unspecified whether the parameter is
passed by copy or by reference.
It appears that your compiler is trying to pass the struct by reference rather than by copy. In C all parameters are passed by copy.
Maybe you already solved the problem, but if not, then you might also want to have at look at the interrupt function attribute provided by GCC (see here). I've translated a test of the GCC testsuite which pushes values to the stack (as described in section 6.12 of the Intel SDM) and reads them back in an ISR. The translated Ada version seems to work well. See here for the original C version. See the GCC ChangeLog for some additional info.
main.adb
with PR68037_1;
procedure Main is
begin
PR68037_1.Run;
end Main;
pr68037_1.ads
package PR68037_1 is
procedure Run;
end PR68037_1;
pr68037_1.adb
with System.Machine_Code;
with Ada.Assertions;
with Interfaces.C;
with GNAT.OS_Lib;
package body PR68037_1 is
-- Ada-like re-implementation of
-- gcc/testsuite/gcc.dg/guality/pr68037-1.c
subtype uword_t is Interfaces.C.unsigned_long; -- for x86-64
ERROR : constant uword_t := 16#1234567_0#;
IP : constant uword_t := 16#1234567_1#;
CS : constant uword_t := 16#1234567_2#;
FLAGS : constant uword_t := 16#1234567_3#;
SP : constant uword_t := 16#1234567_4#;
SS : constant uword_t := 16#1234567_5#;
type interrupt_frame is
record
ip : uword_t;
cs : uword_t;
flags : uword_t;
sp : uword_t;
ss : uword_t;
end record
with Convention => C;
procedure fn (frame : interrupt_frame; error : uword_t)
with Export, Convention => C, Link_Name => "__fn";
pragma Machine_Attribute (fn, "interrupt");
--------
-- fn --
--------
procedure fn (frame : interrupt_frame; error : uword_t) is
use Ada.Assertions;
use type uword_t;
begin
-- Using the assertion function here. In general, be careful when
-- calling subprograms from an ISR. For now it's OK as we will not
-- return from the ISR and not continue the execution of an interrupted
-- program.
Assert (frame.ip = IP , "Mismatch IP");
Assert (frame.cs = CS , "Mismatch CS");
Assert (frame.flags = FLAGS, "Mismatch FLAGS");
Assert (frame.sp = SP , "Mismatch SP");
Assert (frame.ss = SS , "Mismatch SS");
-- At the end of this function IRET will be executed. This will
-- result in a segmentation fault as the value for EIP is nonsense.
-- Hence, abort the program before IRET is executed.
GNAT.OS_Lib.OS_Exit (0);
end fn;
---------
-- Run --
---------
procedure Run is
use System.Machine_Code;
use ASCII;
begin
-- Mimic the processor behavior when an ISR is invoked. See also:
--
-- Intel (R) 64 and IA-32 Architectures / Software Developer's Manual
-- Volume 3 (3A, 3B, 3C & 3D) : System Programming Guide
-- Section 6.12: Exception and Interrupt Handling
--
-- Push the data to the stack and jump unconditionally to the
-- interrupt service routine.
Asm
(Template =>
"push %0" & LF &
"push %1" & LF &
"push %2" & LF &
"push %3" & LF &
"push %4" & LF &
"push %5" & LF &
"jmp __fn",
Inputs =>
(uword_t'Asm_Input ("l", SS),
uword_t'Asm_Input ("l", SP),
uword_t'Asm_Input ("l", FLAGS),
uword_t'Asm_Input ("l", CS),
uword_t'Asm_Input ("l", IP),
uword_t'Asm_Input ("l", ERROR)),
Volatile => True);
end Run;
end PR68037_1;
I compiled the program in GNAT CE 2019 with compiler options -g -mgeneral-regs-only (copied from the GCC test). Note that the parameter interrupt_frame will be passed by reference (see RM B.3 69/2).
I have some methods in a package that operate on an access constant tot a tagged record; in order to call these functions, I must specify the package name. I would much rather just put the variable name [dot] function name, but this gives the error: no selector "foo" for type "Color". Why is that?
Here's a minimal reproducer:
procedure Main is
type Color is tagged
record
Hue : Integer;
Saturation : Integer;
Value : Integer;
end record;
type AccessColor is access constant Color;
procedure foo (C : in AccessColor) is
begin
null;
end foo;
AccessS : AccessColor;
begin
foo (AccessS);
--AccessS.foo; -- does not work. Why?
end Main;
Note that in my real code, it is inconvenient to specify the function fully, because unlike in the example above, foo is defined somewhere in a seperate package:
Some.Package.Name.Depp.foo(AccessS);
Even though AccessS already specifies where to find the function, so I should just be able to do:
AccessS.foo;
The problem is that foo isn’t actually a primitive operation of Color (in this reproducer).
ARM 3.3.2(6) says that the primitive subprograms of a specific type are
For a specific type declared immediately within a package_specification, any subprograms (in addition to the enumeration literals) that are explicitly declared immediately within the same package_specification and that operate on the type
This (apologies for reformatting, casing adjustment) compiles fine.
procedure Main is
package Pak is
type Color is tagged
record
Hue : Integer;
Saturation : Integer;
Value : Integer;
end record;
procedure Foo (C : in Color) is null;
type AccessColor is access constant Color;
end Pak;
Col : aliased Pak.Color;
AccessS : Pak.AccessColor := Col'Access;
begin
AccessS.Foo;
end Main;
I declared Foo as taking in Color; you could equally declare it to take access constant Color if you need to, because (ARM 4.1.3(9.2))
The first formal parameter of the subprogram shall be of type T, or a class-wide type that covers T, or an access parameter designating one of these types
This doesn't work because as you define it, foo is not a primitive operation of the tagged type Color. Prefix notation can only be used on primitive operations of tagged types.
The solution is to make foo a primitive operation of Color like this:
procedure foo (C : access constant Color) is
begin
null;
end foo;
If you use a named access type, foo will instead be a primitive operation of that type, and since that type is not a tagged type, prefix notation doesn't work.
I am attempting to understand how to fix this circular dependency. All the examples I can find online suggest using a limited with, but then they demonstrate the use with two basic types, whereas this is a bit more advanced. The circular dependency is between the two files below. I thought it was between package Chessboard ... and the Piece type, but now I am not so sure. Attempting to put the package Chessboard ... line within chess_types.ads after the Piece type is declared and removing the use and with of Chessboard results in an error: this primitive operation is declared too late for the Move procedure. I am stuck on how to get out of this dependency. Any help would be much appreciated!
Thank you
chessboard.ads:
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
with Chess_Types;
use Chess_Types;
package Chessboard is new Indefinite_Vectors(Board_Index, Piece'Class);
chess_types.ads:
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
with Chessboard;
use Chessboard;
package Chess_Types is
subtype Board_Index is Integer range 1 .. 64;
type Color is (Black, White);
type Piece is tagged
record
Name : String (1 .. 3) := " ";
Alive : Boolean := False;
Team : Color;
Coordinate : Integer;
end record;
procedure Move_Piece(Board: in Vector; P: in Piece; Move_To: in Integer);
end Chess_Types;
More Code for question in comments:
Chess_Types.Piece_Types.ads:
package Chess_Types.Piece_Types is
type Pawn is new Piece with
record
First_Move : Boolean := True;
end record;
overriding
procedure Move_Piece(Board: in CB_Vector'Class; Po: in Pawn; Move_To: in Board_Index);
-- Other piece types declared here
end Chess_Types.Piece_Types;
Chess_Types.Piece_Types.adb:
with Ada.Text_IO;
use Ada.Text_IO;
package body Chess_Types.Piece_Types is
procedure Move_Piece(Board: in CB_Vector'Class; Po: in Pawn; Move_To: in Board_Index) is
Index_From, Index_To : Board_Index;
Move_From : Board_Index := Po.Coordinate;
begin
-- Obtain locations of Pawn to move from (Index_From) and to (Index_To)
-- in terms of the single dimension vector
for I in Board.First_Index .. Board.Last_Index loop
if Board.Element(I).Coordinate = Move_From then
Index_From := I;
end if;
if Board.Element(I).Coordinate = Move_To then
Index_To := I;
end if;
end loop;
-- Determine if the requested move is legal, and if so, do the move.
-- More possibilties to be entered, very primitive for simple checking.
if Move_To - Move_From = 2 and then Po.First_Move = True then
Board.Swap(I => Index_From, J => Index_To); -- "actual for "Container" must be a variable"
Board.Element(Index_From).First_Move := False; -- "no selector for "First_Move" for type "Piece'Class"
elsif Move_To - Po.Coordinate = 1 then
Board.Swap(Index_From, Index_To); -- "actual for "Container" must be a variable"
end if;
-- Test to make sure we are in the right Move_Piece procedure
Put_Line("1");
end Move_Piece;
-- Other piece type move_piece procedures defined here
end Chess_types.Piece_Types;
As a note to understand further, the Coordinate component of each piece correspond to ICCF numeric notation, which is two digits, so there needs to be some type of conversion between the vector and the ICCF notation, hence the reason for the whole for loop at the start.
This is a tough one. It looks like limited with and generics don't play nice together. The only way to make it work is to go back to using your own access type:
with Ada.Containers.Vectors;
use Ada.Containers;
limited with Chess_Types;
use Chess_Types;
package Chessboard_Package is
subtype Board_Index is Integer range 1 .. 64;
type Piece_Acc is access all Piece'Class;
package Chessboard is new Vectors(Board_Index, Piece_Acc);
end Chessboard_Package;
I had to put the instantiation into a new package, and move the Board_Index there too. Also, I changed it to Vectors since Piece_Acc is a definite type and there's no point in using Indefinite_Vectors. But in any event, this defeats the purpose. I'm just not sure Ada gives you a way to do what you want with two packages like this.
Even doing it in one package is not easy:
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
package Chess_Types is
subtype Board_Index is Integer range 1 .. 64;
type Color is (Black, White);
type Piece is tagged record ... end record;
type CB_Vector is tagged;
procedure Move_Piece (Board : in CB_Vector'Class;
P : in Piece;
Move_To : in Board_Index);
package Chessboard is new Indefinite_Vectors(Board_Index, Piece'Class);
type CB_Vector is new Chessboard.Vector with null record;
end Chess_Types;
This compiles, but I had to add extra stuff to get around some of the language rules (in particular, when you instantiate a generic, that "freezes" all prior tagged types so that you can no longer declare a new primitive operation of the type); also, I had to make the Board parameter a classwide type to avoid running into the rule about primitive operations of multiple tagged types.
As I understand it, this will do what you want.
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
package Chess_Types is
subtype Board_Index is Integer range 1 .. 64;
type Color is (Black, White);
type Piece is abstract tagged
record
Name : String (1 .. 3) := " ";
Alive : Boolean := False;
Team : Color;
Coordinate : Board_Index;
end record;
type Piece_Ptr is access all Piece'Class;
package Chessboard is new Indefinite_Vectors(Board_Index, Piece_Ptr);
procedure Move_Piece (Board : in Chessboard.Vector;
P : in Piece'Class;
Move_To : in Board_Index) is abstract;
end Chess_Types;
NOTES:
Piece is now abstract, as is the Move_Piece method. This will mean you now need to derive your other piece types (package piece_type-rook.ads, with a move_piece method for rook) etc...
Chessboard now contains pointers (Class wide pointers), beware allocating, deallocating, deep copy, shallow copy issues when using it.
You should now be able to call Move_Piece on any dereference of a piece_ptr and have it dispatch to the correct method.
The Move_To parameter is now the same type as the Board_Index. (Coordinate also brought in line) -- this seems a bit clunky, perhaps rethink this. (Row & Column Indices defining a 2D array perhaps? --No need for Indefinite_Vectors)
To answer the second question in the comment:
To use First_Move, the procedure has to know that it's a Pawn. If the object is declared with type Piece'Class, you can't access components that are defined only for one of the derived types. (That's true in most OO languages.) This may indicate a flaw in your design; if you have a procedure that takes a Piece'Class as a parameter, but you want to do something that makes sense only for a Pawn, then maybe you should add another operation to your Piece that does a default action for most pieces (perhaps it does nothing) and then override it for Pawn. Other possibilities are to use a type conversion:
procedure Something (P : Piece'Class) is ...
if Pawn(P).First_Move then ...
which will raise an exception if P isn't a Pawn. If you want to test first, you can say "if P in Pawn". I sometimes write code like:
if P in Pawn then
declare
P_Pawn : Pawn renames Pawn(P);
begin
if P_Pawn.First_Move then ...
end;
end if;
But defining a new polymorphic operation is preferable. (Note: I haven't tested the above code, hope I didn't make a syntax error somewhere.)