2 Copyright (C) 2001-2003, The Perl Foundation.
7 src/key.c - Base vtable calling functions
11 The base vtable calling functions.
21 #include "parrot/parrot.h"
26 key_new(Interp *interp)>
28 Returns a new C<Key> PMC.
35 key_new(Interp
*interp
)
37 PMC
*key
= pmc_new(interp
, enum_class_Key
);
45 key_new_integer(Interp *interp, INTVAL value)>
47 Returns a new integer C<Key> PMC with value C<value>.
54 key_new_integer(Interp
*interp
, INTVAL value
)
56 PMC
*key
= pmc_new(interp
, enum_class_Key
);
58 PObj_get_FLAGS(key
) |= KEY_integer_FLAG
;
59 PMC_int_val(key
) = value
;
67 key_new_number(Interp *interp, FLOATVAL value)>
69 Returns a new number C<Key> PMC with value C<value>.
76 key_new_number(Interp
*interp
, FLOATVAL value
)
78 PMC
*key
= pmc_new(interp
, enum_class_Key
);
80 PObj_get_FLAGS(key
) |= KEY_number_FLAG
;
81 PMC_num_val(key
) = value
;
89 key_new_string(Interp *interp, STRING *value)>
91 Returns a new string C<Key> PMC with value C<value>.
98 key_new_string(Interp
*interp
, STRING
*value
)
100 PMC
*key
= pmc_new(interp
, enum_class_Key
);
102 PObj_get_FLAGS(key
) |= KEY_string_FLAG
;
103 PMC_str_val(key
) = value
;
111 key_new_cstring(Interp *interp, const char *value)>
113 Returns a new string C<Key> PMC with value C<value> converted to a
121 key_new_cstring(Interp
*interp
, const char *value
)
123 return key_new_string(interp
,
124 string_from_cstring(interp
, value
, 0));
130 key_new_pmc(Interp *interp, PMC *value)>
132 Returns a new PMC C<Key> PMC with value C<value>.
139 key_new_pmc(Interp
*interp
, PMC
*value
)
141 PMC
*key
= pmc_new(interp
, enum_class_Key
);
143 PObj_get_FLAGS(key
) |= KEY_pmc_FLAG
;
144 internal_exception(1, "this is broken - see slice.pmc");
145 PMC_pmc_val(key
) = value
;
153 key_set_integer(Interp *interp, PMC *key, INTVAL value)>
155 Set the integer C<value> in C<key>.
162 key_set_integer(Interp
*interp
, PMC
*key
, INTVAL value
)
164 PObj_get_FLAGS(key
) &= ~KEY_type_FLAGS
;
165 PObj_get_FLAGS(key
) |= KEY_integer_FLAG
;
166 PMC_int_val(key
) = value
;
174 key_set_register(Interp *interp, PMC *key, INTVAL value,
177 Set the register C<value> in C<key>.
184 key_set_register(Interp
*interp
, PMC
*key
, INTVAL value
,
187 PObj_get_FLAGS(key
) &= ~KEY_type_FLAGS
;
188 PObj_get_FLAGS(key
) |= KEY_register_FLAG
| flag
;
189 PMC_int_val(key
) = value
;
197 key_set_number(Interp *interp, PMC *key, FLOATVAL value)>
199 Set the number C<value> in C<key>.
206 key_set_number(Interp
*interp
, PMC
*key
, FLOATVAL value
)
208 PObj_get_FLAGS(key
) &= ~KEY_type_FLAGS
;
209 PObj_get_FLAGS(key
) |= KEY_number_FLAG
;
210 PMC_num_val(key
) = value
;
218 key_set_string(Interp *interp, PMC *key, STRING *value)>
220 Set the string C<value> in C<key>.
227 key_set_string(Interp
*interp
, PMC
*key
, STRING
*value
)
229 PObj_get_FLAGS(key
) &= ~KEY_type_FLAGS
;
230 PObj_get_FLAGS(key
) |= KEY_string_FLAG
;
231 PMC_str_val(key
) = value
;
239 key_set_pmc(Interp *interp, PMC *key, PMC *value)>
241 Set the PMC C<value> in C<key>.
248 key_set_pmc(Interp
*interp
, PMC
*key
, PMC
*value
)
250 PObj_get_FLAGS(key
) &= ~KEY_type_FLAGS
;
251 PObj_get_FLAGS(key
) |= KEY_pmc_FLAG
;
254 * what for is this indirection?
256 internal_exception(1, "this is broken - see slice.pmc");
257 PMC_pmc_val(key
) = value
;
265 key_type(Interp *interp, PMC *key)>
267 Returns the type of C<key>.
274 key_type(Interp
*interp
, PMC
*key
)
276 return (PObj_get_FLAGS(key
) & KEY_type_FLAGS
) & ~KEY_register_FLAG
;
282 key_integer(Interp *interp, PMC *key)>
289 key_integer(Interp
*interp
, PMC
*key
)
294 switch (PObj_get_FLAGS(key
) & KEY_type_FLAGS
) {
295 case KEY_hash_iterator_FLAGS
:
296 case KEY_integer_FLAG
:
297 return PMC_int_val(key
);
298 case KEY_integer_FLAG
| KEY_register_FLAG
:
299 return REG_INT(PMC_int_val(key
));
300 case KEY_pmc_FLAG
| KEY_register_FLAG
:
301 reg
= REG_PMC(PMC_int_val(key
));
302 return VTABLE_get_integer(interp
, reg
);
303 case KEY_string_FLAG
:
304 return string_to_int(interp
, PMC_str_val(key
));
305 case KEY_string_FLAG
| KEY_register_FLAG
:
306 s_reg
= REG_STR(PMC_int_val(key
));
307 return string_to_int(interp
, s_reg
);
309 /* TODO check for slice_FLAGs */
310 return VTABLE_get_integer(interp
, key
);
317 key_number(Interp *interp, PMC *key)>
324 key_number(Interp
*interp
, PMC
*key
)
328 switch (PObj_get_FLAGS(key
) & KEY_type_FLAGS
) {
329 case KEY_number_FLAG
:
330 return PMC_num_val(key
);
331 case KEY_number_FLAG
| KEY_register_FLAG
:
332 return REG_NUM(PMC_int_val(key
));
334 return VTABLE_get_number(interp
, key
);
335 /* PMC_pmc_val(key)); */
336 case KEY_pmc_FLAG
| KEY_register_FLAG
:
337 reg
= REG_PMC(PMC_int_val(key
));
338 return VTABLE_get_number(interp
, reg
);
340 internal_exception(INVALID_OPERATION
, "Key not a number!\n");
348 key_string(Interp *interp, PMC *key)>
355 key_string(Interp
*interp
, PMC
*key
)
359 switch (PObj_get_FLAGS(key
) & KEY_type_FLAGS
) {
360 case KEY_string_FLAG
:
361 return PMC_str_val(key
);
362 case KEY_string_FLAG
| KEY_register_FLAG
:
363 return REG_STR(PMC_int_val(key
));
364 /* PMC_pmc_val(key)); */
365 case KEY_pmc_FLAG
| KEY_register_FLAG
:
366 reg
= REG_PMC(PMC_int_val(key
));
367 return VTABLE_get_string(interp
, reg
);
368 case KEY_integer_FLAG
:
369 return string_from_int(interp
, PMC_int_val(key
));
370 case KEY_integer_FLAG
| KEY_register_FLAG
:
371 return string_from_int(interp
, REG_INT(PMC_int_val(key
)));
374 return VTABLE_get_string(interp
, key
);
381 key_pmc(Interp *interp, PMC *key)>
383 These functions return the integer/number/string/PMC values of C<key> if
384 possible. Otherwise they throws an exceptions.
391 key_pmc(Interp
*interp
, PMC
*key
)
393 switch (PObj_get_FLAGS(key
) & KEY_type_FLAGS
) {
394 case KEY_pmc_FLAG
| KEY_register_FLAG
:
395 return REG_PMC(PMC_int_val(key
));
397 return key
; /* PMC_pmc_val(key); */
404 key_next(Interp *interp, PMC *key)>
406 Returns the next key if C<key> is in a sequence of linked keys.
413 key_next(Interp
*interp
, PMC
*key
)
417 return (PMC
*)PMC_data(key
);
423 key_append(Interp *interp, PMC *key1, PMC *key2)>
425 Appends C<key2> to C<key1>.
427 Note that if C<key1> is not the last key in a sequence linked keys then
428 the last key will be found and C<key2> appended to that.
437 key_append(Interp
*interp
, PMC
*key1
, PMC
*key2
)
441 while (PMC_data(tail
)) {
442 tail
= (PMC
*)PMC_data(tail
);
445 PMC_data(tail
) = key2
;
453 key_mark(Interp *interp, PMC *key)>
455 Marks C<key> as live.
462 key_mark(Interp
*interp
, PMC
*key
)
466 flags
= PObj_get_FLAGS(key
) & KEY_type_FLAGS
;
467 if (flags
== KEY_string_FLAG
)
468 pobject_lives(interp
, (PObj
*)PMC_str_val(key
));
470 * KEY_hash_iterator_FLAGS denote a hash key iteration, PMC_data() is
471 * the bucket_index and not the next key component
473 if (flags
== KEY_hash_iterator_FLAGS
)
476 /* if iteration hasn't started, above flag isn't set yet */
477 if (PMC_data(key
) && PMC_data(key
) != (void *)INITBucketIndex
)
478 pobject_lives(interp
, (PObj
*)PMC_data(key
));
485 key_set_to_string(Interp *interpreter, PMC *key)>
492 key_set_to_string(Interp
*interp
, PMC
*key
)
495 STRING
*semicolon
= string_from_cstring(interp
, " ; ", 3);
496 STRING
*quote
= string_from_cstring(interp
, "'", 1);
497 STRING
*value
= string_from_cstring(interp
, "[ ", 2);
499 for (; key
; key
= (PMC
*)PMC_data(key
)) {
500 switch (PObj_get_FLAGS(key
) & KEY_type_FLAGS
) {
501 case KEY_integer_FLAG
:
502 string_append(interp
, value
, string_from_int(interp
, PMC_int_val(key
)));
504 case KEY_string_FLAG
:
505 string_append(interp
, value
, quote
);
506 string_append(interp
, value
, PMC_str_val(key
));
507 string_append(interp
, value
, quote
);
510 string_append(interp
, value
, VTABLE_get_string(interp
, key
));
512 case KEY_integer_FLAG
| KEY_register_FLAG
:
513 string_append(interp
, value
, string_from_int(interp
, REG_INT(PMC_int_val(key
))));
515 case KEY_string_FLAG
| KEY_register_FLAG
:
516 string_append(interp
, value
, quote
);
517 string_append(interp
, value
, REG_STR(PMC_int_val(key
)));
518 string_append(interp
, value
, quote
);
520 case KEY_pmc_FLAG
| KEY_register_FLAG
:
521 reg
= REG_PMC(PMC_int_val(key
));
522 string_append(interp
, value
, VTABLE_get_string(interp
, reg
));
525 string_append(interp
, value
, string_from_cstring(interp
, "Key type unknown", 0));
530 string_append(interp
, value
, semicolon
);
532 string_append(interp
, value
, string_from_cstring(interp
, " ]", 2));
542 F<include/parrot/key.h>.
546 Initial version by Jeff G. on 2001.12.05.
555 * c-file-style: "parrot"
557 * vim: expandtab shiftwidth=4: