diff options
Diffstat (limited to 'src/boot/me')
| -rw-r--r-- | src/boot/me/alias.ml | 2 | ||||
| -rw-r--r-- | src/boot/me/dwarf.ml | 14 | ||||
| -rw-r--r-- | src/boot/me/effect.ml | 2 | ||||
| -rw-r--r-- | src/boot/me/layout.ml | 10 | ||||
| -rw-r--r-- | src/boot/me/resolve.ml | 1 | ||||
| -rw-r--r-- | src/boot/me/semant.ml | 74 | ||||
| -rw-r--r-- | src/boot/me/trans.ml | 264 | ||||
| -rw-r--r-- | src/boot/me/type.ml | 37 | ||||
| -rw-r--r-- | src/boot/me/typestate.ml | 66 | ||||
| -rw-r--r-- | src/boot/me/walk.ml | 2 |
10 files changed, 313 insertions, 159 deletions
diff --git a/src/boot/me/alias.ml b/src/boot/me/alias.ml index 94d34fb2..27575324 100644 --- a/src/boot/me/alias.ml +++ b/src/boot/me/alias.ml @@ -59,7 +59,7 @@ let alias_analysis_visitor * survive 'into' a sub-block (those formed during iteration) * need to be handled in this module. *) Ast.STMT_call (dst, callee, args) - | Ast.STMT_spawn (dst, _, callee, args) + | Ast.STMT_spawn (dst, _, _, callee, args) -> alias_call_args dst callee args | Ast.STMT_send (_, src) -> alias src diff --git a/src/boot/me/dwarf.ml b/src/boot/me/dwarf.ml index d3fb81de..552b41e4 100644 --- a/src/boot/me/dwarf.ml +++ b/src/boot/me/dwarf.ml @@ -1677,7 +1677,7 @@ let dwarf_visitor in let record trec = - let rty = referent_type abi (Ast.TY_rec trec) in + let rty = referent_type word_bits (Ast.TY_rec trec) in let rty_sz = Il.referent_ty_size abi.Abi.abi_word_bits in let fix = new_fixup "record type DIE" in let die = DEF (fix, SEQ [| @@ -1926,7 +1926,7 @@ let dwarf_visitor * I'm a bit surprised by that! *) - let rty = referent_type abi (Ast.TY_tag ttag) in + let rty = referent_type word_bits (Ast.TY_tag ttag) in let rty_sz = Il.referent_ty_size abi.Abi.abi_word_bits in let rtys = match rty with @@ -2176,14 +2176,8 @@ let dwarf_visitor in let addr_ranges (fix:fixup) : frag = - let image_is_relocated = - match cx.ctxt_sess.Session.sess_targ with - Win32_x86_pe -> - cx.ctxt_sess.Session.sess_library_mode - | _ -> true - in let lo = - if image_is_relocated + if cx.ctxt_sess.Session.sess_library_mode then image_base_rel fix else M_POS fix in @@ -2801,6 +2795,7 @@ let rec extract_meta queue_to_arr meta ;; +let external_opaques = Hashtbl.create 0;; let rec extract_mod_items (nref:node_id ref) @@ -2822,7 +2817,6 @@ let rec extract_mod_items id in - let external_opaques = Hashtbl.create 0 in let get_opaque_of o = htab_search_or_add external_opaques o (fun _ -> next_opaque_id()) diff --git a/src/boot/me/effect.ml b/src/boot/me/effect.ml index 79868def..73797409 100644 --- a/src/boot/me/effect.ml +++ b/src/boot/me/effect.ml @@ -62,7 +62,7 @@ let mutability_checking_visitor match s.node with Ast.STMT_copy (lv_dst, _) | Ast.STMT_call (lv_dst, _, _) - | Ast.STMT_spawn (lv_dst, _, _, _) + | Ast.STMT_spawn (lv_dst, _, _, _, _) | Ast.STMT_recv (lv_dst, _) | Ast.STMT_bind (lv_dst, _, _) | Ast.STMT_new_rec (lv_dst, _, _) diff --git a/src/boot/me/layout.ml b/src/boot/me/layout.ml index a9358795..cfd087ff 100644 --- a/src/boot/me/layout.ml +++ b/src/boot/me/layout.ml @@ -113,7 +113,7 @@ let layout_visitor | Il.CodeTy -> true | Il.NilTy -> false in - rt_in_mem (slot_referent_type cx.ctxt_abi slot) + rt_in_mem (slot_referent_type cx.ctxt_abi.Abi.abi_word_bits slot) in let rty_sz rty = Il.referent_ty_size cx.ctxt_abi.Abi.abi_word_bits rty in @@ -142,7 +142,7 @@ let layout_visitor : unit = let accum (off,align) id : (size * size) = let slot = get_slot cx id in - let rt = slot_referent_type cx.ctxt_abi slot in + let rt = slot_referent_type cx.ctxt_abi.Abi.abi_word_bits slot in let (elt_size, elt_align) = rty_layout rt in if vregs_ok && (is_subword_size elt_size) @@ -170,7 +170,9 @@ let layout_visitor then elt_off else neg_sz (add_sz elt_off elt_size) in - Stack.push (slot_referent_type cx.ctxt_abi slot) slot_accum; + Stack.push + (slot_referent_type cx.ctxt_abi.Abi.abi_word_bits slot) + slot_accum; iflog begin fun _ -> @@ -400,7 +402,7 @@ let layout_visitor let callees = match s.node with Ast.STMT_call (_, lv, _) - | Ast.STMT_spawn (_, _, lv, _) -> [| lv |] + | Ast.STMT_spawn (_, _, _, lv, _) -> [| lv |] | Ast.STMT_check (_, calls) -> Array.map (fun (lv, _) -> lv) calls | _ -> [| |] in diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml index bf11ad23..25eb544a 100644 --- a/src/boot/me/resolve.ml +++ b/src/boot/me/resolve.ml @@ -48,6 +48,7 @@ let stmt_collecting_visitor : Walk.visitor = let block_ids = Stack.create () in let visit_block_pre (b:Ast.block) = + htab_put cx.ctxt_all_blocks b.id b.node; Stack.push b.id block_ids; inner.Walk.visit_block_pre b in diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml index bcaec2b4..7d1b21ef 100644 --- a/src/boot/me/semant.ml +++ b/src/boot/me/semant.ml @@ -98,6 +98,7 @@ type ctxt = ctxt_all_cast_types: (node_id,Ast.ty) Hashtbl.t; ctxt_all_type_items: (node_id,Ast.ty) Hashtbl.t; ctxt_all_stmts: (node_id,Ast.stmt) Hashtbl.t; + ctxt_all_blocks: (node_id,Ast.block') Hashtbl.t; ctxt_item_files: (node_id,filename) Hashtbl.t; ctxt_all_lvals: (node_id,Ast.lval) Hashtbl.t; ctxt_call_lval_params: (node_id,Ast.ty array) Hashtbl.t; @@ -183,6 +184,7 @@ let new_ctxt sess abi crate = ctxt_all_cast_types = Hashtbl.create 0; ctxt_all_type_items = Hashtbl.create 0; ctxt_all_stmts = Hashtbl.create 0; + ctxt_all_blocks = Hashtbl.create 0; ctxt_item_files = crate.Ast.crate_files; ctxt_all_lvals = Hashtbl.create 0; ctxt_all_defns = Hashtbl.create 0; @@ -1012,7 +1014,8 @@ let type_is_unsigned_2s_complement t = | Ast.TY_mach TY_u64 | Ast.TY_char | Ast.TY_uint - | Ast.TY_bool -> true + | Ast.TY_bool + | Ast.TY_native _ -> true | _ -> false ;; @@ -1822,24 +1825,24 @@ let run_passes (* Rust type -> IL type conversion. *) -let word_sty (abi:Abi.abi) : Il.scalar_ty = - Il.ValTy abi.Abi.abi_word_bits +let word_sty (word_bits:Il.bits) : Il.scalar_ty = + Il.ValTy word_bits ;; -let word_rty (abi:Abi.abi) : Il.referent_ty = - Il.ScalarTy (word_sty abi) +let word_rty (word_bits:Il.bits) : Il.referent_ty = + Il.ScalarTy (word_sty word_bits) ;; -let tydesc_rty (abi:Abi.abi) : Il.referent_ty = +let tydesc_rty (word_bits:Il.bits) : Il.referent_ty = (* * NB: must match corresponding tydesc structure * in trans and offsets in ABI exactly. *) Il.StructTy [| - word_rty abi; (* Abi.tydesc_field_first_param *) - word_rty abi; (* Abi.tydesc_field_size *) - word_rty abi; (* Abi.tydesc_field_align *) + word_rty word_bits; (* Abi.tydesc_field_first_param *) + word_rty word_bits; (* Abi.tydesc_field_size *) + word_rty word_bits; (* Abi.tydesc_field_align *) 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 *) @@ -1849,29 +1852,29 @@ let tydesc_rty (abi:Abi.abi) : Il.referent_ty = |] ;; -let obj_closure_rty (abi:Abi.abi) : Il.referent_ty = +let obj_closure_rty (word_bits:Il.bits) : Il.referent_ty = Il.StructTy [| - word_rty abi; + word_rty word_bits; Il.StructTy [| - Il.ScalarTy (Il.AddrTy (tydesc_rty abi)); - word_rty abi (* A lie: it's opaque, but this permits - * GEP'ing to it. *) + Il.ScalarTy (Il.AddrTy (tydesc_rty word_bits)); + word_rty word_bits (* A lie: it's opaque, but this permits + * GEP'ing to it. *) |] |] ;; -let rec referent_type (abi:Abi.abi) (t:Ast.ty) : Il.referent_ty = +let rec referent_type (word_bits:Il.bits) (t:Ast.ty) : Il.referent_ty = let s t = Il.ScalarTy t in let v b = Il.ValTy b in let p t = Il.AddrTy t in let sv b = s (v b) in let sp t = s (p t) in - let word = word_rty abi in + let word = word_rty word_bits in let ptr = sp Il.OpaqueTy in let rc_ptr = sp (Il.StructTy [| word; Il.OpaqueTy |]) in let codeptr = sp Il.CodeTy in - let tup ttup = Il.StructTy (Array.map (referent_type abi) ttup) in + let tup ttup = Il.StructTy (Array.map (referent_type word_bits) ttup) in let tag ttag = let union = Il.UnionTy @@ -1916,7 +1919,7 @@ let rec referent_type (abi:Abi.abi) (t:Ast.ty) : Il.referent_ty = Il.StructTy [| codeptr; fn_closure_ptr |] | Ast.TY_obj _ -> - let obj_closure_ptr = sp (obj_closure_rty abi) in + let obj_closure_ptr = sp (obj_closure_rty word_bits) in Il.StructTy [| ptr; obj_closure_ptr |] | Ast.TY_tag ttag -> tag ttag @@ -1928,26 +1931,26 @@ let rec referent_type (abi:Abi.abi) (t:Ast.ty) : Il.referent_ty = | Ast.TY_port _ | Ast.TY_task -> rc_ptr - | Ast.TY_type -> sp (tydesc_rty abi) + | Ast.TY_type -> sp (tydesc_rty word_bits) | Ast.TY_native _ -> ptr | Ast.TY_box t -> - sp (Il.StructTy [| word; referent_type abi t |]) + sp (Il.StructTy [| word; referent_type word_bits t |]) - | Ast.TY_mutable t -> referent_type abi t + | Ast.TY_mutable t -> referent_type word_bits t | Ast.TY_param (i, _) -> Il.ParamTy i | Ast.TY_named _ -> bug () "named type in referent_type" - | Ast.TY_constrained (t, _) -> referent_type abi t + | Ast.TY_constrained (t, _) -> referent_type word_bits t -and slot_referent_type (abi:Abi.abi) (sl:Ast.slot) : Il.referent_ty = +and slot_referent_type (word_bits:Il.bits) (sl:Ast.slot) : Il.referent_ty = let s t = Il.ScalarTy t in let p t = Il.AddrTy t in let sp t = s (p t) in - let rty = referent_type abi (slot_ty sl) in + let rty = referent_type word_bits (slot_ty sl) in match sl.Ast.slot_mode with | Ast.MODE_local -> rty | Ast.MODE_alias -> sp rty @@ -1958,7 +1961,7 @@ let task_rty (abi:Abi.abi) : Il.referent_ty = begin Array.init Abi.n_visible_task_fields - (fun _ -> word_rty abi) + (fun _ -> word_rty abi.Abi.abi_word_bits) end ;; @@ -1970,14 +1973,17 @@ let call_args_referent_type_full (iterator_arg_rtys:Il.referent_ty array) (indirect_arg_rtys:Il.referent_ty array) : Il.referent_ty = - let out_slot_rty = slot_referent_type abi out_slot in + let out_slot_rty = slot_referent_type abi.Abi.abi_word_bits out_slot in let out_ptr_rty = Il.ScalarTy (Il.AddrTy out_slot_rty) in let task_ptr_rty = Il.ScalarTy (Il.AddrTy (task_rty abi)) in let ty_param_rtys = - let td = Il.ScalarTy (Il.AddrTy (tydesc_rty abi)) in + let td = Il.ScalarTy (Il.AddrTy (tydesc_rty abi.Abi.abi_word_bits)) in Il.StructTy (Array.init n_ty_params (fun _ -> td)) in - let arg_rtys = Il.StructTy (Array.map (slot_referent_type abi) in_slots) in + let arg_rtys = + Il.StructTy + (Array.map (slot_referent_type abi.Abi.abi_word_bits) in_slots) + in (* * NB: must match corresponding calltup structure in trans and * member indices in ABI exactly. @@ -2003,7 +2009,7 @@ let call_args_referent_type (* Abi.indirect_args_elt_closure *) match closure with None -> - [| word_rty cx.ctxt_abi |] + [| word_rty cx.ctxt_abi.Abi.abi_word_bits |] | Some c -> [| Il.ScalarTy (Il.AddrTy c) |] in @@ -2057,16 +2063,18 @@ let direct_call_args_referent_type ;; let ty_sz (abi:Abi.abi) (t:Ast.ty) : int64 = - force_sz (Il.referent_ty_size abi.Abi.abi_word_bits (referent_type abi t)) + let wb = abi.Abi.abi_word_bits in + force_sz (Il.referent_ty_size wb (referent_type wb t)) ;; let ty_align (abi:Abi.abi) (t:Ast.ty) : int64 = - force_sz (Il.referent_ty_align abi.Abi.abi_word_bits (referent_type abi t)) + let wb = abi.Abi.abi_word_bits in + force_sz (Il.referent_ty_align wb (referent_type wb t)) ;; let slot_sz (abi:Abi.abi) (s:Ast.slot) : int64 = - force_sz (Il.referent_ty_size abi.Abi.abi_word_bits - (slot_referent_type abi s)) + let wb = abi.Abi.abi_word_bits in + force_sz (Il.referent_ty_size wb (slot_referent_type wb s)) ;; let word_slot (abi:Abi.abi) : Ast.slot = diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml index b708bb26..03174b0a 100644 --- a/src/boot/me/trans.ml +++ b/src/boot/me/trans.ml @@ -88,6 +88,7 @@ let trans_visitor let zero = imm 0L in let imm_true = imm_of_ty 1L TY_u8 in let imm_false = imm_of_ty 0L TY_u8 in + let zero_byte = imm_of_ty 0L TY_u8 in let nil_ptr = Il.Mem ((Il.Abs (Asm.IMM 0L)), Il.NilTy) in let wordptr_ty = Il.AddrTy (Il.ScalarTy word_sty) in @@ -181,7 +182,7 @@ let trans_visitor match q with Il.Jmp _ -> flush_emitter_size_cache(); | _ -> () - end; + end; Il.emit (emitter()) q in @@ -292,7 +293,7 @@ let trans_visitor in let ptr_at (mem:Il.mem) (pointee_ty:Ast.ty) : Il.cell = - rty_ptr_at mem (referent_type abi pointee_ty) + rty_ptr_at mem (referent_type word_bits pointee_ty) in let need_scalar_ty (rty:Il.referent_ty) : Il.scalar_ty = @@ -330,11 +331,7 @@ let trans_visitor (cell_str mem_cell) in - let rec ptr_cast (cell:Il.cell) (rty:Il.referent_ty) : Il.cell = - match cell with - Il.Mem (mem, _) -> Il.Mem (mem, rty) - | Il.Reg (reg, Il.AddrTy _) -> Il.Reg (reg, Il.AddrTy rty) - | _ -> bug () "expected address cell in Trans.ptr_cast" + let rec ptr_cast = Il.ptr_cast and curr_crate_ptr _ : Il.cell = word_at (fp_imm frame_crate_ptr) @@ -453,13 +450,22 @@ let trans_visitor in let slot_id_referent_type (slot_id:node_id) : Il.referent_ty = - slot_referent_type abi (get_slot cx slot_id) + slot_referent_type word_bits (get_slot cx slot_id) in let caller_args_cell (args_rty:Il.referent_ty) : Il.cell = Il.Mem (fp_imm out_mem_disp, args_rty) in + let get_obj_box_from_calltup (args_cell:Il.cell) = + let indirect_args = + get_element_ptr args_cell Abi.calltup_elt_indirect_args + in + deref (ptr_cast + (get_element_ptr indirect_args Abi.indirect_args_elt_closure) + (Il.ScalarTy (Il.AddrTy (obj_closure_rty word_bits)))) + in + let fp_to_args (fp:Il.cell) (args_rty:Il.referent_ty): Il.cell = let (reg, _) = force_to_reg (Il.Cell fp) in Il.Mem(based_imm reg out_mem_disp, args_rty) @@ -469,11 +475,43 @@ let trans_visitor get_element_ptr ty_params param_idx in - let get_ty_params_of_frame (fp:Il.reg) (n_params:int) : Il.cell = - let fn_ty = mk_simple_ty_fn [| |] in - let fn_rty = call_args_referent_type cx n_params fn_ty None in - let args_cell = Il.Mem (based_imm fp out_mem_disp, fn_rty) in - get_element_ptr args_cell Abi.calltup_elt_ty_params + let get_ty_params_of_frame + (fnid:node_id) + (fp:Il.reg) + (n_ty_params:int) + : Il.cell = + + let fn_ty = mk_simple_ty_fn [| |] in + let fn_rty = + call_args_referent_type cx n_ty_params fn_ty (Some Il.OpaqueTy) + in + let args_cell = Il.Mem (based_imm fp out_mem_disp, fn_rty) in + + if defn_id_is_obj_fn_or_drop cx fnid + then + (* + * To get the typarams in an obj fn, we must go to the + * implicit obj's captured type descriptor. + *) + let obj_box = + get_obj_box_from_calltup args_cell + in + let obj = get_element_ptr obj_box Abi.box_rc_field_body in + let tydesc = get_element_ptr obj Abi.obj_body_elt_tydesc in + let ty_params_ty = Ast.TY_tup (make_tydesc_tys n_ty_params) in + let ty_params_rty = referent_type word_bits ty_params_ty in + let ty_params = + get_element_ptr (deref tydesc) Abi.tydesc_field_first_param + in + let ty_params = + ptr_cast ty_params (Il.ScalarTy (Il.AddrTy ty_params_rty)) + in + deref ty_params + else + (* + * Regular function --- typarams are right in the frame calltup. + *) + get_element_ptr args_cell Abi.calltup_elt_ty_params in let get_args_for_current_frame _ = @@ -520,34 +558,10 @@ let trans_visitor Abi.iterator_args_elt_outer_frame_ptr in - let get_obj_for_current_frame _ = - deref (ptr_cast - (get_closure_for_current_frame ()) - (Il.ScalarTy (Il.AddrTy (obj_closure_rty abi)))) - in - let get_ty_params_of_current_frame _ : Il.cell = - let id = current_fn() in - let n_ty_params = n_item_ty_params cx id in - if defn_id_is_obj_fn_or_drop cx id - then - begin - let obj_box = get_obj_for_current_frame() in - let obj = get_element_ptr obj_box Abi.box_rc_field_body in - let tydesc = get_element_ptr obj Abi.obj_body_elt_tydesc in - let ty_params_ty = Ast.TY_tup (make_tydesc_tys n_ty_params) in - let ty_params_rty = referent_type abi ty_params_ty in - let ty_params = - get_element_ptr (deref tydesc) Abi.tydesc_field_first_param - in - let ty_params = - ptr_cast ty_params (Il.ScalarTy (Il.AddrTy ty_params_rty)) - in - deref ty_params - end - - else - get_ty_params_of_frame abi.Abi.abi_fp_reg n_ty_params + let fnid = current_fn() in + let n_ty_params = n_item_ty_params cx fnid in + get_ty_params_of_frame fnid abi.Abi.abi_fp_reg n_ty_params in let get_ty_param_in_current_frame (param_idx:int) : Il.cell = @@ -721,7 +735,7 @@ let trans_visitor in let ty_sz_in_current_frame (ty:Ast.ty) : Il.operand = - let rty = referent_type abi ty in + let rty = referent_type word_bits ty in let sz = Il.referent_ty_size word_bits rty in calculate_sz_in_current_frame sz in @@ -730,7 +744,7 @@ let trans_visitor (ty_params:Il.cell) (ty:Ast.ty) : Il.operand = - let rty = referent_type abi ty in + let rty = referent_type word_bits ty in let sz = Il.referent_ty_size word_bits rty in calculate_sz ty_params sz in @@ -931,7 +945,7 @@ let trans_visitor mov idx atop; emit (Il.binary Il.UMUL idx (Il.Cell idx) unit_sz); let elt_mem = trans_bounds_check (deref cell) (Il.Cell idx) in - (Il.Mem (elt_mem, referent_type abi ty), ty) + (Il.Mem (elt_mem, referent_type word_bits ty), ty) in (* * All lval components aside from explicit-deref just auto-deref @@ -1120,7 +1134,7 @@ let trans_visitor and trans_static_string (s:string) : Il.operand = Il.Cell (crate_rel_to_ptr (trans_crate_rel_static_string_operand s) - (referent_type abi Ast.TY_str)) + (referent_type word_bits Ast.TY_str)) and get_static_tydesc (idopt:node_id option) @@ -1226,7 +1240,7 @@ let trans_visitor let fty = Hashtbl.find (snd caller) ident in let self_args_rty = call_args_referent_type cx 0 - (Ast.TY_fn fty) (Some (obj_closure_rty abi)) + (Ast.TY_fn fty) (Some (obj_closure_rty word_bits)) in let callsz = Il.referent_ty_size word_bits self_args_rty in let spill = new_fixup "forwarding fn spill" in @@ -1394,7 +1408,7 @@ let trans_visitor push_new_emitter_with_vregs None; iflog (fun _ -> annotate "prologue"); abi.Abi.abi_emit_fn_prologue (emitter()) - framesz callsz nabi_rust (upcall_fixup "upcall_grow_task"); + framesz callsz nabi_rust (upcall_fixup "upcall_grow_task") false; write_frame_info_ptrs None; (* FIXME: not clear why, but checking interrupt in glue context * causes many.rs to crash when run on a sufficiently large number @@ -1473,8 +1487,8 @@ let trans_visitor (* FIXME (issue #5): mutability flag *) : Il.referent_ty = let rc = Il.ScalarTy word_sty in - let targ = referent_type abi (mk_simple_ty_fn [||]) in - let bindings = Array.map (slot_referent_type abi) bs in + let targ = referent_type word_bits (mk_simple_ty_fn [||]) in + let bindings = Array.map (slot_referent_type word_bits) bs in Il.StructTy [| rc; targ; Il.StructTy bindings |] (* FIXME (issue #2): this should eventually use tail calling logic *) @@ -2128,10 +2142,12 @@ let trans_visitor ((*initializing*)_:bool) (dst:Ast.lval) (domain:Ast.domain) + (name:string) (fn_lval:Ast.lval) (args:Ast.atom array) : unit = let (task_cell, _) = trans_lval_init dst in + let runtime_name = trans_static_string name in let (fptr_operand, fn_ty) = trans_callee fn_lval in (*let fn_ty_params = [| |] in*) let _ = @@ -2165,7 +2181,7 @@ let trans_visitor match domain with Ast.DOMAIN_thread -> begin - trans_upcall "upcall_new_thread" new_task [| |]; + trans_upcall "upcall_new_thread" new_task [| runtime_name |]; copy_fn_args false true (CLONE_all new_task) call; trans_upcall "upcall_start_thread" task_cell [| @@ -2177,7 +2193,7 @@ let trans_visitor end | _ -> begin - trans_upcall "upcall_new_task" new_task [| |]; + trans_upcall "upcall_new_task" new_task [| runtime_name |]; copy_fn_args false true (CLONE_chan new_task) call; trans_upcall "upcall_start_task" task_cell [| @@ -2243,8 +2259,17 @@ let trans_visitor trans_void_upcall "upcall_join" [| trans_atom (Ast.ATOM_lval task) |] and trans_send (chan:Ast.lval) (src:Ast.lval) : unit = - let (srccell, _) = trans_lval src in - aliasing false srccell + let (src_cell, src_ty) = trans_lval src in + begin + match (ty_mem_ctrl src_ty) with + | MEM_rc_opaque + | MEM_rc_struct + | MEM_gc -> + iflog (fun _ -> annotate "incr_refcount of src obj"); + incr_refcount src_cell; + | _ -> () + end; + aliasing false src_cell begin fun src_alias -> trans_void_upcall "upcall_send" @@ -2331,7 +2356,7 @@ let trans_visitor (get_element_ptr_dyn_in_current_frame vec Abi.vec_elt_data)) in - let unit_rty = referent_type abi unit_ty in + let unit_rty = referent_type word_bits unit_ty in let body_rty = Il.StructTy (Array.map (fun _ -> unit_rty) atoms) in let body = Il.Mem (body_mem, body_rty) in Array.iteri @@ -2377,12 +2402,12 @@ let trans_visitor let root_desc = Il.Cell (crate_rel_to_ptr (get_static_tydesc idopt t 0L 0L force_stateful) - (tydesc_rty abi)) + (tydesc_rty word_bits)) in let (t, param_descs) = linearize_ty_params t in let descs = Array.append [| root_desc |] param_descs in let n = Array.length descs in - let rty = referent_type abi t in + let rty = referent_type word_bits t in let (size_sz, align_sz) = Il.referent_ty_layout word_bits rty in let size = calculate_sz_in_current_frame size_sz in let align = calculate_sz_in_current_frame align_sz in @@ -2418,7 +2443,7 @@ let trans_visitor (ty_sz abi ty) (ty_align abi ty) mut) - (tydesc_rty abi)) + (tydesc_rty word_bits)) and box_rc_cell (cell:Il.cell) : Il.cell = get_element_ptr (deref cell) Abi.box_rc_field_refcnt @@ -2435,7 +2460,7 @@ let trans_visitor in let ty = simplified_ty ty in let refty_sz = - Il.referent_ty_size abi.Abi.abi_word_bits (referent_type abi ty) + Il.referent_ty_size abi.Abi.abi_word_bits (referent_type word_bits ty) in match refty_sz with SIZE_fixed _ -> imm (Int64.add (ty_sz abi ty) header_sz) @@ -2532,7 +2557,7 @@ let trans_visitor trans_compare_simple Il.JAE (Il.Cell ptr) (Il.Cell lim) in let unit_cell = - deref (ptr_cast ptr (referent_type abi unit_ty)) + deref (ptr_cast ptr (referent_type word_bits unit_ty)) in f unit_cell unit_cell unit_ty curr_iso; add_to ptr unit_sz; @@ -2932,6 +2957,7 @@ let trans_visitor (slot:Ast.slot) (curr_iso:Ast.ty_iso option) : unit = + check_and_flush_chan cell slot; drop_slot (get_ty_params_of_current_frame()) cell slot curr_iso and drop_ty_in_current_frame @@ -4188,6 +4214,25 @@ let trans_visitor let last_jumps = Array.map trans_arm at.Ast.alt_tag_arms in Array.iter patch last_jumps + (* If we're about to drop a channel, synthesize an upcall_flush_chan. + * TODO: This should rather appear in a chan dtor when chans become + * objects. *) + and check_and_flush_chan + (cell:Il.cell) + (slot:Ast.slot) + : unit = + let ty = strip_mutable_or_constrained_ty (slot_ty slot) in + match simplified_ty ty with + Ast.TY_chan _ -> + annotate "check_and_flush_chan, flush_chan"; + let rc = box_rc_cell cell in + emit (Il.cmp (Il.Cell rc) one); + let jump = mark () in + emit (Il.jmp Il.JNE Il.CodeNone); + trans_void_upcall "upcall_flush_chan" [| Il.Cell cell |]; + patch jump; + | _ -> () + and drop_slots_at_curr_stmt _ : unit = let stmt = Stack.top curr_stmt in match htab_search cx.ctxt_post_stmt_slot_drops stmt with @@ -4290,7 +4335,7 @@ let trans_visitor push_new_emitter_with_vregs (Some id); iflog (fun _ -> annotate "prologue"); abi.Abi.abi_emit_fn_prologue (emitter()) - framesz callsz nabi_rust (upcall_fixup "upcall_grow_task"); + framesz callsz nabi_rust (upcall_fixup "upcall_grow_task") false; write_frame_info_ptrs None; iflog (fun _ -> annotate "finished prologue"); trans_block fe.Ast.for_each_body; @@ -4345,18 +4390,18 @@ let trans_visitor (src_ty:Ast.ty) : unit = let elt_ty = seq_unit_ty dst_ty in - let trim_trailing_null = dst_ty = Ast.TY_str in - assert (simplified_ty src_ty = simplified_ty dst_ty); - match simplified_ty src_ty with - Ast.TY_str - | Ast.TY_vec _ -> + let trailing_null = simplified_ty dst_ty = Ast.TY_str in + match (simplified_ty dst_ty, simplified_ty src_ty) with + (Ast.TY_str, Ast.TY_str) + | (Ast.TY_vec _, Ast.TY_vec _) + when (simplified_ty dst_ty) = (simplified_ty src_ty) -> let is_gc = if type_has_state src_ty then 1L else 0L in let src_cell = need_cell src_oper in let src_vec = deref src_cell in let src_fill = get_element_ptr src_vec Abi.vec_elt_fill in let dst_vec = deref dst_cell in let dst_fill = get_element_ptr dst_vec Abi.vec_elt_fill in - if trim_trailing_null + if trailing_null then sub_from dst_fill (imm 1L); trans_upcall "upcall_vec_grow" dst_cell @@ -4374,7 +4419,7 @@ let trans_visitor let dst_fill = get_element_ptr dst_vec Abi.vec_elt_fill in (* Copy loop: *) - let eltp_rty = Il.AddrTy (referent_type abi elt_ty) in + let eltp_rty = Il.AddrTy (referent_type word_bits elt_ty) in let dptr = next_vreg_cell eltp_rty in let sptr = next_vreg_cell eltp_rty in let dlim = next_vreg_cell eltp_rty in @@ -4413,9 +4458,53 @@ let trans_visitor let v = next_vreg_cell word_sty in mov v (Il.Cell src_fill); add_to dst_fill (Il.Cell v); - | t -> + + | (Ast.TY_str, e) + | (Ast.TY_vec _, e) + when e = simplified_ty elt_ty -> + + let dst_is_gc = if type_has_state dst_ty then 1L else 0L in + let elt_sz = ty_sz_in_current_frame elt_ty in + trans_upcall "upcall_vec_grow" + dst_cell + [| Il.Cell dst_cell; + elt_sz; + imm dst_is_gc |]; + + (* + * By now, dst_cell points to a vec/str with room for us + * to add to. + *) + + (* Reload dst vec, fill; might have changed. *) + let dst_vec = deref dst_cell in + let dst_fill = get_element_ptr dst_vec Abi.vec_elt_fill in + + let eltp_rty = Il.AddrTy (referent_type word_bits elt_ty) in + let dptr = next_vreg_cell eltp_rty in + let dst_data = + get_element_ptr_dyn_in_current_frame + dst_vec Abi.vec_elt_data + in + lea dptr (fst (need_mem_cell dst_data)); + add_to dptr (Il.Cell dst_fill); + if trailing_null + then sub_from dptr elt_sz; + trans_copy_ty + (get_ty_params_of_current_frame()) true + (deref dptr) elt_ty + (Il.Mem (force_to_mem src_oper)) elt_ty + None; + add_to dptr elt_sz; + if trailing_null + then mov (deref dptr) zero_byte; + add_to dst_fill elt_sz; + + | _ -> begin - bug () "unsupported vector-append type %a" Ast.sprintf_ty t + bug () "unsupported vector-append types %a += %a" + Ast.sprintf_ty dst_ty + Ast.sprintf_ty src_ty end @@ -4496,8 +4585,9 @@ let trans_visitor | Ast.STMT_send (chan,src) -> trans_send chan src - | Ast.STMT_spawn (dst, domain, plv, args) -> - trans_spawn (maybe_init stmt.id "spawn" dst) dst domain plv args + | Ast.STMT_spawn (dst, domain, name, plv, args) -> + trans_spawn (maybe_init stmt.id "spawn" dst) dst + domain name plv args | Ast.STMT_recv (dst, chan) -> trans_recv (maybe_init stmt.id "recv" dst) dst chan @@ -4693,6 +4783,8 @@ let trans_visitor let get_frame_glue glue inner = get_mem_glue glue begin + (* `mem` here is a pointer to the frame we are marking, dropping, + or relocing, etc. *) fun mem -> iter_frame_and_arg_slots cx fnid begin @@ -4700,10 +4792,19 @@ let trans_visitor match htab_search cx.ctxt_slot_offsets slot_id with Some off when not (slot_is_obj_state cx slot_id) -> let referent_type = slot_id_referent_type slot_id in + (* + * This might look as though we're always taking the + * pointer-to-frame and giving it the type of the + * frame/arg of interest, but this is because our + * deref_off a few lines later takes the referent + * type of the given poiinter (`st`) as the referent + * type of the mem-offset-from-the-given-pointer + * that it returns. + *) let fp_cell = rty_ptr_at mem referent_type in let (fp, st) = force_to_reg (Il.Cell fp_cell) in let ty_params = - get_ty_params_of_frame fp n_ty_params + get_ty_params_of_frame fnid fp n_ty_params in let slot_cell = deref_off_sz ty_params (Il.Reg (fp,st)) off @@ -4751,7 +4852,7 @@ let trans_visitor end in - let trans_frame_entry (fnid:node_id) : unit = + let trans_frame_entry (fnid:node_id) (obj_fn:bool) : unit = let framesz = get_framesz cx fnid in let callsz = get_callsz cx fnid in Stack.push (Stack.create()) epilogue_jumps; @@ -4765,7 +4866,7 @@ let trans_visitor (string_of_size callsz))); abi.Abi.abi_emit_fn_prologue (emitter()) framesz callsz nabi_rust - (upcall_fixup "upcall_grow_task"); + (upcall_fixup "upcall_grow_task") obj_fn; write_frame_info_ptrs (Some fnid); check_interrupt_flag (); @@ -4789,8 +4890,9 @@ let trans_visitor let trans_fn (fnid:node_id) (body:Ast.block) + (obj_fn:bool) : unit = - trans_frame_entry fnid; + trans_frame_entry fnid obj_fn; trans_block body; trans_frame_exit fnid true; in @@ -4799,7 +4901,7 @@ let trans_visitor (obj_id:node_id) (header:Ast.header_slots) : unit = - trans_frame_entry obj_id; + trans_frame_entry obj_id true; let all_args_rty = current_fn_args_rty None in let all_args_cell = caller_args_cell all_args_rty in @@ -4818,7 +4920,7 @@ let trans_visitor let obj_args_ty = Ast.TY_tup obj_args_tup in let state_ty = Ast.TY_tup [| Ast.TY_type; obj_args_ty |] in let state_ptr_ty = Ast.TY_box state_ty in - let state_ptr_rty = referent_type abi state_ptr_ty in + let state_ptr_rty = referent_type word_bits state_ptr_ty in let state_malloc_sz = box_allocation_size state_ptr_ty in let ctor_ty = Hashtbl.find cx.ctxt_all_item_types obj_id in @@ -4920,7 +5022,7 @@ let trans_visitor in let trans_required_fn (fnid:node_id) (blockid:node_id) : unit = - trans_frame_entry fnid; + trans_frame_entry fnid false; emit (Il.Enter (Hashtbl.find cx.ctxt_block_fixups blockid)); let (ilib, conv) = Hashtbl.find cx.ctxt_required_items fnid in let lib_num = @@ -5058,7 +5160,7 @@ let trans_visitor (tagid:node_id) (tag:(Ast.header_tup * Ast.ty_tag * node_id)) : unit = - trans_frame_entry tagid; + trans_frame_entry tagid false; trace_str cx.ctxt_sess.Session.sess_trace_tag ("in tag constructor " ^ n); let (header_tup, _, _) = tag in @@ -5121,7 +5223,7 @@ let trans_visitor iflog (fun _ -> log cx "translating defined item #%d = %s" (int_of_node i.id) (path_name())); match i.node.Ast.decl_item with - Ast.MOD_ITEM_fn f -> trans_fn i.id f.Ast.fn_body + Ast.MOD_ITEM_fn f -> trans_fn i.id f.Ast.fn_body false | Ast.MOD_ITEM_tag t -> trans_tag n i.id t | Ast.MOD_ITEM_obj ob -> trans_obj_ctor i.id @@ -5155,7 +5257,7 @@ let trans_visitor push_new_emitter_with_vregs (Some b.id); iflog (fun _ -> annotate "prologue"); abi.Abi.abi_emit_fn_prologue (emitter()) - framesz callsz nabi_rust (upcall_fixup "upcall_grow_task"); + framesz callsz nabi_rust (upcall_fixup "upcall_grow_task") true; write_frame_info_ptrs None; iflog (fun _ -> annotate "finished prologue"); trans_block b; @@ -5165,7 +5267,7 @@ let trans_visitor in let visit_defined_obj_fn_pre _ _ fn = - trans_fn fn.id fn.node.Ast.fn_body + trans_fn fn.id fn.node.Ast.fn_body true in let visit_required_obj_fn_pre _ _ _ = diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml index 23210ea1..17a4b38f 100644 --- a/src/boot/me/type.ml +++ b/src/boot/me/type.ml @@ -101,11 +101,11 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) = if not (is_integer (fundamental_ty actual)) then type_error "integer" actual in - let demand_bool_or_char_or_integer (actual:Ast.ty) : unit = + let demand_bool_or_char_or_integer_or_native (actual:Ast.ty) : unit = match fundamental_ty actual with - Ast.TY_bool | Ast.TY_char -> () + Ast.TY_bool | Ast.TY_char | Ast.TY_native _ -> () | ty when is_integer ty -> () - | _ -> type_error "bool, char, or integer" actual + | _ -> type_error "bool, char, integer or native" actual in let demand_number (actual:Ast.ty) : unit = match fundamental_ty actual with @@ -634,9 +634,11 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) = ty | Ast.EXPR_unary (Ast.UNOP_cast dst_ty_id, atom) -> (* TODO: probably we want to handle more cases here *) - demand_bool_or_char_or_integer (check_atom atom); - let dst_ty = dst_ty_id.Common.node in - demand_bool_or_char_or_integer dst_ty; + demand_bool_or_char_or_integer_or_native (check_atom atom); + let dst_ty = + Hashtbl.find cx.Semant.ctxt_all_cast_types dst_ty_id.Common.id + in + demand_bool_or_char_or_integer_or_native dst_ty; dst_ty in @@ -692,7 +694,7 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) = and check_stmt (stmt:Ast.stmt) : unit = check_ret stmt; match stmt.Common.node with - Ast.STMT_spawn (dst, _, callee, args) -> + Ast.STMT_spawn (dst, _, _, callee, args) -> infer_lval Ast.TY_task dst; demand Ast.TY_nil (check_fn callee args) @@ -761,6 +763,27 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) = | Ast.STMT_copy (dst, src) -> infer_lval (check_expr src) dst + | Ast.STMT_copy_binop (dst, Ast.BINOP_add, src) -> + begin + let src_ty = check_atom ~deref:true src in + let dst_ty = check_lval dst in + match fundamental_ty dst_ty, fundamental_ty src_ty with + Ast.TY_vec elt1, Ast.TY_vec elt2 + | Ast.TY_vec elt1, elt2 -> + if elt1 = elt2 + then () + else + Common.err None + "mismatched types in vec-append: %a += %a" + Ast.sprintf_ty dst_ty + Ast.sprintf_ty src_ty + | Ast.TY_str, (Ast.TY_mach Common.TY_u8) + | Ast.TY_str, Ast.TY_str -> () + | _ -> + infer_lval src_ty dst; + demand src_ty (check_binop Ast.BINOP_add src_ty) + end + | Ast.STMT_copy_binop (dst, binop, src) -> let ty = check_atom ~deref:true src in infer_lval ty dst; diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml index baf4a543..8f8d7179 100644 --- a/src/boot/me/typestate.ml +++ b/src/boot/me/typestate.ml @@ -664,7 +664,7 @@ let condition_assigning_visitor let precond = Array.append dst_init src_init in raise_pre_post_cond s.id precond; - | Ast.STMT_spawn (dst, _, lv, args) + | Ast.STMT_spawn (dst, _, _, lv, args) | Ast.STMT_call (dst, lv, args) -> raise_dst_init_precond_if_writing_through s.id dst; visit_callable_pre s.id (lval_slots cx dst) lv args @@ -697,7 +697,8 @@ let condition_assigning_visitor | Ast.STMT_while sw -> let (_, expr) = sw.Ast.while_lval in let precond = slot_inits (expr_slots cx expr) in - raise_pre_post_cond s.id precond + raise_precondition sw.Ast.while_body.id precond; + raise_postcondition sw.Ast.while_body.id precond | Ast.STMT_alt_tag at -> let precond = slot_inits (lval_slots cx at.Ast.alt_tag_lval) in @@ -947,16 +948,17 @@ let graph_special_block_structure_building_visitor let ts = tables () in let graph = ts.ts_graph in let cond_id = s.id in + let succ = Hashtbl.find graph cond_id in let then_id = sif.Ast.if_then.id in let then_end_id = last_id_or_block_id sif.Ast.if_then in let show_node = show_node cx graph in + let succ = List.filter (fun x -> not (x = then_id)) succ in show_node "initial cond" cond_id; show_node "initial then" then_id; show_node "initial then_end" then_end_id; begin match sif.Ast.if_else with None -> - let succ = Hashtbl.find graph then_end_id in Hashtbl.replace graph cond_id (then_id :: succ); (* Kill residual messed-up block wiring.*) remove_flow_edges graph then_end_id [then_id]; @@ -966,8 +968,10 @@ let graph_special_block_structure_building_visitor | Some e -> let else_id = e.id in + let succ = + List.filter (fun x -> not (x = else_id)) succ + in let else_end_id = last_id_or_block_id e in - let succ = Hashtbl.find graph else_end_id in show_node "initial else" else_id; show_node "initial else_end" else_end_id; Hashtbl.replace graph cond_id [then_id; else_id]; @@ -1049,19 +1053,23 @@ let graph_special_block_structure_building_visitor ;; let find_roots + (cx:ctxt) (graph:(node_id, (node_id list)) Hashtbl.t) : (node_id,unit) Hashtbl.t = let roots = Hashtbl.create 0 in Hashtbl.iter (fun src _ -> Hashtbl.replace roots src ()) graph; Hashtbl.iter (fun _ dsts -> List.iter (fun d -> Hashtbl.remove roots d) dsts) graph; + iflog cx + (fun _ -> Hashtbl.iter + (fun k _ -> log cx "root: %d" (int_of_node k)) roots); roots ;; let run_dataflow (cx:ctxt) (ts:typestate_tables) : unit = let graph = ts.ts_graph in let idref = ts.ts_maxid in - let roots = find_roots graph in + let roots = find_roots cx graph in let nodes = Queue.create () in let progress = ref true in @@ -1138,9 +1146,17 @@ let run_dataflow (cx:ctxt) (ts:typestate_tables) : unit = begin fun _ -> log cx "stmt %d: '%s'" (int_of_node node) - (match htab_search cx.ctxt_all_stmts node with - None -> "??" - | Some stmt -> Fmt.fmt_to_str Ast.fmt_stmt stmt); + begin + match htab_search cx.ctxt_all_stmts node with + None -> + begin + match htab_search cx.ctxt_all_blocks node with + None -> "??" + | Some b -> + Fmt.fmt_to_str Ast.fmt_block b + end + | Some stmt -> Fmt.fmt_to_str Ast.fmt_stmt stmt + end; log cx "stmt %d:" (int_of_node node); log cx " prestate %s" (fmt_constr_bitv prestate); @@ -1227,27 +1243,35 @@ let typestate_verify_visitor let tables _ = Stack.top tables_stack in - let visit_stmt_pre s = + let check_states id = let ts = tables () in - let prestate = Hashtbl.find ts.ts_prestates s.id in - let precond = Hashtbl.find ts.ts_preconditions s.id in + let prestate = Hashtbl.find ts.ts_prestates id in + let precond = Hashtbl.find ts.ts_preconditions id in List.iter (fun i -> if not (Bits.get prestate i) then let ckey = Hashtbl.find ts.ts_constrs (Constr i) in let constr_str = fmt_constr_key cx ckey in - err (Some s.id) - "Unsatisfied precondition constraint %s at stmt %d: %s" - constr_str - (int_of_node s.id) - (Fmt.fmt_to_str Ast.fmt_stmt - (Hashtbl.find cx.ctxt_all_stmts s.id))) - (Bits.to_list precond); - inner.Walk.visit_stmt_pre s + err (Some id) + "Unsatisfied precondition constraint %s" + constr_str) + (Bits.to_list precond) + in + + let visit_stmt_pre s = + check_states s.id; + inner.Walk.visit_stmt_pre s + in + + let visit_block_pre b = + check_states b.id; + inner.Walk.visit_block_pre b in + { inner with - Walk.visit_stmt_pre = visit_stmt_pre } + Walk.visit_stmt_pre = visit_stmt_pre; + Walk.visit_block_pre = visit_block_pre } ;; let lifecycle_visitor @@ -1350,7 +1374,7 @@ let lifecycle_visitor match s.node with Ast.STMT_copy (lv_dst, _) | Ast.STMT_call (lv_dst, _, _) - | Ast.STMT_spawn (lv_dst, _, _, _) + | Ast.STMT_spawn (lv_dst, _, _, _, _) | Ast.STMT_recv (lv_dst, _) | Ast.STMT_bind (lv_dst, _, _) | Ast.STMT_new_rec (lv_dst, _, _) diff --git a/src/boot/me/walk.ml b/src/boot/me/walk.ml index 0e65406a..cadfd66b 100644 --- a/src/boot/me/walk.ml +++ b/src/boot/me/walk.ml @@ -451,7 +451,7 @@ and walk_stmt walk_lval v f; Array.iter (walk_opt_atom v) az - | Ast.STMT_spawn (dst,_,p,az) -> + | Ast.STMT_spawn (dst,_,_,p,az) -> walk_lval v dst; walk_lval v p; Array.iter (walk_atom v) az |