aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2020-05-14 19:09:37 +0200
committerTristan Gingold <tgingold@free.fr>2020-05-14 19:09:37 +0200
commite2a12a0150098fb8bd322096181bc83b18383fdb (patch)
tree2d14d78012793ed0ccb76ad21aee33a8878b3bd6
parentbb8259a3956b2ef082761196b68c2aba6dda1a0c (diff)
downloadghdl-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.adb34
-rw-r--r--src/synth/synth-objtypes.ads2
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;