------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a GNU GPL real-time scheduling analysis tool. -- This program provides services to automatically check schedulability and -- other performance criteria of real-time architecture models. -- -- Copyright (C) 2002-2020, Frank Singhoff, Alain Plantec, Jerome Legrand, -- Hai Nam Tran, Stephane Rubini -- -- The Cheddar project was started in 2002 by -- Frank Singhoff, Lab-STICC UMR 6285, Université de Bretagne Occidentale -- -- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008. -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- The full list of contributors and sponsors can be found in AUTHORS.txt and SPONSORS.txt -- -- 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 -- ------------------------------------------------------------------------------ -- Last update : -- $Rev$ -- $Date$ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Ada.Exceptions; use Ada.Exceptions; with Gdk.Drawable; use Gdk.Drawable; with Gdk.Font; use Gdk.Font; with Gtk.Arguments; use Gtk.Arguments; with Gtk.Drawing_Area; use Gtk.Drawing_Area; with Gtk.Handlers; use Gtk.Handlers; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with GNAT.Current_Exception; use GNAT.Current_Exception; with processor_set; use processor_set; use processor_set.generic_processor_set; with tasks; use tasks; with resources; use resources; with messages; use messages; with buffers; use buffers; with address_spaces; use address_spaces; with address_space_set; use address_space_set; with core_units; use core_units; use core_units.core_units_table_package; with processors; use processors; with time_unit_events; use time_unit_events; use time_unit_events.time_unit_package; with unbounded_strings; use unbounded_strings; with time_unit_events.extended; use time_unit_events.extended; with framework_config; use framework_config; with translate; use translate; with graphical_editor.select_time_line; use graphical_editor.select_time_line; with objects; use objects; with editor_config; use editor_config; with Ada.Text_IO; use Ada.Text_IO; with Gdk.Window; use Gdk.Window; with Gdk.Color; use Gdk.Color; with Pango.Font; use Pango.Font; with scheduler_interface; use scheduler_interface; with processor_interface; use processor_interface; with graphical_editor.scheduling_simulation_draw_callbacks; use graphical_editor.scheduling_simulation_draw_callbacks; with graphical_editor.user_message; use graphical_editor.user_message; with graphical_editor.colors; use graphical_editor.colors; with graphical_editor; use graphical_editor; with debug; use debug; with double_util; use double_util; package body graphical_editor.draw_scheduling is package es_entiers is new Ada.Text_IO.Integer_IO (Integer); use es_entiers; procedure draw_time_line_axis (line_number : in gint) is line_size : gint; begin line_size := gint (graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling .period - graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling .start_draw); if line_size < 40 then line_size := 40; end if; Draw_Line (Get_Window (drawing_area_cheddar), graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .black_gc, left_margin, high_margin + line_number * interligne, left_margin + line_size * gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0), high_margin + line_number * interligne); -- For each line, draw unit time lines -- for j in 0 .. gint (Double (line_size) * zoom_values (zoom_level) / 100.0) loop Draw_Line (Get_Window (drawing_area_cheddar), graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling .black_gc, left_margin + j * timeunit_margin, high_margin + line_number * interligne - 3, left_margin + j * timeunit_margin, high_margin + line_number * interligne + 3); if j mod gint (display_witch_time_unit_label) = 0 then Draw_Text (Get_Window (drawing_area_cheddar), graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling .font, graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling .black_gc, left_margin + j * timeunit_margin, high_margin + line_number * interligne + 20, To_String (format (Double (j) * zoom_values (-1 * zoom_level) / 100.0, 2))); Gdk.GC.Set_Foreground (graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling .black_gc, Gdk.Color.Black (Gtk.Widget.Get_Default_Colormap)); Draw_Rectangle (Get_Window (drawing_area_cheddar), graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling .black_gc, True, left_margin + timeunit_margin * j, high_margin + line_number * interligne - 8, 3, 16); end if; end loop; exception when others => put_debug ("Draw_Time_Line_Axis : " & Exception_Name & " : " & Exception_Message); end draw_time_line_axis; procedure clear_time_line is begin Draw_Rectangle (Get_Window (drawing_area_cheddar), graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .white_gc, Filled => True, X => 0, Y => 0, Width => graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling .current_width, Height => graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling .current_height); end clear_time_line; procedure draw_time_line is begin draw_time_line (graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .period, graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .start_draw, graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .sched); end draw_time_line; procedure draw_time_line (period1 : Natural; start_draw1 : Natural; sched1 : in scheduling_table_ptr) is i : gint := 0; ok : Boolean := False; number_of_time_axis : gint := 0; my_processor_iterator : processors_iterator; a_processor : generic_processor_ptr; begin -- Select font to display text -- --Load (graphical_editor.scheduling_simulation_draw_callbacks.Draw_Scheduling.Font, -- to_string(selected_font)); graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .font := From_Description (From_String (To_String (selected_font))); -- White_Gc : color map to clean the drawing area -- Gdk.GC.Gdk_New (graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .white_gc, Get_Window (drawing_area_cheddar)); Gdk.GC.Set_Foreground (graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .white_gc, Gdk.Color.White (Gtk.Widget.Get_Default_Colormap)); -- Black_Gc : color map to draw the scheduling -- Gdk.GC.Gdk_New (graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .black_gc, Get_Window (drawing_area_cheddar)); Gdk.GC.Set_Foreground (graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .black_gc, Gdk.Color.Black (Gtk.Widget.Get_Default_Colormap)); -- Colors to display specific events from the event tables -- graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .red_color := Gdk.Color.Parse ("Red"); Gdk.Color.Alloc (Gtk.Widget.Get_Default_Colormap, graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .red_color); graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .blue_color := Gdk.Color.Parse ("Blue"); Gdk.Color.Alloc (Gtk.Widget.Get_Default_Colormap, graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .blue_color); graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .light_blue := Gdk.Color.Parse ("#87CEFA"); Gdk.Color.Alloc (Gtk.Widget.Get_Default_Colormap, graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .light_blue); graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .orange_color := Gdk.Color.Parse ("#FF4500"); Gdk.Color.Alloc (Gtk.Widget.Get_Default_Colormap, graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .orange_color); -- Save parameters of the caller -- graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .period := period1; graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .start_draw := start_draw1; graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .sched := sched1; -- Set default Widget size -- graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .current_width := 1000; graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .current_height := 400; -- Compute Width Widget size -- ok := False; i := (gint (period1 - start_draw1) * gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0)) + left_margin + right_margin; if i > graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .current_width then graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .current_width := i; ok := True; end if; -- Compute Height Widget size -- if is_empty (time_line_to_display) then number_of_time_axis := gint (get_number_of_elements (sys.tasks)); if schedule_with_resources then number_of_time_axis := number_of_time_axis + gint (get_number_of_elements (sys.resources)); end if; if schedule_with_precedencies then number_of_time_axis := number_of_time_axis + gint (get_number_of_elements (sys.messages)) + gint (get_number_of_elements (sys.buffers)); end if; else number_of_time_axis := number_of_time_axis + gint (get_number_of_elements (time_line_to_display)); end if; -- Compute size of the widget with the number of entity (tasks/resources/cores/...) -- if draw_core_unit_time_line then reset_iterator (sys.processors, my_processor_iterator); loop current_element (sys.processors, a_processor, my_processor_iterator); if a_processor.processor_type = monocore_type then number_of_time_axis := number_of_time_axis + 1; else number_of_time_axis := number_of_time_axis + gint (multi_cores_processor_ptr (a_processor).cores.nb_entries); end if; exit when is_last_element (sys.processors, my_processor_iterator); next_element (sys.processors, my_processor_iterator); end loop; end if; if draw_address_space_time_line then number_of_time_axis := number_of_time_axis + gint (get_number_of_elements (sys.address_spaces)); end if; -- Take care of Time line Axis -- We need some extra lines to display time axis lines -- number_of_time_axis := number_of_time_axis + (number_of_time_axis / gint (time_line_between_time_axis)) + 1; i := (interligne + 2) * number_of_time_axis + high_margin; if i > graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .current_height then graphical_editor.scheduling_simulation_draw_callbacks.draw_scheduling .current_height := i; ok := True; end if; if ok then Gtk.Drawing_Area.Set_USize (gtk_drawing_area (drawing_area_cheddar), graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling .current_width, graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling .current_height); end if; redraw_time_line (graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling); exception when others => put_debug ("Draw_Time_Line : " & Exception_Name & " : " & Exception_Message); end draw_time_line; procedure redraw_time_line (draw_scheduling : access draw_scheduling_record'class) is my_task_iterator : tasks_iterator; my_resource_iterator : resources_iterator; my_buffer_iterator : buffers_iterator; my_message_iterator : messages_iterator; my_processor_iterator : processors_iterator; my_address_space_iterator : address_spaces_iterator; a_task : generic_task_ptr; a_message : generic_message_ptr; a_resource : generic_resource_ptr; a_buffer : buffer_ptr; a_core : core_unit_ptr; an_address_space : address_space_ptr; a_processor : generic_processor_ptr; i : gint := 0; nb_cores : core_units.core_units_range; msg, name, name2 : Unbounded_String; subtype object_range is Natural range 1 .. (max_address_spaces + max_tasks + max_resources + max_buffers + max_messages + max_core_units); task_name : array (object_range) of Unbounded_String; resource_name : array (object_range) of Unbounded_String; message_name : array (object_range) of Unbounded_String; buffer_name : array (object_range) of Unbounded_String; core_name : array (object_range) of Unbounded_String; address_space_name : array (object_range) of Unbounded_String; object_id, object2_id : gint; time_u : gint; save_start_u : array (object_range) of gint := (others => 0); save_start_m : array (object_range) of gint := (others => 0); ok : Boolean; number_of_time_line : gint := 0; line_size : gint; begin -- Compute the horizontal line size -- line_size := gint (graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling .period - graphical_editor.scheduling_simulation_draw_callbacks .draw_scheduling .start_draw); if line_size < 40 then line_size := 40; end if; --------------------------------- -- Clear work space --------------------------------- Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.white_gc, Filled => True, X => 0, Y => 0, Width => draw_scheduling.current_width, Height => draw_scheduling.current_height); --------------------------------- -- Draw a line per task --------------------------------- i := 0; reset_iterator (sys.tasks, my_task_iterator); loop current_element (sys.tasks, a_task, my_task_iterator); if to_display (a_task.name, task_object_type) then msg := lb_task_name (current_language) & "=" & a_task.name & " "; case a_task.task_type is when aperiodic_type => msg := msg & lb_capacity (current_language) & To_Unbounded_String ("=") & a_task.capacity'img & To_Unbounded_String ("; ") & lb_deadline (current_language) & To_Unbounded_String ("=") & aperiodic_task_ptr (a_task).deadline'img & To_Unbounded_String ("; ") & lb_start_time (current_language) & To_Unbounded_String ("=") & a_task.start_time'img & To_Unbounded_String ("; ") & lb_priority (current_language) & To_Unbounded_String ("=") & a_task.priority'img; when others => msg := msg & lb_period (current_language) & To_Unbounded_String ("=") & periodic_task_ptr (a_task).period'img & To_Unbounded_String ("; ") & lb_capacity (current_language) & To_Unbounded_String ("=") & a_task.capacity'img & To_Unbounded_String ("; ") & lb_deadline (current_language) & To_Unbounded_String ("=") & periodic_task_ptr (a_task).deadline'img & To_Unbounded_String ("; ") & lb_start_time (current_language) & To_Unbounded_String ("=") & a_task.start_time'img & To_Unbounded_String ("; ") & lb_priority (current_language) & To_Unbounded_String ("=") & a_task.priority'img ; end case; if a_task.task_type = parametric_type then msg := msg & To_Unbounded_String (";") & lb_activation_rule (current_language) & To_Unbounded_String ("=") & parametric_task_ptr (a_task).activation_rule; end if; -- cpu name & core name -- if (a_task.core_name/=empty_string) then msg := msg & To_Unbounded_String ("; Core Unit/Processor name=") & a_task.core_name & To_Unbounded_String ("/") & a_task.cpu_name; else msg := msg & To_Unbounded_String ("; Processor name= ") & a_task.cpu_name; end if; -- Draw axis time line if necessary -- if (number_of_time_line mod gint (time_line_between_time_axis)) = 0 then draw_time_line_axis (i); i := i + 1; end if; number_of_time_line := number_of_time_line + 1; Draw_Text (Get_Window (drawing_area_cheddar), draw_scheduling.font, draw_scheduling.black_gc, left_margin, high_margin + i * interligne + 20, To_String (msg)); Draw_Line (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, left_margin, high_margin + i * interligne, left_margin + gint (line_size) * gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0), high_margin + i * interligne); -- For each line, draw unit time lines -- for j in 0 .. gint (Double (line_size) * zoom_values (zoom_level) / 100.0) loop Draw_Line (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, left_margin + j * gint (timeunit_margin), high_margin + i * interligne - 3, left_margin + j * gint (timeunit_margin), high_margin + i * interligne + 3); end loop; -- Register each task in the name table -- task_name (object_range (i)) := a_task.name; i := i + 1; end if; exit when is_last_element (sys.tasks, my_task_iterator); next_element (sys.tasks, my_task_iterator); end loop; ---------------------------------------- -- Draw a line for each address space ---------------------------------------- if draw_address_space_time_line then reset_iterator (sys.address_spaces, my_address_space_iterator); loop current_element (sys.address_spaces, an_address_space, my_address_space_iterator); msg := lb_address_space_name (current_language) & "=" & an_address_space.name & " "; msg := msg & To_Unbounded_String ("Protocol = " & an_address_space.scheduling.scheduler_type'img); msg := msg & " ; " & an_address_space.scheduling.preemptive_type'img; -- Draw axis time line if necessary -- if (number_of_time_line mod gint (time_line_between_time_axis)) = 0 then draw_time_line_axis (i); i := i + 1; end if; number_of_time_line := number_of_time_line + 1; Draw_Text (Get_Window (drawing_area_cheddar), draw_scheduling.font, draw_scheduling.black_gc, left_margin, high_margin + i * interligne + 20, To_String (msg)); Draw_Line (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, left_margin, high_margin + i * interligne, left_margin + gint (line_size) * gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0), high_margin + i * interligne); -- For each line, draw unit time lines -- for j in 0 .. gint (Double (line_size) * zoom_values (zoom_level) / 100.0) loop Draw_Line (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, left_margin + j * gint (timeunit_margin), high_margin + i * interligne - 3, left_margin + j * gint (timeunit_margin), high_margin + i * interligne + 3); end loop; -- Register each task in the name table -- address_space_name (object_range (i)) := an_address_space.name; i := i + 1; exit when is_last_element (sys.address_spaces, my_address_space_iterator); next_element (sys.address_spaces, my_address_space_iterator); end loop; end if; ------------------------------------- -- Draw a line for each core ------------------------------------- if draw_core_unit_time_line then reset_iterator (sys.processors, my_processor_iterator); loop current_element (sys.processors, a_processor, my_processor_iterator); nb_cores := 0; loop if a_processor.processor_type = monocore_type then a_core := mono_core_processor_ptr (a_processor).core; else a_core := multi_cores_processor_ptr (a_processor).cores.entries (nb_cores); end if; msg := "Core Unit/Processor name= " & a_core.name & "/" & a_processor.name & " "; msg := msg & To_Unbounded_String ("Protocol = " & a_core.scheduling.scheduler_type'img); msg := msg & " ; " & a_core.scheduling.preemptive_type'img; msg := msg & " ; " & To_Unbounded_String ("Speed = " & a_core.speed'img); -- Draw axis time line if necessary -- if (number_of_time_line mod gint (time_line_between_time_axis)) = 0 then draw_time_line_axis (i); i := i + 1; end if; number_of_time_line := number_of_time_line + 1; Draw_Text (Get_Window (drawing_area_cheddar), draw_scheduling.font, draw_scheduling.black_gc, left_margin, high_margin + i * interligne + 20, To_String (msg)); Draw_Line (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, left_margin, high_margin + i * interligne, left_margin + gint (line_size) * gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0), high_margin + i * interligne); -- For each line, draw unit time lines -- for j in 0 .. gint (Double (line_size) * zoom_values (zoom_level) / 100.0) loop Draw_Line (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, left_margin + j * gint (timeunit_margin), high_margin + i * interligne - 3, left_margin + j * gint (timeunit_margin), high_margin + i * interligne + 3); end loop; -- Register each core in the name table -- core_name (object_range (i)) := a_core.name & "/" & a_processor.name; i := i + 1; nb_cores := nb_cores + 1; if a_processor.processor_type = monocore_type then exit; else if nb_cores = multi_cores_processor_ptr (a_processor).cores.nb_entries then exit; end if; end if; end loop; exit when is_last_element (sys.processors, my_processor_iterator); next_element (sys.processors, my_processor_iterator); end loop; end if; ------------------------------------- -- Draw a line for each resource ------------------------------------- if schedule_with_resources then if not is_empty (sys.resources) then reset_iterator (sys.resources, my_resource_iterator); loop current_element (sys.resources, a_resource, my_resource_iterator); if to_display (a_resource.name, resource_object_type) then msg := lb_resource_name (current_language) & "=" & a_resource.name & " "; msg := msg & "Protocol = " & a_resource.protocol'img; msg := msg & To_Unbounded_String ("; Cpu=") & a_resource.cpu_name; -- Draw axis time line if necessary -- if (number_of_time_line mod gint (time_line_between_time_axis)) = 0 then draw_time_line_axis (i); i := i + 1; end if; number_of_time_line := number_of_time_line + 1; Draw_Text (Get_Window (drawing_area_cheddar), draw_scheduling.font, draw_scheduling.black_gc, left_margin, high_margin + i * interligne + 20, To_String (msg)); Draw_Line (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, left_margin, high_margin + i * interligne, left_margin + gint (line_size) * gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0), high_margin + i * interligne); -- For each line, draw unit time lines -- for j in 0 .. gint (Double (line_size) * zoom_values (zoom_level) / 100.0) loop Draw_Line (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, left_margin + j * gint (timeunit_margin), high_margin + i * interligne - 3, left_margin + j * gint (timeunit_margin), high_margin + i * interligne + 3); end loop; -- Register each resource in the name table -- resource_name (object_range (i)) := a_resource.name; i := i + 1; end if; exit when is_last_element (sys.resources, my_resource_iterator); next_element (sys.resources, my_resource_iterator); end loop; end if; end if; ------------------------------------- -- Draw a line for each message ------------------------------------- if schedule_with_precedencies then if not is_empty (sys.messages) then reset_iterator (sys.messages, my_message_iterator); loop current_element (sys.messages, a_message, my_message_iterator); if to_display (a_message.name, message_object_type) then msg := lb_message_name (current_language) & "=" & a_message.name & " "; if a_message.message_type = periodic_type then msg := msg & To_Unbounded_String ("Period=") & periodic_message_ptr (a_message).period'img; else msg := msg & To_Unbounded_String (" ;Period= 0"); end if; msg := msg & To_Unbounded_String (" ; Response time=") & a_message.response_time'img; msg := msg & To_Unbounded_String (" ; Size = ") & a_message.size'img; -- Draw axis time line if necessary -- if (number_of_time_line mod gint (time_line_between_time_axis)) = 0 then draw_time_line_axis (i); i := i + 1; end if; number_of_time_line := number_of_time_line + 1; Draw_Text (Get_Window (drawing_area_cheddar), draw_scheduling.font, draw_scheduling.black_gc, left_margin, high_margin + i * interligne + 20, To_String (msg)); Draw_Line (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, left_margin, high_margin + i * interligne, left_margin + gint (line_size) * gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0), high_margin + i * interligne); -- For each line, draw unit time lines -- for j in 0 .. gint (Double (line_size) * zoom_values (zoom_level) / 100.0) loop Draw_Line (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, left_margin + j * gint (timeunit_margin), high_margin + i * interligne - 3, left_margin + j * gint (timeunit_margin), high_margin + i * interligne + 3); end loop; -- Register each message in the name table -- message_name (object_range (i)) := a_message.name; i := i + 1; end if; exit when is_last_element (sys.messages, my_message_iterator); next_element (sys.messages, my_message_iterator); end loop; end if; ------------------------------------- -- Draw a line for each buffer ------------------------------------- if not is_empty (sys.buffers) then reset_iterator (sys.buffers, my_buffer_iterator); loop current_element (sys.buffers, a_buffer, my_buffer_iterator); if to_display (a_buffer.name, buffer_object_type) then msg := lb_buffer_name (current_language) & "=" & a_buffer.name & " "; msg := msg & To_Unbounded_String ("Size = ") & a_buffer.buffer_size'img; msg := msg & To_Unbounded_String (" ; Cpu = ") & a_buffer.cpu_name; -- Draw axis time line if necessary -- if (number_of_time_line mod gint (time_line_between_time_axis)) = 0 then draw_time_line_axis (i); i := i + 1; end if; number_of_time_line := number_of_time_line + 1; Draw_Text (Get_Window (drawing_area_cheddar), draw_scheduling.font, draw_scheduling.black_gc, left_margin, high_margin + i * interligne + 20, To_String (msg)); Draw_Line (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, left_margin, high_margin + i * interligne, left_margin + gint (line_size) * gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0), high_margin + i * interligne); -- For each line, draw unit time lines -- for j in 0 .. gint (Double (line_size) * zoom_values (zoom_level) / 100.0) loop Draw_Line (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, left_margin + j * gint (timeunit_margin), high_margin + i * interligne - 3, left_margin + j * gint (timeunit_margin), high_margin + i * interligne + 3); end loop; -- Register each buffer in the name table -- buffer_name (object_range (i)) := a_buffer.name; i := i + 1; end if; exit when is_last_element (sys.buffers, my_buffer_iterator); next_element (sys.buffers, my_buffer_iterator); end loop; end if; end if; ------------------------------------------ -- Draw information from scheduling table ------------------------------------------ --------------------------------------------------------- -- Draw background data : i.e. draw horizontal rectangle --------------------------------------------------------- for u in 0 .. draw_scheduling.sched.nb_entries - 1 loop if draw_scheduling.sched.entries (u).data.error_msg = empty_string then -- Scan scheduling sequence, but only for period-start-draw units -- of times -- for k in 0 .. draw_scheduling.sched.entries (u).data.result.nb_entries - 1 loop if (draw_scheduling.sched.entries (u).data.result.entries (k) .item >= draw_scheduling.start_draw) and (draw_scheduling.sched.entries (u).data.result.entries (k) .item <= draw_scheduling.period) then case draw_scheduling.sched.entries (u).data.result.entries (k) .data .type_of_event is ---------------------------------------- -- Draw task running time in black -- (time when the task owns the processor) -- Draw both in the task line and its assigned core/processor -- (we then draw two boxes) ---------------------------------------- when running_task => time_u := gint (draw_scheduling.sched.entries (u).data.result .entries (k) .item - draw_scheduling.start_draw); -- Draw data in the task time line -- name := draw_scheduling.sched.entries (u).data.result.entries (k) .data .running_task .name; if to_display (name, task_object_type) then ok := False; for l in object_range loop if (task_name (l) = name) then ok := True; object_id := gint (l); end if; end loop; if not ok then Raise_Exception (task_not_found'identity, To_String (name)); end if; -- Set color -- if not several_colors_for_time_lines then Gdk.GC.Set_Foreground (draw_scheduling.black_gc, Gdk.Color.Black (Gtk.Widget.Get_Default_Colormap)); else Gdk.GC.Set_Foreground (draw_scheduling.black_gc, colors.colors (to_color (Natural (object_id)))); end if; -- Different color for CRPD -- TODO: The case when several_colors_for_time_lines is active. if (draw_scheduling.sched.entries (u).data.result .entries (k) .data .crpd > 0) then Gdk.GC.Set_Foreground (draw_scheduling.black_gc, draw_scheduling.red_color); end if; Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u + left_margin, object_id * interligne + high_margin - 3, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) + 1, 7); end if; -- Draw data in the core time line -- if draw_core_unit_time_line then name := draw_scheduling.sched.entries (u).data.result .entries (k) .data .running_core & "/" & draw_scheduling.sched.entries (u).data.result .entries (k) .data .running_task .cpu_name; ok := False; for l in object_range loop if (core_name (l) = name) then ok := True; object_id := gint (l); end if; end loop; if not ok then Raise_Exception (core_unit_not_found'identity, To_String (name)); end if; Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u + left_margin, object_id * interligne + high_margin - 3, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) + 1, 7); end if; -- Draw data in the address space time line -- if draw_address_space_time_line then name := draw_scheduling.sched.entries (u).data.result .entries (k) .data .running_task .address_space_name; ok := False; for l in object_range loop if (address_space_name (l) = name) then ok := True; object_id := gint (l); end if; end loop; if not ok then Raise_Exception (address_space_not_found'identity, To_String (name)); end if; Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u + left_margin, object_id * interligne + high_margin - 3, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) + 1, 7); end if; ---------------------------------------- -- Draw task switching time in black ---------------------------------------- when context_switch_overhead => name := draw_scheduling.sched.entries (u).data.result.entries (k) .data .switched_task .name; if to_display (name, task_object_type) then ok := False; for l in object_range loop if (task_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item - draw_scheduling.start_draw); end if; end loop; if not ok then Raise_Exception (task_not_found'identity, To_String (name)); end if; Gdk.GC.Set_Foreground (draw_scheduling.black_gc, draw_scheduling.red_color); Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u + left_margin, object_id * interligne + high_margin - 3, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) + 1, 7); end if; ----------------------------------------------------- -- Draw shared resource allocation in blue color ----------------------------------------------------- when allocate_resource => name := draw_scheduling.sched.entries (u).data.result.entries (k) .data .allocate_resource .name; if to_display (name, resource_object_type) then ok := False; for l in object_range loop if (resource_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item - draw_scheduling.start_draw); end if; end loop; if not ok then Raise_Exception (resource_not_found'identity, To_String (name)); end if; save_start_u (object_range (object_id)) := left_margin + gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u; end if; ---------------------------------------- -- Draw shared resource releasing in black ---------------------------------------- when release_resource => name := draw_scheduling.sched.entries (u).data.result.entries (k) .data .release_resource .name; if to_display (name, resource_object_type) then ok := False; for l in object_range loop if (resource_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item - draw_scheduling.start_draw) + 1; end if; end loop; if not ok then Raise_Exception (resource_not_found'identity, To_String (name)); end if; ok := False; name2 := draw_scheduling.sched.entries (u).data.result .entries (k) .data .release_task .name; for l in object_range loop if (task_name (l) = name2) then ok := True; object2_id := gint (l); end if; end loop; if not ok then Raise_Exception (task_not_found'identity, To_String (name2)); end if; -- Set color depending on the task -- if not several_colors_for_time_lines then Gdk.GC.Set_Foreground (draw_scheduling.black_gc, Gdk.Color.Black (Gtk.Widget.Get_Default_Colormap)); else Gdk.GC.Set_Foreground (draw_scheduling.black_gc, colors.colors (to_color (Natural (object2_id)))); end if; Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, save_start_u (object_range (object_id)), object_id * interligne + high_margin - 3, left_margin + gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u - save_start_u (object_range (object_id)) + 1, 7); end if; ---------------------------------------------------- -- Event about buffers -- Draw in red buffer write and in blue buffer read ---------------------------------------------------- when write_to_buffer => name := draw_scheduling.sched.entries (u).data.result.entries (k) .data .write_buffer .name; if to_display (name, buffer_object_type) then ok := False; for l in object_range loop if (buffer_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item); end if; end loop; if not ok then Raise_Exception (buffer_not_found'identity, To_String (name)); end if; Gdk.GC.Set_Foreground (draw_scheduling.black_gc, draw_scheduling.blue_color); Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u + left_margin, object_id * interligne + high_margin - 3, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) + 1, 7); end if; when read_from_buffer => name := draw_scheduling.sched.entries (u).data.result.entries (k) .data .read_buffer .name; if to_display (name, buffer_object_type) then ok := False; for l in object_range loop if (buffer_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item - draw_scheduling.start_draw); end if; end loop; if not ok then Raise_Exception (buffer_not_found'identity, To_String (name)); end if; Gdk.GC.Set_Foreground (draw_scheduling.black_gc, draw_scheduling.red_color); Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u + left_margin, object_id * interligne + high_margin - 3, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) + 1, 7); end if; when buffer_underflow => name := draw_scheduling.sched.entries (u).data.result.entries (k) .data .underflow_buffer .name; if to_display (name, buffer_object_type) then ok := False; for l in object_range loop if (buffer_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item - draw_scheduling.start_draw); end if; end loop; if not ok then Raise_Exception (buffer_not_found'identity, To_String (name)); end if; Gdk.GC.Set_Foreground (draw_scheduling.black_gc, draw_scheduling.orange_color); Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u + left_margin, object_id * interligne + high_margin - 3, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) + 1, 7); end if; when buffer_overflow => name := draw_scheduling.sched.entries (u).data.result.entries (k) .data .overflow_buffer .name; if to_display (name, buffer_object_type) then ok := False; for l in object_range loop if (buffer_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item - draw_scheduling.start_draw); end if; end loop; if not ok then Raise_Exception (buffer_not_found'identity, To_String (name)); end if; Gdk.GC.Set_Foreground (draw_scheduling.black_gc, draw_scheduling.light_blue); Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u + left_margin, object_id * interligne + high_margin - 3, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) + 1, 7); end if; ---------------------------------------- -- Event about messages -- Draw in red message communication time ---------------------------------------- when send_message => name := draw_scheduling.sched.entries (u).data.result.entries (k) .data .send_message .name; if to_display (name, message_object_type) then ok := False; for l in object_range loop if (message_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item); end if; end loop; if not ok then Raise_Exception (message_not_found'identity, To_String (name)); end if; -- Save the time the message is sent -- save_start_m (object_range (object_id)) := time_u; end if; when receive_message => name := draw_scheduling.sched.entries (u).data.result.entries (k) .data .receive_message .name; if to_display (name, message_object_type) then ok := False; for l in object_range loop if (message_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item - draw_scheduling.start_draw); end if; end loop; if not ok then Raise_Exception (message_not_found'identity, To_String (name)); end if; Gdk.GC.Set_Foreground (draw_scheduling.black_gc, draw_scheduling.red_color); end if; Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, left_margin + save_start_m (object_range (object_id)) * gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0), object_id * interligne + high_margin - 3, gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * (time_u - save_start_m (object_range (object_id))) + 1, 7); ------------------------------------------- -- Events we have nothing to display ------------------------------------------- when others => null; end case; end if; end loop; end if; end loop; --------------------------------------------------------- -- Draw foreground data : i.e. draw vertical rectangle --------------------------------------------------------- for u in 0 .. draw_scheduling.sched.nb_entries - 1 loop if draw_scheduling.sched.entries (u).data.error_msg = empty_string then -- Scan scheduling sequence, but only for period-start-draw units -- of times -- for k in 0 .. draw_scheduling.sched.entries (u).data.result.nb_entries - 1 loop if (draw_scheduling.sched.entries (u).data.result.entries (k) .item >= draw_scheduling.start_draw) and (draw_scheduling.sched.entries (u).data.result.entries (k) .item <= draw_scheduling.period) then case draw_scheduling.sched.entries (u).data.result.entries (k) .data .type_of_event is -------------------------------------------------------- -- Draw in blue when a task has to wait for a resource -------------------------------------------------------- when wait_for_resource => if display_wait_for_resource then name := draw_scheduling.sched.entries (u).data.result .entries (k) .data .wait_for_resource_task .name; if to_display (name, task_object_type) then ok := False; for l in object_range loop if (task_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item - draw_scheduling.start_draw); end if; end loop; if not ok then Raise_Exception (task_not_found'identity, To_String (name)); end if; Gdk.GC.Set_Foreground (draw_scheduling.black_gc, draw_scheduling.blue_color); Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, left_margin + gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u, high_margin + object_id * interligne - 8, 3, 16); end if; end if; ----------------------------------------------------- -- Draw each address space wake up time in red ----------------------------------------------------- when address_space_activation => if draw_address_space_time_line then name := draw_scheduling.sched.entries (u).data.result .entries (k) .data .activation_address_space; if to_display (name, address_space_object_type) then ok := False; for l in object_range loop if (address_space_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item - draw_scheduling.start_draw); end if; end loop; if not ok then Raise_Exception (address_space_not_found'identity, To_String (name)); end if; if display_address_space_activation then Gdk.GC.Set_Foreground (draw_scheduling.black_gc, draw_scheduling.red_color); Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, left_margin + gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u, high_margin + object_id * interligne - 8, 3, 16); end if; if display_address_space_completion then if time_u + gint (draw_scheduling.sched.entries (u).data .result .entries (k) .data .duration) <= gint (graphical_editor .scheduling_simulation_draw_callbacks .draw_scheduling .period + graphical_editor .scheduling_simulation_draw_callbacks .draw_scheduling .start_draw) then Gdk.GC.Set_Foreground (draw_scheduling.black_gc, draw_scheduling.blue_color); Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, left_margin + gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * (time_u + gint (draw_scheduling.sched.entries (u) .data .result .entries (k) .data .duration)), high_margin + object_id * interligne - 8, 3, 16); end if; end if; end if; end if; ----------------------------------------------------- -- Draw each task wake up time in red ----------------------------------------------------- when task_activation => if display_task_activation then name := draw_scheduling.sched.entries (u).data.result .entries (k) .data .activation_task .name; if to_display (name, task_object_type) then ok := False; for l in object_range loop if (task_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item - draw_scheduling.start_draw); end if; end loop; if not ok then Raise_Exception (task_not_found'identity, To_String (name)); end if; Gdk.GC.Set_Foreground (draw_scheduling.black_gc, draw_scheduling.red_color); Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, left_margin + gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u, high_margin + object_id * interligne - 8, 3, 16); end if; end if; ----------------------------------------------------- -- Draw shared resource allocation in blue color ----------------------------------------------------- when allocate_resource => if display_allocate_resource then name := draw_scheduling.sched.entries (u).data.result .entries (k) .data .allocate_resource .name; if to_display (name, resource_object_type) then ok := False; for l in object_range loop if (resource_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item - draw_scheduling.start_draw); end if; end loop; if not ok then Raise_Exception (resource_not_found'identity, To_String (name)); end if; Gdk.GC.Set_Foreground (draw_scheduling.black_gc, draw_scheduling.blue_color); Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, left_margin + gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * time_u, high_margin + object_id * interligne - 8, 3, 16); end if; end if; ----------------------------------------------------- -- Draw shared resource release in red color ----------------------------------------------------- when release_resource => if display_release_resource then name := draw_scheduling.sched.entries (u).data.result .entries (k) .data .release_resource .name; if to_display (name, resource_object_type) then ok := False; for l in object_range loop if (resource_name (l) = name) then ok := True; object_id := gint (l); time_u := gint (draw_scheduling.sched.entries (u).data .result .entries (k) .item - draw_scheduling.start_draw); end if; end loop; if not ok then Raise_Exception (resource_not_found'identity, To_String (name)); end if; Gdk.GC.Set_Foreground (draw_scheduling.black_gc, draw_scheduling.red_color); Draw_Rectangle (Get_Window (drawing_area_cheddar), draw_scheduling.black_gc, True, left_margin + (gint (Double (timeunit_margin) * zoom_values (zoom_level) / 100.0) * (time_u + 1)), high_margin + object_id * interligne - 8, 3, 16); end if; end if; ------------------------------------------- -- Events we have nothing to display ------------------------------------------- when others => null; end case; end if; end loop; end if; end loop; Gdk.GC.Set_Foreground (draw_scheduling.black_gc, Gdk.Color.Black (Gtk.Widget.Get_Default_Colormap)); exception when others => put_debug ("Redraw_Time_Line : " & Exception_Name & " : " & Exception_Message); end redraw_time_line; end graphical_editor.draw_scheduling;