Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
261 lines (184 sloc) 6.86 KB
/*
** experimental.ops
*/
=head1 NAME
experimental.ops - Experimental Opcodes
=cut
=head1 DESCRIPTION
This file contains experimental opcodes.
These opcodes should be considered implicitly deprecated - that is, they
may be removed in any release.
If you rely on any of these opcodes, please open a
Trac ticket at L<https://trac.parrot.org/>.
When making changes to any ops file, run C<make bootstrap-ops> to regenerate
all generated ops files.
=cut
###############################################################################
=head2 More Experimental Ops
=over 4
=item C<trap>()
Break into debugger. Implementation notes:
- x86/gcc ... works with gdb
- ppc/gcc ... works with gdb, to proceed: gdb> p $pc = $pc + 4
- TODO
For other architectures, this is a C<noop>.
=cut
op trap() :deprecated {
#if defined(__GNUC__) && defined(i386)
__asm__("int3"); /* opcode 0xcc */
#endif
#if defined(__GNUC__) && defined(PPC)
__asm__("trap"); /* opcode tr 31, 0, 0 */
#endif
}
=item C<set_label(invar PMC, inconst LABEL)>
Sets the opcode_t* label value for the given PMC. This is basically only
useful for PMCs such as Sub, Continuation, ExceptionHandler and derivatives
=item C<get_label(out INT, invar PMC)>
Gets the opcode_t* label value from the given PMC. This is basically only
useful for PMCs such as Sub, Continuation, ExceptionHandler and derivatives
=cut
inline op set_label(invar PMC, inconst LABEL) {
VTABLE_set_pointer(interp, $1, (CUR_OPCODE + $2));
}
inline op get_label(out INT, invar PMC) {
void * const ptr = VTABLE_get_pointer(interp, $2);
$1 = PTR2INTVAL(ptr);
}
=item C<fetch(out PMC, in PMC, in PMC, in PMC)>
=item C<fetch(out PMC, in PMC, in INT, in PMC)>
=item C<fetch(out PMC, in PMC, in STR, in PMC)>
Fetches a value from $2, keyed by $3 into $1. If the resulting PMC is PMCNULL,
uses the type in $4 to create and return a new PMC.
=cut
inline op fetch(out PMC, in PMC, in PMC, in PMC) :base_core {
$1 = VTABLE_get_pmc_keyed(interp, $2, $3);
Parrot_stock_fetch(interp, $1, $4);
}
inline op fetch(out PMC, in PMC, in INT, in PMC) :base_core {
$1 = VTABLE_get_pmc_keyed_int(interp, $2, $3);
Parrot_stock_fetch(interp, $1, $4);
}
inline op fetch(out PMC, in PMC, in STR, in PMC) :base_core {
$1 = VTABLE_get_pmc_keyed_str(interp, $2, $3);
Parrot_stock_fetch(interp, $1, $4);
}
=item C<vivify(out PMC, in PMC, in PMC, in PMC)>
=item C<vivify(out PMC, in PMC, in INT, in PMC)>
=item C<vivify(out PMC, in PMC, in STR, in PMC)>
Fetches a value from $2, keyed by $3 into $1. If the resulting PMC is PMCNULL,
uses the type in $4 to create and return a new PMC.
=cut
inline op vivify(out PMC, in PMC, in PMC, in PMC) :base_core {
$1 = VTABLE_get_pmc_keyed(interp, $2, $3);
if (PMC_IS_NULL($1)) {
Parrot_stock_vivify(interp, $1, $4);
VTABLE_set_pmc_keyed(interp, $2, $3, $1);
}
}
inline op vivify(out PMC, in PMC, in INT, in PMC) :base_core {
$1 = VTABLE_get_pmc_keyed_int(interp, $2, $3);
if (PMC_IS_NULL($1)) {
Parrot_stock_vivify(interp, $1, $4);
VTABLE_set_pmc_keyed_int(interp, $2, $3, $1);
}
}
inline op vivify(out PMC, in PMC, in STR, in PMC) :base_core {
$1 = VTABLE_get_pmc_keyed_str(interp, $2, $3);
if (PMC_IS_NULL($1)) {
Parrot_stock_vivify(interp, $1, $4);
VTABLE_set_pmc_keyed_str(interp, $2, $3, $1);
}
}
=item C<new(out PMC, in STR, in INT)>
=item C<new(out PMC, in PMC, in INT)>
=cut
op new(out PMC, in STR, in INT) {
STRING * const name = $2;
PMC * const _class = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp))
? Parrot_oo_get_class_str(interp, name)
: PMCNULL;
if (!PMC_IS_NULL(_class)) {
PMC * const initial = Parrot_pmc_new(interp,
Parrot_hll_get_ctx_HLL_type(interp, enum_class_Integer));
VTABLE_set_integer_native(interp, initial, $3);
$1 = VTABLE_instantiate(interp, _class, initial);
}
else {
const INTVAL type = Parrot_pmc_get_type_str(interp, name);
if (type <= 0) {
opcode_t *dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(),
EXCEPTION_NO_CLASS,
"Class '%Ss' not found", name);
goto ADDRESS(dest);
}
$1 = Parrot_pmc_new_init_int(interp, type, $3);
}
}
op new(out PMC, in PMC, in INT) {
PMC * const name_key = $2;
/* get_class() returns a PMCProxy for core types, so check for core PMCs */
const INTVAL type = Parrot_pmc_get_type(interp, name_key);
/* if it's clearly a PIR-level PMC */
if (type > enum_class_core_max) {
PMC * const _class = Parrot_oo_get_class(interp, name_key);
if (!PMC_IS_NULL(_class)) {
PMC * const initial = Parrot_pmc_new(interp,
Parrot_hll_get_ctx_HLL_type(interp, enum_class_Integer));
VTABLE_set_integer_native(interp, initial, $3);
$1 = VTABLE_instantiate(interp, _class, initial);
}
}
/* if it's a core PMC */
else if (type > enum_class_default)
$1 = Parrot_pmc_new_init_int(interp, type, $3);
/* it's a typo */
else {
opcode_t * const dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(),
EXCEPTION_NO_CLASS,
"Class '%Ss' not found", VTABLE_get_repr(interp, name_key));
goto ADDRESS(dest);
}
}
=item C<root_new(out PMC, in PMC, in INT)>
=cut
op root_new(out PMC, in PMC, in INT) {
PMC * const name_key = $2;
/* get_class() returns a PMCProxy for core types, so check for core PMCs */
const INTVAL type = Parrot_pmc_get_type(interp, name_key);
/* if it's clearly a PIR-level PMC */
if (type > enum_class_core_max) {
PMC * const root_ns = interp->root_namespace;
PMC * const ns = Parrot_ns_get_namespace_keyed(interp, root_ns, name_key);
PMC * const _class = Parrot_oo_get_class(interp, ns);
if (!PMC_IS_NULL(_class)) {
PMC * const initial = Parrot_pmc_new(interp,
Parrot_hll_get_ctx_HLL_type(interp, enum_class_Integer));
VTABLE_set_integer_native(interp, initial, $3);
$1 = VTABLE_instantiate(interp, _class, initial);
}
}
/* if it's a core PMC */
else if (type > enum_class_default)
$1 = Parrot_pmc_new_init_int(interp, type, $3);
/* it's a typo */
else {
opcode_t * const dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(),
EXCEPTION_NO_CLASS,
"Class '%Ss' not found", VTABLE_get_repr(interp, name_key));
goto ADDRESS(dest);
}
}
=back
=head1 COPYRIGHT
Copyright (C) 2001-2011, Parrot Foundation.
=head1 LICENSE
This program is free software. It is subject to the same license
as the Parrot interp itself.
=cut
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
*/
Something went wrong with that request. Please try again.