------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- This Ada package was automatically generated by the software engineering tool Platypus -- see http://dossen.univ-brest.fr/apl -- -- Any modification of this file will be lost. -- Please see the "platypus" directory instead : it contains the Cheddar's -- model and its meta-model. ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a free real time scheduling tool. -- This program provides services to automatically check temporal constraints -- of real time tasks. -- -- Copyright (C) 2002-2009 Frank Singhoff -- Cheddar is developed by the LAB-STICC Team, University of Brest -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program 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 -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- -- -- Contact : cheddar@listes.univ-brest.fr -- To post to this mailing list, you must be subscribed -- (see http//beru.univ-brest.fr/~singhoff/cheddar for details) -- ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Text_io; use Text_io; with unbounded_strings; use unbounded_strings; with primitive_xml_strings; use primitive_xml_strings; Package Body Time_Unit_Events is function XML_String(obj : in Time_Unit_Event_Type; level : in natural := 0) return Unbounded_String is begin return to_unbounded_string(Time_Unit_Event_Type'image (obj) ); end XML_String; function XML_Ref_String (obj : in Time_Unit_Event_Type; level : in natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_Ref_String; procedure Initialize (obj : out Time_Unit_Event_Ptr) is begin obj := NULL; end Initialize; procedure Put(obj : in Time_Unit_Event_Ptr) is begin if (obj /= NULL) then put("type_of_event: "); put(obj.type_of_event); put ( "; " ); put ( "value: " ); case obj.type_of_event is when start_of_task_capacity => put("start_task: "); if obj.start_task /= null then put(obj.start_task.all); else put("null"); end if;put ( "; " ); when end_of_task_capacity => put("end_task: "); if obj.end_task /= null then put(obj.end_task.all); else put("null"); end if;put ( "; " ); when write_to_buffer => put("write_buffer: "); if obj.write_buffer /= null then put(obj.write_buffer.all); else put("null"); end if;put ( "; " ); put("write_task: "); if obj.write_task /= null then put(obj.write_task.all); else put("null"); end if;put ( "; " ); put("write_size: "); standards_io.natural_io.put(obj.write_size); put ( "; " ); when read_from_buffer => put("read_buffer: "); if obj.read_buffer /= null then put(obj.read_buffer.all); else put("null"); end if;put ( "; " ); put("read_task: "); if obj.read_task /= null then put(obj.read_task.all); else put("null"); end if;put ( "; " ); put("read_size: "); standards_io.natural_io.put(obj.read_size); put ( "; " ); when context_switch_overhead => put("switched_task: "); if obj.switched_task /= null then put(obj.switched_task.all); else put("null"); end if;put ( "; " ); when running_task => put("running_core: "); put(obj.running_core); put ( "; " ); put("running_task: "); if obj.running_task /= null then put(obj.running_task.all); else put("null"); end if;put ( "; " ); put("current_priority: "); put(obj.current_priority); put ( "; " ); when task_activation => put("activation_task: "); if obj.activation_task /= null then put(obj.activation_task.all); else put("null"); end if;put ( "; " ); when allocate_resource => put("allocate_task: "); if obj.allocate_task /= null then put(obj.allocate_task.all); else put("null"); end if;put ( "; " ); put("allocate_resource: "); if obj.allocate_resource /= null then put(obj.allocate_resource.all); else put("null"); end if;put ( "; " ); when release_resource => put("release_task: "); if obj.release_task /= null then put(obj.release_task.all); else put("null"); end if;put ( "; " ); put("release_resource: "); if obj.release_resource /= null then put(obj.release_resource.all); else put("null"); end if;put ( "; " ); when wait_for_resource => put("wait_for_resource_task: "); if obj.wait_for_resource_task /= null then put(obj.wait_for_resource_task.all); else put("null"); end if;put ( "; " ); put("wait_for_resource: "); if obj.wait_for_resource /= null then put(obj.wait_for_resource.all); else put("null"); end if;put ( "; " ); when send_message => put("send_task: "); if obj.send_task /= null then put(obj.send_task.all); else put("null"); end if;put ( "; " ); put("send_message: "); if obj.send_message /= null then put(obj.send_message.all); else put("null"); end if;put ( "; " ); when receive_message => put("receive_task: "); if obj.receive_task /= null then put(obj.receive_task.all); else put("null"); end if;put ( "; " ); put("receive_message: "); if obj.receive_message /= null then put(obj.receive_message.all); else put("null"); end if;put ( "; " ); when wait_for_memory => put("wait_for_memory_task: "); if obj.wait_for_memory_task /= null then put(obj.wait_for_memory_task.all); else put("null"); end if;put ( "; " ); put("wait_for_cache: "); if obj.wait_for_cache /= null then put(obj.wait_for_cache.all); else put("null"); end if;put ( "; " ); when address_space_activation => put("activation_address_space: "); put(obj.activation_address_space); put ( "; " ); put("duration: "); standards_io.natural_io.put(obj.duration); put ( "; " ); end case; end if; New_Line; end Put; function Copy ( obj : in Time_Unit_Event ) return Time_Unit_Event_Ptr is New_Time_Unit_Event : Time_Unit_Event_Ptr; begin New_Time_Unit_Event := new Time_Unit_Event'(obj); return (New_Time_Unit_Event); end Copy; function Copy ( obj : in Time_Unit_Event_Ptr ) return Time_Unit_Event_Ptr is begin return copy(obj.all); end Copy; function XML_String(obj : in Time_Unit_Event; level : in natural := 0) return Unbounded_String is result : Unbounded_String; begin result := "" & Unbounded_Lf; if (XML_String(obj.type_of_event, level + 1) /= Empty_String) then result := result & unbounded_ht(level + 1) & "" & XML_String(obj.type_of_event, level + 1) & "" & Unbounded_Lf; end if; case obj.type_of_event is when start_of_task_capacity => result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; when end_of_task_capacity => result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; when write_to_buffer => result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; if (XML_String(obj.write_size, level + 1) /= Empty_String) then result := result & unbounded_ht(level + 1) & "" & XML_String(obj.write_size, level + 1) & "" & Unbounded_Lf; end if; when read_from_buffer => result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; if (XML_String(obj.read_size, level + 1) /= Empty_String) then result := result & unbounded_ht(level + 1) & "" & XML_String(obj.read_size, level + 1) & "" & Unbounded_Lf; end if; when context_switch_overhead => result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; when running_task => if (XML_String(obj.running_core, level + 1) /= Empty_String) then result := result & unbounded_ht(level + 1) & "" & XML_String(obj.running_core, level + 1) & "" & Unbounded_Lf; end if; result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; if (XML_String(obj.current_priority, level + 1) /= Empty_String) then result := result & unbounded_ht(level + 1) & "" & XML_String(obj.current_priority, level + 1) & "" & Unbounded_Lf; end if; when task_activation => result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; when allocate_resource => result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; when release_resource => result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; when wait_for_resource => result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; when send_message => result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; when receive_message => result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; when wait_for_memory => result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; result := result & unbounded_ht ( level + 1 ) & "" & Unbounded_Lf; when address_space_activation => if (XML_String(obj.activation_address_space, level + 1) /= Empty_String) then result := result & unbounded_ht(level + 1) & "" & XML_String(obj.activation_address_space, level + 1) & "" & Unbounded_Lf; end if; if (XML_String(obj.duration, level + 1) /= Empty_String) then result := result & unbounded_ht(level + 1) & "" & XML_String(obj.duration, level + 1) & "" & Unbounded_Lf; end if; end case; result := result & "" & Unbounded_Lf; return (result); end XML_String; function XML_String(obj : in Time_Unit_Event_Ptr; level : in natural := 0) return Unbounded_String is begin return XML_String(obj.all); end XML_String; function XML_Ref_String(obj : in Time_Unit_Event; level : in natural := 0) return Unbounded_String is result : Unbounded_String; begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_Ref_String; function XML_Ref_String(obj : in Time_Unit_Event_Ptr; level : in natural := 0) return Unbounded_String is begin return XML_Ref_String(obj.all); end XML_Ref_String; End Time_Unit_Events;