7 let log cx = Session.log "trans"
8 cx.ctxt_sess.Session.sess_log_trans
9 cx.ctxt_sess.Session.sess_log_out
12 let arr_max a = (Array.length a) - 1;;
20 call_callee_ptr: Il.operand;
21 call_callee_ty: Ast.ty;
22 call_callee_ty_params: Ast.ty array;
24 call_args: Ast.atom array;
25 call_iterator_args: Il.operand array;
26 call_indirect_args: Il.operand array;
31 match simplified_ty ty with
33 | _ -> bug () "need fn"
36 let call_output_slot call =
37 (fst (need_ty_fn call.call_callee_ty)).Ast.sig_output_slot
42 (path:Ast.name_component Stack.t)
47 if cx.ctxt_sess.Session.sess_log_trans
52 let curr_file = Stack.create () in
53 let curr_stmt = Stack.create () in
55 let (abi:Abi.abi) = cx.ctxt_abi in
56 let (word_sz:int64) = word_sz abi in
57 let (word_slot:Ast.slot) = word_slot abi in
58 let (word_ty:Ast.ty) = Ast.TY_mach abi.Abi.abi_word_ty in
60 let oper_str = Il.string_of_operand abi.Abi.abi_str_of_hardreg in
61 let cell_str = Il.string_of_cell abi.Abi.abi_str_of_hardreg in
63 let (word_bits:Il.bits) = abi.Abi.abi_word_bits in
64 let (word_sty:Il.scalar_ty) = Il.ValTy word_bits in
65 let (word_rty:Il.referent_ty) = Il.ScalarTy word_sty in
66 let (word_ty_mach:ty_mach) =
73 let (word_ty_signed_mach:ty_mach) =
80 let word_n = word_n abi in
81 let imm_of_ty (i:int64) (tm:ty_mach) : Il.operand =
82 Il.Imm (Asm.IMM i, tm)
85 let imm (i:int64) : Il.operand = imm_of_ty i word_ty_mach in
86 let simm (i:int64) : Il.operand = imm_of_ty i word_ty_signed_mach in
89 let imm_true = imm_of_ty 1L TY_u8 in
90 let imm_false = imm_of_ty 0L TY_u8 in
91 let nil_ptr = Il.Mem ((Il.Abs (Asm.IMM 0L)), Il.NilTy) in
92 let wordptr_ty = Il.AddrTy (Il.ScalarTy word_sty) in
95 Asm.SUB (Asm.M_POS fix, Asm.M_POS cx.ctxt_crate_fixup)
98 let crate_rel_word fix =
99 Asm.WORD (word_ty_signed_mach, crate_rel fix)
102 let crate_rel_imm (fix:fixup) : Il.operand =
103 Il.Imm (crate_rel fix, word_ty_signed_mach)
106 let table_of_crate_rel_fixups (fixups:fixup array) : Asm.frag =
107 Asm.SEQ (Array.map crate_rel_word fixups)
110 let fixup_rel_word (base:fixup) (fix:fixup) =
111 Asm.WORD (word_ty_signed_mach,
112 Asm.SUB (Asm.M_POS fix, Asm.M_POS base))
115 let table_of_fixup_rel_fixups
119 Asm.SEQ (Array.map (fixup_rel_word fixup) fixups)
122 let table_of_table_rel_fixups (fixups:fixup array) : Asm.frag =
123 let table_fix = new_fixup "vtbl" in
124 Asm.DEF (table_fix, table_of_fixup_rel_fixups table_fix fixups)
128 match cx.ctxt_sess.Session.sess_targ with
129 Linux_x86_elf -> false
134 { nabi_indirect = nabi_indirect;
135 nabi_convention = CONV_rust }
138 let out_mem_disp = abi.Abi.abi_frame_base_sz in
140 Int64.add abi.Abi.abi_frame_base_sz abi.Abi.abi_implicit_args_sz
142 let frame_crate_ptr = word_n (-1) in
143 let frame_fns_disp = word_n (-2) in
145 let fn_ty (id:node_id) : Ast.ty =
146 Hashtbl.find cx.ctxt_all_item_types id
150 (closure:Il.referent_ty option)
153 if item_is_obj_fn cx id
155 else n_item_ty_params cx id
157 call_args_referent_type cx n_params (fn_ty id) closure
160 let emitters = Stack.create () in
161 let push_new_emitter (vregs_ok:bool) (fnid:node_id option) =
162 let e = Il.new_emitter
163 abi.Abi.abi_prealloc_quad
164 abi.Abi.abi_is_2addr_machine
167 Stack.push (Hashtbl.create 0) e.Il.emit_size_cache;
168 Stack.push e emitters;
171 let push_new_emitter_with_vregs fnid = push_new_emitter true fnid in
172 let push_new_emitter_without_vregs fnid = push_new_emitter false fnid in
174 let pop_emitter _ = ignore (Stack.pop emitters) in
175 let emitter _ = Stack.top emitters in
176 let emitter_size_cache _ = Stack.top (emitter()).Il.emit_size_cache in
177 let push_emitter_size_cache _ =
179 (Hashtbl.copy (emitter_size_cache()))
180 (emitter()).Il.emit_size_cache
182 let pop_emitter_size_cache _ =
183 ignore (Stack.pop (emitter()).Il.emit_size_cache)
185 let emit q = Il.emit (emitter()) q in
186 let next_vreg _ = Il.next_vreg (emitter()) in
187 let next_vreg_cell t = Il.next_vreg_cell (emitter()) t in
188 let next_spill_cell t =
189 let s = Il.next_spill (emitter()) in
190 let spill_mem = Il.Spill s in
191 let spill_ta = (spill_mem, Il.ScalarTy t) in
194 let mark _ : quad_idx = (emitter()).Il.emit_pc in
195 let patch_existing (jmp:quad_idx) (targ:quad_idx) : unit =
196 Il.patch_jump (emitter()) jmp targ
198 let patch (i:quad_idx) : unit =
199 Il.patch_jump (emitter()) i (mark());
200 (* Insert a dead quad to ensure there's an otherwise-unused
207 match (emitter()).Il.emit_node with
208 None -> bug () "current_fn without associated node"
211 let current_fn_args_rty (closure:Il.referent_ty option) : Il.referent_ty =
212 fn_args_rty (current_fn()) closure
214 let current_fn_callsz () = get_callsz cx (current_fn()) in
217 (emitter()).Il.emit_annotations
220 let annotate (str:string) =
222 Hashtbl.add e.Il.emit_annotations e.Il.emit_pc str
225 let epilogue_jumps = Stack.create() in
227 let path_name (_:unit) : string =
228 string_of_name (Walk.path_to_name path)
231 let based (reg:Il.reg) : Il.mem =
235 let based_off (reg:Il.reg) (off:Asm.expr64) : Il.mem =
236 Il.RegIn (reg, Some off)
239 let based_imm (reg:Il.reg) (imm:int64) : Il.mem =
240 based_off reg (Asm.IMM imm)
243 let fp_imm (imm:int64) : Il.mem =
244 based_imm abi.Abi.abi_fp_reg imm
247 let sp_imm (imm:int64) : Il.mem =
248 based_imm abi.Abi.abi_sp_reg imm
251 let word_at (mem:Il.mem) : Il.cell =
252 Il.Mem (mem, Il.ScalarTy (Il.ValTy word_bits))
255 let mov (dst:Il.cell) (src:Il.operand) : unit =
256 emit (Il.umov dst src)
259 let umul (dst:Il.cell) (a:Il.operand) (b:Il.operand) : unit =
260 emit (Il.binary Il.UMUL dst a b);
263 let add (dst:Il.cell) (a:Il.operand) (b:Il.operand) : unit =
264 emit (Il.binary Il.ADD dst a b);
267 let add_to (dst:Il.cell) (src:Il.operand) : unit =
268 add dst (Il.Cell dst) src;
271 let sub (dst:Il.cell) (a:Il.operand) (b:Il.operand) : unit =
272 emit (Il.binary Il.SUB dst a b);
275 let sub_from (dst:Il.cell) (src:Il.operand) : unit =
276 sub dst (Il.Cell dst) src;
279 let lea (dst:Il.cell) (src:Il.mem) : unit =
280 emit (Il.lea dst (Il.Cell (Il.Mem (src, Il.OpaqueTy))))
283 let rty_ptr_at (mem:Il.mem) (pointee_rty:Il.referent_ty) : Il.cell =
284 Il.Mem (mem, Il.ScalarTy (Il.AddrTy pointee_rty))
287 let ptr_at (mem:Il.mem) (pointee_ty:Ast.ty) : Il.cell =
288 rty_ptr_at mem (referent_type abi pointee_ty)
291 let need_scalar_ty (rty:Il.referent_ty) : Il.scalar_ty =
294 | _ -> bug () "expected ScalarTy"
297 let need_mem_cell (cell:Il.cell) : Il.typed_mem =
301 "expected address cell, got non-address register cell"
304 let need_cell (operand:Il.operand) : Il.cell =
307 | _ -> bug () "expected cell, got operand %s"
308 (Il.string_of_operand abi.Abi.abi_str_of_hardreg operand)
311 let get_element_ptr =
312 Il.get_element_ptr word_bits abi.Abi.abi_str_of_hardreg
315 let get_variant_ptr (mem_cell:Il.cell) (i:int) : Il.cell =
317 Il.Mem (mem, Il.UnionTy elts)
318 when i >= 0 && i < (Array.length elts) ->
319 assert ((Array.length elts) != 0);
320 Il.Mem (mem, elts.(i))
322 | _ -> bug () "get_variant_ptr %d on cell %s" i
326 let rec ptr_cast (cell:Il.cell) (rty:Il.referent_ty) : Il.cell =
328 Il.Mem (mem, _) -> Il.Mem (mem, rty)
329 | Il.Reg (reg, Il.AddrTy _) -> Il.Reg (reg, Il.AddrTy rty)
330 | _ -> bug () "expected address cell in Trans.ptr_cast"
332 and curr_crate_ptr _ : Il.cell =
333 word_at (fp_imm frame_crate_ptr)
335 and crate_rel_to_ptr (rel:Il.operand) (rty:Il.referent_ty) : Il.cell =
336 let cell = next_vreg_cell (Il.AddrTy rty) in
337 mov cell (Il.Cell (curr_crate_ptr()));
342 * Note: alias *requires* its cell to be in memory already, and should
343 * only be used on slots you know to be memory-resident. Use 'aliasing' or
344 * 'via_memory' if you have a cell or operand you want in memory for a very
345 * short period of time (the time spent by the code generated by the thunk).
348 and alias (cell:Il.cell) : Il.cell =
349 let mem, ty = need_mem_cell cell in
350 let vreg_cell = next_vreg_cell (Il.AddrTy ty) in
354 | _ -> lea vreg_cell mem
358 and force_to_mem (src:Il.operand) : Il.typed_mem =
359 let do_spill op (t:Il.scalar_ty) =
360 let spill = next_spill_cell t in
365 Il.Cell (Il.Mem ta) -> ta
366 | Il.Cell (Il.Reg (_, t)) -> do_spill src t
367 | Il.Imm (_,tm) -> do_spill src (Il.ValTy (Il.bits_of_ty_mach tm))
368 | Il.ImmPtr (f, rty) ->
370 (Il.Cell (crate_rel_to_ptr (crate_rel_imm f) rty))
373 and force_to_reg (op:Il.operand) : Il.typed_reg =
375 let tmp = next_vreg () in
376 let regty = (tmp, st) in
377 mov (Il.Reg regty) op;
381 Il.Imm (_, tm) -> do_mov op (Il.ValTy (Il.bits_of_ty_mach tm))
382 | Il.ImmPtr (f, rty) ->
384 (Il.Cell (crate_rel_to_ptr (crate_rel_imm f) rty))
386 | Il.Cell (Il.Reg rt) -> rt
387 | Il.Cell (Il.Mem (_, Il.ScalarTy st)) -> do_mov op st
388 | Il.Cell (Il.Mem (_, rt)) ->
389 bug () "forcing non-scalar referent of type %s to register"
390 (Il.string_of_referent_ty rt)
392 and via_memory (writeback:bool) (c:Il.cell) (thunk:Il.cell -> unit) : unit =
396 let mem_c = Il.Mem (force_to_mem (Il.Cell c)) in
400 mov c (Il.Cell mem_c)
402 and aliasing (writeback:bool) (c:Il.cell) (thunk:Il.cell -> unit) : unit =
403 via_memory writeback c (fun c -> thunk (alias c))
405 and pointee_type (ptr:Il.cell) : Il.referent_ty =
407 Il.Reg (_, (Il.AddrTy rt)) -> rt
408 | Il.Mem (_, Il.ScalarTy (Il.AddrTy rt)) -> rt
410 bug () "taking pointee-type of non-address cell %s "
413 and deref (ptr:Il.cell) : Il.cell =
414 let (r, st) = force_to_reg (Il.Cell ptr) in
416 Il.AddrTy rt -> Il.Mem (based r, rt)
417 | _ -> bug () "dereferencing non-address cell of type %s "
418 (Il.string_of_scalar_ty st)
420 and deref_off (ptr:Il.cell) (off:Asm.expr64) : Il.cell =
421 let (r, st) = force_to_reg (Il.Cell ptr) in
423 Il.AddrTy rt -> Il.Mem (based_off r off, rt)
424 | _ -> bug () "offset-dereferencing non-address cell of type %s "
425 (Il.string_of_scalar_ty st)
427 and deref_imm (ptr:Il.cell) (imm:int64) : Il.cell =
428 deref_off ptr (Asm.IMM imm)
430 and tp_imm (imm:int64) : Il.cell =
431 deref_imm abi.Abi.abi_tp_cell imm
435 let make_tydesc_tys n =
436 Array.init n (fun _ -> Ast.TY_type)
439 let cell_vreg_num (vr:(int option) ref) : int =
442 let v = (Il.next_vreg_num (emitter())) in
448 let slot_id_referent_type (slot_id:node_id) : Il.referent_ty =
449 slot_referent_type abi (get_slot cx slot_id)
452 let caller_args_cell (args_rty:Il.referent_ty) : Il.cell =
453 Il.Mem (fp_imm out_mem_disp, args_rty)
456 let get_ty_param (ty_params:Il.cell) (param_idx:int) : Il.cell =
457 get_element_ptr ty_params param_idx
460 let get_ty_params_of_frame (fp:Il.reg) (n_params:int) : Il.cell =
461 let fn_ty = mk_simple_ty_fn [| |] in
462 let fn_rty = call_args_referent_type cx n_params fn_ty None in
463 let args_cell = Il.Mem (based_imm fp out_mem_disp, fn_rty) in
464 get_element_ptr args_cell Abi.calltup_elt_ty_params
467 let get_args_for_current_frame _ =
469 current_fn_args_rty (Some Il.OpaqueTy)
471 caller_args_cell curr_args_rty
474 let get_indirect_args_for_current_frame _ =
475 get_element_ptr (get_args_for_current_frame ())
476 Abi.calltup_elt_indirect_args
479 let get_iterator_args_for_current_frame _ =
480 get_element_ptr (get_args_for_current_frame ())
481 Abi.calltup_elt_iterator_args
484 let get_closure_for_current_frame _ =
485 let self_indirect_args =
486 get_indirect_args_for_current_frame ()
488 get_element_ptr self_indirect_args
489 Abi.indirect_args_elt_closure
492 let get_iter_block_fn_for_current_frame _ =
493 let self_iterator_args =
494 get_iterator_args_for_current_frame ()
496 let blk_fn = get_element_ptr self_iterator_args
497 Abi.iterator_args_elt_block_fn
500 (Il.ScalarTy (Il.AddrTy Il.CodeTy))
503 let get_iter_outer_frame_ptr_for_current_frame _ =
504 let self_iterator_args =
505 get_iterator_args_for_current_frame ()
507 get_element_ptr self_iterator_args
508 Abi.iterator_args_elt_outer_frame_ptr
511 let get_obj_for_current_frame _ =
513 (get_closure_for_current_frame ())
514 (Il.ScalarTy (Il.AddrTy (obj_closure_rty abi))))
517 let get_ty_params_of_current_frame _ : Il.cell =
518 let id = current_fn() in
519 let n_ty_params = n_item_ty_params cx id in
520 if item_is_obj_fn cx id
523 let obj = get_obj_for_current_frame() in
524 let tydesc = get_element_ptr obj 1 in
525 let ty_params_ty = Ast.TY_tup (make_tydesc_tys n_ty_params) in
526 let ty_params_rty = referent_type abi ty_params_ty in
528 get_element_ptr (deref tydesc) Abi.tydesc_field_first_param
531 ptr_cast ty_params (Il.ScalarTy (Il.AddrTy ty_params_rty))
537 get_ty_params_of_frame abi.Abi.abi_fp_reg n_ty_params
540 let get_ty_param_in_current_frame (param_idx:int) : Il.cell =
541 get_ty_param (get_ty_params_of_current_frame()) param_idx
544 let linearize_ty_params (ty:Ast.ty) : (Ast.ty * Il.operand array) =
545 let htab = Hashtbl.create 0 in
546 let q = Queue.create () in
547 let base = ty_fold_rebuild (fun t -> t) in
548 let ty_fold_param (i, mut) =
549 let param = Ast.TY_param (i, mut) in
550 match htab_search htab param with
553 let p = Ast.TY_param (Hashtbl.length htab, mut) in
554 htab_put htab param p;
555 Queue.add (Il.Cell (get_ty_param_in_current_frame i)) q;
560 ty_fold_param = ty_fold_param; }
562 let ty = fold_ty fold ty in
566 let has_parametric_types (t:Ast.ty) : bool =
567 let base = ty_fold_bool_or false in
568 let ty_fold_param _ =
571 let fold = { base with ty_fold_param = ty_fold_param } in
575 let rec calculate_sz (ty_params:Il.cell) (size:size) : Il.operand =
576 iflog (fun _ -> annotate
577 (Printf.sprintf "calculating size %s"
578 (string_of_size size)));
579 let sub_sz = calculate_sz ty_params in
580 match htab_search (emitter_size_cache()) size with
585 SIZE_fixed i -> imm i
586 | SIZE_fixup_mem_pos f -> Il.Imm (Asm.M_POS f, word_ty_mach)
587 | SIZE_fixup_mem_sz f -> Il.Imm (Asm.M_SZ f, word_ty_mach)
589 | SIZE_param_size i ->
590 let tydesc = deref (get_ty_param ty_params i) in
591 Il.Cell (get_element_ptr tydesc Abi.tydesc_field_size)
593 | SIZE_param_align i ->
594 let tydesc = deref (get_ty_param ty_params i) in
595 Il.Cell (get_element_ptr tydesc Abi.tydesc_field_align)
598 let op_a = sub_sz a in
599 let tmp = next_vreg_cell word_sty in
600 emit (Il.unary Il.NEG tmp op_a);
603 | SIZE_rt_add (a, b) ->
604 let op_a = sub_sz a in
605 let op_b = sub_sz b in
606 let tmp = next_vreg_cell word_sty in
610 | SIZE_rt_mul (a, b) ->
611 let op_a = sub_sz a in
612 let op_b = sub_sz b in
613 let tmp = next_vreg_cell word_sty in
614 emit (Il.binary Il.UMUL tmp op_a op_b);
617 | SIZE_rt_max (a, b) ->
618 let op_a = sub_sz a in
619 let op_b = sub_sz b in
620 let tmp = next_vreg_cell word_sty in
622 emit (Il.cmp op_a op_b);
624 emit (Il.jmp Il.JAE Il.CodeNone);
629 | SIZE_rt_align (align, off) ->
631 * calculate off + pad where:
633 * pad = (align - (off mod align)) mod align
635 * In our case it's always a power of two,
643 annotate "fetch alignment";
644 let op_align = sub_sz align in
645 annotate "fetch offset";
646 let op_off = sub_sz off in
647 let mask = next_vreg_cell word_sty in
648 let off = next_vreg_cell word_sty in
652 add_to off (Il.Cell mask);
653 emit (Il.unary Il.NOT mask (Il.Cell mask));
654 emit (Il.binary Il.AND
655 off (Il.Cell off) (Il.Cell mask));
658 iflog (fun _ -> annotate
659 (Printf.sprintf "calculated size %s is %s"
660 (string_of_size size)
662 htab_put (emitter_size_cache()) size res;
666 and calculate_sz_in_current_frame (size:size) : Il.operand =
667 calculate_sz (get_ty_params_of_current_frame()) size
669 and callee_args_cell (tail_area:bool) (args_rty:Il.referent_ty) : Il.cell =
672 Il.Mem (sp_off_sz (current_fn_callsz ()), args_rty)
674 Il.Mem (sp_imm 0L, args_rty)
676 and based_sz (ty_params:Il.cell) (reg:Il.reg) (size:size) : Il.mem =
677 match Il.size_to_expr64 size with
678 Some e -> based_off reg e
680 let runtime_size = calculate_sz ty_params size in
681 let v = next_vreg () in
682 let c = (Il.Reg (v, word_sty)) in
683 mov c (Il.Cell (Il.Reg (reg, word_sty)));
684 add_to c runtime_size;
687 and fp_off_sz (size:size) : Il.mem =
688 based_sz (get_ty_params_of_current_frame()) abi.Abi.abi_fp_reg size
690 and sp_off_sz (size:size) : Il.mem =
691 based_sz (get_ty_params_of_current_frame()) abi.Abi.abi_sp_reg size
694 let ty_sz_in_current_frame (ty:Ast.ty) : Il.operand =
695 let rty = referent_type abi ty in
696 let sz = Il.referent_ty_size word_bits rty in
697 calculate_sz_in_current_frame sz
700 let ty_sz_with_ty_params
704 let rty = referent_type abi ty in
705 let sz = Il.referent_ty_size word_bits rty in
706 calculate_sz ty_params sz
709 let get_element_ptr_dyn
715 Il.Mem (mem, Il.StructTy elts)
716 when i >= 0 && i < (Array.length elts) ->
717 assert ((Array.length elts) != 0);
719 let elt_rty = elts.(i) in
720 let elt_off = Il.get_element_offset word_bits elts i in
722 SIZE_fixed fixed_off ->
723 Il.Mem (Il.mem_off_imm mem fixed_off, elt_rty)
725 let sz = calculate_sz ty_params sz in
726 let v = next_vreg word_sty in
727 let vc = Il.Reg (v, word_sty) in
730 Il.Mem (based v, elt_rty)
732 | _ -> bug () "get_element_ptr_dyn %d on cell %s" i
736 let get_element_ptr_dyn_in_current_frame
740 get_element_ptr_dyn (get_ty_params_of_current_frame()) mem_cell i
748 match Il.size_to_expr64 size with
749 Some e -> deref_off ptr e
751 let (r,_) = force_to_reg (Il.Cell ptr) in
752 let mem = based_sz ty_params r size in
753 Il.Mem (mem, (pointee_type ptr))
756 let cell_of_block_slot
759 let referent_type = slot_id_referent_type slot_id in
760 match htab_search cx.ctxt_slot_vregs slot_id with
763 match referent_type with
764 Il.ScalarTy st -> Il.Reg (Il.Vreg (cell_vreg_num vr), st)
765 | Il.NilTy -> nil_ptr
766 | Il.StructTy _ -> bugi cx slot_id
767 "cannot treat structured referent as single operand"
768 | Il.UnionTy _ -> bugi cx slot_id
769 "cannot treat union referent as single operand"
770 | Il.ParamTy _ -> bugi cx slot_id
771 "cannot treat parametric referent as single operand"
772 | Il.OpaqueTy -> bugi cx slot_id
773 "cannot treat opaque referent as single operand"
774 | Il.CodeTy -> bugi cx slot_id
775 "cannot treat code referent as single operand"
779 match htab_search cx.ctxt_slot_offsets slot_id with
780 None -> bugi cx slot_id
781 "slot assigned to neither vreg nor offset"
783 if slot_is_obj_state cx slot_id
786 let state_arg = get_closure_for_current_frame () in
788 need_mem_cell (deref_off_sz
789 (get_ty_params_of_current_frame())
792 Il.Mem (slot_mem, referent_type)
795 if (Stack.is_empty curr_stmt)
797 Il.Mem (fp_off_sz off, referent_type)
799 let slot_depth = get_slot_depth cx slot_id in
801 get_stmt_depth cx (Stack.top curr_stmt)
803 if slot_depth <> stmt_depth
805 let _ = assert (slot_depth < stmt_depth) in
811 Hashtbl.find cx.ctxt_slot_keys slot_id
815 "access outer frame slot #%d = %s"
816 (int_of_node slot_id)
821 let diff = stmt_depth - slot_depth in
822 let _ = annotate "get outer frame pointer" in
824 get_iter_outer_frame_ptr_for_current_frame ()
828 bug () "unsupported nested for each loop";
830 (* FIXME (issue #79): access outer
831 * caller-block fps, given nearest
835 annotate "step to outer-outer frame"
839 let _ = annotate "calculate size" in
841 based_sz (get_ty_params_of_current_frame())
842 (fst (force_to_reg (Il.Cell fp))) off
844 Il.Mem (p, referent_type)
846 Il.Mem (fp_off_sz off, referent_type)
850 let binop_to_jmpop (binop:Ast.binop) : Il.jmpop =
852 Ast.BINOP_eq -> Il.JE
853 | Ast.BINOP_ne -> Il.JNE
854 | Ast.BINOP_lt -> Il.JL
855 | Ast.BINOP_le -> Il.JLE
856 | Ast.BINOP_ge -> Il.JGE
857 | Ast.BINOP_gt -> Il.JG
858 | _ -> bug () "Unhandled binop in binop_to_jmpop"
861 let get_vtbl_entry_idx (table_ptr:Il.cell) (i:int) : Il.cell =
862 (* Vtbls are encoded as tables of table-relative displacements. *)
863 let (table_mem, _) = need_mem_cell (deref table_ptr) in
864 let disp = Il.Cell (word_at (Il.mem_off_imm table_mem (word_n i))) in
865 let ptr_cell = next_vreg_cell (Il.AddrTy Il.CodeTy) in
866 mov ptr_cell (Il.Cell table_ptr);
867 add_to ptr_cell disp;
875 : (Il.cell * Ast.ty_fn) =
876 let (_, fns) = obj_ty in
877 let sorted_idents = sorted_htab_keys fns in
878 let i = arr_idx sorted_idents id in
879 let fn_ty = Hashtbl.find fns id in
880 let table_ptr = get_element_ptr obj_cell Abi.binding_field_item in
881 (get_vtbl_entry_idx table_ptr i, fn_ty)
884 let rec trans_slot_lval_ext
888 (comp:Ast.lval_component)
889 : (Il.cell * Ast.ty) =
891 let bounds_checked_access at ty =
892 let atop = trans_atom at in
893 let unit_sz = ty_sz_in_current_frame ty in
894 let idx = next_vreg_cell word_sty in
895 emit (Il.binary Il.UMUL idx atop unit_sz);
896 let elt_mem = trans_bounds_check (deref cell) (Il.Cell idx) in
897 (Il.Mem (elt_mem, referent_type abi ty), ty)
900 * All lval components aside from explicit-deref just auto-deref
901 * through all boxes to find their indexable referent.
903 let base_ty = strip_mutable_or_constrained_ty base_ty in
904 let (cell, base_ty) =
905 if comp = Ast.COMP_deref
907 else deref_ty DEREF_all_boxes initializing cell base_ty
910 match (base_ty, comp) with
912 Ast.COMP_named (Ast.COMP_ident id)) ->
913 let i = arr_idx (Array.map fst entries) id in
914 (get_element_ptr_dyn_in_current_frame cell i, snd entries.(i))
916 | (Ast.TY_tup entries,
917 Ast.COMP_named (Ast.COMP_idx i)) ->
918 (get_element_ptr_dyn_in_current_frame cell i, entries.(i))
922 bounds_checked_access at ty
926 bounds_checked_access at (Ast.TY_mach TY_u8)
928 | (Ast.TY_obj obj_ty,
929 Ast.COMP_named (Ast.COMP_ident id)) ->
930 let (cell, fn_ty) = get_vtbl_entry cell obj_ty id in
931 (cell, (Ast.TY_fn fn_ty))
933 | (Ast.TY_box _, Ast.COMP_deref) ->
934 deref_ty DEREF_one_box initializing cell base_ty
936 | _ -> bug () "unhandled form of lval_ext in trans_slot_lval_ext"
939 * vec: operand holding ptr to vec.
940 * mul_idx: index value * unit size.
941 * return: ptr to element.
943 and trans_bounds_check (vec:Il.cell) (mul_idx:Il.operand) : Il.mem =
944 let (len:Il.cell) = get_element_ptr vec Abi.vec_elt_fill in
945 let (data:Il.cell) = get_element_ptr vec Abi.vec_elt_data in
946 let (base:Il.cell) = next_vreg_cell Il.voidptr_t in
947 let (elt_reg:Il.reg) = next_vreg () in
948 let (elt:Il.cell) = Il.Reg (elt_reg, Il.voidptr_t) in
949 let (diff:Il.cell) = next_vreg_cell word_sty in
950 annotate "bounds check";
951 lea base (fst (need_mem_cell data));
952 add elt (Il.Cell base) mul_idx;
953 emit (Il.binary Il.SUB diff (Il.Cell elt) (Il.Cell base));
954 let jmp = trans_compare Il.JB (Il.Cell diff) (Il.Cell len) in
955 trans_cond_fail "bounds check" jmp;
961 : (Il.cell * Ast.ty) =
963 let rec trans_slot_lval_full (initializing:bool) lv =
966 Ast.LVAL_ext (base, comp) ->
967 let (base_cell, base_ty) =
968 trans_slot_lval_full initializing base
970 trans_slot_lval_ext initializing base_ty base_cell comp
972 | Ast.LVAL_base nbi ->
973 let sloti = lval_base_to_slot cx lv in
974 let cell = cell_of_block_slot sloti.id in
975 let ty = slot_ty sloti.node in
976 let cell = deref_slot initializing cell sloti.node in
978 (* If this fails, type didn't visit the lval, and we
979 * don't know whether to auto-deref its base. Crashing
980 * here is best. Compiler bug.
982 match htab_search cx.ctxt_auto_deref_lval nbi.id with
985 "Lval without auto-deref info; bad typecheck?"
986 | Some true -> DEREF_all_boxes
987 | Some false -> DEREF_none
989 deref_ty dctrl initializing cell ty
995 (Printf.sprintf "lval %a = %s"
1002 if lval_is_slot cx lv
1003 then trans_slot_lval_full initializing lv
1006 then err None "init item"
1009 assert (lval_is_item cx lv);
1011 "trans_lval_full called on item lval '%a'" Ast.sprintf_lval lv
1014 and trans_lval_maybe_init
1017 : (Il.cell * Ast.ty) =
1018 trans_lval_full initializing lv
1020 and trans_lval_init (lv:Ast.lval) : (Il.cell * Ast.ty) =
1021 trans_lval_maybe_init true lv
1023 and trans_lval (lv:Ast.lval) : (Il.cell * Ast.ty) =
1024 trans_lval_maybe_init false lv
1028 : (Il.operand * Ast.ty) =
1029 (* direct call to item *)
1030 let fty = Hashtbl.find cx.ctxt_all_lval_types (lval_base_id flv) in
1031 if lval_is_item cx flv then
1032 let fn_item = lval_item cx flv in
1033 let fn_ptr = code_fixup_to_ptr_operand (get_fn_fixup cx fn_item.id) in
1036 (* indirect call to computed slot *)
1037 let (cell, _) = trans_lval flv in
1041 Asm.ALIGN_FILE (16, Asm.ALIGN_MEM(16, x))
1043 and trans_crate_rel_data_operand
1045 (thunk:unit -> Asm.frag)
1048 htab_search_or_add cx.ctxt_data d
1051 let fix = new_fixup "data item" in
1052 let frag = align (Asm.DEF (fix, thunk())) in
1058 and trans_crate_rel_data_frag (d:data) (thunk:unit -> Asm.frag) : Asm.frag =
1060 htab_search_or_add cx.ctxt_data d
1063 let fix = new_fixup "data item" in
1064 let frag = align (Asm.DEF (fix, thunk())) in
1070 and trans_crate_rel_static_string_operand (s:string) : Il.operand =
1071 trans_crate_rel_data_operand (DATA_str s) (fun _ -> Asm.ZSTRING s)
1073 and trans_crate_rel_static_string_frag (s:string) : Asm.frag =
1074 trans_crate_rel_data_frag (DATA_str s) (fun _ -> Asm.ZSTRING s)
1076 and trans_static_string (s:string) : Il.operand =
1077 Il.Cell (crate_rel_to_ptr
1078 (trans_crate_rel_static_string_operand s)
1079 (referent_type abi Ast.TY_str))
1081 and get_static_tydesc
1082 (idopt:node_id option)
1087 trans_crate_rel_data_operand
1091 let tydesc_fixup = new_fixup "tydesc" in
1093 fixup_rel_word tydesc_fixup fixup
1095 log cx "tydesc for %a has sz=%Ld, align=%Ld"
1096 Ast.sprintf_ty t sz align;
1101 Asm.WORD (word_ty_mach, Asm.IMM 0L);
1102 Asm.WORD (word_ty_mach, Asm.IMM sz);
1103 Asm.WORD (word_ty_mach, Asm.IMM align);
1104 fix (get_copy_glue t None);
1105 fix (get_drop_glue t None);
1107 match ty_mem_ctrl t with
1109 Asm.WORD (word_ty_mach, Asm.IMM 0L);
1111 fix (get_free_glue t (type_has_state t) None);
1113 fix (get_sever_glue t None);
1114 fix (get_mark_glue t None);
1115 (* Include any obj-dtor, if this is an obj and has one. *)
1118 None -> Asm.WORD (word_ty_mach, Asm.IMM 0L);
1121 let g = GLUE_obj_drop oid in
1122 match htab_search cx.ctxt_glue_code g with
1123 Some code -> fix code.code_fixup
1125 Asm.WORD (word_ty_mach, Asm.IMM 0L);
1131 and get_obj_vtbl (id:node_id) : Il.operand =
1133 match Hashtbl.find cx.ctxt_all_defns id with
1134 DEFN_item { Ast.decl_item=Ast.MOD_ITEM_obj obj} -> obj
1135 | _ -> bug () "Trans.get_obj_vtbl on non-obj referent"
1137 trans_crate_rel_data_operand (DATA_obj_vtbl id)
1140 iflog (fun _ -> log cx "emitting %d-entry obj vtbl for %s"
1141 (Hashtbl.length obj.Ast.obj_fns) (path_name()));
1142 table_of_table_rel_fixups
1146 let fn = Hashtbl.find obj.Ast.obj_fns k in
1147 get_fn_fixup cx fn.id
1149 (sorted_htab_keys obj.Ast.obj_fns))
1153 and trans_copy_forward_args (args_rty:Il.referent_ty) : unit =
1154 let caller_args_cell = caller_args_cell args_rty in
1155 let callee_args_cell = callee_args_cell false args_rty in
1156 let (dst_reg, _) = force_to_reg (Il.Cell (alias callee_args_cell)) in
1157 let (src_reg, _) = force_to_reg (Il.Cell (alias caller_args_cell)) in
1158 let tmp_reg = next_vreg () in
1159 let nbytes = force_sz (Il.referent_ty_size word_bits args_rty) in
1160 abi.Abi.abi_emit_inline_memcpy (emitter())
1161 nbytes dst_reg src_reg tmp_reg false;
1164 and get_forwarding_obj_fn
1169 (* Forwarding "glue" is not glue in the normal sense of being called with
1170 * only Abi.worst_case_glue_call_args args; the functions are full-fleged
1171 * obj fns like any other, and they perform a full call to the target
1172 * obj. We just use the glue facility here to store the forwarding
1173 * operators somewhere.
1175 let g = GLUE_forward (ident, caller, callee) in
1176 let fix = new_fixup (glue_str cx g) in
1177 let fty = Hashtbl.find (snd caller) ident in
1179 call_args_referent_type cx 0
1180 (Ast.TY_fn fty) (Some (obj_closure_rty abi))
1182 let callsz = Il.referent_ty_size word_bits self_args_rty in
1183 let spill = new_fixup "forwarding fn spill" in
1184 trans_glue_frame_entry callsz spill;
1185 let all_self_args_cell = caller_args_cell self_args_rty in
1186 let self_indirect_args_cell =
1187 get_element_ptr all_self_args_cell Abi.calltup_elt_indirect_args
1190 * Note: this is wrong. This assumes our closure is a vtbl,
1191 * when in fact it is a pointer to a refcounted malloc slab
1192 * containing an obj.
1195 deref (get_element_ptr self_indirect_args_cell
1196 Abi.indirect_args_elt_closure)
1199 let (callee_fn_cell, _) =
1200 get_vtbl_entry closure_cell callee ident
1202 iflog (fun _ -> annotate "copy args forward to callee");
1203 trans_copy_forward_args self_args_rty;
1205 iflog (fun _ -> annotate "call through to callee");
1206 (* FIXME (issue #80): use a tail-call here. *)
1207 call_code (code_of_cell callee_fn_cell);
1208 trans_glue_frame_exit fix spill g;
1212 and get_forwarding_vtbl
1216 trans_crate_rel_data_operand (DATA_forwarding_vtbl (caller,callee))
1219 let (_,fns) = caller in
1220 iflog (fun _ -> log cx "emitting %d-entry obj forwarding vtbl"
1221 (Hashtbl.length fns));
1222 table_of_table_rel_fixups
1226 get_forwarding_obj_fn k caller callee
1228 (sorted_htab_keys fns))
1231 and trans_init_str (dst:Ast.lval) (s:string) : unit =
1232 (* Include null byte. *)
1233 let init_sz = Int64.of_int ((String.length s) + 1) in
1234 let static = trans_static_string s in
1235 let (dst, _) = trans_lval_init dst in
1236 trans_upcall "upcall_new_str" dst [| static; imm init_sz |]
1238 and trans_lit (lit:Ast.lit) : Il.operand =
1240 Ast.LIT_nil -> Il.Cell (nil_ptr)
1241 | Ast.LIT_bool false -> imm_false
1242 | Ast.LIT_bool true -> imm_true
1243 | Ast.LIT_char c -> imm_of_ty (Int64.of_int c) TY_u32
1244 | Ast.LIT_int (i, _) -> simm i
1245 | Ast.LIT_uint (i, _) -> imm i
1246 | Ast.LIT_mach (m, n, _) -> imm_of_ty n m
1248 and trans_atom (atom:Ast.atom) : Il.operand =
1252 annotate (Fmt.fmt_to_str Ast.fmt_atom atom)
1256 let (cell, ty) = trans_lval lv in
1257 Il.Cell (fst (deref_ty DEREF_none false cell ty))
1259 | Ast.ATOM_literal lit -> trans_lit lit.node
1261 and fixup_to_ptr_operand
1264 (referent_ty:Il.referent_ty)
1267 then Il.ImmPtr (fix, referent_ty)
1268 else Il.Cell (crate_rel_to_ptr (crate_rel_imm fix) referent_ty)
1270 and code_fixup_to_ptr_operand (fix:fixup) : Il.operand =
1271 fixup_to_ptr_operand abi.Abi.abi_has_pcrel_code fix Il.CodeTy
1273 (* A pointer-valued op may be of the form ImmPtr, which carries its
1274 * target fixup, "constant-propagated" through trans so that
1275 * pc-relative addressing can make use of it whenever
1276 * appropriate. Reify_ptr exists for cases when you are about to
1277 * store an ImmPtr into a memory cell or other place beyond which the
1278 * compiler will cease to know about its identity; at this point you
1279 * should decay it to a crate-relative displacement and
1280 * (computationally) add it to the crate base value, before working
1283 * This helps you obey the IL type-system prohibition against
1284 * 'mov'-ing an ImmPtr to a cell. If you forget to call this
1285 * in the right places, you will get code-generation failures.
1287 and reify_ptr (op:Il.operand) : Il.operand =
1289 Il.ImmPtr (fix, rty) ->
1290 Il.Cell (crate_rel_to_ptr (crate_rel_imm fix) rty)
1293 and annotate_quads (name:string) : unit =
1294 let e = emitter() in
1295 let quads = emitted_quads e in
1296 let annotations = annotations() in
1297 log cx "emitted quads for %s:" name;
1298 for i = 0 to arr_max quads
1300 if Hashtbl.mem annotations i
1303 (fun a -> log cx "// %s" a)
1304 (List.rev (Hashtbl.find_all annotations i));
1305 log cx "[%6d]\t%s" i
1307 abi.Abi.abi_str_of_hardreg quads.(i));
1311 and write_frame_info_ptrs (fnid:node_id option) =
1315 | Some fnid -> get_frame_glue_fns fnid
1317 let crate_ptr_reg = next_vreg () in
1318 let crate_ptr_cell = Il.Reg (crate_ptr_reg, (Il.AddrTy Il.OpaqueTy)) in
1319 iflog (fun _ -> annotate "write frame-info pointers");
1320 Abi.load_fixup_addr (emitter())
1321 crate_ptr_reg cx.ctxt_crate_fixup Il.OpaqueTy;
1322 mov (word_at (fp_imm frame_crate_ptr)) (Il.Cell (crate_ptr_cell));
1323 mov (word_at (fp_imm frame_fns_disp)) frame_fns
1325 and check_interrupt_flag _ =
1326 let dom = next_vreg_cell wordptr_ty in
1327 let flag = next_vreg_cell word_sty in
1328 mov dom (Il.Cell (tp_imm (word_n Abi.task_field_dom)));
1329 mov flag (Il.Cell (deref_imm dom
1330 (word_n Abi.dom_field_interrupt_flag)));
1331 let null_jmp = null_check flag in
1335 and trans_glue_frame_entry
1339 let framesz = SIZE_fixup_mem_sz spill in
1340 push_new_emitter_with_vregs None;
1341 iflog (fun _ -> annotate "prologue");
1342 abi.Abi.abi_emit_fn_prologue (emitter())
1343 framesz callsz nabi_rust (upcall_fixup "upcall_grow_task");
1344 write_frame_info_ptrs None;
1345 (* FIXME: not clear why, but checking interrupt in glue context
1346 * causes many.rs to crash when run on a sufficiently large number
1347 * of tasks; possibly a weird interaction with growing? *)
1348 (* check_interrupt_flag (); *)
1349 iflog (fun _ -> annotate "finished prologue");
1351 and emitted_quads e =
1352 Array.sub e.Il.emit_quads 0 e.Il.emit_pc
1354 and capture_emitted_glue (fix:fixup) (spill:fixup) (g:glue) : unit =
1355 let e = emitter() in
1356 iflog (fun _ -> annotate_quads (glue_str cx g));
1357 let code = { code_fixup = fix;
1358 code_quads = emitted_quads e;
1359 code_vregs_and_spill = Some (Il.num_vregs e, spill); }
1361 htab_put cx.ctxt_glue_code g code
1363 and trans_glue_frame_exit (fix:fixup) (spill:fixup) (g:glue) : unit =
1364 iflog (fun _ -> annotate "epilogue");
1365 abi.Abi.abi_emit_fn_epilogue (emitter());
1366 capture_emitted_glue fix spill g;
1369 and emit_exit_task_glue (fix:fixup) (g:glue) : unit =
1370 let name = glue_str cx g in
1371 let spill = new_fixup (name ^ " spill") in
1372 push_new_emitter_with_vregs None;
1374 * We return-to-here in a synthetic frame we did not build; our job is
1375 * merely to call upcall_exit.
1377 iflog (fun _ -> annotate "assume 'exited' state");
1378 trans_void_upcall "upcall_exit" [| |];
1379 capture_emitted_glue fix spill g;
1382 and get_exit_task_glue _ : fixup =
1383 let g = GLUE_exit_task in
1384 match htab_search cx.ctxt_glue_code g with
1385 Some code -> code.code_fixup
1387 let fix = cx.ctxt_exit_task_fixup in
1388 emit_exit_task_glue fix g;
1392 * Closure representation has 3 GEP-parts:
1395 * . gc . gc control word, if mutable
1401 * | tf | ----> pair of fn+binding that closure
1417 and closure_referent_type
1419 (* FIXME (issue #5): mutability flag *)
1421 let rc = Il.ScalarTy word_sty in
1422 let targ = referent_type abi (mk_simple_ty_fn [||]) in
1423 let bindings = Array.map (slot_referent_type abi) bs in
1424 Il.StructTy [| rc; targ; Il.StructTy bindings |]
1426 (* FIXME (issue #2): this should eventually use tail calling logic *)
1428 and emit_fn_binding_glue
1429 (arg_slots:Ast.slot array)
1430 (arg_bound_flags:bool array)
1434 let extract_slots want_bound =
1438 if bound = want_bound then Some slot else None)
1442 let bound_slots = extract_slots true in
1443 let unbound_slots = extract_slots false in
1444 let (self_ty:Ast.ty) = mk_simple_ty_fn unbound_slots in
1445 let (callee_ty:Ast.ty) = mk_simple_ty_fn arg_slots in
1447 let self_closure_rty = closure_referent_type bound_slots in
1448 (* FIXME (issue #81): binding type parameters doesn't work. *)
1450 call_args_referent_type cx 0 self_ty (Some self_closure_rty)
1452 let callee_args_rty =
1453 call_args_referent_type cx 0 callee_ty (Some Il.OpaqueTy)
1456 let callsz = Il.referent_ty_size word_bits callee_args_rty in
1457 let spill = new_fixup "bind glue spill" in
1458 trans_glue_frame_entry callsz spill;
1460 let all_self_args_cell = caller_args_cell self_args_rty in
1461 let self_indirect_args_cell =
1462 get_element_ptr all_self_args_cell Abi.calltup_elt_indirect_args
1465 deref (get_element_ptr self_indirect_args_cell
1466 Abi.indirect_args_elt_closure)
1468 let closure_target_cell =
1469 get_element_ptr closure_cell Abi.binding_field_binding
1471 let closure_target_fn_cell =
1472 get_element_ptr closure_target_cell Abi.binding_field_item
1476 self_args_rty callee_args_rty
1477 arg_slots arg_bound_flags;
1478 iflog (fun _ -> annotate "call through to closure target fn");
1481 * Closures, unlike first-class [disp,*binding] pairs, contain
1482 * a fully-resolved target pointer, not a displacement. So we
1483 * don't want to use callee_fn_ptr or the like to access the
1484 * contents. We just call through the cell directly.
1487 call_code (code_of_cell closure_target_fn_cell);
1488 trans_glue_frame_exit fix spill g
1491 and get_fn_binding_glue
1493 (arg_slots:Ast.slot array)
1494 (arg_bound_flags:bool array)
1496 let g = GLUE_fn_binding bind_id in
1497 match htab_search cx.ctxt_glue_code g with
1498 Some code -> code.code_fixup
1500 let fix = new_fixup (glue_str cx g) in
1501 emit_fn_binding_glue arg_slots arg_bound_flags fix g;
1506 * Mem-glue functions are either 'mark', 'drop' or 'free', they take
1507 * one pointer arg and return nothing.
1510 and trans_mem_glue_frame_entry (n_outgoing_args:int) (spill:fixup) : unit =
1511 let isz = cx.ctxt_abi.Abi.abi_implicit_args_sz in
1512 let callsz = SIZE_fixed (Int64.add isz (word_n n_outgoing_args)) in
1513 trans_glue_frame_entry callsz spill
1515 and get_mem_glue (g:glue) (inner:Il.mem -> unit) : fixup =
1516 match htab_search cx.ctxt_glue_code g with
1517 Some code -> code.code_fixup
1520 let name = glue_str cx g in
1521 let fix = new_fixup name in
1523 * Put a temporary code entry in the table to handle
1524 * recursive emit calls during the generation of the glue
1527 let tmp_code = { code_fixup = fix;
1529 code_vregs_and_spill = None; } in
1530 let spill = new_fixup (name ^ " spill") in
1531 htab_put cx.ctxt_glue_code g tmp_code;
1532 log cx "emitting glue: %s" name;
1533 trans_mem_glue_frame_entry Abi.worst_case_glue_call_args spill;
1534 let (arg:Il.mem) = fp_imm arg0_disp in
1536 Hashtbl.remove cx.ctxt_glue_code g;
1537 trans_glue_frame_exit fix spill g;
1541 and get_typed_mem_glue
1544 (inner:Il.cell -> Il.cell -> unit)
1549 let n_ty_params = 0 in
1551 call_args_referent_type cx n_ty_params fty None
1553 let calltup_cell = caller_args_cell calltup_rty in
1555 get_element_ptr calltup_cell Abi.calltup_elt_out_ptr
1558 get_element_ptr calltup_cell Abi.calltup_elt_args
1561 match Il.cell_referent_ty args_cell with
1563 assert ((Array.length az)
1564 <= Abi.worst_case_glue_call_args);
1565 | _ -> bug () "unexpected cell referent ty in glue args"
1567 inner out_cell args_cell
1574 let static = trans_static_string s in
1575 trans_void_upcall "upcall_trace_str" [| static |]
1578 and trace_word b w =
1581 trans_void_upcall "upcall_trace_word" [| Il.Cell w |]
1583 and ty_params_covering (t:Ast.ty) : Ast.slot =
1584 let n_ty_params = n_used_type_params t in
1585 let params = make_tydesc_tys n_ty_params in
1586 alias_slot (Ast.TY_tup params)
1590 (curr_iso:Ast.ty_iso option)
1592 let g = GLUE_drop ty in
1593 let inner _ (args:Il.cell) =
1594 let ty_params = deref (get_element_ptr args 0) in
1595 let cell = get_element_ptr args 1 in
1596 note_drop_step ty "in drop-glue, dropping";
1597 trace_word cx.ctxt_sess.Session.sess_trace_drop cell;
1598 drop_ty ty_params (deref cell) ty curr_iso;
1599 note_drop_step ty "drop-glue complete";
1601 let ty_params_ptr = ty_params_covering ty in
1602 let fty = mk_simple_ty_fn [| ty_params_ptr; alias_slot ty |] in
1603 get_typed_mem_glue g fty inner
1609 (curr_iso:Ast.ty_iso option)
1611 let g = GLUE_free ty in
1612 let inner _ (args:Il.cell) =
1613 (* Free-glue assumes it's called with a pointer to a box allocation with
1614 * normal box layout. It's just a way to move drop+free out of leaf
1617 let ty_params = deref (get_element_ptr args 0) in
1618 let cell = get_element_ptr args 1 in
1619 free_ty is_gc ty_params ty cell curr_iso
1621 let ty_params_ptr = ty_params_covering ty in
1622 let fty = mk_simple_ty_fn [| ty_params_ptr; local_slot ty |] in
1623 get_typed_mem_glue g fty inner
1628 (curr_iso:Ast.ty_iso option)
1630 let g = GLUE_sever ty in
1631 let inner _ (args:Il.cell) =
1632 let ty_params = deref (get_element_ptr args 0) in
1633 let cell = get_element_ptr args 1 in
1634 note_gc_step ty "in sever-glue, severing";
1635 sever_ty ty_params (deref cell) ty curr_iso;
1636 note_gc_step ty "in sever-glue complete";
1638 let ty_params_ptr = ty_params_covering ty in
1639 let fty = mk_simple_ty_fn [| ty_params_ptr; alias_slot ty |] in
1640 get_typed_mem_glue g fty inner
1645 (curr_iso:Ast.ty_iso option)
1647 let g = GLUE_mark ty in
1648 let inner _ (args:Il.cell) =
1649 let ty_params = deref (get_element_ptr args 0) in
1650 let cell = get_element_ptr args 1 in
1651 note_gc_step ty "in mark-glue, marking";
1652 mark_ty ty_params (deref cell) ty curr_iso;
1653 note_gc_step ty "mark-glue complete";
1655 let ty_params_ptr = ty_params_covering ty in
1656 let fty = mk_simple_ty_fn [| ty_params_ptr; alias_slot ty |] in
1657 get_typed_mem_glue g fty inner
1662 (curr_iso:Ast.ty_iso option)
1664 let g = GLUE_clone ty in
1665 let inner (out_ptr:Il.cell) (args:Il.cell) =
1666 let dst = deref out_ptr in
1667 let ty_params = deref (get_element_ptr args 0) in
1668 let src = deref (get_element_ptr args 1) in
1669 let clone_task = get_element_ptr args 2 in
1670 clone_ty ty_params clone_task dst src ty curr_iso
1672 let ty_params_ptr = ty_params_covering ty in
1675 (local_slot ty) (* dst *)
1678 alias_slot ty; (* src *)
1679 word_slot (* clone-task *)
1682 get_typed_mem_glue g fty inner
1687 (curr_iso:Ast.ty_iso option)
1689 let g = GLUE_copy ty in
1690 let inner (out_ptr:Il.cell) (args:Il.cell) =
1691 let dst = deref out_ptr in
1692 let ty_params = deref (get_element_ptr args 0) in
1693 let src = deref (get_element_ptr args 1) in
1694 trans_copy_ty ty_params false dst ty src ty curr_iso
1696 let ty_params_ptr = ty_params_covering ty in
1700 [| ty_params_ptr; alias_slot ty |]
1702 get_typed_mem_glue g fty inner
1705 (* Glue functions use mostly the same calling convention as ordinary
1708 * Each glue function expects its own particular arguments, which are
1709 * usually aliases-- ie, caller doesn't transfer ownership to the
1710 * glue. And nothing is represented in terms of AST nodes. So we
1711 * don't do lvals-and-atoms here.
1716 (dst:Il.cell option)
1717 (args:Il.cell array)
1720 let scratch = next_vreg_cell Il.voidptr_t in
1721 let pop _ = emit (Il.Pop scratch) in
1722 for i = ((Array.length args) - 1) downto 0
1724 emit (Il.Push (Il.Cell args.(i)))
1726 emit (Il.Push (Il.Cell abi.Abi.abi_tp_cell));
1731 Array.iter (fun _ -> pop()) args;
1735 | Some dst -> aliasing true dst (fun dst -> inner (Il.Cell dst))
1737 and trans_call_static_glue
1739 (dst:Il.cell option)
1740 (args:Il.cell array)
1742 trans_call_glue (code_of_operand callee) dst args
1744 and trans_call_dynamic_glue
1747 (dst:Il.cell option)
1748 (args:Il.cell array)
1750 let fptr = get_vtbl_entry_idx tydesc idx in
1751 trans_call_glue (code_of_operand (Il.Cell fptr)) dst args
1753 and trans_call_simple_static_glue
1758 trans_call_static_glue
1759 (code_fixup_to_ptr_operand fix)
1760 None [| alias ty_params; arg |]
1762 and get_tydesc_params
1763 (outer_ty_params:Il.cell)
1767 get_element_ptr (deref td) Abi.tydesc_field_first_param
1769 let res = next_vreg_cell Il.voidptr_t in
1770 mov res (Il.Cell (alias outer_ty_params));
1771 emit (Il.cmp (Il.Cell first_param) zero);
1772 let no_param_jmp = mark() in
1773 emit (Il.jmp Il.JE Il.CodeNone);
1774 mov res (Il.Cell first_param);
1778 and trans_call_simple_dynamic_glue
1785 annotate (Printf.sprintf "calling tydesc[%d].glue[%d]"
1786 ty_param vtbl_idx));
1787 let td = get_ty_param ty_params ty_param in
1788 let ty_params_ptr = get_tydesc_params ty_params td in
1789 trans_call_dynamic_glue
1791 None [| ty_params_ptr; arg; |]
1793 (* trans_compare returns a quad number of the cjmp, which the caller
1794 patches to the cjmp destination. *)
1800 (* FIXME: this is an x86-ism; abstract via ABI. *)
1801 emit (Il.cmp (Il.Cell (Il.Reg (force_to_reg lhs))) rhs);
1803 emit (Il.jmp cjmp Il.CodeNone);
1806 and trans_cond (invert:bool) (expr:Ast.expr) : quad_idx list =
1812 annotate ((Fmt.fmt_to_str Ast.fmt_expr expr) ^
1818 Ast.EXPR_binary (binop, a, b) ->
1819 let lhs = trans_atom a in
1820 let rhs = trans_atom b in
1821 let cjmp = binop_to_jmpop binop in
1831 | _ -> bug () "Unhandled inverse binop in trans_cond"
1836 trans_compare cjmp' lhs rhs
1839 let bool_operand = trans_expr expr in
1841 trans_compare Il.JNE bool_operand
1842 (if invert then imm_true else imm_false)
1844 and trans_binop (binop:Ast.binop) : Il.binop =
1846 Ast.BINOP_or -> Il.OR
1847 | Ast.BINOP_and -> Il.AND
1848 | Ast.BINOP_xor -> Il.XOR
1850 | Ast.BINOP_lsl -> Il.LSL
1851 | Ast.BINOP_lsr -> Il.LSR
1852 | Ast.BINOP_asr -> Il.ASR
1854 | Ast.BINOP_add -> Il.ADD
1855 | Ast.BINOP_sub -> Il.SUB
1857 (* FIXME (issue #57):
1858 * switch on type of operands, IMUL/IDIV/IMOD etc.
1860 | Ast.BINOP_mul -> Il.UMUL
1861 | Ast.BINOP_div -> Il.UDIV
1862 | Ast.BINOP_mod -> Il.UMOD
1863 | _ -> bug () "bad binop to Trans.trans_binop"
1868 (rhs:Il.operand) : Il.operand =
1870 let bits = Il.operand_bits word_bits lhs in
1871 let dst = Il.Reg (Il.next_vreg (emitter()), Il.ValTy bits) in
1872 emit (Il.binary op dst lhs rhs);
1876 Ast.BINOP_or | Ast.BINOP_and | Ast.BINOP_xor
1877 | Ast.BINOP_lsl | Ast.BINOP_lsr | Ast.BINOP_asr
1878 | Ast.BINOP_add | Ast.BINOP_sub
1879 (* FIXME (issue #57):
1880 * switch on type of operands, IMUL/IDIV/IMOD etc.
1882 | Ast.BINOP_mul | Ast.BINOP_div | Ast.BINOP_mod ->
1883 arith (trans_binop binop)
1885 | _ -> let dst = Il.Reg (Il.next_vreg (emitter()), Il.ValTy Il.Bits8) in
1887 let jmps = trans_compare (binop_to_jmpop binop) lhs rhs in
1889 List.iter patch jmps;
1893 and trans_expr (expr:Ast.expr) : Il.operand =
1899 annotate ((Fmt.fmt_to_str Ast.fmt_expr expr) ^
1900 ": plain exit, finale")
1904 Ast.EXPR_binary (binop, a, b) ->
1905 assert (is_prim_type (simplified_ty (atom_type cx a)));
1906 assert (is_prim_type (simplified_ty (atom_type cx b)));
1907 trans_binary binop (trans_atom a) (trans_atom b)
1909 | Ast.EXPR_unary (unop, a) ->
1910 assert (is_prim_type (simplified_ty (atom_type cx a)));
1911 let src = trans_atom a in
1912 let bits = Il.operand_bits word_bits src in
1913 let dst = Il.Reg (Il.next_vreg (emitter()), Il.ValTy bits) in
1914 let op = match unop with
1916 | Ast.UNOP_bitnot -> Il.NOT
1917 | Ast.UNOP_neg -> Il.NEG
1918 | Ast.UNOP_cast t ->
1919 let t = Hashtbl.find cx.ctxt_all_cast_types t.id in
1920 let at = atom_type cx a in
1921 let (t, at) = (simplified_ty t, simplified_ty at) in
1922 if (type_is_2s_complement at) &&
1923 (type_is_2s_complement t)
1925 if type_is_unsigned_2s_complement t
1929 err None "unsupported cast operator"
1932 emit (Il.unary op dst src);
1935 | Ast.EXPR_atom a ->
1938 and trans_block (block:Ast.block) : unit =
1939 trace_str cx.ctxt_sess.Session.sess_trace_block
1941 push_emitter_size_cache ();
1942 emit (Il.Enter (Hashtbl.find cx.ctxt_block_fixups block.id));
1943 Array.iter trans_stmt block.node;
1944 trace_str cx.ctxt_sess.Session.sess_trace_block
1947 pop_emitter_size_cache ();
1948 trace_str cx.ctxt_sess.Session.sess_trace_block
1951 and upcall_fixup (name:string) : fixup =
1952 Semant.require_native cx REQUIRED_LIB_rustrt name;
1957 (args:Il.operand array)
1959 abi.Abi.abi_emit_native_call (emitter())
1960 ret nabi_rust (upcall_fixup name) args;
1962 and trans_void_upcall
1964 (args:Il.operand array)
1966 abi.Abi.abi_emit_native_void_call (emitter())
1967 nabi_rust (upcall_fixup name) args;
1969 and trans_log_int (a:Ast.atom) : unit =
1970 trans_void_upcall "upcall_log_int" [| (trans_atom a) |]
1972 and trans_log_str (a:Ast.atom) : unit =
1973 trans_void_upcall "upcall_log_str" [| (trans_atom a) |]
1976 ((*initializing*)_:bool)
1980 (args:Ast.atom array)
1982 let (task_cell, _) = trans_lval_init dst in
1983 let (fptr_operand, fn_ty) = trans_callee fn_lval in
1984 (*let fn_ty_params = [| |] in*)
1986 (* FIXME (issue #82): handle indirect-spawns (clone closure). *)
1987 if not (lval_is_direct_fn cx fn_lval)
1988 then bug () "unhandled indirect-spawn"
1990 let args_rty = call_args_referent_type cx 0 fn_ty None in
1991 let fptr_operand = reify_ptr fptr_operand in
1992 let exit_task_glue_fixup = get_exit_task_glue () in
1994 calculate_sz_in_current_frame (Il.referent_ty_size word_bits args_rty)
1996 let exit_task_glue_fptr =
1997 code_fixup_to_ptr_operand exit_task_glue_fixup
1999 let exit_task_glue_fptr = reify_ptr exit_task_glue_fptr in
2001 iflog (fun _ -> annotate "spawn task: copy args");
2003 let new_task = next_vreg_cell Il.voidptr_t in
2004 let call = { call_ctrl = CALL_indirect;
2005 call_callee_ptr = fptr_operand;
2006 call_callee_ty = fn_ty;
2007 call_callee_ty_params = [| |];
2008 call_output = task_cell;
2010 call_iterator_args = [| |];
2011 call_indirect_args = [| |] }
2014 Ast.DOMAIN_thread ->
2016 trans_upcall "upcall_new_thread" new_task [| |];
2017 copy_fn_args false true (CLONE_all new_task) call;
2018 trans_upcall "upcall_start_thread" task_cell
2021 exit_task_glue_fptr;
2028 trans_upcall "upcall_new_task" new_task [| |];
2029 copy_fn_args false true (CLONE_chan new_task) call;
2030 trans_upcall "upcall_start_task" task_cell
2033 exit_task_glue_fptr;
2040 and get_curr_span _ =
2041 if Stack.is_empty curr_stmt
2042 then ("<none>", 0, 0)
2044 let stmt_id = Stack.top curr_stmt in
2045 match (Session.get_span cx.ctxt_sess stmt_id) with
2046 None -> ("<none>", 0, 0)
2049 and trans_cond_fail (str:string) (fwd_jmps:quad_idx list) : unit =
2050 let (filename, line, _) = get_curr_span () in
2051 iflog (fun _ -> annotate ("condition-fail: " ^ str));
2052 trans_void_upcall "upcall_fail"
2054 trans_static_string str;
2055 trans_static_string filename;
2056 imm (Int64.of_int line)
2058 List.iter patch fwd_jmps
2060 and trans_check_expr (id:node_id) (e:Ast.expr) : unit =
2061 match simplified_ty (expr_type cx e) with
2063 let fwd_jmps = trans_cond false e in
2064 trans_cond_fail (Fmt.fmt_to_str Ast.fmt_expr e) fwd_jmps
2065 | _ -> bugi cx id "check expr on non-bool"
2070 (gc_ctrl_word:Il.operand)
2072 trans_upcall "upcall_malloc" dst [| nbytes; gc_ctrl_word |]
2074 and trans_free (src:Il.cell) (is_gc:bool) : unit =
2075 let is_gc = if is_gc then 1L else 0L in
2076 trans_void_upcall "upcall_free" [| Il.Cell src; imm is_gc |]
2078 and trans_yield () : unit =
2079 trans_void_upcall "upcall_yield" [| |];
2081 and trans_fail () : unit =
2082 let (filename, line, _) = get_curr_span () in
2083 trans_void_upcall "upcall_fail"
2085 trans_static_string "explicit failure";
2086 trans_static_string filename;
2087 imm (Int64.of_int line)
2090 and trans_join (task:Ast.lval) : unit =
2091 trans_void_upcall "upcall_join" [| trans_atom (Ast.ATOM_lval task) |]
2093 and trans_send (chan:Ast.lval) (src:Ast.lval) : unit =
2094 let (srccell, _) = trans_lval src in
2095 aliasing false srccell
2098 trans_void_upcall "upcall_send"
2099 [| trans_atom (Ast.ATOM_lval chan);
2100 Il.Cell src_alias |];
2103 and trans_recv (initializing:bool) (dst:Ast.lval) (chan:Ast.lval) : unit =
2104 let (dstcell, _) = trans_lval_maybe_init initializing dst in
2105 aliasing true dstcell
2108 trans_void_upcall "upcall_recv"
2109 [| Il.Cell dst_alias;
2110 trans_atom (Ast.ATOM_lval chan) |];
2113 and trans_init_port (dst:Ast.lval) : unit =
2114 let (dstcell, dst_ty) = trans_lval_init dst in
2115 let unit_ty = match dst_ty with
2117 | _ -> bug () "init dst of port-init has non-port type"
2119 let unit_sz = ty_sz abi unit_ty in
2120 trans_upcall "upcall_new_port" dstcell [| imm unit_sz |]
2122 and trans_del_port (port:Il.cell) : unit =
2123 trans_void_upcall "upcall_del_port" [| Il.Cell port |]
2125 and trans_init_chan (dst:Ast.lval) (port:Ast.lval) : unit =
2126 let (dstcell, _) = trans_lval_init dst
2128 trans_upcall "upcall_new_chan" dstcell
2129 [| trans_atom (Ast.ATOM_lval port) |]
2131 and trans_del_chan (chan:Il.cell) : unit =
2132 trans_void_upcall "upcall_del_chan" [| Il.Cell chan |]
2134 and trans_kill_task (task:Il.cell) : unit =
2135 trans_void_upcall "upcall_kill" [| Il.Cell task |]
2138 * A vec is implicitly boxed: every slot vec[T] is 1 word and
2139 * points to a refcounted structure. That structure has 3 words with
2140 * defined meaning at the beginning; data follows the header.
2142 * word 0: refcount or gc control word
2143 * word 1: allocated size of data
2144 * word 2: initialised size of data
2147 * This 3-word prefix is shared with strings, we factor the common
2148 * part out for reuse in string code.
2151 and trans_init_vec (dst:Ast.lval) (atoms:Ast.atom array) : unit =
2152 let (dst_cell, dst_ty) = trans_lval_init dst in
2154 if (ty_mem_ctrl dst_ty) = MEM_gc
2155 then Il.Cell (get_tydesc None dst_ty)
2158 let unit_ty = match dst_ty with
2160 | _ -> bug () "init dst of vec-init has non-vec type"
2162 let fill = next_vreg_cell word_sty in
2163 let unit_sz = ty_sz_in_current_frame unit_ty in
2164 umul fill unit_sz (imm (Int64.of_int (Array.length atoms)));
2165 trans_upcall "upcall_new_vec" dst_cell [| Il.Cell fill; gc_ctrl |];
2166 let vec = deref dst_cell in
2169 (get_element_ptr_dyn_in_current_frame
2170 vec Abi.vec_elt_data))
2172 let unit_rty = referent_type abi unit_ty in
2173 let body_rty = Il.StructTy (Array.map (fun _ -> unit_rty) atoms) in
2174 let body = Il.Mem (body_mem, body_rty) in
2178 let cell = get_element_ptr_dyn_in_current_frame body i in
2179 trans_init_ty_from_atom cell unit_ty atom
2182 mov (get_element_ptr vec Abi.vec_elt_fill) (Il.Cell fill);
2185 and trans_init_box (dst:Ast.lval) (src:Ast.atom) : unit =
2186 let src_op = trans_atom src in
2187 let src_cell = Il.Mem (force_to_mem src_op) in
2188 let src_ty = simplified_ty (atom_type cx src) in
2189 let dst_sloti = lval_base_to_slot cx dst in
2190 let dst_cell = cell_of_block_slot dst_sloti.id in
2191 let dst_cell = deref_slot true dst_cell dst_sloti.node in
2192 let dst_ty = slot_ty dst_sloti.node in
2193 let (dst_cell, dst_ty) =
2194 deref_ty DEREF_one_box true dst_cell dst_ty
2196 let _ = assert (dst_ty = src_ty) in
2197 trans_copy_ty (get_ty_params_of_current_frame()) true
2198 dst_cell dst_ty src_cell src_ty None
2201 and get_dynamic_tydesc (idopt:node_id option) (t:Ast.ty) : Il.cell =
2202 let td = next_vreg_cell Il.voidptr_t in
2204 Il.Cell (crate_rel_to_ptr
2205 (get_static_tydesc idopt t 0L 0L)
2208 let (t, param_descs) = linearize_ty_params t in
2209 let descs = Array.append [| root_desc |] param_descs in
2210 let n = Array.length descs in
2211 let rty = referent_type abi t in
2212 let (size_sz, align_sz) = Il.referent_ty_layout word_bits rty in
2213 let size = calculate_sz_in_current_frame size_sz in
2214 let align = calculate_sz_in_current_frame align_sz in
2215 let descs_ptr = next_vreg_cell Il.voidptr_t in
2216 if (Array.length descs) > 0
2218 (* FIXME (issue #83): this relies on knowledge that spills are
2222 Array.map (fun _ -> next_spill_cell Il.voidptr_t) descs
2224 Array.iteri (fun i t -> mov spills.(n-(i+1)) t) descs;
2225 lea descs_ptr (fst (need_mem_cell spills.(n-1)))
2228 trans_upcall "upcall_get_type_desc" td
2229 [| Il.Cell (curr_crate_ptr());
2230 size; align; imm (Int64.of_int n);
2231 Il.Cell descs_ptr |];
2234 and get_tydesc (idopt:node_id option) (ty:Ast.ty) : Il.cell =
2235 log cx "getting tydesc for %a" Ast.sprintf_ty ty;
2236 match simplified_ty ty with
2237 Ast.TY_param (idx, _) ->
2238 (get_ty_param_in_current_frame idx)
2239 | t when has_parametric_types t ->
2240 (get_dynamic_tydesc idopt t)
2242 (crate_rel_to_ptr (get_static_tydesc idopt ty
2247 and box_rc_cell (cell:Il.cell) : Il.cell =
2248 get_element_ptr (deref cell) Abi.box_rc_slot_field_refcnt
2250 and box_allocation_size
2254 match ty_mem_ctrl ty with
2257 | MEM_rc_struct -> word_n Abi.box_rc_header_size
2258 | MEM_interior -> bug () "box_allocation_size of MEM_interior"
2260 let ty = simplified_ty ty in
2262 Il.referent_ty_size abi.Abi.abi_word_bits (referent_type abi ty)
2265 SIZE_fixed _ -> imm (Int64.add (ty_sz abi ty) header_sz)
2267 let ty_params = get_ty_params_of_current_frame() in
2268 let refty_sz = calculate_sz ty_params refty_sz in
2269 let v = next_vreg word_sty in
2270 let vc = Il.Reg (v, word_sty) in
2272 add_to vc (imm header_sz);
2280 (f:Il.cell -> Il.cell -> Ast.ty -> (Ast.ty_iso option) -> unit)
2281 (curr_iso:Ast.ty_iso option)
2283 let tag_keys = sorted_htab_keys ttag in
2284 let src_tag = get_element_ptr src_cell 0 in
2285 let dst_tag = get_element_ptr dst_cell 0 in
2286 let src_union = get_element_ptr_dyn ty_params src_cell 1 in
2287 let dst_union = get_element_ptr_dyn ty_params dst_cell 1 in
2288 let tmp = next_vreg_cell word_sty in
2289 f dst_tag src_tag word_ty curr_iso;
2290 mov tmp (Il.Cell src_tag);
2295 annotate (Printf.sprintf "tag case #%i == %a" i
2296 Ast.sprintf_name key)));
2298 trans_compare Il.JNE (Il.Cell tmp) (imm (Int64.of_int i))
2300 let ttup = Hashtbl.find ttag key in
2302 (get_element_ptr_dyn ty_params)
2303 (get_variant_ptr dst_union i)
2304 (get_variant_ptr src_union i)
2306 List.iter patch jmps
2310 and get_iso_tag tiso =
2311 tiso.Ast.iso_group.(tiso.Ast.iso_index)
2314 and seq_unit_ty (seq:Ast.ty) : Ast.ty =
2315 match simplified_ty seq with
2317 | Ast.TY_str -> Ast.TY_mach TY_u8
2318 | _ -> bug () "seq_unit_ty of non-vec, non-str type"
2326 (f:Il.cell -> Il.cell -> Ast.ty -> (Ast.ty_iso option) -> unit)
2327 (curr_iso:Ast.ty_iso option)
2329 let unit_sz = ty_sz_with_ty_params ty_params unit_ty in
2331 * Unlike most of the iter_ty_parts helpers; this one allocates a
2332 * vreg and so has to be aware of when it's iterating over 2
2333 * sequences of cells or just 1.
2335 check_box_rty src_cell;
2336 check_box_rty dst_cell;
2337 if dst_cell = src_cell
2340 let src_cell = deref src_cell in
2342 get_element_ptr_dyn ty_params src_cell Abi.vec_elt_data
2344 let len = get_element_ptr src_cell Abi.vec_elt_fill in
2345 let ptr = next_vreg_cell Il.voidptr_t in
2346 let lim = next_vreg_cell Il.voidptr_t in
2347 lea lim (fst (need_mem_cell data));
2348 mov ptr (Il.Cell lim);
2349 add_to lim (Il.Cell len);
2350 let back_jmp_target = mark () in
2351 let fwd_jmps = trans_compare Il.JAE (Il.Cell ptr) (Il.Cell lim) in
2353 deref (ptr_cast ptr (referent_type abi unit_ty))
2355 f unit_cell unit_cell unit_ty curr_iso;
2357 check_interrupt_flag ();
2358 emit (Il.jmp Il.JMP (Il.CodeLabel back_jmp_target));
2359 List.iter patch fwd_jmps;
2363 bug () "Unsupported form of seq iter: src != dst."
2367 and iter_ty_parts_full
2372 (f:Il.cell -> Il.cell -> Ast.ty -> (Ast.ty_iso option) -> unit)
2373 (curr_iso:Ast.ty_iso option)
2376 * FIXME: this will require some reworking if we support
2377 * rec, tag or tup slots that fit in a vreg. It requires
2380 match strip_mutable_or_constrained_ty ty with
2381 Ast.TY_rec entries ->
2383 (get_element_ptr_dyn ty_params) dst_cell src_cell
2388 (get_element_ptr_dyn ty_params) dst_cell src_cell
2392 iter_tag_parts ty_params dst_cell src_cell tag f curr_iso
2394 | Ast.TY_iso tiso ->
2395 let ttag = get_iso_tag tiso in
2396 iter_tag_parts ty_params dst_cell src_cell ttag f (Some tiso)
2399 | Ast.TY_obj _ -> bug () "Attempting to iterate over fn/pred/obj slots"
2403 let unit_ty = seq_unit_ty ty in
2404 iter_seq_parts ty_params dst_cell src_cell unit_ty f curr_iso
2409 * This just calls iter_ty_parts_full with your cell as both src and
2410 * dst, with an adaptor function that discards the dst parts of the
2411 * parallel traversal and and calls your provided function on the
2412 * passed-in src parts.
2418 (f:Il.cell -> Ast.ty -> (Ast.ty_iso option) -> unit)
2419 (curr_iso:Ast.ty_iso option)
2421 iter_ty_parts_full ty_params cell cell ty
2422 (fun _ src_cell ty curr_iso -> f src_cell ty curr_iso)
2429 (curr_iso:Ast.ty_iso option)
2432 let ty = strip_mutable_or_constrained_ty ty in
2433 let ty = maybe_iso curr_iso ty in
2434 let curr_iso = maybe_enter_iso ty curr_iso in
2435 let mctrl = ty_mem_ctrl ty in
2440 note_drop_step ty "drop_ty: fn path";
2441 let binding = get_element_ptr cell Abi.binding_field_binding in
2442 let null_jmp = null_check binding in
2443 (* Drop non-null bindings. *)
2444 (* FIXME (issue #58): this is completely wrong, Closures need to
2445 * carry tydescs like objs. For now this only works by accident,
2446 * and will leak closures with box substructure.
2448 drop_ty ty_params binding (Ast.TY_box Ast.TY_int) curr_iso;
2450 note_drop_step ty "drop_ty: done fn path";
2453 note_drop_step ty "drop_ty: obj path";
2454 let binding = get_element_ptr cell Abi.binding_field_binding in
2455 let null_jmp = null_check binding in
2456 let obj = deref binding in
2457 let rc = get_element_ptr obj 0 in
2458 let rc_jmp = drop_refcount_and_cmp rc in
2459 let tydesc = get_element_ptr obj 1 in
2460 let body = get_element_ptr obj 2 in
2462 get_element_ptr (deref tydesc) Abi.tydesc_field_first_param
2465 get_element_ptr (deref tydesc) Abi.tydesc_field_obj_drop_glue
2467 let null_dtor_jmp = null_check dtor in
2468 (* Call any dtor, if present. *)
2469 note_drop_step ty "drop_ty: calling obj dtor";
2470 trans_call_dynamic_glue tydesc
2471 Abi.tydesc_field_obj_drop_glue None [| binding |];
2472 patch null_dtor_jmp;
2473 (* Drop the body. *)
2474 note_drop_step ty "drop_ty: dropping obj body";
2475 trans_call_dynamic_glue tydesc
2476 Abi.tydesc_field_drop_glue None [| ty_params; alias body |];
2477 (* FIXME: this will fail if the user has lied about the
2478 * state-ness of their obj. We need to store state-ness in the
2479 * captured tydesc, and use that. *)
2480 note_drop_step ty "drop_ty: freeing obj body";
2481 trans_free binding (type_has_state ty);
2485 note_drop_step ty "drop_ty: done obj path";
2488 | Ast.TY_param (i, _) ->
2489 note_drop_step ty "drop_ty: parametric-ty path";
2493 trans_call_simple_dynamic_glue
2494 i Abi.tydesc_field_drop_glue ty_params cell
2496 note_drop_step ty "drop_ty: done parametric-ty path";
2504 note_drop_step ty "drop_ty: box-drop path";
2506 let _ = check_box_rty cell in
2507 let null_jmp = null_check cell in
2508 let rc = box_rc_cell cell in
2509 let j = drop_refcount_and_cmp rc in
2511 (* FIXME (issue #25): check to see that the box has
2512 * further box members; if it doesn't we can elide the
2513 * call to the glue function. *)
2515 trans_call_simple_static_glue
2516 (get_free_glue ty (mctrl = MEM_gc) curr_iso)
2519 (* Null the slot out to prevent double-free if the frame
2525 note_drop_step ty "drop_ty: done box-drop path";
2527 | MEM_interior when type_is_structured ty ->
2528 note_drop_step ty "drop:ty structured-interior path";
2529 iter_ty_parts ty_params cell ty
2530 (drop_ty ty_params) curr_iso;
2531 note_drop_step ty "drop_ty: done structured-interior path";
2535 note_drop_step ty "drop_ty: no-op simple-interior path";
2536 (* Interior allocation of all-interior value not caught above:
2545 (curr_iso:Ast.ty_iso option)
2547 let _ = note_gc_step ty "severing" in
2549 let _ = check_box_rty c in
2550 let null_jmp = null_check c in
2551 let rc = box_rc_cell c in
2552 let _ = note_gc_step ty "severing GC cell" in
2553 emit (Il.binary Il.SUB rc (Il.Cell rc) one);
2557 let ty = strip_mutable_or_constrained_ty ty in
2562 if type_has_state ty
2564 let binding = get_element_ptr cell Abi.binding_field_binding in
2568 match ty_mem_ctrl ty with
2572 | MEM_interior when type_is_structured ty ->
2573 iter_ty_parts ty_params cell ty
2574 (sever_ty ty_params) curr_iso
2577 (* No need to follow links / call glue; severing is
2582 (clone_task:Il.cell)
2586 (curr_iso:Ast.ty_iso option)
2588 let ty = strip_mutable_or_constrained_ty ty in
2591 trans_upcall "upcall_clone_chan" dst
2592 [| (Il.Cell clone_task); (Il.Cell src) |]
2595 | _ when type_has_state ty
2596 -> bug () "cloning state type"
2597 | _ when i64_le (ty_sz abi ty) word_sz
2598 -> mov dst (Il.Cell src)
2600 | Ast.TY_obj _ -> ()
2602 let glue_fix = get_clone_glue ty curr_iso in
2603 trans_call_static_glue
2604 (code_fixup_to_ptr_operand glue_fix)
2606 [| alias ty_params; src; clone_task |]
2608 iter_ty_parts_full ty_params dst src ty
2609 (clone_ty ty_params clone_task) curr_iso
2616 (curr_iso:Ast.ty_iso option)
2619 note_drop_step ty "in free-ty";
2621 match simplified_ty ty with
2622 Ast.TY_port _ -> trans_del_port cell
2623 | Ast.TY_chan _ -> trans_del_chan cell
2624 | Ast.TY_task -> trans_kill_task cell
2625 | Ast.TY_str -> trans_free cell false
2627 iter_seq_parts ty_params cell cell s
2628 (fun _ src ty iso -> drop_ty ty_params src ty iso) curr_iso;
2629 trans_free cell is_gc
2632 note_drop_step ty "in free-ty, dropping structured body";
2635 (get_element_ptr_dyn ty_params (deref cell)
2636 Abi.box_rc_slot_field_body)
2638 let body_ty = simplified_ty ty in
2639 let vr = next_vreg_cell Il.voidptr_t in
2641 trace_word cx.ctxt_sess.Session.sess_trace_drop vr;
2642 trans_call_simple_static_glue
2643 (get_drop_glue body_ty curr_iso) ty_params vr;
2644 note_drop_step ty "in free-ty, calling free";
2645 trans_free cell is_gc;
2647 note_drop_step ty "free-ty done";
2650 (curr_iso:Ast.ty_iso option)
2653 match (curr_iso, strip_mutable_or_constrained_ty t) with
2654 (_, Ast.TY_idx _) -> bug () "traversing raw TY_idx (non-box )edge"
2655 | (Some iso, Ast.TY_box (Ast.TY_idx n)) ->
2656 Ast.TY_box (Ast.TY_iso { iso with Ast.iso_index = n })
2657 | (None, Ast.TY_box (Ast.TY_idx _)) ->
2658 bug () "TY_idx outside TY_iso"
2663 (curr_iso:Ast.ty_iso option)
2664 : Ast.ty_iso option =
2665 match strip_mutable_or_constrained_ty t with
2666 Ast.TY_box (Ast.TY_iso tiso) -> Some tiso
2673 (curr_iso:Ast.ty_iso option)
2675 (* Marking goes straight through aliases. Reachable means reachable. *)
2676 mark_ty ty_params (deref_slot false cell slot) (slot_ty slot) curr_iso
2682 (curr_iso:Ast.ty_iso option)
2684 let ty = strip_mutable_or_constrained_ty ty in
2685 match ty_mem_ctrl ty with
2687 let tmp = next_vreg_cell Il.voidptr_t in
2688 trans_upcall "upcall_mark" tmp [| Il.Cell cell |];
2690 trans_compare Il.JE (Il.Cell tmp) zero;
2692 (* Iterate over box parts marking outgoing links. *)
2695 (get_element_ptr (deref cell)
2696 Abi.box_gc_slot_field_body)
2698 let ty = maybe_iso curr_iso ty in
2699 let curr_iso = maybe_enter_iso ty curr_iso in
2701 trans_call_simple_static_glue
2702 (get_mark_glue ty curr_iso)
2704 List.iter patch marked_jump;
2706 | MEM_interior when type_is_structured ty ->
2708 annotate ("mark interior memory " ^
2709 (Fmt.fmt_to_str Ast.fmt_ty ty))));
2710 let (mem, _) = need_mem_cell cell in
2711 let tmp = next_vreg_cell Il.voidptr_t in
2712 let ty = maybe_iso curr_iso ty in
2713 let curr_iso = maybe_enter_iso ty curr_iso in
2715 trans_call_simple_static_glue
2716 (get_mark_glue ty curr_iso)
2721 and check_box_rty cell =
2723 Il.Reg (_, Il.AddrTy (Il.StructTy fields))
2724 | Il.Mem (_, Il.ScalarTy (Il.AddrTy (Il.StructTy fields)))
2725 when (((Array.length fields) > 0) && (fields.(0) = word_rty)) -> ()
2727 "expected plausibly-box cell, got %s"
2728 (Il.string_of_referent_ty (Il.cell_referent_ty cell))
2730 and drop_slot_in_current_frame
2733 (curr_iso:Ast.ty_iso option)
2735 drop_slot (get_ty_params_of_current_frame()) cell slot curr_iso
2737 and null_check (cell:Il.cell) : quad_idx =
2738 emit (Il.cmp (Il.Cell cell) zero);
2740 emit (Il.jmp Il.JE Il.CodeNone);
2743 and drop_refcount_and_cmp (rc:Il.cell) : quad_idx =
2744 iflog (fun _ -> annotate "drop refcount and maybe free");
2745 emit (Il.binary Il.SUB rc (Il.Cell rc) one);
2746 emit (Il.cmp (Il.Cell rc) zero);
2748 emit (Il.jmp Il.JNE Il.CodeNone);
2755 (curr_iso:Ast.ty_iso option)
2757 match slot.Ast.slot_mode with
2758 Ast.MODE_alias -> ()
2759 (* Aliases are always free to drop. *)
2761 drop_ty ty_params cell (slot_ty slot) curr_iso
2763 and note_drop_step ty step =
2764 if cx.ctxt_sess.Session.sess_trace_drop ||
2765 cx.ctxt_sess.Session.sess_log_trans
2768 match ty_mem_ctrl ty with
2770 | MEM_rc_struct -> "MEM_rc_struct"
2771 | MEM_rc_opaque -> "MEM_rc_opaque"
2772 | MEM_interior -> "MEM_interior"
2774 let tystr = Fmt.fmt_to_str Ast.fmt_ty ty in
2775 let str = step ^ " " ^ mctrl_str ^ " " ^ tystr in
2778 trace_str cx.ctxt_sess.Session.sess_trace_drop str
2781 and note_gc_step ty step =
2782 if cx.ctxt_sess.Session.sess_trace_gc ||
2783 cx.ctxt_sess.Session.sess_log_trans
2786 match ty_mem_ctrl ty with
2788 | MEM_rc_struct -> "MEM_rc_struct"
2789 | MEM_rc_opaque -> "MEM_rc_opaque"
2790 | MEM_interior -> "MEM_interior"
2792 let tystr = Fmt.fmt_to_str Ast.fmt_ty ty in
2793 let str = step ^ " " ^ mctrl_str ^ " " ^ tystr in
2796 trace_str cx.ctxt_sess.Session.sess_trace_gc str
2799 (* Returns the offset of the slot-body in the initialized allocation. *)
2800 and init_box (cell:Il.cell) (ty:Ast.ty) : unit =
2801 let mctrl = ty_mem_ctrl ty in
2808 then Il.Cell (get_tydesc None ty)
2811 iflog (fun _ -> annotate "init box: malloc");
2812 let sz = box_allocation_size ty in
2813 trans_malloc cell sz ctrl;
2814 iflog (fun _ -> annotate "init box: load refcount");
2815 let rc = box_rc_cell cell in
2818 | MEM_interior -> bug () "init_box of MEM_interior"
2825 : (Il.cell * Ast.ty) =
2826 match (ty, dctrl) with
2828 | (Ast.TY_mutable ty, _)
2829 | (Ast.TY_constrained (ty, _), _) ->
2830 deref_ty dctrl initializing cell ty
2832 | (Ast.TY_box ty', DEREF_one_box)
2833 | (Ast.TY_box ty', DEREF_all_boxes) ->
2836 then init_box cell ty;
2838 get_element_ptr_dyn_in_current_frame
2840 (Abi.box_rc_slot_field_body)
2843 if dctrl = DEREF_one_box
2845 else DEREF_all_boxes
2847 (* Possibly deref recursively. *)
2848 deref_ty inner_dctrl initializing cell ty'
2858 match slot.Ast.slot_mode with
2862 | Ast.MODE_alias _ ->
2877 let sub_dst_cell = get_element_ptr_dyn ty_params dst i in
2878 let sub_src_cell = get_element_ptr_dyn ty_params src i in
2880 ty_params initializing
2881 sub_dst_cell ty sub_src_cell ty None
2888 (dst:Il.cell) (dst_ty:Ast.ty)
2889 (src:Il.cell) (src_ty:Ast.ty)
2890 (curr_iso:Ast.ty_iso option)
2892 let anno (weight:string) : unit =
2897 (Printf.sprintf "%sweight copy: %a <- %a"
2899 Ast.sprintf_ty dst_ty
2900 Ast.sprintf_ty src_ty)
2906 log cx "trans_copy_ty";
2907 log cx " dst ty %a, src ty %a"
2908 Ast.sprintf_ty dst_ty Ast.sprintf_ty src_ty;
2909 log cx " dst cell %s, src cell %s"
2910 (cell_str dst) (cell_str src);
2912 assert (simplified_ty src_ty = simplified_ty dst_ty);
2913 match (ty_mem_ctrl src_ty, ty_mem_ctrl dst_ty) with
2915 | (MEM_rc_opaque, MEM_rc_opaque)
2917 | (MEM_rc_struct, MEM_rc_struct) ->
2918 (* Lightweight copy: twiddle refcounts, move pointer. *)
2919 anno "refcounted light";
2920 add_to (box_rc_cell src) one;
2923 drop_ty ty_params dst dst_ty None;
2924 mov dst (Il.Cell src)
2927 (* Heavyweight copy: duplicate 1 level of the referent. *)
2929 trans_copy_ty_heavy ty_params initializing
2930 dst dst_ty src src_ty curr_iso
2932 (* NB: heavyweight copying here does not mean "producing a deep
2933 * clone of the entire data tree rooted at the src operand". It means
2934 * "replicating a single level of the tree".
2936 * There is no general-recursion entailed in performing a heavy
2937 * copy. There is only "one level" to each heavy copy call.
2939 * In other words, this is a lightweight copy:
2941 * [dstptr] <-copy- [srcptr]
2944 * [some record.rc++]
2946 * [some other record]
2948 * Whereas this is a heavyweight copy:
2950 * [dstptr] <-copy- [srcptr]
2953 * [some record] [some record]
2955 * [some other record]
2959 and trans_copy_ty_heavy
2962 (dst:Il.cell) (dst_ty:Ast.ty)
2963 (src:Il.cell) (src_ty:Ast.ty)
2964 (curr_iso:Ast.ty_iso option)
2966 let src_ty = strip_mutable_or_constrained_ty src_ty in
2967 let dst_ty = strip_mutable_or_constrained_ty dst_ty in
2968 let dst_ty = maybe_iso curr_iso dst_ty in
2969 let src_ty = maybe_iso curr_iso src_ty in
2974 log cx "trans_copy_ty_heavy";
2975 log cx " dst ty %a, src ty %a"
2976 Ast.sprintf_ty dst_ty Ast.sprintf_ty src_ty;
2977 log cx " dst cell %s, src cell %s"
2978 (cell_str dst) (cell_str src);
2981 assert (src_ty = dst_ty);
2983 annotate ("heavy copy: slot preparation"));
2985 let curr_iso = maybe_enter_iso dst_ty curr_iso in
2986 let (dst, ty) = deref_ty DEREF_none initializing dst dst_ty in
2987 let (src, _) = deref_ty DEREF_none false src src_ty in
2988 assert (ty = dst_ty);
3000 (Printf.sprintf "copy_ty: simple mov (%Ld byte scalar)"
3002 mov dst (Il.Cell src)
3004 | Ast.TY_param (i, _) ->
3007 (Printf.sprintf "copy_ty: parametric copy %#d" i));
3011 let td = get_ty_param ty_params i in
3012 let ty_params_ptr = get_tydesc_params ty_params td in
3013 trans_call_dynamic_glue
3014 td Abi.tydesc_field_copy_glue
3015 (Some dst) [| ty_params_ptr; src; |]
3021 let src_item = get_element_ptr src Abi.binding_field_item in
3022 let dst_item = get_element_ptr dst Abi.binding_field_item in
3024 get_element_ptr src Abi.binding_field_binding
3027 get_element_ptr dst Abi.binding_field_binding
3029 mov dst_item (Il.Cell src_item);
3030 let null_jmp = null_check src_binding in
3031 (* Copy if we have a src binding. *)
3032 (* FIXME (issue #58): this is completely wrong, call
3033 * through to the binding's self-copy fptr. For now
3034 * this only works by accident.
3036 trans_copy_ty ty_params initializing
3037 dst_binding (Ast.TY_box Ast.TY_int)
3038 src_binding (Ast.TY_box Ast.TY_int)
3044 iter_ty_parts_full ty_params dst src ty
3045 (fun dst src ty curr_iso ->
3046 trans_copy_ty ty_params true
3047 dst ty src ty curr_iso)
3056 let (dst_cell, dst_ty) = trans_lval_maybe_init initializing dst in
3057 let dst_ty = strip_mutable_or_constrained_ty dst_ty in
3058 let rec can_append t =
3061 | Ast.TY_str -> true
3062 | Ast.TY_box t when can_append t -> true
3065 match (dst_ty, src) with
3067 Ast.EXPR_binary (Ast.BINOP_add,
3068 Ast.ATOM_lval a, Ast.ATOM_lval b))
3069 when can_append t ->
3071 * Translate str or vec
3080 let (a_cell, a_ty) = trans_lval a in
3081 let (b_cell, b_ty) = trans_lval b in
3083 (get_ty_params_of_current_frame())
3084 initializing dst_cell dst_ty
3086 trans_vec_append dst_cell dst_ty
3087 (Il.Cell b_cell) b_ty
3090 | (Ast.TY_obj caller_obj_ty,
3091 Ast.EXPR_unary (Ast.UNOP_cast t, a)) ->
3092 let src_ty = atom_type cx a in
3093 let _ = assert (not (is_prim_type (src_ty))) in
3095 let t = Hashtbl.find cx.ctxt_all_cast_types t.id in
3096 let _ = assert (t = (Ast.TY_obj caller_obj_ty)) in
3098 match atom_type cx a with
3100 | _ -> bug () "obj cast from non-obj type"
3102 let src_cell = need_cell (trans_atom a) in
3104 (* FIXME (issue #84): this is wrong. It treats the underlying
3105 * obj-state as the same as the callee and simply substitutes
3106 * the forwarding vtbl, which would be great if it had any way
3107 * convey the callee vtbl to the forwarding functions. But it
3108 * doesn't. Instead, we have to malloc a fresh 3-word
3109 * refcounted obj to hold the callee's vtbl+state pair, copy
3110 * that in as the state here. *)
3112 trans_copy_ty (get_ty_params_of_current_frame())
3117 let caller_vtbl_oper =
3118 get_forwarding_vtbl caller_obj_ty callee_obj_ty
3120 let (caller_obj, _) =
3121 deref_ty DEREF_none initializing dst_cell dst_ty
3124 get_element_ptr caller_obj Abi.binding_field_item
3126 mov caller_vtbl caller_vtbl_oper
3129 | (_, Ast.EXPR_binary _)
3130 | (_, Ast.EXPR_unary _)
3131 | (_, Ast.EXPR_atom (Ast.ATOM_literal _)) ->
3133 * Translations of these expr types yield vregs,
3134 * so copy is just MOV into the lval.
3136 let src_operand = trans_expr src in
3138 (fst (deref_ty DEREF_none false dst_cell dst_ty))
3141 | (_, Ast.EXPR_atom (Ast.ATOM_lval src_lval)) ->
3142 if lval_is_direct_fn cx src_lval then
3143 trans_copy_direct_fn dst_cell src_lval
3145 (* Possibly-large structure copying *)
3146 let (src_cell, src_ty) = trans_lval src_lval in
3148 (get_ty_params_of_current_frame())
3154 and trans_copy_direct_fn
3158 let item = lval_item cx flv in
3159 let fix = Hashtbl.find cx.ctxt_fn_fixups item.id in
3161 let dst_pair_item_cell =
3162 get_element_ptr dst_cell Abi.binding_field_item
3164 let dst_pair_binding_cell =
3165 get_element_ptr dst_cell Abi.binding_field_binding
3167 mov dst_pair_item_cell (crate_rel_imm fix);
3168 mov dst_pair_binding_cell zero
3171 and trans_init_structural_from_atoms
3173 (dst_tys:Ast.ty array)
3174 (atoms:Ast.atom array)
3179 trans_init_ty_from_atom
3180 (get_element_ptr_dyn_in_current_frame dst i)
3185 and trans_init_rec_update
3187 (dst_tys:Ast.ty array)
3189 (atab:(Ast.ident * Ast.atom) array)
3194 fun i (fml_ident, _) ->
3195 let fml_entry _ (act_ident, atom) =
3196 if act_ident = fml_ident then Some atom else None
3198 let dst_ty = dst_tys.(i) in
3199 match arr_search atab fml_entry with
3201 trans_init_ty_from_atom
3202 (get_element_ptr_dyn_in_current_frame dst i)
3205 let (src, _) = trans_lval base in
3207 (get_ty_params_of_current_frame()) true
3208 (get_element_ptr_dyn_in_current_frame dst i) dst_ty
3209 (get_element_ptr_dyn_in_current_frame src i) dst_ty
3214 and trans_init_ty_from_atom
3215 (dst:Il.cell) (ty:Ast.ty) (atom:Ast.atom)
3217 let src = Il.Mem (force_to_mem (trans_atom atom)) in
3218 trans_copy_ty (get_ty_params_of_current_frame())
3219 true dst ty src ty None
3221 and trans_init_slot_from_cell
3224 (dst:Il.cell) (dst_slot:Ast.slot)
3225 (src:Il.cell) (src_ty:Ast.ty)
3227 let dst_ty = slot_ty dst_slot in
3230 log cx "trans_init_slot_from_cell";
3231 log cx " dst slot %a, src ty %a"
3232 Ast.sprintf_slot dst_slot Ast.sprintf_ty src_ty;
3233 log cx " dst cell %s, src cell %s"
3234 (cell_str dst) (cell_str src))
3236 match (dst_slot.Ast.slot_mode, clone) with
3237 (Ast.MODE_alias, CLONE_none) ->
3238 mov dst (Il.Cell (alias (Il.Mem (need_mem_cell src))))
3240 | (Ast.MODE_local, CLONE_none) ->
3243 dst dst_ty src src_ty None
3245 | (Ast.MODE_alias, _) ->
3246 bug () "attempting to clone into alias slot"
3248 | (_, CLONE_chan clone_task) ->
3250 if (type_contains_chan src_ty)
3251 then CLONE_all clone_task
3254 (* Feed back with massaged args. *)
3255 trans_init_slot_from_cell ty_params
3256 clone dst dst_slot src src_ty
3258 | (_, CLONE_all clone_task) ->
3259 clone_ty ty_params clone_task dst src src_ty None
3262 and trans_init_slot_from_atom
3264 (dst:Il.cell) (dst_slot:Ast.slot)
3269 log cx "trans_init_slot_from_atom";
3270 log cx " dst slot %a, src ty %a"
3271 Ast.sprintf_slot dst_slot
3272 Ast.sprintf_ty (atom_type cx src_atom);
3273 log cx " dst cell %s"
3276 match (dst_slot.Ast.slot_mode, clone, src_atom) with
3277 (Ast.MODE_alias, CLONE_none,
3278 Ast.ATOM_literal _) ->
3279 (* Aliasing a literal is a bit weird since nobody
3280 * else will ever see it, but it seems harmless.
3282 let src = trans_atom src_atom in
3283 mov dst (Il.Cell (alias (Il.Mem (force_to_mem src))))
3285 | (Ast.MODE_alias, CLONE_chan _, _)
3286 | (Ast.MODE_alias, CLONE_all _, _) ->
3287 bug () "attempting to clone into alias slot"
3289 let src = Il.Mem (force_to_mem (trans_atom src_atom)) in
3291 log cx " forced-to-mem src cell %s" (cell_str src);
3292 trans_init_slot_from_cell
3293 (get_ty_params_of_current_frame())
3294 clone dst dst_slot src (atom_type cx src_atom)
3302 (ty_params:Ast.ty array)
3303 (args:Ast.atom array)
3305 let (ptr, fn_ty) = trans_callee flv in
3306 let cc = call_ctrl flv in
3307 let call = { call_ctrl = cc;
3308 call_callee_ptr = ptr;
3309 call_callee_ty = fn_ty;
3310 call_callee_ty_params = ty_params;
3311 call_output = dst_cell;
3313 call_iterator_args = call_iterator_args None;
3314 call_indirect_args = call_indirect_args flv cc }
3316 (* FIXME (issue #85): true if caller is object fn *)
3317 let caller_is_closure = false in
3318 log cx "trans_be_fn: %s call to lval %a"
3319 (call_ctrl_string cc) Ast.sprintf_lval flv;
3320 trans_be (fun () -> Ast.sprintf_lval () flv) caller_is_closure call
3322 and trans_prepare_fn_call
3327 (ty_params:Ast.ty array)
3328 (fco:for_each_ctrl option)
3329 (args:Ast.atom array)
3331 let (ptr, fn_ty) = trans_callee flv in
3332 let cc = call_ctrl flv in
3333 let call = { call_ctrl = cc;
3334 call_callee_ptr = ptr;
3335 call_callee_ty = fn_ty;
3336 call_callee_ty_params = ty_params;
3337 call_output = dst_cell;
3339 call_iterator_args = call_iterator_args fco;
3340 call_indirect_args = call_indirect_args flv cc }
3345 log cx "trans_prepare_fn_call: %s call to lval %a"
3346 (call_ctrl_string cc) Ast.sprintf_lval flv;
3347 log cx "lval type: %a" Ast.sprintf_ty fn_ty;
3348 Array.iteri (fun i t -> log cx "ty param %d = %a"
3352 trans_prepare_call initializing (fun () -> Ast.sprintf_lval () flv) call
3354 and trans_call_pred_and_check
3357 (args:Ast.atom array)
3359 let (ptr, fn_ty) = trans_callee flv in
3360 let dst_cell = Il.Mem (force_to_mem imm_false) in
3361 let call = { call_ctrl = call_ctrl flv;
3362 call_callee_ptr = ptr;
3363 call_callee_ty = fn_ty;
3364 call_callee_ty_params = [| |];
3365 call_output = dst_cell;
3367 call_iterator_args = [| |];
3368 call_indirect_args = [| |] }
3370 iflog (fun _ -> annotate "predicate call");
3372 trans_prepare_call true (fun _ -> Ast.sprintf_lval () flv) call
3374 call_code (code_of_operand fn_ptr);
3375 iflog (fun _ -> annotate "predicate check/fail");
3376 let jmp = trans_compare Il.JE (Il.Cell dst_cell) imm_true in
3377 let errstr = Printf.sprintf "predicate check: %a"
3378 Ast.sprintf_constr constr
3380 trans_cond_fail errstr jmp
3382 and trans_init_closure
3383 (closure_cell:Il.cell)
3384 (target_fn_ptr:Il.operand)
3385 (target_binding_ptr:Il.operand)
3386 (bound_arg_slots:Ast.slot array)
3387 (bound_args:Ast.atom array)
3390 let rc_cell = get_element_ptr closure_cell 0 in
3391 let targ_cell = get_element_ptr closure_cell 1 in
3392 let args_cell = get_element_ptr closure_cell 2 in
3394 iflog (fun _ -> annotate "init closure refcount");
3396 iflog (fun _ -> annotate "set closure target code ptr");
3397 mov (get_element_ptr targ_cell 0) (reify_ptr target_fn_ptr);
3398 iflog (fun _ -> annotate "set closure target binding ptr");
3399 mov (get_element_ptr targ_cell 1) (reify_ptr target_binding_ptr);
3401 iflog (fun _ -> annotate "set closure bound args");
3402 copy_bound_args args_cell bound_arg_slots bound_args
3411 (args:Ast.atom option array)
3413 let (dst_cell, _) = trans_lval_maybe_init initializing dst in
3414 let (target_ptr, _) = trans_callee flv in
3415 let arg_bound_flags = Array.map bool_of_option args in
3418 (fun arg_slot bound_flag ->
3419 if bound_flag then Some arg_slot else None)
3420 fn_sig.Ast.sig_input_slots
3423 let bound_arg_slots = arr_filter_some arg_slots in
3424 let bound_args = arr_filter_some args in
3426 get_fn_binding_glue bind_id fn_sig.Ast.sig_input_slots arg_bound_flags
3428 let target_fn_ptr = callee_fn_ptr target_ptr cc in
3429 let target_binding_ptr = callee_binding_ptr flv cc in
3430 let closure_rty = closure_referent_type bound_arg_slots in
3431 let closure_sz = force_sz (Il.referent_ty_size word_bits closure_rty) in
3432 let fn_cell = get_element_ptr dst_cell Abi.binding_field_item in
3435 (get_element_ptr dst_cell Abi.binding_field_binding)
3436 (Il.ScalarTy (Il.AddrTy (closure_rty)))
3438 iflog (fun _ -> annotate "assign glue-code to fn slot of pair");
3439 mov fn_cell (crate_rel_imm glue_fixup);
3441 annotate "heap-allocate closure to binding slot of pair");
3442 trans_malloc closure_cell (imm closure_sz) zero;
3444 (deref closure_cell)
3445 target_fn_ptr target_binding_ptr
3446 bound_arg_slots bound_args
3449 and trans_arg0 (arg_cell:Il.cell) (initializing:bool) (call:call) : unit =
3450 (* Emit arg0 of any call: the output slot. *)
3451 iflog (fun _ -> annotate "fn-call arg 0: output slot");
3455 (get_ty_params_of_current_frame())
3457 (call_output_slot call) None;
3458 (* We always get to the same state here: the output slot is uninitialized.
3459 * We then do something that's illegal to do in the language, but legal
3460 * here: alias the uninitialized memory. We are ok doing this because the
3461 * call will fill it in before anyone else observes it. That's the
3464 mov arg_cell (Il.Cell (alias call.call_output));
3466 and trans_arg1 (arg_cell:Il.cell) : unit =
3467 (* Emit arg1 of any call: the task pointer. *)
3468 iflog (fun _ -> annotate "fn-call arg 1: task pointer");
3469 trans_init_slot_from_cell
3470 (get_ty_params_of_current_frame())
3473 abi.Abi.abi_tp_cell word_ty
3481 log cx "trans_argN: arg slot %a, arg atom %a"
3482 Ast.sprintf_slot arg_slot Ast.sprintf_atom arg;
3483 trans_init_slot_from_atom clone arg_cell arg_slot arg
3485 and code_of_cell (cell:Il.cell) : Il.code =
3487 Il.Mem (_, Il.ScalarTy (Il.AddrTy Il.CodeTy))
3488 | Il.Reg (_, Il.AddrTy Il.CodeTy) -> Il.CodePtr (Il.Cell cell)
3490 bug () "expected code-pointer cell, found %s"
3493 and code_of_operand (operand:Il.operand) : Il.code =
3495 Il.Cell c -> code_of_cell c
3496 | Il.ImmPtr (_, Il.CodeTy) -> Il.CodePtr operand
3498 bug () "expected code-pointer operand, got %s"
3501 and ty_arg_slots (ty:Ast.ty) : Ast.slot array =
3502 match simplified_ty ty with
3503 Ast.TY_fn (tsig, _) -> tsig.Ast.sig_input_slots
3504 | _ -> bug () "Trans.ty_arg_slots on non-callable type: %a"
3509 (initializing_arg0:bool)
3514 let n_ty_params = Array.length call.call_callee_ty_params in
3515 let all_callee_args_rty =
3517 if call.call_ctrl = CALL_direct
3519 else (Some Il.OpaqueTy)
3521 call_args_referent_type cx n_ty_params call.call_callee_ty clo
3523 let all_callee_args_cell =
3524 callee_args_cell tail_area all_callee_args_rty
3527 let _ = iflog (fun _ -> annotate
3529 "copying fn args to %d-ty-param call with rty: %s\n"
3530 n_ty_params (Il.string_of_referent_ty
3531 all_callee_args_rty)))
3533 let callee_arg_slots = ty_arg_slots call.call_callee_ty in
3534 let callee_output_cell =
3535 get_element_ptr all_callee_args_cell Abi.calltup_elt_out_ptr
3537 let callee_task_cell =
3538 get_element_ptr all_callee_args_cell Abi.calltup_elt_task_ptr
3540 let callee_ty_params =
3541 get_element_ptr all_callee_args_cell Abi.calltup_elt_ty_params
3544 get_element_ptr_dyn_in_current_frame
3545 all_callee_args_cell Abi.calltup_elt_args
3547 let callee_iterator_args =
3548 get_element_ptr_dyn_in_current_frame
3549 all_callee_args_cell Abi.calltup_elt_iterator_args
3551 let callee_indirect_args =
3552 get_element_ptr_dyn_in_current_frame
3553 all_callee_args_cell Abi.calltup_elt_indirect_args
3556 let n_args = Array.length call.call_args in
3557 let n_iterators = Array.length call.call_iterator_args in
3558 let n_indirects = Array.length call.call_indirect_args in
3565 (Printf.sprintf "fn-call arg %d of %d (+ %d indirect)"
3566 i n_args n_indirects));
3569 (get_element_ptr_dyn_in_current_frame callee_args i)
3570 callee_arg_slots.(i)
3577 fun i iterator_arg_operand ->
3579 annotate (Printf.sprintf "fn-call iterator-arg %d of %d"
3582 (get_element_ptr_dyn_in_current_frame callee_iterator_args i)
3583 iterator_arg_operand
3585 call.call_iterator_args;
3589 fun i indirect_arg_operand ->
3591 annotate (Printf.sprintf "fn-call indirect-arg %d of %d"
3594 (get_element_ptr_dyn_in_current_frame callee_indirect_args i)
3595 indirect_arg_operand
3597 call.call_indirect_args;
3604 (Printf.sprintf "fn-call ty param %d of %d"
3606 trans_init_slot_from_cell
3607 (get_ty_params_of_current_frame())
3609 (get_element_ptr callee_ty_params i) word_slot
3610 (get_tydesc None ty_param) word_ty
3612 call.call_callee_ty_params;
3614 trans_arg1 callee_task_cell;
3616 trans_arg0 callee_output_cell initializing_arg0 call
3620 and call_code (code:Il.code) : unit =
3621 let vr = next_vreg_cell Il.voidptr_t in
3622 emit (Il.call vr code);
3627 (bound_arg_slots:Ast.slot array)
3628 (bound_args:Ast.atom array)
3630 let n_slots = Array.length bound_arg_slots in
3635 annotate (Printf.sprintf
3636 "copy bound arg %d of %d" i n_slots));
3637 trans_argN CLONE_none
3638 (get_element_ptr dst_cell i)
3643 and merge_bound_args
3644 (all_self_args_rty:Il.referent_ty)
3645 (all_callee_args_rty:Il.referent_ty)
3646 (arg_slots:Ast.slot array)
3647 (arg_bound_flags:bool array)
3651 * NB: 'all_*_args', both self and callee, are always 4-tuples:
3653 * [out_ptr, task_ptr, [args], [indirect_args]]
3655 * The first few bindings here just destructure those via GEP.
3658 let all_self_args_cell = caller_args_cell all_self_args_rty in
3659 let all_callee_args_cell = callee_args_cell false all_callee_args_rty in
3661 let self_args_cell =
3662 get_element_ptr all_self_args_cell Abi.calltup_elt_args
3664 let self_ty_params_cell =
3665 get_element_ptr all_self_args_cell Abi.calltup_elt_ty_params
3667 let callee_args_cell =
3668 get_element_ptr all_callee_args_cell Abi.calltup_elt_args
3670 let self_indirect_args_cell =
3671 get_element_ptr all_self_args_cell Abi.calltup_elt_indirect_args
3674 let n_args = Array.length arg_bound_flags in
3675 let bound_i = ref 0 in
3676 let unbound_i = ref 0 in
3678 iflog (fun _ -> annotate "copy out-ptr");
3680 (get_element_ptr all_callee_args_cell Abi.calltup_elt_out_ptr)
3681 (Il.Cell (get_element_ptr all_self_args_cell
3682 Abi.calltup_elt_out_ptr));
3684 iflog (fun _ -> annotate "copy task-ptr");
3686 (get_element_ptr all_callee_args_cell Abi.calltup_elt_task_ptr)
3687 (Il.Cell (get_element_ptr all_self_args_cell
3688 Abi.calltup_elt_task_ptr));
3690 iflog (fun _ -> annotate "extract closure indirect-arg");
3692 deref (get_element_ptr self_indirect_args_cell
3693 Abi.indirect_args_elt_closure)
3695 let closure_args_cell = get_element_ptr closure_cell 2 in
3697 for arg_i = 0 to (n_args - 1) do
3698 let dst_cell = get_element_ptr callee_args_cell arg_i in
3699 let slot = arg_slots.(arg_i) in
3700 let is_bound = arg_bound_flags.(arg_i) in
3704 iflog (fun _ -> annotate
3706 "extract bound arg %d as actual arg %d"
3708 get_element_ptr closure_args_cell (!bound_i)
3712 iflog (fun _ -> annotate
3714 "extract unbound arg %d as actual arg %d"
3716 get_element_ptr self_args_cell (!unbound_i);
3719 iflog (fun _ -> annotate
3721 "copy into actual-arg %d" arg_i));
3722 trans_init_slot_from_cell
3723 self_ty_params_cell CLONE_none
3725 (deref_slot false src_cell slot) (slot_ty slot);
3726 incr (if is_bound then bound_i else unbound_i);
3728 assert ((!bound_i + !unbound_i) == n_args)
3740 (* fptr is a pair [disp, binding*] *)
3741 let pair_cell = need_cell (reify_ptr fptr) in
3742 let disp_cell = get_element_ptr pair_cell Abi.binding_field_item in
3743 Il.Cell (crate_rel_to_ptr (Il.Cell disp_cell) Il.CodeTy)
3745 and callee_binding_ptr
3746 (pair_lval:Ast.lval)
3752 let (pair_cell, _) = trans_lval pair_lval in
3753 Il.Cell (get_element_ptr pair_cell Abi.binding_field_binding)
3755 and call_ctrl flv : call_ctrl =
3756 if lval_is_static cx flv
3759 if lval_is_obj_vtbl cx flv
3763 and call_ctrl_string cc =
3765 CALL_direct -> "direct"
3766 | CALL_indirect -> "indirect"
3767 | CALL_vtbl -> "vtbl"
3769 and call_iterator_args
3770 (fco:for_each_ctrl option)
3771 : Il.operand array =
3776 iflog (fun _ -> annotate "calculate iterator args");
3777 [| reify_ptr (code_fixup_to_ptr_operand fco.for_each_fixup);
3778 Il.Cell (Il.Reg (abi.Abi.abi_fp_reg, Il.voidptr_t)); |]
3781 and call_indirect_args
3784 : Il.operand array =
3787 CALL_direct -> [| |]
3788 | CALL_indirect -> [| callee_binding_ptr flv cc |]
3792 (* FIXME (issue #84): will need to pass both words of obj
3793 * if we add a 'self' value for self-dispatch within
3794 * objs. Also to support forwarding-functions / 'as'.
3796 Ast.LVAL_ext (base, _) -> [| callee_binding_ptr base cc |]
3798 bug (lval_base_id flv)
3799 "call_indirect_args on obj-fn without base obj"
3804 (logname:(unit -> string))
3805 (caller_is_closure:bool)
3808 let callee_fptr = callee_fn_ptr call.call_callee_ptr call.call_ctrl in
3809 let callee_code = code_of_operand callee_fptr in
3810 let callee_args_rty =
3811 call_args_referent_type cx 0 call.call_callee_ty
3812 (if call.call_ctrl = CALL_direct then None else (Some Il.OpaqueTy))
3815 force_sz (Il.referent_ty_size word_bits callee_args_rty)
3818 if caller_is_closure
3819 then Some Il.OpaqueTy
3822 let caller_args_rty = current_fn_args_rty closure_rty in
3824 force_sz (Il.referent_ty_size word_bits caller_args_rty)
3826 iflog (fun _ -> annotate
3827 (Printf.sprintf "copy args for tail call to %s" (logname ())));
3828 copy_fn_args true true CLONE_none call;
3829 drop_slots_at_curr_stmt();
3830 abi.Abi.abi_emit_fn_tail_call (emitter())
3831 (force_sz (current_fn_callsz()))
3832 caller_argsz callee_code callee_argsz;
3834 and trans_prepare_call
3836 (logname:(unit -> string))
3840 let callee_fptr = callee_fn_ptr call.call_callee_ptr call.call_ctrl in
3841 iflog (fun _ -> annotate
3842 (Printf.sprintf "copy args for call to %s" (logname ())));
3843 copy_fn_args false initializing CLONE_none call;
3844 iflog (fun _ -> annotate (Printf.sprintf "call %s" (logname ())));
3847 and callee_drop_slot
3853 annotate (Printf.sprintf "callee_drop_slot %d = %s "
3854 (int_of_node slot_id)
3855 (Fmt.fmt_to_str Ast.fmt_slot_key k)));
3856 drop_slot_in_current_frame (cell_of_block_slot slot_id) slot None
3859 and trans_alt_tag (at:Ast.stmt_alt_tag) : unit =
3861 let trans_arm arm : quad_idx =
3862 let (pat, block) = arm.node in
3863 (* Translates the pattern and returns the addresses of the branch
3864 * instructions, which are taken if the match fails. *)
3865 let rec trans_pat pat src_cell src_ty =
3868 trans_compare Il.JNE (trans_lit lit) (Il.Cell src_cell)
3870 | Ast.PAT_tag (lval, pats) ->
3871 let tag_name = tag_ctor_name_to_tag_name (lval_to_name lval) in
3874 Ast.TY_tag tag_ty -> tag_ty
3875 | Ast.TY_iso ti -> (ti.Ast.iso_group).(ti.Ast.iso_index)
3876 | _ -> bug cx "expected tag type"
3878 let tag_keys = sorted_htab_keys ty_tag in
3879 let tag_number = arr_idx tag_keys tag_name in
3880 let ty_tup = Hashtbl.find ty_tag tag_name in
3882 let tag_cell:Il.cell = get_element_ptr src_cell 0 in
3884 get_element_ptr_dyn_in_current_frame src_cell 1
3888 trans_compare Il.JNE
3889 (Il.Cell tag_cell) (imm (Int64.of_int tag_number))
3892 let tup_cell:Il.cell = get_variant_ptr union_cell tag_number in
3894 let trans_elem_pat i elem_pat : quad_idx list =
3896 get_element_ptr_dyn_in_current_frame tup_cell i
3898 let elem_ty = ty_tup.(i) in
3899 trans_pat elem_pat elem_cell elem_ty
3902 let elem_jumps = Array.mapi trans_elem_pat pats in
3903 next_jumps @ (List.concat (Array.to_list elem_jumps))
3905 | Ast.PAT_slot (dst, _) ->
3906 let dst_slot = get_slot cx dst.id in
3907 let dst_cell = cell_of_block_slot dst.id in
3908 trans_init_slot_from_cell
3909 (get_ty_params_of_current_frame())
3910 CLONE_none dst_cell dst_slot
3912 [] (* irrefutable *)
3914 | Ast.PAT_wild -> [] (* irrefutable *)
3917 let (lval_cell, lval_slot) = trans_lval at.Ast.alt_tag_lval in
3918 let next_jumps = trans_pat pat lval_cell lval_slot in
3920 let last_jump = mark() in
3921 emit (Il.jmp Il.JMP Il.CodeNone);
3922 List.iter patch next_jumps;
3925 let last_jumps = Array.map trans_arm at.Ast.alt_tag_arms in
3926 Array.iter patch last_jumps
3928 and drop_slots_at_curr_stmt _ : unit =
3929 let stmt = Stack.top curr_stmt in
3930 match htab_search cx.ctxt_post_stmt_slot_drops stmt with
3936 let slot = get_slot cx slot_id in
3937 let k = Hashtbl.find cx.ctxt_slot_keys slot_id in
3941 "post-stmt, drop_slot %d = %s "
3942 (int_of_node slot_id)
3943 (Fmt.fmt_to_str Ast.fmt_slot_key k)));
3944 drop_slot_in_current_frame
3945 (cell_of_block_slot slot_id) slot None
3949 and trans_stmt (stmt:Ast.stmt) : unit =
3950 (* Helper to localize errors by stmt, at minimum. *)
3955 let s = Fmt.fmt_to_str Ast.fmt_stmt_body stmt in
3956 log cx "translating stmt: %s" s;
3959 Stack.push stmt.id curr_stmt;
3960 trans_stmt_full stmt;
3962 match stmt.node with
3964 | Ast.STMT_ret _ -> ()
3965 | _ -> drop_slots_at_curr_stmt();
3967 ignore (Stack.pop curr_stmt);
3969 Semant_err (None, msg) -> raise (Semant_err ((Some stmt.id), msg))
3972 and maybe_init (id:node_id) (action:string) (dst:Ast.lval) : bool =
3973 let b = Hashtbl.mem cx.ctxt_copy_stmt_is_init id in
3974 let act = if b then ("initializing-" ^ action) else action in
3977 annotate (Printf.sprintf "%s on dst lval %a"
3978 act Ast.sprintf_lval dst));
3982 and get_current_output_cell_and_slot _ : (Il.cell * Ast.slot) =
3984 need_ty_fn (Hashtbl.find cx.ctxt_all_item_types (current_fn()))
3986 let curr_args = get_args_for_current_frame () in
3988 get_element_ptr curr_args Abi.calltup_elt_out_ptr
3990 let dst_cell = deref curr_outptr in
3991 let dst_slot = (fst curr_fty).Ast.sig_output_slot in
3992 (dst_cell, dst_slot)
3994 and trans_set_outptr (at:Ast.atom) : unit =
3995 let (dst_cell, dst_slot) = get_current_output_cell_and_slot () in
3996 trans_init_slot_from_atom
3997 CLONE_none dst_cell dst_slot at
4000 and trans_for_loop (fo:Ast.stmt_for) : unit =
4001 let ty_params = get_ty_params_of_current_frame () in
4002 let dst_slot_id = (fst (fo.Ast.for_slot)).id in
4003 let dst_slot = get_slot cx dst_slot_id in
4004 let dst_cell = cell_of_block_slot dst_slot_id in
4005 let (head_stmts, seq) = fo.Ast.for_seq in
4006 let (seq_cell, seq_ty) = trans_lval seq in
4007 let unit_ty = seq_unit_ty seq_ty in
4008 Array.iter trans_stmt head_stmts;
4009 iter_seq_parts ty_params seq_cell seq_cell unit_ty
4011 fun _ src_cell unit_ty _ ->
4012 trans_init_slot_from_cell
4013 ty_params CLONE_none
4016 trans_block fo.Ast.for_body;
4020 and trans_for_each_loop (stmt_id:node_id) (fe:Ast.stmt_for_each) : unit =
4021 let id = fe.Ast.for_each_body.id in
4022 let g = GLUE_loop_body id in
4023 let name = glue_str cx g in
4024 let fix = new_fixup name in
4025 let framesz = get_framesz cx id in
4026 let callsz = get_callsz cx id in
4027 let spill = Hashtbl.find cx.ctxt_spill_fixups id in
4028 push_new_emitter_with_vregs (Some id);
4029 iflog (fun _ -> annotate "prologue");
4030 abi.Abi.abi_emit_fn_prologue (emitter())
4031 framesz callsz nabi_rust (upcall_fixup "upcall_grow_task");
4032 write_frame_info_ptrs None;
4033 iflog (fun _ -> annotate "finished prologue");
4034 trans_block fe.Ast.for_each_body;
4035 trans_glue_frame_exit fix spill g;
4038 * We've now emitted the body helper-fn. Next, set up a loop that
4039 * calls the iter and passes the helper-fn in.
4043 cx.ctxt_block_fixups
4044 fe.Ast.for_each_head.id));
4045 let (dst_slot, _) = fe.Ast.for_each_slot in
4046 let dst_cell = cell_of_block_slot dst_slot.id in
4047 let (flv, args) = fe.Ast.for_each_call in
4049 match htab_search cx.ctxt_call_lval_params (lval_base_id flv) with
4050 Some params -> params
4053 let depth = Hashtbl.find cx.ctxt_stmt_loop_depths stmt_id in
4054 let fc = { for_each_fixup = fix; for_each_depth = depth } in
4056 log cx "for-each at depth %d\n" depth);
4058 trans_prepare_fn_call true cx dst_cell flv ty_params (Some fc) args
4060 call_code (code_of_operand fn_ptr);
4063 and trans_put (atom_opt:Ast.atom option) : unit =
4067 | Some at -> trans_set_outptr at
4069 let block_fptr = Il.Cell (get_iter_block_fn_for_current_frame ()) in
4070 let fp = get_iter_outer_frame_ptr_for_current_frame () in
4071 let vr = next_vreg_cell Il.voidptr_t in
4073 trans_call_glue (code_of_operand block_fptr) None [| vr; fp |]
4075 and trans_vec_append dst_cell dst_ty src_oper src_ty =
4076 let elt_ty = seq_unit_ty dst_ty in
4077 let trim_trailing_null = dst_ty = Ast.TY_str in
4078 assert (simplified_ty src_ty = simplified_ty dst_ty);
4079 match simplified_ty src_ty with
4082 let is_gc = if type_has_state src_ty then 1L else 0L in
4083 let src_cell = need_cell src_oper in
4084 let src_vec = deref src_cell in
4085 let src_fill = get_element_ptr src_vec Abi.vec_elt_fill in
4086 let dst_vec = deref dst_cell in
4087 let dst_fill = get_element_ptr dst_vec Abi.vec_elt_fill in
4088 if trim_trailing_null
4089 then sub_from dst_fill (imm 1L);
4090 trans_upcall "upcall_vec_grow"
4092 [| Il.Cell dst_cell;
4097 * By now, dst_cell points to a vec/str with room for us
4101 (* Reload dst vec, fill; might have changed. *)
4102 let dst_vec = deref dst_cell in
4103 let dst_fill = get_element_ptr dst_vec Abi.vec_elt_fill in
4106 let eltp_rty = Il.AddrTy (referent_type abi elt_ty) in
4107 let dptr = next_vreg_cell eltp_rty in
4108 let sptr = next_vreg_cell eltp_rty in
4109 let dlim = next_vreg_cell eltp_rty in
4110 let elt_sz = ty_sz_in_current_frame elt_ty in
4112 get_element_ptr_dyn_in_current_frame
4113 dst_vec Abi.vec_elt_data
4116 get_element_ptr_dyn_in_current_frame
4117 src_vec Abi.vec_elt_data
4119 lea dptr (fst (need_mem_cell dst_data));
4120 lea sptr (fst (need_mem_cell src_data));
4121 add_to dptr (Il.Cell dst_fill);
4122 mov dlim (Il.Cell dptr);
4123 add_to dlim (Il.Cell src_fill);
4124 let fwd_jmp = mark () in
4125 emit (Il.jmp Il.JMP Il.CodeNone);
4126 let back_jmp_targ = mark () in
4129 (get_ty_params_of_current_frame()) true
4136 check_interrupt_flag ();
4138 trans_compare Il.JB (Il.Cell dptr) (Il.Cell dlim) in
4140 (fun j -> patch_existing j back_jmp_targ) back_jmp;
4141 let v = next_vreg_cell word_sty in
4142 mov v (Il.Cell src_fill);
4143 add_to dst_fill (Il.Cell v);
4146 bug () "unsupported vector-append type %a" Ast.sprintf_ty t
4150 and trans_copy_binop dst binop a_src =
4151 let (dst_cell, dst_ty) = trans_lval_maybe_init false dst in
4152 let src_oper = trans_atom a_src in
4155 | Ast.TY_vec _ when binop = Ast.BINOP_add ->
4156 trans_vec_append dst_cell dst_ty src_oper (atom_type cx a_src)
4158 let (dst_cell, _) = deref_ty DEREF_none false dst_cell dst_ty in
4159 let op = trans_binop binop in
4160 emit (Il.binary op dst_cell (Il.Cell dst_cell) src_oper);
4163 and trans_call id dst flv args =
4164 let init = maybe_init id "call" dst in
4165 let ty = lval_ty cx flv in
4169 cx.ctxt_call_lval_params (lval_base_id flv)
4171 Some params -> params
4174 match simplified_ty ty with
4176 let (dst_cell, _) = trans_lval_maybe_init init dst in
4178 trans_prepare_fn_call init cx dst_cell flv
4181 call_code (code_of_operand fn_ptr)
4182 | _ -> bug () "Calling unexpected lval."
4185 and trans_log id a =
4186 match simplified_ty (atom_type cx a) with
4187 (* NB: If you extend this, be sure to update the
4188 * typechecking code in type.ml as well. *)
4189 Ast.TY_str -> trans_log_str a
4190 | Ast.TY_int | Ast.TY_uint | Ast.TY_bool
4191 | Ast.TY_char | Ast.TY_mach (TY_u8)
4192 | Ast.TY_mach (TY_u16) | Ast.TY_mach (TY_u32)
4193 | Ast.TY_mach (TY_i8) | Ast.TY_mach (TY_i16)
4194 | Ast.TY_mach (TY_i32) ->
4196 | _ -> bugi cx id "unimplemented logging type"
4199 and trans_stmt_full (stmt:Ast.stmt) : unit =
4200 match stmt.node with
4205 | Ast.STMT_check_expr e ->
4206 trans_check_expr stmt.id e
4214 | Ast.STMT_join task ->
4217 | Ast.STMT_send (chan,src) ->
4220 | Ast.STMT_spawn (dst, domain, plv, args) ->
4221 trans_spawn (maybe_init stmt.id "spawn" dst) dst domain plv args
4223 | Ast.STMT_recv (dst, chan) ->
4224 trans_recv (maybe_init stmt.id "recv" dst) dst chan
4226 | Ast.STMT_copy (dst, e_src) ->
4227 trans_copy (maybe_init stmt.id "copy" dst) dst e_src
4229 | Ast.STMT_copy_binop (dst, binop, a_src) ->
4230 trans_copy_binop dst binop a_src
4232 | Ast.STMT_call (dst, flv, args) ->
4233 trans_call stmt.id dst flv args
4235 | Ast.STMT_bind (dst, flv, args) ->
4237 let init = maybe_init stmt.id "bind" dst in
4238 match lval_ty cx flv with
4239 Ast.TY_fn (tsig, _) ->
4241 init (call_ctrl flv) stmt.id dst flv tsig args
4242 | _ -> bug () "Binding unexpected lval."
4245 | Ast.STMT_init_rec (dst, atab, base) ->
4246 let (slot_cell, ty) = trans_lval_init dst in
4247 let (trec, dst_tys) =
4249 Ast.TY_rec trec -> (trec, Array.map snd trec)
4252 "non-rec destination type in stmt_init_rec"
4254 let (dst_cell, _) = deref_ty DEREF_none true slot_cell ty in
4258 let atoms = Array.map snd atab in
4259 trans_init_structural_from_atoms
4260 dst_cell dst_tys atoms
4262 trans_init_rec_update
4263 dst_cell dst_tys trec atab base_lval
4266 | Ast.STMT_init_tup (dst, atoms) ->
4267 let (slot_cell, ty) = trans_lval_init dst in
4270 Ast.TY_tup ttup -> ttup
4273 "non-tup destination type in stmt_init_tup"
4275 let (dst_cell, _) = deref_ty DEREF_none true slot_cell ty in
4276 trans_init_structural_from_atoms dst_cell dst_tys atoms
4279 | Ast.STMT_init_str (dst, s) ->
4280 trans_init_str dst s
4282 | Ast.STMT_init_vec (dst, atoms) ->
4283 trans_init_vec dst atoms
4285 | Ast.STMT_init_port dst ->
4288 | Ast.STMT_init_chan (dst, port) ->
4295 mov dst_cell imm_false
4297 trans_init_chan dst p
4300 | Ast.STMT_init_box (dst, src) ->
4301 trans_init_box dst src
4303 | Ast.STMT_block block ->
4306 | Ast.STMT_while sw ->
4307 let (head_stmts, head_expr) = sw.Ast.while_lval in
4308 let fwd_jmp = mark () in
4309 emit (Il.jmp Il.JMP Il.CodeNone);
4310 let block_begin = mark () in
4311 trans_block sw.Ast.while_body;
4313 Array.iter trans_stmt head_stmts;
4314 check_interrupt_flag ();
4315 let back_jmps = trans_cond false head_expr in
4316 List.iter (fun j -> patch_existing j block_begin) back_jmps;
4319 let skip_thn_jmps = trans_cond true si.Ast.if_test in
4320 trans_block si.Ast.if_then;
4322 match si.Ast.if_else with
4323 None -> List.iter patch skip_thn_jmps
4325 let skip_els_jmp = mark () in
4327 emit (Il.jmp Il.JMP Il.CodeNone);
4328 List.iter patch skip_thn_jmps;
4334 | Ast.STMT_check (preds, calls) ->
4336 (fun i (fn, args) -> trans_call_pred_and_check preds.(i) fn args)
4339 | Ast.STMT_ret atom_opt ->
4343 | Some at -> trans_set_outptr at
4345 drop_slots_at_curr_stmt();
4346 Stack.push (mark()) (Stack.top epilogue_jumps);
4347 emit (Il.jmp Il.JMP Il.CodeNone)
4349 | Ast.STMT_be (flv, args) ->
4351 match htab_search cx.ctxt_call_lval_params (lval_base_id flv) with
4352 Some params -> params
4355 let (dst_cell, _) = get_current_output_cell_and_slot () in
4356 trans_be_fn cx dst_cell flv ty_params args
4358 | Ast.STMT_put atom_opt ->
4361 | Ast.STMT_alt_tag stmt_alt_tag -> trans_alt_tag stmt_alt_tag
4363 | Ast.STMT_decl _ -> ()
4365 | Ast.STMT_for fo ->
4368 | Ast.STMT_for_each fe ->
4369 trans_for_each_loop stmt.id fe
4371 | _ -> bugi cx stmt.id "unhandled form of statement in trans_stmt %a"
4372 Ast.sprintf_stmt stmt
4374 and capture_emitted_quads (fix:fixup) (node:node_id) : unit =
4375 let e = emitter() in
4376 let n_vregs = Il.num_vregs e in
4377 let quads = emitted_quads e in
4378 let name = path_name () in
4380 if Stack.is_empty curr_file
4381 then bugi cx node "missing file scope when capturing quads."
4382 else Stack.top curr_file
4384 let item_code = Hashtbl.find cx.ctxt_file_code f in
4387 log cx "capturing quads for item #%d" (int_of_node node);
4388 annotate_quads name);
4390 match htab_search cx.ctxt_spill_fixups node with
4391 None -> (assert (n_vregs = 0); None)
4392 | Some spill -> Some (n_vregs, spill)
4394 let code = { code_fixup = fix;
4396 code_vregs_and_spill = vr_s; }
4398 htab_put item_code node code;
4399 htab_put cx.ctxt_all_item_code node code
4402 and get_frame_glue_fns (fnid:node_id) : Il.operand =
4403 let n_ty_params = n_item_ty_params cx fnid in
4404 let get_frame_glue glue inner =
4408 iter_frame_and_arg_slots cx fnid
4410 fun key slot_id slot ->
4411 match htab_search cx.ctxt_slot_offsets slot_id with
4412 Some off when not (slot_is_obj_state cx slot_id) ->
4413 let referent_type = slot_id_referent_type slot_id in
4414 let fp_cell = rty_ptr_at mem referent_type in
4415 let (fp, st) = force_to_reg (Il.Cell fp_cell) in
4417 get_ty_params_of_frame fp n_ty_params
4420 deref_off_sz ty_params (Il.Reg (fp,st)) off
4422 inner key slot_id ty_params slot slot_cell
4427 trans_crate_rel_data_operand
4428 (DATA_frame_glue_fns fnid)
4431 let mark_frame_glue_fixup =
4432 get_frame_glue (GLUE_mark_frame fnid)
4434 fun _ _ ty_params slot slot_cell ->
4435 mark_slot ty_params slot_cell slot None
4438 let drop_frame_glue_fixup =
4439 get_frame_glue (GLUE_drop_frame fnid)
4441 fun _ _ ty_params slot slot_cell ->
4442 drop_slot ty_params slot_cell slot None
4445 let reloc_frame_glue_fixup =
4446 get_frame_glue (GLUE_reloc_frame fnid)
4452 table_of_crate_rel_fixups
4455 * NB: this must match the struct-offsets given in ABI
4456 * & rust runtime library.
4458 mark_frame_glue_fixup;
4459 drop_frame_glue_fixup;
4460 reloc_frame_glue_fixup;
4465 let trans_frame_entry (fnid:node_id) : unit =
4466 let framesz = get_framesz cx fnid in
4467 let callsz = get_callsz cx fnid in
4468 Stack.push (Stack.create()) epilogue_jumps;
4469 push_new_emitter_with_vregs (Some fnid);
4470 iflog (fun _ -> annotate "prologue");
4471 iflog (fun _ -> annotate (Printf.sprintf
4473 (string_of_size framesz)));
4474 iflog (fun _ -> annotate (Printf.sprintf
4476 (string_of_size callsz)));
4477 abi.Abi.abi_emit_fn_prologue
4478 (emitter()) framesz callsz nabi_rust
4479 (upcall_fixup "upcall_grow_task");
4481 write_frame_info_ptrs (Some fnid);
4482 check_interrupt_flag ();
4483 iflog (fun _ -> annotate "finished prologue");
4486 let trans_frame_exit (fnid:node_id) (drop_args:bool) : unit =
4487 Stack.iter patch (Stack.pop epilogue_jumps);
4491 iflog (fun _ -> annotate "drop args");
4492 iter_arg_slots cx fnid callee_drop_slot;
4494 iflog (fun _ -> annotate "epilogue");
4495 abi.Abi.abi_emit_fn_epilogue (emitter());
4496 capture_emitted_quads (get_fn_fixup cx fnid) fnid;
4504 trans_frame_entry fnid;
4506 trans_frame_exit fnid true;
4511 (header:Ast.header_slots)
4513 trans_frame_entry obj_id;
4515 let all_args_rty = current_fn_args_rty None in
4516 let all_args_cell = caller_args_cell all_args_rty in
4518 get_element_ptr_dyn_in_current_frame
4519 all_args_cell Abi.calltup_elt_args
4521 let frame_ty_params =
4522 get_element_ptr_dyn_in_current_frame
4523 all_args_cell Abi.calltup_elt_ty_params
4527 Array.map (fun (sloti,_) -> (slot_ty sloti.node)) header
4529 let obj_args_ty = Ast.TY_tup obj_args_tup in
4530 let state_ty = Ast.TY_tup [| Ast.TY_type; obj_args_ty |] in
4531 let state_ptr_ty = Ast.TY_box state_ty in
4532 let state_ptr_rty = referent_type abi state_ptr_ty in
4533 let state_malloc_sz = box_allocation_size state_ptr_ty in
4535 let ctor_ty = Hashtbl.find cx.ctxt_all_item_types obj_id in
4537 slot_ty (fst (need_ty_fn ctor_ty)).Ast.sig_output_slot
4540 let vtbl_ptr = get_obj_vtbl obj_id in
4542 iflog (fun _ -> annotate "calculate vtbl-ptr from displacement")
4544 let vtbl_cell = crate_rel_to_ptr vtbl_ptr Il.CodeTy in
4546 let _ = iflog (fun _ -> annotate "load destination obj pair ptr") in
4547 let dst_pair_cell = deref (ptr_at (fp_imm out_mem_disp) obj_ty) in
4548 let dst_pair_item_cell =
4549 get_element_ptr dst_pair_cell Abi.binding_field_item
4551 let dst_pair_state_cell =
4552 get_element_ptr dst_pair_cell Abi.binding_field_binding
4555 (* Load first cell of pair with vtbl ptr.*)
4556 iflog (fun _ -> annotate "mov vtbl-ptr to obj.item cell");
4557 mov dst_pair_item_cell (Il.Cell vtbl_cell);
4559 (* Load second cell of pair with pointer to fresh state tuple.*)
4560 iflog (fun _ -> annotate "malloc state-tuple to obj.state cell");
4561 trans_malloc dst_pair_state_cell state_malloc_sz zero;
4563 (* Copy args into the state tuple. *)
4564 let state_ptr = next_vreg_cell (need_scalar_ty state_ptr_rty) in
4565 iflog (fun _ -> annotate "load obj.state ptr to vreg");
4566 mov state_ptr (Il.Cell dst_pair_state_cell);
4567 let state = deref state_ptr in
4568 let refcnt = get_element_ptr_dyn_in_current_frame state 0 in
4569 let body = get_element_ptr_dyn_in_current_frame state 1 in
4570 let obj_tydesc = get_element_ptr_dyn_in_current_frame body 0 in
4571 let obj_args = get_element_ptr_dyn_in_current_frame body 1 in
4572 iflog (fun _ -> annotate "write refcnt=1 to obj state");
4574 iflog (fun _ -> annotate "get args-tup tydesc");
4576 (Il.Cell (get_tydesc
4578 (Ast.TY_tup obj_args_tup)));
4579 iflog (fun _ -> annotate "copy ctor args to obj args");
4581 frame_ty_params true
4582 obj_args frame_args obj_args_tup;
4583 (* We have to do something curious here: we can't drop the
4584 * arg slots directly as in the normal frame-exit sequence,
4585 * because the arg slot ids are actually given layout
4586 * positions inside the object state, and are at different
4587 * offsets within that state than within the current
4588 * frame. So we manually drop the argument slots here,
4589 * without mentioning the slot ids.
4592 (fun i (sloti, _) ->
4594 get_element_ptr_dyn_in_current_frame
4597 drop_slot frame_ty_params cell sloti.node None)
4599 trans_frame_exit obj_id false;
4602 let string_of_name_component (nc:Ast.name_component) : string =
4604 Ast.COMP_ident i -> i
4606 "Trans.string_of_name_component on non-COMP_ident"
4610 let trans_static_name_components
4611 (ncs:Ast.name_component list)
4614 trans_crate_rel_static_string_frag (string_of_name_component nc)
4616 trans_crate_rel_data_operand
4617 (DATA_name (Walk.name_of ncs))
4618 (fun _ -> Asm.SEQ (Array.append
4619 (Array.map f (Array.of_list ncs))
4620 [| Asm.WORD (word_ty_mach, Asm.IMM 0L) |]))
4623 let trans_required_fn (fnid:node_id) (blockid:node_id) : unit =
4624 trans_frame_entry fnid;
4625 emit (Il.Enter (Hashtbl.find cx.ctxt_block_fixups blockid));
4626 let (ilib, conv) = Hashtbl.find cx.ctxt_required_items fnid in
4628 htab_search_or_add cx.ctxt_required_lib_num ilib
4629 (fun _ -> Hashtbl.length cx.ctxt_required_lib_num)
4631 let f = next_vreg_cell (Il.AddrTy (Il.CodeTy)) in
4632 let n_ty_params = n_item_ty_params cx fnid in
4633 let args_rty = direct_call_args_referent_type cx fnid in
4634 let caller_args_cell = caller_args_cell args_rty in
4637 REQUIRED_LIB_rust ls ->
4640 htab_search_or_add cx.ctxt_required_c_sym_num
4641 (ilib, "rust_crate")
4642 (fun _ -> Hashtbl.length cx.ctxt_required_c_sym_num)
4645 htab_search_or_add cx.ctxt_required_rust_sym_num fnid
4646 (fun _ -> Hashtbl.length cx.ctxt_required_rust_sym_num)
4648 let path_elts = stk_elts_from_bot path in
4650 assert (ls.required_prefix < (List.length path_elts))
4652 let relative_path_elts =
4653 list_drop ls.required_prefix path_elts
4655 let libstr = trans_static_string ls.required_libname in
4657 trans_static_name_components relative_path_elts
4659 trans_upcall "upcall_require_rust_sym" f
4660 [| Il.Cell (curr_crate_ptr());
4661 imm (Int64.of_int lib_num);
4662 imm (Int64.of_int c_sym_num);
4663 imm (Int64.of_int rust_sym_num);
4667 trans_copy_forward_args args_rty;
4669 call_code (code_of_operand (Il.Cell f));
4672 | REQUIRED_LIB_c ls ->
4675 match htab_search cx.ctxt_required_syms fnid with
4678 string_of_name_component (Stack.top path)
4681 (* FIXME: permit remapping symbol names to handle
4684 htab_search_or_add cx.ctxt_required_c_sym_num
4686 (fun _ -> Hashtbl.length cx.ctxt_required_c_sym_num)
4688 let libstr = trans_static_string ls.required_libname in
4689 let symstr = trans_static_string c_sym_str in
4690 let check_rty_sz rty =
4691 let sz = force_sz (Il.referent_ty_size word_bits rty) in
4692 if sz = 0L || sz = word_sz
4694 else bug () "bad arg or ret cell size for native require"
4697 get_element_ptr caller_args_cell Abi.calltup_elt_out_ptr
4699 let _ = check_rty_sz (pointee_type out) in
4701 let ty_params_cell =
4702 get_element_ptr caller_args_cell Abi.calltup_elt_ty_params
4705 get_element_ptr caller_args_cell Abi.calltup_elt_args
4708 match args_cell with
4709 Il.Mem (_, Il.StructTy elts) -> Array.length elts
4710 | _ -> bug () "non-StructTy in Trans.trans_required_fn"
4713 Il.Cell (get_element_ptr ty_params_cell i)
4716 let arg = get_element_ptr args_cell i in
4717 let _ = check_rty_sz (Il.cell_referent_ty arg) in
4721 (Array.init n_ty_params mk_ty_param)
4722 (Array.init n_args mk_arg)
4724 let nabi = { nabi_convention = conv;
4725 nabi_indirect = true }
4727 if conv <> CONV_rust
4728 then assert (n_ty_params = 0);
4729 trans_upcall "upcall_require_c_sym" f
4730 [| Il.Cell (curr_crate_ptr());
4731 imm (Int64.of_int lib_num);
4732 imm (Int64.of_int c_sym_num);
4736 abi.Abi.abi_emit_native_call_in_thunk (emitter())
4737 out nabi (Il.Cell f) args;
4741 "Trans.required_rust_fn on unexpected form of require library"
4745 REQUIRED_LIB_rust _ ->
4746 trans_frame_exit fnid false;
4747 | REQUIRED_LIB_c _ ->
4748 trans_frame_exit fnid true;
4750 "Trans.required_rust_fn on unexpected form of require library"
4756 (tag:(Ast.header_tup * Ast.ty_tag * node_id))
4758 trans_frame_entry tagid;
4759 trace_str cx.ctxt_sess.Session.sess_trace_tag
4760 ("in tag constructor " ^ n);
4761 let (header_tup, _, _) = tag in
4762 let ctor_ty = Hashtbl.find cx.ctxt_all_item_types tagid in
4764 match slot_ty (fst (need_ty_fn ctor_ty)).Ast.sig_output_slot with
4765 Ast.TY_tag ttag -> ttag
4766 | Ast.TY_iso tiso -> get_iso_tag tiso
4767 | _ -> bugi cx tagid "unexpected fn type for tag constructor"
4769 let tag_keys = sorted_htab_keys ttag in
4770 let i = arr_idx tag_keys (Ast.NAME_base (Ast.BASE_ident n)) in
4771 let _ = log cx "tag variant: %s -> tag value #%d" n i in
4772 let (dst_cell, dst_slot) = get_current_output_cell_and_slot() in
4773 let dst_cell = deref_slot true dst_cell dst_slot in
4774 let tag_cell = get_element_ptr dst_cell 0 in
4775 let union_cell = get_element_ptr_dyn_in_current_frame dst_cell 1 in
4776 let tag_body_cell = get_variant_ptr union_cell i in
4777 let tag_body_rty = snd (need_mem_cell tag_body_cell) in
4778 let ty_params = get_ty_params_of_current_frame() in
4779 (* A clever compiler will inline this. We are not clever. *)
4780 iflog (fun _ -> annotate (Printf.sprintf "write tag #%d" i));
4781 mov tag_cell (imm (Int64.of_int i));
4782 iflog (fun _ -> annotate ("copy tag-content tuple: tag_body_rty=" ^
4783 (Il.string_of_referent_ty tag_body_rty)));
4787 let slot = sloti.node in
4788 let ty = slot_ty slot in
4789 trans_copy_ty ty_params true
4790 (get_element_ptr_dyn_in_current_frame tag_body_cell i) ty
4791 (deref_slot false (cell_of_block_slot sloti.id) slot) ty
4795 trace_str cx.ctxt_sess.Session.sess_trace_tag
4796 ("finished tag constructor " ^ n);
4797 trans_frame_exit tagid true;
4800 let enter_file_for id =
4801 if Hashtbl.mem cx.ctxt_item_files id
4802 then Stack.push id curr_file
4805 let leave_file_for id =
4806 if Hashtbl.mem cx.ctxt_item_files id
4808 if Stack.is_empty curr_file
4809 then bugi cx id "Missing source file on file-scope exit."
4810 else ignore (Stack.pop curr_file)
4813 let visit_defined_mod_item_pre n _ i =
4814 iflog (fun _ -> log cx "translating defined item #%d = %s"
4815 (int_of_node i.id) (path_name()));
4816 match i.node.Ast.decl_item with
4817 Ast.MOD_ITEM_fn f -> trans_fn i.id f.Ast.fn_body
4818 | Ast.MOD_ITEM_tag t -> trans_tag n i.id t
4819 | Ast.MOD_ITEM_obj ob ->
4821 (Array.map (fun (sloti,ident) ->
4822 ({sloti with node = get_slot cx sloti.id},ident))
4827 let visit_required_mod_item_pre _ _ i =
4828 iflog (fun _ -> log cx "translating required item #%d = %s"
4829 (int_of_node i.id) (path_name()));
4830 match i.node.Ast.decl_item with
4831 Ast.MOD_ITEM_fn f -> trans_required_fn i.id f.Ast.fn_body.id
4832 | Ast.MOD_ITEM_mod _ -> ()
4833 | Ast.MOD_ITEM_type _ -> ()
4834 | _ -> bugi cx i.id "unsupported type of require: %s" (path_name())
4837 let visit_obj_drop_pre obj b =
4838 let g = GLUE_obj_drop obj.id in
4840 match htab_search cx.ctxt_glue_code g with
4841 Some code -> code.code_fixup
4842 | None -> bug () "visit_obj_drop_pre without assigned fixup"
4844 let framesz = get_framesz cx b.id in
4845 let callsz = get_callsz cx b.id in
4846 let spill = Hashtbl.find cx.ctxt_spill_fixups b.id in
4847 push_new_emitter_with_vregs (Some b.id);
4848 iflog (fun _ -> annotate "prologue");
4849 abi.Abi.abi_emit_fn_prologue (emitter())
4850 framesz callsz nabi_rust (upcall_fixup "upcall_grow_task");
4851 write_frame_info_ptrs None;
4852 iflog (fun _ -> annotate "finished prologue");
4854 Hashtbl.remove cx.ctxt_glue_code g;
4855 trans_glue_frame_exit fix spill g;
4856 inner.Walk.visit_obj_drop_pre obj b
4859 let visit_defined_obj_fn_pre _ _ fn =
4860 trans_fn fn.id fn.node.Ast.fn_body
4863 let visit_required_obj_fn_pre _ _ _ =
4867 let visit_obj_fn_pre obj ident fn =
4868 enter_file_for fn.id;
4870 if Hashtbl.mem cx.ctxt_required_items fn.id
4872 visit_required_obj_fn_pre obj ident fn
4874 visit_defined_obj_fn_pre obj ident fn;
4876 inner.Walk.visit_obj_fn_pre obj ident fn
4879 let visit_mod_item_pre n p i =
4880 enter_file_for i.id;
4882 if Hashtbl.mem cx.ctxt_required_items i.id
4884 visit_required_mod_item_pre n p i
4886 visit_defined_mod_item_pre n p i
4888 inner.Walk.visit_mod_item_pre n p i
4891 let visit_mod_item_post n p i =
4892 inner.Walk.visit_mod_item_post n p i;
4896 let visit_obj_fn_post obj ident fn =
4897 inner.Walk.visit_obj_fn_post obj ident fn;
4898 leave_file_for fn.id
4901 let visit_crate_pre crate =
4902 enter_file_for crate.id;
4903 inner.Walk.visit_crate_pre crate
4906 let visit_crate_post crate =
4908 inner.Walk.visit_crate_post crate;
4910 let emit_aux_global_glue cx glue fix fn =
4911 let glue_name = glue_str cx glue in
4912 push_new_emitter_without_vregs None;
4913 let e = emitter() in
4915 iflog (fun _ -> annotate_quads glue_name);
4916 if (Il.num_vregs e) != 0
4917 then bug () "%s uses nonzero vregs" glue_name;
4921 code_quads = emitted_quads e;
4922 code_vregs_and_spill = None; }
4924 htab_put cx.ctxt_glue_code glue code
4928 Asm.WORD (word_ty_mach, Asm.IMM (Int64.of_int (Hashtbl.length htab)))
4932 (cx.ctxt_crate_fixup,
4934 (cx.ctxt_crate_fixup,
4937 * NB: this must match the rust_crate structure
4938 * in the rust runtime library.
4940 crate_rel_word cx.ctxt_image_base_fixup;
4941 Asm.WORD (word_ty_mach, Asm.M_POS cx.ctxt_crate_fixup);
4943 crate_rel_word cx.ctxt_debug_abbrev_fixup;
4944 Asm.WORD (word_ty_mach, Asm.M_SZ cx.ctxt_debug_abbrev_fixup);
4946 crate_rel_word cx.ctxt_debug_info_fixup;
4947 Asm.WORD (word_ty_mach, Asm.M_SZ cx.ctxt_debug_info_fixup);
4949 crate_rel_word cx.ctxt_activate_fixup;
4950 crate_rel_word cx.ctxt_yield_fixup;
4951 crate_rel_word cx.ctxt_unwind_fixup;
4952 crate_rel_word cx.ctxt_gc_fixup;
4953 crate_rel_word cx.ctxt_exit_task_fixup;
4955 tab_sz cx.ctxt_required_rust_sym_num;
4956 tab_sz cx.ctxt_required_c_sym_num;
4957 tab_sz cx.ctxt_required_lib_num;
4961 (* Emit additional glue we didn't do elsewhere. *)
4962 emit_aux_global_glue cx GLUE_activate
4963 cx.ctxt_activate_fixup
4964 abi.Abi.abi_activate;
4966 emit_aux_global_glue cx GLUE_yield
4970 emit_aux_global_glue cx GLUE_unwind
4971 cx.ctxt_unwind_fixup
4972 (fun e -> abi.Abi.abi_unwind
4973 e nabi_rust (upcall_fixup "upcall_exit"));
4975 emit_aux_global_glue cx GLUE_gc
4979 ignore (get_exit_task_glue ());
4982 match abi.Abi.abi_get_next_pc_thunk with
4984 | Some (_, fix, fn) ->
4985 emit_aux_global_glue cx GLUE_get_next_pc fix fn
4988 htab_put cx.ctxt_data
4989 DATA_crate crate_data;
4991 provide_existing_native cx SEG_data "rust_crate" cx.ctxt_crate_fixup;
4993 leave_file_for crate.id
4997 Walk.visit_crate_pre = visit_crate_pre;
4998 Walk.visit_crate_post = visit_crate_post;
4999 Walk.visit_mod_item_pre = visit_mod_item_pre;
5000 Walk.visit_mod_item_post = visit_mod_item_post;
5001 Walk.visit_obj_fn_pre = visit_obj_fn_pre;
5002 Walk.visit_obj_fn_post = visit_obj_fn_post;
5003 Walk.visit_obj_drop_pre = visit_obj_drop_pre;
5008 let fixup_assigning_visitor
5010 (path:Ast.name_component Stack.t)
5011 (inner:Walk.visitor)
5014 let path_name (_:unit) : string =
5015 Fmt.fmt_to_str Ast.fmt_name (Walk.path_to_name path)
5018 let enter_file_for id =
5019 if Hashtbl.mem cx.ctxt_item_files id
5023 if Stack.is_empty path
5027 htab_put cx.ctxt_file_fixups id (new_fixup name);
5028 if not (Hashtbl.mem cx.ctxt_file_code id)
5029 then htab_put cx.ctxt_file_code id (Hashtbl.create 0);
5033 let visit_mod_item_pre n p i =
5034 enter_file_for i.id;
5036 match i.node.Ast.decl_item with
5038 Ast.MOD_ITEM_tag _ ->
5039 htab_put cx.ctxt_fn_fixups i.id
5040 (new_fixup (path_name()));
5042 | Ast.MOD_ITEM_fn _ ->
5044 let path = path_name () in
5046 if (not cx.ctxt_sess.Session.sess_library_mode)
5047 && (Some path) = cx.ctxt_main_name
5049 match cx.ctxt_main_fn_fixup with
5050 None -> bug () "missing main fixup in trans"
5055 htab_put cx.ctxt_fn_fixups i.id fixup;
5058 | Ast.MOD_ITEM_obj _ ->
5059 htab_put cx.ctxt_fn_fixups i.id
5060 (new_fixup (path_name()));
5064 inner.Walk.visit_mod_item_pre n p i
5067 let visit_obj_fn_pre obj ident fn =
5068 htab_put cx.ctxt_fn_fixups fn.id
5069 (new_fixup (path_name()));
5070 inner.Walk.visit_obj_fn_pre obj ident fn
5073 let visit_obj_drop_pre obj b =
5074 let g = GLUE_obj_drop obj.id in
5075 let fix = new_fixup (path_name()) in
5076 let tmp_code = { code_fixup = fix;
5078 code_vregs_and_spill = None; } in
5079 htab_put cx.ctxt_glue_code g tmp_code;
5080 inner.Walk.visit_obj_drop_pre obj b
5083 let visit_block_pre b =
5084 htab_put cx.ctxt_block_fixups b.id
5085 (new_fixup ("lexical block in " ^ (path_name())));
5086 inner.Walk.visit_block_pre b
5089 let visit_crate_pre c =
5090 enter_file_for c.id;
5091 inner.Walk.visit_crate_pre c
5095 Walk.visit_crate_pre = visit_crate_pre;
5096 Walk.visit_mod_item_pre = visit_mod_item_pre;
5097 Walk.visit_obj_fn_pre = visit_obj_fn_pre;
5098 Walk.visit_obj_drop_pre = visit_obj_drop_pre;
5099 Walk.visit_block_pre = visit_block_pre; }
5106 let path = Stack.create () in
5109 (unreferenced_required_item_ignoring_visitor cx
5110 (fixup_assigning_visitor cx path
5111 Walk.empty_visitor));
5112 (unreferenced_required_item_ignoring_visitor cx
5113 (Walk.mod_item_logging_visitor
5114 (log cx "translation pass: %s")
5116 (trans_visitor cx path
5117 Walk.empty_visitor)))
5120 log cx "translating crate";
5122 match cx.ctxt_main_name with
5124 | Some m -> log cx "with main fn %s" m
5126 run_passes cx "trans" path passes (log cx "%s") crate;
5132 * indent-tabs-mode: nil
5133 * buffer-file-coding-system: utf-8-unix
5134 * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";