1-- VHDL libraries handling. 2-- Copyright (C) 2018 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16with Flags; 17with Name_Table; 18with Files_Map; 19with Vhdl.Utils; use Vhdl.Utils; 20with Errorout; use Errorout; 21with Vhdl.Errors; use Vhdl.Errors; 22with Libraries; use Libraries; 23with Vhdl.Scanner; 24with Vhdl.Parse; 25with Vhdl.Disp_Tree; 26with Vhdl.Prints; 27with Vhdl.Sem; 28with Vhdl.Post_Sems; 29with Vhdl.Canon; 30with Vhdl.Nodes_GC; 31 32package body Vhdl.Sem_Lib is 33 procedure Error_Lib_Msg (Msg : String; Arg1 : Earg_Type) is 34 begin 35 Report_Msg (Msgid_Error, Library, No_Source_Coord, Msg, (1 => Arg1)); 36 end Error_Lib_Msg; 37 38 function Load_File (File : Source_File_Entry) return Iir_Design_File 39 is 40 Res : Iir_Design_File; 41 begin 42 Vhdl.Scanner.Set_File (File); 43 if Vhdl.Scanner.Detect_Encoding_Errors then 44 -- Don't even try to parse such a file. The BOM will be interpreted 45 -- as an identifier, which is not valid at the beginning of a file. 46 Res := Null_Iir; 47 else 48 Res := Vhdl.Parse.Parse_Design_File; 49 end if; 50 Vhdl.Scanner.Close_File; 51 52 if Res /= Null_Iir then 53 Set_Parent (Res, Work_Library); 54 Set_Design_File_Filename (Res, Files_Map.Get_File_Name (File)); 55 Set_Design_File_Source (Res, File); 56 end if; 57 return Res; 58 end Load_File; 59 60 -- parse a file. 61 -- Return a design_file without putting it into the library 62 -- (because it was not analyzed). 63 function Load_File_Name (File_Name: Name_Id) return Iir_Design_File 64 is 65 Fe : Source_File_Entry; 66 begin 67 Fe := Files_Map.Read_Source_File (Local_Directory, File_Name); 68 if Fe = No_Source_File_Entry then 69 Error_Msg_Option ("cannot open " & Name_Table.Image (File_Name)); 70 return Null_Iir; 71 end if; 72 return Load_File (Fe); 73 end Load_File_Name; 74 75 procedure Finish_Compilation 76 (Unit : Iir_Design_Unit; Main : Boolean := False) 77 is 78 Lib_Unit : Iir; 79 begin 80 Lib_Unit := Get_Library_Unit (Unit); 81 if (Main or Flags.Dump_All) and then Flags.Dump_Parse then 82 Vhdl.Disp_Tree.Disp_Tree (Unit); 83 end if; 84 85 if Flags.Check_Ast_Level > 0 then 86 Vhdl.Nodes_GC.Check_Tree (Unit); 87 end if; 88 89 if Flags.Verbose then 90 Report_Msg (Msgid_Note, Semantic, +Lib_Unit, 91 "analyze %n", (1 => +Lib_Unit)); 92 end if; 93 94 Sem.Semantic (Unit); 95 96 if (Main or Flags.Dump_All) and then Flags.Dump_Sem then 97 Vhdl.Disp_Tree.Disp_Tree (Unit); 98 end if; 99 100 if Errorout.Nbr_Errors > 0 then 101 return; 102 end if; 103 104 if (Main or Flags.List_All) and then Flags.List_Sem then 105 Vhdl.Prints.Disp_Vhdl (Unit); 106 end if; 107 108 if Flags.Check_Ast_Level > 0 then 109 Vhdl.Nodes_GC.Check_Tree (Unit); 110 end if; 111 112 -- Post checks 113 ---------------- 114 115 Vhdl.Post_Sems.Post_Sem_Checks (Unit); 116 117 if Errorout.Nbr_Errors > 0 then 118 return; 119 end if; 120 121 -- Canonalisation. 122 ------------------ 123 124 if Flags.Verbose then 125 Report_Msg (Msgid_Note, Semantic, +Lib_Unit, 126 "canonicalize %n", (1 => +Lib_Unit)); 127 end if; 128 129 Vhdl.Canon.Canonicalize (Unit); 130 131 if (Main or Flags.Dump_All) and then Flags.Dump_Canon then 132 Vhdl.Disp_Tree.Disp_Tree (Unit); 133 end if; 134 135 if Errorout.Nbr_Errors > 0 then 136 return; 137 end if; 138 139 if (Main or Flags.List_All) and then Flags.List_Canon then 140 Vhdl.Prints.Disp_Vhdl (Unit); 141 end if; 142 143 if Flags.Check_Ast_Level > 0 then 144 Vhdl.Nodes_GC.Check_Tree (Unit); 145 end if; 146 end Finish_Compilation; 147 148 procedure Free_Dependence_List (Design : Iir_Design_Unit) 149 is 150 List : Iir_List; 151 It : List_Iterator; 152 El : Iir; 153 begin 154 List := Get_Dependence_List (Design); 155 if List = Null_Iir_List then 156 return; 157 end if; 158 159 It := List_Iterate (List); 160 while Is_Valid (It) loop 161 El := Get_Element (It); 162 case Get_Kind (El) is 163 when Iir_Kind_Design_Unit => 164 null; 165 when Iir_Kind_Entity_Aspect_Entity => 166 Free_Recursive (El); 167 when others => 168 Error_Kind ("free_dependence_list", El); 169 end case; 170 Next (It); 171 end loop; 172 Destroy_Iir_List (List); 173 Set_Dependence_List (Design, Null_Iir_List); 174 end Free_Dependence_List; 175 176 procedure Load_Parse_Design_Unit 177 (Design_Unit: Iir_Design_Unit; Loc : Location_Type) 178 is 179 use Vhdl.Scanner; 180 Design_File : constant Iir_Design_File := Get_Design_File (Design_Unit); 181 Fe : Source_File_Entry; 182 Line, Off: Natural; 183 Pos: Source_Ptr; 184 Res: Iir; 185 Checksum : File_Checksum_Id; 186 begin 187 -- The unit must not be loaded. 188 pragma Assert (Get_Date_State (Design_Unit) = Date_Disk); 189 190 Fe := Get_Design_File_Source (Design_File); 191 if Fe = No_Source_File_Entry then 192 -- Load the file in memory. 193 Fe := Files_Map.Read_Source_File 194 (Get_Design_File_Directory (Design_File), 195 Get_Design_File_Filename (Design_File)); 196 if Fe = No_Source_File_Entry then 197 Error_Lib_Msg ("cannot load %n", +Get_Library_Unit (Design_Unit)); 198 raise Compilation_Error; 199 end if; 200 Set_Design_File_Source (Design_File, Fe); 201 202 -- Check if the file has changed (but only if it has a checksum). 203 Checksum := Get_File_Checksum (Design_File); 204 if Checksum /= No_File_Checksum_Id 205 and then 206 not Files_Map.Is_Eq (Files_Map.Get_File_Checksum (Fe), Checksum) 207 then 208 Error_Msg_Sem (+Loc, "file %i has changed and must be reanalysed", 209 +Get_Design_File_Filename (Design_File)); 210 raise Compilation_Error; 211 end if; 212 end if; 213 214 if Get_Date (Design_Unit) = Date_Obsolete then 215 Error_Msg_Sem (+Loc, "%n has been obsoleted", 216 +Get_Library_Unit (Design_Unit)); 217 raise Compilation_Error; 218 end if; 219 220 -- Set the position of the lexer 221 Set_File (Fe); 222 Pos := Get_Design_Unit_Source_Pos (Design_Unit); 223 Line := Natural (Get_Design_Unit_Source_Line (Design_Unit)); 224 Off := Natural (Get_Design_Unit_Source_Col (Design_Unit)); 225 Files_Map.File_Add_Line_Number (Get_Current_Source_File, Line, Pos); 226 Set_Current_Position (Pos + Source_Ptr (Off)); 227 228 -- Parse 229 Scan; 230 Res := Vhdl.Parse.Parse_Design_Unit; 231 Close_File; 232 if Res = Null_Iir then 233 raise Compilation_Error; 234 end if; 235 236 Set_Date_State (Design_Unit, Date_Parse); 237 238 -- FIXME: check the library unit read is the one expected. 239 240 -- Move the unit in the library: keep the design_unit of the library, 241 -- but replace the library_unit by the one that has been parsed. Do 242 -- not forget to relocate parents. 243 Vhdl.Utils.Free_Recursive (Get_Library_Unit (Design_Unit)); 244 Set_Library_Unit (Design_Unit, Get_Library_Unit (Res)); 245 Set_Design_Unit (Get_Library_Unit (Res), Design_Unit); 246 Set_Parent (Get_Library_Unit (Res), Design_Unit); 247 declare 248 Item : Iir; 249 begin 250 Item := Get_Context_Items (Res); 251 Set_Context_Items (Design_Unit, Item); 252 while Is_Valid (Item) loop 253 Set_Parent (Item, Design_Unit); 254 Item := Get_Chain (Item); 255 end loop; 256 end; 257 Location_Copy (Design_Unit, Res); 258 Free_Dependence_List (Design_Unit); 259 Set_Dependence_List (Design_Unit, Get_Dependence_List (Res)); 260 Set_Dependence_List (Res, Null_Iir_List); 261 Free_Iir (Res); 262 end Load_Parse_Design_Unit; 263 264 procedure Error_Obsolete 265 (Loc : Location_Type; Msg : String; Args : Earg_Arr) is 266 begin 267 if not Flags.Flag_Elaborate_With_Outdated then 268 Error_Msg_Sem (Loc, Msg, Args); 269 end if; 270 end Error_Obsolete; 271 272 -- Check if one of its dependency makes this unit obsolete. 273 function Check_Obsolete_Dependence (Design_Unit : Iir; Loc : Location_Type) 274 return Boolean 275 is 276 List : constant Iir_List := Get_Dependence_List (Design_Unit); 277 Du_Ts : constant Time_Stamp_Id := 278 Get_Analysis_Time_Stamp (Get_Design_File (Design_Unit)); 279 U_Ts : Time_Stamp_Id; 280 El : Iir; 281 It : List_Iterator; 282 begin 283 if List = Null_Iir_List then 284 return False; 285 end if; 286 287 It := List_Iterate (List); 288 while Is_Valid (It) loop 289 El := Get_Element (It); 290 if Get_Kind (El) = Iir_Kind_Design_Unit then 291 U_Ts := Get_Analysis_Time_Stamp (Get_Design_File (El)); 292 if Files_Map.Is_Gt (U_Ts, Du_Ts) then 293 Error_Obsolete 294 (Loc, "%n is obsoleted by %n", (+Design_Unit, +El)); 295 return True; 296 end if; 297 end if; 298 Next (It); 299 end loop; 300 301 return False; 302 end Check_Obsolete_Dependence; 303 304 procedure Explain_Obsolete 305 (Design_Unit : Iir_Design_Unit; Loc : Location_Type) 306 is 307 List : Iir_List; 308 It : List_Iterator; 309 El : Iir; 310 begin 311 pragma Assert (Get_Date_State (Design_Unit) = Date_Analyze); 312 pragma Assert (Get_Date (Design_Unit) = Date_Obsolete); 313 314 List := Get_Dependence_List (Design_Unit); 315 if List = Null_Iir_List then 316 -- Argh, we don't know why. 317 Error_Obsolete (Loc, "%n is obsolete", (1 => +Design_Unit)); 318 return; 319 end if; 320 321 It := List_Iterate (List); 322 while Is_Valid (It) loop 323 El := Get_Element (It); 324 -- Just handle design unit; but there could also be entity aspects. 325 if Get_Kind (El) = Iir_Kind_Design_Unit 326 and then Get_Date (El) = Date_Obsolete 327 then 328 Error_Obsolete (Loc, "%n is obsoleted by %n", (+Design_Unit, +El)); 329 return; 330 end if; 331 Next (It); 332 end loop; 333 end Explain_Obsolete; 334 335 -- Load, parse, analyze, back-end a design_unit if necessary. 336 procedure Load_Design_Unit 337 (Design_Unit : Iir_Design_Unit; Loc : Location_Type) 338 is 339 Prev_Nbr_Errors : Natural; 340 Warnings : Warnings_Setting; 341 Error : Boolean; 342 begin 343 if Get_Date (Design_Unit) = Date_Replacing then 344 Error_Msg_Sem (+Loc, "circular reference of %n", +Design_Unit); 345 return; 346 end if; 347 348 -- Save and clear Nbr_Errors so that the unit is fully analyzed even 349 -- if there were errors. 350 Prev_Nbr_Errors := Errorout.Nbr_Errors; 351 Errorout.Nbr_Errors := 0; 352 353 -- Disable all warnings. Warnings are emitted only when the unit 354 -- is analyzed. 355 Save_Warnings_Setting (Warnings); 356 Disable_All_Warnings; 357 358 if Get_Date_State (Design_Unit) = Date_Disk then 359 Load_Parse_Design_Unit (Design_Unit, Loc); 360 end if; 361 362 Error := False; 363 364 if Get_Date_State (Design_Unit) = Date_Parse then 365 -- Analyze the design unit. 366 367 if Get_Date (Design_Unit) = Date_Analyzed then 368 -- Work-around for an internal check in sem. 369 -- FIXME: to be removed ? 370 Set_Date (Design_Unit, Date_Parsed); 371 end if; 372 373 -- Avoid infinite recursion, if the unit is self-referenced. 374 Set_Date_State (Design_Unit, Date_Analyze); 375 376 -- Analyze unit. 377 Finish_Compilation (Design_Unit); 378 379 -- Check if one of its dependency makes this unit obsolete. 380 -- FIXME: to do when the dependency is added ? 381 if not Flags.Flag_Elaborate_With_Outdated 382 and then Check_Obsolete_Dependence (Design_Unit, Loc) 383 then 384 Set_Date (Design_Unit, Date_Obsolete); 385 Error := True; 386 end if; 387 end if; 388 389 -- Restore nbr_errors (accumulate). 390 Errorout.Nbr_Errors := Prev_Nbr_Errors + Errorout.Nbr_Errors; 391 392 -- Restore warnings. 393 Restore_Warnings_Setting (Warnings); 394 395 if Error then 396 -- Return now in case of analyze error. 397 return; 398 end if; 399 400 case Get_Date (Design_Unit) is 401 when Date_Parsed => 402 raise Internal_Error; 403 when Date_Analyzing => 404 -- Self-referenced unit. 405 return; 406 when Date_Analyzed => 407 -- FIXME: Accept it silently ? 408 -- Note: this is used when Flag_Elaborate_With_Outdated is set. 409 -- This is also used by anonymous configuration declaration. 410 null; 411 when Date_Uptodate => 412 return; 413 when Date_Valid => 414 null; 415 when Date_Obsolete => 416 if not Flags.Flag_Elaborate_With_Outdated then 417 Explain_Obsolete (Design_Unit, Loc); 418 end if; 419 when others => 420 raise Internal_Error; 421 end case; 422 end Load_Design_Unit; 423 424 procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) is 425 begin 426 Load_Design_Unit (Design_Unit, Get_Location (Loc)); 427 end Load_Design_Unit; 428 429 function Load_Primary_Unit 430 (Library: Iir_Library_Declaration; Name: Name_Id; Loc : Iir) 431 return Iir_Design_Unit 432 is 433 Design_Unit: Iir_Design_Unit; 434 begin 435 Design_Unit := Find_Primary_Unit (Library, Name); 436 if Design_Unit /= Null_Iir then 437 Load_Design_Unit (Design_Unit, Loc); 438 end if; 439 return Design_Unit; 440 end Load_Primary_Unit; 441 442 -- Load an secondary unit and analyse it. 443 function Load_Secondary_Unit 444 (Primary: Iir_Design_Unit; Name: Name_Id; Loc : Iir) 445 return Iir_Design_Unit 446 is 447 Design_Unit: Iir_Design_Unit; 448 begin 449 Design_Unit := Find_Secondary_Unit (Primary, Name); 450 if Design_Unit /= Null_Iir then 451 Load_Design_Unit (Design_Unit, Loc); 452 end if; 453 return Design_Unit; 454 end Load_Secondary_Unit; 455end Vhdl.Sem_Lib; 456