22
22
static INTVAL p6s_id = 0;
23
23
static INTVAL or_id = 0;
24
24
static INTVAL lls_id = 0;
25
static INTVAL obj_id = 0;
26
static INTVAL p6o_id = 0;
28
static STRING *LLSIG_ATTR_str;
29
static STRING *BANG_LLSIG_str;
30
static STRING *DISPATCH_JUNCTION_str;
26
32
/* Plus a function pointer to the binder. */
27
typedef INTVAL (*bind_signature_func_type) (PARROT_INTERP, PMC *lexpad,
28
PMC *signature, PMC *capture, INTVAL no_nom_type_check, STRING **error);
33
typedef INTVAL (*bind_llsig_func_type) (PARROT_INTERP, PMC *lexpad,
34
PMC *llsig, PMC *capture, INTVAL no_nom_type_check, STRING **error);
30
static bind_signature_func_type bind_signature_func = NULL;
36
static bind_llsig_func_type bind_llsig_func = NULL;
43
49
inline op rakudo_dynop_setup() :base_core {
44
50
/* Look up some type IDs. */
45
p6s_id = pmc_type(interp, string_from_literal(interp, "Perl6Scalar"));
46
or_id = pmc_type(interp, string_from_literal(interp, "ObjectRef"));
47
lls_id = pmc_type(interp, string_from_literal(interp, "P6LowLevelSig"));
51
p6s_id = pmc_type(interp, Parrot_str_new(interp, "Perl6Scalar", 0));
52
or_id = pmc_type(interp, Parrot_str_new(interp, "ObjectRef", 0));
53
lls_id = pmc_type(interp, Parrot_str_new(interp, "P6LowLevelSig", 0));
54
p6o_id = pmc_type(interp, Parrot_str_new(interp, "P6opaque", 0));
55
obj_id = enum_class_Object;
57
BANG_LLSIG_str = Parrot_str_new_constant(interp, "!llsig");
58
LLSIG_ATTR_str = Parrot_str_new_constant(interp, "$!llsig");
59
DISPATCH_JUNCTION_str = Parrot_str_new_constant(interp,
60
"!DISPATCH_JUNCTION_SINGLE");
49
62
/* Create dummy low level sig op and use its get_pointer to get a pointer
50
63
* to the signature binder. */
51
bind_signature_func = (bind_signature_func_type)VTABLE_get_pointer(interp, pmc_new(interp, lls_id));
64
bind_llsig_func = (bind_llsig_func_type)VTABLE_get_pointer(interp, pmc_new(interp, lls_id));
123
135
* in the end we will end up with just as many PMCs existing. */
124
136
PMC * const temp = mem_allocate_typed(PMC);
125
137
PMC * const proxy = VTABLE_get_attr_keyed(interp, new_ins, current_class,
126
string_from_literal(interp, "proxy"));
138
Parrot_str_new(interp, "proxy", 0));
127
139
Parrot_block_GC_mark(interp);
129
141
/* Using memcpy here may trigger gcc optimizations, which at this point
142
154
for (i = 0; i < new_attribs; i++)
143
155
VTABLE_set_pmc_keyed_int(interp, PARROT_OBJECT(value)->attrib_store,
144
156
i, pmc_new(interp, enum_class_Undef));
146
/* And make sure the new object is of the right type. */
147
new_ins->vtable = interp->vtables[p6opaque];
149
else if ((value->vtable->base_type != enum_class_Object && value->vtable->base_type != p6opaque)
158
else if ((value->vtable->base_type != enum_class_Object && value->vtable->base_type != p6o_id)
150
159
|| current_class->vtable->base_type != enum_class_Class) {
151
160
/* If we're here, we found a really odd state - the class claims to be
152
161
* a standard Parrot one but the object it supposedly created is not.
306
315
inline op get_next_candidate_info(out PMC, out PMC, out PMC) :base_core {
307
316
PMC *ctx = Parrot_pcc_get_caller_ctx(interp, CURRENT_CONTEXT(interp));
308
STRING *name = string_from_literal(interp, "__CANDIDATE_LIST__");
309
STRING *wrapper = string_from_literal(interp, "$!wrapper_block");
310
PMC *last_lexpad = PMCNULL;
311
PMC *last_sub = PMCNULL;
317
STRING * const name = Parrot_str_new(interp, "__CANDIDATE_LIST__", 0);
313
319
while (!PMC_IS_NULL(ctx)) {
314
320
/* See if we've found a candidate list. */
315
PMC *lexpad = Parrot_pcc_get_lex_pad(interp, ctx);
316
PMC *clist = VTABLE_get_pmc_keyed_str(interp, lexpad, name);
321
PMC * const lexpad = Parrot_pcc_get_lex_pad(interp, ctx);
322
PMC * const clist = VTABLE_get_pmc_keyed_str(interp, lexpad, name);
317
323
if (!PMC_IS_NULL(clist)) {
318
324
/* Found. Set results and we're done. */
320
if (PMC_IS_NULL(VTABLE_getprop(interp, Parrot_pcc_get_sub(interp, ctx), wrapper))) {
321
$2 = Parrot_pcc_get_sub(interp, ctx);
326
$2 = Parrot_pcc_get_sub(interp, ctx);
331
331
/* Not found; keep looking. */
332
last_sub = Parrot_pcc_get_sub(interp, ctx);
333
last_lexpad = lexpad;
334
332
ctx = Parrot_pcc_get_outer_ctx(interp, ctx);
355
353
inline op transform_to_p6opaque(inout PMC) :base_core {
356
354
/* Sanity check. */
357
355
if ($1->vtable->base_type == enum_class_Object) {
358
INTVAL type_id = pmc_type(interp, string_from_literal(interp, "P6opaque"));
359
$1->vtable = interp->vtables[type_id];
356
$1->vtable = interp->vtables[p6o_id];
363
opcode_t *handler = Parrot_ex_throw_from_op_args(interp, NULL,
360
opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, NULL,
364
361
EXCEPTION_INVALID_OPERATION, "Can only transform an Object to p6opaque");
365
362
goto ADDRESS(handler);
413
=item allocate_signature(out PMC, in INT)
410
=item deref_unless_object(out PMC, in PMC)
412
If the value underlying $2 is anything but an Object or P6opaque,
413
return that value; otherwise return $2.
418
inline op deref_unless_object(out PMC, in PMC) :base_core {
421
while (val->vtable->base_type == or_id || val->vtable->base_type == p6s_id)
422
val = VTABLE_get_pmc(interp, val);
423
$1 = (val->vtable->base_type == obj_id || val->vtable->base_type == p6o_id)
431
=item allocate_llsig(out PMC, in INT)
415
433
Sets $1 to be a P6LowLevelSig with $2 signature elements allocated.
420
inline op allocate_signature(out PMC, in INT) :base_core {
421
struct llsig_element **elements;
438
inline op allocate_llsig(out PMC, in INT) :base_core {
424
439
/* Create new low level signature PMC. */
425
$1 = pmc_new(interp, lls_id);
427
/* Allocate required amount of structs. */
428
elements = (struct llsig_element **)mem_sys_allocate(($2 + 1) * sizeof(llsig_element *));
430
for (i = 0; i < $2; i++)
431
elements[i] = (llsig_element *)mem_sys_allocate_zeroed(sizeof(llsig_element));
433
SETATTR_P6LowLevelSig_elements(interp, $1, elements);
436
SETATTR_P6LowLevelSig_num_elements(interp, $1, $2);
440
$1 = Parrot_pmc_new_init_int(interp, lls_id, $2);
444
=item get_signature_size(out INT, in PMC)
447
=item get_llsig_size(out INT, in PMC)
446
449
Sets $1 to be the number of elements the P6LowLevelSig $2 has.
451
inline op get_signature_size(out INT, in PMC) :base_core {
454
inline op get_llsig_size(out INT, in PMC) :base_core {
452
455
if ($2->vtable->base_type == lls_id) {
453
456
INTVAL num_elements;
454
457
GETATTR_P6LowLevelSig_num_elements(interp, $2, num_elements);
468
=item set_signature_elem(in PMC, in INT, in STR, in INT, inout PMC, inout PMC, inout PMC, inout PMC, inout PMC, inout PMC)
471
=item set_llsig_elem(in PMC, in INT, in STR, in INT, inout PMC, inout PMC, inout PMC, inout PMC, inout PMC, inout PMC, in STR)
470
473
Takes $1 (a P6LowLevelSig) and sets the contents of the signature element with
471
474
index $2 as follows:
478
481
$8 = array of type captures
479
482
$9 = default value closure
480
483
$10 = nested signature
484
$11 = name of coercion method to call, if any
485
inline op set_signature_elem(in PMC, in INT, in STR, in INT, inout PMC, inout PMC, inout PMC, inout PMC, inout PMC, inout PMC) :base_core {
489
inline op set_llsig_elem(in PMC, in INT, in STR, in INT, inout PMC, inout PMC, inout PMC, inout PMC, inout PMC, inout PMC, in STR) :base_core {
486
490
if ($1->vtable->base_type == lls_id) {
487
491
struct llsig_element **elements;
488
492
INTVAL num_elements;
492
496
GETATTR_P6LowLevelSig_num_elements(interp, $1, num_elements);
493
497
if ($2 < num_elements) {
494
498
/* Set up sig. */
495
struct llsig_element *element = elements[$2];
499
struct llsig_element * const element = elements[$2];
496
500
element->variable_name = $3;
497
501
element->flags = $4;
498
502
element->post_constraints = $6;
499
503
element->named_names = $7;
500
504
element->type_captures = $8;
501
505
element->default_closure = $9;
502
element->sub_signature = $10;
506
element->sub_llsig = $10;
507
element->coerce_to = $11;
504
509
/* Also need to do fixups on the nominal type. */
505
510
if (!PMC_IS_NULL($5)) {
506
PMC *refined = VTABLE_getprop(interp, $5, string_from_literal(interp, "subtype_realtype"));
511
PMC *refined = VTABLE_getprop(interp, $5, Parrot_str_new(interp, "subtype_realtype", 0));
507
512
if (PMC_IS_NULL(refined)) {
508
513
/* It's not some subtype, we're fine. */
509
514
element->nominal_type = $5;
520
element->nominal_type = Parrot_find_global_n(interp, Parrot_get_ctx_HLL_namespace(interp),
521
string_from_literal(interp, "Object"));
525
element->nominal_type = Parrot_ns_find_namespace_global(interp, Parrot_hll_get_ctx_HLL_namespace(interp),
526
Parrot_str_new(interp, "Mu", 0));
527
opcode_t *handler = Parrot_ex_throw_from_op_args(interp, NULL,
528
EXCEPTION_INVALID_OPERATION, "signature element out of range in set_signature_elem");
532
opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, NULL,
533
EXCEPTION_INVALID_OPERATION, "signature element out of range in set_llsig_elem");
529
534
goto ADDRESS(handler);
533
opcode_t *handler = Parrot_ex_throw_from_op_args(interp, NULL,
534
EXCEPTION_INVALID_OPERATION, "set_signature_elem only works on P6LowLevelSig PMCs");
538
opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, NULL,
539
EXCEPTION_INVALID_OPERATION, "set_llsig_elem only works on P6LowLevelSig PMCs");
535
540
goto ADDRESS(handler);
542
=item get_signature_elem(in PMC, in INT, out STR, out INT, out PMC, out PMC, out PMC, out PMC, out PMC, out PMC, out PMC)
547
=item get_llsig_elem(in PMC, in INT, out STR, out INT, out PMC, out PMC, out PMC, out PMC, out PMC, out PMC, out PMC, out STR)
544
549
Takes $1 (a P6LowLevelSig) and sets the registers with the contents of the
545
550
signature element with index $2 as follows:
552
557
$8 = array of type captures
553
558
$9 = default value closure
554
559
$10 = nested signature
560
$11 = name of coercion method to call, if any
559
inline op get_signature_elem(in PMC, in INT, out STR, out INT, out PMC, out PMC, out PMC, out PMC, out PMC, out PMC) :base_core {
565
inline op get_llsig_elem(in PMC, in INT, out STR, out INT, out PMC, out PMC, out PMC, out PMC, out PMC, out PMC, out STR) :base_core {
560
566
if ($1->vtable->base_type == lls_id) {
561
567
struct llsig_element **elements;
562
568
INTVAL num_elements;
573
579
$7 = element->named_names;
574
580
$8 = element->type_captures;
575
581
$9 = element->default_closure;
576
$10 = element->sub_signature;
582
$10 = element->sub_llsig;
583
$11 = element->coerce_to;
580
opcode_t *handler = Parrot_ex_throw_from_op_args(interp, NULL,
581
EXCEPTION_INVALID_OPERATION, "signature element out of range in set_signature_elem");
587
opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, NULL,
588
EXCEPTION_INVALID_OPERATION, "signature element out of range in set_llsig_elem");
582
589
goto ADDRESS(handler);
586
opcode_t *handler = Parrot_ex_throw_from_op_args(interp, NULL,
587
EXCEPTION_INVALID_OPERATION, "get_signature_elem only works on P6LowLevelSig PMCs");
593
opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, NULL,
594
EXCEPTION_INVALID_OPERATION, "get_llsig_elem only works on P6LowLevelSig PMCs");
588
595
goto ADDRESS(handler);
605
inline op bind_signature(in PMC) :base_core {
606
PMC *ctx = CURRENT_CONTEXT(interp);
612
inline op bind_llsig(in PMC) :base_core {
613
PMC * const ctx = CURRENT_CONTEXT(interp);
608
615
/* If we aren't already bound, enter the appropriate binder. */
609
616
if (!PObj_flag_TEST(P6S_ALREADY_BOUND, ctx)) {
610
PMC *lexpad = Parrot_pcc_get_lex_pad(interp, ctx);
611
PMC *sub = Parrot_pcc_get_sub(interp, ctx);
612
PMC *signature = VTABLE_getprop(interp, sub, string_from_literal(interp, "$!signature"));
613
INTVAL noms_checked = PObj_flag_TEST(P6S_ALREADY_CHECKED, ctx);
617
PMC * const lexpad = Parrot_pcc_get_lex_pad(interp, ctx);
618
PMC * const sub = Parrot_pcc_get_sub(interp, ctx);
619
PMC * const llsig = VTABLE_getprop(interp, sub, LLSIG_ATTR_str);
620
const INTVAL noms_checked = PObj_flag_TEST(P6S_ALREADY_CHECKED, ctx);
614
621
STRING *error = NULL;
616
624
/* Need to make sure some stuff doesn't get destroyed. */
617
PMC * ctx = CURRENT_CONTEXT(interp);
625
PMC * const ctx = CURRENT_CONTEXT(interp); /* XXX This ctx shadows the outer one. */
618
626
PMC * const saved_ccont = interp->current_cont;
619
627
PMC * const saved_sig = Parrot_pcc_get_signature(interp, ctx);
620
PMC * const saved_rs = Parrot_pcc_get_results_signature(interp, ctx);
621
opcode_t * const saved_cr = Parrot_pcc_get_results(interp, ctx);
622
628
opcode_t * const current_pc = Parrot_pcc_get_pc(interp, ctx);
630
/* Ensure we actually have a signature; if not, try to lazily generate
632
if (PMC_IS_NULL(llsig)) {
633
PMC * const sig_meth = VTABLE_find_method(interp, sub, BANG_LLSIG_str);
634
Parrot_ext_call(interp, sig_meth, "P->P", sub, &llsig);
624
637
/* Call signature binder. */
625
INTVAL bind_error = bind_signature_func(interp, lexpad, signature, $1, noms_checked, &error);
638
bind_error = bind_llsig_func(interp, lexpad, llsig, $1, noms_checked, &error);
628
641
if (!bind_error) {
629
642
/* Re-instate anything we may have damaged. */
630
643
CURRENT_CONTEXT(interp) = ctx;
631
interp->current_cont = saved_ccont;
644
interp->current_cont = saved_ccont;
632
645
Parrot_pcc_set_signature(interp, ctx, saved_sig);
633
Parrot_pcc_set_results_signature(interp, ctx, saved_rs);
634
Parrot_pcc_set_results(interp, ctx, saved_cr);
635
646
Parrot_pcc_set_pc(interp, ctx, current_pc);
639
650
/* Maybe we need to auto-thread... */
640
651
if (bind_error == BIND_RESULT_JUNCTION) {
641
652
/* Find dispatcher and call it. */
642
PMC *dispatcher = Parrot_find_global_n(interp, Parrot_get_ctx_HLL_namespace(interp),
643
string_from_literal(interp, "!DISPATCH_JUNCTION_SINGLE"));
653
PMC * const returns = Parrot_pmc_new(interp, enum_class_CallContext);
654
PMC * const dispatcher = Parrot_ns_find_namespace_global(interp, Parrot_hll_get_ctx_HLL_namespace(interp), DISPATCH_JUNCTION_str);
645
PMC *junc_result, *caller_sig;
646
658
Parrot_ext_call(interp, dispatcher, "PP->P", sub, $1, &junc_result);
648
/* Re-instate anything we may have damaged. */
649
CURRENT_CONTEXT(interp) = ctx;
650
interp->current_cont = saved_ccont;
651
Parrot_pcc_set_signature(interp, ctx, saved_sig);
652
Parrot_pcc_set_results_signature(interp, ctx, saved_rs);
653
Parrot_pcc_set_results(interp, ctx, saved_cr);
654
Parrot_pcc_set_pc(interp, ctx, current_pc);
656
/* Save the Junctional result as the return value. */
657
caller_sig = Parrot_pcc_get_signature(interp, Parrot_pcc_get_caller_ctx(interp, ctx));
658
if (!PMC_IS_NULL(caller_sig))
659
Parrot_pcc_fill_returns_from_c_args(interp, caller_sig, "P", junc_result);
660
/* Build call signautre of returns and set it. */
661
VTABLE_push_pmc(interp, returns, junc_result);
662
Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), returns);
661
664
/* Invoke the current return continuation, to return said value. */
662
665
next = VTABLE_invoke(interp, Parrot_pcc_get_continuation(interp,
667
670
/* Nope, just normal fail... */
668
opcode_t *handler = Parrot_ex_throw_from_op_args(interp, NULL,
669
EXCEPTION_INVALID_OPERATION, Parrot_str_to_cstring(interp, error));
671
opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, NULL,
672
EXCEPTION_INVALID_OPERATION, "%Ss", error);
670
673
goto ADDRESS(handler);
685
=item x_setprophash(in PMC, in PMC)
687
Sets the properties hash of $1 to be $2.
692
inline op x_setprophash(in PMC, in PMC) :base_core {
693
PMC_metadata($1) = $2;
700
=item find_method_null_ok(out PMC, in PMC, in STR)
702
Like Parrot's find_method, but returns PMCNULL in $1 if $2 doesn't have a
703
method named $3 instead of throwing an exception.
708
inline op find_method_null_ok(out PMC, in PMC, in STR) :base_core {
709
$1 = VTABLE_find_method(interp, $2, $3);
716
=item fixup_outer_ctx(inout PMC)
721
inline op fixup_outer_ctx(inout PMC) :base_core {
722
PMC * const cur_ctx = CURRENT_CONTEXT(interp);
723
if ($1->vtable->base_type == enum_class_CallContext) {
724
Parrot_pcc_set_outer_ctx(interp, $1, cur_ctx);
728
opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, NULL,
729
EXCEPTION_INVALID_OPERATION, "fixup_outer_ctx only valid on a context");
730
goto ADDRESS(handler);
737
=item encodelocaltime(out INT, in PMC)
739
The inverse of C<decodelocaltime>.
744
inline op encodelocaltime(out INT, in PMC) :base_core {
747
tm.tm_sec = VTABLE_get_integer_keyed_int(interp, $2, 0);
748
tm.tm_min = VTABLE_get_integer_keyed_int(interp, $2, 1);
749
tm.tm_hour = VTABLE_get_integer_keyed_int(interp, $2, 2);
750
tm.tm_mday = VTABLE_get_integer_keyed_int(interp, $2, 3);
751
tm.tm_mon = VTABLE_get_integer_keyed_int(interp, $2, 4) - 1;
752
tm.tm_year = VTABLE_get_integer_keyed_int(interp, $2, 5) - 1900;
753
/* We needn't bother setting tm_wday or tm_yday, since mktime
754
is required to ignore them. */
755
tm.tm_isdst = VTABLE_get_integer_keyed_int(interp, $2, 8);
680
762
* Local variables:
681
763
* c-file-style: "parrot"
added
removed
src/ops/perl6.ops
