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; } }