Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'ops_pct' back to trunk.

git-svn-id: https://svn.parrot.org/parrot/trunk@46922 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
commit 762a0f20396cf052d7d1cace2b2b947a1be04ced 1 parent fb5d6d9
@bacek bacek authored
Showing with 37,564 additions and 7,910 deletions.
  1. +31 −30 MANIFEST
  2. +31 −1 MANIFEST.SKIP
  3. +3 −2 MANIFEST.generated
  4. +24 −0 compilers/opsc/Defines.mak
  5. +50 −0 compilers/opsc/Rules.mak
  6. +14 −0 compilers/opsc/TODO
  7. +1 −0  compilers/opsc/gen/Ops/Compiler/IGNOREME
  8. 0  compilers/opsc/gen/Ops/Trans/IGNOREME
  9. +113 −0 compilers/opsc/ops2c.nqp
  10. +25 −0 compilers/opsc/opsc.pir
  11. +17 −0 compilers/opsc/src/Ops/Compiler.pm
  12. +413 −0 compilers/opsc/src/Ops/Compiler/Actions.pm
  13. +147 −0 compilers/opsc/src/Ops/Compiler/Grammar.pm
  14. +444 −0 compilers/opsc/src/Ops/Emitter.pm
  15. +331 −0 compilers/opsc/src/Ops/File.pm
  16. +392 −0 compilers/opsc/src/Ops/Op.pm
  17. +234 −0 compilers/opsc/src/Ops/OpLib.pm
  18. +108 −0 compilers/opsc/src/Ops/Renumberer.pm
  19. +58 −0 compilers/opsc/src/Ops/Trans.pm
  20. +367 −0 compilers/opsc/src/Ops/Trans/C.pm
  21. +196 −0 compilers/opsc/src/builtins.pir
  22. +1 −1  compilers/pct/Rules.mak
  23. +0 −1  config/auto/extra_nci_thunks.pm
  24. +193 −221 config/gen/makefiles/root.in
  25. +3 −4 docs/tests.pod
  26. +1,303 −0 include/parrot/oplib/core_ops.h
  27. +1,300 −0 include/parrot/oplib/ops.h
  28. +1,226 −0 include/parrot/opsenum.h
  29. +4 −0 lib/Parrot/Distribution.pm
  30. +2 −1  lib/Parrot/Harness/DefaultTests.pm
  31. +2 −2 lib/Parrot/Ops2c/Utils.pm
  32. +12 −0 lib/Parrot/Test/Pod.pm
  33. +14 −60 runtime/parrot/library/distutils.pir
  34. +6 −6 src/dynoplibs/Rules.in
  35. +29,804 −0 src/ops/core_ops.c
  36. +1 −1  src/ops/var.ops
  37. +1 −0  src/pmc/nci.pmc
  38. +2 −0  t/codingstd/linelength.t
  39. +2 −1  t/codingstd/perlcritic.t
  40. +205 −0 t/compilers/opsc/01-parse.t
  41. +90 −0 t/compilers/opsc/02-parse-all-ops.t
  42. +110 −0 t/compilers/opsc/03-past.t
  43. +36 −0 t/compilers/opsc/04-op.t
  44. +28 −0 t/compilers/opsc/05-oplib.t
  45. +45 −0 t/compilers/opsc/06-opsfile.t
  46. +129 −0 t/compilers/opsc/07-emitter.t
  47. +39 −0 t/compilers/opsc/common.pir
  48. +1 −1  t/harness.pir
  49. +0 −105 t/op/01-parse_ops.t
  50. +0 −197 t/tools/ops2cutils/01-new.t
  51. +0 −146 t/tools/ops2cutils/02-usage.t
  52. +0 −131 t/tools/ops2cutils/03-print_c_header_file.t
  53. +0 −120 t/tools/ops2cutils/04-print_c_source_top.t
  54. +0 −123 t/tools/ops2cutils/05-print_c_source_bottom.t
  55. +0 −157 t/tools/ops2cutils/06-dynamic.t
  56. +0 −156 t/tools/ops2cutils/07-make_incdir.t
  57. +0 −118 t/tools/ops2cutils/08-nolines.t
  58. +0 −128 t/tools/ops2cutils/09-dynamic_nolines.t
  59. +0 −131 t/tools/ops2cutils/10-print_c_source_file.t
  60. +0 −185 t/tools/ops2cutils/testlib/GenerateCore.pm
  61. +0 −66 t/tools/ops2pm/00-qualify.t
  62. +0 −64 t/tools/ops2pm/01-ops2pm.t
  63. +0 −106 t/tools/ops2pm/02-usage.t
  64. +0 −99 t/tools/ops2pm/03-new.t
  65. +0 −304 t/tools/ops2pm/04-prepare_ops.t
  66. +0 −138 t/tools/ops2pm/05-renum_op_map_file.t
  67. +0 −371 t/tools/ops2pm/06-load_op_map_files.t
  68. +0 −117 t/tools/ops2pm/07-no_ops_skip.t
  69. +0 −353 t/tools/ops2pm/08-sort_ops.t
  70. +0 −215 t/tools/ops2pm/09-prepare_real_ops.t
  71. +0 −212 t/tools/ops2pm/10-print_module.t
  72. +0 −144 t/tools/ops2pm/11-print_h.t
  73. +0 −353 t/tools/ops2pm/samples/bit_ops.original
  74. +0 −333 t/tools/ops2pm/samples/bit_ops.second
  75. +0 −1,326 t/tools/ops2pm/samples/core_ops.original
  76. +0 −1,223 t/tools/ops2pm/samples/ops_num.original
  77. +0 −316 t/tools/ops2pm/samples/pic_ops.original
  78. +6 −141 tools/build/ops2c.pl
View
61 MANIFEST
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Sun May 23 08:19:12 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sun May 23 18:01:00 2010 UT
#
# See below for documentation on the format of this file.
#
@@ -62,6 +62,24 @@ compilers/imcc/sets.h [imcc]
compilers/imcc/symreg.c [imcc]
compilers/imcc/symreg.h [imcc]
compilers/imcc/unit.h [imcc]
+compilers/opsc/Defines.mak [opsc]
+compilers/opsc/Rules.mak [opsc]
+compilers/opsc/TODO [opsc]
+compilers/opsc/gen/Ops/Compiler/IGNOREME [opsc]
+compilers/opsc/gen/Ops/Trans/IGNOREME [opsc]
+compilers/opsc/ops2c.nqp [opsc]
+compilers/opsc/opsc.pir [opsc]
+compilers/opsc/src/Ops/Compiler.pm [opsc]
+compilers/opsc/src/Ops/Compiler/Actions.pm [opsc]
+compilers/opsc/src/Ops/Compiler/Grammar.pm [opsc]
+compilers/opsc/src/Ops/Emitter.pm [opsc]
+compilers/opsc/src/Ops/File.pm [opsc]
+compilers/opsc/src/Ops/Op.pm [opsc]
+compilers/opsc/src/Ops/OpLib.pm [opsc]
+compilers/opsc/src/Ops/Renumberer.pm [opsc]
+compilers/opsc/src/Ops/Trans.pm [opsc]
+compilers/opsc/src/Ops/Trans/C.pm [opsc]
+compilers/opsc/src/builtins.pir [opsc]
compilers/pct/Defines.mak [pct]
compilers/pct/PCT.pir [pct]
compilers/pct/README.pod []doc
@@ -963,6 +981,9 @@ include/parrot/oo.h [main]include
include/parrot/oo_private.h [main]include
include/parrot/op.h [main]include
include/parrot/oplib.h [main]include
+include/parrot/oplib/core_ops.h [main]include
+include/parrot/oplib/ops.h [main]include
+include/parrot/opsenum.h [main]include
include/parrot/packfile.h [main]include
include/parrot/parrot.h [main]include
include/parrot/platform_interface.h [main]include
@@ -1312,6 +1333,7 @@ src/oo.c []
src/ops/bit.ops []
src/ops/cmp.ops []
src/ops/core.ops []
+src/ops/core_ops.c []
src/ops/debug.ops []
src/ops/experimental.ops []
src/ops/io.ops []
@@ -1521,6 +1543,14 @@ t/compilers/imcc/syn/subflags.t [test]
t/compilers/imcc/syn/symbols.t [test]
t/compilers/imcc/syn/tail.t [test]
t/compilers/imcc/syn/veracity.t [test]
+t/compilers/opsc/01-parse.t [test]
+t/compilers/opsc/02-parse-all-ops.t [test]
+t/compilers/opsc/03-past.t [test]
+t/compilers/opsc/04-op.t [test]
+t/compilers/opsc/05-oplib.t [test]
+t/compilers/opsc/06-opsfile.t [test]
+t/compilers/opsc/07-emitter.t [test]
+t/compilers/opsc/common.pir [test]
t/compilers/pct/complete_workflow.t [test]
t/compilers/pct/past.t [test]
t/compilers/pct/pct_hllcompiler.t [test]
@@ -1741,7 +1771,6 @@ t/oo/subclass.t [test]
t/oo/vtableoverride.t [test]
t/op/00ff-dos.t [test]
t/op/00ff-unix.t [test]
-t/op/01-parse_ops.t [test]
t/op/64bit.t [test]
t/op/annotate-old.t [test]
t/op/annotate.t [test]
@@ -2034,34 +2063,6 @@ t/tools/install/testlib/src/ops/ops.num [test]
t/tools/install/testlib/src/pmc/pmc_object.h [test]
t/tools/install/testlib/tools/build/ops2c.pl [test]
t/tools/install/testlib/vtable.dump [test]
-t/tools/ops2cutils/01-new.t [test]
-t/tools/ops2cutils/02-usage.t [test]
-t/tools/ops2cutils/03-print_c_header_file.t [test]
-t/tools/ops2cutils/04-print_c_source_top.t [test]
-t/tools/ops2cutils/05-print_c_source_bottom.t [test]
-t/tools/ops2cutils/06-dynamic.t [test]
-t/tools/ops2cutils/07-make_incdir.t [test]
-t/tools/ops2cutils/08-nolines.t [test]
-t/tools/ops2cutils/09-dynamic_nolines.t [test]
-t/tools/ops2cutils/10-print_c_source_file.t [test]
-t/tools/ops2cutils/testlib/GenerateCore.pm [test]
-t/tools/ops2pm/00-qualify.t [test]
-t/tools/ops2pm/01-ops2pm.t [test]
-t/tools/ops2pm/02-usage.t [test]
-t/tools/ops2pm/03-new.t [test]
-t/tools/ops2pm/04-prepare_ops.t [test]
-t/tools/ops2pm/05-renum_op_map_file.t [test]
-t/tools/ops2pm/06-load_op_map_files.t [test]
-t/tools/ops2pm/07-no_ops_skip.t [test]
-t/tools/ops2pm/08-sort_ops.t [test]
-t/tools/ops2pm/09-prepare_real_ops.t [test]
-t/tools/ops2pm/10-print_module.t [test]
-t/tools/ops2pm/11-print_h.t [test]
-t/tools/ops2pm/samples/bit_ops.original [test]
-t/tools/ops2pm/samples/bit_ops.second [test]
-t/tools/ops2pm/samples/core_ops.original [test]
-t/tools/ops2pm/samples/ops_num.original [test]
-t/tools/ops2pm/samples/pic_ops.original [test]
t/tools/parrot_debugger.t [test]
t/tools/pbc_disassemble.t [test]
t/tools/pbc_dump.t [test]
View
32 MANIFEST.SKIP
@@ -1,6 +1,6 @@
# ex: set ro:
# $Id$
-# generated by tools/dev/mk_manifest_and_skip.pl Sun May 23 08:10:47 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sat May 22 04:46:14 2010 UT
#
# This file should contain a transcript of the svn:ignore properties
# of the directories in the Parrot subversion repository. (Needed for
@@ -81,6 +81,14 @@
^miniparrot/
^myconfig$
^myconfig/
+^ops2c$
+^ops2c/
+^ops2c\.c$
+^ops2c\.c/
+^ops2c\.pbc$
+^ops2c\.pbc/
+^ops2c\.pir$
+^ops2c\.pir/
^parrot$
^parrot/
^parrot-nqp$
@@ -188,6 +196,22 @@
^compilers/imcc/imcparser\.h/
^compilers/imcc/imcparser\.output$
^compilers/imcc/imcparser\.output/
+# generated from svn:ignore of 'compilers/opsc/'
+^compilers/opsc/opsc\.pbc$
+^compilers/opsc/opsc\.pbc/
+# generated from svn:ignore of 'compilers/opsc/gen/Ops/'
+^compilers/opsc/gen/Ops/ $
+^compilers/opsc/gen/Ops/ /
+^compilers/opsc/gen/Ops/.*\.pir$
+^compilers/opsc/gen/Ops/.*\.pir/
+# generated from svn:ignore of 'compilers/opsc/gen/Ops/Compiler/'
+^compilers/opsc/gen/Ops/Compiler/Actions\.pir$
+^compilers/opsc/gen/Ops/Compiler/Actions\.pir/
+^compilers/opsc/gen/Ops/Compiler/Grammar\.pir$
+^compilers/opsc/gen/Ops/Compiler/Grammar\.pir/
+# generated from svn:ignore of 'compilers/opsc/gen/Ops/Trans/'
+^compilers/opsc/gen/Ops/Trans/C\.pir$
+^compilers/opsc/gen/Ops/Trans/C\.pir/
# generated from svn:ignore of 'compilers/pct/src/PAST/'
^compilers/pct/src/PAST/.*\.pbc$
^compilers/pct/src/PAST/.*\.pbc/
@@ -428,6 +452,12 @@
# generated from svn:ignore of 'ext/Parrot-Embed/t/'
^ext/Parrot-Embed/t/.*\.pbc$
^ext/Parrot-Embed/t/.*\.pbc/
+# generated from svn:ignore of 'ext/nqp-rx/src/gen/'
+^ext/nqp-rx/src/gen/settings\.pir$
+^ext/nqp-rx/src/gen/settings\.pir/
+# generated from svn:ignore of 'ext/nqp-rx/src/stage0/'
+^ext/nqp-rx/src/stage0/nqp-setting\.pir$
+^ext/nqp-rx/src/stage0/nqp-setting\.pir/
# generated from svn:ignore of 'include/parrot/'
^include/parrot/.*\.tmp$
^include/parrot/.*\.tmp/
View
5 MANIFEST.generated
@@ -125,6 +125,8 @@ include/pmc/pmc_timer.h [devel]include
include/pmc/pmc_undef.h [devel]include
include/pmc/pmc_unmanagedstruct.h [devel]include
install_config.fpmc [main]lib
+installable_ops2c [main]bin
+installable_ops2c.exe [main]bin
installable_parrot [main]bin
installable_parrot-nqp [main]bin
installable_parrot-nqp.exe [main]bin
@@ -145,7 +147,6 @@ installable_pbc_merge.exe [main]bin
installable_pbc_to_exe [main]bin
installable_pbc_to_exe.exe [main]bin
lib/Parrot/Config/Generated.pm [devel]lib
-lib/Parrot/OpLib/core.pm [devel]lib
lib/Parrot/PMC.pm [devel]lib
lib/Parrot/Pmc2c/PCCMETHOD_BITS.pm [devel]lib
libparrot.dll [main]bin
@@ -272,7 +273,6 @@ runtime/parrot/library/Stream/Writer.pbc [main]
runtime/parrot/library/TAP/Formatter.pbc [main]
runtime/parrot/library/TAP/Harness.pbc [main]
runtime/parrot/library/TAP/Parser.pbc [main]
-runtime/parrot/library/TGE.pbc [tge]
runtime/parrot/library/Tcl/Glob.pbc [main]
runtime/parrot/library/TclLibrary.pbc [main]
runtime/parrot/library/Test/Builder.pbc [main]
@@ -294,6 +294,7 @@ runtime/parrot/library/libpcre.pbc [main]
runtime/parrot/library/ncurses.pbc [main]
runtime/parrot/library/nqp-rx.pbc [nqp]
runtime/parrot/library/nqp-setting.pbc [nqp]
+runtime/parrot/library/opsc.pbc [main]
runtime/parrot/library/osutils.pbc [main]
runtime/parrot/library/parrotlib.pbc [main]
runtime/parrot/library/pcore.pbc [main]
View
24 compilers/opsc/Defines.mak
@@ -0,0 +1,24 @@
+OPSC_DIR = compilers/opsc
+
+OPSC_SOURCES_GENERATED = \
+ $(OPSC_DIR)/gen/Ops/Compiler.pir \
+ $(OPSC_DIR)/gen/Ops/Compiler/Actions.pir \
+ $(OPSC_DIR)/gen/Ops/Compiler/Grammar.pir \
+ $(OPSC_DIR)/gen/Ops/Emitter.pir \
+ $(OPSC_DIR)/gen/Ops/Trans.pir \
+ $(OPSC_DIR)/gen/Ops/Trans/C.pir \
+ $(OPSC_DIR)/gen/Ops/Op.pir \
+ $(OPSC_DIR)/gen/Ops/OpLib.pir \
+ $(OPSC_DIR)/gen/Ops/File.pir \
+ $(OPSC_DIR)/gen/Ops/Renumberer.pir
+
+OPSC_SOURCES = \
+ $(OPSC_DIR)/opsc.pir \
+ $(OPSC_DIR)/src/builtins.pir \
+ $(OPSC_SOURCES_GENERATED)
+
+OPSC_CLEANUPS = \
+ $(OPSC_DIR)/opsc.pbc \
+ $(LIBRARY_DIR)/opsc.pbc \
+ $(OPSC_SOURCES_GENERATED)
+
View
50 compilers/opsc/Rules.mak
@@ -0,0 +1,50 @@
+$(LIBRARY_DIR)/opsc.pbc: $(NQP_RX) $(OPSC_SOURCES) $(NQPRX_LIB_SETTING)
+ $(PARROT) -o $(LIBRARY_DIR)/opsc.pbc $(OPSC_DIR)/opsc.pir
+
+$(OPSC_DIR)/gen/Ops/Compiler.pir: $(OPSC_DIR)/src/Ops/Compiler.pm $(NQP_RX)
+ $(NQP_RX) --target=pir --output=$@ $(OPSC_DIR)/src/Ops/Compiler.pm
+
+$(OPSC_DIR)/gen/Ops/Compiler/Actions.pir: $(OPSC_DIR)/src/Ops/Compiler/Actions.pm $(NQP_RX)
+ $(NQP_RX) --target=pir --output=$@ $(OPSC_DIR)/src/Ops/Compiler/Actions.pm
+
+$(OPSC_DIR)/gen/Ops/Compiler/Grammar.pir: $(OPSC_DIR)/src/Ops/Compiler/Grammar.pm $(NQP_RX)
+ $(NQP_RX) --target=pir --output=$@ $(OPSC_DIR)/src/Ops/Compiler/Grammar.pm
+
+$(OPSC_DIR)/gen/Ops/Emitter.pir: $(OPSC_DIR)/src/Ops/Emitter.pm $(NQP_RX)
+ $(NQP_RX) --target=pir --output=$@ $(OPSC_DIR)/src/Ops/Emitter.pm
+
+$(OPSC_DIR)/gen/Ops/File.pir: $(OPSC_DIR)/src/Ops/File.pm $(NQP_RX)
+ $(NQP_RX) --target=pir --output=$@ $(OPSC_DIR)/src/Ops/File.pm
+
+$(OPSC_DIR)/gen/Ops/Op.pir: $(OPSC_DIR)/src/Ops/Op.pm $(NQP_RX)
+ $(NQP_RX) --target=pir --output=$@ $(OPSC_DIR)/src/Ops/Op.pm
+
+$(OPSC_DIR)/gen/Ops/OpLib.pir: $(OPSC_DIR)/src/Ops/OpLib.pm $(NQP_RX)
+ $(NQP_RX) --target=pir --output=$@ $(OPSC_DIR)/src/Ops/OpLib.pm
+
+$(OPSC_DIR)/gen/Ops/Trans.pir: $(OPSC_DIR)/src/Ops/Trans.pm $(NQP_RX)
+ $(NQP_RX) --target=pir --output=$@ $(OPSC_DIR)/src/Ops/Trans.pm
+
+$(OPSC_DIR)/gen/Ops/Trans/C.pir: $(OPSC_DIR)/src/Ops/Trans/C.pm $(NQP_RX)
+ $(NQP_RX) --target=pir --output=$@ $(OPSC_DIR)/src/Ops/Trans/C.pm
+
+$(OPSC_DIR)/gen/Ops/Renumberer.pir: $(OPSC_DIR)/src/Ops/Renumberer.pm $(NQP_RX)
+ $(NQP_RX) --target=pir --output=$@ $(OPSC_DIR)/src/Ops/Renumberer.pm
+
+# Target to force rebuild opsc from main Makefile
+$(OPSC_DIR)/ops2c.nqp: $(LIBRARY_DIR)/opsc.pbc
+
+$(OPS2C): $(OPSC_DIR)/ops2c.nqp $(LIBRARY_DIR)/opsc.pbc $(NQP_RX) $(PBC_TO_EXE)
+ $(NQP_RX) --target=pir $(OPSC_DIR)/ops2c.nqp >ops2c.pir
+ $(PARROT) -o ops2c.pbc ops2c.pir
+ $(PBC_TO_EXE) ops2c.pbc
+
+$(INSTALLABLEOPS2C): $(OPS2C) src/install_config$(O)
+ $(PBC_TO_EXE) ops2c.pbc --install
+
+opsc: $(LIBRARY_DIR)/opsc.pbc
+
+# Local variables:
+# mode: makefile
+# End:
+# vim: ft=make:
View
14 compilers/opsc/TODO
@@ -0,0 +1,14 @@
+Simple todo.
+
+Required for initial self-hosting:
+
+ * NONE! We are selfhosted now!
+
+Required for full implementation:
+ * Handling #line directives.
+ * A LOT OF DOCUMENTATION.
+ * Add tests for Trans::C independent from 06-emitter.t
+ * Add tests for dynamic mode of Emitter.
+
+Nice to have:
+ * Profiling and performance tuning of ops parsing (we need pmichaud).
View
1  compilers/opsc/gen/Ops/Compiler/IGNOREME
@@ -0,0 +1 @@
+I just dummy file. Please ignore me. Please...
View
0  compilers/opsc/gen/Ops/Trans/IGNOREME
No changes.
View
113 compilers/opsc/ops2c.nqp
@@ -0,0 +1,113 @@
+#! ./parrot-nqp
+# $Id$
+
+pir::load_bytecode("opsc.pbc");
+pir::load_bytecode("Getopt/Obj.pbc");
+
+my $core := 0;
+my @files;
+my $emit_lines := 1;
+
+my $getopts := Q:PIR{ %r = new ['Getopt';'Obj'] };
+
+$getopts.notOptStop();
+my $arg := $getopts.add();
+$arg.long('core');
+$arg.short('c');
+
+$arg := $getopts.add();
+$arg.long('dynamic');
+$arg.short('d');
+$arg.type('String');
+
+$arg := $getopts.add();
+$arg.long('debug');
+$arg.short('g');
+
+$arg := $getopts.add();
+$arg.long('no-lines');
+$arg.short('n');
+
+$arg := $getopts.add();
+$arg.long('help');
+$arg.short('h');
+
+$arg := $getopts.add();
+$arg.long('force-regen');
+$arg.short('f');
+
+my $opts := $getopts.get_options(pir::getinterp__p()[2]);
+
+if $opts<core> {
+ @files := <
+ src/ops/core.ops
+ src/ops/bit.ops
+ src/ops/cmp.ops
+ src/ops/debug.ops
+ src/ops/io.ops
+ src/ops/math.ops
+ src/ops/object.ops
+ src/ops/pmc.ops
+ src/ops/set.ops
+ src/ops/string.ops
+ src/ops/sys.ops
+ src/ops/var.ops
+ src/ops/experimental.ops
+ >;
+ $core := 1;
+}
+elsif $opts<dynamic> {
+ $core := 0;
+ @files.push( $opts<dynamic>);
+}
+elsif (+$opts == 0 || $opts<help>) {
+ say("This is ops2c, part of Parrot build infrastructure.
+usage:
+ops2c --core
+ops2c --dynamic path/to/dynops.ops");
+ pir::exit(0);
+}
+
+my $force_regen := ?$opts<force-regen>;
+
+if ($opts<no-lines>) {
+ #TODO: figure out how to generate line numbers
+ # $emit_lines is currently ignored
+ $emit_lines := 0;
+}
+
+my $trans := Ops::Trans::C.new();
+my $start_time := pir::time__N();
+my $debug := ?$opts<debug>;
+my $f;
+my $renum;
+
+if $core {
+ my $lib := Ops::OpLib.new(
+ :num_file('src/ops/ops.num'),
+ :skip_file('src/ops/ops.skip'),
+ );
+ $f := Ops::File.new(|@files, :oplib($lib), :core(1));
+}
+else {
+ $f := Ops::File.new(|@files, :core(0));
+}
+
+pir::sprintf(my $time, "%.3f", [pir::time__N() - $start_time] );
+#say("# Ops parsed in $time seconds.");
+
+my $emitter := Ops::Emitter.new(
+ :ops_file($f), :trans($trans),
+ :script('ops2c.nqp'), :file(@files[0]),
+ :flags( hash( core => $core ) ),
+);
+
+unless $debug {
+ if $force_regen || $f<renum>.need_regeneration {
+ $emitter.print_ops_num_files();
+ }
+ $emitter.print_c_header_files();
+ $emitter.print_c_source_file();
+}
+
+# vim: expandtab shiftwidth=4 ft=perl6:
View
25 compilers/opsc/opsc.pir
@@ -0,0 +1,25 @@
+#! parrot
+# Copyright (C) 2009-2010, Parrot Foundation.
+# $Id$
+
+.namespace [ 'Ops';'Compiler' ]
+
+.include 'compilers/opsc/src/builtins.pir'
+.include 'compilers/opsc/gen/Ops/Compiler/Grammar.pir'
+.include 'compilers/opsc/gen/Ops/Compiler/Actions.pir'
+.include 'compilers/opsc/gen/Ops/Compiler.pir'
+
+.include 'compilers/opsc/gen/Ops/Emitter.pir'
+.include 'compilers/opsc/gen/Ops/Trans.pir'
+.include 'compilers/opsc/gen/Ops/Trans/C.pir'
+
+.include 'compilers/opsc/gen/Ops/Op.pir'
+.include 'compilers/opsc/gen/Ops/OpLib.pir'
+.include 'compilers/opsc/gen/Ops/File.pir'
+.include 'compilers/opsc/gen/Ops/Renumberer.pir'
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
View
17 compilers/opsc/src/Ops/Compiler.pm
@@ -0,0 +1,17 @@
+#! nqp
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+class Ops::Compiler is HLL::Compiler;
+
+INIT {
+ Ops::Compiler.language('Ops');
+ Ops::Compiler.parsegrammar(Ops::Compiler::Grammar);
+ Ops::Compiler.parseactions(Ops::Compiler::Actions);
+}
+
+method set_oplib($oplib) {
+ $Ops::Compiler::Actions::OPLIB := $oplib;
+}
+
+# vim: ft=perl6 expandtab shiftwidth=4:
View
413 compilers/opsc/src/Ops/Compiler/Actions.pm
@@ -0,0 +1,413 @@
+#! nqp
+# Copyright (C) 2009-2010, Parrot Foundation.
+# $Id$
+
+class Ops::Compiler::Actions is HLL::Actions;
+
+our $OPLIB;
+
+INIT {
+ pir::load_bytecode("nqp-setting.pbc");
+ $OPLIB := 0;
+}
+
+method TOP($/) {
+ make $<body>.ast;
+}
+
+method body($/) {
+ my $past := PAST::Stmts.new(
+ :node($/)
+ );
+
+ $past<preamble> := PAST::Stmts.new(
+ :node($/)
+ );
+ $past<ops> := PAST::Stmts.new(
+ :node($/)
+ );
+
+ for $<preamble> {
+ $past<preamble>.push($_<preamble_guts>);
+ }
+
+ for $<op> {
+ my $ops := $_.ast;
+ my $op_skip_table;
+ if $OPLIB {
+ $op_skip_table := $OPLIB.op_skip_table;
+ }
+ for @($ops) -> $op {
+ if $OPLIB && !$op_skip_table.exists($op.full_name) || !$OPLIB {
+ $past<ops>.push($op);
+ }
+ }
+ }
+
+ make $past;
+}
+
+method preamble($/) {
+ make PAST::Op.new(
+ :node($/),
+ :pasttype('preamble'),
+ ~$<preamble_guts>
+ );
+}
+
+method op($/) {
+
+ # Handling flags.
+ my %flags := hash();
+ for $<op_flag> {
+ %flags{~$_<identifier>} := 1;
+ }
+
+ my @args := list();
+ if ($<op_params>) {
+ @args := @($<op_params>[0].ast);
+ }
+
+ my @norm_args := normalize_args(@args);
+ # We have to clone @norm_args. Otherwise it will be destroyed...
+ my @variants := expand_args(pir::clone__PP(@norm_args));
+
+ my $op := Ops::Op.new(
+ :name(~$<op_name>),
+ );
+
+ # Flatten PAST::Stmts into Op.
+ for @($<op_body>.ast) {
+ $op.push($_);
+ }
+
+ for $<op_body>.ast<jump> {
+ $op.add_jump($_);
+ }
+ if ~$<op_name> eq 'runinterp' {
+ $op.add_jump('PARROT_JUMP_RELATIVE');
+ }
+ $op<flags> := %flags;
+ $op<args> := @args;
+ $op<type> := ~$<op_type>;
+ $op<normalized_args> := @norm_args;
+
+ if !%flags<flow> {
+ my $goto_next := PAST::Op.new(
+ :pasttype('call'),
+ :name('goto_offset'),
+ PAST::Op.new(
+ :pasttype<call>,
+ :name<OPSIZE>,
+ )
+ );
+
+ my $nl := "\n";
+ $op.push(PAST::Op.new(
+ :pasttype<inline>,
+ :inline($nl)
+ ));
+ $op.push($goto_next);
+ $op.push(PAST::Op.new(
+ :pasttype<inline>,
+ :inline<;>
+ ));
+ }
+
+ my $past := PAST::Stmts.new(
+ :node($/)
+ );
+
+ if @variants {
+ for @variants {
+ my $new_op := pir::clone__PP($op);
+ $new_op<arg_types> := $_;
+ $past.push($new_op);
+ }
+ }
+ else {
+ $past.push($op);
+ }
+
+ make $past;
+}
+
+# Normalize args
+# For each arg produce LoL of all available variants
+# E.g. "in" will produce "i" and "ic" variants
+#
+# type one of <i p s n>
+# direction one of <i o io>
+# is_label one of <0 1>
+
+sub normalize_args(@args) {
+ my @result;
+ for @args -> $arg {
+ my $res := PAST::Var.new(
+ :isdecl(1)
+ );
+
+ if $arg<type> eq 'LABEL' {
+ $res<type> := 'i';
+ $res<is_label> := 1;
+ }
+ else {
+ $res<is_label> := 0;
+ }
+
+ if $arg<type> eq 'INTKEY' {
+ $res<type> := 'ki';
+ }
+ elsif $arg<type> ne 'LABEL' {
+ $res<type> := lc(substr($arg<type>, 0, 1));
+ }
+
+ my $use := $arg<direction>;
+
+ if $use eq 'in' {
+ $res<variant> := $res<type> ~ "c";
+ $res<direction> := 'i';
+ }
+ elsif $use eq 'invar' {
+ $res<direction> := 'i';
+ }
+ elsif $use eq 'inconst' {
+ $res<type> := $res<type> ~ "c";
+ $res<direction> := 'i';
+ }
+ elsif $use eq 'inout' {
+ $res<direction> := 'io';
+ }
+ else {
+ $res<direction> := 'o';
+ }
+
+ @result.push($res);
+ }
+ @result;
+}
+
+=begin
+
+=item C<expand_args(@args)>
+
+Given an argument list, returns a list of all the possible argument
+combinations.
+
+=end
+sub expand_args(@args) {
+
+ return list() unless @args;
+
+ my $arg := @args.shift;
+
+ my @var := list($arg<type>);
+ if $arg<variant> {
+ @var.push($arg<variant>);
+ }
+
+ my @list := expand_args(@args);
+ unless +@list {
+ return @var;
+ }
+
+ my @results;
+ for @list -> $l {
+ for @var -> $v {
+ # NQP can't handle it automagically. So wrap $l into list.
+ my @l := pir::does__IPS($l, 'array') ?? $l !! list($l);
+ @results.push(list($v, |@l));
+ }
+ }
+
+ @results;
+}
+
+
+method op_params($/) {
+ my $past := PAST::Stmts.new(
+ :node($/)
+ );
+
+ for $<op_param> {
+ $past.push($_.ast);
+ }
+
+ make $past;
+}
+
+method op_param($/) {
+ my $past := PAST::Var.new(
+ :node($/),
+ :isdecl(1)
+ );
+
+ # We have to store 2 "types". Just set 2 properties on Var for now
+ $past<direction> := ~$<op_param_direction>;
+ $past<type> := ~$<op_param_type>;
+
+ make $past;
+}
+
+method op_body($/) {
+ my $past := PAST::Stmts.new(
+ :node($/),
+ );
+ $past<jump> := list();
+ my $prev_words := '';
+ for $<body_word> {
+ if $prev_words && $_<word> {
+ $prev_words := $prev_words ~ ~$_<word>;
+ }
+ elsif $_<word> {
+ $prev_words := ~$_<word>;
+ }
+ else {
+ $past.push(PAST::Op.new(
+ :pasttype('inline'),
+ :inline($prev_words),
+ ));
+ $prev_words := '';
+
+ if $_<macro_param> {
+ $past.push($_<macro_param>.ast);
+ }
+ elsif $_<op_macro> {
+ $past.push($_<op_macro>.ast);
+ for $_<op_macro>.ast<jump> {
+ $past<jump>.push($_);
+ }
+ }
+ }
+ }
+ if $prev_words {
+ $past.push(PAST::Op.new(
+ :pasttype('inline'),
+ :inline($prev_words)
+ ));
+ }
+ make $past;
+}
+
+method macro_param($/) {
+ make PAST::Var.new(
+ :name(~$<num>),
+ :node($/),
+ );
+}
+
+method body_word($/) {
+ #say('# body_word: '~ ~$<word>);
+ my $past;
+ if $<word> {
+ $past := PAST::Op.new(
+ :pasttype('inline'),
+ :inline(~$<word>)
+ );
+ }
+ elsif $<macro_param> {
+ $past := $<macro_param>.ast;
+ }
+ elsif $<op_macro> {
+ $past := $<op_macro>.ast;
+ }
+ else {
+ die('horribly');
+ }
+ #_dumper($past);
+ make $past;
+}
+
+method op_macro($/) {
+ #say('# op_macro');
+ # Generate set of calls to Trans:
+ # goto NEXT() -> goto_offset(opsize())
+ # goto OFFSET($addr) -> goto_offset($addr)
+ # goto ADDRESS($addr) -> goto_address($addr)
+ # expr NEXT() -> expr_offset(opsize())
+ # expr OFFSET($addr) -> expr_offset($addr)
+ # expr ADDRERR($addr) -> expr_address($addr)
+ # restart NEXT() -> restart_offset(opsize()); goto_address(0)
+ # restart OFFSET() -> restart_offset($addr); goto_offset($addr)
+ # XXX In trunk "restart ADDRESS" equivalent of "goto ADDRESS".
+ # restart ADDRESS() -> restart_address($addr); goto_address($addr)
+
+ my $macro_type := ~$<macro_type>;
+ my $macro_dest := ~$<macro_destination>;
+ my $is_next := $macro_dest eq 'NEXT';
+ my $macro_name := $macro_type ~ '_' ~ lc($is_next ?? 'offset' !! $macro_dest);
+
+ my $past := PAST::Stmts.new;
+
+ my $macro := PAST::Op.new(
+ :pasttype('call'),
+ :name($macro_name),
+ );
+ $past.push($macro);
+
+ $past<jump> := list();
+
+ if $macro_type ne 'expr' && $macro_dest eq 'OFFSET' {
+ $past<jump>.push('PARROT_JUMP_RELATIVE');
+ }
+
+ if $macro_type eq 'expr' || $macro_type eq 'goto' {
+ if $is_next {
+ $macro.push(PAST::Op.new(
+ :pasttype<call>,
+ :name<OPSIZE>,
+ ));
+ }
+ else {
+ process_op_macro_body_word($/, $macro);
+ }
+ }
+ elsif $macro_type eq 'restart' {
+ if $is_next {
+ $macro.push(PAST::Op.new(
+ :pasttype<call>,
+ :name<OPSIZE>,
+ ));
+ }
+ else {
+ process_op_macro_body_word($/, $macro);
+ }
+
+ $macro := PAST::Op.new(
+ :pasttype<call>,
+ :name<goto_address>,
+ );
+ if $is_next {
+ $macro.push(PAST::Op.new(
+ :pasttype<inline>,
+ :inline<0>,
+ ));
+ }
+ else {
+ process_op_macro_body_word($/, $macro);
+ }
+ $past.push($macro);
+ }
+ else {
+ pir::die("Horribly");
+ }
+
+ make $past;
+}
+
+sub process_op_macro_body_word($/, $macro) {
+ #_dumper($<body_word>);
+ if $<body_word> {
+ for $<body_word> {
+ #say(' word ' ~ $_);
+ my $bit := $_.ast;
+ $macro.push($_.ast) if defined($bit);
+ }
+ }
+}
+
+# Local Variables:
+# mode: perl6
+# fill-column: 100
+# End:
+# vim: expandtab ft=perl6 shiftwidth=4:
View
147 compilers/opsc/src/Ops/Compiler/Grammar.pm
@@ -0,0 +1,147 @@
+#! nqp
+# Copyright (C) 2009-2010, Parrot Foundation.
+# $Id$
+
+INIT { pir::load_bytecode('HLL.pbc'); }
+
+grammar Ops::Compiler::Grammar is HLL::Grammar;
+
+rule TOP {
+ <body>
+ [ $ || <panic: 'Syntax error'> ]
+ {*}
+}
+
+rule body {
+ [ <preamble> | <op> ]* {*}
+}
+
+token preamble {
+ <begin_preamble>
+ <preamble_guts>
+ <end_preamble> {*}
+}
+
+regex preamble_guts {
+ .*? <?end_preamble>
+}
+
+token begin_preamble {
+ ^^'BEGIN_OPS_PREAMBLE'
+}
+
+token end_preamble {
+ ^^'END_OPS_PREAMBLE'
+}
+
+rule op {
+ <op_type>? 'op' <op_name=identifier> '('
+ [ <op_params>? || <panic: "Fail to parse params"> ]
+ ')' <op_flag>*
+ [ <op_body> || <panic: "Fail to parse op body"> ]
+ {*}
+}
+
+token op_type {
+ [ 'inline' | 'function' ]
+}
+
+rule op_params {
+ <op_param> [ ',' <op_param> ]*
+ {*}
+}
+
+rule op_param {
+ <op_param_direction> <op_param_type>
+ {*}
+}
+
+token op_param_direction {
+ # Order is crucial. PGE doesn't support LTM yet.
+ [
+ | 'inout'
+ | 'inconst'
+ | 'invar'
+ | 'in'
+ | 'out'
+ ]
+}
+
+token op_param_type {
+ # Order is crucial. PGE doesn't support LTM yet.
+ [
+ | 'INTKEY'
+ | 'INT'
+ | 'NUM'
+ | 'STR'
+ | 'PMC'
+ | 'KEY'
+ | 'LABEL'
+ ]
+}
+
+rule op_flag {
+ ':' <identifier>
+}
+
+# OpBody starts with '{' and ends with single '}' on line.
+regex op_body {
+ '{'
+ <body_word>*?
+ ^^ '}'
+}
+
+#Process op body by breaking it into "words" consisting entirely of whitespace,
+#alnums or a single punctuation, then checking for interesting macros (e.g $1
+#or goto NEXT() ) in the midst of the words.
+regex body_word {
+ [
+ | <macro_param>
+ | <op_macro>
+ | $<word>=[<alnum>+|<punct>|<space>+]
+ ]
+ {*}
+}
+
+token macro_param {
+ '$' $<num>=[<digit>+]
+ {*}
+}
+
+regex op_macro {
+ <macro_type> <space>* <macro_destination> <space>* '(' <space>* <body_word>*? ')'
+ {*}
+}
+
+token macro_type {
+ [
+ | 'goto'
+ | 'expr'
+ | 'restart'
+ ]
+}
+
+token macro_destination {
+ [
+ | 'OFFSET'
+ | 'ADDRESS'
+ | 'NEXT'
+ ]
+}
+
+token identifier {
+ <.ident>
+}
+
+# ws handles whitespace, pod and perl and C comments
+token ws {
+ [
+ | \s+
+ | '#' \N*
+ | ^^ '=' .*? \n '=cut'
+ | '/*' .*? '*/'
+ ]*
+}
+
+
+# vim: expandtab shiftwidth=4 ft=perl6:
View
444 compilers/opsc/src/Ops/Emitter.pm
@@ -0,0 +1,444 @@
+#! nqp
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+class Ops::Emitter is Hash;
+
+=begin
+
+Emitter.
+
+=end
+
+method new(:$ops_file!, :$trans!, :$script!, :$file, :%flags!) {
+ self<ops_file> := $ops_file;
+ self<trans> := $trans;
+ self<script> := $script;
+ self<file> := $file;
+ self<flags> := %flags;
+
+ # Preparing various bits.
+ my $suffix := $trans.suffix();
+ my $base := 'core';
+
+ if !%flags<core> {
+ $base := subst( $file, /.ops$$/, '');
+ $base := subst( $base, /.*\//, '');
+ }
+
+ my $base_ops_stub := $base ~ '_ops' ~ $suffix;
+ my $base_ops_h := $base_ops_stub ~ '.h';
+
+ self<base> := $base;
+ self<suffix> := $suffix;
+ self<bs> := $base ~ $suffix ~ '_';
+
+ if %flags<core> {
+ self<include> := "parrot/oplib/$base_ops_h";
+ self<func_header> := (~%flags<dir>) ~ "include/" ~ self<include>;
+ self<enum_header> := (~%flags<dir>) ~ "include/parrot/oplib/ops.h";
+ self<source> := (~%flags<dir>) ~ "src/ops/$base_ops_stub.c";
+ }
+ else {
+ my $dynops_dir := subst( $file, /\w+\.ops$$/, '');
+ self<include> := $base ~ "_ops.h";
+ self<func_header> := $dynops_dir ~ self<include>;
+ self<source> := $dynops_dir ~ $base ~ "_ops.c";
+ }
+
+ self<sym_export> := %flags<core>
+ ?? ''
+ !! 'PARROT_DYNEXT_EXPORT';
+
+ self<init_func> := join('_',
+ 'Parrot', 'DynOp', $base ~ $suffix, |$ops_file.version );
+
+ # Prepare ops
+ $trans.prepare_ops(self, $ops_file);
+
+ self;
+};
+
+method ops_file() { self<ops_file> };
+method trans() { self<trans> };
+method script() { self<script> };
+method file() { self<file> };
+method flags() { self<flags> };
+method sym_export() { self<sym_export> };
+method init_func() { self<init_func> };
+
+method base() { self<base> };
+method suffix() { self<suffix> };
+method bs() { self<bs> };
+
+method print_c_header_files() {
+
+ my $fh := pir::open__PSs(self<func_header>, 'w')
+ || die("Can't open "~ self<func_header>);
+ self.emit_c_op_func_header($fh);
+ $fh.close();
+
+ if self.ops_file<core> {
+ $fh := pir::open__PSs(self<enum_header>, 'w')
+ || die("Can't open "~ self<enum_header>);
+ self.emit_c_op_enum_header($fh);
+ $fh.close();
+ }
+}
+
+method emit_c_op_func_header($fh) {
+
+ self._emit_guard_prefix($fh, self<func_header>);
+
+ self._emit_preamble($fh);
+
+ self._emit_includes($fh);
+
+ # Emit runcore specific part.
+ self.trans.emit_c_op_funcs_header_part($fh);
+
+ self._emit_guard_suffix($fh, self<func_header>);
+
+ self._emit_coda($fh);
+}
+
+method emit_c_op_enum_header($fh) {
+
+ self._emit_guard_prefix($fh, self<enum_header>);
+
+ self._emit_preamble($fh);
+
+ self._emit_c_op_enum_header_part($fh);
+
+ self._emit_guard_suffix($fh, self<enum_header>);
+
+ self._emit_coda($fh);
+}
+
+method print_ops_num_files() {
+
+ my $file := ~self<dir> ~ ~self<ops_file>.oplib.num_file;
+ my $fh := pir::open__pss($file, 'w')
+ || die("Can't open $file for writing: " ~ ~pir::err__s());
+ self.emit_ops_num_file($fh);
+ $fh.close();
+
+ $file := ~self<dir> ~ "include/parrot/opsenum.h";
+ $fh := pir::open__pss($file, 'w')
+ || die("Can't open $file for writing: " ~ ~pir::err__s());
+ self.emit_c_opsenum_header($fh, $file);
+ $fh.close();
+}
+
+method emit_ops_num_file($fh) {
+
+ if !self.exists('max_fixed_op_num') {
+ self._prepare_ops_num();
+ }
+
+ $fh.print( join('', |self<ops_num_start>) );
+ my $max_op_num := self<max_fixed_op_num> + 0; #+ 0 to force cloning
+
+ for self.ops_file.ops -> $op {
+ if self<numbered_ops>.exists( $op.full_name ) {
+
+ $max_op_num++;
+
+ my $space := pir::repeat__SsI(' ',
+ 35 - pir::length__Is($op.full_name) - pir::length__Is(~$max_op_num));
+ $fh.print($op.full_name ~ $space ~ $max_op_num ~ "\n");
+ }
+ }
+
+}
+
+method emit_c_opsenum_header($fh, $file) {
+
+ if !self.exists('max_fixed_op_num') {
+ self._prepare_ops_num();
+ }
+
+ self._emit_guard_prefix($fh, $file);
+
+ self._emit_preamble($fh);
+
+ self.emit_opsenum_h_body($fh);
+
+ self._emit_guard_suffix($fh, $file);
+
+ self._emit_coda($fh);
+}
+
+method emit_opsenum_h_body($fh) {
+
+ $fh.print("enum OPS_ENUM \{\n");
+
+ my $max_op_num := self<max_fixed_op_num> + 0;
+ for self.ops_file.ops -> $op {
+ if self<numbered_ops>.exists( $op.full_name ) {
+ $max_op_num++;
+
+ my $space := pir::repeat__SsI(' ', 30 - pir::length__Is($op.full_name));
+ $fh.print(" enum_ops_" ~ $op.full_name ~ $space ~ "=");
+ $space := pir::repeat__SsI(' ', 5 - pir::length__Is(~$max_op_num));
+ $fh.print($space ~ $max_op_num ~ ",\n");
+ }
+ }
+
+ $fh.print("};\n");
+}
+
+method _prepare_ops_num() {
+
+ #grab all ops in ops.num
+ self<numbered_ops> := hash();
+ my $found_dynamic := 0;
+ self<max_fixed_op_num> := 0;
+ self<ops_num_start> := list();
+
+ #record which ones have fixed numbers and which just need to be somewhere in ops.num
+ for self.ops_file.oplib.num_file_lines -> $line {
+
+ #copy all lines through ###DYNAMIC### into the new ops.num verbatim
+ unless $found_dynamic {
+ self<ops_num_start>.push(~$line);
+ }
+
+ if $line<op> {
+ if $found_dynamic {
+ self<numbered_ops>{ $line<op><name> } := 1;
+ #say("# added '"~$line<op><name> ~" to numered ops");
+ }
+ else {
+ #don't need to keep track of fixed ops
+ self<max_fixed_op_num> := +$line<op><number>;
+ #say("# added '"~$line<op><name> ~" to fixed ops");
+ }
+ }
+ elsif $line<dynamic> {
+ $found_dynamic := 1;
+ }
+ }
+}
+
+method print_c_source_file() {
+ # Build file in memeory
+ my $fh := pir::new__Ps('StringHandle');
+ $fh.open('dummy.c', 'w');
+ self.emit_c_source_file($fh);
+ $fh.close();
+
+ # ... and write it to disk
+ my $final := pir::open__PSs(self<source>, 'w') || die("Can't open filehandle");
+ $final.print($fh.readall());
+ $final.close();
+ return self<source>;
+}
+
+method emit_c_source_file($fh) {
+ self._emit_source_preamble($fh);
+
+ self.trans.emit_source_part(self, $fh);
+
+ self._emit_op_lib_descriptor($fh);
+
+ self.trans.emit_op_lookup(self, $fh);
+
+ self._emit_init_func($fh);
+ self._emit_dymanic_lib_load($fh);
+ self._emit_coda($fh);
+}
+
+method _emit_c_op_enum_header_part($fh) {
+ my $sb := pir::new__Ps('StringBuilder');
+ my $last_op_code := +self.ops_file.ops - 1;
+ for self.ops_file.ops -> $op {
+ $sb.append_format(" PARROT_OP_%0%1 %2 /* %3 */\n",
+ $op.full_name,
+ ($op.code == $last_op_code ?? ' ' !! ','),
+ pir::repeat__SsI(' ', 30 - pir::length__Is($op.full_name)),
+ $op.code);
+ }
+ $fh.print(q|
+typedef enum {
+|);
+ $fh.print(~$sb);
+ $fh.print(q|
+} parrot_opcode_enums;
+|);
+}
+
+method _emit_source_preamble($fh) {
+
+ self._emit_preamble($fh);
+ $fh.print(qq|
+#include "{self<include>}"
+#include "pmc/pmc_parrotlibrary.h"
+#include "pmc/pmc_callcontext.h"
+
+{self.trans.defines(self)}
+
+|);
+
+ $fh.print(self.ops_file.preamble);
+}
+
+method _emit_op_lib_descriptor($fh) {
+
+ my $core_type := self.trans.core_type;
+ $fh.print(q|
+/*
+** op lib descriptor:
+*/
+
+static op_lib_t | ~ self.bs ~ q|op_lib = {| ~ qq|
+ "{self.base}", /* name */
+ "{self.suffix}", /* suffix */
+ $core_type, /* core_type = PARROT_XX_CORE */
+ 0, /* flags */
+ {self.ops_file.version_major}, /* major_version */
+ {self.ops_file.version_minor}, /* minor_version */
+ {self.ops_file.version_patch}, /* patch_version */
+ {+self.ops_file.ops}, /* op_count */
+ {self.trans.op_info(self)}, /* op_info_table */
+ {self.trans.op_func(self)}, /* op_func_table */
+ {self.trans.getop(self)} /* op_code() */ | ~ q|
+};
+|);
+}
+
+method _emit_init_func($fh) {
+
+ my $init1 := self.trans.init_func_init1;
+ my $dispatch := self.trans.init_func_disaptch;
+
+ # TODO There is a bug in NQP about \{
+ $fh.print(q|
+op_lib_t *
+| ~ self.init_func ~ q|(PARROT_INTERP, long init) {
+ /* initialize and return op_lib ptr */
+ if (init == 1) {
+| ~ $init1 ~ q|
+ return &| ~ self.bs ~q|op_lib;
+ }
+ /* set op_lib to the passed ptr (in init) */
+ else if (init) {
+| ~ $dispatch ~ q|
+ }
+ /* deinit - free resources */
+ else {
+ hop_deinit(interp);
+ }
+ return NULL;
+}
+
+|);
+}
+
+method _emit_dymanic_lib_load($fh) {
+
+ if self.flags<core> {
+ return;
+ }
+
+ my $load_func := join('_',
+ q{Parrot}, q{lib}, self.base, q{ops} ~ self.suffix, q{load}, );
+ $fh.print(qq|
+/*
+ * dynamic lib load function - called once
+ */
+{self.sym_export} PMC*
+$load_func(PARROT_INTERP);
+
+{self.sym_export} PMC*
+$load_func(PARROT_INTERP)
+| ~ q|
+{
+ PMC *const lib = Parrot_pmc_new(interp, enum_class_ParrotLibrary);
+ ((Parrot_ParrotLibrary_attributes*)PMC_data(lib))->oplib_init = (void *) | ~ self.init_func ~q|;
+ dynop_register(interp, lib);
+ return lib;
+}
+|);
+}
+
+# given a headerfile name like "include/parrot/oplib/core_ops.h", this
+# returns a string like "PARROT_OPLIB_CORE_OPS_H_GUARD"
+method _generate_guard_macro_name($filename) {
+ $filename := subst($filename, /.h$/, '');
+ #my @path = File::Spec->splitdir($filename);
+ my @path := split('/', $filename);
+ @path.shift if @path[0]~'/' eq self<flags><dir>;
+ @path.shift if @path[0] eq 'include';
+ @path.shift if @path[0] eq 'parrot';
+ uc( join( '_', 'parrot', |@path, 'h', 'guard' ) );
+}
+
+
+method _emit_guard_prefix($fh, $filename) {
+ my $guardname := self._generate_guard_macro_name($filename);
+ $fh.print('
+/* $Id' ~ '$ */
+');
+ $fh.print(qq/
+#ifndef $guardname
+#define $guardname
+
+/);
+}
+
+method _emit_guard_suffix($fh, $filename) {
+ my $guardname := self._generate_guard_macro_name($filename);
+ $fh.print(qq|
+
+#endif /* $guardname */
+|);
+}
+
+
+method _emit_coda($fh) {
+ $fh.print(q|
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * buffer-read-only: t
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
+|);
+}
+
+method _emit_includes($fh) {
+
+ $fh.print(qq|
+#include "parrot/parrot.h"
+#include "parrot/oplib.h"
+#include "parrot/runcore_api.h"
+
+{self.sym_export} op_lib_t *{self.init_func}(PARROT_INTERP, long init);
+
+|);
+}
+
+method _emit_preamble($fh) {
+
+ $fh.print(qq|
+/* ex: set ro:
+ * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+ *
+ * This file is generated automatically from '{self<file>}' (and possibly other
+ * .ops files). by {self<script>}.
+ *
+ * Any changes made here will be lost!
+ *
+ */
+|);
+
+ if !self.flags<core> {
+ $fh.print("#define PARROT_IN_EXTENSION\n");
+ }
+
+}
+
+# vim: expandtab shiftwidth=4 ft=perl6:
View
331 compilers/opsc/src/Ops/File.pm
@@ -0,0 +1,331 @@
+#! nqp
+# Copyright (C) 2001-2009, Parrot Foundation.
+# $Id$
+
+# XXX Better to put this into docs/ somewhere.
+
+=begin
+
+=head1 NAME
+
+Ops::File - Ops To C Code Generation
+
+=head1 SYNOPSIS
+
+ use Ops::File;
+
+=head1 DESCRIPTION
+
+C<Ops::File> takes one or more files of op functions and
+creates real C code for them.
+
+This class is used by F<tools/build/ops2c.pl>,
+F<tools/build/ops2pm.pl> and F<tools/build/pbc2c.pl>.
+
+=head2 Op Functions
+
+For ops that have trivial bodies (such as just a call to some other
+function and a C<return> statement), opcode functions are in the format:
+
+ inline op opname (args) :flags {
+ ... body of function ...
+ }
+
+Note that currently the C<inline> op type is ignored.
+
+Alternately, for opcode functions that have more internal complexity the
+format is:
+
+ op opname (args) :flags {
+ ... body of function ...
+ }
+
+There may be more than one C<return>.
+
+In both cases the closing brace B<must> be on its own line.
+
+When specifying multiple flags, each flag gets its own prefixing colon.
+
+=head2 Op Arguments
+
+Op arguments are a comma-separated list of direction and type pairs.
+
+Argument direction is one of:
+
+ in the argument passes a value into the op
+ out the argument passes a value out of the op
+ inout the argument passes a value into and out of the op
+ inconst the argument passes a constant value into the op
+ invar the argument passes a variable value into the op
+
+Argument direction is used to determine the life times of symbols and
+their related register allocations. When an argument is passed into an
+op a register is read from, when it's passed out of an op a register is
+written to.
+
+Argument type is one of:
+
+ INT the argument is an integer
+ NUM the argument is an numeric
+ STR the argument is an string
+ PMC the argument is an PMC
+ KEY the argument is an aggregate PMC key
+ INTKEY the argument is an aggregate PMC integer key
+ LABEL the argument is an integer branch offset or address
+
+The size of the return offset is determined from the op function's
+signature.
+
+=head2 Op Flags
+
+The flags are of two types:
+
+=over 4
+
+=item 1 class
+
+The classification of ops is intended to facilitate the selection of
+suitable ops for a Parrot safe mode.
+
+=item 2 behavior
+
+The presence (or absence) of certain flags will change how the op behaves. For
+example, the lack of the C<flow> flag will cause the op to be implicitly
+terminated with C<goto NEXT()>. (See next section).
+
+The :deprecated flag will generate a diagnostic to standard error at
+runtime when a deprecated opcode is invoked and
+C<PARROT_WARNINGS_DEPRECATED_FLAG> has been set.
+
+=back
+
+=head2 Op Body (Macro Substitutions)
+
+In the following macro descriptions, C<PC> and C<PC'> are the current
+and next position within the Parrot code.
+
+=over 4
+
+=item C<goto OFFSET(X)>
+
+Transforms to C<PC' = PC + X>. This is used for branches.
+
+=item C<goto NEXT()>
+
+Transforms to C<PC' = PC + S>, where C<S> is the size of an op.
+
+=item C<goto ADDRESS(X)>
+
+Transforms to C<PC' = X>. This is used for absolute jumps.
+
+=item C<expr OFFSET(X)>
+
+Transforms to C<PC + X>. This is used to give a relative address.
+
+=item C<expr NEXT()>
+
+Transforms to C<PC + S>, the position of the next op.
+
+=item C<expr ADDRESS(X)>
+
+Transforms to C<X>, an absolute address.
+
+=item C<OP_SIZE>
+
+Transforms to C<S>, the size of an op.
+
+=item C<HALT()>
+
+Transforms to C<PC' = 0>. Halts run loop, and resets the current
+position to the start of the Parrot code, without resuming.
+
+=item C<restart OFFSET(X)>
+
+Transforms to C<PC' = 0> and restarts at C<PC + X>.
+
+=item C<restart NEXT()>
+
+Transforms to C<PC' = 0> and restarts at C<PC + S>.
+
+=item C<$n>
+
+Transforms to the op function's nth argument. C<$0> is the opcode itself.
+
+=back
+
+Note that, for ease of parsing, if the argument to one of the above
+notations in a ops file contains parentheses, then double the enclosing
+parentheses and add a space around the argument, like so:
+
+ goto OFFSET(( (void*)interp->happy_place ))
+
+=head2 Class Methods
+
+=over 4
+
+=end
+
+class Ops::File is Hash;
+
+pir::load_bytecode('config.pbc');
+
+=begin
+
+=item C<new(@files)>
+
+Returns a new instance initialized by calling C<read_ops()> on each of
+the specified op files.
+
+=item C<new_str($str)>
+
+Returns a new instance initialized by compiling C<$str> as the contents of an
+ops file.
+
+=end
+
+method new(*@files, :$oplib, :$core!, :$nolines) {
+ self<files> := @files;
+ self<core> := $core;
+ self<ops> := list(); # Ops
+ self<preamble>:= '';
+ self<compiler>:= pir::compreg__Ps('Ops');
+ self<op_order>:= 0;
+ self<renum> := Ops::Renumberer.new( :ops_file(self) );
+
+ if $core {
+ self<oplib> := $oplib;
+ self<compiler>.set_oplib($oplib);
+ }
+ else {
+ self<file> := @files[0];
+ }
+
+ self._set_version();
+
+ for @files { self.read_ops( $_, $nolines ) }
+
+ self._calculate_op_codes();
+
+ self;
+}
+
+method new_str($str, :$oplib) {
+ self<ops> := list(); # Ops
+ self<preamble> := '';
+
+ self<compiler> := pir::compreg__Ps('Ops');
+ self<oplib> := $oplib;
+ self<compiler>.set_oplib($oplib);
+
+ self._set_version();
+
+ self._set_version();
+
+ self.compile_ops($str);
+
+ self;
+}
+
+
+=begin
+
+=back
+
+=head2 Instance Methods
+
+=over 4
+
+=item C<read_ops($file,$nolines)>
+
+Reads in the specified .ops file, gathering information about the ops.
+
+=end
+
+method read_ops($file, $nolines) {
+ $Ops::Compiler::Actions::OPLIB := self<oplib>;
+
+ say("# Parsing $file...");
+ my $start_time := pir::time__N();
+ my $buffer := slurp($file);
+ self.compile_ops($buffer, :experimental( $file ~~ /experimental\.ops/));
+ pir::sprintf(my $time, "%.3f", [pir::time__N() - $start_time] );
+ say("# Parsed $file in $time seconds.");
+}
+
+method compile_ops($str, :$experimental? = 0) {
+ my $compiler := self<compiler>;
+ my $past := $compiler.compile($str, :target('past'));
+
+ for @($past<ops>) {
+ $_<experimental> := $experimental;
+ self<ops>.push($_);
+ #say($_.full_name ~ " is number " ~ self<op_order>);
+ self<op_order>++;
+ }
+
+ for @( $past<preamble> ) {
+ self<preamble> := self<preamble> ~ $_;
+ }
+ $past;
+}
+
+method get_parse_tree($str) {
+ my $compiler := pir::compreg__Ps('Ops');
+ $compiler.compile($str, :target('parse'));
+}
+
+method preamble() { self<preamble> };
+method ops() { self<ops> };
+method oplib() { self<oplib> };
+method version() { self<version>; }
+
+method version_major() { self<version_major> }
+method version_minor() { self<version_minor> }
+method version_patch() { self<version_patch> }
+
+method _calculate_op_codes() {
+
+ my $code := self<oplib> ??
+ self<oplib>.max_op_num + 1 !!
+ 0;
+
+ for self<ops> -> $op {
+ #ops listed in ops.num are non-experimental
+ if self<oplib> {
+ my $full_name := $op.full_name;
+ if self<oplib>.op_num_table.exists($full_name) {
+ $op<code> := self<oplib>.op_num_table{$full_name};
+ }
+ elsif !$op<experimental> && !self<oplib>.op_skip_table.exists($full_name) {
+ die("Non-experimental op " ~ $op.full_name ~ " is not in ops.num.");
+ }
+ #ops not explicitly listed but not skipped are experimental
+ else {
+ $op<code> := $code++;
+ say("# Experimental op " ~ $op.full_name ~ " is not in ops.num.");
+ }
+ }
+ #if there's no oplib, we're compiling dynops and ops aren't experimental
+ else {
+ $op<code> := $code++;
+ }
+ }
+}
+
+method _set_version() {
+ my $config := _config();
+ my $version := $config<VERSION>;
+ #say("# $version");
+ my @bits := split('.', $version);
+ self<version_major> := @bits[0];
+ self<version_minor> := @bits[1];
+ self<version_patch> := @bits[2];
+ self<version> := @bits;
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: ft=perl6 expandtab shiftwidth=4:
View
392 compilers/opsc/src/Ops/Op.pm
@@ -0,0 +1,392 @@
+#! nqp
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=begin
+
+=head1 NAME
+
+Ops::Op - Parrot Operation
+
+=head1 SYNOPSIS
+
+ use Ops::Op;
+
+=head1 DESCRIPTION
+
+C<Ops::Op> represents a Parrot operation (op, for short), as read
+from an ops file via C<Ops::OpsFile>, or perhaps even generated by
+some other means. It is the Perl equivalent of the C<op_info_t> C
+C<struct> defined in F<include/parrot/op.h>.
+
+=head2 Op Type
+
+Ops are either I<auto> or I<manual>. Manual ops are responsible for
+having explicit next-op C<RETURN()> statements, while auto ops can count
+on an automatically generated next-op to be appended to the op body.
+
+Note that F<tools/build/ops2c.pl> supplies either 'inline' or 'function'
+as the op's type, depending on whether the C<inline> keyword is present
+in the op definition. This has the effect of causing all ops to be
+considered manual.
+
+=head2 Op Arguments
+
+Note that argument 0 is considered to be the op itself, with arguments
+1..9 being the arguments passed to the op.
+
+Op argument direction and type are represented by short one or two letter
+descriptors.
+
+Op Direction:
+
+ i The argument is incoming
+ o The argument is outgoing
+ io The argument is both incoming and outgoing
+
+Op Type:
+
+ i The argument is an integer register index.
+ n The argument is a number register index.
+ p The argument is a PMC register index.
+ s The argument is a string register index.
+ ic The argument is an integer constant (in-line).
+ nc The argument is a number constant index.
+ pc The argument is a PMC constant index.
+ sc The argument is a string constant index.
+ kc The argument is a key constant index.
+ ki The argument is a key integer register index.
+ kic The argument is a key integer constant (in-line).
+
+=head2 Class Methods
+
+=over 4
+
+=end
+
+class Ops::Op is PAST::Block;
+
+INIT {
+ pir::load_bytecode("dumper.pbc");
+}
+
+=begin
+
+=item C<new(:$code, :$type, :$name, :@args, :%flags)>
+
+Allocates a new bodyless op. A body must be provided eventually for the
+op to be usable.
+
+C<$code> is the integer identifier for the op.
+
+C<$type> is the type of op (see the note on op types above).
+
+C<$name> is the name of the op.
+
+C<@args> is a reference to an array of argument type descriptors.
+
+C<$flags> is a hash reference containing zero or more I<hints> or
+I<directives>.
+
+
+=back
+
+=head2 Instance Methods
+
+=over 4
+
+=item C<code()>
+
+Returns the op code.
+
+=item C<type()>
+
+The type of the op, either 'inline' or 'function'.
+
+=item C<name()>
+
+The (short or root) name of the op.
+
+=item C<full_name()>
+
+For argumentless ops, it's the same as C<name()>. For ops with
+arguments, an underscore followed by underscore-separated argument types
+are appended to the name.
+
+=item C<func_name()>
+
+The same as C<full_name()>, but with 'C<Parrot_>' prefixed.
+
+=end
+
+method code($code?) { self.attr('code', $code, defined($code)) }
+
+method type($type?) { self.attr('type', $type, defined($type)) }
+
+method name($name?) { self.attr('name', $name, defined($name)) }
+
+method args($args?) { self.attr('args', $args, defined($args)) }
+
+method arg_types($args?) {
+ my $res := self.attr('arg_types', $args, defined($args));
+
+ return list() if !defined($res);
+ pir::does__IPS($res, 'array') ?? $res !! list($res);
+}
+
+method arg_dirs($args?) { self.attr('arg_dirs', $args, defined($args)) }
+
+method arg_type($arg_num) {
+ my @arg_types := self.arg_types;
+ @arg_types[$arg_num];
+}
+
+method full_name() {
+ my $name := self.name;
+ my @arg_types := self.arg_types;
+
+ #say("# $name arg_types " ~ @arg_types);
+ join('_', $name, |@arg_types);
+}
+
+method func_name($trans) {
+ return $trans.prefix ~ self.full_name;
+}
+
+
+=begin
+
+=item C<flags()>
+
+Sets the op's flags. This returns a hash reference, whose keys are any
+flags (passed as ":flag") specified for the op.
+
+=end
+
+method flags(%flags?) { self.attr('flags', %flags, defined(%flags)) }
+
+=begin
+
+=item C<body($body)>
+
+=item C<body()>
+
+Sets/gets the op's code body.
+
+=end
+
+method body() {
+ my $res := '';
+ for @(self) -> $part {
+ $res := $res ~ $part<inline>;
+ }
+ $res;
+}
+
+=begin
+
+=item C<jump($jump)>
+
+=item C<jump()>
+
+Sets/gets a string containing one or more C<op_jump_t> values joined with
+C<|> (see F<include/parrot/op.h>). This indicates if and how an op
+may jump.
+
+=end
+
+method jump($jump?) { self.attr('jump', $jump, defined($jump)) }
+
+=begin
+
+=item C<add_jump($jump)>
+
+=item C<add_jump($jump)>
+
+Add a jump flag to this op if it's not there already.
+
+=end
+
+method add_jump($jump) {
+ my $found_jump := 0;
+
+ unless self.jump { self.jump(list()) }
+
+ for self.jump {
+ if $_ eq $jump { $found_jump := 1 }
+ }
+
+ unless $found_jump {
+ self.jump.push($jump);
+ }
+}
+
+=begin
+
+=item C<get_jump()>
+
+=item C<get_jump()>
+
+Get the jump flags that apply to this op.
+
+=end
+
+method get_jump() {
+
+ if self.jump {
+ return join( '|', |self.jump );
+ }
+ else {
+ return '0';
+ }
+}
+
+=begin
+
+=item C<source($trans, $op)>
+
+Returns the L<C<body()>> of the op with substitutions made by
+C<$trans> (a subclass of C<Ops::Trans>).
+
+=end
+
+method source( $trans ) {
+
+ my $prelude := $trans.body_prelude;
+ return $prelude ~ self.get_body( $trans );
+}
+
+=begin
+
+=item C<get_body($trans)>
+
+Performs the various macro substitutions using the specified transform,
+correctly handling nested substitions, and repeating over the whole string
+until no more substitutions can be made.
+
+C<VTABLE_> macros are enforced by converting C<<< I<< x >>->vtable->I<<
+method >> >>> to C<VTABLE_I<method>>.
+
+=end
+
+method get_body( $trans ) {
+
+ my @body := list();
+
+ #work through the op_body tree
+ for @(self) {
+ my $chunk := self.process_body_chunk($trans, $_);
+ #pir::say('# chunk ' ~ $chunk);
+ @body.push($chunk);
+ }
+
+ join('', |@body);
+}
+
+# Recursively process body chunks returning string.
+# Ideally bunch of multisubs, but...
+method process_body_chunk($trans, $chunk) {
+ my $what := $chunk.WHAT;
+ # Poor man multis...
+ if $what eq 'PAST::Var()' {
+ my $n := +$chunk.name;
+ return $trans.access_arg( self.arg_type($n - 1), $n);
+ }
+ elsif $what eq 'PAST::Op()' {
+ my $type := $chunk.pasttype;
+ #say('OP ' ~ $type);
+ if $type eq 'inline' {
+ #_dumper($chunk);
+ #pir::say('RET ' ~ $chunk<inline>);
+ return $chunk.inline;
+ }
+ elsif $type eq 'call' {
+ my $name := $chunk.name;
+ #say('NAME '~$name ~ ' ' ~ $is_next);
+ if $name eq 'OPSIZE' {
+ #say('is_next');
+ return ~self.size;
+ }
+
+ my @children := list();
+ for @($chunk) {
+ @children.push(self.process_body_chunk($trans, $_));
+ }
+ my $children := join('', |@children);
+
+ #pir::say('children ' ~ $children);
+ my $ret := Q:PIR<
+ $P0 = find_lex '$trans'
+ $P1 = find_lex '$name'
+ $S0 = $P1
+ $P1 = find_lex '$children'
+ %r = $P0.$S0($P1)
+ >;
+ #pir::say('RET ' ~ $ret);
+ return $ret;
+ }
+ }
+ elsif $what eq 'PAST::Stmts()' {
+ my @children := list();
+ for @($chunk) {
+ @children.push(self.process_body_chunk($trans, $_));
+ }
+ my $children := join('', |@children);
+ return $children;
+ }
+ else {
+ pir::die('HOLEY');
+ }
+}
+
+
+=begin
+
+=item C<size()>
+
+Returns the op's number of arguments. Note that this also includes
+the op itself as one argument.
+
+=end
+
+method size() {
+ return pir::does__IPs(self.arg_types, 'array') ?? +self.arg_types + 1 !! 2;
+}
+
+=begin
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item C<Ops::OpsFile>
+
+=item C<Ops::OpTrans>
+
+=item F<tools/build/ops2c.pl>
+
+=item F<tools/build/ops2pm.pl>
+
+=item F<tools/build/pbc2c.pl>
+
+=back
+
+=head1 HISTORY
+
+Author: Gregor N. Purdy E<lt>gregor@focusresearch.comE<gt>
+
+Migrate to NQP: Vasily Chekalkin E<lt>bacek@bacek.comE<gt>
+
+=end
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: ft=perl6 expandtab shiftwidth=4:
+
View
234 compilers/opsc/src/Ops/OpLib.pm
@@ -0,0 +1,234 @@
+#! nqp
+# Copyright (C) 2009-2010, Parrot Foundation.
+# $Id$
+
+INIT {
+ pir::load_bytecode("dumper.pbc");
+};
+
+class Ops::OpLib is Hash;
+
+=begin NAME
+
+C<Ops::OpLib> - library of Parrot Operations.
+
+=end NAME
+
+=begin DESCRIPTION
+
+Responsible for loading F<src/ops/ops.num> and F<src/ops/ops.skip> files,
+parse F<.ops> files, sort them, etc.
+
+Heavily inspired by Perl5 Parrot::Ops2pm.
+
+=end DESCRIPTION
+
+=begin SYNOPSIS
+
+ my $oplib := Ops::OpLib.new(
+ :num_file('../../src/ops/ops.num'),
+ :skip_file('../../src/ops/ops.skip'),
+ ));
+
+=end SYNOPSIS
+
+=begin ATTRIBUTES
+
+=over 4
+
+=item * C<$.max_op_num>
+
+Scalar holding number of highest non-experimental op. Example:
+
+ 'max_op_num' => 1246,
+
+=item * C<%.op_num_table>
+
+Hash holding mapping of opcode names ops to their numbers.
+Example:
+
+ 'op_num_table' => {
+ 'pow_p_p_i' => 650,
+ 'say_s' => 463,
+ 'lsr_p_p_i' => 207,
+ 'lt_s_sc_ic' => 289,
+ # ...
+ 'debug_init' => 429,
+ 'iseq_i_nc_n' => 397,
+ 'eq_addr_sc_s_ic' => 254
+ },
+
+Per F<src/ops/ops.num>, this mapping exists so that we can nail down
+the op numbers for the core opcodes in a particular version of the
+bytecode and provide backward-compatibility for bytecode.
+
+=item * C<%.op_skip_table>
+
+Reference to a 'seen-hash' of skipped opcodes.
+
+ 'op_skip_table' => {
+ 'bor_i_ic_ic' => 1,
+ 'xor_i_ic_ic' => 1,
+ 'tanh_n_nc' => 1,
+ # ...
+ },
+
+As F<src/ops/ops.skip> states, these are "... opcodes that could be listed in
+F<[src/ops/]ops.num> but aren't ever to be generated or implemented because
+they are useless and/or silly."
+
+=back
+
+=end ATTRIBUTES
+
+=begin METHODS
+
+=over 4
+
+=item C<new>
+
+Build OpLib.
+
+(It's NQP. In Perl 6 it should be submethod and invoked automatically)
+
+=end METHODS
+
+method new(:$num_file, :$skip_file) {
+ self<num_file> := $num_file // './src/ops/ops.num';
+ self<skip_file> := $skip_file // './src/ops/ops.skip';
+
+ # Initialize self.
+ self<max_op_num> := 0;
+ self<op_num_table> := hash();
+ self<op_skip_table> := hash();
+ self<num_file_lines>:= list();
+ self<ops_past> := list();
+ self<regen_ops_num> := 0;
+
+ self.load_op_map_files();
+
+ self;
+}
+
+=begin METHODS
+
+=item C<load_op_map_files>
+
+Load ops.num and ops.skip files.
+
+=end METHODS
+
+method load_op_map_files() {
+ self._load_num_file;
+ self._load_skip_file;
+}
+
+my method _load_num_file() {
+ # slurp isn't very efficient. But extending NQP beyond bare minimum is not in scope.
+ my $buf := slurp(self<num_file>);
+ grammar NUM {
+ rule TOP { <line>+ }
+
+ rule line {
+ [
+ | <op>
+ | <dynamic>
+ | <comment>
+ ]
+ }
+ rule op { $<name>=(\w+) $<number>=(\d+) }
+ rule dynamic { '###DYNAMIC###' \N* }
+ rule comment { '#' \N* }
+ }
+
+ #say("Parsing NUM");
+ my $ops := NUM.parse($buf);
+ #_dumper($ops);
+ #pir::exit(0);
+
+ my $prev := -1;
+ for $ops<line> {
+ self<num_file_lines>.push($_);
+ if $_<op> {
+ my $name := ~$_<op><name>;
+ my $number := +$_<op><number>;
+ if (+$number) eq $number {
+ if ($prev + 1 != $number) {
+ self<regen_ops_num> := 1;
+ say("# hole in ops.num before #$number: will regenerate ops.num");
+ }
+ if self<op_num_table>.exists($name) {
+ self<regen_ops_num> := 1;
+ say("# duplicate opcode $name and $number: will regenerate ops.num");
+ }
+
+ $prev := $number;
+ self<op_num_table>{$name} := $number;
+ if ( $number > self<max_op_num> ) {
+ self<max_op_num> := $number;
+ }
+ }
+ }
+ }
+
+ #_dumper(self<op_num_table>);
+}
+
+method _load_skip_file() {
+ my $buf := slurp(self<skip_file>);
+ grammar SKIP {
+ rule TOP { <op>+ }
+
+ rule op { $<name>=(\w+) }
+ token ws {
+ [
+ | \s+
+ | '#' \N*
+ ]*
+ }
+ }
+
+ my $lines := SKIP.parse($buf);
+
+ for $lines<op> {
+ if self<op_num_table> && self<op_num_table>.exists($_<name>) {