------------------------------------------------------------------------------
------------------------------------------------------------------------------
--  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 ("; ");

         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 ("<time_unit_event>");
      if (xml_string (obj.type_of_event) /= empty_string) then
         result :=
           result &
           To_Unbounded_String ("<type_of_event>") &
           xml_string (obj.type_of_event) &
           To_Unbounded_String ("</type_of_event>");
      end if;

      case obj.type_of_event is
         when start_of_task_capacity =>
            result :=
              result &
              To_Unbounded_String ("<start_task ref=""") &
              obj.start_task.cheddar_private_id &
              To_Unbounded_String (""" />");

         when end_of_task_capacity =>
            result :=
              result &
              To_Unbounded_String ("<end_task ref=""") &
              obj.end_task.cheddar_private_id &
              To_Unbounded_String (""" />");

         when write_to_buffer =>
            result :=
              result &
              To_Unbounded_String ("<write_buffer ref=""") &
              obj.write_buffer.cheddar_private_id &
              To_Unbounded_String (""" />");
            result :=
              result &
              To_Unbounded_String ("<write_task ref=""") &
              obj.write_task.cheddar_private_id &
              To_Unbounded_String (""" />");
            if (xml_string (obj.write_size) /= empty_string) then
               result :=
                 result &
                 To_Unbounded_String ("<write_size>") &
                 xml_string (obj.write_size) &
                 To_Unbounded_String ("</write_size>");
            end if;
            if
              (xml_string (obj.write_buffer_current_data_size) /= empty_string)
            then
               result :=
                 result &
                 To_Unbounded_String ("<write_buffer_current_data_size>") &
                 xml_string (obj.write_buffer_current_data_size) &
                 To_Unbounded_String ("</write_buffer_current_data_size>");
            end if;

         when read_from_buffer =>
            result :=
              result &
              To_Unbounded_String ("<read_buffer ref=""") &
              obj.read_buffer.cheddar_private_id &
              To_Unbounded_String (""" />");
            result :=
              result &
              To_Unbounded_String ("<read_task ref=""") &
              obj.read_task.cheddar_private_id &
              To_Unbounded_String (""" />");
            if (xml_string (obj.read_size) /= empty_string) then
               result :=
                 result &
                 To_Unbounded_String ("<read_size>") &
                 xml_string (obj.read_size) &
                 To_Unbounded_String ("</read_size>");
            end if;
            if
              (xml_string (obj.read_buffer_current_data_size) /= empty_string)
            then
               result :=
                 result &
                 To_Unbounded_String ("<read_buffer_current_data_size>") &
                 xml_string (obj.read_buffer_current_data_size) &
                 To_Unbounded_String ("</read_buffer_current_data_size>");
            end if;

         when buffer_overflow =>
            result :=
              result &
              To_Unbounded_String ("<overflow_buffer ref=""") &
              obj.overflow_buffer.cheddar_private_id &
              To_Unbounded_String (""" />");
            result :=
              result &
              To_Unbounded_String ("<overflow_task ref=""") &
              obj.overflow_task.cheddar_private_id &
              To_Unbounded_String (""" />");
            if (xml_string (obj.overflow_write_size) /= empty_string) then
               result :=
                 result &
                 To_Unbounded_String ("<overflow_write_size>") &
                 xml_string (obj.overflow_write_size) &
                 To_Unbounded_String ("</overflow_write_size>");
            end if;
            if
              (xml_string (obj.overflow_buffer_current_data_size) /=
               empty_string)
            then
               result :=
                 result &
                 To_Unbounded_String ("<overflow_buffer_current_data_size>") &
                 xml_string (obj.overflow_buffer_current_data_size) &
                 To_Unbounded_String ("</overflow_buffer_current_data_size>");
            end if;

         when buffer_underflow =>
            result :=
              result &
              To_Unbounded_String ("<underflow_buffer ref=""") &
              obj.underflow_buffer.cheddar_private_id &
              To_Unbounded_String (""" />");
            result :=
              result &
              To_Unbounded_String ("<underflow_task ref=""") &
              obj.underflow_task.cheddar_private_id &
              To_Unbounded_String (""" />");
            if (xml_string (obj.underflow_read_size) /= empty_string) then
               result :=
                 result &
                 To_Unbounded_String ("<underflow_read_size>") &
                 xml_string (obj.underflow_read_size) &
                 To_Unbounded_String ("</underflow_read_size>");
            end if;
            if
              (xml_string (obj.underflow_buffer_current_data_size) /=
               empty_string)
            then
               result :=
                 result &
                 To_Unbounded_String ("<underflow_buffer_current_data_size>") &
                 xml_string (obj.underflow_buffer_current_data_size) &
                 To_Unbounded_String ("</underflow_buffer_current_data_size>");
            end if;

         when context_switch_overhead =>
            result :=
              result &
              To_Unbounded_String ("<switched_task ref=""") &
              obj.switched_task.cheddar_private_id &
              To_Unbounded_String (""" />");

         when running_task =>
            if (xml_string (obj.running_core) /= empty_string) then
               result :=
                 result &
                 To_Unbounded_String ("<running_core>") &
                 xml_string (obj.running_core) &
                 To_Unbounded_String ("</running_core>");
            end if;
            result :=
              result &
              To_Unbounded_String ("<running_task ref=""") &
              obj.running_task.cheddar_private_id &
              To_Unbounded_String (""" />");
            if (xml_string (obj.current_priority) /= empty_string) then
               result :=
                 result &
                 To_Unbounded_String ("<current_priority>") &
                 xml_string (obj.current_priority) &
                 To_Unbounded_String ("</current_priority>");
            end if;
            if (xml_string (obj.crpd) /= empty_string) then
               result :=
                 result &
                 To_Unbounded_String ("<crpd>") &
                 xml_string (obj.crpd) &
                 To_Unbounded_String ("</crpd>");
            end if;
            if (xml_string (obj.cache_state) /= empty_string) then
               result :=
                 result &
                 To_Unbounded_String ("<cache_state>") &
                 xml_string (obj.cache_state) &
                 To_Unbounded_String ("</cache_state>");
            end if;

         when task_activation =>
            result :=
              result &
              To_Unbounded_String ("<activation_task ref=""") &
              obj.activation_task.cheddar_private_id &
              To_Unbounded_String (""" />");

         when allocate_resource =>
            result :=
              result &
              To_Unbounded_String ("<allocate_task ref=""") &
              obj.allocate_task.cheddar_private_id &
              To_Unbounded_String (""" />");
            result :=
              result &
              To_Unbounded_String ("<allocate_resource ref=""") &
              obj.allocate_resource.cheddar_private_id &
              To_Unbounded_String (""" />");

         when release_resource =>
            result :=
              result &
              To_Unbounded_String ("<release_task ref=""") &
              obj.release_task.cheddar_private_id &
              To_Unbounded_String (""" />");
            result :=
              result &
              To_Unbounded_String ("<release_resource ref=""") &
              obj.release_resource.cheddar_private_id &
              To_Unbounded_String (""" />");

         when wait_for_resource =>
            result :=
              result &
              To_Unbounded_String ("<wait_for_resource_task ref=""") &
              obj.wait_for_resource_task.cheddar_private_id &
              To_Unbounded_String (""" />");
            result :=
              result &
              To_Unbounded_String ("<wait_for_resource ref=""") &
              obj.wait_for_resource.cheddar_private_id &
              To_Unbounded_String (""" />");

         when send_message =>
            result :=
              result &
              To_Unbounded_String ("<send_task ref=""") &
              obj.send_task.cheddar_private_id &
              To_Unbounded_String (""" />");
            result :=
              result &
              To_Unbounded_String ("<send_message ref=""") &
              obj.send_message.cheddar_private_id &
              To_Unbounded_String (""" />");

         when receive_message =>
            result :=
              result &
              To_Unbounded_String ("<receive_task ref=""") &
              obj.receive_task.cheddar_private_id &
              To_Unbounded_String (""" />");
            result :=
              result &
              To_Unbounded_String ("<receive_message ref=""") &
              obj.receive_message.cheddar_private_id &
              To_Unbounded_String (""" />");

         when wait_for_memory =>
            result :=
              result &
              To_Unbounded_String ("<wait_for_memory_task ref=""") &
              obj.wait_for_memory_task.cheddar_private_id &
              To_Unbounded_String (""" />");
            result :=
              result &
              To_Unbounded_String ("<wait_for_cache ref=""") &
              obj.wait_for_cache.cheddar_private_id &
              To_Unbounded_String (""" />");

         when address_space_activation =>
            if (xml_string (obj.activation_address_space) /= empty_string) then
               result :=
                 result &
                 To_Unbounded_String ("<activation_address_space>") &
                 xml_string (obj.activation_address_space) &
                 To_Unbounded_String ("</activation_address_space>");
            end if;
            if (xml_string (obj.duration) /= empty_string) then
               result :=
                 result &
                 To_Unbounded_String ("<duration>") &
                 xml_string (obj.duration) &
                 To_Unbounded_String ("</duration>");
            end if;

         when preemption =>
            result :=
              result &
              To_Unbounded_String ("<preempted_task ref=""") &
              obj.preempted_task.cheddar_private_id &
              To_Unbounded_String (""" />");
            result :=
              result &
              To_Unbounded_String ("<preempting_task ref=""") &
              obj.preempting_task.cheddar_private_id &
              To_Unbounded_String (""" />");
            if (xml_string (obj.evicted_ucbs) /= empty_string) then
               result :=
                 result &
                 To_Unbounded_String ("<evicted_ucbs>") &
                 xml_string (obj.evicted_ucbs) &
                 To_Unbounded_String ("</evicted_ucbs>");
            end if;

      end case;
      result := result & To_Unbounded_String ("</time_unit_event>");
      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, "<time_unit_event>");
      Put (into, "<type_of_event>");
      write_xml (into, obj.type_of_event);
      Put_Line (into, "</type_of_event>");

      case obj.type_of_event is
         when start_of_task_capacity =>
            Put_Line
              (into,
               "<start_task ref=""" &
               obj.start_task.cheddar_private_id &
               """ />");

         when end_of_task_capacity =>
            Put_Line
              (into,
               "<end_task ref=""" & obj.end_task.cheddar_private_id & """ />");

         when write_to_buffer =>
            Put_Line
              (into,
               "<write_buffer ref=""" &
               obj.write_buffer.cheddar_private_id &
               """ />");
            Put_Line
              (into,
               "<write_task ref=""" &
               obj.write_task.cheddar_private_id &
               """ />");
            Put (into, "<write_size>");
            write_xml (into, obj.write_size);
            Put_Line (into, "</write_size>");
            Put (into, "<write_buffer_current_data_size>");
            write_xml (into, obj.write_buffer_current_data_size);
            Put_Line (into, "</write_buffer_current_data_size>");

         when read_from_buffer =>
            Put_Line
              (into,
               "<read_buffer ref=""" &
               obj.read_buffer.cheddar_private_id &
               """ />");
            Put_Line
              (into,
               "<read_task ref=""" &
               obj.read_task.cheddar_private_id &
               """ />");
            Put (into, "<read_size>");
            write_xml (into, obj.read_size);
            Put_Line (into, "</read_size>");
            Put (into, "<read_buffer_current_data_size>");
            write_xml (into, obj.read_buffer_current_data_size);
            Put_Line (into, "</read_buffer_current_data_size>");

         when buffer_overflow =>
            Put_Line
              (into,
               "<overflow_buffer ref=""" &
               obj.overflow_buffer.cheddar_private_id &
               """ />");
            Put_Line
              (into,
               "<overflow_task ref=""" &
               obj.overflow_task.cheddar_private_id &
               """ />");
            Put (into, "<overflow_write_size>");
            write_xml (into, obj.overflow_write_size);
            Put_Line (into, "</overflow_write_size>");
            Put (into, "<overflow_buffer_current_data_size>");
            write_xml (into, obj.overflow_buffer_current_data_size);
            Put_Line (into, "</overflow_buffer_current_data_size>");

         when buffer_underflow =>
            Put_Line
              (into,
               "<underflow_buffer ref=""" &
               obj.underflow_buffer.cheddar_private_id &
               """ />");
            Put_Line
              (into,
               "<underflow_task ref=""" &
               obj.underflow_task.cheddar_private_id &
               """ />");
            Put (into, "<underflow_read_size>");
            write_xml (into, obj.underflow_read_size);
            Put_Line (into, "</underflow_read_size>");
            Put (into, "<underflow_buffer_current_data_size>");
            write_xml (into, obj.underflow_buffer_current_data_size);
            Put_Line (into, "</underflow_buffer_current_data_size>");

         when context_switch_overhead =>
            Put_Line
              (into,
               "<switched_task ref=""" &
               obj.switched_task.cheddar_private_id &
               """ />");

         when running_task =>
            Put (into, "<running_core>");
            write_xml (into, obj.running_core);
            Put_Line (into, "</running_core>");
            Put_Line
              (into,
               "<running_task ref=""" &
               obj.running_task.cheddar_private_id &
               """ />");
            Put (into, "<current_priority>");
            write_xml (into, obj.current_priority);
            Put_Line (into, "</current_priority>");
            Put (into, "<CRPD>");
            write_xml (into, obj.crpd);
            Put_Line (into, "</CRPD>");
            Put (into, "<cache_state>");
            write_xml (into, obj.cache_state);
            Put_Line (into, "</cache_state>");

         when task_activation =>
            Put_Line
              (into,
               "<activation_task ref=""" &
               obj.activation_task.cheddar_private_id &
               """ />");

         when allocate_resource =>
            Put_Line
              (into,
               "<allocate_task ref=""" &
               obj.allocate_task.cheddar_private_id &
               """ />");
            Put_Line
              (into,
               "<allocate_resource ref=""" &
               obj.allocate_resource.cheddar_private_id &
               """ />");

         when release_resource =>
            Put_Line
              (into,
               "<release_task ref=""" &
               obj.release_task.cheddar_private_id &
               """ />");
            Put_Line
              (into,
               "<release_resource ref=""" &
               obj.release_resource.cheddar_private_id &
               """ />");

         when wait_for_resource =>
            Put_Line
              (into,
               "<wait_for_resource_task ref=""" &
               obj.wait_for_resource_task.cheddar_private_id &
               """ />");
            Put_Line
              (into,
               "<wait_for_resource ref=""" &
               obj.wait_for_resource.cheddar_private_id &
               """ />");

         when send_message =>
            Put_Line
              (into,
               "<send_task ref=""" &
               obj.send_task.cheddar_private_id &
               """ />");
            Put_Line
              (into,
               "<send_message ref=""" &
               obj.send_message.cheddar_private_id &
               """ />");

         when receive_message =>
            Put_Line
              (into,
               "<receive_task ref=""" &
               obj.receive_task.cheddar_private_id &
               """ />");
            Put_Line
              (into,
               "<receive_message ref=""" &
               obj.receive_message.cheddar_private_id &
               """ />");

         when wait_for_memory =>
            Put_Line
              (into,
               "<wait_for_memory_task ref=""" &
               obj.wait_for_memory_task.cheddar_private_id &
               """ />");
            Put_Line
              (into,
               "<wait_for_cache ref=""" &
               obj.wait_for_cache.cheddar_private_id &
               """ />");

         when address_space_activation =>
            Put (into, "<activation_address_space>");
            write_xml (into, obj.activation_address_space);
            Put_Line (into, "</activation_address_space>");
            Put (into, "<duration>");
            write_xml (into, obj.duration);
            Put_Line (into, "</duration>");

         when preemption =>
            Put_Line
              (into,
               "<preempted_task ref=""" &
               obj.preempted_task.cheddar_private_id &
               """ />");
            Put_Line
              (into,
               "<preempting_task ref=""" &
               obj.preempting_task.cheddar_private_id &
               """ />");
            Put (into, "<evicted_ucbs>");
            write_xml (into, obj.evicted_ucbs);
            Put_Line (into, "</evicted_ucbs>");

      end case;
      Put_Line (into, "</time_unit_event>");
   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;