1-- Environment definition for synthesis. 2-- Copyright (C) 2017 Tristan Gingold 3-- 4-- This file is part of GHDL. 5-- 6-- This program is free software; you can redistribute it and/or modify 7-- it under the terms of the GNU General Public License as published by 8-- the Free Software Foundation; either version 2 of the License, or 9-- (at your option) any later version. 10-- 11-- This program is distributed in the hope that it will be useful, 12-- but WITHOUT ANY WARRANTY; without even the implied warranty of 13-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14-- GNU General Public License for more details. 15-- 16-- You should have received a copy of the GNU General Public License 17-- along with this program; if not, write to the Free Software 18-- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, 19-- MA 02110-1301, USA. 20 21with Netlists.Builders; use Netlists.Builders; 22with Netlists.Concats; 23with Netlists.Gates; 24with Netlists.Gates_Ports; 25with Netlists.Locations; use Netlists.Locations; 26with Netlists.Utils; use Netlists.Utils; 27with Netlists.Folds; use Netlists.Folds; 28with Netlists.Inference; 29 30with Errorout; use Errorout; 31with Name_Table; 32 33with Synth.Flags; 34with Synth.Errors; use Synth.Errors; 35with Synth.Source; use Synth.Source; 36with Synth.Context; 37 38with Vhdl.Nodes; 39with Vhdl.Utils; 40 41package body Synth.Environment is 42 procedure Phi_Assign 43 (Ctxt : Builders.Context_Acc; Dest : Wire_Id; Pasgn : Partial_Assign); 44 45 procedure Set_Wire_Mark (Wid : Wire_Id; Mark : Boolean := True) is 46 begin 47 Wire_Id_Table.Table (Wid).Mark_Flag := Mark; 48 end Set_Wire_Mark; 49 50 function Get_Wire_Mark (Wid : Wire_Id) return Boolean is 51 begin 52 return Wire_Id_Table.Table (Wid).Mark_Flag; 53 end Get_Wire_Mark; 54 55 function Alloc_Wire (Kind : Wire_Kind; Typ : Type_Acc; Obj : Source.Syn_Src) 56 return Wire_Id 57 is 58 Res : Wire_Id; 59 begin 60 Wire_Id_Table.Append ((Kind => Kind, 61 Mark_Flag => False, 62 Decl => Obj, 63 Typ => Typ, 64 Gate => No_Net, 65 Cur_Assign => No_Seq_Assign, 66 Final_Assign => No_Conc_Assign, 67 Nbr_Final_Assign => 0)); 68 Res := Wire_Id_Table.Last; 69 return Res; 70 end Alloc_Wire; 71 72 procedure Free_Wire (Wid : Wire_Id) 73 is 74 Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); 75 begin 76 -- Check the wire was not already free. 77 pragma Assert (Wire_Rec.Kind /= Wire_None); 78 79 -- All the assignments have been handled. 80 pragma Assert (Wire_Rec.Cur_Assign = No_Seq_Assign); 81 82 Wire_Rec.Kind := Wire_None; 83 end Free_Wire; 84 85 procedure Set_Wire_Gate (Wid : Wire_Id; Gate : Net) is 86 begin 87 -- Cannot override a gate. 88 pragma Assert (Wire_Id_Table.Table (Wid).Gate = No_Net); 89 90 Wire_Id_Table.Table (Wid).Gate := Gate; 91 end Set_Wire_Gate; 92 93 function Get_Wire_Gate (Wid : Wire_Id) return Net is 94 begin 95 return Wire_Id_Table.Table (Wid).Gate; 96 end Get_Wire_Gate; 97 98 function Get_Wire_Id (W : Seq_Assign) return Wire_Id is 99 begin 100 return Assign_Table.Table (W).Id; 101 end Get_Wire_Id; 102 103 function Get_Assign_Prev (Asgn : Seq_Assign) return Seq_Assign is 104 begin 105 return Assign_Table.Table (Asgn).Prev; 106 end Get_Assign_Prev; 107 108 function Get_Assign_Chain (Asgn : Seq_Assign) return Seq_Assign is 109 begin 110 return Assign_Table.Table (Asgn).Chain; 111 end Get_Assign_Chain; 112 113 procedure Set_Assign_Chain (Asgn : Seq_Assign; Chain : Seq_Assign) is 114 begin 115 Assign_Table.Table (Asgn).Chain := Chain; 116 end Set_Assign_Chain; 117 118 function Get_Assign_Is_Static (Asgn : Seq_Assign) return Boolean is 119 begin 120 return Assign_Table.Table (Asgn).Val.Is_Static = True; 121 end Get_Assign_Is_Static; 122 123 function Get_Assign_Static_Val (Asgn : Seq_Assign) return Memtyp is 124 begin 125 return Assign_Table.Table (Asgn).Val.Val; 126 end Get_Assign_Static_Val; 127 128 function Get_Assign_Partial (Asgn : Seq_Assign) return Partial_Assign is 129 begin 130 -- Note: fails if the value is static. 131 -- Use Get_Assign_Partial_Force if you want to automatically convert 132 -- the value to a Partial_Assign (a net). 133 return Assign_Table.Table (Asgn).Val.Asgns; 134 end Get_Assign_Partial; 135 136 function Get_Seq_Assign_Value (Asgn : Seq_Assign) return Seq_Assign_Value is 137 begin 138 return Assign_Table.Table (Asgn).Val; 139 end Get_Seq_Assign_Value; 140 141 function New_Partial_Assign (Val : Net; Offset : Uns32) 142 return Partial_Assign is 143 begin 144 Partial_Assign_Table.Append ((Next => No_Partial_Assign, 145 Value => Val, 146 Offset => Offset)); 147 return Partial_Assign_Table.Last; 148 end New_Partial_Assign; 149 150 function Get_Partial_Offset (Asgn : Partial_Assign) return Uns32 is 151 begin 152 return Partial_Assign_Table.Table (Asgn).Offset; 153 end Get_Partial_Offset; 154 155 function Get_Partial_Value (Asgn : Partial_Assign) return Net is 156 begin 157 return Partial_Assign_Table.Table (Asgn).Value; 158 end Get_Partial_Value; 159 160 function Get_Partial_Next (Asgn : Partial_Assign) return Partial_Assign is 161 begin 162 return Partial_Assign_Table.Table (Asgn).Next; 163 end Get_Partial_Next; 164 165 procedure Set_Partial_Next (Asgn : Partial_Assign; 166 Chain : Partial_Assign) is 167 begin 168 Partial_Assign_Table.Table (Asgn).Next := Chain; 169 end Set_Partial_Next; 170 171 function Current_Phi return Phi_Id is 172 begin 173 return Phis_Table.Last; 174 end Current_Phi; 175 176 procedure Push_Phi is 177 begin 178 Phis_Table.Append ((First => No_Seq_Assign, 179 Last => No_Seq_Assign, 180 Nbr => 0, 181 En => No_Wire_Id)); 182 end Push_Phi; 183 184 procedure Mark (M : out Wire_Id) is 185 begin 186 M := Wire_Id_Table.Last; 187 end Mark; 188 189 procedure Release (M : in out Wire_Id) 190 is 191 Last : Wire_Id; 192 begin 193 -- Check all wires to be released are free. 194 Last := M; 195 for I in M + 1 .. Wire_Id_Table.Last loop 196 declare 197 Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (I); 198 Asgn : Seq_Assign; 199 begin 200 case Wire_Rec.Kind is 201 when Wire_None => 202 null; 203 when Wire_Enable => 204 -- Keep. This renames the wire, but the only references 205 -- must be in the wire. 206 Last := Last + 1; 207 if Last /= I then 208 -- Renames. 209 Asgn := Wire_Rec.Cur_Assign; 210 while Asgn /= No_Seq_Assign loop 211 Assign_Table.Table (Asgn).Id := Last; 212 Asgn := Get_Assign_Prev (Asgn); 213 end loop; 214 Wire_Id_Table.Table (Last) := Wire_Rec; 215 end if; 216 when others => 217 raise Internal_Error; 218 end case; 219 end; 220 end loop; 221 222 -- Release. 223 Wire_Id_Table.Set_Last (Last); 224 225 M := No_Wire_Id; 226 end Release; 227 228 procedure All_Released is 229 begin 230 if Wire_Id_Table.Last /= No_Wire_Id then 231 raise Internal_Error; 232 end if; 233 end All_Released; 234 235 -- Concatenate when possible partial assignments of HEAD. 236 procedure Merge_Partial_Assignments 237 (Ctxt : Context_Acc; Head : Seq_Assign_Value) 238 is 239 use Netlists.Concats; 240 First : Partial_Assign; 241 Next : Partial_Assign; 242 Concat : Concat_Type; 243 Expected_Next_Off : Uns32; 244 Next_Off : Uns32; 245 Next_Val : Net; 246 begin 247 if Head.Is_Static /= False then 248 return; 249 end if; 250 251 First := Head.Asgns; 252 loop 253 exit when First = No_Partial_Assign; 254 255 Next := Get_Partial_Next (First); 256 exit when Next = No_Partial_Assign; 257 Expected_Next_Off := Get_Partial_Offset (First) 258 + Get_Width (Get_Partial_Value (First)); 259 Next_Off := Get_Partial_Offset (Next); 260 if Expected_Next_Off = Next_Off then 261 -- Merge First and Next. 262 Next_Val := Get_Partial_Value (Next); 263 Append (Concat, Get_Partial_Value (First)); 264 Append (Concat, Next_Val); 265 Expected_Next_Off := Next_Off + Get_Width (Next_Val); 266 -- Merge as long as possible. 267 loop 268 Next := Get_Partial_Next (Next); 269 exit when Next = No_Partial_Assign; 270 271 Next_Off := Get_Partial_Offset (Next); 272 Next_Val := Get_Partial_Value (Next); 273 exit when Next_Off /= Expected_Next_Off; 274 Append (Concat, Next_Val); 275 Expected_Next_Off := Next_Off + Get_Width (Next_Val); 276 end loop; 277 278 -- Replace. 279 declare 280 First_Record : Partial_Assign_Record renames 281 Partial_Assign_Table.Table (First); 282 begin 283 Build (Ctxt, Concat, First_Record.Value); 284 First_Record.Next := Next; 285 286 end; 287 end if; 288 First := Next; 289 end loop; 290 end Merge_Partial_Assignments; 291 292 -- Get list of assignments for this current block. 293 procedure Pop_Phi (Phi : out Phi_Type) 294 is 295 Cur_Phi : constant Phi_Id := Current_Phi; 296 Asgn : Seq_Assign; 297 begin 298 -- Pop. 299 Phi := Phis_Table.Table (Cur_Phi); 300 Phis_Table.Decrement_Last; 301 302 -- Point to previous wires. The current values are the ones before 303 -- the block. 304 Asgn := Phi.First; 305 while Asgn /= No_Seq_Assign loop 306 pragma Assert (Assign_Table.Table (Asgn).Phi = Cur_Phi); 307 Wire_Id_Table.Table (Get_Wire_Id (Asgn)).Cur_Assign := 308 Get_Assign_Prev (Asgn); 309 Asgn := Get_Assign_Chain (Asgn); 310 end loop; 311 end Pop_Phi; 312 313 procedure Phi_Discard_Wires (Wid1 : Wire_Id; Wid2 : Wire_Id) 314 is 315 Phi : Phi_Type renames Phis_Table.Table (Current_Phi); 316 Asgn, Next_Asgn : Seq_Assign; 317 Wid : Wire_Id; 318 begin 319 Asgn := Phi.First; 320 Phi := (First => No_Seq_Assign, 321 Last => No_Seq_Assign, 322 Nbr => 0, 323 En => No_Wire_Id); 324 while Asgn /= No_Seq_Assign loop 325 pragma Assert (Assign_Table.Table (Asgn).Phi = Current_Phi); 326 Next_Asgn := Get_Assign_Chain (Asgn); 327 Set_Assign_Chain (Asgn, No_Seq_Assign); 328 329 Wid := Get_Wire_Id (Asgn); 330 if Wid = Wid1 or Wid = Wid2 then 331 -- Discard. 332 pragma Assert (Wid /= No_Wire_Id); 333 Wire_Id_Table.Table (Wid).Cur_Assign := No_Seq_Assign; 334 else 335 -- Append. 336 if Phi.First = No_Seq_Assign then 337 Phi.First := Asgn; 338 else 339 Set_Assign_Chain (Phi.Last, Asgn); 340 end if; 341 Phi.Nbr := Phi.Nbr + 1; 342 Phi.Last := Asgn; 343 end if; 344 Asgn := Next_Asgn; 345 end loop; 346 end Phi_Discard_Wires; 347 348 function Get_Conc_Offset (Asgn : Conc_Assign) return Uns32 is 349 begin 350 return Conc_Assign_Table.Table (Asgn).Offset; 351 end Get_Conc_Offset; 352 353 function Get_Conc_Value (Asgn : Conc_Assign) return Net is 354 begin 355 return Conc_Assign_Table.Table (Asgn).Value; 356 end Get_Conc_Value; 357 358 function Get_Conc_Chain (Asgn : Conc_Assign) return Conc_Assign is 359 begin 360 return Conc_Assign_Table.Table (Asgn).Next; 361 end Get_Conc_Chain; 362 363 procedure Set_Conc_Chain (Asgn : Conc_Assign; Chain : Conc_Assign) is 364 begin 365 Conc_Assign_Table.Table (Asgn).Next := Chain; 366 end Set_Conc_Chain; 367 368 procedure Add_Conc_Assign 369 (Wid : Wire_Id; Val : Net; Off : Uns32; Stmt : Source.Syn_Src) 370 is 371 Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); 372 begin 373 pragma Assert (Wire_Rec.Kind /= Wire_None); 374 Conc_Assign_Table.Append ((Next => Wire_Rec.Final_Assign, 375 Value => Val, 376 Offset => Off, 377 Stmt => Stmt)); 378 Wire_Rec.Final_Assign := Conc_Assign_Table.Last; 379 Wire_Rec.Nbr_Final_Assign := Wire_Rec.Nbr_Final_Assign + 1; 380 end Add_Conc_Assign; 381 382 procedure Pop_And_Merge_Phi_Wire (Ctxt : Builders.Context_Acc; 383 Asgn_Rec : Seq_Assign_Record; 384 Stmt : Source.Syn_Src) 385 is 386 Wid : constant Wire_Id := Asgn_Rec.Id; 387 Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); 388 Outport : constant Net := Wire_Rec.Gate; 389 -- Must be connected to an Id_Output or Id_Signal 390 pragma Assert (Outport /= No_Net); 391 P : Partial_Assign; 392 Res : Net; 393 begin 394 -- Check output is not already assigned. 395 pragma Assert (Get_Input_Net (Get_Net_Parent (Outport), 0) = No_Net); 396 397 case Asgn_Rec.Val.Is_Static is 398 when Unknown => 399 raise Internal_Error; 400 when True => 401 -- Create a net. No inference to do. 402 Res := Synth.Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val); 403 if Wire_Rec.Kind = Wire_Enable then 404 Connect (Get_Input (Get_Net_Parent (Outport), 0), Res); 405 else 406 Add_Conc_Assign (Wid, Res, 0, Stmt); 407 end if; 408 when False => 409 P := Asgn_Rec.Val.Asgns; 410 pragma Assert (P /= No_Partial_Assign); 411 while P /= No_Partial_Assign loop 412 declare 413 Pa : Partial_Assign_Record renames 414 Partial_Assign_Table.Table (P); 415 begin 416 if Synth.Flags.Flag_Debug_Noinference then 417 Res := Pa.Value; 418 elsif Wire_Rec.Kind = Wire_Enable then 419 -- Possibly infere a idff/iadff. 420 pragma Assert (Pa.Offset = 0); 421 pragma Assert (Pa.Next = No_Partial_Assign); 422 Res := Inference.Infere_Assert 423 (Ctxt, Pa.Value, Outport, Stmt); 424 Connect (Get_Input (Get_Net_Parent (Outport), 0), Res); 425 else 426 -- Note: lifetime is currently based on the kind of the 427 -- wire (variable -> not reused beyond this process). 428 -- This is OK for vhdl but not general. 429 Res := Inference.Infere 430 (Ctxt, Pa.Value, Pa.Offset, Outport, Stmt, 431 Wire_Rec.Kind = Wire_Variable); 432 Add_Conc_Assign (Wid, Res, Pa.Offset, Stmt); 433 end if; 434 P := Pa.Next; 435 end; 436 end loop; 437 end case; 438 end Pop_And_Merge_Phi_Wire; 439 440 -- This procedure is called after each concurrent statement to assign 441 -- values to signals. 442 procedure Pop_And_Merge_Phi (Ctxt : Builders.Context_Acc; 443 Stmt : Source.Syn_Src) 444 is 445 Phi : Phi_Type; 446 Asgn : Seq_Assign; 447 begin 448 Pop_Phi (Phi); 449 pragma Assert (Phis_Table.Last = No_Phi_Id); 450 451 -- It is possible that the same value is assigned to different targets. 452 -- Example: 453 -- if rising_edge(clk) then 454 -- a := c; 455 -- end if; 456 -- b := a; 457 -- Because the assignment is not yet done, only the net is stored in 458 -- the partial assign. When the net for variable A is infered and 459 -- changed to a dff, it is not known that it will also be assigned to 460 -- variable B. 461 -- 462 -- Mark gates that will be infered. And if already marked, insert 463 -- a nop. 464 Asgn := Phi.First; 465 while Asgn /= No_Seq_Assign loop 466 declare 467 Asgn_Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn); 468 P : Partial_Assign; 469 begin 470 if Asgn_Rec.Val.Is_Static = False then 471 P := Asgn_Rec.Val.Asgns; 472 pragma Assert (P /= No_Partial_Assign); 473 while P /= No_Partial_Assign loop 474 declare 475 Pa : Partial_Assign_Record 476 renames Partial_Assign_Table.Table (P); 477 Res_Inst : constant Instance := Get_Net_Parent (Pa.Value); 478 begin 479 if Get_Mark_Flag (Res_Inst) 480 and then Get_Id (Res_Inst) = Gates.Id_Mux2 481 then 482 -- A nop is needed iff the value is reused and will be 483 -- inferred (which is only possible for Id_Mux2). 484 Pa.Value := Build_Nop (Ctxt, Pa.Value); 485 else 486 Set_Mark_Flag (Res_Inst, True); 487 end if; 488 489 P := Pa.Next; 490 end; 491 end loop; 492 end if; 493 Asgn := Asgn_Rec.Chain; 494 end; 495 end loop; 496 497 -- Clear mark flag. 498 Asgn := Phi.First; 499 while Asgn /= No_Seq_Assign loop 500 declare 501 Asgn_Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn); 502 P : Partial_Assign; 503 begin 504 if Asgn_Rec.Val.Is_Static = False then 505 P := Asgn_Rec.Val.Asgns; 506 pragma Assert (P /= No_Partial_Assign); 507 while P /= No_Partial_Assign loop 508 declare 509 Pa : Partial_Assign_Record 510 renames Partial_Assign_Table.Table (P); 511 Res_Inst : constant Instance := Get_Net_Parent (Pa.Value); 512 begin 513 Set_Mark_Flag (Res_Inst, False); 514 515 P := Pa.Next; 516 end; 517 end loop; 518 end if; 519 Asgn := Asgn_Rec.Chain; 520 end; 521 end loop; 522 523 Asgn := Phi.First; 524 while Asgn /= No_Seq_Assign loop 525 declare 526 Asgn_Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn); 527 begin 528 Pop_And_Merge_Phi_Wire (Ctxt, Asgn_Rec, Stmt); 529 Asgn := Asgn_Rec.Chain; 530 end; 531 end loop; 532 end Pop_And_Merge_Phi; 533 534 procedure Propagate_Phi_Until_Mark (Ctxt : Builders.Context_Acc; 535 Phi : Phi_Type; 536 Mark : Wire_Id) 537 is 538 Asgn, Next_Asgn : Seq_Assign; 539 begin 540 Asgn := Phi.First; 541 while Asgn /= No_Seq_Assign loop 542 declare 543 Asgn_Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn); 544 Wid : constant Wire_Id := Asgn_Rec.Id; 545 Pasgn, Next_Pasgn : Partial_Assign; 546 begin 547 -- FIXME: Asgn_Rec may become invalid due to allocation by 548 -- Phi_Assign. So we read what is needed before calling 549 -- Phi_Assign. 550 Next_Asgn := Asgn_Rec.Chain; 551 if Wid <= Mark then 552 case Asgn_Rec.Val.Is_Static is 553 when Unknown => 554 raise Internal_Error; 555 when True => 556 Phi_Assign_Static (Wid, Asgn_Rec.Val.Val); 557 when False => 558 Pasgn := Asgn_Rec.Val.Asgns; 559 while Pasgn /= No_Partial_Assign loop 560 Next_Pasgn := Get_Partial_Next (Pasgn); 561 Set_Partial_Next (Pasgn, No_Partial_Assign); 562 Phi_Assign (Ctxt, Wid, Pasgn); 563 Pasgn := Next_Pasgn; 564 end loop; 565 end case; 566 end if; 567 Asgn := Next_Asgn; 568 end; 569 end loop; 570 end Propagate_Phi_Until_Mark; 571 572 -- Merge sort of conc_assign by offset. 573 function Le_Conc_Assign (Left, Right : Conc_Assign) return Boolean is 574 begin 575 if Get_Conc_Offset (Left) < Get_Conc_Offset (Right) then 576 return True; 577 end if; 578 if Get_Conc_Offset (Left) = Get_Conc_Offset (Right) then 579 return (Get_Width (Get_Conc_Value (Left)) 580 < Get_Width (Get_Conc_Value (Right))); 581 else 582 return False; 583 end if; 584 end Le_Conc_Assign; 585 586 procedure Sort_Conc_Assign (Chain : Conc_Assign; 587 Len : Natural; 588 First : out Conc_Assign; 589 Next : out Conc_Assign) 590 is 591 Left, Right : Conc_Assign; 592 Last : Conc_Assign; 593 El : Conc_Assign; 594 begin 595 if Len = 0 then 596 First := No_Conc_Assign; 597 Next := Chain; 598 elsif Len = 1 then 599 First := Chain; 600 Next := Get_Conc_Chain (Chain); 601 Set_Conc_Chain (Chain, No_Conc_Assign); 602 else 603 -- Divide. 604 Sort_Conc_Assign (Chain, Len / 2, Left, Right); 605 Sort_Conc_Assign (Right, Len - Len / 2, Right, Next); 606 607 First := No_Conc_Assign; 608 Last := No_Conc_Assign; 609 for I in 1 .. Len loop 610 pragma Assert (not (Left = No_Conc_Assign 611 and Right = No_Conc_Assign)); 612 if Right = No_Conc_Assign 613 or else 614 (Left /= No_Conc_Assign and then Le_Conc_Assign (Left, Right)) 615 then 616 El := Left; 617 Left := Get_Conc_Chain (Left); 618 else 619 pragma Assert (Right /= No_Conc_Assign); 620 El := Right; 621 Right := Get_Conc_Chain (Right); 622 end if; 623 -- Append 624 if First = No_Conc_Assign then 625 First := El; 626 else 627 Set_Conc_Chain (Last, El); 628 end if; 629 Last := El; 630 end loop; 631 Set_Conc_Chain (Last, No_Conc_Assign); 632 end if; 633 end Sort_Conc_Assign; 634 635 -- Return True iff PREV and NEXT are two concurrent assignments for 636 -- a multiport memory. 637 function Is_Finalize_Assignment_Multiport (Prev, Next : Conc_Assign) 638 return Boolean 639 is 640 use Netlists.Gates; 641 P_Val : Net; 642 N_Val : Net; 643 begin 644 -- The assignemnts must fully overlap (same offset and same width). 645 if Get_Conc_Offset (Prev) /= Get_Conc_Offset (Next) then 646 return False; 647 end if; 648 P_Val := Get_Conc_Value (Prev); 649 N_Val := Get_Conc_Value (Next); 650 if Get_Width (P_Val) /= Get_Width (N_Val) then 651 return False; 652 end if; 653 654 -- Both assignments must be a dff. 655 case Get_Id (Get_Net_Parent (P_Val)) is 656 when Id_Dyn_Insert_En => 657 null; 658 when others => 659 return False; 660 end case; 661 case Get_Id (Get_Net_Parent (N_Val)) is 662 when Id_Dyn_Insert_En => 663 null; 664 when others => 665 return False; 666 end case; 667 668 return True; 669 end Is_Finalize_Assignment_Multiport; 670 671 function Is_Tribuf_Net (N : Net) return Boolean 672 is 673 use Netlists.Gates; 674 begin 675 case Get_Id (Get_Net_Parent (N)) is 676 when Id_Tri 677 | Id_Resolver 678 | Id_Port => 679 return True; 680 when others => 681 return False; 682 end case; 683 end Is_Tribuf_Net; 684 685 function Is_Tribuf_Assignment (Prev, Next : Conc_Assign) return Boolean 686 is 687 P_Val : Net; 688 N_Val : Net; 689 begin 690 -- The assignemnts must fully overlap (same offset and same width). 691 if Get_Conc_Offset (Prev) /= Get_Conc_Offset (Next) then 692 return False; 693 end if; 694 P_Val := Get_Conc_Value (Prev); 695 N_Val := Get_Conc_Value (Next); 696 if Get_Width (P_Val) /= Get_Width (N_Val) then 697 return False; 698 end if; 699 700 -- Both assignments must be a tri or a resolver. 701 return Is_Tribuf_Net (P_Val) 702 and then Is_Tribuf_Net (N_Val); 703 end Is_Tribuf_Assignment; 704 705 function Info_Subrange_Vhdl (Off : Width; Wd : Width; Bnd: Bound_Type) 706 return String 707 is 708 function Image (V : Int32) return String 709 is 710 Res : constant String := Int32'Image (V); 711 begin 712 if V >= 0 then 713 return Res (2 .. Res'Last); 714 else 715 return Res; 716 end if; 717 end Image; 718 begin 719 case Bnd.Dir is 720 when Dir_To => 721 if Wd = 1 then 722 return Image (Bnd.Right - Int32 (Off)); 723 else 724 return Image (Bnd.Left + Int32 (Bnd.Len - (Off + Wd))) 725 & " to " 726 & Image (Bnd.Right - Int32 (Off)); 727 end if; 728 when Dir_Downto => 729 if Wd = 1 then 730 return Image (Bnd.Right + Int32 (Off)); 731 else 732 return Image (Bnd.Left - Int32 (Bnd.Len - (Off + Wd))) 733 & " downto " 734 & Image (Bnd.Right + Int32 (Off)); 735 end if; 736 end case; 737 end Info_Subrange_Vhdl; 738 739 procedure Info_Subnet_Vhdl (Loc : Location_Type; 740 Prefix : String; 741 Otype : Vhdl.Nodes.Node; 742 Typ : Type_Acc; 743 Off : Width; 744 Wd : Width) is 745 begin 746 case Typ.Kind is 747 when Type_Bit 748 | Type_Logic 749 | Type_Discrete 750 | Type_Float => 751 pragma Assert (Wd = Typ.W); 752 pragma Assert (Off = 0); 753 Info_Msg_Synth (+Loc, " " & Prefix); 754 when Type_File 755 | Type_Protected 756 | Type_Access 757 | Type_Unbounded_Array 758 | Type_Unbounded_Record 759 | Type_Unbounded_Vector => 760 raise Internal_Error; 761 when Type_Vector => 762 pragma Assert (Wd <= Typ.W); 763 if Off = 0 and Wd = Typ.W then 764 Info_Msg_Synth (+Loc, " " & Prefix); 765 else 766 Info_Msg_Synth 767 (+Loc, 768 " " & Prefix 769 & "(" & Info_Subrange_Vhdl (Off, Wd, Typ.Vbound) & ")"); 770 end if; 771 when Type_Slice 772 | Type_Array => 773 Info_Msg_Synth (+Loc, " " & Prefix & "(??)"); 774 when Type_Record => 775 declare 776 use Vhdl.Nodes; 777 Els : constant Iir_Flist := 778 Get_Elements_Declaration_List (Otype); 779 begin 780 for I in Typ.Rec.E'Range loop 781 declare 782 El : Rec_El_Type renames Typ.Rec.E (I); 783 Field : constant Vhdl.Nodes.Node := 784 Get_Nth_Element (Els, Natural (I - 1)); 785 Sub_Off : Uns32; 786 Sub_Wd : Width; 787 begin 788 if Off + Wd <= El.Boff then 789 -- Not covered anymore. 790 exit; 791 elsif Off >= El.Boff + El.Typ.W then 792 -- Not yet covered. 793 null; 794 elsif Off <= El.Boff 795 and then Off + Wd >= El.Boff + El.Typ.W 796 then 797 -- Fully covered. 798 Info_Msg_Synth 799 (+Loc, 800 " " & Prefix & '.' 801 & Vhdl.Utils.Image_Identifier (Field)); 802 else 803 -- Partially covered. 804 if Off < El.Boff then 805 Sub_Off := 0; 806 Sub_Wd := Wd - (El.Boff - Off); 807 Sub_Wd := Width'Min (Sub_Wd, El.Typ.W); 808 else 809 Sub_Off := Off - El.Boff; 810 Sub_Wd := El.Typ.W - (Off - El.Boff); 811 Sub_Wd := Width'Min (Sub_Wd, Wd); 812 end if; 813 Info_Subnet_Vhdl 814 (+Loc, 815 Prefix & '.' & Vhdl.Utils.Image_Identifier (Field), 816 Get_Type (Field), El.Typ, Sub_Off, Sub_Wd); 817 end if; 818 end; 819 end loop; 820 end; 821 end case; 822 end Info_Subnet_Vhdl; 823 824 procedure Info_Subnet 825 (Decl : Vhdl.Nodes.Node; Typ : Type_Acc; Off : Width; Wd : Width) 826 is 827 Loc : Location_Type; 828 begin 829 if Typ = null then 830 -- Type is unknown, cannot display more infos. 831 return; 832 end if; 833 834 if Off = 0 and Wd = Typ.W then 835 -- Whole object, no need to give details. 836 -- TODO: just say it ? 837 return; 838 end if; 839 840 Loc := Vhdl.Nodes.Get_Location (Decl); 841 Info_Msg_Synth (+Loc, " this concerns these parts of the signal:"); 842 Info_Subnet_Vhdl (Loc, 843 Name_Table.Image (Vhdl.Nodes.Get_Identifier (Decl)), 844 Vhdl.Nodes.Get_Type (Decl), 845 Typ, Off, Wd); 846 end Info_Subnet; 847 848 -- Compute the VALUE to be assigned to WIRE_REC. Handle partial 849 -- assignment, multiple assignments and error cases. 850 procedure Finalize_Complex_Assignment (Ctxt : Builders.Context_Acc; 851 Wire_Rec : Wire_Id_Record; 852 Value : out Net) 853 is 854 Wire_Width : constant Width := Get_Width (Wire_Rec.Gate); 855 First_Assign : Conc_Assign; 856 Asgn : Conc_Assign; 857 Last_Asgn : Conc_Assign; 858 New_Asgn : Conc_Assign; 859 Next_Off : Uns32; 860 Expected_Off : Uns32; 861 Nbr_Assign : Natural; 862 begin 863 Nbr_Assign := Wire_Rec.Nbr_Final_Assign; 864 -- Sort assignments by offset. 865 Asgn := Wire_Rec.Final_Assign; 866 Sort_Conc_Assign (Asgn, Nbr_Assign, Asgn, Last_Asgn); 867 First_Assign := Asgn; 868 869 -- Report overlaps and holes, count number of inputs 870 Last_Asgn := No_Conc_Assign; 871 Expected_Off := 0; 872 while (Expected_Off < Wire_Width) or Asgn /= No_Conc_Assign loop 873 -- NEXT_OFF is the offset of the next assignment. 874 -- EXPECTED_OFF is the offset just after the previous assignment. 875 if Asgn /= No_Conc_Assign then 876 Next_Off := Get_Conc_Offset (Asgn); 877 else 878 -- If there is no more assignment, simulate a hole until the end. 879 Next_Off := Wire_Width; 880 end if; 881 882 if Next_Off = Expected_Off then 883 -- Normal case. 884 pragma Assert (Asgn /= No_Conc_Assign); 885 Expected_Off := Expected_Off + Get_Width (Get_Conc_Value (Asgn)); 886 Last_Asgn := Asgn; 887 Asgn := Get_Conc_Chain (Asgn); 888 elsif Next_Off > Expected_Off then 889 -- There is an hole. 890 if Next_Off = Expected_Off + 1 then 891 Warning_Msg_Synth 892 (+Wire_Rec.Decl, "no assignment for offset %v of %n", 893 (1 => +Expected_Off, 2 => +Wire_Rec.Decl)); 894 else 895 Warning_Msg_Synth 896 (+Wire_Rec.Decl, "no assignment for offsets %v:%v of %n", 897 (+Expected_Off, +(Next_Off - 1), +Wire_Rec.Decl)); 898 end if; 899 900 -- Insert conc_assign with initial value. 901 -- FIXME: handle initial values. 902 Conc_Assign_Table.Append 903 ((Next => Asgn, 904 Value => Build_Const_Z (Ctxt, Next_Off - Expected_Off), 905 Offset => Expected_Off, 906 Stmt => Source.No_Syn_Src)); 907 New_Asgn := Conc_Assign_Table.Last; 908 if Last_Asgn = No_Conc_Assign then 909 First_Assign := New_Asgn; 910 else 911 Set_Conc_Chain (Last_Asgn, New_Asgn); 912 end if; 913 Last_Asgn := New_Asgn; 914 Nbr_Assign := Nbr_Assign + 1; 915 916 Expected_Off := Next_Off; 917 else 918 -- Overlap. 919 pragma Assert (Next_Off < Expected_Off); 920 pragma Assert (Asgn /= No_Conc_Assign); 921 922 if Wire_Rec.Kind = Wire_Variable 923 and then Is_Finalize_Assignment_Multiport (Last_Asgn, Asgn) 924 then 925 -- Insert a multiport (for shared variable). 926 declare 927 Last_Asgn_Rec : Conc_Assign_Record renames 928 Conc_Assign_Table.Table (Last_Asgn); 929 begin 930 Last_Asgn_Rec.Value := Build_Mem_Multiport 931 (Ctxt, Last_Asgn_Rec.Value, Get_Conc_Value (Asgn)); 932 end; 933 -- Remove this assignment. 934 Nbr_Assign := Nbr_Assign - 1; 935 Set_Conc_Chain (Last_Asgn, Get_Conc_Chain (Asgn)); 936 elsif Is_Tribuf_Assignment (Last_Asgn, Asgn) then 937 -- Insert a resolver. 938 declare 939 Last_Asgn_Rec : Conc_Assign_Record renames 940 Conc_Assign_Table.Table (Last_Asgn); 941 V : constant Net := Last_Asgn_Rec.Value; 942 begin 943 Last_Asgn_Rec.Value := Build_Resolver 944 (Ctxt, V, Get_Conc_Value (Asgn)); 945 Copy_Location (Last_Asgn_Rec.Value, V); 946 end; 947 -- Remove this assignment. 948 Nbr_Assign := Nbr_Assign - 1; 949 Set_Conc_Chain (Last_Asgn, Get_Conc_Chain (Asgn)); 950 else 951 declare 952 Asgn_Wd : constant Width := 953 Get_Width (Get_Conc_Value (Asgn)); 954 Overlap_Wd : Width; 955 begin 956 Overlap_Wd := Asgn_Wd; 957 if Next_Off + Overlap_Wd > Expected_Off then 958 Overlap_Wd := Expected_Off - Next_Off; 959 end if; 960 961 Error_Msg_Synth 962 (+Wire_Rec.Decl, 963 "multiple assignments for %i offsets %v:%v", 964 (+Wire_Rec.Decl, 965 +Next_Off, +(Next_Off + Overlap_Wd - 1))); 966 Info_Subnet (Wire_Rec.Decl, Wire_Rec.Typ, 967 Next_Off, Overlap_Wd); 968 969 if Next_Off + Asgn_Wd < Expected_Off then 970 -- Remove this assignment 971 Nbr_Assign := Nbr_Assign - 1; 972 Set_Conc_Chain (Last_Asgn, Get_Conc_Chain (Asgn)); 973 else 974 Expected_Off := Next_Off + Asgn_Wd; 975 Last_Asgn := Asgn; 976 end if; 977 end; 978 end if; 979 Asgn := Get_Conc_Chain (Asgn); 980 end if; 981 end loop; 982 983 -- Create concat 984 -- Set concat inputs 985 if Nbr_Assign = 1 then 986 Value := Get_Conc_Value (First_Assign); 987 elsif Nbr_Assign = 2 then 988 Value := Build_Concat2 (Ctxt, 989 Get_Conc_Value (Last_Asgn), 990 Get_Conc_Value (First_Assign)); 991 else 992 Value := Build_Concatn (Ctxt, Wire_Width, Uns32 (Nbr_Assign)); 993 declare 994 Inst : constant Instance := Get_Net_Parent (Value); 995 begin 996 Asgn := First_Assign; 997 for I in reverse 0 .. Nbr_Assign - 1 loop 998 Connect (Get_Input (Inst, Port_Idx (I)), Get_Conc_Value (Asgn)); 999 Asgn := Get_Conc_Chain (Asgn); 1000 end loop; 1001 end; 1002 end if; 1003 end Finalize_Complex_Assignment; 1004 1005 procedure Finalize_Assignment 1006 (Ctxt : Builders.Context_Acc; Wid : Wire_Id) 1007 is 1008 use Vhdl.Nodes; 1009 Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); 1010 Gate_Inst : constant Instance := Get_Net_Parent (Wire_Rec.Gate); 1011 Inp : constant Input := Get_Input (Gate_Inst, 0); 1012 Value : Net; 1013 begin 1014 case Wire_Rec.Nbr_Final_Assign is 1015 when 0 => 1016 -- TODO: use initial value ? 1017 -- TODO: fix that in synth-decls.finalize_object. 1018 if Wire_Rec.Decl /= Null_Node 1019 and then Wire_Rec.Kind = Wire_Output 1020 then 1021 Warning_Msg_Synth 1022 (+Wire_Rec.Decl, "no assignment for %n", +Wire_Rec.Decl); 1023 if Get_Id (Gate_Inst) = Gates.Id_Iinout then 1024 Value := Get_Input_Net (Gate_Inst, 1); 1025 else 1026 Value := Build_Const_Z (Ctxt, Get_Width (Wire_Rec.Gate)); 1027 end if; 1028 else 1029 return; 1030 end if; 1031 when 1 => 1032 declare 1033 Conc_Asgn : Conc_Assign_Record renames 1034 Conc_Assign_Table.Table (Wire_Rec.Final_Assign); 1035 begin 1036 if Conc_Asgn.Offset = 0 1037 and then (Get_Width (Conc_Asgn.Value) 1038 = Get_Width (Wire_Rec.Gate)) 1039 then 1040 -- Single and full assignment. 1041 Value := Conc_Asgn.Value; 1042 else 1043 -- Partial assignment. 1044 Finalize_Complex_Assignment (Ctxt, Wire_Rec, Value); 1045 end if; 1046 end; 1047 Wire_Rec.Final_Assign := No_Conc_Assign; 1048 when others => 1049 -- Multiple assignments. 1050 Finalize_Complex_Assignment (Ctxt, Wire_Rec, Value); 1051 Wire_Rec.Final_Assign := No_Conc_Assign; 1052 end case; 1053 1054 Connect (Inp, Value); 1055 end Finalize_Assignment; 1056 1057 procedure Finalize_Wires is 1058 begin 1059 pragma Assert (Phis_Table.Last = No_Phi_Id); 1060 -- pragma Assert (Assign_Table.Last = No_Seq_Assign); 1061 1062 for Wid in Wire_Id_Table.First + 1 .. Wire_Id_Table.Last loop 1063 declare 1064 Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); 1065 begin 1066 pragma Assert (Wire_Rec.Kind = Wire_None 1067 or Wire_Rec.Kind = Wire_Enable); 1068 pragma Assert (Wire_Rec.Final_Assign = No_Conc_Assign); 1069 null; 1070 end; 1071 end loop; 1072 1073 Wire_Id_Table.Set_Last (No_Wire_Id); 1074 end Finalize_Wires; 1075 1076 -- Sort the LEN first wires of chain W (linked by Chain) in Id increasing 1077 -- values. The result is assigned to FIRST and the first non-sorted wire 1078 -- (the one after LEN) is assigned to NEXT. The chain headed by FIRST 1079 -- is truncated to LEN elements. 1080 -- Use a merge sort. 1081 procedure Sort_Wires (Asgn : Seq_Assign; 1082 Len : Uns32; 1083 First : out Seq_Assign; 1084 Next : out Seq_Assign) 1085 is 1086 Left, Right : Seq_Assign; 1087 Last : Seq_Assign; 1088 El : Seq_Assign; 1089 begin 1090 if Len = 0 then 1091 -- Empty chain. 1092 First := No_Seq_Assign; 1093 Next := Asgn; 1094 return; 1095 elsif Len = 1 then 1096 -- Chain with one element. 1097 First := Asgn; 1098 Next := Get_Assign_Chain (First); 1099 Set_Assign_Chain (First, No_Seq_Assign); 1100 return; 1101 else 1102 -- Divide. 1103 Sort_Wires (Asgn, Len / 2, Left, Right); 1104 Sort_Wires (Right, Len - Len / 2, Right, Next); 1105 1106 -- Conquer: merge. 1107 First := No_Seq_Assign; 1108 Last := No_Seq_Assign; 1109 for I in 1 .. Len loop 1110 if Left /= No_Seq_Assign 1111 and then (Right = No_Seq_Assign 1112 or else Get_Wire_Id (Left) <= Get_Wire_Id (Right)) 1113 then 1114 El := Left; 1115 Left := Get_Assign_Chain (Left); 1116 else 1117 pragma Assert (Right /= No_Seq_Assign); 1118 El := Right; 1119 Right := Get_Assign_Chain (Right); 1120 end if; 1121 1122 -- Append 1123 if First = No_Seq_Assign then 1124 First := El; 1125 else 1126 Set_Assign_Chain (Last, El); 1127 end if; 1128 Last := El; 1129 end loop; 1130 Set_Assign_Chain (Last, No_Seq_Assign); 1131 end if; 1132 end Sort_Wires; 1133 1134 function Sort_Phi (P : Phi_Type) return Seq_Assign 1135 is 1136 Res, Last : Seq_Assign; 1137 begin 1138 Sort_Wires (P.First, P.Nbr, Res, Last); 1139 pragma Assert (Last = No_Seq_Assign); 1140 return Res; 1141 end Sort_Phi; 1142 1143 function Get_Assign_Value (Ctxt : Builders.Context_Acc; Asgn : Seq_Assign) 1144 return Net 1145 is 1146 Asgn_Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn); 1147 Wid_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Asgn_Rec.Id); 1148 W : constant Width := Get_Width (Wid_Rec.Gate); 1149 begin 1150 case Wid_Rec.Kind is 1151 when Wire_Signal | Wire_Output | Wire_Inout 1152 | Wire_Variable => 1153 null; 1154 when Wire_Input | Wire_Enable | Wire_None => 1155 raise Internal_Error; 1156 end case; 1157 1158 if Asgn_Rec.Val.Is_Static = True then 1159 return Synth.Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val); 1160 end if; 1161 1162 -- Cannot be empty. 1163 pragma Assert (Asgn_Rec.Val.Asgns /= No_Partial_Assign); 1164 1165 -- Simple case: fully assigned. 1166 declare 1167 Pasgn : Partial_Assign_Record renames 1168 Partial_Assign_Table.Table (Asgn_Rec.Val.Asgns); 1169 begin 1170 if Pasgn.Offset = 0 and then Get_Width (Pasgn.Value) = W then 1171 return Pasgn.Value; 1172 end if; 1173 end; 1174 1175 return Get_Current_Assign_Value (Ctxt, Asgn_Rec.Id, 0, W); 1176 end Get_Assign_Value; 1177 1178 function Get_Current_Value (Ctxt : Builders.Context_Acc; Wid : Wire_Id) 1179 return Net 1180 is 1181 Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); 1182 pragma Assert (Wire_Rec.Kind /= Wire_None); 1183 begin 1184 case Wire_Rec.Kind is 1185 when Wire_Variable => 1186 if Wire_Rec.Cur_Assign = No_Seq_Assign then 1187 -- The variable was never assigned, so the variable value is 1188 -- the initial value. 1189 -- FIXME: use initial value directly ? 1190 return Wire_Rec.Gate; 1191 else 1192 return Get_Assign_Value (Ctxt, Wire_Rec.Cur_Assign); 1193 end if; 1194 when Wire_Signal | Wire_Output | Wire_Inout | Wire_Input 1195 | Wire_Enable => 1196 -- For signals, always read the previous value. 1197 return Wire_Rec.Gate; 1198 when Wire_None => 1199 raise Internal_Error; 1200 end case; 1201 end Get_Current_Value; 1202 1203 -- Get the current value of W for WD bits at offset OFF. 1204 function Get_Current_Assign_Value 1205 (Ctxt : Context_Acc; Wid : Wire_Id; Off : Uns32; Wd : Width) 1206 return Net 1207 is 1208 Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); 1209 pragma Assert (Wire_Rec.Kind /= Wire_None); 1210 First_Seq : Seq_Assign; 1211 begin 1212 -- Latest seq assign 1213 First_Seq := Wire_Rec.Cur_Assign; 1214 1215 -- If no seq assign, return current value. 1216 if First_Seq = No_Seq_Assign then 1217 return Build2_Extract_Push (Ctxt, Wire_Rec.Gate, Off, Wd); 1218 end if; 1219 1220 -- If the current value is static, just return it. 1221 if Get_Assign_Is_Static (First_Seq) then 1222 return Context.Get_Partial_Memtyp_Net 1223 (Ctxt, Get_Assign_Static_Val (First_Seq), Off, Wd); 1224 end if; 1225 1226 -- If the range is the same as the seq assign, return the value. 1227 declare 1228 P : constant Partial_Assign := Get_Assign_Partial (First_Seq); 1229 V : Net; 1230 begin 1231 if Get_Partial_Offset (P) = Off then 1232 V := Get_Partial_Value (P); 1233 if Get_Width (V) = Wd then 1234 return V; 1235 end if; 1236 end if; 1237 end; 1238 1239 -- Build a vector 1240 declare 1241 use Netlists.Concats; 1242 Vec : Concat_Type; 1243 Seq : Seq_Assign; 1244 P : Partial_Assign; 1245 Cur_Off : Uns32; 1246 Cur_Wd : Width; 1247 1248 Res : Net; 1249 begin 1250 Cur_Off := Off; 1251 Cur_Wd := Wd; 1252 pragma Assert (Wd > 0); 1253 loop 1254 -- Find value at CUR_OFF from assignment. Start at the top 1255 -- phi (which is not a static value). 1256 Seq := First_Seq; 1257 P := Get_Assign_Partial (Seq); 1258 loop 1259 pragma Assert (P /= No_Partial_Assign); 1260 declare 1261 Pr : Partial_Assign_Record renames 1262 Partial_Assign_Table.Table (P); 1263 Pw : constant Width := Get_Width (Pr.Value); 1264 begin 1265 if Pr.Offset <= Cur_Off 1266 and then Pr.Offset + Pw > Cur_Off 1267 then 1268 -- Found. 1269 if Pr.Offset = Cur_Off and then Pw <= Cur_Wd then 1270 -- No need to extract. 1271 Append (Vec, Pr.Value); 1272 Cur_Wd := Pw; 1273 else 1274 Cur_Wd := Width'Min 1275 (Cur_Wd, Pw - (Cur_Off - Pr.Offset)); 1276 Append 1277 (Vec, 1278 Build2_Extract_Push (Ctxt, Pr.Value, 1279 Cur_Off - Pr.Offset, Cur_Wd)); 1280 end if; 1281 exit; 1282 end if; 1283 if Pr.Offset + Pw <= Cur_Off then 1284 -- Skip this partial, it is before what we are searching. 1285 P := Pr.Next; 1286 elsif Pr.Offset > Cur_Off 1287 and then Pr.Offset < Cur_Off + Cur_Wd 1288 then 1289 -- There is a partial assignment that should be 1290 -- considered, but first we need some values before it. 1291 -- Reduce WD and continue to search in previous; 1292 Cur_Wd := Pr.Offset - Cur_Off; 1293 P := No_Partial_Assign; 1294 else 1295 -- The next partial assignment is beyond what we are 1296 -- searching. 1297 -- Continue to search in previous. 1298 P := No_Partial_Assign; 1299 end if; 1300 if P = No_Partial_Assign then 1301 Seq := Get_Assign_Prev (Seq); 1302 if Seq = No_Seq_Assign then 1303 -- Extract from gate. 1304 Append (Vec, Build2_Extract_Push (Ctxt, Wire_Rec.Gate, 1305 Cur_Off, Cur_Wd)); 1306 exit; 1307 end if; 1308 if Get_Assign_Is_Static (Seq) then 1309 -- Extract from static value. 1310 Append (Vec, Context.Get_Partial_Memtyp_Net 1311 (Ctxt, Get_Assign_Static_Val (Seq), 1312 Cur_Off, Cur_Wd)); 1313 exit; 1314 end if; 1315 P := Get_Assign_Partial (Seq); 1316 end if; 1317 end; 1318 end loop; 1319 1320 Cur_Off := Cur_Off + Cur_Wd; 1321 Cur_Wd := Wd - (Cur_Off - Off); 1322 exit when Cur_Off = Off + Wd; 1323 end loop; 1324 1325 -- Concat 1326 Build (Ctxt, Vec, Res); 1327 return Res; 1328 end; 1329 end Get_Current_Assign_Value; 1330 1331 -- P is an array of Partial_Assign. Each element is a list 1332 -- of partial assign from a different basic block. 1333 -- Extract the value to nets N of the maximal partial assignment starting 1334 -- at offset OFF for all partial assignments. Fully handled partial 1335 -- assignments are poped. Set the offset and width to OFF and WD of the 1336 -- result. 1337 procedure Extract_Merge_Partial_Assigns (Ctxt : Builders.Context_Acc; 1338 P : in out Seq_Assign_Value_Array; 1339 N : out Net_Array; 1340 Off : in out Uns32; 1341 Wd : out Width) 1342 is 1343 Min_Off : Uns32; 1344 begin 1345 Min_Off := Off; 1346 1347 -- Look for the partial assign with the least offset (but still 1348 -- greather than Min_Off). Also extract the least width. 1349 Off := Uns32'Last; 1350 Wd := Width'Last; 1351 for I in P'Range loop 1352 case P (I).Is_Static is 1353 when Unknown => 1354 -- No assignment. 1355 null; 1356 when True => 1357 declare 1358 P_Wd : constant Width := P (I).Val.Typ.W; 1359 begin 1360 if Min_Off >= P_Wd then 1361 -- No net can be beyond the width. 1362 pragma Assert (Off = Uns32'Last); 1363 pragma Assert (Wd = Width'Last); 1364 return; 1365 end if; 1366 1367 if Off > Min_Off and then Off < P_Wd then 1368 -- There is already an assignment for an offset after 1369 -- the minimum. Stick to the min! 1370 Wd := Off - Min_Off; 1371 Off := Min_Off; 1372 else 1373 -- Either no assignment, or an assignment at Min_Off. 1374 Off := Min_Off; 1375 Wd := Width'Min (Wd, P_Wd - Min_Off); 1376 end if; 1377 end; 1378 when False => 1379 declare 1380 pragma Assert (P (I).Asgns /= No_Partial_Assign); 1381 Pa : Partial_Assign_Record 1382 renames Partial_Assign_Table.Table (P (I).Asgns); 1383 N_Wd : Width; 1384 N_Off : Uns32; 1385 begin 1386 if Pa.Offset < Off and then Min_Off < Off then 1387 -- There is an assignment for an offset before the 1388 -- current one. Handle it. 1389 pragma Assert (Off >= Min_Off); 1390 N_Off := Uns32'Max (Pa.Offset, Min_Off); 1391 N_Wd := Get_Width (Pa.Value) - (N_Off - Pa.Offset); 1392 Wd := Width'Min (N_Wd, Off - N_Off); 1393 Off := N_Off; 1394 elsif Pa.Offset = Off 1395 or else (Off = Min_Off and then Pa.Offset < Off) 1396 then 1397 -- Reduce the width if the assignment is shorter. 1398 Wd := Width'Min 1399 (Wd, Get_Width (Pa.Value) - (Off - Pa.Offset)); 1400 elsif Pa.Offset < Off + Wd then 1401 -- Reduce the width when there is an assignment after 1402 -- the current offset. 1403 Wd := Pa.Offset - Off; 1404 end if; 1405 end; 1406 end case; 1407 end loop; 1408 1409 -- No more assignments. 1410 if Off = Uns32'Last and Wd = Width'Last then 1411 return; 1412 end if; 1413 1414 -- Get the values for that offset/width. Update lists. 1415 for I in P'Range loop 1416 -- Default: no partial assignment. Get extract previous value. 1417 N (I) := No_Net; 1418 1419 case P (I).Is_Static is 1420 when Unknown => 1421 null; 1422 when True => 1423 N (I) := Context.Get_Partial_Memtyp_Net 1424 (Ctxt, P (I).Val, Off, Wd); 1425 when False => 1426 if Get_Partial_Offset (P (I).Asgns) <= Off then 1427 declare 1428 Asgn : constant Partial_Assign := P (I).Asgns; 1429 Val : constant Net := Get_Partial_Value (Asgn); 1430 P_W : constant Width := Get_Width (Val); 1431 P_Off : constant Uns32 := Get_Partial_Offset (Asgn); 1432 begin 1433 -- There is a partial assignment. 1434 if P_Off = Off and then P_W = Wd then 1435 -- Full covered. 1436 N (I) := Val; 1437 P (I).Asgns := Get_Partial_Next (Asgn); 1438 else 1439 N (I) := Build_Extract (Ctxt, Val, Off - P_Off, Wd); 1440 if P_Off + P_W = Off + Wd then 1441 P (I).Asgns := Get_Partial_Next (Asgn); 1442 end if; 1443 end if; 1444 end; 1445 if P (I).Asgns = No_Partial_Assign then 1446 P (I) := No_Seq_Assign_Value; 1447 end if; 1448 end if; 1449 end case; 1450 end loop; 1451 end Extract_Merge_Partial_Assigns; 1452 1453 function Is_Assign_Value_Array_Static 1454 (Wid : Wire_Id; Arr : Seq_Assign_Value_Array) return Memtyp 1455 is 1456 Res : Memtyp; 1457 Prev_Val : Memtyp; 1458 begin 1459 Prev_Val := Null_Memtyp; 1460 for I in Arr'Range loop 1461 case Arr (I).Is_Static is 1462 when False => 1463 -- A value is not static. 1464 return Null_Memtyp; 1465 when Unknown => 1466 if Prev_Val = Null_Memtyp then 1467 -- First use of previous value. 1468 if not Is_Static_Wire (Wid) then 1469 -- The previous value is not static. 1470 return Null_Memtyp; 1471 end if; 1472 Prev_Val := Get_Static_Wire (Wid); 1473 if Res /= Null_Memtyp then 1474 -- There is already a result. 1475 if not Is_Equal (Res, Prev_Val) then 1476 -- The previous value is different from the result. 1477 return Null_Memtyp; 1478 end if; 1479 else 1480 Res := Prev_Val; 1481 end if; 1482 end if; 1483 when True => 1484 if Res = Null_Memtyp then 1485 -- First value. Keep it. 1486 Res := Arr (I).Val; 1487 else 1488 if not Is_Equal (Res, Arr (I).Val) then 1489 -- Value is different. 1490 return Null_Memtyp; 1491 end if; 1492 end if; 1493 end case; 1494 end loop; 1495 return Res; 1496 end Is_Assign_Value_Array_Static; 1497 1498 procedure Partial_Assign_Init (List : out Partial_Assign_List) is 1499 begin 1500 List := (First | Last => No_Partial_Assign); 1501 end Partial_Assign_Init; 1502 1503 procedure Partial_Assign_Append (List : in out Partial_Assign_List; 1504 Pasgn : Partial_Assign) is 1505 begin 1506 if List.First = No_Partial_Assign then 1507 List.First := Pasgn; 1508 else 1509 Set_Partial_Next (List.Last, Pasgn); 1510 end if; 1511 List.Last := Pasgn; 1512 end Partial_Assign_Append; 1513 1514 procedure Merge_Partial_Assigns (Ctxt : Builders.Context_Acc; 1515 Wid : Wire_Id; 1516 List : in out Partial_Assign_List) 1517 is 1518 Pasgn : Partial_Assign; 1519 begin 1520 while List.First /= No_Partial_Assign loop 1521 Pasgn := Get_Partial_Next (List.First); 1522 Set_Partial_Next (List.First, No_Partial_Assign); 1523 Phi_Assign (Ctxt, Wid, List.First); 1524 List.First := Pasgn; 1525 end loop; 1526 end Merge_Partial_Assigns; 1527 1528 procedure Merge_Assigns (Ctxt : Builders.Context_Acc; 1529 Wid : Wire_Id; 1530 Sel : Net; 1531 F_Asgns : Seq_Assign_Value; 1532 T_Asgns : Seq_Assign_Value; 1533 Stmt : Source.Syn_Src) 1534 is 1535 use Netlists.Gates; 1536 use Netlists.Gates_Ports; 1537 P : Seq_Assign_Value_Array (0 .. 1); 1538 N : Net_Array (0 .. 1); 1539 Min_Off : Uns32; 1540 Off : Uns32; 1541 Wd : Width; 1542 Res : Net; 1543 List : Partial_Assign_List; 1544 Pasgn : Partial_Assign; 1545 N1_Inst : Instance; 1546 begin 1547 P := (0 => F_Asgns, 1 => T_Asgns); 1548 Partial_Assign_Init (List); 1549 1550 Min_Off := 0; 1551 loop 1552 Off := Min_Off; 1553 Extract_Merge_Partial_Assigns (Ctxt, P, N, Off, Wd); 1554 1555 -- No more assignments. 1556 exit when Off = Uns32'Last and Wd = Width'Last; 1557 1558 for I in N'Range loop 1559 if N (I) = No_Net then 1560 -- No partial assignment. Get extract previous value. 1561 N (I) := Get_Current_Assign_Value (Ctxt, Wid, Off, Wd); 1562 end if; 1563 end loop; 1564 1565 -- Possible optimizations: 1566 -- if C1 then _ _ _ 1567 -- if C2 then R0-|0\ R0-|0\ R0 -|0\ 1568 -- R := V; ==> | |--+ | |- R ==> | |- R 1569 -- end if; V-|_/ +----|_/ V-|_/ 1570 -- end if; C1 C2 C1.C2 1571 -- 1572 -- This really helps inference as the net R0 doesn't have to be 1573 -- walked twice (in absence of memoization). 1574 1575 -- Build mux. 1576 N1_Inst := Get_Net_Parent (N (1)); 1577 if Get_Id (N1_Inst) = Id_Mux2 1578 and then Same_Net (Get_Driver (Get_Mux2_I0 (N1_Inst)), N (0)) 1579 then 1580 declare 1581 N1_Net : Net; 1582 N1_Sel : Input; 1583 N1_Sel_Net : Net; 1584 begin 1585 N1_Net := Get_Output (N1_Inst, 0); 1586 N1_Sel := Get_Input (N1_Inst, 0); 1587 N1_Sel_Net := Get_Driver (N1_Sel); 1588 if not Is_Connected (N1_Net) then 1589 -- If the previous mux2 is not used, just modify it. 1590 Res := N1_Net; 1591 Disconnect (N1_Sel); 1592 N1_Sel_Net := Build_Dyadic (Ctxt, Id_And, Sel, N1_Sel_Net); 1593 Set_Location (N1_Sel_Net, Stmt); 1594 Connect (N1_Sel, N1_Sel_Net); 1595 else 1596 Res := Build_Dyadic (Ctxt, Id_And, Sel, N1_Sel_Net); 1597 Set_Location (Res, Stmt); 1598 Res := Build_Mux2 1599 (Ctxt, Res, N (0), Get_Driver (Get_Mux2_I1 (N1_Inst))); 1600 end if; 1601 end; 1602 elsif N (0) = N (1) then 1603 -- Minor optimization: no need to add a mux if both sides are 1604 -- equal. But this is important for the control wires. 1605 Res := N (0); 1606 else 1607 Res := Build_Mux2 (Ctxt, Sel, N (0), N (1)); 1608 end if; 1609 Set_Location (Res, Stmt); 1610 1611 -- Keep the result in a list. 1612 Pasgn := New_Partial_Assign (Res, Off); 1613 Partial_Assign_Append (List, Pasgn); 1614 1615 Min_Off := Off + Wd; 1616 end loop; 1617 1618 -- Do the assignments from the result list. 1619 -- It cannot be done before because the assignments will overwrite the 1620 -- last assignments which are read to create a partial assignment. 1621 Merge_Partial_Assigns (Ctxt, Wid, List); 1622 end Merge_Assigns; 1623 1624 function Merge_Static_Assigns (Wid : Wire_Id; Tv, Fv : Seq_Assign_Value) 1625 return Boolean 1626 is 1627 Prev : Memtyp; 1628 begin 1629 -- First case: both TV and FV are static. 1630 if Tv.Is_Static = True and then Fv.Is_Static = True then 1631 if Is_Equal (Tv.Val, Fv.Val) then 1632 Phi_Assign_Static (Wid, Tv.Val); 1633 return True; 1634 else 1635 return False; 1636 end if; 1637 end if; 1638 1639 -- If either TV or FV are nets, they cannot be merged. 1640 if Tv.Is_Static = False or else Fv.Is_Static = False then 1641 return False; 1642 end if; 1643 1644 -- Get the previous value. 1645 declare 1646 Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); 1647 pragma Assert (Wire_Rec.Kind /= Wire_None); 1648 First_Seq : Seq_Assign; 1649 begin 1650 -- Latest seq assign 1651 First_Seq := Wire_Rec.Cur_Assign; 1652 1653 -- If no seq assign, fails. 1654 if First_Seq = No_Seq_Assign then 1655 return False; 1656 end if; 1657 1658 if not Get_Assign_Is_Static (First_Seq) then 1659 return False; 1660 end if; 1661 Prev := Get_Assign_Static_Val (First_Seq); 1662 end; 1663 1664 if Tv.Is_Static = True then 1665 pragma Assert (Fv = No_Seq_Assign_Value); 1666 return Is_Equal (Tv.Val, Prev); 1667 else 1668 pragma Assert (Fv.Is_Static = True); 1669 pragma Assert (Tv = No_Seq_Assign_Value); 1670 return Is_Equal (Fv.Val, Prev); 1671 end if; 1672 end Merge_Static_Assigns; 1673 1674 -- Add muxes for two lists T and F of assignments. 1675 procedure Merge_Phis (Ctxt : Builders.Context_Acc; 1676 Sel : Net; 1677 T, F : Phi_Type; 1678 Stmt : Source.Syn_Src) 1679 is 1680 T_Asgns : Seq_Assign; 1681 F_Asgns : Seq_Assign; 1682 W : Wire_Id; 1683 Tv, Fv : Seq_Assign_Value; 1684 begin 1685 T_Asgns := Sort_Phi (T); 1686 F_Asgns := Sort_Phi (F); 1687 1688 while T_Asgns /= No_Seq_Assign or F_Asgns /= No_Seq_Assign loop 1689 -- Extract a wire. 1690 if T_Asgns = No_Seq_Assign 1691 or else (F_Asgns /= No_Seq_Assign 1692 and then Get_Wire_Id (F_Asgns) < Get_Wire_Id (T_Asgns)) 1693 then 1694 -- Has an assignment only for the false branch. 1695 W := Get_Wire_Id (F_Asgns); 1696 Fv := Get_Seq_Assign_Value (F_Asgns); 1697 Tv := No_Seq_Assign_Value; 1698 F_Asgns := Get_Assign_Chain (F_Asgns); 1699 elsif F_Asgns = No_Seq_Assign 1700 or else (T_Asgns /= No_Seq_Assign 1701 and then Get_Wire_Id (T_Asgns) < Get_Wire_Id (F_Asgns)) 1702 then 1703 -- Has an assignment only for the true branch. 1704 W := Get_Wire_Id (T_Asgns); 1705 Fv := No_Seq_Assign_Value; 1706 Tv := Get_Seq_Assign_Value (T_Asgns); 1707 T_Asgns := Get_Assign_Chain (T_Asgns); 1708 else 1709 -- Has assignments for both the true and the false branch. 1710 pragma Assert (Get_Wire_Id (F_Asgns) = Get_Wire_Id (T_Asgns)); 1711 W := Get_Wire_Id (F_Asgns); 1712 Fv := Get_Seq_Assign_Value (F_Asgns); 1713 Tv := Get_Seq_Assign_Value (T_Asgns); 1714 T_Asgns := Get_Assign_Chain (T_Asgns); 1715 F_Asgns := Get_Assign_Chain (F_Asgns); 1716 end if; 1717 -- Merge partial assigns as much as possible. This reduce 1718 -- propagation of splits. 1719 Merge_Partial_Assignments (Ctxt, Fv); 1720 Merge_Partial_Assignments (Ctxt, Tv); 1721 if not Merge_Static_Assigns (W, Tv, Fv) then 1722 Merge_Assigns (Ctxt, W, Sel, Fv, Tv, Stmt); 1723 end if; 1724 1725 end loop; 1726 end Merge_Phis; 1727 1728 procedure Phi_Append_Assign (P : in out Phi_Type; Asgn : Seq_Assign) is 1729 begin 1730 -- Chain assignment in the current sequence. 1731 if P.First = No_Seq_Assign then 1732 P.First := Asgn; 1733 else 1734 Set_Assign_Chain (P.Last, Asgn); 1735 end if; 1736 P.Last := Asgn; 1737 P.Nbr := P.Nbr + 1; 1738 end Phi_Append_Assign; 1739 1740 procedure Phi_Append_Assign (Asgn : Seq_Assign) 1741 is 1742 pragma Assert (Asgn /= No_Seq_Assign); 1743 Asgn_Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn); 1744 pragma Assert (Asgn_Rec.Phi = Current_Phi); 1745 pragma Assert (Asgn_Rec.Chain = No_Seq_Assign); 1746 begin 1747 Phi_Append_Assign (Phis_Table.Table (Phis_Table.Last), Asgn); 1748 end Phi_Append_Assign; 1749 1750 function Phi_Enable (Ctxt : Builders.Context_Acc; Loc : Source.Syn_Src) 1751 return Net 1752 is 1753 Last : constant Phi_Id := Phis_Table.Last; 1754 Wid : Wire_Id; 1755 N : Net; 1756 Asgn : Seq_Assign; 1757 begin 1758 if Last = No_Phi_Id then 1759 -- Can be called only when a phi is created. 1760 raise Internal_Error; 1761 end if; 1762 if Last = No_Phi_Id + 1 then 1763 -- That's the first phi, which is always enabled. 1764 return No_Net; 1765 end if; 1766 1767 -- Cached value. 1768 Wid := Phis_Table.Table (Last).En; 1769 if Wid = No_Wire_Id then 1770 Wid := Alloc_Wire (Wire_Enable, Bit_Type, Loc); 1771 Phis_Table.Table (Last).En := Wid; 1772 1773 -- Create the Enable gate. 1774 N := Build_Enable (Ctxt); 1775 Set_Location (N, Loc); 1776 Set_Wire_Gate (Wid, N); 1777 1778 -- Initialize to '0'. 1779 -- This is really cheating, as it is like assigning in the first 1780 -- phi. 1781 Assign_Table.Append ((Phi => No_Phi_Id + 1, 1782 Id => Wid, 1783 Prev => No_Seq_Assign, 1784 Chain => No_Seq_Assign, 1785 Val => (Is_Static => True, Val => Bit0))); 1786 Asgn := Assign_Table.Last; 1787 Wire_Id_Table.Table (Wid).Cur_Assign := Asgn; 1788 Phi_Append_Assign (Phis_Table.Table (No_Phi_Id + 1), Asgn); 1789 1790 -- Assign to '1'. 1791 Phi_Assign_Static (Wid, Bit1); 1792 return N; 1793 else 1794 return Get_Current_Value (Ctxt, Wid); 1795 end if; 1796 end Phi_Enable; 1797 1798 -- Check consistency: 1799 -- - ordered. 1800 -- - no overlaps. 1801 procedure Check (Seq : Seq_Assign) 1802 is 1803 Seq_Asgn : Seq_Assign_Record renames Assign_Table.Table (Seq); 1804 Prev_El : Partial_Assign; 1805 begin 1806 Prev_El := Seq_Asgn.Val.Asgns; 1807 if Prev_El = No_Partial_Assign then 1808 -- It's empty! 1809 return; 1810 end if; 1811 loop 1812 declare 1813 Prev : Partial_Assign_Record 1814 renames Partial_Assign_Table.Table (Prev_El); 1815 El : constant Partial_Assign := Prev.Next; 1816 begin 1817 if El = No_Partial_Assign then 1818 -- Done. 1819 exit; 1820 end if; 1821 declare 1822 Cur : Partial_Assign_Record 1823 renames Partial_Assign_Table.Table (El); 1824 begin 1825 -- Check no overlap. 1826 if Cur.Offset < Prev.Offset + Get_Width (Prev.Value) then 1827 raise Internal_Error; 1828 end if; 1829 end; 1830 Prev_El := El; 1831 end; 1832 end loop; 1833 end Check; 1834 1835 -- Insert partial assignment ASGN to list SEQ. 1836 -- Deal with overrides. Place it correctly. 1837 procedure Insert_Partial_Assign 1838 (Ctxt : Builders.Context_Acc; Seq : Seq_Assign; Asgn : Partial_Assign) 1839 is 1840 V : Partial_Assign_Record renames Partial_Assign_Table.Table (Asgn); 1841 V_Next : constant Uns32 := V.Offset + Get_Width (V.Value); 1842 Seq_Asgn : Seq_Assign_Record renames Assign_Table.Table (Seq); 1843 El, Last_El : Partial_Assign; 1844 Inserted : Boolean; 1845 begin 1846 Inserted := False; 1847 Last_El := No_Partial_Assign; 1848 El := Seq_Asgn.Val.Asgns; 1849 while El /= No_Partial_Assign loop 1850 declare 1851 P : Partial_Assign_Record renames Partial_Assign_Table.Table (El); 1852 P_Next : constant Uns32 := P.Offset + Get_Width (P.Value); 1853 begin 1854 if V.Offset < P_Next and then V_Next > P.Offset then 1855 -- Override. 1856 if V.Offset <= P.Offset and then V_Next >= P_Next then 1857 -- Full override: 1858 -- V.Off V.Next 1859 -- |------------------|| 1860 -- |----------|| 1861 -- P.Off P.Next 1862 -- Remove it. 1863 -- FIXME: free it. 1864 if not Inserted then 1865 if Last_El /= No_Partial_Assign then 1866 Partial_Assign_Table.Table (Last_El).Next := Asgn; 1867 else 1868 Seq_Asgn.Val.Asgns := Asgn; 1869 end if; 1870 V.Next := P.Next; 1871 Inserted := True; 1872 Last_El := Asgn; 1873 else 1874 pragma Assert (Last_El /= No_Partial_Assign); 1875 Partial_Assign_Table.Table (Last_El).Next := P.Next; 1876 end if; 1877 elsif V.Offset <= P.Offset and then V_Next < P_Next then 1878 -- Overrides the beginning of EL. 1879 -- V.Off V.Next 1880 -- |--------------|| 1881 -- |----------|| 1882 -- P.Off P.Next 1883 -- Shrink EL. 1884 P.Value := Build2_Extract_Push (Ctxt, P.Value, 1885 Off => V_Next - P.Offset, 1886 W => P_Next - V_Next); 1887 P.Offset := V_Next; 1888 if not Inserted then 1889 if Last_El /= No_Partial_Assign then 1890 Partial_Assign_Table.Table (Last_El).Next := Asgn; 1891 else 1892 Seq_Asgn.Val.Asgns := Asgn; 1893 end if; 1894 V.Next := El; 1895 Inserted := True; 1896 end if; 1897 -- No more possible overlaps. 1898 exit; 1899 elsif V.Offset > P.Offset and then P_Next <= V_Next then 1900 -- Overrides the end of EL. 1901 -- V.Off V.Next 1902 -- |------------------|| 1903 -- |----------|| 1904 -- P.Off P.Next 1905 -- Shrink EL. 1906 P.Value := Build2_Extract_Push (Ctxt, P.Value, 1907 Off => 0, 1908 W => V.Offset - P.Offset); 1909 pragma Assert (not Inserted); 1910 V.Next := P.Next; 1911 P.Next := Asgn; 1912 Last_El := Asgn; 1913 Inserted := True; 1914 elsif V.Offset > P.Offset and then V_Next < P_Next then 1915 -- Contained within EL. 1916 -- V.Off V.Next 1917 -- |----------|| 1918 -- |---------------|| 1919 -- P.Off P.Next 1920 -- Split EL. 1921 pragma Assert (not Inserted); 1922 Partial_Assign_Table.Append 1923 ((Next => P.Next, 1924 Value => Build2_Extract_Push (Ctxt, P.Value, 1925 Off => V_Next - P.Offset, 1926 W => P_Next - V_Next), 1927 Offset => V_Next)); 1928 V.Next := Partial_Assign_Table.Last; 1929 P.Value := Build2_Extract_Push (Ctxt, P.Value, 1930 Off => 0, 1931 W => V.Offset - P.Offset); 1932 P.Next := Asgn; 1933 Inserted := True; 1934 -- No more possible overlaps. 1935 exit; 1936 else 1937 -- No other case. 1938 raise Internal_Error; 1939 end if; 1940 else 1941 if V.Offset < P.Offset then 1942 -- Insert before P (if not already inserted). 1943 if not Inserted then 1944 if Last_El /= No_Partial_Assign then 1945 Partial_Assign_Table.Table (Last_El).Next := Asgn; 1946 else 1947 Seq_Asgn.Val.Asgns := Asgn; 1948 end if; 1949 V.Next := El; 1950 Inserted := True; 1951 end if; 1952 exit; 1953 elsif P.Next = No_Partial_Assign then 1954 if not Inserted then 1955 -- Insert after P. 1956 P.Next := Asgn; 1957 Inserted := True; 1958 end if; 1959 exit; 1960 else 1961 Last_El := El; 1962 end if; 1963 end if; 1964 1965 El := P.Next; 1966 end; 1967 end loop; 1968 pragma Assert (Inserted); 1969 pragma Debug (Check (Seq)); 1970 end Insert_Partial_Assign; 1971 1972 procedure Phi_Assign 1973 (Ctxt : Builders.Context_Acc; Dest : Wire_Id; Pasgn : Partial_Assign) 1974 is 1975 Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Dest); 1976 pragma Assert (Wire_Rec.Kind /= Wire_None); 1977 Cur_Asgn : constant Seq_Assign := Wire_Rec.Cur_Assign; 1978 begin 1979 if Cur_Asgn = No_Seq_Assign 1980 or else Assign_Table.Table (Cur_Asgn).Phi < Current_Phi 1981 then 1982 -- Never assigned, or first assignment in that level 1983 Assign_Table.Append ((Phi => Current_Phi, 1984 Id => Dest, 1985 Prev => Cur_Asgn, 1986 Chain => No_Seq_Assign, 1987 Val => (Is_Static => False, Asgns => Pasgn))); 1988 Wire_Rec.Cur_Assign := Assign_Table.Last; 1989 Phi_Append_Assign (Assign_Table.Last); 1990 else 1991 -- Overwrite. 1992 if Get_Assign_Is_Static (Cur_Asgn) then 1993 -- Force seq_assign to be a net. 1994 declare 1995 Asgn_Rec : Seq_Assign_Record renames 1996 Assign_Table.Table (Cur_Asgn); 1997 N : Net; 1998 Pa : Partial_Assign; 1999 begin 2000 N := Synth.Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val); 2001 Pa := New_Partial_Assign (N, 0); 2002 Asgn_Rec.Val := (Is_Static => False, Asgns => Pa); 2003 end; 2004 end if; 2005 2006 Insert_Partial_Assign (Ctxt, Cur_Asgn, Pasgn); 2007 end if; 2008 end Phi_Assign; 2009 2010 procedure Phi_Assign_Net 2011 (Ctxt : Builders.Context_Acc; Dest : Wire_Id; Val : Net; Offset : Uns32) 2012 is 2013 Pasgn : Partial_Assign; 2014 begin 2015 Pasgn := New_Partial_Assign (Val, Offset); 2016 2017 Phi_Assign (Ctxt, Dest, Pasgn); 2018 end Phi_Assign_Net; 2019 2020 procedure Phi_Assign_Static (Dest : Wire_Id; Val : Memtyp) 2021 is 2022 Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Dest); 2023 pragma Assert (Wire_Rec.Kind /= Wire_None); 2024 Cur_Asgn : constant Seq_Assign := Wire_Rec.Cur_Assign; 2025 begin 2026 if Cur_Asgn = No_Seq_Assign 2027 or else Assign_Table.Table (Cur_Asgn).Phi < Current_Phi 2028 then 2029 -- Never assigned, or first assignment in that level 2030 Assign_Table.Append ((Phi => Current_Phi, 2031 Id => Dest, 2032 Prev => Cur_Asgn, 2033 Chain => No_Seq_Assign, 2034 Val => (Is_Static => True, Val => Val))); 2035 Wire_Rec.Cur_Assign := Assign_Table.Last; 2036 Phi_Append_Assign (Assign_Table.Last); 2037 else 2038 Assign_Table.Table (Cur_Asgn).Val := (Is_Static => True, Val => Val); 2039 end if; 2040 end Phi_Assign_Static; 2041 2042 -- Return the net driving WID when it is known to be possibly constant. 2043 -- Return No_Net is not constant. 2044 function Is_Static_Wire (Wid : Wire_Id) return Boolean 2045 is 2046 Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); 2047 begin 2048 if Wire_Rec.Kind /= Wire_Variable then 2049 return False; 2050 end if; 2051 if Wire_Rec.Cur_Assign = No_Seq_Assign then 2052 return False; 2053 end if; 2054 return Get_Assign_Is_Static (Wire_Rec.Cur_Assign); 2055 end Is_Static_Wire; 2056 2057 function Get_Static_Wire (Wid : Wire_Id) return Memtyp 2058 is 2059 Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); 2060 begin 2061 return Get_Assign_Static_Val (Wire_Rec.Cur_Assign); 2062 end Get_Static_Wire; 2063begin 2064 Wire_Id_Table.Append ((Kind => Wire_None, 2065 Mark_Flag => False, 2066 Decl => Source.No_Syn_Src, 2067 Typ => null, 2068 Gate => No_Net, 2069 Cur_Assign => No_Seq_Assign, 2070 Final_Assign => No_Conc_Assign, 2071 Nbr_Final_Assign => 0)); 2072 pragma Assert (Wire_Id_Table.Last = No_Wire_Id); 2073 2074 Assign_Table.Append ((Phi => No_Phi_Id, 2075 Id => No_Wire_Id, 2076 Prev => No_Seq_Assign, 2077 Chain => No_Seq_Assign, 2078 Val => (Is_Static => False, 2079 Asgns => No_Partial_Assign))); 2080 pragma Assert (Assign_Table.Last = No_Seq_Assign); 2081 2082 Partial_Assign_Table.Append ((Next => No_Partial_Assign, 2083 Value => No_Net, 2084 Offset => 0)); 2085 pragma Assert (Partial_Assign_Table.Last = No_Partial_Assign); 2086 2087 Phis_Table.Append ((First => No_Seq_Assign, 2088 Last => No_Seq_Assign, 2089 Nbr => 0, 2090 En => No_Wire_Id)); 2091 pragma Assert (Phis_Table.Last = No_Phi_Id); 2092 2093 Conc_Assign_Table.Append ((Next => No_Conc_Assign, 2094 Value => No_Net, 2095 Offset => 0, 2096 Stmt => Source.No_Syn_Src)); 2097 pragma Assert (Conc_Assign_Table.Last = No_Conc_Assign); 2098end Synth.Environment; 2099