?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
free internal hash struct on exceptions
[parrot.git] / src / call / args.c
blob1a24213fefe41fb6c682e06f9abb18f7c3f57668
1 /*
2 Copyright (C) 2001-2010, Parrot Foundation.
3 $Id$
4
5 =head1 NAME
6
7 src/call/args.c
8
9 =head1 DESCRIPTION
10
11 B<Arguments and Returns>: Functions in this file handle argument/return value
12 passing to and from subroutines following the Parrot Calling Conventions.
13
14 =head1 FUNCTIONS
15
16 =over 4
17
18 =cut
19
20 */
21
22 #include "parrot/parrot.h"
23 #include "parrot/oplib/ops.h"
24 #include "args.str"
25 #include "pmc/pmc_key.h"
26 #include "pmc/pmc_fixedintegerarray.h"
27
28 /* HEADERIZER HFILE: include/parrot/call.h */
29
30 /*
31 Set of functions used in generic versions of fill_params and fill_returns.
32 */
33 typedef INTVAL* (*intval_ptr_func_t)(PARROT_INTERP, void *arg_info, INTVAL index);
34 typedef FLOATVAL* (*numval_ptr_func_t)(PARROT_INTERP, void *arg_info, INTVAL index);
35 typedef STRING** (*string_ptr_func_t)(PARROT_INTERP, void *arg_info, INTVAL index);
36 typedef PMC** (*pmc_ptr_func_t) (PARROT_INTERP, void *arg_info, INTVAL index);
37
38 typedef INTVAL (*intval_func_t)(PARROT_INTERP, void *arg_info, INTVAL index);
39 typedef FLOATVAL (*numval_func_t)(PARROT_INTERP, void *arg_info, INTVAL index);
40 typedef STRING* (*string_func_t)(PARROT_INTERP, void *arg_info, INTVAL index);
41 typedef PMC* (*pmc_func_t) (PARROT_INTERP, void *arg_info, INTVAL index);
42
43 typedef struct pcc_funcs_ptr {
44 intval_ptr_func_t intval;
45 numval_ptr_func_t numval;
46 string_ptr_func_t string;
47 pmc_ptr_func_t pmc;
48
49 intval_func_t intval_constant;
50 numval_func_t numval_constant;
51 string_func_t string_constant;
52 pmc_func_t pmc_constant;
53 } pcc_funcs_ptr;
54
55 /* HEADERIZER BEGIN: static */
56 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
57
58 static void assign_default_param_value(PARROT_INTERP,
59 INTVAL param_index,
60 INTVAL param_flags,
61 ARGIN(void *arg_info),
62 ARGMOD(struct pcc_funcs_ptr *accessor))
63 __attribute__nonnull__(1)
64 __attribute__nonnull__(4)
65 __attribute__nonnull__(5)
66 FUNC_MODIFIES(*accessor);
67
68 PARROT_CAN_RETURN_NULL
69 PARROT_WARN_UNUSED_RESULT
70 static PMC* clone_key_arg(PARROT_INTERP, ARGIN(PMC *key))
71 __attribute__nonnull__(1)
72 __attribute__nonnull__(2);
73
74 static void dissect_aggregate_arg(PARROT_INTERP,
75 ARGMOD(PMC *call_object),
76 ARGIN(PMC *aggregate))
77 __attribute__nonnull__(1)
78 __attribute__nonnull__(2)
79 __attribute__nonnull__(3)
80 FUNC_MODIFIES(*call_object);
81
82 static void extract_named_arg_from_op(PARROT_INTERP,
83 ARGMOD(PMC *call_object),
84 ARGIN(STRING *name),
85 ARGIN(PMC *raw_sig),
86 ARGIN(opcode_t *raw_args),
87 INTVAL arg_index)
88 __attribute__nonnull__(1)
89 __attribute__nonnull__(2)
90 __attribute__nonnull__(3)
91 __attribute__nonnull__(4)
92 __attribute__nonnull__(5)
93 FUNC_MODIFIES(*call_object);
94
95 static void fill_params(PARROT_INTERP,
96 ARGMOD_NULLOK(PMC *call_object),
97 ARGIN(PMC *raw_sig),
98 ARGIN(void *arg_info),
99 ARGIN(struct pcc_funcs_ptr *accessor),
100 Errors_classes direction)
101 __attribute__nonnull__(1)
102 __attribute__nonnull__(3)
103 __attribute__nonnull__(4)
104 __attribute__nonnull__(5)
105 FUNC_MODIFIES(*call_object);
106
107 PARROT_WARN_UNUSED_RESULT
108 static INTVAL intval_constant_from_op(SHIM_INTERP,
109 ARGIN(const opcode_t *raw_params),
110 INTVAL param_index)
111 __attribute__nonnull__(2);
112
113 PARROT_WARN_UNUSED_RESULT
114 static INTVAL intval_constant_from_varargs(SHIM_INTERP,
115 SHIM(void *data),
116 SHIM(INTVAL index));
117
118 PARROT_WARN_UNUSED_RESULT
119 PARROT_CANNOT_RETURN_NULL
120 static INTVAL* intval_param_from_c_args(SHIM_INTERP,
121 ARGIN(va_list *args),
122 SHIM(INTVAL param_index))
123 __attribute__nonnull__(2);
124
125 PARROT_WARN_UNUSED_RESULT
126 PARROT_CANNOT_RETURN_NULL
127 static INTVAL* intval_param_from_op(PARROT_INTERP,
128 ARGIN(const opcode_t *raw_params),
129 INTVAL param_index)
130 __attribute__nonnull__(1)
131 __attribute__nonnull__(2);
132
133 PARROT_WARN_UNUSED_RESULT
134 static FLOATVAL numval_constant_from_op(PARROT_INTERP,
135 ARGIN(const opcode_t *raw_params),
136 INTVAL param_index)
137 __attribute__nonnull__(1)
138 __attribute__nonnull__(2);
139
140 PARROT_WARN_UNUSED_RESULT
141 static FLOATVAL numval_constant_from_varargs(SHIM_INTERP,
142 SHIM(void *data),
143 SHIM(INTVAL index));
144
145 PARROT_WARN_UNUSED_RESULT
146 PARROT_CANNOT_RETURN_NULL
147 static FLOATVAL* numval_param_from_c_args(SHIM_INTERP,
148 ARGIN(va_list *args),
149 SHIM(INTVAL param_index))
150 __attribute__nonnull__(2);
151
152 PARROT_WARN_UNUSED_RESULT
153 PARROT_CANNOT_RETURN_NULL
154 static FLOATVAL* numval_param_from_op(PARROT_INTERP,
155 ARGIN(const opcode_t *raw_params),
156 INTVAL param_index)
157 __attribute__nonnull__(1)
158 __attribute__nonnull__(2);
159
160 static void parse_signature_string(PARROT_INTERP,
161 ARGIN(const char *signature),
162 ARGMOD(PMC **arg_flags))
163 __attribute__nonnull__(1)
164 __attribute__nonnull__(2)
165 __attribute__nonnull__(3)
166 FUNC_MODIFIES(*arg_flags);
167
168 PARROT_WARN_UNUSED_RESULT
169 PARROT_CAN_RETURN_NULL
170 static PMC* pmc_constant_from_op(PARROT_INTERP,
171 ARGIN(const opcode_t *raw_params),
172 INTVAL param_index)
173 __attribute__nonnull__(1)
174 __attribute__nonnull__(2);
175
176 PARROT_CAN_RETURN_NULL
177 PARROT_WARN_UNUSED_RESULT
178 static PMC* pmc_constant_from_varargs(SHIM_INTERP,
179 SHIM(void *data),
180 SHIM(INTVAL index));
181
182 PARROT_WARN_UNUSED_RESULT
183 PARROT_CANNOT_RETURN_NULL
184 static PMC** pmc_param_from_c_args(SHIM_INTERP,
185 ARGIN(va_list *args),
186 SHIM(INTVAL param_index))
187 __attribute__nonnull__(2);
188
189 PARROT_WARN_UNUSED_RESULT
190 PARROT_CANNOT_RETURN_NULL
191 static PMC** pmc_param_from_op(PARROT_INTERP,
192 ARGIN(const opcode_t *raw_params),
193 INTVAL param_index)
194 __attribute__nonnull__(1)
195 __attribute__nonnull__(2);
196
197 PARROT_WARN_UNUSED_RESULT
198 PARROT_CAN_RETURN_NULL
199 static STRING* string_constant_from_op(PARROT_INTERP,
200 ARGIN(const opcode_t *raw_params),
201 INTVAL param_index)
202 __attribute__nonnull__(1)
203 __attribute__nonnull__(2);
204
205 PARROT_CAN_RETURN_NULL
206 PARROT_WARN_UNUSED_RESULT
207 static STRING* string_constant_from_varargs(SHIM_INTERP,
208 SHIM(void *data),
209 SHIM(INTVAL index));
210
211 PARROT_WARN_UNUSED_RESULT
212 PARROT_CANNOT_RETURN_NULL
213 static STRING** string_param_from_c_args(SHIM_INTERP,
214 ARGIN(va_list *args),
215 SHIM(INTVAL param_index))
216 __attribute__nonnull__(2);
217
218 PARROT_WARN_UNUSED_RESULT
219 PARROT_CANNOT_RETURN_NULL
220 static STRING** string_param_from_op(PARROT_INTERP,
221 ARGIN(const opcode_t *raw_params),
222 INTVAL param_index)
223 __attribute__nonnull__(1)
224 __attribute__nonnull__(2);
225
226 #define ASSERT_ARGS_assign_default_param_value __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
227 PARROT_ASSERT_ARG(interp) \
228 , PARROT_ASSERT_ARG(arg_info) \
229 , PARROT_ASSERT_ARG(accessor))
230 #define ASSERT_ARGS_clone_key_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
231 PARROT_ASSERT_ARG(interp) \
232 , PARROT_ASSERT_ARG(key))
233 #define ASSERT_ARGS_dissect_aggregate_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
234 PARROT_ASSERT_ARG(interp) \
235 , PARROT_ASSERT_ARG(call_object) \
236 , PARROT_ASSERT_ARG(aggregate))
237 #define ASSERT_ARGS_extract_named_arg_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
238 PARROT_ASSERT_ARG(interp) \
239 , PARROT_ASSERT_ARG(call_object) \
240 , PARROT_ASSERT_ARG(name) \
241 , PARROT_ASSERT_ARG(raw_sig) \
242 , PARROT_ASSERT_ARG(raw_args))
243 #define ASSERT_ARGS_fill_params __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
244 PARROT_ASSERT_ARG(interp) \
245 , PARROT_ASSERT_ARG(raw_sig) \
246 , PARROT_ASSERT_ARG(arg_info) \
247 , PARROT_ASSERT_ARG(accessor))
248 #define ASSERT_ARGS_intval_constant_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
249 PARROT_ASSERT_ARG(raw_params))
250 #define ASSERT_ARGS_intval_constant_from_varargs __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
251 #define ASSERT_ARGS_intval_param_from_c_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
252 PARROT_ASSERT_ARG(args))
253 #define ASSERT_ARGS_intval_param_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
254 PARROT_ASSERT_ARG(interp) \
255 , PARROT_ASSERT_ARG(raw_params))
256 #define ASSERT_ARGS_numval_constant_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
257 PARROT_ASSERT_ARG(interp) \
258 , PARROT_ASSERT_ARG(raw_params))
259 #define ASSERT_ARGS_numval_constant_from_varargs __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
260 #define ASSERT_ARGS_numval_param_from_c_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
261 PARROT_ASSERT_ARG(args))
262 #define ASSERT_ARGS_numval_param_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
263 PARROT_ASSERT_ARG(interp) \
264 , PARROT_ASSERT_ARG(raw_params))
265 #define ASSERT_ARGS_parse_signature_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
266 PARROT_ASSERT_ARG(interp) \
267 , PARROT_ASSERT_ARG(signature) \
268 , PARROT_ASSERT_ARG(arg_flags))
269 #define ASSERT_ARGS_pmc_constant_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
270 PARROT_ASSERT_ARG(interp) \
271 , PARROT_ASSERT_ARG(raw_params))
272 #define ASSERT_ARGS_pmc_constant_from_varargs __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
273 #define ASSERT_ARGS_pmc_param_from_c_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
274 PARROT_ASSERT_ARG(args))
275 #define ASSERT_ARGS_pmc_param_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
276 PARROT_ASSERT_ARG(interp) \
277 , PARROT_ASSERT_ARG(raw_params))
278 #define ASSERT_ARGS_string_constant_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
279 PARROT_ASSERT_ARG(interp) \
280 , PARROT_ASSERT_ARG(raw_params))
281 #define ASSERT_ARGS_string_constant_from_varargs __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
282 #define ASSERT_ARGS_string_param_from_c_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
283 PARROT_ASSERT_ARG(args))
284 #define ASSERT_ARGS_string_param_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
285 PARROT_ASSERT_ARG(interp) \
286 , PARROT_ASSERT_ARG(raw_params))
287 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
288 /* HEADERIZER END: static */
289
290 /*
291
292 =item C<PMC* Parrot_pcc_build_sig_object_from_op(PARROT_INTERP, PMC *signature,
293 PMC *raw_sig, opcode_t *raw_args)>
294
295 Take a raw signature and argument list from a set_args opcode and
296 convert it to a CallContext PMC.
297
298 =cut
299
300 */
301
302 PARROT_EXPORT
303 PARROT_WARN_UNUSED_RESULT
304 PARROT_CANNOT_RETURN_NULL
305 PMC*
306 Parrot_pcc_build_sig_object_from_op(PARROT_INTERP, ARGIN_NULLOK(PMC *signature),
307 ARGIN(PMC *raw_sig), ARGIN(opcode_t *raw_args))
308 {
309 ASSERT_ARGS(Parrot_pcc_build_sig_object_from_op)
310 PMC * const ctx = CURRENT_CONTEXT(interp);
311 PMC *call_object;
312 INTVAL *int_array;
313 INTVAL arg_count;
314 INTVAL arg_index = 0;
315
316 if (PMC_IS_NULL(signature))
317 call_object = Parrot_pmc_new(interp, enum_class_CallContext);
318 else {
319 call_object = signature;
320 VTABLE_morph(interp, call_object, PMCNULL);
321 }
322
323 /* this macro is much, much faster than the VTABLE STRING comparisons */
324 SETATTR_CallContext_arg_flags(interp, call_object, raw_sig);
325 GETATTR_FixedIntegerArray_size(interp, raw_sig, arg_count);
326 GETATTR_FixedIntegerArray_int_array(interp, raw_sig, int_array);
327
328 for (; arg_index < arg_count; ++arg_index) {
329 const INTVAL arg_flags = int_array[arg_index];
330 const INTVAL constant = PARROT_ARG_CONSTANT_ISSET(arg_flags);
331 const INTVAL raw_index = raw_args[arg_index + 2];
332
333 switch (PARROT_ARG_TYPE_MASK_MASK(arg_flags)) {
334 case PARROT_ARG_INTVAL:
335 if (constant)
336 VTABLE_push_integer(interp, call_object, raw_index);
337 else {
338 const INTVAL int_value = CTX_REG_INT(ctx, raw_index);
339 VTABLE_push_integer(interp, call_object, int_value);
340 }
341 break;
342 case PARROT_ARG_FLOATVAL:
343 if (constant)
344 VTABLE_push_float(interp, call_object,
345 Parrot_pcc_get_num_constant(interp, ctx, raw_index));
346 else {
347 const FLOATVAL float_value = CTX_REG_NUM(ctx, raw_index);
348 VTABLE_push_float(interp, call_object, float_value);
349 }
350 break;
351 case PARROT_ARG_STRING:
352 {
353 STRING *string_value;
354 if (constant)
355 string_value = Parrot_pcc_get_string_constant(interp, ctx, raw_index);
356 else
357 string_value = CTX_REG_STR(ctx, raw_index);
358
359 if (arg_flags & PARROT_ARG_NAME) {
360 ++arg_index;
361 if (!PMC_IS_NULL(call_object)
362 && VTABLE_exists_keyed_str(interp, call_object, string_value)) {
363 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
364 "duplicate named argument in call");
365
366 }
367 extract_named_arg_from_op(interp, call_object, string_value,
368 raw_sig, raw_args, arg_index);
369 }
370 else
371 VTABLE_push_string(interp, call_object, string_value);
372
373 break;
374 }
375 case PARROT_ARG_PMC:
376 {
377 PMC *pmc_value;
378 if (constant)
379 pmc_value = Parrot_pcc_get_pmc_constant(interp, ctx, raw_index);
380 else
381 pmc_value = CTX_REG_PMC(ctx, raw_index);
382
383 if (arg_flags & PARROT_ARG_FLATTEN) {
384 dissect_aggregate_arg(interp, call_object, pmc_value);
385 }
386 else {
387 VTABLE_push_pmc(interp, call_object, PMC_IS_NULL(pmc_value)
388 ? PMCNULL
389 : clone_key_arg(interp, pmc_value));
390 if (arg_flags & PARROT_ARG_INVOCANT)
391 Parrot_pcc_set_object(interp, call_object, pmc_value);
392 }
393
394 break;
395 }
396 default:
397 break;
398 }
399
400 }
401
402 return call_object;
403 }
404
405 /*
406
407 =item C<static void extract_named_arg_from_op(PARROT_INTERP, PMC *call_object,
408 STRING *name, PMC *raw_sig, opcode_t *raw_args, INTVAL arg_index)>
409
410 Pulls in the next argument from a set_args opcode, and sets it as the
411 value of a named argument in the CallContext PMC.
412
413 =cut
414
415 */
416
417 static void
418 extract_named_arg_from_op(PARROT_INTERP, ARGMOD(PMC *call_object), ARGIN(STRING *name),
419 ARGIN(PMC *raw_sig), ARGIN(opcode_t *raw_args), INTVAL arg_index)
420 {
421 ASSERT_ARGS(extract_named_arg_from_op)
422 PMC * const ctx = CURRENT_CONTEXT(interp);
423 const INTVAL arg_flags = VTABLE_get_integer_keyed_int(interp, raw_sig, arg_index);
424 const INTVAL constant = PARROT_ARG_CONSTANT_ISSET(arg_flags);
425 const INTVAL raw_index = raw_args[arg_index + 2];
426
427 switch (PARROT_ARG_TYPE_MASK_MASK(arg_flags)) {
428 case PARROT_ARG_INTVAL:
429 if (constant)
430 VTABLE_set_integer_keyed_str(interp, call_object, name, raw_index);
431 else
432 VTABLE_set_integer_keyed_str(interp, call_object, name,
433 CTX_REG_INT(ctx, raw_index));
434 break;
435 case PARROT_ARG_FLOATVAL:
436 if (constant)
437 VTABLE_set_number_keyed_str(interp, call_object, name,
438 Parrot_pcc_get_num_constant(interp, ctx, raw_index));
439 else
440 VTABLE_set_number_keyed_str(interp, call_object, name,
441 CTX_REG_NUM(ctx, raw_index));
442 break;
443 case PARROT_ARG_STRING:
444 if (constant)
445 VTABLE_set_string_keyed_str(interp, call_object, name,
446 Parrot_pcc_get_string_constant(interp, ctx, raw_index));
447 else
448 VTABLE_set_string_keyed_str(interp, call_object, name,
449 CTX_REG_STR(ctx, raw_index));
450 break;
451 case PARROT_ARG_PMC:
452 if (constant)
453 VTABLE_set_pmc_keyed_str(interp, call_object, name,
454 Parrot_pcc_get_pmc_constant(interp, ctx, raw_index));
455 else
456 VTABLE_set_pmc_keyed_str(interp, call_object, name,
457 CTX_REG_PMC(ctx, raw_index));
458 break;
459 default:
460 break;
461 }
462 }
463
464 /*
465
466 =item C<static void dissect_aggregate_arg(PARROT_INTERP, PMC *call_object, PMC
467 *aggregate)>
468
469 Takes an aggregate PMC and splits it up into individual arguments,
470 adding each one to the CallContext PMC. If the aggregate is an array,
471 its elements are added as positional arguments. If the aggregate is a
472 hash, its key/value pairs are added as named arguments.
473
474 =cut
475
476 */
477
478 static void
479 dissect_aggregate_arg(PARROT_INTERP, ARGMOD(PMC *call_object), ARGIN(PMC *aggregate))
480 {
481 ASSERT_ARGS(dissect_aggregate_arg)
482 if (VTABLE_does(interp, aggregate, CONST_STRING(interp, "array"))) {
483 const INTVAL elements = VTABLE_elements(interp, aggregate);
484 INTVAL index;
485 for (index = 0; index < elements; ++index) {
486 VTABLE_push_pmc(interp, call_object,
487 VTABLE_get_pmc_keyed_int(interp, aggregate, index));
488 }
489 }
490 else if (VTABLE_does(interp, aggregate, CONST_STRING(interp, "hash"))) {
491 Hash *hash = (Hash *)VTABLE_get_pointer(interp, aggregate);
492
493 parrot_hash_iterate(hash,
494 VTABLE_set_pmc_keyed_str(interp, call_object,
495 (STRING *)_bucket->key,
496 hash_value_to_pmc(interp, hash, _bucket->value));)
497 }
498 else {
499 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
500 "flattened parameters must be a hash or array");
501 }
502 }
503
504 /*
505
506 =item C<PMC* Parrot_pcc_build_call_from_c_args(PARROT_INTERP, PMC *signature,
507 const char *sig, ...)>
508
509 Converts a variable list of C args into a CallContext PMC. The CallContext
510 stores the original short signature string and an array of integer types to
511 pass on to the multiple dispatch search.
512
513 =cut
514
515 */
516
517 PARROT_EXPORT
518 PARROT_WARN_UNUSED_RESULT
519 PARROT_CANNOT_RETURN_NULL
520 PMC*
521 Parrot_pcc_build_call_from_c_args(PARROT_INTERP,
522 ARGIN_NULLOK(PMC *signature), ARGIN(const char *sig), ...)
523 {
524 ASSERT_ARGS(Parrot_pcc_build_call_from_c_args)
525 PMC *call_object;
526 va_list args;
527 va_start(args, sig);
528 call_object = Parrot_pcc_build_call_from_varargs(interp, signature,
529 sig, &args);
530 va_end(args);
531 return call_object;
532 }
533
534 /*
535
536 =item C<PMC* Parrot_pcc_build_call_from_varargs(PARROT_INTERP, PMC *signature,
537 const char *sig, va_list *args)>
538
539 Converts a varargs list into a CallContext PMC. The CallContext stores the
540 original short signature string and an array of integer types to pass on to the
541 multiple dispatch search.
542
543 =cut
544
545 */
546
547 PARROT_EXPORT
548 PARROT_WARN_UNUSED_RESULT
549 PARROT_CANNOT_RETURN_NULL
550 PMC*
551 Parrot_pcc_build_call_from_varargs(PARROT_INTERP,
552 ARGIN_NULLOK(PMC *signature), ARGIN(const char *sig),
553 ARGMOD(va_list *args))
554 {
555 ASSERT_ARGS(Parrot_pcc_build_call_from_varargs)
556 PMC *call_object;
557 PMC *arg_flags = PMCNULL;
558 INTVAL i = 0;
559
560 if (PMC_IS_NULL(signature))
561 call_object = Parrot_pmc_new(interp, enum_class_CallContext);
562 else {
563 call_object = signature;
564 VTABLE_morph(interp, call_object, PMCNULL);
565 }
566
567 parse_signature_string(interp, sig, &arg_flags);
568 VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "arg_flags"), arg_flags);
569
570 /* Process the varargs list */
571 for (; sig[i] != '\0'; ++i) {
572 const INTVAL type = sig[i];
573
574 /* Regular arguments just set the value */
575 switch (type) {
576 case 'P':
577 {
578 const INTVAL type_lookahead = sig[i+1];
579 PMC * const pmc_arg = va_arg(*args, PMC *);
580 if (type_lookahead == 'f') {
581 dissect_aggregate_arg(interp, call_object, pmc_arg);
582 ++i; /* skip 'f' */
583 }
584 else if (type_lookahead == 'i') {
585 if (i)
586 Parrot_ex_throw_from_c_args(interp, NULL,
587 EXCEPTION_INVALID_OPERATION,
588 "Dispatch: only the first argument can be an invocant");
589 else {
590 VTABLE_push_pmc(interp, call_object, pmc_arg);
591 ++i; /* skip 'i' */
592 Parrot_pcc_set_object(interp, call_object, pmc_arg);
593 }
594 }
595 else
596 VTABLE_push_pmc(interp, call_object, PMC_IS_NULL(pmc_arg)
597 ? PMCNULL
598 : clone_key_arg(interp, pmc_arg));
599 break;
600 }
601 case 'S':
602 VTABLE_push_string(interp, call_object, va_arg(*args, STRING *));
603 break;
604 case 'I':
605 VTABLE_push_integer(interp, call_object, va_arg(*args, INTVAL));
606 break;
607 case 'N':
608 VTABLE_push_float(interp, call_object, va_arg(*args, FLOATVAL));
609 break;
610 case '-':
611 return call_object;
612 break;
613 default:
614 Parrot_ex_throw_from_c_args(interp, NULL,
615 EXCEPTION_INVALID_OPERATION,
616 "Dispatch: invalid argument type %c!", type);
617 }
618 }
619
620 return call_object;
621 }
622
623 /*
624
625 =item C<PMC* Parrot_pcc_build_sig_object_from_varargs(PARROT_INTERP, PMC *obj,
626 const char *sig, va_list args)>
627
628 Converts a varargs list into a CallContext PMC. The CallContext stores the
629 original short signature string and an array of integer types to pass on to the
630 multiple dispatch search.
631
632 =cut
633
634 */
635
636 PARROT_EXPORT
637 PARROT_WARN_UNUSED_RESULT
638 PARROT_CANNOT_RETURN_NULL
639 PMC*
640 Parrot_pcc_build_sig_object_from_varargs(PARROT_INTERP, ARGIN_NULLOK(PMC *obj),
641 ARGIN(const char *sig), va_list args)
642 {
643 ASSERT_ARGS(Parrot_pcc_build_sig_object_from_varargs)
644 PMC * arg_flags = PMCNULL;
645 PMC * const call_object = Parrot_pmc_new(interp, enum_class_CallContext);
646 INTVAL in_return_sig = 0;
647 INTVAL i;
648 int append_pi = 1;
649
650 /* empty args or empty returns */
651 if (*sig == '-' || *sig == '\0')
652 return call_object;
653
654 parse_signature_string(interp, sig, &arg_flags);
655 VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "arg_flags"), arg_flags);
656
657 /* Process the varargs list */
658 for (i = 0; sig[i] != '\0'; ++i) {
659 const INTVAL type = sig[i];
660
661 /* Don't process returns */
662 if (in_return_sig)
663 break;
664
665 /* Regular arguments just set the value */
666 switch (type) {
667 case 'I':
668 VTABLE_push_integer(interp, call_object, va_arg(args, INTVAL));
669 break;
670 case 'N':
671 VTABLE_push_float(interp, call_object, va_arg(args, FLOATVAL));
672 break;
673 case 'S':
674 VTABLE_push_string(interp, call_object, va_arg(args, STRING *));
675 break;
676 case 'P':
677 {
678 const INTVAL type_lookahead = sig[i+1];
679 PMC * const pmc_arg = va_arg(args, PMC *);
680 if (type_lookahead == 'f') {
681 dissect_aggregate_arg(interp, call_object, pmc_arg);
682 ++i; /* skip 'f' */
683 }
684 else {
685 VTABLE_push_pmc(interp, call_object, PMC_IS_NULL(pmc_arg)
686 ? PMCNULL
687 : clone_key_arg(interp, pmc_arg));
688 if (type_lookahead == 'i') {
689 if (i != 0)
690 Parrot_ex_throw_from_c_args(interp, NULL,
691 EXCEPTION_INVALID_OPERATION,
692 "Dispatch: only the first argument "
693 "can be an invocant");
694 ++i; /* skip 'i' */
695 append_pi = 0; /* Don't prepend Pi to signature */
696 }
697 }
698 break;
699 }
700 case '-':
701 in_return_sig = 1;
702 break;
703 default:
704 Parrot_ex_throw_from_c_args(interp, NULL,
705 EXCEPTION_INVALID_OPERATION,
706 "Dispatch: invalid argument type %c!", type);
707 }
708 }
709
710 /* Add invocant to the front of the arguments iff needed */
711 if (!PMC_IS_NULL(obj) && append_pi)
712 VTABLE_unshift_pmc(interp, call_object, obj);
713
714 return call_object;
715 }
716
717 /*
718
719 =item C<static void fill_params(PARROT_INTERP, PMC *call_object, PMC *raw_sig,
720 void *arg_info, struct pcc_funcs_ptr *accessor, Errors_classes direction)>
721
722 Gets args for the current function call and puts them into position.
723 First it gets the positional non-slurpy parameters, then the positional
724 slurpy parameters, then the named parameters, and finally the named
725 slurpy parameters.
726
727 =cut
728
729 */
730
731 static void
732 fill_params(PARROT_INTERP, ARGMOD_NULLOK(PMC *call_object),
733 ARGIN(PMC *raw_sig), ARGIN(void *arg_info),
734 ARGIN(struct pcc_funcs_ptr *accessor),
735 Errors_classes direction)
736 {
737 ASSERT_ARGS(fill_params)
738 INTVAL *raw_params;
739 Hash *named_used_list = NULL;
740 INTVAL param_index = 0;
741 INTVAL arg_index = 0;
742 INTVAL named_count = 0;
743 INTVAL param_count;
744 INTVAL positional_args;
745 /* Check if we should be throwing errors. This is configured separately
746 * for parameters and return values. */
747 const INTVAL err_check = PARROT_ERRORS_test(interp, direction);
748
749 GETATTR_FixedIntegerArray_size(interp, raw_sig, param_count);
750
751 /* A null call object is fine if there are no arguments and no returns. */
752 if (PMC_IS_NULL(call_object)) {
753 if (param_count > 0 && err_check)
754 Parrot_ex_throw_from_c_args(interp, NULL,
755 EXCEPTION_INVALID_OPERATION,
756 "too few arguments: 0 passed, %d expected", param_count);
757
758 return;
759 }
760
761 GETATTR_FixedIntegerArray_int_array(interp, raw_sig, raw_params);
762
763 /* EXPERIMENTAL! This block adds provisional :call_sig param support on the
764 callee side only. Does not add :call_sig arg support on the caller side.
765 This is not the final form of the algorithm, but should provide the
766 tools that HLL designers need in the interim. */
767 if (param_count > 2 || param_count == 0)
768 /* help branch predictors */;
769 else {
770 const INTVAL second_flag = raw_params[param_count - 1];
771 if (second_flag & PARROT_ARG_CALL_SIG) {
772 *accessor->pmc(interp, arg_info, param_count - 1) = call_object;
773 if (param_count == 1)
774 return;
775 }
776 }
777
778 /* First iterate over positional args and positional parameters. */
779 GETATTR_CallContext_num_positionals(interp, call_object, positional_args);
780
781 while (1) {
782 INTVAL param_flags;
783
784 /* Check if we've used up all the parameters. */
785 if (param_index >= param_count) {
786 /* We've used up all arguments and parameters; we're done. */
787 if (arg_index >= positional_args)
788 break;
789 else if (err_check) {
790 /* We've used up all the parameters, but have extra positional
791 * args left over. */
792 if (named_used_list != NULL)
793 parrot_hash_destroy(interp, named_used_list);
794 Parrot_ex_throw_from_c_args(interp, NULL,
795 EXCEPTION_INVALID_OPERATION,
796 "too many positional arguments: %d passed, %d expected",
797 positional_args, param_index);
798 }
799 return;
800 }
801
802 param_flags = raw_params[param_index];
803
804 /* If it's a call_sig, we're done. */
805 if (param_flags & PARROT_ARG_CALL_SIG)
806 return;
807
808 /* If the parameter is slurpy, collect all remaining positional
809 * arguments into an array.*/
810 if (param_flags & PARROT_ARG_SLURPY_ARRAY) {
811 /* Can't handle named slurpy here, go to named argument handling */
812 if (!(param_flags & PARROT_ARG_NAME)) {
813 PMC *collect_positional;
814 int j;
815 INTVAL num_positionals = positional_args - arg_index;
816 if (num_positionals < 0)
817 num_positionals = 0;
818 if (named_count > 0){
819 if (named_used_list != NULL)
820 parrot_hash_destroy(interp, named_used_list);
821 Parrot_ex_throw_from_c_args(interp, NULL,
822 EXCEPTION_INVALID_OPERATION,
823 "named parameters must follow all positional parameters");
824 }
825
826 collect_positional = Parrot_pmc_new_init_int(interp,
827 Parrot_get_ctx_HLL_type(interp, enum_class_ResizablePMCArray),
828 num_positionals);
829
830 for (j = 0; arg_index < positional_args; ++arg_index)
831 VTABLE_set_pmc_keyed_int(interp, collect_positional, j++,
832 VTABLE_get_pmc_keyed_int(interp, call_object, arg_index));
833
834 *accessor->pmc(interp, arg_info, param_index) = collect_positional;
835 ++param_index;
836 }
837 break; /* Terminate the positional arg loop. */
838 }
839
840 /* We have a positional argument, fill the parameter with it. */
841 if (arg_index < positional_args) {
842
843 /* Fill a named parameter with a positional argument. */
844 if (param_flags & PARROT_ARG_NAME) {
845 STRING *param_name;
846 if (!(param_flags & PARROT_ARG_STRING)){
847 if (named_used_list != NULL)
848 parrot_hash_destroy(interp, named_used_list);
849 Parrot_ex_throw_from_c_args(interp, NULL,
850 EXCEPTION_INVALID_OPERATION,
851 "named parameters must have a name specified");
852 }
853 param_name = PARROT_ARG_CONSTANT_ISSET(param_flags)
854 ? accessor->string_constant(interp, arg_info, param_index)
855 : *accessor->string(interp, arg_info, param_index);
856
857 ++named_count;
858 ++param_index;
859 if (param_index >= param_count)
860 continue;
861
862 param_flags = raw_params[param_index];
863
864 /* Mark the name as used, cannot be filled again. */
865 if (named_used_list==NULL) /* Only created if needed. */
866 named_used_list = parrot_create_hash(interp,
867 enum_type_INTVAL, Hash_key_type_STRING);
868
869 parrot_hash_put(interp, named_used_list, param_name, (void *)1);
870 }
871 else if (named_count > 0){
872 if (named_used_list != NULL)
873 parrot_hash_destroy(interp, named_used_list);
874 Parrot_ex_throw_from_c_args(interp, NULL,
875 EXCEPTION_INVALID_OPERATION,
876 "named parameters must follow all positional parameters");
877 }
878
879 /* Check for :lookahead parameter goes here. */
880
881 /* Go ahead and fill the parameter with a positional argument. */
882 switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
883 case PARROT_ARG_PMC:
884 *accessor->pmc(interp, arg_info, param_index) =
885 VTABLE_get_pmc_keyed_int(interp, call_object, arg_index);
886 break;
887 case PARROT_ARG_STRING:
888 *accessor->string(interp, arg_info, param_index) =
889 VTABLE_get_string_keyed_int(interp, call_object, arg_index);
890 break;
891 case PARROT_ARG_INTVAL:
892 *accessor->intval(interp, arg_info, param_index) =
893 VTABLE_get_integer_keyed_int(interp, call_object, arg_index);
894 break;
895 case PARROT_ARG_FLOATVAL:
896 *accessor->numval(interp, arg_info, param_index) =
897 VTABLE_get_number_keyed_int(interp, call_object, arg_index);
898 break;
899 default:
900 if (named_used_list != NULL)
901 parrot_hash_destroy(interp, named_used_list);
902 Parrot_ex_throw_from_c_args(interp, NULL,
903 EXCEPTION_INVALID_OPERATION, "invalid parameter type");
904 break;
905 }
906
907 /* Mark the option flag for the filled parameter. */
908 if (param_flags & PARROT_ARG_OPTIONAL) {
909 if (param_index + 1 < param_count) {
910 const int next_param_flags = raw_params[param_index + 1];
911
912 if (next_param_flags & PARROT_ARG_OPT_FLAG) {
913 ++param_index;
914 *accessor->intval(interp, arg_info, param_index) = 1;
915 }
916 }
917 }
918 }
919 /* We have no more positional arguments, fill the optional parameter
920 * with a default value. */
921 else if (param_flags & PARROT_ARG_OPTIONAL) {
922 /* We don't handle optional named params here, handle them in the
923 * next loop. */
924 if (param_flags & PARROT_ARG_NAME)
925 break;
926
927 assign_default_param_value(interp, param_index, param_flags,
928 arg_info, accessor);
929
930 /* Mark the option flag for the parameter to FALSE, it was filled
931 * with a default value. */
932 if (param_index + 1 < param_count) {
933 const INTVAL next_param_flags = raw_params[param_index + 1];
934
935 if (next_param_flags & PARROT_ARG_OPT_FLAG) {
936 ++param_index;
937 *accessor->intval(interp, arg_info, param_index) = 0;
938 }
939 }
940 }
941 /* We don't have an argument for the parameter, and it's not optional,
942 * so it's an error. */
943 else {
944 /* We don't handle named params here, go to the next loop. */
945 if (param_flags & PARROT_ARG_NAME)
946 break;
947
948 if (err_check){
949 if (named_used_list != NULL)
950 parrot_hash_destroy(interp, named_used_list);
951 Parrot_ex_throw_from_c_args(interp, NULL,
952 EXCEPTION_INVALID_OPERATION,
953 "too few positional arguments: "
954 "%d passed, %d (or more) expected",
955 positional_args, param_index + 1);
956 }
957 }
958
959 /* Go on to next argument and parameter. */
960 ++arg_index;
961 ++param_index;
962 }
963
964 /* Now iterate over the named arguments and parameters. */
965 while (param_index < param_count) {
966 STRING *param_name;
967 INTVAL param_flags = raw_params[param_index];
968
969 /* All remaining parameters must be named. */
970 if (!(param_flags & PARROT_ARG_NAME)){
971 if (named_used_list != NULL)
972 parrot_hash_destroy(interp, named_used_list);
973 Parrot_ex_throw_from_c_args(interp, NULL,
974 EXCEPTION_INVALID_OPERATION,
975 "named parameters must follow all positional parameters");
976 }
977
978 if (arg_index < positional_args) {
979 PMC *arg_sig;
980
981 GETATTR_CallContext_arg_flags(interp, call_object, arg_sig);
982
983 if (named_used_list != NULL)
984 parrot_hash_destroy(interp, named_used_list);
985
986 /* We've used up all the positional parameters, but have extra
987 * positional args left over. */
988 if (VTABLE_get_integer_keyed_int(interp, arg_sig, arg_index) & PARROT_ARG_NAME){
989 Parrot_ex_throw_from_c_args(interp, NULL,
990 EXCEPTION_INVALID_OPERATION,
991 "named arguments must follow all positional arguments");
992 }
993
994 Parrot_ex_throw_from_c_args(interp, NULL,
995 EXCEPTION_INVALID_OPERATION,
996 "too many positional arguments: %d passed, %d expected",
997 positional_args, param_index);
998 }
999
1000 /* Collected ("slurpy") named parameter */
1001 if (param_flags & PARROT_ARG_SLURPY_ARRAY) {
1002 PMC * const collect_named = Parrot_pmc_new(interp,
1003 Parrot_get_ctx_HLL_type(interp, enum_class_Hash));
1004 PMC * const named_arg_list = VTABLE_get_attr_str(interp, call_object, CONST_STRING(interp, "named"));
1005
1006 if (!PMC_IS_NULL(named_arg_list)) {
1007 const INTVAL named_arg_count = VTABLE_elements(interp, named_arg_list);
1008 INTVAL named_arg_index;
1009
1010 /* Named argument iteration. */
1011 for (named_arg_index = 0; named_arg_index < named_arg_count; ++named_arg_index) {
1012 STRING * const name = VTABLE_get_string_keyed_int(interp,
1013 named_arg_list, named_arg_index);
1014
1015 if ((named_used_list == NULL)
1016 || !parrot_hash_exists(interp, named_used_list, name)) {
1017
1018 VTABLE_set_pmc_keyed_str(interp, collect_named, name,
1019 VTABLE_get_pmc_keyed_str(interp, call_object, name));
1020
1021 /* Mark the name as used, cannot be filled again. */
1022 if (named_used_list==NULL) /* Only created if needed. */
1023 named_used_list = parrot_create_hash(interp,
1024 enum_type_INTVAL, Hash_key_type_STRING);
1025
1026 parrot_hash_put(interp, named_used_list, name, (void *)1);
1027
1028 ++named_count;
1029 }
1030 }
1031 }
1032
1033 *accessor->pmc(interp, arg_info, param_index) = collect_named;
1034 break; /* End of named parameters. */
1035 }
1036
1037 /* Store the name. */
1038 if (!(param_flags & PARROT_ARG_STRING)){
1039 if (named_used_list != NULL)
1040 parrot_hash_destroy(interp, named_used_list);
1041 Parrot_ex_throw_from_c_args(interp, NULL,
1042 EXCEPTION_INVALID_OPERATION,
1043 "named parameters must have a name specified");
1044 }
1045
1046 param_name = PARROT_ARG_CONSTANT_ISSET(param_flags)
1047 ? accessor->string_constant(interp, arg_info, param_index)
1048 : *accessor->string(interp, arg_info, param_index);
1049
1050 if (!STRING_IS_NULL(param_name)) {
1051 /* The next parameter is the actual value. */
1052 if (++param_index >= param_count)
1053 continue;
1054
1055 param_flags = raw_params[param_index];
1056
1057 if (VTABLE_exists_keyed_str(interp, call_object, param_name)) {
1058
1059 /* Mark the name as used, cannot be filled again. */
1060 if (named_used_list==NULL) /* Only created if needed. */
1061 named_used_list = parrot_create_hash(interp,
1062 enum_type_INTVAL, Hash_key_type_STRING);
1063
1064 parrot_hash_put(interp, named_used_list, param_name, (void *)1);
1065 ++named_count;
1066
1067 /* Fill the named parameter. */
1068 switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
1069 case PARROT_ARG_INTVAL:
1070 *accessor->intval(interp, arg_info, param_index) =
1071 VTABLE_get_integer_keyed_str(interp, call_object, param_name);
1072 break;
1073 case PARROT_ARG_FLOATVAL:
1074 *accessor->numval(interp, arg_info, param_index) =
1075 VTABLE_get_number_keyed_str(interp, call_object, param_name);
1076 break;
1077 case PARROT_ARG_STRING:
1078 *accessor->string(interp, arg_info, param_index) =
1079 VTABLE_get_string_keyed_str(interp, call_object, param_name);
1080 break;
1081 case PARROT_ARG_PMC:
1082 *accessor->pmc(interp, arg_info, param_index) =
1083 VTABLE_get_pmc_keyed_str(interp, call_object, param_name);
1084 break;
1085 default:
1086 if (named_used_list != NULL)
1087 parrot_hash_destroy(interp, named_used_list);
1088 Parrot_ex_throw_from_c_args(interp, NULL,
1089 EXCEPTION_INVALID_OPERATION, "invalid parameter type");
1090 break;
1091 }
1092
1093 /* Mark the option flag for the filled parameter. */
1094 if (param_flags & PARROT_ARG_OPTIONAL) {
1095 if (param_index + 1 < param_count) {
1096 const INTVAL next_param_flags = raw_params[param_index + 1];
1097
1098 if (next_param_flags & PARROT_ARG_OPT_FLAG) {
1099 ++param_index;
1100 *accessor->intval(interp, arg_info, param_index) = 1;
1101 }
1102 }
1103 }
1104 }
1105 else if (param_flags & PARROT_ARG_OPTIONAL) {
1106 assign_default_param_value(interp, param_index, param_flags,
1107 arg_info, accessor);
1108
1109 /* Mark the option flag for the parameter to FALSE;
1110 * it was filled with a default value. */
1111 if (param_index + 1 < param_count) {
1112 const INTVAL next_param_flags = raw_params[param_index + 1];
1113
1114 if (next_param_flags & PARROT_ARG_OPT_FLAG) {
1115 ++param_index;
1116 *accessor->intval(interp, arg_info, param_index) = 0;
1117 }
1118 }
1119 }
1120
1121 /* We don't have an argument for the parameter, and it's not
1122 * optional, so it's an error. */
1123 else {
1124 if (err_check){
1125 if (named_used_list != NULL)
1126 parrot_hash_destroy(interp, named_used_list);
1127 Parrot_ex_throw_from_c_args(interp, NULL,
1128 EXCEPTION_INVALID_OPERATION,
1129 "too few named arguments: "
1130 "no argument for required parameter '%S'", param_name);
1131 }
1132 }
1133 }
1134
1135 ++param_index;
1136 }
1137
1138 if (named_used_list != NULL)
1139 parrot_hash_destroy(interp, named_used_list);
1140
1141 /* Double check that all named arguments were assigned to parameters. */
1142 if (err_check) {
1143 PMC *named_arg_list;
1144 Hash *h;
1145 /* Early exit to avoid vtable call */
1146 GETATTR_CallContext_hash(interp, call_object, h);
1147 if (!h || !h->entries){
1148 return;
1149 }
1150
1151 named_arg_list = VTABLE_get_attr_str(interp, call_object, CONST_STRING(interp, "named"));
1152
1153 if (!PMC_IS_NULL(named_arg_list)) {
1154 const INTVAL named_arg_count = VTABLE_elements(interp, named_arg_list);
1155
1156 if (named_used_list==NULL)
1157 return;
1158
1159 /* The 'return' above is a temporary hack to duplicate an old
1160 * bug, and will be replaced by the exception below at the next
1161 * deprecation point, see TT #1103
1162
1163 Parrot_ex_throw_from_c_args(interp, NULL,
1164 EXCEPTION_INVALID_OPERATION,
1165 "too many named arguments: %d passed, 0 used",
1166 named_arg_count);
1167 */
1168
1169 if (named_arg_count > named_count) {
1170 /* At this point we know we have named arguments that weren't
1171 * assigned to parameters. We're going to throw an exception
1172 * anyway, so spend a little extra effort to tell the user
1173 * *which* named argument is extra. */
1174 INTVAL named_arg_index;
1175
1176 /* Named argument iteration. */
1177 for (named_arg_index = 0; named_arg_index < named_arg_count; ++named_arg_index) {
1178 STRING * const name = VTABLE_get_string_keyed_int(interp,
1179 named_arg_list, named_arg_index);
1180
1181 if (!parrot_hash_exists(interp, named_used_list, name)) {
1182 Parrot_ex_throw_from_c_args(interp, NULL,
1183 EXCEPTION_INVALID_OPERATION,
1184 "too many named arguments: '%S' not used",
1185 name);
1186 }
1187 }
1188 }
1189 }
1190 }
1191 }
1192
1193
1194 /*
1195
1196 =item C<static void assign_default_param_value(PARROT_INTERP, INTVAL
1197 param_index, INTVAL param_flags, void *arg_info, struct pcc_funcs_ptr
1198 *accessor)>
1199
1200 Assign an appropriate default value to the parameter depending on its type
1201
1202 =cut
1203
1204 */
1205
1206 static void
1207 assign_default_param_value(PARROT_INTERP, INTVAL param_index, INTVAL param_flags,
1208 ARGIN(void *arg_info), ARGMOD(struct pcc_funcs_ptr *accessor))
1209 {
1210 ASSERT_ARGS(assign_default_param_value)
1211 switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
1212 case PARROT_ARG_INTVAL:
1213 *accessor->intval(interp, arg_info, param_index) = 0;
1214 break;
1215 case PARROT_ARG_FLOATVAL:
1216 *accessor->numval(interp, arg_info, param_index) = 0.0;
1217 break;
1218 case PARROT_ARG_STRING:
1219 *accessor->string(interp, arg_info, param_index) = NULL;
1220 break;
1221 case PARROT_ARG_PMC:
1222 *accessor->pmc(interp, arg_info, param_index) = PMCNULL;
1223 break;
1224 default:
1225 Parrot_ex_throw_from_c_args(interp, NULL,
1226 EXCEPTION_INVALID_OPERATION, "invalid parameter type");
1227 break;
1228 }
1229 }
1230
1231 /*
1232
1233 =item C<void Parrot_pcc_fill_params_from_op(PARROT_INTERP, PMC *call_object, PMC
1234 *raw_sig, opcode_t *raw_params, Errors_classes direction)>
1235
1236 Gets args for the current function call and puts them into position.
1237 First it gets the positional non-slurpy parameters, then the positional
1238 slurpy parameters, then the named parameters, and finally the named
1239 slurpy parameters.
1240
1241 C<direction> used to distinguish set_returns vs set_params for checking
1242 different flags.
1243
1244 =cut
1245
1246 */
1247
1248 PARROT_EXPORT
1249 void
1250 Parrot_pcc_fill_params_from_op(PARROT_INTERP, ARGMOD_NULLOK(PMC *call_object),
1251 ARGIN(PMC *raw_sig), ARGIN(opcode_t *raw_params), Errors_classes direction)
1252 {
1253 ASSERT_ARGS(Parrot_pcc_fill_params_from_op)
1254
1255 static pcc_funcs_ptr function_pointers = {
1256 (intval_ptr_func_t)intval_param_from_op,
1257 (numval_ptr_func_t)numval_param_from_op,
1258 (string_ptr_func_t)string_param_from_op,
1259 (pmc_ptr_func_t)pmc_param_from_op,
1260
1261 (intval_func_t)intval_constant_from_op,
1262 (numval_func_t)numval_constant_from_op,
1263 (string_func_t)string_constant_from_op,
1264 (pmc_func_t)pmc_constant_from_op,
1265 };
1266
1267 fill_params(interp, call_object, raw_sig, raw_params, &function_pointers, direction);
1268 }
1269
1270 /*
1271
1272 =item C<void Parrot_pcc_fill_params_from_c_args(PARROT_INTERP, PMC *call_object,
1273 const char *signature, ...)>
1274
1275 Gets args for the current function call and puts them into position.
1276 First it gets the positional non-slurpy parameters, then the positional
1277 slurpy parameters, then the named parameters, and finally the named
1278 slurpy parameters.
1279
1280 The signature is a string in the format used for
1281 C<Parrot_pcc_invoke_from_sig_object>, but with no return arguments. The
1282 parameters are passed in as a list of references to the destination
1283 variables.
1284
1285 =cut
1286
1287 */
1288
1289 PARROT_EXPORT
1290 void
1291 Parrot_pcc_fill_params_from_c_args(PARROT_INTERP, ARGMOD(PMC *call_object),
1292 ARGIN(const char *signature), ...)
1293 {
1294 ASSERT_ARGS(Parrot_pcc_fill_params_from_c_args)
1295 va_list args;
1296
1297 va_start(args, signature);
1298 Parrot_pcc_fill_params_from_varargs(interp, call_object, signature, &args,
1299 PARROT_ERRORS_PARAM_COUNT_FLAG);
1300 va_end(args);
1301 }
1302
1303 /*
1304
1305 =item C<void Parrot_pcc_fill_params_from_varargs(PARROT_INTERP, PMC
1306 *call_object, const char *signature, va_list *args, Errors_classes direction)>
1307
1308 Gets args for the current function call and puts them into position.
1309 First it gets the positional non-slurpy parameters, then the positional
1310 slurpy parameters, then the named parameters, and finally the named
1311 slurpy parameters.
1312
1313 The signature is a string in the format used for
1314 C<Parrot_pcc_invoke_from_sig_object>, but with no return arguments. The
1315 parameters are passed in as a list of references to the destination
1316 variables.
1317
1318 =cut
1319
1320 */
1321
1322 PARROT_EXPORT
1323 void
1324 Parrot_pcc_fill_params_from_varargs(PARROT_INTERP, ARGMOD_NULLOK(PMC *call_object),
1325 ARGIN(const char *signature), ARGMOD(va_list *args), Errors_classes direction)
1326 {
1327 ASSERT_ARGS(Parrot_pcc_fill_params_from_varargs)
1328 PMC *raw_sig = PMCNULL;
1329 static pcc_funcs_ptr function_pointers = {
1330 (intval_ptr_func_t)intval_param_from_c_args,
1331 (numval_ptr_func_t)numval_param_from_c_args,
1332 (string_ptr_func_t)string_param_from_c_args,
1333 (pmc_ptr_func_t)pmc_param_from_c_args,
1334
1335 (intval_func_t)intval_constant_from_varargs,
1336 (numval_func_t)numval_constant_from_varargs,
1337 (string_func_t)string_constant_from_varargs,
1338 (pmc_func_t)pmc_constant_from_varargs,
1339 };
1340
1341 /* empty args or empty returns */
1342 if (*signature == '-' || *signature == '\0')
1343 return;
1344
1345 parse_signature_string(interp, signature, &raw_sig);
1346
1347 fill_params(interp, call_object, raw_sig, args, &function_pointers,
1348 direction);
1349 }
1350
1351 /*
1352
1353 =item C<void Parrot_pcc_split_signature_string(const char *signature, const char
1354 **arg_sig, const char **return_sig)>
1355
1356 Splits a full signature string and creates call and return signature strings.
1357 The two result strings should be passed in as references to a C string.
1358
1359 =cut
1360
1361 */
1362
1363 void
1364 Parrot_pcc_split_signature_string(ARGIN(const char *signature),
1365 ARGMOD(const char **arg_sig), ARGMOD(const char **return_sig))
1366 {
1367 ASSERT_ARGS(Parrot_pcc_split_signature_string)
1368 const char *cur;
1369 *arg_sig = signature;
1370
1371 for (cur = signature; *cur != '\0'; ++cur) {
1372 if (*cur == '-') {
1373 *return_sig = cur + 2;
1374 return;
1375 }
1376 }
1377
1378 *return_sig = cur;
1379 }
1380
1381 /*
1382
1383 =item C<static void parse_signature_string(PARROT_INTERP, const char *signature,
1384 PMC **arg_flags)>
1385
1386 Parses a signature string and creates call and return signature integer
1387 arrays. The two integer arrays should be passed in as references to a
1388 PMC.
1389
1390 =cut
1391
1392 */
1393
1394 static void
1395 parse_signature_string(PARROT_INTERP, ARGIN(const char *signature),
1396 ARGMOD(PMC **arg_flags))
1397 {
1398 ASSERT_ARGS(parse_signature_string)
1399 PMC *current_array;
1400 const char *x;
1401 INTVAL flags = 0;
1402 INTVAL set = 0;
1403 INTVAL count = 0;
1404
1405 for (x = signature; *x; ++x) {
1406 if (*x == '-')
1407 break;
1408 switch (*x) {
1409 case 'I': count++; break;
1410 case 'N': count++; break;
1411 case 'S': count++; break;
1412 case 'P': count++; break;
1413 default: break;
1414 }
1415 }
1416
1417 if (PMC_IS_NULL(*arg_flags))
1418 current_array = *arg_flags
1419 = Parrot_pmc_new_init_int(interp,
1420 enum_class_ResizableIntegerArray, count);
1421 else {
1422 current_array = *arg_flags;
1423 VTABLE_set_integer_native(interp, current_array, count);
1424 }
1425
1426 count = 0;
1427
1428 for (x = signature; *x != '\0'; ++x) {
1429
1430 /* detect -> separator */
1431 if (*x == '-')
1432 break;
1433
1434 /* parse arg type */
1435 else if (isupper((unsigned char)*x)) {
1436 /* Starting a new argument, so store the previous argument,
1437 * if there was one. */
1438 if (set) {
1439 VTABLE_set_integer_keyed_int(interp, current_array, count++, flags);
1440 set = 0;
1441 }
1442
1443 switch (*x) {
1444 case 'I': flags = PARROT_ARG_INTVAL; ++set; break;
1445 case 'N': flags = PARROT_ARG_FLOATVAL; ++set; break;
1446 case 'S': flags = PARROT_ARG_STRING; ++set; break;
1447 case 'P': flags = PARROT_ARG_PMC; ++set; break;
1448 default:
1449 Parrot_ex_throw_from_c_args(interp, NULL,
1450 EXCEPTION_INVALID_OPERATION,
1451 "invalid signature string element %c!", *x);
1452 }
1453
1454 }
1455 /* parse arg adverbs */
1456 else if (islower((unsigned char)*x)) {
1457 switch (*x) {
1458 case 'c': flags |= PARROT_ARG_CONSTANT; break;
1459 case 'f': flags |= PARROT_ARG_FLATTEN; break;
1460 case 'i': flags |= PARROT_ARG_INVOCANT; break;
1461 case 'l': flags |= PARROT_ARG_LOOKAHEAD; break;
1462 case 'n': flags |= PARROT_ARG_NAME; break;
1463 case 'o': flags |= PARROT_ARG_OPTIONAL; break;
1464 case 'p': flags |= PARROT_ARG_OPT_FLAG; break;
1465 case 's': flags |= PARROT_ARG_SLURPY_ARRAY; break;
1466 default:
1467 Parrot_ex_throw_from_c_args(interp, NULL,
1468 EXCEPTION_INVALID_OPERATION,
1469 "invalid signature string element %c!", *x);
1470 }
1471 }
1472 }
1473
1474 /* Store the final argument, if there was one. */
1475 if (set)
1476 VTABLE_set_integer_keyed_int(interp, current_array, count, flags);
1477 }
1478
1479 /*
1480
1481 =item C<void Parrot_pcc_parse_signature_string(PARROT_INTERP, STRING *signature,
1482 PMC **arg_flags, PMC **return_flags)>
1483
1484 Parses a signature string and creates call and return signature integer
1485 arrays. The two integer arrays should be passed in as references to a
1486 PMC.
1487
1488 =cut
1489
1490 */
1491
1492 PARROT_CAN_RETURN_NULL
1493 void
1494 Parrot_pcc_parse_signature_string(PARROT_INTERP, ARGIN(STRING *signature),
1495 ARGMOD(PMC **arg_flags), ARGMOD(PMC **return_flags))
1496 {
1497 ASSERT_ARGS(Parrot_pcc_parse_signature_string)
1498 char * const s = Parrot_str_to_cstring(interp, signature);
1499 const char *arg_sig, *ret_sig;
1500
1501 Parrot_pcc_split_signature_string(s, &arg_sig, &ret_sig);
1502
1503 *arg_flags = PMCNULL;
1504 *return_flags = PMCNULL;
1505 parse_signature_string(interp, arg_sig, arg_flags);
1506 parse_signature_string(interp, ret_sig, return_flags);
1507 Parrot_str_free_cstring(s);
1508 }
1509
1510 /*
1511
1512 =item C<void Parrot_pcc_merge_signature_for_tailcall(PARROT_INTERP, PMC *
1513 parent, PMC * tailcall)>
1514
1515 merge in signatures for tailcall
1516
1517 =cut
1518
1519 */
1520
1521 void
1522 Parrot_pcc_merge_signature_for_tailcall(PARROT_INTERP,
1523 ARGMOD_NULLOK(PMC * parent), ARGMOD_NULLOK(PMC * tailcall))
1524 {
1525 ASSERT_ARGS(Parrot_pcc_merge_signature_for_tailcall)
1526 if (PMC_IS_NULL(parent) || PMC_IS_NULL(tailcall) || (parent == tailcall))
1527 return;
1528 else {
1529 /* Broke encapuslation. Direct poking into CallContext is much faster */
1530 PMC * return_flags;
1531
1532 /* Store raw signature */
1533 GETATTR_CallContext_return_flags(interp, parent, return_flags);
1534 SETATTR_CallContext_return_flags(interp, tailcall, return_flags);
1535
1536 }
1537 }
1538
1539 /*
1540
1541 Get the appropriate argument value from the op.
1542
1543 =item C<static INTVAL intval_arg_from_op(PARROT_INTERP, const opcode_t
1544 *raw_args, INTVAL arg_index)>
1545
1546 =item C<static FLOATVAL numval_arg_from_op(PARROT_INTERP, const opcode_t
1547 *raw_args, INTVAL arg_index)>
1548
1549 =item C<static STRING* string_arg_from_op(PARROT_INTERP, const opcode_t
1550 *raw_args, INTVAL arg_index)>
1551
1552 =item C<static PMC* pmc_arg_from_op(PARROT_INTERP, const opcode_t *raw_args,
1553 INTVAL arg_index)>
1554
1555 Get the appropriate parameter value from the op (these are pointers, so the
1556 argument value can be stored into them.)
1557
1558 =item C<static INTVAL* intval_param_from_op(PARROT_INTERP, const opcode_t
1559 *raw_params, INTVAL param_index)>
1560
1561 =item C<static FLOATVAL* numval_param_from_op(PARROT_INTERP, const opcode_t
1562 *raw_params, INTVAL param_index)>
1563
1564 =item C<static STRING** string_param_from_op(PARROT_INTERP, const opcode_t
1565 *raw_params, INTVAL param_index)>
1566
1567 =item C<static PMC** pmc_param_from_op(PARROT_INTERP, const opcode_t
1568 *raw_params, INTVAL param_index)>
1569
1570 =item C<static INTVAL intval_constant_from_op(PARROT_INTERP, const opcode_t
1571 *raw_params, INTVAL param_index)>
1572
1573 =item C<static FLOATVAL numval_constant_from_op(PARROT_INTERP, const opcode_t
1574 *raw_params, INTVAL param_index)>
1575
1576 =item C<static STRING* string_constant_from_op(PARROT_INTERP, const opcode_t
1577 *raw_params, INTVAL param_index)>
1578
1579 =item C<static PMC* pmc_constant_from_op(PARROT_INTERP, const opcode_t
1580 *raw_params, INTVAL param_index)>
1581
1582 Get the appropriate argument value from varargs.
1583
1584 =item C<static INTVAL intval_arg_from_c_args(PARROT_INTERP, va_list *args,
1585 INTVAL param_index)>
1586
1587 =item C<static FLOATVAL numval_arg_from_c_args(PARROT_INTERP, va_list *args,
1588 INTVAL param_index)>
1589
1590 =item C<static STRING* string_arg_from_c_args(PARROT_INTERP, va_list *args,
1591 INTVAL param_index)>
1592
1593 =item C<static PMC* pmc_arg_from_c_args(PARROT_INTERP, va_list *args, INTVAL
1594 param_index)>
1595
1596 Get the appropriate parameter value from varargs (these are pointers, so they
1597 can be set with the argument value).
1598
1599 =item C<static INTVAL* intval_param_from_c_args(PARROT_INTERP, va_list *args,
1600 INTVAL param_index)>
1601
1602 =item C<static FLOATVAL* numval_param_from_c_args(PARROT_INTERP, va_list *args,
1603 INTVAL param_index)>
1604
1605 =item C<static STRING** string_param_from_c_args(PARROT_INTERP, va_list *args,
1606 INTVAL param_index)>
1607
1608 =item C<static PMC** pmc_param_from_c_args(PARROT_INTERP, va_list *args, INTVAL
1609 param_index)>
1610
1611 Parrot constants cannot be passed from varargs, so these functions are dummies
1612 that throw exceptions.
1613
1614 =item C<static INTVAL intval_constant_from_varargs(PARROT_INTERP, void *data,
1615 INTVAL index)>
1616
1617 =item C<static FLOATVAL numval_constant_from_varargs(PARROT_INTERP, void *data,
1618 INTVAL index)>
1619
1620 =item C<static STRING* string_constant_from_varargs(PARROT_INTERP, void *data,
1621 INTVAL index)>
1622
1623 =item C<static PMC* pmc_constant_from_varargs(PARROT_INTERP, void *data, INTVAL
1624 index)>
1625
1626 - More specific comments can be added later
1627
1628 =cut
1629
1630 */
1631
1632 PARROT_WARN_UNUSED_RESULT
1633 PARROT_CANNOT_RETURN_NULL
1634 static INTVAL*
1635 intval_param_from_op(PARROT_INTERP, ARGIN(const opcode_t *raw_params), INTVAL param_index)
1636 {
1637 ASSERT_ARGS(intval_param_from_op)
1638 const INTVAL raw_index = raw_params[param_index + 2];
1639 return &REG_INT(interp, raw_index);
1640 }
1641
1642 PARROT_WARN_UNUSED_RESULT
1643 PARROT_CANNOT_RETURN_NULL
1644 static FLOATVAL*
1645 numval_param_from_op(PARROT_INTERP, ARGIN(const opcode_t *raw_params), INTVAL param_index)
1646 {
1647 ASSERT_ARGS(numval_param_from_op)
1648 const INTVAL raw_index = raw_params[param_index + 2];
1649 return &REG_NUM(interp, raw_index);
1650 }
1651
1652 PARROT_WARN_UNUSED_RESULT
1653 PARROT_CANNOT_RETURN_NULL
1654 static STRING**
1655 string_param_from_op(PARROT_INTERP, ARGIN(const opcode_t *raw_params), INTVAL param_index)
1656 {
1657 ASSERT_ARGS(string_param_from_op)
1658 const INTVAL raw_index = raw_params[param_index + 2];
1659 return &REG_STR(interp, raw_index);
1660 }
1661
1662 PARROT_WARN_UNUSED_RESULT
1663 PARROT_CANNOT_RETURN_NULL
1664 static PMC**
1665 pmc_param_from_op(PARROT_INTERP, ARGIN(const opcode_t *raw_params), INTVAL param_index)
1666 {
1667 ASSERT_ARGS(pmc_param_from_op)
1668 const INTVAL raw_index = raw_params[param_index + 2];
1669 return &REG_PMC(interp, raw_index);
1670 }
1671
1672 PARROT_WARN_UNUSED_RESULT
1673 static INTVAL
1674 intval_constant_from_op(SHIM_INTERP, ARGIN(const opcode_t *raw_params), INTVAL param_index)
1675 {
1676 ASSERT_ARGS(intval_constant_from_op)
1677 const INTVAL raw_index = raw_params[param_index + 2];
1678 return raw_index;
1679 }
1680
1681 PARROT_WARN_UNUSED_RESULT
1682 static FLOATVAL
1683 numval_constant_from_op(PARROT_INTERP, ARGIN(const opcode_t *raw_params), INTVAL param_index)
1684 {
1685 ASSERT_ARGS(numval_constant_from_op)
1686 const INTVAL raw_index = raw_params[param_index + 2];
1687 return Parrot_pcc_get_num_constant(interp, CURRENT_CONTEXT(interp), raw_index);
1688 }
1689
1690 PARROT_WARN_UNUSED_RESULT
1691 PARROT_CAN_RETURN_NULL
1692 static STRING*
1693 string_constant_from_op(PARROT_INTERP, ARGIN(const opcode_t *raw_params), INTVAL param_index)
1694 {
1695 ASSERT_ARGS(string_constant_from_op)
1696 const INTVAL raw_index = raw_params[param_index + 2];
1697 return Parrot_pcc_get_string_constant(interp, CURRENT_CONTEXT(interp), raw_index);
1698 }
1699
1700 PARROT_WARN_UNUSED_RESULT
1701 PARROT_CAN_RETURN_NULL
1702 static PMC*
1703 pmc_constant_from_op(PARROT_INTERP, ARGIN(const opcode_t *raw_params), INTVAL param_index)
1704 {
1705 ASSERT_ARGS(pmc_constant_from_op)
1706 const INTVAL raw_index = raw_params[param_index + 2];
1707 return Parrot_pcc_get_pmc_constant(interp, CURRENT_CONTEXT(interp), raw_index);
1708 }
1709
1710 PARROT_WARN_UNUSED_RESULT
1711 PARROT_CANNOT_RETURN_NULL
1712 static INTVAL*
1713 intval_param_from_c_args(SHIM_INTERP, ARGIN(va_list *args), SHIM(INTVAL param_index))
1714 {
1715 ASSERT_ARGS(intval_param_from_c_args)
1716 return va_arg(*args, INTVAL*);
1717 }
1718
1719 PARROT_WARN_UNUSED_RESULT
1720 PARROT_CANNOT_RETURN_NULL
1721 static FLOATVAL*
1722 numval_param_from_c_args(SHIM_INTERP, ARGIN(va_list *args), SHIM(INTVAL param_index))
1723 {
1724 ASSERT_ARGS(numval_param_from_c_args)
1725 return va_arg(*args, FLOATVAL*);
1726 }
1727
1728 PARROT_WARN_UNUSED_RESULT
1729 PARROT_CANNOT_RETURN_NULL
1730 static STRING**
1731 string_param_from_c_args(SHIM_INTERP, ARGIN(va_list *args), SHIM(INTVAL param_index))
1732 {
1733 ASSERT_ARGS(string_param_from_c_args)
1734 return va_arg(*args, STRING**);
1735 }
1736
1737 PARROT_WARN_UNUSED_RESULT
1738 PARROT_CANNOT_RETURN_NULL
1739 static PMC**
1740 pmc_param_from_c_args(SHIM_INTERP, ARGIN(va_list *args), SHIM(INTVAL param_index))
1741 {
1742 ASSERT_ARGS(pmc_param_from_c_args)
1743 return va_arg(*args, PMC**);
1744 }
1745
1746 PARROT_WARN_UNUSED_RESULT
1747 static INTVAL
1748 intval_constant_from_varargs(SHIM_INTERP, SHIM(void *data), SHIM(INTVAL index))
1749 {
1750 ASSERT_ARGS(intval_constant_from_varargs)
1751 PARROT_FAILURE("Wrong call");
1752 return 0;
1753 }
1754
1755 PARROT_WARN_UNUSED_RESULT
1756 static FLOATVAL
1757 numval_constant_from_varargs(SHIM_INTERP, SHIM(void *data), SHIM(INTVAL index))
1758 {
1759 ASSERT_ARGS(numval_constant_from_varargs)
1760 PARROT_FAILURE("Wrong call");
1761 return 0.0;
1762 }
1763
1764 PARROT_CAN_RETURN_NULL
1765 PARROT_WARN_UNUSED_RESULT
1766 static STRING*
1767 string_constant_from_varargs(SHIM_INTERP, SHIM(void *data), SHIM(INTVAL index))
1768 {
1769 ASSERT_ARGS(string_constant_from_varargs)
1770 PARROT_FAILURE("Wrong call");
1771 return NULL;
1772 }
1773
1774 PARROT_CAN_RETURN_NULL
1775 PARROT_WARN_UNUSED_RESULT
1776 static PMC*
1777 pmc_constant_from_varargs(SHIM_INTERP, SHIM(void *data), SHIM(INTVAL index))
1778 {
1779 ASSERT_ARGS(pmc_constant_from_varargs)
1780 PARROT_FAILURE("Wrong call");
1781 return PMCNULL;
1782 }
1783
1784 /*
1785
1786 =item C<static PMC* clone_key_arg(PARROT_INTERP, PMC *key)>
1787
1788 Replaces any src registers by their values (done inside clone). This needs a
1789 test for tailcalls too, but I think there is no syntax to pass a key to a
1790 tailcalled function or method.
1791
1792 =cut
1793
1794 */
1795
1796 PARROT_CAN_RETURN_NULL
1797 PARROT_WARN_UNUSED_RESULT
1798 static PMC*
1799 clone_key_arg(PARROT_INTERP, ARGIN(PMC *key))
1800 {
1801 ASSERT_ARGS(clone_key_arg)
1802 PMC *t;
1803
1804 if (PMC_IS_NULL(key))
1805 return key;
1806
1807 if (key->vtable->base_type != enum_class_Key)
1808 return key;
1809
1810 for (t = key; t; t=key_next(interp, t)) {
1811 /* register keys have to be cloned */
1812 if (PObj_get_FLAGS(key) & KEY_register_FLAG) {
1813 return VTABLE_clone(interp, key);
1814 }
1815 }
1816
1817 return key;
1818 }
1819
1820 /*
1821
1822 =back
1823
1824 =head1 SEE ALSO
1825
1826 F<include/parrot/call.h>, F<src/call/ops.c>, F<src/call/pcc.c>.
1827
1828 =cut
1829
1830 */
1831
1832 /*
1833 * Local variables:
1834 * c-file-style: "parrot"
1835 * End:
1836 * vim: expandtab shiftwidth=4:
1837 */
parrot vm git mirror