1-- GHDL Run Time (GRT) - VITAL annotator. 2-- Copyright (C) 2002 - 2014 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>. 16-- 17-- As a special exception, if other files instantiate generics from this 18-- unit, or you link this unit with other files to produce an executable, 19-- this unit does not by itself cause the resulting executable to be 20-- covered by the GNU General Public License. This exception does not 21-- however invalidate any other reasons why the executable file might be 22-- covered by the GNU Public License. 23with Grt.Types; use Grt.Types; 24with Grt.Hooks; use Grt.Hooks; 25with Grt.Astdio; use Grt.Astdio; 26with Grt.Stdio; use Grt.Stdio; 27with Grt.Options; 28with Grt.Avhpi; use Grt.Avhpi; 29with Grt.Avhpi_Utils; use Grt.Avhpi_Utils; 30with Grt.Errors; use Grt.Errors; 31 32package body Grt.Vital_Annotate is 33 -- Point of the annotation. 34 Sdf_Top : VhpiHandleT; 35 36 -- Instance being annotated. 37 Sdf_Inst : VhpiHandleT; 38 39 Flag_Dump : Boolean := False; 40 Flag_Verbose : constant Boolean := False; 41 42 -- Note: RES may alias CUR. 43 procedure Find_Instance (Cur : VhpiHandleT; 44 Res : out VhpiHandleT; 45 Name : String; 46 Ok : out Boolean) 47 is 48 Error : AvhpiErrorT; 49 It : VhpiHandleT; 50 begin 51 Ok := False; 52 Vhpi_Iterator (VhpiInternalRegions, Cur, It, Error); 53 if Error /= AvhpiErrorOk then 54 return; 55 end if; 56 loop 57 Vhpi_Scan (It, Res, Error); 58 exit when Error /= AvhpiErrorOk; 59 if Name_Compare (Res, Name) then 60 Ok := True; 61 return; 62 end if; 63 end loop; 64 return; 65-- Put ("find instance: "); 66-- Put (Name); 67-- New_Line; 68 end Find_Instance; 69 70 procedure Find_Generic (Gen_Name : String; 71 Gen_Handle : out VhpiHandleT; 72 Port1_Name : String; 73 Port1_Handle : out VhpiHandleT; 74 Port2_Name : String; 75 Port2_Handle : out VhpiHandleT) 76 is 77 Error : AvhpiErrorT; 78 It : VhpiHandleT; 79 Decl : VhpiHandleT; 80 begin 81 Gen_Handle := Null_Handle; 82 Port1_Handle := Null_Handle; 83 Port2_Handle := Null_Handle; 84 85 Vhpi_Iterator (VhpiDecls, Sdf_Inst, It, Error); 86 if Error /= AvhpiErrorOk then 87 return; 88 end if; 89 90 -- Look for the generic. 91 loop 92 Vhpi_Scan (It, Decl, Error); 93 if Error /= AvhpiErrorOk then 94 return; 95 end if; 96 exit when Vhpi_Get_Kind (Decl) /= VhpiGenericDeclK; 97 if Name_Compare (Decl, Gen_Name) then 98 Gen_Handle := Decl; 99 exit; 100 end if; 101 end loop; 102 103 -- Skip generics. 104 while Vhpi_Get_Kind (Decl) = VhpiGenericDeclK loop 105 Vhpi_Scan (It, Decl, Error); 106 if Error /= AvhpiErrorOk then 107 return; 108 end if; 109 end loop; 110 111 -- Look for ports. 112 loop 113 exit when Vhpi_Get_Kind (Decl) /= VhpiPortDeclK; 114 if Name_Compare (Decl, Port1_Name) then 115 Port1_Handle := Decl; 116 exit when Port2_Name'Length = 0; 117 end if; 118 if Port2_Name'Length > 0 119 and then Name_Compare (Decl, Port2_Name) 120 then 121 Port2_Handle := Decl; 122 exit when Vhpi_Get_Kind (Port1_Handle) /= VhpiUndefined; 123 end if; 124 Vhpi_Scan (It, Decl, Error); 125 if Error /= AvhpiErrorOk then 126 return; 127 end if; 128 end loop; 129 130 end Find_Generic; 131 132 procedure Sdf_Header (Context : Sdf_Context_Type) 133 is 134 begin 135 if Flag_Dump then 136 case Context.Version is 137 when Sdf_2_1 => 138 Put ("found SDF file version 2.1"); 139 when Sdf_Version_Unknown => 140 Put ("found SDF file without version"); 141 when Sdf_Version_Bad => 142 Put ("found SDF file with unknown version"); 143 end case; 144 New_Line; 145 end if; 146 end Sdf_Header; 147 148 procedure Sdf_Celltype (Context : Sdf_Context_Type) 149 is 150 begin 151 if Flag_Dump then 152 Put ("celltype: "); 153 Put (Context.Celltype (1 .. Context.Celltype_Len)); 154 New_Line; 155 Put ("instance:"); 156 return; 157 end if; 158 Sdf_Inst := Sdf_Top; 159 end Sdf_Celltype; 160 161 procedure Sdf_Instance (Context : in out Sdf_Context_Type; 162 Instance : String; 163 Status : out Boolean) 164 is 165 pragma Unreferenced (Context); 166 New_Inst : VhpiHandleT; 167 begin 168 if Flag_Dump then 169 Put (' '); 170 Put (Instance); 171 Status := True; 172 return; 173 end if; 174 175 Find_Instance (Sdf_Inst, New_Inst, Instance, Status); 176 Sdf_Inst := New_Inst; 177 end Sdf_Instance; 178 179 procedure Sdf_Instance_End (Context : Sdf_Context_Type; 180 Status : out Boolean) 181 is 182 begin 183 if Flag_Dump then 184 Status := True; 185 New_Line; 186 return; 187 end if; 188 case Vhpi_Get_Kind (Sdf_Inst) is 189 when VhpiRootInstK => 190 declare 191 Hdl : VhpiHandleT; 192 begin 193 Hdl := Get_Root_Entity (Sdf_Inst); 194 Status := Name_Compare 195 (Hdl, Context.Celltype (1 .. Context.Celltype_Len)); 196 end; 197 when VhpiCompInstStmtK => 198 Status := Name_Compare 199 (Sdf_Inst, 200 Context.Celltype (1 .. Context.Celltype_Len), 201 VhpiCompNameP); 202 when others => 203 Status := False; 204 end case; 205 end Sdf_Instance_End; 206 207 VitalDelayType01 : VhpiHandleT; 208 VitalDelayType01Z : VhpiHandleT; 209 VitalDelayType01ZX : VhpiHandleT; 210 VitalDelayArrayType01 : VhpiHandleT; 211 VitalDelayType : VhpiHandleT; 212 VitalDelayArrayType : VhpiHandleT; 213 214 type Map_Type is array (1 .. 12) of Natural; 215 Map_1 : constant Map_Type := (1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0); 216 Map_2 : constant Map_Type := (1, 2, 1, 1, 2, 2, 0, 0, 0, 0, 0, 0); 217 Map_3 : constant Map_Type := (1, 2, 3, 1, 3, 2, 0, 0, 0, 0, 0, 0); 218 Map_6 : constant Map_Type := (1, 2, 3, 4, 5, 6, 0, 0, 0, 0, 0, 0); 219 --Map_12 : constant Map_Type := (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12); 220 221 function Write_Td_Delay_Generic (Context : Sdf_Context_Type; 222 Gen : VhpiHandleT; 223 Nbr : Natural; 224 Map : Map_Type) 225 return Boolean 226 is 227 It : VhpiHandleT; 228 El : VhpiHandleT; 229 Error : AvhpiErrorT; 230 N : Natural; 231 begin 232 Vhpi_Iterator (VhpiIndexedNames, Gen, It, Error); 233 if Error /= AvhpiErrorOk then 234 Internal_Error ("vhpiIndexedNames"); 235 return False; 236 end if; 237 for I in 1 .. Nbr loop 238 Vhpi_Scan (It, El, Error); 239 if Error /= AvhpiErrorOk then 240 Internal_Error ("scan on vhpiIndexedNames"); 241 return False; 242 end if; 243 N := Map (I); 244 if Context.Timing_Set (N) then 245 if Vhpi_Put_Value (El, Context.Timing (N) * 1000) /= AvhpiErrorOk 246 then 247 Internal_Error ("vhpi_put_value"); 248 return False; 249 end if; 250 end if; 251 end loop; 252 return True; 253 end Write_Td_Delay_Generic; 254 255 function Write_Td_Delay_Generic (Context : Sdf_Context_Type; 256 Gen : VhpiHandleT) 257 return Boolean 258 is 259 Gen_Basetype : VhpiHandleT; 260 Error : AvhpiErrorT; 261 begin 262 Vhpi_Handle (VhpiBaseType, Gen, Gen_Basetype, Error); 263 if Error /= AvhpiErrorOk then 264 Internal_Error ("write_td_delay_generic: vhpiBaseType"); 265 return False; 266 end if; 267 if Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01) then 268 case Context.Timing_Nbr is 269 when 1 => 270 return Write_Td_Delay_Generic (Context, Gen, 2, Map_1); 271 when 2 => 272 return Write_Td_Delay_Generic (Context, Gen, 2, Map_2); 273 when others => 274 Errors.Error 275 ("timing generic type mismatch SDF timing specification"); 276 end case; 277 elsif Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01Z) then 278 case Context.Timing_Nbr is 279 when 1 => 280 return Write_Td_Delay_Generic (Context, Gen, 6, Map_1); 281 when 2 => 282 return Write_Td_Delay_Generic (Context, Gen, 6, Map_2); 283 when 3 => 284 return Write_Td_Delay_Generic (Context, Gen, 6, Map_3); 285 when 6 => 286 return Write_Td_Delay_Generic (Context, Gen, 6, Map_6); 287 when others => 288 Errors.Error 289 ("timing generic type mismatch SDF timing specification"); 290 end case; 291 elsif Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType) then 292 if Vhpi_Put_Value (Gen, Context.Timing (1) * 1000) /= AvhpiErrorOk 293 then 294 Internal_Error ("vhpi_put_value (vitaldelaytype)"); 295 else 296 return True; 297 end if; 298 else 299 Internal_Error ("write_td_delay_generic: unhandled generic type"); 300 end if; 301 end Write_Td_Delay_Generic; 302 303 procedure Generic_Get_Bounds (Port : VhpiHandleT; 304 Left : out Ghdl_I32; 305 Len : out Ghdl_Index_Type; 306 Up : out Boolean) 307 is 308 Port_Type, Port_Range : VhpiHandleT; 309 Error : AvhpiErrorT; 310 Right : VhpiIntT; 311 begin 312 Vhpi_Handle (VhpiSubtype, Port, Port_Type, Error); 313 Left := 0; 314 Len := 0; 315 Up := True; 316 if Error /= AvhpiErrorOk then 317 Internal_Error ("vhpiSubtype - port"); 318 return; 319 end if; 320 Vhpi_Handle_By_Index (VhpiConstraints, Port_Type, 1, Port_Range, Error); 321 if Error /= AvhpiErrorOk then 322 Internal_Error ("vhpiIndexConstraints - port"); 323 return; 324 end if; 325 Vhpi_Get (VhpiLeftBoundP, Port_Range, Left, Error); 326 if Error /= AvhpiErrorOk then 327 Internal_Error ("vhpiLeftBoundP - port"); 328 return; 329 end if; 330 Vhpi_Get (VhpiRightBoundP, Port_Range, Right, Error); 331 if Error /= AvhpiErrorOk then 332 Internal_Error ("vhpiRightBoundP - port"); 333 return; 334 end if; 335 Vhpi_Get (VhpiIsUpP, Port_Range, Up, Error); 336 if Error /= AvhpiErrorOk then 337 Internal_Error ("vhpiIsUpP - port"); 338 return; 339 end if; 340 if Up then 341 Len := Ghdl_Index_Type (Right - Left) + 1; 342 else 343 Len := Ghdl_Index_Type (Left - Right) + 1; 344 end if; 345 end Generic_Get_Bounds; 346 347 procedure Sdf_Generic (Context : in out Sdf_Context_Type; 348 Name : String; 349 Ok : out Boolean) 350 is 351 Gen : VhpiHandleT; 352 Gen_Basetype : VhpiHandleT; 353 Port1, Port2 : VhpiHandleT; 354 Error : AvhpiErrorT; 355 begin 356 if Flag_Dump then 357 Put ("generic: "); 358 Put (Name); 359 if Context.Timing_Nbr = 0 then 360 Put (' '); 361 Put_I64 (stdout, Context.Timing (1)); 362 else 363 for I in 1 .. 12 loop 364 Put (' '); 365 if Context.Timing_Set (I) then 366 Put_I64 (stdout, Context.Timing (I)); 367 else 368 Put ('?'); 369 end if; 370 end loop; 371 end if; 372 373 New_Line; 374 Ok := True; 375 return; 376 end if; 377 378 Ok := False; 379 380 if Context.Port_Num = 1 then 381 Context.Ports (2).Name_Len := 0; 382 end if; 383 Find_Generic 384 (Name, Gen, 385 Context.Ports (1).Name (1 .. Context.Ports (1).Name_Len), Port1, 386 Context.Ports (2).Name (1 .. Context.Ports (2).Name_Len), Port2); 387 if Vhpi_Get_Kind (Gen) = VhpiUndefined 388 or else Vhpi_Get_Kind (Port1) = VhpiUndefined 389 or else (Context.Port_Num = 2 390 and then Vhpi_Get_Kind (Port2) = VhpiUndefined) 391 then 392 return; 393 end if; 394 395 -- Extract subtype. 396 Vhpi_Handle (VhpiBaseType, Gen, Gen_Basetype, Error); 397 if Error /= AvhpiErrorOk then 398 Internal_Error ("vhpiBaseType"); 399 return; 400 end if; 401 if Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01) 402 or else Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01Z) 403 or else Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01ZX) 404 or else Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType) 405 then 406 Ok := Write_Td_Delay_Generic (Context, Gen); 407 elsif Vhpi_Compare_Handles (Gen_Basetype, VitalDelayArrayType01) 408 or else Vhpi_Compare_Handles (Gen_Basetype, VitalDelayArrayType) 409 then 410 declare 411 Left_Gen, Left1, Left2 : Ghdl_I32; 412 Len_Gen, Len1, Len2 : Ghdl_Index_Type; 413 Up_Gen, Up1, Up2 : Boolean; 414 Pos : Ghdl_Index_Type; 415 Gen_El : VhpiHandleT; 416 begin 417 Generic_Get_Bounds (Gen, Left_Gen, Len_Gen, Up_Gen); 418 if Context.Port_Num >= 1 419 and then Context.Ports (1).L /= Invalid_Dnumber 420 then 421 Generic_Get_Bounds (Port1, Left1, Len1, Up1); 422 if Up1 then 423 Pos := Ghdl_Index_Type (Context.Ports (1).L - Left1); 424 else 425 Pos := Ghdl_Index_Type (Left1 - Context.Ports (1).L); 426 end if; 427 else 428 Pos := 0; 429 end if; 430 if Context.Port_Num >= 2 431 and then Context.Ports (2).L /= Invalid_Dnumber 432 then 433 Generic_Get_Bounds (Port2, Left2, Len2, Up2); 434 Pos := Pos * Len2; 435 if Up2 then 436 Pos := Pos + Ghdl_Index_Type (Context.Ports (2).L - Left2); 437 else 438 Pos := Pos + Ghdl_Index_Type (Left2 - Context.Ports (2).L); 439 end if; 440 end if; 441 Vhpi_Handle_By_Index 442 (VhpiIndexedNames, Gen, Integer (Pos), Gen_El, Error); 443 if Error /= AvhpiErrorOk then 444 Internal_Error ("vhpiIndexedNames - gen_el"); 445 return; 446 end if; 447 Ok := Write_Td_Delay_Generic (Context, Gen_El); 448 end; 449 else 450 Errors.Error_S ("vital: unhandled generic type for generic "); 451 Errors.Error_E (Name); 452 end if; 453 end Sdf_Generic; 454 455 procedure Annotate (Arg : String) 456 is 457 S, E : Natural; 458 Ok : Boolean; 459 New_Top : VhpiHandleT; 460 begin 461 if Flag_Verbose then 462 Put ("sdf annotate: "); 463 Put (Arg); 464 New_Line; 465 end if; 466 467 -- Find scope by name. 468 Get_Root_Inst (Sdf_Top); 469 E := Arg'First; 470 S := E; 471 L1: loop 472 -- Skip path separator. 473 while Arg (E) = '/' or Arg (E) = '.' loop 474 E := E + 1; 475 exit L1 when E > Arg'Last; 476 end loop; 477 478 exit L1 when E > Arg'Last or else Arg (E) = '='; 479 480 -- Instance element. 481 S := E; 482 while Arg (E) /= '=' and Arg (E) /= '.' and Arg (E) /= '/' loop 483 E := E + 1; 484 exit L1 when E > Arg'Last; 485 end loop; 486 487 -- Path element. 488 if E - 1 >= S then 489 Find_Instance (Sdf_Top, New_Top, Arg (S .. E - 1), Ok); 490 if not Ok then 491 Error_S ("cannot find instance '"); 492 Diag_C (Arg (S .. E - 1)); 493 Error_E ("' for sdf annotation"); 494 return; 495 end if; 496 Sdf_Top := New_Top; 497 end if; 498 end loop L1; 499 500 -- start annotation. 501 if E >= Arg'Last or else Arg (E) /= '=' then 502 Error_S ("no filename in sdf option '"); 503 Diag_C (Arg); 504 Error_E ("'"); 505 return; 506 end if; 507 if not Sdf.Parse_Sdf_File (Arg (E + 1 .. Arg'Last)) then 508 null; 509 end if; 510 end Annotate; 511 512 procedure Extract_Vital_Delay_Type 513 is 514 It : VhpiHandleT; 515 Pkg : VhpiHandleT; 516 Decl : VhpiHandleT; 517 Basetype : VhpiHandleT; 518 Status : AvhpiErrorT; 519 begin 520 Get_Package_Inst (It); 521 loop 522 Vhpi_Scan (It, Pkg, Status); 523 exit when Status /= AvhpiErrorOk; 524 exit when Name_Compare (Pkg, "vital_timing") 525 and then Name_Compare (Pkg, "ieee", VhpiLibLogicalNameP); 526 end loop; 527 if Status /= AvhpiErrorOk then 528 Error ("package ieee.vital_timing not found, SDF annotation aborted"); 529 return; 530 end if; 531 Vhpi_Iterator (VhpiDecls, Pkg, It, Status); 532 if Status /= AvhpiErrorOk then 533 Error ("cannot iterate on vital_timing"); 534 return; 535 end if; 536 loop 537 Vhpi_Scan (It, Decl, Status); 538 exit when Status /= AvhpiErrorOk; 539 if Vhpi_Get_Kind (Decl) = VhpiSubtypeDeclK 540 or else Vhpi_Get_Kind (Decl) = VhpiArrayTypeDeclK 541 then 542 Vhpi_Handle (VhpiBaseType, Decl, Basetype, Status); 543 if Status = AvhpiErrorOk then 544 if Name_Compare (Decl, "vitaldelaytype01") then 545 VitalDelayType01 := Basetype; 546 elsif Name_Compare (Decl, "vitaldelaytype01z") then 547 VitalDelayType01Z := Basetype; 548 elsif Name_Compare (Decl, "vitaldelaytype01zx") then 549 VitalDelayType01ZX := Basetype; 550 elsif Name_Compare (Decl, "vitaldelayarraytype01") then 551 VitalDelayArrayType01 := Basetype; 552 elsif Name_Compare (Decl, "vitaldelaytype") then 553 VitalDelayType := Basetype; 554 elsif Name_Compare (Decl, "vitaldelayarraytype") then 555 VitalDelayArrayType := Basetype; 556 end if; 557 end if; 558 end if; 559 end loop; 560 if Vhpi_Get_Kind (VitalDelayType01) = VhpiUndefined then 561 Error ("cannot find VitalDelayType01 in ieee.vital_timing"); 562 return; 563 end if; 564 if Vhpi_Get_Kind (VitalDelayType01Z) = VhpiUndefined then 565 Error ("cannot find VitalDelayType01Z in ieee.vital_timing"); 566 return; 567 end if; 568 if Vhpi_Get_Kind (VitalDelayType01ZX) = VhpiUndefined then 569 Error ("cannot find VitalDelayType01ZX in ieee.vital_timing"); 570 return; 571 end if; 572 if Vhpi_Get_Kind (VitalDelayArrayType01) = VhpiUndefined then 573 Error ("cannot find VitalDelayArrayType01 in ieee.vital_timing"); 574 return; 575 end if; 576 if Vhpi_Get_Kind (VitalDelayType) = VhpiUndefined then 577 Error ("cannot find VitalDelayType in ieee.vital_timing"); 578 return; 579 end if; 580 end Extract_Vital_Delay_Type; 581 582 Has_Sdf_Option : Boolean := False; 583 584 procedure Sdf_Start 585 is 586 use Grt.Options; 587 Len : Integer; 588 Beg : Integer; 589 Arg : Ghdl_C_String; 590 begin 591 if not Has_Sdf_Option then 592 -- Nothing to do. 593 return; 594 end if; 595 Flag_Dump := False; 596 597 -- Extract VitalDelayType(s) from VITAL_Timing package. 598 Extract_Vital_Delay_Type; 599 600 -- Annotate. 601 for I in 1 .. Last_Opt loop 602 Arg := Argv (I); 603 Len := strlen (Arg); 604 if Len > 5 and then Arg (1 .. 6) = "--sdf=" then 605 Sdf_Mtm := Typical; 606 Beg := 7; 607 if Len > 10 then 608 if Arg (7 .. 10) = "typ=" then 609 Beg := 11; 610 elsif Arg (7 .. 10) = "min=" then 611 Sdf_Mtm := Minimum; 612 Beg := 11; 613 elsif Arg (7 .. 10) = "max=" then 614 Sdf_Mtm := Maximum; 615 Beg := 11; 616 end if; 617 end if; 618 Annotate (Arg (Beg .. Len)); 619 end if; 620 end loop; 621 end Sdf_Start; 622 623 function Sdf_Option (Option : String) return Boolean 624 is 625 Opt : constant String (1 .. Option'Length) := Option; 626 begin 627 if Opt'Length > 11 and then Opt (1 .. 11) = "--sdf-dump=" then 628 Flag_Dump := True; 629 if Sdf.Parse_Sdf_File (Opt (12 .. Opt'Last)) then 630 null; 631 end if; 632 return True; 633 end if; 634 if Opt'Length > 5 and then Opt (1 .. 6) = "--sdf=" then 635 Has_Sdf_Option := True; 636 return True; 637 else 638 return False; 639 end if; 640 end Sdf_Option; 641 642 procedure Sdf_Help is 643 begin 644 Put_Line (" --sdf=[min=|typ=|max=]TOP=FILENAME"); 645 Put_Line (" annotate TOP with SDF delay file FILENAME"); 646 end Sdf_Help; 647 648 Sdf_Hooks : aliased constant Hooks_Type := 649 (Desc => new String' 650 ("sdf-annotate: annotate vital generics from an sdf file"), 651 Option => Sdf_Option'Access, 652 Help => Sdf_Help'Access, 653 Init => Proc_Hook_Nil'Access, 654 Start => Sdf_Start'Access, 655 Finish => Proc_Hook_Nil'Access); 656 657 procedure Register is 658 begin 659 Register_Hooks (Sdf_Hooks'Access); 660 end Register; 661end Grt.Vital_Annotate; 662