public inbox for gcc-prs@sourceware.org
help / color / mirror / Atom feed
* ada/8614: Assert_Failure exp_util.adb:1404
@ 2002-11-22 12:46 sigra
0 siblings, 0 replies; 2+ messages in thread
From: sigra @ 2002-11-22 12:46 UTC (permalink / raw)
To: gcc-gnats
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 81426 bytes --]
>Number: 8614
>Category: ada
>Synopsis: Assert_Failure exp_util.adb:1404
>Confidential: no
>Severity: critical
>Priority: medium
>Responsible: unassigned
>State: open
>Class: sw-bug
>Submitter-Id: net
>Arrival-Date: Sun Nov 17 09:46:01 PST 2002
>Closed-Date:
>Last-Modified:
>Originator: sigra@home.se
>Release: 3.2
>Organization:
>Environment:
i686-pc-linux-gnu with adasockets-1.4
>Description:
gnatmake -gnatafnN -gnatVa -gnatwa -gnaty agent_client `adasockets-config`
gcc -c -gnatafnN -gnatVa -gnatwa -gnaty -I/usr/local/lib/adasockets agent_client.adb
+===========================GNAT BUG DETECTED==============================+
| 3.2 20020814 (release) (i686-pc-linux-gnu) Assert_Failure exp_util.adb:1404|
| Error detected at agent_client.adb:140:50 |
| Please submit a bug report, see http://gcc.gnu.org/bugs.html. |
| Include the entire contents of this bug box in the report. |
| Include the exact gcc or gnatmake command that you entered. |
| Also include sources listed below in gnatchop format |
| (concatenated together with no headers between files). |
+==========================================================================+
Please include these source files with error report
agent_client.adb
agent.ads
agents.ads
coordinates.ads
symbols.ads
client_network.ads
/usr/local/lib/adasockets/sockets.ads
/usr/local/lib/adasockets/sockets-stream_io.ads
agent.adb
/usr/local/lib/gcc-lib/i686-pc-linux-gnu/3.2/adainclude/s-assert.ads
list may be incomplete
agent.adb:8:04: warning: body is too large for front-end inlining of "Get_Action"
agent.adb:158:04: warning: body is too large for front-end inlining of "Inform_About_Rules"
agent.adb:289:04: warning: unconstrained return type prevents front-end inlining of "To_String"
agent.adb:371:07: warning: declaration prevents front-end inlining of "Explore"
agent.adb:549:04: warning: body is too large for front-end inlining of "Extend"
i-cstrea.adb:94:07: warning: declaration prevents front-end inlining of "fread"
compilation abandoned
gnatmake: "agent_client.adb" compilation error
>How-To-Repeat:
>Fix:
>Release-Note:
>Audit-Trail:
>Unformatted:
----gnatsweb-attachment----
Content-Type: text/plain; name="gnatbug"
Content-Disposition: inline; filename="gnatbug"
with Agent; use Agent;
with Coordinates; use Coordinates;
with Agents; use Agents;
with Client_Network; use Client_Network;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Streams; use Ada.Streams;
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
with Sockets.Stream_IO; use Sockets, Sockets.Stream_IO;
with Ada.Unchecked_Conversion;
procedure Agent_Client is
type Boolean_Aggregate is array (0 .. 7) of Boolean;
for Boolean_Aggregate'Component_Size use 1;
function Get
(Stream : access Root_Stream_Type'Class) return Boolean_Aggregate;
function Get
(Stream : access Root_Stream_Type'Class) return Boolean_Aggregate is
function Convert is new Ada.Unchecked_Conversion
(Character, Boolean_Aggregate);
Item : Character;
begin
Character'Read (Stream, Item);
return Convert (Item);
end Get;
function Get
(Stream : access Root_Stream_Type'Class) return Location_Count;
function Get
(Stream : access Root_Stream_Type'Class) return Location_Count is
function Convert is new Ada.Unchecked_Conversion
(Size_16, Location_Count);
Item : Size_16;
begin
Size_16'Read (Stream, Item);
return Convert (Item);
end Get;
function Get
(Stream : access Root_Stream_Type'Class) return Ammunition_Count;
function Get
(Stream : access Root_Stream_Type'Class) return Ammunition_Count is
function Convert is new Ada.Unchecked_Conversion
(Size_16, Ammunition_Count);
Item : Size_16;
begin
Size_16'Read (Stream, Item);
return Convert (Item);
end Get;
function Get
(Stream : access Root_Stream_Type'Class) return Cost;
function Get
(Stream : access Root_Stream_Type'Class) return Cost is
function Convert is new Ada.Unchecked_Conversion (Size_16, Cost);
Item : Size_16;
begin
Size_16'Read (Stream, Item);
return Convert (Item);
end Get;
function Get
(Stream : access Root_Stream_Type'Class) return Cost_Sum;
function Get
(Stream : access Root_Stream_Type'Class) return Cost_Sum is
function Convert is new Ada.Unchecked_Conversion (Size_32, Cost_Sum);
Item : Size_32;
begin
Size_32'Read (Stream, Item);
return Convert (Item);
end Get;
function Get
(Stream : access Root_Stream_Type'Class) return Reward;
function Get
(Stream : access Root_Stream_Type'Class) return Reward is
function Convert is new Ada.Unchecked_Conversion (Size_16, Reward);
Item : Size_16;
begin
Size_16'Read (Stream, Item);
return Convert (Item);
end Get;
function Get
(Stream : access Root_Stream_Type'Class) return Cardinal_Distance;
function Get
(Stream : access Root_Stream_Type'Class) return Cardinal_Distance is
function Convert is new Ada.Unchecked_Conversion
(Character, Cardinal_Distance);
Item : Character;
begin
Character'Read (Stream, Item);
return Convert (Item);
end Get;
procedure Write
(Stream : access Root_Stream_Type'Class; Item : in Action);
procedure Write
(Stream : access Root_Stream_Type'Class; Item : in Action) is
function Convert is new Ada.Unchecked_Conversion (Action, Character);
begin
Character'Write (Stream, Convert (Item));
end Write;
Current_Byte : Boolean_Aggregate;
begin
Put_Line ("Boolean_Aggregate'Size = " & Boolean_Aggregate'Size'Img);
Put_Line ("Cardinal_Distance'Size = " & Cardinal_Distance'Size'Img);
if Argument_Count /= 2 then
Raise_Exception
(Constraint_Error'Identity,
"Usage: " & Command_Name & " remotehost remoteport");
end if;
Socket (The_Socket, AF_INET, SOCK_STREAM);
Set_Buffer (The_Socket);
Connect (The_Socket, Argument (1), Positive'Value (Argument (2)));
Initialize (The_Stream, The_Socket);
-- Send information about this client. Bit 7 requests LittleEndian.
Character'Write (The_Stream'Access, Character'Val (2**7));
-- The main loop. Each iteration is a simulation.
loop
declare
The_Agent : State;
The_Rules : Rules;
The_Agent_Accepts_The_Rules : Boolean := True;
begin
-- Read the rules.
Current_Byte := Get (The_Stream'Access); -- byte 0
The_Rules.Lower_X_Bound_Is_Known := Current_Byte (0);
The_Rules.Upper_X_Bound_Is_Known := Current_Byte (1);
The_Rules.Lower_Y_Bound_Is_Known := Current_Byte (2);
The_Rules.Upper_Y_Bound_Is_Known := Current_Byte (3);
The_Rules.Number_Of_Homes_Is_Known := Current_Byte (4);
The_Rules.Number_Of_Items_Is_Known := Current_Byte (5);
The_Rules.Number_Of_Enemies_Is_Known := Current_Byte (6);
The_Rules.Number_Of_Dangers_Is_Known := Current_Byte (7);
Put_Line
("Lower_X_Bound_Is_Known = " &
The_Rules.Lower_X_Bound_Is_Known'Img);
Put_Line
("Upper_X_Bound_Is_Known = " &
The_Rules.Upper_X_Bound_Is_Known'Img);
Put_Line
("Lower_Y_Bound_Is_Known = " &
The_Rules.Lower_Y_Bound_Is_Known'Img);
Put_Line
("Upper_Y_Bound_Is_Known = " &
The_Rules.Upper_Y_Bound_Is_Known'Img);
Put_Line
("Number_Of_Homes_Is_Known = " &
The_Rules.Number_Of_Homes_Is_Known'Img);
Put_Line
("Number_Of_Items_Is_Known = " &
The_Rules.Number_Of_Items_Is_Known'Img);
Put_Line
("Number_Of_Enemies_Is_Known = " &
The_Rules.Number_Of_Enemies_Is_Known'Img);
Put_Line
("Number_Of_Dangers_Is_Known = " &
The_Rules.Number_Of_Dangers_Is_Known'Img);
Current_Byte := Get (The_Stream'Access); -- byte 0
if Current_Byte (0) then -- parallell with the y-axis
if Current_Byte (1) then The_Rules.Initial_Direction := 3;
else The_Rules.Initial_Direction := 1;
end if;
else -- parallell with the x-axis
if Current_Byte (1) then The_Rules.Initial_Direction := 2;
else The_Rules.Initial_Direction := 0;
end if;
end if;
The_Rules.Ammunition_Is_Limited := Current_Byte (2);
The_Rules.Cost_Is_Limited := Current_Byte (3);
The_Rules.Score_Is_Limited := Current_Byte (4);
The_Rules.Can_Recharge_Ammunition_At_Home := Current_Byte (5);
The_Rules.Neutralized_Enemy_Becomes_Item := Current_Byte (6);
The_Rules.Neutralization_Stops_At_First_Enemy := Current_Byte (7);
Put_Line
("Initial_Direction = " & The_Rules.Initial_Direction'Img);
Put_Line
("Ammunition_Is_Limited = " & The_Rules.Ammunition_Is_Limited'Img);
Put_Line
("Cost_Is_Limited = " & The_Rules.Cost_Is_Limited'Img);
Put_Line
("Score_Is_Limited = " & The_Rules.Score_Is_Limited'Img);
Put_Line
("Can_Recharge_Ammunition_At_Home = " &
The_Rules.Can_Recharge_Ammunition_At_Home'Img);
Put_Line
("Neutralized_Enemy_Becomes_Item = " &
The_Rules.Neutralized_Enemy_Becomes_Item'Img);
Put_Line
("Neutralization_Stops_At_First_Enemy = " &
The_Rules.Neutralization_Stops_At_First_Enemy'Img);
The_Rules.Neutralization_Range := Get (The_Stream'Access); -- byte 2
if
The_Rules.Neutralization_Range = 1 and
not The_Rules.Neutralization_Stops_At_First_Enemy
then
Put_Line
(Standard_Error,
"Neutralization_Range is 1 but " &
"Neutralization_Stops_At_First_Enemy is false. This " &
"indicates an error in the simulator or a corrupted transfer.");
end if;
Put_Line
("Neutralization_Range = " & The_Rules.Neutralization_Range'Img);
The_Rules.Move_Cost :=
Get (The_Stream'Access); -- byte 3 .. 4
Put_Line ("Move_Cost = " & The_Rules.Move_Cost'Img);
The_Rules.Turn_Left_Cost :=
Get (The_Stream'Access); -- byte 5 .. 6
Put_Line ("Turn_Left_Cost = " & The_Rules.Turn_Left_Cost'Img);
The_Rules.Turn_Right_Cost :=
Get (The_Stream'Access); -- byte 7 .. 8
Put_Line ("Turn_Right_Cost = " & The_Rules.Turn_Right_Cost'Img);
The_Rules.Grab_Cost :=
Get (The_Stream'Access); -- byte 9 .. 10
Put_Line ("Grab_Cost = " & The_Rules.Grab_Cost'Img);
The_Rules.Neutralize_Cost :=
Get (The_Stream'Access); -- byte 11 .. 12
Put_Line ("Neutralize_Cost = " & The_Rules.Neutralize_Cost'Img);
The_Rules.Item_Reward :=
Get (The_Stream'Access); -- byte 13 .. 14
Put_Line ("Item_Reward = " & The_Rules.Item_Reward'Img);
The_Rules.Neutralize_Reward
:= Get (The_Stream'Access); -- byte 15 .. 16
Put_Line ("Neutralize_Reward = " & The_Rules.Neutralize_Reward'Img);
The_Rules.Home_Reward
:= Get (The_Stream'Access); -- byte 17 .. 18
Put_Line ("Home_Reward = " & The_Rules.Home_Reward'Img);
The_Rules.Initial_Cost
:= Get (The_Stream'Access); -- byte 19 .. 22
Put_Line ("Initial_Cost = " & The_Rules.Initial_Cost'Img);
Score'Read
(The_Stream'Access, The_Rules.Initial_Score); -- byte 23 .. 26
Put_Line ("Initial_Score = " & The_Rules.Initial_Score'Img);
if The_Rules.Lower_X_Bound_Is_Known then -- 1 byte
Negative_X_Coordinate'Read
(The_Stream'Access, The_Rules.Lower_X_Bound);
Put_Line ("Lower_X_Bound = " & The_Rules.Lower_X_Bound'Img);
end if;
if The_Rules.Upper_X_Bound_Is_Known then -- 1 byte
Positive_X_Coordinate'Read
(The_Stream'Access, The_Rules.Upper_X_Bound);
Put_Line ("Upper_X_Bound = " & The_Rules.Upper_X_Bound'Img);
end if;
if The_Rules.Lower_Y_Bound_Is_Known then -- 1 byte
Negative_Y_Coordinate'Read
(The_Stream'Access, The_Rules.Lower_Y_Bound);
Put_Line ("Lower_Y_Bound = " & The_Rules.Lower_Y_Bound'Img);
end if;
if The_Rules.Upper_Y_Bound_Is_Known then -- 1 byte
Positive_Y_Coordinate'Read
(The_Stream'Access, The_Rules.Upper_Y_Bound);
Put_Line ("Upper_Y_Bound = " & The_Rules.Upper_Y_Bound'Img);
end if;
if The_Rules.Number_Of_Homes_Is_Known then -- 2 bytes
The_Rules.Number_Of_Homes := Get (The_Stream'Access);
Put_Line ("Number_Of_Homes = " & The_Rules.Number_Of_Homes'Img);
end if;
if The_Rules.Number_Of_Items_Is_Known then -- 2 bytes
The_Rules.Number_Of_Items := Get (The_Stream'Access);
Put_Line ("Number_Of_Items = " & The_Rules.Number_Of_Items'Img);
end if;
if The_Rules.Number_Of_Enemies_Is_Known then -- 2 bytes
The_Rules.Number_Of_Enemies := Get (The_Stream'Access);
Put_Line
("Number_Of_Enemies = " & The_Rules.Number_Of_Enemies'Img);
end if;
if The_Rules.Number_Of_Dangers_Is_Known then -- 2 bytes
The_Rules.Number_Of_Dangers := Get (The_Stream'Access);
Put_Line
("Number_Of_Dangers = " & The_Rules.Number_Of_Dangers'Img);
end if;
if The_Rules.Ammunition_Is_Limited then -- 4 bytes
The_Rules.Ammunition_Limit := Get (The_Stream'Access);
Put_Line ("Ammunition_Limit = " & The_Rules.Ammunition_Limit'Img);
The_Rules.Initial_Ammunition := Get (The_Stream'Access);
Put_Line
("Initial_Ammunition = " & The_Rules.Initial_Ammunition'Img);
end if;
if The_Rules.Cost_Is_Limited then -- 4 bytes
The_Rules.Cost_Limit := Get (The_Stream'Access);
Put_Line ("Cost_Limit = " & The_Rules.Cost_Limit'Img);
end if;
if The_Rules.Score_Is_Limited then -- 4 bytes
Score'Read (The_Stream'Access, The_Rules.Score_Limit);
Put_Line ("Score_Limit = " & The_Rules.Score_Limit'Img);
end if;
-- Read the first percept.
Put ("Reading first percept...");
Current_Byte := Get (The_Stream'Access);
Put_Line ("OK");
begin
Inform_About_Rules
(The_Agent, The_Rules,
First_Percept_Includes_Home => Current_Byte (0),
First_Percept_Includes_Item => Current_Byte (1),
First_Percept_Includes_Hostility => Current_Byte (2),
First_Percept_Includes_Fear => Current_Byte (4));
exception
when Event : others =>
Notify (Exception_Name (Event));
Notify (Exception_Message (Event));
Put_Line (Exception_Information (Event));
The_Agent_Accepts_The_Rules := False;
end;
Receive_Info_About_Tiles :
loop
declare
Tileinfo : Boolean_Aggregate;
X : X_Coordinate;
Y : Y_Coordinate;
begin
Put_Line ("Waiting for info about tile.");
Tileinfo := Get (The_Stream'Access);
Put ("Receiving info about a tile: ");
for I in Boolean_Aggregate'Range loop
Put (Tileinfo (I)'Img & ' ');
end loop;
New_Line;
if Tileinfo =
(False, False, False, False, False, False, False, False) then
exit Receive_Info_About_Tiles;
end if;
X_Coordinate'Read (The_Stream'Access, X);
Y_Coordinate'Read (The_Stream'Access, Y);
Put_Line ("received tile (" & X'Img & ", " & Y'Img & ")");
if The_Agent_Accepts_The_Rules then
begin
if Tileinfo (1) then
if Tileinfo (2) then
Inform_About_A_Clear_Tile
(The_Agent, The_Rules, X, Y,
Has_Home => Tileinfo (3),
Has_Item => Tileinfo (4),
Has_Percept_Hostility => Tileinfo (5),
Has_Percept_Fear => Tileinfo (6));
else
Inform_About_A_Clear_Tile_With_Enemy
(The_Agent, The_Rules, X, Y,
Has_Home => Tileinfo (3),
Has_Item => Tileinfo (4));
end if;
else
if Tileinfo (2) then
Inform_About_A_Wall_Tile
(The_Agent, The_Rules, X, Y);
else
Inform_About_A_Danger_Tile
(The_Agent, The_Rules, X, Y,
Has_Enemy => Tileinfo (3));
end if;
end if;
exception
when Event : others =>
Notify (Exception_Name (Event));
Notify (Exception_Message (Event));
Put_Line (Exception_Information (Event));
-- An exception occured in Inform_About_A_Clear_Tile,
-- Inform_About_A_Clear_Tile_With_Enemy,
-- Inform_About_A_Wall_Tile or
-- Inform_About_A_Danger_Tile in the agent.
The_Agent_Accepts_The_Rules := False;
end;
end if;
end;
end loop Receive_Info_About_Tiles;
if The_Agent_Accepts_The_Rules then
loop -- The percept<=>action cycle.
for I in Boolean_Aggregate'Range loop
Put (Current_Byte (I)'Img & ' ');
end loop;
New_Line;
if Current_Byte (7) then
declare
Final_Score : Score;
begin
Put ("Reading score...");
Score'Read (The_Stream'Access, Final_Score);
Put_Line ("OK");
Inform_About_Score
(The_Agent, The_Rules, Final_Score);
exception
when Event : others =>
Notify (Exception_Name (Event));
Notify (Exception_Message (Event));
Put_Line (Exception_Information (Event));
end;
exit;
end if;
declare
Current_Action : Action;
begin
Get_Action
(The_Agent, The_Rules, Current_Action,
Home => Current_Byte (0),
Item => Current_Byte (1),
Hostility => Current_Byte (2),
Bump => Current_Byte (3),
Fear => Current_Byte (4),
Enemy_Neutralized => Current_Byte (5));
Write (The_Stream'Access, Current_Action);
exception
when Event : others =>
Notify (Exception_Name (Event));
Notify (Exception_Message (Event));
Put_Line (Exception_Information (Event));
Write (The_Stream'Access, Shut_Off);
-- The server will send another percept (1 byte) and then
-- the score (4 byte). Eat it.
Current_Byte := Get (The_Stream'Access);
Current_Byte := Get (The_Stream'Access);
Current_Byte := Get (The_Stream'Access);
Current_Byte := Get (The_Stream'Access);
Current_Byte := Get (The_Stream'Access);
exit;
end;
Put ("Reading percept...");
Current_Byte := Get (The_Stream'Access);
Put_Line ("OK");
end loop;
else
Write (The_Stream'Access, Shut_Off);
-- The server will send another percept (1 byte) and then the
-- score (4 byte). Eat it.
Current_Byte := Get (The_Stream'Access);
Current_Byte := Get (The_Stream'Access);
Current_Byte := Get (The_Stream'Access);
Current_Byte := Get (The_Stream'Access);
Current_Byte := Get (The_Stream'Access);
end if;
end;
end loop;
end Agent_Client;
with Agents; use Agents;
with Coordinates; use Coordinates;
with Symbols; use Symbols;
with Ada; use Ada;
with Ada.Unchecked_Deallocation;
package Agent is
GUNNAR_ERROR : exception;
type State is new Abstract_State with private;
procedure Get_Action
(Agent : in out State;
The_Rules : in Rules;
Result : out Action;
Home : in Boolean;
Item : in Boolean;
Hostility : in Boolean;
Bump : in Boolean;
Fear : in Boolean;
Enemy_Neutralized : in Boolean);
pragma Inline (Get_Action);
-- Inform the agent about the rules before the simulation begins.
procedure Inform_About_Rules
(Agent : in out State;
The_Rules : in Rules;
First_Percept_Includes_Home : in Boolean;
First_Percept_Includes_Item : in Boolean;
First_Percept_Includes_Hostility : in Boolean;
First_Percept_Includes_Fear : in Boolean);
pragma Inline (Inform_About_Rules);
-- Inform the agent about the tile at (X, Y), which is clear.
procedure Inform_About_A_Clear_Tile
(Agent : in out State;
The_Rules : in Rules;
X : in X_Coordinate;
Y : in Y_Coordinate;
Has_Home : in Boolean;
Has_Item : in Boolean;
Has_Percept_Hostility : in Boolean;
Has_Percept_Fear : in Boolean);
pragma Inline (Inform_About_A_Clear_Tile);
-- Inform the agent about the tile at (X, Y), which is wall or danger.
procedure Inform_About_A_Clear_Tile_With_Enemy
(Agent : in out State;
The_Rules : in Rules;
X : in X_Coordinate;
Y : in Y_Coordinate;
Has_Home : in Boolean;
Has_Item : in Boolean);
pragma Inline (Inform_About_A_Clear_Tile_With_Enemy);
procedure Inform_About_A_Wall_Tile
(Agent : in out State;
The_Rules : in Rules;
X : in X_Coordinate;
Y : in Y_Coordinate);
pragma Inline (Inform_About_A_Wall_Tile);
procedure Inform_About_A_Danger_Tile
(Agent : in out State;
The_Rules : in Rules;
X : in X_Coordinate;
Y : in Y_Coordinate;
Has_Enemy : in Boolean);
pragma Inline (Inform_About_A_Danger_Tile);
procedure Inform_About_Score
(Agent : in out State;
The_Rules : in Rules;
The_Score : in Score);
pragma Inline (Inform_About_Score);
private
type Tile is
(Free_0, Free_1, Free_2, Free_3, Wall, Irrelevant, Unreachable, Unknown);
type Map is array (X_Coordinate range <>, Y_Coordinate range <>) of Tile;
type Map_Access is access Map;
procedure Free is new Unchecked_Deallocation (Map, Map_Access);
type Action_Node;
type Plan is access Action_Node;
type Action_Node is record
First : Action;
Rest : Plan := null;
end record;
procedure Free is new Unchecked_Deallocation (Action_Node, Plan);
function To_String (The_Plan : in Plan) return String;
pragma Inline (To_String);
function Tile_Right_Of
(The_Map : in Map_Access;
X : in X_Coordinate;
Y : in Y_Coordinate;
D : in Direction) return Tile;
pragma Inline (Tile_Right_Of);
function Explore
(The_Rules : in Rules;
The_Map : in Map_Access;
Current_Location_X : in X_Coordinate;
Current_Location_Y : in Y_Coordinate;
Current_Direction : in Direction) return Plan;
pragma Inline (Explore);
type State is new Abstract_State with record
The_Map : Map_Access;
Current_Location_X : X_Coordinate := 0;
Current_Location_Y : Y_Coordinate := 0;
Current_Direction : Direction;
The_Plan : Plan := null;
Previous_Action : Action := Shut_Off;
end record;
procedure Finalize (The_State : in out State);
procedure Write
(The_Map : in out Map_Access;
X : in X_Coordinate;
Y : in Y_Coordinate;
Tiletype : in Tile);
pragma Inline (Write);
procedure Extend
(The_Map : in out Map_Access;
Lower_X : in X_Coordinate;
Upper_X : in X_Coordinate;
Lower_Y : in Y_Coordinate;
Upper_Y : in Y_Coordinate);
pragma Inline (Extend);
end Agent;
with Coordinates; use Coordinates;
with Ada; use Ada;
with Ada.Finalization; use Finalization;
package Agents is
UNACCEPTABLE_RULES : exception;
type Ground_Kind is (Clear, Wall, Danger);
for Ground_Kind'Size use 8;
type Direction is mod 4;
for Direction'Size use 8;
type Action is (Shut_Off, Move, Turn_Left, Turn_Right, Grab, Neutralize);
for Action'Size use 8;
type Location_Count is range 0 .. 65535;
for Location_Count'Size use 16;
type Ammunition_Count is range 0 .. 65535;
for Ammunition_Count'Size use 16;
-- Cost is used for the costs of the actions that the agent can perform
type Cost is range 0 .. 65535;
for Cost'Size use 16;
type Cost_Sum is range 0 .. 2**32 - 1;
for Cost_Sum'Size use 32;
-- Reward is used for the rewards that the agent gets for doing certain
-- actions under certain circumstances:
type Reward is range 0 .. 65535;
for Reward'Size use 16;
type Score is new Integer;
for Score'Size use 32;
type Size is new Integer;
for Size'Size use 32;
type Cardinal_Distance is range 0 .. 128;
for Cardinal_Distance'Size use 8;
type Rules is record
Lower_X_Bound_Is_Known : Boolean;
Upper_X_Bound_Is_Known : Boolean;
Lower_Y_Bound_Is_Known : Boolean;
Upper_Y_Bound_Is_Known : Boolean;
Number_Of_Homes_Is_Known : Boolean;
Number_Of_Items_Is_Known : Boolean;
Number_Of_Dangers_Is_Known : Boolean;
Number_Of_Enemies_Is_Known : Boolean;
Ammunition_Is_Limited : Boolean;
Cost_Is_Limited : Boolean;
Score_Is_Limited : Boolean;
Can_Recharge_Ammunition_At_Home : Boolean;
Neutralized_Enemy_Becomes_Item : Boolean;
Neutralization_Stops_At_First_Enemy : Boolean;
Initial_Direction : Direction;
-- If this is 1, Neutralization_Stops_At_First_Enemy is implicitly
-- necessarly true. Assert that it is in fact true.
Neutralization_Range : Cardinal_Distance;
Move_Cost : Cost;
Grab_Cost : Cost;
Turn_Left_Cost : Cost;
Turn_Right_Cost : Cost;
Neutralize_Cost : Cost;
Item_Reward : Reward;
Neutralize_Reward : Reward;
Home_Reward : Reward;
Lower_X_Bound : Negative_X_Coordinate; -- v.o.w. Lower_X_Bound_Is_Known
Upper_X_Bound : Positive_X_Coordinate; -- v.o.w. Upper_X_Bound_Is_Known
Lower_Y_Bound : Negative_Y_Coordinate; -- v.o.w. Lower_Y_Bound_Is_Known
Upper_Y_Bound : Positive_Y_Coordinate; -- v.o.w. Upper_Y_Bound_Is_Known
Number_Of_Homes : Location_Count; -- v.o.w N._Of_H._L._I._K.
Number_Of_Items : Location_Count; -- v.o.w N._Of_I._L._I._K.
Number_Of_Enemies : Location_Count; -- v.o.w N._Of_E._L._I._K.
Number_Of_Dangers : Location_Count; -- v.o.w N._Of_D._L._I._K.
Initial_Ammunition : Ammunition_Count; -- v.o.w. Ammunition_Is_Limited
Initial_Cost : Cost_Sum;
Initial_Score : Score;
Ammunition_Limit : Ammunition_Count; -- v.o.w. Ammunition_Is_Limited
Cost_Limit : Cost_Sum; -- valid only when Cost_is_Limited
Score_Limit : Score; -- valid only when Score_Is_Limited
end record;
type Abstract_State is abstract new Controlled with null record;
procedure Get_Action
(Agent : in out Abstract_State;
The_Rules : in Rules;
Result : out Action;
Home : in Boolean;
Item : in Boolean;
Hostility : in Boolean;
Bump : in Boolean;
Fear : in Boolean;
Enemy_Neutralized : in Boolean)
is abstract;
-- Informs the agent about the rules and the first percept (except Bump and
-- Enemy_Neutralized, which are necessarly false). This gives the agent an
-- opportunity to verify the rules before it starts acting. If the agent
-- encounters a rule that it was not constructed to handle, it should
-- reject the simulation by calling Client_Network.Notify with an
-- explaination and then raise UNACCEPTABLE_RULES.
procedure Inform_About_Rules
(Agent : in out Abstract_State;
The_Rules : in Rules;
First_Percept_Includes_Home : in Boolean;
First_Percept_Includes_Item : in Boolean;
First_Percept_Includes_Hostility : in Boolean;
First_Percept_Includes_Fear : in Boolean)
is abstract;
-- Informs the agent about the tile at (X, Y), which is clear without
-- enemy. This provedes all the information that the agent would get by
-- visiting the tile.
procedure Inform_About_A_Clear_Tile
(Agent : in out Abstract_State;
The_Rules : in Rules;
X : in X_Coordinate;
Y : in Y_Coordinate;
Has_Home : in Boolean;
Has_Item : in Boolean;
Has_Percept_Hostility : in Boolean;
Has_Percept_Fear : in Boolean)
is abstract;
-- Informs the agent about the tile at (X, Y), which has an enemy.
procedure Inform_About_A_Clear_Tile_With_Enemy
(Agent : in out Abstract_State;
The_Rules : in Rules;
X : in X_Coordinate;
Y : in Y_Coordinate;
Has_Home : in Boolean;
Has_Item : in Boolean)
is abstract;
-- Informs the agent that the tile at (X, Y), is wall. Wall tiles can not
-- have home, item or enemy. This provides all the information that the
-- agent would get by bumping into the tile.
procedure Inform_About_A_Wall_Tile
(Agent : in out Abstract_State;
The_Rules : in Rules;
X : in X_Coordinate;
Y : in Y_Coordinate)
is abstract;
-- Informs the agent about the tile at (X, Y), which is danger. Danger
-- tiles can not have home or item, but can have enemy.
procedure Inform_About_A_Danger_Tile
(Agent : in out Abstract_State;
The_Rules : in Rules;
X : in X_Coordinate;
Y : in Y_Coordinate;
Has_Enemy : in Boolean)
is abstract;
-- Informs the agent about its achievement after the simulation.
procedure Inform_About_Score
(Agent : in out Abstract_State;
The_Rules : in Rules;
The_Score : in Score)
is abstract;
end Agents;
package Coordinates is
Lowest_X_Coordinate : constant := -127;
Highest_X_Coordinate : constant := 127;
Lowest_Y_Coordinate : constant := -127;
Highest_Y_Coordinate : constant := 127;
type X_Coordinate is range Lowest_X_Coordinate .. Highest_X_Coordinate;
for X_Coordinate'Size use 8;
type Y_Coordinate is range Lowest_Y_Coordinate .. Highest_Y_Coordinate;
for Y_Coordinate'Size use 8;
type Negative_X_Coordinate is
new X_Coordinate range Lowest_X_Coordinate .. -1;
for Negative_X_Coordinate'Size use 8;
type Positive_X_Coordinate is
new X_Coordinate range 1 .. Highest_X_Coordinate;
for Positive_X_Coordinate'Size use 8;
type Negative_Y_Coordinate is
new Y_Coordinate range Lowest_Y_Coordinate .. -1;
for Negative_Y_Coordinate'Size use 8;
type Positive_Y_Coordinate is
new Y_Coordinate range 1 .. Highest_Y_Coordinate;
for Positive_Y_Coordinate'Size use 8;
function Min (A : in X_Coordinate; B : in X_Coordinate) return X_Coordinate;
function Max (A : in X_Coordinate; B : in X_Coordinate) return X_Coordinate;
function Min (A : in Y_Coordinate; B : in Y_Coordinate) return Y_Coordinate;
function Max (A : in Y_Coordinate; B : in Y_Coordinate) return Y_Coordinate;
end Coordinates;
package Symbols is
type Symbol is
(Number_00,
Number_01,
Number_02,
Number_03,
Number_04,
Number_05,
Number_06,
Number_07,
Number_08,
Number_09,
Number_10,
Number_11,
Number_12,
Number_13,
Number_14,
Number_15,
Number_16,
Number_17,
Number_18,
Number_19,
Number_20,
Number_21,
Number_22,
Number_23,
Number_24,
Number_25,
Number_26,
Number_27,
Number_28,
Number_29,
Number_30,
Number_31,
Number_32,
Number_33,
Number_34,
Number_35,
Number_36,
Number_37,
Number_38,
Number_39,
Number_40,
Number_41,
Number_42,
Number_43,
Number_44,
Number_45,
Number_46,
Number_47,
Number_48,
Number_49,
Number_50,
Number_51,
Number_52,
Number_53,
Number_54,
Number_55,
Number_56,
Number_57,
Number_58,
Number_59,
Number_60,
Number_61,
Number_62,
Number_63,
Number_64,
Number_65,
Number_66,
Number_67,
Number_68,
Number_69,
Number_70,
Number_71,
Number_72,
Number_73,
Number_74,
Number_75,
Number_76,
Number_77,
Number_78,
Number_79,
Number_80,
Number_81,
Number_82,
Number_83,
Number_84,
Number_85,
Number_86,
Number_87,
Number_88,
Number_89,
Number_90,
Number_91,
Number_92,
Number_93,
Number_94,
Number_95,
Number_96,
Number_97,
Number_98,
Number_99,
Number_Sign,
Question,
Unreachable,
Irrelevant,
Possible_Danger,
Danger,
Possible_Enemy,
Enemy);
for Symbol'Size use 8;
for Symbol use
(Number_00 => 100,
Number_01 => 101,
Number_02 => 102,
Number_03 => 103,
Number_04 => 104,
Number_05 => 105,
Number_06 => 106,
Number_07 => 107,
Number_08 => 108,
Number_09 => 109,
Number_10 => 110,
Number_11 => 111,
Number_12 => 112,
Number_13 => 113,
Number_14 => 114,
Number_15 => 115,
Number_16 => 116,
Number_17 => 117,
Number_18 => 118,
Number_19 => 119,
Number_20 => 120,
Number_21 => 121,
Number_22 => 122,
Number_23 => 123,
Number_24 => 124,
Number_25 => 125,
Number_26 => 126,
Number_27 => 127,
Number_28 => 128,
Number_29 => 129,
Number_30 => 130,
Number_31 => 131,
Number_32 => 132,
Number_33 => 133,
Number_34 => 134,
Number_35 => 135,
Number_36 => 136,
Number_37 => 137,
Number_38 => 138,
Number_39 => 139,
Number_40 => 140,
Number_41 => 141,
Number_42 => 142,
Number_43 => 143,
Number_44 => 144,
Number_45 => 145,
Number_46 => 146,
Number_47 => 147,
Number_48 => 148,
Number_49 => 149,
Number_50 => 150,
Number_51 => 151,
Number_52 => 152,
Number_53 => 153,
Number_54 => 154,
Number_55 => 155,
Number_56 => 156,
Number_57 => 157,
Number_58 => 158,
Number_59 => 159,
Number_60 => 160,
Number_61 => 161,
Number_62 => 162,
Number_63 => 163,
Number_64 => 164,
Number_65 => 165,
Number_66 => 166,
Number_67 => 167,
Number_68 => 168,
Number_69 => 169,
Number_70 => 170,
Number_71 => 171,
Number_72 => 172,
Number_73 => 173,
Number_74 => 174,
Number_75 => 175,
Number_76 => 176,
Number_77 => 177,
Number_78 => 178,
Number_79 => 179,
Number_80 => 180,
Number_81 => 181,
Number_82 => 182,
Number_83 => 183,
Number_84 => 184,
Number_85 => 185,
Number_86 => 186,
Number_87 => 187,
Number_88 => 188,
Number_89 => 189,
Number_90 => 190,
Number_91 => 191,
Number_92 => 192,
Number_93 => 193,
Number_94 => 194,
Number_95 => 195,
Number_96 => 196,
Number_97 => 197,
Number_98 => 198,
Number_99 => 199,
Number_Sign => 200,
Question => 201,
Unreachable => 202,
Irrelevant => 203,
Possible_Danger => 204,
Danger => 205,
Possible_Enemy => 206,
Enemy => 207);
end Symbols;
with Coordinates; use Coordinates;
with Symbols; use Symbols;
with Sockets.Stream_IO; use Sockets, Sockets.Stream_IO;
package Client_Network is
The_Socket : Socket_FD;
The_Stream : aliased Socket_Stream_Type;
procedure Display_Symbol_On_Map
(X : in X_Coordinate; Y : in Y_Coordinate; The_Symbol : in Symbol);
procedure Display_Number_Symbol_On_Map
(X : in X_Coordinate; Y : in Y_Coordinate; The_Number : in Natural);
procedure Remove_Symbol_On_Map
(X : in X_Coordinate; Y : in Y_Coordinate);
procedure Remove_All_Symbols_On_Map;
type Size_16 is mod 2**16;
for Size_16'Size use 16;
type Size_32 is mod 2**32;
for Size_32'Size use 32;
procedure Notify (Message : in String);
end Client_Network;
-----------------------------------------------------------------------------
-- --
-- ADASOCKETS COMPONENTS --
-- --
-- S O C K E T S --
-- --
-- S p e c --
-- --
-- $ReleaseVersion: 0.1.6 $ --
-- --
-- Copyright (C) 1998-2000 --
-- École Nationale Supérieure des Télécommunications --
-- --
-- AdaSockets is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2, or (at your option) --
-- any later version. AdaSockets is distributed in the hope that it --
-- will be useful, but WITHOUT ANY WARRANTY; without even the implied --
-- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- See the GNU General Public License for more details. You should --
-- have received a copy of the GNU General Public License distributed --
-- with AdaSockets; see file COPYING. If not, write to the Free --
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --
-- 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
-- --
-- The main repository for this software is located at: --
-- http://www.infres.enst.fr/ANC/ --
-- --
-- If you have any question, please send a mail to --
-- Samuel Tardieu <sam@inf.enst.fr> --
-- --
-----------------------------------------------------------------------------
with Ada.Streams;
with Interfaces.C;
package Sockets is
type Socket_FD is tagged private;
-- A socket
type Socket_Domain is (PF_INET, AF_INET);
-- PF_INET: Internet sockets
-- AF_INET: This entry is bogus and should never be used, but it is
-- kept here for some time for compatibility reasons.
type Socket_Type is (SOCK_STREAM, SOCK_DGRAM);
-- SOCK_STREAM: Stream mode (TCP)
-- SOCK_DGRAM: Datagram mode (UDP, Multicast)
procedure Socket
(Sock : out Socket_FD;
Domain : in Socket_Domain := PF_INET;
Typ : in Socket_Type := SOCK_STREAM);
-- Create a socket of the given mode
Connection_Refused : exception;
Socket_Error : exception;
procedure Connect
(Socket : in Socket_FD;
Host : in String;
Port : in Positive);
-- Connect a socket on a given host/port. Raise Connection_Refused if
-- the connection has not been accepted by the other end, or
-- Socket_Error (with a more precise exception message) for another error.
procedure Bind
(Socket : in Socket_FD;
Port : in Natural;
Host : in String := "");
-- Bind a socket on a given port. Using 0 for the port will tell the
-- OS to allocate a non-privileged free port. The port can be later
-- retrieved using Get_Sock_Port on the bound socket.
-- If Host is not the empty string, it is used to designate the interface
-- to bind on.
-- Socket_Error can be raised if the system refuses to bind the port.
procedure Listen
(Socket : in Socket_FD;
Queue_Size : in Positive := 5);
-- Create a socket's listen queue
type Socket_Level is (SOL_SOCKET, IPPROTO_IP);
type Socket_Option is (SO_REUSEADDR, SO_REUSEPORT, IP_MULTICAST_TTL,
IP_ADD_MEMBERSHIP, IP_DROP_MEMBERSHIP,
IP_MULTICAST_LOOP, SO_SNDBUF, SO_RCVBUF);
procedure Getsockopt
(Socket : in Socket_FD'Class;
Level : in Socket_Level := SOL_SOCKET;
Optname : in Socket_Option;
Optval : out Integer);
-- Get a socket option
procedure Setsockopt
(Socket : in Socket_FD'Class;
Level : in Socket_Level := SOL_SOCKET;
Optname : in Socket_Option;
Optval : in Integer);
-- Set a socket option
generic
Level : Socket_Level;
Optname : Socket_Option;
type Opt_Type is private;
procedure Customized_Setsockopt (Socket : in Socket_FD'Class;
Optval : in Opt_Type);
-- Low level control on setsockopt
procedure Accept_Socket (Socket : in Socket_FD;
New_Socket : out Socket_FD);
-- Accept a connection on a socket
Connection_Closed : exception;
procedure Send (Socket : in Socket_FD;
Data : in Ada.Streams.Stream_Element_Array);
-- Send data on a socket. Raise Connection_Closed if the socket
-- has been closed.
function Receive (Socket : Socket_FD;
Max : Ada.Streams.Stream_Element_Count := 4096)
return Ada.Streams.Stream_Element_Array;
-- Receive data from a socket. May raise Connection_Closed
procedure Receive (Socket : in Socket_FD'Class;
Data : out Ada.Streams.Stream_Element_Array);
-- Get data from a socket. Raise Connection_Closed if the socket has
-- been closed before the end of the array.
procedure Receive_Some
(Socket : in Socket_FD'Class;
Data : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
-- Get some data from a socket. The index of the last element will
-- be placed in Last.
type Shutdown_Type is (Receive, Send, Both);
procedure Shutdown (Socket : in out Socket_FD;
How : in Shutdown_Type := Both);
-- Close a previously opened socket
procedure Socketpair
(Read_End : out Socket_FD;
Write_End : out Socket_FD;
Domain : in Socket_Domain := PF_INET;
Typ : in Socket_Type := SOCK_STREAM);
-- Create a socketpair.
function Get_FD (Socket : in Socket_FD)
return Interfaces.C.int;
-- Get a socket's FD field
---------------------------------
-- String-oriented subprograms --
---------------------------------
procedure Put (Socket : in Socket_FD'Class;
Str : in String);
-- Send a string on the socket
procedure New_Line (Socket : in Socket_FD'Class;
Count : in Natural := 1);
-- Send CR/LF sequences on the socket
procedure Put_Line (Socket : in Socket_FD'Class;
Str : in String);
-- Send a string + CR/LF on the socket
function Get (Socket : Socket_FD'Class) return String;
-- Get a string from the socket
function Get_Char (Socket : Socket_FD'Class) return Character;
-- Get one character from the socket
function Get_Line (Socket : Socket_FD'Class) return String;
-- Get a full line from the socket. CR is ignored and LF is considered
-- as an end-of-line marker.
procedure Set_Buffer (Socket : in out Socket_FD'Class;
Length : in Positive := 1500);
-- Put socket in buffered mode. If the socket is already buffered,
-- the content of the previous buffer will be lost. The buffered mode
-- only affects read operation, through Get, Get_Char and Get_Line. Other
-- reception subprograms will not function properly if buffered mode
-- is used at the same time. The size of the buffer has to be greater
-- than the biggest possible packet, otherwise data loss may occur.
procedure Unset_Buffer (Socket : in out Socket_FD'Class);
-- Put socket in unbuffered mode. If the socket was unbuffered already,
-- no error will be raised. If it was buffered and the buffer was not
-- empty, its content will be lost.
private
use type Ada.Streams.Stream_Element_Count;
type Buffer_Type
(Length : Ada.Streams.Stream_Element_Count := 1500)
is record
Content : Ada.Streams.Stream_Element_Array (0 .. Length);
-- One byte will stay unused, but this does not have any consequence
First : Ada.Streams.Stream_Element_Offset :=
Ada.Streams.Stream_Element_Offset'Last;
Last : Ada.Streams.Stream_Element_Offset := 0;
end record;
type Buffer_Access is access Buffer_Type;
type Shutdown_Array is array (Receive .. Send) of Boolean;
type Socket_FD is tagged record
FD : Interfaces.C.int;
Shutdown : Shutdown_Array;
Buffer : Buffer_Access;
end record;
end Sockets;
-----------------------------------------------------------------------------
-- --
-- ADASOCKETS COMPONENTS --
-- --
-- S O C K E T S . S T R E A M _ I O --
-- --
-- S p e c --
-- --
-- $ReleaseVersion: 0.1.0 $ --
-- --
-- Copyright (C) 1998-2000 --
-- École Nationale Supérieure des Télécommunications --
-- --
-- AdaSockets is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2, or (at your option) --
-- any later version. AdaSockets is distributed in the hope that it --
-- will be useful, but WITHOUT ANY WARRANTY; without even the implied --
-- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- See the GNU General Public License for more details. You should --
-- have received a copy of the GNU General Public License distributed --
-- with AdaSockets; see file COPYING. If not, write to the Free --
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --
-- 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
-- --
-- The main repository for this software is located at: --
-- http://www.infres.enst.fr/ANC/ --
-- --
-- If you have any question, please send a mail to --
-- Samuel Tardieu <sam@inf.enst.fr> --
-- --
-----------------------------------------------------------------------------
with Ada.Streams;
package Sockets.Stream_IO is
type Socket_Stream_Type is new Ada.Streams.Root_Stream_Type with private;
procedure Initialize
(Stream : in out Socket_Stream_Type;
FD : in Socket_FD);
-- Initialize must be called with an opened socket as parameter before
-- being used as a stream.
procedure Read
(Stream : in out Socket_Stream_Type;
Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
procedure Write
(Stream : in out Socket_Stream_Type;
Item : in Ada.Streams.Stream_Element_Array);
private
type Socket_Stream_Type is new Ada.Streams.Root_Stream_Type with record
FD : Socket_FD;
end record;
end Sockets.Stream_IO;
with Ada.Text_IO; use Ada.Text_IO;
with Client_Network; use Client_Network;
with Ada.Text_IO; use Ada.Text_IO;
package body Agent is
procedure Get_Action
(Agent : in out State;
The_Rules : in Rules;
Result : out Action;
Home : in Boolean;
Item : in Boolean;
Hostility : in Boolean;
Bump : in Boolean;
Fear : in Boolean;
Enemy_Neutralized : in Boolean) is
begin
if Bump then
-- No item should be here. If there is, it should have been picked
-- making the attempt to leave that resulted in the bump.
pragma Assert (not Item);
-- If a plan is interrupted by a bump the plan was wrong.
pragma Assert (Agent.The_Plan = null);
-- Learned that the tile is Wall. Mark it in the map to remember it.
Write
(Agent.The_Map, Agent.Current_Location_X, Agent.Current_Location_Y,
Wall);
-- Revert the coordinate.
case Agent.Current_Direction is
when 0 => Agent.Current_Location_X := Agent.Current_Location_X - 1;
when 1 => Agent.Current_Location_Y := Agent.Current_Location_Y - 1;
when 2 => Agent.Current_Location_X := Agent.Current_Location_X + 1;
when 3 => Agent.Current_Location_Y := Agent.Current_Location_Y + 1;
end case;
else
-- Extend the map if needed.
if
Agent.Current_Location_X = Agent.The_Map'First (1) or
Agent.Current_Location_X = Agent.The_Map'Last (1) or
Agent.Current_Location_Y = Agent.The_Map'First (2) or
Agent.Current_Location_Y = Agent.The_Map'Last (2) then
Extend
(Agent.The_Map,
Min (Agent.Current_Location_X - 1, Agent.The_Map'First (1)),
Max (Agent.Current_Location_X + 1, Agent.The_Map'Last (1)),
Min (Agent.Current_Location_Y - 1, Agent.The_Map'First (2)),
Max (Agent.Current_Location_Y + 1, Agent.The_Map'Last (2)));
end if;
end if;
-- Mark the tile as Free. The number is to remember in which
-- direction the tile was left.
declare
Tile_Here : Tile;
begin
case Agent.Current_Direction is
when 0 => Tile_Here := Free_0;
when 1 => Tile_Here := Free_1;
when 2 => Tile_Here := Free_2;
when 3 => Tile_Here := Free_3;
end case;
Write
(Agent.The_Map,
Agent.Current_Location_X, Agent.Current_Location_Y, Tile_Here);
end;
-- Decide what to do.
if Item then Result := Grab; -- This is the easiest desicion.
else
-- The right-rule: Always explore to the right first if there is
-- an unknown tile to explore there. If there is a plan, delete it
-- and go to the right instead.
--
-- But remember that if the agent follows the right-rule when it is
-- completely surrounded by unknown tiles it will rotate
-- indefinitely.
if
Agent.Previous_Action = Move and then Tile_Right_Of
(Agent.The_Map, Agent.Current_Location_X,
Agent.Current_Location_Y, Agent.Current_Direction) =
Unknown then
Notify ("Gunnar: follwing the right-rule");
while Agent.The_Plan /= null loop
declare
Rest : Plan := Agent.The_Plan.Rest;
begin
Free (Agent.The_Plan);
Agent.The_Plan := Rest;
end;
end loop;
Agent.The_Plan :=
new Action_Node'(Turn_Right, new Action_Node'(Move, null));
end if;
-- If there is no plan, find an unknown tile to explore.
if Agent.The_Plan = null then
Notify
("Gunnar: exploring from (" & Agent.Current_Location_X'Img &
", " & Agent.Current_Location_Y'Img & ", " &
Agent.Current_Direction'Img & ")");
Agent.The_Plan := Explore
(The_Rules, Agent.The_Map, Agent.Current_Location_X,
Agent.Current_Location_Y, Agent.Current_Direction);
end if;
Notify
("Gunnar: plan after planning: " & To_String (Agent.The_Plan));
-- If there is no plan and no unknown tile to explore, shut off.
if Agent.The_Plan = null then Result := Shut_Off;
-- Store the first action of the plan in Result so that the action
-- will be executed. Then remove it from the plan.
else
Result := Agent.The_Plan.First;
declare
Rest : Plan := Agent.The_Plan.Rest;
begin
Free (Agent.The_Plan);
Agent.The_Plan := Rest;
end;
end if;
end if;
-- Update location or direction.
case Result is
when Move =>
case Agent.Current_Direction is
when 0 =>
Agent.Current_Location_X := Agent.Current_Location_X + 1;
when 1 =>
Agent.Current_Location_Y := Agent.Current_Location_Y + 1;
when 2 =>
Agent.Current_Location_X := Agent.Current_Location_X - 1;
when 3 =>
Agent.Current_Location_Y := Agent.Current_Location_Y - 1;
end case;
when Turn_Left =>
Agent.Current_Direction := Agent.Current_Direction + 1;
when Turn_Right =>
Agent.Current_Direction := Agent.Current_Direction - 1;
when others => null;
end case;
end Get_Action;
procedure Inform_About_Rules
(Agent : in out State;
The_Rules : in Rules;
First_Percept_Includes_Home : in Boolean;
First_Percept_Includes_Item : in Boolean;
First_Percept_Includes_Hostility : in Boolean;
First_Percept_Includes_Fear : in Boolean)
is
begin
if The_Rules.Lower_X_Bound_Is_Known then
Notify ("ERROR: Requires the rule (not Lower_X_Bound_Is_Known).");
raise UNACCEPTABLE_RULES;
end if;
if The_Rules.Lower_Y_Bound_Is_Known then
Notify ("ERROR: Requires the rule (not Lower_Y_Bound_Is_Known).");
raise UNACCEPTABLE_RULES;
end if;
if not The_Rules.Number_Of_Homes_Is_Known then
Notify
("ERROR: Requires the rule (Number_Of_Homes_Is_Known).");
raise UNACCEPTABLE_RULES;
end if;
if The_Rules.Number_Of_Homes > 0 then
Notify ("ERROR: Requires the rule (Number_Of_Homes = 0).");
raise UNACCEPTABLE_RULES;
end if;
if not The_Rules.Number_Of_Enemies_Is_Known then
Notify
("ERROR: Requires the rule (Number_Of_Enemies_Is_Known).");
raise UNACCEPTABLE_RULES;
end if;
if The_Rules.Number_Of_Enemies > 0 then
Notify ("ERROR: Requires the rule (Number_Of_Enemies = 0).");
raise UNACCEPTABLE_RULES;
end if;
if not The_Rules.Number_Of_Dangers_Is_Known then
Notify
("ERROR: Requires the rule (Number_Of_Dangers_Is_Known).");
raise UNACCEPTABLE_RULES;
end if;
if The_Rules.Number_Of_Dangers > 0 then
Notify ("ERROR: Requires the rule (Number_Of_Dangers = 0).");
raise UNACCEPTABLE_RULES;
end if;
Notify ("The rules seem OK.");
Agent.Current_Direction := The_Rules.Initial_Direction;
Agent.The_Map := new Map'(-1 .. 1 => (-1 .. 1 => Unknown));
-- The number after free does not matter here. It will be set correctly
-- in Get_Action.
Agent.The_Map (0, 0) := Free_0;
Display_Symbol_On_Map (1, 0, Question);
Display_Symbol_On_Map (1, 1, Question);
Display_Symbol_On_Map (0, 1, Question);
Display_Symbol_On_Map (-1, 1, Question);
Display_Symbol_On_Map (-1, 0, Question);
Display_Symbol_On_Map (-1, -1, Question);
Display_Symbol_On_Map (0, -1, Question);
Display_Symbol_On_Map (1, -1, Question);
end Inform_About_Rules;
procedure Inform_About_A_Clear_Tile
(Agent : in out State;
The_Rules : in Rules;
X : in X_Coordinate;
Y : in Y_Coordinate;
Has_Home : in Boolean;
Has_Item : in Boolean;
Has_Percept_Hostility : in Boolean;
Has_Percept_Fear : in Boolean)
is
begin
Put_Line
("Gunnar: Got informed about the clear tile (" & X'Img & ", " &
Y'Img & ") with home = " & Has_Home'Img & ", item = " &
Has_Item'Img & ", percept_hostility = " & Has_Percept_Hostility'Img &
", percept_fear = " & Has_Percept_Fear'Img);
end Inform_About_A_Clear_Tile;
procedure Inform_About_A_Clear_Tile_With_Enemy
(Agent : in out State;
The_Rules : in Rules;
X : in X_Coordinate;
Y : in Y_Coordinate;
Has_Home : in Boolean;
Has_Item : in Boolean)
is
begin
Put_Line
("Gunnar: Got informed about the clear tile (" & X'Img & ", " &
Y'Img & ") with enemy = TRUE, home = " & Has_Home'Img & ", item = " &
Has_Item'Img);
end Inform_About_A_Clear_Tile_With_Enemy;
procedure Inform_About_A_Wall_Tile
(Agent : in out State;
The_Rules : in Rules;
X : in X_Coordinate;
Y : in Y_Coordinate)
is
begin
Put_Line
("Gunnar: Got informed about the wall tile (" & X'Img & ", " &
Y'Img & ')');
null;
end Inform_About_A_Wall_Tile;
procedure Inform_About_A_Danger_Tile
(Agent : in out State;
The_Rules : in Rules;
X : in X_Coordinate;
Y : in Y_Coordinate;
Has_Enemy : in Boolean)
is
begin
Put_Line
("Gunnar: Got informed about the danger tile (" & X'Img & ", " &
Y'Img & ") with enemy = " & Has_Enemy'Img);
end Inform_About_A_Danger_Tile;
procedure Inform_About_Score
(Agent : in out State;
The_Rules : in Rules;
The_Score : in Score)
is
begin
null;
end Inform_About_Score;
function To_String (The_Plan : in Plan) return String is
function To_String_Recursive
(Result : in String; The_Plan : in Plan) return String;
function To_String_Recursive
(Result : in String; The_Plan : in Plan) return String is
begin
if The_Plan /= null then
case The_Plan.First is
when Shut_Off => return
To_String_Recursive (Result & "Shut_Off ", The_Plan.Rest);
when Move => return
To_String_Recursive (Result & "Move ", The_Plan.Rest);
when Turn_Left => return
To_String_Recursive (Result & "Turn_Left ", The_Plan.Rest);
when Turn_Right => return
To_String_Recursive (Result & "Turn_Right ", The_Plan.Rest);
when Grab => return
To_String_Recursive (Result & "Grab ", The_Plan.Rest);
when Neutralize => return
To_String_Recursive (Result & "Neutralize ", The_Plan.Rest);
end case;
end if;
return Result;
end To_String_Recursive;
Result : String := "";
begin
return To_String_Recursive (Result, The_Plan);
end To_String;
function Tile_Right_Of
(The_Map : in Map_Access;
X : in X_Coordinate;
Y : in Y_Coordinate;
D : in Direction) return Tile is
New_X : X_Coordinate;
New_Y : Y_Coordinate;
begin
case D is
when 0 => New_X := X; New_Y := Y - 1;
when 1 => New_X := X + 1; New_Y := Y;
when 2 => New_X := X; New_Y := Y + 1;
when 3 => New_X := X - 1; New_Y := Y;
end case;
return The_Map (New_X, New_Y);
end Tile_Right_Of;
function Explore
(The_Rules : in Rules;
The_Map : in Map_Access;
Current_Location_X : in X_Coordinate;
Current_Location_Y : in Y_Coordinate;
Current_Direction : in Direction) return Plan is
type Cost_30_Bit is range 0 .. 2**30 - 1;
for Cost_30_Bit'Size use 30;
type Motion_Action is (Move, Turn_Left, Turn_Right);
for Motion_Action'Size use 2;
type Searchmap_Component is record
The_Cost : Cost_30_Bit;
Last_Action : Motion_Action;
end record;
pragma Pack (Searchmap_Component);
for Searchmap_Component'Size use 32;
type Searchmap is array (The_Map'Range (1), The_Map'Range (2), Direction)
of Searchmap_Component;
for Searchmap'Component_Size use 32;
The_Searchmap : Searchmap :=
(others => (others => (others => (Cost_30_Bit'Last, Turn_Right))));
type Candidate_Node;
type Candidate_List is access Candidate_Node;
type Candidate_Node is record
X : X_Coordinate;
Y : Y_Coordinate;
D : Direction;
Rest : Candidate_List;
end record;
for Candidate_Node'Size use 64;
procedure Free is new Unchecked_Deallocation
(Candidate_Node, Candidate_List);
Candidates : Candidate_List := new Candidate_Node'
(Current_Location_X, Current_Location_Y, Current_Direction, null);
Result : Plan := null;
begin
The_Searchmap (Current_Location_X, Current_Location_Y, Current_Direction)
:= (0, Turn_Right);
while Candidates /= null loop
declare
procedure Insert_Candidate
(X : in X_Coordinate;
Y : in Y_Coordinate;
D : in Direction;
The_Cost : in Cost_30_Bit);
procedure Insert_Candidate
(X : in X_Coordinate;
Y : in Y_Coordinate;
D : in Direction;
The_Cost : in Cost_30_Bit) is
begin
if Candidates = null or else The_Cost <= The_Searchmap
(Candidates.X, Candidates.Y, Candidates.D).The_Cost then
Candidates := new Candidate_Node'(X, Y, D, Candidates);
else
declare
N : Candidate_List := Candidates;
begin
while
N.Rest /= null and then The_Cost > The_Searchmap
(N.Rest.X, N.Rest.Y, N.Rest.D).The_Cost loop
N := N.Rest;
end loop;
N.Rest := new Candidate_Node'(X, Y, D, N.Rest);
end;
end if;
end Insert_Candidate;
X : X_Coordinate := Candidates.X;
Y : Y_Coordinate := Candidates.Y;
D : Direction := Candidates.D;
Rest : Candidate_List := Candidates.Rest;
begin
Free (Candidates);
Candidates := Rest;
case The_Map (X, Y) is
when Free_0 | Free_1 | Free_2 | Free_3 =>
declare
The_Cost : Cost_30_Bit :=
The_Searchmap (X, Y, D).The_Cost;
begin
declare -- Turn_Left
New_D : Direction := D + 1;
New_Cost : Cost_30_Bit := The_Cost +
Cost_30_Bit (The_Rules.Turn_Left_Cost);
begin
if New_Cost < The_Searchmap (X, Y, New_D).The_Cost then
The_Searchmap (X, Y, New_D) :=
(New_Cost, Turn_Left);
Insert_Candidate (X, Y, New_D, New_Cost);
end if;
end;
declare -- Move
New_X : X_Coordinate;
New_Y : Y_Coordinate;
New_Cost : Cost_30_Bit :=
The_Cost + Cost_30_Bit (The_Rules.Move_Cost);
begin
case D is
when 0 => New_X := X + 1; New_Y := Y;
when 1 => New_X := X; New_Y := Y + 1;
when 2 => New_X := X - 1; New_Y := Y;
when 3 => New_X := X; New_Y := Y - 1;
end case;
if New_Cost <
The_Searchmap (New_X, New_Y, D).The_Cost then
The_Searchmap (New_X, New_Y, D) := (New_Cost, Move);
Insert_Candidate (New_X, New_Y, D, New_Cost);
end if;
end;
declare -- Turn_Right
New_D : Direction := D - 1;
New_Cost : Cost_30_Bit := The_Cost +
Cost_30_Bit (The_Rules.Turn_Right_Cost);
begin
if New_Cost < The_Searchmap (X, Y, New_D).The_Cost then
The_Searchmap (X, Y, New_D) :=
(New_Cost, Turn_Right);
Insert_Candidate (X, Y, New_D, New_Cost);
end if;
end;
end;
when Wall | Irrelevant =>
null;
when Unknown =>
loop
declare
The_Searchmap_Component : Searchmap_Component
:= The_Searchmap (X, Y, D);
The_Cost : Cost_30_Bit :=
The_Searchmap_Component.The_Cost;
Last_Action : Motion_Action :=
The_Searchmap_Component.Last_Action;
The_Action : Action;
begin
exit when The_Cost = 0;
case Last_Action is
when Turn_Right =>
The_Action := Turn_Right;
D := D + 1;
when Move =>
The_Action := Move;
case D is
when 0 => X := X - 1;
when 1 => Y := Y - 1;
when 2 => X := X + 1;
when 3 => Y := Y + 1;
end case;
when Turn_Left =>
The_Action := Turn_Left;
D := D - 1;
end case;
Result := new Action_Node'(The_Action, Result);
end;
end loop;
while Candidates /= null loop
declare
Rest : Candidate_List := Candidates.Rest;
begin
Free (Candidates);
Candidates := Rest;
end;
end loop;
when Unreachable =>
Notify
("Gunnar: Error in Explore: Search encountered a tile " &
"marked as unreachable.");
raise GUNNAR_ERROR;
end case;
end;
end loop;
return Result;
end Explore;
procedure Finalize (The_State : in out State) is
begin
Put_Line ("Finalizing the agent");
Free (The_State.The_Map);
end Finalize;
procedure Write
(The_Map : in out Map_Access;
X : in X_Coordinate;
Y : in Y_Coordinate;
Tiletype : in Tile) is
begin
The_Map (X, Y) := Tiletype;
case Tiletype is
when Free_0 | Free_1 | Free_2 | Free_3 | Wall =>
Remove_Symbol_On_Map (X, Y);
when Irrelevant => Display_Symbol_On_Map (X, Y, Irrelevant);
when Unreachable => Display_Symbol_On_Map (X, Y, Unreachable);
when Unknown => Display_Symbol_On_Map (X, Y, Question);
end case;
end Write;
-- FIXME this procedure should mark tiles as wall or Wall_Or_Danger when
-- FIXME they are known to be that because of known bounds
procedure Extend
(The_Map : in out Map_Access;
Lower_X : in X_Coordinate;
Upper_X : in X_Coordinate;
Lower_Y : in Y_Coordinate;
Upper_Y : in Y_Coordinate)
is
pragma Assert (Lower_X <= The_Map'First (1));
pragma Assert (Upper_X >= The_Map'Last (1));
pragma Assert (Lower_Y <= The_Map'First (2));
pragma Assert (Upper_Y >= The_Map'Last (2));
New_Map : constant Map_Access := new Map
(Lower_X .. Upper_X, Lower_Y .. Upper_Y);
Old_Lower_X : constant X_Coordinate := The_Map'First (1);
Old_Upper_X : constant X_Coordinate := The_Map'Last (1);
Old_Lower_Y : constant Y_Coordinate := The_Map'First (2);
Old_Upper_Y : constant Y_Coordinate := The_Map'Last (2);
begin
Notify
("Gunnar: Extending the map to from (" & The_Map'First (1)'Img & " .. "
& The_Map'Last (1)'Img & ", " & The_Map'First (2)'Img & " .. " &
The_Map'Last (2)'Img & ") to (" & New_Map'First (1)'Img & " .. " &
New_Map'Last (1)'Img & ", " & New_Map'First (2)'Img & " .. " &
New_Map'Last (2)'Img & ").");
-- Copy the old map to the new map.
for X in The_Map'Range (1) loop
for Y in The_Map'Range (2) loop
New_Map (X, Y) := The_Map (X, Y);
end loop;
end loop;
Free (The_Map);
The_Map := New_Map;
-- Set the new tiles to unknown.
if The_Map'First (1) < Old_Lower_X then
for X in The_Map'First (1) .. Old_Lower_X - 1 loop
for Y in The_Map'First (2) .. The_Map'Last (2) loop
Write (The_Map, X, Y, Unknown);
end loop;
end loop;
end if;
Notify
("The_Map'Last (1) = " & The_Map'Last (1)'Img & ", Old_Upper_X = " &
Old_Upper_X'Img);
if The_Map'Last (1) > Old_Upper_X then
for X in Old_Upper_X + 1 .. The_Map'Last (1) loop
for Y in The_Map'First (2) .. The_Map'Last (2) loop
Write (The_Map, X, Y, Unknown);
end loop;
end loop;
end if;
if The_Map'First (2) < Old_Lower_Y then
for X in Old_Lower_X .. Old_Upper_X loop
for Y in The_Map'First (2) .. Old_Lower_Y - 1 loop
Write (The_Map, X, Y, Unknown);
end loop;
end loop;
end if;
Notify
("The_Map'Last (2) = " & The_Map'Last (2)'Img & ", Old_Upper_Y = " &
Old_Upper_X'Img);
if The_Map'Last (2) > Old_Upper_Y then
for X in Old_Lower_X .. Old_Upper_X loop
for Y in Old_Upper_Y + 1 .. The_Map'Last (2) loop
Write (The_Map, X, Y, Unknown);
end loop;
end loop;
end if;
end Extend;
end Agent;
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- S Y S T E M . A S S E R T I O N S --
-- --
-- S p e c --
-- --
-- $Revision: 1.1.16.2 $
-- --
-- Copyright (C) 1992-1998 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
package System.Assertions is
Assert_Failure : exception;
-- Exception raised when assertion fails
procedure Raise_Assert_Failure (Msg : String);
pragma No_Return (Raise_Assert_Failure);
-- Called to raise Assert_Failure with given message
end System.Assertions;
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: ada/8614: Assert_Failure exp_util.adb:1404
@ 2003-05-12 17:06 Dara Hazeghi
0 siblings, 0 replies; 2+ messages in thread
From: Dara Hazeghi @ 2003-05-12 17:06 UTC (permalink / raw)
To: nobody; +Cc: gcc-prs
The following reply was made to PR ada/8614; it has been noted by GNATS.
From: Dara Hazeghi <dhazeghi@yahoo.com>
To: sigra@home.se, gcc-gnats@gcc.gnu.org, nobody@gcc.gnu.org
Cc:
Subject: Re: ada/8614: Assert_Failure exp_util.adb:1404
Date: Mon, 12 May 2003 09:59:09 -0700
http://gcc.gnu.org/cgi-bin/gnatsweb.pl?cmd=view%20audit-
trail&database=gcc&pr=8614
Hello,
I can confirm that this bug is still present on gcc 3.3 branch
(20030510) and mainline (20030510) on i686-linux. The problem goes away
if I remove the -gnatVa switch.
Dara
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2003-05-12 17:06 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2002-11-22 12:46 ada/8614: Assert_Failure exp_util.adb:1404 sigra
2003-05-12 17:06 Dara Hazeghi
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).