Remove prefixing from SM.ml, change bytecode format.

byterun/byterun.c

@@ -13,7 +13,7 @@ void *__stop_custom_data;
 typedef struct
 {
   char *string_ptr;          /* A pointer to the beginning of the string table */
-  int *public_ptr;           /* A pointer to the beginning of publics table    */
+  char *public_ptr;          /* A pointer to the beginning of publics table    */
   char *code_ptr;            /* A pointer to the bytecode itself               */
   int *global_ptr;           /* A pointer to the global area                   */
   int stringtab_size;        /* The size (in bytes) of the string table        */
@@ -28,16 +28,25 @@ char *get_string(bytefile *f, int pos)
   return &f->string_ptr[pos];
 }
 
+/* Each public symbol entry: int32 name_offset, int32 code_offset, uint8 flag */
+#define PUBLIC_ENTRY_SIZE 9
+
 /* Gets a name for a public symbol */
 char *get_public_name(bytefile *f, int i)
 {
-  return get_string(f, f->public_ptr[i * 2]);
+  return get_string(f, *(int *)(f->public_ptr + i * PUBLIC_ENTRY_SIZE));
 }
 
-/* Gets an offset for a publie symbol */
+/* Gets an offset for a public symbol */
 int get_public_offset(bytefile *f, int i)
 {
-  return f->public_ptr[i * 2 + 1];
+  return *(int *)(f->public_ptr + i * PUBLIC_ENTRY_SIZE + sizeof(int));
+}
+
+/* Gets a flag for a public symbol (0 = function, 1 = global) */
+char get_public_flag(bytefile *f, int i)
+{
+  return f->public_ptr[i * PUBLIC_ENTRY_SIZE + 2 * sizeof(int)];
 }
 
 /* Reads a binary bytecode file by name and unpacks it */
@@ -57,7 +66,7 @@ bytefile *read_file(char *fname)
     failure("%s\n", strerror(errno));
   }
 
-  file = (bytefile *)malloc(sizeof(int) * 4 + (size = ftell(f)));
+  file = (bytefile *)malloc(sizeof(void *) * 4 + (size = ftell(f)));
 
   if (file == 0)
   {
@@ -73,8 +82,8 @@ bytefile *read_file(char *fname)
 
   fclose(f);
 
-  file->string_ptr = &file->buffer[file->public_symbols_number * 2 * sizeof(int)];
-  file->public_ptr = (int *)file->buffer;
+  file->string_ptr = &file->buffer[file->public_symbols_number * PUBLIC_ENTRY_SIZE];
+  file->public_ptr = file->buffer;
   file->code_ptr = &file->string_ptr[file->stringtab_size];
   file->global_ptr = (int *)malloc(file->global_area_size * sizeof(int));
 
@@ -281,23 +290,23 @@ void disassemble(FILE *f, bytefile *bf)
       switch (l)
       {
       case 0:
-        fprintf(f, "CALL\tLread");
+        fprintf(f, "CALL\tread");
         break;
 
       case 1:
-        fprintf(f, "CALL\tLwrite");
+        fprintf(f, "CALL\twrite");
         break;
 
       case 2:
-        fprintf(f, "CALL\tLlength");
+        fprintf(f, "CALL\tlength");
         break;
 
       case 3:
-        fprintf(f, "CALL\tLstring");
+        fprintf(f, "CALL\tstring");
         break;
 
       case 4:
-        fprintf(f, "CALL\tBarray\t%d", INT);
+        fprintf(f, "CALL\t.array\t%d", INT);
         break;
 
       default:
@@ -327,7 +336,8 @@ void dump_file(FILE *f, bytefile *bf)
   fprintf(f, "Public symbols          :\n");
 
   for (i = 0; i < bf->public_symbols_number; i++)
-    fprintf(f, "   0x%.8x: %s\n", get_public_offset(bf, i), get_public_name(bf, i));
+    fprintf(f, "   0x%.8x: %s (%s)\n", get_public_offset(bf, i), get_public_name(bf, i),
+            get_public_flag(bf, i) == 0 ? "function" : "global");
 
   fprintf(f, "Code:\n");
   disassemble(f, bf);

src/Options.ml

@@ -2,6 +2,9 @@ exception Commandline_error of string
 
 type os_t = Linux | Darwin
 
+let init_label = "Init"
+let labeled_init s = init_label ^ s
+
 class options args =
   let n = Array.length args in
   let dump_ast = 0b1 in
@@ -187,7 +190,7 @@ class options args =
       Filename.chop_suffix (Filename.basename self#get_infile) ".lama"
 
     method topname =
-      match !mode with `Compile -> "init" ^ self#basename | _ -> "main"
+      match !mode with `Compile -> labeled_init self#basename | _ -> "main"
 
     method dump_file ext contents =
       let name = self#basename in

src/SM.ml

@@ -14,13 +14,7 @@ type scope = {
 }
 [@@deriving gt ~options:{ show }]
 
-let normal_label = "L"
-let builtin_label = "B"
-let global_label = "global_"
-let labeled s = normal_label ^ s
-let labeled_builtin s = builtin_label ^ s
-let labeled_global s = global_label ^ s
-let labeled_scoped i s = labeled s ^ "_" ^ string_of_int i
+let scoped i s = s ^ "_" ^ string_of_int i
 let show_scope = show scope
 
 (* The type for the stack machine instructions *)
@@ -88,10 +82,10 @@ type insn =
   | PATT of patt
   (* match failure (location, leave a value    *)
   | FAIL of Loc.t * bool
-  (* external definition                       *)
-  | EXTERN of string
-  (* public   definition                       *)
-  | PUBLIC of string
+  (* external definition (name, is_function)   *)
+  | EXTERN of string * bool
+  (* public   definition (name, is_function)   *)
+  | PUBLIC of string * bool
   (* import clause                             *)
   | IMPORT of string
   (* line info                                 *)
@@ -168,18 +162,25 @@ module ByteCode = struct
        16 FLABEL
   *)
 
+  (* Public symbol flags *)
+  let pub_flag_function = 0
+  let pub_flag_global = 1
+
   let compile cmd insns =
     let code = Buffer.create 256 in
     let st = StringTab.create () in
-    let lmap = Stdlib.ref M.empty in
-    let pubs = Stdlib.ref S.empty in
-    let imports = Stdlib.ref S.empty in
-    let globals = Stdlib.ref M.empty in
+    let lmap = Hashtbl.create 32 in
+    let pubs = Stdlib.ref [] in
+    let imports = Stdlib.ref [] in
+    let globals = Hashtbl.create 16 in
     let glob_count = Stdlib.ref 0 in
     let fixups = Stdlib.ref [] in
-    let add_lab l = lmap := M.add l (Buffer.length code) !lmap in
-    let add_public l = pubs := S.add l !pubs in
-    let add_import l = imports := S.add l !imports in
+    let add_lab l = Hashtbl.replace lmap l (Buffer.length code) in
+    let add_public name is_fun =
+      let flag = if is_fun then pub_flag_function else pub_flag_global in
+      pubs := (name, flag) :: !pubs
+    in
+    let add_import l = imports := l :: !imports in
     let add_fixup l = fixups := (Buffer.length code, l) :: !fixups in
     let add_bytes = List.iter (fun x -> Buffer.add_char code @@ Char.chr x) in
     let add_ints =
@@ -194,11 +195,11 @@ module ByteCode = struct
       List.iter (function
         | Value.Global s ->
             let i =
-              try M.find s !globals
+              try Hashtbl.find globals s
               with Not_found ->
                 let i = !glob_count in
                 incr glob_count;
-                globals := M.add s i !globals;
+                Hashtbl.add globals s i;
                 i
             in
             add_bytes [ b 0 ];
@@ -271,13 +272,13 @@ module ByteCode = struct
           add_fixup s;
           add_ints [ 0 ]
       (* 0x70                 *)
-      | CALL (f, _, _) when f = labeled "read" -> add_bytes [ (7 * 16) + 0 ]
+      | CALL ("read", _, _) -> add_bytes [ (7 * 16) + 0 ]
       (* 0x71                 *)
-      | CALL (f, _, _) when f = labeled "write" -> add_bytes [ (7 * 16) + 1 ]
+      | CALL ("write", _, _) -> add_bytes [ (7 * 16) + 1 ]
       (* 0x72                 *)
-      | CALL (f, _, _) when f = labeled "length" -> add_bytes [ (7 * 16) + 2 ]
+      | CALL ("length", _, _) -> add_bytes [ (7 * 16) + 2 ]
       (* 0x73                 *)
-      | CALL (f, _, _) when f = labeled "string" -> add_bytes [ (7 * 16) + 3 ]
+      | CALL ("string", _, _) -> add_bytes [ (7 * 16) + 3 ]
       (* 0x74                 *)
       | CALL (".array", n, _) ->
           add_bytes [ (7 * 16) + 4 ];
@@ -325,7 +326,7 @@ module ByteCode = struct
       (* 0x6p                 *)
       | PATT p -> add_bytes [ (6 * 16) + enum patt p ]
       | EXTERN _ -> ()
-      | PUBLIC s -> add_public s
+      | PUBLIC (name, is_fun) -> add_public name is_fun
       | IMPORT s -> add_import s
       | _ ->
           failwith
@@ -339,30 +340,36 @@ module ByteCode = struct
         Bytes.set_int32_ne code ofs
           (Int32.of_int
           @@
-          try M.find l !lmap
+          try Hashtbl.find lmap l
           with Not_found ->
             failwith (Printf.sprintf "ERROR: undefined label '%s'" l)))
       !fixups;
-    let pubs =
-      List.map (fun l ->
-          ( Int32.of_int @@ StringTab.add st l,
-            Int32.of_int
-            @@
-            try M.find l !lmap
-            with Not_found ->
-              failwith (Printf.sprintf "ERROR: undefined label '%s'" l) ))
-      @@ S.elements !pubs
+    let pubs_resolved =
+      List.rev_map (fun (name, flag) ->
+          let pos = 
+            if flag = pub_flag_global then
+              try Hashtbl.find globals name
+              with Not_found ->
+                failwith (Printf.sprintf "ERROR: undefined global variable '%s'" name)
+            else 
+              try Hashtbl.find lmap name
+              with Not_found ->
+                failwith (Printf.sprintf "ERROR: undefined label of public '%s'" name)
+          in
+          (Int32.of_int @@ StringTab.add st name, Int32.of_int pos, flag))
+        !pubs
     in
     let st = Buffer.to_bytes st.StringTab.buffer in
     let file = Buffer.create 1024 in
     Buffer.add_int32_ne file (Int32.of_int @@ Bytes.length st);
     Buffer.add_int32_ne file (Int32.of_int @@ !glob_count);
-    Buffer.add_int32_ne file (Int32.of_int @@ List.length pubs);
+    Buffer.add_int32_ne file (Int32.of_int @@ List.length pubs_resolved);
     List.iter
-      (fun (n, o) ->
+      (fun (n, o, f) ->
         Buffer.add_int32_ne file n;
-        Buffer.add_int32_ne file o)
-      pubs;
+        Buffer.add_int32_ne file o;
+        Buffer.add_uint8 file f)
+      pubs_resolved;
     Buffer.add_bytes file st;
     Buffer.add_bytes file code;
     let f = open_out_bin (Printf.sprintf "%s.bc" cmd#basename) in
@@ -770,11 +777,6 @@ let run p i =
          inherit indexer p
 
          method builtin f args ((cstack, stack, glob, loc, i, o) : config) =
-           let f =
-             match f.[0] with
-             | 'L' -> String.sub f 1 (String.length f - 1)
-             | _ -> f
-           in
            let _, i, o, r =
              Language.Builtin.eval (State.I, i, o, [])
                (List.map Obj.magic @@ List.rev args)
@@ -1038,27 +1040,23 @@ class env cmd imports =
     method global_scope = scope_index = 0
 
     method get_label =
-      (labeled @@ string_of_int label_index, {<label_index = label_index + 1>})
+      (string_of_int label_index, {<label_index = label_index + 1>})
 
     method get_end_label =
-      let lab = labeled @@ string_of_int label_index in
+      let lab = string_of_int label_index in
       (lab, {<end_label = lab; label_index = label_index + 1>})
 
     method end_label = end_label
     method nargs = scope.arg_index
     method nlocals = scope.nlocals
 
     method get_decls =
-      let opt_label = function
-        | true -> labeled
-        | _ -> labeled_global
-      in
       List.flatten
       @@ List.map (function
-           | name, `Extern, f -> [ EXTERN (opt_label f name) ]
-           | name, `Public, f -> [ PUBLIC (opt_label f name) ]
+           | name, `Extern, f -> [ EXTERN (name, f) ]
+           | name, `Public, f -> [ PUBLIC (name, f) ]
            | name, `PublicExtern, f ->
-               [ PUBLIC (opt_label f name); EXTERN (opt_label f name) ]
+               [ PUBLIC (name, f); EXTERN (name, f) ]
            | _ -> invalid_arg "must not happen")
       @@ List.filter (function _, `Local, _ -> false | _ -> true) decls
 
@@ -1200,10 +1198,9 @@ class env cmd imports =
                  }>}
 
     method fun_internal_name (name : string) =
-      (match scope.st with
-      | State.G _ -> labeled
-      | _ -> labeled_scoped scope_index)
-        name
+      match scope.st with
+      | State.G _ -> name
+      | _ -> scoped scope_index name
 
     method add_fun_name (name : string)
         (m : [ `Local | `Extern | `Public | `PublicExtern ]) =
@@ -1668,7 +1665,7 @@ let compile cmd ((imports, _), p) =
   in
   let prg =
     List.map (fun i -> IMPORT i) imports
-    @ [ PUBLIC topname ] @ env#get_decls @ List.flatten prg
+    @ [ PUBLIC (topname, true) ] @ env#get_decls @ List.flatten prg
   in
   (*Printf.eprintf "Before propagating closures:\n";
     Printf.eprintf "%s\n%!" env#show_funinfo;