diff options
author | Tristan Gingold <tgingold@free.fr> | 2017-06-02 06:35:02 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2017-06-02 06:35:02 +0200 |
commit | f81495cf31274567abca01cb68d3e064039162f6 (patch) | |
tree | f44fa894754356221446ba99c8e6ea05c1863a29 | |
parent | c5b18686521d520cb919bd3bac12bc1be9bb5ac3 (diff) | |
download | ghdl-f81495cf31274567abca01cb68d3e064039162f6.tar.gz ghdl-f81495cf31274567abca01cb68d3e064039162f6.tar.bz2 ghdl-f81495cf31274567abca01cb68d3e064039162f6.zip |
ghwlib/grt-waves: handle unbounded records.
-rw-r--r-- | src/grt/ghwlib.c | 267 | ||||
-rw-r--r-- | src/grt/ghwlib.h | 12 | ||||
-rw-r--r-- | src/grt/grt-disp_rti.adb | 3 | ||||
-rw-r--r-- | src/grt/grt-rtis.ads | 40 | ||||
-rw-r--r-- | src/grt/grt-waves.adb | 145 |
5 files changed, 337 insertions, 130 deletions
diff --git a/src/grt/ghwlib.c b/src/grt/ghwlib.c index 7c5b80bd0..ddfab6b57 100644 --- a/src/grt/ghwlib.c +++ b/src/grt/ghwlib.c @@ -391,7 +391,8 @@ ghw_get_base_type (union ghw_type *t) } } -int +/* Return -1 for unbounded types. */ +static int get_nbr_elements (union ghw_type *t) { switch (t->kind) @@ -406,20 +407,21 @@ get_nbr_elements (union ghw_type *t) case ghdl_rtik_type_p64: case ghdl_rtik_subtype_scalar: return 1; + case ghdl_rtik_type_array: + return -1; case ghdl_rtik_subtype_array: - case ghdl_rtik_subtype_array_ptr: - return t->sa.nbr_el; + return t->sa.nbr_scalars; case ghdl_rtik_type_record: - return t->rec.nbr_el; + return t->rec.nbr_scalars; case ghdl_rtik_subtype_record: - return t->sr.base->nbr_el; + return t->sr.nbr_scalars; default: fprintf (stderr, "get_nbr_elements: unhandled type %d\n", t->kind); abort (); } } -int +static int get_range_length (union ghw_range *rng) { switch (rng->kind) @@ -445,6 +447,91 @@ get_range_length (union ghw_range *rng) } } +/* Create an array subtype using BASE and ranges read from H. */ + +struct ghw_subtype_array * +ghw_read_array_subtype (struct ghw_handler *h, struct ghw_type_array *base) +{ + struct ghw_subtype_array *sa; + int j; + int nbr_scalars; + + sa = malloc (sizeof (struct ghw_subtype_array)); + sa->kind = ghdl_rtik_subtype_array; + sa->name = NULL; + sa->base = base; + nbr_scalars = get_nbr_elements (base->el); + sa->rngs = malloc (base->nbr_dim * sizeof (union ghw_range *)); + for (j = 0; j < base->nbr_dim; j++) + { + sa->rngs[j] = ghw_read_range (h); + nbr_scalars *= get_range_length (sa->rngs[j]); + } + sa->nbr_scalars = nbr_scalars; + return sa; +} + +struct ghw_subtype_record * +ghw_read_record_subtype (struct ghw_handler *h, struct ghw_type_record *base) +{ + struct ghw_subtype_record *sr; + + sr = malloc (sizeof (struct ghw_subtype_record)); + sr->kind = ghdl_rtik_subtype_record; + sr->name = NULL; + sr->base = base; + if (base->nbr_scalars >= 0) + { + /* Record base type is bounded. */ + sr->nbr_scalars = base->nbr_scalars; + sr->els = base->els; + } + else + { + /* Read subtypes. */ + int j; + int nbr_scalars; + + sr->els = malloc (base->nbr_fields * sizeof (struct ghw_record_element)); + nbr_scalars = 0; + for (j = 0; j < base->nbr_fields; j++) + { + union ghw_type *btype = base->els[j].type; + int el_nbr_scalars = get_nbr_elements (btype); + + sr->els[j].name = base->els[j].name; + if (el_nbr_scalars >= 0) + { + /* Element is constrained. */ + sr->els[j].type = btype; + } + else + { + switch (btype->kind) + { + case ghdl_rtik_type_array: + sr->els[j].type = (union ghw_type *) + ghw_read_array_subtype (h, &btype->ar); + break; + case ghdl_rtik_type_record: + sr->els[j].type = (union ghw_type *) + ghw_read_record_subtype (h, &btype->rec); + break; + default: + fprintf + (stderr, "ghw_read_record_subtype: unhandled kind %d\n", + btype->kind); + return NULL; + } + el_nbr_scalars = get_nbr_elements (sr->els[j].type); + } + nbr_scalars += el_nbr_scalars; + } + sr->nbr_scalars = nbr_scalars; + } + return sr; +} + int ghw_read_type (struct ghw_handler *h) { @@ -574,66 +661,71 @@ ghw_read_type (struct ghw_handler *h) } break; case ghdl_rtik_subtype_array: - case ghdl_rtik_subtype_array_ptr: { struct ghw_subtype_array *sa; - int j; - int nbr_el; + const char *name; + struct ghw_type_array *base; - sa = malloc (sizeof (struct ghw_subtype_array)); - sa->kind = t; - sa->name = ghw_read_strid (h); - sa->base = (struct ghw_type_array *)ghw_read_typeid (h); - nbr_el = get_nbr_elements (sa->base->el); - sa->rngs = malloc (sa->base->nbr_dim * sizeof (union ghw_range *)); - for (j = 0; j < sa->base->nbr_dim; j++) - { - sa->rngs[j] = ghw_read_range (h); - nbr_el *= get_range_length (sa->rngs[j]); - } - sa->nbr_el = nbr_el; - if (h->flag_verbose > 1) - printf ("subtype array: %s (nbr_el=%d)\n", sa->name, sa->nbr_el); + name = ghw_read_strid (h); + base = (struct ghw_type_array *)ghw_read_typeid (h); + + sa = ghw_read_array_subtype (h, base); + sa->name = name; h->types[i] = (union ghw_type *)sa; + if (h->flag_verbose > 1) + printf ("subtype array: %s (nbr_scalars=%d)\n", + sa->name, sa->nbr_scalars); } break; case ghdl_rtik_type_record: { struct ghw_type_record *rec; int j; - int nbr_el; + int nbr_scalars; rec = malloc (sizeof (struct ghw_type_record)); rec->kind = t; rec->name = ghw_read_strid (h); if (ghw_read_uleb128 (h, &rec->nbr_fields) != 0) return -1; - rec->el = malloc + rec->els = malloc (rec->nbr_fields * sizeof (struct ghw_record_element)); - nbr_el = 0; + nbr_scalars = 0; for (j = 0; j < rec->nbr_fields; j++) { - rec->el[j].name = ghw_read_strid (h); - rec->el[j].type = ghw_read_typeid (h); - nbr_el += get_nbr_elements (rec->el[j].type); + rec->els[j].name = ghw_read_strid (h); + rec->els[j].type = ghw_read_typeid (h); + if (nbr_scalars != -1) + { + int field_nbr_scalars = get_nbr_elements (rec->els[j].type); + if (field_nbr_scalars == -1) + nbr_scalars = -1; + else + nbr_scalars += field_nbr_scalars; + } } - rec->nbr_el = nbr_el; + rec->nbr_scalars = nbr_scalars; if (h->flag_verbose > 1) - printf ("record type: %s (nbr_el=%d)\n", rec->name, rec->nbr_el); + printf ("record type: %s (nbr_scalars=%d)\n", + rec->name, rec->nbr_scalars); h->types[i] = (union ghw_type *)rec; } break; case ghdl_rtik_subtype_record: { struct ghw_subtype_record *sr; + const char *name; + struct ghw_type_record *base; - sr = malloc (sizeof (struct ghw_subtype_record)); - sr->kind = t; - sr->name = ghw_read_strid (h); - sr->base = (struct ghw_type_record *)ghw_read_typeid (h); - if (h->flag_verbose > 1) - printf ("subtype record: %s\n", sr->name); + name = ghw_read_strid (h); + base = (struct ghw_type_record *)ghw_read_typeid (h); + + sr = ghw_read_record_subtype (h, base); + sr->name = name; h->types[i] = (union ghw_type *)sr; + if (h->flag_verbose > 1) + printf ("subtype record: %s (nbr_scalars=%d)\n", + sr->name, sr->nbr_scalars); } break; default: @@ -710,13 +802,12 @@ ghw_read_signal (struct ghw_handler *h, unsigned int *sigs, union ghw_type *t) } return 0; case ghdl_rtik_subtype_array: - case ghdl_rtik_subtype_array_ptr: { int i; int stride; int len; - len = t->sa.nbr_el; + len = t->sa.nbr_scalars; stride = get_nbr_elements (t->sa.base->el); for (i = 0; i < len; i += stride) @@ -726,20 +817,36 @@ ghw_read_signal (struct ghw_handler *h, unsigned int *sigs, union ghw_type *t) return 0; case ghdl_rtik_type_record: { + struct ghw_type_record *r = &t->rec; + int nbr_fields = r->nbr_fields; int i; int off; off = 0; - for (i = 0; i < t->rec.nbr_fields; i++) + for (i = 0; i < nbr_fields; i++) { - if (ghw_read_signal (h, &sigs[off], t->rec.el[i].type) < 0) + if (ghw_read_signal (h, &sigs[off], r->els[i].type) < 0) return -1; - off += get_nbr_elements (t->rec.el[i].type); + off += get_nbr_elements (r->els[i].type); } } return 0; case ghdl_rtik_subtype_record: - return ghw_read_signal (h, sigs, (union ghw_type *)t->sr.base); + { + struct ghw_subtype_record *sr = &t->sr; + int nbr_fields = sr->base->nbr_fields; + int i; + int off; + + off = 0; + for (i = 0; i < nbr_fields; i++) + { + if (ghw_read_signal (h, &sigs[off], sr->els[i].type) < 0) + return -1; + off += get_nbr_elements (sr->els[i].type); + } + } + return 0; default: fprintf (stderr, "ghw_read_signal: type kind %d unhandled\n", t->kind); abort (); @@ -1765,6 +1872,57 @@ ghw_disp_range (union ghw_type *type, union ghw_range *rng) } static void +ghw_disp_array_subtype_bounds (struct ghw_subtype_array *a) +{ + int i; + + printf (" ("); + for (i = 0; i < a->base->nbr_dim; i++) + { + if (i != 0) + printf (", "); + ghw_disp_range (a->base->dims[i], a->rngs[i]); + } + printf (")"); +} + +static void +ghw_disp_record_subtype_bounds (struct ghw_subtype_record *sr) +{ + struct ghw_type_record *base = sr->base; + int is_first = 1; + int i; + + for (i = 0; i < base->nbr_fields; i++) + { + if (sr->els[i].type != base->els[i].type) + { + if (is_first) + { + printf ("("); + is_first = 0; + } + else + printf (", "); + printf ("%s", base->els[i].name); + switch (sr->els[i].type->kind) + { + case ghdl_rtik_subtype_array: + ghw_disp_array_subtype_bounds (&sr->els[i].type->sa); + break; + case ghdl_rtik_subtype_record: + ghw_disp_record_subtype_bounds (&sr->els[i].type->sr); + break; + default: + printf ("??? (%d)", sr->els[i].type->kind); + } + } + } + if (!is_first) + printf (")"); +} + +static void ghw_disp_subtype_definition (struct ghw_handler *h, union ghw_type *t) { switch (t->kind) @@ -1778,24 +1936,20 @@ ghw_disp_subtype_definition (struct ghw_handler *h, union ghw_type *t) } break; case ghdl_rtik_subtype_array: - case ghdl_rtik_subtype_array_ptr: { struct ghw_subtype_array *a = &t->sa; - int i; ghw_disp_typename (h, (union ghw_type *)a->base); - printf (" ("); - for (i = 0; i < a->base->nbr_dim; i++) - { - if (i != 0) - printf (", "); - ghw_disp_range (a->base->dims[i], a->rngs[i]); - } - printf (")"); + ghw_disp_array_subtype_bounds (a); } break; case ghdl_rtik_subtype_record: - ghw_disp_typename (h, (union ghw_type *)t->sr.base); + { + struct ghw_subtype_record *sr = &t->sr; + + ghw_disp_typename (h, (union ghw_type *)sr->base); + ghw_disp_record_subtype_bounds (sr); + } break; default: printf ("ghw_disp_subtype_definition: unhandled type kind %d\n", @@ -1893,15 +2047,14 @@ ghw_disp_type (struct ghw_handler *h, union ghw_type *t) printf ("type %s is record\n", r->name); for (i = 0; i < r->nbr_fields; i++) { - printf (" %s: ", r->el[i].name); - ghw_disp_subtype_indication (h, r->el[i].type); + printf (" %s: ", r->els[i].name); + ghw_disp_subtype_indication (h, r->els[i].type); printf (";\n"); } printf ("end record;\n"); } break; case ghdl_rtik_subtype_array: - case ghdl_rtik_subtype_array_ptr: case ghdl_rtik_subtype_scalar: case ghdl_rtik_subtype_record: { diff --git a/src/grt/ghwlib.h b/src/grt/ghwlib.h index 6f65d6ba8..5ee05953a 100644 --- a/src/grt/ghwlib.h +++ b/src/grt/ghwlib.h @@ -65,8 +65,8 @@ enum ghdl_rtik { ghdl_rtik_type_file, ghdl_rtik_subtype_scalar, ghdl_rtik_subtype_array, /* 35 */ - ghdl_rtik_subtype_array_ptr, - ghdl_rtik_subtype_unconstrained_array, + ghdl_rtik_subtype_array_ptr, /* Obsolete. */ + ghdl_rtik_subtype_unconstrained_array, /* Obsolete. */ ghdl_rtik_subtype_record, ghdl_rtik_subtype_access, ghdl_rtik_type_protected, @@ -191,7 +191,7 @@ struct ghw_subtype_array const char *name; struct ghw_type_array *base; - int nbr_el; + int nbr_scalars; union ghw_range **rngs; }; @@ -216,8 +216,8 @@ struct ghw_type_record const char *name; unsigned int nbr_fields; - int nbr_el; /* Number of scalar signals. */ - struct ghw_record_element *el; + int nbr_scalars; /* Number of scalar elements (ie nbr of signals). */ + struct ghw_record_element *els; }; struct ghw_subtype_record @@ -226,6 +226,8 @@ struct ghw_subtype_record const char *name; struct ghw_type_record *base; + int nbr_scalars; /* Number of scalar elements (ie nbr of signals). */ + struct ghw_record_element *els; }; union ghw_type diff --git a/src/grt/grt-disp_rti.adb b/src/grt/grt-disp_rti.adb index 898300c26..9ce17ed91 100644 --- a/src/grt/grt-disp_rti.adb +++ b/src/grt/grt-disp_rti.adb @@ -1260,7 +1260,8 @@ package body Grt.Disp_Rti is | Ghdl_Rtik_Type_Unbounded_Record => Disp_Type_Record (To_Ghdl_Rtin_Type_Record_Acc (Rti), Ctxt, Indent); - when Ghdl_Rtik_Subtype_Record => + when Ghdl_Rtik_Subtype_Record + | Ghdl_Rtik_Subtype_Unbounded_Record => Disp_Subtype_Record_Decl (To_Ghdl_Rtin_Subtype_Composite_Acc (Rti), Ctxt, Indent); when Ghdl_Rtik_Type_Protected => diff --git a/src/grt/grt-rtis.ads b/src/grt/grt-rtis.ads index 685df3eae..afe9676c6 100644 --- a/src/grt/grt-rtis.ads +++ b/src/grt/grt-rtis.ads @@ -45,7 +45,7 @@ package Grt.Rtis is Ghdl_Rtik_If_Generate, Ghdl_Rtik_Case_Generate, - Ghdl_Rtik_For_Generate, -- 10 + Ghdl_Rtik_For_Generate, -- 10 Ghdl_Rtik_Generate_Body, Ghdl_Rtik_Instance, Ghdl_Rtik_Constant, @@ -57,33 +57,33 @@ package Grt.Rtis is Ghdl_Rtik_Port, Ghdl_Rtik_Generic, - Ghdl_Rtik_Alias, -- 20 + Ghdl_Rtik_Alias, -- 20 Ghdl_Rtik_Guard, Ghdl_Rtik_Component, Ghdl_Rtik_Attribute, - Ghdl_Rtik_Type_B1, -- Enum + Ghdl_Rtik_Type_B1, -- Rtin_Type_Enum - Ghdl_Rtik_Type_E8, + Ghdl_Rtik_Type_E8, -- Rtin_Type_Enum Ghdl_Rtik_Type_E32, - Ghdl_Rtik_Type_I32, -- Scalar - Ghdl_Rtik_Type_I64, - Ghdl_Rtik_Type_F64, - - Ghdl_Rtik_Type_P32, -- 30 - Ghdl_Rtik_Type_P64, - Ghdl_Rtik_Type_Access, - Ghdl_Rtik_Type_Array, - Ghdl_Rtik_Type_Record, - - Ghdl_Rtik_Type_Unbounded_Record, - Ghdl_Rtik_Type_File, - Ghdl_Rtik_Subtype_Scalar, - Ghdl_Rtik_Subtype_Array, + Ghdl_Rtik_Type_I32, -- Rtin_Type_Scalar + Ghdl_Rtik_Type_I64, -- Rtin_Type_Scalar + Ghdl_Rtik_Type_F64, -- Rtin_Type_Scalar + + Ghdl_Rtik_Type_P32, -- 30 -- Rtin_Type_Physical + Ghdl_Rtik_Type_P64, -- Rtin_Type_Physical + Ghdl_Rtik_Type_Access, -- Rtin_Type_Fileacc + Ghdl_Rtik_Type_Array, -- Rtin_Type_Array + Ghdl_Rtik_Type_Record, -- Rtin_Type_Record + + Ghdl_Rtik_Type_Unbounded_Record, -- Rtin_Type_Record + Ghdl_Rtik_Type_File, -- Rtin_Type_Fileacc + Ghdl_Rtik_Subtype_Scalar, -- Rtin_Subtype_Scalar + Ghdl_Rtik_Subtype_Array, -- Rtin_Subtype_Composite Ghdl_Rtik_Subtype_Unconstrained_Array, - Ghdl_Rtik_Subtype_Record, -- 40 + Ghdl_Rtik_Subtype_Record, -- 40 -- Rtin_Subtype_Composite Ghdl_Rtik_Subtype_Unbounded_Record, - Ghdl_Rtik_Subtype_Access, + Ghdl_Rtik_Subtype_Access, -- Rtin_Type_Fileacc Ghdl_Rtik_Type_Protected, Ghdl_Rtik_Element, diff --git a/src/grt/grt-waves.adb b/src/grt/grt-waves.adb index 025f2195e..2fbfccf2a 100644 --- a/src/grt/grt-waves.adb +++ b/src/grt/grt-waves.adb @@ -613,9 +613,9 @@ package body Grt.Waves is when Ghdl_Rtik_Type_B1 | Ghdl_Rtik_Type_E8 => declare - Enum : Ghdl_Rtin_Type_Enum_Acc; + Enum : constant Ghdl_Rtin_Type_Enum_Acc := + To_Ghdl_Rtin_Type_Enum_Acc (Rti); begin - Enum := To_Ghdl_Rtin_Type_Enum_Acc (Rti); Create_String_Id (Enum.Name); for I in 1 .. Enum.Nbr loop Create_String_Id (Enum.Names (I - 1)); @@ -658,18 +658,18 @@ package body Grt.Waves is | Ghdl_Rtik_Type_I64 | Ghdl_Rtik_Type_F64 => declare - Base : Ghdl_Rtin_Type_Scalar_Acc; + Base : constant Ghdl_Rtin_Type_Scalar_Acc := + To_Ghdl_Rtin_Type_Scalar_Acc (Rti); begin - Base := To_Ghdl_Rtin_Type_Scalar_Acc (Rti); Create_String_Id (Base.Name); end; when Ghdl_Rtik_Type_P32 | Ghdl_Rtik_Type_P64 => declare - Base : Ghdl_Rtin_Type_Physical_Acc; + Base : constant Ghdl_Rtin_Type_Physical_Acc := + To_Ghdl_Rtin_Type_Physical_Acc (Rti); Unit_Name : Ghdl_C_String; begin - Base := To_Ghdl_Rtin_Type_Physical_Acc (Rti); Create_String_Id (Base.Name); for I in 1 .. Base.Nbr loop Unit_Name := @@ -677,12 +677,13 @@ package body Grt.Waves is Create_String_Id (Unit_Name); end loop; end; - when Ghdl_Rtik_Type_Record => + when Ghdl_Rtik_Type_Record + | Ghdl_Rtik_Type_Unbounded_Record => declare - Rec : Ghdl_Rtin_Type_Record_Acc; + Rec : constant Ghdl_Rtin_Type_Record_Acc := + To_Ghdl_Rtin_Type_Record_Acc (Rti); El : Ghdl_Rtin_Element_Acc; begin - Rec := To_Ghdl_Rtin_Type_Record_Acc (Rti); Create_String_Id (Rec.Name); for I in 1 .. Rec.Nbrel loop El := To_Ghdl_Rtin_Element_Acc (Rec.Elements (I - 1)); @@ -723,12 +724,16 @@ package body Grt.Waves is Rti := Avhpi_Get_Rti (Obj_Type); Create_Type (Rti, Avhpi_Get_Context (Obj_Type)); - -- The the signal type is an unconstrained array, also put the object - -- in the type AVL. + -- The the signal type is an unbounded type, also put the object + -- in the type AVL. This is for unbounded ports. -- The real type will be written to the file. - if Rti.Kind = Ghdl_Rtik_Type_Array then - Add_Type (Avhpi_Get_Rti (Obj), Avhpi_Get_Context (Obj)); - end if; + case Rti.Kind is + when Ghdl_Rtik_Type_Array + | Ghdl_Rtik_Type_Unbounded_Record => + Add_Type (Avhpi_Get_Rti (Obj), Avhpi_Get_Context (Obj)); + when others => + null; + end case; end Create_Object_Type; procedure Write_Object_Type (Obj : VhpiHandleT) @@ -744,11 +749,13 @@ package body Grt.Waves is return; end if; Rti := Avhpi_Get_Rti (Obj_Type); - if Rti.Kind = Ghdl_Rtik_Type_Array then - Write_Type_Id (Avhpi_Get_Rti (Obj), Avhpi_Get_Context (Obj)); - else - Write_Type_Id (Rti, Avhpi_Get_Context (Obj_Type)); - end if; + case Rti.Kind is + when Ghdl_Rtik_Type_Array + | Ghdl_Rtik_Type_Unbounded_Record => + Write_Type_Id (Avhpi_Get_Rti (Obj), Avhpi_Get_Context (Obj)); + when others => + Write_Type_Id (Rti, Avhpi_Get_Context (Obj_Type)); + end case; end Write_Object_Type; procedure Create_Generate_Type (Gen : VhpiHandleT) @@ -1206,7 +1213,8 @@ package body Grt.Waves is return Ghw_Rtik_Subtype_Array; when Ghdl_Rtik_Type_Array => return Ghw_Rtik_Type_Array; - when Ghdl_Rtik_Type_Record => + when Ghdl_Rtik_Type_Record + | Ghdl_Rtik_Type_Unbounded_Record => return Ghw_Rtik_Type_Record; when Ghdl_Rtik_Subtype_Record => return Ghw_Rtik_Subtype_Record; @@ -1267,17 +1275,52 @@ package body Grt.Waves is end case; end Write_Range; + procedure Write_Array_Bounds (Arr : Ghdl_Rtin_Type_Array_Acc; + Bounds : in out Address) + is + Rng : Ghdl_Range_Ptr; + Index_Type : Ghdl_Rti_Access; + begin + for I in 0 .. Arr.Nbr_Dim - 1 loop + Index_Type := Get_Base_Type (Arr.Indexes (I)); + Extract_Range (Bounds, Index_Type, Rng); + Write_Range (Index_Type, Rng); + end loop; + end Write_Array_Bounds; + + procedure Write_Record_Bounds (Rec : Ghdl_Rtin_Type_Record_Acc; + Bounds : in out Address) + is + El : Ghdl_Rtin_Element_Acc; + begin + for I in 1 .. Rec.Nbrel loop + El := To_Ghdl_Rtin_Element_Acc (Rec.Elements (I - 1)); + case El.Eltype.Kind is + when Ghdl_Rtik_Type_Array => + Write_Array_Bounds + (To_Ghdl_Rtin_Type_Array_Acc (El.Eltype), Bounds); + when Ghdl_Rtik_Type_Unbounded_Record => + Write_Record_Bounds + (To_Ghdl_Rtin_Type_Record_Acc (El.Eltype), Bounds); + when others => + null; + end case; + end loop; + end Write_Record_Bounds; + procedure Write_Types is Rti : Ghdl_Rti_Access; Ctxt : Rti_Context; begin + -- Types header. Wave_Section ("TYP" & NUL); Wave_Put_Byte (0); Wave_Put_Byte (0); Wave_Put_Byte (0); Wave_Put_Byte (0); Wave_Put_I32 (Ghdl_I32 (Types_Table.Last)); + for I in Types_Table.First .. Types_Table.Last loop Rti := Types_Table.Table (I).Type_Rti; Ctxt := Types_Table.Table (I).Context; @@ -1286,23 +1329,26 @@ package body Grt.Waves is declare Obj_Rti : constant Ghdl_Rtin_Object_Acc := To_Ghdl_Rtin_Object_Acc (Rti); - Arr : constant Ghdl_Rtin_Type_Array_Acc := - To_Ghdl_Rtin_Type_Array_Acc (Obj_Rti.Obj_Type); - Addr : Ghdl_Uc_Array_Acc; begin - Wave_Put_Byte (Ghw_Rtik'Pos (Ghw_Rtik_Subtype_Array)); - Write_String_Id (null); - Write_Type_Id (Obj_Rti.Obj_Type, Ctxt); - Addr := To_Ghdl_Uc_Array_Acc - (Loc_To_Addr (Rti.Depth, Obj_Rti.Loc, Ctxt)); - declare - Rngs : Ghdl_Range_Array (0 .. Arr.Nbr_Dim - 1); - begin - Bound_To_Range (Addr.Bounds, Arr, Rngs); - for I in Rngs'Range loop - Write_Range (Arr.Indexes (I), Rngs (I)); - end loop; - end; + case Obj_Rti.Obj_Type.Kind is + when Ghdl_Rtik_Type_Array => + declare + Arr : constant Ghdl_Rtin_Type_Array_Acc := + To_Ghdl_Rtin_Type_Array_Acc (Obj_Rti.Obj_Type); + Addr : Ghdl_Uc_Array_Acc; + Bounds : Address; + begin + Wave_Put_Byte (Ghw_Rtik'Pos (Ghw_Rtik_Subtype_Array)); + Write_String_Id (null); + Write_Type_Id (Obj_Rti.Obj_Type, Ctxt); + Addr := To_Ghdl_Uc_Array_Acc + (Loc_To_Addr (Rti.Depth, Obj_Rti.Loc, Ctxt)); + Bounds := Addr.Bounds; + Write_Array_Bounds (Arr, Bounds); + end; + when others => + Internal_Error ("waves.write_types: unhandled obj kind"); + end case; end; else -- Kind. @@ -1331,14 +1377,10 @@ package body Grt.Waves is declare Bt : constant Ghdl_Rtin_Type_Array_Acc := To_Ghdl_Rtin_Type_Array_Acc (Arr.Basetype); - Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1); + Bounds : Address; begin - Bound_To_Range - (Loc_To_Addr (Rti.Depth, Arr.Bounds, Ctxt), - Bt, Rngs); - for I in Rngs'Range loop - Write_Range (Bt.Indexes (I), Rngs (I)); - end loop; + Bounds := Loc_To_Addr (Rti.Depth, Arr.Bounds, Ctxt); + Write_Array_Bounds (Bt, Bounds); end; end; when Ghdl_Rtik_Type_Array => @@ -1353,7 +1395,8 @@ package body Grt.Waves is Write_Type_Id (Arr.Indexes (I - 1), Ctxt); end loop; end; - when Ghdl_Rtik_Type_Record => + when Ghdl_Rtik_Type_Record + | Ghdl_Rtik_Type_Unbounded_Record => declare Rec : constant Ghdl_Rtin_Type_Record_Acc := To_Ghdl_Rtin_Type_Record_Acc (Rti); @@ -1369,11 +1412,19 @@ package body Grt.Waves is end; when Ghdl_Rtik_Subtype_Record => declare - Arr : constant Ghdl_Rtin_Subtype_Composite_Acc := + Rec : constant Ghdl_Rtin_Subtype_Composite_Acc := To_Ghdl_Rtin_Subtype_Composite_Acc (Rti); + Base : constant Ghdl_Rtin_Type_Record_Acc := + To_Ghdl_Rtin_Type_Record_Acc (Rec.Basetype); + Bounds : Address; begin - Write_String_Id (Arr.Name); - Write_Type_Id (Arr.Basetype, Ctxt); + Write_String_Id (Rec.Name); + Write_Type_Id (Rec.Basetype, Ctxt); + if Base.Common.Kind = Ghdl_Rtik_Type_Unbounded_Record then + Bounds := Loc_To_Addr + (Rec.Common.Depth, Rec.Bounds, Ctxt); + Write_Record_Bounds (Base, Bounds); + end if; end; when Ghdl_Rtik_Subtype_Scalar => declare |