From eb39f0e61503bd6aa22b03a576e2d3c503c8d0a8 Mon Sep 17 00:00:00 2001
From: rina <k@rina.fyi>
Date: Wed, 10 Jul 2024 11:51:12 +1000
Subject: [PATCH] add flags for controlling vectoriser

---
 bin/asli.ml   | 42 ++++++++++++++++++++++++------------------
 libASL/dis.ml |  8 ++++----
 2 files changed, 28 insertions(+), 22 deletions(-)

diff --git a/bin/asli.ml b/bin/asli.ml
index 20fd6838..4347f36c 100644
--- a/bin/asli.ml
+++ b/bin/asli.ml
@@ -33,6 +33,15 @@ let () = Printexc.register_printer
         Some (Printf.sprintf "EvalError at %s: %s" (pp_loc loc) msg)
     | _ -> None)
 
+let flags = [
+    ("trace:write", Eval.trace_write);
+    ("trace:fun",   Eval.trace_funcall);
+    ("trace:prim",  Eval.trace_primop);
+    ("trace:instr", Eval.trace_instruction);
+    ("eval:concrete_unknown", Value.concrete_unknown);
+    ("dis:vectoriser", Dis.use_vectoriser);
+]
+
 let help_msg = [
     {|:? :help                       Show this help message|};
     {|:elf <file>                    Load an ELF file|};
@@ -51,7 +60,9 @@ let help_msg = [
     {|:init regs                     Initializes registers to concrete values (for evaluation)|};
     {|:coverage <instr-set> <regex>  Runs differential testing of partial and concrete evaluation|};
     {|<expr>                         Execute ASL expression|};
-    {|<stmt> ;                       Execute ASL statement|}
+    {|<stmt> ;                       Execute ASL statement|};
+    "";
+    "Behaviour flags:"
 ]
 
 (** supported backends for :gen and their default output directories *)
@@ -60,13 +71,15 @@ let gen_backends = [
     ("cpp",   (Cpu.Cpp, "offlineASL-cpp"));
 ]
 
-let flags = [
-    ("trace:write", Eval.trace_write);
-    ("trace:fun",   Eval.trace_funcall);
-    ("trace:prim",  Eval.trace_primop);
-    ("trace:instr", Eval.trace_instruction);
-    ("eval:concrete_unknown", Value.concrete_unknown)
-]
+let set_flag s =
+    if not (Utils.startswith s "+" || Utils.startswith s "-") then
+        raise @@ Arg.Bad "flag should start with + to set and - to unset";
+    let flags_str = String.concat ", " @@ List.map fst flags in
+    let flag = Utils.stringDrop 1 s in
+
+    (match List.assoc_opt flag flags with
+    | None -> raise @@ Arg.Bad (Printf.sprintf "unknown flag '%s'\navailable flags: %s" flag flags_str);
+    | Some f -> f := Utils.startswith flag "+")
 
 let () = Random.self_init ()
 
@@ -236,16 +249,8 @@ let rec process_command (tcenv: TC.Env.t) (cpu: Cpu.cpu) (fname: string) (input0
         close_out chan
     | (":set" :: "impdef" :: rest) ->
         Eval.set_impdef tcenv cpu.env fname rest
-    | [":set"; flag] when Utils.startswith flag "+" ->
-        (match List.assoc_opt (Utils.stringDrop 1 flag) flags with
-        | None -> Printf.printf "Unknown flag %s\n" flag;
-        | Some f -> f := true
-        )
-    | [":set"; flag] when Utils.startswith flag "-" ->
-        (match List.assoc_opt (Utils.stringDrop 1 flag) flags with
-        | None -> Printf.printf "Unknown flag %s\n" flag;
-        | Some f -> f := false
-        )
+    | [":set"; flag] ->
+        set_flag flag
     | [":project"; prj] ->
         let inchan = open_in prj in
         (try
@@ -312,6 +317,7 @@ let options = Arg.align ([
     ( "--export-aarch64", Arg.Set_string opt_export_aarch64_dir,  "       Export bundled AArch64 MRA to the given directory");
     ( "--version", Arg.Set opt_print_version, "       Print version");
     ( "--prelude", Arg.Set_string opt_prelude,"       ASL prelude file (default: ./prelude.asl)");
+    ( "--flag", Arg.String set_flag,          "       Behaviour flags to set (+) or unset (-)");
 ] )
 
 let version = "ASL 0.2.0 alpha"
diff --git a/libASL/dis.ml b/libASL/dis.ml
index 134d3ebf..3cddd867 100644
--- a/libASL/dis.ml
+++ b/libASL/dis.ml
@@ -23,6 +23,7 @@ module StringCmp = struct
 end
 module StringMap = Map.Make(StringCmp)
 
+let use_vectoriser = ref true
 
 let debug_level_none = -1
 let debug_level = ref debug_level_none
@@ -1593,11 +1594,10 @@ let dis_core (env: Eval.Env.t) (unroll_bound) ((lenv,globals): env) (decode: dec
    partial evaluation, rather than having to unroll after we know vectorization failed.
  *)
 let dis_decode_entry (env: Eval.Env.t) ((lenv,globals): env) (decode: decode_case) (op: Primops.bigint): stmt list =
-  let unroll_bound = Z.of_int 1 in
-  let _,stmts' = dis_core env unroll_bound (lenv,globals) decode op in
-  let (res,stmts') = Transforms.LoopClassify.run stmts' env in
+  let _,stmts' = dis_core env Z.one (lenv,globals) decode op in
+  let (res,stmts') = if !use_vectoriser then Transforms.LoopClassify.run stmts' env else (false, stmts') in
   if res then stmts' else
-    snd @@ dis_core env (Z.of_int 1000) (lenv,globals) decode op
+    snd @@ dis_core env (Z.of_int64 Int64.max_int) (lenv,globals) decode op
 
 let build_env (env: Eval.Env.t): env =
     let env = Eval.Env.freeze env in