-
Notifications
You must be signed in to change notification settings - Fork 138
/
lexinfo.pmc
183 lines (120 loc) · 3.77 KB
/
lexinfo.pmc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
/*
Copyright (C) 2008, The Perl Foundation.
$Id$
=head1 NAME
src/pmc/lexinfo.pmc - LexInfo PMC
=head1 DESCRIPTION
These are the vtable functions for the lexinfo PMC.
=head2 Functions
=over 4
=cut
*/
#include "parrot/parrot.h"
/* included manually to prevent breaking C++ builds -- see RT #56534*/
#include "pmc_hash.h"
/*
* LexInfo contains a constant Hash with constant string
* keys and integer indices - no marking and no pmc_ext
* needed (except for freeze/thaw
*/
pmclass LexInfo need_ext provides hash no_ro {
/*
=item C<void class_init()>
Manipulate vtable->flags so that constant PMCs are created.
If your inherited LexInfo is not so constant, then don't
do that and provide a mark() method and set the custom_mark flag.
=item C<init_pmc(PMC *sub)>
Initialize the LexInfo PMC and remember the associate
subroutine.
=cut
*/
void class_init() {
/* there is no pmclass const_pmc flag yet */
if (pass == 1)
interp->vtables[entry]->flags |= VTABLE_IS_CONST_PMC_FLAG;
}
VTABLE void init() {
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
"Cannot create a LexInfo PMC without an initializer");
}
VTABLE void init_pmc(PMC *sub) {
PARROT_ASSERT(PObj_constant_TEST(SELF));
PMC_pmc_val(SELF) = sub;
parrot_new_pmc_hash_x(SELF,
(PARROT_DATA_TYPE)enum_hash_int,
Hash_key_type_STRING,
(hash_comp_fn)string_equal, /* STRING compare */
(hash_hash_key_fn)string_hash); /* hash */
PObj_active_destroy_SET(SELF);
}
/*
=item C<void destroy()>
Frees any malloced memory held by this PMC.
=cut
*/
void destroy() {
if (PMC_struct_val(SELF))
parrot_hash_destroy(INTERP, (Hash *)PMC_struct_val(SELF));
}
/*
=item C<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 LexInfo hash.
=cut
*/
METHOD declare_lex_preg(STRING *name, INTVAL preg) {
parrot_hash_put(INTERP, (Hash*)PMC_struct_val(SELF), name, (void*)preg);
}
VTABLE INTVAL elements() {
return parrot_hash_size(INTERP, (Hash *)PMC_struct_val(SELF));
}
/*
=item C<void visit(visit_info *info)>
=item C<void freeze(visit_info *info)>
=item C<void thaw(visit_info *info)>
Freeze/thaw interface used during freeze/thaw of the Sub PMC.
The implementation of the Hash PMC is called.
=cut
*/
VTABLE void visit(visit_info *info) {
Parrot_Hash_visit(INTERP, SELF, info);
}
VTABLE void freeze(visit_info *info) {
Parrot_Hash_freeze(INTERP, SELF, info);
}
VTABLE void thaw(visit_info *info) {
IMAGE_IO * const io = info->image_io;
if (info->extra_flags == EXTRA_IS_NULL) {
const INTVAL elems = VTABLE_shift_integer(INTERP, io);
const INTVAL k_type = VTABLE_shift_integer(INTERP, io);
const INTVAL v_type = VTABLE_shift_integer(INTERP, io);
Hash *hash;
UNUSED(k_type);
UNUSED(v_type);
PARROT_ASSERT(v_type == enum_hash_int);
/* TODO make a better interface for hash creation
* TODO create hash with needed types in the first place
*/
SELF.init_pmc(NULL);
hash = (Hash *)PMC_struct_val(SELF);
hash->entries = elems;
}
else {
SUPER(info);
}
}
}
/*
=back
=head1 SEE ALSO
F<docs/pdds/pdd20_lexical_vars.pod>, F<src/classes/lexpad.pmc>.
=cut
*/
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4:
*/