1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- SYSTEM.MULTIPROCESSORS.DISPATCHING_DOMAINS -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2011-2019, 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 : CPU; Last : CPU_Range) return Dispatching_Domain is 69 pragma Unreferenced (First, Last); 70 begin 71 return raise Dispatching_Domain_Error with 72 "dispatching domains not supported"; 73 end Create; 74 75 function Create (Set : CPU_Set) return Dispatching_Domain is 76 pragma Unreferenced (Set); 77 begin 78 return raise Dispatching_Domain_Error with 79 "dispatching domains not supported"; 80 end Create; 81 82 ----------------------------- 83 -- Delay_Until_And_Set_CPU -- 84 ----------------------------- 85 86 procedure Delay_Until_And_Set_CPU 87 (Delay_Until_Time : Ada.Real_Time.Time; 88 CPU : CPU_Range) 89 is 90 pragma Unreferenced (Delay_Until_Time, CPU); 91 begin 92 raise Dispatching_Domain_Error with "dispatching domains not supported"; 93 end Delay_Until_And_Set_CPU; 94 95 -------------------------------- 96 -- Freeze_Dispatching_Domains -- 97 -------------------------------- 98 99 procedure Freeze_Dispatching_Domains is 100 begin 101 null; 102 end Freeze_Dispatching_Domains; 103 104 ------------- 105 -- Get_CPU -- 106 ------------- 107 108 function Get_CPU 109 (T : Ada.Task_Identification.Task_Id := 110 Ada.Task_Identification.Current_Task) return CPU_Range 111 is 112 pragma Unreferenced (T); 113 begin 114 return Not_A_Specific_CPU; 115 end Get_CPU; 116 117 ----------------- 118 -- Get_CPU_Set -- 119 ----------------- 120 121 function Get_CPU_Set (Domain : Dispatching_Domain) return CPU_Set is 122 pragma Unreferenced (Domain); 123 begin 124 return raise Dispatching_Domain_Error 125 with "dispatching domains not supported"; 126 end Get_CPU_Set; 127 128 ---------------------------- 129 -- Get_Dispatching_Domain -- 130 ---------------------------- 131 132 function Get_Dispatching_Domain 133 (T : Ada.Task_Identification.Task_Id := 134 Ada.Task_Identification.Current_Task) return Dispatching_Domain 135 is 136 pragma Unreferenced (T); 137 begin 138 return System_Dispatching_Domain; 139 end Get_Dispatching_Domain; 140 141 ------------------- 142 -- Get_First_CPU -- 143 ------------------- 144 145 function Get_First_CPU (Domain : Dispatching_Domain) return CPU is 146 pragma Unreferenced (Domain); 147 begin 148 return CPU'First; 149 end Get_First_CPU; 150 151 ------------------ 152 -- Get_Last_CPU -- 153 ------------------ 154 155 function Get_Last_CPU (Domain : Dispatching_Domain) return CPU_Range is 156 pragma Unreferenced (Domain); 157 begin 158 return Number_Of_CPUs; 159 end Get_Last_CPU; 160 161 ------------- 162 -- Set_CPU -- 163 ------------- 164 165 procedure Set_CPU 166 (CPU : CPU_Range; 167 T : Ada.Task_Identification.Task_Id := 168 Ada.Task_Identification.Current_Task) 169 is 170 pragma Unreferenced (CPU, T); 171 begin 172 raise Dispatching_Domain_Error with "dispatching domains not supported"; 173 end Set_CPU; 174 175end System.Multiprocessors.Dispatching_Domains; 176