@@ -88,6 +88,7 @@ let trans_visitor
88
88
let zero = imm 0L in
89
89
let imm_true = imm_of_ty 1L TY_u8 in
90
90
let imm_false = imm_of_ty 0L TY_u8 in
91
+ let zero_byte = imm_of_ty 0L TY_u8 in
91
92
let nil_ptr = Il. Mem ((Il. Abs (Asm. IMM 0L )), Il. NilTy ) in
92
93
let wordptr_ty = Il. AddrTy (Il. ScalarTy word_sty) in
93
94
@@ -4389,18 +4390,18 @@ let trans_visitor
4389
4390
(src_ty :Ast.ty )
4390
4391
: unit =
4391
4392
let elt_ty = seq_unit_ty dst_ty in
4392
- let trim_trailing_null = dst_ty = Ast. TY_str in
4393
- assert (simplified_ty src_ty = simplified_ty dst_ty);
4394
- match simplified_ty src_ty with
4395
- Ast. TY_str
4396
- | Ast. TY_vec _ ->
4393
+ let trailing_null = simplified_ty dst_ty = Ast. TY_str in
4394
+ match (simplified_ty dst_ty, simplified_ty src_ty) with
4395
+ ( Ast. TY_str, Ast. TY_str)
4396
+ | ( Ast. TY_vec _, Ast. TY_vec _)
4397
+ when (simplified_ty dst_ty) = (simplified_ty src_ty) ->
4397
4398
let is_gc = if type_has_state src_ty then 1L else 0L in
4398
4399
let src_cell = need_cell src_oper in
4399
4400
let src_vec = deref src_cell in
4400
4401
let src_fill = get_element_ptr src_vec Abi. vec_elt_fill in
4401
4402
let dst_vec = deref dst_cell in
4402
4403
let dst_fill = get_element_ptr dst_vec Abi. vec_elt_fill in
4403
- if trim_trailing_null
4404
+ if trailing_null
4404
4405
then sub_from dst_fill (imm 1L );
4405
4406
trans_upcall " upcall_vec_grow"
4406
4407
dst_cell
@@ -4457,9 +4458,53 @@ let trans_visitor
4457
4458
let v = next_vreg_cell word_sty in
4458
4459
mov v (Il. Cell src_fill);
4459
4460
add_to dst_fill (Il. Cell v);
4460
- | t ->
4461
+
4462
+ | (Ast. TY_str , e)
4463
+ | (Ast. TY_vec _, e)
4464
+ when e = simplified_ty elt_ty ->
4465
+
4466
+ let dst_is_gc = if type_has_state dst_ty then 1L else 0L in
4467
+ let elt_sz = ty_sz_in_current_frame elt_ty in
4468
+ trans_upcall " upcall_vec_grow"
4469
+ dst_cell
4470
+ [| Il. Cell dst_cell;
4471
+ elt_sz;
4472
+ imm dst_is_gc |];
4473
+
4474
+ (*
4475
+ * By now, dst_cell points to a vec/str with room for us
4476
+ * to add to.
4477
+ *)
4478
+
4479
+ (* Reload dst vec, fill; might have changed. *)
4480
+ let dst_vec = deref dst_cell in
4481
+ let dst_fill = get_element_ptr dst_vec Abi. vec_elt_fill in
4482
+
4483
+ let eltp_rty = Il. AddrTy (referent_type word_bits elt_ty) in
4484
+ let dptr = next_vreg_cell eltp_rty in
4485
+ let dst_data =
4486
+ get_element_ptr_dyn_in_current_frame
4487
+ dst_vec Abi. vec_elt_data
4488
+ in
4489
+ lea dptr (fst (need_mem_cell dst_data));
4490
+ add_to dptr (Il. Cell dst_fill);
4491
+ if trailing_null
4492
+ then sub_from dptr elt_sz;
4493
+ trans_copy_ty
4494
+ (get_ty_params_of_current_frame() ) true
4495
+ (deref dptr) elt_ty
4496
+ (Il. Mem (force_to_mem src_oper)) elt_ty
4497
+ None ;
4498
+ add_to dptr elt_sz;
4499
+ if trailing_null
4500
+ then mov (deref dptr) zero_byte;
4501
+ add_to dst_fill elt_sz;
4502
+
4503
+ | _ ->
4461
4504
begin
4462
- bug () " unsupported vector-append type %a" Ast. sprintf_ty t
4505
+ bug () " unsupported vector-append types %a += %a"
4506
+ Ast. sprintf_ty dst_ty
4507
+ Ast. sprintf_ty src_ty
4463
4508
end
4464
4509
4465
4510
0 commit comments