diff --git a/ml-proto/host/builtins.ml b/ml-proto/host/builtins.ml index fa599e7987..dfa6eaa39a 100644 --- a/ml-proto/host/builtins.ml +++ b/ml-proto/host/builtins.ml @@ -1,9 +1,50 @@ open Source +open Eval +open Memory +open Types -let print vs = +let print m vs = List.iter Print.print_value (List.map (fun v -> Some v) vs); None +let rec stdout_write_inner at mem offset count i = + let load_result = Memory.load_extend mem (Int64.add offset i) Mem8 ZX Int32Type in + + begin + match load_result with + | Values.Int32 byte -> + print_char (Char.chr (Int32.to_int byte)) + | _ -> + ignore (Error.error at "load_extend returned wrong type") + end; + + let next = Int64.succ i in + let should_iterate = (Int64.compare next count) < 0 in + + if should_iterate then + ignore (stdout_write_inner at mem offset count next) + else + (); + +and stdout_write at m vs = + if List.length vs != 2 then + Error.error at "stdio.write expects 2 arguments (offset, count)"; + + let mem = Eval.memory_for_module at m in + match vs with + | [Values.Int32 _offset; Values.Int32 _count] -> + let offset = (Int64.of_int32 _offset) in + let count = (Int64.of_int32 _count) in + + set_binary_mode_out stdout false; + ignore (stdout_write_inner at mem offset count Int64.zero); + set_binary_mode_out stdout true; + None + + | _ -> + ignore (Error.error at "stdio.write expected i32 offset, i32 count"); + None + let match_import i = let {Ast.module_name; func_name; func_params; func_result} = i.it in if module_name <> "stdio" then @@ -13,6 +54,10 @@ let match_import i = if func_result <> None then Error.error i.at "stdio.print has no result"; print + | "write" -> + if func_result <> None then + Error.error i.at "stdio.write has no result"; + stdout_write i.at | _ -> Error.error i.at ("no stdio." ^ func_name ^ "\"") diff --git a/ml-proto/spec/eval.ml b/ml-proto/spec/eval.ml index 121d5fa51a..e5fef35362 100644 --- a/ml-proto/spec/eval.ml +++ b/ml-proto/spec/eval.ml @@ -13,13 +13,13 @@ let error = Error.error type value = Values.value type func = Ast.func -type import = value list -> value option type host_params = {page_size : Memory.size} module ExportMap = Map.Make(String) type export_map = func ExportMap.t -type instance = +type import = instance -> value list -> value option +and instance = { funcs : func list; imports : import list; @@ -159,7 +159,7 @@ let rec eval_expr (c : config) (e : expr) = | CallImport (x, es) -> let vs = List.map (fun ev -> some (eval_expr c ev) ev.at) es in - (import c x) vs + (import c x) c.module_ vs | CallIndirect (x, e1, es) -> let i = int32 (eval_expr c e1) e1.at in @@ -312,3 +312,10 @@ let host_eval e = let host = {page_size = 1L} in let m = {imports = []; exports; tables = []; funcs = [f]; memory = None; host} in eval_func m f [] + +let memory_for_module at m = + match m.memory with + | Some mem -> + mem + | _ -> + error at "Module has no memory"; diff --git a/ml-proto/spec/eval.mli b/ml-proto/spec/eval.mli index 2442bfe13f..91b207dec7 100644 --- a/ml-proto/spec/eval.mli +++ b/ml-proto/spec/eval.mli @@ -4,12 +4,13 @@ type instance type value = Values.value -type import = value list -> value option +type import = instance -> value list -> value option type host_params = {page_size : Memory.size} val init : Ast.module_ -> import list -> host_params -> instance val invoke : instance -> string -> value list -> value option (* raise Error.Error *) -(* This function is not part of the spec. *) +(* These functions are not part of the spec. *) val host_eval : Ast.expr -> value option (* raise Error.Error *) +val memory_for_module : Source.region -> instance -> Memory.t \ No newline at end of file diff --git a/ml-proto/test/expected-output/stdio_write.wast.log b/ml-proto/test/expected-output/stdio_write.wast.log new file mode 100644 index 0000000000..aa860abb47 Binary files /dev/null and b/ml-proto/test/expected-output/stdio_write.wast.log differ diff --git a/ml-proto/test/stdio_write.wast b/ml-proto/test/stdio_write.wast new file mode 100644 index 0000000000..80eae6fbd2 --- /dev/null +++ b/ml-proto/test/stdio_write.wast @@ -0,0 +1,13 @@ +(module + (import $write "stdio" "write" (param i32 i32)) + + (memory 4096 4096 (segment 0 "\89\50\4e\47\0d\0a\1a\0a\00")) + + (func $write_png_header + (call_import $write (i32.const 0) (i32.const 9)) + ) + + (export "write_png_header" $write_png_header) +) + +(invoke "write_png_header") \ No newline at end of file