Add sever-glue, for missing first stage of sweep.

5 files changed, 87 insertions, 15 deletions

diff --git a/src/boot/be/abi.ml b/src/boot/be/abi.ml
index 1a432086..9108a182 100644
--- a/src/boot/be/abi.ml
+++ b/src/boot/be/abi.ml
@@ -57,8 +57,9 @@ let tydesc_field_align = 2;;
 let tydesc_field_copy_glue = 3;;
 let tydesc_field_drop_glue = 4;;
 let tydesc_field_free_glue = 5;;
-let tydesc_field_mark_glue = 6;;
-let tydesc_field_obj_drop_glue = 7;;
+let tydesc_field_sever_glue = 6;;
+let tydesc_field_mark_glue = 7;;
+let tydesc_field_obj_drop_glue = 8;;
 
 let vec_elt_rc = 0;;
 let vec_elt_alloc = 1;;
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 41e6a55a..08155ed3 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -20,11 +20,12 @@ type glue =
   | GLUE_yield
   | GLUE_exit_main_task
   | GLUE_exit_task
-  | GLUE_mark of Ast.ty
-  | GLUE_drop of Ast.ty
-  | GLUE_free of Ast.ty
-  | GLUE_copy of Ast.ty      (* One-level copy. *)
-  | GLUE_clone of Ast.ty     (* Deep copy. *)
+  | GLUE_copy of Ast.ty           (* One-level copy.                    *)
+  | GLUE_drop of Ast.ty           (* De-initialize interior memory.     *)
+  | GLUE_free of Ast.ty           (* Drop body + free() exterior ptr.   *)
+  | GLUE_sever of Ast.ty          (* Null all exterior state slots.     *)
+  | GLUE_mark of Ast.ty           (* Mark all exterior state slots.     *)
+  | GLUE_clone of Ast.ty          (* Deep copy.                         *)
   | GLUE_compare of Ast.ty
   | GLUE_hash of Ast.ty
   | GLUE_write of Ast.ty
@@ -32,12 +33,12 @@ type glue =
   | GLUE_unwind
   | GLUE_gc
   | GLUE_get_next_pc
-  | GLUE_mark_frame of node_id    (* node is the frame                 *)
-  | GLUE_drop_frame of node_id    (* node is the frame                 *)
-  | GLUE_reloc_frame of node_id   (* node is the frame                 *)
-  | GLUE_fn_binding of node_id    (* node is the 'bind' stmt           *)
-  | GLUE_obj_drop of node_id      (* node is the obj                   *)
-  | GLUE_loop_body of node_id     (* node is the 'for each' body block *)
+  | GLUE_mark_frame of node_id    (* Node is the frame.                 *)
+  | GLUE_drop_frame of node_id    (* Node is the frame.                 *)
+  | GLUE_reloc_frame of node_id   (* Node is the frame.                 *)
+  | GLUE_fn_binding of node_id    (* Node is the 'bind' stmt.           *)
+  | GLUE_obj_drop of node_id      (* Node is the obj.                   *)
+  | GLUE_loop_body of node_id     (* Node is the 'for each' body block. *)
   | GLUE_forward of (Ast.ident * Ast.ty_obj * Ast.ty_obj)
 ;;
 
@@ -1603,6 +1604,7 @@ let tydesc_rty (abi:Abi.abi) : Il.referent_ty =
       Il.ScalarTy (Il.AddrTy Il.CodeTy); (* Abi.tydesc_field_copy_glue     *)
       Il.ScalarTy (Il.AddrTy Il.CodeTy); (* Abi.tydesc_field_drop_glue     *)
       Il.ScalarTy (Il.AddrTy Il.CodeTy); (* Abi.tydesc_field_free_glue     *)
+      Il.ScalarTy (Il.AddrTy Il.CodeTy); (* Abi.tydesc_field_sever_glue    *)
       Il.ScalarTy (Il.AddrTy Il.CodeTy); (* Abi.tydesc_field_mark_glue     *)
       Il.ScalarTy (Il.AddrTy Il.CodeTy); (* Abi.tydesc_field_obj_drop_glue *)
     |]
@@ -1982,10 +1984,11 @@ let glue_str (cx:ctxt) (g:glue) : string =
     | GLUE_yield -> "glue$yield"
     | GLUE_exit_main_task -> "glue$exit_main_task"
     | GLUE_exit_task -> "glue$exit_task"
-    | GLUE_mark ty -> "glue$mark$" ^ (ty_str ty)
+    | GLUE_copy ty -> "glue$copy$" ^ (ty_str ty)
     | GLUE_drop ty -> "glue$drop$" ^ (ty_str ty)
     | GLUE_free ty -> "glue$free$" ^ (ty_str ty)
-    | GLUE_copy ty -> "glue$copy$" ^ (ty_str ty)
+    | GLUE_sever ty -> "glue$sever$" ^ (ty_str ty)
+    | GLUE_mark ty -> "glue$mark$" ^ (ty_str ty)
     | GLUE_clone ty -> "glue$clone$" ^ (ty_str ty)
     | GLUE_compare ty -> "glue$compare$" ^ (ty_str ty)
     | GLUE_hash ty -> "glue$hash$" ^ (ty_str ty)
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index 98bf6bab..911c2acd 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -1082,6 +1082,7 @@ let trans_visitor
                        get_copy_glue t None;
                        get_drop_glue t None;
                        get_free_glue t (slot_mem_ctrl (interior_slot t)) None;
+                       get_sever_glue t None;
                        get_mark_glue t None;
                      |];
                    (* Include any obj-dtor, if this is an obj and has one. *)
@@ -1653,6 +1654,21 @@ let trans_visitor
       get_typed_mem_glue g fty inner
 
 
+  and get_sever_glue
+      (ty:Ast.ty)
+      (curr_iso:Ast.ty_iso option)
+      : fixup =
+    let g = GLUE_sever ty in
+    let inner _ (args:Il.cell) =
+      let ty_params = deref (get_element_ptr args 0) in
+      let cell = get_element_ptr args 1 in
+        sever_ty ty_params ty (deref cell) curr_iso
+    in
+    let ty_params_ptr = ty_params_covering ty in
+    let fty = mk_simple_ty_fn [| ty_params_ptr; alias_slot ty |] in
+      get_typed_mem_glue g fty inner
+
+
   and get_mark_glue
       (ty:Ast.ty)
       (curr_iso:Ast.ty_iso option)
@@ -2485,6 +2501,18 @@ let trans_visitor
       | _ ->
           iter_ty_slots ty_params ty cell (drop_slot ty_params) curr_iso
 
+  and sever_ty
+      (ty_params:Il.cell)
+      (ty:Ast.ty)
+      (cell:Il.cell)
+      (curr_iso:Ast.ty_iso option)
+      : unit =
+    match ty with
+      | Ast.TY_fn _
+      | Ast.TY_obj _ -> ()
+      | _ ->
+          iter_ty_slots ty_params ty cell (sever_slot ty_params) curr_iso
+
   and mark_ty
       (ty_params:Il.cell)
       (ty:Ast.ty)
@@ -2624,6 +2652,44 @@ let trans_visitor
         Ast.TY_iso tiso -> Some tiso
       | _ -> curr_iso
 
+  and sever_slot
+      (ty_params:Il.cell)
+      (cell:Il.cell)
+      (slot:Ast.slot)
+      (curr_iso:Ast.ty_iso option)
+      : unit =
+    let ty = slot_ty slot in
+      match slot_mem_ctrl slot with
+          MEM_gc ->
+
+            let _ = check_exterior_rty cell in
+            let null_jmp = null_check cell in
+            let rc = exterior_rc_cell cell in
+            let _ = note_gc_step slot "severing" in
+              emit (Il.binary Il.SUB rc (Il.Cell rc) one);
+              mov cell zero;
+              patch null_jmp
+
+        | MEM_interior when type_is_structured ty ->
+            (iflog (fun _ ->
+                      annotate ("sever interior slot " ^
+                                  (Fmt.fmt_to_str Ast.fmt_slot slot))));
+            let (mem, _) = need_mem_cell cell in
+            let tmp = next_vreg_cell Il.voidptr_t in
+            let ty = maybe_iso curr_iso ty in
+            let curr_iso = maybe_enter_iso ty curr_iso in
+              lea tmp mem;
+              trans_call_simple_static_glue
+                (get_sever_glue ty curr_iso)
+                ty_params tmp
+
+        | MEM_interior ->
+            (* Interior allocation of all-interior value: sever directly. *)
+            let ty = maybe_iso curr_iso ty in
+              sever_ty ty_params ty cell curr_iso
+
+        | _ -> ()
+
   and mark_slot
       (ty_params:Il.cell)
       (cell:Il.cell)
diff --git a/src/rt/rust_crate_cache.cpp b/src/rt/rust_crate_cache.cpp
index fa10b91b..2db0eb45 100644
--- a/src/rt/rust_crate_cache.cpp
+++ b/src/rt/rust_crate_cache.cpp
@@ -221,6 +221,7 @@ rust_crate_cache::get_type_desc(size_t size,
     adjust_disp(td->drop_glue_off, descs[0], td);
     adjust_disp(td->free_glue_off, descs[0], td);
     adjust_disp(td->mark_glue_off, descs[0], td);
+    adjust_disp(td->sever_glue_off, descs[0], td);
     adjust_disp(td->obj_drop_glue_off, descs[0], td);
     HASH_ADD(hh, this->type_descs, descs, keysz, td);
     return td;
diff --git a/src/rt/rust_internal.h b/src/rt/rust_internal.h
index 7f703012..c9a28946 100644
--- a/src/rt/rust_internal.h
+++ b/src/rt/rust_internal.h
@@ -306,6 +306,7 @@ struct type_desc {
     uintptr_t copy_glue_off;
     uintptr_t drop_glue_off;
     uintptr_t free_glue_off;
+    uintptr_t sever_glue_off;    // For GC.
     uintptr_t mark_glue_off;     // For GC.
     uintptr_t obj_drop_glue_off; // For custom destructors.