@@ -1248,12 +1248,16 @@ let trans_visitor
1248
1248
(sorted_htab_keys fns))
1249
1249
end
1250
1250
1251
- and trans_init_str (dst :Ast.lval ) (s :string ) : unit =
1251
+ and trans_init_str (initializing :bool ) ( dst :Ast.lval ) (s :string ) : unit =
1252
1252
(* Include null byte. *)
1253
1253
let init_sz = Int64. of_int ((String. length s) + 1 ) in
1254
1254
let static = trans_static_string s in
1255
- let (dst, _) = trans_lval_init dst in
1256
- trans_upcall " upcall_new_str" dst [| static; imm init_sz |]
1255
+ let (dst_cell, dst_ty) = trans_lval_maybe_init initializing dst in
1256
+ let _ =
1257
+ if not initializing
1258
+ then drop_ty_in_current_frame dst_cell dst_ty
1259
+ in
1260
+ trans_upcall " upcall_new_str" dst_cell [| static; imm init_sz |]
1257
1261
1258
1262
and trans_lit (lit :Ast.lit ) : Il.operand =
1259
1263
match lit with
@@ -2220,22 +2224,33 @@ let trans_visitor
2220
2224
trans_atom (Ast. ATOM_lval chan) |];
2221
2225
end
2222
2226
2223
- and trans_init_port (dst :Ast.lval ) : unit =
2224
- let (dstcell, dst_ty) = trans_lval_init dst in
2227
+ and trans_init_port (initializing :bool ) (dst :Ast.lval ) : unit =
2228
+ let (dst_cell, dst_ty) = trans_lval_maybe_init initializing dst in
2229
+ let _ =
2230
+ if not initializing
2231
+ then drop_ty_in_current_frame dst_cell dst_ty
2232
+ in
2225
2233
let unit_ty = match dst_ty with
2226
2234
Ast. TY_port t -> t
2227
2235
| _ -> bug () " init dst of port-init has non-port type"
2228
2236
in
2229
2237
let unit_sz = ty_sz abi unit_ty in
2230
- trans_upcall " upcall_new_port" dstcell [| imm unit_sz |]
2238
+ trans_upcall " upcall_new_port" dst_cell [| imm unit_sz |]
2231
2239
2232
2240
and trans_del_port (port :Il.cell ) : unit =
2233
2241
trans_void_upcall " upcall_del_port" [| Il. Cell port |]
2234
2242
2235
- and trans_init_chan (dst :Ast.lval ) (port :Ast.lval ) : unit =
2236
- let (dstcell, _) = trans_lval_init dst
2243
+ and trans_init_chan
2244
+ (initializing :bool )
2245
+ (dst :Ast.lval )
2246
+ (port :Ast.lval )
2247
+ : unit =
2248
+ let (dst_cell, dst_ty) = trans_lval_maybe_init initializing dst in
2249
+ let _ =
2250
+ if not initializing
2251
+ then drop_ty_in_current_frame dst_cell dst_ty
2237
2252
in
2238
- trans_upcall " upcall_new_chan" dstcell
2253
+ trans_upcall " upcall_new_chan" dst_cell
2239
2254
[| trans_atom (Ast. ATOM_lval port) |]
2240
2255
2241
2256
and trans_del_chan (chan :Il.cell ) : unit =
@@ -2258,8 +2273,16 @@ let trans_visitor
2258
2273
* part out for reuse in string code.
2259
2274
*)
2260
2275
2261
- and trans_init_vec (dst :Ast.lval ) (atoms :Ast.atom array ) : unit =
2262
- let (dst_cell, dst_ty) = trans_lval_init dst in
2276
+ and trans_init_vec
2277
+ (initializing :bool )
2278
+ (dst :Ast.lval )
2279
+ (atoms :Ast.atom array )
2280
+ : unit =
2281
+ let (dst_cell, dst_ty) = trans_lval_maybe_init initializing dst in
2282
+ let _ =
2283
+ if not initializing
2284
+ then drop_ty_in_current_frame dst_cell dst_ty
2285
+ in
2263
2286
let gc_ctrl =
2264
2287
if (ty_mem_ctrl dst_ty) = MEM_gc
2265
2288
then Il. Cell (get_tydesc None dst_ty)
@@ -2292,17 +2315,26 @@ let trans_visitor
2292
2315
mov (get_element_ptr vec Abi. vec_elt_fill) (Il. Cell fill);
2293
2316
2294
2317
2295
- and trans_init_box (dst :Ast.lval ) (src :Ast.atom ) : unit =
2318
+ and trans_init_box
2319
+ (initializing :bool )
2320
+ (dst :Ast.lval )
2321
+ (src :Ast.atom )
2322
+ : unit =
2296
2323
let src_op = trans_atom src in
2297
2324
let src_cell = Il. Mem (force_to_mem src_op) in
2298
2325
let src_ty = simplified_ty (atom_type cx src) in
2299
- let dst_sloti = lval_base_to_slot cx dst in
2300
- let dst_cell = cell_of_block_slot dst_sloti.id in
2301
- let dst_cell = deref_slot true dst_cell dst_sloti.node in
2302
- let dst_ty = slot_ty dst_sloti.node in
2326
+ let (dst_cell, dst_ty) = trans_lval_maybe_init initializing dst in
2327
+ let _ =
2328
+ if not initializing
2329
+ then drop_ty_in_current_frame dst_cell dst_ty
2330
+ in
2331
+ let dst_ty = strip_mutable_or_constrained_ty dst_ty in
2303
2332
let (dst_cell, dst_ty) =
2304
2333
deref_ty DEREF_one_box true dst_cell dst_ty
2305
2334
in
2335
+ let _ = log cx " init_box: dst ty %a, src ty %a"
2336
+ Ast. sprintf_ty dst_ty Ast. sprintf_ty src_ty
2337
+ in
2306
2338
let _ = assert (dst_ty = src_ty) in
2307
2339
trans_copy_ty (get_ty_params_of_current_frame() ) true
2308
2340
dst_cell dst_ty src_cell src_ty None
@@ -2868,6 +2900,12 @@ let trans_visitor
2868
2900
: unit =
2869
2901
drop_slot (get_ty_params_of_current_frame() ) cell slot curr_iso
2870
2902
2903
+ and drop_ty_in_current_frame
2904
+ (cell :Il.cell )
2905
+ (ty :Ast.ty )
2906
+ : unit =
2907
+ drop_ty (get_ty_params_of_current_frame() ) cell ty None
2908
+
2871
2909
and null_check (cell :Il.cell ) : quad_idx =
2872
2910
emit (Il. cmp (Il. Cell cell) zero);
2873
2911
let j = mark() in
@@ -4338,7 +4376,7 @@ let trans_visitor
4338
4376
4339
4377
4340
4378
and trans_copy_binop dst binop a_src =
4341
- let (dst_cell, dst_ty) = trans_lval_maybe_init false dst in
4379
+ let (dst_cell, dst_ty) = trans_lval dst in
4342
4380
let src_oper = trans_atom a_src in
4343
4381
match dst_ty with
4344
4382
Ast. TY_str
@@ -4440,15 +4478,15 @@ let trans_visitor
4440
4478
end
4441
4479
4442
4480
| Ast. STMT_init_rec (dst , atab , base ) ->
4443
- let (slot_cell, ty) = trans_lval_init dst in
4481
+ let init = maybe_init stmt.id " rec-init" dst in
4482
+ let (dst_cell, ty) = trans_lval_maybe_init init dst in
4444
4483
let (trec, dst_tys) =
4445
4484
match ty with
4446
4485
Ast. TY_rec trec -> (trec, Array. map snd trec)
4447
4486
| _ ->
4448
4487
bugi cx stmt.id
4449
4488
" non-rec destination type in stmt_init_rec"
4450
4489
in
4451
- let (dst_cell, _) = deref_ty DEREF_none true slot_cell ty in
4452
4490
begin
4453
4491
match base with
4454
4492
None ->
@@ -4461,42 +4499,52 @@ let trans_visitor
4461
4499
end
4462
4500
4463
4501
| Ast. STMT_init_tup (dst , elems ) ->
4464
- let (slot_cell, ty) = trans_lval_init dst in
4502
+ let init = maybe_init stmt.id " tup-init" dst in
4503
+ let (dst_cell, dst_ty) = trans_lval_maybe_init init dst in
4504
+ let _ =
4505
+ if not init
4506
+ then drop_ty_in_current_frame dst_cell dst_ty
4507
+ in
4465
4508
let dst_tys =
4466
- match ty with
4509
+ match dst_ty with
4467
4510
Ast. TY_tup ttup -> ttup
4468
4511
| _ ->
4469
4512
bugi cx stmt.id
4470
4513
" non-tup destination type in stmt_init_tup"
4471
4514
in
4472
4515
let atoms = Array. map snd elems in
4473
- let (dst_cell, _) = deref_ty DEREF_none true slot_cell ty in
4516
+ let (dst_cell, _) = deref_ty DEREF_none init dst_cell dst_ty in
4474
4517
trans_init_structural_from_atoms dst_cell dst_tys atoms
4475
4518
4476
4519
4477
4520
| Ast. STMT_init_str (dst , s ) ->
4478
- trans_init_str dst s
4521
+ let init = maybe_init stmt.id " str-init" dst in
4522
+ trans_init_str init dst s
4479
4523
4480
4524
| Ast. STMT_init_vec (dst , _ , atoms ) ->
4481
- trans_init_vec dst atoms
4525
+ let init = maybe_init stmt.id " vec-init" dst in
4526
+ trans_init_vec init dst atoms
4482
4527
4483
4528
| Ast. STMT_init_port dst ->
4484
- trans_init_port dst
4529
+ let init = maybe_init stmt.id " port-init" dst in
4530
+ trans_init_port init dst
4485
4531
4486
4532
| Ast. STMT_init_chan (dst , port ) ->
4533
+ let init = maybe_init stmt.id " chan-init" dst in
4487
4534
begin
4488
4535
match port with
4489
4536
None ->
4490
4537
let (dst_cell, _) =
4491
- trans_lval_init dst
4538
+ trans_lval_maybe_init init dst
4492
4539
in
4493
4540
mov dst_cell imm_false
4494
4541
| Some p ->
4495
- trans_init_chan dst p
4542
+ trans_init_chan init dst p
4496
4543
end
4497
4544
4498
4545
| Ast. STMT_init_box (dst , _ , src ) ->
4499
- trans_init_box dst src
4546
+ let init = maybe_init stmt.id " box-init" dst in
4547
+ trans_init_box init dst src
4500
4548
4501
4549
| Ast. STMT_block block ->
4502
4550
trans_block block
0 commit comments