1------------------------------------------------------------------------------ 2-- -- 3-- ASIS-for-GNAT IMPLEMENTATION COMPONENTS -- 4-- -- 5-- A 4 G . C O N T T -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 1995-2013, Free Software Foundation, Inc. -- 10-- -- 11-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it -- 12-- under terms of the GNU General Public License as published by the Free -- 13-- Software Foundation; either version 2, or (at your option) any later -- 14-- version. ASIS-for-GNAT is distributed in the hope that it will be use- -- 15-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- -- 16-- CHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -- 17-- Public License for more details. You should have received a copy of the -- 18-- GNU General Public License distributed with ASIS-for-GNAT; see file -- 19-- COPYING. If not, write to the Free Software Foundation, 59 Temple Place -- 20-- - Suite 330, Boston, MA 02111-1307, USA. -- 21-- -- 22-- -- 23-- -- 24-- -- 25-- -- 26-- -- 27-- -- 28-- -- 29-- ASIS-for-GNAT was originally developed by the ASIS-for-GNAT team at the -- 30-- Software Engineering Laboratory of the Swiss Federal Institute of -- 31-- Technology (LGL-EPFL) in Lausanne, Switzerland, in cooperation with the -- 32-- Scientific Research Computer Center of Moscow State University (SRCC -- 33-- MSU), Russia, with funding partially provided by grants from the Swiss -- 34-- National Science Foundation and the Swiss Academy of Engineering -- 35-- Sciences. ASIS-for-GNAT is now maintained by AdaCore -- 36-- (http://www.adacore.com). -- 37-- -- 38-- -- 39------------------------------------------------------------------------------ 40 41pragma Ada_2012; 42 43-- This package defines the Context (Context) Table - the top-level ASIS data 44-- structure for ASIS Context/Compilation_Unit processing. 45 46with A4G.A_Alloc; use A4G.A_Alloc; 47with A4G.A_Types; use A4G.A_Types; 48with A4G.Unit_Rec; 49with A4G.Tree_Rec; 50with A4G.A_Elists; use A4G.A_Elists; 51with A4G.A_Opt; use A4G.A_Opt; 52 53with Table; 54with Alloc; 55 56with Types; use Types; 57with GNAT.OS_Lib; use GNAT.OS_Lib; 58with Hostparm; 59 60package A4G.Contt is 61 62 ------------------------------------------------ 63 -- Subprograms for General Context Processing -- 64 ------------------------------------------------ 65 66 procedure Verify_Context_Name (Name : String; Cont : Context_Id); 67 -- Verifies the string passed as the Name parameter for 68 -- Asis.Ada_Environments.Associate. If the string can be used as a 69 -- Context name, it is stored in a Context Table for a further use, 70 -- and if the verification is failed, ASIS_Failed is raised and a Status 71 -- is set as Parameter_Error. 72 73 procedure Process_Context_Parameters 74 (Parameters : String; 75 Cont : Context_Id := Non_Associated); 76 -- Processes a Parameters string passed parameter to the 77 -- Asis.Ada_Environments.Associate query. If there are any errors contained 78 -- in the Context association parameters, ASIS_Failed is raised and 79 -- a Status is set as Parameter_Error only in case of a fatal error, 80 -- that is, when a given set of parameters does not allow to define a legal 81 -- ASIS Context in case of ASIS-for-GNAT. For a non-fatal error detected 82 -- for some parameter, ASIS warning is generated. 83 -- 84 -- If the Parameters string contains tree file names, these names are 85 -- stored in the Context Tree Table for Cont. 86 87 function I_Options (C : Context_Id) return Argument_List; 88 -- Returns the list of "-I" GNAT options according to the definition of 89 -- the Context C. 90 91 procedure Set_Extra_Options 92 (C : Context_Id; Extra_Options : Argument_List); 93 function Get_Extra_Options (C : Context_Id) return Argument_List; 94 -- Set/Get extra options to pass to gcc. Used by gnat2xml. ???Gnat2xml 95 -- should probably switch to using ASIS_UL.Compiler_Options, in which case 96 -- these will not be needed, but that's too big a change for now. 97 -- Extra_Options is initially empty. 98 99 procedure Initialize; 100 -- Should be called by Asis.Implementation.Initialize. Initializes the 101 -- Context Table. Sets Current_Context and Current_Tree to nil values. 102 103 procedure Finalize; 104 -- Should be called by Asis.Implementation.Finalize. 105 -- Finalizes all the Contexts being processed by ASIS and then finalizes 106 -- the general Context Table. Produces the debug output, if the 107 -- corresponding debug flags are set ON. 108 -- ??? Requires revising 109 110 procedure Pre_Initialize (C : Context_Id); 111 -- Should be called by Asis.Ada_Environments.Associate. It initializes 112 -- the unit and tree tables for C, but it does not put any information 113 -- in these tables. Before doing this, it backups the current context, 114 -- and after initializing Context tables it sets Current_Context to C and 115 -- Current_Tree to Nil_Tree. 116 117 procedure Initialize (C : Context_Id); 118 -- Should be called by Asis.Ada_Environments.Open. 119 -- Initializes the internal structures and Tables for the Context C. 120 121 procedure Finalize (C : Context_Id); 122 -- Should be called by Asis.Ada_Environments.Close. 123 -- Finalizes the internal structures and Tables for the Context C. 124 -- Produces the debug output, if the corresponding debug flags are 125 -- set ON. 126 127 function Allocate_New_Context return Context_Id; 128 -- Allocates a new entry to an ASIS Context Table and returns the 129 -- corresponding Id as a result 130 131 function Context_Info (C : Context_Id) return String; 132 -- returns the string, which content uniquely identifies the ASIS Context 133 -- printed by C in user-understandable form. Initially is supposed to 134 -- be called in the implementation of Asis_Compilation_Units.Unique_Name. 135 -- May be used for producing some debug output. 136 137 procedure Erase_Old (C : Context_Id); 138 -- Erases all the settings for the given context, which have been 139 -- made by previous calls to Asis.Ada_Environments.Associate 140 -- procedure. (All the dynamically allocated memory is reclaimed) 141 142 procedure Set_Context_Name (C : Context_Id; Name : String); 143 -- Stores Name as the context name for context C 144 145 procedure Set_Context_Parameters (C : Context_Id; Parameters : String); 146 -- Stores Parameters as the context parameters for context C 147 148 function Get_Context_Name (C : Context_Id) return String; 149 -- returns a name string associated with a context 150 151 function Get_Context_Parameters (C : Context_Id) return String; 152 -- returns a parameters string associated with a context 153 154 procedure Print_Context_Info; 155 -- produces the general debug output for ASIS contexts; 156 -- is intended to be used during ASIS implementation finalization 157 158 procedure Print_Context_Info (C : Context_Id); 159 -- produces the detailed debug output for the ASIS context C 160 -- is intended to be used during ASIS implementation finalization 161 162 procedure Print_Context_Parameters (C : Context_Id); 163 -- prints strings which were used when the Context C was associated 164 -- for the last time, as well as the corresponding settings made 165 -- as the result of this association 166 167 procedure Scan_Trees_New (C : Context_Id); 168 -- This procedure does the main job when opening the Context C in case if 169 -- tree processing mode for this context is set to Pre_Created or Mixed. 170 -- It scans the set of tree files making up the Context and collects some 171 -- block-box information about Compilation Units belonging to this Context. 172 -- In case if any error is detected (including error when reading a tree 173 -- file in -C1 or -CN Context mode or any inconsistency), ASIS_Failed is 174 -- raised as a result of opening the Context 175 176 function Get_Current_Tree return Tree_Id; 177 -- Returns the Id of the tree currently accessed by ASIS. 178 179 procedure Set_Current_Tree (Tree : Tree_Id); 180 -- Sets the currently accessed tree 181 182 function Get_Current_Cont return Context_Id; 183 -- Returns the Id of the ASIS Context to which the currently accessed 184 -- tree belongs 185 186 procedure Set_Current_Cont (L : Context_Id); 187 -- Sets the Id of the Context to which the currently accessed tree 188 -- belongs 189 190 --------------------------------------------------- 191 -- Context Attributes Access and Update Routines -- 192 --------------------------------------------------- 193 194 function Is_Associated (C : Context_Id) return Boolean; 195 function Is_Opened (C : Context_Id) return Boolean; 196 function Opened_At (C : Context_Id) return ASIS_OS_Time; 197 198 function Context_Processing_Mode (C : Context_Id) return Context_Mode; 199 function Tree_Processing_Mode (C : Context_Id) return Tree_Mode; 200 function Source_Processing_Mode (C : Context_Id) return Source_Mode; 201 function Use_Default_Trees (C : Context_Id) return Boolean; 202 function Gcc_To_Call (C : Context_Id) return String_Access; 203 204 -------- 205 206 procedure Set_Is_Associated (C : Context_Id; Ass : Boolean); 207 procedure Set_Is_Opened (C : Context_Id; Op : Boolean); 208 209 procedure Set_Context_Processing_Mode (C : Context_Id; M : Context_Mode); 210 procedure Set_Tree_Processing_Mode (C : Context_Id; M : Tree_Mode); 211 procedure Set_Source_Processing_Mode (C : Context_Id; M : Source_Mode); 212 procedure Set_Use_Default_Trees (C : Context_Id; B : Boolean); 213 214 procedure Set_Default_Context_Processing_Mode (C : Context_Id); 215 procedure Set_Default_Tree_Processing_Mode (C : Context_Id); 216 procedure Set_Default_Source_Processing_Mode (C : Context_Id); 217 ------------------------------------------------- 218 219 ----------------- 220 -- Name Buffer -- 221 ----------------- 222 223 -- All the Name Tables from the ASIS Context implementation 224 -- shares the same Name Buffer. 225 226 A_Name_Buffer : String (1 .. Hostparm.Max_Name_Length); 227 -- This buffer is used to set the name to be stored in the table for the 228 -- Name_Find call, and to retrieve the name for the Get_Name_String call. 229 230 A_Name_Len : Natural; 231 -- Length of name stored in Name_Buffer. Used as an input parameter for 232 -- Name_Find, and as an output value by Get_Name_String. 233 234 procedure Set_Name_String (S : String); 235 -- Sets A_Name_Len as S'Length and after that sets 236 -- A_Name_Buffer (1 .. A_Name_Len) as S. We do not need any encoding, 237 -- and we usually operate with strings which should be stored as they 238 -- came from the clients, so we simply can set the string to be 239 -- stored or looked for in the name buffer as it is. 240 241 procedure NB_Save; 242 -- Saves the current state (the value of A_Name_Len and the characters 243 -- in A_Name_Buffer (1 .. A_Name_Len) of the A_Name Buffer. This state may 244 -- be restored by NB_Restore 245 246 procedure NB_Restore; 247 -- Restores the state of the A_Name Buffer, which has been saved by the 248 -- NB_Save procedure 249 250 ------------------ 251 -- Search Paths -- 252 ------------------ 253 254 procedure Set_Search_Paths (C : Context_Id); 255 -- Stores the previously verified and stored in temporary data structures 256 -- directory names as search paths for a given contexts. Also sets the 257 -- list of the "-I" options for calling the compiler from inside ASIS. 258 -- The temporary structures are cleaned, and the dynamically allocated 259 -- storage used by them are reclaimed. 260 261 function Locate_In_Search_Path 262 (C : Context_Id; 263 File_Name : String; 264 Dir_Kind : Search_Dir_Kinds) 265 return String_Access; 266 -- This function tries to locate the given file (having File_Name as its 267 -- name) in the search path associated with context C. If the file 268 -- cannot be located, the null access value is returned 269 270 ----------------- 271 -- NEW STUFF -- 272 ----------------- 273 274 procedure Save_Context (C : Context_Id); 275 -- Saves the tables for C. Does nothing, if the currently accessed Context 276 -- is Non_Associated 277 278 procedure Restore_Context (C : Context_Id); 279 -- restored tables for C taking them from the internal C structure 280 281 procedure Reset_Context (C : Context_Id); 282 -- If C is not Nil_Context_Id, resets the currently accessed Context to be 283 -- C, including restoring all the tables. If C is Nil_Context_Id, does 284 -- nothing (we need this check for Nil_Context_Id, because C may come from 285 -- Nil_Compilation_Unit 286 287 procedure Backup_Current_Context; 288 -- Saves tables for the currently accessed Context. Does nothing, if the 289 -- currently accessed Context is Non_Associated. 290 291private 292 293 ------------------------ 294 -- ASIS Context Table -- 295 ------------------------ 296 297 -- The entries in the table are accessed using a Context_Id that ranges 298 -- from Context_Low_Bound to Context_High_Bound. Context_Low_Bound is 299 -- reserved for a Context which has never been associated. 300 -- 301 -- The following diagram shows the general idea of the multiple 302 -- Context processing in ASIS: 303 304 -- Asis.Compilation_Unit value: 305 -- +-----------------------+ 306 -- | Id : Unit_Id; ------+--------- 307 -- | | | 308 -- | Cont_Id : Context_Id;-+- | 309 -- +-----------------------+ | | 310 -- | | 311 -- | | 312 -- +------------------------- | 313 -- | | 314 -- | Context Table: | 315 -- | ============= | 316 -- | +--------------+ | 317 -- | | | | 318 -- | | | | 319 -- | | | | 320 -- | | | | 321 -- | +--------------+ | Unit_Reciord value 322 -- +-->| | | / 323 -- | ... | | / 324 -- | | V / Unit Table for 325 -- | | +-----+-----+----------... / a given 326 -- | Units -----+----->| | | / Context 327 -- | | +-----+-----+----------... 328 -- | | ^ ^ 329 -- | | | |------------------+ 330 -- | | | | 331 -- | | | | 332 -- | | V | 333 -- | | +-----------------... | 334 -- | Name_Chars --+----> | | 335 -- | | +-----------------... | 336 -- | | | 337 -- | | +----------------------- 338 -- | | | 339 -- | | V 340 -- | | +----------------... 341 -- | Hash_Table -+----> | 342 -- | | +----------------... 343 -- | | 344 -- | | 345 -- | ... | 346 -- | | 347 -- +--------------+ 348 -- | | 349 -- | | 350 -- | ... | 351 -- +--------------+ 352 -- | | 353 -- . . 354 -- . . 355 -- . . 356 357 --------------------------- 358 -- Types for hash tables -- 359 --------------------------- 360 361 Hash_Num : constant Int := 2**12; 362 -- Number of headers in the hash table. Current hash algorithm is closely 363 -- tailored to this choice, so it can only be changed if a corresponding 364 -- change is made to the hash algorithm. 365 366 Hash_Max : constant Int := Hash_Num - 1; 367 -- Indexes in the hash header table run from 0 to Hash_Num - 1 368 369 subtype Hash_Index_Type is Int range 0 .. Hash_Max; 370 -- Range of hash index values 371 372 type Hash_Array is array (Hash_Index_Type) of Unit_Id; 373 -- Each kind of tables in the implementation of an ASIS Context uses 374 -- its own type of hash table 375 -- 376 -- The hash table is used to locate existing entries in the names table. 377 -- The entries point to the first names table entry whose hash value 378 -- matches the hash code. Then subsequent names table entries with the 379 -- same hash code value are linked through the Hash_Link fields. 380 381 function Hash return Hash_Index_Type; 382 pragma Inline (Hash); 383 -- Compute hash code for name stored in Name_Buffer (length in Name_Len) 384 -- In Unit Name Table it can really be applied only to the "normalized" 385 -- unit names. 386 387 --------------- 388 -- NEW STUFF -- 389 --------------- 390 391 package A_Name_Chars is new Table.Table ( 392 Table_Component_Type => Character, 393 Table_Index_Type => Int, 394 Table_Low_Bound => 0, 395 Table_Initial => Alloc.Name_Chars_Initial, 396 Table_Increment => Alloc.Name_Chars_Increment, 397 Table_Name => "A_Name_Chars"); 398 399 package Unit_Table is new Table.Table ( 400 Table_Component_Type => A4G.Unit_Rec.Unit_Record, 401 Table_Index_Type => A4G.A_Types.Unit_Id, 402 Table_Low_Bound => A4G.A_Types.First_Unit_Id, 403 Table_Initial => A4G.A_Alloc.Alloc_ASIS_Units_Initial, 404 Table_Increment => A4G.A_Alloc.Alloc_ASIS_Units_Increment, 405 Table_Name => "ASIS_Compilation_Units"); 406 407 package Tree_Table is new Table.Table ( 408 Table_Component_Type => A4G.Tree_Rec.Tree_Record, 409 Table_Index_Type => A4G.A_Types.Tree_Id, 410 Table_Low_Bound => A4G.A_Types.First_Tree_Id, 411 Table_Initial => A4G.A_Alloc.Alloc_ASIS_Trees_Initial, 412 Table_Increment => A4G.A_Alloc.Alloc_ASIS_Trees_Increment, 413 Table_Name => "ASIS_Trees"); 414 415 subtype Directory_List_Ptr is Argument_List_Access; 416 subtype Tree_File_List_Ptr is Argument_List_Access; 417 418 type Saved_Context is record 419 Context_Name_Chars : A_Name_Chars.Saved_Table; 420 Context_Unit_Lists : A4G.A_Elists.Saved_Lists; 421 Units : Unit_Table.Saved_Table; 422 Trees : Tree_Table.Saved_Table; 423 end record; 424 425 -------------------- 426 -- Context Record -- 427 -------------------- 428 429 type Context_Record is record -- the field should be commented also here!!! 430 431 --------------------------------------------------- 432 -- General Context/Context Attributes and Fields -- 433 --------------------------------------------------- 434 435 Name : String_Access; 436 Parameters : String_Access; 437 -- to keep the parameters set by the ASIS Associate routine 438 439 GCC : String_Access; 440 -- If non-null, contains the full path to the compiler to be used when 441 -- creating trees on the fly. (If null, the standard gcc/GNAT 442 -- installation is used) 443 444 Is_Associated : Boolean := False; 445 Is_Opened : Boolean := False; 446 447 Opened_At : ASIS_OS_Time := Last_ASIS_OS_Time; 448 -- when an application opens a Context, we store the time of opening; 449 -- we need it to check whether an Element or a Compilation_Unit in 450 -- use has been obtained after the last opening of this Context 451 452 Specs : Natural; 453 Bodies : Natural; 454 -- counters for library_units_declarations and library_unit_bodies/ 455 -- subunits (respectively) contained in a Context. We need them to 456 -- optimize processing of the queries Compilation_Units, 457 -- Libary_Unit_Declarations and Compilation_Unit_Bodies from 458 -- Asis.Compilation_Units and to make the difference between "regular" 459 -- and nonexistent units. Last for Context's Unit table gives us the 460 -- whole number of all the units, including nonexistent ones. 461 462 ------------------------------------- 463 -- Fields for Context's Unit Table -- 464 ------------------------------------- 465 466 Hash_Table : Hash_Array; -- hash table for Unit Table 467 468 Current_Main_Unit : Unit_Id; 469 -- The variable to store the Id of the Unit corresponding to the 470 -- main unit of the currently accessed tree 471 472 -- ----------------------------------------------... 473 -- | Nil | |...|XXX| | | | | 474 -- | Unit | |...|XXX| | | | | <- Unit Table 475 -- ----------------------------------------------... 476 -- ^ ^ ^ ^ ^ 477 -- | | | | | 478 -- | ----------------| 479 -- Current_Main_Unit | 480 -- | 481 -- for all of these Units 482 -- Is_New (C, Unit) = True 483 484 ------------------ 485 -- Search Paths -- 486 ------------------ 487 488 -- we do not know the number of the directories in a path, so we have 489 -- to use pointers to the arrays of the pointers to strings 490 491 Source_Path : Directory_List_Ptr; 492 -- The search path for the source files 493 Object_Path : Directory_List_Ptr; 494 -- The search path for library (that is, object + ALI) files 495 Tree_Path : Directory_List_Ptr; 496 -- The search path for the tree output files 497 498 Context_I_Options : Directory_List_Ptr; 499 -- Source search path for GNAT or another tree builder, when it is 500 -- called from inside ASIS to create a tree output file "on the fly" 501 -- ("I" comes after "-I" gcc/GNAT option). The corresponding search 502 -- path is obtained form the value of the Source_Path field by 503 -- prepending "-I" to each directory name kept in Source_Path and 504 -- by appending "-I-" element to this path 505 506 Extra_Options : Argument_List_Access; 507 -- Extra options to pass to gcc. 508 509 Context_Tree_Files : Tree_File_List_Ptr; 510 511 Back_Up : Saved_Context; 512 513 Mode : Context_Mode := All_Trees; 514 Tree_Processing : Tree_Mode := Pre_Created; 515 Source_Processing : Source_Mode := All_Sources; 516 517 Use_Default_Trees : Boolean := False; 518 -- If set On, the value of the GNAT environment variable 519 -- ADA_OBJECTS_PATH is appended to Object_Path 520 521 end record; 522 523 ------------------- 524 -- Context Table -- 525 ------------------- 526 527 package Contexts is new Table.Table ( 528 Table_Component_Type => Context_Record, 529 Table_Index_Type => Context_Id, 530 Table_Low_Bound => First_Context_Id, 531 Table_Initial => Alloc_Contexts_Initial, 532 Table_Increment => Alloc_Contexts_Increment, 533 Table_Name => "ASIS_Contexts"); 534 535 ------------------------------------------------------ 536 -- "Back-Up" Name Buffer for NB_Save and NB_Restore -- 537 ------------------------------------------------------ 538 539 Backup_Name_Buffer : String (1 .. Hostparm.Max_Name_Length); 540 Backup_Name_Len : Natural := 0; 541 -- ??? is it the right place for these declarations??? 542 543 Current_Tree : Tree_Id := Nil_Tree; 544 -- This is the tree, which is being currently accessed by ASIS. 545 -- The Initialize procedure sets Current_Tree equal to Nil_Tree. 546 547 Current_Context : Context_Id := Non_Associated; 548 -- This is the Context to which the currently accessed tree belongs. 549 -- The Initialize procedure sets Current_Context equal to Non_Associated. 550 551 First_New_Unit : Unit_Id; 552 -- In the Incremental Context mode stores the first unit registered 553 -- from the newly created tree. Then used by Set_All_Dependencies routine 554 -- to collect full dependencies only for the units added to the Context 555 556end A4G.Contt; 557