Encode and decode tag types in dwarf properly. Add list module to std. Shift rustc to use std.util.option. Fix various dependent bugs. Closes #73.

src/boot/me/dwarf.ml

@@ -1211,6 +1211,19 @@ let (abbrev_subprogram:abbrev) =
    |])
 ;;
 
+let (abbrev_tag_constructor_subprogram:abbrev) =
+  (DW_TAG_subprogram, DW_CHILDREN_yes,
+   [|
+     (DW_AT_name, DW_FORM_string);
+     (DW_AT_rust_tag_type_id, DW_FORM_data4);
+     (DW_AT_discr_value, DW_FORM_data4);
+     (DW_AT_low_pc, DW_FORM_addr);
+     (DW_AT_high_pc, DW_FORM_addr);
+     (DW_AT_frame_base, DW_FORM_block1);
+     (DW_AT_return_addr, DW_FORM_block1);
+   |])
+;;
+
 let (abbrev_typedef:abbrev) =
   (DW_TAG_typedef, DW_CHILDREN_yes,
    [|
@@ -1233,7 +1246,7 @@ let (abbrev_variable:abbrev) =
   (DW_TAG_variable, DW_CHILDREN_no,
    [|
      (DW_AT_name, DW_FORM_string);
-     (DW_AT_location, DW_FORM_block1);
+     (DW_AT_location, DW_FORM_block4);
      (DW_AT_type, DW_FORM_ref_addr)
    |])
 ;;
@@ -1243,7 +1256,7 @@ let (abbrev_formal:abbrev) =
   (DW_TAG_formal_parameter, DW_CHILDREN_no,
    [|
      (DW_AT_name, DW_FORM_string);
-     (DW_AT_location, DW_FORM_block1);
+     (DW_AT_location, DW_FORM_block4);
      (DW_AT_type, DW_FORM_ref_addr)
    |])
 ;;
@@ -1572,7 +1585,7 @@ let dwarf_visitor
                 ref_addr_for_fix fix
 
 
-  and size_block4 (sz:size) (add_to_base:bool) : frag =
+  and size_block4 (sz:size) (push_fbreg:bool) (add_to_base:bool) : frag =
     (* NB: typarams = "words following implicit args" by convention in
      * ABI/x86.
      *)
@@ -1656,7 +1669,12 @@ let dwarf_visitor
                 DW_OP_and;            (* ... aligned          *)
               ]
     in
-    let ops = sz_ops sz in
+    let ops =
+      if push_fbreg
+      then [ DW_OP_reg abi.Abi.abi_dwarf_fp_reg ]
+      else []
+    in
+    let ops = ops @ (sz_ops sz) in
     let ops =
       if add_to_base
       then ops @ [ DW_OP_plus ]
@@ -1685,7 +1703,7 @@ let dwarf_visitor
         let die = DEF (fix, SEQ [|
                          uleb (get_abbrev_code abbrev_struct_type);
                          (* DW_AT_byte_size: DW_FORM_block4 *)
-                         size_block4 (rty_sz rty) false
+                         size_block4 (rty_sz rty) false false
                        |]);
         in
         let rtys =
@@ -1706,9 +1724,9 @@ let dwarf_visitor
                             (* DW_AT_data_member_location: DW_FORM_block4 *)
                             size_block4
                               (Il.get_element_offset word_bits rtys i)
-                              true;
+                              false true;
                             (* DW_AT_byte_size: DW_FORM_block4 *)
-                            size_block4 (rty_sz rtys.(i)) false |]);
+                            size_block4 (rty_sz rtys.(i)) false false |]);
             end
             trec;
           emit_null_die ()
@@ -1908,6 +1926,7 @@ let dwarf_visitor
          *)
 
         let n_variants = get_n_tag_tups cx ttag in
+        let n_args = Array.length ttag.Ast.tag_args in
         let tinfo = Hashtbl.find cx.ctxt_all_tag_info ttag.Ast.tag_id in
         let rty = referent_type cx (Ast.TY_tag ttag) in
         let rty_sz = Il.referent_ty_size abi.Abi.abi_word_bits in
@@ -1921,7 +1940,7 @@ let dwarf_visitor
           DEF (fix, SEQ [|
                  uleb (get_abbrev_code abbrev_struct_type);
                  (* DW_AT_byte_size: DW_FORM_block4 *)
-                 size_block4 (rty_sz rty) false
+                 size_block4 (rty_sz rty) false false
                |])
         in
 
@@ -1936,9 +1955,9 @@ let dwarf_visitor
                  (* DW_AT_data_member_location: DW_FORM_block4 *)
                  size_block4
                    (Il.get_element_offset word_bits rtys 0)
-                   true;
+                   false true;
                  (* DW_AT_byte_size: DW_FORM_block4 *)
-                 size_block4 (rty_sz rtys.(0)) false |]);
+                 size_block4 (rty_sz rtys.(0)) false false |]);
         in
 
         let variant_part_die =
@@ -1952,6 +1971,7 @@ let dwarf_visitor
           |]
         in
 
+
         let emit_variant i =
           let (name, _, _) = Hashtbl.find tinfo.tag_nums i in
           let ttup = get_nth_tag_tup cx ttag i in
@@ -1963,9 +1983,19 @@ let dwarf_visitor
                         (* DW_AT_name: DW_FORM_string *)
                         ZSTRING name
                       |]);
-            ignore (tup ttup);
+            ignore (ref_type_die (Ast.TY_tup ttup));
             emit_null_die ();
         in
+
+        let emit_arg i =
+          let arg = ttag.Ast.tag_args.(i) in
+          emit_die (SEQ [|
+                      uleb (get_abbrev_code abbrev_formal_type);
+                      (* DW_AT_type: DW_FORM_ref_addr *)
+                      (ref_type_die arg)
+                    |]);
+        in
+
           emit_die outer_structure_die;
           emit_die discr_die;
           emit_die variant_part_die;
@@ -1974,6 +2004,10 @@ let dwarf_visitor
             emit_variant i
           done;
           emit_null_die (); (* end variant-part *)
+          for i = 0 to n_args - 1
+          do
+            emit_arg i
+          done;
           emit_null_die (); (* end outer struct *)
       in
 
@@ -2024,9 +2058,7 @@ let dwarf_visitor
             | Ast.TY_str -> string_type ()
             | Ast.TY_rec trec -> record trec
             | Ast.TY_tup ttup -> tup ttup
-            | Ast.TY_tag ttag ->
+            | Ast.TY_tag ttag -> tag_type ttag
-                let _ = fun _ -> tag_type ttag in
-                  unspecified_struct DW_RUST_nil
             | Ast.TY_vec t -> unspecified_ptr_with_ref_ty DW_RUST_vec t
             | Ast.TY_chan t -> unspecified_ptr_with_ref_ty DW_RUST_chan t
             | Ast.TY_port t -> unspecified_ptr_with_ref_ty DW_RUST_port t
@@ -2276,6 +2308,41 @@ let dwarf_visitor
       emit_die subprogram_die
   in
 
+  let emit_tag_constructor_die
+      (id:Ast.ident)
+      (tid:opaque_id)
+      (n_slots:int)
+      (tag_num:int)
+      (fix:fixup)
+      : unit =
+    (* NB: retpc = "top word of frame-base" by convention in ABI/x86. *)
+    let abi = cx.ctxt_abi in
+    let retpc = Int64.sub abi.Abi.abi_frame_base_sz abi.Abi.abi_word_sz in
+    let abbrev_code = get_abbrev_code abbrev_tag_constructor_subprogram in
+    let subprogram_die =
+      (SEQ [|
+         uleb abbrev_code;
+         (* DW_AT_name *)
+         ZSTRING id;
+         (* DW_AT_tag_type_id *)
+         WORD (word_ty_mach, IMM (Int64.of_int (int_of_opaque tid)));
+         (* DW_AT_discr_value *)
+         WORD (word_ty_mach, IMM (Int64.of_int tag_num));
+         if n_slots = 0
+         then
+           SEQ [| WORD (word_ty_mach, IMM 0L);
+                  WORD (word_ty_mach, IMM 0L); |]
+         else
+           addr_ranges fix;
+         (* DW_AT_frame_base *)
+         dw_form_block1 [| DW_OP_reg abi.Abi.abi_dwarf_fp_reg |];
+         (* DW_AT_return_addr *)
+         dw_form_block1 [| DW_OP_fbreg (Asm.IMM retpc); |];
+       |])
+    in
+      emit_die subprogram_die
+  in
+
   let emit_typedef_die
       (id:Ast.ident)
       (e:Ast.effect)
@@ -2331,6 +2398,7 @@ let dwarf_visitor
               emit_module_die id;
               emit_type_param_decl_dies item.node.Ast.decl_params;
             end
+
         | Ast.MOD_ITEM_fn _ ->
             begin
               let ty = Hashtbl.find cx.ctxt_all_item_types item.id in
@@ -2350,6 +2418,7 @@ let dwarf_visitor
                   (Hashtbl.find cx.ctxt_fn_fixups item.id);
                 emit_type_param_decl_dies item.node.Ast.decl_params;
             end
+
         | Ast.MOD_ITEM_type (e, _) ->
             begin
               log cx "walking typedef '%s' with %d type params"
@@ -2359,6 +2428,15 @@ let dwarf_visitor
                 id e (Hashtbl.find cx.ctxt_all_type_items item.id);
               emit_type_param_decl_dies item.node.Ast.decl_params;
             end
+
+        | Ast.MOD_ITEM_tag (hslots, tid, n) ->
+            log cx "walking tag constructor '%s' with %d type params"
+              (path_name())
+              (Array.length item.node.Ast.decl_params);
+            emit_tag_constructor_die id tid (Array.length hslots) n
+              (Hashtbl.find cx.ctxt_fn_fixups item.id);
+            emit_type_param_decl_dies item.node.Ast.decl_params;
+
         | _ -> ()
     end;
     inner.Walk.visit_mod_item_pre id params item
@@ -2386,6 +2464,7 @@ let dwarf_visitor
       match item.node.Ast.decl_item with
           Ast.MOD_ITEM_mod _
         | Ast.MOD_ITEM_fn _
+        | Ast.MOD_ITEM_tag _
         | Ast.MOD_ITEM_type _ -> emit_null_die ()
         | _ -> ()
     end;
@@ -2432,8 +2511,8 @@ let dwarf_visitor
                     uleb abbrev_code;
                     (* DW_AT_name: DW_FORM_string *)
                     ZSTRING ident;
-                    (* DW_AT_location:  DW_FORM_block1 *)
+                    (* DW_AT_location:  DW_FORM_block4 *)
-                    dw_form_block1 slot_loc;
+                    slot_loc;
                     (* DW_AT_type: DW_FORM_ref_addr *)
                     ref_slot_die resolved_slot
                   |]
@@ -2442,16 +2521,8 @@ let dwarf_visitor
               in
                 match htab_search cx.ctxt_slot_offsets s.id with
                     Some off ->
-                      begin
+                      emit_var_die (size_block4 off true true)
-                        match Il.size_to_expr64 off with
+
-                            (* FIXME (issue #73): handle dynamic-size
-                             * slots.
-                             *)
-                            None -> ()
-                          | Some off ->
-                              emit_var_die
-                                [| DW_OP_fbreg off |]
-                      end
                   | None ->
                       (* FIXME (issue #28): handle slots assigned to
                        * vregs.
@@ -2791,6 +2862,10 @@ let rec extract_mod_items
     atab_find die.die_attrs attr
   in
 
+  let has_attr die attr =
+    atab_mem die.die_attrs attr
+  in
+
   let get_str die attr  =
     match get_attr die attr with
         (_, DATA_str s) -> s
@@ -2831,6 +2906,10 @@ let rec extract_mod_items
     get_num die DW_AT_rust_native_type_id
   in
 
+  let get_tag_id die =
+    get_num die DW_AT_rust_tag_type_id
+  in
+
   let get_type_param_decl die =
     ((get_str die DW_AT_name), (get_type_param die))
   in
@@ -2843,9 +2922,9 @@ let rec extract_mod_items
 
   let rec get_ty die : Ast.ty =
 
-    let is_tagged_variant =
+    let is_tagged_variant die =
-      Array.length die.die_children == 2 &&
+      Array.length die.die_children >= 2 &&
-        die.die_children.(1).die_tag = DW_TAG_variant
+      die.die_children.(1).die_tag = DW_TAG_variant_part
     in
 
       match die.die_tag with
@@ -2913,13 +2992,19 @@ let rec extract_mod_items
                 | _ -> bug () "unexpected type of DW_TAG_base_type"
             end
 
-        | DW_TAG_structure_type when is_tagged_variant ->
+        | DW_TAG_structure_type when is_tagged_variant die ->
             Ast.TY_tag
-              { Ast.tag_id = Opaque (get_num
+              { Ast.tag_id = get_opaque_of (get_tag_id die.die_children.(1));
-                                       (die.die_children.(1))
+                Ast.tag_args =
-                                       DW_AT_rust_tag_type_id);
+                  let n_children = Array.length die.die_children in
-                (* FIXME: encode and decode tag args. *)
+                    if n_children > 2
-                Ast.tag_args = [| |] }
+                    then
+                      Array.map
+                        get_referenced_ty
+                        (Array.sub die.die_children 2 (n_children - 2))
+                    else
+                      [| |]
+              }
 
         | DW_TAG_structure_type ->
             begin
@@ -3100,6 +3185,16 @@ let rec extract_mod_items
           let mi = Ast.MOD_ITEM_mod (view, sub_mis) in
             htab_put mis ident (decl [||] mi)
 
+      | DW_TAG_subprogram
+          when has_attr die DW_AT_rust_tag_type_id ->
+          let ident = get_name die in
+          let tid = get_opaque_of (get_tag_id die) in
+          let n = get_num die DW_AT_discr_value in
+          let (params, islots) = get_formals die in
+          let hslots = form_header_slots islots in
+          let ctor = Ast.MOD_ITEM_tag (hslots, tid, n) in
+            htab_put mis ident (decl params ctor)
+
       | DW_TAG_subprogram ->
           (* FIXME (issue #74): finish this. *)
           let ident = get_name die in

src/boot/me/resolve.ml

@@ -445,8 +445,12 @@ let type_resolving_visitor
                   (fun (s,_) -> (slot_ty (resolve_slot_identified s).node))
                   slots
               in
-                htab_put tinfo.tag_idents id (n, item.id, ttup);
+                if not (Hashtbl.mem tinfo.tag_idents id)
-                htab_put tinfo.tag_nums n (id, item.id, ttup);
+                then
+                  begin
+                    htab_put tinfo.tag_idents id (n, item.id, ttup);
+                    htab_put tinfo.tag_nums n (id, item.id, ttup);
+                  end
 
           | _ -> resolve_and_store_type ()
       with

src/boot/me/trans.ml

@@ -1415,16 +1415,49 @@ let trans_visitor
                  (sorted_htab_keys obj.Ast.obj_fns))
         end
 
+  and copy_loop
+      (dst:Il.cell)
+      (src:Il.cell)
+      (sz:Il.operand)
+      (elt_sz:Il.operand)
+      (elt_copy:Il.cell -> Il.cell -> unit)
+      : unit =
+    let eltp_sty = Il.AddrTy (Il.ScalarTy (Il.ValTy Il.Bits8)) in
+    let dptr = next_vreg_cell eltp_sty in
+    let sptr = next_vreg_cell eltp_sty in
+    let dlim = next_vreg_cell eltp_sty in
+      lea dptr (fst (need_mem_cell dst));
+      lea sptr (fst (need_mem_cell src));
+      mov dlim (Il.Cell dptr);
+      add_to dlim sz;
+
+      let fwd_jmp = mark () in
+        emit (Il.jmp Il.JMP Il.CodeNone);
+        let back_jmp_targ = mark () in
+
+          elt_copy dptr sptr;
+
+          add_to dptr elt_sz;
+          add_to sptr elt_sz;
+
+          patch fwd_jmp;
+          let back_jmp =
+            trans_compare_simple Il.JB (Il.Cell dptr) (Il.Cell dlim)
+          in
+            List.iter
+              (fun j -> patch_existing j back_jmp_targ) back_jmp;
+
 
   and trans_copy_forward_args (args_rty:Il.referent_ty) : unit =
     let caller_args_cell = caller_args_cell args_rty in
     let callee_args_cell = callee_args_cell false args_rty in
-    let (dst_reg, _) = force_to_reg (Il.Cell (alias callee_args_cell)) in
+    let nbytes = Il.referent_ty_size word_bits args_rty in
-    let (src_reg, _) = force_to_reg (Il.Cell (alias caller_args_cell)) in
+    let nbytes = calculate_sz_in_current_frame nbytes in
-    let tmp_reg = next_vreg () in
+      copy_loop callee_args_cell caller_args_cell nbytes one
-    let nbytes = force_sz (Il.referent_ty_size word_bits args_rty) in
+        begin
-      abi.Abi.abi_emit_inline_memcpy (emitter())
+          fun dptr sptr ->
-        nbytes dst_reg src_reg tmp_reg false;
+            mov (deref dptr) (Il.Cell (deref sptr))
+        end
 
 
   and get_forwarding_obj_fn
@@ -2126,55 +2159,34 @@ let trans_visitor
               get_element_ptr_dyn ty_params_cell src_vec Abi.vec_elt_data
             in
 
-            (* Copy loop: *)
+            let ty_params_ptr =
-            let eltp_sty = Il.AddrTy (Il.OpaqueTy) in
+              get_tydesc_params ty_params_cell elt_td_ptr_cell
-            let dptr = next_vreg_cell eltp_sty in
+            in
-            let sptr = next_vreg_cell eltp_sty in
-            let dlim = next_vreg_cell eltp_sty in
 
-              lea dptr (fst (need_mem_cell dst_buf));
+            let initflag = Il.Reg (force_to_reg one) in
-              lea sptr (fst (need_mem_cell src_buf));
-              mov dlim (Il.Cell dptr);
-              add_to dlim (Il.Cell fill);
 
-              (* Copy loop body: *)
+              copy_loop dst_buf src_buf (Il.Cell fill) (Il.Cell elt_sz)
-              let fwd_jmp = mark () in
+                begin
-                emit (Il.jmp Il.JMP Il.CodeNone);
+                  fun dptr sptr ->
-                let back_jmp_targ = mark () in
+                    trans_call_dynamic_glue
+                      elt_td_ptr_cell
+                      Abi.tydesc_field_copy_glue
+                      (Some (deref dptr))
+                      [| ty_params_ptr; sptr; initflag |]
+                      None
+                end;
 
-                (* Copy *)
+              (* Set the new vec's fill to the original vec's fill *)
-                let ty_params_ptr =
+              let dst_fill = get_element_ptr dst_vec Abi.vec_elt_fill in
-                  get_tydesc_params ty_params_cell elt_td_ptr_cell
+              let v = next_vreg_cell word_sty in
-                in
+                mov v (Il.Cell fill);
-                let initflag = Il.Reg (force_to_reg one) in
+                mov dst_fill (Il.Cell v);
-                  trans_call_dynamic_glue
-                    elt_td_ptr_cell
-                    Abi.tydesc_field_copy_glue
-                    (Some (deref dptr))
-                    [| ty_params_ptr; sptr; initflag |]
-                    None;
 
-                  add_to dptr (Il.Cell elt_sz);
+                List.iter patch no_copy_jmps;
-                  add_to sptr (Il.Cell elt_sz);
 
-                  patch fwd_jmp;
+                mov vec_cell (Il.Cell new_vec_cell);
-                  let back_jmp =
-                    trans_compare_simple Il.JB (Il.Cell dptr) (Il.Cell dlim)
-                  in
-                    List.iter
-                      (fun j -> patch_existing j back_jmp_targ) back_jmp;
 
-                    (* Set the new vec's fill to the original vec's fill *)
+                trans_glue_frame_exit fix spill g
-                    let dst_fill = get_element_ptr dst_vec Abi.vec_elt_fill in
-                    let v = next_vreg_cell word_sty in
-                      mov v (Il.Cell fill);
-                      mov dst_fill (Il.Cell v);
-
-                      List.iter patch no_copy_jmps;
-
-                      mov vec_cell (Il.Cell new_vec_cell);
-
-                      trans_glue_frame_exit fix spill g
 
 
   and get_vec_grow_glue _
@@ -5737,9 +5749,14 @@ let trans_visitor
                              [| Asm.WORD (word_ty_mach, Asm.IMM 0L) |]))
   in
 
-  let trans_required_fn (fnid:node_id) (blockid:node_id) : unit =
+  let trans_required_fn (fnid:node_id) (blockid:node_id option) : unit =
     trans_frame_entry fnid false false;
-    emit (Il.Enter (Hashtbl.find cx.ctxt_block_fixups blockid));
+    begin
+      match blockid with
+          None -> ()
+        | Some blockid ->
+            emit (Il.Enter (Hashtbl.find cx.ctxt_block_fixups blockid));
+    end;
     let (ilib, conv) = Hashtbl.find cx.ctxt_required_items fnid in
     let lib_num =
       htab_search_or_add cx.ctxt_required_lib_num ilib
@@ -5862,7 +5879,8 @@ let trans_visitor
           | _ -> bug ()
               "Trans.required_rust_fn on unexpected form of require library"
       end;
-      emit Il.Leave;
+      if blockid <> None
+      then emit Il.Leave;
       match ilib with
           REQUIRED_LIB_rust _ ->
             trans_frame_exit fnid false;
@@ -5956,7 +5974,12 @@ let trans_visitor
     iflog (fun _ -> log cx "translating required item #%d = %s"
              (int_of_node i.id) (path_name()));
     match i.node.Ast.decl_item with
-        Ast.MOD_ITEM_fn f -> trans_required_fn i.id f.Ast.fn_body.id
+        Ast.MOD_ITEM_fn f ->
+          trans_required_fn i.id (Some f.Ast.fn_body.id)
+      | Ast.MOD_ITEM_tag (hslots, _, _) ->
+          if Array.length hslots = 0
+          then ()
+          else trans_required_fn i.id None
       | Ast.MOD_ITEM_mod _ -> ()
       | Ast.MOD_ITEM_type _ -> ()
       | _ -> unimpl (Some i.id)

src/comp/front/ast.rs

@@ -1,11 +1,9 @@
 
 import util.common.option;
 import std.map.hashmap;
+import std.util.option;
 import util.common.span;
 import util.common.spanned;
-import util.common.option;
-import util.common.some;
-import util.common.none;
 
 type ident = str;
 

src/comp/front/parser.rs

@@ -1,11 +1,12 @@
 import std._io;
+import std.util.option;
+import std.util.some;
+import std.util.none;
+
 import driver.session;
 import util.common;
 import util.common.span;
 import util.common.new_str_hash;
-import util.common.option;
-import util.common.some;
-import util.common.none;
 
 state type parser =
     state obj {

src/comp/middle/fold.rs

@@ -1,13 +1,13 @@
 import std.map.hashmap;
+import std.util.option;
+import std.util.some;
+import std.util.none;
+
 import util.common.new_str_hash;
 import util.common.spanned;
 import util.common.span;
-import util.common.option;
-import util.common.some;
-import util.common.none;
 import util.common.ty_mach;
 
-
 import front.ast;
 import front.ast.ident;
 import front.ast.name;

src/comp/middle/trans.rs

@@ -3,6 +3,9 @@ import std._vec;
 import std._str.rustrt.sbuf;
 import std._vec.rustrt.vbuf;
 import std.map.hashmap;
+import std.util.option;
+import std.util.some;
+import std.util.none;
 
 import front.ast;
 import driver.session;
@@ -11,9 +14,6 @@ import back.abi;
 
 import util.common.istr;
 import util.common.new_str_hash;
-import util.common.option;
-import util.common.some;
-import util.common.none;
 
 import lib.llvm.llvm;
 import lib.llvm.builder;

src/comp/util/common.rs

@@ -5,14 +5,6 @@ type pos = rec(uint line, uint col);
 type span = rec(str filename, pos lo, pos hi);
 type spanned[T] = rec(T node, span span);
 
-// FIXME: import std.util.option and use it here.
-// import std.util.option;
-
-tag option[T] {
-  none;
-  some(T);
-}
-
 tag ty_mach {
     ty_i8;
     ty_i16;

src/lib/list.rs

@@ -0,0 +1,15 @@
+
+tag list[T] {
+    cons(T, @list[T]);
+    nil;
+}
+
+
+// Local Variables:
+// mode: rust;
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:

src/lib/std.rc

@@ -47,9 +47,10 @@ alt (target_os) {
     }
  }
 
-// FIXME: parametric 
+// FIXME: parametric
 mod map;
 mod deque;
+mod list;
 mod rand;
 mod dbg;