Author: fperrad
Date: Wed May 7 00:37:52 2008
New Revision: 27374
Added:
trunk/languages/lua/src/pmc/luabytecode.pmc (contents, props changed)
Modified:
trunk/MANIFEST
trunk/languages/lua/config/makefiles/root.in
trunk/languages/lua/luad.pir
trunk/languages/lua/src/lib/luabytecode.pir
trunk/languages/lua/src/pmc/lua.pmc
Log:
[Lua]
- implement bytecode loader in a PMC
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Wed May 7 00:37:52 2008
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Mon May 5 23:32:49 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Wed May 7 07:35:21 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -1618,6 +1618,7 @@
languages/lua/src/pmc/lua_private.h [lua]
languages/lua/src/pmc/luaany.pmc [lua]
languages/lua/src/pmc/luaboolean.pmc [lua]
+languages/lua/src/pmc/luabytecode.pmc [lua]
languages/lua/src/pmc/luaclosure.pmc [lua]
languages/lua/src/pmc/luafunction.pmc [lua]
languages/lua/src/pmc/luanil.pmc [lua]
Modified: trunk/languages/lua/config/makefiles/root.in
==============================================================================
--- trunk/languages/lua/config/makefiles/root.in (original)
+++ trunk/languages/lua/config/makefiles/root.in Wed May 7 00:37:52 2008
@@ -26,6 +26,7 @@
lua \
luaany \
luaboolean \
+ luabytecode \
luaclosure \
luafunction \
luanil \
@@ -39,6 +40,7 @@
$(PMCDIR)/lua.pmc \
$(PMCDIR)/luaany.pmc \
$(PMCDIR)/luaboolean.pmc \
+ $(PMCDIR)/luabytecode.pmc \
$(PMCDIR)/luaclosure.pmc \
$(PMCDIR)/luafunction.pmc \
$(PMCDIR)/luanil.pmc \
Modified: trunk/languages/lua/luad.pir
==============================================================================
--- trunk/languages/lua/luad.pir (original)
+++ trunk/languages/lua/luad.pir Wed May 7 00:37:52 2008
@@ -39,8 +39,8 @@
unless content goto L1
.local pmc script
push_eh _handler
- $P0 = get_hll_global ['Lua::Bytecode'], 'undump'
- script = $P0(content)
+ new $P0, 'LuaBytecode'
+ script = $P0.'undump'(content)
.local string basename
$P0 = split '/', filename
$S0 = pop $P0
Modified: trunk/languages/lua/src/lib/luabytecode.pir
==============================================================================
--- trunk/languages/lua/src/lib/luabytecode.pir (original)
+++ trunk/languages/lua/src/lib/luabytecode.pir Wed May 7 00:37:52 2008
@@ -53,78 +53,6 @@
$P0 = subclass 'String', 'Lua::Upvalue'
.end
-.sub 'undump'
- .param string bytecode
- .local int idx
- .local pmc script
- idx = 0
- $S0 = substr bytecode, idx, 4
- if $S0 == "\x1BLua" goto L1
- die "not a Lua bytecode"
- L1:
- idx += 4
- script = new 'Lua::Bytecode'
- $S0 = bytecode[idx]
- $I0 = ord $S0
- if $I0 == 0x51 goto L2
- die "only Lua 5.1 bytecode is supported"
- L2:
- new $P0, 'Integer'
- set $P0, $I0
- setattribute script, 'version', $P0
- idx += 1
- $S0 = bytecode[idx]
- $I0 = ord $S0
- new $P0, 'Integer'
- set $P0, $I0
- setattribute script, 'format', $P0
- idx += 1
- $S0 = bytecode[idx]
- $I0 = ord $S0
- new $P0, 'Boolean'
- set $P0, $I0
- setattribute script, 'endian', $P0
- idx += 1
- $S0 = bytecode[idx]
- $I0 = ord $S0
- new $P0, 'Integer'
- set $P0, $I0
- setattribute script, 'sizeof_int', $P0
- idx += 1
- $S0 = bytecode[idx]
- $I0 = ord $S0
- new $P0, 'Integer'
- set $P0, $I0
- setattribute script, 'sizeof_size_t', $P0
- idx += 1
- $S0 = bytecode[idx]
- $I0 = ord $S0
- new $P0, 'Integer'
- set $P0, $I0
- setattribute script, 'sizeof_opcode', $P0
- idx += 1
- $S0 = bytecode[idx]
- $I0 = ord $S0
- new $P0, 'Integer'
- set $P0, $I0
- setattribute script, 'sizeof_number', $P0
- idx += 1
- $S0 = bytecode[idx]
- $I0 = ord $S0
- new $P0, 'Boolean'
- set $P0, $I0
- setattribute script, 'integral', $P0
- idx += 1
- new $P0, 'Lua::Function'
- idx = $P0.'init'(script, bytecode, idx)
- setattribute script, 'top', $P0
- $I0 = length bytecode
- if idx == $I0 goto L3
- die "bad length"
- L3:
- .return (script)
-.end
-
.sub 'brief' :method
.param string filename
print "; source chunk: "
@@ -134,125 +62,9 @@
$P0.'brief'(0, 1)
.end
-.sub 'get_int' :method
- .param string str
- .local int endian
- $P0 = getattribute self, 'endian'
- endian = $P0
- .local int ret
- $P0 = split '', str
- ret = 0
- L1:
- unless $P0 goto L2
- unless endian goto L3
- $P1 = pop $P0
- goto L4
- L3:
- $P1 = shift $P0
- L4:
- $S1 = $P1
- $I0 = ord $S1
- ret <<= 8
- ret += $I0
- goto L1
- L2:
- .return (ret)
-.end
-
-.sub 'get_Integer' :method
- .param string str
- .local pmc ret
- $I0 = self.'get_int'(str)
- new ret, 'Integer'
- set ret, $I0
- .return (ret)
-.end
-
-.sub 'get_number' :method
- .param string str
- .local num ret
- new $P0, 'Lua'
- ret = $P0.'float_from_bytecode'(str)
-# ret = 0.0
- .return (ret)
-.end
-
.namespace ['Lua::Function']
-.sub 'init' :method
- .param pmc script
- .param string bytecode
- .param int idx
- .local int size_t
- $P0 = getattribute script, 'sizeof_size_t'
- size_t = $P0
- $S0 = substr bytecode, idx, size_t
- $I0 = script.'get_int'($S0)
- idx += size_t
- unless $I0 goto L1
- $S0 = substr bytecode, idx, $I0
- new $P0, 'String'
- set $P0, $S0
- setattribute self, 'source', $P0
- idx += $I0
- L1:
- .local int size
- $P0 = getattribute script, 'sizeof_int'
- size = $P0
- $S0 = substr bytecode, idx, size
- $P0 = script.'get_Integer'($S0)
- setattribute self, 'linedefined', $P0
- idx += size
- $S0 = substr bytecode, idx, size
- $P0 = script.'get_Integer'($S0)
- setattribute self, 'lastlinedefined', $P0
- idx += size
- $S0 = bytecode[idx]
- $I0 = ord $S0
- new $P0, 'Integer'
- set $P0, $I0
- setattribute self, 'nups', $P0
- idx += 1
- $S0 = bytecode[idx]
- $I0 = ord $S0
- new $P0, 'Integer'
- set $P0, $I0
- setattribute self, 'numparams', $P0
- idx += 1
- $S0 = bytecode[idx]
- $I0 = ord $S0
- new $P0, 'Integer'
- set $P0, $I0
- setattribute self, 'is_vararg', $P0
- idx += 1
- $S0 = bytecode[idx]
- $I0 = ord $S0
- new $P0, 'Integer'
- set $P0, $I0
- setattribute self, 'maxstacksize', $P0
- idx += 1
- $P0 = new 'Lua::InstructionList'
- idx = $P0.'init'(script, bytecode, idx)
- setattribute self, 'code', $P0
- $P0 = new 'Lua::ConstantList'
- idx = $P0.'init'(script, bytecode, idx)
- setattribute self, 'k', $P0
- $P0 = new 'Lua::PrototypeList'
- idx = $P0.'init'(script, bytecode, idx)
- setattribute self, 'p', $P0
- $P0 = new 'Lua::LineList'
- idx = $P0.'init'(script, bytecode, idx)
- setattribute self, 'lineinfo', $P0
- $P0 = new 'Lua::LocalList'
- idx = $P0.'init'(script, bytecode, idx)
- setattribute self, 'locvars', $P0
- $P0 = new 'Lua::UpvalueList'
- idx = $P0.'init'(script, bytecode, idx)
- setattribute self, 'upvalues', $P0
- .return (idx)
-.end
-
.sub 'brief' :method
.param int i
.param int level
@@ -303,87 +115,9 @@
print "; end of function\n\n"
.end
-.namespace ['Lua::InstructionList']
-
-.sub 'init' :method
- .param pmc script
- .param string bytecode
- .param int idx
- .local int size
- $P0 = getattribute script, 'sizeof_int'
- size = $P0
- .local int n
- $S0 = substr bytecode, idx, size
- n = script.'get_int'($S0)
- set self, n
- idx += size
- $P0 = getattribute script, 'sizeof_opcode'
- size = $P0
- .local int i
- i = 0
- L1:
- unless i < n goto L2
- $S0 = substr bytecode, idx, size
- $I0 = script.'get_int'($S0)
- self[i] = $I0
- idx += size
- inc i
- goto L1
- L2:
- .return (idx)
-.end
-
.namespace ['Lua::ConstantList']
-.sub 'init' :method
- .param pmc script
- .param string bytecode
- .param int idx
- .local int size
- $P0 = getattribute script, 'sizeof_int'
- size = $P0
- .local int n
- $S0 = substr bytecode, idx, size
- n = script.'get_int'($S0)
- set self, n
- idx += size
- .local int i
- i = 0
- L1:
- unless i < n goto L2
- $S0 = bytecode[idx]
- $I0 = ord $S0
- idx += 1
- unless $I0 == 0 goto L3
- $P0 = new 'Lua::Nil'
- goto L9
- L3:
- unless $I0 == 1 goto L4
- $P0 = new 'Lua::Boolean'
- idx = $P0.'init'(script, bytecode, idx)
- goto L9
- L4:
- unless $I0 == 3 goto L5
- $P0 = new 'Lua::Number'
- idx = $P0.'init'(script, bytecode, idx)
- goto L9
- L5:
- unless $I0 == 4 goto L6
- $P0 = new 'Lua::String'
- idx = $P0.'init'(script, bytecode, idx)
- goto L9
- L6:
- $S0 = "invalid type of constant"
- die $S0
- L9:
- self[i] = $P0
- inc i
- goto L1
- L2:
- .return (idx)
-.end
-
.sub 'brief' :method
.local int i, n
n = self
@@ -410,16 +144,6 @@
.namespace ['Lua::Boolean']
-.sub 'init' :method
- .param pmc script
- .param string bytecode
- .param int idx
- $S0 = bytecode[idx]
- $I0 = ord $S0
- set self, $I0
- .return (idx)
-.end
-
.sub 'brief' :method
.param int i
print ".const "
@@ -432,20 +156,6 @@
.namespace ['Lua::Number']
-.sub 'init' :method
- .param pmc script
- .param string bytecode
- .param int idx
- .local int size
- $P0 = getattribute script, 'sizeof_number'
- size = $P0
- $S0 = substr bytecode, idx, size
- $N0 = script.'get_number'($S0)
- idx += size
- set self, $N0
- .return (idx)
-.end
-
.sub 'brief' :method
.param int i
print ".const "
@@ -458,27 +168,6 @@
.namespace ['Lua::String']
-.sub 'init' :method
- .param pmc script
- .param string bytecode
- .param int idx
- .local int size_t
- $P0 = getattribute script, 'sizeof_size_t'
- size_t = $P0
- $S0 = substr bytecode, idx, size_t
- $I0 = script.'get_int'($S0)
- idx += size_t
- $S0 = ''
- unless $I0 goto L1
- $S0 = substr bytecode, idx, $I0
- idx += $I0
- dec $I0
- $S0 = substr $S0, 0, $I0
- L1:
- set self, $S0
- .return (idx)
-.end
-
.sub 'brief' :method
.param int i
print ".const \""
@@ -493,31 +182,6 @@
.namespace ['Lua::PrototypeList']
-.sub 'init' :method
- .param pmc script
- .param string bytecode
- .param int idx
- .local int size
- $P0 = getattribute script, 'sizeof_int'
- size = $P0
- .local int n
- $S0 = substr bytecode, idx, size
- n = script.'get_int'($S0)
- set self, n
- idx += size
- .local int i
- i = 0
- L1:
- unless i < n goto L2
- new $P0, 'Lua::Function'
- idx = $P0.'init'(script, bytecode, idx)
- self[i] = $P0
- inc i
- goto L1
- L2:
- .return (idx)
-.end
-
.sub 'brief' :method
.param int level
.local int i, n
@@ -533,62 +197,8 @@
.end
-.namespace ['Lua::LineList']
-
-.sub 'init' :method
- .param pmc script
- .param string bytecode
- .param int idx
- .local int size
- $P0 = getattribute script, 'sizeof_int'
- size = $P0
- .local int n
- $S0 = substr bytecode, idx, size
- n = script.'get_int'($S0)
- set self, n
- idx += size
- .local int i
- i = 0
- L1:
- unless i < n goto L2
- $S0 = substr bytecode, idx, size
- $P0 = script.'get_Integer'($S0)
- idx += size
- self[i] = $P0
- inc i
- goto L1
- L2:
- .return (idx)
-.end
-
-
.namespace ['Lua::LocalList']
-.sub 'init' :method
- .param pmc script
- .param string bytecode
- .param int idx
- .local int size
- $P0 = getattribute script, 'sizeof_int'
- size = $P0
- .local int n
- $S0 = substr bytecode, idx, size
- n = script.'get_int'($S0)
- set self, n
- idx += size
- .local int i
- i = 0
- L1:
- unless i < n goto L2
- new $P0, 'Lua::Local'
- idx = $P0.'init'(script, bytecode, idx)
- self[i] = $P0
- inc i
- goto L1
- L2:
- .return (idx)
-.end
-
.sub 'brief' :method
.local int i, n
n = self
@@ -605,38 +215,6 @@
.namespace ['Lua::Local']
-.sub 'init' :method
- .param pmc script
- .param string bytecode
- .param int idx
- .local int size_t
- $P0 = getattribute script, 'sizeof_size_t'
- size_t = $P0
- $S0 = substr bytecode, idx, size_t
- $I0 = script.'get_int'($S0)
- idx += size_t
- $S0 = ''
- unless $I0 goto L1
- $S0 = substr bytecode, idx, $I0
- idx += $I0
- dec $I0
- $S0 = substr $S0, 0, $I0
- L1:
- set self, $S0
- .local int size
- $P0 = getattribute script, 'sizeof_int'
- size = $P0
- $S0 = substr bytecode, idx, size
- $P0 = script.'get_Integer'($S0)
- setattribute self, 'startpc', $P0
- idx += size
- $S0 = substr bytecode, idx, size
- $P0 = script.'get_Integer'($S0)
- setattribute self, 'endpc', $P0
- idx += size
- .return (idx)
-.end
-
.sub 'brief' :method
.param int i
print ".local \""
@@ -649,31 +227,6 @@
.namespace ['Lua::UpvalueList']
-.sub 'init' :method
- .param pmc script
- .param string bytecode
- .param int idx
- .local int size
- $P0 = getattribute script, 'sizeof_int'
- size = $P0
- .local int n
- $S0 = substr bytecode, idx, size
- n = script.'get_int'($S0)
- set self, n
- idx += size
- .local int i
- i = 0
- L1:
- unless i < n goto L2
- new $P0, 'Lua::Upvalue'
- idx = $P0.'init'(script, bytecode, idx)
- self[i] = $P0
- inc i
- goto L1
- L2:
- .return (idx)
-.end
-
.sub 'brief' :method
.local int i, n
n = self
@@ -690,27 +243,6 @@
.namespace ['Lua::Upvalue']
-.sub 'init' :method
- .param pmc script
- .param string bytecode
- .param int idx
- .local int size_t
- $P0 = getattribute script, 'sizeof_size_t'
- size_t = $P0
- $S0 = substr bytecode, idx, size_t
- $I0 = script.'get_int'($S0)
- idx += size_t
- $S0 = ''
- unless $I0 goto L1
- $S0 = substr bytecode, idx, $I0
- idx += $I0
- dec $I0
- $S0 = substr $S0, 0, $I0
- L1:
- set self, $S0
- .return (idx)
-.end
-
.sub 'brief' :method
.param int i
print ".upvalue \""
Modified: trunk/languages/lua/src/pmc/lua.pmc
==============================================================================
--- trunk/languages/lua/src/pmc/lua.pmc (original)
+++ trunk/languages/lua/src/pmc/lua.pmc Wed May 7 00:37:52 2008
@@ -435,12 +435,6 @@
RETURN(STRING *retval);
}
- METHOD FLOATVAL float_from_bytecode(STRING *str) {
- FLOATVAL retval;
- memcpy(&retval, str->strstart, sizeof retval);
- RETURN(FLOATVAL retval);
- }
-
}
/*
Added: trunk/languages/lua/src/pmc/luabytecode.pmc
==============================================================================
--- (empty file)
+++ trunk/languages/lua/src/pmc/luabytecode.pmc Wed May 7 00:37:52 2008
@@ -0,0 +1,415 @@
+/*
+Copyright (C) 2008, The Perl Foundation.
+$Id$
+
+=head1 NAME
+
+pmc/luabytecode - Lua 5.1 VM bytecode loader
+
+=head1 DESCRIPTION
+
+This singleton PMC holds a factory.
+
+=head2 Methods
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/embed.h"
+
+/*** from lua.h ***/
+
+/* type of numbers in Lua */
+typedef double lua_Number;
+
+/*** from limits.h ***/
+
+/*
+** type for virtual-machine instructions
+** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h)
+*/
+typedef Parrot_Int4 Instruction;
+
+/*** from lundump.h ***/
+
+/* for header of binary files -- this is Lua 5.1 */
+#define LUAC_VERSION 0x51
+
+/* for header of binary files -- this is the official format */
+#define LUAC_FORMAT 0
+
+/* size of header of binary files */
+#define LUAC_HEADERSIZE 12
+
+/*** ***/
+
+static const char header_ref[LUAC_HEADERSIZE] = {
+ '\033', 'L', 'u', 'a',
+ LUAC_VERSION,
+ LUAC_FORMAT,
+ PARROT_LITTLEENDIAN,
+ sizeof(int),
+ sizeof(size_t),
+ sizeof(Instruction),
+ sizeof(lua_Number),
+ 0,
+};
+
+static PMC * LuaBytecode_PMC;
+static PMC * script;
+static const char * bytecode;
+static UINTVAL maxi;
+static const char *fp;
+
+static void _init(Interp *interp, STRING *str)
+{
+ bytecode = Parrot_string_cstring(interp, str);
+ maxi = string_length(interp, str);
+ fp = (const char *)bytecode;
+}
+
+
+#define _info_get() (UINTVAL)(&bytecode[maxi] - fp)
+#define _get_pos() (fp)
+#define _get_byte() (*(fp++))
+
+static void _get_block(void* b, size_t size)
+{
+ memcpy(b, fp, size);
+ fp += size;
+}
+
+static int _get_integer()
+{
+ int x;
+ memcpy(&x, fp, sizeof x);
+ fp += sizeof x;
+ return x;
+}
+
+static Instruction _get_instruction()
+{
+ Instruction x;
+ memcpy(&x, fp, sizeof x);
+ fp += sizeof x;
+ return x;
+}
+
+static double _get_number()
+{
+ double x;
+ memcpy(&x, fp, sizeof x);
+ fp += sizeof x;
+ return x;
+}
+
+static STRING* _get_string(Interp *interp)
+{
+ STRING* str;
+ size_t s;
+ memcpy(&s, fp, sizeof s);
+ fp += sizeof s;
+ if (s != 0) {
+ str = string_from_cstring(interp, fp, s-1);
+ fp += s;
+ }
+ else
+ str = string_from_cstring(interp, "", 0);
+ return str;
+}
+
+static PMC* _load_function(Interp *interp);
+
+static PMC* _load_bool(Interp *interp)
+{
+ PMC* ret = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Boolean")));
+ VTABLE_set_integer_native(interp, ret, _get_byte());
+ return ret;
+}
+
+static PMC* _load_byte(Interp *interp)
+{
+ PMC* ret = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Integer")));
+ VTABLE_set_integer_native(interp, ret, _get_byte());
+ return ret;
+}
+
+static PMC* _load_integer(Interp *interp)
+{
+ PMC* ret = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Integer")));
+ VTABLE_set_integer_native(interp, ret, _get_integer());
+ return ret;
+}
+
+static PMC* _load_string(Interp *interp)
+{
+ PMC* ret = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "String")));
+ VTABLE_set_string_native(interp, ret, _get_string(interp));
+ return ret;
+}
+
+static void _load_header(Interp *interp)
+{
+ char header[LUAC_HEADERSIZE];
+
+ _get_block(header, sizeof header);
+ if (memcmp(header, header_ref, sizeof header) != 0) {
+ real_exception(interp, NULL, ILL_INHERIT,
+ "bad header");
+ }
+#if 1
+ fp -= 8;
+ VTABLE_set_attr_str(interp, script,
+ const_string(interp, "version"), _load_byte(interp));
+ VTABLE_set_attr_str(interp, script,
+ const_string(interp, "format"), _load_byte(interp));
+ VTABLE_set_attr_str(interp, script,
+ const_string(interp, "endian"), _load_byte(interp));
+ VTABLE_set_attr_str(interp, script,
+ const_string(interp, "sizeof_int"), _load_byte(interp));
+ VTABLE_set_attr_str(interp, script,
+ const_string(interp, "sizeof_size_t"), _load_byte(interp));
+ VTABLE_set_attr_str(interp, script,
+ const_string(interp, "sizeof_opcode"), _load_byte(interp));
+ VTABLE_set_attr_str(interp, script,
+ const_string(interp, "sizeof_number"), _load_byte(interp));
+ VTABLE_set_attr_str(interp, script,
+ const_string(interp, "integral"), _load_byte(interp));
+#endif
+}
+
+static PMC* _load_instruction_list(Interp *interp)
+{
+ int i;
+ int n = _get_integer();
+ PMC * ret = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Lua::InstructionList")));
+ VTABLE_set_integer_native(interp, ret, n);
+
+ for (i = 0; i < n; i++) {
+ VTABLE_set_integer_keyed_int(interp, ret, i, _get_instruction());
+ }
+
+ return ret;
+}
+
+static PMC* _load_constant_list(Interp *interp)
+{
+ int i;
+ int n = _get_integer();
+ PMC * ret = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Lua::ConstantList")));
+ VTABLE_set_integer_native(interp, ret, n);
+
+ for (i = 0; i < n; i++) {
+ PMC* k;
+ int type = _get_byte();
+ switch (type) {
+ case 0:
+ k = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Lua::Nil")));
+ break;
+ case 1:
+ k = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Lua::Boolean")));
+ VTABLE_set_integer_native(interp, k, _get_byte());
+ break;
+ case 3:
+ k = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Lua::Number")));
+ VTABLE_set_number_native(interp, k, _get_number());
+ break;
+ case 4:
+ k = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Lua::String")));
+ VTABLE_set_string_native(interp, k, _get_string(interp));
+ break;
+ default:
+ real_exception(interp, NULL, ILL_INHERIT,
+ "bad constant");
+ }
+ VTABLE_set_pmc_keyed_int(interp, ret, i, k);
+ }
+
+ return ret;
+}
+
+static PMC* _load_prototype_list(Interp *interp)
+{
+ int i;
+ int n = _get_integer();
+ PMC * ret = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Lua::PrototypeList")));
+ VTABLE_set_integer_native(interp, ret, n);
+
+ for (i = 0; i < n; i++) {
+ VTABLE_set_pmc_keyed_int(interp, ret, i, _load_function(interp));
+ }
+
+ return ret;
+}
+
+static PMC* _load_line_list(Interp *interp)
+{
+ int i;
+ int n = _get_integer();
+ PMC * ret = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Lua::LineList")));
+ VTABLE_set_integer_native(interp, ret, n);
+
+ for (i = 0; i < n; i++) {
+ VTABLE_set_integer_keyed_int(interp, ret, i, _get_integer());
+ }
+
+ return ret;
+}
+
+static PMC* _load_local_list(Interp *interp)
+{
+ int i;
+ int n = _get_integer();
+ PMC * ret = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Lua::LocalList")));
+ VTABLE_set_integer_native(interp, ret, n);
+
+ for (i = 0; i < n; i++) {
+ PMC* local = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Lua::Local")));
+ VTABLE_set_string_native(interp, local, _get_string(interp));
+ VTABLE_set_attr_str(interp, local,
+ const_string(interp, "startpc"), _load_integer(interp));
+ VTABLE_set_attr_str(interp, local,
+ const_string(interp, "endpc"), _load_integer(interp));
+ VTABLE_set_pmc_keyed_int(interp, ret, i, local);
+ }
+
+ return ret;
+}
+
+static PMC* _load_upvalue_list(Interp *interp)
+{
+ int i;
+ int n = _get_integer();
+ PMC * ret = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Lua::UpvalueList")));
+ VTABLE_set_integer_native(interp, ret, n);
+
+ for (i = 0; i < n; i++) {
+ PMC* upvalue = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Lua::Upvalue")));
+ VTABLE_set_string_native(interp, upvalue, _get_string(interp));
+ VTABLE_set_pmc_keyed_int(interp, ret, i, upvalue);
+ }
+
+ return ret;
+}
+
+static PMC* _load_function(Interp *interp)
+{
+ PMC * ret = pmc_new(interp, pmc_type(interp,
+ const_string(interp, "Lua::Function")));
+
+ VTABLE_set_attr_str(interp, ret,
+ const_string(interp, "source"), _load_string(interp));
+ VTABLE_set_attr_str(interp, ret,
+ const_string(interp, "linedefined"), _load_integer(interp));
+ VTABLE_set_attr_str(interp, ret,
+ const_string(interp, "lastlinedefined"), _load_integer(interp));
+ VTABLE_set_attr_str(interp, ret,
+ const_string(interp, "nups"), _load_byte(interp));
+ VTABLE_set_attr_str(interp, ret,
+ const_string(interp, "numparams"), _load_byte(interp));
+ VTABLE_set_attr_str(interp, ret,
+ const_string(interp, "is_vararg"), _load_byte(interp));
+ VTABLE_set_attr_str(interp, ret,
+ const_string(interp, "maxstacksize"), _load_byte(interp));
+ VTABLE_set_attr_str(interp, ret,
+ const_string(interp, "code"), _load_instruction_list(interp));
+ VTABLE_set_attr_str(interp, ret,
+ const_string(interp, "k"), _load_constant_list(interp));
+ VTABLE_set_attr_str(interp, ret,
+ const_string(interp, "p"), _load_prototype_list(interp));
+ VTABLE_set_attr_str(interp, ret,
+ const_string(interp, "lineinfo"), _load_line_list(interp));
+ VTABLE_set_attr_str(interp, ret,
+ const_string(interp, "locvars"), _load_local_list(interp));
+ VTABLE_set_attr_str(interp, ret,
+ const_string(interp, "upvalues"), _load_upvalue_list(interp));
+
+ return ret;
+}
+
+
+pmclass LuaBytecode
+ singleton
+ dynpmc
+ group lua_group {
+
+/*
+
+=item C<void* get_pointer()>
+
+=item C<void set_pointer(void *ptr)>
+
+These two functions are part of the singleton creation interface. For more
+information see F<src/pmc.c>.
+
+=cut
+
+*/
+ void* get_pointer() {
+ return LuaBytecode_PMC;
+ }
+
+ void set_pointer(void* ptr) {
+ LuaBytecode_PMC = (PMC*) ptr;
+ }
+
+/*
+
+=item C<PMC* undump(STRING* bytecode)>
+
+Loads Lua 5.1 VM bytecode.
+
+=cut
+
+*/
+ METHOD PMC* undump(STRING* bytecode) {
+ script = pmc_new(INTERP, pmc_type(INTERP,
+ const_string(INTERP, "Lua::Bytecode")));
+
+ _init(INTERP, bytecode);
+ _load_header(INTERP);
+ VTABLE_set_attr_str(INTERP, script,
+ const_string(interp, "top"), _load_function(INTERP));
+
+ RETURN(PMC *script);
+ }
+
+}
+
+/*
+
+=back
+
+=head1 AUTHORS
+
+Francois Perrad
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
