%{
/*
* imcc.y
*
* Intermediate Code Compiler for Parrot.
*
* Copyright (C) 2002 Melvin Smith <melvin.smith@mindspring.com>
* Copyright (C) 2002-2010, Parrot Foundation.
*
* Grammar of the PIR language parser.
*
*
*/
/*
=pod
=head1 NAME
compilers/imcc/imcc.y - Intermediate Code Compiler for Parrot.
=head1 DESCRIPTION
This file contains the grammar of the PIR language parser.
=cut
*/
#include <string.h>
#include <stdio.h>
#include <stdlib.h>
#define _PARSER
#define PARSER_MAIN
#include "imc.h"
#include "parrot/dynext.h"
#include "pmc/pmc_callcontext.h"
#include "pbc.h"
#include "parser.h"
#include "optimizer.h"
#include "instructions.h"
#include "symreg.h"
/* prevent declarations of malloc() and free() in the generated parser. */
#define YYMALLOC
#define YYFREE(Ptr) do { /* empty */; } while (YYID (0))
#ifndef YYENABLE_NLS
# define YYENABLE_NLS 0
#endif
#ifndef YYLTYPE_IS_TRIVIAL
# define YYLTYPE_IS_TRIVIAL 0
#endif
/* HEADERIZER HFILE: compilers/imcc/imc.h */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
static void add_pcc_named_arg(
ARGMOD(imc_info_t *imcc),
ARGMOD(SymReg *cur_call),
ARGMOD(SymReg *name),
ARGMOD(SymReg *value))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4)
FUNC_MODIFIES(*imcc)
FUNC_MODIFIES(*cur_call)
FUNC_MODIFIES(*name)
FUNC_MODIFIES(*value);
static void add_pcc_named_arg_var(
ARGMOD(imc_info_t *imcc),
ARGMOD(SymReg *cur_call),
ARGMOD(SymReg *name),
ARGMOD(SymReg *value))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4)
FUNC_MODIFIES(*imcc)
FUNC_MODIFIES(*cur_call)
FUNC_MODIFIES(*name)
FUNC_MODIFIES(*value);
static void add_pcc_named_param(
ARGMOD(imc_info_t *imcc),
ARGMOD(SymReg *cur_call),
ARGMOD(SymReg *name),
ARGMOD(SymReg *value))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4)
FUNC_MODIFIES(*imcc)
FUNC_MODIFIES(*cur_call)
FUNC_MODIFIES(*name)
FUNC_MODIFIES(*value);
static void add_pcc_named_result(
ARGMOD(imc_info_t *imcc),
ARGMOD(SymReg *cur_call),
ARGMOD(SymReg *name),
ARGMOD(SymReg *value))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4)
FUNC_MODIFIES(*imcc)
FUNC_MODIFIES(*cur_call)
FUNC_MODIFIES(*name)
FUNC_MODIFIES(*value);
static void add_pcc_named_return(
ARGMOD(imc_info_t *imcc),
ARGMOD(SymReg *cur_call),
ARGMOD(SymReg *name),
ARGMOD(SymReg *value))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4)
FUNC_MODIFIES(*imcc)
FUNC_MODIFIES(*cur_call)
FUNC_MODIFIES(*name)
FUNC_MODIFIES(*value);
static void adv_named_set(ARGMOD(imc_info_t *imcc), ARGIN(const char *name))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*imcc);
static void adv_named_set_u(
ARGMOD(imc_info_t *imcc),
ARGIN(const char *name))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*imcc);
static void begin_return_or_yield(ARGMOD(imc_info_t *imcc), int yield)
__attribute__nonnull__(1)
FUNC_MODIFIES(*imcc);
static void clear_state(ARGMOD(imc_info_t *imcc))
__attribute__nonnull__(1)
FUNC_MODIFIES(*imcc);
static void do_loadlib(ARGMOD(imc_info_t *imcc), ARGIN(const char *lib))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*imcc);
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static Instruction* func_ins(
ARGMOD(imc_info_t *imcc),
ARGMOD(IMC_Unit *unit),
ARGIN(SymReg *lhs),
ARGIN(const char *op),
ARGMOD(SymReg **r),
int n,
int keyv,
int emit)
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4)
__attribute__nonnull__(5)
FUNC_MODIFIES(*imcc)
FUNC_MODIFIES(*unit)
FUNC_MODIFIES(*r);
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static Instruction * iINDEXFETCH(
ARGMOD(imc_info_t *imcc),
ARGMOD(IMC_Unit *unit),
ARGIN(SymReg *r0),
ARGIN(SymReg *r1),
ARGIN(SymReg *r2))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4)
__attribute__nonnull__(5)
FUNC_MODIFIES(*imcc)
FUNC_MODIFIES(*unit);
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static Instruction * iINDEXSET(
ARGMOD(imc_info_t *imcc),
ARGMOD(IMC_Unit *unit),
ARGIN(SymReg *r0),
ARGIN(SymReg *r1),
ARGIN(SymReg *r2))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4)
__attribute__nonnull__(5)
FUNC_MODIFIES(*imcc)
FUNC_MODIFIES(*unit);
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static Instruction * iLABEL(
ARGMOD(imc_info_t *imcc),
ARGMOD_NULLOK(IMC_Unit *unit),
ARGMOD(SymReg *r0))
__attribute__nonnull__(1)
__attribute__nonnull__(3)
FUNC_MODIFIES(*imcc)
FUNC_MODIFIES(*unit)
FUNC_MODIFIES(*r0);
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static const char * inv_op(ARGIN(const char *op))
__attribute__nonnull__(1);
PARROT_IGNORABLE_RESULT
PARROT_CANNOT_RETURN_NULL
static Instruction * iSUBROUTINE(
ARGMOD(imc_info_t *imcc),
ARGMOD_NULLOK(IMC_Unit *unit),
ARGMOD(SymReg *r))
__attribute__nonnull__(1)
__attribute__nonnull__(3)
FUNC_MODIFIES(*imcc)
FUNC_MODIFIES(*unit)
FUNC_MODIFIES(*r);
PARROT_IGNORABLE_RESULT
PARROT_CAN_RETURN_NULL
static Instruction * MK_I(
ARGMOD(imc_info_t *imcc),
ARGMOD(IMC_Unit *unit),
ARGIN(const char *fmt),
int n,
...)
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
FUNC_MODIFIES(*imcc)
FUNC_MODIFIES(*unit);
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static Instruction* mk_pmc_const_named(
ARGMOD(imc_info_t *imcc),
ARGMOD(IMC_Unit *unit),
ARGIN(const char *name),
ARGMOD(SymReg *left),
ARGIN(const char *constant))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4)
__attribute__nonnull__(5)
FUNC_MODIFIES(*imcc)
FUNC_MODIFIES(*unit)
FUNC_MODIFIES(*left);
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static SymReg * mk_sub_address_fromc(
ARGMOD(imc_info_t *imcc),
ARGIN(const char *name))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*imcc);
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static SymReg * mk_sub_address_u(
ARGMOD(imc_info_t *imcc),
ARGIN(const char *name))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*imcc);
static void set_lexical(
ARGMOD(imc_info_t *imcc),
ARGMOD(SymReg *r),
ARGMOD(SymReg *name))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
FUNC_MODIFIES(*imcc)
FUNC_MODIFIES(*r)
FUNC_MODIFIES(*name);
#define ASSERT_ARGS_add_pcc_named_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(cur_call) \
, PARROT_ASSERT_ARG(name) \
, PARROT_ASSERT_ARG(value))
#define ASSERT_ARGS_add_pcc_named_arg_var __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(cur_call) \
, PARROT_ASSERT_ARG(name) \
, PARROT_ASSERT_ARG(value))
#define ASSERT_ARGS_add_pcc_named_param __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(cur_call) \
, PARROT_ASSERT_ARG(name) \
, PARROT_ASSERT_ARG(value))
#define ASSERT_ARGS_add_pcc_named_result __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(cur_call) \
, PARROT_ASSERT_ARG(name) \
, PARROT_ASSERT_ARG(value))
#define ASSERT_ARGS_add_pcc_named_return __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(cur_call) \
, PARROT_ASSERT_ARG(name) \
, PARROT_ASSERT_ARG(value))
#define ASSERT_ARGS_adv_named_set __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(name))
#define ASSERT_ARGS_adv_named_set_u __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(name))
#define ASSERT_ARGS_begin_return_or_yield __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc))
#define ASSERT_ARGS_clear_state __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc))
#define ASSERT_ARGS_do_loadlib __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(lib))
#define ASSERT_ARGS_func_ins __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(unit) \
, PARROT_ASSERT_ARG(lhs) \
, PARROT_ASSERT_ARG(op) \
, PARROT_ASSERT_ARG(r))
#define ASSERT_ARGS_iINDEXFETCH __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(unit) \
, PARROT_ASSERT_ARG(r0) \
, PARROT_ASSERT_ARG(r1) \
, PARROT_ASSERT_ARG(r2))
#define ASSERT_ARGS_iINDEXSET __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(unit) \
, PARROT_ASSERT_ARG(r0) \
, PARROT_ASSERT_ARG(r1) \
, PARROT_ASSERT_ARG(r2))
#define ASSERT_ARGS_iLABEL __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(r0))
#define ASSERT_ARGS_inv_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(op))
#define ASSERT_ARGS_iSUBROUTINE __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(r))
#define ASSERT_ARGS_MK_I __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(unit) \
, PARROT_ASSERT_ARG(fmt))
#define ASSERT_ARGS_mk_pmc_const_named __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(unit) \
, PARROT_ASSERT_ARG(name) \
, PARROT_ASSERT_ARG(left) \
, PARROT_ASSERT_ARG(constant))
#define ASSERT_ARGS_mk_sub_address_fromc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(name))
#define ASSERT_ARGS_mk_sub_address_u __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(name))
#define ASSERT_ARGS_set_lexical __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(imcc) \
, PARROT_ASSERT_ARG(r) \
, PARROT_ASSERT_ARG(name))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
#define YYDEBUG 1
#define YYERROR_VERBOSE 1
/* Warning: parser is probably not reentrant */
/*
* Choosing instructions for Parrot is pretty easy since many are
* polymorphic.
*/
/*
=over 4
=item C<static Instruction * MK_I(imc_info_t *imcc, IMC_Unit *unit, const char
*fmt, int n, ...)>
build and emitb instruction by INS. fmt may contain:
op %s, %s # comment
or just
op
NOTE: Most usage of this function is with
imcc->cur_unit, but there are some
exceptions. Thus, we can't easily factorize that piece of
code.
=cut
*/
PARROT_IGNORABLE_RESULT
PARROT_CAN_RETURN_NULL
static Instruction *
MK_I(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(const char *fmt), int n, ...)
{
ASSERT_ARGS(MK_I)
char opname[64];
char *p;
const char *q;
va_list ap;
SymReg *r[IMCC_MAX_FIX_REGS];
int i;
for (p = opname, q = fmt; *q && *q != ' ';)
*p++ = *q++;
*p = '\0';
if (!*q)
fmt = NULL;
else
fmt = ++q;
#ifdef OPDEBUG
fprintf(stderr, "op '%s' format '%s' (%d)\n", opname, fmt?:"", n);
#endif
va_start(ap, n);
i = 0;
for (i = 0; i < n; ++i) {
r[i] = va_arg(ap, SymReg *);
}
va_end(ap);
return INS(imcc, unit, opname, fmt, r, n, imcc->keyvec, 1);
}
/*
=item C<static Instruction* mk_pmc_const_named(imc_info_t *imcc, IMC_Unit *unit,
const char *name, SymReg *left, const char *constant)>
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static Instruction*
mk_pmc_const_named(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit),
ARGIN(const char *name), ARGMOD(SymReg *left), ARGIN(const char *constant))
{
ASSERT_ARGS(mk_pmc_const_named)
SymReg *rhs;
SymReg *r[3];
char *const_name;
const int ascii = (*constant == '\'' || *constant == '"');
char *unquoted_name = mem_sys_strdup(name + 1);
size_t name_length = strlen(unquoted_name) - 1;
unquoted_name[name_length] = 0;
if (left->type == VTADDRESS) { /* IDENTIFIER */
if (imcc->state->pasm_file) {
IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
"Ident as PMC constant",
" %s\n", left->name);
}
left->type = VTIDENTIFIER;
left->set = 'P';
}
r[0] = left;
if (ascii) {
/* strip delimiters */
const_name = mem_sys_strdup(constant + 1);
const_name[strlen(const_name) - 1] = 0;
}
else {
const_name = mem_sys_strdup(constant);
}
if ((strncmp(unquoted_name, "Sub", name_length) == 0)
|| (strncmp(unquoted_name, "Coroutine", name_length) == 0)) {
rhs = mk_const(imcc, const_name, 'p');
if (!ascii)
rhs->type |= VT_ENCODED;
rhs->usage |= U_FIXUP | U_SUBID_LOOKUP;
}
else if (strncmp(unquoted_name, "LexInfo", name_length) == 0) {
rhs = mk_const(imcc, const_name, 'l');
if (!ascii)
rhs->type |= VT_ENCODED;
rhs->usage |= U_FIXUP | U_LEXINFO_LOOKUP;
}
else {
rhs = mk_const(imcc, const_name, 'P');
}
r[1] = rhs;
rhs->pmc_type = Parrot_pmc_get_type_str(imcc->interp,
Parrot_str_new(imcc->interp, unquoted_name, name_length));
mem_sys_free(unquoted_name);
mem_sys_free(const_name);
return INS(imcc, unit, "set_p_pc", "", r, 2, 0, 1);
}
/*
=item C<static Instruction* func_ins(imc_info_t *imcc, IMC_Unit *unit, SymReg
*lhs, const char *op, SymReg **r, int n, int keyv, int emit)>
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static Instruction*
func_ins(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(SymReg *lhs),
ARGIN(const char *op), ARGMOD(SymReg **r), int n, int keyv, int emit)
{
ASSERT_ARGS(func_ins)
int i;
/* shift regs up by 1 */
for (i = n - 1; i >= 0; --i)
r[i+1] = r[i];
r[0] = lhs;
/* shift keyvec */
keyv <<= 1;
return INS(imcc, unit, op, "", r, n+1, keyv, emit);
}
/*
=item C<static void clear_state(imc_info_t *imcc)>
=cut
*/
static void
clear_state(ARGMOD(imc_info_t *imcc))
{
ASSERT_ARGS(clear_state)
imcc -> nargs = 0;
imcc -> keyvec = 0;
}
/*
=item C<Instruction * INS_LABEL(imc_info_t *imcc, IMC_Unit *unit, SymReg *r0,
int emit)>
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
Instruction *
INS_LABEL(ARGMOD(imc_info_t *imcc), ARGMOD_NULLOK(IMC_Unit *unit),
ARGMOD(SymReg *r0), int emit)
{
ASSERT_ARGS(INS_LABEL)
Instruction * const ins = _mk_instruction("", "%s:", 1, &r0, 0);
ins->type = ITLABEL;
r0->first_ins = ins;
if (emit)
emitb(imcc, unit, ins);
return ins;
}
/*
=item C<static Instruction * iLABEL(imc_info_t *imcc, IMC_Unit *unit, SymReg
*r0)>
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static Instruction *
iLABEL(ARGMOD(imc_info_t *imcc), ARGMOD_NULLOK(IMC_Unit *unit),
ARGMOD(SymReg *r0))
{
ASSERT_ARGS(iLABEL)
Instruction * const i = INS_LABEL(imcc, unit, r0, 1);
i->line = imcc->line;
clear_state(imcc);
return i;
}
/*
=item C<static Instruction * iSUBROUTINE(imc_info_t *imcc, IMC_Unit *unit,
SymReg *r)>
=cut
*/
PARROT_IGNORABLE_RESULT
PARROT_CANNOT_RETURN_NULL
static Instruction *
iSUBROUTINE(ARGMOD(imc_info_t *imcc), ARGMOD_NULLOK(IMC_Unit *unit), ARGMOD(SymReg *r))
{
ASSERT_ARGS(iSUBROUTINE)
Instruction * const i = iLABEL(imcc, unit, r);
i->type |= ITPCCPARAM;
r->type = (r->type & VT_ENCODED) ? VT_PCC_SUB|VT_ENCODED : VT_PCC_SUB;
r->pcc_sub = mem_gc_allocate_zeroed_typed(imcc->interp, pcc_sub_t);
imcc->cur_call = r;
i->line = imcc->line;
add_namespace(imcc, unit);
return i;
}
/*
=item C<static Instruction * iINDEXFETCH(imc_info_t *imcc, IMC_Unit *unit,
SymReg *r0, SymReg *r1, SymReg *r2)>
substr or X = P[key]
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static Instruction *
iINDEXFETCH(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(SymReg *r0),
ARGIN(SymReg *r1), ARGIN(SymReg *r2))
{
ASSERT_ARGS(iINDEXFETCH)
imcc -> keyvec |= KEY_BIT(2);
return MK_I(imcc, unit, "set %s, %s[%s]", 3, r0, r1, r2);
}
/*
=item C<static Instruction * iINDEXSET(imc_info_t *imcc, IMC_Unit *unit, SymReg
*r0, SymReg *r1, SymReg *r2)>
substr or P[key] = X
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static Instruction *
iINDEXSET(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(SymReg *r0),
ARGIN(SymReg *r1), ARGIN(SymReg *r2))
{
ASSERT_ARGS(iINDEXSET)
if (r0->set == 'P') {
imcc->keyvec |= KEY_BIT(1);
MK_I(imcc, unit, "set %s[%s], %s", 3, r0, r1, r2);
}
else
IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
"unsupported indexed set op\n");
return NULL;
}
/*
=item C<static const char * inv_op(const char *op)>
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static const char *
inv_op(ARGIN(const char *op))
{
ASSERT_ARGS(inv_op)
int n;
return get_neg_op(op, &n);
}
/*
=item C<Instruction * IMCC_create_itcall_label(imc_info_t *imcc)>
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
Instruction *
IMCC_create_itcall_label(ARGMOD(imc_info_t *imcc))
{
ASSERT_ARGS(IMCC_create_itcall_label)
char name[128];
SymReg *r;
Instruction *i;
snprintf(name, sizeof (name), "%cpcc_sub_call_%d", IMCC_INTERNAL_CHAR,
imcc->cnr++);
r = mk_pcc_sub(imcc, name, 0);
i = iLABEL(imcc, imcc->cur_unit, r);
i->type = ITCALL | ITPCCSUB;
imcc->cur_call = r;
return i;
}
/*
=item C<static SymReg * mk_sub_address_fromc(imc_info_t *imcc, const char
*name)>
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static SymReg *
mk_sub_address_fromc(ARGMOD(imc_info_t *imcc), ARGIN(const char *name))
{
ASSERT_ARGS(mk_sub_address_fromc)
/* name is a quoted sub name */
SymReg *r;
char *name_copy;
/* interpolate only if the first character is a double-quote */
if (*name == '"') {
STRING *unescaped = Parrot_str_unescape(imcc->interp, name, '"', NULL);
name_copy = Parrot_str_to_cstring(imcc->interp, unescaped);
}
else {
name_copy = mem_sys_strdup(name);
name_copy[strlen(name) - 1] = 0;
}
r = mk_sub_address(imcc, name_copy + 1);
mem_sys_free(name_copy);
return r;
}
/*
=item C<static SymReg * mk_sub_address_u(imc_info_t *imcc, const char *name)>
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static SymReg *
mk_sub_address_u(ARGMOD(imc_info_t *imcc), ARGIN(const char *name))
{
ASSERT_ARGS(mk_sub_address_u)
SymReg * const r = mk_sub_address(imcc, name);
r->type |= VT_ENCODED;
return r;
}
/*
=item C<void IMCC_itcall_sub(imc_info_t *imcc, SymReg *sub)>
=cut
*/
void
IMCC_itcall_sub(ARGMOD(imc_info_t *imcc), ARGIN(SymReg *sub))
{
ASSERT_ARGS(IMCC_itcall_sub)
imcc->cur_call->pcc_sub->sub = sub;
if (imcc->cur_obj) {
if (imcc->cur_obj->set != 'P')
IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "object isn't a PMC");
imcc->cur_call->pcc_sub->object = imcc->cur_obj;
imcc->cur_obj = NULL;
}
}
/*
=item C<static void begin_return_or_yield(imc_info_t *imcc, int yield)>
=cut
*/
static void
begin_return_or_yield(ARGMOD(imc_info_t *imcc), int yield)
{
ASSERT_ARGS(begin_return_or_yield)
Instruction *i;
Instruction * const ins = imcc->cur_unit->instructions;
char name[128];
if (!ins || !ins->symregs[0] || !(ins->symregs[0]->type & VT_PCC_SUB))
IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
"yield or return directive outside pcc subroutine\n");
ins->symregs[0]->pcc_sub->yield = yield;
snprintf(name, sizeof (name), yield ? "%cpcc_sub_yield_%d" : "%cpcc_sub_ret_%d",
IMCC_INTERNAL_CHAR, imcc->cnr++);
imcc->sr_return = mk_pcc_sub(imcc, name, 0);
i = iLABEL(imcc, imcc->cur_unit, imcc->sr_return);
i->type = yield ? ITPCCSUB | ITLABEL | ITPCCYIELD : ITPCCSUB | ITLABEL ;
imcc->asm_state = yield ? AsmInYield : AsmInReturn;
}
/*
=item C<static void set_lexical(imc_info_t *imcc, SymReg *r, SymReg *name)>
=cut
*/
static void
set_lexical(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *r), ARGMOD(SymReg *name))
{
ASSERT_ARGS(set_lexical)
r->usage |= U_LEXICAL;
if (name == r->reg)
IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
"register %s already declared as lexical %s", r->name, name->name);
/* chain all names in r->reg */
name->reg = r->reg;
r->reg = name;
name->usage |= U_LEXICAL;
r->use_count++;
}
/*
=item C<static void add_pcc_named_arg(imc_info_t *imcc, SymReg *cur_call, SymReg
*name, SymReg *value)>
=cut
*/
static void
add_pcc_named_arg(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call),
ARGMOD(SymReg *name), ARGMOD(SymReg *value))
{
ASSERT_ARGS(add_pcc_named_arg)
name->type |= VT_NAMED;
add_pcc_arg(imcc, cur_call, name);
add_pcc_arg(imcc, cur_call, value);
}
/*
=item C<static void add_pcc_named_arg_var(imc_info_t *imcc, SymReg *cur_call,
SymReg *name, SymReg *value)>
=cut
*/
static void
add_pcc_named_arg_var(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call),
ARGMOD(SymReg *name), ARGMOD(SymReg *value))
{
ASSERT_ARGS(add_pcc_named_arg_var)
name->type |= VT_NAMED;
add_pcc_arg(imcc, cur_call, name);
add_pcc_arg(imcc, cur_call, value);
}
/*
=item C<static void add_pcc_named_result(imc_info_t *imcc, SymReg *cur_call,
SymReg *name, SymReg *value)>
=cut
*/
static void
add_pcc_named_result(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call),
ARGMOD(SymReg *name), ARGMOD(SymReg *value))
{
ASSERT_ARGS(add_pcc_named_result)
name->type |= VT_NAMED;
add_pcc_result(imcc, cur_call, name);
add_pcc_result(imcc, cur_call, value);
}
/*
=item C<static void add_pcc_named_param(imc_info_t *imcc, SymReg *cur_call,
SymReg *name, SymReg *value)>
=cut
*/
static void
add_pcc_named_param(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call),
ARGMOD(SymReg *name), ARGMOD(SymReg *value))
{
ASSERT_ARGS(add_pcc_named_param)
name->type |= VT_NAMED;
add_pcc_arg(imcc, cur_call, name);
add_pcc_arg(imcc, cur_call, value);
}
/*
=item C<static void add_pcc_named_return(imc_info_t *imcc, SymReg *cur_call,
SymReg *name, SymReg *value)>
=cut
*/
static void
add_pcc_named_return(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call),
ARGMOD(SymReg *name), ARGMOD(SymReg *value))
{
ASSERT_ARGS(add_pcc_named_return)
name->type |= VT_NAMED;
add_pcc_result(imcc, cur_call, name);
add_pcc_result(imcc, cur_call, value);
}
/*
=item C<static void adv_named_set(imc_info_t *imcc, const char *name)>
=item C<static void adv_named_set_u(imc_info_t *imcc, const char *name)>
Sets the name of the current named argument.
C<adv_named_set_u> is the Unicode version of this function.
=cut
*/
static void
adv_named_set(ARGMOD(imc_info_t *imcc), ARGIN(const char *name))
{
ASSERT_ARGS(adv_named_set)
if (imcc->adv_named_id)
IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
"Named parameter with more than one name.\n");
imcc->adv_named_id = mk_const(imcc, name, 'S');
}
static void
adv_named_set_u(ARGMOD(imc_info_t *imcc), ARGIN(const char *name))
{
ASSERT_ARGS(adv_named_set_u)
if (imcc->adv_named_id)
IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
"Named parameter with more than one name.\n");
imcc->adv_named_id = mk_const(imcc, name, 'U');
}
/*
=item C<static void do_loadlib(imc_info_t *imcc, const char *lib)>
=cut
*/
static void
do_loadlib(ARGMOD(imc_info_t *imcc), ARGIN(const char *lib))
{
ASSERT_ARGS(do_loadlib)
STRING * const s = Parrot_str_unescape(imcc->interp, lib + 1, '"', NULL);
PMC * const lib_pmc = Parrot_dyn_load_lib(imcc->interp, s, NULL);
if (PMC_IS_NULL(lib_pmc) || !VTABLE_get_bool(imcc->interp, lib_pmc)) {
IMCC_fataly(imcc, EXCEPTION_LIBRARY_ERROR,
"loadlib directive could not find library `%S'", s);
}
/* store non-dynoplib library deps here, dynoplibs are treated separately for now */
/* TODO: This is very ugly and heavily nested. Can we avoid this? */
if (!STRING_equal(imcc->interp,
VTABLE_get_string(imcc->interp,
Parrot_pmc_getprop(imcc->interp, lib_pmc,
Parrot_str_new_constant(imcc->interp, "_type"))),
Parrot_str_new_constant(imcc->interp, "Ops")))
imcc_pbc_add_libdep(imcc, s);
}
/* HEADERIZER STOP */
%}
%union {
IdList * idlist;
int t;
char * s;
SymReg * sr;
Instruction *i;
}
/* We need precedence for a few tokens to resolve a couple of conflicts */
%nonassoc LOW_PREC
%nonassoc '\n'
%nonassoc <t> PARAM
%token <t> SOL HLL
%token <t> GOTO ARG IF UNLESS PNULL SET_RETURN SET_YIELD
%token <t> ADV_FLAT ADV_SLURPY ADV_OPTIONAL ADV_OPT_FLAG ADV_NAMED ADV_ARROW
%token <t> ADV_INVOCANT ADV_CALL_SIG
%token <t> NAMESPACE DOT_METHOD
%token <t> SUB SYM LOCAL LEXICAL CONST ANNOTATE
%token <t> GLOBAL_CONST
%token <t> PLUS_ASSIGN MINUS_ASSIGN MUL_ASSIGN DIV_ASSIGN CONCAT_ASSIGN
%token <t> BAND_ASSIGN BOR_ASSIGN BXOR_ASSIGN FDIV FDIV_ASSIGN MOD_ASSIGN
%token <t> SHR_ASSIGN SHL_ASSIGN SHR_U_ASSIGN
%token <t> SHIFT_LEFT SHIFT_RIGHT INTV FLOATV STRINGV PMCV LOG_XOR
%token <t> RELOP_EQ RELOP_NE RELOP_GT RELOP_GTE RELOP_LT RELOP_LTE
%token <t> RESULT RETURN TAILCALL YIELDT GET_RESULTS
%token <t> POW SHIFT_RIGHT_U LOG_AND LOG_OR
%token <t> COMMA ESUB DOTDOT
%token <t> PCC_BEGIN PCC_END PCC_CALL PCC_SUB PCC_BEGIN_RETURN PCC_END_RETURN
%token <t> PCC_BEGIN_YIELD PCC_END_YIELD INVOCANT
%token <t> MAIN LOAD INIT IMMEDIATE POSTCOMP METHOD ANON OUTER NEED_LEX
%token <t> MULTI SUBTAG VTABLE_METHOD LOADLIB SUB_INSTANCE_OF SUBID
%token <t> NS_ENTRY
%token <s> LABEL
%token <t> EMIT EOM
%token <s> IREG NREG SREG PREG IDENTIFIER REG MACRO ENDM
%token <s> STRINGC INTC FLOATC USTRINGC
%token <s> PARROT_OP
%type <t> type hll_def return_or_yield comma_or_goto
%type <i> program
%type <i> class_namespace
%type <i> constdef sub emit pcc_ret pcc_yield
%type <i> compilation_units compilation_unit pmc_const pragma
%type <s> relop any_string assign_op bin_op un_op
%type <i> labels _labels label statement sub_call
%type <i> pcc_sub_call
%type <sr> sub_param pcc_arg pcc_result pcc_args pcc_results sub_param_type_def
%type <sr> pcc_returns pcc_yields pcc_return pcc_call arg arglist the_sub multi_type
%type <sr> subtags
%type <t> argtype_list argtype paramtype_list paramtype
%type <t> pcc_return_many
%type <t> proto sub_proto sub_proto_list multi subtag multi_types outer
%type <t> vtable instanceof subid
%type <t> method ns_entry_name
%type <i> instruction assignment conditional_statement labeled_inst opt_label op_assign
%type <i> if_statement unless_statement
%type <i> func_assign get_results
%type <i> opt_invocant
%type <i> annotate_directive
%type <sr> target targetlist reg const stringc var result pcc_set_yield
%type <sr> keylist keylist_force _keylist key maybe_ns nslist _nslist
%type <sr> vars _vars var_or_i _var_or_i label_op sub_label_op sub_label_op_c
%type <i> pasmcode pasmline pasm_inst
%type <sr> pasm_args
%type <i> var_returns
%token <sr> VAR
%token <t> LINECOMMENT
%token <s> FILECOMMENT
%type <idlist> id_list id_list_id
%nonassoc CONCAT DOT
/* %locations */
%pure_parser
%parse-param {void *yyscanner}
%lex-param {void *yyscanner}
%parse-param {imc_info_t *imcc}
%lex-param {imc_info_t *imcc}
%start program
/* In effort to make the grammar readable but not militaristic, please space indent
code blocks on 10 col boundaries and keep indentation same for all code blocks
in a rule. Indent rule tokens | and ; to 4th col and sub rules 6th col
*/
%%
program:
compilation_units { if (yynerrs) YYABORT; $$ = 0; }
;
compilation_units:
compilation_unit
| compilation_units compilation_unit
;
compilation_unit:
class_namespace { $$ = $1; }
| constdef { $$ = $1; }
| sub
{
$$ = $1;
imc_close_unit(imcc, imcc->cur_unit);
imcc->cur_unit = 0;
}
| emit
{
$$ = $1;
imc_close_unit(imcc, imcc->cur_unit);
imcc->cur_unit = 0;
}
| MACRO '\n' { $$ = 0; }
| pragma { $$ = 0; }
| '\n' { $$ = 0; }
;
pragma:
hll_def '\n' { $$ = 0; }
| LOADLIB STRINGC '\n'
{
$$ = 0;
do_loadlib(imcc, $2);
mem_sys_free($2);
}
;
annotate_directive:
ANNOTATE STRINGC COMMA const
{
/* We'll want to store an entry while emitting instructions, so just
* store annotation like it's an instruction. */
SymReg * const key = mk_const(imcc, $2, 'S');
$$ = MK_I(imcc, imcc->cur_unit, ".annotate", 2, key, $4);
mem_sys_free($2);
}
;
hll_def:
HLL STRINGC
{
STRING * const hll_name = Parrot_str_unescape(imcc->interp, $2 + 1, '"', NULL);
Parrot_pcc_set_HLL(imcc->interp, CURRENT_CONTEXT(imcc->interp),
Parrot_hll_register_HLL(imcc->interp, hll_name));
imcc->cur_namespace = NULL;
mem_sys_free($2);
$$ = 0;
}
;
constdef:
CONST { imcc->is_def = 1; } type IDENTIFIER '=' const
{
mk_const_ident(imcc, $4, $3, $6, 1);
mem_sys_free($4);
imcc->is_def = 0;
}
;
pmc_const:
CONST { imcc->is_def = 1; } STRINGC var_or_i '=' any_string
{
$$ = mk_pmc_const_named(imcc, imcc->cur_unit, $3, $4, $6);
mem_sys_free($3);
mem_sys_free($6);
imcc->is_def = 0;
}
;
any_string:
STRINGC
| USTRINGC
;
pasmcode:
pasmline
| pasmcode pasmline
;
pasmline:
labels pasm_inst '\n' { $$ = 0; }
| MACRO '\n' { $$ = 0; }
| FILECOMMENT { $$ = 0; }
| LINECOMMENT { $$ = 0; }
| class_namespace { $$ = $1; }
| pmc_const
| pragma
;
pasm_inst: { clear_state(imcc); }
PARROT_OP pasm_args
{
$$ = INS(imcc, imcc->cur_unit, $2, 0, imcc->regs,
imcc->nargs, imcc -> keyvec, 1);
mem_sys_free($2);
}
| PCC_SUB
{
imc_close_unit(imcc, imcc->cur_unit);
imcc->cur_unit = imc_open_unit(imcc, IMC_PASM);
}
sub_proto LABEL
{
$$ = iSUBROUTINE(imcc, imcc->cur_unit, mk_sub_label(imcc, $4));
imcc->cur_call->pcc_sub->pragma = $3;
mem_sys_free($4);
}
| PNULL var
{
$$ = MK_I(imcc, imcc->cur_unit, "null", 1, $2);
}
| LEXICAL STRINGC COMMA REG
{
char *name = mem_sys_strdup($2 + 1);
SymReg *r = mk_pasm_reg(imcc, $4);
SymReg *n;
name[strlen(name) - 1] = 0;
n = mk_const(imcc, name, 'S');
set_lexical(imcc, r, n);
$$ = 0;
mem_sys_free(name);
mem_sys_free($2);
mem_sys_free($4);
}
| /* none */ { $$ = 0;}
;
pasm_args:
vars
;
emit: /* EMIT and EOM tokens are used when compiling a .pasm file. */
EMIT { imcc->cur_unit = imc_open_unit(imcc, IMC_PASM); }
opt_pasmcode
EOM
{
/* if (optimizer_level & OPT_PASM)
imc_compile_unit(interp, imcc->cur_unit);
emit_flush(interp);
*/
$$ = 0;
}
;
opt_pasmcode:
/* empty */
| pasmcode
;
class_namespace:
NAMESPACE maybe_ns '\n'
{
int re_open = 0;
$$ = 0;
if (imcc->state->pasm_file && imcc->cur_namespace) {
imc_close_unit(imcc, imcc->cur_unit);
re_open = 1;
}
imcc->cur_namespace = $2;
if (re_open)
imcc->cur_unit = imc_open_unit(imcc, IMC_PASM);
}
;
maybe_ns:
'[' nslist ']' { $$ = $2; }
| '[' ']' { $$ = NULL; }
;
nslist:
{
imcc->nkeys = 0;
}
_nslist
{
$$ = link_keys(imcc, imcc->nkeys, imcc->keys, 0);
}
;
_nslist:
stringc { imcc->keys[imcc->nkeys++] = $1; }
| _nslist ';' stringc
{
imcc->keys[imcc->nkeys++] = $3;
$$ = imcc->keys[0];
}
;
sub:
SUB
{
imcc->cur_unit = imc_open_unit(imcc, IMC_PCCSUB);
}
sub_label_op_c
{
iSUBROUTINE(imcc, imcc->cur_unit, $3);
}
sub_proto '\n'
{
imcc->cur_call->pcc_sub->pragma = $5;
if (!imcc->cur_unit->instructions->symregs[0]->subid) {
imcc->cur_unit->instructions->symregs[0]->subid =
imcc->cur_unit->instructions->symregs[0];
}
}
sub_body ESUB { $$ = 0; imcc->cur_call = NULL; }
;
sub_param:
PARAM
{ imcc->is_def = 1; }
sub_param_type_def '\n'
{
if (/* IMCC_INFO(interp)->cur_unit->last_ins->op
|| */ !(imcc->cur_unit->last_ins->type & ITPCCPARAM)) {
SymReg *r;
Instruction *i;
char name[128];
snprintf(name, sizeof (name), "%cpcc_params_%d",
IMCC_INTERNAL_CHAR, imcc->cnr++);
r = mk_symreg(imcc, name, 0);
r->type = VT_PCC_SUB;
r->pcc_sub = mem_gc_allocate_zeroed_typed(imcc->interp, pcc_sub_t);
i = iLABEL(imcc, imcc->cur_unit, r);
imcc->cur_call = r;
i->type = ITPCCPARAM;
}
if (imcc->adv_named_id) {
add_pcc_named_param(imcc, imcc->cur_call,
imcc->adv_named_id, $3);
imcc->adv_named_id = NULL;
}
else
add_pcc_arg(imcc, imcc->cur_call, $3);
}
{ imcc->is_def = 0; }
;
sub_param_type_def:
type IDENTIFIER paramtype_list
{
if ($3 & VT_OPT_FLAG && $1 != 'I') {
const char *type;
switch ($1) {
case 'N': type = "num"; break;
case 'S': type = "string"; break;
case 'P': type = "pmc"; break;
default: type = "strange"; break;
}
IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
":opt_flag parameter must be of type 'int', not '%s'", type);
}
if ($3 & VT_NAMED && !($3 & VT_FLAT) && !imcc->adv_named_id)
adv_named_set(imcc, $2);
$$ = mk_ident(imcc, $2, $1, VTIDENTIFIER);
$$->type |= $3;
mem_sys_free($2);
}
;
multi:
MULTI '(' multi_types ')' { $$ = 0; }
;
multi_types:
/* empty */
{
add_pcc_multi(imcc, imcc->cur_call, NULL);
}
| multi_types COMMA multi_type
{
$$ = 0;
add_pcc_multi(imcc, imcc->cur_call, $3);
}
| multi_type
{
$$ = 0;
add_pcc_multi(imcc, imcc->cur_call, $1);
}
;
multi_type:
INTV { $$ = mk_const(imcc, "INTVAL", 'S'); }
| FLOATV { $$ = mk_const(imcc, "FLOATVAL", 'S'); }
| PMCV { $$ = mk_const(imcc, "PMC", 'S'); }
| STRINGV { $$ = mk_const(imcc, "STRING", 'S'); }
| IDENTIFIER
{
SymReg *r;
if (strcmp($1, "_") != 0)
r = mk_const(imcc, $1, 'S');
else {
r = mk_const(imcc, "PMC", 'S');
}
mem_sys_free($1);
$$ = r;
}
| STRINGC
{
SymReg *r;
if (strcmp($1, "\"_\"") == 0 || strcmp($1, "'_'") == 0)
r = mk_const(imcc, "PMC", 'S');
else {
r = mk_const(imcc, $1, 'S');
}
mem_sys_free($1);
$$ = r;
}
| '[' keylist ']' { $$ = $2; }
;
subtag:
SUBTAG '(' subtags ')' { $$ = 0; }
;
subtags:
subtags COMMA STRINGC
{
SymReg * const r = mk_const(imcc, $3, 'S');
add_pcc_flag_str(imcc, imcc->cur_call, r);
mem_sys_free($3);
$$ = r;
}
| STRINGC
{
SymReg * const r = mk_const(imcc, $1, 'S');
add_pcc_flag_str(imcc, imcc->cur_call, r);
mem_sys_free($1);
$$ = r;
}
;
outer:
OUTER '(' STRINGC ')'
{
$$ = 0;
imcc->cur_unit->outer = mk_sub_address_fromc(imcc, $3);
mem_sys_free($3);
}
| OUTER '(' IDENTIFIER ')'
{
$$ = 0;
imcc->cur_unit->outer = mk_const(imcc, $3, 'S');
mem_sys_free($3);
}
;
vtable:
VTABLE_METHOD
{
$$ = P_VTABLE;
imcc->cur_unit->vtable_name = NULL;
imcc->cur_unit->is_vtable_method = 1;
}
| VTABLE_METHOD '(' STRINGC ')'
{
$$ = P_VTABLE;
imcc->cur_unit->vtable_name = $3;
imcc->cur_unit->is_vtable_method = 1;
}
;
method:
METHOD
{
$$ = P_METHOD;
imcc->cur_unit->method_name = NULL;
imcc->cur_unit->is_method = 1;
}
| METHOD '(' any_string ')'
{
$$ = P_METHOD;
imcc->cur_unit->method_name = $3;
imcc->cur_unit->is_method = 1;
}
;
ns_entry_name:
NS_ENTRY
{
$$ = P_NSENTRY;
imcc->cur_unit->ns_entry_name = NULL;
imcc->cur_unit->has_ns_entry_name = 1;
}
| NS_ENTRY '(' any_string ')'
{
$$ = P_NSENTRY;
imcc->cur_unit->ns_entry_name = $3;
imcc->cur_unit->has_ns_entry_name = 1;
}
;
instanceof:
SUB_INSTANCE_OF '(' STRINGC ')'
{
$$ = 0;
imcc->cur_unit->instance_of = $3;
}
;
subid:
SUBID
{
$$ = 0;
imcc->cur_unit->subid = NULL;
}
| SUBID '(' any_string ')'
{
SymReg *r = mk_const(imcc, $3, 'S');
$$ = 0;
imcc->cur_unit->subid = r;
imcc->cur_unit->instructions->symregs[0]->subid = r;
mem_sys_free($3);
}
;
sub_body:
/* empty */
| statements
;
pcc_sub_call:
PCC_BEGIN '\n'
{
char name[128];
SymReg *r;
Instruction *i;
snprintf(name, sizeof (name), "%cpcc_sub_call_%d",
IMCC_INTERNAL_CHAR, imcc->cnr++);
$<sr>$ = r = mk_pcc_sub(imcc, name, 0);
/* this mid rule action has the semantic value of the
* sub SymReg.
* This is used below to append args & results
*/
i = iLABEL(imcc, imcc->cur_unit, r);
imcc->cur_call = r;
i->type = ITPCCSUB;
}
pcc_args
opt_invocant
pcc_call
opt_label
pcc_results
PCC_END { $$ = 0; imcc->cur_call = NULL; }
;
opt_label:
/* empty */ { $$ = NULL; imcc->cur_call->pcc_sub->label = 0; }
| label '\n' { $$ = NULL; imcc->cur_call->pcc_sub->label = 1; }
;
opt_invocant:
/* empty */ { $$ = NULL; }
| INVOCANT var '\n' { $$ = NULL; imcc->cur_call->pcc_sub->object = $2; }
;
sub_proto:
/* empty */ { $$ = 0; }
| sub_proto_list
;
sub_proto_list:
proto { $$ = $1; }
| sub_proto_list proto { $$ = $1 | $2; }
;
proto:
LOAD {
$$ = P_LOAD;
/*
SymReg * const r = mk_const(imcc, "load", 'S');
add_pcc_flag_str(imcc, imcc->cur_call, r);
$$ = r;
*/
}
| INIT {
$$ = P_INIT;
/*
SymReg * const r = mk_const(imcc, "load", 'S');
add_pcc_flag_str(imcc, imcc->cur_call, r);
$$ = r;
*/
}
| MAIN { $$ = P_MAIN; }
| IMMEDIATE { $$ = P_IMMEDIATE; }
| POSTCOMP { $$ = P_POSTCOMP; }
| ANON { $$ = P_ANON; }
| NEED_LEX { $$ = P_NEED_LEX; }
| multi
| subtag
| outer
| vtable
| method
| ns_entry_name
| instanceof
| subid
;
pcc_call:
PCC_CALL var COMMA var '\n'
{
add_pcc_sub(imcc->cur_call, $2);
add_pcc_cc(imcc->cur_call, $4);
}
| PCC_CALL var '\n'
{
add_pcc_sub(imcc->cur_call, $2);
}
pcc_args:
/* empty */ { $$ = 0; }
| pcc_args pcc_arg '\n'
{
if (imcc->adv_named_id) {
add_pcc_named_param(imcc, imcc->cur_call,
imcc->adv_named_id, $2);
imcc->adv_named_id = NULL;
}
else
add_pcc_arg(imcc, imcc->cur_call, $2);
}
;
pcc_arg:
ARG arg { $$ = $2; }
;
pcc_results:
/* empty */ { $$ = 0; }
| pcc_results pcc_result '\n'
{
if ($2)
add_pcc_result(imcc, imcc->cur_call, $2);
}
;
pcc_result:
RESULT target paramtype_list { $$ = $2; $$->type |= $3; }
| LOCAL { imcc->is_def = 1; } type id_list_id
{
IdList * const l = $4;
SymReg *ignored;
ignored = mk_ident(imcc, l->id, $3, VTIDENTIFIER);
UNUSED(ignored);
imcc->is_def = 0;
$$ = 0;
}
;
paramtype_list:
/* empty */ { $$ = 0; }
| paramtype_list paramtype { $$ = $1 | $2; }
;
paramtype:
ADV_SLURPY { $$ = VT_FLAT; }
| ADV_OPTIONAL { $$ = VT_OPTIONAL; }
| ADV_OPT_FLAG { $$ = VT_OPT_FLAG; }
| ADV_NAMED { $$ = VT_NAMED; }
| ADV_NAMED '(' STRINGC ')' { adv_named_set(imcc, $3); $$ = VT_NAMED; mem_sys_free($3); }
| ADV_NAMED '(' USTRINGC ')' { adv_named_set_u(imcc, $3); $$ = VT_NAMED; mem_sys_free($3); }
| ADV_CALL_SIG { $$ = VT_CALL_SIG; }
;
pcc_ret:
PCC_BEGIN_RETURN '\n' { begin_return_or_yield(imcc, 0); }
pcc_returns
PCC_END_RETURN { $$ = 0; imcc->asm_state = AsmDefault; }
| pcc_return_many
{
imcc->asm_state = AsmDefault;
$$ = 0;
}
;
pcc_yield:
PCC_BEGIN_YIELD '\n' { begin_return_or_yield(imcc, 1); }
pcc_yields
PCC_END_YIELD { $$ = 0; imcc->asm_state = AsmDefault; }
;
pcc_returns:
/* empty */ { $$ = 0; }
| pcc_returns '\n'
{
if ($1)
add_pcc_result(imcc, imcc->sr_return, $1);
}
| pcc_returns pcc_return '\n'
{
if ($2)
add_pcc_result(imcc, imcc->sr_return, $2);
}
;
pcc_yields:
/* empty */ { $$ = 0; }
| pcc_yields '\n'
{
if ($1)
add_pcc_result(imcc, imcc->sr_return, $1);
}
| pcc_yields pcc_set_yield '\n'
{
if ($2)
add_pcc_result(imcc, imcc->sr_return, $2);
}
;
pcc_return:
SET_RETURN var argtype_list { $$ = $2; $$->type |= $3; }
;
pcc_set_yield:
SET_YIELD var argtype_list { $$ = $2; $$->type |= $3; }
;
pcc_return_many:
return_or_yield '('
{
if (imcc->asm_state == AsmDefault)
begin_return_or_yield(imcc, $1);
}
var_returns ')'
{
imcc->asm_state = AsmDefault;
$$ = 0;
}
;
return_or_yield:
RETURN { $$ = 0; }
| YIELDT { $$ = 1; }
;
var_returns:
/* empty */ { $$ = 0; }
| arg
{
if (imcc->adv_named_id) {
add_pcc_named_return(imcc, imcc->sr_return,
imcc->adv_named_id, $1);
imcc->adv_named_id = NULL;
}
else
add_pcc_result(imcc, imcc->sr_return, $1);
}
| STRINGC ADV_ARROW var
{
SymReg * const name = mk_const(imcc, $1, 'S');
add_pcc_named_return(imcc, imcc->sr_return, name, $3);
}
| var_returns COMMA arg
{
if (imcc->adv_named_id) {
add_pcc_named_return(imcc, imcc->sr_return,
imcc->adv_named_id, $3);
imcc->adv_named_id = NULL;
}
else
add_pcc_result(imcc, imcc->sr_return, $3);
}
| var_returns COMMA STRINGC ADV_ARROW var
{
SymReg * const name = mk_const(imcc, $3, 'S');
add_pcc_named_return(imcc, imcc->sr_return, name, $5);
}
;
statements:
statement
| statements statement
;
/* This is ugly. Because 'instruction' can start with PARAM and in the
* 'pcc_sub' rule, 'pcc_params' is followed by 'statement', we get a
* shift/reduce conflict on PARAM between reducing to the dummy
* { clear_state(); } rule and shifting the PARAM to be used as part
* of the 'pcc_params' (which is what we want). However, yacc syntax
* doesn't propagate precedence to the dummy rules, so we have to
* split out the action just so that we can assign it a precedence. */
helper_clear_state:
{ clear_state(imcc); } %prec LOW_PREC
;
statement:
sub_param { $$ = 0; }
| helper_clear_state
instruction { $$ = $2; }
| MACRO '\n' { $$ = 0; }
| FILECOMMENT { $$ = 0; }
| LINECOMMENT { $$ = 0; }
| annotate_directive { $$ = $1; }
;
labels:
/* none */ { $$ = NULL; }
| _labels
;
_labels:
_labels label
| label
;
label:
LABEL
{
Instruction * const i = iLABEL(imcc, imcc->cur_unit,
mk_local_label(imcc, $1));
mem_sys_free($1);
$$ = i;
}
;
instruction:
labels labeled_inst '\n' { $$ = $2; }
| error '\n'
{
if (yynerrs >= PARROT_MAX_RECOVER_ERRORS) {
IMCC_warning(imcc, "Too many errors. Correct some first.\n");
YYABORT;
}
yyerrok;
}
;
id_list :
id_list_id
{
IdList* const l = $1;
l->next = NULL;
$$ = l;
}
| id_list COMMA id_list_id
{
IdList* const l = $3;
l->next = $1;
$$ = l;
}
;
id_list_id :
IDENTIFIER
{
IdList* const l = mem_gc_allocate_n_zeroed_typed(imcc->interp, 1, IdList);
l->id = $1;
$$ = l;
}
;
labeled_inst:
assignment
| conditional_statement
| LOCAL { imcc->is_def = 1; } type id_list
{
IdList *l = $4;
while (l) {
IdList *l1;
mk_ident(imcc, l->id, $3, VTIDENTIFIER);
l1 = l;
l = l->next;
mem_sys_free(l1->id);
mem_sys_free(l1);
}
imcc->is_def = 0; $$ = 0;
}
| LEXICAL STRINGC COMMA target
{
SymReg *n;
char *name = mem_sys_strdup($2 + 1);
name[strlen(name) - 1] = 0;
n = mk_const(imcc, name, 'S');
set_lexical(imcc, $4, n); $$ = 0;
mem_sys_free($2);
mem_sys_free(name);
}
| LEXICAL USTRINGC COMMA target
{
SymReg *n = mk_const(imcc, $2, 'U');
set_lexical(imcc, $4, n); $$ = 0;
mem_sys_free($2);
}
| CONST { imcc->is_def = 1; } type IDENTIFIER '=' const
{
mk_const_ident(imcc, $4, $3, $6, 0);
imcc->is_def = 0;
mem_sys_free($4);
}
| pmc_const
| GLOBAL_CONST { imcc->is_def = 1; } type IDENTIFIER '=' const
{
mk_const_ident(imcc, $4, $3, $6, 1);
imcc->is_def = 0;
mem_sys_free($4);
}
| TAILCALL sub_call
{
$$ = NULL;
imcc->cur_call->pcc_sub->tailcall = 1;
imcc->cur_call = NULL;
}
| GOTO label_op
{
$$ = MK_I(imcc, imcc->cur_unit, "branch", 1, $2);
}
| PARROT_OP vars
{
$$ = INS(imcc, imcc->cur_unit, $1, 0, imcc->regs, imcc->nargs,
imcc->keyvec, 1);
mem_sys_free($1);
}
| PNULL var { $$ = MK_I(imcc, imcc->cur_unit, "null", 1, $2); }
| sub_call { $$ = 0; imcc->cur_call = NULL; }
| pcc_sub_call { $$ = 0; }
| pcc_ret
| pcc_yield
| /* none */ { $$ = 0;}
;
type:
INTV {$$ = 'I'; }
| FLOATV { $$ = 'N'; }
| STRINGV { $$ = 'S'; }
| PMCV { $$ = 'P'; }
;
assignment:
target '=' var
{ $$ = MK_I(imcc, imcc->cur_unit, "set", 2, $1, $3); }
| target '=' un_op var
{ $$ = MK_I(imcc, imcc->cur_unit, $3, 2, $1, $4); }
| target '=' var bin_op var
{ $$ = MK_I(imcc, imcc->cur_unit, $4, 3, $1, $3, $5); }
| target '=' var '[' keylist ']'
{ $$ = iINDEXFETCH(imcc, imcc->cur_unit, $1, $3, $5); }
| target '[' keylist ']' '=' var
{ $$ = iINDEXSET(imcc, imcc->cur_unit, $1, $3, $6); }
/* Subroutine call the short way */
| target '=' sub_call
{
add_pcc_result(imcc, $3->symregs[0], $1);
imcc->cur_call = NULL;
$$ = 0;
}
| '('
{
$<i>$ = IMCC_create_itcall_label(imcc);
}
targetlist ')' '=' the_sub '(' arglist ')'
{
IMCC_itcall_sub(imcc, $6);
imcc->cur_call = NULL;
}
| get_results
| op_assign
| func_assign
| target '=' PNULL
{
$$ = MK_I(imcc, imcc->cur_unit, "null", 1, $1);
}
;
/* C++ hates implicit casts from string constants to char *, so be explicit */
un_op:
'!' { $$ = (char *)"not"; }
| '~' { $$ = (char *)"bnot"; }
| '-' { $$ = (char *)"neg"; }
;
bin_op:
'-' { $$ = (char *)"sub"; }
| '+' { $$ = (char *)"add"; }
| '*' { $$ = (char *)"mul"; }
| '/' { $$ = (char *)"div"; }
| '%' { $$ = (char *)"mod"; }
| FDIV { $$ = (char *)"fdiv"; }
| POW { $$ = (char *)"pow"; }
| CONCAT { $$ = (char *)"concat"; }
| RELOP_EQ { $$ = (char *)"iseq"; }
| RELOP_NE { $$ = (char *)"isne"; }
| RELOP_GT { $$ = (char *)"isgt"; }
| RELOP_GTE { $$ = (char *)"isge"; }
| RELOP_LT { $$ = (char *)"islt"; }
| RELOP_LTE { $$ = (char *)"isle"; }
| SHIFT_LEFT { $$ = (char *)"shl"; }
| SHIFT_RIGHT { $$ = (char *)"shr"; }
| SHIFT_RIGHT_U { $$ = (char *)"lsr"; }
| LOG_AND { $$ = (char *)"and"; }
| LOG_OR { $$ = (char *)"or"; }
| LOG_XOR { $$ = (char *)"xor"; }
| '&' { $$ = (char *)"band"; }
| '|' { $$ = (char *)"bor"; }
| '~' { $$ = (char *)"bxor"; }
;
get_results:
GET_RESULTS
{
$<i>$ = IMCC_create_itcall_label(imcc);
$<i>$->type &= ~ITCALL;
$<i>$->type |= ITRESULT;
}
'(' targetlist ')' { $$ = 0; }
;
op_assign:
target assign_op var
{ $$ = MK_I(imcc, imcc->cur_unit, $2, 2, $1, $3); }
| target CONCAT_ASSIGN var
{
if ($1->set == 'P')
$$ = MK_I(imcc, imcc->cur_unit, "concat", 2, $1, $3);
else
$$ = MK_I(imcc, imcc->cur_unit, "concat", 3, $1, $1, $3);
}
;
assign_op:
PLUS_ASSIGN { $$ = (char *)"add"; }
| MINUS_ASSIGN { $$ = (char *)"sub"; }
| MUL_ASSIGN { $$ = (char *)"mul"; }
| DIV_ASSIGN { $$ = (char *)"div"; }
| MOD_ASSIGN { $$ = (char *)"mod"; }
| FDIV_ASSIGN { $$ = (char *)"fdiv"; }
| BAND_ASSIGN { $$ = (char *)"band"; }
| BOR_ASSIGN { $$ = (char *)"bor"; }
| BXOR_ASSIGN { $$ = (char *)"bxor"; }
| SHR_ASSIGN { $$ = (char *)"shr"; }
| SHL_ASSIGN { $$ = (char *)"shl"; }
| SHR_U_ASSIGN { $$ = (char *)"lsr"; }
;
func_assign:
target '=' PARROT_OP pasm_args
{
$$ = func_ins(imcc, imcc->cur_unit, $1, $3, imcc -> regs,
imcc -> nargs, imcc -> keyvec, 1);
mem_sys_free($3);
}
;
the_sub:
IDENTIFIER { $$ = mk_sub_address(imcc, $1); mem_sys_free($1); }
| STRINGC { $$ = mk_sub_address_fromc(imcc, $1); mem_sys_free($1); }
| USTRINGC { $$ = mk_sub_address_u(imcc, $1); mem_sys_free($1); }
| target
{
$$ = $1;
if ($1->set != 'P')
IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Sub isn't a PMC");
}
| target DOT sub_label_op
{
/* disallow bareword method names; SREG name constants are fine */
const char * const name = $3->name;
if (!($3->type & VTREG)) {
if (*name != '\'' || *name != '\"')
IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
"Bareword method name '%s' not allowed in PIR",
$3->name);
}
imcc->cur_obj = $1;
$$ = $3;
}
| target DOT USTRINGC
{
imcc->cur_obj = $1;
$$ = mk_const(imcc, $3, 'U');
mem_sys_free($3);
}
| target DOT STRINGC
{
imcc->cur_obj = $1;
$$ = mk_const(imcc, $3, 'S');
mem_sys_free($3);
}
| target DOT target
{
imcc->cur_obj = $1;
$$ = $3;
}
;
sub_call:
the_sub
{
$<i>$ = IMCC_create_itcall_label(imcc);
IMCC_itcall_sub(imcc, $1);
}
'(' arglist ')' { $$ = $<i>2; }
;
arglist:
/* empty */ { $$ = 0; }
| arglist COMMA arg
{
$$ = 0;
if (imcc->adv_named_id) {
add_pcc_named_arg(imcc, imcc->cur_call, imcc->adv_named_id, $3);
imcc->adv_named_id = NULL;
}
else
add_pcc_arg(imcc, imcc->cur_call, $3);
}
| arg
{
$$ = 0;
if (imcc->adv_named_id) {
add_pcc_named_arg(imcc, imcc->cur_call, imcc->adv_named_id, $1);
imcc->adv_named_id = NULL;
}
else
add_pcc_arg(imcc, imcc->cur_call, $1);
}
| arglist COMMA STRINGC ADV_ARROW var
{
$$ = 0;
add_pcc_named_arg(imcc, imcc->cur_call, mk_const(imcc, $3, 'S'), $5);
mem_sys_free($3);
}
| var ADV_ARROW var
{
$$ = 0;
add_pcc_named_arg_var(imcc, imcc->cur_call, $1, $3);
}
| STRINGC ADV_ARROW var
{
$$ = 0;
add_pcc_named_arg(imcc, imcc->cur_call,
mk_const(imcc, $1, 'S'), $3);
mem_sys_free($1);
}
;
arg:
var argtype_list { $$ = $1; $$->type |= $2; }
;
argtype_list:
/* empty */ { $$ = 0; }
| argtype_list argtype { $$ = $1 | $2; }
;
argtype:
ADV_FLAT { $$ = VT_FLAT; }
| ADV_NAMED { $$ = VT_NAMED; }
| ADV_CALL_SIG { $$ = VT_CALL_SIG; }
| ADV_NAMED '(' USTRINGC ')'
{
adv_named_set_u(imcc, $3);
mem_sys_free($3);
$$ = 0;
}
| ADV_NAMED '(' STRINGC ')'
{
adv_named_set(imcc, $3);
mem_sys_free($3);
$$ = 0;
}
;
result:
target paramtype_list { $$ = $1; $$->type |= $2; }
;
targetlist:
targetlist COMMA result
{
$$ = 0;
if (imcc->adv_named_id) {
add_pcc_named_result(imcc, imcc->cur_call, imcc->adv_named_id, $3);
imcc->adv_named_id = NULL;
}
else
add_pcc_result(imcc, imcc->cur_call, $3);
}
| targetlist COMMA STRINGC ADV_ARROW target
{
add_pcc_named_result(imcc, imcc->cur_call,
mk_const(imcc, $3, 'S'), $5);
mem_sys_free($3);
}
| result
{
$$ = 0;
if (imcc->adv_named_id) {
add_pcc_named_result(imcc, imcc->cur_call, imcc->adv_named_id, $1);
imcc->adv_named_id = NULL;
}
else
add_pcc_result(imcc, imcc->cur_call, $1);
}
| STRINGC ADV_ARROW target
{
add_pcc_named_result(imcc, imcc->cur_call, mk_const(imcc, $1, 'S'), $3);
mem_sys_free($1);
}
| /* empty */ { $$ = 0; }
;
conditional_statement:
if_statement { $$ = $1; }
| unless_statement { $$ = $1; }
;
unless_statement:
UNLESS var relop var GOTO label_op
{
$$ = MK_I(imcc, imcc->cur_unit, inv_op($3), 3, $2, $4, $6);
}
| UNLESS PNULL var GOTO label_op
{
$$ = MK_I(imcc, imcc->cur_unit, "unless_null", 2, $3, $5);
}
| UNLESS var comma_or_goto label_op
{
$$ = MK_I(imcc, imcc->cur_unit, "unless", 2, $2, $4);
}
;
if_statement:
IF var comma_or_goto label_op
{
$$ = MK_I(imcc, imcc->cur_unit, "if", 2, $2, $4);
}
| IF var relop var GOTO label_op
{
$$ = MK_I(imcc, imcc->cur_unit, $3, 3, $2, $4, $6);
}
| IF PNULL var GOTO label_op
{
$$ = MK_I(imcc, imcc->cur_unit, "if_null", 2, $3, $5);
}
;
comma_or_goto:
COMMA { $$ = 0; }
| GOTO { $$ = 0; }
;
relop:
RELOP_EQ { $$ = (char *)"eq"; }
| RELOP_NE { $$ = (char *)"ne"; }
| RELOP_GT { $$ = (char *)"gt"; }
| RELOP_GTE { $$ = (char *)"ge"; }
| RELOP_LT { $$ = (char *)"lt"; }
| RELOP_LTE { $$ = (char *)"le"; }
;
target:
VAR
| reg
;
vars:
/* empty */ { $$ = NULL; }
| _vars { $$ = $1; }
;
_vars:
_vars COMMA _var_or_i { $$ = imcc->regs[0]; }
| _var_or_i
;
_var_or_i:
var_or_i { imcc->regs[imcc->nargs++] = $1; }
| target '[' keylist ']'
{
imcc -> regs[imcc->nargs++] = $1;
imcc -> keyvec |= KEY_BIT(imcc->nargs);
imcc -> regs[imcc->nargs++] = $3;
$$ = $1;
}
| '[' keylist_force ']'
{
imcc -> regs[imcc->nargs++] = $2;
$$ = $2;
}
;
sub_label_op_c:
sub_label_op
| STRINGC { $$ = mk_sub_address_fromc(imcc, $1); mem_sys_free($1); }
| USTRINGC { $$ = mk_sub_address_u(imcc, $1); mem_sys_free($1); }
;
sub_label_op:
IDENTIFIER { $$ = mk_sub_address(imcc, $1); mem_sys_free($1); }
| PARROT_OP { $$ = mk_sub_address(imcc, $1); mem_sys_free($1); }
;
label_op:
IDENTIFIER { $$ = mk_label_address(imcc, $1); mem_sys_free($1); }
| PARROT_OP { $$ = mk_label_address(imcc, $1); mem_sys_free($1); }
;
var_or_i:
label_op
| var
;
var:
target
| const
;
keylist:
{
imcc->nkeys = 0;
}
_keylist
{
$$ = link_keys(imcc, imcc->nkeys, imcc->keys, 0);
}
;
keylist_force:
{
imcc->nkeys = 0;
}
_keylist
{
$$ = link_keys(imcc,
imcc->nkeys,
imcc->keys, 1);
}
;
_keylist:
key { imcc->keys[imcc->nkeys++] = $1; }
| _keylist ';' key
{
imcc->keys[imcc->nkeys++] = $3;
$$ = imcc->keys[0];
}
;
key:
var
{
$$ = $1;
}
;
reg:
IREG { $$ = mk_symreg(imcc, $1, 'I'); }
| NREG { $$ = mk_symreg(imcc, $1, 'N'); }
| SREG { $$ = mk_symreg(imcc, $1, 'S'); }
| PREG { $$ = mk_symreg(imcc, $1, 'P'); }
| REG { $$ = mk_pasm_reg(imcc, $1); mem_sys_free($1); }
;
stringc:
STRINGC { $$ = mk_const(imcc, $1, 'S'); mem_sys_free($1); }
| USTRINGC { $$ = mk_const(imcc, $1, 'U'); mem_sys_free($1); }
;
const:
INTC { $$ = mk_const(imcc, $1, 'I'); mem_sys_free($1); }
| FLOATC { $$ = mk_const(imcc, $1, 'N'); mem_sys_free($1); }
| stringc { $$ = $1; }
;
/* The End */
%%
/* I need this prototype somewhere... */
char *yyget_text(yyscan_t yyscanner);
/* I do not like this function, but, atm, it is the only way I can
* make the code in yyerror work without segfault on some specific
* cases.
*/
/* int yyholds_char(yyscan_t yyscanner); */
int yyerror(void *yyscanner, ARGMOD(imc_info_t *imcc), const char *s)
{
/* If the error occurr in the end of the buffer (I mean, the last
* token was already read), yyget_text will return a pointer
* outside the bison buffer, and thus, not "accessible" by
* us. This means it may segfault. */
const char * const chr = yyget_text((yyscan_t)yyscanner);
/* IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, s); */
/* --- This was called before, not sure if I should call some
similar function that does not die like this one. */
/* Basically, if current token is a newline, it mean the error was
* before the newline, and thus, line is the line *after* the
* error. Instead of duplicating code for both cases (the 'newline' and
* non-newline case, do the test twice; efficiency is not important when
* we have an error anyway. */
if (!at_eof(yyscanner)) {
IMCC_warning(imcc, "error:imcc:%s", s);
/* don't print the current token if it is a newline */
if (*chr != '\n')
IMCC_warning(imcc, " ('%s')", chr);
IMCC_print_inc(imcc);
}
/* scanner is at EOF; just to be sure, don't print "current" token */
else {
IMCC_warning(imcc, "error:imcc:%s", s);
IMCC_print_inc(imcc);
}
return 0;
}
/*
=back
*/
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
*/