------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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-2023, 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 README.md -- -- 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: 4211 $ -- $Date: 2022-09-26 17:16:28 +0200 (lun., 26 sept. 2022) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Ada.Exceptions; use Ada.Exceptions; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with GNAT.Current_Exception; use GNAT.Current_Exception; with Ada.Text_IO; use Ada.Text_IO; with Glib; use Glib; with Gdk.Types; use Gdk.Types; with Gdk.Window; use Gdk.Window; with Cairo; use Cairo; 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 batteries; use batteries; with address_spaces; use address_spaces; with core_units; use core_units; use core_units.core_units_table_package; with processors; use processors; with address_space_set; use address_space_set; with buffer_set; use buffer_set; with task_set; use task_set; with resource_set; use resource_set; with message_set; use message_set; with processor_set; use processor_set; with battery_set; use battery_set; with time_unit_events; use time_unit_events; use time_unit_events.time_unit_package; with time_unit_events.extended; use time_unit_events.extended; with unbounded_strings; use unbounded_strings; with framework_config; use framework_config; with translate; use translate; with objects; use objects; with editor_config; use editor_config; with scheduler_interface; use scheduler_interface; with processor_interface; use processor_interface; with debug; use debug; with double_util; use double_util; with multiprocessor_services_interface; use multiprocessor_services_interface; use multiprocessor_services_interface.scheduling_result_per_processor_package; with execution_units; use execution_units; use execution_units.Execution_Units_Table_Package; with graphical_editor.user_message; use graphical_editor.user_message; with graphical_editor.colors; use graphical_editor.colors; with graphical_editor.select_time_line; use graphical_editor.select_time_line; package body graphical_editor.draw_scheduling is ------------------------------------------ -- Draw all events of a scheduling table ------------------------------------------ -- Large data to redraw time lines -- subtype object_range is Natural range 1 .. (max_address_spaces + max_tasks + max_resources + max_buffers + max_messages + max_batteries + 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; battery_name : array (object_range) of Unbounded_String; 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; my_battery_iterator : batteries_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; a_battery : battery_ptr; i : gint := 0; nb_cores : core_units.core_units_range; msg, name, name2 : Unbounded_String; object_id, object2_id : gint; time_u : gdouble; save_start_u : array (object_range) of gdouble := (others => 0.0); number_of_time_line : gint := 0; number_of_time_axis : gint := 0; line_size : gdouble; ok : Boolean := False; -- Draw axis for each CheddarADL entities -- procedure draw_axis (line_number : in gint) is must_draw_units : boolean :=false; begin Set_color(cr, black); Move_To (Cr, left_margin, high_margin + gdouble(line_number) * interligne); Line_To (Cr, left_margin + line_size * timeunit_margin * zoom_values (zoom_level) / 100.0, high_margin + gdouble(line_number) * interligne); Stroke (Cr); -- For each line, draw vertical unit time lines -- for j in 0 .. gint (line_size * zoom_values (zoom_level) / 100.0) loop Move_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(line_number) * interligne - 3.0); Line_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(line_number) * interligne + 3.0); Stroke (Cr); -- For some zoom level, we dot display all data -- as the drawing area is too small -- must_draw_units:=false; if zoom_level > 2 then must_draw_units := j mod gint (display_witch_time_unit_label*2) = 0; else must_draw_units := j mod gint (display_witch_time_unit_label) = 0; end if; -- Draw time value under the time line -- if must_draw_units then Move_To (Cr, left_margin + gdouble(j) * timeunit_margin +1.0, high_margin + gdouble(line_number) * interligne + 20.0); Show_Text (Cr, To_String (format (Double (gdouble(j) * zoom_values (-1 * zoom_level)) / 100.0, 2) )); Stroke (Cr); end if; end loop; exception when others => put_debug ("draw_axis : " & Exception_Name & " : " & Exception_Message); end draw_axis; procedure clear_time_line is begin Cr := Create (surface); Set_Source_Rgb (Cr, 1.0, 1.0, 1.0); Paint (Cr); Destroy (Cr); Cr := Create (surface); Set_Source_Rgba (Cr, 1.0, 1.0, 1.0, 1.0); Rectangle(cr, 0.0, 0.0, gdouble(current_width), gdouble(current_height)); Fill(cr); Stroke (Cr); Send_Draw_Event(drawing_area_cheddar); exception when others => put_debug ("clear_time_line : " & Exception_Name & " : " & Exception_Message); end clear_time_line; procedure draw_scheduling_events ( period1 : in Natural; start_draw1 : in Natural) is begin draw_scheduling.period:=period1; draw_scheduling.start_draw:=start_draw1; number_of_time_line := 0; i := 0; number_of_time_axis := 0; ok := False; Cr := Create(surface); compute_drawingarea_size; ------------------------------------------- -- Draw time line ------------------------------------------- draw_entity_lines; ------------------------------------------ -- Draw information from scheduling table ------------------------------------------ draw_horizontal_data; --------------------------------------------------------- -- Draw horizontal rectangle --------------------------------------------------------- draw_vertical_data; Send_Draw_Event(drawing_area_cheddar); end draw_scheduling_events; -- Compute the size of the drawing area according to the -- Cheddar ADL entities to display -- procedure compute_drawingarea_size is begin -- Compute the how much simulation results we must display -- according to the current zoom level -- if (zoom_level>0) then zoomed_period:=natural(gdouble(period) * zoom_values (zoom_level) / 100.0); else zoomed_period:=period; end if; ok := False; -- Compute Widget size -- i := gint (zoomed_period - start_draw) * gint (timeunit_margin * zoom_values (zoom_level) / 100.0) + gint (left_margin + right_margin); if i > current_width then current_width := i; ok := True; end if; 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 := gint(interligne + 2.0) * number_of_time_axis + gint(high_margin); if i > current_height then current_height := i; ok := True; end if; if ok then drawing_area_cheddar.Set_Size_Request (current_width, current_height); end if; -- Compute the horizontal line size -- line_size := gdouble (zoomed_period - start_draw); if line_size < 40.0 then line_size := 40.0; end if; exception when others => put_debug ("compute_drawingarea_size: " & Exception_Name & " : " & Exception_Message); end compute_drawingarea_size; -- Draw all horizontal time lines -- procedure draw_entity_lines is begin -- All time line are in black -- Set_color(cr, black); --------------------------------- -- 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 := "Task=" & a_task.name & " " & to_unbounded_string("Type=") & a_task.task_type'img & To_Unbounded_String ("; "); msg := msg & lb_capacity (current_language) & To_Unbounded_String ("="); if a_task.capacity_model = mixedcriticality_Execution_Unit then msg := msg & "("; for i in 0..a_task.capacities.nb_entries-1 loop msg:=msg & a_task.capacities.entries(i).values_eu'img & ","; end loop; msg := msg & "); "; else msg := msg & a_task.capacity'img & To_Unbounded_String ("; "); end if; case a_task.task_type is when aperiodic_type => msg := msg & 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_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 & 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=") & a_task.core_name & To_Unbounded_String ("/") & a_task.cpu_name; else msg := msg & To_Unbounded_String ("; Processor=") & 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_axis (i); i := i + 1; end if; number_of_time_line := number_of_time_line + 1; Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne + 20.0); Show_Text (Cr, To_String (msg)); Stroke (Cr); Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne); Line_To (Cr, left_margin + line_size * timeunit_margin * zoom_values (zoom_level) / 100.0, high_margin + gdouble(i) * interligne); Stroke (Cr); -- For each line, draw unit time lines -- for j in 0 .. gint (line_size * zoom_values (zoom_level) / 100.0) loop Move_To (Cr, left_margin + gdouble(j) * timeunit_margin + 1.0, high_margin + gdouble(i) * interligne - 3.0); Line_To (Cr, left_margin + gdouble(j) * timeunit_margin + 1.0, high_margin + gdouble(i) * interligne + 3.0); Stroke (Cr); 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 := "Address space=" & 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_axis (i); i := i + 1; end if; number_of_time_line := number_of_time_line + 1; Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne + 20.0); Show_Text (Cr, To_String (msg)); Stroke (Cr); Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne); Line_To (Cr, left_margin + line_size * timeunit_margin * zoom_values (zoom_level) / 100.0, high_margin + gdouble(i) * interligne); Stroke (Cr); -- For each line, draw unit time lines -- for j in 0 .. gint (line_size * zoom_values (zoom_level) / 100.0) loop Move_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(i) * interligne - 3.0); Line_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(i) * interligne + 3.0); Stroke (Cr); end loop; -- Register each address space 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=" & 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_axis (i); i := i + 1; end if; number_of_time_line := number_of_time_line + 1; Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne + 20.0); Show_Text (Cr, To_String (msg)); Stroke (Cr); Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne); Line_To (Cr, left_margin + line_size * timeunit_margin * zoom_values (zoom_level) / 100.0, high_margin + gdouble(i) * interligne); Stroke (Cr); -- For each line, draw unit time lines -- for j in 0 .. gint (line_size * zoom_values (zoom_level) / 100.0) loop Move_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(i) * interligne - 3.0); Line_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(i) * interligne + 3.0); Stroke (Cr); 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 := "Resource=" & a_resource.name & " "; msg := msg & "Protocol=" & a_resource.protocol'img; msg := msg & To_Unbounded_String ("; Processor=") & 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_axis(i); i := i + 1; end if; number_of_time_line := number_of_time_line + 1; Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne + 20.0); Show_Text (Cr, To_String (msg)); Stroke (Cr); Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne); Line_To (Cr, left_margin + line_size * timeunit_margin * zoom_values (zoom_level) / 100.0, high_margin + gdouble(i) * interligne); Stroke (Cr); -- For each line, draw unit time lines -- for j in 0 .. gint (line_size * zoom_values (zoom_level) / 100.0) loop Move_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(i) * interligne - 3.0); Line_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(i) * interligne + 3.0); Stroke (Cr); 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 := "Message=" & 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_axis (i); i := i + 1; end if; number_of_time_line := number_of_time_line + 1; Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne + 20.0); Show_Text (Cr, To_String (msg)); Stroke (Cr); Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne); Line_To (Cr, left_margin + line_size * timeunit_margin * zoom_values (zoom_level) / 100.0, high_margin + gdouble(i) * interligne); Stroke (Cr); -- For each line, draw unit time lines -- for j in 0 .. gint (line_size * zoom_values (zoom_level) / 100.0) loop Move_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(i) * interligne - 3.0); Line_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(i) * interligne + 3.0); Stroke (Cr); 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 := "Buffer=" & a_buffer.name & " "; msg := msg & To_Unbounded_String ("Size=") & a_buffer.buffer_size'img; msg := msg & To_Unbounded_String (" ; Processor=") & 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_axis (i); i := i + 1; end if; number_of_time_line := number_of_time_line + 1; Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne + 20.0); Show_Text (Cr, To_String (msg)); Stroke (Cr); Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne); Line_To (Cr, left_margin + line_size * timeunit_margin * zoom_values (zoom_level) / 100.0, high_margin + gdouble(i) * interligne); Stroke (Cr); -- For each line, draw unit time lines -- for j in 0 .. gint (line_size * zoom_values (zoom_level) / 100.0) loop Move_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(i) * interligne - 3.0); Line_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(i) * interligne + 3.0); Stroke (Cr); 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 a large line for each battery ------------------------------------- if not is_empty (sys.batteries) then reset_iterator (sys.batteries, my_battery_iterator); loop current_element (sys.batteries, a_battery, my_battery_iterator); if to_display (a_battery.name, battery_object_type) then msg := "Battery=" & a_battery.name & " "; msg := msg & To_Unbounded_String (" ; Processor=") & a_battery.cpu_name & To_Unbounded_String (" ; Capacity=") & a_battery.capacity'img & To_Unbounded_String ("; "); -- Draw axis between each battery drawing -- draw_axis (i); i := i + 3; Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne + 20.0); Show_Text (Cr, To_String (msg)); Stroke (Cr); Move_To (Cr, left_margin, high_margin + gdouble(i) * interligne); Line_To (Cr, left_margin + line_size * timeunit_margin * zoom_values (zoom_level) / 100.0, high_margin + gdouble(i) * interligne); Stroke (Cr); -- For each line, draw unit time lines -- for j in 0 .. gint (line_size * zoom_values (zoom_level) / 100.0) loop Move_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(i) * interligne - 3.0); Line_To (Cr, left_margin + gdouble(j) * timeunit_margin, high_margin + gdouble(i) * interligne + 3.0); Stroke (Cr); end loop; -- Register each battery in the name table -- battery_name (object_range (i)) := a_battery.name; i := i + 1; end if; exit when is_last_element (sys.batteries, my_battery_iterator); next_element (sys.batteries, my_battery_iterator); end loop; end if; exception when others => put_debug ("draw_entity_lines: " & Exception_Name & " : " & Exception_Message); end draw_entity_lines; -- Display any elements on the horizontal view -- procedure draw_horizontal_data is begin for u in 0 .. sched.nb_entries - 1 loop if 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 .. sched.entries (u).data.result.nb_entries - 1 loop if (sched.entries (u).data.result.entries (k) .item >= start_draw) and (sched.entries (u).data.result.entries (k) .item <= zoomed_period) then case sched.entries (u).data.result.entries (k) .data .type_of_event is ------------------------------------ -- Draw battery level data -- These events are drawn in black ------------------------------------ when energy => -- Display ony when the battery has a positive value of level -- if (sched.entries (u).data.result.entries (k).data.energy_level>0) then time_u := gdouble(sched.entries (u).data.result .entries (k) .item - start_draw); -- Draw data in the battery time line -- name := sched.entries (u).data.result.entries (k) .data.energy_battery.name; if to_display (name, battery_object_type) then ok := False; for l in object_range loop if (battery_name (l) = name) then ok := True; object_id := gint (l); end if; end loop; if not ok then Raise_Exception (battery_not_found'identity, To_String (name)); end if; -- Set color -- Set_color(cr, black); -- We have 50 pixels in the vertical axis to display the battery capacity -- We scale the the 50 vertical pixels according to the battery capacity -- Rectangle(cr, timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u + left_margin, gdouble(object_id) * interligne + high_margin, timeunit_margin * zoom_values (zoom_level) / 100.0 + 1.0, -100.0 / gdouble (sched.entries (u).data.result.entries (k).data.energy_battery.capacity) * gdouble (sched.entries (u).data.result.entries (k).data.energy_level) ); Fill(cr); end if; end if; ---------------------------------------- -- 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 := gdouble(sched.entries (u).data.result .entries (k) .item - start_draw); -- Draw data in the task time line -- name := 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 Set_color(cr, black); else Set_color(cr, to_color(name)); end if; if (sched.entries (u).data.result .entries (k) .data .crpd > 0) then Set_color(cr, red); end if; Rectangle(cr, timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u + left_margin, gdouble(object_id) * interligne + high_margin - 3.0, timeunit_margin * zoom_values (zoom_level) / 100.0 + 1.0, 7.0); Fill(cr); end if; -- Draw data in the core time line -- if draw_core_unit_time_line then name := sched.entries (u).data.result .entries (k) .data .running_core & "/" & 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; Rectangle(cr, timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u + left_margin, gdouble(object_id) * interligne + high_margin - 3.0, timeunit_margin * zoom_values (zoom_level) / 100.0 + 1.0, 7.0); Fill(cr); end if; -- Draw data in the address space time line -- if draw_address_space_time_line then name := 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; Rectangle(cr, timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u + left_margin, gdouble(object_id) * interligne + high_margin - 3.0, timeunit_margin * zoom_values (zoom_level) / 100.0 + 1.0, 7.0); Fill(cr); end if; ---------------------------------------- -- Draw task switching time in black ---------------------------------------- when context_switch_overhead => name := 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 := gdouble (sched.entries (u).data .result .entries (k) .item - start_draw); end if; end loop; if not ok then Raise_Exception (task_not_found'identity, To_String (name)); end if; Set_color(cr, red); Rectangle(cr, timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u + left_margin, gdouble(object_id) * interligne + high_margin - 3.0, timeunit_margin * zoom_values (zoom_level) / 100.0 + 1.0, 7.0); Fill(cr); end if; ----------------------------------------------------- -- Draw shared resource allocation in blue color ----------------------------------------------------- when allocate_resource => name := 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 := gdouble (sched.entries (u).data .result .entries (k) .item - 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 + timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u; end if; ---------------------------------------- -- Draw shared resource releasing in black ---------------------------------------- when release_resource => name := 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 := gdouble (sched.entries (u).data .result .entries (k) .item - start_draw) + 1.0; end if; end loop; if not ok then Raise_Exception (resource_not_found'identity, To_String (name)); end if; ok := False; name2 := 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 Set_color(cr, black); else set_color(cr, to_color (name2)); end if; Rectangle(cr, save_start_u (object_range (object_id)), gdouble(object_id) * interligne + high_margin - 3.0, left_margin + timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u - save_start_u (object_range (object_id)) + 1.0, 7.0); Fill(cr); end if; ---------------------------------------------------- -- Event about buffers -- Draw in red buffer write and in blue buffer read -- Draw in light red buffer overflow and in light blue buffer underflow ---------------------------------------------------- when write_to_buffer => name := 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 := gdouble (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; Set_color(cr, red); Rectangle(cr, timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u + left_margin, gdouble(object_id) * interligne + high_margin - 3.0, timeunit_margin * zoom_values (zoom_level) / 100.0 + 1.0, 7.0); Fill(cr); end if; when read_from_buffer => name := 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 := gdouble (sched.entries (u).data .result .entries (k) .item - start_draw); end if; end loop; if not ok then Raise_Exception (buffer_not_found'identity, To_String (name)); end if; Set_color(cr, blue); Rectangle(cr, timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u + left_margin, gdouble(object_id) * interligne + high_margin - 3.0, timeunit_margin * zoom_values (zoom_level) / 100.0 + 1.0, 7.0); Fill(cr); end if; when buffer_underflow => name := 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 := gdouble (sched.entries (u).data .result .entries (k) .item - start_draw); end if; end loop; if not ok then Raise_Exception (buffer_not_found'identity, To_String (name)); end if; Set_color(cr, lightblue); Rectangle(cr, timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u + left_margin, gdouble(object_id) * interligne + high_margin - 3.0, timeunit_margin * zoom_values (zoom_level) / 100.0 + 1.0, 7.0); Fill(cr); end if; when buffer_overflow => name := 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 := gdouble (sched.entries (u).data .result .entries (k) .item - start_draw); end if; end loop; if not ok then Raise_Exception (buffer_not_found'identity, To_String (name)); end if; Set_color(cr, lightred); Rectangle(cr, timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u + left_margin, gdouble(object_id) * interligne + high_margin - 3.0, timeunit_margin * zoom_values (zoom_level) / 100.0 + 1.0, 7.0); Fill(cr); end if; ---------------------------------------- -- Event about messages : we do nothing for -- both sending and receiving messages ---------------------------------------- when send_message => null; when receive_message => null; ------------------------------------------- -- Events we have nothing to display ------------------------------------------- when others => null; end case; end if; end loop; end if; end loop; exception when others => put_debug ("draw_horizontal_data: " & Exception_Name & " : " & Exception_Message); end draw_horizontal_data; --------------------------------------------------------- -- Draw vertical rectangles --------------------------------------------------------- procedure draw_vertical_data is begin for u in 0 .. sched.nb_entries - 1 loop if 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 .. sched.entries (u).data.result.nb_entries - 1 loop if (sched.entries (u).data.result.entries (k) .item >= start_draw) and (sched.entries (u).data.result.entries (k) .item <= zoomed_period) then case 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 := 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 := gdouble (sched.entries (u).data .result .entries (k) .item - start_draw); end if; end loop; if not ok then Raise_Exception (task_not_found'identity, To_String (name)); end if; Set_color(cr, blue); Rectangle(cr, left_margin + timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u, high_margin + gdouble(object_id) * interligne - 8.0, 3.0, 16.0); Fill(cr); 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 := 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 := gdouble (sched.entries (u).data .result .entries (k) .item - 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 Set_color(cr, red); Rectangle(cr, left_margin + timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u, high_margin + gdouble(object_id) * interligne - 8.0, 3.0, 16.0); Fill(cr); end if; if display_address_space_completion then if time_u + gdouble (sched.entries (u).data .result .entries (k) .data .duration) <= gdouble(draw_scheduling .zoomed_period + draw_scheduling .start_draw) then Set_color(cr, blue); Rectangle(cr, left_margin + timeunit_margin * zoom_values (zoom_level) / 100.0 * (time_u + gdouble (sched.entries (u) .data .result .entries (k) .data .duration)), high_margin + gdouble(object_id) * interligne - 8.0, 3.0, 16.0); Fill(cr); 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 := 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 := gdouble (sched.entries (u).data .result .entries (k) .item - start_draw); end if; end loop; if not ok then Raise_Exception (task_not_found'identity, To_String (name)); end if; Set_color(cr, red); Rectangle(cr, left_margin + timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u, high_margin + gdouble(object_id) * interligne - 8.0, 3.0, 16.0); Fill(cr); end if; end if; ----------------------------------------------------- -- Draw shared resource allocation in blue color ----------------------------------------------------- when allocate_resource => if display_allocate_resource then name := 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 := gdouble (sched.entries (u).data .result .entries (k) .item - start_draw); end if; end loop; if not ok then Raise_Exception (resource_not_found'identity, To_String (name)); end if; Set_color(cr, blue); Rectangle(cr, left_margin + timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u - 2.0, high_margin + gdouble(object_id) * interligne - 8.0, 3.0, 16.0); Fill(cr); end if; end if; ----------------------------------------------------- -- Draw shared resource release in red color ----------------------------------------------------- when release_resource => if display_release_resource then name := 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 := gdouble (sched.entries (u).data .result .entries (k) .item - start_draw); end if; end loop; if not ok then Raise_Exception (resource_not_found'identity, To_String (name)); end if; Set_color(cr, red); Rectangle(cr, left_margin + timeunit_margin * zoom_values (zoom_level) / 100.0 * (time_u + 1.0), high_margin + gdouble(object_id) * interligne - 8.0, 3.0, 16.0); Fill(cr); end if; end if; ----------------------------------------------------- -- Draw time at which the message is received -- (in red) ----------------------------------------------------- when receive_message => name := sched.entries (u).data.result.entries (k) .data .receive_message .name; ok := False; for l in object_range loop if (message_name (l) = name) then ok := True; object_id := gint (l); time_u := gdouble (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; if to_display (name, message_object_type) then Set_color(cr, red); Rectangle(cr, left_margin + timeunit_margin * zoom_values (zoom_level) / 100.0 * time_u, high_margin + gdouble(object_id) * interligne - 8.0, 3.0, 16.0); Fill(cr); end if; ----------------------------------------------------- -- Draw shared sended message in blue color ----------------------------------------------------- when send_message => name := 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 := gdouble(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; Set_color(cr, blue); Rectangle(cr, left_margin + (timeunit_margin * zoom_values (zoom_level) / 100.0) * time_u - 2.0, high_margin + gdouble(object_id) * interligne - 8.0, 3.0, 16.0); Fill(cr); end if; ------------------------------------------- -- Events we have nothing to display ------------------------------------------- when others => null; end case; end if; end loop; end if; end loop; exception when others => put_debug ("draw_vertical_data: " & Exception_Name & " : " & Exception_Message); end draw_vertical_data; ------------------------------------ -- Calbacks and drawing subroutines procedure Send_Draw_Event (Self : access Gtk_Widget_Record'Class) is begin Self.Queue_Draw_Area (0, 0, current_width, current_height); end Send_Draw_Event; function draw_cb (Self : access Gtk_Widget_Record'Class; Cr : Cairo_Context) return Boolean is begin Set_Source_Surface (Cr, surface, 0.0, 0.0); Paint (Cr); return False; end draw_cb; function configure_event_cb (Self : access Gtk_Widget_Record'Class; Event : Gdk.Event.Gdk_Event_Configure) return Boolean is begin surface := Create_Similar_Surface (Self.Get_Window, Cairo_Content_Color, Self.Get_Allocated_Width, Self.Get_Allocated_Height); Clear_Time_Line; return True; end configure_event_cb; procedure initialize is begin drawing_area_cheddar.On_Draw (draw_cb'Access); drawing_area_cheddar.On_Configure_Event (configure_event_cb'Access); drawing_area_cheddar.Set_Events (drawing_area_cheddar.Get_Events or Button_Press_Mask or Pointer_Motion_Mask); -- Set default Widget size -- current_width := gint(Max_Time_Line_Size_To_Display) * gint (timeunit_margin * zoom_values (zoom_level) / 100.0) + gint (left_margin + right_margin); current_height := gint(interligne + 2.0) * gint(Max_Time_Line_To_Display) + gint(high_margin); drawing_area_cheddar.Set_Size_Request (current_width, current_height); Send_Draw_Event(drawing_area_cheddar); end initialize; end graphical_editor.draw_scheduling;