diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml index fd214f6bf86..2a95e223c31 100644 --- a/src/codegen/compile.ml +++ b/src/codegen/compile.ml @@ -6581,11 +6581,31 @@ module MakeSerialization (Strm : Stream) = struct let set_instruction_limit env = G.i (GlobalSet (nr (E.get_global env "@@instruction_limit"))) + let get_instruction_factor env = + G.i (GlobalGet (nr (E.get_global env "@@instruction_factor"))) + let set_instruction_factor env = + G.i (GlobalSet (nr (E.get_global env "@@instruction_factor"))) + + let get_instruction_bias env = + G.i (GlobalGet (nr (E.get_global env "@@instruction_bias"))) + let set_instruction_bias env = + G.i (GlobalSet (nr (E.get_global env "@@instruction_bias"))) + let get_allocation_limit env = G.i (GlobalGet (nr (E.get_global env "@@allocation_limit"))) let set_allocation_limit env = G.i (GlobalSet (nr (E.get_global env "@@allocation_limit"))) + let get_allocation_factor env = + G.i (GlobalGet (nr (E.get_global env "@@allocation_factor"))) + let set_allocation_factor env = + G.i (GlobalSet (nr (E.get_global env "@@allocation_factor"))) + + let get_allocation_bias env = + G.i (GlobalGet (nr (E.get_global env "@@allocation_bias"))) + let set_allocation_bias env = + G.i (GlobalSet (nr (E.get_global env "@@allocation_bias"))) + (* interval for checking instruction counter *) let idl_limit_interval = 32l (* TUNE *) let idl_instruction_factor = 1000L (* TUNE *) @@ -6621,9 +6641,9 @@ module MakeSerialization (Strm : Stream) = struct get_blob ^^ Blob.len env ^^ G.i (Convert (Wasm.Values.I64 I64Op.ExtendUI32)) ^^ - compile_const_64 idl_instruction_factor ^^ + get_instruction_factor env ^^ G.i (Binary (Wasm.Values.I64 I64Op.Mul)) ^^ - compile_const_64 idl_instruction_bias ^^ + get_instruction_bias env ^^ G.i (Binary (Wasm.Values.I64 I64Op.Add)) ^^ G.i (Binary (Wasm.Values.I64 I64Op.Add)) ^^ set_instruction_limit env ^^ @@ -6632,9 +6652,9 @@ module MakeSerialization (Strm : Stream) = struct get_blob ^^ Blob.len env ^^ G.i (Convert (Wasm.Values.I64 I64Op.ExtendUI32)) ^^ - compile_const_64 idl_allocation_factor ^^ + get_allocation_factor env ^^ G.i (Binary (Wasm.Values.I64 I64Op.Mul)) ^^ - compile_const_64 idl_allocation_bias ^^ + get_allocation_bias env ^^ G.i (Binary (Wasm.Values.I64 I64Op.Add)) ^^ G.i (Binary (Wasm.Values.I64 I64Op.Add)) ^^ set_allocation_limit env @@ -6654,6 +6674,10 @@ module MakeSerialization (Strm : Stream) = struct E.add_global32 env "@@typtbl_end" Mutable 0l; E.add_global32 env "@@typtbl_size" Mutable 0l; E.add_global32 env "@@limit_counter" Mutable idl_limit_interval; + E.add_global64 env "@@instruction_factor" Mutable idl_instruction_factor; + E.add_global64 env "@@instruction_bias" Mutable idl_instruction_bias; + E.add_global64 env "@@allocation_factor" Mutable idl_allocation_factor; + E.add_global64 env "@@allocation_bias" Mutable idl_allocation_bias; (match E.mode env with | Flags.ICMode | Flags.RefMode -> () @@ -11856,6 +11880,28 @@ 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; e4] -> + SR.unit, + compile_exp_as env ae (SR.UnboxedWord64 Type.Nat64) e1 ^^ + Serialization.Registers.set_instruction_factor env ^^ + compile_exp_as env ae (SR.UnboxedWord64 Type.Nat64) e2 ^^ + Serialization.Registers.set_instruction_bias env ^^ + compile_exp_as env ae (SR.UnboxedWord64 Type.Nat64) e3 ^^ + Serialization.Registers.set_allocation_factor env ^^ + compile_exp_as env ae (SR.UnboxedWord64 Type.Nat64) e4 ^^ + Serialization.Registers.set_allocation_bias env + + | OtherPrim "getCandidLimits", [] -> + SR.UnboxedTuple 4, + Serialization.Registers.get_instruction_factor env ^^ + BoxedWord64.box env Type.Nat64 ^^ + Serialization.Registers.get_instruction_bias env ^^ + BoxedWord64.box env Type.Nat64 ^^ + Serialization.Registers.get_allocation_factor env ^^ + BoxedWord64.box env Type.Nat64 ^^ + Serialization.Registers.get_allocation_bias env ^^ + BoxedWord64.box env Type.Nat64 + (* Coercions for abstract types *) | CastPrim (_,_), [e] -> compile_exp env ae e diff --git a/src/prelude/prim.mo b/src/prelude/prim.mo index b750b75dfad..f14a4a6cdb4 100644 --- a/src/prelude/prim.mo +++ b/src/prelude/prim.mo @@ -501,6 +501,24 @@ let call_raw = @call_raw; func performanceCounter(counter : Nat32) : Nat64 = (prim "performanceCounter" : (Nat32) -> Nat64) counter; + +// Candid configuration +func setCandidLimits ( + { instructions: { factor: Nat64; bias : Nat64 }; + allocations: { factor: Nat64; bias : Nat64 } } + ) { + (prim "setCandidLimits" : (Nat64, Nat64, Nat64, Nat64) -> ()) + (instructions.factor, instructions.bias, allocations.factor, allocations.bias) +}; + +func getCandidLimits() : + { instructions: { factor: Nat64; bias : Nat64}; + allocations: { factor: Nat64; bias : Nat64 } } { + let (f1, b1, f2, b2) = (prim "getCandidLimits" : () -> (Nat64, Nat64, Nat64, Nat64)) (); + { instructions = { factor = f1; bias = b1 }; + allocations = { factor = f2; bias = b2 } } +}; + // predicates for motoko-san func forall(f: T -> Bool): Bool { diff --git a/test/run-drun/max-stack-variant.mo b/test/run-drun/max-stack-variant.mo index 692a8e0f431..a5c21dde983 100644 --- a/test/run-drun/max-stack-variant.mo +++ b/test/run-drun/max-stack-variant.mo @@ -1,9 +1,10 @@ //MOC-FLAG --compacting-gc --rts-stack-pages 32 -measure-rts-stack -import { errorMessage; debugPrint; } = "mo:⛔"; +import { errorMessage; debugPrint; setCandidLimits} = "mo:⛔"; actor { let expectedMinimumSize = 31_000; - + setCandidLimits{ instructions = {factor = 0; bias = 5_000_000_000 }; + allocations = {factor = 0; bias = 5_000_000_000 } }; public func ser() : async () { await go(false) }; public func deser() : async () { await go(true) }; @@ -37,9 +38,9 @@ actor { done := true } }; - + assert(i > expectedMinimumSize); - + let b = to_candid(l); debugPrint("serialized"); diff --git a/test/run-drun/max-stack.mo b/test/run-drun/max-stack.mo index 74775b0e191..12c0c802628 100644 --- a/test/run-drun/max-stack.mo +++ b/test/run-drun/max-stack.mo @@ -1,9 +1,10 @@ //MOC-FLAG --compacting-gc --rts-stack-pages 32 -measure-rts-stack -import { errorMessage; debugPrint; } = "mo:⛔"; +import { errorMessage; debugPrint; setCandidLimits } = "mo:⛔"; actor { let expectedMinimumSize = 35_000; - + setCandidLimits{ instructions = {factor = 0; bias = 5_000_000_000 }; + allocations = {factor = 0; bias = 5_000_000_000 } }; public func ser() : async () { await go(false) }; public func deser() : async () { await go(true) }; @@ -27,7 +28,6 @@ actor { if deserialize from_candid(b) else null; - () }; } catch e { @@ -37,7 +37,7 @@ actor { }; assert i > expectedMinimumSize; - + let b = to_candid(l); debugPrint("serialized");