1 /* Implementation of Fortran lexer
2 Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002, 2003
3 Free Software Foundation, Inc.
4 Contributed by James Craig Burley.
6 This file is part of GNU Fortran.
8 GNU Fortran is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Fortran is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Fortran; see the file COPYING. If not, write to
20 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
37 static void ffelex_append_to_token_ (char c
);
38 static int ffelex_backslash_ (int c
, ffewhereColumnNumber col
);
39 static void ffelex_bad_1_ (ffebad errnum
, ffewhereLineNumber ln0
,
40 ffewhereColumnNumber cn0
);
41 static void ffelex_bad_2_ (ffebad errnum
, ffewhereLineNumber ln0
,
42 ffewhereColumnNumber cn0
, ffewhereLineNumber ln1
,
43 ffewhereColumnNumber cn1
);
44 static void ffelex_bad_here_ (int num
, ffewhereLineNumber ln0
,
45 ffewhereColumnNumber cn0
);
46 static void ffelex_finish_statement_ (void);
47 static int ffelex_get_directive_line_ (char **text
, FILE *finput
);
48 static int ffelex_hash_ (FILE *f
);
49 static ffewhereColumnNumber
ffelex_image_char_ (int c
,
50 ffewhereColumnNumber col
);
51 static void ffelex_include_ (void);
52 static bool ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col
);
53 static bool ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col
);
54 static void ffelex_next_line_ (void);
55 static void ffelex_prepare_eos_ (void);
56 static void ffelex_send_token_ (void);
57 static ffelexHandler
ffelex_swallow_tokens_ (ffelexToken t
);
58 static ffelexToken
ffelex_token_new_ (void);
60 /* Pertaining to the geometry of the input file. */
62 /* Initial size for card image to be allocated. */
63 #define FFELEX_columnINITIAL_SIZE_ 255
65 /* The card image itself, which grows as source lines get longer. It
66 has room for ffelex_card_size_ + 8 characters, and the length of the
67 current image is ffelex_card_length_. (The + 8 characters are made
68 available for easy handling of tabs and such.) */
69 static char *ffelex_card_image_
;
70 static ffewhereColumnNumber ffelex_card_size_
;
71 static ffewhereColumnNumber ffelex_card_length_
;
73 /* Max width for free-form lines (ISO F90). */
74 #define FFELEX_FREE_MAX_COLUMNS_ 132
76 /* True if we saw a tab on the current line, as this (currently) means
77 the line is therefore treated as though final_nontab_column_ were
79 static bool ffelex_saw_tab_
;
81 /* TRUE if current line is known to be erroneous, so don't bother
82 expanding room for it just to display it. */
83 static bool ffelex_bad_line_
= FALSE
;
85 /* Last column for vanilla, i.e. non-tabbed, line. Usually 72 or 132. */
86 static ffewhereColumnNumber ffelex_final_nontab_column_
;
88 /* Array for quickly deciding what kind of line the current card has,
89 based on its first character. */
90 static ffelexType ffelex_first_char_
[256];
92 /* Pertaining to file management. */
94 /* The wf argument of the most recent active ffelex_file_(fixed,free)
96 static GTY (()) ffewhereFile ffelex_current_wf_
;
98 /* TRUE if an INCLUDE statement can be processed (ffelex_set_include
100 static bool ffelex_permit_include_
;
102 /* TRUE if an INCLUDE statement is pending (ffelex_set_include has been
104 static bool ffelex_set_include_
;
106 /* Information on the pending INCLUDE file. */
107 static FILE *ffelex_include_file_
;
108 static bool ffelex_include_free_form_
;
109 static GTY(()) ffewhereFile ffelex_include_wherefile_
;
111 /* Current master line count. */
112 static ffewhereLineNumber ffelex_linecount_current_
;
113 /* Next master line count. */
114 static ffewhereLineNumber ffelex_linecount_next_
;
116 /* ffewhere info on the latest (currently active) line read from the
117 active source file. */
118 static ffewhereLine ffelex_current_wl_
;
119 static ffewhereColumn ffelex_current_wc_
;
121 /* Pertaining to tokens in general. */
123 /* Initial capacity for text in a CHARACTER/HOLLERITH/NAME/NAMES/NUMBER
125 #define FFELEX_columnTOKEN_SIZE_ 63
126 #if FFELEX_columnTOKEN_SIZE_ < FFEWHERE_indexMAX
127 #error "token size too small!"
130 /* Current token being lexed. */
131 static ffelexToken ffelex_token_
;
133 /* Handler for current token. */
134 static ffelexHandler ffelex_handler_
;
136 /* TRUE if fixed-form lexer is to generate NAMES instead of NAME tokens. */
137 static bool ffelex_names_
;
139 /* TRUE if both lexers are to generate NAMES instead of NAME tokens. */
140 static bool ffelex_names_pure_
;
142 /* TRUE if 0-9 starts a NAME token instead of NUMBER, for parsing hex
144 static bool ffelex_hexnum_
;
146 /* For ffelex_swallow_tokens(). */
147 static ffelexHandler ffelex_eos_handler_
;
149 /* Number of tokens sent since last EOS or beginning of input file
150 (include INCLUDEd files). */
151 static unsigned long int ffelex_number_of_tokens_
;
153 /* Number of labels sent (as NUMBER tokens) since last reset of
154 ffelex_number_of_tokens_ to 0, should be 0 or 1 in most cases.
155 (Fixed-form source only.) */
156 static unsigned long int ffelex_label_tokens_
;
158 /* Metering for token management, to catch token-memory leaks. */
159 static long int ffelex_total_tokens_
= 0;
160 static long int ffelex_old_total_tokens_
= 1;
161 static long int ffelex_token_nextid_
= 0;
163 /* Pertaining to lexing CHARACTER and HOLLERITH tokens. */
165 /* >0 if a Hollerith constant of that length might be in mid-lex, used
166 when the next character seen is 'H' or 'h' to enter HOLLERITH lexing
167 mode (see ffelex_raw_mode_). */
168 static long int ffelex_expecting_hollerith_
;
170 /* -3: Backslash (escape) sequence being lexed in CHARACTER.
171 -2: Possible closing apostrophe/quote seen in CHARACTER.
172 -1: Lexing CHARACTER.
173 0: Not lexing CHARACTER or HOLLERITH.
174 >0: Lexing HOLLERITH, value is # chars remaining to expect. */
175 static long int ffelex_raw_mode_
;
177 /* When lexing CHARACTER, open quote/apostrophe (either ' or "). */
178 static char ffelex_raw_char_
;
180 /* TRUE when backslash processing had to use most recent character
181 to finish its state engine, but that character is not part of
182 the backslash sequence, so must be reconsidered as a "normal"
183 character in CHARACTER/HOLLERITH lexing. */
184 static bool ffelex_backslash_reconsider_
= FALSE
;
186 /* Characters preread before lexing happened (might include EOF). */
187 static int *ffelex_kludge_chars_
= NULL
;
189 /* Doing the kludge processing, so not initialized yet. */
190 static bool ffelex_kludge_flag_
= FALSE
;
192 /* The beginning of a (possible) CHARACTER/HOLLERITH token. */
193 static ffewhereLine ffelex_raw_where_line_
;
194 static ffewhereColumn ffelex_raw_where_col_
;
197 /* Call this to append another character to the current token. If it isn't
198 currently big enough for it, it will be enlarged. The current token
199 must be a CHARACTER, HOLLERITH, NAME, NAMES, or NUMBER. */
202 ffelex_append_to_token_ (char c
)
204 if (ffelex_token_
->text
== NULL
)
207 = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
208 FFELEX_columnTOKEN_SIZE_
+ 1);
209 ffelex_token_
->size
= FFELEX_columnTOKEN_SIZE_
;
210 ffelex_token_
->length
= 0;
212 else if (ffelex_token_
->length
>= ffelex_token_
->size
)
215 = malloc_resize_ksr (malloc_pool_image (),
217 (ffelex_token_
->size
<< 1) + 1,
218 ffelex_token_
->size
+ 1);
219 ffelex_token_
->size
<<= 1;
220 assert (ffelex_token_
->length
< ffelex_token_
->size
);
223 Sorry
, MAP_CHARACTER is
not going to work as expected in GNU Fortran
,
224 please contact fortran@gnu
.org
if you wish to fund work to
225 port g77 to non
-ASCII machines
.
227 ffelex_token_
->text
[ffelex_token_
->length
++] = c
;
230 /* Do backslash (escape) processing for a CHARACTER/HOLLERITH token
234 ffelex_backslash_ (int c
, ffewhereColumnNumber col
)
236 static int state
= 0;
237 static unsigned int count
;
239 static unsigned int firstdig
= 0;
241 static ffewhereLineNumber line
;
242 static ffewhereColumnNumber column
;
244 /* See gcc/c-lex.c readescape() for a straightforward version
245 of this state engine for handling backslashes in character/
246 hollerith constants. */
254 && (ffelex_raw_mode_
!= 0)
255 && ffe_is_backslash ())
259 line
= ffelex_linecount_current_
;
265 state
= 0; /* Assume simple case. */
275 case '0': case '1': case '2': case '3': case '4':
276 case '5': case '6': case '7':
282 case '\\': case '\'': case '"':
285 #if 0 /* Inappropriate for Fortran. */
287 ffelex_next_line_ ();
293 return TARGET_NEWLINE
;
325 /* xgettext:no-c-format */
326 ffebad_start_msg_lex ("Non-ISO-C-standard escape sequence `\\%A' at %0",
327 FFEBAD_severityPEDANTIC
);
328 ffelex_bad_here_ (0, line
, column
);
332 return (c
== 'E' || c
== 'e') ? 033 : c
;
338 if (c
>= 040 && c
< 0177)
344 /* xgettext:no-c-format */
345 ffebad_start_msg_lex ("Unknown escape sequence `\\%A' at %0",
346 FFEBAD_severityPEDANTIC
);
347 ffelex_bad_here_ (0, line
, column
);
353 /* xgettext:no-c-format */
354 ffebad_start_msg_lex ("Unterminated escape sequence `\\' at %0",
355 FFEBAD_severityPEDANTIC
);
356 ffelex_bad_here_ (0, line
, column
);
363 sprintf (&m
[0], "%x", c
);
364 /* xgettext:no-c-format */
365 ffebad_start_msg_lex ("Unknown escape sequence `\\' followed by char code 0x%A at %0",
366 FFEBAD_severityPEDANTIC
);
367 ffelex_bad_here_ (0, line
, column
);
377 code
= (code
* 16) + hex_value (c
);
378 if (code
!= 0 || count
!= 0)
392 /* xgettext:no-c-format */
393 ffebad_start_msg_lex ("\\x used at %0 with no following hex digits",
394 FFEBAD_severityFATAL
);
395 ffelex_bad_here_ (0, line
, column
);
399 /* Digits are all 0's. Ok. */
401 else if ((count
- 1) * 4 >= TYPE_PRECISION (integer_type_node
)
403 && ((1 << (TYPE_PRECISION (integer_type_node
) - (count
- 1) * 4))
406 /* xgettext:no-c-format */
407 ffebad_start_msg_lex ("Hex escape at %0 out of range",
408 FFEBAD_severityPEDANTIC
);
409 ffelex_bad_here_ (0, line
, column
);
415 if ((c
<= '7') && (c
>= '0') && (count
++ < 3))
417 code
= (code
* 8) + (c
- '0');
424 assert ("bad backslash state" == NULL
);
428 /* Come here when code has a built character, and c is the next
429 character that might (or might not) be the next one in the constant. */
431 /* Don't bother doing this check for each character going into
432 CHARACTER or HOLLERITH constants, just the escaped-value ones.
433 gcc apparently checks every single character, which seems
434 like it'd be kinda slow and not worth doing anyway. */
437 && TYPE_PRECISION (char_type_node
) < HOST_BITS_PER_INT
438 && code
>= (1 << TYPE_PRECISION (char_type_node
)))
440 /* xgettext:no-c-format */
441 ffebad_start_msg_lex ("Escape sequence at %0 out of range for character",
442 FFEBAD_severityFATAL
);
443 ffelex_bad_here_ (0, line
, column
);
449 /* Known end of constant, just append this character. */
450 ffelex_append_to_token_ (code
);
451 if (ffelex_raw_mode_
> 0)
456 /* Have two characters to handle. Do the first, then leave it to the
457 caller to detect anything special about the second. */
459 ffelex_append_to_token_ (code
);
460 if (ffelex_raw_mode_
> 0)
462 ffelex_backslash_reconsider_
= TRUE
;
466 /* ffelex_bad_1_ -- Issue diagnostic with one source point
468 ffelex_bad_1_(FFEBAD_SOME_ERROR,ffelex_linecount_current_,column + 1);
470 Creates ffewhere line and column objects for the source point, sends them
471 along with the error code to ffebad, then kills the line and column
472 objects before returning. */
475 ffelex_bad_1_ (ffebad errnum
, ffewhereLineNumber ln0
, ffewhereColumnNumber cn0
)
480 wl0
= ffewhere_line_new (ln0
);
481 wc0
= ffewhere_column_new (cn0
);
482 ffebad_start_lex (errnum
);
483 ffebad_here (0, wl0
, wc0
);
485 ffewhere_line_kill (wl0
);
486 ffewhere_column_kill (wc0
);
489 /* ffelex_bad_2_ -- Issue diagnostic with two source points
491 ffelex_bad_2_(FFEBAD_SOME_ERROR,ffelex_linecount_current_,column + 1,
492 otherline,othercolumn);
494 Creates ffewhere line and column objects for the source points, sends them
495 along with the error code to ffebad, then kills the line and column
496 objects before returning. */
499 ffelex_bad_2_ (ffebad errnum
, ffewhereLineNumber ln0
, ffewhereColumnNumber cn0
,
500 ffewhereLineNumber ln1
, ffewhereColumnNumber cn1
)
502 ffewhereLine wl0
, wl1
;
503 ffewhereColumn wc0
, wc1
;
505 wl0
= ffewhere_line_new (ln0
);
506 wc0
= ffewhere_column_new (cn0
);
507 wl1
= ffewhere_line_new (ln1
);
508 wc1
= ffewhere_column_new (cn1
);
509 ffebad_start_lex (errnum
);
510 ffebad_here (0, wl0
, wc0
);
511 ffebad_here (1, wl1
, wc1
);
513 ffewhere_line_kill (wl0
);
514 ffewhere_column_kill (wc0
);
515 ffewhere_line_kill (wl1
);
516 ffewhere_column_kill (wc1
);
520 ffelex_bad_here_ (int n
, ffewhereLineNumber ln0
,
521 ffewhereColumnNumber cn0
)
526 wl0
= ffewhere_line_new (ln0
);
527 wc0
= ffewhere_column_new (cn0
);
528 ffebad_here (n
, wl0
, wc0
);
529 ffewhere_line_kill (wl0
);
530 ffewhere_column_kill (wc0
);
534 ffelex_getc_ (FILE *finput
)
538 if (ffelex_kludge_chars_
== NULL
)
539 return getc (finput
);
541 c
= *ffelex_kludge_chars_
++;
545 ffelex_kludge_chars_
= NULL
;
546 return getc (finput
);
550 ffelex_cfebackslash_ (int *use_d
, int *d
, FILE *finput
)
552 register int c
= getc (finput
);
554 register unsigned count
;
555 unsigned firstdig
= 0;
575 code
= (code
* 16) + hex_value (c
);
576 if (code
!= 0 || count
!= 0)
585 error ("\\x used with no following hex digits");
587 /* Digits are all 0's. Ok. */
589 else if ((count
- 1) * 4 >= TYPE_PRECISION (integer_type_node
)
592 << (TYPE_PRECISION (integer_type_node
) - (count
- 1)
595 pedwarn ("hex escape out of range");
598 case '0': case '1': case '2': case '3': case '4':
599 case '5': case '6': case '7':
602 while ((c
<= '7') && (c
>= '0') && (count
++ < 3))
604 code
= (code
* 8) + (c
- '0');
611 case '\\': case '\'': case '"':
615 ffelex_next_line_ ();
625 return TARGET_NEWLINE
;
648 pedwarn ("non-ANSI-standard escape sequence, `\\%c'", c
);
654 /* `\(', etc, are used at beginning of line to avoid confusing Emacs. */
658 /* `\%' is used to prevent SCCS from getting confused. */
661 pedwarn ("non-ISO escape sequence `\\%c'", c
);
664 if (c
>= 040 && c
< 0177)
665 pedwarn ("unknown escape sequence `\\%c'", c
);
667 pedwarn ("unknown escape sequence: `\\' followed by char code 0x%x", c
);
671 /* A miniature version of the C front-end lexer. */
674 ffelex_cfelex_ (ffelexToken
*xtoken
, FILE *finput
, int c
)
681 register unsigned buffer_length
;
683 if ((*xtoken
!= NULL
) && !ffelex_kludge_flag_
)
684 ffelex_token_kill (*xtoken
);
688 case '0': case '1': case '2': case '3': case '4':
689 case '5': case '6': case '7': case '8': case '9':
690 buffer_length
= ARRAY_SIZE (buff
);
693 r
= &buff
[buffer_length
];
699 register unsigned bytes_used
= (p
- q
);
702 q
= (char *)xrealloc (q
, buffer_length
);
704 r
= &q
[buffer_length
];
706 c
= ffelex_getc_ (finput
);
711 token
= ffelex_token_new_number (q
, ffewhere_line_unknown (),
712 ffewhere_column_unknown ());
720 buffer_length
= ARRAY_SIZE (buff
);
723 r
= &buff
[buffer_length
];
724 c
= ffelex_getc_ (finput
);
738 case '\\': /* ~~~~~ */
739 c
= ffelex_cfebackslash_ (&use_d
, &d
, finput
);
744 error ("badly formed directive -- no closing quote");
754 if (use_d
!= 2) /* 0=>c, 1=>cd, 2=>nil. */
759 register unsigned bytes_used
= (p
- q
);
761 buffer_length
= bytes_used
* 2;
762 q
= (char *)xrealloc (q
, buffer_length
);
764 r
= &q
[buffer_length
];
773 token
= ffelex_token_new_character (q
, ffewhere_line_unknown (),
774 ffewhere_column_unknown ());
791 ffelex_file_pop_ (const char *filename
)
793 if (input_file_stack
->next
)
795 struct file_stack
*p
= input_file_stack
;
796 input_file_stack
= p
->next
;
798 input_file_stack_tick
++;
799 (*debug_hooks
->end_source_file
) (input_file_stack
->location
.line
);
802 error ("#-lines for entering and leaving files don't match");
804 /* Now that we've pushed or popped the input stack,
805 update the name in the top element. */
806 if (input_file_stack
)
807 input_file_stack
->location
.file
= filename
;
811 ffelex_file_push_ (int old_lineno
, const char *filename
)
814 = (struct file_stack
*) xmalloc (sizeof (struct file_stack
));
816 input_file_stack
->location
.line
= old_lineno
;
817 p
->next
= input_file_stack
;
818 p
->location
.file
= filename
;
819 input_file_stack
= p
;
820 input_file_stack_tick
++;
822 (*debug_hooks
->start_source_file
) (0, filename
);
824 /* Now that we've pushed or popped the input stack,
825 update the name in the top element. */
826 if (input_file_stack
)
827 input_file_stack
->location
.file
= filename
;
830 /* Prepare to finish a statement-in-progress by sending the current
831 token, if any, then setting up EOS as the current token with the
832 appropriate current pointer. The caller can then move the current
833 pointer before actually sending EOS, if desired, as it is in
834 typical fixed-form cases. */
837 ffelex_prepare_eos_ ()
839 if (ffelex_token_
->type
!= FFELEX_typeNONE
)
841 ffelex_backslash_ (EOF
, 0);
843 switch (ffelex_raw_mode_
)
849 ffebad_start_lex ((ffelex_raw_char_
== '\'') ? FFEBAD_NO_CLOSING_APOSTROPHE
850 : FFEBAD_NO_CLOSING_QUOTE
);
851 ffebad_here (0, ffelex_token_
->where_line
, ffelex_token_
->where_col
);
852 ffebad_here (1, ffelex_current_wl_
, ffelex_current_wc_
);
863 ffebad_start_lex (FFEBAD_NOT_ENOUGH_HOLLERITH_CHARS
);
864 ffebad_here (0, ffelex_token_
->where_line
, ffelex_token_
->where_col
);
865 ffebad_here (1, ffelex_current_wl_
, ffelex_current_wc_
);
866 sprintf (num
, "%lu", (unsigned long) ffelex_raw_mode_
);
869 /* Make sure the token has some text, might as well fill up with spaces. */
872 ffelex_append_to_token_ (' ');
873 } while (--ffelex_raw_mode_
> 0);
877 ffelex_raw_mode_
= 0;
878 ffelex_send_token_ ();
880 ffelex_token_
->type
= FFELEX_typeEOS
;
881 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
882 ffelex_token_
->where_col
= ffewhere_column_use (ffelex_current_wc_
);
886 ffelex_finish_statement_ ()
888 if ((ffelex_number_of_tokens_
== 0)
889 && (ffelex_token_
->type
== FFELEX_typeNONE
))
890 return; /* Don't have a statement pending. */
892 if (ffelex_token_
->type
!= FFELEX_typeEOS
)
893 ffelex_prepare_eos_ ();
895 ffelex_permit_include_
= TRUE
;
896 ffelex_send_token_ ();
897 ffelex_permit_include_
= FALSE
;
898 ffelex_number_of_tokens_
= 0;
899 ffelex_label_tokens_
= 0;
900 ffelex_names_
= TRUE
;
901 ffelex_names_pure_
= FALSE
; /* Probably not necessary. */
902 ffelex_hexnum_
= FALSE
;
904 if (!ffe_is_ffedebug ())
907 /* For debugging purposes only. */
909 if (ffelex_total_tokens_
!= ffelex_old_total_tokens_
)
911 fprintf (dmpout
, "; token_track had %ld tokens, now have %ld.\n",
912 ffelex_old_total_tokens_
, ffelex_total_tokens_
);
913 ffelex_old_total_tokens_
= ffelex_total_tokens_
;
917 /* Copied from gcc/c-common.c get_directive_line. */
920 ffelex_get_directive_line_ (char **text
, FILE *finput
)
922 static char *directive_buffer
= NULL
;
923 static unsigned buffer_length
= 0;
925 register char *buffer_limit
;
926 register int looking_for
= 0;
927 register int char_escaped
= 0;
929 if (buffer_length
== 0)
931 directive_buffer
= (char *)xmalloc (128);
935 buffer_limit
= &directive_buffer
[buffer_length
];
937 for (p
= directive_buffer
; ; )
941 /* Make buffer bigger if it is full. */
942 if (p
>= buffer_limit
)
944 register unsigned bytes_used
= (p
- directive_buffer
);
948 = (char *)xrealloc (directive_buffer
, buffer_length
);
949 p
= &directive_buffer
[bytes_used
];
950 buffer_limit
= &directive_buffer
[buffer_length
];
955 /* Discard initial whitespace. */
956 if ((c
== ' ' || c
== '\t') && p
== directive_buffer
)
959 /* Detect the end of the directive. */
960 if ((c
== '\n' && looking_for
== 0)
963 if (looking_for
!= 0)
964 error ("bad directive -- missing close-quote");
967 *text
= directive_buffer
;
973 ffelex_next_line_ ();
975 /* Handle string and character constant syntax. */
978 if (looking_for
== c
&& !char_escaped
)
979 looking_for
= 0; /* Found terminator... stop looking. */
982 if (c
== '\'' || c
== '"')
983 looking_for
= c
; /* Don't stop buffering until we see another
984 one of these (or an EOF). */
986 /* Handle backslash. */
987 char_escaped
= (c
== '\\' && ! char_escaped
);
991 /* Handle # directives that make it through (or are generated by) the
992 preprocessor. As much as reasonably possible, emulate the behavior
993 of the gcc compiler phase cc1, though interactions between #include
994 and INCLUDE might possibly produce bizarre results in terms of
995 error reporting and the generation of debugging info vis-a-vis the
996 locations of some things.
998 Returns the next character unhandled, which is always newline or EOF. */
1000 #if defined HANDLE_PRAGMA
1001 /* Local versions of these macros, that can be passed as function pointers. */
1005 return getc (finput
);
1012 ungetc (arg
, finput
);
1014 #endif /* HANDLE_PRAGMA */
1017 ffelex_hash_ (FILE *finput
)
1020 ffelexToken token
= NULL
;
1022 /* Read first nonwhite char after the `#'. */
1024 c
= ffelex_getc_ (finput
);
1025 while (c
== ' ' || c
== '\t')
1026 c
= ffelex_getc_ (finput
);
1028 /* If a letter follows, then if the word here is `line', skip
1029 it and ignore it; otherwise, ignore the line, with an error
1030 if the word isn't `pragma', `ident', `define', or `undef'. */
1036 if (getc (finput
) == 'r'
1037 && getc (finput
) == 'a'
1038 && getc (finput
) == 'g'
1039 && getc (finput
) == 'm'
1040 && getc (finput
) == 'a'
1041 && ((c
= getc (finput
)) == ' ' || c
== '\t' || c
== '\n'
1044 #if 0 /* g77 doesn't handle pragmas, so ignores them FOR NOW. */
1045 static char buffer
[128];
1046 char * buff
= buffer
;
1048 /* Read the pragma name into a buffer.
1049 ISSPACE() may evaluate its argument more than once! */
1050 while (((c
= getc (finput
)), ISSPACE(c
)))
1058 while (c
!= EOF
&& ! ISSPACE (c
) && c
!= '\n'
1059 && buff
< buffer
+ 128);
1064 #ifdef HANDLE_PRAGMA
1065 if (HANDLE_PRAGMA (pragma_getc
, pragma_ungetc
, buffer
))
1067 #endif /* HANDLE_PRAGMA */
1068 #ifdef HANDLE_GENERIC_PRAGMAS
1069 if (handle_generic_pragma (buffer
))
1071 #endif /* !HANDLE_GENERIC_PRAGMAS */
1073 /* Issue a warning message if we have been asked to do so.
1074 Ignoring unknown pragmas in system header file unless
1075 an explcit -Wunknown-pragmas has been given. */
1076 if (warn_unknown_pragmas
> 1
1077 || (warn_unknown_pragmas
&& ! in_system_header
))
1078 warning ("ignoring pragma: %s", token_buffer
);
1086 if (getc (finput
) == 'e'
1087 && getc (finput
) == 'f'
1088 && getc (finput
) == 'i'
1089 && getc (finput
) == 'n'
1090 && getc (finput
) == 'e'
1091 && ((c
= getc (finput
)) == ' ' || c
== '\t' || c
== '\n'
1096 c
= ffelex_get_directive_line_ (&text
, finput
);
1098 if (debug_info_level
== DINFO_LEVEL_VERBOSE
)
1099 (*debug_hooks
->define
) (input_line
, text
);
1106 if (getc (finput
) == 'n'
1107 && getc (finput
) == 'd'
1108 && getc (finput
) == 'e'
1109 && getc (finput
) == 'f'
1110 && ((c
= getc (finput
)) == ' ' || c
== '\t' || c
== '\n'
1115 c
= ffelex_get_directive_line_ (&text
, finput
);
1117 if (debug_info_level
== DINFO_LEVEL_VERBOSE
)
1118 (*debug_hooks
->undef
) (input_line
, text
);
1125 if (getc (finput
) == 'i'
1126 && getc (finput
) == 'n'
1127 && getc (finput
) == 'e'
1128 && ((c
= getc (finput
)) == ' ' || c
== '\t'))
1133 if (getc (finput
) == 'd'
1134 && getc (finput
) == 'e'
1135 && getc (finput
) == 'n'
1136 && getc (finput
) == 't'
1137 && ((c
= getc (finput
)) == ' ' || c
== '\t'))
1139 /* #ident. The pedantic warning is now in cpp. */
1141 /* Here we have just seen `#ident '.
1142 A string constant should follow. */
1144 while (c
== ' ' || c
== '\t')
1147 /* If no argument, ignore the line. */
1148 if (c
== '\n' || c
== EOF
)
1151 c
= ffelex_cfelex_ (&token
, finput
, c
);
1154 || (ffelex_token_type (token
) != FFELEX_typeCHARACTER
))
1156 error ("invalid #ident");
1160 if (! flag_no_ident
)
1162 #ifdef ASM_OUTPUT_IDENT
1163 ASM_OUTPUT_IDENT (asm_out_file
,
1164 ffelex_token_text (token
));
1168 /* Skip the rest of this line. */
1173 error ("undefined or invalid # directive");
1178 /* Here we have either `#line' or `# <nonletter>'.
1179 In either case, it should be a line number; a digit should follow. */
1181 while (c
== ' ' || c
== '\t')
1182 c
= ffelex_getc_ (finput
);
1184 /* If the # is the only nonwhite char on the line,
1185 just ignore it. Check the new newline. */
1186 if (c
== '\n' || c
== EOF
)
1189 /* Something follows the #; read a token. */
1191 c
= ffelex_cfelex_ (&token
, finput
, c
);
1194 && (ffelex_token_type (token
) == FFELEX_typeNUMBER
))
1196 location_t old_loc
= input_location
;
1199 /* subtract one, because it is the following line that
1200 gets the specified number */
1201 int l
= atoi (ffelex_token_text (token
)) - 1;
1203 /* Is this the last nonwhite stuff on the line? */
1204 while (c
== ' ' || c
== '\t')
1205 c
= ffelex_getc_ (finput
);
1206 if (c
== '\n' || c
== EOF
)
1208 /* No more: store the line number and check following line. */
1210 if (!ffelex_kludge_flag_
)
1212 ffewhere_file_set (NULL
, TRUE
, (ffewhereLineNumber
) l
);
1215 ffelex_token_kill (token
);
1220 /* More follows: it must be a string constant (filename). */
1222 /* Read the string constant. */
1223 c
= ffelex_cfelex_ (&token
, finput
, c
);
1226 || (ffelex_token_type (token
) != FFELEX_typeCHARACTER
))
1228 error ("invalid #line");
1234 if (ffelex_kludge_flag_
)
1235 input_filename
= ggc_strdup (ffelex_token_text (token
));
1238 wf
= ffewhere_file_new (ffelex_token_text (token
),
1239 ffelex_token_length (token
));
1240 input_filename
= ffewhere_file_name (wf
);
1241 ffewhere_file_set (wf
, TRUE
, (ffewhereLineNumber
) l
);
1244 #if 0 /* Not sure what g77 should do with this yet. */
1245 /* Each change of file name
1246 reinitializes whether we are now in a system header. */
1247 in_system_header
= 0;
1250 if (main_input_filename
== 0)
1251 main_input_filename
= input_filename
;
1253 /* Is this the last nonwhite stuff on the line? */
1254 while (c
== ' ' || c
== '\t')
1256 if (c
== '\n' || c
== EOF
)
1258 if (!ffelex_kludge_flag_
)
1260 /* Update the name in the top element of input_file_stack. */
1261 if (input_file_stack
)
1262 input_file_stack
->location
.file
= input_filename
;
1265 ffelex_token_kill (token
);
1270 c
= ffelex_cfelex_ (&token
, finput
, c
);
1272 /* `1' after file name means entering new file.
1273 `2' after file name means just left a file. */
1276 && (ffelex_token_type (token
) == FFELEX_typeNUMBER
))
1278 int num
= atoi (ffelex_token_text (token
));
1280 if (ffelex_kludge_flag_
)
1283 input_filename
= old_loc
.file
;
1284 error ("use `#line ...' instead of `# ...' in first line");
1289 /* Pushing to a new file. */
1290 ffelex_file_push_ (old_loc
.line
, input_filename
);
1294 /* Popping out of a file. */
1295 ffelex_file_pop_ (input_filename
);
1298 /* Is this the last nonwhite stuff on the line? */
1299 while (c
== ' ' || c
== '\t')
1301 if (c
== '\n' || c
== EOF
)
1304 ffelex_token_kill (token
);
1308 c
= ffelex_cfelex_ (&token
, finput
, c
);
1311 /* `3' after file name means this is a system header file. */
1313 #if 0 /* Not sure what g77 should do with this yet. */
1315 && (ffelex_token_type (token
) == FFELEX_typeNUMBER
)
1316 && (atoi (ffelex_token_text (token
)) == 3))
1317 in_system_header
= 1;
1320 while (c
== ' ' || c
== '\t')
1322 if (((token
!= NULL
)
1323 || (c
!= '\n' && c
!= EOF
))
1324 && ffelex_kludge_flag_
)
1327 input_filename
= old_loc
.file
;
1328 error ("use `#line ...' instead of `# ...' in first line");
1330 if (c
== '\n' || c
== EOF
)
1332 if (token
!= NULL
&& !ffelex_kludge_flag_
)
1333 ffelex_token_kill (token
);
1338 error ("invalid #-line");
1340 /* skip the rest of this line. */
1342 if ((token
!= NULL
) && !ffelex_kludge_flag_
)
1343 ffelex_token_kill (token
);
1344 while ((c
= getc (finput
)) != EOF
&& c
!= '\n')
1349 /* "Image" a character onto the card image, return incremented column number.
1351 Normally invoking this function as in
1352 column = ffelex_image_char_ (c, column);
1353 is the same as doing:
1354 ffelex_card_image_[column++] = c;
1356 However, tabs and carriage returns are handled specially, to preserve
1357 the visual "image" of the input line (in most editors) in the card
1360 Carriage returns are ignored, as they are assumed to be followed
1363 A tab is handled by first doing:
1364 ffelex_card_image_[column++] = ' ';
1365 That is, it translates to at least one space. Then, as many spaces
1366 are imaged as necessary to bring the column number to the next tab
1367 position, where tab positions start in the ninth column and each
1368 eighth column afterwards. ALSO, a static var named ffelex_saw_tab_
1369 is set to TRUE to notify the lexer that a tab was seen.
1371 Columns are numbered and tab stops set as illustrated below:
1373 012345670123456701234567...
1377 xxxxxxx yyyyyyy zzzzzzz
1378 xxxxxxxx yyyyyyyy... */
1380 static ffewhereColumnNumber
1381 ffelex_image_char_ (int c
, ffewhereColumnNumber column
)
1383 ffewhereColumnNumber old_column
= column
;
1385 if (column
>= ffelex_card_size_
)
1387 ffewhereColumnNumber newmax
= ffelex_card_size_
<< 1;
1389 if (ffelex_bad_line_
)
1392 if ((newmax
>> 1) != ffelex_card_size_
)
1393 { /* Overflowed column number. */
1394 overflow
: /* :::::::::::::::::::: */
1396 ffelex_bad_line_
= TRUE
;
1397 strcpy (&ffelex_card_image_
[column
- 3], "...");
1398 ffelex_card_length_
= column
;
1399 ffelex_bad_1_ (FFEBAD_LINE_TOO_LONG
,
1400 ffelex_linecount_current_
, column
+ 1);
1405 = malloc_resize_ksr (malloc_pool_image (),
1408 ffelex_card_size_
+ 9);
1409 ffelex_card_size_
= newmax
;
1418 ffelex_saw_tab_
= TRUE
;
1419 ffelex_card_image_
[column
++] = ' ';
1420 while ((column
& 7) != 0)
1421 ffelex_card_image_
[column
++] = ' ';
1425 if (!ffelex_bad_line_
)
1427 ffelex_bad_line_
= TRUE
;
1428 strcpy (&ffelex_card_image_
[column
], "[\\0]");
1429 ffelex_card_length_
= column
+ 4;
1430 /* xgettext:no-c-format */
1431 ffebad_start_msg_lex ("Null character at %0 -- line ignored",
1432 FFEBAD_severityFATAL
);
1433 ffelex_bad_here_ (0, ffelex_linecount_current_
, column
+ 1);
1440 ffelex_card_image_
[column
++] = c
;
1444 if (column
< old_column
)
1446 column
= old_column
;
1447 goto overflow
; /* :::::::::::::::::::: */
1456 ffewhereFile include_wherefile
= ffelex_include_wherefile_
;
1457 FILE *include_file
= ffelex_include_file_
;
1458 /* The rest of this is to push, and after the INCLUDE file is processed,
1459 pop, the static lexer state info that pertains to each particular
1462 ffewhereColumnNumber card_size
= ffelex_card_size_
;
1463 ffewhereColumnNumber card_length
= ffelex_card_length_
;
1464 ffewhereLine current_wl
= ffelex_current_wl_
;
1465 ffewhereColumn current_wc
= ffelex_current_wc_
;
1466 bool saw_tab
= ffelex_saw_tab_
;
1467 ffewhereColumnNumber final_nontab_column
= ffelex_final_nontab_column_
;
1468 ffewhereFile current_wf
= ffelex_current_wf_
;
1469 ffewhereLineNumber linecount_current
= ffelex_linecount_current_
;
1470 ffewhereLineNumber linecount_offset
1471 = ffewhere_line_filelinenum (current_wl
);
1472 location_t old_loc
= input_location
;
1474 if (card_length
!= 0)
1476 card_image
= malloc_new_ks (malloc_pool_image (),
1477 "FFELEX saved card image",
1479 memcpy (card_image
, ffelex_card_image_
, card_length
);
1484 ffelex_set_include_
= FALSE
;
1486 ffelex_next_line_ ();
1488 ffewhere_file_set (include_wherefile
, TRUE
, 0);
1490 ffelex_file_push_ (old_loc
.line
, ffewhere_file_name (include_wherefile
));
1492 if (ffelex_include_free_form_
)
1493 ffelex_file_free (include_wherefile
, include_file
);
1495 ffelex_file_fixed (include_wherefile
, include_file
);
1497 ffelex_file_pop_ (ffewhere_file_name (current_wf
));
1499 ffewhere_file_set (current_wf
, TRUE
, linecount_offset
);
1501 ffecom_close_include (include_file
);
1503 if (card_length
!= 0)
1505 #ifdef REDUCE_CARD_SIZE_AFTER_BIGGY /* Define if occasional large lines. */
1506 #error "need to handle possible reduction of card size here!!"
1508 assert (ffelex_card_size_
>= card_length
); /* It shrunk?? */
1509 memcpy (ffelex_card_image_
, card_image
, card_length
);
1511 ffelex_card_image_
[card_length
] = '\0';
1513 input_location
= old_loc
;
1514 ffelex_linecount_current_
= linecount_current
;
1515 ffelex_current_wf_
= current_wf
;
1516 ffelex_final_nontab_column_
= final_nontab_column
;
1517 ffelex_saw_tab_
= saw_tab
;
1518 ffelex_current_wc_
= current_wc
;
1519 ffelex_current_wl_
= current_wl
;
1520 ffelex_card_length_
= card_length
;
1521 ffelex_card_size_
= card_size
;
1524 /* ffelex_is_free_char_ctx_contin_ -- Character Context Continuation?
1526 ffewhereColumnNumber col;
1527 int c; // Char at col.
1528 if ((c == '&') && ffelex_is_free_char_ctx_contin_(col + 1))
1529 // We have a continuation indicator.
1531 If there are <n> spaces starting at ffelex_card_image_[col] up through
1532 the null character, where <n> is 0 or greater, returns TRUE. */
1535 ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col
)
1537 while (ffelex_card_image_
[col
] != '\0')
1539 if (ffelex_card_image_
[col
++] != ' ')
1545 /* ffelex_is_free_nonc_ctx_contin_ -- Noncharacter Context Continuation?
1547 ffewhereColumnNumber col;
1548 int c; // Char at col.
1549 if ((c == '&') && ffelex_is_free_nonc_ctx_contin_(col + 1))
1550 // We have a continuation indicator.
1552 If there are <n> spaces starting at ffelex_card_image_[col] up through
1553 the null character or '!', where <n> is 0 or greater, returns TRUE. */
1556 ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col
)
1558 while ((ffelex_card_image_
[col
] != '\0') && (ffelex_card_image_
[col
] != '!'))
1560 if (ffelex_card_image_
[col
++] != ' ')
1567 ffelex_next_line_ ()
1569 ffelex_linecount_current_
= ffelex_linecount_next_
;
1570 ++ffelex_linecount_next_
;
1575 ffelex_send_token_ ()
1577 ++ffelex_number_of_tokens_
;
1579 ffelex_backslash_ (EOF
, 0);
1581 if (ffelex_token_
->text
== NULL
)
1583 if (ffelex_token_
->type
== FFELEX_typeCHARACTER
)
1585 ffelex_append_to_token_ ('\0');
1586 ffelex_token_
->length
= 0;
1590 ffelex_token_
->text
[ffelex_token_
->length
] = '\0';
1592 assert (ffelex_raw_mode_
== 0);
1594 if (ffelex_token_
->type
== FFELEX_typeNAMES
)
1596 ffewhere_line_kill (ffelex_token_
->currentnames_line
);
1597 ffewhere_column_kill (ffelex_token_
->currentnames_col
);
1600 assert (ffelex_handler_
!= NULL
);
1601 ffelex_handler_
= (ffelexHandler
) (*ffelex_handler_
) (ffelex_token_
);
1602 assert (ffelex_handler_
!= NULL
);
1604 ffelex_token_kill (ffelex_token_
);
1606 ffelex_token_
= ffelex_token_new_ ();
1607 ffelex_token_
->uses
= 1;
1608 ffelex_token_
->text
= NULL
;
1609 if (ffelex_raw_mode_
< 0)
1611 ffelex_token_
->type
= FFELEX_typeCHARACTER
;
1612 ffelex_token_
->where_line
= ffelex_raw_where_line_
;
1613 ffelex_token_
->where_col
= ffelex_raw_where_col_
;
1614 ffelex_raw_where_line_
= ffewhere_line_unknown ();
1615 ffelex_raw_where_col_
= ffewhere_column_unknown ();
1619 ffelex_token_
->type
= FFELEX_typeNONE
;
1620 ffelex_token_
->where_line
= ffewhere_line_unknown ();
1621 ffelex_token_
->where_col
= ffewhere_column_unknown ();
1624 if (ffelex_set_include_
)
1628 /* ffelex_swallow_tokens_ -- Eat all tokens delivered to me
1630 return ffelex_swallow_tokens_;
1632 Return this handler when you don't want to look at any more tokens in the
1633 statement because you've encountered an unrecoverable error in the
1636 static ffelexHandler
1637 ffelex_swallow_tokens_ (ffelexToken t
)
1639 assert (ffelex_eos_handler_
!= NULL
);
1641 if ((ffelex_token_type (t
) == FFELEX_typeEOS
)
1642 || (ffelex_token_type (t
) == FFELEX_typeSEMICOLON
))
1643 return (ffelexHandler
) (*ffelex_eos_handler_
) (t
);
1645 return (ffelexHandler
) ffelex_swallow_tokens_
;
1649 ffelex_token_new_ ()
1653 ++ffelex_total_tokens_
;
1655 t
= (ffelexToken
) malloc_new_ks (malloc_pool_image (),
1656 "FFELEX token", sizeof (*t
));
1657 t
->id_
= ffelex_token_nextid_
++;
1662 ffelex_type_string_ (ffelexType type
)
1664 static const char *const types
[] = {
1666 "FFELEX_typeCOMMENT",
1672 "FFELEX_typeDOLLAR",
1674 "FFELEX_typePERCENT",
1675 "FFELEX_typeAMPERSAND",
1676 "FFELEX_typeAPOSTROPHE",
1677 "FFELEX_typeOPEN_PAREN",
1678 "FFELEX_typeCLOSE_PAREN",
1679 "FFELEX_typeASTERISK",
1682 "FFELEX_typePERIOD",
1684 "FFELEX_typeNUMBER",
1685 "FFELEX_typeOPEN_ANGLE",
1686 "FFELEX_typeEQUALS",
1687 "FFELEX_typeCLOSE_ANGLE",
1691 "FFELEX_typeCONCAT",
1694 "FFELEX_typeHOLLERITH",
1695 "FFELEX_typeCHARACTER",
1697 "FFELEX_typeSEMICOLON",
1698 "FFELEX_typeUNDERSCORE",
1699 "FFELEX_typeQUESTION",
1700 "FFELEX_typeOPEN_ARRAY",
1701 "FFELEX_typeCLOSE_ARRAY",
1702 "FFELEX_typeCOLONCOLON",
1703 "FFELEX_typeREL_LE",
1704 "FFELEX_typeREL_NE",
1705 "FFELEX_typeREL_EQ",
1706 "FFELEX_typePOINTS",
1710 if (type
>= ARRAY_SIZE (types
))
1716 ffelex_display_token (ffelexToken t
)
1721 fprintf (dmpout
, "; Token #%lu is %s (line %" ffewhereLineNumber_f
"u, col %"
1722 ffewhereColumnNumber_f
"u)",
1724 ffelex_type_string_ (t
->type
),
1725 ffewhere_line_number (t
->where_line
),
1726 ffewhere_column_number (t
->where_col
));
1728 if (t
->text
!= NULL
)
1729 fprintf (dmpout
, ": \"%.*s\"\n",
1733 fprintf (dmpout
, ".\n");
1736 /* ffelex_expecting_character -- Tells if next token expected to be CHARACTER
1738 if (ffelex_expecting_character())
1739 // next token delivered by lexer will be CHARACTER.
1741 If the most recent call to ffelex_set_expecting_hollerith since the last
1742 token was delivered by the lexer passed a length of -1, then we return
1743 TRUE, because the next token we deliver will be typeCHARACTER, else we
1747 ffelex_expecting_character ()
1749 return (ffelex_raw_mode_
!= 0);
1752 /* ffelex_file_fixed -- Lex a given file in fixed source form
1756 ffelex_file_fixed(wf,f);
1758 Lexes the file according to Fortran 90 ANSI + VXT specifications. */
1761 ffelex_file_fixed (ffewhereFile wf
, FILE *f
)
1763 register int c
= 0; /* Character currently under consideration. */
1764 register ffewhereColumnNumber column
= 0; /* Not really; 0 means column 1... */
1765 bool disallow_continuation_line
;
1766 bool ignore_disallowed_continuation
= FALSE
;
1767 int latest_char_in_file
= 0; /* For getting back into comment-skipping
1770 ffewhereColumnNumber first_label_char
; /* First char of label --
1772 char label_string
[6]; /* Text of label. */
1773 int labi
; /* Length of label text. */
1774 bool finish_statement
; /* Previous statement finished? */
1775 bool have_content
; /* This line have content? */
1776 bool just_do_label
; /* Nothing but label (and continuation?) on
1779 /* Lex is called for a particular file, not for a particular program unit.
1780 Yet the two events do share common characteristics. The first line in a
1781 file or in a program unit cannot be a continuation line. No token can
1782 be in mid-formation. No current label for the statement exists, since
1783 there is no current statement. */
1785 assert (ffelex_handler_
!= NULL
);
1788 input_filename
= ffewhere_file_name (wf
);
1789 ffelex_current_wf_
= wf
;
1790 disallow_continuation_line
= TRUE
;
1791 ignore_disallowed_continuation
= FALSE
;
1792 ffelex_token_
->type
= FFELEX_typeNONE
;
1793 ffelex_number_of_tokens_
= 0;
1794 ffelex_label_tokens_
= 0;
1795 ffelex_current_wl_
= ffewhere_line_unknown ();
1796 ffelex_current_wc_
= ffewhere_column_unknown ();
1797 latest_char_in_file
= '\n';
1799 goto first_line
; /* :::::::::::::::::::: */
1801 /* Come here to get a new line. */
1803 beginning_of_line
: /* :::::::::::::::::::: */
1805 disallow_continuation_line
= FALSE
;
1807 /* Come here directly when last line didn't clarify the continuation issue. */
1809 beginning_of_line_again
: /* :::::::::::::::::::: */
1811 #ifdef REDUCE_CARD_SIZE_AFTER_BIGGY /* Define if occasional large lines. */
1812 if (ffelex_card_size_
!= FFELEX_columnINITIAL_SIZE_
)
1815 = malloc_resize_ks (malloc_pool_image (),
1817 FFELEX_columnINITIAL_SIZE_
+ 9,
1818 ffelex_card_size_
+ 9);
1819 ffelex_card_size_
= FFELEX_columnINITIAL_SIZE_
;
1823 first_line
: /* :::::::::::::::::::: */
1825 c
= latest_char_in_file
;
1826 if ((c
== EOF
) || ((c
= ffelex_getc_ (f
)) == EOF
))
1829 end_of_file
: /* :::::::::::::::::::: */
1831 /* Line ending in EOF instead of \n still counts as a whole line. */
1833 ffelex_finish_statement_ ();
1834 ffewhere_line_kill (ffelex_current_wl_
);
1835 ffewhere_column_kill (ffelex_current_wc_
);
1836 return (ffelexHandler
) ffelex_handler_
;
1839 ffelex_next_line_ ();
1841 ffelex_bad_line_
= FALSE
;
1843 /* Skip over comment (and otherwise ignored) lines as quickly as possible! */
1845 while (((lextype
= ffelex_first_char_
[c
]) == FFELEX_typeCOMMENT
)
1846 || (lextype
== FFELEX_typeERROR
)
1847 || (lextype
== FFELEX_typeSLASH
)
1848 || (lextype
== FFELEX_typeHASH
))
1850 /* Test most frequent type of line first, etc. */
1851 if ((lextype
== FFELEX_typeCOMMENT
)
1852 || ((lextype
== FFELEX_typeSLASH
)
1853 && ((c
= getc (f
)) == '*'))) /* NOTE SIDE-EFFECT. */
1855 /* Typical case (straight comment), just ignore rest of line. */
1856 comment_line
: /* :::::::::::::::::::: */
1858 while ((c
!= '\n') && (c
!= EOF
))
1861 else if (lextype
== FFELEX_typeHASH
)
1862 c
= ffelex_hash_ (f
);
1863 else if (lextype
== FFELEX_typeSLASH
)
1865 /* SIDE-EFFECT ABOVE HAS HAPPENED. */
1866 ffelex_card_image_
[0] = '/';
1867 ffelex_card_image_
[1] = c
;
1869 goto bad_first_character
; /* :::::::::::::::::::: */
1872 /* typeERROR or unsupported typeHASH. */
1873 { /* Bad first character, get line and display
1875 column
= ffelex_image_char_ (c
, 0);
1877 bad_first_character
: /* :::::::::::::::::::: */
1879 ffelex_bad_line_
= TRUE
;
1880 while (((c
= getc (f
)) != '\n') && (c
!= EOF
))
1881 column
= ffelex_image_char_ (c
, column
);
1882 ffelex_card_image_
[column
] = '\0';
1883 ffelex_card_length_
= column
;
1884 ffelex_bad_1_ (FFEBAD_FIRST_CHAR_INVALID
,
1885 ffelex_linecount_current_
, 1);
1888 /* Read past last char in line. */
1892 ffelex_next_line_ ();
1893 goto end_of_file
; /* :::::::::::::::::::: */
1898 ffelex_next_line_ ();
1901 goto end_of_file
; /* :::::::::::::::::::: */
1903 ffelex_bad_line_
= FALSE
;
1904 } /* while [c, first char, means comment] */
1908 || (ffelex_final_nontab_column_
== 0);
1910 if (lextype
== FFELEX_typeDEBUG
)
1911 c
= ' '; /* A 'D' or 'd' in column 1 with the
1912 debug-lines option on. */
1914 column
= ffelex_image_char_ (c
, 0);
1916 /* Read the entire line in as is (with whitespace processing). */
1918 while (((c
= getc (f
)) != '\n') && (c
!= EOF
))
1919 column
= ffelex_image_char_ (c
, column
);
1921 if (ffelex_bad_line_
)
1923 ffelex_card_image_
[column
] = '\0';
1924 ffelex_card_length_
= column
;
1925 goto comment_line
; /* :::::::::::::::::::: */
1928 /* If no tab, cut off line after column 72/132. */
1930 if (!ffelex_saw_tab_
&& (column
> ffelex_final_nontab_column_
))
1932 /* Technically, we should now fill ffelex_card_image_ up thru column
1933 72/132 with spaces, since character/hollerith constants must count
1934 them in that manner. To save CPU time in several ways (avoid a loop
1935 here that would be used only when we actually end a line in
1936 character-constant mode; avoid writing memory unnecessarily; avoid a
1937 loop later checking spaces when not scanning for character-constant
1938 characters), we don't do this, and we do the appropriate thing when
1939 we encounter end-of-line while actually processing a character
1942 column
= ffelex_final_nontab_column_
;
1945 ffelex_card_image_
[column
] = '\0';
1946 ffelex_card_length_
= column
;
1948 /* Save next char in file so we can use register-based c while analyzing
1949 line we just read. */
1951 latest_char_in_file
= c
; /* Should be either '\n' or EOF. */
1953 have_content
= FALSE
;
1955 /* Handle label, if any. */
1958 first_label_char
= FFEWHERE_columnUNKNOWN
;
1959 for (column
= 0; column
< 5; ++column
)
1961 switch (c
= ffelex_card_image_
[column
])
1965 goto stop_looking
; /* :::::::::::::::::::: */
1980 label_string
[labi
++] = c
;
1981 if (first_label_char
== FFEWHERE_columnUNKNOWN
)
1982 first_label_char
= column
+ 1;
1988 ffelex_bad_1_ (FFEBAD_LABEL_FIELD_NOT_NUMERIC
,
1989 ffelex_linecount_current_
,
1991 goto beginning_of_line_again
; /* :::::::::::::::::::: */
1993 if (ffe_is_pedantic ())
1994 ffelex_bad_1_ (FFEBAD_AMPERSAND
,
1995 ffelex_linecount_current_
, 1);
1996 finish_statement
= FALSE
;
1997 just_do_label
= FALSE
;
1998 goto got_a_continuation
; /* :::::::::::::::::::: */
2001 if (ffelex_card_image_
[column
+ 1] == '*')
2002 goto stop_looking
; /* :::::::::::::::::::: */
2005 ffelex_bad_1_ (FFEBAD_LABEL_FIELD_NOT_NUMERIC
,
2006 ffelex_linecount_current_
, column
+ 1);
2007 goto beginning_of_line_again
; /* :::::::::::::::::::: */
2011 stop_looking
: /* :::::::::::::::::::: */
2013 label_string
[labi
] = '\0';
2015 /* Find first nonblank char starting with continuation column. */
2017 if (column
== 5) /* In which case we didn't see end of line in
2019 while ((c
= ffelex_card_image_
[column
]) == ' ')
2022 /* Now we're trying to figure out whether this is a continuation line and
2023 whether there's anything else of substance on the line. The cases are
2026 1. If a line has an explicit continuation character (other than the digit
2027 zero), then if it also has a label, the label is ignored and an error
2028 message is printed. Any remaining text on the line is passed to the
2029 parser tasks, thus even an all-blank line (possibly with an ignored
2030 label) aside from a positive continuation character might have meaning
2031 in the midst of a character or hollerith constant.
2033 2. If a line has no explicit continuation character (that is, it has a
2034 space in column 6 and the first non-space character past column 6 is
2035 not a digit 0-9), then there are two possibilities:
2037 A. A label is present and/or a non-space (and non-comment) character
2038 appears somewhere after column 6. Terminate processing of the previous
2039 statement, if any, send the new label for the next statement, if any,
2040 and start processing a new statement with this non-blank character, if
2043 B. The line is essentially blank, except for a possible comment character.
2044 Don't terminate processing of the previous statement and don't pass any
2045 characters to the parser tasks, since the line is not flagged as a
2046 continuation line. We treat it just like a completely blank line.
2048 3. If a line has a continuation character of zero (0), then we terminate
2049 processing of the previous statement, if any, send the new label for the
2050 next statement, if any, and start processing a new statement, if any
2051 non-blank characters are present.
2053 If, when checking to see if we should terminate the previous statement, it
2054 is found that there is no previous statement but that there is an
2055 outstanding label, substitute CONTINUE as the statement for the label
2056 and display an error message. */
2058 finish_statement
= FALSE
;
2059 just_do_label
= FALSE
;
2063 case '!': /* ANSI Fortran 90 says ! in column 6 is
2065 /* VXT Fortran says ! anywhere is comment, even column 6. */
2066 if (ffe_is_vxt () || (column
!= 5))
2067 goto no_tokens_on_line
; /* :::::::::::::::::::: */
2068 goto got_a_continuation
; /* :::::::::::::::::::: */
2071 if (ffelex_card_image_
[column
+ 1] != '*')
2072 goto some_other_character
; /* :::::::::::::::::::: */
2076 /* This seems right to do. But it is close to call, since / * starting
2077 in column 6 will thus be interpreted as a continuation line
2078 beginning with '*'. */
2080 goto got_a_continuation
;/* :::::::::::::::::::: */
2084 /* End of line. Therefore may be continued-through line, so handle
2085 pending label as possible to-be-continued and drive end-of-statement
2086 for any previous statement, else treat as blank line. */
2088 no_tokens_on_line
: /* :::::::::::::::::::: */
2090 if (ffe_is_pedantic () && (c
== '/'))
2091 ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT
,
2092 ffelex_linecount_current_
, column
+ 1);
2093 if (first_label_char
!= FFEWHERE_columnUNKNOWN
)
2094 { /* Can't be a continued-through line if it
2096 finish_statement
= TRUE
;
2097 have_content
= TRUE
;
2098 just_do_label
= TRUE
;
2101 goto beginning_of_line_again
; /* :::::::::::::::::::: */
2104 if (ffe_is_pedantic () && (column
!= 5))
2105 ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN
,
2106 ffelex_linecount_current_
, column
+ 1);
2107 finish_statement
= TRUE
;
2108 goto check_for_content
; /* :::::::::::::::::::: */
2120 /* NOTE: This label can be reached directly from the code
2121 that lexes the label field in columns 1-5. */
2122 got_a_continuation
: /* :::::::::::::::::::: */
2124 if (first_label_char
!= FFEWHERE_columnUNKNOWN
)
2126 ffelex_bad_2_ (FFEBAD_LABEL_ON_CONTINUATION
,
2127 ffelex_linecount_current_
,
2129 ffelex_linecount_current_
,
2131 first_label_char
= FFEWHERE_columnUNKNOWN
;
2133 if (disallow_continuation_line
)
2135 if (!ignore_disallowed_continuation
)
2136 ffelex_bad_1_ (FFEBAD_INVALID_CONTINUATION
,
2137 ffelex_linecount_current_
, column
+ 1);
2138 goto beginning_of_line_again
; /* :::::::::::::::::::: */
2140 if (ffe_is_pedantic () && (column
!= 5))
2141 ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN
,
2142 ffelex_linecount_current_
, column
+ 1);
2143 if ((ffelex_raw_mode_
!= 0)
2144 && (((c
= ffelex_card_image_
[column
+ 1]) != '\0')
2145 || !ffelex_saw_tab_
))
2148 have_content
= TRUE
;
2152 check_for_content
: /* :::::::::::::::::::: */
2154 while ((c
= ffelex_card_image_
[++column
]) == ' ')
2159 && (ffelex_card_image_
[column
+ 1] == '*')))
2161 if (ffe_is_pedantic () && (c
== '/'))
2162 ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT
,
2163 ffelex_linecount_current_
, column
+ 1);
2164 just_do_label
= TRUE
;
2167 have_content
= TRUE
;
2172 some_other_character
: /* :::::::::::::::::::: */
2175 goto got_a_continuation
;/* :::::::::::::::::::: */
2177 /* Here is the very normal case of a regular character starting in
2178 column 7 or beyond with a blank in column 6. */
2180 finish_statement
= TRUE
;
2181 have_content
= TRUE
;
2186 || (first_label_char
!= FFEWHERE_columnUNKNOWN
))
2188 /* The line has content of some kind, install new end-statement
2189 point for error messages. Note that "content" includes cases
2190 where there's little apparent content but enough to finish
2191 a statement. That's because finishing a statement can trigger
2192 an impending INCLUDE, and that requires accurate line info being
2193 maintained by the lexer. */
2195 if (finish_statement
)
2196 ffelex_prepare_eos_ (); /* Prepare EOS before we move current pointer. */
2198 ffewhere_line_kill (ffelex_current_wl_
);
2199 ffewhere_column_kill (ffelex_current_wc_
);
2200 ffelex_current_wl_
= ffewhere_line_new (ffelex_linecount_current_
);
2201 ffelex_current_wc_
= ffewhere_column_new (ffelex_card_length_
+ 1);
2204 /* We delay this for a combination of reasons. Mainly, it can start
2205 INCLUDE processing, and we want to delay that until the lexer's
2206 info on the line is coherent. And we want to delay that until we're
2207 sure there's a reason to make that info coherent, to avoid saving
2208 lots of useless lines. */
2210 if (finish_statement
)
2211 ffelex_finish_statement_ ();
2213 /* If label is present, enclose it in a NUMBER token and send it along. */
2215 if (first_label_char
!= FFEWHERE_columnUNKNOWN
)
2217 assert (ffelex_token_
->type
== FFELEX_typeNONE
);
2218 ffelex_token_
->type
= FFELEX_typeNUMBER
;
2219 ffelex_append_to_token_ ('\0'); /* Make room for label text. */
2220 strcpy (ffelex_token_
->text
, label_string
);
2221 ffelex_token_
->where_line
2222 = ffewhere_line_use (ffelex_current_wl_
);
2223 ffelex_token_
->where_col
= ffewhere_column_new (first_label_char
);
2224 ffelex_token_
->length
= labi
;
2225 ffelex_send_token_ ();
2226 ++ffelex_label_tokens_
;
2230 goto beginning_of_line
; /* :::::::::::::::::::: */
2232 /* Here is the main engine for parsing. c holds the character at column.
2233 It is already known that c is not a blank, end of line, or shriek,
2234 unless ffelex_raw_mode_ is not 0 (indicating we are in a
2235 character/hollerith constant). A partially filled token may already
2236 exist in ffelex_token_. One special case: if, when the end of the line
2237 is reached, continuation_line is FALSE and the only token on the line is
2238 END, then it is indeed the last statement. We don't look for
2239 continuation lines during this program unit in that case. This is
2240 according to ANSI. */
2242 if (ffelex_raw_mode_
!= 0)
2245 parse_raw_character
: /* :::::::::::::::::::: */
2249 ffewhereColumnNumber i
;
2251 if (ffelex_saw_tab_
|| (column
>= ffelex_final_nontab_column_
))
2252 goto beginning_of_line
; /* :::::::::::::::::::: */
2254 /* Pad out line with "virtual" spaces. */
2256 for (i
= column
; i
< ffelex_final_nontab_column_
; ++i
)
2257 ffelex_card_image_
[i
] = ' ';
2258 ffelex_card_image_
[i
] = '\0';
2259 ffelex_card_length_
= i
;
2263 switch (ffelex_raw_mode_
)
2266 c
= ffelex_backslash_ (c
, column
);
2270 if (!ffelex_backslash_reconsider_
)
2271 ffelex_append_to_token_ (c
);
2272 ffelex_raw_mode_
= -1;
2276 if (c
== ffelex_raw_char_
)
2278 ffelex_raw_mode_
= -1;
2279 ffelex_append_to_token_ (c
);
2283 ffelex_raw_mode_
= 0;
2284 ffelex_backslash_reconsider_
= TRUE
;
2289 if (c
== ffelex_raw_char_
)
2290 ffelex_raw_mode_
= -2;
2293 c
= ffelex_backslash_ (c
, column
);
2296 ffelex_raw_mode_
= -3;
2300 ffelex_append_to_token_ (c
);
2305 c
= ffelex_backslash_ (c
, column
);
2309 if (!ffelex_backslash_reconsider_
)
2311 ffelex_append_to_token_ (c
);
2317 if (ffelex_backslash_reconsider_
)
2318 ffelex_backslash_reconsider_
= FALSE
;
2320 c
= ffelex_card_image_
[++column
];
2322 if (ffelex_raw_mode_
== 0)
2324 ffelex_send_token_ ();
2325 assert (ffelex_raw_mode_
== 0);
2327 c
= ffelex_card_image_
[++column
];
2331 && (ffelex_card_image_
[column
+ 1] == '*')))
2332 goto beginning_of_line
; /* :::::::::::::::::::: */
2333 goto parse_nonraw_character
; /* :::::::::::::::::::: */
2335 goto parse_raw_character
; /* :::::::::::::::::::: */
2338 parse_nonraw_character
: /* :::::::::::::::::::: */
2340 switch (ffelex_token_
->type
)
2342 case FFELEX_typeNONE
:
2346 ffelex_token_
->type
= FFELEX_typeQUOTE
;
2347 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2348 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2349 ffelex_send_token_ ();
2353 ffelex_token_
->type
= FFELEX_typeDOLLAR
;
2354 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2355 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2356 ffelex_send_token_ ();
2360 ffelex_token_
->type
= FFELEX_typePERCENT
;
2361 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2362 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2363 ffelex_send_token_ ();
2367 ffelex_token_
->type
= FFELEX_typeAMPERSAND
;
2368 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2369 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2370 ffelex_send_token_ ();
2374 ffelex_token_
->type
= FFELEX_typeAPOSTROPHE
;
2375 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2376 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2377 ffelex_send_token_ ();
2381 ffelex_token_
->type
= FFELEX_typeOPEN_PAREN
;
2382 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2383 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2387 ffelex_token_
->type
= FFELEX_typeCLOSE_PAREN
;
2388 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2389 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2390 ffelex_send_token_ ();
2394 ffelex_token_
->type
= FFELEX_typeASTERISK
;
2395 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2396 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2400 ffelex_token_
->type
= FFELEX_typePLUS
;
2401 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2402 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2403 ffelex_send_token_ ();
2407 ffelex_token_
->type
= FFELEX_typeCOMMA
;
2408 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2409 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2410 ffelex_send_token_ ();
2414 ffelex_token_
->type
= FFELEX_typeMINUS
;
2415 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2416 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2417 ffelex_send_token_ ();
2421 ffelex_token_
->type
= FFELEX_typePERIOD
;
2422 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2423 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2424 ffelex_send_token_ ();
2428 ffelex_token_
->type
= FFELEX_typeSLASH
;
2429 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2430 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2444 = ffelex_hexnum_
? FFELEX_typeNAME
: FFELEX_typeNUMBER
;
2445 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2446 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2447 ffelex_append_to_token_ (c
);
2451 ffelex_token_
->type
= FFELEX_typeCOLON
;
2452 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2453 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2457 ffelex_token_
->type
= FFELEX_typeSEMICOLON
;
2458 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2459 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2460 ffelex_permit_include_
= TRUE
;
2461 ffelex_send_token_ ();
2462 ffelex_permit_include_
= FALSE
;
2466 ffelex_token_
->type
= FFELEX_typeOPEN_ANGLE
;
2467 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2468 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2472 ffelex_token_
->type
= FFELEX_typeEQUALS
;
2473 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2474 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2478 ffelex_token_
->type
= FFELEX_typeCLOSE_ANGLE
;
2479 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2480 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2484 ffelex_token_
->type
= FFELEX_typeQUESTION
;
2485 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
2486 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2487 ffelex_send_token_ ();
2491 if (1 || ffe_is_90 ())
2493 ffelex_token_
->type
= FFELEX_typeUNDERSCORE
;
2494 ffelex_token_
->where_line
2495 = ffewhere_line_use (ffelex_current_wl_
);
2496 ffelex_token_
->where_col
2497 = ffewhere_column_new (column
+ 1);
2498 ffelex_send_token_ ();
2554 c
= ffesrc_char_source (c
);
2556 if (ffesrc_char_match_init (c
, 'H', 'h')
2557 && ffelex_expecting_hollerith_
!= 0)
2559 ffelex_raw_mode_
= ffelex_expecting_hollerith_
;
2560 ffelex_token_
->type
= FFELEX_typeHOLLERITH
;
2561 ffelex_token_
->where_line
= ffelex_raw_where_line_
;
2562 ffelex_token_
->where_col
= ffelex_raw_where_col_
;
2563 ffelex_raw_where_line_
= ffewhere_line_unknown ();
2564 ffelex_raw_where_col_
= ffewhere_column_unknown ();
2565 c
= ffelex_card_image_
[++column
];
2566 goto parse_raw_character
; /* :::::::::::::::::::: */
2571 ffelex_token_
->where_line
2572 = ffewhere_line_use (ffelex_token_
->currentnames_line
2573 = ffewhere_line_use (ffelex_current_wl_
));
2574 ffelex_token_
->where_col
2575 = ffewhere_column_use (ffelex_token_
->currentnames_col
2576 = ffewhere_column_new (column
+ 1));
2577 ffelex_token_
->type
= FFELEX_typeNAMES
;
2581 ffelex_token_
->where_line
2582 = ffewhere_line_use (ffelex_current_wl_
);
2583 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
2584 ffelex_token_
->type
= FFELEX_typeNAME
;
2586 ffelex_append_to_token_ (c
);
2590 ffelex_bad_1_ (FFEBAD_UNRECOGNIZED_CHARACTER
,
2591 ffelex_linecount_current_
, column
+ 1);
2592 ffelex_finish_statement_ ();
2593 disallow_continuation_line
= TRUE
;
2594 ignore_disallowed_continuation
= TRUE
;
2595 goto beginning_of_line_again
; /* :::::::::::::::::::: */
2599 case FFELEX_typeNAME
:
2654 c
= ffesrc_char_source (c
);
2669 && !ffe_is_dollar_ok ())
2671 ffelex_send_token_ ();
2672 goto parse_next_character
; /* :::::::::::::::::::: */
2674 ffelex_append_to_token_ (c
);
2678 ffelex_send_token_ ();
2679 goto parse_next_character
; /* :::::::::::::::::::: */
2683 case FFELEX_typeNAMES
:
2738 c
= ffesrc_char_source (c
);
2753 && !ffe_is_dollar_ok ())
2755 ffelex_send_token_ ();
2756 goto parse_next_character
; /* :::::::::::::::::::: */
2758 if (ffelex_token_
->length
< FFEWHERE_indexMAX
)
2760 ffewhere_track (&ffelex_token_
->currentnames_line
,
2761 &ffelex_token_
->currentnames_col
,
2762 ffelex_token_
->wheretrack
,
2763 ffelex_token_
->length
,
2764 ffelex_linecount_current_
,
2767 ffelex_append_to_token_ (c
);
2771 ffelex_send_token_ ();
2772 goto parse_next_character
; /* :::::::::::::::::::: */
2776 case FFELEX_typeNUMBER
:
2789 ffelex_append_to_token_ (c
);
2793 ffelex_send_token_ ();
2794 goto parse_next_character
; /* :::::::::::::::::::: */
2798 case FFELEX_typeASTERISK
:
2802 ffelex_token_
->type
= FFELEX_typePOWER
;
2803 ffelex_send_token_ ();
2806 default: /* * not followed by another *. */
2807 ffelex_send_token_ ();
2808 goto parse_next_character
; /* :::::::::::::::::::: */
2812 case FFELEX_typeCOLON
:
2816 ffelex_token_
->type
= FFELEX_typeCOLONCOLON
;
2817 ffelex_send_token_ ();
2820 default: /* : not followed by another :. */
2821 ffelex_send_token_ ();
2822 goto parse_next_character
; /* :::::::::::::::::::: */
2826 case FFELEX_typeSLASH
:
2830 ffelex_token_
->type
= FFELEX_typeCONCAT
;
2831 ffelex_send_token_ ();
2835 ffelex_token_
->type
= FFELEX_typeCLOSE_ARRAY
;
2836 ffelex_send_token_ ();
2840 ffelex_token_
->type
= FFELEX_typeREL_NE
;
2841 ffelex_send_token_ ();
2845 ffelex_send_token_ ();
2846 goto parse_next_character
; /* :::::::::::::::::::: */
2850 case FFELEX_typeOPEN_PAREN
:
2854 ffelex_token_
->type
= FFELEX_typeOPEN_ARRAY
;
2855 ffelex_send_token_ ();
2859 ffelex_send_token_ ();
2860 goto parse_next_character
; /* :::::::::::::::::::: */
2864 case FFELEX_typeOPEN_ANGLE
:
2868 ffelex_token_
->type
= FFELEX_typeREL_LE
;
2869 ffelex_send_token_ ();
2873 ffelex_send_token_ ();
2874 goto parse_next_character
; /* :::::::::::::::::::: */
2878 case FFELEX_typeEQUALS
:
2882 ffelex_token_
->type
= FFELEX_typeREL_EQ
;
2883 ffelex_send_token_ ();
2887 ffelex_token_
->type
= FFELEX_typePOINTS
;
2888 ffelex_send_token_ ();
2892 ffelex_send_token_ ();
2893 goto parse_next_character
; /* :::::::::::::::::::: */
2897 case FFELEX_typeCLOSE_ANGLE
:
2901 ffelex_token_
->type
= FFELEX_typeREL_GE
;
2902 ffelex_send_token_ ();
2906 ffelex_send_token_ ();
2907 goto parse_next_character
; /* :::::::::::::::::::: */
2912 assert ("Serious error!!" == NULL
);
2917 c
= ffelex_card_image_
[++column
];
2919 parse_next_character
: /* :::::::::::::::::::: */
2921 if (ffelex_raw_mode_
!= 0)
2922 goto parse_raw_character
; /* :::::::::::::::::::: */
2925 c
= ffelex_card_image_
[++column
];
2930 && (ffelex_card_image_
[column
+ 1] == '*')))
2932 if ((ffelex_number_of_tokens_
== ffelex_label_tokens_
)
2933 && (ffelex_token_
->type
== FFELEX_typeNAMES
)
2934 && (ffelex_token_
->length
== 3)
2935 && (ffesrc_strncmp_2c (ffe_case_match (),
2936 ffelex_token_
->text
,
2937 "END", "end", "End",
2941 ffelex_finish_statement_ ();
2942 disallow_continuation_line
= TRUE
;
2943 ignore_disallowed_continuation
= FALSE
;
2944 goto beginning_of_line_again
; /* :::::::::::::::::::: */
2946 goto beginning_of_line
; /* :::::::::::::::::::: */
2948 goto parse_nonraw_character
; /* :::::::::::::::::::: */
2951 /* ffelex_file_free -- Lex a given file in free source form
2955 ffelex_file_free(wf,f);
2957 Lexes the file according to Fortran 90 ANSI + VXT specifications. */
2960 ffelex_file_free (ffewhereFile wf
, FILE *f
)
2962 register int c
= 0; /* Character currently under consideration. */
2963 register ffewhereColumnNumber column
= 0; /* Not really; 0 means column 1... */
2964 bool continuation_line
= FALSE
;
2965 ffewhereColumnNumber continuation_column
;
2966 int latest_char_in_file
= 0; /* For getting back into comment-skipping
2969 /* Lex is called for a particular file, not for a particular program unit.
2970 Yet the two events do share common characteristics. The first line in a
2971 file or in a program unit cannot be a continuation line. No token can
2972 be in mid-formation. No current label for the statement exists, since
2973 there is no current statement. */
2975 assert (ffelex_handler_
!= NULL
);
2978 input_filename
= ffewhere_file_name (wf
);
2979 ffelex_current_wf_
= wf
;
2980 continuation_line
= FALSE
;
2981 ffelex_token_
->type
= FFELEX_typeNONE
;
2982 ffelex_number_of_tokens_
= 0;
2983 ffelex_current_wl_
= ffewhere_line_unknown ();
2984 ffelex_current_wc_
= ffewhere_column_unknown ();
2985 latest_char_in_file
= '\n';
2987 /* Come here to get a new line. */
2989 beginning_of_line
: /* :::::::::::::::::::: */
2991 c
= latest_char_in_file
;
2992 if ((c
== EOF
) || ((c
= ffelex_getc_ (f
)) == EOF
))
2995 end_of_file
: /* :::::::::::::::::::: */
2997 /* Line ending in EOF instead of \n still counts as a whole line. */
2999 ffelex_finish_statement_ ();
3000 ffewhere_line_kill (ffelex_current_wl_
);
3001 ffewhere_column_kill (ffelex_current_wc_
);
3002 return (ffelexHandler
) ffelex_handler_
;
3005 ffelex_next_line_ ();
3007 ffelex_bad_line_
= FALSE
;
3009 /* Skip over initial-comment and empty lines as quickly as possible! */
3016 c
= ffelex_hash_ (f
);
3018 comment_line
: /* :::::::::::::::::::: */
3020 while ((c
!= '\n') && (c
!= EOF
))
3025 ffelex_next_line_ ();
3026 goto end_of_file
; /* :::::::::::::::::::: */
3031 ffelex_next_line_ ();
3034 goto end_of_file
; /* :::::::::::::::::::: */
3037 ffelex_saw_tab_
= FALSE
;
3039 column
= ffelex_image_char_ (c
, 0);
3041 /* Read the entire line in as is (with whitespace processing). */
3043 while (((c
= getc (f
)) != '\n') && (c
!= EOF
))
3044 column
= ffelex_image_char_ (c
, column
);
3046 if (ffelex_bad_line_
)
3048 ffelex_card_image_
[column
] = '\0';
3049 ffelex_card_length_
= column
;
3050 goto comment_line
; /* :::::::::::::::::::: */
3053 /* If no tab, cut off line after column 132. */
3055 if (!ffelex_saw_tab_
&& (column
> FFELEX_FREE_MAX_COLUMNS_
))
3056 column
= FFELEX_FREE_MAX_COLUMNS_
;
3058 ffelex_card_image_
[column
] = '\0';
3059 ffelex_card_length_
= column
;
3061 /* Save next char in file so we can use register-based c while analyzing
3062 line we just read. */
3064 latest_char_in_file
= c
; /* Should be either '\n' or EOF. */
3067 continuation_column
= 0;
3069 /* Skip over initial spaces to see if the first nonblank character
3070 is exclamation point, newline, or EOF (line is therefore a comment) or
3071 ampersand (line is therefore a continuation line). */
3073 while ((c
= ffelex_card_image_
[column
]) == ' ')
3080 goto beginning_of_line
; /* :::::::::::::::::::: */
3083 continuation_column
= column
+ 1;
3090 /* The line definitely has content of some kind, install new end-statement
3091 point for error messages. */
3093 ffewhere_line_kill (ffelex_current_wl_
);
3094 ffewhere_column_kill (ffelex_current_wc_
);
3095 ffelex_current_wl_
= ffewhere_line_new (ffelex_linecount_current_
);
3096 ffelex_current_wc_
= ffewhere_column_new (ffelex_card_length_
+ 1);
3098 /* Figure out which column to start parsing at. */
3100 if (continuation_line
)
3102 if (continuation_column
== 0)
3104 if (ffelex_raw_mode_
!= 0)
3106 ffelex_bad_1_ (FFEBAD_BAD_CHAR_CONTINUE
,
3107 ffelex_linecount_current_
, column
+ 1);
3109 else if (ffelex_token_
->type
!= FFELEX_typeNONE
)
3111 ffelex_bad_1_ (FFEBAD_BAD_LEXTOK_CONTINUE
,
3112 ffelex_linecount_current_
, column
+ 1);
3115 else if (ffelex_is_free_char_ctx_contin_ (continuation_column
))
3116 { /* Line contains only a single "&" as only
3117 nonblank character. */
3118 ffelex_bad_1_ (FFEBAD_BAD_FREE_CONTINUE
,
3119 ffelex_linecount_current_
, continuation_column
);
3120 goto beginning_of_line
; /* :::::::::::::::::::: */
3122 column
= continuation_column
;
3127 c
= ffelex_card_image_
[column
];
3128 continuation_line
= FALSE
;
3130 /* Here is the main engine for parsing. c holds the character at column.
3131 It is already known that c is not a blank, end of line, or shriek,
3132 unless ffelex_raw_mode_ is not 0 (indicating we are in a
3133 character/hollerith constant). A partially filled token may already
3134 exist in ffelex_token_. */
3136 if (ffelex_raw_mode_
!= 0)
3139 parse_raw_character
: /* :::::::::::::::::::: */
3144 if (ffelex_is_free_char_ctx_contin_ (column
+ 1))
3146 continuation_line
= TRUE
;
3147 goto beginning_of_line
; /* :::::::::::::::::::: */
3152 ffelex_finish_statement_ ();
3153 goto beginning_of_line
; /* :::::::::::::::::::: */
3159 switch (ffelex_raw_mode_
)
3162 c
= ffelex_backslash_ (c
, column
);
3166 if (!ffelex_backslash_reconsider_
)
3167 ffelex_append_to_token_ (c
);
3168 ffelex_raw_mode_
= -1;
3172 if (c
== ffelex_raw_char_
)
3174 ffelex_raw_mode_
= -1;
3175 ffelex_append_to_token_ (c
);
3179 ffelex_raw_mode_
= 0;
3180 ffelex_backslash_reconsider_
= TRUE
;
3185 if (c
== ffelex_raw_char_
)
3186 ffelex_raw_mode_
= -2;
3189 c
= ffelex_backslash_ (c
, column
);
3192 ffelex_raw_mode_
= -3;
3196 ffelex_append_to_token_ (c
);
3201 c
= ffelex_backslash_ (c
, column
);
3205 if (!ffelex_backslash_reconsider_
)
3207 ffelex_append_to_token_ (c
);
3213 if (ffelex_backslash_reconsider_
)
3214 ffelex_backslash_reconsider_
= FALSE
;
3216 c
= ffelex_card_image_
[++column
];
3218 if (ffelex_raw_mode_
== 0)
3220 ffelex_send_token_ ();
3221 assert (ffelex_raw_mode_
== 0);
3223 c
= ffelex_card_image_
[++column
];
3224 if ((c
== '\0') || (c
== '!'))
3226 ffelex_finish_statement_ ();
3227 goto beginning_of_line
; /* :::::::::::::::::::: */
3229 if ((c
== '&') && ffelex_is_free_nonc_ctx_contin_ (column
+ 1))
3231 continuation_line
= TRUE
;
3232 goto beginning_of_line
; /* :::::::::::::::::::: */
3234 goto parse_nonraw_character_noncontin
; /* :::::::::::::::::::: */
3236 goto parse_raw_character
; /* :::::::::::::::::::: */
3239 parse_nonraw_character
: /* :::::::::::::::::::: */
3241 if ((c
== '&') && ffelex_is_free_nonc_ctx_contin_ (column
+ 1))
3243 continuation_line
= TRUE
;
3244 goto beginning_of_line
; /* :::::::::::::::::::: */
3247 parse_nonraw_character_noncontin
: /* :::::::::::::::::::: */
3249 switch (ffelex_token_
->type
)
3251 case FFELEX_typeNONE
:
3254 finish-statement/continue-statement
3257 c
= ffelex_card_image_
[++column
];
3258 if ((c
== '\0') || (c
== '!'))
3260 ffelex_finish_statement_ ();
3261 goto beginning_of_line
; /* :::::::::::::::::::: */
3263 if ((c
== '&') && ffelex_is_free_nonc_ctx_contin_ (column
+ 1))
3265 continuation_line
= TRUE
;
3266 goto beginning_of_line
; /* :::::::::::::::::::: */
3273 ffelex_token_
->type
= FFELEX_typeQUOTE
;
3274 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3275 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3276 ffelex_send_token_ ();
3280 ffelex_token_
->type
= FFELEX_typeDOLLAR
;
3281 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3282 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3283 ffelex_send_token_ ();
3287 ffelex_token_
->type
= FFELEX_typePERCENT
;
3288 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3289 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3290 ffelex_send_token_ ();
3294 ffelex_token_
->type
= FFELEX_typeAMPERSAND
;
3295 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3296 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3297 ffelex_send_token_ ();
3301 ffelex_token_
->type
= FFELEX_typeAPOSTROPHE
;
3302 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3303 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3304 ffelex_send_token_ ();
3308 ffelex_token_
->type
= FFELEX_typeOPEN_PAREN
;
3309 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3310 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3314 ffelex_token_
->type
= FFELEX_typeCLOSE_PAREN
;
3315 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3316 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3317 ffelex_send_token_ ();
3321 ffelex_token_
->type
= FFELEX_typeASTERISK
;
3322 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3323 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3327 ffelex_token_
->type
= FFELEX_typePLUS
;
3328 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3329 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3330 ffelex_send_token_ ();
3334 ffelex_token_
->type
= FFELEX_typeCOMMA
;
3335 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3336 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3337 ffelex_send_token_ ();
3341 ffelex_token_
->type
= FFELEX_typeMINUS
;
3342 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3343 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3344 ffelex_send_token_ ();
3348 ffelex_token_
->type
= FFELEX_typePERIOD
;
3349 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3350 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3351 ffelex_send_token_ ();
3355 ffelex_token_
->type
= FFELEX_typeSLASH
;
3356 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3357 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3371 = ffelex_hexnum_
? FFELEX_typeNAME
: FFELEX_typeNUMBER
;
3372 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3373 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3374 ffelex_append_to_token_ (c
);
3378 ffelex_token_
->type
= FFELEX_typeCOLON
;
3379 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3380 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3384 ffelex_token_
->type
= FFELEX_typeSEMICOLON
;
3385 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3386 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3387 ffelex_permit_include_
= TRUE
;
3388 ffelex_send_token_ ();
3389 ffelex_permit_include_
= FALSE
;
3393 ffelex_token_
->type
= FFELEX_typeOPEN_ANGLE
;
3394 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3395 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3399 ffelex_token_
->type
= FFELEX_typeEQUALS
;
3400 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3401 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3405 ffelex_token_
->type
= FFELEX_typeCLOSE_ANGLE
;
3406 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3407 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3411 ffelex_token_
->type
= FFELEX_typeQUESTION
;
3412 ffelex_token_
->where_line
= ffewhere_line_use (ffelex_current_wl_
);
3413 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3414 ffelex_send_token_ ();
3418 if (1 || ffe_is_90 ())
3420 ffelex_token_
->type
= FFELEX_typeUNDERSCORE
;
3421 ffelex_token_
->where_line
3422 = ffewhere_line_use (ffelex_current_wl_
);
3423 ffelex_token_
->where_col
3424 = ffewhere_column_new (column
+ 1);
3425 ffelex_send_token_ ();
3481 c
= ffesrc_char_source (c
);
3483 if (ffesrc_char_match_init (c
, 'H', 'h')
3484 && ffelex_expecting_hollerith_
!= 0)
3486 ffelex_raw_mode_
= ffelex_expecting_hollerith_
;
3487 ffelex_token_
->type
= FFELEX_typeHOLLERITH
;
3488 ffelex_token_
->where_line
= ffelex_raw_where_line_
;
3489 ffelex_token_
->where_col
= ffelex_raw_where_col_
;
3490 ffelex_raw_where_line_
= ffewhere_line_unknown ();
3491 ffelex_raw_where_col_
= ffewhere_column_unknown ();
3492 c
= ffelex_card_image_
[++column
];
3493 goto parse_raw_character
; /* :::::::::::::::::::: */
3496 if (ffelex_names_pure_
)
3498 ffelex_token_
->where_line
3499 = ffewhere_line_use (ffelex_token_
->currentnames_line
3500 = ffewhere_line_use (ffelex_current_wl_
));
3501 ffelex_token_
->where_col
3502 = ffewhere_column_use (ffelex_token_
->currentnames_col
3503 = ffewhere_column_new (column
+ 1));
3504 ffelex_token_
->type
= FFELEX_typeNAMES
;
3508 ffelex_token_
->where_line
3509 = ffewhere_line_use (ffelex_current_wl_
);
3510 ffelex_token_
->where_col
= ffewhere_column_new (column
+ 1);
3511 ffelex_token_
->type
= FFELEX_typeNAME
;
3513 ffelex_append_to_token_ (c
);
3517 ffelex_bad_1_ (FFEBAD_UNRECOGNIZED_CHARACTER
,
3518 ffelex_linecount_current_
, column
+ 1);
3519 ffelex_finish_statement_ ();
3520 goto beginning_of_line
; /* :::::::::::::::::::: */
3524 case FFELEX_typeNAME
:
3579 c
= ffesrc_char_source (c
);
3594 && !ffe_is_dollar_ok ())
3596 ffelex_send_token_ ();
3597 goto parse_next_character
; /* :::::::::::::::::::: */
3599 ffelex_append_to_token_ (c
);
3603 ffelex_send_token_ ();
3604 goto parse_next_character
; /* :::::::::::::::::::: */
3608 case FFELEX_typeNAMES
:
3663 c
= ffesrc_char_source (c
);
3678 && !ffe_is_dollar_ok ())
3680 ffelex_send_token_ ();
3681 goto parse_next_character
; /* :::::::::::::::::::: */
3683 if (ffelex_token_
->length
< FFEWHERE_indexMAX
)
3685 ffewhere_track (&ffelex_token_
->currentnames_line
,
3686 &ffelex_token_
->currentnames_col
,
3687 ffelex_token_
->wheretrack
,
3688 ffelex_token_
->length
,
3689 ffelex_linecount_current_
,
3692 ffelex_append_to_token_ (c
);
3696 ffelex_send_token_ ();
3697 goto parse_next_character
; /* :::::::::::::::::::: */
3701 case FFELEX_typeNUMBER
:
3714 ffelex_append_to_token_ (c
);
3718 ffelex_send_token_ ();
3719 goto parse_next_character
; /* :::::::::::::::::::: */
3723 case FFELEX_typeASTERISK
:
3727 ffelex_token_
->type
= FFELEX_typePOWER
;
3728 ffelex_send_token_ ();
3731 default: /* * not followed by another *. */
3732 ffelex_send_token_ ();
3733 goto parse_next_character
; /* :::::::::::::::::::: */
3737 case FFELEX_typeCOLON
:
3741 ffelex_token_
->type
= FFELEX_typeCOLONCOLON
;
3742 ffelex_send_token_ ();
3745 default: /* : not followed by another :. */
3746 ffelex_send_token_ ();
3747 goto parse_next_character
; /* :::::::::::::::::::: */
3751 case FFELEX_typeSLASH
:
3755 ffelex_token_
->type
= FFELEX_typeCONCAT
;
3756 ffelex_send_token_ ();
3760 ffelex_token_
->type
= FFELEX_typeCLOSE_ARRAY
;
3761 ffelex_send_token_ ();
3765 ffelex_token_
->type
= FFELEX_typeREL_NE
;
3766 ffelex_send_token_ ();
3770 ffelex_send_token_ ();
3771 goto parse_next_character
; /* :::::::::::::::::::: */
3775 case FFELEX_typeOPEN_PAREN
:
3779 ffelex_token_
->type
= FFELEX_typeOPEN_ARRAY
;
3780 ffelex_send_token_ ();
3784 ffelex_send_token_ ();
3785 goto parse_next_character
; /* :::::::::::::::::::: */
3789 case FFELEX_typeOPEN_ANGLE
:
3793 ffelex_token_
->type
= FFELEX_typeREL_LE
;
3794 ffelex_send_token_ ();
3798 ffelex_send_token_ ();
3799 goto parse_next_character
; /* :::::::::::::::::::: */
3803 case FFELEX_typeEQUALS
:
3807 ffelex_token_
->type
= FFELEX_typeREL_EQ
;
3808 ffelex_send_token_ ();
3812 ffelex_token_
->type
= FFELEX_typePOINTS
;
3813 ffelex_send_token_ ();
3817 ffelex_send_token_ ();
3818 goto parse_next_character
; /* :::::::::::::::::::: */
3822 case FFELEX_typeCLOSE_ANGLE
:
3826 ffelex_token_
->type
= FFELEX_typeREL_GE
;
3827 ffelex_send_token_ ();
3831 ffelex_send_token_ ();
3832 goto parse_next_character
; /* :::::::::::::::::::: */
3837 assert ("Serious error!" == NULL
);
3842 c
= ffelex_card_image_
[++column
];
3844 parse_next_character
: /* :::::::::::::::::::: */
3846 if (ffelex_raw_mode_
!= 0)
3847 goto parse_raw_character
; /* :::::::::::::::::::: */
3849 if ((c
== '\0') || (c
== '!'))
3851 ffelex_finish_statement_ ();
3852 goto beginning_of_line
; /* :::::::::::::::::::: */
3854 goto parse_nonraw_character
; /* :::::::::::::::::::: */
3857 /* See the code in com.c that calls this to understand why. */
3860 ffelex_hash_kludge (FILE *finput
)
3862 /* If you change this constant string, you have to change whatever
3863 code might thus be affected by it in terms of having to use
3864 ffelex_getc_() instead of getc() in the lexers and _hash_. */
3865 static const char match
[] = "# 1 \"";
3866 static int kludge
[ARRAY_SIZE (match
) + 1];
3871 /* Read chars as long as they match the target string.
3872 Copy them into an array that will serve as a record
3873 of what we read (essentially a multi-char ungetc(),
3874 for code that uses ffelex_getc_ instead of getc() elsewhere
3876 for (p
= &match
[0], q
= &kludge
[0], c
= getc (finput
);
3877 (c
== *p
) && (*p
!= '\0') && (c
!= EOF
);
3878 ++p
, ++q
, c
= getc (finput
))
3881 *q
= c
; /* Might be EOF, which requires int. */
3884 ffelex_kludge_chars_
= &kludge
[0];
3888 ffelex_kludge_flag_
= TRUE
;
3889 ++ffelex_kludge_chars_
;
3890 ffelex_hash_ (finput
); /* Handle it NOW rather than later. */
3891 ffelex_kludge_flag_
= FALSE
;
3900 ffelex_final_nontab_column_
= ffe_fixed_line_length ();
3901 ffelex_card_size_
= FFELEX_columnINITIAL_SIZE_
;
3902 ffelex_card_image_
= malloc_new_ksr (malloc_pool_image (),
3903 "FFELEX card image",
3904 FFELEX_columnINITIAL_SIZE_
+ 9);
3905 ffelex_card_image_
[0] = '\0';
3907 for (i
= 0; i
< 256; ++i
)
3908 ffelex_first_char_
[i
] = FFELEX_typeERROR
;
3910 ffelex_first_char_
['\t'] = FFELEX_typeRAW
;
3911 ffelex_first_char_
['\n'] = FFELEX_typeCOMMENT
;
3912 ffelex_first_char_
['\v'] = FFELEX_typeCOMMENT
;
3913 ffelex_first_char_
['\f'] = FFELEX_typeCOMMENT
;
3914 ffelex_first_char_
['\r'] = FFELEX_typeRAW
;
3915 ffelex_first_char_
[' '] = FFELEX_typeRAW
;
3916 ffelex_first_char_
['!'] = FFELEX_typeCOMMENT
;
3917 ffelex_first_char_
['*'] = FFELEX_typeCOMMENT
;
3918 ffelex_first_char_
['/'] = FFELEX_typeSLASH
;
3919 ffelex_first_char_
['&'] = FFELEX_typeRAW
;
3920 ffelex_first_char_
['#'] = FFELEX_typeHASH
;
3922 for (i
= '0'; i
<= '9'; ++i
)
3923 ffelex_first_char_
[i
] = FFELEX_typeRAW
;
3925 if ((ffe_case_match () == FFE_caseNONE
)
3926 || ((ffe_case_match () == FFE_caseUPPER
)
3927 && (ffe_case_source () != FFE_caseLOWER
)) /* Idiot! :-) */
3928 || ((ffe_case_match () == FFE_caseLOWER
)
3929 && (ffe_case_source () == FFE_caseLOWER
)))
3931 ffelex_first_char_
['C'] = FFELEX_typeCOMMENT
;
3932 ffelex_first_char_
['D'] = FFELEX_typeCOMMENT
;
3934 if ((ffe_case_match () == FFE_caseNONE
)
3935 || ((ffe_case_match () == FFE_caseLOWER
)
3936 && (ffe_case_source () != FFE_caseUPPER
)) /* Idiot! :-) */
3937 || ((ffe_case_match () == FFE_caseUPPER
)
3938 && (ffe_case_source () == FFE_caseUPPER
)))
3940 ffelex_first_char_
['c'] = FFELEX_typeCOMMENT
;
3941 ffelex_first_char_
['d'] = FFELEX_typeCOMMENT
;
3944 ffelex_linecount_current_
= 0;
3945 ffelex_linecount_next_
= 1;
3946 ffelex_raw_mode_
= 0;
3947 ffelex_set_include_
= FALSE
;
3948 ffelex_permit_include_
= FALSE
;
3949 ffelex_names_
= TRUE
; /* First token in program is a names. */
3950 ffelex_names_pure_
= FALSE
; /* Free-form lexer does NAMES only for
3952 ffelex_hexnum_
= FALSE
;
3953 ffelex_expecting_hollerith_
= 0;
3954 ffelex_raw_where_line_
= ffewhere_line_unknown ();
3955 ffelex_raw_where_col_
= ffewhere_column_unknown ();
3957 ffelex_token_
= ffelex_token_new_ ();
3958 ffelex_token_
->type
= FFELEX_typeNONE
;
3959 ffelex_token_
->uses
= 1;
3960 ffelex_token_
->where_line
= ffewhere_line_unknown ();
3961 ffelex_token_
->where_col
= ffewhere_column_unknown ();
3962 ffelex_token_
->text
= NULL
;
3964 ffelex_handler_
= NULL
;
3967 /* ffelex_is_names_expected -- Is the current parser expecting NAMES vs. NAME?
3969 if (ffelex_is_names_expected())
3970 // Deliver NAMES token
3972 // Deliver NAME token
3974 Must be called while lexer is active, obviously. */
3977 ffelex_is_names_expected ()
3979 return ffelex_names_
;
3982 /* Current card image, which has the master linecount number
3983 ffelex_linecount_current_. */
3988 return ffelex_card_image_
;
3991 /* ffelex_line_length -- Return length of current lexer line
3993 printf("Length is %lu\n",ffelex_line_length());
3995 Must be called while lexer is active, obviously. */
3997 ffewhereColumnNumber
3998 ffelex_line_length ()
4000 return ffelex_card_length_
;
4003 /* Master line count of current card image, or 0 if no card image
4007 ffelex_line_number ()
4009 return ffelex_linecount_current_
;
4012 /* ffelex_set_expecting_hollerith -- Set hollerith expectation status
4014 ffelex_set_expecting_hollerith(0);
4016 Lex initially assumes no hollerith constant is about to show up. If
4017 syntactic analysis expects one, it should call this function with the
4018 number of characters expected in the constant immediately after recognizing
4019 the decimal number preceding the "H" and the constant itself. Then, if
4020 the next character is indeed H, the lexer will interpret it as beginning
4021 a hollerith constant and ship the token formed by reading the specified
4022 number of characters (interpreting blanks and otherwise-comments too)
4023 from the input file. It is up to syntactic analysis to call this routine
4024 again with 0 to turn hollerith detection off immediately upon receiving
4025 the token that might or might not be HOLLERITH.
4027 Also call this after seeing an APOSTROPHE or QUOTE token that begins a
4028 character constant. Pass the expected termination character (apostrophe
4031 Pass for length either the length of the hollerith (must be > 0), -1
4032 meaning expecting a character constant, or 0 to cancel expectation of
4033 a hollerith only after calling it with a length of > 0 and receiving the
4034 next token (which may or may not have been a HOLLERITH token).
4036 Pass for which either an apostrophe or quote when passing length of -1.
4037 Else which is a don't-care.
4039 Pass for line and column the line/column info for the token beginning the
4040 character or hollerith constant, for use in error messages, when passing
4041 a length of -1 -- this function will invoke ffewhere_line/column_use to
4042 make its own copies. Else line and column are don't-cares (when length
4043 is 0) and the outstanding copies of the previous line/column info, if
4044 still around, are killed.
4047 When called with length of 0, also zero ffelex_raw_mode_. This is
4048 so ffest_save_ can undo the effects of replaying tokens like
4049 APOSTROPHE and QUOTE.
4051 New line, column arguments allow error messages to point to the true
4052 beginning of a character/hollerith constant, rather than the beginning
4053 of the content part, which makes them more consistent and helpful.
4055 New "which" argument allows caller to specify termination character,
4056 which should be apostrophe or double-quote, to support Fortran 90. */
4059 ffelex_set_expecting_hollerith (long length
, char which
,
4060 ffewhereLine line
, ffewhereColumn column
)
4063 /* First kill the pending line/col info, if any (should only be pending
4064 when this call has length==0, the previous call had length>0, and a
4065 non-HOLLERITH token was sent in between the calls, but play it safe). */
4067 ffewhere_line_kill (ffelex_raw_where_line_
);
4068 ffewhere_column_kill (ffelex_raw_where_col_
);
4070 /* Now handle the length function. */
4074 ffelex_expecting_hollerith_
= 0;
4075 ffelex_raw_mode_
= 0;
4076 ffelex_raw_where_line_
= ffewhere_line_unknown ();
4077 ffelex_raw_where_col_
= ffewhere_column_unknown ();
4078 return; /* Don't set new line/column info from args. */
4081 ffelex_raw_mode_
= -1;
4082 ffelex_raw_char_
= which
;
4085 default: /* length > 0 */
4086 ffelex_expecting_hollerith_
= length
;
4090 /* Now set new line/column information from passed args. */
4092 ffelex_raw_where_line_
= ffewhere_line_use (line
);
4093 ffelex_raw_where_col_
= ffewhere_column_use (column
);
4096 /* ffelex_set_handler -- Set handler for tokens before calling _fixed or _free
4098 ffelex_set_handler((ffelexHandler) my_first_handler);
4100 Must be called before calling ffelex_file_fixed or ffelex_file_free or
4101 after they return, but not while they are active. */
4104 ffelex_set_handler (ffelexHandler first
)
4106 ffelex_handler_
= first
;
4109 /* ffelex_set_hexnum -- Set hexnum flag
4111 ffelex_set_hexnum(TRUE);
4113 Lex normally interprets a token starting with [0-9] as a NUMBER token,
4114 so if it sees a [A-Za-z] in it, it stops parsing the NUMBER and leaves
4115 the character as the first of the next token. But when parsing a
4116 hexadecimal number, by calling this function with TRUE before starting
4117 the parse of the token itself, lex will interpret [0-9] as the start
4121 ffelex_set_hexnum (bool f
)
4126 /* ffelex_set_include -- Set INCLUDE file to be processed next
4128 ffewhereFile wf; // The ffewhereFile object for the file.
4129 bool free_form; // TRUE means read free-form file, FALSE fixed-form.
4130 FILE *fi; // The file to INCLUDE.
4131 ffelex_set_include(wf,free_form,fi);
4133 Must be called only after receiving the EOS token following a valid
4134 INCLUDE statement specifying a file that has already been successfully
4138 ffelex_set_include (ffewhereFile wf
, bool free_form
, FILE *fi
)
4140 assert (ffelex_permit_include_
);
4141 assert (!ffelex_set_include_
);
4142 ffelex_set_include_
= TRUE
;
4143 ffelex_include_free_form_
= free_form
;
4144 ffelex_include_file_
= fi
;
4145 ffelex_include_wherefile_
= wf
;
4148 /* ffelex_set_names -- Set names/name flag, names = TRUE
4150 ffelex_set_names(FALSE);
4152 Lex initially assumes multiple names should be formed. If this function is
4153 called with FALSE, then single names are formed instead. The differences
4154 are a difference in the token type (FFELEX_typeNAMES vs. FFELEX_typeNAME)
4155 and in whether full source-location tracking is performed (it is for
4156 multiple names, not for single names), which is more expensive in terms of
4160 ffelex_set_names (bool f
)
4164 ffelex_names_pure_
= FALSE
;
4167 /* ffelex_set_names_pure -- Set names/name (pure) flag, names = TRUE
4169 ffelex_set_names_pure(FALSE);
4171 Like ffelex_set_names, except affects both lexers. Normally, the
4172 free-form lexer need not generate NAMES tokens because adjacent NAME
4173 tokens must be separated by spaces which causes the lexer to generate
4174 separate tokens for analysis (whereas in fixed-form the spaces are
4175 ignored resulting in one long token). But in FORMAT statements, for
4176 some reason, the Fortran 90 standard specifies that spaces can occur
4177 anywhere within a format-item-list with no effect on the format spec
4178 (except of course within character string edit descriptors), which means
4179 that "1PE14.2" and "1 P E 1 4 . 2" are equivalent. For the FORMAT
4180 statement handling, the existence of spaces makes it hard to deal with,
4181 because each token is seen distinctly (i.e. seven tokens in the latter
4182 example). But when no spaces are provided, as in the former example,
4183 then only four tokens are generated, NUMBER("1"), NAME("PE14"), PERIOD,
4184 NUMBER ("2"). By generating a NAMES instead of NAME, three things happen:
4185 One, ffest_kw_format_ does a substring rather than full-string match,
4186 and thus matches "PE14" to "PE"; two, ffelex_token_xyz_from_names functions
4187 may be used to pull NAME/NAMES and NUMBER tokens out of the NAMES token;
4188 and three, error reporting can point to the actual character rather than
4189 at or prior to it. The first two things could be resolved by providing
4190 alternate functions fairly easy, thus allowing FORMAT handling to expect
4191 both lexers to generate NAME tokens instead of NAMES (with otherwise minor
4192 changes to FORMAT parsing), but the third, error reporting, would suffer,
4193 and when one makes mistakes in a FORMAT, believe me, one wants a pointer
4194 to exactly where the compilers thinks the problem is, to even begin to get
4195 a handle on it. So there. */
4198 ffelex_set_names_pure (bool f
)
4200 ffelex_names_pure_
= f
;
4204 /* ffelex_splice_tokens -- Splice off and send tokens from a NAMES
4206 return (ffelexHandler) ffelex_splice_tokens(first_handler,master_token,
4209 Returns first_handler if start_char_index chars into master_token (which
4210 must be a NAMES token) is '\0'. Else, creates a subtoken from that
4211 char, either NUMBER (if it is a digit), a NAME (if a valid firstnamechar),
4212 an UNDERSCORE (if an underscore), or DOLLAR (if a dollar sign)
4213 and sends it to first_handler. If anything other than NAME is sent, the
4214 character at the end of it in the master token is examined to see if it
4215 begins a NAME, NUMBER, UNDERSCORE, or DOLLAR, and, if so,
4216 the handler returned by first_handler is invoked with that token, and
4217 this process is repeated until the end of the master token or a NAME
4218 token is reached. */
4221 ffelex_splice_tokens (ffelexHandler first
, ffelexToken master
,
4222 ffeTokenLength start
)
4228 p
= ffelex_token_text (master
) + (i
= start
);
4234 t
= ffelex_token_number_from_names (master
, i
);
4235 p
+= ffelex_token_length (t
);
4236 i
+= ffelex_token_length (t
);
4238 else if (ffesrc_is_name_init (*p
))
4240 t
= ffelex_token_name_from_names (master
, i
, 0);
4241 p
+= ffelex_token_length (t
);
4242 i
+= ffelex_token_length (t
);
4246 t
= ffelex_token_dollar_from_names (master
, i
);
4252 t
= ffelex_token_uscore_from_names (master
, i
);
4258 assert ("not a valid NAMES character" == NULL
);
4261 assert (first
!= NULL
);
4262 first
= (ffelexHandler
) (*first
) (t
);
4263 ffelex_token_kill (t
);
4269 /* ffelex_swallow_tokens -- Eat all tokens delivered to me
4271 return ffelex_swallow_tokens;
4273 Return this handler when you don't want to look at any more tokens in the
4274 statement because you've encountered an unrecoverable error in the
4278 ffelex_swallow_tokens (ffelexToken t
, ffelexHandler handler
)
4280 assert (handler
!= NULL
);
4282 if ((t
!= NULL
) && ((ffelex_token_type (t
) == FFELEX_typeEOS
)
4283 || (ffelex_token_type (t
) == FFELEX_typeSEMICOLON
)))
4284 return (ffelexHandler
) (*handler
) (t
);
4286 ffelex_eos_handler_
= handler
;
4287 return (ffelexHandler
) ffelex_swallow_tokens_
;
4290 /* ffelex_token_dollar_from_names -- Return a dollar from within a names token
4293 t = ffelex_token_dollar_from_names(t,6);
4295 It's as if you made a new token of dollar type having the dollar
4296 at, in the example above, the sixth character of the NAMES token. */
4299 ffelex_token_dollar_from_names (ffelexToken t
, ffeTokenLength start
)
4304 assert (ffelex_token_type (t
) == FFELEX_typeNAMES
);
4305 assert (start
< t
->length
);
4306 assert (t
->text
[start
] == '$');
4308 /* Now make the token. */
4310 nt
= ffelex_token_new_ ();
4311 nt
->type
= FFELEX_typeDOLLAR
;
4314 ffewhere_set_from_track (&nt
->where_line
, &nt
->where_col
, t
->where_line
,
4315 t
->where_col
, t
->wheretrack
, start
);
4320 /* ffelex_token_kill -- Decrement use count for token, kill if no uses left
4323 ffelex_token_kill(t);
4325 Complements a call to ffelex_token_use or ffelex_token_new_.... */
4328 ffelex_token_kill (ffelexToken t
)
4332 assert (t
->uses
> 0);
4337 --ffelex_total_tokens_
;
4339 if (t
->type
== FFELEX_typeNAMES
)
4340 ffewhere_track_kill (t
->where_line
, t
->where_col
,
4341 t
->wheretrack
, t
->length
);
4342 ffewhere_line_kill (t
->where_line
);
4343 ffewhere_column_kill (t
->where_col
);
4344 if (t
->text
!= NULL
)
4345 malloc_kill_ksr (malloc_pool_image (), t
->text
, t
->size
+ 1);
4346 malloc_kill_ks (malloc_pool_image (), t
, sizeof (*t
));
4349 /* Make a new NAME token that is a substring of a NAMES token. */
4352 ffelex_token_name_from_names (ffelexToken t
, ffeTokenLength start
,
4358 assert (ffelex_token_type (t
) == FFELEX_typeNAMES
);
4359 assert (start
< t
->length
);
4361 len
= t
->length
- start
;
4365 assert ((start
+ len
) <= t
->length
);
4367 assert (ffelex_is_firstnamechar ((unsigned char)(t
->text
[start
])));
4369 nt
= ffelex_token_new_ ();
4370 nt
->type
= FFELEX_typeNAME
;
4371 nt
->size
= len
; /* Assume nobody's gonna fiddle with token
4375 ffewhere_set_from_track (&nt
->where_line
, &nt
->where_col
, t
->where_line
,
4376 t
->where_col
, t
->wheretrack
, start
);
4377 nt
->text
= malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
4379 strncpy (nt
->text
, t
->text
+ start
, len
);
4380 nt
->text
[len
] = '\0';
4384 /* Make a new NAMES token that is a substring of another NAMES token. */
4387 ffelex_token_names_from_names (ffelexToken t
, ffeTokenLength start
,
4393 assert (ffelex_token_type (t
) == FFELEX_typeNAMES
);
4394 assert (start
< t
->length
);
4396 len
= t
->length
- start
;
4400 assert ((start
+ len
) <= t
->length
);
4402 assert (ffelex_is_firstnamechar ((unsigned char)(t
->text
[start
])));
4404 nt
= ffelex_token_new_ ();
4405 nt
->type
= FFELEX_typeNAMES
;
4406 nt
->size
= len
; /* Assume nobody's gonna fiddle with token
4410 ffewhere_set_from_track (&nt
->where_line
, &nt
->where_col
, t
->where_line
,
4411 t
->where_col
, t
->wheretrack
, start
);
4412 ffewhere_track_copy (nt
->wheretrack
, t
->wheretrack
, start
, len
);
4413 nt
->text
= malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
4415 strncpy (nt
->text
, t
->text
+ start
, len
);
4416 nt
->text
[len
] = '\0';
4420 /* Make a new CHARACTER token. */
4423 ffelex_token_new_character (const char *s
, ffewhereLine l
, ffewhereColumn c
)
4427 t
= ffelex_token_new_ ();
4428 t
->type
= FFELEX_typeCHARACTER
;
4429 t
->length
= t
->size
= strlen (s
); /* Assume it won't get bigger. */
4431 t
->text
= malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
4433 strcpy (t
->text
, s
);
4434 t
->where_line
= ffewhere_line_use (l
);
4435 t
->where_col
= ffewhere_column_new (c
);
4439 /* Make a new EOF token right after end of file. */
4442 ffelex_token_new_eof ()
4446 t
= ffelex_token_new_ ();
4447 t
->type
= FFELEX_typeEOF
;
4450 t
->where_line
= ffewhere_line_new (ffelex_linecount_current_
);
4451 t
->where_col
= ffewhere_column_new (1);
4455 /* Make a new NAME token. */
4458 ffelex_token_new_name (const char *s
, ffewhereLine l
, ffewhereColumn c
)
4462 assert (ffelex_is_firstnamechar ((unsigned char)*s
));
4464 t
= ffelex_token_new_ ();
4465 t
->type
= FFELEX_typeNAME
;
4466 t
->length
= t
->size
= strlen (s
); /* Assume it won't get bigger. */
4468 t
->text
= malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
4470 strcpy (t
->text
, s
);
4471 t
->where_line
= ffewhere_line_use (l
);
4472 t
->where_col
= ffewhere_column_new (c
);
4476 /* Make a new NAMES token. */
4479 ffelex_token_new_names (const char *s
, ffewhereLine l
, ffewhereColumn c
)
4483 assert (ffelex_is_firstnamechar ((unsigned char)*s
));
4485 t
= ffelex_token_new_ ();
4486 t
->type
= FFELEX_typeNAMES
;
4487 t
->length
= t
->size
= strlen (s
); /* Assume it won't get bigger. */
4489 t
->text
= malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
4491 strcpy (t
->text
, s
);
4492 t
->where_line
= ffewhere_line_use (l
);
4493 t
->where_col
= ffewhere_column_new (c
);
4494 ffewhere_track_clear (t
->wheretrack
, t
->length
); /* Assume contiguous
4499 /* Make a new NUMBER token.
4501 The first character of the string must be a digit, and only the digits
4502 are copied into the new number. So this may be used to easily extract
4503 a NUMBER token from within any text string. Then the length of the
4504 resulting token may be used to calculate where the digits stopped
4505 in the original string. */
4508 ffelex_token_new_number (const char *s
, ffewhereLine l
, ffewhereColumn c
)
4513 /* How long is the string of decimal digits at s? */
4515 len
= strspn (s
, "0123456789");
4517 /* Make sure there is at least one digit. */
4521 /* Now make the token. */
4523 t
= ffelex_token_new_ ();
4524 t
->type
= FFELEX_typeNUMBER
;
4525 t
->length
= t
->size
= len
; /* Assume it won't get bigger. */
4527 t
->text
= malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
4529 strncpy (t
->text
, s
, len
);
4530 t
->text
[len
] = '\0';
4531 t
->where_line
= ffewhere_line_use (l
);
4532 t
->where_col
= ffewhere_column_new (c
);
4536 /* Make a new token of any type that doesn't contain text. A private
4537 function that is used by public macros in the interface file. */
4540 ffelex_token_new_simple_ (ffelexType type
, ffewhereLine l
, ffewhereColumn c
)
4544 t
= ffelex_token_new_ ();
4548 t
->where_line
= ffewhere_line_use (l
);
4549 t
->where_col
= ffewhere_column_new (c
);
4553 /* Make a new NUMBER token from an existing NAMES token.
4555 Like ffelex_token_new_number, this function calculates the length
4556 of the digit string itself. */
4559 ffelex_token_number_from_names (ffelexToken t
, ffeTokenLength start
)
4565 assert (ffelex_token_type (t
) == FFELEX_typeNAMES
);
4566 assert (start
< t
->length
);
4568 /* How long is the string of decimal digits at s? */
4570 len
= strspn (t
->text
+ start
, "0123456789");
4572 /* Make sure there is at least one digit. */
4576 /* Now make the token. */
4578 nt
= ffelex_token_new_ ();
4579 nt
->type
= FFELEX_typeNUMBER
;
4580 nt
->size
= len
; /* Assume nobody's gonna fiddle with token
4584 ffewhere_set_from_track (&nt
->where_line
, &nt
->where_col
, t
->where_line
,
4585 t
->where_col
, t
->wheretrack
, start
);
4586 nt
->text
= malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
4588 strncpy (nt
->text
, t
->text
+ start
, len
);
4589 nt
->text
[len
] = '\0';
4593 /* Make a new UNDERSCORE token from a NAMES token. */
4596 ffelex_token_uscore_from_names (ffelexToken t
, ffeTokenLength start
)
4601 assert (ffelex_token_type (t
) == FFELEX_typeNAMES
);
4602 assert (start
< t
->length
);
4603 assert (t
->text
[start
] == '_');
4605 /* Now make the token. */
4607 nt
= ffelex_token_new_ ();
4608 nt
->type
= FFELEX_typeUNDERSCORE
;
4610 ffewhere_set_from_track (&nt
->where_line
, &nt
->where_col
, t
->where_line
,
4611 t
->where_col
, t
->wheretrack
, start
);
4616 /* ffelex_token_use -- Return another instance of a token
4619 t = ffelex_token_use(t);
4621 In a sense, the new token is a copy of the old, though it might be the
4622 same with just a new use count.
4624 We use the use count method (easy). */
4627 ffelex_token_use (ffelexToken t
)
4630 assert ("_token_use: null token" == NULL
);
4635 #include "gt-f-lex.h"