1 /*
2 Copyright (C) 2009-2014, Parrot Foundation.
3
4 =head1 NAME
5
6 src/context.c
7
8 =head1 DESCRIPTION
9
10 Parrot_Context functions.
11
12 =cut
13
14 */
15
16 #include "parrot/parrot.h"
17 #include "parrot/call.h"
18 #include "pmc/pmc_sub.h"
19 #include "pmc/pmc_callcontext.h"
20 #include "pmc/pmc_continuation.h"
21 #include "pmc/pmc_proxy.h"
22
23 /*
24
25 =head2 Context and register frame layout
26
27 +----------++----+------+------------+----+
28 | context || N | I | P | S +
29 +----------++----+------+------------+----+
30 ^ ^ ^ ^
31 | | ctx.bp ctx.bp_ps
32 ctx.state opt
33 padding
34
35 Registers are addressed as usual via the register base pointer ctx.bp.
36
37 The macro CONTEXT() hides these details
38
39 =cut
40
41 */
42
43 #define ALIGNED_CTX_SIZE (((sizeof (Parrot_Context) + NUMVAL_SIZE - 1) \
44 / NUMVAL_SIZE) * NUMVAL_SIZE)
45
46 /*
47
48 =head2 Allocation Size
49
50 Round register allocation size up to the nearest multiple of 8. A granularity
51 of 8 is arbitrary, it could have been some bigger power of 2. A "slot" is an
52 index into the free_list array. Each slot in free_list has a linked list of
53 pointers to already allocated contexts available for (re)use. The slot where
54 an available context is stored corresponds to the size of the context.
55
56 =cut
57
58 */
59
60 #define SLOT_CHUNK_SIZE 8
61
62 #define ROUND_ALLOC_SIZE(size) ((((size) + SLOT_CHUNK_SIZE - 1) \
63 / SLOT_CHUNK_SIZE) * SLOT_CHUNK_SIZE)
64 #define CALCULATE_SLOT_NUM(size) ((size) / SLOT_CHUNK_SIZE)
65
66
67 /* HEADERIZER HFILE: include/parrot/call.h */
68
69 /* HEADERIZER BEGIN: static */
70 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
71
72 static void allocate_registers(PARROT_INTERP,
73 ARGIN(PMC *pmcctx),
74 ARGIN(const UINTVAL *number_regs_used))
75 __attribute__nonnull__(1)
76 __attribute__nonnull__(2)
77 __attribute__nonnull__(3);
78
79 PARROT_WARN_UNUSED_RESULT
80 PARROT_PURE_FUNCTION
81 static size_t calculate_registers_size(PARROT_INTERP,
82 ARGIN(const UINTVAL *number_regs_used))
83 __attribute__nonnull__(2);
84
85 static void clear_regs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx))
86 __attribute__nonnull__(1)
87 __attribute__nonnull__(2)
88 FUNC_MODIFIES(*ctx);
89
90 PARROT_CANNOT_RETURN_NULL
91 static PMC* init_context(ARGMOD(PMC *pmcctx), ARGIN_NULLOK(PMC *pmcold))
92 __attribute__nonnull__(1)
93 FUNC_MODIFIES(*pmcctx);
94
95 PARROT_WARN_UNUSED_RESULT
96 PARROT_PURE_FUNCTION
97 static size_t Parrot_pcc_calculate_registers_size(PARROT_INTERP,
98 ARGIN(const UINTVAL *number_regs_used))
99 __attribute__nonnull__(1)
100 __attribute__nonnull__(2);
101
102 static void set_context(PARROT_INTERP, ARGIN(PMC *ctx))
103 __attribute__nonnull__(1)
104 __attribute__nonnull__(2);
105
106 #define ASSERT_ARGS_allocate_registers __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
107 PARROT_ASSERT_ARG(interp) \
108 , PARROT_ASSERT_ARG(pmcctx) \
109 , PARROT_ASSERT_ARG(number_regs_used))
110 #define ASSERT_ARGS_calculate_registers_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
111 PARROT_ASSERT_ARG(number_regs_used))
112 #define ASSERT_ARGS_clear_regs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
113 PARROT_ASSERT_ARG(interp) \
114 , PARROT_ASSERT_ARG(ctx))
115 #define ASSERT_ARGS_init_context __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
116 PARROT_ASSERT_ARG(pmcctx))
117 #define ASSERT_ARGS_Parrot_pcc_calculate_registers_size \
118 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
119 PARROT_ASSERT_ARG(interp) \
120 , PARROT_ASSERT_ARG(number_regs_used))
121 #define ASSERT_ARGS_set_context __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
122 PARROT_ASSERT_ARG(interp) \
123 , PARROT_ASSERT_ARG(ctx))
124 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
125 /* HEADERIZER END: static */
126
127
128 /*
129
130 =head2 Context API Functions
131
132 =over 4
133
134 =item C<PMC* Parrot_pcc_get_sub(PARROT_INTERP, const PMC *ctx)>
135
136 Get Sub executed inside Context.
137
138 =cut
139
140 */
141
142 PARROT_EXPORT
143 PARROT_PURE_FUNCTION
144 PARROT_CAN_RETURN_NULL
145 PMC*
Parrot_pcc_get_sub(SHIM_INTERP,ARGIN (const PMC * ctx))146 Parrot_pcc_get_sub(SHIM_INTERP, ARGIN(const PMC *ctx))
147 {
148 ASSERT_ARGS(Parrot_pcc_get_sub)
149 const Parrot_Context * const c = CONTEXT_STRUCT(ctx);
150 return c->current_sub;
151 }
152
153
154 /*
155
156 =item C<void Parrot_pcc_set_sub(PARROT_INTERP, PMC *ctx, PMC *sub)>
157
158 Set Sub executed inside Context.
159
160 =cut
161
162 */
163
164 PARROT_EXPORT
165 void
Parrot_pcc_set_sub(PARROT_INTERP,ARGIN (PMC * ctx),ARGIN_NULLOK (PMC * sub))166 Parrot_pcc_set_sub(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN_NULLOK(PMC *sub))
167 {
168 ASSERT_ARGS(Parrot_pcc_set_sub)
169 Parrot_Context * const c = CONTEXT_STRUCT(ctx);
170 c->current_sub = sub;
171
172 if (sub && !PMC_IS_NULL(sub)) {
173 Parrot_Sub_attributes *subattr;
174
175 PMC_get_sub(interp, sub, subattr);
176
177 c->current_pc = subattr->seg->base.data + subattr->start_offs;
178 c->current_HLL = subattr->HLL_id;
179 #ifdef THREAD_DEBUG
180 PARROT_ASSERT(
181 PObj_is_shared_TEST(sub)
182 || subattr->namespace_stash == NULL
183 || subattr->namespace_stash->orig_interp == interp);
184 #endif
185 c->current_namespace = subattr->namespace_stash;
186 }
187 }
188
189
190 /*
191
192 =back
193
194 =head2 Context and Register Allocation Functions
195
196 =over 4
197
198 =item C<void create_initial_context(PARROT_INTERP)>
199
200 Creates the interpreter's initial context.
201
202 =cut
203
204 */
205
206 void
create_initial_context(PARROT_INTERP)207 create_initial_context(PARROT_INTERP)
208 {
209 ASSERT_ARGS(create_initial_context)
210 static const UINTVAL num_regs[] = {32, 32, 32, 32};
211
212 /* Create some initial free_list slots. */
213 #define INITIAL_FREE_SLOTS 8
214
215 /* For now create context with 32 regs each. Some src tests (and maybe
216 * other extenders) assume the presence of these registers */
217 PMC * const ctx = Parrot_set_new_context(interp, num_regs);
218 if (!ctx)
219 Parrot_x_panic_and_exit(interp, "Out of mem", __FILE__, __LINE__);
220 }
221
222 /*
223
224 =item C<static PMC* init_context(PMC *pmcctx, PMC *pmcold)>
225
226 Initializes a freshly allocated or recycled context and returns the new one.
227
228 =cut
229
230 */
231
232 PARROT_CANNOT_RETURN_NULL
233 static PMC*
init_context(ARGMOD (PMC * pmcctx),ARGIN_NULLOK (PMC * pmcold))234 init_context(ARGMOD(PMC *pmcctx), ARGIN_NULLOK(PMC *pmcold))
235 {
236 ASSERT_ARGS(init_context)
237 Parrot_Context * const ctx = CONTEXT_STRUCT(pmcctx);
238
239 PARROT_ASSERT_MSG(!PMC_IS_NULL(pmcctx), "Can't initialise Null CallContext");
240
241 PARROT_ASSERT(PMC_IS_NULL(pmcold) || pmcold->vtable->base_type == enum_class_CallContext);
242
243 /*
244 * FIXME Invoking corotine shouldn't initialise context. So just
245 * check ctx->current_sub. If it's not null return from here
246 */
247 if (LIKELY(!PMC_IS_NULL(ctx->current_sub)))
248 return pmcctx;
249
250 ctx->lex_pad = PMCNULL;
251 ctx->outer_ctx = NULL;
252 ctx->current_cont = NULL;
253 ctx->handlers = PMCNULL;
254 ctx->caller_ctx = NULL;
255 ctx->current_sig = PMCNULL;
256 ctx->current_sub = PMCNULL;
257
258 if (PMC_IS_NULL(pmcold)) {
259 ctx->num_constants = NULL;
260 ctx->str_constants = NULL;
261 ctx->pmc_constants = NULL;
262 ctx->warns = 0;
263 ctx->errors = 0;
264 ctx->trace_flags = 0;
265 ctx->current_HLL = 0;
266 ctx->current_namespace = PMCNULL;
267 ctx->recursion_depth = 0;
268 }
269 else {
270 Parrot_Context *old = CONTEXT_STRUCT(pmcold);
271 /* some items should better be COW copied */
272 ctx->num_constants = old->num_constants;
273 ctx->str_constants = old->str_constants;
274 ctx->pmc_constants = old->pmc_constants;
275 ctx->warns = old->warns;
276 ctx->errors = old->errors;
277 ctx->trace_flags = old->trace_flags;
278 ctx->current_HLL = old->current_HLL;
279 PARROT_ASSERT_INTERP(old->current_namespace, pmcctx->orig_interp);
280 ctx->current_namespace = old->current_namespace;
281 /* end COW */
282 ctx->recursion_depth = old->recursion_depth;
283 ctx->caller_ctx = pmcold;
284 }
285
286 return pmcctx;
287 }
288
289
290 /*
291
292 =item C<PMC * Parrot_push_context(PARROT_INTERP, const UINTVAL *n_regs_used)>
293
294 Creates and sets the current context to a new context, remembering the old
295 context in C<caller_ctx>. Suitable to use with C<Parrot_pop_context>.
296
297 =cut
298
299 */
300
301 PARROT_EXPORT
302 PARROT_WARN_UNUSED_RESULT
303 PARROT_CANNOT_RETURN_NULL
304 PMC *
Parrot_push_context(PARROT_INTERP,ARGIN (const UINTVAL * n_regs_used))305 Parrot_push_context(PARROT_INTERP, ARGIN(const UINTVAL *n_regs_used))
306 {
307 ASSERT_ARGS(Parrot_push_context)
308 PMC * const old = CURRENT_CONTEXT(interp);
309 PMC * const ctx = Parrot_set_new_context(interp, n_regs_used);
310
311 /* doesn't change */
312 Parrot_pcc_set_sub(interp, ctx, Parrot_pcc_get_sub(interp, old));
313
314 /* copy more ? */
315 return ctx;
316 }
317
318
319 /*
320
321 =item C<void Parrot_pop_context(PARROT_INTERP)>
322
323 Frees the context created with C<Parrot_push_context> and restores the previous
324 context (the caller context).
325
326 =cut
327
328 */
329
330 PARROT_EXPORT
331 void
Parrot_pop_context(PARROT_INTERP)332 Parrot_pop_context(PARROT_INTERP)
333 {
334 ASSERT_ARGS(Parrot_pop_context)
335 PMC * const ctx = CURRENT_CONTEXT(interp);
336 PMC * const old = Parrot_pcc_get_caller_ctx(interp, ctx);
337
338 /* restore old, set cached interpreter base pointers */
339 set_context(interp, old);
340 }
341
342 /*
343
344 =item C<static size_t calculate_registers_size(PARROT_INTERP, const UINTVAL
345 *number_regs_used)>
346
347 Calculate memory size required for registers.
348
349 =cut
350
351 */
352
353 PARROT_WARN_UNUSED_RESULT
354 PARROT_PURE_FUNCTION
355 static size_t
calculate_registers_size(SHIM_INTERP,ARGIN (const UINTVAL * number_regs_used))356 calculate_registers_size(SHIM_INTERP, ARGIN(const UINTVAL *number_regs_used))
357 {
358 ASSERT_ARGS(calculate_registers_size)
359
360 return ROUND_ALLOC_SIZE(
361 sizeof (INTVAL) * number_regs_used[REGNO_INT] +
362 sizeof (FLOATVAL) * number_regs_used[REGNO_NUM] +
363 sizeof (STRING *) * number_regs_used[REGNO_STR] +
364 sizeof (PMC *) * number_regs_used[REGNO_PMC]);
365 }
366
367
368 /*
369
370 =item C<static size_t Parrot_pcc_calculate_registers_size(PARROT_INTERP, const
371 UINTVAL *number_regs_used)>
372
373 Calculate size of Context.
374
375 =cut
376
377 */
378
379 PARROT_WARN_UNUSED_RESULT
380 PARROT_PURE_FUNCTION
381 static size_t
Parrot_pcc_calculate_registers_size(PARROT_INTERP,ARGIN (const UINTVAL * number_regs_used))382 Parrot_pcc_calculate_registers_size(PARROT_INTERP, ARGIN(const UINTVAL *number_regs_used))
383 {
384 ASSERT_ARGS(Parrot_pcc_calculate_registers_size)
385 return calculate_registers_size(interp, number_regs_used);
386 }
387
388 /*
389
390 =item C<static void allocate_registers(PARROT_INTERP, PMC *pmcctx, const UINTVAL
391 *number_regs_used)>
392
393 Allocate registers inside Context.
394
395 =cut
396
397 */
398 static void
allocate_registers(PARROT_INTERP,ARGIN (PMC * pmcctx),ARGIN (const UINTVAL * number_regs_used))399 allocate_registers(PARROT_INTERP, ARGIN(PMC *pmcctx), ARGIN(const UINTVAL *number_regs_used))
400 {
401 ASSERT_ARGS(allocate_registers)
402 Parrot_CallContext_attributes *ctx = PARROT_CALLCONTEXT(pmcctx);
403
404 const size_t size_i = sizeof (INTVAL) * number_regs_used[REGNO_INT];
405 const size_t size_n = sizeof (FLOATVAL) * number_regs_used[REGNO_NUM];
406 const size_t size_s = sizeof (STRING *) * number_regs_used[REGNO_STR];
407 const size_t size_p = sizeof (PMC *) * number_regs_used[REGNO_PMC];
408
409 const size_t size_nip = size_n + size_i + size_p;
410 const size_t all_regs_size = size_n + size_i + size_p + size_s;
411 const size_t reg_alloc = ROUND_ALLOC_SIZE(all_regs_size);
412
413 ctx->n_regs_used[REGNO_INT] = number_regs_used[REGNO_INT];
414 ctx->n_regs_used[REGNO_NUM] = number_regs_used[REGNO_NUM];
415 ctx->n_regs_used[REGNO_STR] = number_regs_used[REGNO_STR];
416 ctx->n_regs_used[REGNO_PMC] = number_regs_used[REGNO_PMC];
417
418 if (!reg_alloc) {
419 ctx->registers = NULL;
420 return;
421 }
422 /* don't allocate any storage if there are no registers */
423 ctx->registers = (Parrot_Context *)Parrot_gc_allocate_fixed_size_storage(interp, reg_alloc);
424
425 /* ctx.bp points to I0, which has Nx on the left */
426 ctx->bp.regs_i = (INTVAL *)((char *)ctx->registers + size_n);
427
428 /* ctx.bp_ps points to S0, which has Px on the left */
429 ctx->bp_ps.regs_s = (STRING **)((char *)ctx->registers + size_nip);
430
431 clear_regs(interp, ctx);
432 }
433
434
435 /*
436
437 =item C<static void clear_regs(PARROT_INTERP, Parrot_Context *ctx)>
438
439 Clears all registers in a context. PMC and STRING registers contain PMCNULL
440 and NULL, respectively. Integer and float registers contain negative flag
441 values, for debugging purposes.
442
443 =cut
444
445 */
446
447 static void
clear_regs(PARROT_INTERP,ARGMOD (Parrot_Context * ctx))448 clear_regs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx))
449 {
450 ASSERT_ARGS(clear_regs)
451 UINTVAL i;
452 const UINTVAL s_regs = ctx->n_regs_used[REGNO_STR];
453 const UINTVAL p_regs = ctx->n_regs_used[REGNO_PMC];
454
455 /* NULL out registers - P/S have to be NULL for GC */
456 for (i = 0; i < s_regs; ++i)
457 ctx->bp_ps.regs_s[i] = STRINGNULL;
458
459 for (i = 0; i < p_regs; ++i)
460 ctx->bp_ps.regs_p[-1L - i] = PMCNULL;
461
462 if (Interp_debug_TEST(interp, PARROT_REG_DEBUG_FLAG)) {
463 /* depending on -D40, set int and num to identifiable garbage values */
464 for (i = 0; i < ctx->n_regs_used[REGNO_INT]; ++i)
465 ctx->bp.regs_i[i] = -999;
466
467 for (i = 0; i < ctx->n_regs_used[REGNO_NUM]; ++i)
468 ctx->bp.regs_n[-1L - i] = -99.9;
469 }
470 }
471
472
473 /*
474
475 =item C<void Parrot_pcc_allocate_registers(PARROT_INTERP, PMC *pmcctx, const
476 UINTVAL *number_regs_used)>
477
478 Allocate registers in Context.
479
480 =cut
481
482 */
483
484 void
Parrot_pcc_allocate_registers(PARROT_INTERP,ARGIN (PMC * pmcctx),ARGIN (const UINTVAL * number_regs_used))485 Parrot_pcc_allocate_registers(PARROT_INTERP, ARGIN(PMC *pmcctx),
486 ARGIN(const UINTVAL *number_regs_used))
487 {
488 ASSERT_ARGS(Parrot_pcc_allocate_registers)
489 if (number_regs_used[0]
490 || number_regs_used[1]
491 || number_regs_used[2]
492 || number_regs_used[3])
493 allocate_registers(interp, pmcctx, number_regs_used);
494 }
495
496
497 /*
498
499 =item C<void Parrot_pcc_free_registers(PARROT_INTERP, PMC *pmcctx)>
500
501 Free memory allocated for registers in Context.
502
503 =cut
504
505 */
506
507 void
Parrot_pcc_free_registers(PARROT_INTERP,ARGIN (PMC * pmcctx))508 Parrot_pcc_free_registers(PARROT_INTERP, ARGIN(PMC *pmcctx))
509 {
510 ASSERT_ARGS(Parrot_pcc_free_registers)
511 Parrot_CallContext_attributes * const ctx = PARROT_CALLCONTEXT(pmcctx);
512
513 const size_t reg_size =
514 Parrot_pcc_calculate_registers_size(interp, ctx->n_regs_used);
515
516 if (reg_size)
517 Parrot_gc_free_fixed_size_storage(interp, reg_size, ctx->registers);
518 }
519
520
521 /*
522
523 =item C<PMC * Parrot_alloc_context(PARROT_INTERP, const UINTVAL
524 *number_regs_used, PMC *old)>
525
526 Allocates and returns a new context. Does not set this new context as the
527 current context. Note that the register usage C<n_regs_used> is copied. Use
528 the init flag to indicate whether you want to initialize the new context
529 (setting its default values and clearing its registers).
530
531 TODO: Remove this function!
532
533 =cut
534
535 */
536
537 PARROT_CANNOT_RETURN_NULL
538 PARROT_WARN_UNUSED_RESULT
539 PMC *
Parrot_alloc_context(PARROT_INTERP,ARGIN (const UINTVAL * number_regs_used),ARGIN_NULLOK (PMC * old))540 Parrot_alloc_context(PARROT_INTERP, ARGIN(const UINTVAL *number_regs_used),
541 ARGIN_NULLOK(PMC *old))
542 {
543 ASSERT_ARGS(Parrot_alloc_context)
544 PMC * const pmcctx = Parrot_pmc_new(interp, enum_class_CallContext);
545
546 allocate_registers(interp, pmcctx, number_regs_used);
547 return init_context(pmcctx, old);
548 }
549
550
551 /*
552
553 =item C<PMC * Parrot_pcc_allocate_empty_context(PARROT_INTERP, PMC *old)>
554
555 Allocates and returns a new context. Does not set this new context as the
556 current context.
557
558 =cut
559
560 */
561
562 PARROT_CANNOT_RETURN_NULL
563 PARROT_WARN_UNUSED_RESULT
564 PMC *
Parrot_pcc_allocate_empty_context(PARROT_INTERP,ARGIN_NULLOK (PMC * old))565 Parrot_pcc_allocate_empty_context(PARROT_INTERP, ARGIN_NULLOK(PMC *old))
566 {
567 ASSERT_ARGS(Parrot_pcc_allocate_empty_context)
568 PMC * const pmcctx = Parrot_pmc_new(interp, enum_class_CallContext);
569
570 return init_context(pmcctx, old);
571 }
572
573 /*
574
575 =item C<PMC * Parrot_pcc_init_context(PARROT_INTERP, PMC *ctx, PMC *old)>
576
577 Initialise new context from old.
578
579 =cut
580
581 */
582
583 PARROT_CANNOT_RETURN_NULL
584 PMC *
Parrot_pcc_init_context(SHIM_INTERP,ARGIN (PMC * ctx),ARGIN_NULLOK (PMC * old))585 Parrot_pcc_init_context(SHIM_INTERP, ARGIN(PMC *ctx), ARGIN_NULLOK(PMC *old))
586 {
587 ASSERT_ARGS(Parrot_pcc_init_context)
588
589 return init_context(ctx, old);
590 }
591
592 /*
593
594 =item C<PMC * Parrot_set_new_context(PARROT_INTERP, const UINTVAL
595 *number_regs_used)>
596
597 Allocates and returns a new context as the current context. Note that the
598 register usage C<n_regs_used> is copied.
599
600 =cut
601
602 */
603
604 PARROT_CANNOT_RETURN_NULL
605 PARROT_WARN_UNUSED_RESULT
606 PMC *
Parrot_set_new_context(PARROT_INTERP,ARGIN (const UINTVAL * number_regs_used))607 Parrot_set_new_context(PARROT_INTERP, ARGIN(const UINTVAL *number_regs_used))
608 {
609 ASSERT_ARGS(Parrot_set_new_context)
610 PMC * const old = CURRENT_CONTEXT(interp);
611 PMC * const ctx = Parrot_alloc_context(interp, number_regs_used, old);
612
613 set_context(interp, ctx);
614
615 return ctx;
616 }
617
618
619 /*
620
621 =back
622
623 =head2 Register Stack Functions
624
625 =over 4
626
627 =cut
628
629 =item C<INTVAL * Parrot_pcc_get_INTVAL_reg(PARROT_INTERP, const PMC *ctx,
630 UINTVAL idx)>
631
632 Get pointer to INTVAL register.
633
634 Notice that this pointer IS NOT intended for long term use. This pointer is
635 tied to the lifetime of the Context, and if the Context is destroyed the
636 memory for the registers will be freed and possibly even recycled. This
637 pointer should be used for an immediate set or fetch and should not be
638 cached.
639
640 =cut
641
642 */
643
644 PARROT_EXPORT
645 PARROT_PURE_FUNCTION
646 PARROT_CANNOT_RETURN_NULL
647 INTVAL *
Parrot_pcc_get_INTVAL_reg(PARROT_INTERP,ARGIN (const PMC * ctx),UINTVAL idx)648 Parrot_pcc_get_INTVAL_reg(PARROT_INTERP, ARGIN(const PMC *ctx), UINTVAL idx)
649 {
650 ASSERT_ARGS(Parrot_pcc_get_INTVAL_reg)
651 #ifdef NDEBUG
652 UNUSED(interp)
653 #endif
654 PARROT_ASSERT(PCC_GET_REGS_USED(ctx, REGNO_INT) > idx);
655 return &(CONTEXT_STRUCT(ctx)->bp.regs_i[idx]);
656 }
657
658 /*
659
660 =item C<FLOATVAL * Parrot_pcc_get_FLOATVAL_reg(PARROT_INTERP, const PMC *ctx,
661 UINTVAL idx)>
662
663 Get pointer to FLOATVAL register.
664
665 Notice that this pointer IS NOT intended for long term use. This pointer is
666 tied to the lifetime of the Context, and if the Context is destroyed the
667 memory for the registers will be freed and possibly even recycled. This
668 pointer should be used for an immediate set or fetch and should not be
669 cached.
670
671 =cut
672
673 */
674
675 PARROT_EXPORT
676 PARROT_PURE_FUNCTION
677 PARROT_CANNOT_RETURN_NULL
678 FLOATVAL *
Parrot_pcc_get_FLOATVAL_reg(PARROT_INTERP,ARGIN (const PMC * ctx),UINTVAL idx)679 Parrot_pcc_get_FLOATVAL_reg(PARROT_INTERP, ARGIN(const PMC *ctx), UINTVAL idx)
680 {
681 ASSERT_ARGS(Parrot_pcc_get_FLOATVAL_reg)
682 #ifdef NDEBUG
683 UNUSED(interp)
684 #endif
685 PARROT_ASSERT(PCC_GET_REGS_USED(ctx, REGNO_NUM) > idx);
686 return &(CONTEXT_STRUCT(ctx)->bp.regs_n[-1L - idx]);
687 }
688
689 /*
690
691 =item C<STRING ** Parrot_pcc_get_STRING_reg(PARROT_INTERP, PMC *ctx, UINTVAL
692 idx)>
693
694 Get pointer to STRING register.
695
696 Notice that this pointer IS NOT intended for long term use. This pointer is
697 tied to the lifetime of the Context, and if the Context is destroyed the
698 memory for the registers will be freed and possibly even recycled. This
699 pointer should be used for an immediate set or fetch and should not be
700 cached.
701
702 =cut
703
704 */
705
706 PARROT_EXPORT
707 PARROT_PURE_FUNCTION
708 PARROT_CANNOT_RETURN_NULL
709 STRING **
Parrot_pcc_get_STRING_reg(PARROT_INTERP,ARGIN (PMC * ctx),UINTVAL idx)710 Parrot_pcc_get_STRING_reg(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL idx)
711 {
712 ASSERT_ARGS(Parrot_pcc_get_STRING_reg)
713 PARROT_ASSERT(PCC_GET_REGS_USED(ctx, REGNO_STR) > idx);
714 PARROT_GC_WRITE_BARRIER(interp, ctx);
715 return &(CONTEXT_STRUCT(ctx)->bp_ps.regs_s[idx]);
716 }
717
718 /*
719
720 =item C<PMC ** Parrot_pcc_get_PMC_reg(PARROT_INTERP, PMC *ctx, UINTVAL idx)>
721
722 Get pointer to PMC register.
723
724 Notice that this pointer IS NOT intended for long term use. This pointer is
725 tied to the lifetime of the Context, and if the Context is destroyed the
726 memory for the registers will be freed and possibly even recycled. This
727 pointer should be used for an immediate set or fetch and should not be
728 cached.
729
730 =cut
731
732 */
733
734 PARROT_EXPORT
735 PARROT_PURE_FUNCTION
736 PARROT_CANNOT_RETURN_NULL
737 PMC **
Parrot_pcc_get_PMC_reg(PARROT_INTERP,ARGIN (PMC * ctx),UINTVAL idx)738 Parrot_pcc_get_PMC_reg(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL idx)
739 {
740 ASSERT_ARGS(Parrot_pcc_get_PMC_reg)
741 PMC **res;
742 PARROT_ASSERT(PCC_GET_REGS_USED(ctx, REGNO_PMC) > idx);
743 PARROT_GC_WRITE_BARRIER(interp, ctx);
744 res = &(CONTEXT_STRUCT(ctx)->bp_ps.regs_p[-1L - idx]);
745 PARROT_ASSERT(!*res || !PObj_on_free_list_TEST(*res));
746 return res;
747 }
748
749 /*
750
751 =item C<UINTVAL Parrot_pcc_get_regs_used(PARROT_INTERP, const PMC *ctx, int
752 type)>
753
754 Return number of used registers of particular type.
755
756 =cut
757
758 */
759
760 PARROT_EXPORT
761 PARROT_PURE_FUNCTION
762 UINTVAL
Parrot_pcc_get_regs_used(SHIM_INTERP,ARGIN (const PMC * ctx),int type)763 Parrot_pcc_get_regs_used(SHIM_INTERP, ARGIN(const PMC *ctx), int type)
764 {
765 ASSERT_ARGS(Parrot_pcc_get_regs_used)
766 return PCC_GET_REGS_USED(ctx, type);
767 }
768
769 /*
770
771 =item C<Regs_ni* Parrot_pcc_get_regs_ni(PARROT_INTERP, const PMC *ctx)>
772
773 Get pointer to FLOANFAL and INTVAL registers.
774
775 =cut
776
777 */
778
779 PARROT_EXPORT
780 PARROT_PURE_FUNCTION
781 PARROT_CANNOT_RETURN_NULL
782 Regs_ni*
Parrot_pcc_get_regs_ni(SHIM_INTERP,ARGIN (const PMC * ctx))783 Parrot_pcc_get_regs_ni(SHIM_INTERP, ARGIN(const PMC *ctx))
784 {
785 ASSERT_ARGS(Parrot_pcc_get_regs_ni)
786 return &(CONTEXT_STRUCT(ctx)->bp);
787 }
788
789 /*
790
791 =item C<void Parrot_pcc_set_regs_ni(PARROT_INTERP, PMC *ctx, Regs_ni *bp)>
792
793 Copy Regs_ni into Context.
794
795 =cut
796
797 */
798
799 PARROT_EXPORT
800 void
Parrot_pcc_set_regs_ni(SHIM_INTERP,ARGIN (PMC * ctx),ARGIN (Regs_ni * bp))801 Parrot_pcc_set_regs_ni(SHIM_INTERP, ARGIN(PMC *ctx), ARGIN(Regs_ni *bp))
802 {
803 ASSERT_ARGS(Parrot_pcc_set_regs_ni)
804 CONTEXT_STRUCT(ctx)->bp = *bp;
805 }
806
807 /*
808
809 =item C<Regs_ps* Parrot_pcc_get_regs_ps(PARROT_INTERP, PMC *ctx)>
810
811 Get pointer to PMC and STRING registers.
812
813 =cut
814
815 */
816
817 PARROT_EXPORT
818 PARROT_PURE_FUNCTION
819 PARROT_CANNOT_RETURN_NULL
820 Regs_ps*
Parrot_pcc_get_regs_ps(SHIM_INTERP,ARGIN (PMC * ctx))821 Parrot_pcc_get_regs_ps(SHIM_INTERP, ARGIN(PMC *ctx))
822 {
823 ASSERT_ARGS(Parrot_pcc_get_regs_ps)
824 return &(CONTEXT_STRUCT(ctx)->bp_ps);
825 }
826
827 /*
828
829 =item C<void Parrot_pcc_set_regs_ps(PARROT_INTERP, PMC *ctx, Regs_ps *bp_ps)>
830
831 Copy Regs_ps into Context.
832
833 =cut
834
835 */
836
837 PARROT_EXPORT
838 void
Parrot_pcc_set_regs_ps(SHIM_INTERP,ARGIN (PMC * ctx),ARGIN (Regs_ps * bp_ps))839 Parrot_pcc_set_regs_ps(SHIM_INTERP, ARGIN(PMC *ctx), ARGIN(Regs_ps *bp_ps))
840 {
841 ASSERT_ARGS(Parrot_pcc_set_regs_ps)
842 CONTEXT_STRUCT(ctx)->bp_ps = *bp_ps;
843 }
844
845 /*
846
847 =item C<void Parrot_pcc_set_context_func(PARROT_INTERP, PMC *ctx)>
848
849 Set new Context to interpreter.
850
851 =cut
852
853 */
854
855 PARROT_EXPORT
856 void
Parrot_pcc_set_context_func(PARROT_INTERP,ARGIN (PMC * ctx))857 Parrot_pcc_set_context_func(PARROT_INTERP, ARGIN(PMC *ctx))
858 {
859 ASSERT_ARGS(Parrot_pcc_set_context_func)
860
861 set_context(interp, ctx);
862 }
863
864 /*
865
866 =item C<void Parrot_pcc_reuse_continuation(PARROT_INTERP, PMC *call_context,
867 opcode_t *next)>
868
869 Try to reuse old Continuation for subsequent calls from same CallContext.
870
871 =cut
872
873 */
874
875 PARROT_EXPORT
876 void
Parrot_pcc_reuse_continuation(PARROT_INTERP,ARGIN (PMC * call_context),ARGIN_NULLOK (opcode_t * next))877 Parrot_pcc_reuse_continuation(PARROT_INTERP, ARGIN(PMC *call_context), ARGIN_NULLOK(opcode_t *next))
878 {
879 ASSERT_ARGS(Parrot_pcc_reuse_continuation)
880 Parrot_CallContext_attributes * const c = CONTEXT_STRUCT(call_context);
881 INTVAL reuse = 0;
882 PMC * cont = c->continuation;
883
884 if (!PMC_IS_NULL(cont)) {
885 INTVAL invoked;
886 GETATTR_Continuation_invoked(interp, cont, invoked);
887 /* Reuse if invoked. And not tailcalled? */
888 reuse = invoked && !(PObj_get_FLAGS(cont) |= SUB_FLAG_TAILCALL);
889 }
890
891 if (!reuse || !PMC_data(cont)) {
892 cont = Parrot_pmc_new(interp, enum_class_Continuation);
893 #ifndef NDEBUG
894 if (Interp_trace_TEST(interp, PARROT_TRACE_CORO_STATE_FLAG))
895 Parrot_io_eprintf(interp, "# continuation not reused\n");
896 }
897 else {
898 if (Interp_trace_TEST(interp, PARROT_TRACE_CORO_STATE_FLAG))
899 Parrot_io_eprintf(interp, "# continuation reused\n");
900 #endif
901 }
902
903 /* inlined VTABLE_set_pointer(interp, c->continuation, next) */
904 SETATTR_Continuation_address(interp, cont, next);
905 /* needed */
906 SETATTR_Continuation_runloop_id(interp, cont, interp->current_runloop_id);
907 PARROT_GC_WRITE_BARRIER(interp, cont);
908
909 interp->current_cont = cont;
910 }
911
912 /*
913
914 =item C<static void set_context(PARROT_INTERP, PMC *ctx)>
915
916 Helper function to set breakpoint to.
917
918 =cut
919
920 */
921
922 static void
set_context(PARROT_INTERP,ARGIN (PMC * ctx))923 set_context(PARROT_INTERP, ARGIN(PMC *ctx))
924 {
925 ASSERT_ARGS(set_context)
926
927 CURRENT_CONTEXT(interp) = ctx;
928 }
929
930 /*
931
932 =item C<PMC * Parrot_pcc_unproxy_context(PARROT_INTERP, PMC * proxy)>
933
934 CallContext cannot be properly proxied across threads because of direct field
935 accesses. Instead, create a new CallContext which acts like a proxy but can
936 be used with direct accesses.
937
938 =cut
939
940 */
941
942 PARROT_WARN_UNUSED_RESULT
943 PARROT_CANNOT_RETURN_NULL
944 PMC *
Parrot_pcc_unproxy_context(PARROT_INTERP,ARGIN (PMC * proxy))945 Parrot_pcc_unproxy_context(PARROT_INTERP, ARGIN(PMC * proxy))
946 {
947 ASSERT_ARGS(Parrot_pcc_unproxy_context)
948 PMC * const ctx_pmc = Parrot_pcc_allocate_empty_context(interp, PMCNULL);
949 PMC * const target_ctx_pmc = PARROT_PROXY(proxy)->target;
950 Parrot_Context * const ctx = CONTEXT_STRUCT(ctx_pmc);
951 Parrot_Context * const target_ctx = CONTEXT_STRUCT(target_ctx_pmc);
952 Parrot_Interp const target_interp = PARROT_PROXY(proxy)->interp;
953
954 ctx->caller_ctx = PMCNULL; /* TODO: Double-check this */
955 ctx->outer_ctx = PMCNULL;
956 ctx->lex_pad = Parrot_thread_create_proxy(target_interp, interp, target_ctx->lex_pad);
957 ctx->handlers = Parrot_thread_create_proxy(target_interp, interp, target_ctx->handlers);
958 ctx->current_cont = PMCNULL;
959 ctx->current_namespace = PMCNULL;
960 ctx->current_sig = PMCNULL;
961 ctx->type_tuple = PMCNULL;
962 ctx->arg_flags = PMCNULL;
963 ctx->return_flags = PMCNULL;
964 return ctx_pmc;
965 }
966
967 /*
968
969 =back
970
971 */
972
973
974 /*
975 * Local variables:
976 * c-file-style: "parrot"
977 * End:
978 * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
979 */
980