------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- 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 ("CRPD: ");
standards_io.natural_io.Put (obj.crpd);
Put ("; ");
Put ("cache_state: ");
Put (obj.cache_state);
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 ("; ");
when discard_missed_deadline =>
Put ("missed_deadline_task: ");
if obj.missed_deadline_task /= null then
Put (obj.missed_deadline_task.all);
else
Put ("null");
end if;
Put ("; ");
when mode_change =>
Put ("From mode: ");
standards_io.integer_io.Put (integer(obj.from_mode));
Put ("To mode: ");
standards_io.integer_io.Put (integer(obj.To_mode));
Put ("; ");
when tdma_slot =>
Put ("Message: ");
put(obj.slot_message);
Put ("Duration: ");
standards_io.integer_io.Put (integer(obj.slot_duration));
when energy =>
Put ("energy_battery: ");
if obj.energy_battery/= null then
Put (obj.energy_battery.all);
else
Put ("null");
end if;
Put ("Battery level: ");
standards_io.natural_io.Put (obj.energy_level);
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.crpd) /= empty_string) then
result :=
result &
To_Unbounded_String ("") &
xml_string (obj.crpd) &
To_Unbounded_String ("");
end if;
if (xml_string (obj.cache_state) /= empty_string) then
result :=
result &
To_Unbounded_String ("") &
xml_string (obj.cache_state) &
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;
when discard_missed_deadline =>
result :=
result &
To_Unbounded_String ("");
when tdma_slot =>
if (xml_string (obj.slot_duration) /= empty_string) then
result :=
result &
To_Unbounded_String ("") &
xml_string (obj.slot_duration) &
To_Unbounded_String ("");
end if;
result :=
result &
To_Unbounded_String ("") &
xml_string (obj.slot_message) &
To_Unbounded_String ("");
when mode_change =>
if (xml_string (obj.from_mode) /= empty_string) then
result :=
result &
To_Unbounded_String ("") &
xml_string (obj.from_mode) &
To_Unbounded_String ("");
end if;
if (xml_string (obj.to_mode) /= empty_string) then
result :=
result &
To_Unbounded_String ("") &
xml_string (obj.to_mode) &
To_Unbounded_String ("");
end if;
when energy =>
result :=
result &
To_Unbounded_String ("");
if (xml_string (obj.energy_level) /= empty_string) then
result :=
result &
To_Unbounded_String ("") &
xml_string (obj.energy_level) &
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 get_xml (result : in out Unbounded_String; obj : in time_unit_event) is
begin
result := result & "" & unbounded_lf;
result := result &
"" &
time_unit_event_type'image (obj.type_of_event) &
"" & unbounded_lf;
case obj.type_of_event is
when start_of_task_capacity =>
result := result & "" & unbounded_lf;
when end_of_task_capacity =>
result := result & "" & unbounded_lf;
when write_to_buffer =>
result := result & "" & unbounded_lf;
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.write_size);
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.write_buffer_current_data_size);
result := result & "" & unbounded_lf;
when read_from_buffer =>
result := result & "" & unbounded_lf;
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.read_size);
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.read_buffer_current_data_size);
result := result & "" & unbounded_lf;
when buffer_overflow =>
result := result & "" & unbounded_lf;
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.overflow_write_size);
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.overflow_buffer_current_data_size);
result := result & "" & unbounded_lf;
when buffer_underflow =>
result := result & "" & unbounded_lf;
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.underflow_read_size);
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.underflow_buffer_current_data_size);
result := result & "" & unbounded_lf;
when context_switch_overhead =>
result := result & "" & unbounded_lf;
when running_task =>
result := result & "";
result := result & xml_string (obj.running_core);
result := result & "" & unbounded_lf;
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.current_priority);
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.crpd);
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.cache_state);
result := result & "" & unbounded_lf;
when task_activation =>
result := result & "" & unbounded_lf;
when allocate_resource =>
result := result & "" & unbounded_lf;
result := result & "" & unbounded_lf;
when release_resource =>
result := result & "" & unbounded_lf;
result := result & "" & unbounded_lf;
when wait_for_resource =>
result := result & "" & unbounded_lf;
result := result & "" & unbounded_lf;
when send_message =>
result := result & "" & unbounded_lf;
result := result & "" & unbounded_lf;
when receive_message =>
result := result & "" & unbounded_lf;
result := result & "" & unbounded_lf;
when wait_for_memory =>
result := result & "" & unbounded_lf;
result := result & "" & unbounded_lf;
when address_space_activation =>
result := result & "";
result := result & xml_string (obj.activation_address_space);
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.duration);
result := result & "" & unbounded_lf;
when preemption =>
result := result & "" & unbounded_lf;
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.evicted_ucbs);
result := result & "" & unbounded_lf;
when discard_missed_deadline =>
result := result & "" & unbounded_lf;
when energy =>
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.energy_level);
result := result & "";
when mode_change =>
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.from_mode);
result := result & "";
result := result & "";
result := result & xml_string (obj.to_mode);
result := result & "";
when tdma_slot =>
result := result & "" & unbounded_lf;
result := result & "";
result := result & xml_string (obj.slot_message);
result := result & "";
result := result & "";
result := result & xml_string (obj.slot_duration);
result := result & "";
end case;
result := result & "" & unbounded_lf;
end get_xml;
procedure get_xml (result : in out Unbounded_String; obj : in time_unit_event_ptr) is
begin
get_xml (result, obj.all);
end get_xml;
procedure get_xml (result : in out Unbounded_String; obj : in time_unit_event_type) is
begin
result := result & time_unit_event_type'image (obj);
end get_xml;
end time_unit_events;