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;
Related
I am migrating some code from Delphi 5 to a modern platform. Currently I have the compiled code (which works in my environment) and the source code (which cannot be compiled in my environment). This means I can't really experiment with the code by changing it or inserting breakpoints or dumping values. In looking at one particular passage of code, I see that one Procedure (ProcedureA) is calling another (ProcedureB) and passing in parameters that must be by reference, since otherwise ProcedureB would have no effect. It's my understanding that a var prefix must be added to parameters in a Procedure's parameter list in order for them to be passed by reference, but this is not being done here. One of the parameters, though, is of type TList, which I know to be essentially an array of pointers. My question is: are parameters of type TList (as well as others having to do with pointers) implicitly passed by reference?
Here's the code:
Procedure ProcedureB(PartyHeaderInformationPtr : PartyHeaderInformationPointer;
PartyHeaderTable : TTable;
_PrisonCode : String;
_FineType : TFineTypes;
PartyHeaderInformationList : TList);
begin
with PartyHeaderInformationPtr^, PartyHeaderTable do
begin
AssessmentYear := FieldByName('TaxRollYr').Text;
PartyType := FieldByName('PartyType').Text;
PartyNumber := FieldByName('PartyNo').AsInteger;
PrisonCode := _PrisonCode;
FineType := _FineType;
end; {with PartyHeaderInformationPtr^ ...}
PartyHeaderInformationList.Add(PartyHeaderInformationPtr);
end; {AddPartyHeaderPointerInformation}
{=================================================================}
Procedure ProcedureA(PartyHeaderTable : TTable;
PartyDetailTable : TTable;
PartyHeaderInformationList : TList);
var
Done, FirstTimeThrough : Boolean;
PrisonPartyFound, JunglePartyFound : Boolean;
PrisonPartyYear, PrisonCode, PartyType : String;
PartyHeaderInformationPtr : PartyHeaderInformationPointer;
begin
PartyHeaderTable.Last;
PrisonPartyYear := '';
PrisonPartyFound := False;
JunglePartyFound := False;
Done := False;
FirstTimeThrough := True;
repeat
If FirstTimeThrough
then FirstTimeThrough := False
else PartyHeaderTable.Prior;
If PartyHeaderTable.BOF
then Done := True;
If not Done
then
begin
PartyType := PartyHeaderTable.FieldByName('PartyType').Text;
If ((not JunglePartyFound) and
((PartyType = 'MU') or
(PartyType = 'TO')))
then
begin
JunglePartyFound := True;
New(PartyHeaderInformationPtr);
AddPartyHeaderPointerInformation(PartyHeaderInformationPtr,
PartyHeaderTable,
'', ltPlace,
PartyHeaderInformationList);
end; {If ((not JunglePartyFound) and ...}
end; {If not Done}
until Done;
end; {FillPartyHeaderInformationList}
Yes.
In Delphi, classes are reference types.
Every variable of type TBitmap, TList, TButton, TStringList, TForm etc. is nothing but a pointer to the object, so an object is always passed "by reference". It is only this address, this native-sized integer, that is given to the called routine.
Consequently, even without var, the called routine can alter the object since it, like the caller, has the address to it. But the pointer itself is passed by value, so if the called routine alters the parameter pointer to point to a different object, the caller will not see that; only the called routine's copy of the address is changed. With var, the pointer itself is passed by reference, so the called routine can change that too: it can change the original object, and it can make the caller's variable point to a different object, if it wants to.
On the other hand, value types like integers, booleans, sets, static arrays, and records are passed by value, so -- without any parameter decoration such as var -- the called routine gets a copy, and any changes made are only made to that copy. The caller will not see its variable being modified. If you use a var parameter, however, the variable will be passed by reference.
So, in your case, it has nothing to do with TList being a "list" or being something that "contains pointers". It's about TList being a class.
I am new to Ada programming.This is my ADA CODE for a program which gives me a list of things when typed a Football legend name in execution time.But I am getting the following errors.Please help me out:
Some of the Errors found are:
1.Discriminants must have a discrete or Access type
2.components "FBClubs cannot be used before end of record declaration
3.discriminant in a variant part must be of discrete part
4."player" is undefined
5."pos" is undefined.
6.no candidate interpretations match the sctuals : = > in call to inherited operation "to_string" at line "type playernames..."
with Ada.Text_Io; use Ada.Text_Io;
with Ada.Integer_Text_Io; use Ada.Integer_Text_Io;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
Procedure football_record is
type Position is (Goalkeeper,Midfielder,Forward,Defender);
type playernames is new Unbounded_String;
type FBClubs is (ACMilan,Man_United,Aresnal,ParisSt.Germain,Real_Madrid,Liverpool,Chelsea,Man_City,Lille,
Tottenham,Ajax,Juventus,Dortmund,Roma,Santos,Roma,Bayern_Munich,Inter_Milan);
type countries is (England,Argentina,Brazil,France,Italy,Portugal,Spain,Germany,Iran,Japan);
type fbplayer(player:playernames) is
record
WCAppearances:Integer;
pos:Position;
country:countries;
fbclubs:FBClubs;
case player is
when "David Beckham" =>
country:countries:=England;
WCAppearances:Integer:=3;
pos:Position:=Midfielder;
fbclubs:FBClubs:=ACMilan &"+" & Man_United &"+" & Real_Madrid &"+"& ParisSt.Germain;
when "Lionel Messi" =>
country:countries:=Argentina;
WCAppearances:Integer:=1;
pos:Position:=Forward;
fbclubs:FBClubs:=Barcelona;
.....and some other 12 players(legends)..
when others =>
country:countries:=Nil;
WCAppearances:Integer:=Nil;
pos:Position:=Nil;
fbclubs:FBClubs:=Nil;
end case;
end record;
begin
Get(player);
Put_Line(To_String(Integer'Image(player)));
Put_Line(To_String(Integer'Image(FBClubs'Image(fbclubs)));
Put_Line(To_Unbounded_String(Position'Image(pos)));
end football_record;
The biggest problem is that you're mixing code in with a type declaration.
In Ada, putting a case within a record is only for variant records; these are records where some fields exist in certain cases but not others. For example:
type Employee_Type is (Regular, Manager);
type Employee (Emp_Type : Employee_Type) is record
Name : Unbounded_String;
case Emp_Type is
when Manager =>
Managerial_Level : Integer;
when Regular =>
null;
end case;
end record;
This is a variant record; we're assuming here that there are two kinds of employees, and the Managerial_Level field makes sense only for one of those kinds. Records whose type is Regular will not have a Managerial_Level field at all.
This syntax isn't what you would use to return different values of fields. Instead, you need to do this in statements, usually in a procedure or function (or package initialization, or some other places that allow statements).
And since you're not using the variant record syntax, you don't need to make player a discriminant. It doesn't work, anyway; in Ada, a "discriminant" (like Emp_Type in my example) has to be a discrete type like an integer or an enumeration type (Employee_Type is an enumeration type), or an access (access discriminants are an advanced concept). It can't be an Unbounded_String. So you'd want to make player a regular field:
type fbplayer is record
player : Unbounded_String;
pos : Position;
country : countries;
clubs : FBClubs; -- Note name change!
WCAppearances : Integer;
end record;
and create a procedure to fill in the fields:
procedure Fill_In_Player(P : in out fbplayer; Player : Playernames) is
begin
P.Player := Player;
if Player = "David Beckham" then
P.country := England;
P.WCAppearances := 3;
P.pos = Midfielder;
P.clubs := ??? -- see below
elsif Player = "Lionel Messi" then
------- etc.
elsif ------
end if;
end Fill_In_Player;
and then call Fill_In_Player when you have the Player and want to set up the record fields. You have to write statements to do this; you can't do it inside the declaration of a record.
Note that in Ada, case statements can only be used on integer or enumeration types. You can't use them to test for a string, as some other languages allow.
Ada does not treat lower-case and upper-case letters the same in identifiers or keywords. Therefore, fbclubs is the same name as FBClubs, and you can't declare the field
fbclubs : FBClubs;
because of the name conflict. I changed the name.
Finally, it looks like you want FBClubs to hold more than one club. But FBClubs is an enumeration type, and can therefore hold only one value at a time. If you want each player record to contain a list of clubs, you'll need to do something else, such as using one of Ada's container types (like Ada.Containers.Vectors.Vector) or something like
type Set_Of_Clubs is array(FBClubs) of Boolean;
where each array value is true if the player played for that club.
I'm not sure that will take care of all your errors, but it looks like you have a lot of work to do already.
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.)
I have a function that returns a string for a particular item, and I need to call that function numerous times and combine those strings into one. The combined string is bounded. I've made sure to fill it when space characters when it initializes but I keep getting "length check failed" errors. Is there something basic I'm doing wrong here?
FOR I IN 1..Collection.Size LOOP
Combined_String := combined_string & Tostring(Collection.Book(I));
END LOOP;
Unbounded_String is probably the easiest way to go:
with Ada.Strings.Unbounded;
use Ada.Strings.unbounded;
...
Temp_Unbounded_String : Unbounded_String; -- Is empty by default.
...
for I in 1 .. Collection.Size loop
Append(Temp_Unbounded_String, ToString(Collection.Book(I));
end loop;
If you then need to have the result placed in your fixed length standard string:
declare
Temp_String : constant String := To_String(Temp_Unbounded_String);
begin
-- Beware! If the length of the Temp_String is greater than that of the
-- fixed-length string, a Constraint_Error will be raised. Some verification
-- of source and target string lengths must be performed!
Combined_String(Temp_String'Range) := Temp_String;
end;
Alternatively, you can use the Ada.Strings.Fixed Move() procedure to bring the Unbounded_String into the target fixed-length string:
Ada.Strings.Fixed.Move(To_String(Temp_Unbounded_String), Combined_String);
In this case, if the source string is "too long", by default a Length_Error exception is raised. There are other parameters to Move() that can modify the behavior in that situation, see the provided link on Move for more detail.
In order to assign Combined_String, you must assign the full correct length at once. You can't "build up" a string and assign it that way in Ada.
Without seeing the rest of your code, I think Ada.Strings.Unbounded is probably what you should be using.
I know this is an ancient question, but now that Ada 2012 is out I thought I'd share an idiom I've been finding myself using...
declare
function Concatenate(i: Collection'index)
is
(tostring(Collection(i) &
if (i = Collection'last) then
("")
else
(Concatenate(i+1))
);
s: string := Concatenate(Collection'first);
begin
Put_Line(s);
end;
Typed off the top of my head, so it'll be full of typos; and if you want it to work on empty collections you'll need to tweak the logic (should be obvious).
Ada 2012's expression functions are awesome!
Ada works best when you can use perfectly-sized arrays and strings. This works wonderfully for 99% of string uses, but causes problems any time you need to progressively build a string from something else.
Given that, I'd really like to know why you need that combined string.
If you really need it like that, there are two good ways I know of to do it. The first is to use "unbounded" (dynamically-sized) strings from Ada.Strings.Unbounded, as Dave and Marc C suggested.
The other is to use a bit of functional programming (in this case, recursion) to create your fixed string. Eg:
function Combined_String (String_Collection : in String_Collection_Type) return String is
begin
if String_Collection'length = 1 then
return String_Collection(String_Collection'first);
end if;
return String_Collection(String_Collection'first) &
Combined_String (String_Collection'first + 1 .. String_Collection'last);
end Combined_String;
I don't know what type you used for Collection, so I'm making some guesses. In particular, I'm assuming its an unconstrained array of fixed strings. If it's not, you will need to replace some of the above code with whatever your container uses to return its bounds, access elements, and perform slicing.
From AdaPower.com:
function Next_Line(File : in Ada.Text_IO.File_Type :=
Ada.Text_Io.Standard_Input) return String is
Answer : String(1..256);
Last : Natural;
begin
Ada.Text_IO.Get_Line(File => File,
Item => Answer,
Last => Last);
if Last = Answer'Last then
return Answer & Next_Line(File);
else
return Answer(1..Last);
end if;
end Next_Line;
As you can see, this method builds a string (using Get_Line) of unlimited* length from the file it's reading from. So what you'll need to do, in order to keep what you have is something on the order of:
function Combined_String (String_Collection : in String_Collection_Type)
Return String is
begin
if String_Collection'length = 1 then
Return String_Collection(String_Collection'First).All;
end if;
Recursion:
Declare
Data : String:= String_Collection(String_Collection'First).All;
SubType Constraint is Positive Range
Positive'Succ(String_Collection'First)..String_Collection'Last;
Begin
Return Data & Combined_String( String_Collection(Constraint'Range) );
End Recursion;
end Combined_String;
Assuming that String_Collection is defined as:
Type String_Collection is Array (Positive Range <>) of Access String;
*Actually limited by Integer'Range, IIRC
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... ;-)