------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- This source file was automatically generated by 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-2014 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;
with primitive_write_xml;
use primitive_write_xml;
Package Body Time_Unit_Events is
function XML_String(obj : in Time_Unit_Event_Type) 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) 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 ( "; " );
put("write_buffer_current_data_size: "); standards_io.natural_io.put(obj.write_buffer_current_data_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 ( "; " );
put("read_buffer_current_data_size: "); standards_io.natural_io.put(obj.read_buffer_current_data_size); put ( "; " );
when buffer_overflow =>
put("overflow_buffer: "); if obj.overflow_buffer /= null then put(obj.overflow_buffer.all); else put("null"); end if;put ( "; " );
put("overflow_task: "); if obj.overflow_task /= null then put(obj.overflow_task.all); else put("null"); end if;put ( "; " );
put("overflow_write_size: "); standards_io.natural_io.put(obj.overflow_write_size); put ( "; " );
put("overflow_buffer_current_data_size: "); standards_io.natural_io.put(obj.overflow_buffer_current_data_size); put ( "; " );
when buffer_underflow =>
put("underflow_buffer: "); if obj.underflow_buffer /= null then put(obj.underflow_buffer.all); else put("null"); end if;put ( "; " );
put("underflow_task: "); if obj.underflow_task /= null then put(obj.underflow_task.all); else put("null"); end if;put ( "; " );
put("underflow_read_size: "); standards_io.natural_io.put(obj.underflow_read_size); put ( "; " );
put("underflow_buffer_current_data_size: "); standards_io.natural_io.put(obj.underflow_buffer_current_data_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 ( "; " );
put("remaining_crpd: "); standards_io.natural_io.put(obj.remaining_crpd); 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 ( "; " );
when preemption =>
put("preempted_task: "); if obj.preempted_task /= null then put(obj.preempted_task.all); else put("null"); end if;put ( "; " );
put("preempting_task: "); if obj.preempting_task /= null then put(obj.preempting_task.all); else put("null"); end if;put ( "; " );
put("evicted_ucbs: "); standards_io.natural_io.put(obj.evicted_ucbs); 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) return Unbounded_String is
result : Unbounded_String;
begin
result := to_unbounded_string("");
if (XML_String(obj.type_of_event) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.type_of_event) & to_unbounded_string("");
end if;
case obj.type_of_event is
when start_of_task_capacity =>
result := result & to_unbounded_string("");
when end_of_task_capacity =>
result := result & to_unbounded_string("");
when write_to_buffer =>
result := result & to_unbounded_string("");
result := result & to_unbounded_string("");
if (XML_String(obj.write_size) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.write_size) & to_unbounded_string("");
end if;
if (XML_String(obj.write_buffer_current_data_size) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.write_buffer_current_data_size) & to_unbounded_string("");
end if;
when read_from_buffer =>
result := result & to_unbounded_string("");
result := result & to_unbounded_string("");
if (XML_String(obj.read_size) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.read_size) & to_unbounded_string("");
end if;
if (XML_String(obj.read_buffer_current_data_size) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.read_buffer_current_data_size) & to_unbounded_string("");
end if;
when buffer_overflow =>
result := result & to_unbounded_string("");
result := result & to_unbounded_string("");
if (XML_String(obj.overflow_write_size) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.overflow_write_size) & to_unbounded_string("");
end if;
if (XML_String(obj.overflow_buffer_current_data_size) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.overflow_buffer_current_data_size) & to_unbounded_string("");
end if;
when buffer_underflow =>
result := result & to_unbounded_string("");
result := result & to_unbounded_string("");
if (XML_String(obj.underflow_read_size) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.underflow_read_size) & to_unbounded_string("");
end if;
if (XML_String(obj.underflow_buffer_current_data_size) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.underflow_buffer_current_data_size) & to_unbounded_string("");
end if;
when context_switch_overhead =>
result := result & to_unbounded_string("");
when running_task =>
if (XML_String(obj.running_core) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.running_core) & to_unbounded_string("");
end if;
result := result & to_unbounded_string("");
if (XML_String(obj.current_priority) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.current_priority) & to_unbounded_string("");
end if;
if (XML_String(obj.remaining_crpd) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.remaining_crpd) & to_unbounded_string("");
end if;
when task_activation =>
result := result & to_unbounded_string("");
when allocate_resource =>
result := result & to_unbounded_string("");
result := result & to_unbounded_string("");
when release_resource =>
result := result & to_unbounded_string("");
result := result & to_unbounded_string("");
when wait_for_resource =>
result := result & to_unbounded_string("");
result := result & to_unbounded_string("");
when send_message =>
result := result & to_unbounded_string("");
result := result & to_unbounded_string("");
when receive_message =>
result := result & to_unbounded_string("");
result := result & to_unbounded_string("");
when wait_for_memory =>
result := result & to_unbounded_string("");
result := result & to_unbounded_string("");
when address_space_activation =>
if (XML_String(obj.activation_address_space) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.activation_address_space) & to_unbounded_string("");
end if;
if (XML_String(obj.duration) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.duration) & to_unbounded_string("");
end if;
when preemption =>
result := result & to_unbounded_string("");
result := result & to_unbounded_string("");
if (XML_String(obj.evicted_ucbs) /= Empty_String) then
result := result & to_unbounded_string("") & XML_String(obj.evicted_ucbs) & to_unbounded_string("");
end if;
end case;
result := result & to_unbounded_string("");
return (result);
end XML_String;
function XML_String(obj : in Time_Unit_Event_Ptr) return Unbounded_String is
begin
return XML_String(obj.all);
end XML_String;
function XML_Ref_String(obj : in Time_Unit_Event) 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) return Unbounded_String is
begin
return XML_Ref_String(obj.all);
end XML_Ref_String;
procedure write_XML(into : in file_type ; obj : in time_unit_event) is
begin
put_line(into,"");
put(into, ""); write_xml(into, obj.type_of_event); put_line(into, "");
case obj.type_of_event is
when start_of_task_capacity =>
put_line(into, "");
when end_of_task_capacity =>
put_line(into, "");
when write_to_buffer =>
put_line(into, "");
put_line(into, "");
put(into, ""); write_xml(into, obj.write_size); put_line(into, "");
put(into, ""); write_xml(into, obj.write_buffer_current_data_size); put_line("");
when read_from_buffer =>
put_line(into, "");
put_line(into, "");
put(into, ""); write_XML(into, obj.read_size); put_line("");
put(into, ""); write_XML(into, obj.read_buffer_current_data_size); put_line(into, "");
when buffer_overflow =>
put_line(into, "");
put_line(into, "");
put(into, ""); write_XML(into, obj.overflow_write_size); put_line(into, "");
put(into, ""); write_xml(into, obj.overflow_buffer_current_data_size); put_line(into, "");
when buffer_underflow =>
put_line(into, "");
put_line(into, "");
put(into, ""); write_xml(into, obj.underflow_read_size); put_line(into, "");
put(into, ""); write_xml(into, obj.underflow_buffer_current_data_size); put_line(into, "");
when context_switch_overhead =>
put_line(into, "");
when running_task =>
put(into, ""); write_xml(into, obj.running_core); put_line(into, "");
put_line(into, "");
put(into, ""); write_xml(into, obj.current_priority); put_line(into, "");
put_line(into, ""); write_xml(into, obj.remaining_crpd); put_line(into, "");
when task_activation =>
put_line(into, "");
when allocate_resource =>
put_line(into, "");
put_line(into, "");
when release_resource =>
put_line(into, "");
put_line(into, "");
when wait_for_resource =>
put_line(into, "");
put_line(into, "");
when send_message =>
put_line(into, "");
put_line(into, "");
when receive_message =>
put_line(into, "");
put_line(into, "");
when wait_for_memory =>
put_line(into, "");
put_line(into, "");
when address_space_activation =>
put(into, ""); write_XML(into, obj.activation_address_space); put_line(into, "");
put(into, ""); write_xml(into, obj.duration); put_line(into, "");
when preemption =>
put_line(into, "");
put_line(into, "");
put(into, ""); write_xml(into, obj.evicted_ucbs); put_line(into, "");
end case;
put_line(into, "");
end write_XML;
procedure write_XML(into : in file_type ; obj : in time_unit_event_ptr) is
begin
write_xml(into, obj.all);
end write_XML;
procedure write_xml(into : in file_type ; obj : in Time_Unit_Event_Type) is
begin
put(into, Time_Unit_Event_Type'image (obj));
end write_xml;
End Time_Unit_Events;