add candid setCandidLimits/getCandidLimits prims to override default …

…settings

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

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<system> (
+  { 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<system>() :
+  { 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<T>(f: T -> Bool): Bool {

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<system>{ 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");
 

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<system>{ 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");