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