Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/lib.adb @ 145:1830386684a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
4 -- -- 4 -- --
5 -- L I B -- 5 -- L I B --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 11 -- GNAT 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- -- 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- -- 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- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
275 begin 275 begin
276 Units.Table (U).OA_Setting := C; 276 Units.Table (U).OA_Setting := C;
277 end Set_OA_Setting; 277 end Set_OA_Setting;
278 278
279 procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type) is 279 procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type) is
280 begin 280 Old_N : constant Unit_Name_Type := Units.Table (U).Unit_Name;
281
282 begin
283 -- First unregister the old name, if any
284
285 if Old_N /= No_Unit_Name and then Unit_Names.Get (Old_N) = U then
286 Unit_Names.Set (Old_N, No_Unit);
287 end if;
288
289 -- Then set the new name
290
281 Units.Table (U).Unit_Name := N; 291 Units.Table (U).Unit_Name := N;
292
293 -- Finally register the new name
294
295 if Unit_Names.Get (N) = No_Unit then
296 Unit_Names.Set (N, U);
297 end if;
282 end Set_Unit_Name; 298 end Set_Unit_Name;
283 299
284 ------------------------------ 300 ------------------------------
285 -- Check_Same_Extended_Unit -- 301 -- Check_Same_Extended_Unit --
286 ------------------------------ 302 ------------------------------
1066 begin 1082 begin
1067 TSN := TSN + 1; 1083 TSN := TSN + 1;
1068 return TSN; 1084 return TSN;
1069 end Increment_Serial_Number; 1085 end Increment_Serial_Number;
1070 1086
1087 ----------------------
1088 -- Init_Unit_Name --
1089 ----------------------
1090
1091 procedure Init_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type) is
1092 begin
1093 Units.Table (U).Unit_Name := N;
1094 Unit_Names.Set (N, U);
1095 end Init_Unit_Name;
1096
1071 ---------------- 1097 ----------------
1072 -- Initialize -- 1098 -- Initialize --
1073 ---------------- 1099 ----------------
1074 1100
1075 procedure Initialize is 1101 procedure Initialize is
1085 -- Is_Loaded -- 1111 -- Is_Loaded --
1086 --------------- 1112 ---------------
1087 1113
1088 function Is_Loaded (Uname : Unit_Name_Type) return Boolean is 1114 function Is_Loaded (Uname : Unit_Name_Type) return Boolean is
1089 begin 1115 begin
1090 for Unum in Units.First .. Units.Last loop 1116 return Unit_Names.Get (Uname) /= No_Unit;
1091 if Uname = Unit_Name (Unum) then
1092 return True;
1093 end if;
1094 end loop;
1095
1096 return False;
1097 end Is_Loaded; 1117 end Is_Loaded;
1098 1118
1099 --------------- 1119 ---------------
1100 -- Last_Unit -- 1120 -- Last_Unit --
1101 --------------- 1121 ---------------
1139 ----------------- 1159 -----------------
1140 1160
1141 procedure Remove_Unit (U : Unit_Number_Type) is 1161 procedure Remove_Unit (U : Unit_Number_Type) is
1142 begin 1162 begin
1143 if U = Units.Last then 1163 if U = Units.Last then
1164 Unit_Names.Set (Unit_Name (U), No_Unit);
1144 Units.Decrement_Last; 1165 Units.Decrement_Last;
1145 end if; 1166 end if;
1146 end Remove_Unit; 1167 end Remove_Unit;
1147 1168
1148 ---------------------------------- 1169 ----------------------------------
1274 1295
1275 for J in 1 .. Compilation_Switches.Last loop 1296 for J in 1 .. Compilation_Switches.Last loop
1276 Tree_Write_Str (Compilation_Switches.Table (J)); 1297 Tree_Write_Str (Compilation_Switches.Table (J));
1277 end loop; 1298 end loop;
1278 end Tree_Write; 1299 end Tree_Write;
1300
1301 --------------------
1302 -- Unit_Name_Hash --
1303 --------------------
1304
1305 function Unit_Name_Hash (Id : Unit_Name_Type) return Unit_Name_Header_Num is
1306 begin
1307 return Unit_Name_Header_Num (Id mod Unit_Name_Table_Size);
1308 end Unit_Name_Hash;
1279 1309
1280 ------------ 1310 ------------
1281 -- Unlock -- 1311 -- Unlock --
1282 ------------ 1312 ------------
1283 1313