wip

examples/ack.ml

@@ -2,7 +2,5 @@ let rec ack x y =
   if x = 0 then y + 1 else
   if y = 0 then ack (x-1) 1 else
   ack (x-1) (ack x (y-1)) in
-let a = print_int(ack 3 6) in
-print_newline()
-
-
+let a = print_int(ack 1 1) in
+let _ = print_int(a) in ()

examples/fact.ml

@@ -1,6 +1,6 @@
 let rec fact x =
   if x <= 1 then 1 else
     x * fact (x-1) in
-let z = read_int() in
+let z = 5 in
 let r = fact z in
 print_int r

src/joe/main.ml

@@ -1,4 +1,5 @@
 open MinCaml
+open BacCaml
 
 type backend =
    | Intel
@@ -30,8 +31,7 @@ let lexbuf oc l =
   match !backend_type with
   | Intel -> X64.RegAlloc.f p |> X64.Emit.f oc
   | ARM -> Arm64.RegAlloc.f p |> Arm64.Emit.f oc
-  | Virtual -> Asm.show_prog p |> Printf.fprintf oc "%s"
-;;
+  | Virtual -> Stdlib.output_bytes oc (Marshal.to_bytes (Emit.f p) [Marshal.No_sharing])
 
 let string s = lexbuf stdout (Lexing.from_string s)
 
@@ -42,7 +42,7 @@ let main f =
     match !backend_type with
     | Intel -> open_out (f ^ ".intel.s")
     | ARM -> open_out (f ^ ".arm.s")
-    | _ -> stdout
+    | Virtual -> open_out_bin (f ^ ".joe")
   in
   try
     let input = Lexing.from_channel inchan in

src/vm/dune

@@ -4,6 +4,7 @@
   (modules (:standard \ main))
   (flags (-w -4-33-40-41))
   (libraries str MinCaml)
+  (foreign_stubs (language c) (names libmincaml))
   (foreign_stubs (language c) (names float))
   (preprocess (pps ppx_deriving.show ppx_deriving.enum)))
 

src/vm/insts.ml

@@ -1,5 +1,4 @@
-type inst =
-  | UNIT
+type inst = | UNIT
   | ADD
   | SUB
   | MUL
@@ -39,7 +38,7 @@ type inst =
   | PRINT_STRING
 [@@deriving show]
 
-let insts =
+let instsmap =
   [| UNIT
    ; ADD
    ; SUB
@@ -83,7 +82,7 @@ let index_of instr =
   | TRACING_COMP -> -1048
   | METHOD_COMP -> -1024
   | _ ->
-    Array.to_list insts
+    Array.to_list instsmap
     |> List.mapi (fun i instr -> instr, i)
     |> List.find (fun (instr', i) -> instr = instr')
     |> snd
@@ -97,7 +96,7 @@ module Printer = struct
            Printf.printf "%s => %d\n" (show_inst instr) i;
            i + 1)
          0
-         insts)
+         instsmap)
   ;;
 
   let pp_insts_counter = ref 0

src/vm/insts.mli

@@ -36,10 +36,11 @@ type inst =
   | Lref of string
   | Ldef of string
   | READ_STRING
-  | PRINT_STRING 
+  | PRINT_STRING
 
+val index_of : inst -> int
 val show_inst : inst -> string
-val insts : inst array
+val instsmap : inst array
 
 module Printer : sig
   val pp_inst_map : unit -> unit

src/vm/libmincaml.c

@@ -0,0 +1,138 @@
+#include <stdio.h>
+#include <math.h>
+
+// NOTE: コンパイル後のシンボルのプリフィックスに _ がつくのを避ける
+void min_caml_print_int(long n) asm("min_caml_print_int");
+void min_caml_print_newline() asm("min_caml_print_newline");
+long* min_caml_create_array(long number_of_element, long init_value) asm("min_caml_create_array");
+double* min_caml_create_float_array(long number_of_element, double float_value) asm("min_caml_create_float_array");
+long min_caml_truncate(double d) asm("min_caml_truncate");
+void min_caml_print_float(double d) asm("min_caml_print_float");
+void min_caml_print_byte(long n) asm("min_caml_print_byte");
+long min_caml_read_int() asm("min_caml_read_int");
+double min_caml_read_float() asm("min_caml_read_float");
+double min_caml_atan(double x) asm("min_caml_atan");
+double min_caml_cos(double x) asm("min_caml_cos");
+double min_caml_floor(double x) asm("min_caml_floor");
+double min_caml_sin(double x) asm("min_caml_sin");
+double min_caml_abs_float(double x) asm("min_caml_abs_float");
+double min_caml_float_of_int(long n) asm("min_caml_float_of_int");
+long min_caml_int_of_float(double d) asm("min_caml_int_of_float");
+double min_caml_sqrt(double d) asm("min_caml_sqrt");
+
+void min_caml_print_int(long n) {
+  printf("%ld", n);
+}
+
+void min_caml_print_newline() {
+  printf("\n");
+}
+
+long* min_caml_create_array(long number_of_element, long init_value) {
+  long *heap_ptr;
+
+  // x27 に格納されたヒープのアドレスを heap_ptr へ書き出す
+  asm volatile ("mov %0, x27" : "=r"(heap_ptr));
+
+  // Array の先頭アドレスを取得
+  long *array_ptr = heap_ptr;
+
+  for (long i = 0l; i < number_of_element; i++) {
+    // Array へ書き込んだ後、ヒープの先頭アドレスを8バイト進める
+    *heap_ptr = init_value;
+    heap_ptr += 1;
+  }
+
+  // ヒープの先頭アドレスを x27 に書き戻す
+  asm volatile ("mov x27, %0" : : "r"(heap_ptr));
+
+  return array_ptr;
+}
+
+double* min_caml_create_float_array(long number_of_element, double float_value) {
+  double *heap_ptr;
+
+  // x27 に格納されたヒープのアドレスを heap_ptr へ書き出す
+  asm volatile ("mov %0, x27" : "=r"(heap_ptr));
+
+  // Array の先頭アドレスを取得
+  double *array_ptr = heap_ptr;
+
+  for (long i = 0l; i < number_of_element; i++) {
+    // Array へ書き込んだ後、ヒープの先頭アドレスを8バイト進める
+    *heap_ptr = float_value;
+    heap_ptr += 1;
+  }
+
+  // ヒープの先頭アドレスを x27 に書き戻す
+  asm volatile ("mov x27, %0" : : "r"(heap_ptr));
+
+  return array_ptr;
+}
+
+// truncate
+long min_caml_truncate(double d) {
+  return (long)d;
+}
+
+void min_caml_print_float(double d) {
+  printf("%lf", d);
+}
+
+void min_caml_print_byte(long n) {
+  putchar(n);
+}
+
+long min_caml_read_int() {
+  long l;
+  // fscanf(fp, "%ld", &l);
+  scanf("%ld", &l);
+  return l;
+}
+
+double min_caml_read_float() {
+    double d;
+    // fscanf(fp, "%lf", &d);
+    scanf("%lf", &d);
+    return d;
+}
+
+// atan
+double min_caml_atan(double x) {
+  return atan(x);
+}
+
+// cos
+double min_caml_cos(double x) {
+  return cos(x);
+}
+
+// floor
+double min_caml_floor(double x) {
+  return floor(x);
+}
+
+// sin
+double min_caml_sin(double x) {
+  return sin(x);
+}
+
+// abs_float
+double min_caml_abs_float(double x) {
+  return fabs(x);
+}
+
+// float_of_int
+double min_caml_float_of_int(long n) {
+  return (double)n;
+}
+
+// int_of_float
+long min_caml_int_of_float(double d) {
+  return (long)d;
+}
+
+// sqrt
+double min_caml_sqrt(double d) {
+  return sqrt(d);
+}

src/vm/main.ml

@@ -1,14 +1,14 @@
 open MinCaml
+open Format
+open Printf
 module B = BacCaml
 
 type backend =
-  | Virtual
-  | Bytecode
-  | PPBytecode
-  | Interp
+  | Compile
+  | Interpret
   | Nothing
 
-let backend_type = ref Bytecode
+let backend_type = ref Compile
 let show_insts_map_type = ref false
 let debug_flg = ref false
 
@@ -26,41 +26,43 @@ let with_show_insts f =
   | false -> f ()
 ;;
 
-let rec lexbuf oc l =
+let rec lexbuf l =
   let open B in
-  Id.counter := 0;
-  Typing.extenv := M.empty;
-  Parser.exp Lexer.token l
+  (Parser.exp Lexer.token l)
   |> Typing.f
   |> KNormal.f
   |> Alpha.f
   |> Util.(iter !limit)
   |> Closure.f
   |> Virtual.f
   |> Simm.f
-  |> fun p ->
-  match !backend_type with
-  | Virtual -> p |> Emit.f |> Array.to_list |> Insts.Printer.pp_insts
-  | PPBytecode -> p |> Emit.f |> Insts.Printer.pp_bytecode oc
-  | Bytecode -> p |> Emit.f |> Insts.Printer.write_bytecode oc
-  | Interp -> p |> Emit.f |> VM.run_asm |> ignore
-  | Nothing -> ()
-;;
 
-let main f =
-  let ic = open_in f in
-  let oc = stdout in
-  try
+let parseML ic =
     let input = Lexing.from_channel ic in
-    lexbuf oc input;
-    close_in ic;
-    close_out oc
-  with
-  | e ->
-    close_in ic;
-    close_out oc;
-    raise e
-;;
+    let res = lexbuf input in
+    let _ = close_in ic in res
+
+let main f =
+    let open B in
+    Id.counter := 0;
+    Typing.extenv := M.empty;
+    try
+      let r x = match x with
+              | Insts.Literal i -> Printf.printf "%d;" i
+              | _ -> Printf.printf "%d;" (Insts.index_of x) in
+      match !backend_type with
+      | Interpret ->
+        let joe = open_in_bin ((Filename.remove_extension f) ^ ".joe") in
+        let insts = (Marshal.from_channel joe) in
+        let _ = Array.map r insts in VM.run_asm insts ; close_in joe ; ()
+      | Compile ->
+        let ml  = open_in ((Filename.remove_extension f) ^ ".ml") in
+        let vm  = open_out_bin ((Filename.remove_extension f) ^ ".joe") in
+        let insts = (Emit.f (parseML ml)) in
+        let _ = Array.map r insts in Stdlib.output_bytes vm (Marshal.to_bytes insts [Marshal.No_sharing])
+        ; close_in ml ; close_out vm
+      | Nothing -> ()
+    with | e -> raise e
 
 let () =
   let files = ref [] in
@@ -70,16 +72,13 @@ let () =
         ( "-inline", Arg.Int (fun i -> MinCaml.Inline.threshold := i), "set a threshold for inlining") ;
         ( "-iter", Arg.Int (fun i -> MinCaml.Util.limit := i), "set a threshold for iterating") ;
         ( "-no-sh", Arg.Unit (fun _ -> Config.(sh_flg := false)), "disable stack hybridization" ) ;
-        ( "-virtual", Arg.Unit (fun _ -> backend_type := Virtual), "emit MinCaml IR" ) ;
+        ( "-compile", Arg.Unit (fun _ -> backend_type := Compile), "emit MinCaml IR" ) ;
+        ( "-exec", Arg.Unit (fun _ -> backend_type := Interpret), "run IR in VM interpreter" ) ;
         ( "-no-tail", Arg.Unit (fun _ -> Config.(tail_opt_flg := false)) , "enable optimization for tail-recursive call" ) ;
-        ( "-no-fr", Arg.Unit (fun _ -> Config.frame_reset_flg := false), "disable to emit frame_reset" ) ;
-        ( "-insts", Arg.Unit (fun _ -> show_insts_map_type := true), "show instruction map" ) ;
-        ( "-pp", Arg.Unit (fun _ -> backend_type := PPBytecode), "emit bytecode for BacCaml" ) ;
-        ( "-interp", Arg.Unit (fun _ -> backend_type := Interp), "run as interpreter" ) ;
-        ( "-interp-hs", Arg.Unit (fun _ -> Config.stack_mode_flg := `Host_stack; backend_type := Interp), "running an interpreter using host-stack " )
+        ( "-no-fr", Arg.Unit (fun _ -> Config.frame_reset_flg := false), "disable to emit frame_reset" ) 
       ])
     (fun s -> files := !files @ [ s ])
     ( "MinCaml IR Virtual Machine (c) 2024 Namdak Tonpa\n"
-    ^ "usage: vm [-options] filename");
+    ^ "usage: vm [-options] filenames");
   with_show_insts (fun _ -> with_debug (fun _ -> List.iter main !files))
 ;;