Arrays with non-constant lengths

compiler/CCT/fail/randombytes.jazz

@@ -3,7 +3,8 @@ export
 fn main() -> reg u64 {
   stack u64[1] s;
   reg u64 r;
-  s = #randombytes(s);
+  reg u64 len = 8;
+  s = #randombytes{8}(s,len);
   r = s[0];
   while (r < 64) {
     r += 64;

compiler/CCT/fail/secret_ptr.jazz

@@ -8,7 +8,8 @@ fn pointers(reg u64 a) -> reg u8 {
   q = s[1:1];
   r = p;
   r = q if a <s 0;
-  r = #randombytes(r);
+  reg u64 len = 1;
+  r = #randombytes{1}(r, len);
   f = r[0];
   return f;
 }

compiler/CCT/success/randombytes.jazz

@@ -7,7 +7,8 @@ fn toss(reg u64 a b) -> reg u64 {
   reg u64[2] input;
   input[0] = a;
   input[1] = b;
-  s = #randombytes(s);
+  reg u64 len = 1;
+  s = #randombytes{1}(s, len);
   t = s[0];
   r = input[0];
   r = input[1] if t <s 0;

compiler/config/tests.config

@@ -1,5 +1,11 @@
 [default]
 
+[test-template]
+bin    = ./scripts/check
+args   = -arch x86-64
+okdirs = tests/template/success
+kodirs = tests/template/fail
+
 [test-x86-64-nolea]
 bin    = ./scripts/check
 args   = -arch x86-64 -nolea

compiler/dune-project

@@ -1,6 +1,6 @@
-(lang dune 3.7)
+(lang dune 3.18)
 (name jasmin)
 (package (name jasmin))
 (license MIT)
 (authors "The Jasmin development team")
-(using menhir 2.1)
+(using menhir 3.0)

compiler/examples/x86-64/matrix_product.jazz

@@ -65,7 +65,7 @@ fn productMM(reg u64 x y z) {
   inline int i;
   stack u64[N * N] mx my mz;
   reg u64 tmp;
-  for i = 0 to N * N {
+  for i = 0 to (N * N) {
     tmp = [:u64 x + 8 * i];
     mx[i] = tmp;
     tmp = [:u64 y + 8 * i];

compiler/linter/Analyser/BackwardAnalyser.ml

@@ -15,12 +15,12 @@ module type Logic = sig
 
   val forget : var_i -> domain -> domain annotation
 
-  val funcall : Location.i_loc -> lvals -> funname -> exprs -> domain -> domain annotation
+  val funcall : Location.i_loc -> lvals -> funname -> length list -> exprs -> domain -> domain annotation
 
   val syscall :
        Location.i_loc
     -> lvals
-    -> (Wsize.wsize * BinNums.positive) Syscall_t.syscall_t
+    -> Syscall.syscall_t
     -> exprs
     -> domain
     -> domain annotation
@@ -208,12 +208,12 @@ struct
       | Cassert (msg, e) ->
           let annotation = Annotation.bind annotation (L.assertion loc msg e) in
           (Cassert (msg, e), annotation)
-      | Ccall (lvs, fn, es) ->
-          let annotation = Annotation.bind annotation (L.funcall loc lvs fn es) in
-          (Ccall (lvs, fn, es), annotation)
-      | Csyscall (lvs, sc, es) ->
+      | Ccall (lvs, fn, al, es) ->
+          let annotation = Annotation.bind annotation (L.funcall loc lvs fn al es) in
+          (Ccall (lvs, fn, al, es), annotation)
+      | Csyscall (lvs, sc, al, es) ->
           let annotation = Annotation.bind annotation (L.syscall loc lvs sc es) in
-          (Csyscall (lvs, sc, es), annotation)
+          (Csyscall (lvs, sc, al, es), annotation)
       | Cif (cond, th, el) ->
           let th, annotation_th = analyse_stmt th annotation in
           let el, annotation_el = analyse_stmt el annotation in

compiler/linter/Analyser/BackwardAnalyser.mli

@@ -86,6 +86,7 @@ module type Logic =
       Jasmin.Location.i_loc ->
       Jasmin.Prog.lvals ->
       Jasmin.CoreIdent.funname ->
+      Jasmin.Prog.length list ->
       Jasmin.Prog.exprs -> domain -> domain Annotation.annotation
 
     (**
@@ -94,7 +95,7 @@ module type Logic =
     val syscall :
       Jasmin.Location.i_loc ->
       Jasmin.Prog.lvals ->
-      (Jasmin.Wsize.wsize * Jasmin.BinNums.positive) Jasmin.Syscall_t.syscall_t ->
+      Jasmin.Syscall.syscall_t ->
       Jasmin.Prog.exprs -> domain -> domain Annotation.annotation
 
     (**

compiler/linter/Analyser/ForwardAnalyser.ml

@@ -17,12 +17,12 @@ module type Logic = sig
 
   val forget : var_i -> domain -> domain annotation
 
-  val funcall : Location.i_loc -> lvals -> funname -> exprs -> domain -> domain annotation
+  val funcall : Location.i_loc -> lvals -> funname -> length list -> exprs -> domain -> domain annotation
 
   val syscall :
        Location.i_loc
     -> lvals
-    -> (Wsize.wsize * BinNums.positive) Syscall_t.syscall_t
+    -> Syscall.syscall_t
     -> exprs
     -> domain
     -> domain annotation
@@ -185,12 +185,12 @@ module Make (Logic : Logic) : S with type domain = Logic.domain = struct
       | Cassert (msg, e) ->
           let annotation = Annotation.bind annotation (Logic.assertion loc msg e) in
           (Cassert (msg, e), annotation)
-      | Ccall (lvs, fn, es) ->
-          let annotation = Annotation.bind annotation (Logic.funcall loc lvs fn es) in
-          (Ccall (lvs, fn, es), annotation)
-      | Csyscall (lvs, sc, es) ->
+      | Ccall (lvs, fn, al, es) ->
+          let annotation = Annotation.bind annotation (Logic.funcall loc lvs fn al es) in
+          (Ccall (lvs, fn, al, es), annotation)
+      | Csyscall (lvs, sc, al, es) ->
           let annotation = Annotation.bind annotation (Logic.syscall loc lvs sc es) in
-          (Csyscall (lvs, sc, es), annotation)
+          (Csyscall (lvs, sc, al, es), annotation)
       | Cif (expr, th, el) ->
           let annotation_th, annotation_el = Logic.assume expr annotation in
           let th, annotation_th = analyse_stmt th annotation_th in

compiler/linter/Analyser/ForwardAnalyser.mli

@@ -108,6 +108,7 @@ module type Logic =
       Jasmin.Location.i_loc ->
       Jasmin.Prog.lvals ->
       Jasmin.CoreIdent.funname ->
+      Jasmin.Prog.length list ->
       Jasmin.Prog.exprs -> domain -> domain Annotation.annotation
 
     (**
@@ -116,7 +117,7 @@ module type Logic =
     val syscall :
       Jasmin.Location.i_loc ->
       Jasmin.Prog.lvals ->
-      (Jasmin.Wsize.wsize * Jasmin.BinNums.positive) Jasmin.Syscall_t.syscall_t ->
+      Jasmin.Syscall.syscall_t ->
       Jasmin.Prog.exprs -> domain -> domain Annotation.annotation
 
     (**

compiler/linter/Analysis/Liveness/LivenessAnalyser.ml

@@ -43,13 +43,13 @@ module LivenessDomain : BackwardAnalyser.Logic with type domain = Sv.t = struct
     assert (not (Sv.mem (L.unloc var) domain));
     Annotation domain
 
-  let funcall (_ : Location.i_loc) (lvs : lvals) (_ : funname) (exprs : exprs) (domain : domain) =
+  let funcall (_ : Location.i_loc) (lvs : lvals) (_ : funname) (_ : length list) (exprs : exprs) (domain : domain) =
       Annotation (live_assigns domain lvs exprs)
 
   let syscall
     (_ : Location.i_loc)
     (lvs : lvals)
-    (_ : (Wsize.wsize * BinNums.positive) Syscall_t.syscall_t)
+    (_ : Syscall.syscall_t)
     (exprs : exprs)
     (domain : domain) =
     Annotation (live_assigns domain lvs exprs)

compiler/linter/Analysis/ReachingDefinitions/RDAnalyser.ml

@@ -34,7 +34,7 @@ module ReachingDefinitionLogic :
     Annotation
       (RDDomain.add (List.fold_left written_lv Sv.empty lvs) loc domain)
 
-  let funcall loc lvs _ _ domain = logic loc lvs domain
+  let funcall loc lvs _ _ _ domain = logic loc lvs domain
   let syscall loc lvs _ _ domain = logic loc lvs domain
   let assign loc lv _ _ _ domain = logic loc [ lv ] domain
   let opn loc lvs _ _ _ domain = logic loc lvs domain

compiler/linter/Checker/VariableInitialisation.ml

@@ -59,7 +59,7 @@ let check_func fd =
     | Cassgn (x, _, _, e) ->
         check_lv i_info x;
         check_e i_info e
-    | Copn (xs, _, _, es) | Csyscall (xs, _, es) | Ccall (xs, _, es) ->
+    | Copn (xs, _, _, es) | Csyscall (xs, _, _, es) | Ccall (xs, _, _, es) ->
         check_lvs i_info xs;
         check_es i_info es
     | Cassert (_, e) -> check_a i_info e

compiler/safetylib/safetyAbsExpr.ml

@@ -28,7 +28,13 @@ type msub = int gmsub
 let check_msub ms =
   let gv = ms.ms_v in
   (* array size, in bytes   *)
-  let arr_size = arr_range gv * (size_of_ws (arr_size gv)) in
+  let len = arr_range gv in
+  let len =
+    match len with
+    | Const len -> len
+    | _ -> assert false
+  in
+  let arr_size = len * (size_of_ws (arr_size gv)) in
   (* sub-array size, in bytes * *)
   let sub_size = ms.ms_len * (size_of_ws ms.ms_ws) in
   let offset = ms.ms_offset in
@@ -40,10 +46,16 @@ let check_msubo ms = match ms.ms_offset with
   | Some off -> check_msub { ms with ms_offset = off }
 
 let msub_of_arr gv sc =
+  let len = arr_range gv in
+  let len =
+    match len with
+    | Const len -> len
+    | _ -> assert false
+  in
   let msub = { ms_v      = gv;
                ms_sc     = sc;
                ms_ws     = arr_size gv;
-               ms_len    = arr_range gv;
+               ms_len    = len;
                ms_offset = Some 0; } in
   check_msubo msub;
   msub
@@ -216,15 +228,15 @@ let print_not_word_expr e =
   Format.eprintf "@[<v>Should be a word expression:@;\
                   @[%a@]@;Type:@;@[%a@]@]@."
     (Printer.pp_expr ~debug:(!Glob_options.debug)) e
-    (PrintCommon.pp_ty) (Conv.ty_of_cty (Conv.cty_of_ty (ty_expr e)))
+    (Printer.pp_ty ~debug:false) (Conv.ty_of_cty (Conv.cty_of_ty (ty_expr e)))
 
 let check_is_int v =
   let gv = L.unloc v.gv in
   match gv.v_ty with
   | Bty Int -> ()
   | _ ->
     Format.eprintf "%s should be an int but is a %a@."
-      gv.v_name PrintCommon.pp_ty gv.v_ty;
+      gv.v_name (Printer.pp_ty ~debug:false) gv.v_ty;
     raise (Aint_error "Bad type")
 
 let check_is_word v =
@@ -233,7 +245,7 @@ let check_is_word v =
   | Bty (U _) -> ()
   | _ ->
     Format.eprintf "%s should be a word but is a %a@."
-      gv.v_name PrintCommon.pp_ty gv.v_ty;
+      gv.v_name (Printer.pp_ty ~debug:false) gv.v_ty;
     raise (Aint_error "Bad type")
 
 
@@ -416,8 +428,14 @@ module AbsExpr (Arch : SafetyArch.SafetyArch) (AbsDom : AbsNumBoolType) = struct
 
   (*-------------------------------------------------------------------------*)
   let arr_full_range x =
+    let len = arr_range x in
+    let len =
+      match len with
+      | Const len -> len
+      | _ -> assert false
+    in
     List.init
-      (arr_range x * size_of_ws (arr_size x))
+      (len * size_of_ws (arr_size x))
       (fun i -> AarraySlice (x, U8, i))
 
   (* let abs_arr_range_at abs x acc ws ei = match aeval_cst_int abs ei with
@@ -452,7 +470,7 @@ module AbsExpr (Arch : SafetyArch.SafetyArch) (AbsDom : AbsNumBoolType) = struct
 
   (*-------------------------------------------------------------------------*)
   (* Collect all variables appearing in e. *)
-  let ptr_expr_of_expr abs e =
+  let ptr_expr_of_expr abs (e:length gexpr) =
     let exception Expr_contain_load in
     let rec aux acc e = match e with
       | Pbool _ | Parr_init _ | Pconst _ -> acc
@@ -462,6 +480,11 @@ module AbsExpr (Arch : SafetyArch.SafetyArch) (AbsDom : AbsNumBoolType) = struct
       | Pget(_, access,ws,x,ei) ->
         abs_sub_arr_range abs (L.unloc x.gv,x.gs) access ws 1   ei @ acc
       | Psub (access, ws, len, x, ei) ->
+        let len =
+          match len with
+          | Const len -> len
+          | _ -> assert false
+        in
         abs_sub_arr_range abs (L.unloc x.gv,x.gs) access ws len ei @ acc
 
       | Papp1 (_, e1) -> aux acc e1
@@ -1076,6 +1099,11 @@ module AbsExpr (Arch : SafetyArch.SafetyArch) (AbsDom : AbsNumBoolType) = struct
       end
 
     | Lasub (acc, ws, len, x, ei) ->
+      let len =
+        match len with
+        | Const len -> len
+        | _ -> assert false
+      in
       let offset = match aeval_cst_int abs ei with
         | Some i -> Some (access_offset acc ws i)
         | None -> None in
@@ -1087,7 +1115,7 @@ module AbsExpr (Arch : SafetyArch.SafetyArch) (AbsDom : AbsNumBoolType) = struct
 
       MLasub (loc, msub)
 
-  let apply_offset_expr abs outv info (inv : int ggvar) offset_expr =
+  let apply_offset_expr abs outv info (inv : length ggvar) offset_expr =
     (* Global variable cannot alias to a input pointer. *)
     assert (inv.gs = Expr.Slocal);
     let inv = L.unloc inv.gv in
@@ -1154,6 +1182,11 @@ module AbsExpr (Arch : SafetyArch.SafetyArch) (AbsDom : AbsNumBoolType) = struct
 
   let msub_of_sub_expr abs = function
     | Psub (acc, ws, len, ggv, ei) ->
+      let len =
+        match len with
+        | CoreIdent.Const len -> len
+        | _ -> assert false
+      in
       let offset = match aeval_cst_int abs ei with
         | Some i -> Some (access_offset acc ws i)
         | None -> None in

compiler/safetylib/safetyAbsExpr.mli

@@ -14,7 +14,7 @@ val pcast : wsize -> expr -> expr
 
 val wsize_of_ty : 'a gty -> int
 
-val check_is_word : int ggvar -> unit
+val check_is_word : length ggvar -> unit
 
 (*---------------------------------------------------------------*)
 type 'a gmsub = { ms_v      : var;

compiler/safetylib/safetyArch.ml

@@ -37,21 +37,21 @@ module type SafetyArch = sig
   val split_asm_opn :
     int ->
     extended_op ->
-    expr list ->
+    exprs ->
     expr option list
   (** Architecture-specific assembly operation splitting *)
 
   val post_opn :
     extended_op ->
-    (int glval) list ->
-    expr list ->
+    lvals ->
+    exprs ->
     btcons list
   (** Post-conditions of operators, that cannot be precisely expressed as an expression of the arguments *)
 
   val opn_heur :
     extended_op ->
     mvar ->
-    expr list ->
+    exprs ->
     flags_heur option
   (** Heuristic for flags *)
 end