@@ -745,8 +745,6 @@ type dw_rust_type =
745
745
| DW_RUST_chan
746
746
| DW_RUST_port
747
747
| DW_RUST_task
748
- | DW_RUST_tag
749
- | DW_RUST_iso
750
748
| DW_RUST_type
751
749
| DW_RUST_native
752
750
;;
@@ -759,10 +757,8 @@ let dw_rust_type_to_int (pt:dw_rust_type) : int =
759
757
| DW_RUST_chan -> 0x4
760
758
| DW_RUST_port -> 0x5
761
759
| DW_RUST_task -> 0x6
762
- | DW_RUST_tag -> 0x7
763
- | DW_RUST_iso -> 0x8
764
- | DW_RUST_type -> 0x9
765
- | DW_RUST_native -> 0xa
760
+ | DW_RUST_type -> 0x7
761
+ | DW_RUST_native -> 0x8
766
762
;;
767
763
768
764
let dw_rust_type_of_int (i :int ) : dw_rust_type =
@@ -773,10 +769,8 @@ let dw_rust_type_of_int (i:int) : dw_rust_type =
773
769
| 0x4 -> DW_RUST_chan
774
770
| 0x5 -> DW_RUST_port
775
771
| 0x6 -> DW_RUST_task
776
- | 0x7 -> DW_RUST_tag
777
- | 0x8 -> DW_RUST_iso
778
- | 0x9 -> DW_RUST_type
779
- | 0xa -> DW_RUST_native
772
+ | 0x7 -> DW_RUST_type
773
+ | 0x8 -> DW_RUST_native
780
774
| _ -> bug () " bad DWARF rust-pointer-type code: %d" i
781
775
;;
782
776
@@ -1344,6 +1338,21 @@ let (abbrev_struct_type_member:abbrev) =
1344
1338
|])
1345
1339
;;
1346
1340
1341
+ let (abbrev_variant_part:abbrev ) =
1342
+ (DW_TAG_variant_part , DW_CHILDREN_yes ,
1343
+ [|
1344
+ (DW_AT_discr , DW_FORM_ref_addr )
1345
+ |])
1346
+ ;;
1347
+
1348
+
1349
+ let (abbrev_variant:abbrev ) =
1350
+ (DW_TAG_variant , DW_CHILDREN_yes ,
1351
+ [|
1352
+ (DW_AT_discr_value , DW_FORM_udata )
1353
+ |])
1354
+ ;;
1355
+
1347
1356
let (abbrev_subroutine_type:abbrev ) =
1348
1357
(DW_TAG_subroutine_type , DW_CHILDREN_yes ,
1349
1358
[|
@@ -1428,6 +1437,8 @@ let dwarf_visitor
1428
1437
| Il. Bits64 -> TY_i64
1429
1438
in
1430
1439
1440
+ let iso_stack = Stack. create () in
1441
+
1431
1442
let path_name _ = Fmt. fmt_to_str Ast. fmt_name (Walk. path_to_name path) in
1432
1443
1433
1444
let (abbrev_table:(abbrev, int) Hashtbl. t ) = Hashtbl. create 0 in
@@ -1720,6 +1731,12 @@ let dwarf_visitor
1720
1731
ref_addr_for_fix fix
1721
1732
in
1722
1733
1734
+ let tup ttup =
1735
+ record (Array. mapi (fun i s ->
1736
+ (" _" ^ (string_of_int i), s))
1737
+ ttup)
1738
+ in
1739
+
1723
1740
let string_type _ =
1724
1741
(*
1725
1742
* Strings, like vecs, are &[rc,alloc,fill,data...]
@@ -1912,6 +1929,117 @@ let dwarf_visitor
1912
1929
ref_addr_for_fix fix
1913
1930
in
1914
1931
1932
+ let tag_type fix_opt ttag =
1933
+ (*
1934
+ * Tag-encoding is a bit complex. It's based on the pascal model.
1935
+ *
1936
+ * You have a structure (DW_TAG_structure_type) with 2 fields:
1937
+ *
1938
+ * 0 : the discriminant (type uint)
1939
+ * 1 : the variant-part of the structure (DW_TAG_variant_part)
1940
+ * with DW_AT_discr pointing to the disctiminant, and kids:
1941
+ * 0 : variant 0 (DW_TAG_variant) with DW_AT_discr_value 0
1942
+ * (with a tuple-type child)
1943
+ * 1 : variant 1 ...
1944
+ * ...
1945
+ * N : variant N (DW_TAG_variant) with DW_AT_discr_value N
1946
+ *
1947
+ * Curiously, DW_TAG_union_type doesn't seem to play into it.
1948
+ * I'm a bit surprised by that!
1949
+ *)
1950
+
1951
+ let rty = referent_type abi (Ast. TY_tag ttag) in
1952
+ let rty_sz = Il. referent_ty_size abi.Abi. abi_word_bits in
1953
+ let rtys =
1954
+ match rty with
1955
+ Il. StructTy rtys -> rtys
1956
+ | _ -> bug () " tag type became non-struct referent_ty"
1957
+ in
1958
+
1959
+ let outer_structure_fix =
1960
+ match fix_opt with
1961
+ None -> new_fixup " tag type"
1962
+ | Some f -> f
1963
+ in
1964
+ let outer_structure_die =
1965
+ DEF (outer_structure_fix, SEQ [|
1966
+ uleb (get_abbrev_code abbrev_struct_type);
1967
+ (* DW_AT_byte_size: DW_FORM_block4 *)
1968
+ size_block4 (rty_sz rty) false
1969
+ |])
1970
+ in
1971
+
1972
+ let discr_fix = new_fixup " tag discriminant" in
1973
+ let discr_die =
1974
+ DEF (discr_fix, SEQ [|
1975
+ uleb (get_abbrev_code abbrev_struct_type_member);
1976
+ (* DW_AT_name: DW_FORM_string *)
1977
+ ZSTRING " tag" ;
1978
+ (* DW_AT_type: DW_FORM_ref_addr *)
1979
+ (ref_slot_die (interior_slot Ast. TY_uint ));
1980
+ (* DW_AT_mutable: DW_FORM_flag *)
1981
+ BYTE 0 ;
1982
+ (* DW_AT_data_member_location: DW_FORM_block4 *)
1983
+ size_block4
1984
+ (Il. get_element_offset word_bits rtys 0 )
1985
+ true ;
1986
+ (* DW_AT_byte_size: DW_FORM_block4 *)
1987
+ size_block4 (rty_sz rtys.(0 )) false |]);
1988
+ in
1989
+
1990
+ let variant_part_die =
1991
+ SEQ [|
1992
+ uleb (get_abbrev_code abbrev_variant_part);
1993
+ (* DW_AT_discr: DW_FORM_ref_addr *)
1994
+ (dw_form_ref_addr discr_fix)
1995
+ |]
1996
+ in
1997
+
1998
+ let emit_variant i (* name*) _ ttup =
1999
+ (* FIXME: Possibly use a DW_TAG_enumeration_type here? *)
2000
+ (* Tag-names aren't getting encoded; I'm not sure if that's a
2001
+ * problem. Might be. *)
2002
+ emit_die (SEQ [|
2003
+ uleb (get_abbrev_code abbrev_variant);
2004
+ (* DW_AT_discr_value: DW_FORM_udata *)
2005
+ uleb i;
2006
+ |]);
2007
+ ignore (tup ttup);
2008
+ emit_null_die () ;
2009
+ in
2010
+ emit_die outer_structure_die;
2011
+ emit_die discr_die;
2012
+ emit_die variant_part_die;
2013
+ let tag_keys = sorted_htab_keys ttag in
2014
+ Array. iteri
2015
+ (fun i k -> emit_variant i k (Hashtbl. find ttag k))
2016
+ tag_keys;
2017
+ emit_null_die () ; (* end variant-part *)
2018
+ emit_null_die () ; (* end outer struct *)
2019
+ ref_addr_for_fix outer_structure_fix
2020
+ in
2021
+
2022
+ let iso_type tiso =
2023
+ let iso_fixups =
2024
+ Array. map
2025
+ (fun _ -> new_fixup " iso-member tag type" )
2026
+ tiso.Ast. iso_group
2027
+ in
2028
+ Stack. push iso_fixups iso_stack;
2029
+ let tag_dies =
2030
+ Array. mapi
2031
+ (fun i fix ->
2032
+ tag_type (Some fix) tiso.Ast. iso_group.(i))
2033
+ iso_fixups
2034
+ in
2035
+ ignore (Stack. pop iso_stack);
2036
+ tag_dies.(tiso.Ast. iso_index)
2037
+ in
2038
+
2039
+ let idx_type i =
2040
+ ref_addr_for_fix (Stack. top iso_stack).(i)
2041
+ in
2042
+
1915
2043
match ty with
1916
2044
Ast. TY_nil -> unspecified_struct DW_RUST_nil
1917
2045
| Ast. TY_bool -> base (" bool" , DW_ATE_boolean , 1 )
@@ -1928,18 +2056,15 @@ let dwarf_visitor
1928
2056
| Ast. TY_char -> base (" char" , DW_ATE_unsigned_char , 4 )
1929
2057
| Ast. TY_str -> string_type ()
1930
2058
| Ast. TY_rec trec -> record trec
1931
- | Ast. TY_tup ttup ->
1932
- record (Array. mapi (fun i s ->
1933
- (" _" ^ (string_of_int i), s))
1934
- ttup)
1935
-
2059
+ | Ast. TY_tup ttup -> tup ttup
2060
+ | Ast. TY_tag ttag -> tag_type None ttag
2061
+ | Ast. TY_iso tiso -> iso_type tiso
2062
+ | Ast. TY_idx i -> idx_type i
1936
2063
| Ast. TY_vec s -> unspecified_ptr_with_ref_slot DW_RUST_vec s
1937
2064
| Ast. TY_chan t -> unspecified_ptr_with_ref_ty DW_RUST_chan t
1938
2065
| Ast. TY_port t -> unspecified_ptr_with_ref_ty DW_RUST_port t
1939
2066
| Ast. TY_task -> unspecified_ptr DW_RUST_task
1940
2067
| Ast. TY_fn fn -> fn_type fn
1941
- | Ast. TY_tag _ -> unspecified_ptr DW_RUST_tag
1942
- | Ast. TY_iso _ -> unspecified_ptr DW_RUST_iso
1943
2068
| Ast. TY_type -> unspecified_ptr DW_RUST_type
1944
2069
| Ast. TY_native i -> native_ptr_type i
1945
2070
| Ast. TY_param p -> rust_type_param p
0 commit comments