Merge pull request #98 from UQ-PAC/loops

Vectorisation, loops, and division improvements
UQ-PAC · Jul 11, 2024 · 34cfa40 · 34cfa40
2 parents 00b73b5 + e44ce42
commit 34cfa40
Show file tree

Hide file tree

Showing 20 changed files with 8,120 additions and 6,617 deletions.
diff --git a/aslp-cpp/include/aslp-cpp/aslp-cpp.hpp b/aslp-cpp/include/aslp-cpp/aslp-cpp.hpp
@@ -1,35 +1,41 @@
 #pragma once
 
-#include <string>
+#include <map>
 #include <memory>
+#include <string>
+#include <vector>
 
-namespace httplib {
+namespace httplib
+{
 class Client;
-} // namespace httplib;
+}  // namespace httplib
 
 // tuple of encoding and semantics
 using aslp_opcode_result_t = std::tuple<std::string, std::string>;
 
 class aslp_connection
 {
+  using params_t = std::multimap<std::string, std::string>;
+
+  const params_t& extra_params;
   std::unique_ptr<httplib::Client> client {nullptr};
 
 public:
-  aslp_connection(const std::string& server_addr, int server_port);
+  aslp_connection(const std::string& server_addr, int server_port, const params_t& extra_params = {});
   aslp_connection(aslp_connection&&) noexcept;
   auto get_opcode(uint32_t opcode) -> aslp_opcode_result_t;
   void wait_active();
   ~aslp_connection();
 };
 
-
-
-class aslp_client {
+class aslp_client
+{
 private:
   const std::string server_addr;
   pid_t server_pid;
   int server_port;
   void shutdown();
+
 public:
   aslp_client(const aslp_client&) = delete;
   aslp_client(aslp_client&&) = delete;
@@ -43,26 +49,26 @@ class aslp_client {
       : server_pid(pid)
       , server_port(port)
       , server_addr(std::move(addr))
-  { }
+  {
+  }
 
   /**
    * Creates a new aslp_client with a managed server on
    * the default address, localhost:8000.
    */
-  std::unique_ptr<aslp_client> static start() {
+  std::unique_ptr<aslp_client> static start()
+  {
     return start("127.0.0.1", 8000);
   }
 
   /** Creates a new managed aslp_client with the given address and port. */
-  auto static start(const std::string& addr, int server_port) -> std::unique_ptr<aslp_client>;
+  auto static start(const std::string& addr,
+                    int server_port) -> std::unique_ptr<aslp_client>;
 
-  /** Returns the semantics for the given opcode, as a newline-separated string. */
+  /** Returns the semantics for the given opcode, as a newline-separated string.
+   */
   auto get_opcode(uint32_t opcode) -> aslp_opcode_result_t;
 
   /** Destroys the aslp_client and terminates the managed server as well. */
-  virtual ~aslp_client() {
-    shutdown();
-  };
-
+  virtual ~aslp_client() { shutdown(); };
 };
-
diff --git a/aslp-cpp/source/aslp-cpp.cpp b/aslp-cpp/source/aslp-cpp.cpp
@@ -151,7 +151,10 @@ aslp_opcode_result_t aslp_connection::get_opcode(uint32_t opcode)
 {
   auto codestr = std::format("{:#x}", opcode);
   std::cout << codestr << "\n";
-  const auto params = httplib::Params({{"opcode", codestr}});
+  auto params = httplib::Params({{"opcode", codestr}});
+  for (const auto& pair : extra_params) {
+    params.insert(pair);
+  }
   auto req = client->Get("/", params, httplib::Headers());
 
   if (req.error() != httplib::Error::Success) {
@@ -174,10 +177,11 @@ aslp_opcode_result_t aslp_connection::get_opcode(uint32_t opcode)
 }
 
 aslp_connection::aslp_connection(const std::string& server_addr,
-                                 int server_port)
-{
-  client = std::make_unique<httplib::Client>(server_addr, server_port);
-}
+                                 int server_port,
+                                 const params_t& extra_params) :
+  extra_params{extra_params},
+  client{std::make_unique<httplib::Client>(server_addr, server_port)}
+{}
 
 aslp_connection::aslp_connection(aslp_connection&&) noexcept = default;
 aslp_connection::~aslp_connection() = default;

diff --git a/bin/asli.ml b/bin/asli.ml
@@ -60,14 +60,6 @@ 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 () = Random.self_init ()
 
 let rec process_command (tcenv: TC.Env.t) (cpu: Cpu.cpu) (fname: string) (input0: string): unit =
@@ -165,7 +157,7 @@ let rec process_command (tcenv: TC.Env.t) (cpu: Cpu.cpu) (fname: string) (input0
     | [":help"] | [":?"] ->
         List.iter print_endline help_msg;
         print_endline "\nFlags:";
-        List.iter (fun (nm, v) -> Printf.printf "  %s%s\n" (if !v then "+" else "-") nm) flags
+        Flags.StringMap.iter (fun nm v -> Printf.printf "  %s%s\n" (if v then "+" else "-") nm) (Flags.get_flags ())
     | [":opcode"; iset; opcode] ->
         (* todo: make this code more robust *)
         let op = Z.of_string opcode in
@@ -236,16 +228,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] ->
+        Flags.set_flag flag
     | [":project"; prj] ->
         let inchan = open_in prj in
         (try
@@ -312,6 +296,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 Flags.set_flag,          "       Behaviour flags to set (+) or unset (-)");
 ] )
 
 let version = "ASL 0.2.0 alpha"

diff --git a/bin/server.ml b/bin/server.ml
@@ -24,12 +24,11 @@ let eval_instr (opcode: string) : string * string =
     let env' = Lazy.force persistent_env in
     let lenv = Dis.build_env env' in
     let decoder = Eval.Env.getDecoder env' (Ident "A64") in
-    let (enc, stmts) = Dis.dis_decode_entry_with_inst env' lenv decoder (Z.of_string opcode) in
+    let (enc,stmts) = Dis.dis_decode_entry_with_inst env' lenv decoder (Z.of_string opcode) in
 
     let stmts'   = List.map pp_raw stmts in
     enc, String.concat "\n" stmts'
 
-
 let get_reply (jsonin: string) : Cohttp.Code.status_code * string =
   (*let json  = Yojson.Safe.from_string jsonin in *)
   let make_reply code tail =
@@ -47,26 +46,37 @@ let unsupp_method_resp : Cohttp.Code.status_code * string =
 let missing_param : Cohttp.Code.status_code * string =
   (`Bad_request, Yojson.Safe.to_string (`Assoc [("error", `String "missing opcode param.")]))
 
-(*let () = ignore (List.map (fun (f: string) -> print_endline (eval_instr f)) (tl (to_list Sys.argv))) *)
-
+let try_set_flags xs : (unit, Cohttp.Code.status_code * string) Result.t =
+  match (List.iter Flags.set_flag xs) with
+  | exception (Arg.Bad _ as e) -> Result.error (`Bad_request, Yojson.Safe.to_string (`Assoc [("error", `String (Printexc.to_string e))]))
+  | _ -> Result.ok ()
 
 let get_resp (opcode: string) : Cohttp.Code.status_code * string =
     get_reply opcode
 
 let server addr port =
   Printf.printf "Started aslp-server at http://%s:%d\n" addr port;
   flush stdout;
+
+  let oldflags = Flags.get_flags () in
+
   let callback _conn req body =
     let uri = req |> Request.uri in
     let _meth = req |> Request.meth |> Code.string_of_method in
     let _headers = req |> Request.headers |> Header.to_string in
     let body' = body |> Cohttp_lwt.Body.to_string in
-    let resp' =
-      match (Request.meth req, Uri.get_query_param uri "opcode") with
-      | `POST, _ -> body' >|= get_resp
-      | `GET, Some param -> Lwt.return (get_resp param)
-      | `GET, None -> Lwt.return missing_param
-      |  _ -> Lwt.return unsupp_method_resp
+
+    Flags.set_flags oldflags;
+
+    let resp' = 
+      match (Option.map try_set_flags (Uri.get_query_param' uri "flags")) with
+      | Some (Error xs) -> Lwt.return xs
+      | Some (Ok ()) | None ->
+        match (Request.meth req, Uri.get_query_param uri "opcode") with
+        | `POST, _ -> body' >|= get_resp
+        | `GET, Some param -> Lwt.return (get_resp param)
+        | `GET, None -> Lwt.return missing_param
+        |  _ -> Lwt.return unsupp_method_resp
     in
     resp' >>= fun (code, body) -> Server.respond_string ~status:code ~body ()
   in