@@ -1663,6 +1663,7 @@ let trans_visitor
1663
1663
(* FIXME (issue #2): this should eventually use tail calling logic *)
1664
1664
1665
1665
and emit_fn_thunk_glue
1666
+ (n_ty_params :int )
1666
1667
(arg_slots :Ast.slot array )
1667
1668
(arg_bound_flags :bool array )
1668
1669
(fix :fixup )
@@ -1683,14 +1684,14 @@ let trans_visitor
1683
1684
let (self_ty:Ast.ty ) = mk_simple_ty_fn unbound_slots in
1684
1685
let (callee_ty:Ast.ty ) = mk_simple_ty_fn arg_slots in
1685
1686
1686
- let self_box_rty = closure_box_rty cx bound_slots in
1687
+ let self_box_rty = closure_box_rty cx n_ty_params bound_slots in
1687
1688
1688
1689
let self_args_rty =
1689
1690
call_args_referent_type cx 0 self_ty (Some self_box_rty)
1690
1691
in
1691
1692
1692
1693
let callee_args_rty =
1693
- call_args_referent_type cx 0 callee_ty (Some Il. OpaqueTy )
1694
+ call_args_referent_type cx n_ty_params callee_ty (Some Il. OpaqueTy )
1694
1695
in
1695
1696
1696
1697
let callsz = Il. referent_ty_size word_bits callee_args_rty in
@@ -1729,6 +1730,7 @@ let trans_visitor
1729
1730
in
1730
1731
1731
1732
merge_bound_args
1733
+ n_ty_params
1732
1734
self_args_rty callee_args_rty
1733
1735
arg_slots arg_bound_flags;
1734
1736
iflog (fun _ -> annotate " call through to closure target fn" );
@@ -1747,6 +1749,7 @@ let trans_visitor
1747
1749
1748
1750
and get_fn_thunk_glue
1749
1751
(bind_id :node_id )
1752
+ (n_ty_params :int )
1750
1753
(arg_slots :Ast.slot array )
1751
1754
(arg_bound_flags :bool array )
1752
1755
: fixup =
@@ -1755,7 +1758,7 @@ let trans_visitor
1755
1758
Some code -> code.code_fixup
1756
1759
| None ->
1757
1760
let fix = new_fixup (glue_str cx g) in
1758
- emit_fn_thunk_glue arg_slots arg_bound_flags fix g;
1761
+ emit_fn_thunk_glue n_ty_params arg_slots arg_bound_flags fix g;
1759
1762
fix
1760
1763
1761
1764
@@ -4186,6 +4189,7 @@ let trans_visitor
4186
4189
(closure_cell :Il.cell )
4187
4190
(target_fn_ptr :Il.operand )
4188
4191
(target_binding_ptr :Il.operand )
4192
+ (ty_params :Ast.ty array )
4189
4193
(bound_arg_slots :Ast.slot array )
4190
4194
(bound_args :Ast.atom array )
4191
4195
: unit =
@@ -4196,6 +4200,9 @@ let trans_visitor
4196
4200
let bound_args_tydesc_cell =
4197
4201
get_element_ptr body_cell Abi. closure_body_elt_bound_args_tydesc
4198
4202
in
4203
+ let bound_ty_params_cell =
4204
+ get_element_ptr body_cell Abi. closure_body_elt_bound_ty_params
4205
+ in
4199
4206
let args_cell =
4200
4207
get_element_ptr body_cell Abi. closure_body_elt_bound_args
4201
4208
in
@@ -4219,6 +4226,16 @@ let trans_visitor
4219
4226
(get_element_ptr targ_cell Abi. fn_field_box)
4220
4227
(reify_ptr target_binding_ptr);
4221
4228
4229
+ iflog (fun _ -> annotate " set closure bound tydescs" );
4230
+ Array. iteri
4231
+ begin
4232
+ fun i ty ->
4233
+ mov
4234
+ (get_element_ptr bound_ty_params_cell i)
4235
+ (Il. Cell (get_tydesc None ty))
4236
+ end
4237
+ ty_params;
4238
+
4222
4239
iflog (fun _ -> annotate " set closure bound args" );
4223
4240
copy_bound_args args_cell bound_arg_slots bound_args
4224
4241
@@ -4233,6 +4250,12 @@ let trans_visitor
4233
4250
: unit =
4234
4251
let (dst_cell, _) = trans_lval_maybe_init initializing dst in
4235
4252
let (target_ptr, _) = trans_callee flv in
4253
+ let ty_params =
4254
+ match htab_search cx.ctxt_call_lval_params (lval_base_id flv) with
4255
+ Some params -> params
4256
+ | None -> [| |]
4257
+ in
4258
+ let n_ty_params = Array. length ty_params in
4236
4259
let arg_bound_flags = Array. map bool_of_option args in
4237
4260
let arg_slots =
4238
4261
arr_map2
@@ -4244,11 +4267,12 @@ let trans_visitor
4244
4267
let bound_arg_slots = arr_filter_some arg_slots in
4245
4268
let bound_args = arr_filter_some args in
4246
4269
let thunk_fixup =
4247
- get_fn_thunk_glue bind_id fn_sig.Ast. sig_input_slots arg_bound_flags
4270
+ get_fn_thunk_glue bind_id n_ty_params
4271
+ fn_sig.Ast. sig_input_slots arg_bound_flags
4248
4272
in
4249
4273
let target_code_ptr = callee_code_ptr target_ptr cc in
4250
4274
let target_box_ptr = callee_box_ptr flv cc in
4251
- let closure_box_rty = closure_box_rty cx bound_arg_slots in
4275
+ let closure_box_rty = closure_box_rty cx n_ty_params bound_arg_slots in
4252
4276
let closure_box_sz =
4253
4277
calculate_sz_in_current_frame
4254
4278
(Il. referent_ty_size word_bits closure_box_rty)
@@ -4268,6 +4292,7 @@ let trans_visitor
4268
4292
(deref pair_box_cell)
4269
4293
target_code_ptr
4270
4294
target_box_ptr
4295
+ ty_params
4271
4296
bound_arg_slots
4272
4297
bound_args
4273
4298
@@ -4466,14 +4491,15 @@ let trans_visitor
4466
4491
bound_arg_slots
4467
4492
4468
4493
and merge_bound_args
4494
+ (n_ty_params :int )
4469
4495
(all_self_args_rty :Il.referent_ty )
4470
4496
(all_callee_args_rty :Il.referent_ty )
4471
4497
(arg_slots :Ast.slot array )
4472
4498
(arg_bound_flags :bool array )
4473
4499
: unit =
4474
4500
begin
4475
4501
(*
4476
- * NB: 'all_*_args', both self and callee, are always 4 -tuples:
4502
+ * NB: 'all_*_args', both self and callee, are always 5 -tuples:
4477
4503
*
4478
4504
* [out_ptr, task_ptr, indirect_args, ty_params, [args]]
4479
4505
*
@@ -4486,17 +4512,31 @@ let trans_visitor
4486
4512
let self_args_cell =
4487
4513
get_element_ptr all_self_args_cell Abi. calltup_elt_args
4488
4514
in
4489
- let self_ty_params_cell =
4490
- get_element_ptr all_self_args_cell Abi. calltup_elt_ty_params
4515
+ let self_indirect_args_cell =
4516
+ get_element_ptr all_self_args_cell Abi. calltup_elt_indirect_args
4517
+ in
4518
+ let closure_box_cell =
4519
+ deref (get_element_ptr self_indirect_args_cell
4520
+ Abi. indirect_args_elt_closure)
4521
+ in
4522
+ let closure_cell =
4523
+ get_element_ptr closure_box_cell Abi. box_rc_field_body
4524
+ in
4525
+ let closure_args_cell =
4526
+ get_element_ptr closure_cell Abi. closure_body_elt_bound_args
4527
+ in
4528
+ let closure_ty_params_cell =
4529
+ get_element_ptr closure_cell Abi. closure_body_elt_bound_ty_params
4530
+ in
4531
+ let callee_ty_params_cell =
4532
+ get_element_ptr all_callee_args_cell Abi. calltup_elt_ty_params
4491
4533
in
4492
4534
let callee_args_cell =
4493
4535
(* FIXME (issue #81): Once we've actually got proper ty_params,
4494
4536
* we should GEP dynamically here to get the args, since they may
4495
4537
* be aligned dynamically if they have parameterized type. *)
4496
- get_element_ptr all_callee_args_cell Abi. calltup_elt_args
4497
- in
4498
- let self_indirect_args_cell =
4499
- get_element_ptr all_self_args_cell Abi. calltup_elt_indirect_args
4538
+ get_element_ptr_dyn closure_ty_params_cell
4539
+ all_callee_args_cell Abi. calltup_elt_args
4500
4540
in
4501
4541
4502
4542
let n_args = Array. length arg_bound_flags in
@@ -4515,51 +4555,46 @@ let trans_visitor
4515
4555
(Il. Cell (get_element_ptr all_self_args_cell
4516
4556
Abi. calltup_elt_task_ptr));
4517
4557
4518
- iflog (fun _ -> annotate " extract closure indirect-arg" );
4519
- let closure_box_cell =
4520
- deref (get_element_ptr self_indirect_args_cell
4521
- Abi. indirect_args_elt_closure)
4522
- in
4523
- let closure_cell =
4524
- get_element_ptr closure_box_cell Abi. box_rc_field_body
4525
- in
4526
-
4527
- let closure_args_cell =
4528
- get_element_ptr closure_cell Abi. closure_body_elt_bound_args
4529
- in
4558
+ iflog (fun _ -> annotate " copy ty-params" );
4559
+ for ty_i = 0 to (n_ty_params - 1 ) do
4560
+ mov
4561
+ (get_element_ptr callee_ty_params_cell ty_i)
4562
+ (Il. Cell (get_element_ptr closure_ty_params_cell ty_i))
4563
+ done ;
4530
4564
4531
- for arg_i = 0 to (n_args - 1 ) do
4532
- let dst_cell = get_element_ptr callee_args_cell arg_i in
4533
- let slot = arg_slots.(arg_i) in
4534
- let is_bound = arg_bound_flags.(arg_i) in
4535
- let src_cell =
4536
- if is_bound then
4537
- begin
4538
- iflog (fun _ -> annotate
4539
- (Printf. sprintf
4540
- " extract bound arg %d as actual arg %d"
4541
- ! bound_i arg_i));
4542
- get_element_ptr closure_args_cell (! bound_i)
4543
- end
4544
- else
4545
- begin
4546
- iflog (fun _ -> annotate
4547
- (Printf. sprintf
4548
- " extract unbound arg %d as actual arg %d"
4549
- ! unbound_i arg_i));
4550
- get_element_ptr self_args_cell (! unbound_i);
4551
- end
4552
- in
4553
- iflog (fun _ -> annotate
4554
- (Printf. sprintf
4555
- " copy into actual-arg %d" arg_i));
4556
- trans_init_slot_from_cell
4557
- self_ty_params_cell CLONE_none
4558
- dst_cell slot
4559
- (deref_slot false src_cell slot) (slot_ty slot);
4560
- incr (if is_bound then bound_i else unbound_i);
4561
- done ;
4562
- assert ((! bound_i + ! unbound_i) == n_args)
4565
+ iflog (fun _ -> annotate " copy args" );
4566
+ for arg_i = 0 to (n_args - 1 ) do
4567
+ let dst_cell = get_element_ptr callee_args_cell arg_i in
4568
+ let slot = arg_slots.(arg_i) in
4569
+ let is_bound = arg_bound_flags.(arg_i) in
4570
+ let src_cell =
4571
+ if is_bound then
4572
+ begin
4573
+ iflog (fun _ -> annotate
4574
+ (Printf. sprintf
4575
+ " extract bound arg %d as actual arg %d"
4576
+ ! bound_i arg_i));
4577
+ get_element_ptr closure_args_cell (! bound_i)
4578
+ end
4579
+ else
4580
+ begin
4581
+ iflog (fun _ -> annotate
4582
+ (Printf. sprintf
4583
+ " extract unbound arg %d as actual arg %d"
4584
+ ! unbound_i arg_i));
4585
+ get_element_ptr self_args_cell (! unbound_i);
4586
+ end
4587
+ in
4588
+ iflog (fun _ -> annotate
4589
+ (Printf. sprintf
4590
+ " copy into actual-arg %d" arg_i));
4591
+ trans_init_slot_from_cell
4592
+ closure_ty_params_cell CLONE_none
4593
+ dst_cell slot
4594
+ (deref_slot false src_cell slot) (slot_ty slot);
4595
+ incr (if is_bound then bound_i else unbound_i);
4596
+ done ;
4597
+ assert ((! bound_i + ! unbound_i) == n_args)
4563
4598
end
4564
4599
4565
4600
0 commit comments