Merge pull request ocaml#803 from nojb/make_opcodes_in_ml

ocaml tool to extract opcode information

.gitignore

@@ -363,6 +363,8 @@
 /tools/cmpbyt.opt
 /tools/stripdebug
 /tools/stripdebug.opt
+/tools/make_opcodes
+/tools/make_opcodes.ml
 
 /utils/config.ml
 

Changes

@@ -53,7 +53,7 @@ Next version (4.05.0):
   This can be tested with ocamlopt -config
   (Sébastien Hinderer)
 
-- PR#7137, GPR#960: "-open" command line flag now accepts a module path 
+- PR#7137, GPR#960: "-open" command line flag now accepts a module path
   (not a module name) (Arseniy Alekseyev and Leo White)
 
 ### Standard library:
@@ -172,6 +172,10 @@ Next version (4.05.0):
   enabled
   (Mark Shinwell)
 
+- GPR#803: new ocamllex-based tool to extract bytecode compiler
+  opcode information from C headers.
+  (Nicolas Ojeda Bar)
+
 ### Internal/compiler-libs changes:
 
 - GPR#744, GPR#781: fix duplicate self-reference in imported cmi_crcs

Makefile

@@ -516,17 +516,6 @@ partialclean::
 $(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(MIDDLE_END:.cmo=.cmx) \
 $(ASMCOMP:.cmo=.cmx): ocamlopt
 
-# The numeric opcodes
-
-bytecomp/opcodes.ml: byterun/caml/instruct.h
-	sed -n -e '/^enum/p' -e 's/,//g' -e '/^  /p' byterun/caml/instruct.h | \
-	awk -f tools/make-opcodes > bytecomp/opcodes.ml
-
-partialclean::
-	rm -f bytecomp/opcodes.ml
-
-beforedepend:: bytecomp/opcodes.ml
-
 # The predefined exceptions and primitives
 
 byterun/primitives:

Makefile.nt

@@ -506,17 +506,6 @@ partialclean::
 $(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(MIDDLE_END:.cmo=.cmx) \
 $(ASMCOMP:.cmo=.cmx): ocamlopt
 
-# The numeric opcodes
-
-bytecomp/opcodes.ml: byterun/caml/instruct.h
-	sed -n -e "/^enum/p" -e "s|,||g" -e "/^  /p" byterun/caml/instruct.h | \
-	gawk -f tools/make-opcodes > bytecomp/opcodes.ml
-
-partialclean::
-	rm -f bytecomp/opcodes.ml
-
-beforedepend:: bytecomp/opcodes.ml
-
 # The predefined exceptions and primitives
 
 byterun/primitives:

Makefile.shared

@@ -346,3 +346,16 @@ partialclean::
 	rm -f ocamlnat$(EXE)
 
 toplevel/opttoploop.cmx: otherlibs/dynlink/dynlink.cmxa
+
+# The numeric opcodes
+
+bytecomp/opcodes.ml: byterun/caml/instruct.h tools/make_opcodes
+	$(CAMLRUN) tools/make_opcodes -opcodes < $< > $@
+
+tools/make_opcodes: tools/make_opcodes.mll
+	cd tools && $(MAKE) make_opcodes
+
+partialclean::
+	rm -f bytecomp/opcodes.ml
+
+beforedepend:: bytecomp/opcodes.ml

tools/Makefile

@@ -290,17 +290,14 @@ $(call byte_and_opt,dumpobj,misc.cmo identifiable.cmo numbers.cmo tbl.cmo \
                     config.cmo ident.cmo opcodes.cmo bytesections.cmo \
 		    $(DUMPOBJ),)
 
-opnames.ml: ../byterun/caml/instruct.h
-	unset LC_ALL || : ; \
-	unset LC_CTYPE || : ; \
-	unset LC_COLLATE LANG || : ; \
-	sed -e '/[/][*]/d' \
-	    -e '/^#/d' \
-	    -e 's/enum \(.*\) {/let names_of_\1 = [|/' \
-	    -e 's/.*};$$/ |]/' \
-	    -e 's/\([A-Z][A-Z_0-9a-z]*\)/"\1"/g' \
-	    -e 's/,/;/g' \
-	../byterun/caml/instruct.h > opnames.ml
+make_opcodes.ml: make_opcodes.mll
+	$(CAMLLEX) make_opcodes.mll
+
+make_opcodes: make_opcodes.ml
+	$(CAMLC) make_opcodes.ml -o $@
+
+opnames.ml: ../byterun/caml/instruct.h make_opcodes
+	$(CAMLRUN) make_opcodes -opnames < $< > $@
 
 clean::
 	rm -f opnames.ml

tools/make_opcodes.mll

@@ -0,0 +1,47 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                      Nicolas Ojeda Bar, LexiFi                      *)
+(*                                                                     *)
+(*  Copyright 2016 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+let ident = ['a'-'z''A'-'Z''_']['a'-'z''A'-'Z''0'-'9''_']*
+let space = [' ''\n''\t']*
+
+rule find_enum = parse
+| "enum" space (ident as id) space '{' { id, opnames lexbuf }
+| _                                    { find_enum lexbuf }
+
+and opnames = parse
+| space (ident as op) space ','        { op :: opnames lexbuf }
+| space ident space '}'                { [] }
+
+{
+  let print_opnames = ref false
+  let print_opcodes = ref false
+
+  open Printf
+
+  let () =
+    let spec =
+      [
+        "-opnames", Arg.Set print_opnames, " Dump opcode names";
+        "-opcodes", Arg.Set print_opcodes, " Dump opcode numbers";
+      ]
+    in
+    Arg.parse (Arg.align spec) ignore "Extract opcode info from instruct.h";
+    let lexbuf = Lexing.from_channel stdin in
+    let id, opnames = find_enum lexbuf in
+    if !print_opnames then begin
+      printf "let names_of_%s = [|\n" id;
+      List.iter (fun s -> printf "  %S;\n" s) opnames;
+      printf "|]\n"
+    end;
+    if !print_opcodes then
+      List.iteri (fun i op -> printf "let op%s = %i\n" op i) opnames
+}