Skip to content

Commit

Permalink
Manual merge conflict resolution
Browse files Browse the repository at this point in the history
  • Loading branch information
@luc-blaeser
luc-blaeser committed Aug 19, 2024
1 parent 99dfdd2 commit 1f7c2f3
Showing 1 changed file with 142 additions and 14 deletions.
156 changes: 142 additions & 14 deletions src/codegen/compile_classical.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6406,7 +6406,12 @@ module RTS_Exports = struct
E.add_export env (nr {
name = Lib.Utf8.decode "moc_stable_mem_set_version";
edesc = nr (FuncExport (nr moc_stable_mem_set_version_fi))
})
});

E.add_export env (nr {
name = Lib.Utf8.decode "idl_limit_check";
edesc = nr (FuncExport (nr (E.built_in env "idl_limit_check")))
})

end (* RTS_Exports *)

Expand Down Expand Up @@ -6596,13 +6601,23 @@ module MakeSerialization (Strm : Stream) = struct
G.i (GlobalGet (nr (E.get_global env "__typtbl_idltyps")))

module Registers = struct

(* interval for checking instruction counter *)
let idl_value_numerator = 1l
let idl_value_denominator = 1l
let idl_value_bias = 1024l

let register_globals env =
E.add_global32 env "@@rel_buf_opt" Mutable 0l;
E.add_global32 env "@@data_buf" Mutable 0l;
E.add_global32 env "@@ref_buf" Mutable 0l;
E.add_global32 env "@@typtbl" Mutable 0l;
E.add_global32 env "@@typtbl_end" Mutable 0l;
E.add_global32 env "@@typtbl_size" Mutable 0l
E.add_global32 env "@@typtbl_size" Mutable 0l;
E.add_global32 env "@@value_denominator" Mutable idl_value_denominator;
E.add_global32 env "@@value_numerator" Mutable idl_value_numerator;
E.add_global32 env "@@value_bias" Mutable idl_value_bias;
E.add_global64 env "@@value_quota" Mutable 0L

let get_rel_buf_opt env =
G.i (GlobalGet (nr (E.get_global env "@@rel_buf_opt")))
Expand Down Expand Up @@ -6633,6 +6648,88 @@ module MakeSerialization (Strm : Stream) = struct
G.i (GlobalGet (nr (E.get_global env "@@typtbl_size")))
let set_typtbl_size env =
G.i (GlobalSet (nr (E.get_global env "@@typtbl_size")))

let get_value_quota env =
G.i (GlobalGet (nr (E.get_global env "@@value_quota")))
let set_value_quota env =
G.i (GlobalSet (nr (E.get_global env "@@value_quota")))

let get_value_numerator env =
G.i (GlobalGet (nr (E.get_global env "@@value_numerator")))
let set_value_numerator env =
G.i (GlobalSet (nr (E.get_global env "@@value_numerator")))

let get_value_denominator env =
G.i (GlobalGet (nr (E.get_global env "@@value_denominator")))
let set_value_denominator env =
G.i (GlobalSet (nr (E.get_global env "@@value_denominator")))

let get_value_bias env =
G.i (GlobalGet (nr (E.get_global env "@@value_bias")))
let set_value_bias env =
G.i (GlobalSet (nr (E.get_global env "@@value_bias")))

let reset_value_limit env get_blob get_rel_buf_opt =
get_rel_buf_opt ^^
G.if0
begin (* Candid deserialization *)
(* Set instruction limit *)
(* Use 32-bit factors and terms to (mostly) avoid 64-bit overflow *)
let (set_product, get_product) = new_local64 env "product" in
get_blob ^^
Blob.len env ^^
G.i (Convert (Wasm.Values.I64 I64Op.ExtendUI32)) ^^
get_value_numerator env ^^
G.i (Convert (Wasm.Values.I64 I64Op.ExtendUI32)) ^^
G.i (Binary (Wasm.Values.I64 I64Op.Mul)) ^^
get_value_denominator env ^^
G.i (Convert (Wasm.Values.I64 I64Op.ExtendUI32)) ^^
G.i (Binary (Wasm.Values.I64 I64Op.DivU)) ^^
set_product ^^
get_product ^^
get_value_bias env ^^
G.i (Convert (Wasm.Values.I64 I64Op.ExtendUI32)) ^^
G.i (Binary (Wasm.Values.I64 I64Op.Add)) ^^
set_value_quota env ^^
(* Saturate value_quota on overflow *)
get_value_quota env ^^
get_product ^^
G.i (Compare (Wasm.Values.I64 I64Op.LtU)) ^^
G.if0 begin
compile_const_64 (-1L) ^^
set_value_quota env
end
G.nop
end
begin (* Extended candid/ Destabilization *)
G.nop
end

let define_idl_limit_check env =
Func.define_built_in env "idl_limit_check"
[("decrement", I32Type); ("count", I64Type)] [] (fun env ->
get_rel_buf_opt env ^^
G.if0 begin (* Candid deserialization *)
get_value_quota env ^^
G.i (LocalGet (nr 1l)) ^^ (* Count of values *)
G.i (Compare (Wasm.Values.I64 I64Op.LtU)) ^^
E.then_trap_with env "IDL error: exceeded value limit" ^^
(* if (decrement) quota -= count *)
G.i (LocalGet (nr 0l)) ^^
G.if0 begin
get_value_quota env ^^
G.i (LocalGet (nr 1l)) ^^
G.i (Binary (Wasm.Values.I64 I64Op.Sub)) ^^
set_value_quota env
end
G.nop
end begin (* Extended Candid/Destabilization *)
G.nop
end)

let idl_limit_check env =
G.i (Call (nr (E.built_in env "idl_limit_check")))

end

open Typ_hash
Expand Down Expand Up @@ -7289,6 +7386,11 @@ module MakeSerialization (Strm : Stream) = struct
let get_typtbl_end = Registers.get_typtbl_end env in
let get_typtbl_size = Registers.get_typtbl_size env in

(* Decrement and check idl quota *)
compile_unboxed_const 1l ^^
compile_const_64 1L ^^
Registers.idl_limit_check env ^^

(* Check recursion depth (protects against empty record etc.) *)
(* Factor 2 because at each step, the expected type could go through one
level of opt that is not present in the value type
Expand Down Expand Up @@ -7707,7 +7809,7 @@ module MakeSerialization (Strm : Stream) = struct
end
begin
match normalize t with
| Opt _ | Any -> Opt.null_lit env
| Prim Null | Opt _ | Any -> Opt.null_lit env
| _ -> coercion_failed "IDL error: did not find tuple field in record"
end
) ts ^^
Expand Down Expand Up @@ -7736,7 +7838,7 @@ module MakeSerialization (Strm : Stream) = struct
end
begin
match normalize f.typ with
| Opt _ | Any -> Opt.null_lit env
| Prim Null | Opt _ | Any -> Opt.null_lit env
| _ -> coercion_failed (Printf.sprintf "IDL error: did not find field %s in record" f.lab)
end
) (sort_by_hash fs)) ^^
Expand Down Expand Up @@ -7798,6 +7900,10 @@ module MakeSerialization (Strm : Stream) = struct
ReadBuf.read_sleb128 env get_typ_buf ^^
set_arg_typ ^^
ReadBuf.read_leb128 env get_data_buf ^^ set_len ^^
(* Don't decrement just check quota *)
compile_unboxed_const 0l ^^
get_len ^^ G.i (Convert (Wasm.Values.I64 I64Op.ExtendUI32)) ^^
Registers.idl_limit_check env ^^
Arr.alloc env Tagged.I get_len ^^ set_x ^^
get_len ^^ from_0_to_n env (fun get_i ->
get_x ^^ get_i ^^ Arr.unsafe_idx env ^^
Expand Down Expand Up @@ -8045,6 +8151,16 @@ module MakeSerialization (Strm : Stream) = struct

(* Allocate memo table, if necessary *)
with_rel_buf_opt env extended (get_typtbl_size_ptr ^^ load_unskewed_ptr) (fun get_rel_buf_opt ->
begin
(* set up invariant register arguments *)
get_rel_buf_opt ^^ Registers.set_rel_buf_opt env ^^
get_data_buf ^^ Registers.set_data_buf env ^^
get_ref_buf ^^ Registers.set_ref_buf env ^^
get_typtbl_ptr ^^ load_unskewed_ptr ^^ Registers.set_typtbl env ^^
get_maintyps_ptr ^^ load_unskewed_ptr ^^ Registers.set_typtbl_end env ^^
get_typtbl_size_ptr ^^ load_unskewed_ptr ^^ Registers.set_typtbl_size env ^^
Registers.reset_value_limit env get_blob get_rel_buf_opt
end ^^

(* set up a dedicated read buffer for the list of main types *)
ReadBuf.alloc env (fun get_main_typs_buf ->
Expand All @@ -8055,7 +8171,7 @@ module MakeSerialization (Strm : Stream) = struct
G.concat_map (fun t ->
let can_recover, default_or_trap = Type.(
match normalize t with
| Opt _ | Any ->
| Prim Null | Opt _ | Any ->
(Bool.lit true, fun msg -> Opt.null_lit env)
| _ ->
(get_can_recover, fun msg ->
Expand All @@ -8069,15 +8185,6 @@ module MakeSerialization (Strm : Stream) = struct
G.if1 I32Type
(default_or_trap ("IDL error: too few arguments " ^ ts_name))
(begin
begin
(* set up invariant register arguments *)
get_rel_buf_opt ^^ Registers.set_rel_buf_opt env ^^
get_data_buf ^^ Registers.set_data_buf env ^^
get_ref_buf ^^ Registers.set_ref_buf env ^^
get_typtbl_ptr ^^ load_unskewed_ptr ^^ Registers.set_typtbl env ^^
get_maintyps_ptr ^^ load_unskewed_ptr ^^ Registers.set_typtbl_end env ^^
get_typtbl_size_ptr ^^ load_unskewed_ptr ^^ Registers.set_typtbl_size env
end ^^
(* set up variable frame arguments *)
Stack.with_frame env "frame_ptr" 3l (fun () ->
(* idltyp *)
Expand Down Expand Up @@ -11816,6 +11923,26 @@ and compile_prim_invocation (env : E.t) ae p es at =
| OtherPrim "btstInt64", [_;_] ->
const_sr (SR.UnboxedWord64 Type.Int64) (Word64.btst_kernel env)

| OtherPrim "setCandidLimits", [e1; e2; e3] ->
SR.unit,
compile_exp_as env ae (SR.UnboxedWord32 Type.Nat32) e1 ^^
Serialization.Registers.set_value_numerator env ^^
compile_exp_as env ae (SR.UnboxedWord32 Type.Nat32) e2 ^^
Serialization.Registers.set_value_denominator env ^^
Serialization.Registers.get_value_denominator env ^^
E.else_trap_with env "Candid limit denominator cannot be zero" ^^
compile_exp_as env ae (SR.UnboxedWord32 Type.Nat32) e3 ^^
Serialization.Registers.set_value_bias env

| OtherPrim "getCandidLimits", [] ->
SR.UnboxedTuple 3,
Serialization.Registers.get_value_numerator env ^^
BoxedSmallWord.box env Type.Nat32 ^^
Serialization.Registers.get_value_denominator env ^^
BoxedSmallWord.box env Type.Nat32 ^^
Serialization.Registers.get_value_bias env ^^
BoxedSmallWord.box env Type.Nat32

(* Coercions for abstract types *)
| CastPrim (_,_), [e] ->
compile_exp env ae e
Expand Down Expand Up @@ -12919,6 +13046,7 @@ let compile mode rts (prog : Ir.prog) : Wasm_exts.CustomModule.extended_module =
GC.register_globals env;
StableMem.register_globals env;
Serialization.Registers.register_globals env;
Serialization.Registers.define_idl_limit_check env;

(* See Note [Candid subtype checks] *)
let set_serialization_globals = Serialization.register_delayed_globals env in
Expand Down

0 comments on commit 1f7c2f3

Please sign in to comment.