?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
[t][cage] Remove PGE-dependence from t/op/inf_nan.t since it is part of 'make coretest'
[parrot.git] / src / call / args.c
blob34fa65bcf8a015c02c09c42fa9c4f87e60314d96
1 /*
2 Copyright (C) 2001-2009, 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 "parrot/runcore_api.h"
25 #include "args.str"
26 #include "pmc/pmc_key.h"
27 #include "pmc/pmc_callsignature.h"
28 #include "pmc/pmc_fixedintegerarray.h"
29 #include "pmc/pmc_context.h"
30
31 /* HEADERIZER HFILE: include/parrot/call.h */
32
33 /*
34 Set of functions used in generic versions of fill_params and fill_returns.
35 */
36 typedef INTVAL* (*intval_ptr_func_t)(PARROT_INTERP, void *arg_info, INTVAL index);
37 typedef FLOATVAL* (*numval_ptr_func_t)(PARROT_INTERP, void *arg_info, INTVAL index);
38 typedef STRING** (*string_ptr_func_t)(PARROT_INTERP, void *arg_info, INTVAL index);
39 typedef PMC** (*pmc_ptr_func_t) (PARROT_INTERP, void *arg_info, INTVAL index);
40
41 typedef INTVAL (*intval_func_t)(PARROT_INTERP, void *arg_info, INTVAL index);
42 typedef FLOATVAL (*numval_func_t)(PARROT_INTERP, void *arg_info, INTVAL index);
43 typedef STRING* (*string_func_t)(PARROT_INTERP, void *arg_info, INTVAL index);
44 typedef PMC* (*pmc_func_t) (PARROT_INTERP, void *arg_info, INTVAL index);
45
46 typedef struct pcc_set_funcs {
47 intval_ptr_func_t intval;
48 numval_ptr_func_t numval;
49 string_ptr_func_t string;
50 pmc_ptr_func_t pmc;
51
52 intval_func_t intval_constant;
53 numval_func_t numval_constant;
54 string_func_t string_constant;
55 pmc_func_t pmc_constant;
56 } pcc_set_funcs;
57
58 typedef struct pcc_get_funcs {
59 intval_func_t intval;
60 numval_func_t numval;
61 string_func_t string;
62 pmc_func_t pmc;
63
64 intval_func_t intval_constant;
65 numval_func_t numval_constant;
66 string_func_t string_constant;
67 pmc_func_t pmc_constant;
68 } pcc_get_funcs;
69
70 /* HEADERIZER BEGIN: static */
71 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
72
73 static void assign_default_param_value(PARROT_INTERP,
74 INTVAL param_index,
75 INTVAL param_flags,
76 ARGIN(void *arg_info),
77 ARGIN(struct pcc_set_funcs *accessor))
78 __attribute__nonnull__(1)
79 __attribute__nonnull__(4)
80 __attribute__nonnull__(5);
81
82 static void assign_default_result_value(PARROT_INTERP,
83 ARGMOD(PMC *results),
84 INTVAL index,
85 INTVAL result_flags)
86 __attribute__nonnull__(1)
87 __attribute__nonnull__(2)
88 FUNC_MODIFIES(*results);
89
90 PARROT_CAN_RETURN_NULL
91 static PMC* clone_key_arg(PARROT_INTERP, ARGIN(PMC *key))
92 __attribute__nonnull__(1)
93 __attribute__nonnull__(2);
94
95 PARROT_CANNOT_RETURN_NULL
96 static void dissect_aggregate_arg(PARROT_INTERP,
97 ARGMOD(PMC *call_object),
98 ARGIN(PMC *aggregate))
99 __attribute__nonnull__(1)
100 __attribute__nonnull__(2)
101 __attribute__nonnull__(3)
102 FUNC_MODIFIES(*call_object);
103
104 static void extract_named_arg_from_op(PARROT_INTERP,
105 ARGMOD(PMC *call_object),
106 ARGIN(STRING *name),
107 ARGIN(PMC * const raw_sig),
108 ARGIN(opcode_t * const raw_args),
109 INTVAL arg_index)
110 __attribute__nonnull__(1)
111 __attribute__nonnull__(2)
112 __attribute__nonnull__(3)
113 __attribute__nonnull__(4)
114 __attribute__nonnull__(5)
115 FUNC_MODIFIES(*call_object);
116
117 static void fill_params(PARROT_INTERP,
118 ARGMOD_NULLOK(PMC *call_object),
119 ARGIN(PMC *raw_sig),
120 ARGIN(void *arg_info),
121 ARGIN(struct pcc_set_funcs *accessor))
122 __attribute__nonnull__(1)
123 __attribute__nonnull__(3)
124 __attribute__nonnull__(4)
125 __attribute__nonnull__(5)
126 FUNC_MODIFIES(*call_object);
127
128 static void fill_results(PARROT_INTERP,
129 ARGMOD_NULLOK(PMC *call_object),
130 ARGIN(PMC *raw_sig),
131 ARGIN(void *return_info),
132 ARGIN(struct pcc_get_funcs *accessor))
133 __attribute__nonnull__(1)
134 __attribute__nonnull__(3)
135 __attribute__nonnull__(4)
136 __attribute__nonnull__(5)
137 FUNC_MODIFIES(*call_object);
138
139 PARROT_CANNOT_RETURN_NULL
140 static INTVAL intval_arg_from_c_args(PARROT_INTERP,
141 ARGIN(va_list *args),
142 SHIM(INTVAL param_index))
143 __attribute__nonnull__(1)
144 __attribute__nonnull__(2);
145
146 PARROT_CANNOT_RETURN_NULL
147 static INTVAL intval_arg_from_continuation(PARROT_INTERP,
148 ARGIN(PMC *cs),
149 INTVAL arg_index)
150 __attribute__nonnull__(1)
151 __attribute__nonnull__(2);
152
153 PARROT_CANNOT_RETURN_NULL
154 static INTVAL intval_arg_from_op(PARROT_INTERP,
155 ARGIN(opcode_t *raw_args),
156 INTVAL arg_index)
157 __attribute__nonnull__(1)
158 __attribute__nonnull__(2);
159
160 static INTVAL intval_constant_from_op(PARROT_INTERP,
161 ARGIN(opcode_t *raw_params),
162 INTVAL param_index)
163 __attribute__nonnull__(1)
164 __attribute__nonnull__(2);
165
166 static INTVAL intval_constant_from_varargs(PARROT_INTERP,
167 ARGIN(void *data),
168 INTVAL index)
169 __attribute__nonnull__(1)
170 __attribute__nonnull__(2);
171
172 PARROT_CANNOT_RETURN_NULL
173 static INTVAL* intval_param_from_c_args(PARROT_INTERP,
174 ARGIN(va_list *args),
175 SHIM(INTVAL param_index))
176 __attribute__nonnull__(1)
177 __attribute__nonnull__(2);
178
179 PARROT_CANNOT_RETURN_NULL
180 static INTVAL* intval_param_from_op(PARROT_INTERP,
181 ARGIN(opcode_t *raw_params),
182 INTVAL param_index)
183 __attribute__nonnull__(1)
184 __attribute__nonnull__(2);
185
186 PARROT_CANNOT_RETURN_NULL
187 static FLOATVAL numval_arg_from_c_args(PARROT_INTERP,
188 ARGIN(va_list *args),
189 SHIM(INTVAL param_index))
190 __attribute__nonnull__(1)
191 __attribute__nonnull__(2);
192
193 PARROT_CANNOT_RETURN_NULL
194 static FLOATVAL numval_arg_from_continuation(PARROT_INTERP,
195 ARGIN(PMC *cs),
196 INTVAL arg_index)
197 __attribute__nonnull__(1)
198 __attribute__nonnull__(2);
199
200 PARROT_CANNOT_RETURN_NULL
201 static FLOATVAL numval_arg_from_op(PARROT_INTERP,
202 ARGIN(opcode_t *raw_args),
203 INTVAL arg_index)
204 __attribute__nonnull__(1)
205 __attribute__nonnull__(2);
206
207 static FLOATVAL numval_constant_from_op(PARROT_INTERP,
208 ARGIN(opcode_t *raw_params),
209 INTVAL param_index)
210 __attribute__nonnull__(1)
211 __attribute__nonnull__(2);
212
213 static FLOATVAL numval_constant_from_varargs(PARROT_INTERP,
214 ARGIN(void *data),
215 INTVAL index)
216 __attribute__nonnull__(1)
217 __attribute__nonnull__(2);
218
219 PARROT_CANNOT_RETURN_NULL
220 static FLOATVAL* numval_param_from_c_args(PARROT_INTERP,
221 ARGIN(va_list *args),
222 SHIM(INTVAL param_index))
223 __attribute__nonnull__(1)
224 __attribute__nonnull__(2);
225
226 PARROT_CANNOT_RETURN_NULL
227 static FLOATVAL* numval_param_from_op(PARROT_INTERP,
228 ARGIN(opcode_t *raw_params),
229 INTVAL param_index)
230 __attribute__nonnull__(1)
231 __attribute__nonnull__(2);
232
233 PARROT_CAN_RETURN_NULL
234 static void parse_signature_string(PARROT_INTERP,
235 ARGIN(const char *signature),
236 ARGMOD(PMC **arg_flags),
237 ARGMOD(PMC **return_flags))
238 __attribute__nonnull__(1)
239 __attribute__nonnull__(2)
240 __attribute__nonnull__(3)
241 __attribute__nonnull__(4)
242 FUNC_MODIFIES(*arg_flags)
243 FUNC_MODIFIES(*return_flags);
244
245 PARROT_CANNOT_RETURN_NULL
246 static PMC* pmc_arg_from_c_args(PARROT_INTERP,
247 ARGIN(va_list *args),
248 SHIM(INTVAL param_index))
249 __attribute__nonnull__(1)
250 __attribute__nonnull__(2);
251
252 PARROT_CANNOT_RETURN_NULL
253 static PMC* pmc_arg_from_continuation(PARROT_INTERP,
254 ARGIN(PMC *cs),
255 INTVAL arg_index)
256 __attribute__nonnull__(1)
257 __attribute__nonnull__(2);
258
259 PARROT_CANNOT_RETURN_NULL
260 static PMC* pmc_arg_from_op(PARROT_INTERP,
261 ARGIN(opcode_t *raw_args),
262 INTVAL arg_index)
263 __attribute__nonnull__(1)
264 __attribute__nonnull__(2);
265
266 PARROT_CAN_RETURN_NULL
267 static PMC* pmc_constant_from_op(PARROT_INTERP,
268 ARGIN(opcode_t *raw_params),
269 INTVAL param_index)
270 __attribute__nonnull__(1)
271 __attribute__nonnull__(2);
272
273 PARROT_CAN_RETURN_NULL
274 static PMC* pmc_constant_from_varargs(PARROT_INTERP,
275 ARGIN(void *data),
276 INTVAL index)
277 __attribute__nonnull__(1)
278 __attribute__nonnull__(2);
279
280 PARROT_CANNOT_RETURN_NULL
281 static PMC** pmc_param_from_c_args(PARROT_INTERP,
282 ARGIN(va_list *args),
283 SHIM(INTVAL param_index))
284 __attribute__nonnull__(1)
285 __attribute__nonnull__(2);
286
287 PARROT_CANNOT_RETURN_NULL
288 static PMC** pmc_param_from_op(PARROT_INTERP,
289 ARGIN(opcode_t *raw_params),
290 INTVAL param_index)
291 __attribute__nonnull__(1)
292 __attribute__nonnull__(2);
293
294 PARROT_CANNOT_RETURN_NULL
295 static STRING* string_arg_from_c_args(PARROT_INTERP,
296 ARGIN(va_list *args),
297 SHIM(INTVAL param_index))
298 __attribute__nonnull__(1)
299 __attribute__nonnull__(2);
300
301 PARROT_CANNOT_RETURN_NULL
302 static STRING* string_arg_from_continuation(PARROT_INTERP,
303 ARGIN(PMC *cs),
304 INTVAL arg_index)
305 __attribute__nonnull__(1)
306 __attribute__nonnull__(2);
307
308 PARROT_CANNOT_RETURN_NULL
309 static STRING* string_arg_from_op(PARROT_INTERP,
310 ARGIN(opcode_t *raw_args),
311 INTVAL arg_index)
312 __attribute__nonnull__(1)
313 __attribute__nonnull__(2);
314
315 PARROT_CAN_RETURN_NULL
316 static STRING* string_constant_from_op(PARROT_INTERP,
317 ARGIN(opcode_t *raw_params),
318 INTVAL param_index)
319 __attribute__nonnull__(1)
320 __attribute__nonnull__(2);
321
322 PARROT_CAN_RETURN_NULL
323 static STRING* string_constant_from_varargs(PARROT_INTERP,
324 ARGIN(void *data),
325 INTVAL index)
326 __attribute__nonnull__(1)
327 __attribute__nonnull__(2);
328
329 PARROT_CANNOT_RETURN_NULL
330 static STRING** string_param_from_c_args(PARROT_INTERP,
331 ARGIN(va_list *args),
332 SHIM(INTVAL param_index))
333 __attribute__nonnull__(1)
334 __attribute__nonnull__(2);
335
336 PARROT_CANNOT_RETURN_NULL
337 static STRING** string_param_from_op(PARROT_INTERP,
338 ARGIN(opcode_t *raw_params),
339 INTVAL param_index)
340 __attribute__nonnull__(1)
341 __attribute__nonnull__(2);
342
343 #define ASSERT_ARGS_assign_default_param_value __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
344 PARROT_ASSERT_ARG(interp) \
345 , PARROT_ASSERT_ARG(arg_info) \
346 , PARROT_ASSERT_ARG(accessor))
347 #define ASSERT_ARGS_assign_default_result_value __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
348 PARROT_ASSERT_ARG(interp) \
349 , PARROT_ASSERT_ARG(results))
350 #define ASSERT_ARGS_clone_key_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
351 PARROT_ASSERT_ARG(interp) \
352 , PARROT_ASSERT_ARG(key))
353 #define ASSERT_ARGS_dissect_aggregate_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
354 PARROT_ASSERT_ARG(interp) \
355 , PARROT_ASSERT_ARG(call_object) \
356 , PARROT_ASSERT_ARG(aggregate))
357 #define ASSERT_ARGS_extract_named_arg_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
358 PARROT_ASSERT_ARG(interp) \
359 , PARROT_ASSERT_ARG(call_object) \
360 , PARROT_ASSERT_ARG(name) \
361 , PARROT_ASSERT_ARG(raw_sig) \
362 , PARROT_ASSERT_ARG(raw_args))
363 #define ASSERT_ARGS_fill_params __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
364 PARROT_ASSERT_ARG(interp) \
365 , PARROT_ASSERT_ARG(raw_sig) \
366 , PARROT_ASSERT_ARG(arg_info) \
367 , PARROT_ASSERT_ARG(accessor))
368 #define ASSERT_ARGS_fill_results __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
369 PARROT_ASSERT_ARG(interp) \
370 , PARROT_ASSERT_ARG(raw_sig) \
371 , PARROT_ASSERT_ARG(return_info) \
372 , PARROT_ASSERT_ARG(accessor))
373 #define ASSERT_ARGS_intval_arg_from_c_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
374 PARROT_ASSERT_ARG(interp) \
375 , PARROT_ASSERT_ARG(args))
376 #define ASSERT_ARGS_intval_arg_from_continuation __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
377 PARROT_ASSERT_ARG(interp) \
378 , PARROT_ASSERT_ARG(cs))
379 #define ASSERT_ARGS_intval_arg_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
380 PARROT_ASSERT_ARG(interp) \
381 , PARROT_ASSERT_ARG(raw_args))
382 #define ASSERT_ARGS_intval_constant_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
383 PARROT_ASSERT_ARG(interp) \
384 , PARROT_ASSERT_ARG(raw_params))
385 #define ASSERT_ARGS_intval_constant_from_varargs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
386 PARROT_ASSERT_ARG(interp) \
387 , PARROT_ASSERT_ARG(data))
388 #define ASSERT_ARGS_intval_param_from_c_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
389 PARROT_ASSERT_ARG(interp) \
390 , PARROT_ASSERT_ARG(args))
391 #define ASSERT_ARGS_intval_param_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
392 PARROT_ASSERT_ARG(interp) \
393 , PARROT_ASSERT_ARG(raw_params))
394 #define ASSERT_ARGS_numval_arg_from_c_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
395 PARROT_ASSERT_ARG(interp) \
396 , PARROT_ASSERT_ARG(args))
397 #define ASSERT_ARGS_numval_arg_from_continuation __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
398 PARROT_ASSERT_ARG(interp) \
399 , PARROT_ASSERT_ARG(cs))
400 #define ASSERT_ARGS_numval_arg_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
401 PARROT_ASSERT_ARG(interp) \
402 , PARROT_ASSERT_ARG(raw_args))
403 #define ASSERT_ARGS_numval_constant_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
404 PARROT_ASSERT_ARG(interp) \
405 , PARROT_ASSERT_ARG(raw_params))
406 #define ASSERT_ARGS_numval_constant_from_varargs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
407 PARROT_ASSERT_ARG(interp) \
408 , PARROT_ASSERT_ARG(data))
409 #define ASSERT_ARGS_numval_param_from_c_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
410 PARROT_ASSERT_ARG(interp) \
411 , PARROT_ASSERT_ARG(args))
412 #define ASSERT_ARGS_numval_param_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
413 PARROT_ASSERT_ARG(interp) \
414 , PARROT_ASSERT_ARG(raw_params))
415 #define ASSERT_ARGS_parse_signature_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
416 PARROT_ASSERT_ARG(interp) \
417 , PARROT_ASSERT_ARG(signature) \
418 , PARROT_ASSERT_ARG(arg_flags) \
419 , PARROT_ASSERT_ARG(return_flags))
420 #define ASSERT_ARGS_pmc_arg_from_c_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
421 PARROT_ASSERT_ARG(interp) \
422 , PARROT_ASSERT_ARG(args))
423 #define ASSERT_ARGS_pmc_arg_from_continuation __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
424 PARROT_ASSERT_ARG(interp) \
425 , PARROT_ASSERT_ARG(cs))
426 #define ASSERT_ARGS_pmc_arg_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
427 PARROT_ASSERT_ARG(interp) \
428 , PARROT_ASSERT_ARG(raw_args))
429 #define ASSERT_ARGS_pmc_constant_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
430 PARROT_ASSERT_ARG(interp) \
431 , PARROT_ASSERT_ARG(raw_params))
432 #define ASSERT_ARGS_pmc_constant_from_varargs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
433 PARROT_ASSERT_ARG(interp) \
434 , PARROT_ASSERT_ARG(data))
435 #define ASSERT_ARGS_pmc_param_from_c_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
436 PARROT_ASSERT_ARG(interp) \
437 , PARROT_ASSERT_ARG(args))
438 #define ASSERT_ARGS_pmc_param_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
439 PARROT_ASSERT_ARG(interp) \
440 , PARROT_ASSERT_ARG(raw_params))
441 #define ASSERT_ARGS_string_arg_from_c_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
442 PARROT_ASSERT_ARG(interp) \
443 , PARROT_ASSERT_ARG(args))
444 #define ASSERT_ARGS_string_arg_from_continuation __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
445 PARROT_ASSERT_ARG(interp) \
446 , PARROT_ASSERT_ARG(cs))
447 #define ASSERT_ARGS_string_arg_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
448 PARROT_ASSERT_ARG(interp) \
449 , PARROT_ASSERT_ARG(raw_args))
450 #define ASSERT_ARGS_string_constant_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
451 PARROT_ASSERT_ARG(interp) \
452 , PARROT_ASSERT_ARG(raw_params))
453 #define ASSERT_ARGS_string_constant_from_varargs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
454 PARROT_ASSERT_ARG(interp) \
455 , PARROT_ASSERT_ARG(data))
456 #define ASSERT_ARGS_string_param_from_c_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
457 PARROT_ASSERT_ARG(interp) \
458 , PARROT_ASSERT_ARG(args))
459 #define ASSERT_ARGS_string_param_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
460 PARROT_ASSERT_ARG(interp) \
461 , PARROT_ASSERT_ARG(raw_params))
462 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
463 /* HEADERIZER END: static */
464
465 /*
466
467 =item C<PMC* Parrot_pcc_build_sig_object_from_op(PARROT_INTERP, PMC *signature,
468 PMC * const raw_sig, opcode_t * const raw_args)>
469
470 Take a raw signature and argument list from a set_args opcode and
471 convert it to a CallSignature PMC.
472
473 =cut
474
475 */
476
477 PARROT_EXPORT
478 PARROT_WARN_UNUSED_RESULT
479 PARROT_CANNOT_RETURN_NULL
480 PMC*
481 Parrot_pcc_build_sig_object_from_op(PARROT_INTERP, ARGIN_NULLOK(PMC *signature),
482 ARGIN(PMC * const raw_sig), ARGIN(opcode_t * const raw_args))
483 {
484 ASSERT_ARGS(Parrot_pcc_build_sig_object_from_op)
485 PMC *call_object;
486 PMC *ctx = CURRENT_CONTEXT(interp);
487 INTVAL *int_array;
488 INTVAL arg_count;
489 INTVAL arg_index;
490
491 if (PMC_IS_NULL(signature))
492 call_object = pmc_new(interp, enum_class_CallSignature);
493 else
494 call_object = signature;
495
496 /* this macro is much, much faster than the VTABLE STRING comparisons */
497 SETATTR_CallSignature_arg_flags(interp, call_object, raw_sig);
498 GETATTR_FixedIntegerArray_size(interp, raw_sig, arg_count);
499 GETATTR_FixedIntegerArray_int_array(interp, raw_sig, int_array);
500
501 for (arg_index = 0; arg_index < arg_count; arg_index++) {
502 INTVAL arg_flags = int_array[arg_index];
503
504 const INTVAL constant = PARROT_ARG_CONSTANT_ISSET(arg_flags);
505 const INTVAL raw_index = raw_args[arg_index + 2];
506
507 switch (PARROT_ARG_TYPE_MASK_MASK(arg_flags)) {
508 case PARROT_ARG_INTVAL:
509 if (constant)
510 VTABLE_push_integer(interp, call_object, raw_index);
511 else {
512 const INTVAL int_value = CTX_REG_INT(ctx, raw_index);
513 VTABLE_push_integer(interp, call_object, int_value);
514 }
515 break;
516 case PARROT_ARG_FLOATVAL:
517 if (constant)
518 VTABLE_push_float(interp, call_object,
519 Parrot_pcc_get_num_constant(interp, ctx, raw_index));
520 else {
521 const FLOATVAL float_value = CTX_REG_NUM(ctx, raw_index);
522 VTABLE_push_float(interp, call_object, float_value);
523 }
524 break;
525 case PARROT_ARG_STRING:
526 {
527 STRING *string_value;
528 if (constant)
529 /* ensure that callees don't modify constant caller strings */
530 string_value = Parrot_str_new_COW(interp,
531 Parrot_pcc_get_string_constant(interp, ctx, raw_index));
532 else
533 string_value = CTX_REG_STR(ctx, raw_index);
534
535 if (arg_flags & PARROT_ARG_NAME) {
536 arg_index++;
537 if (!PMC_IS_NULL(call_object)
538 && VTABLE_exists_keyed_str(interp, call_object, string_value)) {
539 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
540 "duplicate named argument in call");
541
542 }
543 extract_named_arg_from_op(interp, call_object, string_value,
544 raw_sig, raw_args, arg_index);
545 }
546 else
547 VTABLE_push_string(interp, call_object, string_value);
548
549 break;
550 }
551 case PARROT_ARG_PMC:
552 {
553 PMC *pmc_value;
554 if (constant)
555 pmc_value = Parrot_pcc_get_pmc_constant(interp, ctx, raw_index);
556 else
557 pmc_value = CTX_REG_PMC(ctx, raw_index);
558
559 if (arg_flags & PARROT_ARG_FLATTEN) {
560 dissect_aggregate_arg(interp, call_object, pmc_value);
561 }
562 else {
563 VTABLE_push_pmc(interp, call_object, clone_key_arg(interp, pmc_value));
564 }
565
566 break;
567 }
568 default:
569 break;
570 }
571
572 }
573
574 return call_object;
575 }
576
577 /*
578
579 =item C<static void extract_named_arg_from_op(PARROT_INTERP, PMC *call_object,
580 STRING *name, PMC * const raw_sig, opcode_t * const raw_args, INTVAL arg_index)>
581
582 Pulls in the next argument from a set_args opcode, and sets it as the
583 value of a named argument in the CallSignature PMC.
584
585 =cut
586
587 */
588
589 static void
590 extract_named_arg_from_op(PARROT_INTERP, ARGMOD(PMC *call_object), ARGIN(STRING *name),
591 ARGIN(PMC * const raw_sig), ARGIN(opcode_t * const raw_args),
592 INTVAL arg_index)
593 {
594 ASSERT_ARGS(extract_named_arg_from_op)
595 PMC *ctx = CURRENT_CONTEXT(interp);
596 INTVAL arg_flags = VTABLE_get_integer_keyed_int(interp,
597 raw_sig, arg_index);
598
599 const INTVAL constant = PARROT_ARG_CONSTANT_ISSET(arg_flags);
600 const INTVAL raw_index = raw_args[arg_index + 2];
601
602 switch (PARROT_ARG_TYPE_MASK_MASK(arg_flags)) {
603 case PARROT_ARG_INTVAL:
604 if (constant)
605 VTABLE_set_integer_keyed_str(interp, call_object, name, raw_index);
606 else
607 VTABLE_set_integer_keyed_str(interp, call_object, name,
608 CTX_REG_INT(ctx, raw_index));
609 break;
610 case PARROT_ARG_FLOATVAL:
611 if (constant)
612 VTABLE_set_number_keyed_str(interp, call_object, name,
613 Parrot_pcc_get_num_constant(interp, ctx, raw_index));
614 else
615 VTABLE_set_number_keyed_str(interp, call_object, name,
616 CTX_REG_NUM(ctx, raw_index));
617 break;
618 case PARROT_ARG_STRING:
619 if (constant)
620 /* ensure that callees don't modify constant caller strings */
621 VTABLE_set_string_keyed_str(interp, call_object, name,
622 Parrot_str_new_COW(interp,
623 Parrot_pcc_get_string_constant(interp, ctx, raw_index)));
624 else
625 VTABLE_set_string_keyed_str(interp, call_object, name,
626 CTX_REG_STR(ctx, raw_index));
627 break;
628 case PARROT_ARG_PMC:
629 if (constant)
630 VTABLE_set_pmc_keyed_str(interp, call_object, name,
631 Parrot_pcc_get_pmc_constant(interp, ctx, raw_index));
632 else
633 VTABLE_set_pmc_keyed_str(interp, call_object, name,
634 CTX_REG_PMC(ctx, raw_index));
635 break;
636 default:
637 break;
638 }
639 }
640
641 /*
642
643 =item C<static void dissect_aggregate_arg(PARROT_INTERP, PMC *call_object, PMC
644 *aggregate)>
645
646 Takes an aggregate PMC and splits it up into individual arguments,
647 adding each one to the CallSignature PMC. If the aggregate is an array,
648 its elements are added as positional arguments. If the aggregate is a
649 hash, its key/value pairs are added as named arguments.
650
651 =cut
652
653 */
654
655 PARROT_CANNOT_RETURN_NULL
656 static void
657 dissect_aggregate_arg(PARROT_INTERP, ARGMOD(PMC *call_object), ARGIN(PMC *aggregate))
658 {
659 ASSERT_ARGS(dissect_aggregate_arg)
660 if (VTABLE_does(interp, aggregate, CONST_STRING(interp, "array"))) {
661 INTVAL elements = VTABLE_elements(interp, aggregate);
662 INTVAL index;
663 for (index = 0; index < elements; index++) {
664 VTABLE_push_pmc(interp, call_object,
665 VTABLE_get_pmc_keyed_int(interp, aggregate, index));
666 }
667 }
668 else if (VTABLE_does(interp, aggregate, CONST_STRING(interp, "hash"))) {
669 INTVAL elements = VTABLE_elements(interp, aggregate);
670 INTVAL index;
671 PMC *key = pmc_new(interp, enum_class_Key);
672 VTABLE_set_integer_native(interp, key, 0);
673 SETATTR_Key_next_key(interp, key, (PMC *)INITBucketIndex);
674
675 /* Low-level hash iteration. */
676 for (index = 0; index < elements; index++) {
677 if (!PMC_IS_NULL(key)) {
678 STRING *name = (STRING *)parrot_hash_get_idx(interp,
679 (Hash *)VTABLE_get_pointer(interp, aggregate), key);
680 PARROT_ASSERT(name);
681 VTABLE_set_pmc_keyed_str(interp, call_object, name,
682 VTABLE_get_pmc_keyed_str(interp, aggregate, name));
683 }
684 }
685 }
686 else {
687 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
688 "flattened parameters must be a hash or array");
689 }
690 }
691
692 /*
693
694 =item C<PMC* Parrot_pcc_build_sig_object_returns_from_op(PARROT_INTERP, PMC
695 *signature, PMC *raw_sig, opcode_t *raw_args)>
696
697 Take a raw signature and argument list from a set_results opcode and
698 convert it to a CallSignature PMC. Uses an existing CallSignature PMC if
699 one was already created for set_args. Otherwise, creates a new one.
700
701 =cut
702
703 */
704
705 PARROT_EXPORT
706 PARROT_WARN_UNUSED_RESULT
707 PARROT_CAN_RETURN_NULL
708 PMC*
709 Parrot_pcc_build_sig_object_returns_from_op(PARROT_INTERP, ARGIN_NULLOK(PMC *signature),
710 ARGIN(PMC *raw_sig), ARGIN(opcode_t *raw_args))
711 {
712 ASSERT_ARGS(Parrot_pcc_build_sig_object_returns_from_op)
713 PMC *call_object;
714 INTVAL *int_array;
715 PMC *ctx = CURRENT_CONTEXT(interp);
716 PMC *returns = pmc_new(interp, enum_class_CallSignatureReturns);
717 INTVAL returns_pos = 0;
718 INTVAL arg_index;
719 INTVAL arg_count;
720
721 if (PMC_IS_NULL(signature))
722 call_object = pmc_new(interp, enum_class_CallSignature);
723 /* A hack to support 'get_results' as the way of fetching the
724 * exception object inside an exception handler. The first argument
725 * in the call object is the exception, stick it directly into the
726 * destination register. */
727 else if (CALLSIGNATURE_is_exception_TEST(signature)) {
728 const INTVAL raw_index = raw_args[2];
729 CTX_REG_PMC(ctx, raw_index) =
730 VTABLE_get_pmc_keyed_int(interp, signature, 0);
731 return NULL;
732 }
733 else
734 call_object = signature;
735
736 /* a little encapsulation violation for great speed */
737 SETATTR_CallSignature_return_flags(interp, call_object, raw_sig);
738 SETATTR_CallSignature_results(interp, call_object, returns);
739
740 GETATTR_FixedIntegerArray_size(interp, raw_sig, arg_count);
741 GETATTR_FixedIntegerArray_int_array(interp, raw_sig, int_array);
742
743 for (arg_index = 0; arg_index < arg_count; arg_index++) {
744 STRING * const signature = CONST_STRING(interp, "signature");
745 const INTVAL arg_flags = int_array[arg_index];
746 const INTVAL raw_index = raw_args[arg_index + 2];
747
748 /* Returns store a pointer to the register, so they can pass
749 * the result back to the caller. */
750 switch (PARROT_ARG_TYPE_MASK_MASK(arg_flags)) {
751 case PARROT_ARG_INTVAL:
752 VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
753 &(CTX_REG_INT(ctx, raw_index)));
754 VTABLE_push_integer(interp, returns, PARROT_ARG_INTVAL);
755 break;
756 case PARROT_ARG_FLOATVAL:
757 VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
758 &(CTX_REG_NUM(ctx, raw_index)));
759 VTABLE_push_integer(interp, returns, PARROT_ARG_FLOATVAL);
760 break;
761 case PARROT_ARG_STRING:
762 if (arg_flags & PARROT_ARG_NAME) {
763 STRING * string_val = arg_flags & PARROT_ARG_CONSTANT
764 ? Parrot_pcc_get_string_constant(interp, ctx, raw_index)
765 : CTX_REG_STR(ctx, raw_index);
766 VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
767 string_val);
768 }
769 else {
770 VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
771 &(CTX_REG_STR(ctx, raw_index)));
772 VTABLE_push_integer(interp, returns, PARROT_ARG_STRING);
773 }
774 break;
775 case PARROT_ARG_PMC:
776 VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
777 &(CTX_REG_PMC(ctx, raw_index)));
778 VTABLE_push_integer(interp, returns, PARROT_ARG_PMC);
779 break;
780 default:
781 break;
782 }
783
784 }
785
786 return call_object;
787 }
788
789 /*
790
791 =item C<PMC* Parrot_pcc_build_sig_object_from_varargs(PARROT_INTERP, PMC *obj,
792 const char *sig, va_list args)>
793
794 Converts a varargs list into a CallSignature PMC. The CallSignature stores the
795 original short signature string and an array of integer types to pass on to the
796 multiple dispatch search.
797
798 =cut
799
800 */
801
802 PARROT_EXPORT
803 PARROT_WARN_UNUSED_RESULT
804 PARROT_CANNOT_RETURN_NULL
805 PMC*
806 Parrot_pcc_build_sig_object_from_varargs(PARROT_INTERP, ARGIN_NULLOK(PMC *obj),
807 ARGIN(const char *sig), va_list args)
808 {
809 ASSERT_ARGS(Parrot_pcc_build_sig_object_from_varargs)
810 PMC *type_tuple = PMCNULL;
811 PMC *returns = PMCNULL;
812 PMC *arg_flags = PMCNULL;
813 PMC *return_flags = PMCNULL;
814 PMC * const call_object = pmc_new(interp, enum_class_CallSignature);
815 const INTVAL sig_len = strlen(sig);
816 INTVAL in_return_sig = 0;
817 INTVAL i;
818 int append_pi = 1;
819 INTVAL returns_pos = 0;
820
821 if (!sig_len)
822 return call_object;
823
824 parse_signature_string(interp, sig, &arg_flags, &return_flags);
825 VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "arg_flags"), arg_flags);
826 VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "return_flags"), return_flags);
827
828 /* Process the varargs list */
829 for (i = 0; i < sig_len; ++i) {
830 const INTVAL type = sig[i];
831
832 /* Only create the returns array if it's needed */
833 if (in_return_sig && PMC_IS_NULL(returns)) {
834 returns = pmc_new(interp, enum_class_CallSignatureReturns);
835 VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "returns"), returns);
836 }
837
838 if (in_return_sig) {
839 STRING * const signature = CONST_STRING(interp, "signature");
840 /* Returns store the original passed-in pointer so they can pass
841 * the result back to the caller. */
842 switch (type) {
843 case 'I':
844 VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
845 (void *)va_arg(args, INTVAL *));
846 VTABLE_push_integer(interp, returns, PARROT_ARG_INTVAL);
847 break;
848 case 'N':
849 VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
850 (void *)va_arg(args, FLOATVAL *));
851 VTABLE_push_integer(interp, returns, PARROT_ARG_FLOATVAL);
852 break;
853 case 'S':
854 VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
855 (void *)va_arg(args, STRING **));
856 VTABLE_push_integer(interp, returns, PARROT_ARG_STRING);
857 break;
858 case 'P':
859 VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
860 (void *)va_arg(args, PMC **));
861 VTABLE_push_integer(interp, returns, PARROT_ARG_PMC);
862 break;
863 default:
864 Parrot_ex_throw_from_c_args(interp, NULL,
865 EXCEPTION_INVALID_OPERATION,
866 "Dispatch: invalid argument type %c!", type);
867 }
868 }
869 else {
870 /* Regular arguments just set the value */
871 switch (type) {
872 case 'I':
873 VTABLE_push_integer(interp, call_object, va_arg(args, INTVAL));
874 break;
875 case 'N':
876 VTABLE_push_float(interp, call_object, va_arg(args, FLOATVAL));
877 break;
878 case 'S':
879 VTABLE_push_string(interp, call_object, va_arg(args, STRING *));
880 break;
881 case 'P':
882 {
883 INTVAL type_lookahead = sig[i+1];
884 PMC * const pmc_arg = va_arg(args, PMC *);
885 if (type_lookahead == 'f') {
886 dissect_aggregate_arg(interp, call_object, pmc_arg);
887 i++; /* skip 'f' */
888 }
889 else {
890 VTABLE_push_pmc(interp, call_object, clone_key_arg(interp, pmc_arg));
891 if (type_lookahead == 'i') {
892 if (i != 0)
893 Parrot_ex_throw_from_c_args(interp, NULL,
894 EXCEPTION_INVALID_OPERATION,
895 "Dispatch: only the first argument can be an invocant");
896 i++; /* skip 'i' */
897 append_pi = 0; /* Don't append Pi in front of signature */
898 }
899 }
900 break;
901 }
902 case '-':
903 i++; /* skip '>' */
904 in_return_sig = 1;
905 break;
906 default:
907 Parrot_ex_throw_from_c_args(interp, NULL,
908 EXCEPTION_INVALID_OPERATION,
909 "Dispatch: invalid argument type %c!", type);
910 }
911 }
912 }
913
914 /* Check if we have an invocant, and add it to the front of the arguments iff needed */
915 if (!PMC_IS_NULL(obj) && append_pi) {
916 VTABLE_unshift_pmc(interp, call_object, obj);
917 }
918
919 return call_object;
920 }
921
922 /*
923
924 =item C<static void fill_params(PARROT_INTERP, PMC *call_object, PMC *raw_sig,
925 void *arg_info, struct pcc_set_funcs *accessor)>
926
927 Gets args for the current function call and puts them into position.
928 First it gets the positional non-slurpy parameters, then the positional
929 slurpy parameters, then the named parameters, and finally the named
930 slurpy parameters.
931
932 =cut
933
934 */
935
936 static void
937 fill_params(PARROT_INTERP, ARGMOD_NULLOK(PMC *call_object),
938 ARGIN(PMC *raw_sig), ARGIN(void *arg_info), ARGIN(struct pcc_set_funcs *accessor))
939 {
940 ASSERT_ARGS(fill_params)
941 PMC *named_used_list = PMCNULL;
942 PMC *arg_sig;
943 INTVAL *raw_params;
944 INTVAL param_count = VTABLE_elements(interp, raw_sig);
945 INTVAL param_index = 0;
946 INTVAL arg_index = 0;
947 INTVAL named_count = 0;
948 INTVAL err_check = 0;
949 INTVAL positional_args;
950
951 /* Check if we should be throwing errors. This is configured separately
952 * for parameters and return values. */
953 if (PARROT_ERRORS_test(interp, PARROT_ERRORS_PARAM_COUNT_FLAG))
954 err_check = 1;
955
956 /* A null call object is fine if there are no arguments and no returns. */
957 if (PMC_IS_NULL(call_object)) {
958 if (param_count > 0 && err_check)
959 Parrot_ex_throw_from_c_args(interp, NULL,
960 EXCEPTION_INVALID_OPERATION,
961 "too few arguments: 0 passed, %d expected", param_count);
962
963 return;
964 }
965
966 positional_args = VTABLE_elements(interp, call_object);
967 GETATTR_CallSignature_arg_flags(interp, call_object, arg_sig);
968 GETATTR_FixedIntegerArray_int_array(interp, raw_sig, raw_params);
969
970 /* EXPERIMENTAL! This block adds provisional :call_sig param support on the
971 callee side only. Does not add :call_sig arg support on the caller side.
972 This is not the final form of the algorithm, but should provide the
973 tools that HLL designers need in the interim. */
974 if (param_count == 1) {
975 const INTVAL first_flag = raw_params[0];
976
977 if (first_flag & PARROT_ARG_CALL_SIG) {
978 *accessor->pmc(interp, arg_info, 0) = call_object;
979 return;
980 }
981 }
982 else if (param_count == 2) {
983 const INTVAL second_flag = raw_params[1];
984 if (second_flag & PARROT_ARG_CALL_SIG)
985 *accessor->pmc(interp, arg_info, 1) = call_object;
986 }
987
988 /* First iterate over positional args and positional parameters. */
989 arg_index = 0;
990 param_index = 0;
991 while (1) {
992 INTVAL param_flags;
993
994 /* Check if we've used up all the parameters. */
995 if (param_index >= param_count) {
996 if (arg_index >= positional_args) {
997 /* We've used up all the arguments and parameters, we're done. */
998 break;
999 }
1000 else if (err_check) {
1001 /* We've used up all the parameters, but have extra positional
1002 * args left over. */
1003 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1004 "too many positional arguments: %d passed, %d expected",
1005 positional_args, param_index);
1006 }
1007 return;
1008 }
1009
1010 param_flags = raw_params[param_index];
1011
1012 /* If it's a call_sig, we're done. */
1013 if (param_flags & PARROT_ARG_CALL_SIG)
1014 return;
1015
1016 /* If the parameter is slurpy, collect all remaining positional
1017 * arguments into an array.*/
1018 if (param_flags & PARROT_ARG_SLURPY_ARRAY) {
1019 PMC *collect_positional;
1020
1021 /* Can't handle named slurpy here, go on to named argument handling. */
1022 if (param_flags & PARROT_ARG_NAME)
1023 break;
1024
1025 if (named_count > 0)
1026 Parrot_ex_throw_from_c_args(interp, NULL,
1027 EXCEPTION_INVALID_OPERATION,
1028 "named parameters must follow all positional parameters");
1029
1030 collect_positional = pmc_new(interp,
1031 Parrot_get_ctx_HLL_type(interp, enum_class_ResizablePMCArray));
1032 for (; arg_index < positional_args; arg_index++) {
1033 VTABLE_push_pmc(interp, collect_positional,
1034 VTABLE_get_pmc_keyed_int(interp, call_object, arg_index));
1035 }
1036 *accessor->pmc(interp, arg_info, param_index) = collect_positional;
1037 param_index++;
1038 break; /* Terminate the positional arg loop. */
1039 }
1040
1041 /* We have a positional argument, fill the parameter with it. */
1042 if (arg_index < positional_args) {
1043
1044 /* Fill a named parameter with a positional argument. */
1045 if (param_flags & PARROT_ARG_NAME) {
1046 STRING *param_name;
1047 if (!(param_flags & PARROT_ARG_STRING))
1048 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1049 "named parameters must have a name specified");
1050 param_name = PARROT_ARG_CONSTANT_ISSET(param_flags)
1051 ? accessor->string_constant(interp, arg_info, param_index)
1052 : *accessor->string(interp, arg_info, param_index);
1053 named_count++;
1054 param_index++;
1055 if (param_index >= param_count)
1056 continue;
1057
1058 param_flags = raw_params[param_index];
1059
1060 /* Mark the name as used, cannot be filled again. */
1061 if (PMC_IS_NULL(named_used_list)) /* Only created if needed. */
1062 named_used_list = pmc_new(interp, enum_class_Hash);
1063
1064 VTABLE_set_integer_keyed_str(interp, named_used_list, param_name, 1);
1065 }
1066 else if (named_count > 0) {
1067 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1068 "named parameters must follow all positional parameters");
1069 }
1070
1071 /* Check for :lookahead parameter goes here. */
1072
1073 /* Go ahead and fill the parameter with a positional argument. */
1074 switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
1075 case PARROT_ARG_INTVAL:
1076 *accessor->intval(interp, arg_info, param_index) =
1077 VTABLE_get_integer_keyed_int(interp, call_object, arg_index);
1078 break;
1079 case PARROT_ARG_FLOATVAL:
1080 *accessor->numval(interp, arg_info, param_index) =
1081 VTABLE_get_number_keyed_int(interp, call_object, arg_index);
1082 break;
1083 case PARROT_ARG_STRING:
1084 *accessor->string(interp, arg_info, param_index) =
1085 VTABLE_get_string_keyed_int(interp, call_object, arg_index);
1086 break;
1087 case PARROT_ARG_PMC:
1088 *accessor->pmc(interp, arg_info, param_index) =
1089 VTABLE_get_pmc_keyed_int(interp, call_object, arg_index);
1090 break;
1091 default:
1092 Parrot_ex_throw_from_c_args(interp, NULL,
1093 EXCEPTION_INVALID_OPERATION, "invalid parameter type");
1094 break;
1095 }
1096
1097 /* Mark the option flag for the filled parameter. */
1098 if (param_flags & PARROT_ARG_OPTIONAL) {
1099 INTVAL next_param_flags;
1100
1101 if (param_index + 1 < param_count) {
1102 next_param_flags = raw_params[param_index + 1];
1103
1104 if (next_param_flags & PARROT_ARG_OPT_FLAG) {
1105 param_index++;
1106 *accessor->intval(interp, arg_info, param_index) = 1;
1107 }
1108 }
1109 }
1110 }
1111 /* We have no more positional arguments, fill the optional parameter
1112 * with a default value. */
1113 else if (param_flags & PARROT_ARG_OPTIONAL) {
1114 INTVAL next_param_flags;
1115
1116 /* We don't handle optional named params here, handle them in the
1117 * next loop. */
1118 if (param_flags & PARROT_ARG_NAME)
1119 break;
1120
1121 assign_default_param_value(interp, param_index, param_flags,
1122 arg_info, accessor);
1123
1124 /* Mark the option flag for the parameter to FALSE, it was filled
1125 * with a default value. */
1126 if (param_index + 1 < param_count) {
1127 next_param_flags = raw_params[param_index + 1];
1128
1129 if (next_param_flags & PARROT_ARG_OPT_FLAG) {
1130 param_index++;
1131 *accessor->intval(interp, arg_info, param_index) = 0;
1132 }
1133 }
1134 }
1135 /* We don't have an argument for the parameter, and it's not optional,
1136 * so it's an error. */
1137 else {
1138 /* We don't handle named params here, go to the next loop. */
1139 if (param_flags & PARROT_ARG_NAME)
1140 break;
1141
1142 if (err_check)
1143 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1144 "too few positional arguments: %d passed, %d (or more) expected",
1145 positional_args, param_index + 1);
1146 }
1147
1148 /* Go on to next argument and parameter. */
1149 arg_index++;
1150 param_index++;
1151 }
1152
1153 /* Now iterate over the named arguments and parameters. */
1154 while (1) {
1155 STRING *param_name = NULL;
1156 INTVAL param_flags;
1157
1158 /* Check if we've used up all the parameters. We'll check for leftover
1159 * named args after the loop. */
1160 if (param_index >= param_count)
1161 break;
1162
1163 param_flags = raw_params[param_index];
1164
1165 /* All remaining parameters must be named. */
1166 if (!(param_flags & PARROT_ARG_NAME)) {
1167 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1168 "named parameters must follow all positional parameters");
1169 }
1170
1171 if (arg_index < positional_args) {
1172 /* We've used up all the positional parameters, but have extra
1173 * positional args left over. */
1174 if (VTABLE_get_integer_keyed_int(interp, arg_sig, arg_index) & PARROT_ARG_NAME) {
1175 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1176 "named arguments must follow all positional arguments");
1177 }
1178 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1179 "too many positional arguments: %d passed, %d expected",
1180 positional_args, param_index);
1181 }
1182
1183 /* Collected ("slurpy") named parameter */
1184 if (param_flags & PARROT_ARG_SLURPY_ARRAY) {
1185 PMC * const collect_named = pmc_new(interp,
1186 Parrot_get_ctx_HLL_type(interp, enum_class_Hash));
1187 PMC *named_arg_list = VTABLE_get_attr_str(interp, call_object, CONST_STRING(interp, "named"));
1188 if (!PMC_IS_NULL(named_arg_list)) {
1189 INTVAL named_arg_count = VTABLE_elements(interp, named_arg_list);
1190 INTVAL named_arg_index;
1191
1192 /* Named argument iteration. */
1193 for (named_arg_index = 0; named_arg_index < named_arg_count; named_arg_index++) {
1194 STRING *name = VTABLE_get_string_keyed_int(interp,
1195 named_arg_list, named_arg_index);
1196
1197 if ((PMC_IS_NULL(named_used_list)) ||
1198 !VTABLE_exists_keyed_str(interp, named_used_list, name)) {
1199 VTABLE_set_pmc_keyed_str(interp, collect_named, name,
1200 VTABLE_get_pmc_keyed_str(interp, call_object, name));
1201 /* Mark the name as used, cannot be filled again. */
1202 if (PMC_IS_NULL(named_used_list)) /* Only created if needed. */
1203 named_used_list = pmc_new(interp, enum_class_Hash);
1204 VTABLE_set_integer_keyed_str(interp, named_used_list, name, 1);
1205 named_count++;
1206 }
1207 }
1208 }
1209
1210 *accessor->pmc(interp, arg_info, param_index) = collect_named;
1211 break; /* End of named parameters. */
1212 }
1213
1214 /* Store the name. */
1215 if (!(param_flags & PARROT_ARG_STRING))
1216 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1217 "named parameters must have a name specified");
1218 param_name = PARROT_ARG_CONSTANT_ISSET(param_flags)
1219 ? accessor->string_constant(interp, arg_info, param_index)
1220 : *accessor->string(interp, arg_info, param_index);
1221
1222 if (!STRING_IS_NULL(param_name)) {
1223 /* The next parameter is the actual value. */
1224 param_index++;
1225 if (param_index >= param_count)
1226 continue;
1227
1228 param_flags = raw_params[param_index];
1229
1230 if (VTABLE_exists_keyed_str(interp, call_object, param_name)) {
1231
1232 /* Mark the name as used, cannot be filled again. */
1233 if (PMC_IS_NULL(named_used_list)) /* Only created if needed. */
1234 named_used_list = pmc_new(interp, enum_class_Hash);
1235 VTABLE_set_integer_keyed_str(interp, named_used_list, param_name, 1);
1236 named_count++;
1237
1238 /* Fill the named parameter. */
1239 switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
1240 case PARROT_ARG_INTVAL:
1241 *accessor->intval(interp, arg_info, param_index) =
1242 VTABLE_get_integer_keyed_str(interp, call_object, param_name);
1243 break;
1244 case PARROT_ARG_FLOATVAL:
1245 *accessor->numval(interp, arg_info, param_index) =
1246 VTABLE_get_number_keyed_str(interp, call_object, param_name);
1247 break;
1248 case PARROT_ARG_STRING:
1249 *accessor->string(interp, arg_info, param_index) =
1250 VTABLE_get_string_keyed_str(interp, call_object, param_name);
1251 break;
1252 case PARROT_ARG_PMC:
1253 *accessor->pmc(interp, arg_info, param_index) =
1254 VTABLE_get_pmc_keyed_str(interp, call_object, param_name);
1255 break;
1256 default:
1257 Parrot_ex_throw_from_c_args(interp, NULL,
1258 EXCEPTION_INVALID_OPERATION, "invalid parameter type");
1259 break;
1260 }
1261
1262 /* Mark the option flag for the filled parameter. */
1263 if (param_flags & PARROT_ARG_OPTIONAL) {
1264 INTVAL next_param_flags;
1265
1266 if (param_index + 1 < param_count) {
1267 next_param_flags = raw_params[param_index + 1];
1268
1269 if (next_param_flags & PARROT_ARG_OPT_FLAG) {
1270 param_index++;
1271 *accessor->intval(interp, arg_info, param_index) = 1;
1272 }
1273 }
1274 }
1275 }
1276 else if (param_flags & PARROT_ARG_OPTIONAL) {
1277 INTVAL next_param_flags;
1278
1279 assign_default_param_value(interp, param_index, param_flags,
1280 arg_info, accessor);
1281
1282 /* Mark the option flag for the parameter to FALSE, it was filled
1283 * with a default value. */
1284 if (param_index + 1 < param_count) {
1285 next_param_flags = raw_params[param_index + 1];
1286
1287 if (next_param_flags & PARROT_ARG_OPT_FLAG) {
1288 param_index++;
1289 *accessor->intval(interp, arg_info, param_index) = 0;
1290 }
1291 }
1292 }
1293 /* We don't have an argument for the parameter, and it's not optional,
1294 * so it's an error. */
1295 else {
1296 if (err_check)
1297 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1298 "too few named arguments: no argument for required parameter '%S'",
1299 param_name);
1300 }
1301 }
1302
1303 param_index++;
1304 }
1305
1306 /* Double check that all named arguments were assigned to parameters. */
1307 if (err_check) {
1308 PMC *named_arg_list;
1309 Hash *h;
1310 /* Early exit to avoid vtable call */
1311 GETATTR_CallSignature_hash(interp, call_object, h);
1312 if (!h || !h->entries)
1313 return;
1314
1315 named_arg_list = VTABLE_get_attr_str(interp, call_object, CONST_STRING(interp, "named"));
1316 if (!PMC_IS_NULL(named_arg_list)) {
1317 INTVAL named_arg_count = VTABLE_elements(interp, named_arg_list);
1318 if (PMC_IS_NULL(named_used_list))
1319 return;
1320 /* The 'return' above is a temporary hack to duplicate an old bug,
1321 * and will be replaced by the exception below at the next
1322 * deprecation point, see TT #1103
1323
1324 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1325 "too many named arguments: %d passed, 0 used",
1326 named_arg_count);
1327 */
1328 if (named_arg_count > named_count) {
1329 /* At this point we know we have named arguments that weren't
1330 * assigned to parameters. We're going to throw an exception
1331 * anyway, so spend a little extra effort to tell the user *which*
1332 * named argument is extra. */
1333 INTVAL named_arg_index;
1334
1335 /* Named argument iteration. */
1336 for (named_arg_index = 0; named_arg_index < named_arg_count; named_arg_index++) {
1337 STRING *name = VTABLE_get_string_keyed_int(interp,
1338 named_arg_list, named_arg_index);
1339
1340 if (!VTABLE_exists_keyed_str(interp, named_used_list, name)) {
1341 Parrot_ex_throw_from_c_args(interp, NULL,
1342 EXCEPTION_INVALID_OPERATION,
1343 "too many named arguments: '%S' not used",
1344 name);
1345 }
1346 }
1347 }
1348 }
1349 }
1350 }
1351
1352 /*
1353
1354 =item C<static void assign_default_param_value(PARROT_INTERP, INTVAL
1355 param_index, INTVAL param_flags, void *arg_info, struct pcc_set_funcs
1356 *accessor)>
1357
1358 Assign an appropriate default value to the parameter depending on its type
1359
1360 =cut
1361
1362 */
1363
1364 static void
1365 assign_default_param_value(PARROT_INTERP, INTVAL param_index, INTVAL param_flags,
1366 ARGIN(void *arg_info), ARGIN(struct pcc_set_funcs *accessor))
1367 {
1368 ASSERT_ARGS(assign_default_param_value)
1369 switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
1370 case PARROT_ARG_INTVAL:
1371 *accessor->intval(interp, arg_info, param_index) = 0;
1372 break;
1373 case PARROT_ARG_FLOATVAL:
1374 *accessor->numval(interp, arg_info, param_index) = 0.0;
1375 break;
1376 case PARROT_ARG_STRING:
1377 *accessor->string(interp, arg_info, param_index) = NULL;
1378 break;
1379 case PARROT_ARG_PMC:
1380 *accessor->pmc(interp, arg_info, param_index) = PMCNULL;
1381 break;
1382 default:
1383 Parrot_ex_throw_from_c_args(interp, NULL,
1384 EXCEPTION_INVALID_OPERATION, "invalid parameter type");
1385 break;
1386 }
1387 }
1388
1389 /*
1390
1391 =item C<static void assign_default_result_value(PARROT_INTERP, PMC *results,
1392 INTVAL index, INTVAL result_flags)>
1393
1394 Assign an appropriate default value to the result depending on its type
1395
1396 =cut
1397
1398 */
1399
1400 static void
1401 assign_default_result_value(PARROT_INTERP, ARGMOD(PMC *results), INTVAL index, INTVAL result_flags)
1402 {
1403 ASSERT_ARGS(assign_default_result_value)
1404 switch (PARROT_ARG_TYPE_MASK_MASK(result_flags)) {
1405 case PARROT_ARG_INTVAL:
1406 VTABLE_set_integer_keyed_int(interp, results, index, 0);
1407 break;
1408 case PARROT_ARG_FLOATVAL:
1409 VTABLE_set_number_keyed_int(interp, results, index, 0.0);
1410 break;
1411 case PARROT_ARG_STRING:
1412 VTABLE_set_string_keyed_int(interp, results, index, NULL);
1413 break;
1414 case PARROT_ARG_PMC:
1415 VTABLE_set_pmc_keyed_int(interp, results, index, PMCNULL);
1416 break;
1417 default:
1418 Parrot_ex_throw_from_c_args(interp, NULL,
1419 EXCEPTION_INVALID_OPERATION, "invalid parameter type");
1420 break;
1421 }
1422 }
1423
1424 /*
1425
1426 =item C<void Parrot_pcc_fill_params_from_op(PARROT_INTERP, PMC *call_object, PMC
1427 *raw_sig, opcode_t *raw_params)>
1428
1429 Gets args for the current function call and puts them into position.
1430 First it gets the positional non-slurpy parameters, then the positional
1431 slurpy parameters, then the named parameters, and finally the named
1432 slurpy parameters.
1433
1434 =cut
1435
1436 */
1437
1438 PARROT_EXPORT
1439 void
1440 Parrot_pcc_fill_params_from_op(PARROT_INTERP, ARGMOD_NULLOK(PMC *call_object),
1441 ARGIN(PMC *raw_sig), ARGIN(opcode_t *raw_params))
1442 {
1443 ASSERT_ARGS(Parrot_pcc_fill_params_from_op)
1444
1445 static pcc_set_funcs function_pointers = {
1446 (intval_ptr_func_t)intval_param_from_op,
1447 (numval_ptr_func_t)numval_param_from_op,
1448 (string_ptr_func_t)string_param_from_op,
1449 (pmc_ptr_func_t)pmc_param_from_op,
1450
1451 (intval_func_t)intval_constant_from_op,
1452 (numval_func_t)numval_constant_from_op,
1453 (string_func_t)string_constant_from_op,
1454 (pmc_func_t)pmc_constant_from_op,
1455 };
1456
1457 fill_params(interp, call_object, raw_sig, raw_params, &function_pointers);
1458 }
1459
1460 /*
1461
1462 =item C<void Parrot_pcc_fill_params_from_c_args(PARROT_INTERP, PMC *call_object,
1463 const char *signature, ...)>
1464
1465 Gets args for the current function call and puts them into position.
1466 First it gets the positional non-slurpy parameters, then the positional
1467 slurpy parameters, then the named parameters, and finally the named
1468 slurpy parameters.
1469
1470 The signature is a string in the format used for
1471 C<Parrot_pcc_invoke_from_sig_object>, but with no return arguments. The
1472 parameters are passed in as a list of references to the destination
1473 variables.
1474
1475 =cut
1476
1477 */
1478
1479 PARROT_EXPORT
1480 void
1481 Parrot_pcc_fill_params_from_c_args(PARROT_INTERP, ARGMOD(PMC *call_object),
1482 ARGIN(const char *signature), ...)
1483 {
1484 ASSERT_ARGS(Parrot_pcc_fill_params_from_c_args)
1485 va_list args;
1486 PMC *raw_sig = PMCNULL;
1487 PMC *invalid_sig = PMCNULL;
1488 static pcc_set_funcs function_pointers = {
1489 (intval_ptr_func_t)intval_param_from_c_args,
1490 (numval_ptr_func_t)numval_param_from_c_args,
1491 (string_ptr_func_t)string_param_from_c_args,
1492 (pmc_ptr_func_t)pmc_param_from_c_args,
1493
1494 (intval_func_t)intval_constant_from_varargs,
1495 (numval_func_t)numval_constant_from_varargs,
1496 (string_func_t)string_constant_from_varargs,
1497 (pmc_func_t)pmc_constant_from_varargs,
1498 };
1499
1500 parse_signature_string(interp, signature, &raw_sig, &invalid_sig);
1501 if (!PMC_IS_NULL(invalid_sig))
1502 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1503 "returns should not be included in the parameter list");
1504
1505 va_start(args, signature);
1506 fill_params(interp, call_object, raw_sig, &args, &function_pointers);
1507 va_end(args);
1508 }
1509
1510 /*
1511
1512 =item C<static void fill_results(PARROT_INTERP, PMC *call_object, PMC *raw_sig,
1513 void *return_info, struct pcc_get_funcs *accessor)>
1514
1515 Gets return values for the current return and puts them into position.
1516 First it gets the positional non-slurpy returns, then the positional
1517 slurpy returns, then the named returns, and finally the named
1518 slurpy returns.
1519
1520 =cut
1521
1522 */
1523
1524 static void
1525 fill_results(PARROT_INTERP, ARGMOD_NULLOK(PMC *call_object),
1526 ARGIN(PMC *raw_sig), ARGIN(void *return_info), ARGIN(struct pcc_get_funcs *accessor))
1527 {
1528 ASSERT_ARGS(fill_results)
1529 INTVAL *return_array;
1530 INTVAL *result_array;
1531 PMC *result_list;
1532 PMC *result_sig = NULL;
1533 PMC *ctx = CURRENT_CONTEXT(interp);
1534 PMC *named_used_list = PMCNULL;
1535 PMC *named_return_list = PMCNULL;
1536 INTVAL return_index = 0;
1537 INTVAL return_subindex = 0;
1538 INTVAL result_index = 0;
1539 INTVAL positional_index = 0;
1540 INTVAL named_count = 0;
1541 INTVAL err_check = 0;
1542 INTVAL positional_returns = 0; /* initialized by a loop later */
1543 INTVAL i = 0; /* used by the initialization loop */
1544 INTVAL return_count;
1545 INTVAL result_count;
1546
1547 /* Check if we should be throwing errors. This is configured separately
1548 * for parameters and return values. */
1549 if (PARROT_ERRORS_test(interp, PARROT_ERRORS_RESULT_COUNT_FLAG))
1550 err_check = 1;
1551
1552 GETATTR_FixedIntegerArray_size(interp, raw_sig, return_count);
1553
1554 /* A null call object is fine if there are no returns and no results. */
1555 if (PMC_IS_NULL(call_object)) {
1556 /* If the return_count is 0, then there are no return values waiting to
1557 * fill the results, so no error. */
1558 if (return_count > 0 && (err_check))
1559 Parrot_ex_throw_from_c_args(interp, NULL,
1560 EXCEPTION_INVALID_OPERATION,
1561 "too few returns: 0 passed, %d expected", return_count);
1562
1563 return;
1564 }
1565
1566 GETATTR_CallSignature_results(interp, call_object, result_list);
1567 GETATTR_CallSignature_return_flags(interp, call_object, result_sig);
1568
1569 result_count = PMC_IS_NULL(result_list) ? 0 : VTABLE_elements(interp, result_list);
1570 PARROT_ASSERT(PMC_IS_NULL(result_list) || !PMC_IS_NULL(result_sig));
1571
1572 GETATTR_FixedIntegerArray_int_array(interp, raw_sig, return_array);
1573 if (!PMC_IS_NULL(result_sig))
1574 GETATTR_FixedIntegerArray_int_array(interp, result_sig, result_array);
1575
1576 /* the call obj doesn't have the returns as positionals.
1577 * instead count number of returns before first named return */
1578 for (i = 0; i < return_count; i++) {
1579 INTVAL flags = return_array[i];
1580 if (flags & PARROT_ARG_NAME)
1581 break;
1582
1583 positional_returns++;
1584 }
1585
1586 /*
1587 Parrot_io_eprintf(interp,
1588 "return_count: %d\nresult_count: %d\npositional_returns: %d\nraw_sig: %S\nresult_sig: %S\n",
1589 return_count, result_count, positional_returns, VTABLE_get_repr(interp, raw_sig),
1590 VTABLE_get_repr(interp, result_sig));
1591 */
1592
1593 while (1) {
1594 INTVAL result_flags;
1595
1596 /* Check if we've used up all the results. */
1597 if (result_index >= result_count) {
1598 if (return_index >= return_count) {
1599 /* We've used up all returns and results, we're
1600 * done with the whole process. */
1601 return;
1602 }
1603 else if (err_check) {
1604 /* We've used up all the results, but have extra positional
1605 * returns left over. */
1606 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1607 "too many positional returns: %d passed, %d expected",
1608 return_index, result_count);
1609 }
1610 return;
1611 }
1612
1613 result_flags = result_array[result_index];
1614
1615 /* If the result is slurpy, collect all remaining positional
1616 * returns into an array.*/
1617 if (result_flags & PARROT_ARG_SLURPY_ARRAY) {
1618 PMC *collect_positional;
1619
1620 /* Can't handle named slurpy here, go on to named return handling. */
1621 if (result_flags & PARROT_ARG_NAME)
1622 break;
1623
1624 if (named_count > 0)
1625 Parrot_ex_throw_from_c_args(interp, NULL,
1626 EXCEPTION_INVALID_OPERATION,
1627 "named results must follow all positional results");
1628
1629 collect_positional = pmc_new(interp,
1630 Parrot_get_ctx_HLL_type(interp, enum_class_ResizablePMCArray));
1631
1632 /* Iterate over all positional returns in the list. */
1633 while (1) {
1634 INTVAL constant;
1635 INTVAL return_flags;
1636 if (return_index >= return_count)
1637 break; /* no more returns */
1638
1639 return_flags = return_array[return_index];
1640
1641 if (return_flags & PARROT_ARG_NAME)
1642 break; /* stop at named returns */
1643
1644 constant = PARROT_ARG_CONSTANT_ISSET(return_flags);
1645 switch (PARROT_ARG_TYPE_MASK_MASK(return_flags)) {
1646 case PARROT_ARG_INTVAL:
1647 VTABLE_push_integer(interp, collect_positional, constant?
1648 accessor->intval_constant(interp, return_info, return_index)
1649 :accessor->intval(interp, return_info, return_index));
1650 break;
1651 case PARROT_ARG_FLOATVAL:
1652 VTABLE_push_float(interp, collect_positional, constant?
1653 accessor->numval_constant(interp, return_info, return_index)
1654 :accessor->numval(interp, return_info, return_index));
1655 break;
1656 case PARROT_ARG_STRING:
1657 VTABLE_push_string(interp, collect_positional, constant?
1658 accessor->string_constant(interp, return_info, return_index)
1659 :accessor->string(interp, return_info, return_index));
1660 break;
1661 case PARROT_ARG_PMC:
1662 {
1663 PMC *return_item = (constant)
1664 ? accessor->pmc_constant(interp, return_info, return_index)
1665 : accessor->pmc(interp, return_info, return_index);
1666 if (return_flags & PARROT_ARG_FLATTEN) {
1667 INTVAL flat_pos;
1668 INTVAL flat_elems;
1669 if (!VTABLE_does(interp, return_item, CONST_STRING(interp, "array"))) {
1670 Parrot_ex_throw_from_c_args(interp, NULL,
1671 EXCEPTION_INVALID_OPERATION,
1672 "flattened return on a non-array");
1673 }
1674 flat_elems = VTABLE_elements(interp, return_item);
1675 for (flat_pos = 0; flat_pos < flat_elems; flat_pos++) {
1676 /* fetch an item out of the aggregate */
1677 VTABLE_push_pmc(interp, collect_positional,
1678 VTABLE_get_pmc_keyed_int(interp, return_item, flat_pos));
1679 }
1680 }
1681 else
1682 VTABLE_push_pmc(interp, collect_positional, return_item);
1683 break;
1684 }
1685 default:
1686 Parrot_ex_throw_from_c_args(interp, NULL,
1687 EXCEPTION_INVALID_OPERATION, "invalid return type");
1688 break;
1689 }
1690 return_index++;
1691 }
1692 VTABLE_set_pmc_keyed_int(interp, result_list, result_index, collect_positional);
1693 result_index++;
1694 break; /* Terminate the positional return loop. */
1695 }
1696
1697 /* We have a positional return, fill the result with it. */
1698 if (return_index < positional_returns) {
1699 INTVAL return_flags = return_array[return_index];
1700 INTVAL constant = PARROT_ARG_CONSTANT_ISSET(return_flags);
1701
1702 /* Fill a named result with a positional return. */
1703 if (result_flags & PARROT_ARG_NAME) {
1704 STRING *result_name;
1705 if (!(result_flags & PARROT_ARG_STRING))
1706 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1707 "named results must have a name specified 1683");
1708 result_name = VTABLE_get_string_keyed_int(interp, result_list, result_index);
1709 named_count++;
1710 result_index++;
1711 if (result_index >= result_count)
1712 continue;
1713 result_flags = result_array[result_index];
1714
1715 /* Mark the name as used, cannot be filled again. */
1716 if (PMC_IS_NULL(named_used_list)) /* Only created if needed. */
1717 named_used_list = pmc_new(interp,
1718 Parrot_get_ctx_HLL_type(interp, enum_class_Hash));
1719 VTABLE_set_integer_keyed_str(interp, named_used_list, result_name, 1);
1720 }
1721 else if (named_count > 0) {
1722 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1723 "named results must follow all positional results");
1724 }
1725
1726 /* Check for :lookahead result goes here. */
1727
1728 /* Go ahead and fill the result with a positional return. */
1729 switch (PARROT_ARG_TYPE_MASK_MASK(return_flags)) {
1730 case PARROT_ARG_INTVAL:
1731 if (constant)
1732 VTABLE_set_integer_keyed_int(interp, result_list, result_index,
1733 accessor->intval_constant(interp, return_info, return_index));
1734 else
1735 VTABLE_set_integer_keyed_int(interp, result_list, result_index,
1736 accessor->intval(interp, return_info, return_index));
1737 break;
1738 case PARROT_ARG_FLOATVAL:
1739 if (constant)
1740 VTABLE_set_number_keyed_int(interp, result_list, result_index,
1741 accessor->numval_constant(interp, return_info, return_index));
1742 else
1743 VTABLE_set_number_keyed_int(interp, result_list, result_index,
1744 accessor->numval(interp, return_info, return_index));
1745 break;
1746 case PARROT_ARG_STRING:
1747 if (constant)
1748 VTABLE_set_string_keyed_int(interp, result_list, result_index,
1749 accessor->string_constant(interp, return_info, return_index));
1750 else
1751 VTABLE_set_string_keyed_int(interp, result_list, result_index,
1752 accessor->string(interp, return_info, return_index));
1753 break;
1754 case PARROT_ARG_PMC:
1755 {
1756 PMC *return_item = (constant)
1757 ? accessor->pmc_constant(interp, return_info, return_index)
1758 : accessor->pmc(interp, return_info, return_index);
1759 if (return_flags & PARROT_ARG_FLATTEN) {
1760 INTVAL flat_elems;
1761 if (!VTABLE_does(interp, return_item, CONST_STRING(interp, "array"))) {
1762 Parrot_ex_throw_from_c_args(interp, NULL,
1763 EXCEPTION_INVALID_OPERATION,
1764 "flattened return on a non-array");
1765 }
1766 flat_elems = VTABLE_elements(interp, return_item);
1767 if (flat_elems == 0) {
1768 /* Skip empty aggregate */
1769 break;
1770 }
1771 if (return_subindex < flat_elems) {
1772 /* fetch an item out of the aggregate */
1773 return_item = VTABLE_get_pmc_keyed_int(interp, return_item,
1774 return_subindex);
1775 return_subindex++;
1776 }
1777 if (return_subindex >= flat_elems) {
1778 return_subindex = 0; /* reset */
1779 }
1780 else {
1781 return_index--; /* we want to stay on the same item */
1782 }
1783 }
1784 VTABLE_set_pmc_keyed_int(interp, result_list, result_index, return_item);
1785 break;
1786 }
1787 default:
1788 Parrot_ex_throw_from_c_args(interp, NULL,
1789 EXCEPTION_INVALID_OPERATION, "invalid return type");
1790 break;
1791 }
1792
1793 /* Mark the option flag for the filled result. */
1794 if (result_flags & PARROT_ARG_OPTIONAL) {
1795 INTVAL next_result_flags;
1796
1797 if (result_index + 1 < result_count) {
1798 next_result_flags = result_array[result_index + 1];
1799 if (next_result_flags & PARROT_ARG_OPT_FLAG) {
1800 result_index++;
1801 VTABLE_set_integer_keyed_int(interp, result_list, result_index, 1);
1802 }
1803 }
1804 }
1805 }
1806 /* We have no more positional returns, fill the optional result
1807 * with a default value. */
1808 else if (result_flags & PARROT_ARG_OPTIONAL) {
1809 INTVAL next_result_flags;
1810
1811 /* We don't handle optional named results here, handle them in the
1812 * next loop. */
1813 if (result_flags & PARROT_ARG_NAME)
1814 break;
1815
1816 assign_default_result_value(interp, result_list, result_index, result_flags);
1817
1818 /* Mark the option flag for the result to FALSE, it was filled
1819 * with a default value. */
1820 if (result_index + 1 < result_count) {
1821 next_result_flags = result_array[result_index + 1];
1822 if (next_result_flags & PARROT_ARG_OPT_FLAG) {
1823 result_index++;
1824 VTABLE_set_integer_keyed_int(interp, result_list, result_index, 0);
1825 }
1826 }
1827 }
1828 /* We don't have an return for the result, and it's not optional,
1829 * so it's an error. */
1830 else {
1831 /* We don't handle named results here, go to the next loop. */
1832 if (result_flags & PARROT_ARG_NAME)
1833 break;
1834
1835 if (err_check)
1836 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1837 "too few positional returns: %d passed, %d (or more) expected",
1838 positional_returns, result_index + 1);
1839 }
1840
1841 /* Go on to next return and result. */
1842 return_index++;
1843 result_index++;
1844 }
1845
1846 for (; return_index < return_count; return_index++) {
1847 STRING *return_name;
1848 INTVAL return_flags;
1849 INTVAL constant;
1850
1851 return_flags = return_array[return_index];
1852
1853 /* All remaining returns must be named. */
1854 if (!(return_flags & PARROT_ARG_NAME))
1855 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1856 "named returns must follow all positional returns");
1857
1858 if (!(return_flags & PARROT_ARG_STRING))
1859 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1860 "named results must have a name specified 1836");
1861
1862 return_name = PARROT_ARG_CONSTANT_ISSET(return_flags)
1863 ? accessor->string_constant(interp, return_info, return_index)
1864 : accessor->string(interp, return_info, return_index);
1865 named_count++;
1866 return_index++;
1867 if (result_index >= result_count)
1868 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1869 "named returns must have a value");
1870
1871 return_flags = return_array[return_index];
1872
1873 if (PMC_IS_NULL(named_return_list)) /* Only created if needed. */
1874 named_return_list = pmc_new(interp,
1875 Parrot_get_ctx_HLL_type(interp, enum_class_Hash));
1876
1877 if (VTABLE_exists_keyed_str(interp, named_return_list, return_name))
1878 continue;
1879
1880 constant = PARROT_ARG_CONSTANT_ISSET(return_flags);
1881 switch (PARROT_ARG_TYPE_MASK_MASK(return_flags)) {
1882 case PARROT_ARG_INTVAL:
1883 VTABLE_set_integer_keyed_str(interp, named_return_list, return_name,
1884 constant
1885 ? accessor->intval_constant(interp, return_info, return_index)
1886 : accessor->intval(interp, return_info, return_index));
1887 break;
1888 case PARROT_ARG_FLOATVAL:
1889 VTABLE_set_number_keyed_str(interp, named_return_list, return_name,
1890 constant
1891 ? accessor->numval_constant(interp, return_info, return_index)
1892 : accessor->numval(interp, return_info, return_index));
1893 break;
1894 case PARROT_ARG_STRING:
1895 VTABLE_set_string_keyed_str(interp, named_return_list, return_name,
1896 constant
1897 ? accessor->string_constant(interp, return_info, return_index)
1898 : accessor->string(interp, return_info, return_index));
1899 break;
1900 case PARROT_ARG_PMC:
1901 if (0) {
1902 PMC *return_item = (constant)
1903 ? accessor->pmc_constant(interp, return_info, return_index)
1904 : accessor->pmc(interp, return_info, return_index);
1905 if (return_flags & PARROT_ARG_FLATTEN) {
1906 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1907 "named flattened returns not yet implemented");
1908 }
1909 VTABLE_set_pmc_keyed_str(interp, named_return_list, return_name, return_item);
1910 break;
1911 }
1912 default:
1913 Parrot_ex_throw_from_c_args(interp, NULL,
1914 EXCEPTION_INVALID_OPERATION, "invalid return type");
1915 break;
1916 }
1917 }
1918
1919 /* Now iterate over the named results, filling them from the
1920 * temporary hash of named returns. */
1921 while (1) {
1922 STRING *result_name = NULL;
1923 INTVAL result_flags;
1924
1925 /* Check if we've used up all the results. We'll check for leftover
1926 * named returns after the loop. */
1927 if (result_index >= result_count)
1928 break;
1929
1930 result_flags = result_array[result_index];
1931
1932 /* All remaining results must be named. */
1933 if (!(result_flags & PARROT_ARG_NAME))
1934 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1935 "named results must follow all positional results");
1936
1937 /* Collected ("slurpy") named result */
1938 if (result_flags & PARROT_ARG_SLURPY_ARRAY) {
1939 if (PMC_IS_NULL(named_return_list))
1940 named_return_list = pmc_new(interp,
1941 Parrot_get_ctx_HLL_type(interp, enum_class_Hash));
1942
1943 VTABLE_set_pmc_keyed_int(interp, result_list, result_index, named_return_list);
1944 break; /* End of named results. */
1945 }
1946
1947 /* Store the name. */
1948 if (!(result_flags & PARROT_ARG_STRING))
1949 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1950 "named results must have a name specified 1926");
1951 result_name = VTABLE_get_string_keyed_int(interp, result_list, result_index);
1952
1953 if (!STRING_IS_NULL(result_name)) {
1954 /* The next result is the actual value. */
1955 result_index++;
1956 if (result_index >= result_count)
1957 continue;
1958 result_flags = result_array[result_index];
1959
1960 if (VTABLE_exists_keyed_str(interp, named_return_list, result_name)) {
1961
1962 named_count++;
1963
1964 /* Fill the named result. */
1965 switch (PARROT_ARG_TYPE_MASK_MASK(result_flags)) {
1966 case PARROT_ARG_INTVAL:
1967 VTABLE_set_integer_keyed_int(interp, result_list, result_index,
1968 VTABLE_get_integer_keyed_str(interp, named_return_list, result_name));
1969 break;
1970 case PARROT_ARG_FLOATVAL:
1971 VTABLE_set_number_keyed_int(interp, result_list, result_index,
1972 VTABLE_get_number_keyed_str(interp, named_return_list, result_name));
1973 break;
1974 case PARROT_ARG_STRING:
1975 VTABLE_set_string_keyed_int(interp, result_list, result_index,
1976 VTABLE_get_string_keyed_str(interp, named_return_list, result_name));
1977 break;
1978 case PARROT_ARG_PMC:
1979 VTABLE_set_pmc_keyed_int(interp, result_list, result_index,
1980 VTABLE_get_pmc_keyed_str(interp, named_return_list, result_name));
1981 break;
1982 default:
1983 Parrot_ex_throw_from_c_args(interp, NULL,
1984 EXCEPTION_INVALID_OPERATION, "invalid result type");
1985 break;
1986 }
1987 VTABLE_delete_keyed_str(interp, named_return_list, result_name);
1988
1989 /* Mark the option flag for the filled result. */
1990 if (result_flags & PARROT_ARG_OPTIONAL) {
1991 INTVAL next_result_flags;
1992
1993 if (result_index + 1 < result_count) {
1994 next_result_flags = return_array[result_index + 1];
1995 if (next_result_flags & PARROT_ARG_OPT_FLAG) {
1996 result_index++;
1997 VTABLE_set_integer_keyed_int(interp, result_list, result_index, 1);
1998 }
1999 }
2000 }
2001 }
2002 else if (result_flags & PARROT_ARG_OPTIONAL) {
2003 INTVAL next_result_flags;
2004
2005 assign_default_result_value(interp, result_list, result_index, result_flags);
2006
2007 /* Mark the option flag for the result to FALSE, it was filled
2008 * with a default value. */
2009 if (result_index + 1 < result_count) {
2010 next_result_flags = result_array[result_index + 1];
2011 if (next_result_flags & PARROT_ARG_OPT_FLAG) {
2012 result_index++;
2013 VTABLE_set_integer_keyed_int(interp, result_list, result_index, 1);
2014 }
2015 }
2016 }
2017 /* We don't have a return for the result, and it's not optional,
2018 * so it's an error. */
2019 else {
2020 if (err_check)
2021 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
2022 "too few named returns: no return for required result '%S'",
2023 result_name);
2024 }
2025 }
2026
2027 result_index++;
2028 }
2029
2030 /* Double check that all named returns were assigned to results. */
2031 if (err_check) {
2032 if (!PMC_IS_NULL(named_return_list)) {
2033 INTVAL named_return_count = VTABLE_elements(interp, named_return_list);
2034 if (named_return_count > 0)
2035 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
2036 "too many named returns: %d passed, %d used",
2037 named_return_count + named_count, named_count);
2038 }
2039 }
2040
2041 }
2042
2043 /*
2044
2045 =item C<void Parrot_pcc_fill_returns_from_op(PARROT_INTERP, PMC *call_object,
2046 PMC *raw_sig, opcode_t *raw_returns)>
2047
2048 Sets return values for the current function call. First it sets the
2049 positional returns, then the named returns.
2050
2051 =cut
2052
2053 */
2054
2055 PARROT_EXPORT
2056 void
2057 Parrot_pcc_fill_returns_from_op(PARROT_INTERP, ARGMOD_NULLOK(PMC *call_object),
2058 ARGIN(PMC *raw_sig), ARGIN(opcode_t *raw_returns))
2059 {
2060 ASSERT_ARGS(Parrot_pcc_fill_returns_from_op)
2061 INTVAL raw_return_count = VTABLE_elements(interp, raw_sig);
2062 INTVAL err_check = 0;
2063 static pcc_get_funcs function_pointers = {
2064 (intval_func_t)intval_arg_from_op,
2065 (numval_func_t)numval_arg_from_op,
2066 (string_func_t)string_arg_from_op,
2067 (pmc_func_t)pmc_arg_from_op,
2068
2069 (intval_func_t)intval_constant_from_op,
2070 (numval_func_t)numval_constant_from_op,
2071 (string_func_t)string_constant_from_op,
2072 (pmc_func_t)pmc_constant_from_op,
2073 };
2074
2075
2076 /* Check if we should be throwing errors. This is configured separately
2077 * for parameters and return values. */
2078 if (PARROT_ERRORS_test(interp, PARROT_ERRORS_RESULT_COUNT_FLAG))
2079 err_check = 1;
2080
2081 /* A null call object is fine if there are no arguments and no returns. */
2082 if (PMC_IS_NULL(call_object)) {
2083 if (raw_return_count > 0) {
2084 if (err_check)
2085 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
2086 "too many return values: %d passed, 0 expected",
2087 raw_return_count);
2088 }
2089 return;
2090 }
2091
2092 fill_results(interp, call_object, raw_sig, raw_returns, &function_pointers);
2093
2094 return;
2095 }
2096 /*
2097
2098 =item C<void Parrot_pcc_fill_returns_from_continuation(PARROT_INTERP, PMC
2099 *call_object, PMC *raw_sig, PMC *from_call_obj)>
2100
2101 Evil function. Fill results from arguments passed to a continuation.
2102 Only works for positional arguments.
2103
2104 =cut
2105
2106 */
2107
2108 PARROT_EXPORT
2109 void
2110 Parrot_pcc_fill_returns_from_continuation(PARROT_INTERP, ARGMOD_NULLOK(PMC *call_object),
2111 ARGIN(PMC *raw_sig), ARGIN(PMC *from_call_obj))
2112 {
2113 ASSERT_ARGS(Parrot_pcc_fill_returns_from_continuation)
2114 INTVAL raw_return_count = VTABLE_elements(interp, raw_sig);
2115 INTVAL err_check = 0;
2116 static pcc_get_funcs function_pointers = {
2117 (intval_func_t)intval_arg_from_continuation,
2118 (numval_func_t)numval_arg_from_continuation,
2119 (string_func_t)string_arg_from_continuation,
2120 (pmc_func_t)pmc_arg_from_continuation,
2121
2122 (intval_func_t)intval_arg_from_continuation,
2123 (numval_func_t)numval_arg_from_continuation,
2124 (string_func_t)string_arg_from_continuation,
2125 (pmc_func_t)pmc_arg_from_continuation,
2126 };
2127
2128
2129 /* Check if we should be throwing errors. This is configured separately
2130 * for parameters and return values. */
2131 if (PARROT_ERRORS_test(interp, PARROT_ERRORS_RESULT_COUNT_FLAG))
2132 err_check = 1;
2133
2134 /* A null call object is fine if there are no arguments and no returns. */
2135 if (PMC_IS_NULL(call_object)) {
2136 if (raw_return_count > 0) {
2137 if (err_check)
2138 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
2139 "too many return values: %d passed, 0 expected",
2140 raw_return_count);
2141 }
2142 return;
2143 }
2144
2145 fill_results(interp, call_object, raw_sig, from_call_obj, &function_pointers);
2146
2147 return;
2148 }
2149
2150 /*
2151
2152 =item C<void Parrot_pcc_fill_returns_from_c_args(PARROT_INTERP, PMC
2153 *call_object, const char *signature, ...)>
2154
2155 Sets return values for the current function call. First it sets the
2156 positional returns, then the named returns.
2157
2158 The signature is a string in the format used for
2159 C<Parrot_pcc_invoke_from_sig_object>, but with only return arguments.
2160 The parameters are passed in as a list of INTVAL, FLOATVAL, STRING *, or
2161 PMC * variables.
2162
2163
2164 =cut
2165
2166 */
2167
2168 PARROT_EXPORT
2169 void
2170 Parrot_pcc_fill_returns_from_c_args(PARROT_INTERP, ARGMOD_NULLOK(PMC *call_object),
2171 ARGIN(const char *signature), ...)
2172 {
2173 ASSERT_ARGS(Parrot_pcc_fill_returns_from_c_args)
2174 va_list args;
2175 INTVAL raw_return_count = 0;
2176 INTVAL err_check = 0;
2177 PMC *raw_sig = PMCNULL;
2178 PMC *invalid_sig = PMCNULL;
2179
2180 static pcc_get_funcs function_pointers = {
2181 (intval_func_t)intval_arg_from_c_args,
2182 (numval_func_t)numval_arg_from_c_args,
2183 (string_func_t)string_arg_from_c_args,
2184 (pmc_func_t)pmc_arg_from_c_args,
2185
2186 (intval_func_t)intval_constant_from_varargs,
2187 (numval_func_t)numval_constant_from_varargs,
2188 (string_func_t)string_constant_from_varargs,
2189 (pmc_func_t)pmc_constant_from_varargs,
2190 };
2191
2192 parse_signature_string(interp, signature, &raw_sig, &invalid_sig);
2193 if (!PMC_IS_NULL(invalid_sig))
2194 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
2195 "parameters should not be included in the return signature");
2196
2197 raw_return_count = VTABLE_elements(interp, raw_sig);
2198
2199 /* Check if we should be throwing errors. This is configured separately
2200 * for parameters and return values. */
2201 if (PARROT_ERRORS_test(interp, PARROT_ERRORS_RESULT_COUNT_FLAG))
2202 err_check = 1;
2203
2204 /* A null call object is fine if there are no arguments and no returns. */
2205 if (PMC_IS_NULL(call_object)) {
2206 if (raw_return_count > 0)
2207 if (err_check)
2208 Parrot_ex_throw_from_c_args(interp, NULL,
2209 EXCEPTION_INVALID_OPERATION,
2210 "too many return values: %d passed, 0 expected",
2211 raw_return_count);
2212 return;
2213 }
2214
2215 va_start(args, signature);
2216 fill_results(interp, call_object, raw_sig, &args, &function_pointers);
2217 va_end(args);
2218 }
2219
2220 /*
2221
2222 =item C<static void parse_signature_string(PARROT_INTERP, const char *signature,
2223 PMC **arg_flags, PMC **return_flags)>
2224
2225 Parses a signature string and creates call and return signature integer
2226 arrays. The two integer arrays should be passed in as references to a
2227 PMC.
2228
2229 =cut
2230
2231 */
2232
2233 PARROT_CAN_RETURN_NULL
2234 static void
2235 parse_signature_string(PARROT_INTERP, ARGIN(const char *signature),
2236 ARGMOD(PMC **arg_flags), ARGMOD(PMC **return_flags))
2237 {
2238 ASSERT_ARGS(parse_signature_string)
2239 PMC *current_array;
2240 const char *x;
2241 INTVAL flags = 0;
2242 INTVAL set = 0;
2243
2244 if (PMC_IS_NULL(*arg_flags))
2245 *arg_flags = pmc_new(interp, enum_class_ResizableIntegerArray);
2246 current_array = *arg_flags;
2247
2248 for (x = signature; *x != '\0'; x++) {
2249
2250 /* detect -> separator */
2251 if (*x == '-') {
2252 /* skip '>' */
2253 x++;
2254
2255 /* Starting a new argument, so store the previous argument,
2256 * if there was one. */
2257 if (set) {
2258 VTABLE_push_integer(interp, current_array, flags);
2259 set = 0;
2260 }
2261
2262 /* Switch to the return argument flags. */
2263 if (PMC_IS_NULL(*return_flags))
2264 *return_flags = pmc_new(interp, enum_class_ResizableIntegerArray);
2265 current_array = *return_flags;
2266 }
2267 /* parse arg type */
2268 else if (isupper((unsigned char)*x)) {
2269 /* Starting a new argument, so store the previous argument,
2270 * if there was one. */
2271 if (set) {
2272 VTABLE_push_integer(interp, current_array, flags);
2273 set = 0;
2274 }
2275
2276 switch (*x) {
2277 case 'I': flags = PARROT_ARG_INTVAL; set++; break;
2278 case 'N': flags = PARROT_ARG_FLOATVAL; set++; break;
2279 case 'S': flags = PARROT_ARG_STRING; set++; break;
2280 case 'P': flags = PARROT_ARG_PMC; set++; break;
2281 default:
2282 Parrot_ex_throw_from_c_args(interp, NULL,
2283 EXCEPTION_INVALID_OPERATION,
2284 "invalid signature string element %c!", *x);
2285 }
2286
2287 }
2288 /* parse arg adverbs */
2289 else if (islower((unsigned char)*x)) {
2290 switch (*x) {
2291 case 'c': flags |= PARROT_ARG_CONSTANT; break;
2292 case 'f': flags |= PARROT_ARG_FLATTEN; break;
2293 case 'i': flags |= PARROT_ARG_INVOCANT; break;
2294 case 'l': flags |= PARROT_ARG_LOOKAHEAD; break;
2295 case 'n': flags |= PARROT_ARG_NAME; break;
2296 case 'o': flags |= PARROT_ARG_OPTIONAL; break;
2297 case 'p': flags |= PARROT_ARG_OPT_FLAG; break;
2298 case 's': flags |= PARROT_ARG_SLURPY_ARRAY; break;
2299 default:
2300 Parrot_ex_throw_from_c_args(interp, NULL,
2301 EXCEPTION_INVALID_OPERATION,
2302 "invalid signature string element %c!", *x);
2303 }
2304 }
2305 }
2306
2307 /* Store the final argument, if there was one. */
2308 if (set)
2309 VTABLE_push_integer(interp, current_array, flags);
2310 }
2311
2312 /*
2313
2314 =item C<void Parrot_pcc_parse_signature_string(PARROT_INTERP, STRING *signature,
2315 PMC **arg_flags, PMC **return_flags)>
2316
2317 Parses a signature string and creates call and return signature integer
2318 arrays. The two integer arrays should be passed in as references to a
2319 PMC.
2320
2321 =cut
2322
2323 */
2324
2325 PARROT_CAN_RETURN_NULL
2326 void
2327 Parrot_pcc_parse_signature_string(PARROT_INTERP, ARGIN(STRING *signature),
2328 ARGMOD(PMC **arg_flags), ARGMOD(PMC **return_flags))
2329 {
2330 ASSERT_ARGS(Parrot_pcc_parse_signature_string)
2331 char *s = Parrot_str_to_cstring(interp, signature);
2332 *arg_flags = PMCNULL;
2333 *return_flags = PMCNULL;
2334 parse_signature_string(interp, s, arg_flags, return_flags);
2335 Parrot_str_free_cstring(s);
2336 }
2337
2338 /*
2339
2340 =item C<void Parrot_pcc_merge_signature_for_tailcall(PARROT_INTERP, PMC *
2341 parent, PMC * tailcall)>
2342
2343 merge in signatures for tailcall
2344
2345 =cut
2346
2347 */
2348
2349 void
2350 Parrot_pcc_merge_signature_for_tailcall(PARROT_INTERP,
2351 ARGMOD_NULLOK(PMC * parent), ARGMOD_NULLOK(PMC * tailcall))
2352 {
2353 ASSERT_ARGS(Parrot_pcc_merge_signature_for_tailcall)
2354 if (PMC_IS_NULL(parent) || PMC_IS_NULL(tailcall))
2355 return;
2356 else {
2357 /* Broke encapuslation. Direct poking into CallSignature is much faster */
2358 PMC * results;
2359 PMC * return_flags;
2360 GETATTR_CallSignature_results(interp, parent, results);
2361 GETATTR_CallSignature_return_flags(interp, parent, return_flags);
2362 SETATTR_CallSignature_results(interp, tailcall, results);
2363 SETATTR_CallSignature_return_flags(interp, tailcall, return_flags);
2364 }
2365 }
2366
2367 /*
2368
2369 Get the appropriate argument value from the continuation
2370
2371 =item C<static INTVAL intval_arg_from_continuation(PARROT_INTERP, PMC *cs,
2372 INTVAL arg_index)>
2373
2374 =item C<static FLOATVAL numval_arg_from_continuation(PARROT_INTERP, PMC *cs,
2375 INTVAL arg_index)>
2376
2377 =item C<static STRING* string_arg_from_continuation(PARROT_INTERP, PMC *cs,
2378 INTVAL arg_index)>
2379
2380 =item C<static PMC* pmc_arg_from_continuation(PARROT_INTERP, PMC *cs, INTVAL
2381 arg_index)>
2382
2383 Get the appropriate argument value from the op.
2384
2385 =item C<static INTVAL intval_arg_from_op(PARROT_INTERP, opcode_t *raw_args,
2386 INTVAL arg_index)>
2387
2388 =item C<static FLOATVAL numval_arg_from_op(PARROT_INTERP, opcode_t *raw_args,
2389 INTVAL arg_index)>
2390
2391 =item C<static STRING* string_arg_from_op(PARROT_INTERP, opcode_t *raw_args,
2392 INTVAL arg_index)>
2393
2394 =item C<static PMC* pmc_arg_from_op(PARROT_INTERP, opcode_t *raw_args, INTVAL
2395 arg_index)>
2396
2397 Get the appropriate parameter value from the op (these are pointers, so the
2398 argument value can be stored into them.)
2399
2400 =item C<static INTVAL* intval_param_from_op(PARROT_INTERP, opcode_t *raw_params,
2401 INTVAL param_index)>
2402
2403 =item C<static FLOATVAL* numval_param_from_op(PARROT_INTERP, opcode_t
2404 *raw_params, INTVAL param_index)>
2405
2406 =item C<static STRING** string_param_from_op(PARROT_INTERP, opcode_t
2407 *raw_params, INTVAL param_index)>
2408
2409 =item C<static PMC** pmc_param_from_op(PARROT_INTERP, opcode_t *raw_params,
2410 INTVAL param_index)>
2411
2412 =item C<static INTVAL intval_constant_from_op(PARROT_INTERP, opcode_t
2413 *raw_params, INTVAL param_index)>
2414
2415 =item C<static FLOATVAL numval_constant_from_op(PARROT_INTERP, opcode_t
2416 *raw_params, INTVAL param_index)>
2417
2418 =item C<static STRING* string_constant_from_op(PARROT_INTERP, opcode_t
2419 *raw_params, INTVAL param_index)>
2420
2421 =item C<static PMC* pmc_constant_from_op(PARROT_INTERP, opcode_t *raw_params,
2422 INTVAL param_index)>
2423
2424 Get the appropriate argument value from varargs.
2425
2426 =item C<static INTVAL intval_arg_from_c_args(PARROT_INTERP, va_list *args,
2427 INTVAL param_index)>
2428
2429 =item C<static FLOATVAL numval_arg_from_c_args(PARROT_INTERP, va_list *args,
2430 INTVAL param_index)>
2431
2432 =item C<static STRING* string_arg_from_c_args(PARROT_INTERP, va_list *args,
2433 INTVAL param_index)>
2434
2435 =item C<static PMC* pmc_arg_from_c_args(PARROT_INTERP, va_list *args, INTVAL
2436 param_index)>
2437
2438 Get the appropriate parameter value from varargs (these are pointers, so they
2439 can be set with the argument value).
2440
2441 =item C<static INTVAL* intval_param_from_c_args(PARROT_INTERP, va_list *args,
2442 INTVAL param_index)>
2443
2444 =item C<static FLOATVAL* numval_param_from_c_args(PARROT_INTERP, va_list *args,
2445 INTVAL param_index)>
2446
2447 =item C<static STRING** string_param_from_c_args(PARROT_INTERP, va_list *args,
2448 INTVAL param_index)>
2449
2450 =item C<static PMC** pmc_param_from_c_args(PARROT_INTERP, va_list *args, INTVAL
2451 param_index)>
2452
2453 Parrot constants cannot be passed from varargs, so these functions are dummies
2454 that throw exceptions.
2455
2456 =item C<static INTVAL intval_constant_from_varargs(PARROT_INTERP, void *data,
2457 INTVAL index)>
2458
2459 =item C<static FLOATVAL numval_constant_from_varargs(PARROT_INTERP, void *data,
2460 INTVAL index)>
2461
2462 =item C<static STRING* string_constant_from_varargs(PARROT_INTERP, void *data,
2463 INTVAL index)>
2464
2465 =item C<static PMC* pmc_constant_from_varargs(PARROT_INTERP, void *data, INTVAL
2466 index)>
2467
2468 - More specific comments can be added later
2469
2470 =cut
2471
2472 */
2473
2474 PARROT_CANNOT_RETURN_NULL
2475 static INTVAL
2476 intval_arg_from_continuation(PARROT_INTERP, ARGIN(PMC *cs), INTVAL arg_index)
2477 {
2478 ASSERT_ARGS(intval_arg_from_continuation)
2479 const INTVAL ret = VTABLE_get_integer_keyed_int(interp, cs, arg_index);
2480 return ret;
2481 }
2482
2483 PARROT_CANNOT_RETURN_NULL
2484 static FLOATVAL
2485 numval_arg_from_continuation(PARROT_INTERP, ARGIN(PMC *cs), INTVAL arg_index)
2486 {
2487 ASSERT_ARGS(numval_arg_from_continuation)
2488 const FLOATVAL ret = VTABLE_get_number_keyed_int(interp, cs, arg_index);
2489 return ret;
2490 }
2491
2492 PARROT_CANNOT_RETURN_NULL
2493 static STRING*
2494 string_arg_from_continuation(PARROT_INTERP, ARGIN(PMC *cs), INTVAL arg_index)
2495 {
2496 ASSERT_ARGS(string_arg_from_continuation)
2497 STRING *ret = VTABLE_get_string_keyed_int(interp, cs, arg_index);
2498 return ret;
2499 }
2500
2501 PARROT_CANNOT_RETURN_NULL
2502 static PMC*
2503 pmc_arg_from_continuation(PARROT_INTERP, ARGIN(PMC *cs), INTVAL arg_index)
2504 {
2505 ASSERT_ARGS(pmc_arg_from_continuation)
2506 PMC *ret = VTABLE_get_pmc_keyed_int(interp, cs, arg_index);
2507 return ret;
2508 }
2509
2510 PARROT_CANNOT_RETURN_NULL
2511 static INTVAL
2512 intval_arg_from_op(PARROT_INTERP, ARGIN(opcode_t *raw_args), INTVAL arg_index)
2513 {
2514 ASSERT_ARGS(intval_arg_from_op)
2515 const INTVAL raw_index = raw_args[arg_index + 2];
2516 return REG_INT(interp, raw_index);
2517 }
2518
2519 PARROT_CANNOT_RETURN_NULL
2520 static FLOATVAL
2521 numval_arg_from_op(PARROT_INTERP, ARGIN(opcode_t *raw_args), INTVAL arg_index)
2522 {
2523 ASSERT_ARGS(numval_arg_from_op)
2524 const INTVAL raw_index = raw_args[arg_index + 2];
2525 return REG_NUM(interp, raw_index);
2526 }
2527
2528 PARROT_CANNOT_RETURN_NULL
2529 static STRING*
2530 string_arg_from_op(PARROT_INTERP, ARGIN(opcode_t *raw_args), INTVAL arg_index)
2531 {
2532 ASSERT_ARGS(string_arg_from_op)
2533 const INTVAL raw_index = raw_args[arg_index + 2];
2534 return REG_STR(interp, raw_index);
2535 }
2536
2537 PARROT_CANNOT_RETURN_NULL
2538 static PMC*
2539 pmc_arg_from_op(PARROT_INTERP, ARGIN(opcode_t *raw_args), INTVAL arg_index)
2540 {
2541 ASSERT_ARGS(pmc_arg_from_op)
2542 const INTVAL raw_index = raw_args[arg_index + 2];
2543 return REG_PMC(interp, raw_index);
2544 }
2545
2546 PARROT_CANNOT_RETURN_NULL
2547 static INTVAL*
2548 intval_param_from_op(PARROT_INTERP, ARGIN(opcode_t *raw_params), INTVAL param_index)
2549 {
2550 ASSERT_ARGS(intval_param_from_op)
2551 const INTVAL raw_index = raw_params[param_index + 2];
2552 return &REG_INT(interp, raw_index);
2553 }
2554
2555 PARROT_CANNOT_RETURN_NULL
2556 static FLOATVAL*
2557 numval_param_from_op(PARROT_INTERP, ARGIN(opcode_t *raw_params), INTVAL param_index)
2558 {
2559 ASSERT_ARGS(numval_param_from_op)
2560 const INTVAL raw_index = raw_params[param_index + 2];
2561 return &REG_NUM(interp, raw_index);
2562 }
2563
2564 PARROT_CANNOT_RETURN_NULL
2565 static STRING**
2566 string_param_from_op(PARROT_INTERP, ARGIN(opcode_t *raw_params), INTVAL param_index)
2567 {
2568 ASSERT_ARGS(string_param_from_op)
2569 const INTVAL raw_index = raw_params[param_index + 2];
2570 return &REG_STR(interp, raw_index);
2571 }
2572
2573 PARROT_CANNOT_RETURN_NULL
2574 static PMC**
2575 pmc_param_from_op(PARROT_INTERP, ARGIN(opcode_t *raw_params), INTVAL param_index)
2576 {
2577 ASSERT_ARGS(pmc_param_from_op)
2578 const INTVAL raw_index = raw_params[param_index + 2];
2579 return &REG_PMC(interp, raw_index);
2580 }
2581
2582 static INTVAL
2583 intval_constant_from_op(PARROT_INTERP, ARGIN(opcode_t *raw_params), INTVAL param_index)
2584 {
2585 ASSERT_ARGS(intval_constant_from_op)
2586 const INTVAL raw_index = raw_params[param_index + 2];
2587 return raw_index;
2588 }
2589
2590 static FLOATVAL
2591 numval_constant_from_op(PARROT_INTERP, ARGIN(opcode_t *raw_params), INTVAL param_index)
2592 {
2593 ASSERT_ARGS(numval_constant_from_op)
2594 const INTVAL raw_index = raw_params[param_index + 2];
2595 return Parrot_pcc_get_num_constant(interp, CURRENT_CONTEXT(interp), raw_index);
2596 }
2597
2598 PARROT_CAN_RETURN_NULL
2599 static STRING*
2600 string_constant_from_op(PARROT_INTERP, ARGIN(opcode_t *raw_params), INTVAL param_index)
2601 {
2602 ASSERT_ARGS(string_constant_from_op)
2603 const INTVAL raw_index = raw_params[param_index + 2];
2604 return Parrot_pcc_get_string_constant(interp, CURRENT_CONTEXT(interp), raw_index);
2605 }
2606
2607 PARROT_CAN_RETURN_NULL
2608 static PMC*
2609 pmc_constant_from_op(PARROT_INTERP, ARGIN(opcode_t *raw_params), INTVAL param_index)
2610 {
2611 ASSERT_ARGS(pmc_constant_from_op)
2612 const INTVAL raw_index = raw_params[param_index + 2];
2613 return Parrot_pcc_get_pmc_constant(interp, CURRENT_CONTEXT(interp), raw_index);
2614 }
2615
2616 PARROT_CANNOT_RETURN_NULL
2617 static INTVAL
2618 intval_arg_from_c_args(PARROT_INTERP, ARGIN(va_list *args), SHIM(INTVAL param_index))
2619 {
2620 ASSERT_ARGS(intval_arg_from_c_args)
2621 return va_arg(*args, INTVAL);
2622 }
2623
2624 PARROT_CANNOT_RETURN_NULL
2625 static FLOATVAL
2626 numval_arg_from_c_args(PARROT_INTERP, ARGIN(va_list *args), SHIM(INTVAL param_index))
2627 {
2628 ASSERT_ARGS(numval_arg_from_c_args)
2629 return va_arg(*args, FLOATVAL);
2630 }
2631
2632 PARROT_CANNOT_RETURN_NULL
2633 static STRING*
2634 string_arg_from_c_args(PARROT_INTERP, ARGIN(va_list *args), SHIM(INTVAL param_index))
2635 {
2636 ASSERT_ARGS(string_arg_from_c_args)
2637 return va_arg(*args, STRING*);
2638 }
2639
2640 PARROT_CANNOT_RETURN_NULL
2641 static PMC*
2642 pmc_arg_from_c_args(PARROT_INTERP, ARGIN(va_list *args), SHIM(INTVAL param_index))
2643 {
2644 ASSERT_ARGS(pmc_arg_from_c_args)
2645 return va_arg(*args, PMC*);
2646 }
2647
2648 PARROT_CANNOT_RETURN_NULL
2649 static INTVAL*
2650 intval_param_from_c_args(PARROT_INTERP, ARGIN(va_list *args), SHIM(INTVAL param_index))
2651 {
2652 ASSERT_ARGS(intval_param_from_c_args)
2653 return va_arg(*args, INTVAL*);
2654 }
2655
2656 PARROT_CANNOT_RETURN_NULL
2657 static FLOATVAL*
2658 numval_param_from_c_args(PARROT_INTERP, ARGIN(va_list *args), SHIM(INTVAL param_index))
2659 {
2660 ASSERT_ARGS(numval_param_from_c_args)
2661 return va_arg(*args, FLOATVAL*);
2662 }
2663
2664 PARROT_CANNOT_RETURN_NULL
2665 static STRING**
2666 string_param_from_c_args(PARROT_INTERP, ARGIN(va_list *args), SHIM(INTVAL param_index))
2667 {
2668 ASSERT_ARGS(string_param_from_c_args)
2669 return va_arg(*args, STRING**);
2670 }
2671
2672 PARROT_CANNOT_RETURN_NULL
2673 static PMC**
2674 pmc_param_from_c_args(PARROT_INTERP, ARGIN(va_list *args), SHIM(INTVAL param_index))
2675 {
2676 ASSERT_ARGS(pmc_param_from_c_args)
2677 return va_arg(*args, PMC**);
2678 }
2679
2680 static INTVAL
2681 intval_constant_from_varargs(PARROT_INTERP, ARGIN(void *data), INTVAL index)
2682 {
2683 ASSERT_ARGS(intval_constant_from_varargs)
2684 PARROT_ASSERT(!"Wrong call");
2685 return 0;
2686 }
2687
2688 static FLOATVAL
2689 numval_constant_from_varargs(PARROT_INTERP, ARGIN(void *data), INTVAL index)
2690 {
2691 ASSERT_ARGS(numval_constant_from_varargs)
2692 PARROT_ASSERT(!"Wrong call");
2693 return 0.0;
2694 }
2695
2696 PARROT_CAN_RETURN_NULL
2697 static STRING*
2698 string_constant_from_varargs(PARROT_INTERP, ARGIN(void *data), INTVAL index)
2699 {
2700 ASSERT_ARGS(string_constant_from_varargs)
2701 PARROT_ASSERT(!"Wrong call");
2702 return NULL;
2703 }
2704
2705 PARROT_CAN_RETURN_NULL
2706 static PMC*
2707 pmc_constant_from_varargs(PARROT_INTERP, ARGIN(void *data), INTVAL index)
2708 {
2709 ASSERT_ARGS(pmc_constant_from_varargs)
2710 PARROT_ASSERT(!"Wrong call");
2711 return PMCNULL;
2712 }
2713
2714 /*
2715
2716 =item C<static PMC* clone_key_arg(PARROT_INTERP, PMC *key)>
2717
2718 Replaces any src registers by their values (done inside clone). This needs a
2719 test for tailcalls too, but I think there is no syntax to pass a key to a
2720 tailcalled function or method.
2721
2722 =cut
2723
2724 */
2725
2726 PARROT_CAN_RETURN_NULL
2727 static PMC*
2728 clone_key_arg(PARROT_INTERP, ARGIN(PMC *key))
2729 {
2730 ASSERT_ARGS(clone_key_arg)
2731 PMC *t;
2732
2733 if (PMC_IS_NULL(key))
2734 return key;
2735
2736 if (key->vtable->base_type != enum_class_Key)
2737 return key;
2738
2739 for (t = key; t; t=key_next(interp, t)) {
2740 /* register keys have to be cloned */
2741 if (PObj_get_FLAGS(key) & KEY_register_FLAG) {
2742 return VTABLE_clone(interp, key);
2743 }
2744 }
2745
2746 return key;
2747 }
2748
2749 /*
2750
2751 =back
2752
2753 =head1 SEE ALSO
2754
2755 F<include/parrot/call.h>, F<src/call/ops.c>, F<src/call/pcc.c>.
2756
2757 =cut
2758
2759 */
2760
2761 /*
2762 * Local variables:
2763 * c-file-style: "parrot"
2764 * End:
2765 * vim: expandtab shiftwidth=4:
2766 */
parrot vm git mirror