/*
* counts the number of characters in UTF-8 strings;
* ASSUMPTION: UTF-8 used as default and (HAVE_ICONV) internal pivot encoding
*/
sz_t (in_cntchar)(const char *p, const char *q, sz_t m, const char **pp)
{
sz_t n = 0;
for (; (!q || p < q) && (m == (sz_t)-1 || n < m); p++) {
if (*p == '\n')
continue;
if (FIRSTUTF8(*p))
n++;
if (p[0] == '?' && p[1] == '?' && (main_opt()->trigraph & 1)) {
switch(p[2]) {
case '(': /* [ */
case ')': /* ] */
case '<': /* { */
case '>': /* } */
case '=': /* # */
case '/': /* \ */
case '\'': /* ^ */
case '!': /* | */
case '-': /* ~ */
p += 2;
break;
}
}
}
while (!FIRSTUTF8(*p) && (!q || p < q))
p++;
if (pp)
*pp = p; /* q or points to char after m chars */
return n;
}
/*
* accepts #error and #warning
*/
static lex_t *derror(const lmap_t *pos, int warn)
{
lex_t *t;
sz_t len, n;
const char *s;
NEXTSP(t); /* consumes error */
if (t->id != LEX_NEWLINE) {
strcpy(snbuf(len=2, 0), " ");
do {
assert(t->id != LEX_EOI);
if (t->id == LEX_SPACE) {
NEXTSP(t); /* consumes space */
if (t->id == LEX_NEWLINE)
break;
strcpy(snbuf(len+1, 1)+len-1, " ");
len++;
}
s = LEX_SPELL(t);
MCR_IDVAARGS(s, t);
n = strlen(s);
strcpy(snbuf(len+n, 1)+len-1, s);
len += n;
} while ((t = lst_nexti())->id != LEX_NEWLINE);
} else
*snbuf(len=1, 0) = '\0';
err_dpos(pos, (warn)? ERR_PP_WARNING:
(main_opt()->stricterr)? ERR_PP_ERRORF: ERR_PP_ERROR, snbuf(len, 0));
if (warn)
err_dpos(pos, ERR_PP_NOSTDDIRECTIVE);
return t;
}
/*
* converts a trigraph warning its first use
*/
int (in_trigraph)(const char *p)
{
int c;
assert(p);
switch(p[2]) {
case '(':
c = '[';
break;
case ')':
c = ']';
break;
case '<':
c = '{';
break;
case '>':
c = '}';
break;
case '=':
c = '#';
break;
case '/':
c = '\\';
break;
case '\'':
c = '^';
break;
case '!':
c = '|';
break;
case '-':
c = '~';
break;
default:
return '?';
}
if (main_opt()->trigraph >= 2)
err_dline(p, 3, (main_opt()->trigraph & 1)?
ERR_INPUT_TRIGRAPH: ERR_INPUT_TRIGRAPHI, p[2], c);
return c;
}
/*
* reads the next line;
* in_limit points to one past the terminating null unless EOF;
* ASSUMPTION: '\n' is no part of multibyte characters and has no effect on the shift state;
* ASSUMPTION: charset in which source is written is same as that in which beluga is running
*/
static void nextline(void)
{
int nul;
char *p;
const char *q;
sz_t len;
assert(fptr);
if (bs > 0)
in_py += bs, bs = 0;
lmap_fline(++in_py, ftell(fptr));
p = (char *)(in_limit = in_line = in_cp = buf);
*p = '\0';
len = 0;
while (1) {
assert(bufn-len > 1);
nul = 0;
q = ngets(p+len, bufn-len, fptr, &nul);
if (ferror(fptr)) {
err_dline(NULL, 1, ERR_INPUT_ERROR);
in_nextline = eof;
break;
}
if (nul)
repnul(p+len, q);
len += (q - (p+len));
if (len == 0) { /* real EOF */
in_nextline = eof;
break;
}
if (len > 1 && (p[len-2] == '\\' ||
(main_opt()->trigraph && len > 3 &&
p[len-4] == '?' && p[len-3] == '?' && p[len-2] == '/')) &&
p[len-1] == '\n') {
if (p[len-2] == '/')
in_trigraph(&p[len-4]); /* for warning */
if (p[len-2] == '\\' || (main_opt()->trigraph & 1)) { /* line splicing */
int n = 1+1;
int c;
lmap_fline(in_py + ++bs, ftell(fptr));
c = getc(fptr);
if (p[len-2] == '/')
len -= 2, n = 3+1;
if (c == EOF) {
err_dline(p+len-2, n, ERR_INPUT_BSNLEOF);
p[len-2] = '\n';
p[--len] = '\0';
bs--; /* for better tracking of locus */
} else {
ungetc(c, fptr);
p[--len-1] = '\n';
continue;
}
}
}
if (p[len-1] == '\n' || feof(fptr)) { /* line completed */
#ifdef HAVE_ICONV
if (main_iton) {
ICONV_DECL(p, len + 1); /* +1 to include NUL */
olenv = olen = ibufn;
obufv = obuf = ibuf;
ICONV_DO(main_iton, 0, { err_dline(p + (ibufv-p+1), 1, ERR_INPUT_CONVFAIL); });
ibuf = p = obuf;
len = olen - olenv - 1;
}
#endif /* HAVE_ICONV */
in_line = p;
if (!feof(fptr)) /* newline read from input */
p[--len] = '\0';
else if (p[len-1] != '\n') /* EOF without newline */
err_dline(p+len, 1, ERR_INPUT_NOTENDNL);
if (len > 1 && ISCH_SP(p[len-1]) && (q = rnsp(p, p+len)) != NULL &&
(*q == '\\' || ((main_opt()->trigraph & 1) && q[0] == '/' && q > p+1 &&
q[-1] == '?' && q[-2] == '?')))
err_dline(q+1, p+len-1-q, ERR_INPUT_BSSPACENL);
in_limit = &p[len+1];
in_cp = p;
if (main_opt()->std) {
sz_t c = in_cntchar(p, &p[len], TL_LINE_STD, &q);
if (c >= TL_LINE_STD)
(void)(err_dline(q, 1, ERR_INPUT_LONGLINE) &&
err_dline(NULL, 1, ERR_INPUT_LONGLINESTD, (unsigned long)TL_LINE_STD));
}
return;
} else { /* expands buffer */
/*
* preprocesses input tokens to form the output list
*/
void (proc_prep)(void)
{
lex_t *t = lst_nexti();
while (1) {
switch(state) {
case SINIT:
case SAFTRNL:
while (1) {
SKIPSP(t);
switch(t->id) {
case LEX_NEWLINE:
lst_flush(1);
t = lst_nexti();
continue;
case LEX_SHARP:
state++;
assert(state == SIDIREC || state == SDIREC);
lex_direc = 1;
goto loop;
default:
state = SNORM;
goto loop;
case LEX_EOI:
if (mg_state == MG_SENDIF && state == SINIT)
mg_once();
cond_finalize();
if (inc_isffile()) {
lst_flush(1);
return;
}
if (main_opt()->pponly) {
lex_t *u = lst_copy(t, 0, strg_line);
u->id = LEX_NEWLINE;
u->f.sync = 2;
u = lst_append(u, lex_make(0, NULL, 0));
lst_output(u);
lst_discard(1); /* discards EOI */
in_switch(NULL, 0); /* pop */
t = lst_nexti();
u->pos = t->pos;
} else {
lst_discard(1); /* discards EOI */
in_switch(NULL, 0); /* pop */
t = lst_nexti();
}
setdirecst(t);
assert(state == SAFTRNL || state == SINIT);
goto loop;
}
}
/* assert(!"impossible control flow - should never reach here");
break; */
case SIDIREC:
case SDIREC:
directive(t);
t = lst_nexti(); /* token after newline */
setdirecst(t);
break;
case SNORM:
while (t->id != LEX_NEWLINE) {
assert(t->id != LEX_EOI);
if (t->id == LEX_ID && !t->f.blue)
mcr_expand(t);
t = lst_nexti();
}
lst_flush(1);
state = SAFTRNL;
return; /* at least newline flushed */
case SIGN:
do {
SKIPSP(t);
if (t->id == LEX_SHARP) {
state = SDIREC;
lex_direc = 1;
goto loop;
}
SKIPNL(t);
t = lst_nexti();
} while(t->id != LEX_EOI);
state = SAFTRNL;
break;
default:
assert(!"invalid state -- should never reach here");
break;
}
loop:
;
}
}
/*
* accepts #include;
* cannot use snbuf() because of a call to inc_start()
*/
static lex_t *dinclude(const lmap_t *pos)
{
static char buf[64+1]; /* size must be (power of 2) + 1 */
lex_t *t;
const lmap_t *hpos;
const char *inc = NULL;
char *pbuf = buf, *p;
lst_assert();
lex_inc = 1;
NEXTSP(t); /* consumes include */
hpos = t->pos;
if (t->id == LEX_HEADER) {
inc = LEX_SPELL(t);
while (1) {
NEXTSP(t); /* consumes header or current token */
if (t->id == LEX_NEWLINE)
break;
assert(t->id != LEX_EOI);
if (t->id == LEX_ID && !t->f.blue && mcr_expand(t))
continue;
t = xtratok(t);
break;
}
} else {
int st = 0; /* initial */
size_t blen, slen;
const lmap_t *epos = NULL;
while (t->id != LEX_NEWLINE) {
assert(t->id != LEX_EOI);
epos = t->pos;
if (t->id == LEX_ID && !t->f.blue && mcr_expand(t)) {
NEXTSP(t); /* consumes expanded id */
continue;
}
assert(t->id != LEX_NEWLINE);
switch(st) {
case 0: /* initial */
hpos = t->pos;
switch(t->id) {
case LEX_SCON:
if (t->spell[0] == 'L') {
default:
SKIPNL(t);
continue;
}
/* no break */
case LEX_HEADER:
st = 1;
inc = LEX_SPELL(t);
break;
case '<':
assert(pbuf == buf);
st = 2;
p = pbuf;
blen = sizeof(buf) - 1;
*p++ = '<';
break;
}
break;
case 1: /* extra tokens */
t = xtratok(t);
continue;
case 2: /* < seen */
slen = strlen(t->spell);
if (slen > blen - (p-pbuf)) {
const char *oldp = pbuf;
blen += ((slen + NELEM(buf)-2) & ~(size_t)(NELEM(buf)-2));
if (pbuf == buf) {
pbuf = MEM_ALLOC(blen + 1);
strcpy(pbuf, oldp);
} else
MEM_RESIZE(pbuf, blen + 1);
p = pbuf + (p - oldp);
}
strcpy(p, t->spell);
p += slen;
if (t->id == '>') {
st = 1;
inc = pbuf;
err_dpos(lmap_range(hpos, t->pos), ERR_PP_COMBINEHDR);
}
break;
default:
assert(!"invalid state -- should never reach here");
break;
}
NEXTSP(t); /* consumes handled token */
}
if (inc)
hpos = lmap_range(hpos, epos);
else
err_dpos(lmap_after(pos), ERR_PP_NOHEADER);
}
if (!inc || !inc_start(inc, hpos))
in_nextline(); /* because lex_inc set */
else if (main_opt()->pponly) {
t->f.sync = 1;
lst_output(lst_copy(t, 0, strg_line));
}
if (pbuf != buf)
MEM_FREE(pbuf);
lex_inc = 0;
return t;
}
/*
* recognizes character constants;
* ASSUMPTION: signed/unsigned integers are compatible on the host
*/
ux_t (clx_ccon)(lex_t *t, int *w)
{
int cbyte;
sz_t len = 0;
const char *ss, *s, *e;
ux_t lim, c;
#ifdef HAVE_ICONV
iconv_t *cd;
#endif /* HAVE_ICONV */
assert(t);
assert(w);
assert(BUFUNIT > 2);
assert(ty_wuchartype); /* ensures types initialized */
assert(xgeu(xmxu, TG_UCHAR_MAX));
assert(xgeu(xmxu, TG_WUCHAR_MAX));
assert(ir_cur);
ss = s = LEX_SPELL(t);
if (*s == 'L')
*w = 1, s++;
e = ++s; /* skips ' */
if (*w) {
cbyte = ty_wchartype->size;
assert(cbyte <= BUFUNIT);
lim = TG_WUCHAR_MAX;
#ifdef HAVE_ICONV
cd = main_ntow;
#endif /* HAVE_ICONV */
} else {
cbyte = 1;
lim = TG_UCHAR_MAX;
#ifdef HAVE_ICONV
cd = main_ntoe;
#endif /* HAVE_ICONV */
}
switch(*e) {
case '\'': /* empty; diagnosed elsewhere */
case '\0': /* unclosed; diagnosed elsewhere */
return xO;
case '\\': /* escape sequences */
assert(sizeof(c) >= cbyte);
c = lex_bs(t, ss, &e, lim, "character constant");
#if HAVE_ICONV
if (cd && !(s[1] == 'x' || (s[1] >= '0' && s[1] <= '7'))) {
char x = xnu(c);
ICONV_DECL(&x, 1);
assert(xe(xiu(x), c));
obuf = strg_sbuf, obufv = strg_sbuf;
olen = strg_slen, olenv = strg_slen;
ICONV_DO(cd, 1, {});
strg_sbuf = obuf, strg_slen = olen; /* for later reuse */
len = strg_slen - len - olenv;
} else {
#else /* !HAVE_ICONV */
{
#endif /* HAVE_ICONV */
if (*w)
memcpy(strg_sbuf, (char *)&c + ((LITTLE)? 0: sizeof(c)-cbyte), cbyte);
else
strg_sbuf[0] = xnu(c);
len = cbyte;
}
break;
default: /* ordinary chars */
#ifdef HAVE_ICONV
if (cd) {
do {
e++;
} while(!FIRSTUTF8(*e));
{
ICONV_DECL((char *)s, e - s);
obuf = strg_sbuf, obufv = strg_sbuf;
olen = strg_slen, olenv = strg_slen;
ICONV_DO(cd, 1, {});
strg_sbuf = obuf, strg_slen = olen; /* for later reuse */
len = strg_slen - len - olenv;
}
} else {
#else /* !HAVE_ICONV */
{
#endif /* HAVE_ICONV */
assert(TG_CHAR_BIT == CHAR_BIT);
if (*w) {
strg_sbuf[(LITTLE)? 0: cbyte-1] = *e;
memset(strg_sbuf + ((LITTLE)? 1: 0), 0, cbyte-1);
} else
strg_sbuf[0] = *e;
e++;
len = cbyte;
}
break;
}
if (*e != '\'' && *e != '\0') {
for (s = e; *e != '\0' && *e != '\''; e++)
continue;
err_dpos((FIRSTUTF8(*s))? lmap_spell(t, ss, s, e): t->pos, ERR_CONST_LARGECHAR);
} else if (len != cbyte) {
err_dpos(t->pos, (*w)? ERR_CONST_WIDENOTFIT: ERR_CONST_MBNOTFIT);
return xO;
}
c = xO;
memcpy(&c, strg_sbuf + ((LITTLE)? 0: sizeof(c)-cbyte), cbyte);
if (*w) {
switch(main_opt()->wchart) {
case 0: /* long */
c = SYM_CROPSL(c);
break;
case 1: /* ushort */
c = SYM_CROPUS(c);
break;
case 2: /* int */
c = SYM_CROPSI(c);
break;
}
} else /* int from char */
c = (main_opt()->uchar)? SYM_CROPUC(c): SYM_CROPSC(c);
return c;
}
/*
* recognizes string literals
*/
static sz_t scon(lex_t *t, int *w)
{
int cbyte;
lex_t *n;
sz_t clen = 0, len = 0;
const char *ss, *s, *e;
ux_t lim;
#ifdef HAVE_ICONV
iconv_t *cd;
#endif
assert(t);
assert(w);
assert(BUFUNIT > 2);
assert(ty_wuchartype); /* ensures types initialized */
assert(xgeu(xmxu, TG_UCHAR_MAX));
assert(xgeu(xmxu, TG_WUCHAR_MAX));
assert(ir_cur);
ss = s = LEX_SPELL(t);
if (*s == 'L')
*w = 1, s++;
e = ++s; /* skips " */
while ((n = lst_peekns())->id == LEX_SCON) {
if (*n->spell == 'L') {
if (!*w) { /* mb + wide = wide */
err_dmpos(n->pos, ERR_CONST_MBWIDE, t->pos, NULL);
err_dmpos(n->pos, ERR_CONST_MBWIDESTD, t->pos, NULL);
*w = 2; /* silences warnings */
}
} else if (*w == 1) { /* wide + mb = wide */
err_dmpos(n->pos, ERR_CONST_MBWIDE, t->pos, NULL);
err_dmpos(n->pos, ERR_CONST_MBWIDESTD, t->pos, NULL);
*w = 2; /* silences warnings */
}
while ((t = lst_append(t, lst_next()))->id != LEX_SCON)
continue;
}
clx_cpos = lmap_range(t->next->pos, t->pos);
if (*w) {
cbyte = ty_wchartype->size;
assert(cbyte <= BUFUNIT);
lim = TG_WUCHAR_MAX;
#ifdef HAVE_ICONV
cd = main_ntow;
#endif /* HAVE_ICONV */
} else {
cbyte = 1;
lim = TG_UCHAR_MAX;
#ifdef HAVE_ICONV
cd = main_ntoe;
#endif /* HAVE_ICONV */
}
n = t->next;
while (1) {
while (1) {
while (*e != '\\' && *e != '"' && *e != '\0')
e++;
if (e > s) { /* ordinary chars */
#ifdef HAVE_ICONV
if (cd) {
ICONV_DECL((char *)s, e - s);
obuf = strg_sbuf, obufv = strg_sbuf + len;
olen = strg_slen, olenv = strg_slen - len;
ICONV_INIT(cd);
ICONV_DO(cd, 0, {});
strg_sbuf = obuf, strg_slen = olen; /* for later reuse */
len += (strg_slen - len - olenv);
} else {
#else /* !HAVE_ICONV */
{
#endif /* HAVE_ICONV */
sz_t d = e - s;
assert(TG_CHAR_BIT == CHAR_BIT);
while (len + (d*cbyte) > strg_slen) /* rarely iterates */
MEM_RESIZE(strg_sbuf, strg_slen += BUFUNIT);
if (*w) {
while (s < e) {
strg_sbuf[len + ((ir_cur->f.little_endian)? 0: cbyte-1)] = *s++;
memset(strg_sbuf + len + ((ir_cur->f.little_endian)? 1: 0), 0,
cbyte-1);
len += cbyte;
}
} else {
memcpy(&strg_sbuf[len], s, d);
len += d;
}
}
for (; s < e; s++)
if (FIRSTUTF8(*s))
clen++;
}
if (*e == '\\') { /* escape sequences */
ux_t c;
assert(sizeof(c) >= cbyte);
c = lex_bs(n, ss, &e, lim, "string literal");
#if HAVE_ICONV
if (cd) { /* inserts initial seq before every esc seq */
ICONV_DECL(NULL, 0);
UNUSED(ilenv);
UNUSED(ibufv);
obuf = strg_sbuf, obufv = strg_sbuf + len;
olen = strg_slen, olenv = strg_slen - len;
ICONV_INIT(cd);
strg_sbuf = obuf, strg_slen = olen; /* for later reuse */
len += (strg_slen - len - olenv);
}
if (cd && !(s[1] == 'x' || (s[1] >= '0' && s[1] <= '7'))) {
char x = xnu(c);
ICONV_DECL(&x, 1);
assert(xe(xiu(x), c));
obuf = strg_sbuf, obufv = strg_sbuf + len;
olen = strg_slen, olenv = strg_slen - len;
ICONV_DO(cd, 0, {});
strg_sbuf = obuf, strg_slen = olen; /* for later reuse */
len += (strg_slen - len - olenv);
} else {
#else /* !HAVE_ICONV */
{
#endif /* HAVE_ICONV */
if (len + cbyte > strg_slen)
MEM_RESIZE(strg_sbuf, strg_slen += BUFUNIT);
if (*w) {
if (LITTLE != ir_cur->f.little_endian)
CHGENDIAN(c, sizeof(c));
memcpy(strg_sbuf+len,
&c + ((ir_cur->f.little_endian)? 0: sizeof(c)-cbyte), cbyte);
len += cbyte;
} else
strg_sbuf[len++] = xnu(c);
}
clen++;
s = e;
continue;
}
break; /* " or NUL */
}
if (n == t) {
if (len + cbyte > strg_slen)
MEM_RESIZE(strg_sbuf, strg_slen += BUFUNIT);
memset(strg_sbuf+len, 0, cbyte);
len += cbyte;
clen++;
break;
}
while ((n = n->next)->id != LEX_SCON)
if (n->id < 0)
strg_free((arena_t *)n->spell);
ss = s = LEX_SPELL(n);
if (*s == 'L')
s++;
e = ++s; /* skips " */
}
if (len % cbyte != 0)
err_dpos(clx_cpos, ERR_CONST_WIDENOTFIT);
if (*w)
clen = (len /= cbyte);
if (clen - 1 > TL_STR_STD) { /* -1 for NUL; note TL_STR_STD may warp around */
err_dpos(clx_cpos, ERR_CONST_LONGSTR);
err_dpos(clx_cpos, ERR_CONST_LONGSTRSTD, (unsigned long)TL_STR_STD);
}
return len;
}
#define N 0 /* no suffix */
#define U 1 /* suffix: U */
#define L 2 /* suffix: L */
#define X 3 /* suffix: UL */
#ifdef SUPPORT_LL
#define M 4 /* suffix: LL */
#define Z 5 /* suffix: ULL */
#endif /* SUPPORT_LL */
#define D 0 /* base: decimal */
#define H 1 /* base: octal or hexadecimal */
/*
* determines the type of an integer constant
*/
static const char *icon(const char *cs, ux_t n, int ovf, int base, const lmap_t *pos)
{
static struct tab {
ux_t limit;
ty_t *type;
#ifdef SUPPORT_LL
} tab[Z+1][H+1][7];
#else /* !SUPPORT_LL */
} tab[X+1][H+1][5];
#endif /* SUPPORT_LL */
int suffix;
struct tab *p;
assert(cs);
assert(pos);
assert(ty_inttype);
#ifdef SUPPORT_LL
assert(xgeu(xmxu, TG_ULLONG_MAX));
#else /* !SUPPORT_LL */
assert(xgeu(xmxu, TG_ULONG_MAX));
#endif /* SUPPORT_LL */
if (xe(tab[N][D][0].limit, xO)) {
/* no suffix, decimal; different in C90 */
tab[N][D][0].limit = TG_INT_MAX;
tab[N][D][0].type = ty_inttype;
tab[N][D][1].limit = TG_LONG_MAX;
tab[N][D][1].type = ty_longtype;
#ifdef SUPPORT_LL
tab[N][D][2].limit = TG_LLONG_MAX;
tab[N][D][2].type = ty_llongtype;
tab[N][D][3].limit = TG_ULLONG_MAX;
tab[N][D][3].type = ty_ullongtype;
tab[N][D][4].limit = xmxu;
tab[N][D][4].type = ty_inttype;
#else /* SUPPORT_LL */
tab[N][D][2].limit = TG_ULONG_MAX;
tab[N][D][2].type = ty_ulongtype;
tab[N][D][3].limit = xmxu;
tab[N][D][3].type = ty_inttype;
#endif /* SUPPORT_LL */
/* no suffix, octal or hex */
tab[N][H][0].limit = TG_INT_MAX;
tab[N][H][0].type = ty_inttype;
tab[N][H][1].limit = TG_UINT_MAX;
tab[N][H][1].type = ty_unsignedtype;
tab[N][H][2].limit = TG_LONG_MAX;
tab[N][H][2].type = ty_longtype;
tab[N][H][3].limit = TG_ULONG_MAX;
tab[N][H][3].type = ty_ulongtype;
#ifdef SUPPORT_LL
tab[N][H][4].limit = TG_LLONG_MAX;
tab[N][H][4].type = ty_llongtype;
tab[N][H][5].limit = TG_ULLONG_MAX;
tab[N][H][5].type = ty_ullongtype;
tab[N][H][6].limit = xmxu;
tab[N][H][6].type = ty_inttype;
#else /* !SUPPORT_LL */
tab[N][H][4].limit = xmxu;
tab[N][H][4].type = ty_inttype;
#endif /* SUPPORT_LL */
/* U, decimal, octal or hex */
tab[U][H][0].limit = tab[U][D][0].limit = TG_UINT_MAX;
tab[U][H][0].type = tab[U][D][0].type = ty_unsignedtype;
tab[U][H][1].limit = tab[U][D][1].limit = TG_ULONG_MAX;
tab[U][H][1].type = tab[U][D][1].type = ty_ulongtype;
#ifdef SUPPORT_LL
tab[U][H][2].limit = tab[U][D][2].limit = TG_ULLONG_MAX;
tab[U][H][2].type = tab[U][D][2].type = ty_ullongtype;
tab[U][H][3].limit = tab[U][D][3].limit = xmxu;
tab[U][H][3].type = tab[U][D][3].type = ty_inttype;
#else /* !SUPPORT_LL */
tab[U][H][2].limit = tab[U][D][2].limit = xmxu;
tab[U][H][2].type = tab[U][D][2].type = ty_inttype;
#endif /* SUPPORT_LL */
/* L, decimal; different in C90 */
tab[L][D][0].limit = TG_LONG_MAX;
tab[L][D][0].type = ty_longtype;
#ifdef SUPPORT_LL
tab[L][D][1].limit = TG_LLONG_MAX;
tab[L][D][1].type = ty_llongtype;
tab[L][D][2].limit = TG_ULLONG_MAX;
tab[L][D][2].type = ty_ullongtype;
tab[L][D][3].limit = xmxu;
tab[L][D][3].type = ty_inttype;
#else /* !SUPPORT_LL */
tab[L][D][1].limit = TG_ULONG_MAX;
tab[L][D][1].type = ty_ulongtype;
tab[L][D][2].limit = xmxu;
tab[L][D][2].type = ty_inttype;
#endif /* SUPPORT_LL */
/* L, octal or hex */
tab[L][H][0].limit = TG_LONG_MAX;
tab[L][H][0].type = ty_longtype;
tab[L][H][1].limit = TG_ULONG_MAX;
tab[L][H][1].type = ty_ulongtype;
#ifdef SUPPORT_LL
tab[L][H][2].limit = TG_LLONG_MAX;
tab[L][H][2].type = ty_llongtype;
tab[L][H][3].limit = TG_ULLONG_MAX;
tab[L][H][3].type = ty_ullongtype;
tab[L][H][4].limit = xmxu;
tab[L][H][4].type = ty_inttype;
#else /* !SUPPORT_LL */
tab[L][H][2].limit = xmxu;
tab[L][H][2].type = ty_inttype;
#endif /* SUPPORT_LL */
/* UL, decimal, octal or hex */
tab[X][H][0].limit = tab[X][D][0].limit = TG_ULONG_MAX;
tab[X][H][0].type = tab[X][D][0].type = ty_ulongtype;
#ifdef SUPPORT_LL
tab[X][H][1].limit = tab[X][D][1].limit = TG_ULLONG_MAX;
tab[X][H][1].type = tab[X][D][1].type = ty_ullongtype;
tab[X][H][2].limit = tab[X][D][2].limit = xmxu;
tab[X][H][2].type = tab[X][D][2].type = ty_inttype;
#else /* !SUPPORT_LL */
tab[X][H][1].limit = tab[X][D][1].limit = xmxu;
tab[X][H][1].type = tab[X][D][1].type = ty_inttype;
#endif /* SUPPORT_LL */
#ifdef SUPPORT_LL
/* LL, decimal, octal or hex */
tab[M][H][0].limit = tab[M][D][0].limit = TG_LLONG_MAX;
tab[M][H][0].type = tab[M][D][0].type = ty_llongtype;
tab[M][H][1].limit = tab[M][D][1].limit = TG_ULLONG_MAX;
tab[M][H][1].type = tab[M][D][1].type = ty_ullongtype;
tab[M][H][2].limit = tab[M][D][2].limit = xmxu;
tab[M][H][2].type = tab[M][D][2].type = ty_inttype;
/* ULL, decimal, octal or hex */
tab[Z][H][0].limit = tab[Z][D][0].limit = TG_ULLONG_MAX;
tab[Z][H][0].type = tab[Z][D][0].type = ty_ullongtype;
tab[Z][H][1].limit = tab[Z][D][1].limit = xmxu;
tab[Z][H][1].type = tab[Z][D][1].type = ty_inttype;
#endif /* SUPPORT_LL */
}
base = (base == 10)? D: H;
suffix = N;
if (tolower((unsigned char)cs[0]) == 'l') {
#ifdef SUPPORT_LL
if (cs[1] == cs[0])
cs += 2, suffix = M;
else
#endif /* SUPPORT_LL */
cs++, suffix = L;
}
if (tolower((unsigned char)cs[0]) == 'u')
cs++, suffix++;
if (suffix <= U && tolower((unsigned char)cs[0]) == 'l') {
#ifdef SUPPORT_LL
if (cs[1] == cs[0])
cs += 2, suffix += M;
else
#endif /* SUPPORT_LL */
cs++, suffix += L;
}
for (p = tab[suffix][base]; xgu(n, p->limit); p++)
continue;
if (ovf || (xe(p->limit, xmxu) && p->type == ty_inttype)) {
err_dpos(pos, ERR_CONST_LARGEINT);
#ifdef SUPPORT_LL
n = TG_ULLONG_MAX;
tval.type = ty_ullongtype;
#else /* !SUPPORT_LL */
n = TG_ULONG_MAX;
tval.type = ty_ulongtype;
#endif /* SUPPORT_LL */
} else
tval.type = p->type;
#ifdef SUPPORT_LL
if (suffix % 2 == 0 && base == D && TY_ISUNSIGN(p->type))
err_dpos(pos, ERR_CONST_LARGEUNSIGN);
else if (tval.type == ty_llongtype && (suffix == N || suffix == L) && xleu(n, TG_ULONG_MAX)) {
err_dpos(pos, ERR_CONST_UNSIGNINC90);
if (main_opt()->std == 1)
tval.type = ty_ulongtype;
}
if ((TY_ISLLONG(tval.type) || TY_ISULLONG(tval.type)))
err_dpos(pos, ERR_CONST_LLONGINC90, tval.type);
#endif /* SUPPORT_LL */
#ifdef SUPPORT_LL
if (tval.type->op == TY_INT || tval.type->op == TY_LONG || tval.type->op == TY_LLONG)
#else /* !SUPPORT_LL */
if (tval.type->op == TY_INT || tval.type->op == TY_LONG)
#endif /* SUPPORT_LL */
tval.u.c.v.s = n;
else
tval.u.c.v.u = n;
return cs;
}
#undef H
#undef D
#undef Z
#undef M
#undef X
#undef L
#undef U
#undef N
/*
* determines the type of a floating constant;
* ASSUMPTION: fp types of the host are same as those of the target
*/
static const char *fcon(const char *cs, long double ld, const lmap_t *pos)
{
assert(cs);
assert(pos);
assert(ty_floattype); /* ensures types initiailized */
switch(*cs) {
case 'f':
case 'F':
cs++; /* skips f or F */
if ((OVF(ld) && errno == ERANGE) || ld > TG_FLT_MAX) {
err_dpos(pos, ERR_CONST_LARGEFP);
ld = TG_FLT_MAX;
} else if ((ld == 0.0 && errno == ERANGE) || (ld > 0.0 && ld < TG_FLT_MIN)) {
err_dpos(pos, ERR_CONST_TRUNCFP);
ld = 0.0f;
}
tval.type = ty_floattype;
tval.u.c.v.f = (float)ld;
break;
case 'l':
case 'L':
cs++; /* skips l or L */
if ((OVF(ld) && errno == ERANGE) || ld > TG_LDBL_MAX) {
err_dpos(pos, ERR_CONST_LARGEFP);
ld = TG_LDBL_MAX;
} else if ((ld == 0.0 && errno == ERANGE) || (ld > 0.0 && ld < TG_LDBL_MIN))
err_dpos(pos, ERR_CONST_TRUNCFP);
tval.type = ty_ldoubletype;
tval.u.c.v.ld = (long double)ld;
break;
default:
if ((OVF(ld) && errno == ERANGE) || ld > TG_DBL_MAX) {
err_dpos(pos, ERR_CONST_LARGEFP);
ld = (double)TG_DBL_MAX;
} else if ((ld == 0.0 && errno == ERANGE) || (ld > 0.0 && ld < TG_DBL_MIN)) {
err_dpos(pos, ERR_CONST_TRUNCFP);
ld = 0.0;
}
tval.type = ty_doubletype;
tval.u.c.v.d = (double)ld;
break;
}
return cs;
}
/*
* recognizes integer or floating constants;
* ASSUMPTION: strtold() supported on the host
*/
static int ifcon(lex_t *t)
{
ux_t n;
int b, d;
long double ld;
int err = 0, ovf = 0;
const char *ss, *s;
char *p = "0123456789abcdef"; /* no const for reuse with strtold() */
assert(t);
ss = s = LEX_SPELL(t);
if (*s == '.')
goto fcon;
n = xO;
if (s[0] == '0' && (s[1] == 'x' || s[1] == 'X') &&
isxdigit(((unsigned char *)s)[2])) { /* 0x[0-9] */
b = 16;
s++; /* skips 0 */
while (isxdigit(*(unsigned char *)++s)) {
d = strchr(p, tolower(*(unsigned char *)s)) - p;
if (xt(xba(n, xbc(xsrl(xmxu, 4)))))
ovf = 1;
n = xau(xsl(n, 4), xiu(d));
}
s = icon(s, n, ovf, b, t->pos);
b = LEX_ICON;
} else { /* 0 or other digits */
b = (*s == '0')? 8: 10;
if (b == 8)
while (isdigit(*(unsigned char *)s)) {
d = *s++ - '0';
if (*s == '8' || *s == '9')
p = (char *)s, err = 1;
if (xt(xba(n, xbc(xsrl(xmxu, 3)))))
ovf = 1;
n = xau(xsl(n, 3), xiu(d));
}
else /* b == 10 */
while (isdigit(*(unsigned char *)s)) {
d = *s++ - '0';
if (xgu(n, xdu(xsu(xmxu, xiu(d)), xiu(10))))
ovf = 1;
n = xau(xmu(xiu(10), n), xiu(d));
}
fcon:
if (b != 16 && (*s == '.' || *s == 'e' || *s == 'E')) {
if (*s == '.')
do {
s++; /* skips . and digits */
} while(isdigit(*s));
if (*s == 'e' || *s == 'E') {
if (*++s == '-' || *s == '+') /* skips e or E */
s++; /* skips - or + */
if (!isdigit(*s)) {
err_dpos(lmap_spell(t, ss, s, s+1), ERR_CONST_NOEXPDIG);
err = 1;
}
}
if (!err) {
errno = 0;
ld = strtold(ss, &p);
s = fcon((s = p), ld, t->pos);
}
b = LEX_FCON;
} else {
if (err)
err_dpos(lmap_spell(t, ss, p, p+1), ERR_CONST_ILLOCTESC);
else
s = icon(s, n, ovf, b, t->pos);
b = LEX_ICON;
}
}
if (*s && !err) {
for (p = (char *)s; *p; p++)
continue;
err_dpos(lmap_spell(t, ss, s, p), ERR_CONST_PPNUMSFX, s, b);
err = 1;
}
clx_sym = (err)? NULL: &tval;
return b;
}
void FedorovInit_R(char **namfich, int *ndimen, int *nbprot, int *numprot,
double *freq, int *nbdata, double *vectps, double *fisher,
int *nok, int *protdep, double *freqdep)
/* Ajout d'une initialisation par l'utilisateur du protocole de population
* définis dans R et envoyé au programme C
* namfich fichiers avec les noms des 2 fichiers (nomini=matrices de Fisher
* nomout=nom du fichier de résultats)
* ndimen dimensions du problème (nb de prot elementaires, dimension de la
* matrice de Fisher, cout total)
* renvoyés par le programme C
* nbprot nb de protocoles dans le protocole de population final P
* numprot liste des protocoles elementaires dans P
* freq liste des fréquences des protocoles élementaires
* nbdata liste du nb de temps dans chaque protocole élementaires
* vectps vecteur des temps
* fisher matrice d'information de Fisher du protocole de population
* nok nb of iterations if optimisation success, pb encountered if not
* défini dans R et envoyé au programme C, pour
* l'initialisation du protocole de population
* protdep premier chiffre=nb de protocoles de départ, chiffres
* suivants=numéros des protocoles élémentaires défini
* dans R, envoyé à C, modifié par C et renvoyé à R
* freqdep fréquence des protocoles élémentaires constituant le protocole
* initial
* renvoyé : fréquences pondérées (par les coûts)
*/
{
char nomini[500],nomout[500];
int nprot,ndim,Ntot;
int i,j,ij;
double sumf;
PROTOC *allprot; /* Vector of individual protocols */
POPROT *pop; /* Population protocol */
*nok = 0;
sprintf(nomini, "%s", namfich[0]);
sprintf(nomout, "%s", namfich[1]);
nprot = ndimen[0];
ndim = ndimen[1];
Ntot = ndimen[2];
fprintf(stderr, "%d %d %d \n", nprot, ndim, Ntot);
allprot = readfich_R(nomini,nomout,nprot,ndim,Ntot);
if(allprot == NULL) {
*nok = -500;
fprintf(stderr,"Check file names.\n");
}
if(*nok >= 0) {
pop = initprot(allprot,protdep,freqdep);
assert(pop != NULL);
*nok = main_opt(allprot,pop,nomout,nprot);
if(*nok == (-1))
fprintf(stderr,"Number of protocols in population protocol too large\n");
if(*nok == (-10))
fprintf(stderr,"Could not find a new protocol to add\n");
if(*nok == (-100))
fprintf(stderr,"Convergence problem in the frequency optimisation step\n");
/* Dimensionnement des tableaux de sortie doit etre effectué avant l'appel!!!
* numprot=(int *)calloc(pop->np,sizeof(int));
*/
if(*nok >= 0) {
*nbprot = pop->np;
sumf = 0;
for(i = 0; i < pop->np; i++) {
numprot[i] = pop->num[i]+1;
nbdata[i] = pop->pind[i].ntps;
/* Calcul de la fréquence à partir de
* la fréquence pondérée par le coût
* calcul de la somme des fréquences
* pour normaliser Somme_i freq[i]=1
*/
freq[i] = pop->freq[i] * (double)(Ntot) / (double)(nbdata[i]);
sumf = sumf + freq[i];
freqdep[i] = pop->freq[i];
}
ij = 0;
for(i = 0; i < pop->np; i++) {
freq[i] = freq[i]/sumf;
for(j = 0; j < pop->pind[i].ntps; j++) {
vectps[ij] = pop->pind[i].tps[j];
ij = ij+1;
}
}
for(i = 0; i < (pop->ndim*(pop->ndim + 1)/2); i++) {
fisher[i] = pop->fisher[i];
}
}
}
}
