#include "proj.h"
#include "top.h"
#include "bad.h"
#include "com.h"
#include "lex.h"
#include "malloc.h"
#include "src.h"
#include "debug.h"
#include "flags.h"
#include "input.h"
#include "toplev.h"
#include "output.h"
#include "ggc.h"
static void ffelex_append_to_token_ (char c);
static int ffelex_backslash_ (int c, ffewhereColumnNumber col);
static void ffelex_bad_1_ (ffebad errnum, ffewhereLineNumber ln0,
ffewhereColumnNumber cn0);
static void ffelex_bad_2_ (ffebad errnum, ffewhereLineNumber ln0,
ffewhereColumnNumber cn0, ffewhereLineNumber ln1,
ffewhereColumnNumber cn1);
static void ffelex_bad_here_ (int num, ffewhereLineNumber ln0,
ffewhereColumnNumber cn0);
static void ffelex_finish_statement_ (void);
static int ffelex_get_directive_line_ (char **text, FILE *finput);
static int ffelex_hash_ (FILE *f);
static ffewhereColumnNumber ffelex_image_char_ (int c,
ffewhereColumnNumber col);
static void ffelex_include_ (void);
static bool ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col);
static bool ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col);
static void ffelex_next_line_ (void);
static void ffelex_prepare_eos_ (void);
static void ffelex_send_token_ (void);
static ffelexHandler ffelex_swallow_tokens_ (ffelexToken t);
static ffelexToken ffelex_token_new_ (void);
#define FFELEX_columnINITIAL_SIZE_ 255
static char *ffelex_card_image_;
static ffewhereColumnNumber ffelex_card_size_;
static ffewhereColumnNumber ffelex_card_length_;
#define FFELEX_FREE_MAX_COLUMNS_ 132
static bool ffelex_saw_tab_;
static bool ffelex_bad_line_ = FALSE;
static ffewhereColumnNumber ffelex_final_nontab_column_;
static ffelexType ffelex_first_char_[256];
static GTY (()) ffewhereFile ffelex_current_wf_;
static bool ffelex_permit_include_;
static bool ffelex_set_include_;
static FILE *ffelex_include_file_;
static bool ffelex_include_free_form_;
static GTY(()) ffewhereFile ffelex_include_wherefile_;
static ffewhereLineNumber ffelex_linecount_current_;
static ffewhereLineNumber ffelex_linecount_next_;
static ffewhereLine ffelex_current_wl_;
static ffewhereColumn ffelex_current_wc_;
#define FFELEX_columnTOKEN_SIZE_ 63
#if FFELEX_columnTOKEN_SIZE_ < FFEWHERE_indexMAX
#error "token size too small!"
#endif
static ffelexToken ffelex_token_;
static ffelexHandler ffelex_handler_;
static bool ffelex_names_;
static bool ffelex_names_pure_;
static bool ffelex_hexnum_;
static ffelexHandler ffelex_eos_handler_;
static unsigned long int ffelex_number_of_tokens_;
static unsigned long int ffelex_label_tokens_;
static long int ffelex_total_tokens_ = 0;
static long int ffelex_old_total_tokens_ = 1;
static long int ffelex_token_nextid_ = 0;
static long int ffelex_expecting_hollerith_;
static long int ffelex_raw_mode_;
static char ffelex_raw_char_;
static bool ffelex_backslash_reconsider_ = FALSE;
static int *ffelex_kludge_chars_ = NULL;
static bool ffelex_kludge_flag_ = FALSE;
static ffewhereLine ffelex_raw_where_line_;
static ffewhereColumn ffelex_raw_where_col_;
static void
ffelex_append_to_token_ (char c)
{
if (ffelex_token_->text == NULL)
{
ffelex_token_->text
= malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
FFELEX_columnTOKEN_SIZE_ + 1);
ffelex_token_->size = FFELEX_columnTOKEN_SIZE_;
ffelex_token_->length = 0;
}
else if (ffelex_token_->length >= ffelex_token_->size)
{
ffelex_token_->text
= malloc_resize_ksr (malloc_pool_image (),
ffelex_token_->text,
(ffelex_token_->size << 1) + 1,
ffelex_token_->size + 1);
ffelex_token_->size <<= 1;
assert (ffelex_token_->length < ffelex_token_->size);
}
#ifdef MAP_CHARACTER
Sorry, MAP_CHARACTER is not going to work as expected in GNU Fortran,
please contact fortran@gnu.org if you wish to fund work to
port g77 to non-ASCII machines.
#endif
ffelex_token_->text[ffelex_token_->length++] = c;
}
static int
ffelex_backslash_ (int c, ffewhereColumnNumber col)
{
static int state = 0;
static unsigned int count;
static int code;
static unsigned int firstdig = 0;
static int nonnull;
static ffewhereLineNumber line;
static ffewhereColumnNumber column;
#define wide_flag 0
switch (state)
{
case 0:
if ((c == '\\')
&& (ffelex_raw_mode_ != 0)
&& ffe_is_backslash ())
{
state = 1;
column = col + 1;
line = ffelex_linecount_current_;
return EOF;
}
return c;
case 1:
state = 0;
switch (c)
{
case 'x':
code = 0;
count = 0;
nonnull = 0;
state = 2;
return EOF;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7':
code = c - '0';
count = 1;
state = 3;
return EOF;
case '\\': case '\'': case '"':
return c;
#if 0
case '\n':
ffelex_next_line_ ();
*ignore_ptr = 1;
return 0;
#endif
case 'n':
return TARGET_NEWLINE;
case 't':
return TARGET_TAB;
case 'r':
return TARGET_CR;
case 'f':
return TARGET_FF;
case 'b':
return TARGET_BS;
case 'a':
return TARGET_BELL;
case 'v':
return TARGET_VT;
case 'e':
case 'E':
case '(':
case '{':
case '[':
case '%':
if (pedantic)
{
char m[2];
m[0] = c;
m[1] = '\0';
ffebad_start_msg_lex ("Non-ISO-C-standard escape sequence `\\%A' at %0",
FFEBAD_severityPEDANTIC);
ffelex_bad_here_ (0, line, column);
ffebad_string (m);
ffebad_finish ();
}
return (c == 'E' || c == 'e') ? 033 : c;
case '?':
return c;
default:
if (c >= 040 && c < 0177)
{
char m[2];
m[0] = c;
m[1] = '\0';
ffebad_start_msg_lex ("Unknown escape sequence `\\%A' at %0",
FFEBAD_severityPEDANTIC);
ffelex_bad_here_ (0, line, column);
ffebad_string (m);
ffebad_finish ();
}
else if (c == EOF)
{
ffebad_start_msg_lex ("Unterminated escape sequence `\\' at %0",
FFEBAD_severityPEDANTIC);
ffelex_bad_here_ (0, line, column);
ffebad_finish ();
}
else
{
char m[20];
sprintf (&m[0], "%x", c);
ffebad_start_msg_lex ("Unknown escape sequence `\\' followed by char code 0x%A at %0",
FFEBAD_severityPEDANTIC);
ffelex_bad_here_ (0, line, column);
ffebad_string (m);
ffebad_finish ();
}
}
return c;
case 2:
if (ISXDIGIT (c))
{
code = (code * 16) + hex_value (c);
if (code != 0 || count != 0)
{
if (count == 0)
firstdig = code;
count++;
}
nonnull = 1;
return EOF;
}
state = 0;
if (! nonnull)
{
ffebad_start_msg_lex ("\\x used at %0 with no following hex digits",
FFEBAD_severityFATAL);
ffelex_bad_here_ (0, line, column);
ffebad_finish ();
}
else if (count == 0)
;
else if ((count - 1) * 4 >= TYPE_PRECISION (integer_type_node)
|| (count > 1
&& ((1 << (TYPE_PRECISION (integer_type_node) - (count - 1) * 4))
<= (int) firstdig)))
{
ffebad_start_msg_lex ("Hex escape at %0 out of range",
FFEBAD_severityPEDANTIC);
ffelex_bad_here_ (0, line, column);
ffebad_finish ();
}
break;
case 3:
if ((c <= '7') && (c >= '0') && (count++ < 3))
{
code = (code * 8) + (c - '0');
return EOF;
}
state = 0;
break;
default:
assert ("bad backslash state" == NULL);
abort ();
}
if (!wide_flag
&& TYPE_PRECISION (char_type_node) < HOST_BITS_PER_INT
&& code >= (1 << TYPE_PRECISION (char_type_node)))
{
ffebad_start_msg_lex ("Escape sequence at %0 out of range for character",
FFEBAD_severityFATAL);
ffelex_bad_here_ (0, line, column);
ffebad_finish ();
}
if (c == EOF)
{
ffelex_append_to_token_ (code);
if (ffelex_raw_mode_ > 0)
--ffelex_raw_mode_;
return EOF;
}
ffelex_append_to_token_ (code);
if (ffelex_raw_mode_ > 0)
--ffelex_raw_mode_;
ffelex_backslash_reconsider_ = TRUE;
return c;
}
static void
ffelex_bad_1_ (ffebad errnum, ffewhereLineNumber ln0, ffewhereColumnNumber cn0)
{
ffewhereLine wl0;
ffewhereColumn wc0;
wl0 = ffewhere_line_new (ln0);
wc0 = ffewhere_column_new (cn0);
ffebad_start_lex (errnum);
ffebad_here (0, wl0, wc0);
ffebad_finish ();
ffewhere_line_kill (wl0);
ffewhere_column_kill (wc0);
}
static void
ffelex_bad_2_ (ffebad errnum, ffewhereLineNumber ln0, ffewhereColumnNumber cn0,
ffewhereLineNumber ln1, ffewhereColumnNumber cn1)
{
ffewhereLine wl0, wl1;
ffewhereColumn wc0, wc1;
wl0 = ffewhere_line_new (ln0);
wc0 = ffewhere_column_new (cn0);
wl1 = ffewhere_line_new (ln1);
wc1 = ffewhere_column_new (cn1);
ffebad_start_lex (errnum);
ffebad_here (0, wl0, wc0);
ffebad_here (1, wl1, wc1);
ffebad_finish ();
ffewhere_line_kill (wl0);
ffewhere_column_kill (wc0);
ffewhere_line_kill (wl1);
ffewhere_column_kill (wc1);
}
static void
ffelex_bad_here_ (int n, ffewhereLineNumber ln0,
ffewhereColumnNumber cn0)
{
ffewhereLine wl0;
ffewhereColumn wc0;
wl0 = ffewhere_line_new (ln0);
wc0 = ffewhere_column_new (cn0);
ffebad_here (n, wl0, wc0);
ffewhere_line_kill (wl0);
ffewhere_column_kill (wc0);
}
static int
ffelex_getc_ (FILE *finput)
{
int c;
if (ffelex_kludge_chars_ == NULL)
return getc (finput);
c = *ffelex_kludge_chars_++;
if (c != 0)
return c;
ffelex_kludge_chars_ = NULL;
return getc (finput);
}
static int
ffelex_cfebackslash_ (int *use_d, int *d, FILE *finput)
{
register int c = getc (finput);
register int code;
register unsigned count;
unsigned firstdig = 0;
int nonnull;
*use_d = 0;
switch (c)
{
case 'x':
code = 0;
count = 0;
nonnull = 0;
while (1)
{
c = getc (finput);
if (! ISXDIGIT (c))
{
*use_d = 1;
*d = c;
break;
}
code = (code * 16) + hex_value (c);
if (code != 0 || count != 0)
{
if (count == 0)
firstdig = code;
count++;
}
nonnull = 1;
}
if (! nonnull)
error ("\\x used with no following hex digits");
else if (count == 0)
;
else if ((count - 1) * 4 >= TYPE_PRECISION (integer_type_node)
|| (count > 1
&& (((unsigned) 1
<< (TYPE_PRECISION (integer_type_node) - (count - 1)
* 4))
<= firstdig)))
pedwarn ("hex escape out of range");
return code;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7':
code = 0;
count = 0;
while ((c <= '7') && (c >= '0') && (count++ < 3))
{
code = (code * 8) + (c - '0');
c = getc (finput);
}
*use_d = 1;
*d = c;
return code;
case '\\': case '\'': case '"':
return c;
case '\n':
ffelex_next_line_ ();
*use_d = 2;
return 0;
case EOF:
*use_d = 1;
*d = EOF;
return EOF;
case 'n':
return TARGET_NEWLINE;
case 't':
return TARGET_TAB;
case 'r':
return TARGET_CR;
case 'f':
return TARGET_FF;
case 'b':
return TARGET_BS;
case 'a':
return TARGET_BELL;
case 'v':
return TARGET_VT;
case 'e':
case 'E':
if (pedantic)
pedwarn ("non-ANSI-standard escape sequence, `\\%c'", c);
return 033;
case '?':
return c;
case '(':
case '{':
case '[':
case '%':
if (pedantic)
pedwarn ("non-ISO escape sequence `\\%c'", c);
return c;
}
if (c >= 040 && c < 0177)
pedwarn ("unknown escape sequence `\\%c'", c);
else
pedwarn ("unknown escape sequence: `\\' followed by char code 0x%x", c);
return c;
}
static int
ffelex_cfelex_ (ffelexToken *xtoken, FILE *finput, int c)
{
ffelexToken token;
char buff[129];
char *p;
char *q;
char *r;
register unsigned buffer_length;
if ((*xtoken != NULL) && !ffelex_kludge_flag_)
ffelex_token_kill (*xtoken);
switch (c)
{
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
buffer_length = ARRAY_SIZE (buff);
p = &buff[0];
q = p;
r = &buff[buffer_length];
for (;;)
{
*p++ = c;
if (p >= r)
{
register unsigned bytes_used = (p - q);
buffer_length *= 2;
q = (char *)xrealloc (q, buffer_length);
p = &q[bytes_used];
r = &q[buffer_length];
}
c = ffelex_getc_ (finput);
if (! ISDIGIT (c))
break;
}
*p = '\0';
token = ffelex_token_new_number (q, ffewhere_line_unknown (),
ffewhere_column_unknown ());
if (q != &buff[0])
free (q);
break;
case '\"':
buffer_length = ARRAY_SIZE (buff);
p = &buff[0];
q = p;
r = &buff[buffer_length];
c = ffelex_getc_ (finput);
for (;;)
{
bool done = FALSE;
int use_d = 0;
int d;
switch (c)
{
case '\"':
c = getc (finput);
done = TRUE;
break;
case '\\':
c = ffelex_cfebackslash_ (&use_d, &d, finput);
break;
case EOF:
case '\n':
error ("badly formed directive -- no closing quote");
done = TRUE;
break;
default:
break;
}
if (done)
break;
if (use_d != 2)
{
*p++ = c;
if (p >= r)
{
register unsigned bytes_used = (p - q);
buffer_length = bytes_used * 2;
q = (char *)xrealloc (q, buffer_length);
p = &q[bytes_used];
r = &q[buffer_length];
}
}
if (use_d == 1)
c = d;
else
c = getc (finput);
}
*p = '\0';
token = ffelex_token_new_character (q, ffewhere_line_unknown (),
ffewhere_column_unknown ());
if (q != &buff[0])
free (q);
break;
default:
token = NULL;
break;
}
*xtoken = token;
return c;
}
static void
ffelex_file_pop_ (const char *input_filename)
{
if (input_file_stack->next)
{
struct file_stack *p = input_file_stack;
input_file_stack = p->next;
free (p);
input_file_stack_tick++;
(*debug_hooks->end_source_file) (input_file_stack->line);
}
else
error ("#-lines for entering and leaving files don't match");
if (input_file_stack)
input_file_stack->name = input_filename;
}
static void
ffelex_file_push_ (int old_lineno, const char *input_filename)
{
struct file_stack *p
= (struct file_stack *) xmalloc (sizeof (struct file_stack));
input_file_stack->line = old_lineno;
p->next = input_file_stack;
p->name = input_filename;
input_file_stack = p;
input_file_stack_tick++;
(*debug_hooks->start_source_file) (0, input_filename);
if (input_file_stack)
input_file_stack->name = input_filename;
}
static void
ffelex_prepare_eos_ ()
{
if (ffelex_token_->type != FFELEX_typeNONE)
{
ffelex_backslash_ (EOF, 0);
switch (ffelex_raw_mode_)
{
case -2:
break;
case -1:
ffebad_start_lex ((ffelex_raw_char_ == '\'') ? FFEBAD_NO_CLOSING_APOSTROPHE
: FFEBAD_NO_CLOSING_QUOTE);
ffebad_here (0, ffelex_token_->where_line, ffelex_token_->where_col);
ffebad_here (1, ffelex_current_wl_, ffelex_current_wc_);
ffebad_finish ();
break;
case 0:
break;
default:
{
char num[20];
ffebad_start_lex (FFEBAD_NOT_ENOUGH_HOLLERITH_CHARS);
ffebad_here (0, ffelex_token_->where_line, ffelex_token_->where_col);
ffebad_here (1, ffelex_current_wl_, ffelex_current_wc_);
sprintf (num, "%lu", (unsigned long) ffelex_raw_mode_);
ffebad_string (num);
ffebad_finish ();
do
{
ffelex_append_to_token_ (' ');
} while (--ffelex_raw_mode_ > 0);
break;
}
}
ffelex_raw_mode_ = 0;
ffelex_send_token_ ();
}
ffelex_token_->type = FFELEX_typeEOS;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_use (ffelex_current_wc_);
}
static void
ffelex_finish_statement_ ()
{
if ((ffelex_number_of_tokens_ == 0)
&& (ffelex_token_->type == FFELEX_typeNONE))
return;
if (ffelex_token_->type != FFELEX_typeEOS)
ffelex_prepare_eos_ ();
ffelex_permit_include_ = TRUE;
ffelex_send_token_ ();
ffelex_permit_include_ = FALSE;
ffelex_number_of_tokens_ = 0;
ffelex_label_tokens_ = 0;
ffelex_names_ = TRUE;
ffelex_names_pure_ = FALSE;
ffelex_hexnum_ = FALSE;
if (!ffe_is_ffedebug ())
return;
if (ffelex_total_tokens_ != ffelex_old_total_tokens_)
{
fprintf (dmpout, "; token_track had %ld tokens, now have %ld.\n",
ffelex_old_total_tokens_, ffelex_total_tokens_);
ffelex_old_total_tokens_ = ffelex_total_tokens_;
}
}
static int
ffelex_get_directive_line_ (char **text, FILE *finput)
{
static char *directive_buffer = NULL;
static unsigned buffer_length = 0;
register char *p;
register char *buffer_limit;
register int looking_for = 0;
register int char_escaped = 0;
if (buffer_length == 0)
{
directive_buffer = (char *)xmalloc (128);
buffer_length = 128;
}
buffer_limit = &directive_buffer[buffer_length];
for (p = directive_buffer; ; )
{
int c;
if (p >= buffer_limit)
{
register unsigned bytes_used = (p - directive_buffer);
buffer_length *= 2;
directive_buffer
= (char *)xrealloc (directive_buffer, buffer_length);
p = &directive_buffer[bytes_used];
buffer_limit = &directive_buffer[buffer_length];
}
c = getc (finput);
if ((c == ' ' || c == '\t') && p == directive_buffer)
continue;
if ((c == '\n' && looking_for == 0)
|| c == EOF)
{
if (looking_for != 0)
error ("bad directive -- missing close-quote");
*p++ = '\0';
*text = directive_buffer;
return c;
}
*p++ = c;
if (c == '\n')
ffelex_next_line_ ();
if (looking_for)
{
if (looking_for == c && !char_escaped)
looking_for = 0;
}
else
if (c == '\'' || c == '"')
looking_for = c;
char_escaped = (c == '\\' && ! char_escaped);
}
}
#if defined HANDLE_PRAGMA
static int
pragma_getc ()
{
return getc (finput);
}
static void
pragma_ungetc (arg)
int arg;
{
ungetc (arg, finput);
}
#endif
static int
ffelex_hash_ (FILE *finput)
{
register int c;
ffelexToken token = NULL;
c = ffelex_getc_ (finput);
while (c == ' ' || c == '\t')
c = ffelex_getc_ (finput);
if (ISALPHA(c))
{
if (c == 'p')
{
if (getc (finput) == 'r'
&& getc (finput) == 'a'
&& getc (finput) == 'g'
&& getc (finput) == 'm'
&& getc (finput) == 'a'
&& ((c = getc (finput)) == ' ' || c == '\t' || c == '\n'
|| c == EOF))
{
#if 0
static char buffer [128];
char * buff = buffer;
while (((c = getc (finput)), ISSPACE(c)))
continue;
do
{
* buff ++ = c;
c = getc (finput);
}
while (c != EOF && ! ISSPACE (c) && c != '\n'
&& buff < buffer + 128);
pragma_ungetc (c);
* -- buff = 0;
#ifdef HANDLE_PRAGMA
if (HANDLE_PRAGMA (pragma_getc, pragma_ungetc, buffer))
goto skipline;
#endif
#ifdef HANDLE_GENERIC_PRAGMAS
if (handle_generic_pragma (buffer))
goto skipline;
#endif
if (warn_unknown_pragmas > 1
|| (warn_unknown_pragmas && ! in_system_header))
warning ("ignoring pragma: %s", token_buffer);
#endif
goto skipline;
}
}
else if (c == 'd')
{
if (getc (finput) == 'e'
&& getc (finput) == 'f'
&& getc (finput) == 'i'
&& getc (finput) == 'n'
&& getc (finput) == 'e'
&& ((c = getc (finput)) == ' ' || c == '\t' || c == '\n'
|| c == EOF))
{
char *text;
c = ffelex_get_directive_line_ (&text, finput);
if (debug_info_level == DINFO_LEVEL_VERBOSE)
(*debug_hooks->define) (lineno, text);
goto skipline;
}
}
else if (c == 'u')
{
if (getc (finput) == 'n'
&& getc (finput) == 'd'
&& getc (finput) == 'e'
&& getc (finput) == 'f'
&& ((c = getc (finput)) == ' ' || c == '\t' || c == '\n'
|| c == EOF))
{
char *text;
c = ffelex_get_directive_line_ (&text, finput);
if (debug_info_level == DINFO_LEVEL_VERBOSE)
(*debug_hooks->undef) (lineno, text);
goto skipline;
}
}
else if (c == 'l')
{
if (getc (finput) == 'i'
&& getc (finput) == 'n'
&& getc (finput) == 'e'
&& ((c = getc (finput)) == ' ' || c == '\t'))
goto linenum;
}
else if (c == 'i')
{
if (getc (finput) == 'd'
&& getc (finput) == 'e'
&& getc (finput) == 'n'
&& getc (finput) == 't'
&& ((c = getc (finput)) == ' ' || c == '\t'))
{
while (c == ' ' || c == '\t')
c = getc (finput);
if (c == '\n' || c == EOF)
return c;
c = ffelex_cfelex_ (&token, finput, c);
if ((token == NULL)
|| (ffelex_token_type (token) != FFELEX_typeCHARACTER))
{
error ("invalid #ident");
goto skipline;
}
if (! flag_no_ident)
{
#ifdef ASM_OUTPUT_IDENT
ASM_OUTPUT_IDENT (asm_out_file,
ffelex_token_text (token));
#endif
}
goto skipline;
}
}
error ("undefined or invalid # directive");
goto skipline;
}
linenum:
while (c == ' ' || c == '\t')
c = ffelex_getc_ (finput);
if (c == '\n' || c == EOF)
return c;
c = ffelex_cfelex_ (&token, finput, c);
if ((token != NULL)
&& (ffelex_token_type (token) == FFELEX_typeNUMBER))
{
int old_lineno = lineno;
const char *old_input_filename = input_filename;
ffewhereFile wf;
int l = atoi (ffelex_token_text (token)) - 1;
while (c == ' ' || c == '\t')
c = ffelex_getc_ (finput);
if (c == '\n' || c == EOF)
{
lineno = l;
if (!ffelex_kludge_flag_)
{
ffewhere_file_set (NULL, TRUE, (ffewhereLineNumber) l);
if (token != NULL)
ffelex_token_kill (token);
}
return c;
}
c = ffelex_cfelex_ (&token, finput, c);
if ((token == NULL)
|| (ffelex_token_type (token) != FFELEX_typeCHARACTER))
{
error ("invalid #line");
goto skipline;
}
lineno = l;
if (ffelex_kludge_flag_)
input_filename = ggc_strdup (ffelex_token_text (token));
else
{
wf = ffewhere_file_new (ffelex_token_text (token),
ffelex_token_length (token));
input_filename = ffewhere_file_name (wf);
ffewhere_file_set (wf, TRUE, (ffewhereLineNumber) l);
}
#if 0
in_system_header = 0;
#endif
if (main_input_filename == 0)
main_input_filename = input_filename;
while (c == ' ' || c == '\t')
c = getc (finput);
if (c == '\n' || c == EOF)
{
if (!ffelex_kludge_flag_)
{
if (input_file_stack)
input_file_stack->name = input_filename;
if (token != NULL)
ffelex_token_kill (token);
}
return c;
}
c = ffelex_cfelex_ (&token, finput, c);
if ((token != NULL)
&& (ffelex_token_type (token) == FFELEX_typeNUMBER))
{
int num = atoi (ffelex_token_text (token));
if (ffelex_kludge_flag_)
{
lineno = 1;
input_filename = old_input_filename;
error ("use `#line ...' instead of `# ...' in first line");
}
if (num == 1)
{
ffelex_file_push_ (old_lineno, input_filename);
}
else if (num == 2)
{
ffelex_file_pop_ (input_filename);
}
while (c == ' ' || c == '\t')
c = getc (finput);
if (c == '\n' || c == EOF)
{
if (token != NULL)
ffelex_token_kill (token);
return c;
}
c = ffelex_cfelex_ (&token, finput, c);
}
#if 0
if ((token != NULL)
&& (ffelex_token_type (token) == FFELEX_typeNUMBER)
&& (atoi (ffelex_token_text (token)) == 3))
in_system_header = 1;
#endif
while (c == ' ' || c == '\t')
c = getc (finput);
if (((token != NULL)
|| (c != '\n' && c != EOF))
&& ffelex_kludge_flag_)
{
lineno = 1;
input_filename = old_input_filename;
error ("use `#line ...' instead of `# ...' in first line");
}
if (c == '\n' || c == EOF)
{
if (token != NULL && !ffelex_kludge_flag_)
ffelex_token_kill (token);
return c;
}
}
else
error ("invalid #-line");
skipline:
if ((token != NULL) && !ffelex_kludge_flag_)
ffelex_token_kill (token);
while ((c = getc (finput)) != EOF && c != '\n')
;
return c;
}
static ffewhereColumnNumber
ffelex_image_char_ (int c, ffewhereColumnNumber column)
{
ffewhereColumnNumber old_column = column;
if (column >= ffelex_card_size_)
{
ffewhereColumnNumber newmax = ffelex_card_size_ << 1;
if (ffelex_bad_line_)
return column;
if ((newmax >> 1) != ffelex_card_size_)
{
overflow:
ffelex_bad_line_ = TRUE;
strcpy (&ffelex_card_image_[column - 3], "...");
ffelex_card_length_ = column;
ffelex_bad_1_ (FFEBAD_LINE_TOO_LONG,
ffelex_linecount_current_, column + 1);
return column;
}
ffelex_card_image_
= malloc_resize_ksr (malloc_pool_image (),
ffelex_card_image_,
newmax + 9,
ffelex_card_size_ + 9);
ffelex_card_size_ = newmax;
}
switch (c)
{
case '\r':
break;
case '\t':
ffelex_saw_tab_ = TRUE;
ffelex_card_image_[column++] = ' ';
while ((column & 7) != 0)
ffelex_card_image_[column++] = ' ';
break;
case '\0':
if (!ffelex_bad_line_)
{
ffelex_bad_line_ = TRUE;
strcpy (&ffelex_card_image_[column], "[\\0]");
ffelex_card_length_ = column + 4;
ffebad_start_msg_lex ("Null character at %0 -- line ignored",
FFEBAD_severityFATAL);
ffelex_bad_here_ (0, ffelex_linecount_current_, column + 1);
ffebad_finish ();
column += 4;
}
break;
default:
ffelex_card_image_[column++] = c;
break;
}
if (column < old_column)
{
column = old_column;
goto overflow;
}
return column;
}
static void
ffelex_include_ ()
{
ffewhereFile include_wherefile = ffelex_include_wherefile_;
FILE *include_file = ffelex_include_file_;
char *card_image;
ffewhereColumnNumber card_size = ffelex_card_size_;
ffewhereColumnNumber card_length = ffelex_card_length_;
ffewhereLine current_wl = ffelex_current_wl_;
ffewhereColumn current_wc = ffelex_current_wc_;
bool saw_tab = ffelex_saw_tab_;
ffewhereColumnNumber final_nontab_column = ffelex_final_nontab_column_;
ffewhereFile current_wf = ffelex_current_wf_;
ffewhereLineNumber linecount_current = ffelex_linecount_current_;
ffewhereLineNumber linecount_offset
= ffewhere_line_filelinenum (current_wl);
int old_lineno = lineno;
const char *old_input_filename = input_filename;
if (card_length != 0)
{
card_image = malloc_new_ks (malloc_pool_image (),
"FFELEX saved card image",
card_length);
memcpy (card_image, ffelex_card_image_, card_length);
}
else
card_image = NULL;
ffelex_set_include_ = FALSE;
ffelex_next_line_ ();
ffewhere_file_set (include_wherefile, TRUE, 0);
ffelex_file_push_ (old_lineno, ffewhere_file_name (include_wherefile));
if (ffelex_include_free_form_)
ffelex_file_free (include_wherefile, include_file);
else
ffelex_file_fixed (include_wherefile, include_file);
ffelex_file_pop_ (ffewhere_file_name (current_wf));
ffewhere_file_set (current_wf, TRUE, linecount_offset);
ffecom_close_include (include_file);
if (card_length != 0)
{
#ifdef REDUCE_CARD_SIZE_AFTER_BIGGY
#error "need to handle possible reduction of card size here!!"
#endif
assert (ffelex_card_size_ >= card_length);
memcpy (ffelex_card_image_, card_image, card_length);
}
ffelex_card_image_[card_length] = '\0';
input_filename = old_input_filename;
lineno = old_lineno;
ffelex_linecount_current_ = linecount_current;
ffelex_current_wf_ = current_wf;
ffelex_final_nontab_column_ = final_nontab_column;
ffelex_saw_tab_ = saw_tab;
ffelex_current_wc_ = current_wc;
ffelex_current_wl_ = current_wl;
ffelex_card_length_ = card_length;
ffelex_card_size_ = card_size;
}
static bool
ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col)
{
while (ffelex_card_image_[col] != '\0')
{
if (ffelex_card_image_[col++] != ' ')
return FALSE;
}
return TRUE;
}
static bool
ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col)
{
while ((ffelex_card_image_[col] != '\0') && (ffelex_card_image_[col] != '!'))
{
if (ffelex_card_image_[col++] != ' ')
return FALSE;
}
return TRUE;
}
static void
ffelex_next_line_ ()
{
ffelex_linecount_current_ = ffelex_linecount_next_;
++ffelex_linecount_next_;
++lineno;
}
static void
ffelex_send_token_ ()
{
++ffelex_number_of_tokens_;
ffelex_backslash_ (EOF, 0);
if (ffelex_token_->text == NULL)
{
if (ffelex_token_->type == FFELEX_typeCHARACTER)
{
ffelex_append_to_token_ ('\0');
ffelex_token_->length = 0;
}
}
else
ffelex_token_->text[ffelex_token_->length] = '\0';
assert (ffelex_raw_mode_ == 0);
if (ffelex_token_->type == FFELEX_typeNAMES)
{
ffewhere_line_kill (ffelex_token_->currentnames_line);
ffewhere_column_kill (ffelex_token_->currentnames_col);
}
assert (ffelex_handler_ != NULL);
ffelex_handler_ = (ffelexHandler) (*ffelex_handler_) (ffelex_token_);
assert (ffelex_handler_ != NULL);
ffelex_token_kill (ffelex_token_);
ffelex_token_ = ffelex_token_new_ ();
ffelex_token_->uses = 1;
ffelex_token_->text = NULL;
if (ffelex_raw_mode_ < 0)
{
ffelex_token_->type = FFELEX_typeCHARACTER;
ffelex_token_->where_line = ffelex_raw_where_line_;
ffelex_token_->where_col = ffelex_raw_where_col_;
ffelex_raw_where_line_ = ffewhere_line_unknown ();
ffelex_raw_where_col_ = ffewhere_column_unknown ();
}
else
{
ffelex_token_->type = FFELEX_typeNONE;
ffelex_token_->where_line = ffewhere_line_unknown ();
ffelex_token_->where_col = ffewhere_column_unknown ();
}
if (ffelex_set_include_)
ffelex_include_ ();
}
static ffelexHandler
ffelex_swallow_tokens_ (ffelexToken t)
{
assert (ffelex_eos_handler_ != NULL);
if ((ffelex_token_type (t) == FFELEX_typeEOS)
|| (ffelex_token_type (t) == FFELEX_typeSEMICOLON))
return (ffelexHandler) (*ffelex_eos_handler_) (t);
return (ffelexHandler) ffelex_swallow_tokens_;
}
static ffelexToken
ffelex_token_new_ ()
{
ffelexToken t;
++ffelex_total_tokens_;
t = (ffelexToken) malloc_new_ks (malloc_pool_image (),
"FFELEX token", sizeof (*t));
t->id_ = ffelex_token_nextid_++;
return t;
}
static const char *
ffelex_type_string_ (ffelexType type)
{
static const char *const types[] = {
"FFELEX_typeNONE",
"FFELEX_typeCOMMENT",
"FFELEX_typeEOS",
"FFELEX_typeEOF",
"FFELEX_typeERROR",
"FFELEX_typeRAW",
"FFELEX_typeQUOTE",
"FFELEX_typeDOLLAR",
"FFELEX_typeHASH",
"FFELEX_typePERCENT",
"FFELEX_typeAMPERSAND",
"FFELEX_typeAPOSTROPHE",
"FFELEX_typeOPEN_PAREN",
"FFELEX_typeCLOSE_PAREN",
"FFELEX_typeASTERISK",
"FFELEX_typePLUS",
"FFELEX_typeMINUS",
"FFELEX_typePERIOD",
"FFELEX_typeSLASH",
"FFELEX_typeNUMBER",
"FFELEX_typeOPEN_ANGLE",
"FFELEX_typeEQUALS",
"FFELEX_typeCLOSE_ANGLE",
"FFELEX_typeNAME",
"FFELEX_typeCOMMA",
"FFELEX_typePOWER",
"FFELEX_typeCONCAT",
"FFELEX_typeDEBUG",
"FFELEX_typeNAMES",
"FFELEX_typeHOLLERITH",
"FFELEX_typeCHARACTER",
"FFELEX_typeCOLON",
"FFELEX_typeSEMICOLON",
"FFELEX_typeUNDERSCORE",
"FFELEX_typeQUESTION",
"FFELEX_typeOPEN_ARRAY",
"FFELEX_typeCLOSE_ARRAY",
"FFELEX_typeCOLONCOLON",
"FFELEX_typeREL_LE",
"FFELEX_typeREL_NE",
"FFELEX_typeREL_EQ",
"FFELEX_typePOINTS",
"FFELEX_typeREL_GE"
};
if (type >= ARRAY_SIZE (types))
return "???";
return types[type];
}
void
ffelex_display_token (ffelexToken t)
{
if (t == NULL)
t = ffelex_token_;
fprintf (dmpout, "; Token #%lu is %s (line %" ffewhereLineNumber_f "u, col %"
ffewhereColumnNumber_f "u)",
t->id_,
ffelex_type_string_ (t->type),
ffewhere_line_number (t->where_line),
ffewhere_column_number (t->where_col));
if (t->text != NULL)
fprintf (dmpout, ": \"%.*s\"\n",
(int) t->length,
t->text);
else
fprintf (dmpout, ".\n");
}
bool
ffelex_expecting_character ()
{
return (ffelex_raw_mode_ != 0);
}
ffelexHandler
ffelex_file_fixed (ffewhereFile wf, FILE *f)
{
register int c = 0;
register ffewhereColumnNumber column = 0;
bool disallow_continuation_line;
bool ignore_disallowed_continuation = FALSE;
int latest_char_in_file = 0;
ffelexType lextype;
ffewhereColumnNumber first_label_char;
char label_string[6];
int labi;
bool finish_statement;
bool have_content;
bool just_do_label;
assert (ffelex_handler_ != NULL);
lineno = 0;
input_filename = ffewhere_file_name (wf);
ffelex_current_wf_ = wf;
disallow_continuation_line = TRUE;
ignore_disallowed_continuation = FALSE;
ffelex_token_->type = FFELEX_typeNONE;
ffelex_number_of_tokens_ = 0;
ffelex_label_tokens_ = 0;
ffelex_current_wl_ = ffewhere_line_unknown ();
ffelex_current_wc_ = ffewhere_column_unknown ();
latest_char_in_file = '\n';
goto first_line;
beginning_of_line:
disallow_continuation_line = FALSE;
beginning_of_line_again:
#ifdef REDUCE_CARD_SIZE_AFTER_BIGGY
if (ffelex_card_size_ != FFELEX_columnINITIAL_SIZE_)
{
ffelex_card_image_
= malloc_resize_ks (malloc_pool_image (),
ffelex_card_image_,
FFELEX_columnINITIAL_SIZE_ + 9,
ffelex_card_size_ + 9);
ffelex_card_size_ = FFELEX_columnINITIAL_SIZE_;
}
#endif
first_line:
c = latest_char_in_file;
if ((c == EOF) || ((c = ffelex_getc_ (f)) == EOF))
{
end_of_file:
ffelex_finish_statement_ ();
ffewhere_line_kill (ffelex_current_wl_);
ffewhere_column_kill (ffelex_current_wc_);
return (ffelexHandler) ffelex_handler_;
}
ffelex_next_line_ ();
ffelex_bad_line_ = FALSE;
while (((lextype = ffelex_first_char_[c]) == FFELEX_typeCOMMENT)
|| (lextype == FFELEX_typeERROR)
|| (lextype == FFELEX_typeSLASH)
|| (lextype == FFELEX_typeHASH))
{
if ((lextype == FFELEX_typeCOMMENT)
|| ((lextype == FFELEX_typeSLASH)
&& ((c = getc (f)) == '*')))
{
comment_line:
while ((c != '\n') && (c != EOF))
c = getc (f);
}
else if (lextype == FFELEX_typeHASH)
c = ffelex_hash_ (f);
else if (lextype == FFELEX_typeSLASH)
{
ffelex_card_image_[0] = '/';
ffelex_card_image_[1] = c;
column = 2;
goto bad_first_character;
}
else
{
column = ffelex_image_char_ (c, 0);
bad_first_character:
ffelex_bad_line_ = TRUE;
while (((c = getc (f)) != '\n') && (c != EOF))
column = ffelex_image_char_ (c, column);
ffelex_card_image_[column] = '\0';
ffelex_card_length_ = column;
ffelex_bad_1_ (FFEBAD_FIRST_CHAR_INVALID,
ffelex_linecount_current_, 1);
}
if (c == EOF)
{
ffelex_next_line_ ();
goto end_of_file;
}
c = getc (f);
ffelex_next_line_ ();
if (c == EOF)
goto end_of_file;
ffelex_bad_line_ = FALSE;
}
ffelex_saw_tab_
= (c == '&')
|| (ffelex_final_nontab_column_ == 0);
if (lextype == FFELEX_typeDEBUG)
c = ' ';
column = ffelex_image_char_ (c, 0);
while (((c = getc (f)) != '\n') && (c != EOF))
column = ffelex_image_char_ (c, column);
if (ffelex_bad_line_)
{
ffelex_card_image_[column] = '\0';
ffelex_card_length_ = column;
goto comment_line;
}
if (!ffelex_saw_tab_ && (column > ffelex_final_nontab_column_))
{
column = ffelex_final_nontab_column_;
}
ffelex_card_image_[column] = '\0';
ffelex_card_length_ = column;
latest_char_in_file = c;
have_content = FALSE;
labi = 0;
first_label_char = FFEWHERE_columnUNKNOWN;
for (column = 0; column < 5; ++column)
{
switch (c = ffelex_card_image_[column])
{
case '\0':
case '!':
goto stop_looking;
case ' ':
break;
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
label_string[labi++] = c;
if (first_label_char == FFEWHERE_columnUNKNOWN)
first_label_char = column + 1;
break;
case '&':
if (column != 0)
{
ffelex_bad_1_ (FFEBAD_LABEL_FIELD_NOT_NUMERIC,
ffelex_linecount_current_,
column + 1);
goto beginning_of_line_again;
}
if (ffe_is_pedantic ())
ffelex_bad_1_ (FFEBAD_AMPERSAND,
ffelex_linecount_current_, 1);
finish_statement = FALSE;
just_do_label = FALSE;
goto got_a_continuation;
case '/':
if (ffelex_card_image_[column + 1] == '*')
goto stop_looking;
default:
ffelex_bad_1_ (FFEBAD_LABEL_FIELD_NOT_NUMERIC,
ffelex_linecount_current_, column + 1);
goto beginning_of_line_again;
}
}
stop_looking:
label_string[labi] = '\0';
if (column == 5)
while ((c = ffelex_card_image_[column]) == ' ')
++column;
finish_statement = FALSE;
just_do_label = FALSE;
switch (c)
{
case '!':
if (ffe_is_vxt () || (column != 5))
goto no_tokens_on_line;
goto got_a_continuation;
case '/':
if (ffelex_card_image_[column + 1] != '*')
goto some_other_character;
if (column == 5)
{
goto got_a_continuation;
}
case '\0':
no_tokens_on_line:
if (ffe_is_pedantic () && (c == '/'))
ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT,
ffelex_linecount_current_, column + 1);
if (first_label_char != FFEWHERE_columnUNKNOWN)
{
finish_statement = TRUE;
have_content = TRUE;
just_do_label = TRUE;
break;
}
goto beginning_of_line_again;
case '0':
if (ffe_is_pedantic () && (column != 5))
ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN,
ffelex_linecount_current_, column + 1);
finish_statement = TRUE;
goto check_for_content;
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
got_a_continuation:
if (first_label_char != FFEWHERE_columnUNKNOWN)
{
ffelex_bad_2_ (FFEBAD_LABEL_ON_CONTINUATION,
ffelex_linecount_current_,
first_label_char,
ffelex_linecount_current_,
column + 1);
first_label_char = FFEWHERE_columnUNKNOWN;
}
if (disallow_continuation_line)
{
if (!ignore_disallowed_continuation)
ffelex_bad_1_ (FFEBAD_INVALID_CONTINUATION,
ffelex_linecount_current_, column + 1);
goto beginning_of_line_again;
}
if (ffe_is_pedantic () && (column != 5))
ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN,
ffelex_linecount_current_, column + 1);
if ((ffelex_raw_mode_ != 0)
&& (((c = ffelex_card_image_[column + 1]) != '\0')
|| !ffelex_saw_tab_))
{
++column;
have_content = TRUE;
break;
}
check_for_content:
while ((c = ffelex_card_image_[++column]) == ' ')
;
if ((c == '\0')
|| (c == '!')
|| ((c == '/')
&& (ffelex_card_image_[column + 1] == '*')))
{
if (ffe_is_pedantic () && (c == '/'))
ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT,
ffelex_linecount_current_, column + 1);
just_do_label = TRUE;
}
else
have_content = TRUE;
break;
default:
some_other_character:
if (column == 5)
goto got_a_continuation;
finish_statement = TRUE;
have_content = TRUE;
break;
}
if (have_content
|| (first_label_char != FFEWHERE_columnUNKNOWN))
{
if (finish_statement)
ffelex_prepare_eos_ ();
ffewhere_line_kill (ffelex_current_wl_);
ffewhere_column_kill (ffelex_current_wc_);
ffelex_current_wl_ = ffewhere_line_new (ffelex_linecount_current_);
ffelex_current_wc_ = ffewhere_column_new (ffelex_card_length_ + 1);
}
if (finish_statement)
ffelex_finish_statement_ ();
if (first_label_char != FFEWHERE_columnUNKNOWN)
{
assert (ffelex_token_->type == FFELEX_typeNONE);
ffelex_token_->type = FFELEX_typeNUMBER;
ffelex_append_to_token_ ('\0');
strcpy (ffelex_token_->text, label_string);
ffelex_token_->where_line
= ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (first_label_char);
ffelex_token_->length = labi;
ffelex_send_token_ ();
++ffelex_label_tokens_;
}
if (just_do_label)
goto beginning_of_line;
if (ffelex_raw_mode_ != 0)
{
parse_raw_character:
if (c == '\0')
{
ffewhereColumnNumber i;
if (ffelex_saw_tab_ || (column >= ffelex_final_nontab_column_))
goto beginning_of_line;
for (i = column; i < ffelex_final_nontab_column_; ++i)
ffelex_card_image_[i] = ' ';
ffelex_card_image_[i] = '\0';
ffelex_card_length_ = i;
c = ' ';
}
switch (ffelex_raw_mode_)
{
case -3:
c = ffelex_backslash_ (c, column);
if (c == EOF)
break;
if (!ffelex_backslash_reconsider_)
ffelex_append_to_token_ (c);
ffelex_raw_mode_ = -1;
break;
case -2:
if (c == ffelex_raw_char_)
{
ffelex_raw_mode_ = -1;
ffelex_append_to_token_ (c);
}
else
{
ffelex_raw_mode_ = 0;
ffelex_backslash_reconsider_ = TRUE;
}
break;
case -1:
if (c == ffelex_raw_char_)
ffelex_raw_mode_ = -2;
else
{
c = ffelex_backslash_ (c, column);
if (c == EOF)
{
ffelex_raw_mode_ = -3;
break;
}
ffelex_append_to_token_ (c);
}
break;
default:
c = ffelex_backslash_ (c, column);
if (c == EOF)
break;
if (!ffelex_backslash_reconsider_)
{
ffelex_append_to_token_ (c);
--ffelex_raw_mode_;
}
break;
}
if (ffelex_backslash_reconsider_)
ffelex_backslash_reconsider_ = FALSE;
else
c = ffelex_card_image_[++column];
if (ffelex_raw_mode_ == 0)
{
ffelex_send_token_ ();
assert (ffelex_raw_mode_ == 0);
while (c == ' ')
c = ffelex_card_image_[++column];
if ((c == '\0')
|| (c == '!')
|| ((c == '/')
&& (ffelex_card_image_[column + 1] == '*')))
goto beginning_of_line;
goto parse_nonraw_character;
}
goto parse_raw_character;
}
parse_nonraw_character:
switch (ffelex_token_->type)
{
case FFELEX_typeNONE:
switch (c)
{
case '\"':
ffelex_token_->type = FFELEX_typeQUOTE;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '$':
ffelex_token_->type = FFELEX_typeDOLLAR;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '%':
ffelex_token_->type = FFELEX_typePERCENT;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '&':
ffelex_token_->type = FFELEX_typeAMPERSAND;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '\'':
ffelex_token_->type = FFELEX_typeAPOSTROPHE;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '(':
ffelex_token_->type = FFELEX_typeOPEN_PAREN;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case ')':
ffelex_token_->type = FFELEX_typeCLOSE_PAREN;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '*':
ffelex_token_->type = FFELEX_typeASTERISK;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case '+':
ffelex_token_->type = FFELEX_typePLUS;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case ',':
ffelex_token_->type = FFELEX_typeCOMMA;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '-':
ffelex_token_->type = FFELEX_typeMINUS;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '.':
ffelex_token_->type = FFELEX_typePERIOD;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '/':
ffelex_token_->type = FFELEX_typeSLASH;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
ffelex_token_->type
= ffelex_hexnum_ ? FFELEX_typeNAME : FFELEX_typeNUMBER;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_append_to_token_ (c);
break;
case ':':
ffelex_token_->type = FFELEX_typeCOLON;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case ';':
ffelex_token_->type = FFELEX_typeSEMICOLON;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_permit_include_ = TRUE;
ffelex_send_token_ ();
ffelex_permit_include_ = FALSE;
break;
case '<':
ffelex_token_->type = FFELEX_typeOPEN_ANGLE;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case '=':
ffelex_token_->type = FFELEX_typeEQUALS;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case '>':
ffelex_token_->type = FFELEX_typeCLOSE_ANGLE;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case '?':
ffelex_token_->type = FFELEX_typeQUESTION;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '_':
if (1 || ffe_is_90 ())
{
ffelex_token_->type = FFELEX_typeUNDERSCORE;
ffelex_token_->where_line
= ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col
= ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
}
case 'A':
case 'B':
case 'C':
case 'D':
case 'E':
case 'F':
case 'G':
case 'H':
case 'I':
case 'J':
case 'K':
case 'L':
case 'M':
case 'N':
case 'O':
case 'P':
case 'Q':
case 'R':
case 'S':
case 'T':
case 'U':
case 'V':
case 'W':
case 'X':
case 'Y':
case 'Z':
case 'a':
case 'b':
case 'c':
case 'd':
case 'e':
case 'f':
case 'g':
case 'h':
case 'i':
case 'j':
case 'k':
case 'l':
case 'm':
case 'n':
case 'o':
case 'p':
case 'q':
case 'r':
case 's':
case 't':
case 'u':
case 'v':
case 'w':
case 'x':
case 'y':
case 'z':
c = ffesrc_char_source (c);
if (ffesrc_char_match_init (c, 'H', 'h')
&& ffelex_expecting_hollerith_ != 0)
{
ffelex_raw_mode_ = ffelex_expecting_hollerith_;
ffelex_token_->type = FFELEX_typeHOLLERITH;
ffelex_token_->where_line = ffelex_raw_where_line_;
ffelex_token_->where_col = ffelex_raw_where_col_;
ffelex_raw_where_line_ = ffewhere_line_unknown ();
ffelex_raw_where_col_ = ffewhere_column_unknown ();
c = ffelex_card_image_[++column];
goto parse_raw_character;
}
if (ffelex_names_)
{
ffelex_token_->where_line
= ffewhere_line_use (ffelex_token_->currentnames_line
= ffewhere_line_use (ffelex_current_wl_));
ffelex_token_->where_col
= ffewhere_column_use (ffelex_token_->currentnames_col
= ffewhere_column_new (column + 1));
ffelex_token_->type = FFELEX_typeNAMES;
}
else
{
ffelex_token_->where_line
= ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_token_->type = FFELEX_typeNAME;
}
ffelex_append_to_token_ (c);
break;
default:
ffelex_bad_1_ (FFEBAD_UNRECOGNIZED_CHARACTER,
ffelex_linecount_current_, column + 1);
ffelex_finish_statement_ ();
disallow_continuation_line = TRUE;
ignore_disallowed_continuation = TRUE;
goto beginning_of_line_again;
}
break;
case FFELEX_typeNAME:
switch (c)
{
case 'A':
case 'B':
case 'C':
case 'D':
case 'E':
case 'F':
case 'G':
case 'H':
case 'I':
case 'J':
case 'K':
case 'L':
case 'M':
case 'N':
case 'O':
case 'P':
case 'Q':
case 'R':
case 'S':
case 'T':
case 'U':
case 'V':
case 'W':
case 'X':
case 'Y':
case 'Z':
case 'a':
case 'b':
case 'c':
case 'd':
case 'e':
case 'f':
case 'g':
case 'h':
case 'i':
case 'j':
case 'k':
case 'l':
case 'm':
case 'n':
case 'o':
case 'p':
case 'q':
case 'r':
case 's':
case 't':
case 'u':
case 'v':
case 'w':
case 'x':
case 'y':
case 'z':
c = ffesrc_char_source (c);
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
case '_':
case '$':
if ((c == '$')
&& !ffe_is_dollar_ok ())
{
ffelex_send_token_ ();
goto parse_next_character;
}
ffelex_append_to_token_ (c);
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeNAMES:
switch (c)
{
case 'A':
case 'B':
case 'C':
case 'D':
case 'E':
case 'F':
case 'G':
case 'H':
case 'I':
case 'J':
case 'K':
case 'L':
case 'M':
case 'N':
case 'O':
case 'P':
case 'Q':
case 'R':
case 'S':
case 'T':
case 'U':
case 'V':
case 'W':
case 'X':
case 'Y':
case 'Z':
case 'a':
case 'b':
case 'c':
case 'd':
case 'e':
case 'f':
case 'g':
case 'h':
case 'i':
case 'j':
case 'k':
case 'l':
case 'm':
case 'n':
case 'o':
case 'p':
case 'q':
case 'r':
case 's':
case 't':
case 'u':
case 'v':
case 'w':
case 'x':
case 'y':
case 'z':
c = ffesrc_char_source (c);
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
case '_':
case '$':
if ((c == '$')
&& !ffe_is_dollar_ok ())
{
ffelex_send_token_ ();
goto parse_next_character;
}
if (ffelex_token_->length < FFEWHERE_indexMAX)
{
ffewhere_track (&ffelex_token_->currentnames_line,
&ffelex_token_->currentnames_col,
ffelex_token_->wheretrack,
ffelex_token_->length,
ffelex_linecount_current_,
column + 1);
}
ffelex_append_to_token_ (c);
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeNUMBER:
switch (c)
{
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
ffelex_append_to_token_ (c);
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeASTERISK:
switch (c)
{
case '*':
ffelex_token_->type = FFELEX_typePOWER;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeCOLON:
switch (c)
{
case ':':
ffelex_token_->type = FFELEX_typeCOLONCOLON;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeSLASH:
switch (c)
{
case '/':
ffelex_token_->type = FFELEX_typeCONCAT;
ffelex_send_token_ ();
break;
case ')':
ffelex_token_->type = FFELEX_typeCLOSE_ARRAY;
ffelex_send_token_ ();
break;
case '=':
ffelex_token_->type = FFELEX_typeREL_NE;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeOPEN_PAREN:
switch (c)
{
case '/':
ffelex_token_->type = FFELEX_typeOPEN_ARRAY;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeOPEN_ANGLE:
switch (c)
{
case '=':
ffelex_token_->type = FFELEX_typeREL_LE;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeEQUALS:
switch (c)
{
case '=':
ffelex_token_->type = FFELEX_typeREL_EQ;
ffelex_send_token_ ();
break;
case '>':
ffelex_token_->type = FFELEX_typePOINTS;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeCLOSE_ANGLE:
switch (c)
{
case '=':
ffelex_token_->type = FFELEX_typeREL_GE;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
default:
assert ("Serious error!!" == NULL);
abort ();
break;
}
c = ffelex_card_image_[++column];
parse_next_character:
if (ffelex_raw_mode_ != 0)
goto parse_raw_character;
while (c == ' ')
c = ffelex_card_image_[++column];
if ((c == '\0')
|| (c == '!')
|| ((c == '/')
&& (ffelex_card_image_[column + 1] == '*')))
{
if ((ffelex_number_of_tokens_ == ffelex_label_tokens_)
&& (ffelex_token_->type == FFELEX_typeNAMES)
&& (ffelex_token_->length == 3)
&& (ffesrc_strncmp_2c (ffe_case_match (),
ffelex_token_->text,
"END", "end", "End",
3)
== 0))
{
ffelex_finish_statement_ ();
disallow_continuation_line = TRUE;
ignore_disallowed_continuation = FALSE;
goto beginning_of_line_again;
}
goto beginning_of_line;
}
goto parse_nonraw_character;
}
ffelexHandler
ffelex_file_free (ffewhereFile wf, FILE *f)
{
register int c = 0;
register ffewhereColumnNumber column = 0;
bool continuation_line = FALSE;
ffewhereColumnNumber continuation_column;
int latest_char_in_file = 0;
assert (ffelex_handler_ != NULL);
lineno = 0;
input_filename = ffewhere_file_name (wf);
ffelex_current_wf_ = wf;
continuation_line = FALSE;
ffelex_token_->type = FFELEX_typeNONE;
ffelex_number_of_tokens_ = 0;
ffelex_current_wl_ = ffewhere_line_unknown ();
ffelex_current_wc_ = ffewhere_column_unknown ();
latest_char_in_file = '\n';
beginning_of_line:
c = latest_char_in_file;
if ((c == EOF) || ((c = ffelex_getc_ (f)) == EOF))
{
end_of_file:
ffelex_finish_statement_ ();
ffewhere_line_kill (ffelex_current_wl_);
ffewhere_column_kill (ffelex_current_wc_);
return (ffelexHandler) ffelex_handler_;
}
ffelex_next_line_ ();
ffelex_bad_line_ = FALSE;
while ((c == '\n')
|| (c == '!')
|| (c == '#'))
{
if (c == '#')
c = ffelex_hash_ (f);
comment_line:
while ((c != '\n') && (c != EOF))
c = getc (f);
if (c == EOF)
{
ffelex_next_line_ ();
goto end_of_file;
}
c = getc (f);
ffelex_next_line_ ();
if (c == EOF)
goto end_of_file;
}
ffelex_saw_tab_ = FALSE;
column = ffelex_image_char_ (c, 0);
while (((c = getc (f)) != '\n') && (c != EOF))
column = ffelex_image_char_ (c, column);
if (ffelex_bad_line_)
{
ffelex_card_image_[column] = '\0';
ffelex_card_length_ = column;
goto comment_line;
}
if (!ffelex_saw_tab_ && (column > FFELEX_FREE_MAX_COLUMNS_))
column = FFELEX_FREE_MAX_COLUMNS_;
ffelex_card_image_[column] = '\0';
ffelex_card_length_ = column;
latest_char_in_file = c;
column = 0;
continuation_column = 0;
while ((c = ffelex_card_image_[column]) == ' ')
++column;
switch (c)
{
case '!':
case '\0':
goto beginning_of_line;
case '&':
continuation_column = column + 1;
break;
default:
break;
}
ffewhere_line_kill (ffelex_current_wl_);
ffewhere_column_kill (ffelex_current_wc_);
ffelex_current_wl_ = ffewhere_line_new (ffelex_linecount_current_);
ffelex_current_wc_ = ffewhere_column_new (ffelex_card_length_ + 1);
if (continuation_line)
{
if (continuation_column == 0)
{
if (ffelex_raw_mode_ != 0)
{
ffelex_bad_1_ (FFEBAD_BAD_CHAR_CONTINUE,
ffelex_linecount_current_, column + 1);
}
else if (ffelex_token_->type != FFELEX_typeNONE)
{
ffelex_bad_1_ (FFEBAD_BAD_LEXTOK_CONTINUE,
ffelex_linecount_current_, column + 1);
}
}
else if (ffelex_is_free_char_ctx_contin_ (continuation_column))
{
ffelex_bad_1_ (FFEBAD_BAD_FREE_CONTINUE,
ffelex_linecount_current_, continuation_column);
goto beginning_of_line;
}
column = continuation_column;
}
else
column = 0;
c = ffelex_card_image_[column];
continuation_line = FALSE;
if (ffelex_raw_mode_ != 0)
{
parse_raw_character:
switch (c)
{
case '&':
if (ffelex_is_free_char_ctx_contin_ (column + 1))
{
continuation_line = TRUE;
goto beginning_of_line;
}
break;
case '\0':
ffelex_finish_statement_ ();
goto beginning_of_line;
default:
break;
}
switch (ffelex_raw_mode_)
{
case -3:
c = ffelex_backslash_ (c, column);
if (c == EOF)
break;
if (!ffelex_backslash_reconsider_)
ffelex_append_to_token_ (c);
ffelex_raw_mode_ = -1;
break;
case -2:
if (c == ffelex_raw_char_)
{
ffelex_raw_mode_ = -1;
ffelex_append_to_token_ (c);
}
else
{
ffelex_raw_mode_ = 0;
ffelex_backslash_reconsider_ = TRUE;
}
break;
case -1:
if (c == ffelex_raw_char_)
ffelex_raw_mode_ = -2;
else
{
c = ffelex_backslash_ (c, column);
if (c == EOF)
{
ffelex_raw_mode_ = -3;
break;
}
ffelex_append_to_token_ (c);
}
break;
default:
c = ffelex_backslash_ (c, column);
if (c == EOF)
break;
if (!ffelex_backslash_reconsider_)
{
ffelex_append_to_token_ (c);
--ffelex_raw_mode_;
}
break;
}
if (ffelex_backslash_reconsider_)
ffelex_backslash_reconsider_ = FALSE;
else
c = ffelex_card_image_[++column];
if (ffelex_raw_mode_ == 0)
{
ffelex_send_token_ ();
assert (ffelex_raw_mode_ == 0);
while (c == ' ')
c = ffelex_card_image_[++column];
if ((c == '\0') || (c == '!'))
{
ffelex_finish_statement_ ();
goto beginning_of_line;
}
if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
{
continuation_line = TRUE;
goto beginning_of_line;
}
goto parse_nonraw_character_noncontin;
}
goto parse_raw_character;
}
parse_nonraw_character:
if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
{
continuation_line = TRUE;
goto beginning_of_line;
}
parse_nonraw_character_noncontin:
switch (ffelex_token_->type)
{
case FFELEX_typeNONE:
if (c == ' ')
{
while (c == ' ')
c = ffelex_card_image_[++column];
if ((c == '\0') || (c == '!'))
{
ffelex_finish_statement_ ();
goto beginning_of_line;
}
if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
{
continuation_line = TRUE;
goto beginning_of_line;
}
}
switch (c)
{
case '\"':
ffelex_token_->type = FFELEX_typeQUOTE;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '$':
ffelex_token_->type = FFELEX_typeDOLLAR;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '%':
ffelex_token_->type = FFELEX_typePERCENT;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '&':
ffelex_token_->type = FFELEX_typeAMPERSAND;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '\'':
ffelex_token_->type = FFELEX_typeAPOSTROPHE;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '(':
ffelex_token_->type = FFELEX_typeOPEN_PAREN;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case ')':
ffelex_token_->type = FFELEX_typeCLOSE_PAREN;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '*':
ffelex_token_->type = FFELEX_typeASTERISK;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case '+':
ffelex_token_->type = FFELEX_typePLUS;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case ',':
ffelex_token_->type = FFELEX_typeCOMMA;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '-':
ffelex_token_->type = FFELEX_typeMINUS;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '.':
ffelex_token_->type = FFELEX_typePERIOD;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '/':
ffelex_token_->type = FFELEX_typeSLASH;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
ffelex_token_->type
= ffelex_hexnum_ ? FFELEX_typeNAME : FFELEX_typeNUMBER;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_append_to_token_ (c);
break;
case ':':
ffelex_token_->type = FFELEX_typeCOLON;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case ';':
ffelex_token_->type = FFELEX_typeSEMICOLON;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_permit_include_ = TRUE;
ffelex_send_token_ ();
ffelex_permit_include_ = FALSE;
break;
case '<':
ffelex_token_->type = FFELEX_typeOPEN_ANGLE;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case '=':
ffelex_token_->type = FFELEX_typeEQUALS;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case '>':
ffelex_token_->type = FFELEX_typeCLOSE_ANGLE;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
break;
case '?':
ffelex_token_->type = FFELEX_typeQUESTION;
ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
case '_':
if (1 || ffe_is_90 ())
{
ffelex_token_->type = FFELEX_typeUNDERSCORE;
ffelex_token_->where_line
= ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col
= ffewhere_column_new (column + 1);
ffelex_send_token_ ();
break;
}
case 'A':
case 'B':
case 'C':
case 'D':
case 'E':
case 'F':
case 'G':
case 'H':
case 'I':
case 'J':
case 'K':
case 'L':
case 'M':
case 'N':
case 'O':
case 'P':
case 'Q':
case 'R':
case 'S':
case 'T':
case 'U':
case 'V':
case 'W':
case 'X':
case 'Y':
case 'Z':
case 'a':
case 'b':
case 'c':
case 'd':
case 'e':
case 'f':
case 'g':
case 'h':
case 'i':
case 'j':
case 'k':
case 'l':
case 'm':
case 'n':
case 'o':
case 'p':
case 'q':
case 'r':
case 's':
case 't':
case 'u':
case 'v':
case 'w':
case 'x':
case 'y':
case 'z':
c = ffesrc_char_source (c);
if (ffesrc_char_match_init (c, 'H', 'h')
&& ffelex_expecting_hollerith_ != 0)
{
ffelex_raw_mode_ = ffelex_expecting_hollerith_;
ffelex_token_->type = FFELEX_typeHOLLERITH;
ffelex_token_->where_line = ffelex_raw_where_line_;
ffelex_token_->where_col = ffelex_raw_where_col_;
ffelex_raw_where_line_ = ffewhere_line_unknown ();
ffelex_raw_where_col_ = ffewhere_column_unknown ();
c = ffelex_card_image_[++column];
goto parse_raw_character;
}
if (ffelex_names_pure_)
{
ffelex_token_->where_line
= ffewhere_line_use (ffelex_token_->currentnames_line
= ffewhere_line_use (ffelex_current_wl_));
ffelex_token_->where_col
= ffewhere_column_use (ffelex_token_->currentnames_col
= ffewhere_column_new (column + 1));
ffelex_token_->type = FFELEX_typeNAMES;
}
else
{
ffelex_token_->where_line
= ffewhere_line_use (ffelex_current_wl_);
ffelex_token_->where_col = ffewhere_column_new (column + 1);
ffelex_token_->type = FFELEX_typeNAME;
}
ffelex_append_to_token_ (c);
break;
default:
ffelex_bad_1_ (FFEBAD_UNRECOGNIZED_CHARACTER,
ffelex_linecount_current_, column + 1);
ffelex_finish_statement_ ();
goto beginning_of_line;
}
break;
case FFELEX_typeNAME:
switch (c)
{
case 'A':
case 'B':
case 'C':
case 'D':
case 'E':
case 'F':
case 'G':
case 'H':
case 'I':
case 'J':
case 'K':
case 'L':
case 'M':
case 'N':
case 'O':
case 'P':
case 'Q':
case 'R':
case 'S':
case 'T':
case 'U':
case 'V':
case 'W':
case 'X':
case 'Y':
case 'Z':
case 'a':
case 'b':
case 'c':
case 'd':
case 'e':
case 'f':
case 'g':
case 'h':
case 'i':
case 'j':
case 'k':
case 'l':
case 'm':
case 'n':
case 'o':
case 'p':
case 'q':
case 'r':
case 's':
case 't':
case 'u':
case 'v':
case 'w':
case 'x':
case 'y':
case 'z':
c = ffesrc_char_source (c);
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
case '_':
case '$':
if ((c == '$')
&& !ffe_is_dollar_ok ())
{
ffelex_send_token_ ();
goto parse_next_character;
}
ffelex_append_to_token_ (c);
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeNAMES:
switch (c)
{
case 'A':
case 'B':
case 'C':
case 'D':
case 'E':
case 'F':
case 'G':
case 'H':
case 'I':
case 'J':
case 'K':
case 'L':
case 'M':
case 'N':
case 'O':
case 'P':
case 'Q':
case 'R':
case 'S':
case 'T':
case 'U':
case 'V':
case 'W':
case 'X':
case 'Y':
case 'Z':
case 'a':
case 'b':
case 'c':
case 'd':
case 'e':
case 'f':
case 'g':
case 'h':
case 'i':
case 'j':
case 'k':
case 'l':
case 'm':
case 'n':
case 'o':
case 'p':
case 'q':
case 'r':
case 's':
case 't':
case 'u':
case 'v':
case 'w':
case 'x':
case 'y':
case 'z':
c = ffesrc_char_source (c);
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
case '_':
case '$':
if ((c == '$')
&& !ffe_is_dollar_ok ())
{
ffelex_send_token_ ();
goto parse_next_character;
}
if (ffelex_token_->length < FFEWHERE_indexMAX)
{
ffewhere_track (&ffelex_token_->currentnames_line,
&ffelex_token_->currentnames_col,
ffelex_token_->wheretrack,
ffelex_token_->length,
ffelex_linecount_current_,
column + 1);
}
ffelex_append_to_token_ (c);
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeNUMBER:
switch (c)
{
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
ffelex_append_to_token_ (c);
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeASTERISK:
switch (c)
{
case '*':
ffelex_token_->type = FFELEX_typePOWER;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeCOLON:
switch (c)
{
case ':':
ffelex_token_->type = FFELEX_typeCOLONCOLON;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeSLASH:
switch (c)
{
case '/':
ffelex_token_->type = FFELEX_typeCONCAT;
ffelex_send_token_ ();
break;
case ')':
ffelex_token_->type = FFELEX_typeCLOSE_ARRAY;
ffelex_send_token_ ();
break;
case '=':
ffelex_token_->type = FFELEX_typeREL_NE;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeOPEN_PAREN:
switch (c)
{
case '/':
ffelex_token_->type = FFELEX_typeOPEN_ARRAY;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeOPEN_ANGLE:
switch (c)
{
case '=':
ffelex_token_->type = FFELEX_typeREL_LE;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeEQUALS:
switch (c)
{
case '=':
ffelex_token_->type = FFELEX_typeREL_EQ;
ffelex_send_token_ ();
break;
case '>':
ffelex_token_->type = FFELEX_typePOINTS;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
case FFELEX_typeCLOSE_ANGLE:
switch (c)
{
case '=':
ffelex_token_->type = FFELEX_typeREL_GE;
ffelex_send_token_ ();
break;
default:
ffelex_send_token_ ();
goto parse_next_character;
}
break;
default:
assert ("Serious error!" == NULL);
abort ();
break;
}
c = ffelex_card_image_[++column];
parse_next_character:
if (ffelex_raw_mode_ != 0)
goto parse_raw_character;
if ((c == '\0') || (c == '!'))
{
ffelex_finish_statement_ ();
goto beginning_of_line;
}
goto parse_nonraw_character;
}
void
ffelex_hash_kludge (FILE *finput)
{
static const char match[] = "# 1 \"";
static int kludge[ARRAY_SIZE (match) + 1];
int c;
const char *p;
int *q;
for (p = &match[0], q = &kludge[0], c = getc (finput);
(c == *p) && (*p != '\0') && (c != EOF);
++p, ++q, c = getc (finput))
*q = c;
*q = c;
*++q = 0;
ffelex_kludge_chars_ = &kludge[0];
if (*p == 0)
{
ffelex_kludge_flag_ = TRUE;
++ffelex_kludge_chars_;
ffelex_hash_ (finput);
ffelex_kludge_flag_ = FALSE;
}
}
void
ffelex_init_1 ()
{
unsigned int i;
ffelex_final_nontab_column_ = ffe_fixed_line_length ();
ffelex_card_size_ = FFELEX_columnINITIAL_SIZE_;
ffelex_card_image_ = malloc_new_ksr (malloc_pool_image (),
"FFELEX card image",
FFELEX_columnINITIAL_SIZE_ + 9);
ffelex_card_image_[0] = '\0';
for (i = 0; i < 256; ++i)
ffelex_first_char_[i] = FFELEX_typeERROR;
ffelex_first_char_['\t'] = FFELEX_typeRAW;
ffelex_first_char_['\n'] = FFELEX_typeCOMMENT;
ffelex_first_char_['\v'] = FFELEX_typeCOMMENT;
ffelex_first_char_['\f'] = FFELEX_typeCOMMENT;
ffelex_first_char_['\r'] = FFELEX_typeRAW;
ffelex_first_char_[' '] = FFELEX_typeRAW;
ffelex_first_char_['!'] = FFELEX_typeCOMMENT;
ffelex_first_char_['*'] = FFELEX_typeCOMMENT;
ffelex_first_char_['/'] = FFELEX_typeSLASH;
ffelex_first_char_['&'] = FFELEX_typeRAW;
ffelex_first_char_['#'] = FFELEX_typeHASH;
for (i = '0'; i <= '9'; ++i)
ffelex_first_char_[i] = FFELEX_typeRAW;
if ((ffe_case_match () == FFE_caseNONE)
|| ((ffe_case_match () == FFE_caseUPPER)
&& (ffe_case_source () != FFE_caseLOWER))
|| ((ffe_case_match () == FFE_caseLOWER)
&& (ffe_case_source () == FFE_caseLOWER)))
{
ffelex_first_char_['C'] = FFELEX_typeCOMMENT;
ffelex_first_char_['D'] = FFELEX_typeCOMMENT;
}
if ((ffe_case_match () == FFE_caseNONE)
|| ((ffe_case_match () == FFE_caseLOWER)
&& (ffe_case_source () != FFE_caseUPPER))
|| ((ffe_case_match () == FFE_caseUPPER)
&& (ffe_case_source () == FFE_caseUPPER)))
{
ffelex_first_char_['c'] = FFELEX_typeCOMMENT;
ffelex_first_char_['d'] = FFELEX_typeCOMMENT;
}
ffelex_linecount_current_ = 0;
ffelex_linecount_next_ = 1;
ffelex_raw_mode_ = 0;
ffelex_set_include_ = FALSE;
ffelex_permit_include_ = FALSE;
ffelex_names_ = TRUE;
ffelex_names_pure_ = FALSE;
ffelex_hexnum_ = FALSE;
ffelex_expecting_hollerith_ = 0;
ffelex_raw_where_line_ = ffewhere_line_unknown ();
ffelex_raw_where_col_ = ffewhere_column_unknown ();
ffelex_token_ = ffelex_token_new_ ();
ffelex_token_->type = FFELEX_typeNONE;
ffelex_token_->uses = 1;
ffelex_token_->where_line = ffewhere_line_unknown ();
ffelex_token_->where_col = ffewhere_column_unknown ();
ffelex_token_->text = NULL;
ffelex_handler_ = NULL;
}
bool
ffelex_is_names_expected ()
{
return ffelex_names_;
}
char *
ffelex_line ()
{
return ffelex_card_image_;
}
ffewhereColumnNumber
ffelex_line_length ()
{
return ffelex_card_length_;
}
ffewhereLineNumber
ffelex_line_number ()
{
return ffelex_linecount_current_;
}
void
ffelex_set_expecting_hollerith (long length, char which,
ffewhereLine line, ffewhereColumn column)
{
ffewhere_line_kill (ffelex_raw_where_line_);
ffewhere_column_kill (ffelex_raw_where_col_);
switch (length)
{
case 0:
ffelex_expecting_hollerith_ = 0;
ffelex_raw_mode_ = 0;
ffelex_raw_where_line_ = ffewhere_line_unknown ();
ffelex_raw_where_col_ = ffewhere_column_unknown ();
return;
case -1:
ffelex_raw_mode_ = -1;
ffelex_raw_char_ = which;
break;
default:
ffelex_expecting_hollerith_ = length;
break;
}
ffelex_raw_where_line_ = ffewhere_line_use (line);
ffelex_raw_where_col_ = ffewhere_column_use (column);
}
void
ffelex_set_handler (ffelexHandler first)
{
ffelex_handler_ = first;
}
void
ffelex_set_hexnum (bool f)
{
ffelex_hexnum_ = f;
}
void
ffelex_set_include (ffewhereFile wf, bool free_form, FILE *fi)
{
assert (ffelex_permit_include_);
assert (!ffelex_set_include_);
ffelex_set_include_ = TRUE;
ffelex_include_free_form_ = free_form;
ffelex_include_file_ = fi;
ffelex_include_wherefile_ = wf;
}
void
ffelex_set_names (bool f)
{
ffelex_names_ = f;
if (!f)
ffelex_names_pure_ = FALSE;
}
void
ffelex_set_names_pure (bool f)
{
ffelex_names_pure_ = f;
ffelex_names_ = f;
}
ffelexHandler
ffelex_splice_tokens (ffelexHandler first, ffelexToken master,
ffeTokenLength start)
{
unsigned char *p;
ffeTokenLength i;
ffelexToken t;
p = ffelex_token_text (master) + (i = start);
while (*p != '\0')
{
if (ISDIGIT (*p))
{
t = ffelex_token_number_from_names (master, i);
p += ffelex_token_length (t);
i += ffelex_token_length (t);
}
else if (ffesrc_is_name_init (*p))
{
t = ffelex_token_name_from_names (master, i, 0);
p += ffelex_token_length (t);
i += ffelex_token_length (t);
}
else if (*p == '$')
{
t = ffelex_token_dollar_from_names (master, i);
++p;
++i;
}
else if (*p == '_')
{
t = ffelex_token_uscore_from_names (master, i);
++p;
++i;
}
else
{
assert ("not a valid NAMES character" == NULL);
t = NULL;
}
assert (first != NULL);
first = (ffelexHandler) (*first) (t);
ffelex_token_kill (t);
}
return first;
}
ffelexHandler
ffelex_swallow_tokens (ffelexToken t, ffelexHandler handler)
{
assert (handler != NULL);
if ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeEOS)
|| (ffelex_token_type (t) == FFELEX_typeSEMICOLON)))
return (ffelexHandler) (*handler) (t);
ffelex_eos_handler_ = handler;
return (ffelexHandler) ffelex_swallow_tokens_;
}
ffelexToken
ffelex_token_dollar_from_names (ffelexToken t, ffeTokenLength start)
{
ffelexToken nt;
assert (t != NULL);
assert (ffelex_token_type (t) == FFELEX_typeNAMES);
assert (start < t->length);
assert (t->text[start] == '$');
nt = ffelex_token_new_ ();
nt->type = FFELEX_typeDOLLAR;
nt->length = 0;
nt->uses = 1;
ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
t->where_col, t->wheretrack, start);
nt->text = NULL;
return nt;
}
void
ffelex_token_kill (ffelexToken t)
{
assert (t != NULL);
assert (t->uses > 0);
if (--t->uses != 0)
return;
--ffelex_total_tokens_;
if (t->type == FFELEX_typeNAMES)
ffewhere_track_kill (t->where_line, t->where_col,
t->wheretrack, t->length);
ffewhere_line_kill (t->where_line);
ffewhere_column_kill (t->where_col);
if (t->text != NULL)
malloc_kill_ksr (malloc_pool_image (), t->text, t->size + 1);
malloc_kill_ks (malloc_pool_image (), t, sizeof (*t));
}
ffelexToken
ffelex_token_name_from_names (ffelexToken t, ffeTokenLength start,
ffeTokenLength len)
{
ffelexToken nt;
assert (t != NULL);
assert (ffelex_token_type (t) == FFELEX_typeNAMES);
assert (start < t->length);
if (len == 0)
len = t->length - start;
else
{
assert (len > 0);
assert ((start + len) <= t->length);
}
assert (ffelex_is_firstnamechar ((unsigned char)(t->text[start])));
nt = ffelex_token_new_ ();
nt->type = FFELEX_typeNAME;
nt->size = len;
nt->length = len;
nt->uses = 1;
ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
t->where_col, t->wheretrack, start);
nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
len + 1);
strncpy (nt->text, t->text + start, len);
nt->text[len] = '\0';
return nt;
}
ffelexToken
ffelex_token_names_from_names (ffelexToken t, ffeTokenLength start,
ffeTokenLength len)
{
ffelexToken nt;
assert (t != NULL);
assert (ffelex_token_type (t) == FFELEX_typeNAMES);
assert (start < t->length);
if (len == 0)
len = t->length - start;
else
{
assert (len > 0);
assert ((start + len) <= t->length);
}
assert (ffelex_is_firstnamechar ((unsigned char)(t->text[start])));
nt = ffelex_token_new_ ();
nt->type = FFELEX_typeNAMES;
nt->size = len;
nt->length = len;
nt->uses = 1;
ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
t->where_col, t->wheretrack, start);
ffewhere_track_copy (nt->wheretrack, t->wheretrack, start, len);
nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
len + 1);
strncpy (nt->text, t->text + start, len);
nt->text[len] = '\0';
return nt;
}
ffelexToken
ffelex_token_new_character (const char *s, ffewhereLine l, ffewhereColumn c)
{
ffelexToken t;
t = ffelex_token_new_ ();
t->type = FFELEX_typeCHARACTER;
t->length = t->size = strlen (s);
t->uses = 1;
t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
t->size + 1);
strcpy (t->text, s);
t->where_line = ffewhere_line_use (l);
t->where_col = ffewhere_column_new (c);
return t;
}
ffelexToken
ffelex_token_new_eof ()
{
ffelexToken t;
t = ffelex_token_new_ ();
t->type = FFELEX_typeEOF;
t->uses = 1;
t->text = NULL;
t->where_line = ffewhere_line_new (ffelex_linecount_current_);
t->where_col = ffewhere_column_new (1);
return t;
}
ffelexToken
ffelex_token_new_name (const char *s, ffewhereLine l, ffewhereColumn c)
{
ffelexToken t;
assert (ffelex_is_firstnamechar ((unsigned char)*s));
t = ffelex_token_new_ ();
t->type = FFELEX_typeNAME;
t->length = t->size = strlen (s);
t->uses = 1;
t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
t->size + 1);
strcpy (t->text, s);
t->where_line = ffewhere_line_use (l);
t->where_col = ffewhere_column_new (c);
return t;
}
ffelexToken
ffelex_token_new_names (const char *s, ffewhereLine l, ffewhereColumn c)
{
ffelexToken t;
assert (ffelex_is_firstnamechar ((unsigned char)*s));
t = ffelex_token_new_ ();
t->type = FFELEX_typeNAMES;
t->length = t->size = strlen (s);
t->uses = 1;
t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
t->size + 1);
strcpy (t->text, s);
t->where_line = ffewhere_line_use (l);
t->where_col = ffewhere_column_new (c);
ffewhere_track_clear (t->wheretrack, t->length);
return t;
}
ffelexToken
ffelex_token_new_number (const char *s, ffewhereLine l, ffewhereColumn c)
{
ffelexToken t;
ffeTokenLength len;
len = strspn (s, "0123456789");
assert (len != 0);
t = ffelex_token_new_ ();
t->type = FFELEX_typeNUMBER;
t->length = t->size = len;
t->uses = 1;
t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
len + 1);
strncpy (t->text, s, len);
t->text[len] = '\0';
t->where_line = ffewhere_line_use (l);
t->where_col = ffewhere_column_new (c);
return t;
}
ffelexToken
ffelex_token_new_simple_ (ffelexType type, ffewhereLine l, ffewhereColumn c)
{
ffelexToken t;
t = ffelex_token_new_ ();
t->type = type;
t->uses = 1;
t->text = NULL;
t->where_line = ffewhere_line_use (l);
t->where_col = ffewhere_column_new (c);
return t;
}
ffelexToken
ffelex_token_number_from_names (ffelexToken t, ffeTokenLength start)
{
ffelexToken nt;
ffeTokenLength len;
assert (t != NULL);
assert (ffelex_token_type (t) == FFELEX_typeNAMES);
assert (start < t->length);
len = strspn (t->text + start, "0123456789");
assert (len != 0);
nt = ffelex_token_new_ ();
nt->type = FFELEX_typeNUMBER;
nt->size = len;
nt->length = len;
nt->uses = 1;
ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
t->where_col, t->wheretrack, start);
nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
len + 1);
strncpy (nt->text, t->text + start, len);
nt->text[len] = '\0';
return nt;
}
ffelexToken
ffelex_token_uscore_from_names (ffelexToken t, ffeTokenLength start)
{
ffelexToken nt;
assert (t != NULL);
assert (ffelex_token_type (t) == FFELEX_typeNAMES);
assert (start < t->length);
assert (t->text[start] == '_');
nt = ffelex_token_new_ ();
nt->type = FFELEX_typeUNDERSCORE;
nt->uses = 1;
ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
t->where_col, t->wheretrack, start);
nt->text = NULL;
return nt;
}
ffelexToken
ffelex_token_use (ffelexToken t)
{
if (t == NULL)
assert ("_token_use: null token" == NULL);
t->uses++;
return t;
}
#include "gt-f-lex.h"