Author: leo
Date: Sat Nov 12 09:19:54 2005
New Revision: 9922
Modified:
trunk/classes/lexinfo.pmc
trunk/classes/sub.pmc
trunk/imcc/pbc.c
trunk/lib/Parrot/Vtable.pm
trunk/t/op/lexicals.t
Log:
lexicals 6 - LexInfo creation set key/value
* oops - VTABLE_IS_CONST_PMC_FLAG defined in autogenerate file
instead of lib/Parrot/Vtable.pm
* fill lexinfo hash
* get_lexinfo method for Subs
Modified: trunk/classes/lexinfo.pmc
==============================================================================
--- trunk/classes/lexinfo.pmc (original)
+++ trunk/classes/lexinfo.pmc Sat Nov 12 09:19:54 2005
@@ -82,6 +82,31 @@ subroutine.
/*
+=item C<void set_integer_keyed_str(STRING *name, INTVAL preg)>
+
+aka void declare_lex_preg(STRING *name, INTVAL preg)
+
+Declare a lexical variable that is an alias for a PMC register. The PIR
+compiler calls this method in response to a ".lex STRING, PREG" directive.
+
+=item C<INTVAL elements()>
+
+Returns the number of elements in the hash.
+
+=cut
+
+*/
+
+ void set_integer_keyed_str (STRING* name, INTVAL preg) {
+ hash_put(INTERP, PMC_struct_val(SELF), name, (void*)preg);
+ }
+
+ INTVAL elements () {
+ return hash_size(INTERP, PMC_struct_val(SELF));
+ }
+
+/*
+
=item C<void visit(visit_info *info)>
=item C<void freeze(visit_info *info)>
Modified: trunk/classes/sub.pmc
==============================================================================
--- trunk/classes/sub.pmc (original)
+++ trunk/classes/sub.pmc Sat Nov 12 09:19:54 2005
@@ -593,6 +593,10 @@ String PMC or a Key PMC for a nested nam
Return amount of used registers for register kinds "I", "S", "P", "N".
+=item C<METHOD PMC* get_lexinfo()>
+
+Return the LexInfo PMC, if any.
+
=cut
*/
@@ -630,6 +634,10 @@ Return amount of used registers for regi
return sub->n_regs_used[p - types];
}
+ METHOD PMC* get_lexinfo() {
+ struct Parrot_sub * sub = PMC_sub(SELF);
+ return sub->lex_info ? sub->lex_info : PMCNULL;
+ }
}
Modified: trunk/imcc/pbc.c
==============================================================================
--- trunk/imcc/pbc.c (original)
+++ trunk/imcc/pbc.c Sat Nov 12 09:19:54 2005
@@ -671,6 +671,8 @@ create_lexinfo(Interp *interpreter, IMC_
assert(k >= 0);
lex_name = constants[k]->u.string;
assert(PObj_is_string_TEST(lex_name));
+ VTABLE_set_integer_keyed_str(interpreter,
+ lex_info, lex_name, r->color);
}
}
}
Modified: trunk/lib/Parrot/Vtable.pm
==============================================================================
--- trunk/lib/Parrot/Vtable.pm (original)
+++ trunk/lib/Parrot/Vtable.pm Sat Nov 12 09:19:54 2005
@@ -132,7 +132,8 @@ typedef enum {
VTABLE_PMC_NEEDS_EXT = 0x04,
VTABLE_DATA_IS_PMC = 0x08,
VTABLE_PMC_IS_SINGLETON = 0x10,
- VTABLE_IS_SHARED_FLAG = 0x20
+ VTABLE_IS_SHARED_FLAG = 0x20,
+ VTABLE_IS_CONST_PMC_FLAG = 0x40
} vtable_flags_t;
struct _vtable {
@@ -324,7 +325,7 @@ sub vtbl_embed
$protos .= sprintf "extern %s Parrot_PMC_%s( %s );\n",
$ret_type, $name, $signature;
- $funcs .= sprintf
+ $funcs .= sprintf
"/*
=item C<%s
Modified: trunk/t/op/lexicals.t
==============================================================================
--- trunk/t/op/lexicals.t (original)
+++ trunk/t/op/lexicals.t Sat Nov 12 09:19:54 2005
@@ -16,7 +16,7 @@ Tests various lexical scratchpad operati
=cut
-use Parrot::Test tests => 17;
+use Parrot::Test tests => 18;
output_is(<<'CODE', <<'OUTPUT', '.lex parsing - PASM');
.pcc_sub main:
@@ -49,6 +49,23 @@ CODE
ok
OUTPUT
+pir_output_is(<<'CODE', <<'OUTPUT', '.lex parsing - get_lexinfo');
+.sub main
+ .lex '$a', $P0
+ .lex '$b', $P9
+.include "interpinfo.pasm"
+ interpinfo $P1, .INTERPINFO_CURRENT_SUB
+ $P2 = $P1.'get_lexinfo'()
+ $S0 = typeof $P2
+ print_item $S0
+ $I0 = elements $P2
+ print_item $I0
+ print_newline
+.end
+CODE
+LexInfo 2
+OUTPUT
+
output_is(<<CODE, <<OUTPUT, "simple store and fetch");
new_pad 0
new P0, .Integer
