2 Copyright (C) 2001-2003, The Perl Foundation.
7 src/inter_run.c - Parrot Interpreter - Run Ops and Methods
11 Various functions that call the run loop.
23 #include "parrot/parrot.h"
28 runops(Interp *interpreter, size_t offset)>
30 Run parrot ops. Set exception handler and/or resume after exception.
36 #define STACKED_EXCEPTIONS 1
37 /* #define RUNLOOP_TRACE 1 */
40 runloop_id_counter
= 0; /* for synthesizing runloop ids. */
43 runops(Interp
*interpreter
, size_t offs
)
45 volatile size_t offset
= offs
;
46 int old_runloop_id
= interpreter
->current_runloop_id
;
47 int our_runloop_level
= ++interpreter
->current_runloop_level
;
48 int our_runloop_id
= ++runloop_id_counter
;
50 /* It is OK if the runloop ID overflows; we only ever test it for equality,
51 so the chance of collision is slight. */
52 interpreter
->current_runloop_id
= our_runloop_id
;
54 fprintf(stderr
, "[entering loop %d, level %d]\n",
55 interpreter
->current_runloop_id
, our_runloop_level
);
58 * STACKED_EXCEPTIONS are necessary to catch exceptions in reentered
59 * run loops, e.g. if a delegate methods throws an exception
61 #if ! STACKED_EXCEPTIONS
62 if (!interpreter
->exceptions
)
65 new_internal_exception(interpreter
);
66 if (setjmp(interpreter
->exceptions
->destination
)) {
67 /* an exception was thrown */
68 interpreter
->current_runloop_level
= our_runloop_level
;
69 interpreter
->current_runloop_id
= our_runloop_id
;
71 fprintf(stderr
, "[exception; back to loop %d, level %d]\n",
72 our_runloop_id
, our_runloop_level
);
74 offset
= handle_exception(interpreter
);
75 /* update profile for exception execution time */
76 if (interpreter
->profile
&&
77 Interp_flags_TEST(interpreter
, PARROT_PROFILE_FLAG
)) {
78 RunProfile
*profile
= interpreter
->profile
;
79 if (profile
->cur_op
== PARROT_PROF_EXCEPTION
) {
80 profile
->data
[PARROT_PROF_EXCEPTION
].time
+=
81 Parrot_floatval_time() - profile
->starttime
;
87 runops_int(interpreter
, offset
);
90 * pop off exception and put it onto the free list
93 if (STACKED_EXCEPTIONS
) {
94 free_internal_exception(interpreter
);
97 fprintf(stderr
, "[exiting loop %d, level %d]\n",
98 our_runloop_id
, our_runloop_level
);
100 interpreter
->current_runloop_level
= --our_runloop_level
;
101 interpreter
->current_runloop_id
= old_runloop_id
;
103 * not yet - this needs classifying of exceptions and handlers
104 * so that only an exit handler does catch this exception
107 do_exception(interpreter
, EXCEPT_exit
, 0);
113 =item C<parrot_context_t *
114 Parrot_runops_fromc(Parrot_Interp interpreter, PMC *sub)>
116 Runs the Parrot ops, called from C code. The function arguments are
117 already setup according to Parrot calling conventions, the C<sub> argument
118 is an invocable C<Sub> PMC.
125 Parrot_runops_fromc(Parrot_Interp interpreter
, PMC
*sub
)
128 opcode_t offset
, *dest
;
129 parrot_context_t
*ctx
;
131 /* we need one return continuation with a NULL offset */
132 interpreter
->current_cont
= ret_c
=
133 new_ret_continuation_pmc(interpreter
, NULL
);
135 PObj_report_SET(ret_c
); /* s. also dod.c */
137 /* invoke the sub, which places the context of the sub in the
138 * interpreter, and switches code segments if needed
139 * Passing a dummy true destination copies registers
141 dest
= VTABLE_invoke(interpreter
, sub
, (void*) 1);
143 internal_exception(1, "Subroutine returned a NULL address");
144 ctx
= CONTEXT(interpreter
->ctx
);
145 offset
= dest
- interpreter
->code
->base
.data
;
146 runops(interpreter
, offset
);
151 static parrot_context_t
*
152 runops_args(Parrot_Interp interpreter
, PMC
*sub
, PMC
*obj
,
153 STRING
*meth
, const char* sig
, va_list ap
)
155 opcode_t offset
, *dest
;
156 parrot_context_t
*ctx
;
157 parrot_context_t
*old_ctx
;
159 * FIXME argument count limited - check strlen of sig
164 old_ctx
= CONTEXT(interpreter
->ctx
);
165 interpreter
->current_cont
= new_ret_continuation_pmc(interpreter
, NULL
);
166 interpreter
->current_object
= obj
;
167 dest
= VTABLE_invoke(interpreter
, sub
, NULL
);
169 internal_exception(1, "Subroutine returned a NULL address");
170 if (PMC_IS_NULL(obj
)) {
171 /* skip over the return type */
174 else if (sig
[1] == 'O') {
175 /* skip over the return type */
179 size_t len
= strlen(sig
);
181 internal_exception(1, "too many arguments in runops_args");
183 strcpy(new_sig
+ 1, sig
+ 1);
187 dest
= parrot_pass_args_fromc(interpreter
, sig_p
, dest
,
191 ctx
= CONTEXT(interpreter
->ctx
);
192 offset
= dest
- interpreter
->code
->base
.data
;
193 runops(interpreter
, offset
);
201 Parrot_run_meth_fromc(Parrot_Interp, PMC *sub, PMC *obj, STRING *meth)>
203 Run a method sub from C. The function arguments are
204 already setup according to Parrot calling conventions, the C<sub> argument
205 is an invocable C<Sub> PMC.
207 If registers a PMC return values, it is returned.
218 Parrot_runops_fromc_args(Parrot_Interp interpreter, PMC *sub,
219 const char *sig, ...)>
222 Parrot_runops_fromc_args_reti(Parrot_Interp interpreter, PMC *sub,
223 const char *sig, ...)>
226 Parrot_runops_fromc_args_retf(Parrot_Interp interpreter, PMC *sub,
227 const char *sig, ...)>
230 Parrot_runops_fromc_arglist(Parrot_Interp interpreter, PMC *sub,
231 const char *sig, va_list args)>
234 Parrot_run_meth_fromc_args(Parrot_Interp interpreter, PMC *sub,
235 PMC* obj, STRING* meth, const char *sig, ...)>
238 Parrot_run_meth_fromc_args_reti(Parrot_Interp interpreter, PMC *sub,
239 PMC* obj, STRING* meth, const char *sig, ...)>
242 Parrot_run_meth_fromc_args_retf(Parrot_Interp interpreter, PMC *sub,
243 PMC* obj, STRING* meth, const char *sig, ...)>
245 Run parrot ops, called from C code, function arguments are passed as
246 C<va_args> according to the signature. The C<sub> argument is an
247 invocable C<Sub> PMC.
249 Signatures are similar to NCI:
252 I ... INTVAL (not Interpreter)
258 Parrot_runops_fromc_args_event(Parrot_Interp interpreter, PMC *sub,
259 const char *sig, ...)>
261 Run code from within event handlers. This variant deals with some reentrency
262 issues. It also should do sanity checks, if e.g. the handler subroutine
263 didn't return properly.
270 Parrot_run_meth_fromc(Parrot_Interp interpreter
,
271 PMC
*sub
, PMC
*obj
, STRING
*meth
)
273 parrot_context_t
*ctx
;
274 opcode_t offset
, *dest
;
276 interpreter
->current_cont
= new_ret_continuation_pmc(interpreter
, NULL
);
277 interpreter
->current_object
= obj
;
278 dest
= VTABLE_invoke(interpreter
, sub
, (void*)1);
280 internal_exception(1, "Subroutine returned a NULL address");
281 ctx
= CONTEXT(interpreter
->ctx
);
282 offset
= dest
- interpreter
->code
->base
.data
;
283 runops(interpreter
, offset
);
284 return set_retval(interpreter
, 0, ctx
);
288 Parrot_runops_fromc_args(Parrot_Interp interpreter
, PMC
*sub
,
289 const char *sig
, ...)
292 parrot_context_t
*ctx
;
295 ctx
= runops_args(interpreter
, sub
, PMCNULL
, NULL
, sig
, args
);
297 return set_retval(interpreter
, *sig
, ctx
);
301 Parrot_runops_fromc_args_event(Parrot_Interp interpreter
, PMC
*sub
,
302 const char *sig
, ...)
305 parrot_context_t
*ctx
;
306 opcode_t
*cargs
, *params
, *returns
;
310 * running code from event handlers isn't fully reentrant due to
311 * these interpreter variables - mainly related to calls
313 cargs
= interpreter
->current_args
;
314 params
= interpreter
->current_params
;
315 returns
= interpreter
->current_returns
;
316 cont
= interpreter
->current_cont
;
320 ctx
= runops_args(interpreter
, sub
, PMCNULL
, NULL
, sig
, args
);
322 retval
= set_retval(interpreter
, *sig
, ctx
);
324 interpreter
->current_args
= cargs
;
325 interpreter
->current_params
= params
;
326 interpreter
->current_returns
= returns
;
327 interpreter
->current_cont
= cont
;
332 Parrot_runops_fromc_args_reti(Parrot_Interp interpreter
, PMC
*sub
,
333 const char *sig
, ...)
336 parrot_context_t
*ctx
;
339 ctx
= runops_args(interpreter
, sub
, PMCNULL
, NULL
, sig
, args
);
341 return set_retval_i(interpreter
, *sig
, ctx
);
345 Parrot_runops_fromc_args_retf(Parrot_Interp interpreter
, PMC
*sub
,
346 const char *sig
, ...)
349 parrot_context_t
*ctx
;
352 ctx
= runops_args(interpreter
, sub
, PMCNULL
, NULL
, sig
, args
);
354 return set_retval_f(interpreter
, *sig
, ctx
);
358 Parrot_run_meth_fromc_args(Parrot_Interp interpreter
,
359 PMC
*sub
, PMC
*obj
, STRING
*meth
, const char *sig
, ...)
362 parrot_context_t
*ctx
;
365 ctx
= runops_args(interpreter
, sub
, obj
, meth
, sig
, args
);
367 return set_retval(interpreter
, *sig
, ctx
);
371 Parrot_run_meth_fromc_args_reti(Parrot_Interp interpreter
,
372 PMC
*sub
, PMC
*obj
, STRING
*meth
, const char *sig
, ...)
375 parrot_context_t
*ctx
;
378 ctx
= runops_args(interpreter
, sub
, obj
, meth
, sig
, args
);
380 return set_retval_i(interpreter
, *sig
, ctx
);
384 Parrot_run_meth_fromc_args_retf(Parrot_Interp interpreter
,
385 PMC
*sub
, PMC
*obj
, STRING
*meth
, const char *sig
, ...)
388 parrot_context_t
*ctx
;
391 ctx
= runops_args(interpreter
, sub
, obj
, meth
, sig
, args
);
393 return set_retval_f(interpreter
, *sig
, ctx
);
397 Parrot_runops_fromc_arglist(Parrot_Interp interpreter
, PMC
*sub
,
398 const char *sig
, va_list args
)
400 parrot_context_t
*ctx
;
402 ctx
= runops_args(interpreter
, sub
, PMCNULL
, NULL
, sig
, args
);
403 return set_retval(interpreter
, *sig
, ctx
);
407 Parrot_runops_fromc_arglist_reti(Parrot_Interp interpreter
, PMC
*sub
,
408 const char *sig
, va_list args
)
410 parrot_context_t
*ctx
;
412 ctx
= runops_args(interpreter
, sub
, PMCNULL
, NULL
, sig
, args
);
413 return set_retval_i(interpreter
, *sig
, ctx
);
417 Parrot_runops_fromc_arglist_retf(Parrot_Interp interpreter
, PMC
*sub
,
418 const char *sig
, va_list args
)
420 parrot_context_t
*ctx
;
422 ctx
= runops_args(interpreter
, sub
, PMCNULL
, NULL
, sig
, args
);
423 return set_retval_f(interpreter
, *sig
, ctx
);
427 Parrot_run_meth_fromc_arglist(Parrot_Interp interpreter
,
428 PMC
*sub
, PMC
*obj
, STRING
*meth
, const char *sig
, va_list args
)
430 parrot_context_t
*ctx
;
432 ctx
= runops_args(interpreter
, sub
, obj
, meth
, sig
, args
);
433 return set_retval(interpreter
, *sig
, ctx
);
437 Parrot_run_meth_fromc_arglist_reti(Parrot_Interp interpreter
,
438 PMC
*sub
, PMC
*obj
, STRING
*meth
, const char *sig
, va_list args
)
440 parrot_context_t
*ctx
;
442 ctx
= runops_args(interpreter
, sub
, obj
, meth
, sig
, args
);
443 return set_retval_i(interpreter
, *sig
, ctx
);
447 Parrot_run_meth_fromc_arglist_retf(Parrot_Interp interpreter
,
448 PMC
*sub
, PMC
*obj
, STRING
*meth
, const char *sig
, va_list args
)
450 parrot_context_t
*ctx
;
452 ctx
= runops_args(interpreter
, sub
, obj
, meth
, sig
, args
);
453 return set_retval_f(interpreter
, *sig
, ctx
);
462 F<include/parrot/interpreter.h>, F<src/interpreter.c>.
470 * c-file-style: "parrot"
472 * vim: expandtab shiftwidth=4: