1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- SYSTEM.MULTIPROCESSORS.DISPATCHING_DOMAINS -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2011, Free Software Foundation, Inc. -- 10-- -- 11-- GNARL is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNARL was developed by the GNARL team at Florida State University. -- 28-- Extensive contributions were provided by Ada Core Technologies, Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- Body used on unimplemented targets, where the operating system does not 33-- support setting task affinities. 34 35package body System.Multiprocessors.Dispatching_Domains is 36 37 ----------------------- 38 -- Local subprograms -- 39 ----------------------- 40 41 procedure Freeze_Dispatching_Domains; 42 pragma Export 43 (Ada, Freeze_Dispatching_Domains, "__gnat_freeze_dispatching_domains"); 44 -- Signal the time when no new dispatching domains can be created. It 45 -- should be called before the environment task calls the main procedure 46 -- (and after the elaboration code), so the binder-generated file needs to 47 -- import and call this procedure. 48 49 ----------------- 50 -- Assign_Task -- 51 ----------------- 52 53 procedure Assign_Task 54 (Domain : in out Dispatching_Domain; 55 CPU : CPU_Range := Not_A_Specific_CPU; 56 T : Ada.Task_Identification.Task_Id := 57 Ada.Task_Identification.Current_Task) 58 is 59 pragma Unreferenced (Domain, CPU, T); 60 begin 61 raise Dispatching_Domain_Error with "dispatching domains not supported"; 62 end Assign_Task; 63 64 ------------ 65 -- Create -- 66 ------------ 67 68 function Create (First, Last : CPU) return Dispatching_Domain is 69 pragma Unreferenced (First, Last); 70 begin 71 raise Dispatching_Domain_Error with "dispatching domains not supported"; 72 return System_Dispatching_Domain; 73 end Create; 74 75 ----------------------------- 76 -- Delay_Until_And_Set_CPU -- 77 ----------------------------- 78 79 procedure Delay_Until_And_Set_CPU 80 (Delay_Until_Time : Ada.Real_Time.Time; 81 CPU : CPU_Range) 82 is 83 pragma Unreferenced (Delay_Until_Time, CPU); 84 begin 85 raise Dispatching_Domain_Error with "dispatching domains not supported"; 86 end Delay_Until_And_Set_CPU; 87 88 -------------------------------- 89 -- Freeze_Dispatching_Domains -- 90 -------------------------------- 91 92 procedure Freeze_Dispatching_Domains is 93 begin 94 null; 95 end Freeze_Dispatching_Domains; 96 97 ------------- 98 -- Get_CPU -- 99 ------------- 100 101 function Get_CPU 102 (T : Ada.Task_Identification.Task_Id := 103 Ada.Task_Identification.Current_Task) return CPU_Range 104 is 105 pragma Unreferenced (T); 106 begin 107 return Not_A_Specific_CPU; 108 end Get_CPU; 109 110 ---------------------------- 111 -- Get_Dispatching_Domain -- 112 ---------------------------- 113 114 function Get_Dispatching_Domain 115 (T : Ada.Task_Identification.Task_Id := 116 Ada.Task_Identification.Current_Task) return Dispatching_Domain 117 is 118 pragma Unreferenced (T); 119 begin 120 return System_Dispatching_Domain; 121 end Get_Dispatching_Domain; 122 123 ------------------- 124 -- Get_First_CPU -- 125 ------------------- 126 127 function Get_First_CPU (Domain : Dispatching_Domain) return CPU is 128 pragma Unreferenced (Domain); 129 begin 130 return CPU'First; 131 end Get_First_CPU; 132 133 ------------------ 134 -- Get_Last_CPU -- 135 ------------------ 136 137 function Get_Last_CPU (Domain : Dispatching_Domain) return CPU is 138 pragma Unreferenced (Domain); 139 begin 140 return Number_Of_CPUs; 141 end Get_Last_CPU; 142 143 ------------- 144 -- Set_CPU -- 145 ------------- 146 147 procedure Set_CPU 148 (CPU : CPU_Range; 149 T : Ada.Task_Identification.Task_Id := 150 Ada.Task_Identification.Current_Task) 151 is 152 pragma Unreferenced (CPU, T); 153 begin 154 raise Dispatching_Domain_Error with "dispatching domains not supported"; 155 end Set_CPU; 156 157end System.Multiprocessors.Dispatching_Domains; 158