static ffebad
ffesymbol_check_token_ (ffelexToken t, char *c)
{
char *p = ffelex_token_text (t);
ffeTokenLength len = ffelex_token_length (t);
ffebad bad;
ffeTokenLength i = 0;
ffebad skip_me = ((ffe_case_symbol () == FFE_caseINITCAP)
? FFEBAD_SYMBOL_NOLOWER_INITCAP : FFEBAD + 1);
ffebad stop_me = ((ffe_case_symbol () == FFE_caseINITCAP)
? FFEBAD : FFEBAD + 1);
if (len == 0)
return FFEBAD;
bad = ffesrc_bad_char_symbol_init (*p);
if (bad == FFEBAD)
{
for (++i, ++p; i < len; ++i, ++p)
{
bad = ffesrc_bad_char_symbol_noninit (*p);
if (bad == skip_me)
continue; /* Keep looking for good InitCap character. */
if (bad == stop_me)
break; /* Found good InitCap character. */
if (bad != FFEBAD)
break; /* Bad character found. */
}
}
if (bad != FFEBAD)
{
if (i >= len)
*c = *(ffelex_token_text (t));
else
*c = *p;
}
return bad;
}
void
ffesrc_init_1 ()
{
int i;
for (i = 0; i < 256; ++i)
{
ffesrc_char_match_init_[i] = i;
ffesrc_char_match_noninit_[i] = i;
ffesrc_char_source_[i] = i;
ffesrc_char_internal_init_[i] = i;
ffesrc_bad_symbol_init_[i] = FFEBAD;
ffesrc_bad_symbol_noninit_[i] = FFEBAD;
}
ffesrc_check_symbol_ = (ffe_case_symbol () != FFE_caseNONE);
ffesrc_ok_match_init_upper_ = (ffe_case_match () != FFE_caseLOWER);
ffesrc_ok_match_init_lower_ = (ffe_case_match () != FFE_caseUPPER)
&& (ffe_case_match () != FFE_caseINITCAP);
ffesrc_ok_match_noninit_upper_ = (ffe_case_match () != FFE_caseLOWER)
&& (ffe_case_match () != FFE_caseINITCAP);
ffesrc_ok_match_noninit_lower_ = (ffe_case_match () != FFE_caseUPPER);
/* Note that '-' is used to flag an invalid match character. '-' is
somewhat arbitrary, actually. -1 was used, but that's not wise on a
system with unsigned chars as default -- it'd turn into 255 or some such
large positive number, which would sort higher than the alphabetics and
thus possibly cause problems. So '-' is picked just because it's never
likely to be a symbol character in Fortran and because it's "less than"
any alphabetic character. EBCDIC might see things differently, I don't
remember it well enough, but that's just tough -- lots of other things
might have to change to support EBCDIC -- anyway, some other character
could easily be picked. */
#define FFESRC_INVALID_SYMBOL_CHAR_ '-'
if (!ffesrc_ok_match_init_upper_)
for (i = 'A'; i <= 'Z'; ++i)
ffesrc_char_match_init_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
if (ffesrc_ok_match_init_lower_)
for (i = 'a'; i <= 'z'; ++i)
ffesrc_char_match_init_[i] = TOUPPER (i);
else
for (i = 'a'; i <= 'z'; ++i)
ffesrc_char_match_init_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
if (!ffesrc_ok_match_noninit_upper_)
for (i = 'A'; i <= 'Z'; ++i)
ffesrc_char_match_noninit_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
if (ffesrc_ok_match_noninit_lower_)
for (i = 'a'; i <= 'z'; ++i)
ffesrc_char_match_noninit_[i] = TOUPPER (i);
else
for (i = 'a'; i <= 'z'; ++i)
ffesrc_char_match_noninit_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
if (ffe_case_source () == FFE_caseLOWER)
for (i = 'A'; i <= 'Z'; ++i)
ffesrc_char_source_[i] = TOLOWER (i);
else if (ffe_case_source () == FFE_caseUPPER)
for (i = 'a'; i <= 'z'; ++i)
ffesrc_char_source_[i] = TOUPPER (i);
if (ffe_case_match () == FFE_caseLOWER)
for (i = 'A'; i <= 'Z'; ++i)
ffesrc_char_internal_init_[i] = TOLOWER (i);
switch (ffe_case_symbol ())
{
case FFE_caseLOWER:
for (i = 'A'; i <= 'Z'; ++i)
{
ffesrc_bad_symbol_init_[i] = FFEBAD_SYMBOL_UPPER_CASE;
ffesrc_bad_symbol_noninit_[i] = FFEBAD_SYMBOL_UPPER_CASE;
}
break;
case FFE_caseUPPER:
for (i = 'a'; i <= 'z'; ++i)
{
ffesrc_bad_symbol_init_[i] = FFEBAD_SYMBOL_LOWER_CASE;
ffesrc_bad_symbol_noninit_[i] = FFEBAD_SYMBOL_LOWER_CASE;
}
break;
case FFE_caseINITCAP:
for (i = 0; i < 256; ++i)
ffesrc_bad_symbol_noninit_[i] = FFEBAD_SYMBOL_NOLOWER_INITCAP;
for (i = 'a'; i <= 'z'; ++i)
{
ffesrc_bad_symbol_init_[i] = FFEBAD_SYMBOL_LOWER_INITCAP;
ffesrc_bad_symbol_noninit_[i] = FFEBAD;
}
break;
default:
break;
}
}
