diff options
author | Tristan Gingold <tgingold@free.fr> | 2020-05-14 19:09:37 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2020-05-14 19:09:37 +0200 |
commit | e2a12a0150098fb8bd322096181bc83b18383fdb (patch) | |
tree | 2d14d78012793ed0ccb76ad21aee33a8878b3bd6 | |
parent | bb8259a3956b2ef082761196b68c2aba6dda1a0c (diff) | |
download | ghdl-e2a12a0150098fb8bd322096181bc83b18383fdb.tar.gz ghdl-e2a12a0150098fb8bd322096181bc83b18383fdb.tar.bz2 ghdl-e2a12a0150098fb8bd322096181bc83b18383fdb.zip |
synth-aggr: create constrained record type if needed.
-rw-r--r-- | src/synth/synth-aggr.adb | 34 | ||||
-rw-r--r-- | src/synth/synth-objtypes.ads | 2 |
2 files changed, 28 insertions, 8 deletions
diff --git a/src/synth/synth-aggr.adb b/src/synth/synth-aggr.adb index 0437bb3fb..cee38bea2 100644 --- a/src/synth/synth-aggr.adb +++ b/src/synth/synth-aggr.adb @@ -438,6 +438,7 @@ package body Synth.Aggr is is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); Tab_Res : Valtyp_Array_Acc; + Res_Typ : Type_Acc; Res : Valtyp; Err_P : Boolean; Const_P : Boolean; @@ -451,15 +452,32 @@ package body Synth.Aggr is if Err_P then Res := No_Valtyp; - elsif Const_P then - Res := Create_Value_Memory (Aggr_Type); - for I in Aggr_Type.Rec.E'Range loop - Write_Value (Res.Val.Mem + Aggr_Type.Rec.E (I).Moff, - Tab_Res (Tab_Res'Last - Nat32 (I) + 1)); - end loop; else - Res := Create_Value_Net - (Valtyp_Array_To_Net (Ctxt, Tab_Res.all), Aggr_Type); + case Type_Records (Aggr_Type.Kind) is + when Type_Unbounded_Record => + declare + Els_Typ : Rec_El_Array_Acc; + begin + Els_Typ := Create_Rec_El_Array (Aggr_Type.Rec.Len); + for I in Els_Typ.E'Range loop + Els_Typ.E (I).Typ := Tab_Res (Nat32 (I)).Typ; + end loop; + Res_Typ := Create_Record_Type (Els_Typ); + end; + when Type_Record => + Res_Typ := Aggr_Type; + end case; + + if Const_P then + Res := Create_Value_Memory (Res_Typ); + for I in Aggr_Type.Rec.E'Range loop + Write_Value (Res.Val.Mem + Aggr_Type.Rec.E (I).Moff, + Tab_Res (Tab_Res'Last - Nat32 (I) + 1)); + end loop; + else + Res := Create_Value_Net + (Valtyp_Array_To_Net (Ctxt, Tab_Res.all), Res_Typ); + end if; end if; Free_Valtyp_Array (Tab_Res); diff --git a/src/synth/synth-objtypes.ads b/src/synth/synth-objtypes.ads index 8824eea18..c0c2a1409 100644 --- a/src/synth/synth-objtypes.ads +++ b/src/synth/synth-objtypes.ads @@ -87,6 +87,8 @@ package Synth.Objtypes is subtype Type_Nets is Type_Kind range Type_Bit .. Type_Logic; subtype Type_All_Discrete is Type_Kind range Type_Bit .. Type_Discrete; + subtype Type_Records is + Type_Kind range Type_Unbounded_Record .. Type_Record; type Type_Type (Kind : Type_Kind); type Type_Acc is access Type_Type; |