Author: fperrad
Date: Thu May 8 10:05:14 2008
New Revision: 27393
Added:
trunk/languages/lua/luac2pir.pir (contents, props changed)
Modified:
trunk/MANIFEST
trunk/languages/lua/src/build/translator.pl
trunk/languages/lua/src/lib/luabytecode.pir
trunk/languages/lua/src/lib/luabytecode.rules
Log:
[Lua]
- skeleton of a bytecode translator
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Thu May 8 10:05:14 2008
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Wed May 7 07:35:21 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Thu May 8 17:01:54 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -1579,6 +1579,7 @@
languages/lua/doc/status.pod [lua]
languages/lua/lua.pir [lua]
languages/lua/luac.pl [lua]
+languages/lua/luac2pir.pir [lua]
languages/lua/luad.pir [lua]
languages/lua/luap.pir [lua]
languages/lua/src/PASTGrammar.tg [lua]
Added: trunk/languages/lua/luac2pir.pir
==============================================================================
--- (empty file)
+++ trunk/languages/lua/luac2pir.pir Thu May 8 10:05:14 2008
@@ -0,0 +1,109 @@
+# Copyright (C) 2008, The Perl Foundation.
+# $Id$
+
+=head1 NAME
+
+luac2pir - Lua 5.1 VM bytecode to Parrot PIR Translator
+
+=head1 SYNOPSYS
+
+ parrot luac2pir.pir file.luac
+
+=head1 DESCRIPTION
+
+B<luac2pir> translates a Lua 5.1 VM bytecode file to Parrot PIR.
+
+=head1 SEE ALSO
+
+luad
+
+=head1 AUTHOR
+
+Francois Perrad.
+
+=cut
+
+.HLL '', 'lua_group'
+
+.sub 'main' :main
+ .param pmc argv
+ .local int argc
+ .local string progname
+ .local string filename
+ .local string content
+ argc = elements argv
+ if argc != 2 goto USAGE
+ progname = shift argv
+ filename = shift argv
+ content = load_file(filename)
+ unless content goto L1
+ .local pmc script
+# push_eh _handler
+ new $P0, 'LuaBytecode'
+ script = $P0.'undump'(content)
+ .local string gen_pir
+ gen_pir = script.translate()
+ save_pir(gen_pir, filename)
+ print gen_pir
+ end
+ _handler:
+ .local pmc e
+ .local string msg
+ .get_results (e, msg)
+ print msg
+ print "\n"
+ L1:
+ end
+ USAGE:
+ printerr "Usage: parrot luad.pir filename\n"
+ exit -1
+.end
+
+.sub 'load_file' :anon
+ .param string filename
+ .local pmc pio
+ .local string content
+ pio = getclass 'ParrotIO'
+ push_eh _handler
+ content = pio.'slurp'(filename)
+ if content goto L1
+ $S0 = err
+ print "Can't slurp '"
+ print filename
+ print "' ("
+ print $S0
+ print ")\n"
+ L1:
+ _handler:
+ .return (content)
+.end
+
+.sub 'save_pir' :anon
+ .param string gen_pir
+ .param string filename
+ .local string output
+ .local pmc fh
+ output = concat filename, '.pir'
+ fh = open output, '>'
+ if fh goto L1
+ $S0 = err
+ print "Can't open '"
+ print output
+ print "' ("
+ print $S0
+ print ")\n"
+ goto L2
+ L1:
+ print fh, gen_pir
+ close fh
+ L2:
+.end
+
+.include 'languages/lua/src/lib/luabytecode.pir'
+
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Modified: trunk/languages/lua/src/build/translator.pl
==============================================================================
--- trunk/languages/lua/src/build/translator.pl (original)
+++ trunk/languages/lua/src/build/translator.pl Thu May 8 10:05:14 2008
@@ -42,6 +42,19 @@
$pir .= generate_final_dump( $srm, $metavars );
+$pir .= generate_initial_code( $srm, [EMAIL PROTECTED], $metavars );
+
+# Emit translation dispatch table.
+$pir .= generate_dispatch_table( $srm, [EMAIL PROTECTED], $metavars );
+
+# Generate instruction translation code from rules.
+foreach (@rules) {
+ $pir .= generate_rule_code( $srm, $_, $metavars );
+}
+
+# Generate final translator code.
+$pir .= generate_final_code( $srm, $metavars );
+
# Finally, write generated PIR to output file.
open my $fh, '>', $output_file
or die "Unable to open $output_file: $!\n";
@@ -199,6 +212,10 @@
unless ( exists $rule->{format} ) {
die "Mandatory entry format missing in rule $name\n";
}
+ unless ( exists $rule->{pir} ) {
+ die "Mandatory entry pir missing in rule $name\n";
+ }
+
return;
}
@@ -213,6 +230,56 @@
PIRCODE
}
+# Generate the translator initialization code.
+# ############################################
+sub generate_initial_code {
+ my ( $srm, $rules, $mv ) = @_;
+
+ # Set up some more metavariables.
+ $mv->{INS} = 'gen_pir';
+ $mv->{PC} = 'pc';
+ $mv->{NEXTPC} = 'next_pc';
+
+ # Emit the dumper.
+ my $pir = <<'PIRCODE';
+.sub 'translate' :method
+ .param pmc func
+ .local string gen_pir
+ .local int pc, next_pc, bc_length, cur_ic, cur_op
+ .local int arg_a
+ .local int arg_b
+ .local int arg_c
+
+ bc_length = self
+ next_pc = 0
+
+PIRCODE
+
+ $pir .= <<'PIRCODE';
+ gen_pir = concat "\n# BEGIN OF TRANSLATED BYTECODE\n\n"
+
+ LOOP:
+ pc = next_pc
+ if pc >= bc_length goto COMPLETE
+ cur_ic = self[pc]
+ next_pc += 1
+ cur_op = cur_ic & 0x003f
+
+PIRCODE
+
+ # Emit label generation code.
+ $pir .= <<'PIRCODE';
+ $S0 = pc
+ gen_pir = concat "PC"
+ gen_pir = concat $S0
+ gen_pir = concat ": \n"
+
+PIRCODE
+
+ # Return generated code.
+ return $pir;
+}
+
# Generate the dumper initialization code.
# ########################################
sub generate_initial_dump {
@@ -339,6 +406,67 @@
return $pir;
}
+# Generate translation code relating to a rule.
+# #############################################
+sub generate_rule_code {
+ my ( $srm, $rule, $mv ) = @_;
+
+ # Emit dispatch label.
+ my $pir = <<"PIRCODE";
+ BDISPATCH_$rule->{name}:
+ # Translation code for $rule->{name} ($rule->{code})
+ gen_pir = concat " # $rule->{name}\\n"
+PIRCODE
+
+ # Emit code to read arguments for the op.
+ if ($rule->{format} =~ /^A/) {
+ $pir .= " arg_a = cur_ic >> 6\n";
+ $pir .= " arg_a &= 0x00ff\n";
+ }
+
+ if ($rule->{format} =~ /sBx$/) {
+ $pir .= " arg_b = cur_ic >>> 14\n";
+ $pir .= " arg_b -= 131071\n";
+ }
+ elsif ($rule->{format} =~ /Bx$/) {
+ $pir .= " arg_b = cur_ic >>> 14\n";
+ }
+ elsif ($rule->{format} =~ /B/) {
+ $pir .= " arg_b = cur_ic >> 23\n";
+ $pir .= " arg_b &= 0x01ff\n";
+ }
+
+ if ($rule->{format} =~ /C$/) {
+ $pir .= " arg_c = cur_ic >> 14\n";
+ $pir .= " arg_c &= 0x01ff\n";
+ }
+
+ $pir .= translation_code( $rule, $mv );
+
+ # Finally, emit code to go to translate next instruction.
+ $pir .= " goto LOOP\n\n";
+
+ # Return generated code.
+ return $pir;
+}
+
+sub translation_code {
+ my ( $rule, $mv ) = @_;
+
+ # If we have PIR for the instruction, just take that. If not, we need
+ # to generate it from the "to generate" instruction directive.
+ my $pir = "### translation\n";
+ if ( $rule->{pir} ) {
+ $pir .= sub_meta( $rule->{pir}, $mv, "pir for rule $rule->{name}" );
+ }
+ else {
+ $pir .= "# TODO\n";
+ }
+ $pir .= "### end translation\n";
+
+ return $pir;
+}
+
# Generate dump code relating to a rule.
# #############################################
sub generate_rule_dump {
@@ -420,6 +548,68 @@
return $pir;
}
+# Generate the translator trailer code.
+# #####################################
+sub generate_final_code {
+ my ( $srm, $mv ) = @_;
+
+ # Emit complete label.
+ # Emit label generation code.
+ my $pir = <<'PIRCODE';
+ COMPLETE:
+
+ $S0 = pc
+ gen_pir = concat "PC"
+ gen_pir = concat $S0
+ gen_pir = concat ": \n"
+
+ gen_pir = concat "\n# END OF TRANSLATED BYTECODE\n\n"
+
+PIRCODE
+
+ # Emit the end of the translator PIR.
+ $pir .= <<'PIRCODE';
+ .return (gen_pir)
+.end
+
+PIRCODE
+
+ # Return generated code.
+ return $pir;
+}
+
+# Substiture meta variables.
+# ##########################
+sub sub_meta {
+ my ( $pir, $mv, $code_source ) = @_;
+ $code_source ||= "(unknown)";
+
+ # Substiture in known meta-variables.
+ for ( keys %$mv ) {
+ $pir =~ s/\${$_}/$mv->{$_}/g;
+ }
+
+ # We need to automagically instantiate [INSP]_ARG_\d+ and [INSP]TEMP\d+.
+ while ( $pir =~ /\$\{([INS])TEMP(\d+)\}/g ) {
+ my $key = $1 . 'TEMP' . $2;
+ my $value = '$' . $1 . $2;
+ $pir =~ s/\$\{$key\}/$value/g;
+ }
+ while ( $pir =~ /\$\{PTEMP(\d+)\}/g ) {
+ my $key = 'PTEMP' . $1;
+ my $value = 'P_temp_' . $1;
+ $mv->{$key} = $value;
+ $pir =~ s/\$\{$key\}/$value/g;
+ }
+
+ # If we have any unsubstituted variables, error.
+ if ( $pir =~ /\$\{([^}]*)}/ ) {
+ warn "Unknown metavariable $1 used in $code_source\n";
+ }
+
+ return $pir;
+}
+
# Usage message.
# ##############
sub usage {
Modified: trunk/languages/lua/src/lib/luabytecode.pir
==============================================================================
--- trunk/languages/lua/src/lib/luabytecode.pir (original)
+++ trunk/languages/lua/src/lib/luabytecode.pir Thu May 8 10:05:14 2008
@@ -62,6 +62,38 @@
$P0.'brief'(0, 1)
.end
+.sub 'translate' :method
+ .local string pir
+ pir = <<'PIRCODE'
+.include 'interpinfo.pasm'
+.HLL 'Lua', 'lua_group'
+
+.namespace
+.sub '&start' :anon :main
+ .param pmc args :optional
+# print "start\n"
+ load_bytecode 'languages/lua/lua.pbc'
+ lua_openlibs()
+ .local pmc env
+ env = get_hll_global '_G'
+ .local pmc vararg
+ vararg = argstolua(env, args)
+ .const .Sub main = '&function_0'
+ main.'setfenv'(env)
+ ($I0, $P0) = docall(main, vararg :flat)
+ unless $I0 goto L1
+ printerr 'luac2pir: '
+ printerr $P0
+ L1:
+.end
+
+PIRCODE
+ $P0 = getattribute self, 'top'
+ $S0 = $P0.'translate'('&function_0', '&start')
+ pir .= $S0
+ .return (pir)
+.end
+
.namespace ['Lua::Function']
@@ -115,6 +147,56 @@
print "; end of function\n\n"
.end
+.sub 'translate' :method
+ .param string funcname
+ .param string outer
+ .local string pir
+ pir = ".sub '" . funcname
+ pir .= "' :anon :lex :outer('"
+ pir .= outer
+ pir .= "')\n"
+ .local int numparams
+ $P0 = getattribute self, 'numparams'
+ numparams = $P0
+ .local int i
+ i = 0
+ L1:
+ unless i < numparams goto L2
+ $S0 = i
+ pir .= " .param pmc arg_"
+ pir .= $S0
+ pir .= " :optional\n"
+ inc i
+ goto L1
+ L2:
+ .local int is_vararg
+ $P0 = getattribute self, 'is_vararg'
+ is_vararg = $P0
+ unless is_vararg goto L3
+ pir.= " .param pmc vararg :slurpy\n"
+ goto L4
+ L3:
+ pir .= " .param pmc extra :slurpy\n"
+ L4:
+ $P0 = getattribute self, 'locvars'
+ $S0 = $P0.'translate'()
+ pir .= $S0
+ $P0 = getattribute self, 'upvalues'
+ $S0 = $P0.'translate'()
+ pir .= $S0
+ $P0 = getattribute self, 'k'
+ $S0= $P0.'translate'()
+ pir .= $S0
+ $P0 = getattribute self, 'code'
+ $S0 = $P0.'translate'(self)
+ pir .= $S0
+ pir .= ".end\n\n"
+ $P0 = getattribute self, 'p'
+ $S0 = $P0.'translate'(funcname)
+ pir .= $S0
+ .return (pir)
+.end
+
.namespace ['Lua::ConstantList']
@@ -131,6 +213,23 @@
L2:
.end
+.sub 'translate' :method
+ .local string pir
+ .local int i, n
+ pir = ''
+ n = self
+ i = 0
+ L1:
+ unless i < n goto L2
+ $P0 = self[i]
+ $S0 = $P0.'translate'(i)
+ pir .= $S0
+ inc i
+ goto L1
+ L2:
+ .return (pir)
+.end
+
.namespace ['Lua::Nil']
@@ -141,6 +240,11 @@
print "\n"
.end
+.sub 'translate' :method
+ .param int i
+ .return ("; const nil\n")
+.end
+
.namespace ['Lua::Boolean']
@@ -153,6 +257,11 @@
print "\n"
.end
+.sub 'translate' :method
+ .param int i
+ .return ("; const bool\n")
+.end
+
.namespace ['Lua::Number']
@@ -165,6 +274,11 @@
print "\n"
.end
+.sub 'translate' :method
+ .param int i
+ .return ("; const number\n")
+.end
+
.namespace ['Lua::String']
@@ -179,6 +293,11 @@
print "\n"
.end
+.sub 'translate' :method
+ .param int i
+ .return ("; const string\n")
+.end
+
.namespace ['Lua::PrototypeList']
@@ -196,6 +315,28 @@
L2:
.end
+.sub 'translate' :method
+ .param string outer
+ .local string pir
+ .local int i, n
+ pir = ''
+ n = self
+ i = 0
+ L1:
+ unless i < n goto L2
+ .local string funcname
+ funcname = outer . '_'
+ $S0 = i
+ funcname .= $S0
+ $P0 = self[i]
+ $S0 = $P0.'translate'(funcname, outer)
+ pir .= $S0
+ inc i
+ goto L1
+ L2:
+ .return (pir)
+.end
+
.namespace ['Lua::LocalList']
@@ -212,6 +353,23 @@
L2:
.end
+.sub 'translate' :method
+ .local string pir
+ .local int i, n
+ pir = ''
+ n = self
+ i = 0
+ L1:
+ unless i < n goto L2
+ $P0 = self[i]
+ $S0 = $P0.'translate'(i)
+ pir .= $S0
+ inc i
+ goto L1
+ L2:
+ .return (pir)
+.end
+
.namespace ['Lua::Local']
@@ -224,6 +382,19 @@
print "\n"
.end
+.sub 'translate' :method
+ .param int i
+ .local string pir
+ pir = " .local pmc loc_"
+ $S0 = i
+ pir .= $S0
+ pir .= " ; "
+ $S0 = self
+ pir .= $S0
+ pir .= "\n"
+ .return (pir)
+.end
+
.namespace ['Lua::UpvalueList']
@@ -240,6 +411,23 @@
L2:
.end
+.sub 'translate' :method
+ .local string pir
+ .local int i, n
+ pir = ''
+ n = self
+ i = 0
+ L1:
+ unless i < n goto L2
+ $P0 = self[i]
+ $S0 = $P0.'translate'(i)
+ pir .= $S0
+ inc i
+ goto L1
+ L2:
+ .return (pir)
+.end
+
.namespace ['Lua::Upvalue']
@@ -252,6 +440,19 @@
print "\n"
.end
+.sub 'translate' :method
+ .param int i
+ .local string pir
+ pir = " .local pmc upv_"
+ $S0 = i
+ pir .= $S0
+ pir .= " ; "
+ $S0 = self
+ pir .= $S0
+ pir .= "\n"
+ .return (pir)
+.end
+
.include 'languages/lua/src/lib/luabytecode_gen.pir'
Modified: trunk/languages/lua/src/lib/luabytecode.rules
==============================================================================
--- trunk/languages/lua/src/lib/luabytecode.rules (original)
+++ trunk/languages/lua/src/lib/luabytecode.rules Thu May 8 10:05:14 2008
@@ -13,168 +13,245 @@
[MOVE]
code = 0
format = AB
+pir = <<PIR
+PIR
[LOADNIL]
code = 3
format = AB
+pir = <<PIR
+PIR
[LOADK]
code = 1
format = ABx
+pir = <<PIR
+PIR
[LOADBOOL]
code = 2
format = ABC
+pir = <<PIR
+PIR
## Upvalues and Globals
[GETUPVAL]
code = 4
format = AB
+pir = <<PIR
+PIR
[GETGLOBAL]
code = 5
format = ABx
+pir = <<PIR
+PIR
[SETGLOBAL]
code = 7
format = ABx
+pir = <<PIR
+PIR
[SETUPVAL]
code = 8
format = AB
+pir = <<PIR
+PIR
## Table Instructions
[GETTABLE]
code = 6
format = ABC
+pir = <<PIR
+PIR
[SETTABLE]
code = 9
format = ABC
+pir = <<PIR
+PIR
## Arithmetic and String Instructions
[ADD]
code = 12
format = ABC
+pir = <<PIR
+PIR
[SUB]
code = 13
format = ABC
+pir = <<PIR
+PIR
[MUL]
code = 14
format = ABC
+pir = <<PIR
+PIR
[DIV]
code = 15
format = ABC
+pir = <<PIR
+PIR
[MOD]
code = 16
format = ABC
+pir = <<PIR
+PIR
[POW]
code = 17
format = ABC
+pir = <<PIR
+PIR
[UNM]
code = 18
format = AB
+pir = <<PIR
+PIR
[NOT]
code = 19
format = AB
+pir = <<PIR
+PIR
[LEN]
code = 20
format = AB
+pir = <<PIR
+PIR
[CONCAT]
code = 21
format = ABC
+pir = <<PIR
+PIR
## Jumps and Calls
[JMP]
code = 22
format = sBx
+pir = <<PIR
+PIR
[CALL]
code = 28
format = ABC
+pir = <<PIR
+PIR
[TAILCALL]
code = 29
format = ABC
+pir = <<PIR
+PIR
[RETURN]
code = 30
format = AB
+pir = <<PIR
+ ${INS} = concat " not_translated()\n"
+PIR
[VARARG]
code = 37
format = AB
+pir = <<PIR
+PIR
[SELF]
code = 11
format = ABC
+pir = <<PIR
+PIR
## Relational and Logic Instructions
[EQ]
code = 23
format = ABC
+pir = <<PIR
+PIR
[LT]
code = 24
format = ABC
+pir = <<PIR
+PIR
[LE]
code = 25
format = ABC
+pir = <<PIR
+PIR
[TEST]
code = 26
format = AC
+pir = <<PIR
+PIR
[TESTSET]
code = 27
format = ABC
+pir = <<PIR
+PIR
## Loop Instructions
[FORLOOP]
code = 31
format = AsBx
+pir = <<PIR
+PIR
[FORPREP]
code = 32
format = AsBx
+pir = <<PIR
+PIR
[TFORLOOP]
code = 33
format = AC
+pir = <<PIR
+PIR
## Table Creation
[NEWTABLE]
code = 10
format = ABC
+pir = <<PIR
+PIR
[SETLIST]
code = 34
format = ABC
+pir = <<PIR
+PIR
## Closures and Closing
[CLOSE]
code = 35
format = A
+pir = <<PIR
+PIR
[CLOSURE]
code = 36
format = ABx
+pir = <<PIR
+PIR
