From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 6350 invoked by alias); 17 Nov 2002 17:46:03 -0000 Mailing-List: contact gcc-prs-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Archive: List-Post: List-Help: Sender: gcc-prs-owner@gcc.gnu.org Received: (qmail 6328 invoked by uid 71); 17 Nov 2002 17:46:02 -0000 Resent-Date: 17 Nov 2002 17:46:02 -0000 Resent-Message-ID: <20021117174602.6327.qmail@sources.redhat.com> Resent-From: gcc-gnats@gcc.gnu.org (GNATS Filer) Resent-Cc: gcc-prs@gcc.gnu.org, gcc-bugs@gcc.gnu.org Resent-Reply-To: gcc-gnats@gcc.gnu.org, sigra@home.se Received: (qmail 6306 invoked by uid 61); 17 Nov 2002 17:45:43 -0000 Message-Id: <20021117174543.6305.qmail@sources.redhat.com> Date: Fri, 22 Nov 2002 12:46:00 -0000 From: sigra@home.se Reply-To: sigra@home.se To: gcc-gnats@gcc.gnu.org X-Send-Pr-Version: gnatsweb-2.9.3 (1.1.1.1.2.31) Subject: ada/8614: Assert_Failure exp_util.adb:1404 X-SW-Source: 2002-11/txt/msg00853.txt.bz2 List-Id: >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 -- -- -- ----------------------------------------------------------------------------- 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 -- -- -- ----------------------------------------------------------------------------- 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;