1 /*
2 * parser_util.c
3 *
4 * Intermediate Code Compiler for Parrot.
5 *
6 * Copyright (C) 2002 Melvin Smith <melvin.smith@mindspring.com>
7 * Copyright (C) 2002-2014, Parrot Foundation.
8 *
9 * parser support functions
10 *
11 *
12 */
13
14 #include <string.h>
15 #include <stdio.h>
16 #include <stdlib.h>
17
18 #define _PARSER
19
20 #include "imc.h"
21 #include "parrot/dynext.h"
22 #include "pmc/pmc_sub.h"
23 #include "pmc/pmc_callcontext.h"
24 #include "pbc.h"
25 #include "parser.h"
26 #include "optimizer.h"
27
28 /*
29
30 =head1 NAME
31
32 compilers/imcc/parser_util.c
33
34 =head1 DESCRIPTION
35
36 ParserUtil - Parser support functions.
37
38 =cut
39
40 */
41
42 /* HEADERIZER HFILE: compilers/imcc/imc.h */
43
44 /* HEADERIZER BEGIN: static */
45 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
46
47 PARROT_WARN_UNUSED_RESULT
48 static int change_op_arg_to_num(
49 ARGMOD(imc_info_t * imcc),
50 ARGMOD(IMC_Unit *unit),
51 ARGMOD(SymReg **r),
52 int num,
53 int emit)
54 __attribute__nonnull__(1)
55 __attribute__nonnull__(2)
56 __attribute__nonnull__(3)
57 FUNC_MODIFIES(* imcc)
58 FUNC_MODIFIES(*unit)
59 FUNC_MODIFIES(*r);
60
61 PARROT_WARN_UNUSED_RESULT
62 PARROT_CAN_RETURN_NULL
63 static op_info_t * try_find_op(
64 ARGMOD(imc_info_t * imcc),
65 ARGMOD(IMC_Unit *unit),
66 ARGIN(const char *name),
67 ARGMOD(SymReg **r),
68 int n,
69 int keyvec,
70 int emit)
71 __attribute__nonnull__(1)
72 __attribute__nonnull__(2)
73 __attribute__nonnull__(3)
74 __attribute__nonnull__(4)
75 FUNC_MODIFIES(* imcc)
76 FUNC_MODIFIES(*unit)
77 FUNC_MODIFIES(*r);
78
79 PARROT_WARN_UNUSED_RESULT
80 PARROT_CAN_RETURN_NULL
81 static const char * try_rev_cmp(ARGIN(const char *name), ARGMOD(SymReg **r))
82 __attribute__nonnull__(1)
83 __attribute__nonnull__(2)
84 FUNC_MODIFIES(*r);
85
86 PARROT_MALLOC
87 PARROT_CANNOT_RETURN_NULL
88 PARROT_WARN_UNUSED_RESULT
89 static Instruction * var_arg_ins(
90 ARGMOD(imc_info_t * imcc),
91 ARGMOD(IMC_Unit *unit),
92 ARGIN(const char *name),
93 ARGMOD(SymReg **r),
94 int n,
95 int emit)
96 __attribute__nonnull__(1)
97 __attribute__nonnull__(2)
98 __attribute__nonnull__(3)
99 __attribute__nonnull__(4)
100 FUNC_MODIFIES(* imcc)
101 FUNC_MODIFIES(*unit)
102 FUNC_MODIFIES(*r);
103
104 #define ASSERT_ARGS_change_op_arg_to_num __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
105 PARROT_ASSERT_ARG(imcc) \
106 , PARROT_ASSERT_ARG(unit) \
107 , PARROT_ASSERT_ARG(r))
108 #define ASSERT_ARGS_try_find_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
109 PARROT_ASSERT_ARG(imcc) \
110 , PARROT_ASSERT_ARG(unit) \
111 , PARROT_ASSERT_ARG(name) \
112 , PARROT_ASSERT_ARG(r))
113 #define ASSERT_ARGS_try_rev_cmp __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
114 PARROT_ASSERT_ARG(name) \
115 , PARROT_ASSERT_ARG(r))
116 #define ASSERT_ARGS_var_arg_ins __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
117 PARROT_ASSERT_ARG(imcc) \
118 , PARROT_ASSERT_ARG(unit) \
119 , PARROT_ASSERT_ARG(name) \
120 , PARROT_ASSERT_ARG(r))
121 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
122 /* HEADERIZER END: static */
123
124 /*
125 * used in -D20 to print files with the output of every PIR compilation
126 * this can't be attached to the imcc->interpreter or packfile because it has to be
127 * absolutely global to prevent the files from being overwritten.
128 *
129 */
130
131 /*
132
133 =head2 Functions
134
135 =over
136
137 =item C<void op_fullname(char *dest, const char *name, SymReg * const *args, int
138 narg, int keyvec)>
139
140 Lookup the full opcode given the short name
141
142 set I0, 5 -> set_i_ic
143 set I0, I1 -> set_i_i
144
145 Obviously the registers must be examined before returning the correct
146 opcode.
147
148 =cut
149
150 */
151 void
op_fullname(ARGOUT (char * dest),ARGIN (const char * name),ARGIN (SymReg * const * args),int narg,int keyvec)152 op_fullname(ARGOUT(char *dest), ARGIN(const char *name),
153 ARGIN(SymReg * const *args), int narg, int keyvec)
154 {
155 ASSERT_ARGS(op_fullname)
156 int i;
157 const size_t namelen = strlen(name);
158
159 memcpy(dest, name, namelen+1);
160 dest += namelen;
161
162 for (i = 0; i < narg && args[i]; i++) {
163 *dest++ = '_';
164 if (args[i]->type == VTADDRESS) {
165 *dest++ = 'i';
166 *dest++ = 'c';
167 continue;
168 }
169 /* if one ever wants num keys, they go with 'S' */
170 if (keyvec & KEY_BIT(i)) {
171 *dest++ = 'k';
172 if (args[i]->set=='S' || args[i]->set=='N' || args[i]->set=='K') {
173 *dest++ = 'c';
174 continue;
175 }
176 else if (args[i]->set == 'P')
177 continue;
178 }
179
180 if (args[i]->set == 'K')
181 *dest++ = 'p';
182 else
183 *dest++ = (char)tolower((unsigned char)args[i]->set);
184
185 if (args[i]->type & (VTCONST|VT_CONSTP)) {
186 *dest++ = 'c';
187 }
188 }
189 *dest = '\0';
190 }
191
192 /*
193
194 =item C<void check_op(imc_info_t * imcc, op_info_t **op_info, char *fullname,
195 const char *name, SymReg * const * r, int narg, int keyvec)>
196
197 Return opcode value for op name
198
199 =cut
200
201 */
202
203 void
check_op(ARGMOD (imc_info_t * imcc),ARGOUT (op_info_t ** op_info),ARGOUT (char * fullname),ARGIN (const char * name),ARGIN (SymReg * const * r),int narg,int keyvec)204 check_op(ARGMOD(imc_info_t * imcc), ARGOUT(op_info_t **op_info), ARGOUT(char *fullname),
205 ARGIN(const char *name), ARGIN(SymReg * const * r), int narg, int keyvec)
206 {
207 ASSERT_ARGS(check_op)
208 op_fullname(fullname, name, r, narg, keyvec);
209 *op_info = (op_info_t *)Parrot_hash_get(imcc->interp, imcc->interp->op_hash, fullname);
210 if (*op_info && !STREQ((*op_info)->full_name, fullname))
211 *op_info = NULL;
212 }
213
214 /*
215
216 =item C<int is_op(imc_info_t * imcc, const char *name)>
217
218 Is instruction a parrot opcode?
219
220 =cut
221
222 */
223
224 PARROT_WARN_UNUSED_RESULT
225 int
is_op(ARGMOD (imc_info_t * imcc),ARGIN (const char * name))226 is_op(ARGMOD(imc_info_t * imcc), ARGIN(const char *name))
227 {
228 ASSERT_ARGS(is_op)
229 return Parrot_hash_exists(imcc->interp, imcc->interp->op_hash, name);
230 }
231
232 /*
233
234 =item C<static Instruction * var_arg_ins(imc_info_t * imcc, IMC_Unit *unit,
235 const char *name, SymReg **r, int n, int emit)>
236
237 Create an C<Instruction> object for an instruction that takes a variable
238 number of arguments.
239
240 =cut
241
242 */
243
244 PARROT_MALLOC
245 PARROT_CANNOT_RETURN_NULL
246 PARROT_WARN_UNUSED_RESULT
247 static Instruction *
var_arg_ins(ARGMOD (imc_info_t * imcc),ARGMOD (IMC_Unit * unit),ARGIN (const char * name),ARGMOD (SymReg ** r),int n,int emit)248 var_arg_ins(ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit), ARGIN(const char *name),
249 ARGMOD(SymReg **r), int n, int emit)
250 {
251 ASSERT_ARGS(var_arg_ins)
252 op_info_t *op;
253 Instruction *ins;
254 char fullname[64];
255
256 /* in constant */
257 int dirs = 1;
258
259 /* XXX: Maybe the check for n == 0 is the only one required
260 * and the other must be assertions? */
261 if (n == 0 || r[0] == NULL || r[0]->name == NULL)
262 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
263 "The opcode '%s' needs arguments", name);
264
265 if (r[0]->set == 'S') {
266 r[0] = mk_const(imcc, r[0]->name, 'P');
267 r[0]->pmc_type = enum_class_FixedIntegerArray;
268 }
269
270 op_fullname(fullname, name, r, 1, 0);
271 op = (op_info_t *)Parrot_hash_get(imcc->interp, imcc->interp->op_hash, fullname);
272
273 PARROT_ASSERT(op && STREQ(op->full_name, fullname));
274
275 ins = _mk_instruction(name, "", n, r, dirs);
276 ins->op = op;
277 ins->opsize = n + 1;
278
279 if (emit)
280 emitb(imcc, unit, ins);
281
282 return ins;
283 }
284
285 /*
286
287 =item C<Instruction * INS(imc_info_t * imcc, IMC_Unit *unit, const char *name,
288 const char *fmt, SymReg **r, int n, int keyvec, int emit)>
289
290 Makes an instruction.
291
292 name ... op name
293 fmt ... optional format
294 regs ... SymReg **
295 n ... number of params
296 keyvec ... see KEY_BIT()
297 emit ... if true, append to instructions
298
299 see imc.c for usage
300
301 =cut
302
303 */
304
305 PARROT_IGNORABLE_RESULT
306 PARROT_CAN_RETURN_NULL
307 Instruction *
INS(ARGMOD (imc_info_t * imcc),ARGMOD (IMC_Unit * unit),ARGIN (const char * name),ARGIN_NULLOK (const char * fmt),ARGIN (SymReg ** r),int n,int keyvec,int emit)308 INS(ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit), ARGIN(const char *name),
309 ARGIN_NULLOK(const char *fmt), ARGIN(SymReg **r), int n, int keyvec,
310 int emit)
311 {
312 ASSERT_ARGS(INS)
313
314 if (STREQ(name, ".annotate")) {
315 Instruction *ins = _mk_instruction(name, "", n, r, 0);
316 if (emit)
317 return emitb(imcc, unit, ins);
318 else
319 return ins;
320 }
321
322 if ((STREQ(name, "set_args"))
323 || (STREQ(name, "get_results"))
324 || (STREQ(name, "get_params"))
325 || (STREQ(name, "set_returns")))
326 return var_arg_ins(imcc, unit, name, r, n, emit);
327 else {
328 Instruction *ins;
329 int i, len;
330 int dirs = 0;
331 op_info_t *op;
332 char fullname[64] = "", format[128] = "";
333
334 op_fullname(fullname, name, r, n, keyvec);
335 op = (op_info_t *)Parrot_hash_get(imcc->interp, imcc->interp->op_hash, fullname);
336 if (op && !STREQ(op->full_name, fullname))
337 op = NULL;
338
339 /* maybe we have a fullname */
340 if (!op) {
341 op = (op_info_t *)Parrot_hash_get(imcc->interp, imcc->interp->op_hash, name);
342 if (op && !STREQ(op->full_name, name))
343 op = NULL;
344 }
345
346 /* still wrong, try reverse compare */
347 if (!op) {
348 const char * const n_name = try_rev_cmp(name, r);
349 if (n_name) {
350 name = n_name;
351 op_fullname(fullname, name, r, n, keyvec);
352 op = (op_info_t *)Parrot_hash_get(imcc->interp, imcc->interp->op_hash, fullname);
353 if (op && !STREQ(op->full_name, fullname))
354 op = NULL;
355 }
356 }
357
358 /* still wrong, try to find an existing op */
359 if (!op)
360 op = try_find_op(imcc, unit, name, r, n, keyvec, emit);
361
362 if (!op) {
363 int ok = 0;
364
365 /* check mixed constants */
366 ins = IMCC_subst_constants_umix(imcc, unit, name, r, n + 1);
367 if (ins)
368 goto found_ins;
369
370 /* and finally multiple constants */
371 ins = IMCC_subst_constants(imcc, unit, name, r, n + 1, &ok);
372
373 if (ok) {
374 if (ins)
375 goto found_ins;
376 else
377 return NULL;
378 }
379 }
380 else
381 strcpy(fullname, name);
382
383 if (!op)
384 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
385 "The opcode '%s' (%s<%d>) was not found. "
386 "Check the type and number of the arguments",
387 fullname, name, n);
388
389 *format = '\0';
390
391 /* info->op_count is args + 1
392 * build instruction format
393 * set LV_in / out flags */
394 if (n != op->op_count - 1)
395 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
396 "arg count mismatch: op #%d '%s' needs %d given %d",
397 op, fullname, op->op_count-1, n);
398
399 /* XXX Speed up some by keep track of the end of format ourselves */
400 for (i = 0; i < n; i++) {
401 switch (op->dirs[i]) {
402 case PARROT_ARGDIR_INOUT:
403 dirs |= 1 << (16 + i);
404 /* go on */
405 case PARROT_ARGDIR_IN:
406 dirs |= 1 << i ;
407 break;
408
409 case PARROT_ARGDIR_OUT:
410 dirs |= 1 << (16 + i);
411 break;
412
413 default:
414 PARROT_ASSERT(0);
415 };
416
417 if (keyvec & KEY_BIT(i)) {
418 /* XXX Assert that len > 2 */
419 len = strlen(format) - 2;
420 PARROT_ASSERT(len >= 0);
421 format[len] = '\0';
422 strcat(format, "[%s], ");
423 }
424 else if (r[i]->set == 'K')
425 strcat(format, "[%s], ");
426 else
427 strcat(format, "%s, ");
428 }
429
430 len = strlen(format);
431 if (len >= 2)
432 len -= 2;
433
434 format[len] = '\0';
435
436 if (fmt && *fmt) {
437 strncpy(format, fmt, sizeof (format) - 1);
438 format[sizeof (format) - 1] = '\0';
439 }
440
441 IMCC_debug(imcc, DEBUG_PARSER, "%s %s\t%s\n", name, format, fullname);
442
443 /* make the instruction */
444 ins = _mk_instruction(name, format, n, r, dirs);
445 ins->keys |= keyvec;
446
447 /* fill in oplib's info */
448 ins->op = op;
449 ins->opsize = n + 1;
450
451 /* mark end as absolute branch */
452 if (STREQ(name, "end") || STREQ(name, "ret")) {
453 ins->type |= ITBRANCH | IF_goto;
454 }
455 else if (STREQ(name, "yield")) {
456 if (!imcc->cur_unit->instructions->symregs[0])
457 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
458 "Cannot yield from non-continuation\n");
459
460 imcc->cur_unit->instructions->symregs[0]->pcc_sub->yield = 1;
461 }
462
463 /* set up branch flags
464 * mark registers that are labels */
465 for (i = 0; i < op->op_count - 1; i++) {
466 if (op->labels[i])
467 ins->type |= ITBRANCH | (1 << i);
468 else {
469 if (r[i]->type == VTADDRESS)
470 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
471 "undefined identifier '%s'\n", r[i]->name);
472 }
473 }
474
475 if (op->jump) {
476 ins->type |= ITBRANCH;
477 /* TODO use opnum constants */
478 if (STREQ(name, "branch")
479 || STREQ(name, "tailcall")
480 || STREQ(name, "returncc"))
481 ins->type |= IF_goto;
482 else if (STREQ(fullname, "jump_i")
483 || STREQ(fullname, "branch_i"))
484 imcc->dont_optimize = 1;
485 }
486
487 found_ins:
488 if (emit)
489 emitb(imcc, unit, ins);
490
491 return ins;
492 }
493 }
494
495
496 /*
497
498 =item C<static int change_op_arg_to_num(imc_info_t * imcc, IMC_Unit *unit,
499 SymReg **r, int num, int emit)>
500
501 Change one argument of an op to be numeric in stead of integral. Used when
502 integer argument op variants don't exist.
503
504 =cut
505
506 */
507
508 PARROT_WARN_UNUSED_RESULT
509 static int
change_op_arg_to_num(ARGMOD (imc_info_t * imcc),ARGMOD (IMC_Unit * unit),ARGMOD (SymReg ** r),int num,int emit)510 change_op_arg_to_num(ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit),
511 ARGMOD(SymReg **r), int num, int emit)
512 {
513 ASSERT_ARGS(change_op_arg_to_num)
514 int changed = 0;
515
516 if (r[num]->type & (VTCONST|VT_CONSTP)) {
517 /* make a number const */
518 const SymReg *c = r[num];
519
520 if (c->type & VT_CONSTP)
521 c = c->reg;
522
523 r[num] = mk_const(imcc, c->name, 'N');
524 changed = 1;
525 }
526 else if (emit) {
527 /* emit
528 * set $N0, Iy
529 * op Nx, $N0
530 * or
531 * op Nx, ..., $N0
532 */
533 SymReg *rr[2];
534
535 rr[0] = mk_temp_reg(imcc, 'N');
536 rr[1] = r[num];
537
538 INS(imcc, unit, "set", NULL, rr, 2, 0, 1);
539
540 r[num] = rr[0];
541 changed = 1;
542
543 /* need to allocate the temp - run reg_alloc */
544 imcc->optimizer_level |= OPT_PASM;
545 }
546
547 return changed;
548 }
549
550 /*
551
552 =item C<static op_info_t * try_find_op(imc_info_t * imcc, IMC_Unit *unit, const
553 char *name, SymReg **r, int n, int keyvec, int emit)>
554
555 Try to find valid op doing the same operation e.g.
556
557 add_n_i_n => add_n_n_i
558 div_n_ic_n => div_n_nc_n
559 div_n_i_n => set_n_i ; div_n_n_n
560 ge_n_ic_ic => ge_n_nc_ic
561 acos_n_i => acos_n_n
562
563 =cut
564
565 */
566
567 PARROT_WARN_UNUSED_RESULT
568 PARROT_CAN_RETURN_NULL
569 static op_info_t *
try_find_op(ARGMOD (imc_info_t * imcc),ARGMOD (IMC_Unit * unit),ARGIN (const char * name),ARGMOD (SymReg ** r),int n,int keyvec,int emit)570 try_find_op(ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit), ARGIN(const char *name),
571 ARGMOD(SymReg **r), int n, int keyvec, int emit)
572 {
573 ASSERT_ARGS(try_find_op)
574 char fullname[64];
575 int changed = 0;
576
577 if (n == 3 && r[0]->set == 'N') {
578 if (r[1]->set == 'I') {
579 const SymReg * const r1 = r[1];
580 changed |= change_op_arg_to_num(imcc, unit, r, 1, emit);
581
582 /* op Nx, Iy, Iy: reuse generated temp Nz */
583 if (r[2]->set == 'I' && r[2]->type != VTADDRESS && r[2] == r1)
584 r[2] = r[1];
585 }
586
587 if (r[2]->set == 'I' && r[2]->type != VTADDRESS)
588 changed |= change_op_arg_to_num(imcc, unit, r, 2, emit);
589 }
590
591 /* handle eq_i_n_ic */
592 else if (n == 3 && r[1]->set == 'N' && r[0]->set == 'I' &&
593 r[2]->type == VTADDRESS) {
594 changed |= change_op_arg_to_num(imcc, unit, r, 0, emit);
595 }
596 else if (n == 2 && r[0]->set == 'N' && r[1]->set == 'I') {
597 /*
598 * transcendentals e.g. acos N, I
599 */
600 if (!STREQ(name, "fact"))
601 changed = change_op_arg_to_num(imcc, unit, r, 1, emit);
602 }
603
604 if (changed) {
605 op_info_t *op;
606 op_fullname(fullname, name, r, n, keyvec);
607 op = (op_info_t *)Parrot_hash_get(imcc->interp, imcc->interp->op_hash, fullname);
608 if (op && !STREQ(op->full_name, fullname))
609 op = NULL;
610 return op;
611 }
612
613 return NULL;
614 }
615
616 /*
617
618 =item C<static const char * try_rev_cmp(const char *name, SymReg **r)>
619
620 Try to find a valid op doing the same thing by reversing comparisons.
621
622 =cut
623
624 */
625
626 PARROT_WARN_UNUSED_RESULT
627 PARROT_CAN_RETURN_NULL
628 static const char *
try_rev_cmp(ARGIN (const char * name),ARGMOD (SymReg ** r))629 try_rev_cmp(ARGIN(const char *name), ARGMOD(SymReg **r))
630 {
631 ASSERT_ARGS(try_rev_cmp)
632 static const struct br_pairs {
633 PARROT_OBSERVER const char * const op;
634 PARROT_OBSERVER const char * const nop;
635 const int to_swap;
636 } br_pairs[] = {
637 { "gt", "lt", 0 },
638 { "ge", "le", 0 },
639 { "isgt", "islt", 1 },
640 { "isge", "isle", 1 },
641 };
642
643 unsigned int i;
644
645 for (i = 0; i < N_ELEMENTS(br_pairs); i++) {
646 if (STREQ(name, br_pairs[i].op)) {
647 const int to_swap = br_pairs[i].to_swap;
648 SymReg *t;
649
650 if (!r[to_swap + 1] || r[to_swap + 1]->set == 'P')
651 return NULL;
652
653 t = r[to_swap];
654 r[to_swap] = r[to_swap + 1];
655 r[to_swap + 1] = t;
656
657 return br_pairs[i].nop;
658 }
659 }
660
661 return NULL;
662 }
663
664
665 /*
666
667 =item C<int imcc_vfprintf(imc_info_t * imcc, PMC *io, ARGIN_FORMAT(const char
668 *format), va_list ap)>
669
670 Formats a given series of arguments per a given format string and prints it to
671 the given Parrot IO PMC.
672
673 =cut
674
675 */
676
677 PARROT_IGNORABLE_RESULT
678 int
imcc_vfprintf(ARGMOD (imc_info_t * imcc),ARGMOD (PMC * io),ARGIN_FORMAT (const char * format),va_list ap)679 imcc_vfprintf(ARGMOD(imc_info_t * imcc), ARGMOD(PMC *io),
680 ARGIN_FORMAT(const char *format), va_list ap)
681 {
682 ASSERT_ARGS(imcc_vfprintf)
683 return Parrot_io_write_s(imcc->interp, io, Parrot_vsprintf_c(imcc->interp, format, ap));
684 }
685
686 /*
687
688 =item C<int imcc_string_ends_with(imc_info_t * imcc, const STRING *str, const
689 char *ext)>
690
691 Checks whether string C<str> has extension C<ext>.
692
693 =cut
694
695 */
696
697 int
imcc_string_ends_with(ARGMOD (imc_info_t * imcc),ARGIN (const STRING * str),ARGIN (const char * ext))698 imcc_string_ends_with(ARGMOD(imc_info_t * imcc), ARGIN(const STRING *str),
699 ARGIN(const char *ext))
700 {
701 ASSERT_ARGS(imcc_string_ends_with)
702 STRING *ext_str = Parrot_str_new(imcc->interp, ext, 0);
703 STRING *substr;
704 INTVAL ext_len = STRING_length(ext_str);
705 INTVAL len = STRING_length(str);
706
707 if (ext_len >= len)
708 return 0;
709
710 substr = STRING_substr(imcc->interp, str, len - ext_len, ext_len);
711
712 return STRING_equal(imcc->interp, substr, ext_str);
713 }
714
715 /*
716
717 =back
718
719 =cut
720
721 */
722
723
724 /*
725 * Local variables:
726 * c-file-style: "parrot"
727 * End:
728 * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
729 */
730