home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / g77-0.5.15-src.tgz / tar.out / fsf / g77 / f / lex.c < prev    next >
C/C++ Source or Header  |  1996-09-28  |  102KB  |  3,829 lines
  1. /* Implementation of Fortran lexer
  2.    Copyright (C) 1995 Free Software Foundation, Inc.
  3.    Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
  4.  
  5. This file is part of GNU Fortran.
  6.  
  7. GNU Fortran is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2, or (at your option)
  10. any later version.
  11.  
  12. GNU Fortran is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. GNU General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with GNU Fortran; see the file COPYING.  If not, write to
  19. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  20.  
  21. #include "proj.h"
  22. #include <ctype.h>
  23. #include "top.h"
  24. #include "bad.h"
  25. #include "com.h"
  26. #include "lex.h"
  27. #include "malloc.h"
  28. #include "src.h"
  29. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  30. #include "config.j"
  31. #include "tree.j"
  32. #endif
  33.  
  34. static void ffelex_append_to_token_ (char c);
  35. static int ffelex_backslash_ (int c, ffewhereColumnNumber col);
  36. static void ffelex_bad_1_ (ffebad errnum, ffewhereLineNumber ln0,
  37.                ffewhereColumnNumber cn0);
  38. static void ffelex_bad_2_ (ffebad errnum, ffewhereLineNumber ln0,
  39.                ffewhereColumnNumber cn0, ffewhereLineNumber ln1,
  40.                ffewhereColumnNumber cn1);
  41. static void ffelex_bad_here_ (int num, ffewhereLineNumber ln0,
  42.                   ffewhereColumnNumber cn0);
  43. #if 0
  44. static void ffelex_display_token_ (void);
  45. #endif
  46. static void ffelex_finish_statement_ (void);
  47. static ffewhereColumnNumber ffelex_image_char_ (int c,
  48.                         ffewhereColumnNumber col);
  49. static void ffelex_include_ (void);
  50. static bool ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col);
  51. static bool ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col);
  52. static void ffelex_send_token_ (void);
  53. static ffelexHandler ffelex_swallow_tokens_ (ffelexToken t);
  54. static ffelexToken ffelex_token_new_ (void);
  55.  
  56. /* Pertaining to the geometry of the input file.  */
  57.  
  58. /* Initial size for card image to be allocated.  */
  59. #define FFELEX_columnINITIAL_SIZE_ 255
  60.  
  61. /* The card image itself, which grows as source lines get longer.  It
  62.    has room for ffelex_card_size_ + 8 characters, and the length of the
  63.    current image is ffelex_card_length_.  (The + 8 characters are made
  64.    available for easy handling of tabs and such.)  */
  65. static char *ffelex_card_image_;
  66. static ffewhereColumnNumber ffelex_card_size_;
  67. static ffewhereColumnNumber ffelex_card_length_;
  68.  
  69. /* Max width for free-form lines (ISO F90).  */
  70. #define FFELEX_FREE_MAX_COLUMNS_ 132
  71.  
  72. /* True if we saw a tab on the current line, as this (currently) means
  73.    the line is therefore treated as though final_nontab_column_ were
  74.    infinite.  */
  75. static bool ffelex_saw_tab_;
  76.  
  77. /* TRUE if current line is known to be erroneous, so don't bother
  78.    expanding room for it just to display it.  */
  79. static bool ffelex_bad_line_ = FALSE;
  80.  
  81. /* Last column for vanilla, i.e. non-tabbed, line.  Usually 72 or 132. */
  82. static ffewhereColumnNumber ffelex_final_nontab_column_;
  83.  
  84. /* Array for quickly deciding what kind of line the current card has,
  85.    based on its first character.  */
  86. static ffelexType ffelex_first_char_[256];
  87.  
  88. /* Pertaining to file management.  */
  89.  
  90. /* The wf argument of the most recent active ffelex_file_(fixed,free)
  91.    function.  */
  92. static ffewhereFile ffelex_current_wf_;
  93.  
  94. /* TRUE if an INCLUDE statement can be processed (ffelex_set_include
  95.    can be called).  */
  96. static bool ffelex_permit_include_;
  97.  
  98. /* TRUE if an INCLUDE statement is pending (ffelex_set_include has been
  99.    called).  */
  100. static bool ffelex_set_include_;
  101.  
  102. /* Information on the pending INCLUDE file.  */
  103. static FILE *ffelex_include_file_;
  104. static bool ffelex_include_free_form_;
  105. static ffewhereFile ffelex_include_wherefile_;
  106.  
  107. /* Current master line count.  */
  108. static ffewhereLineNumber ffelex_linecount_current_;
  109. /* Next master line count.  */
  110. static ffewhereLineNumber ffelex_linecount_next_;
  111.  
  112. /* ffewhere info on the latest (currently active) line read from the
  113.    active source file.  */
  114. static ffewhereLine ffelex_current_wl_;
  115. static ffewhereColumn ffelex_current_wc_;
  116.  
  117. /* Pertaining to tokens in general.  */
  118.  
  119. /* Initial capacity for text in a CHARACTER/HOLLERITH/NAME/NAMES/NUMBER
  120.    token.  */
  121. #define FFELEX_columnTOKEN_SIZE_ 63
  122. #if FFELEX_columnTOKEN_SIZE_ < FFEWHERE_indexMAX
  123. #error token size too small!
  124. #endif
  125.  
  126. /* Current token being lexed.  */
  127. static ffelexToken ffelex_token_;
  128.  
  129. /* Handler for current token.  */
  130. static ffelexHandler ffelex_handler_;
  131.  
  132. /* TRUE if fixed-form lexer is to generate NAMES instead of NAME tokens.  */
  133. static bool ffelex_names_;
  134.  
  135. /* TRUE if both lexers are to generate NAMES instead of NAME tokens.  */
  136. static bool ffelex_names_pure_;
  137.  
  138. /* TRUE if 0-9 starts a NAME token instead of NUMBER, for parsing hex
  139.    numbers.  */
  140. static bool ffelex_hexnum_;
  141.  
  142. /* For ffelex_swallow_tokens().  */
  143. static ffelexHandler ffelex_eos_handler_;
  144.  
  145. /* Number of tokens sent since last EOS or beginning of input file
  146.    (include INCLUDEd files).  */
  147. static unsigned long int ffelex_number_of_tokens_;
  148.  
  149. /* Number of labels sent (as NUMBER tokens) since last reset of
  150.    ffelex_number_of_tokens_ to 0, should be 0 or 1 in most cases.
  151.    (Fixed-form source only.)  */
  152. static int ffelex_label_tokens_;
  153.  
  154. /* Metering for token management, to catch token-memory leaks.  */
  155. static long int ffelex_total_tokens_ = 0;
  156. static long int ffelex_old_total_tokens_ = 1;
  157. static long int ffelex_token_nextid_ = 0;
  158.  
  159. /* Pertaining to lexing CHARACTER and HOLLERITH tokens.  */
  160.  
  161. /* >0 if a Hollerith constant of that length might be in mid-lex, used
  162.    when the next character seen is 'H' or 'h' to enter HOLLERITH lexing
  163.    mode (see ffelex_raw_mode_).  */
  164. static long int ffelex_expecting_hollerith_;
  165.  
  166. /* -3: Backslash (escape) sequence being lexed in CHARACTER.
  167.    -2: Possible closing apostrophe/quote seen in CHARACTER.
  168.    -1: Lexing CHARACTER.
  169.     0: Not lexing CHARACTER or HOLLERITH.
  170.    >0: Lexing HOLLERITH, value is # chars remaining to expect.  */
  171. static long int ffelex_raw_mode_;
  172.  
  173. /* When lexing CHARACTER, open quote/apostrophe (either ' or ").  */
  174. static char ffelex_raw_char_;
  175.  
  176. /* TRUE when backslash processing had to use most recent character
  177.    to finish its state engine, but that character is not part of
  178.    the backslash sequence, so must be reconsidered as a "normal"
  179.    character in CHARACTER/HOLLERITH lexing.  */
  180. static bool ffelex_backslash_reconsider_ = FALSE;
  181.  
  182. /* The beginning of a (possible) CHARACTER/HOLLERITH token.  */
  183. static ffewhereLine ffelex_raw_where_line_;
  184. static ffewhereColumn ffelex_raw_where_col_;
  185.  
  186.  
  187. /* Call this to append another character to the current token.    If it isn't
  188.    currently big enough for it, it will be enlarged.  The current token
  189.    must be a CHARACTER, HOLLERITH, NAME, NAMES, or NUMBER.  */
  190.  
  191. static void
  192. ffelex_append_to_token_ (char c)
  193. {
  194.   if (ffelex_token_->text == NULL)
  195.     {
  196.       ffelex_token_->text
  197.     = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
  198.               FFELEX_columnTOKEN_SIZE_ + 1);
  199.       ffelex_token_->size = FFELEX_columnTOKEN_SIZE_;
  200.       ffelex_token_->length = 0;
  201.     }
  202.   else if (ffelex_token_->length >= ffelex_token_->size)
  203.     {
  204.       ffelex_token_->text
  205.     = malloc_resize_ksr (malloc_pool_image (),
  206.                  ffelex_token_->text,
  207.                  (ffelex_token_->size << 1) + 1,
  208.                  ffelex_token_->size + 1);
  209.       ffelex_token_->size <<= 1;
  210.       assert (ffelex_token_->length < ffelex_token_->size);
  211.     }
  212. #ifdef MAP_CHARACTER
  213. Sorry, MAP_CHARACTER is not going to work as expected in GNU Fortran,
  214. please contact fortran@gnu.ai.mit.edu if you wish to fund work to
  215. port g77 to non-ASCII machines.
  216. #endif
  217.   ffelex_token_->text[ffelex_token_->length++] = c;
  218. }
  219.  
  220. /* Do backslash (escape) processing for a CHARACTER/HOLLERITH token
  221.    being lexed.  */
  222.  
  223. static int
  224. ffelex_backslash_ (int c, ffewhereColumnNumber col)
  225. {
  226.   static int state = 0;
  227.   static unsigned int count;
  228.   static int code;
  229.   static unsigned int firstdig = 0;
  230.   static int nonnull;
  231.   static ffewhereLineNumber line;
  232.   static ffewhereColumnNumber column;
  233.  
  234.   /* See gcc/c-lex.c readescape() for a straightforward version
  235.      of this state engine for handling backslashes in character/
  236.      hollerith constants.  */
  237.  
  238. #define wide_flag 0
  239. #define warn_traditional 0
  240. #define flag_traditional 0
  241.  
  242.   switch (state)
  243.     {
  244.     case 0:
  245.       if ((c == '\\')
  246.       && (ffelex_raw_mode_ != 0)
  247.       && ffe_is_backslash ())
  248.     {
  249.       state = 1;
  250.       column = col + 1;
  251.       line = ffelex_linecount_current_;
  252.       return EOF;
  253.     }
  254.       return c;
  255.  
  256.     case 1:
  257.       state = 0;        /* Assume simple case. */
  258.       switch (c)
  259.     {
  260.     case 'x':
  261.       if (warn_traditional)
  262.         {
  263.           ffebad_start_msg ("The meaning of `\\x' (at %0) varies with -traditional",
  264.                 FFEBAD_severityWARNING);
  265.           ffelex_bad_here_ (0, line, column);
  266.           ffebad_finish ();
  267.         }
  268.       
  269.       if (flag_traditional)
  270.         return c;
  271.  
  272.       code = 0;
  273.       count = 0;
  274.       nonnull = 0;
  275.       state = 2;
  276.       return EOF;
  277.  
  278.     case '0':  case '1':  case '2':  case '3':  case '4':
  279.     case '5':  case '6':  case '7':
  280.       code = c - '0';
  281.       count = 1;
  282.       state = 3;
  283.       return EOF;
  284.  
  285.     case '\\': case '\'': case '"':
  286.       return c;
  287.  
  288. #if 0    /* Inappropriate for Fortran. */
  289.     case '\n':
  290.       lineno++;
  291.       *ignore_ptr = 1;
  292.       return 0;
  293. #endif
  294.  
  295.     case 'n':
  296.       return TARGET_NEWLINE;
  297.  
  298.     case 't':
  299.       return TARGET_TAB;
  300.  
  301.     case 'r':
  302.       return TARGET_CR;
  303.  
  304.     case 'f':
  305.       return TARGET_FF;
  306.  
  307.     case 'b':
  308.       return TARGET_BS;
  309.  
  310.     case 'a':
  311.       if (warn_traditional)
  312.         {
  313.           ffebad_start_msg ("The meaning of `\\a' (at %0) varies with -traditional",
  314.                 FFEBAD_severityWARNING);
  315.           ffelex_bad_here_ (0, line, column);
  316.           ffebad_finish ();
  317.         }
  318.  
  319.       if (flag_traditional)
  320.         return c;
  321.       return TARGET_BELL;
  322.  
  323.     case 'v':
  324. #if 0 /* Vertical tab is present in common usage compilers.  */
  325.       if (flag_traditional)
  326.         return c;
  327. #endif
  328.       return TARGET_VT;
  329.  
  330.     case 'e':
  331.     case 'E':
  332.     case '(':
  333.     case '{':
  334.     case '[':
  335.     case '%':
  336.       if (pedantic)
  337.         {
  338.           char m[2];
  339.  
  340.           m[0] = c;
  341.           m[1] = '\0';
  342.           ffebad_start_msg ("Non-ANSI-C-standard escape sequence `\\%A' at %0",
  343.                 FFEBAD_severityPEDANTIC);
  344.           ffelex_bad_here_ (0, line, column);
  345.           ffebad_string (m);
  346.           ffebad_finish ();
  347.         }
  348.       return (c == 'E' || c == 'e') ? 033 : c;
  349.  
  350.     case '?':
  351.       return c;
  352.  
  353.     default:
  354.       if (c >= 040 && c < 0177)
  355.         {
  356.           char m[2];
  357.  
  358.           m[0] = c;
  359.           m[1] = '\0';
  360.           ffebad_start_msg ("Unknown escape sequence `\\%A' at %0",
  361.                 FFEBAD_severityPEDANTIC);
  362.           ffelex_bad_here_ (0, line, column);
  363.           ffebad_string (m);
  364.           ffebad_finish ();
  365.         }
  366.       else if (c == EOF)
  367.         {
  368.           ffebad_start_msg ("Unterminated escape sequence `\\' at %0",
  369.                 FFEBAD_severityPEDANTIC);
  370.           ffelex_bad_here_ (0, line, column);
  371.           ffebad_finish ();
  372.         }
  373.       else
  374.         {
  375.           char m[20];
  376.  
  377.           sprintf (&m[0], "%x", c);
  378.           ffebad_start_msg ("Unknown escape sequence `\\' followed by char code 0x%A at %0",
  379.                 FFEBAD_severityPEDANTIC);
  380.           ffelex_bad_here_ (0, line, column);
  381.           ffebad_string (m);
  382.           ffebad_finish ();
  383.         }
  384.     }
  385.       return c;
  386.  
  387.     case 2:
  388.       if ((c >= 'a' && c <= 'f')
  389.       || (c >= 'A' && c <= 'F')
  390.       || (c >= '0' && c <= '9'))
  391.     {
  392.       code *= 16;
  393.       if (c >= 'a' && c <= 'f')
  394.         code += c - 'a' + 10;
  395.       if (c >= 'A' && c <= 'F')
  396.         code += c - 'A' + 10;
  397.       if (c >= '0' && c <= '9')
  398.         code += c - '0';
  399.       if (code != 0 || count != 0)
  400.         {
  401.           if (count == 0)
  402.         firstdig = code;
  403.           count++;
  404.         }
  405.       nonnull = 1;
  406.       return EOF;
  407.     }
  408.  
  409.       state = 0;
  410.  
  411.       if (! nonnull)
  412.     {
  413.       ffebad_start_msg ("\\x used at %0 with no following hex digits",
  414.                 FFEBAD_severityFATAL);
  415.       ffelex_bad_here_ (0, line, column);
  416.       ffebad_finish ();
  417.     }
  418.       else if (count == 0)
  419.     /* Digits are all 0's.  Ok.  */
  420.     ;
  421.       else if ((count - 1) * 4 >= TYPE_PRECISION (integer_type_node)
  422.            || (count > 1
  423.            && ((1 << (TYPE_PRECISION (integer_type_node) - (count - 1) * 4))
  424.                <= firstdig)))
  425.     {
  426.       ffebad_start_msg ("Hex escape at %0 out of range",
  427.                 FFEBAD_severityPEDANTIC);
  428.       ffelex_bad_here_ (0, line, column);
  429.       ffebad_finish ();
  430.     }
  431.       break;
  432.  
  433.     case 3:
  434.       if ((c <= '7') && (c >= '0') && (count++ < 3))
  435.     {
  436.       code = (code * 8) + (c - '0');
  437.       return EOF;
  438.     }
  439.       state = 0;
  440.       break;
  441.  
  442.     default:
  443.       assert ("bad backslash state" == NULL);
  444.       abort ();
  445.     }
  446.  
  447.   /* Come here when code has a built character, and c is the next
  448.      character that might (or might not) be the next one in the constant.  */
  449.  
  450.   /* Don't bother doing this check for each character going into
  451.      CHARACTER or HOLLERITH constants, just the escaped-value ones.
  452.      gcc apparently checks every single character, which seems
  453.      like it'd be kinda slow and not worth doing anyway.  */
  454.  
  455.   if (!wide_flag
  456.       && TYPE_PRECISION (char_type_node) < HOST_BITS_PER_INT
  457.       && code >= (1 << TYPE_PRECISION (char_type_node)))
  458.     {
  459.       ffebad_start_msg ("Escape sequence at %0 out of range for character",
  460.             FFEBAD_severityFATAL);
  461.       ffelex_bad_here_ (0, line, column);
  462.       ffebad_finish ();
  463.     }
  464.  
  465.   if (c == EOF)
  466.     {
  467.       /* Known end of constant, just append this character.  */
  468.       ffelex_append_to_token_ (code);
  469.       if (ffelex_raw_mode_ > 0)
  470.     --ffelex_raw_mode_;
  471.       return EOF;
  472.     }
  473.  
  474.   /* Have two characters to handle.  Do the first, then leave it to the
  475.      caller to detect anything special about the second.  */
  476.  
  477.   ffelex_append_to_token_ (code);
  478.   if (ffelex_raw_mode_ > 0)
  479.     --ffelex_raw_mode_;
  480.   ffelex_backslash_reconsider_ = TRUE;
  481.   return c;
  482. }
  483.  
  484. /* ffelex_bad_1_ -- Issue diagnostic with one source point
  485.  
  486.    ffelex_bad_1_(FFEBAD_SOME_ERROR,ffelex_linecount_current_,column + 1);
  487.  
  488.    Creates ffewhere line and column objects for the source point, sends them
  489.    along with the error code to ffebad, then kills the line and column
  490.    objects before returning.  */
  491.  
  492. static void
  493. ffelex_bad_1_ (ffebad errnum, ffewhereLineNumber ln0, ffewhereColumnNumber cn0)
  494. {
  495.   ffewhereLine wl0;
  496.   ffewhereColumn wc0;
  497.  
  498.   wl0 = ffewhere_line_new (ln0);
  499.   wc0 = ffewhere_column_new (cn0);
  500.   ffebad_start_lex (errnum);
  501.   ffebad_here (0, wl0, wc0);
  502.   ffebad_finish ();
  503.   ffewhere_line_kill (wl0);
  504.   ffewhere_column_kill (wc0);
  505. }
  506.  
  507. /* ffelex_bad_2_ -- Issue diagnostic with two source points
  508.  
  509.    ffelex_bad_2_(FFEBAD_SOME_ERROR,ffelex_linecount_current_,column + 1,
  510.      otherline,othercolumn);
  511.  
  512.    Creates ffewhere line and column objects for the source points, sends them
  513.    along with the error code to ffebad, then kills the line and column
  514.    objects before returning.  */
  515.  
  516. static void
  517. ffelex_bad_2_ (ffebad errnum, ffewhereLineNumber ln0, ffewhereColumnNumber cn0,
  518.            ffewhereLineNumber ln1, ffewhereColumnNumber cn1)
  519. {
  520.   ffewhereLine wl0, wl1;
  521.   ffewhereColumn wc0, wc1;
  522.  
  523.   wl0 = ffewhere_line_new (ln0);
  524.   wc0 = ffewhere_column_new (cn0);
  525.   wl1 = ffewhere_line_new (ln1);
  526.   wc1 = ffewhere_column_new (cn1);
  527.   ffebad_start_lex (errnum);
  528.   ffebad_here (0, wl0, wc0);
  529.   ffebad_here (1, wl1, wc1);
  530.   ffebad_finish ();
  531.   ffewhere_line_kill (wl0);
  532.   ffewhere_column_kill (wc0);
  533.   ffewhere_line_kill (wl1);
  534.   ffewhere_column_kill (wc1);
  535. }
  536.  
  537. static void
  538. ffelex_bad_here_ (int n, ffewhereLineNumber ln0,
  539.           ffewhereColumnNumber cn0)
  540. {
  541.   ffewhereLine wl0;
  542.   ffewhereColumn wc0;
  543.  
  544.   wl0 = ffewhere_line_new (ln0);
  545.   wc0 = ffewhere_column_new (cn0);
  546.   ffebad_here (n, wl0, wc0);
  547.   ffewhere_line_kill (wl0);
  548.   ffewhere_column_kill (wc0);
  549. }
  550.  
  551. #if 0
  552. static void
  553. ffelex_display_token_ ()
  554. {
  555.   fprintf (stdout, "; Token #%lu is %s (line %" ffewhereLineNumber_f "u, col %"
  556.        ffewhereColumnNumber_f "u)",
  557.        (unsigned long) ffelex_number_of_tokens_,
  558.        ffelex_type_string_ (ffelex_token_->type),
  559.        ffewhere_line_number (ffelex_token_->where_line),
  560.        ffewhere_column_number (ffelex_token_->where_col));
  561.  
  562.   if (ffelex_token_->text != NULL)
  563.     fprintf (stdout, ": \"%.*s\"\n",
  564.          (unsigned int) ffelex_token_->length,
  565.          ffelex_token_->text);
  566.   else
  567.     fprintf (stdout, ".\n");
  568. }
  569.  
  570. #endif
  571. static void
  572. ffelex_finish_statement_ ()
  573. {
  574.   if ((ffelex_number_of_tokens_ == 0)
  575.       && (ffelex_token_->type == FFELEX_typeNONE))
  576.     return;            /* Don't have a statement pending. */
  577.  
  578.   if (ffelex_token_->type != FFELEX_typeNONE)
  579.     {
  580.       ffelex_backslash_ (EOF, 0);
  581.  
  582.       switch (ffelex_raw_mode_)
  583.     {
  584.     case -2:
  585.       break;
  586.  
  587.     case -1:
  588.       ffebad_start_lex ((ffelex_raw_char_ == '\'') ? FFEBAD_NO_CLOSING_APOSTROPHE
  589.                 : FFEBAD_NO_CLOSING_QUOTE);
  590.       ffebad_here (0, ffelex_token_->where_line, ffelex_token_->where_col);
  591.       ffebad_here (1, ffelex_current_wl_, ffelex_current_wc_);
  592.       ffebad_finish ();
  593.       break;
  594.  
  595.     case 0:
  596.       break;
  597.  
  598.     default:
  599.       {
  600.         char num[20];
  601.  
  602.         ffebad_start_lex (FFEBAD_NOT_ENOUGH_HOLLERITH_CHARS);
  603.         ffebad_here (0, ffelex_token_->where_line, ffelex_token_->where_col);
  604.         ffebad_here (1, ffelex_current_wl_, ffelex_current_wc_);
  605.         sprintf (num, "%lu", (unsigned long) ffelex_raw_mode_);
  606.         ffebad_string (num);
  607.         ffebad_finish ();
  608.         break;
  609.       }
  610.     }
  611.       ffelex_raw_mode_ = 0;
  612.       ffelex_send_token_ ();
  613.     }
  614.   ffelex_token_->type = FFELEX_typeEOS;
  615.   ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  616.   ffelex_token_->where_col = ffewhere_column_use (ffelex_current_wc_);
  617.   ffelex_permit_include_ = TRUE;
  618.   ffelex_send_token_ ();
  619.   ffelex_permit_include_ = FALSE;
  620.   ffelex_number_of_tokens_ = 0;
  621.   ffelex_label_tokens_ = 0;
  622.   ffelex_names_ = TRUE;
  623.   ffelex_names_pure_ = FALSE;    /* Probably not necessary. */
  624.   ffelex_hexnum_ = FALSE;
  625.  
  626.   if (!ffe_is_ffedebug ())
  627.     return;
  628.  
  629.   /* For debugging purposes only. */
  630.  
  631.   if (ffelex_total_tokens_ != ffelex_old_total_tokens_)
  632.     {
  633.       fprintf (stdout, "; token_track had %ld tokens, now have %ld.\n",
  634.            ffelex_old_total_tokens_, ffelex_total_tokens_);
  635.       ffelex_old_total_tokens_ = ffelex_total_tokens_;
  636.     }
  637. }
  638.  
  639. /* "Image" a character onto the card image, return incremented column number.
  640.  
  641.    Normally invoking this function as in
  642.      column = ffelex_image_char_ (c, column);
  643.    is the same as doing:
  644.      ffelex_card_image_[column++] = c;
  645.  
  646.    However, tabs and carriage returns are handled specially, to preserve
  647.    the visual "image" of the input line (in most editors) in the card
  648.    image.
  649.  
  650.    Carriage returns are ignored, as they are assumed to be followed
  651.    by newlines.
  652.  
  653.    A tab is handled by first doing:
  654.      ffelex_card_image_[column++] = ' ';
  655.    That is, it translates to at least one space.  Then, as many spaces
  656.    are imaged as necessary to bring the column number to the next tab
  657.    position, where tab positions start in the ninth column and each
  658.    eighth column afterwards.  ALSO, a static var named ffelex_saw_tab_
  659.    is set to TRUE to notify the lexer that a tab was seen.
  660.  
  661.    Columns are numbered and tab stops set as illustrated below:
  662.  
  663.    012345670123456701234567...
  664.    x       y       z
  665.    xx       yy       zz
  666.    ...
  667.    xxxxxxx yyyyyyy zzzzzzz
  668.    xxxxxxxx       yyyyyyyy...  */
  669.  
  670. static ffewhereColumnNumber
  671. ffelex_image_char_ (int c, ffewhereColumnNumber column)
  672. {
  673.   if (column >= ffelex_card_size_)
  674.     {
  675.       ffewhereColumnNumber newmax = ffelex_card_size_ << 1;
  676.  
  677.       if (ffelex_bad_line_)
  678.     return column;
  679.  
  680.       if ((newmax >> 1) != ffelex_card_size_)
  681.     {            /* Overflowed column number. */
  682.       ffelex_bad_line_ = TRUE;
  683.       strcpy (&ffelex_card_image_[column], "...");
  684.       ffelex_card_length_ = column + 3;
  685.       ffelex_bad_1_ (FFEBAD_LINE_TOO_LONG,
  686.              ffelex_linecount_current_, column + 1);
  687.       return column;
  688.     }
  689.  
  690.       ffelex_card_image_
  691.     = malloc_resize_ksr (malloc_pool_image (),
  692.                  ffelex_card_image_,
  693.                  newmax + 9,
  694.                  ffelex_card_size_ + 9);
  695.       ffelex_card_size_ = newmax;
  696.     }
  697.  
  698.   switch (c)
  699.     {
  700.     case '\r':
  701.       break;
  702.  
  703.     case '\t':
  704.       ffelex_saw_tab_ = TRUE;
  705.       ffelex_card_image_[column++] = ' ';
  706.       while ((column & 7) != 0)
  707.     ffelex_card_image_[column++] = ' ';
  708.       break;
  709.  
  710.     case '\0':
  711.       if (!ffelex_bad_line_)
  712.     {
  713.       ffelex_bad_line_ = TRUE;
  714.       strcpy (&ffelex_card_image_[column], "[\\0]");
  715.       ffelex_card_length_ = column + 4;
  716.       ffebad_start_msg ("Null character at %0 -- line ignored",
  717.                 FFEBAD_severityFATAL);
  718.       ffelex_bad_here_ (0, ffelex_linecount_current_, column + 1);
  719.       ffebad_finish ();
  720.     }
  721.       break;
  722.  
  723.     default:
  724.       ffelex_card_image_[column++] = c;
  725.       break;
  726.     }
  727.  
  728.   return column;
  729. }
  730.  
  731. static void
  732. ffelex_include_ ()
  733. {
  734.   ffewhereFile include_wherefile = ffelex_include_wherefile_;
  735.   FILE *include_file = ffelex_include_file_;
  736.   /* The rest of this is to push, and after the INCLUDE file is processed,
  737.      pop, the static lexer state info that pertains to each particular
  738.      input file.  */
  739.   char *card_image;
  740.   ffewhereColumnNumber card_size = ffelex_card_size_;
  741.   ffewhereColumnNumber card_length = ffelex_card_length_;
  742.   ffewhereLine current_wl = ffelex_current_wl_;
  743.   ffewhereColumn current_wc = ffelex_current_wc_;
  744.   bool saw_tab = ffelex_saw_tab_;
  745.   ffewhereColumnNumber final_nontab_column = ffelex_final_nontab_column_;
  746.   ffewhereFile current_wf = ffelex_current_wf_;
  747.   ffewhereLineNumber linecount_current = ffelex_linecount_current_;
  748. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  749.   int old_lineno = lineno;
  750.   char *old_input_filename = input_filename;
  751. #endif
  752.  
  753.   if (card_length != 0)
  754.     {
  755.       card_image = malloc_new_ks (malloc_pool_image (),
  756.                   "FFELEX saved card image",
  757.                   card_length);
  758.       memcpy (card_image, ffelex_card_image_, card_length);
  759.     }
  760.   else
  761.     card_image = NULL;
  762.  
  763.   ffelex_set_include_ = FALSE;
  764.  
  765.   ffewhere_file_begin (current_wf, include_wherefile);
  766.   if (ffelex_include_free_form_)
  767.     ffelex_file_free (include_wherefile, include_file);
  768.   else
  769.     ffelex_file_fixed (include_wherefile, include_file);
  770.   ffewhere_file_end (include_wherefile, current_wf);
  771.   ffecom_close_include (include_file);
  772.  
  773.   if (card_length != 0)
  774.     {
  775. #ifdef REDUCE_CARD_SIZE_AFTER_BIGGY    /* Define if occasional large lines. */
  776. #error need to handle possible reduction of card size here!!
  777. #endif
  778.       assert (ffelex_card_size_ >= card_length);    /* It shrunk?? */
  779.       memcpy (ffelex_card_image_, card_image, card_length);
  780.     }
  781.   ffelex_card_image_[card_length] = '\0';
  782.  
  783. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  784.   input_filename = old_input_filename;
  785.   lineno = old_lineno;
  786. #endif
  787.   ffelex_linecount_current_ = linecount_current;
  788.   ffelex_current_wf_ = current_wf;
  789.   ffelex_final_nontab_column_ = final_nontab_column;
  790.   ffelex_saw_tab_ = saw_tab;
  791.   ffelex_current_wc_ = current_wc;
  792.   ffelex_current_wl_ = current_wl;
  793.   ffelex_card_length_ = card_length;
  794.   ffelex_card_size_ = card_size;
  795. }
  796.  
  797. /* ffelex_is_free_char_ctx_contin_ -- Character Context Continuation?
  798.  
  799.    ffewhereColumnNumber col;
  800.    int c;  // Char at col.
  801.    if ((c == '&') && ffelex_is_free_char_ctx_contin_(col + 1))
  802.        // We have a continuation indicator.
  803.  
  804.    If there are <n> spaces starting at ffelex_card_image_[col] up through
  805.    the null character, where <n> is 0 or greater, returns TRUE.     */
  806.  
  807. static bool
  808. ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col)
  809. {
  810.   while (ffelex_card_image_[col] != '\0')
  811.     {
  812.       if (ffelex_card_image_[col++] != ' ')
  813.     return FALSE;
  814.     }
  815.   return TRUE;
  816. }
  817.  
  818. /* ffelex_is_free_nonc_ctx_contin_ -- Noncharacter Context Continuation?
  819.  
  820.    ffewhereColumnNumber col;
  821.    int c;  // Char at col.
  822.    if ((c == '&') && ffelex_is_free_nonc_ctx_contin_(col + 1))
  823.        // We have a continuation indicator.
  824.  
  825.    If there are <n> spaces starting at ffelex_card_image_[col] up through
  826.    the null character or '!', where <n> is 0 or greater, returns TRUE.    */
  827.  
  828. static bool
  829. ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col)
  830. {
  831.   while ((ffelex_card_image_[col] != '\0') && (ffelex_card_image_[col] != '!'))
  832.     {
  833.       if (ffelex_card_image_[col++] != ' ')
  834.     return FALSE;
  835.     }
  836.   return TRUE;
  837. }
  838.  
  839. static void
  840. ffelex_send_token_ ()
  841. {
  842.   ++ffelex_number_of_tokens_;
  843.  
  844.   ffelex_backslash_ (EOF, 0);
  845.  
  846.   if (ffelex_token_->text == NULL)
  847.     {
  848.       if (ffelex_token_->type == FFELEX_typeCHARACTER)
  849.     {
  850.       ffelex_append_to_token_ ('\0');
  851.       ffelex_token_->length = 0;
  852.     }
  853.     }
  854.   else
  855.     ffelex_token_->text[ffelex_token_->length] = '\0';
  856.  
  857.   assert (ffelex_raw_mode_ == 0);
  858.  
  859.   if (ffelex_token_->type == FFELEX_typeNAMES)
  860.     {
  861.       ffewhere_line_kill (ffelex_token_->currentnames_line);
  862.       ffewhere_column_kill (ffelex_token_->currentnames_col);
  863.     }
  864.  
  865.   assert (ffelex_handler_ != NULL);
  866.   ffelex_handler_ = (ffelexHandler) (*ffelex_handler_) (ffelex_token_);
  867.   assert (ffelex_handler_ != NULL);
  868.  
  869.   ffelex_token_kill (ffelex_token_);
  870.  
  871.   ffelex_token_ = ffelex_token_new_ ();
  872.   ffelex_token_->uses = 1;
  873.   ffelex_token_->text = NULL;
  874.   if (ffelex_raw_mode_ < 0)
  875.     {
  876.       ffelex_token_->type = FFELEX_typeCHARACTER;
  877.       ffelex_token_->where_line = ffelex_raw_where_line_;
  878.       ffelex_token_->where_col = ffelex_raw_where_col_;
  879.       ffelex_raw_where_line_ = ffewhere_line_unknown ();
  880.       ffelex_raw_where_col_ = ffewhere_column_unknown ();
  881.     }
  882.   else
  883.     {
  884.       ffelex_token_->type = FFELEX_typeNONE;
  885.       ffelex_token_->where_line = ffewhere_line_unknown ();
  886.       ffelex_token_->where_col = ffewhere_column_unknown ();
  887.     }
  888.  
  889.   if (ffelex_set_include_)
  890.     ffelex_include_ ();
  891. }
  892.  
  893. /* ffelex_swallow_tokens_ -- Eat all tokens delivered to me
  894.  
  895.    return ffelex_swallow_tokens_;
  896.  
  897.    Return this handler when you don't want to look at any more tokens in the
  898.    statement because you've encountered an unrecoverable error in the
  899.    statement.  */
  900.  
  901. static ffelexHandler
  902. ffelex_swallow_tokens_ (ffelexToken t)
  903. {
  904.   assert (ffelex_eos_handler_ != NULL);
  905.  
  906.   if ((ffelex_token_type (t) == FFELEX_typeEOS)
  907.       || (ffelex_token_type (t) == FFELEX_typeSEMICOLON))
  908.     return (ffelexHandler) (*ffelex_eos_handler_) (t);
  909.  
  910.   return (ffelexHandler) ffelex_swallow_tokens_;
  911. }
  912.  
  913. static ffelexToken
  914. ffelex_token_new_ ()
  915. {
  916.   ffelexToken t;
  917.  
  918.   ++ffelex_total_tokens_;
  919.  
  920.   t = (ffelexToken) malloc_new_ks (malloc_pool_image (),
  921.                    "FFELEX token", sizeof (*t));
  922.   t->id_ = ffelex_token_nextid_++;
  923.   return t;
  924. }
  925.  
  926. /* ffelex_expecting_character -- Tells if next token expected to be CHARACTER
  927.  
  928.    if (ffelex_expecting_character())
  929.        // next token delivered by lexer will be CHARACTER.
  930.  
  931.    If the most recent call to ffelex_set_expecting_hollerith since the last
  932.    token was delivered by the lexer passed a length of -1, then we return
  933.    TRUE, because the next token we deliver will be typeCHARACTER, else we
  934.    return FALSE.  */
  935.  
  936. bool
  937. ffelex_expecting_character ()
  938. {
  939.   return (ffelex_raw_mode_ != 0);
  940. }
  941.  
  942. /* ffelex_file_fixed -- Lex a given file in fixed source form
  943.  
  944.    ffewhere wf;
  945.    FILE *f;
  946.    ffelex_file_fixed(wf,f);
  947.  
  948.    Lexes the file according to Fortran 90 ANSI + VXT specifications.  */
  949.  
  950. ffelexHandler
  951. ffelex_file_fixed (ffewhereFile wf, FILE *f)
  952. {
  953.   register int c;        /* Character currently under consideration. */
  954.   register ffewhereColumnNumber column;    /* Not really; 0 means column 1... */
  955.   bool disallow_continuation_line;
  956.   bool ignore_disallowed_continuation;
  957.   int latest_char_in_file = 0;    /* For getting back into comment-skipping
  958.                    code. */
  959.   ffelexType lextype;
  960.   ffewhereColumnNumber first_label_char;    /* First char of label --
  961.                            column number. */
  962.   char label_string[6];        /* Text of label. */
  963.   int labi;            /* Length of label text. */
  964.   bool just_do_label;        /* Nothing but label (and continuation?) on
  965.                    line. */
  966.  
  967.   /* Lex is called for a particular file, not for a particular program unit.
  968.      Yet the two events do share common characteristics.  The first line in a
  969.      file or in a program unit cannot be a continuation line.  No token can
  970.      be in mid-formation.  No current label for the statement exists, since
  971.      there is no current statement. */
  972.  
  973.   assert (ffelex_handler_ != NULL);
  974.  
  975. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  976.   lineno = 0;
  977.   input_filename = ffewhere_file_name (wf);
  978. #endif
  979.   ffelex_current_wf_ = wf;
  980.   disallow_continuation_line = TRUE;
  981.   ignore_disallowed_continuation = FALSE;
  982.   ffelex_token_->type = FFELEX_typeNONE;
  983.   ffelex_number_of_tokens_ = 0;
  984.   ffelex_label_tokens_ = 0;
  985.   ffelex_current_wl_ = ffewhere_line_unknown ();
  986.   ffelex_current_wc_ = ffewhere_column_unknown ();
  987.   latest_char_in_file = '\n';
  988.   goto first_line;        /* :::::::::::::::::::: */
  989.  
  990.   /* Come here to get a new line. */
  991.  
  992. beginning_of_line:        /* :::::::::::::::::::: */
  993.  
  994.   disallow_continuation_line = FALSE;
  995.  
  996.   /* Come here directly when last line didn't clarify the continuation issue. */
  997.  
  998. beginning_of_line_again:    /* :::::::::::::::::::: */
  999.  
  1000. #ifdef REDUCE_CARD_SIZE_AFTER_BIGGY    /* Define if occasional large lines. */
  1001.   if (ffelex_card_size_ != FFELEX_columnINITIAL_SIZE_)
  1002.     {
  1003.       ffelex_card_image_
  1004.     = malloc_resize_ks (malloc_pool_image (),
  1005.                 ffelex_card_image_,
  1006.                 FFELEX_columnINITIAL_SIZE_ + 9,
  1007.                 ffelex_card_size_ + 9);
  1008.       ffelex_card_size_ = FFELEX_columnINITIAL_SIZE_;
  1009.     }
  1010. #endif
  1011.  
  1012.  first_line:            /* :::::::::::::::::::: */
  1013.  
  1014.   c = latest_char_in_file;
  1015.   if ((c == EOF) || ((c = getc (f)) == EOF))
  1016.     {
  1017.  
  1018.     end_of_file:        /* :::::::::::::::::::: */
  1019.  
  1020.       ffelex_finish_statement_ ();
  1021.       if (!ffewhere_line_is_unknown (ffelex_current_wl_))
  1022.     ffewhere_line_kill (ffelex_current_wl_);
  1023.       if (!ffewhere_column_is_unknown (ffelex_current_wc_))
  1024.     ffewhere_column_kill (ffelex_current_wc_);
  1025.       return (ffelexHandler) ffelex_handler_;
  1026.       /* Line ending in EOF instead of \n still counts as a whole line. */
  1027.     }
  1028.  
  1029.   ffelex_linecount_current_ = ffelex_linecount_next_;
  1030.   ++ffelex_linecount_next_;
  1031. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  1032.   ++lineno;
  1033. #endif
  1034.  
  1035.   ffelex_bad_line_ = FALSE;
  1036.  
  1037.   /* Skip over comment (and otherwise ignored) lines as quickly as possible! */
  1038.  
  1039.   while (((lextype = ffelex_first_char_[c]) == FFELEX_typeCOMMENT)
  1040.      || (lextype == FFELEX_typeERROR)
  1041.      || (lextype == FFELEX_typeSLASH))
  1042.     {
  1043.       if (lextype == FFELEX_typeERROR)
  1044.     {            /* Bad first character, get line and display
  1045.                    it with message. */
  1046.       column = ffelex_image_char_ (c, 0);
  1047.  
  1048.     bad_first_character:    /* :::::::::::::::::::: */
  1049.  
  1050.       ffelex_bad_line_ = TRUE;
  1051.       while (((c = getc (f)) != '\n') && (c != EOF))
  1052.         column = ffelex_image_char_ (c, column);
  1053.       ffelex_card_image_[column] = '\0';
  1054.       ffelex_card_length_ = column;
  1055.       ffelex_bad_1_ (FFEBAD_FIRST_CHAR_INVALID,
  1056.              ffelex_linecount_current_, 1);
  1057.     }
  1058.       else if ((lextype == FFELEX_typeSLASH) && ((c = getc (f)) != '*'))
  1059.     {
  1060.       ffelex_card_image_[0] = '/';
  1061.       ffelex_card_image_[1] = c;
  1062.       column = 2;
  1063.       goto bad_first_character;    /* :::::::::::::::::::: */
  1064.     }
  1065.       else
  1066.     {
  1067.       /* Typical case (straight comment), just ignore rest of line. */
  1068.      comment_line:        /* :::::::::::::::::::: */
  1069.  
  1070.       while ((c != '\n') && (c != EOF))
  1071.         c = getc (f);
  1072.     }
  1073.  
  1074.       /* Read past last char in line.  */
  1075.  
  1076.       if (c == EOF)
  1077.     {
  1078.       ffelex_linecount_current_ = ffelex_linecount_next_;
  1079.       ++ffelex_linecount_next_;
  1080. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  1081.       ++lineno;
  1082. #endif
  1083.  
  1084.       ffelex_finish_statement_ ();
  1085.       ffewhere_line_kill (ffelex_current_wl_);
  1086.       ffewhere_column_kill (ffelex_current_wc_);
  1087.       return (ffelexHandler) ffelex_handler_;
  1088.     }
  1089.  
  1090.       c = getc (f);
  1091.  
  1092.       ffelex_linecount_current_ = ffelex_linecount_next_;
  1093.       ++ffelex_linecount_next_;
  1094. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  1095.       ++lineno;
  1096. #endif
  1097.  
  1098.       if (c == EOF)
  1099.     goto end_of_file;    /* :::::::::::::::::::: */
  1100.  
  1101.       ffelex_bad_line_ = FALSE;
  1102.     }                /* while [c, first char, means comment] */
  1103.  
  1104.   ffelex_saw_tab_
  1105.     = (c == '&')
  1106.       || (ffelex_final_nontab_column_ == 0);
  1107.  
  1108.   if (lextype == FFELEX_typeDEBUG)
  1109.     c = ' ';            /* A 'D' or 'd' in column 1 with the
  1110.                    debug-lines option on. */
  1111.  
  1112.   column = ffelex_image_char_ (c, 0);
  1113.  
  1114.   /* Read the entire line in as is (with whitespace processing).  */
  1115.  
  1116.   while (((c = getc (f)) != '\n') && (c != EOF))
  1117.     column = ffelex_image_char_ (c, column);
  1118.  
  1119.   if (ffelex_bad_line_)
  1120.     goto comment_line;        /* :::::::::::::::::::: */
  1121.  
  1122.   /* If no tab, cut off line after column 72/132.  */
  1123.  
  1124.   if (!ffelex_saw_tab_ && (column > ffelex_final_nontab_column_))
  1125.     {
  1126.       /* Technically, we should now fill ffelex_card_image_ up thru column
  1127.          72/132 with spaces, since character/hollerith constants must count
  1128.          them in that manner. To save CPU time in several ways (avoid a loop
  1129.          here that would be used only when we actually end a line in
  1130.          character-constant mode; avoid writing memory unnecessarily; avoid a
  1131.          loop later checking spaces when not scanning for character-constant
  1132.          characters), we don't do this, and we do the appropriate thing when
  1133.          we encounter end-of-line while actually processing a character
  1134.          constant. */
  1135.  
  1136.       column = ffelex_final_nontab_column_;
  1137.     }
  1138.   ffelex_card_image_[column] = '\0';
  1139.   ffelex_card_length_ = column;
  1140.  
  1141.   /* Save next char in file so we can use register-based c while analyzing
  1142.      line we just read. */
  1143.  
  1144.   latest_char_in_file = c;    /* Should be either '\n' or EOF. */
  1145.  
  1146.   /* Handle label, if any. */
  1147.  
  1148.   labi = 0;
  1149.   first_label_char = FFEWHERE_columnUNKNOWN;
  1150.   for (column = 0; column < 5; ++column)
  1151.     {
  1152.       switch (c = ffelex_card_image_[column])
  1153.     {
  1154.     case '\0':
  1155.     case '!':
  1156.       goto stop_looking;    /* :::::::::::::::::::: */
  1157.  
  1158.     case ' ':
  1159.       break;
  1160.  
  1161.     case '0':
  1162.     case '1':
  1163.     case '2':
  1164.     case '3':
  1165.     case '4':
  1166.     case '5':
  1167.     case '6':
  1168.     case '7':
  1169.     case '8':
  1170.     case '9':
  1171.       label_string[labi++] = c;
  1172.       if (first_label_char == FFEWHERE_columnUNKNOWN)
  1173.         first_label_char = column + 1;
  1174.       break;
  1175.  
  1176.     case '&':
  1177.       if (column != 0)
  1178.         {
  1179.           ffelex_bad_1_ (FFEBAD_LABEL_FIELD_NOT_NUMERIC,
  1180.                  ffelex_linecount_current_,
  1181.                  column + 1);
  1182.           goto beginning_of_line_again;    /* :::::::::::::::::::: */
  1183.         }
  1184.       if (ffe_is_pedantic ())
  1185.         ffelex_bad_1_ (FFEBAD_AMPERSAND,
  1186.                ffelex_linecount_current_, 1);
  1187.       just_do_label = FALSE;
  1188.       goto got_a_continuation;    /* :::::::::::::::::::: */
  1189.  
  1190.     case '/':
  1191.       if (ffelex_card_image_[column + 1] == '*')
  1192.         goto stop_looking;    /* :::::::::::::::::::: */
  1193.       /* Fall through. */
  1194.     default:
  1195.       ffelex_bad_1_ (FFEBAD_LABEL_FIELD_NOT_NUMERIC,
  1196.              ffelex_linecount_current_, column + 1);
  1197.       goto beginning_of_line_again;    /* :::::::::::::::::::: */
  1198.     }
  1199.     }
  1200.  
  1201. stop_looking:            /* :::::::::::::::::::: */
  1202.  
  1203.   label_string[labi] = '\0';
  1204.  
  1205.   /* Find first nonblank char starting with continuation column. */
  1206.  
  1207.   if (column == 5)        /* In which case we didn't see end of line in
  1208.                    label field. */
  1209.     while ((c = ffelex_card_image_[column]) == ' ')
  1210.       ++column;
  1211.  
  1212.   /* Now we're trying to figure out whether this is a continuation line and
  1213.      whether there's anything else of substance on the line.  The cases are
  1214.      as follows:
  1215.  
  1216.      1. If a line has an explicit continuation character (other than the digit
  1217.      zero), then if it also has a label, the label is ignored and an error
  1218.      message is printed.  Any remaining text on the line is passed to the
  1219.      parser tasks, thus even an all-blank line (possibly with an ignored
  1220.      label) aside from a positive continuation character might have meaning
  1221.      in the midst of a character or hollerith constant.
  1222.  
  1223.      2. If a line has no explicit continuation character (a space in column 6
  1224.      and first non-blank character past column 6 is not a digit 0-9), then
  1225.      there are two possibilities:
  1226.  
  1227.      A. A label is present and/or a non-blank (and non-comment) character
  1228.      appears somewhere after column 6.    Terminate processing of the previous
  1229.      statement, if any, send the new label for the next statement, if any,
  1230.      and start processing a new statement with this non-blank character, if
  1231.      any.
  1232.  
  1233.      B. The line is essentially blank, except for a possible comment character.
  1234.      Don't terminate processing of the previous statement and don't pass any
  1235.      characters to the parser tasks, since the line is not flagged as a
  1236.      continuation line.     We treat it just like a completely blank line.
  1237.  
  1238.      3. If a line has a continuation character of zero (0), then we terminate
  1239.      processing of the previous statement, if any, send the new label for the
  1240.      next statement, if any, and start processing a new statement, if any
  1241.      non-blank characters are present.
  1242.  
  1243.      If, when checking to see if we should terminate the previous statement, it
  1244.      is found that there is no previous statement but that there is an
  1245.      outstanding label, substitute CONTINUE as the statement for the label
  1246.      and display an error message. */
  1247.  
  1248.   just_do_label = FALSE;
  1249.   switch (c)
  1250.     {
  1251.     case '!':            /* ANSI Fortran 90 says ! in column 6 is
  1252.                    continuation. */
  1253.       /* VXT Fortran says ! anywhere is comment, even column 6. */
  1254.       if (ffe_is_vxt_not_90 () || (column != 5))
  1255.     goto no_tokens_on_line;    /* :::::::::::::::::::: */
  1256.       goto got_a_continuation;    /* :::::::::::::::::::: */
  1257.  
  1258.     case '/':
  1259.       if (ffelex_card_image_[column + 1] != '*')
  1260.     goto some_other_character;    /* :::::::::::::::::::: */
  1261.       /* Fall through. */
  1262.       if (column == 5)
  1263.     goto got_a_continuation;/* :::::::::::::::::::: */
  1264.       /* This seems right to do. But it is close to call, since / * starting
  1265.          in column 6 will thus be interpreted as a continuation line
  1266.          beginning with '*'. */
  1267.       /* Fall through. */
  1268.     case '\0':
  1269.       /* End of line.  Therefore may be continued-through line, so handle
  1270.          pending label as possible to-be-continued and drive end-of-statement
  1271.          for any previous statement, else treat as blank line. */
  1272.  
  1273.     no_tokens_on_line:        /* :::::::::::::::::::: */
  1274.  
  1275.       if (first_label_char != FFEWHERE_columnUNKNOWN)
  1276.     {            /* Can't be a continued-through line if it
  1277.                    has a label. */
  1278.       ffelex_finish_statement_ ();
  1279.       if (ffe_is_pedantic () && (c == '/'))
  1280.         ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT,
  1281.                ffelex_linecount_current_, column + 1);
  1282.       just_do_label = TRUE;
  1283.       break;
  1284.     }
  1285.       if (ffe_is_pedantic () && (c == '/'))
  1286.     ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT,
  1287.                ffelex_linecount_current_, column + 1);
  1288.       goto beginning_of_line_again;    /* :::::::::::::::::::: */
  1289.  
  1290.     case '0':
  1291.       ffelex_finish_statement_ ();
  1292.       if (ffe_is_pedantic () && (column != 5))
  1293.     ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN,
  1294.                ffelex_linecount_current_, column + 1);
  1295.       while ((c = ffelex_card_image_[++column]) == ' ')
  1296.     ;
  1297.       if ((c == '\0')
  1298.       || (c == '!')
  1299.       || ((c == '/')
  1300.           && (ffelex_card_image_[column + 1] == '*')))
  1301.     {
  1302.       if (ffe_is_pedantic () && (c == '/'))
  1303.         ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT,
  1304.                ffelex_linecount_current_, column + 1);
  1305.       just_do_label = TRUE;
  1306.     }
  1307.       break;
  1308.  
  1309.     case '1':
  1310.     case '2':
  1311.     case '3':
  1312.     case '4':
  1313.     case '5':
  1314.     case '6':
  1315.     case '7':
  1316.     case '8':
  1317.     case '9':
  1318.       if (first_label_char != FFEWHERE_columnUNKNOWN)
  1319.     {
  1320.       ffelex_bad_2_ (FFEBAD_LABEL_ON_CONTINUATION,
  1321.              ffelex_linecount_current_,
  1322.              first_label_char,
  1323.              ffelex_linecount_current_,
  1324.              column + 1);
  1325.       first_label_char = FFEWHERE_columnUNKNOWN;
  1326.     }
  1327.       if (disallow_continuation_line)
  1328.     {
  1329.       if (!ignore_disallowed_continuation)
  1330.         ffelex_bad_1_ (FFEBAD_INVALID_CONTINUATION,
  1331.                ffelex_linecount_current_, column + 1);
  1332.       goto beginning_of_line_again;    /* :::::::::::::::::::: */
  1333.     }
  1334.       if (ffe_is_pedantic () && (column != 5))
  1335.     ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN,
  1336.                ffelex_linecount_current_, column + 1);
  1337.       if ((ffelex_raw_mode_ != 0)
  1338.       && (((c = ffelex_card_image_[column + 1]) != '\0')
  1339.           || !ffelex_saw_tab_))
  1340.     {
  1341.       ++column;
  1342.       break;
  1343.     }
  1344.       while ((c = ffelex_card_image_[++column]) == ' ')
  1345.     ;
  1346.       if ((c == '\0')
  1347.       || (c == '!')
  1348.       || ((c == '/')
  1349.           && (ffelex_card_image_[column + 1] == '*')))
  1350.     {
  1351.       if (ffe_is_pedantic () && (c == '/'))
  1352.         ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT,
  1353.                ffelex_linecount_current_, column + 1);
  1354.       just_do_label = TRUE;
  1355.     }
  1356.       break;
  1357.  
  1358.     default:
  1359.  
  1360.     some_other_character:    /* :::::::::::::::::::: */
  1361.  
  1362.       if (column == 5)
  1363.     {
  1364.  
  1365.     got_a_continuation:    /* :::::::::::::::::::: */
  1366.  
  1367.       if (first_label_char != FFEWHERE_columnUNKNOWN)
  1368.         {
  1369.           ffelex_bad_2_ (FFEBAD_LABEL_ON_CONTINUATION,
  1370.                  ffelex_linecount_current_,
  1371.                  first_label_char,
  1372.                  ffelex_linecount_current_,
  1373.                  column + 1);
  1374.           first_label_char = FFEWHERE_columnUNKNOWN;
  1375.         }
  1376.       if (disallow_continuation_line)
  1377.         {
  1378.           if (!ignore_disallowed_continuation)
  1379.         ffelex_bad_1_ (FFEBAD_INVALID_CONTINUATION,
  1380.                    ffelex_linecount_current_, column + 1);
  1381.           goto beginning_of_line;    /* :::::::::::::::::::: */
  1382.         }
  1383.       if ((ffelex_raw_mode_ != 0)
  1384.           && (((c = ffelex_card_image_[column + 1]) != '\0')
  1385.           || !ffelex_saw_tab_))
  1386.         {
  1387.           ++column;
  1388.           break;
  1389.         }
  1390.       while ((c = ffelex_card_image_[++column]) == ' ')
  1391.         ;
  1392.       if ((c == '\0')
  1393.           || (c == '!')
  1394.           || ((c == '/')
  1395.           && (ffelex_card_image_[column + 1] == '*')))
  1396.         {
  1397.           if (ffe_is_pedantic () && (c == '/'))
  1398.         ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT,
  1399.                    ffelex_linecount_current_, column + 1);
  1400.           just_do_label = TRUE;
  1401.         }
  1402.       break;
  1403.     }
  1404.  
  1405.       /* Here is the very normal case of a regular character starting in
  1406.          column 7 or beyond with a blank in column 6. */
  1407.  
  1408.       ffelex_finish_statement_ ();
  1409.       break;
  1410.     }
  1411.  
  1412.   /* If label is present, enclose it in a NUMBER token and send it along. */
  1413.  
  1414.   if (first_label_char != FFEWHERE_columnUNKNOWN)
  1415.     {
  1416.       assert (ffelex_token_->type == FFELEX_typeNONE);
  1417.       ffelex_token_->type = FFELEX_typeNUMBER;
  1418.       ffelex_append_to_token_ ('\0');    /* Make room for label text. */
  1419.       strcpy (ffelex_token_->text, label_string);
  1420.       ffelex_token_->where_line
  1421.     = ffewhere_line_new (ffelex_linecount_current_);
  1422.       ffelex_token_->where_col = ffewhere_column_new (first_label_char);
  1423.       ffelex_token_->length = labi;
  1424.       ffelex_send_token_ ();
  1425.       ++ffelex_label_tokens_;
  1426.     }
  1427.  
  1428.   /* The line definitely has content of some kind, install new end-statement
  1429.      point for error messages. */
  1430.  
  1431.   ffewhere_line_kill (ffelex_current_wl_);
  1432.   ffewhere_column_kill (ffelex_current_wc_);
  1433.   ffelex_current_wl_ = ffewhere_line_new (ffelex_linecount_current_);
  1434.   ffelex_current_wc_ = ffewhere_column_new (ffelex_card_length_ + 1);
  1435.  
  1436.   if (just_do_label)
  1437.     goto beginning_of_line;    /* :::::::::::::::::::: */
  1438.  
  1439.   /* Here is the main engine for parsing.  c holds the character at column.
  1440.      It is already known that c is not a blank, end of line, or shriek,
  1441.      unless ffelex_raw_mode_ is not 0 (indicating we are in a
  1442.      character/hollerith constant). A partially filled token may already
  1443.      exist in ffelex_token_.  One special case: if, when the end of the line
  1444.      is reached, continuation_line is FALSE and the only token on the line is
  1445.      END, then it is indeed the last statement. We don't look for
  1446.      continuation lines during this program unit in that case. This is
  1447.      according to ANSI. */
  1448.  
  1449.   if (ffelex_raw_mode_ != 0)
  1450.     {
  1451.  
  1452.     parse_raw_character:    /* :::::::::::::::::::: */
  1453.  
  1454.       if (c == '\0')
  1455.     {
  1456.       ffewhereColumnNumber i;
  1457.  
  1458.       if (ffelex_saw_tab_ || (column >= ffelex_final_nontab_column_))
  1459.         goto beginning_of_line;    /* :::::::::::::::::::: */
  1460.  
  1461.       /* Pad out line with "virtual" spaces. */
  1462.  
  1463.       for (i = column; i < ffelex_final_nontab_column_; ++i)
  1464.         ffelex_card_image_[i] = ' ';
  1465.       ffelex_card_image_[i] = '\0';
  1466.       ffelex_card_length_ = i;
  1467.       c = ' ';
  1468.     }
  1469.  
  1470.       switch (ffelex_raw_mode_)
  1471.     {
  1472.     case -3:
  1473.       c = ffelex_backslash_ (c, column);
  1474.       if (c == EOF)
  1475.         break;
  1476.  
  1477.       if (!ffelex_backslash_reconsider_)
  1478.         ffelex_append_to_token_ (c);
  1479.       ffelex_raw_mode_ = -1;
  1480.       break;
  1481.  
  1482.     case -2:
  1483.       if (c == ffelex_raw_char_)
  1484.         {
  1485.           ffelex_raw_mode_ = -1;
  1486.           ffelex_append_to_token_ (c);
  1487.         }
  1488.       else
  1489.         {
  1490.           ffelex_raw_mode_ = 0;
  1491.           ffelex_backslash_reconsider_ = TRUE;
  1492.         }
  1493.       break;
  1494.  
  1495.     case -1:
  1496.       if (c == ffelex_raw_char_)
  1497.         ffelex_raw_mode_ = -2;
  1498.       else
  1499.         {
  1500.           c = ffelex_backslash_ (c, column);
  1501.           if (c == EOF)
  1502.         {
  1503.           ffelex_raw_mode_ = -3;
  1504.           break;
  1505.         }
  1506.  
  1507.           ffelex_append_to_token_ (c);
  1508.         }
  1509.       break;
  1510.  
  1511.     default:
  1512.       c = ffelex_backslash_ (c, column);
  1513.       if (c == EOF)
  1514.         break;
  1515.  
  1516.       if (!ffelex_backslash_reconsider_)
  1517.         {
  1518.           ffelex_append_to_token_ (c);
  1519.           --ffelex_raw_mode_;
  1520.         }
  1521.       break;
  1522.     }
  1523.  
  1524.       if (ffelex_backslash_reconsider_)
  1525.     ffelex_backslash_reconsider_ = FALSE;
  1526.       else
  1527.     c = ffelex_card_image_[++column];
  1528.  
  1529.       if (ffelex_raw_mode_ == 0)
  1530.     {
  1531.       ffelex_send_token_ ();
  1532.       assert (ffelex_raw_mode_ == 0);
  1533.       while (c == ' ')
  1534.         c = ffelex_card_image_[++column];
  1535.       if ((c == '\0')
  1536.           || (c == '!')
  1537.           || ((c == '/')
  1538.           && (ffelex_card_image_[column + 1] == '*')))
  1539.         goto beginning_of_line;    /* :::::::::::::::::::: */
  1540.       goto parse_nonraw_character;    /* :::::::::::::::::::: */
  1541.     }
  1542.       goto parse_raw_character;    /* :::::::::::::::::::: */
  1543.     }
  1544.  
  1545. parse_nonraw_character:    /* :::::::::::::::::::: */
  1546.  
  1547.   switch (ffelex_token_->type)
  1548.     {
  1549.     case FFELEX_typeNONE:
  1550.       switch (c)
  1551.     {
  1552.     case '\"':
  1553.       ffelex_token_->type = FFELEX_typeQUOTE;
  1554.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1555.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1556.       ffelex_send_token_ ();
  1557.       break;
  1558.  
  1559.     case '$':
  1560.       ffelex_token_->type = FFELEX_typeDOLLAR;
  1561.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1562.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1563.       ffelex_send_token_ ();
  1564.       break;
  1565.  
  1566.     case '%':
  1567.       ffelex_token_->type = FFELEX_typePERCENT;
  1568.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1569.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1570.       ffelex_send_token_ ();
  1571.       break;
  1572.  
  1573.     case '&':
  1574.       ffelex_token_->type = FFELEX_typeAMPERSAND;
  1575.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1576.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1577.       ffelex_send_token_ ();
  1578.       break;
  1579.  
  1580.     case '\'':
  1581.       ffelex_token_->type = FFELEX_typeAPOSTROPHE;
  1582.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1583.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1584.       ffelex_send_token_ ();
  1585.       break;
  1586.  
  1587.     case '(':
  1588.       ffelex_token_->type = FFELEX_typeOPEN_PAREN;
  1589.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1590.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1591.       break;
  1592.  
  1593.     case ')':
  1594.       ffelex_token_->type = FFELEX_typeCLOSE_PAREN;
  1595.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1596.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1597.       ffelex_send_token_ ();
  1598.       break;
  1599.  
  1600.     case '*':
  1601.       ffelex_token_->type = FFELEX_typeASTERISK;
  1602.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1603.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1604.       break;
  1605.  
  1606.     case '+':
  1607.       ffelex_token_->type = FFELEX_typePLUS;
  1608.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1609.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1610.       ffelex_send_token_ ();
  1611.       break;
  1612.  
  1613.     case ',':
  1614.       ffelex_token_->type = FFELEX_typeCOMMA;
  1615.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1616.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1617.       ffelex_send_token_ ();
  1618.       break;
  1619.  
  1620.     case '-':
  1621.       ffelex_token_->type = FFELEX_typeMINUS;
  1622.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1623.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1624.       ffelex_send_token_ ();
  1625.       break;
  1626.  
  1627.     case '.':
  1628.       ffelex_token_->type = FFELEX_typePERIOD;
  1629.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1630.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1631.       ffelex_send_token_ ();
  1632.       break;
  1633.  
  1634.     case '/':
  1635.       ffelex_token_->type = FFELEX_typeSLASH;
  1636.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1637.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1638.       break;
  1639.  
  1640.     case '0':
  1641.     case '1':
  1642.     case '2':
  1643.     case '3':
  1644.     case '4':
  1645.     case '5':
  1646.     case '6':
  1647.     case '7':
  1648.     case '8':
  1649.     case '9':
  1650.       ffelex_token_->type
  1651.         = ffelex_hexnum_ ? FFELEX_typeNAME : FFELEX_typeNUMBER;
  1652.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1653.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1654.       ffelex_append_to_token_ (c);
  1655.       break;
  1656.  
  1657.     case ':':
  1658.       ffelex_token_->type = FFELEX_typeCOLON;
  1659.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1660.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1661.       break;
  1662.  
  1663.     case ';':
  1664.       ffelex_token_->type = FFELEX_typeSEMICOLON;
  1665.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1666.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1667.       ffelex_permit_include_ = TRUE;
  1668.       ffelex_send_token_ ();
  1669.       ffelex_permit_include_ = FALSE;
  1670.       break;
  1671.  
  1672.     case '<':
  1673.       ffelex_token_->type = FFELEX_typeOPEN_ANGLE;
  1674.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1675.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1676.       break;
  1677.  
  1678.     case '=':
  1679.       ffelex_token_->type = FFELEX_typeEQUALS;
  1680.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1681.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1682.       break;
  1683.  
  1684.     case '>':
  1685.       ffelex_token_->type = FFELEX_typeCLOSE_ANGLE;
  1686.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1687.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1688.       break;
  1689.  
  1690.     case '?':
  1691.       ffelex_token_->type = FFELEX_typeQUESTION;
  1692.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  1693.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1694.       ffelex_send_token_ ();
  1695.       break;
  1696.  
  1697.     case '_':
  1698.       if (ffe_is_90 ())
  1699.         {
  1700.           ffelex_token_->type = FFELEX_typeUNDERSCORE;
  1701.           ffelex_token_->where_line
  1702.         = ffewhere_line_use (ffelex_current_wl_);
  1703.           ffelex_token_->where_col
  1704.         = ffewhere_column_new (column + 1);
  1705.           ffelex_send_token_ ();
  1706.           break;
  1707.         }
  1708.       /* Fall through. */
  1709.     case 'A':
  1710.     case 'B':
  1711.     case 'C':
  1712.     case 'D':
  1713.     case 'E':
  1714.     case 'F':
  1715.     case 'G':
  1716.     case 'H':
  1717.     case 'I':
  1718.     case 'J':
  1719.     case 'K':
  1720.     case 'L':
  1721.     case 'M':
  1722.     case 'N':
  1723.     case 'O':
  1724.     case 'P':
  1725.     case 'Q':
  1726.     case 'R':
  1727.     case 'S':
  1728.     case 'T':
  1729.     case 'U':
  1730.     case 'V':
  1731.     case 'W':
  1732.     case 'X':
  1733.     case 'Y':
  1734.     case 'Z':
  1735.     case 'a':
  1736.     case 'b':
  1737.     case 'c':
  1738.     case 'd':
  1739.     case 'e':
  1740.     case 'f':
  1741.     case 'g':
  1742.     case 'h':
  1743.     case 'i':
  1744.     case 'j':
  1745.     case 'k':
  1746.     case 'l':
  1747.     case 'm':
  1748.     case 'n':
  1749.     case 'o':
  1750.     case 'p':
  1751.     case 'q':
  1752.     case 'r':
  1753.     case 's':
  1754.     case 't':
  1755.     case 'u':
  1756.     case 'v':
  1757.     case 'w':
  1758.     case 'x':
  1759.     case 'y':
  1760.     case 'z':
  1761.       c = ffesrc_char_source (c);
  1762.  
  1763.       if (ffesrc_char_match_init (c, 'H', 'h')
  1764.           && ffelex_expecting_hollerith_ != 0)
  1765.         {
  1766.           ffelex_raw_mode_ = ffelex_expecting_hollerith_;
  1767.           ffelex_token_->type = FFELEX_typeHOLLERITH;
  1768.           ffelex_token_->where_line = ffelex_raw_where_line_;
  1769.           ffelex_token_->where_col = ffelex_raw_where_col_;
  1770.           ffelex_raw_where_line_ = ffewhere_line_unknown ();
  1771.           ffelex_raw_where_col_ = ffewhere_column_unknown ();
  1772.           c = ffelex_card_image_[++column];
  1773.           goto parse_raw_character;    /* :::::::::::::::::::: */
  1774.         }
  1775.  
  1776.       if (ffelex_names_)
  1777.         {
  1778.           ffelex_token_->where_line
  1779.         = ffewhere_line_use (ffelex_token_->currentnames_line
  1780.                      = ffewhere_line_use (ffelex_current_wl_));
  1781.           ffelex_token_->where_col
  1782.         = ffewhere_column_use (ffelex_token_->currentnames_col
  1783.                        = ffewhere_column_new (column + 1));
  1784.           ffelex_token_->type = FFELEX_typeNAMES;
  1785.         }
  1786.       else
  1787.         {
  1788.           ffelex_token_->where_line
  1789.         = ffewhere_line_use (ffelex_current_wl_);
  1790.           ffelex_token_->where_col = ffewhere_column_new (column + 1);
  1791.           ffelex_token_->type = FFELEX_typeNAME;
  1792.         }
  1793.       ffelex_append_to_token_ (c);
  1794.       break;
  1795.  
  1796.     default:
  1797.       ffelex_bad_1_ (FFEBAD_UNRECOGNIZED_CHARACTER,
  1798.              ffelex_linecount_current_, column + 1);
  1799.       ffelex_finish_statement_ ();
  1800.       disallow_continuation_line = TRUE;
  1801.       ignore_disallowed_continuation = TRUE;
  1802.       goto beginning_of_line_again;    /* :::::::::::::::::::: */
  1803.     }
  1804.       break;
  1805.  
  1806.     case FFELEX_typeNAME:
  1807.       switch (c)
  1808.     {
  1809.     case 'A':
  1810.     case 'B':
  1811.     case 'C':
  1812.     case 'D':
  1813.     case 'E':
  1814.     case 'F':
  1815.     case 'G':
  1816.     case 'H':
  1817.     case 'I':
  1818.     case 'J':
  1819.     case 'K':
  1820.     case 'L':
  1821.     case 'M':
  1822.     case 'N':
  1823.     case 'O':
  1824.     case 'P':
  1825.     case 'Q':
  1826.     case 'R':
  1827.     case 'S':
  1828.     case 'T':
  1829.     case 'U':
  1830.     case 'V':
  1831.     case 'W':
  1832.     case 'X':
  1833.     case 'Y':
  1834.     case 'Z':
  1835.     case 'a':
  1836.     case 'b':
  1837.     case 'c':
  1838.     case 'd':
  1839.     case 'e':
  1840.     case 'f':
  1841.     case 'g':
  1842.     case 'h':
  1843.     case 'i':
  1844.     case 'j':
  1845.     case 'k':
  1846.     case 'l':
  1847.     case 'm':
  1848.     case 'n':
  1849.     case 'o':
  1850.     case 'p':
  1851.     case 'q':
  1852.     case 'r':
  1853.     case 's':
  1854.     case 't':
  1855.     case 'u':
  1856.     case 'v':
  1857.     case 'w':
  1858.     case 'x':
  1859.     case 'y':
  1860.     case 'z':
  1861.       c = ffesrc_char_source (c);
  1862.       /* Fall through.  */
  1863.     case '0':
  1864.     case '1':
  1865.     case '2':
  1866.     case '3':
  1867.     case '4':
  1868.     case '5':
  1869.     case '6':
  1870.     case '7':
  1871.     case '8':
  1872.     case '9':
  1873.     case '_':
  1874.     case '$':
  1875.       if ((c == '$')
  1876.           && !ffe_is_dollar_ok ())
  1877.         {
  1878.           ffelex_send_token_ ();
  1879.           goto parse_next_character;    /* :::::::::::::::::::: */
  1880.         }
  1881.       ffelex_append_to_token_ (c);
  1882.       break;
  1883.  
  1884.     default:
  1885.       ffelex_send_token_ ();
  1886.       goto parse_next_character;    /* :::::::::::::::::::: */
  1887.     }
  1888.       break;
  1889.  
  1890.     case FFELEX_typeNAMES:
  1891.       switch (c)
  1892.     {
  1893.     case 'A':
  1894.     case 'B':
  1895.     case 'C':
  1896.     case 'D':
  1897.     case 'E':
  1898.     case 'F':
  1899.     case 'G':
  1900.     case 'H':
  1901.     case 'I':
  1902.     case 'J':
  1903.     case 'K':
  1904.     case 'L':
  1905.     case 'M':
  1906.     case 'N':
  1907.     case 'O':
  1908.     case 'P':
  1909.     case 'Q':
  1910.     case 'R':
  1911.     case 'S':
  1912.     case 'T':
  1913.     case 'U':
  1914.     case 'V':
  1915.     case 'W':
  1916.     case 'X':
  1917.     case 'Y':
  1918.     case 'Z':
  1919.     case 'a':
  1920.     case 'b':
  1921.     case 'c':
  1922.     case 'd':
  1923.     case 'e':
  1924.     case 'f':
  1925.     case 'g':
  1926.     case 'h':
  1927.     case 'i':
  1928.     case 'j':
  1929.     case 'k':
  1930.     case 'l':
  1931.     case 'm':
  1932.     case 'n':
  1933.     case 'o':
  1934.     case 'p':
  1935.     case 'q':
  1936.     case 'r':
  1937.     case 's':
  1938.     case 't':
  1939.     case 'u':
  1940.     case 'v':
  1941.     case 'w':
  1942.     case 'x':
  1943.     case 'y':
  1944.     case 'z':
  1945.       c = ffesrc_char_source (c);
  1946.       /* Fall through.  */
  1947.     case '0':
  1948.     case '1':
  1949.     case '2':
  1950.     case '3':
  1951.     case '4':
  1952.     case '5':
  1953.     case '6':
  1954.     case '7':
  1955.     case '8':
  1956.     case '9':
  1957.     case '_':
  1958.     case '$':
  1959.       if ((c == '$')
  1960.           && !ffe_is_dollar_ok ())
  1961.         {
  1962.           ffelex_send_token_ ();
  1963.           goto parse_next_character;    /* :::::::::::::::::::: */
  1964.         }
  1965.       if (ffelex_token_->length < FFEWHERE_indexMAX)
  1966.         {
  1967.           ffewhere_track (&ffelex_token_->currentnames_line,
  1968.                   &ffelex_token_->currentnames_col,
  1969.                   ffelex_token_->wheretrack,
  1970.                   ffelex_token_->length,
  1971.                   ffelex_linecount_current_,
  1972.                   column + 1);
  1973.         }
  1974.       ffelex_append_to_token_ (c);
  1975.       break;
  1976.  
  1977.     default:
  1978.       ffelex_send_token_ ();
  1979.       goto parse_next_character;    /* :::::::::::::::::::: */
  1980.     }
  1981.       break;
  1982.  
  1983.     case FFELEX_typeNUMBER:
  1984.       switch (c)
  1985.     {
  1986.     case '0':
  1987.     case '1':
  1988.     case '2':
  1989.     case '3':
  1990.     case '4':
  1991.     case '5':
  1992.     case '6':
  1993.     case '7':
  1994.     case '8':
  1995.     case '9':
  1996.       ffelex_append_to_token_ (c);
  1997.       break;
  1998.  
  1999.     default:
  2000.       ffelex_send_token_ ();
  2001.       goto parse_next_character;    /* :::::::::::::::::::: */
  2002.     }
  2003.       break;
  2004.  
  2005.     case FFELEX_typeASTERISK:
  2006.       switch (c)
  2007.     {
  2008.     case '*':        /* ** */
  2009.       ffelex_token_->type = FFELEX_typePOWER;
  2010.       ffelex_send_token_ ();
  2011.       break;
  2012.  
  2013.     default:        /* * not followed by another *. */
  2014.       ffelex_send_token_ ();
  2015.       goto parse_next_character;    /* :::::::::::::::::::: */
  2016.     }
  2017.       break;
  2018.  
  2019.     case FFELEX_typeCOLON:
  2020.       switch (c)
  2021.     {
  2022.     case ':':        /* :: */
  2023.       ffelex_token_->type = FFELEX_typeCOLONCOLON;
  2024.       ffelex_send_token_ ();
  2025.       break;
  2026.  
  2027.     default:        /* : not followed by another :. */
  2028.       ffelex_send_token_ ();
  2029.       goto parse_next_character;    /* :::::::::::::::::::: */
  2030.     }
  2031.       break;
  2032.  
  2033.     case FFELEX_typeSLASH:
  2034.       switch (c)
  2035.     {
  2036.     case '/':        /* // */
  2037.       ffelex_token_->type = FFELEX_typeCONCAT;
  2038.       ffelex_send_token_ ();
  2039.       break;
  2040.  
  2041.     case ')':        /* /) */
  2042.       ffelex_token_->type = FFELEX_typeCLOSE_ARRAY;
  2043.       ffelex_send_token_ ();
  2044.       break;
  2045.  
  2046.     case '=':        /* /= */
  2047.       ffelex_token_->type = FFELEX_typeREL_NE;
  2048.       ffelex_send_token_ ();
  2049.       break;
  2050.  
  2051.     default:
  2052.       ffelex_send_token_ ();
  2053.       goto parse_next_character;    /* :::::::::::::::::::: */
  2054.     }
  2055.       break;
  2056.  
  2057.     case FFELEX_typeOPEN_PAREN:
  2058.       switch (c)
  2059.     {
  2060.     case '/':        /* (/ */
  2061.       ffelex_token_->type = FFELEX_typeOPEN_ARRAY;
  2062.       ffelex_send_token_ ();
  2063.       break;
  2064.  
  2065.     default:
  2066.       ffelex_send_token_ ();
  2067.       goto parse_next_character;    /* :::::::::::::::::::: */
  2068.     }
  2069.       break;
  2070.  
  2071.     case FFELEX_typeOPEN_ANGLE:
  2072.       switch (c)
  2073.     {
  2074.     case '=':        /* <= */
  2075.       ffelex_token_->type = FFELEX_typeREL_LE;
  2076.       ffelex_send_token_ ();
  2077.       break;
  2078.  
  2079.     default:
  2080.       ffelex_send_token_ ();
  2081.       goto parse_next_character;    /* :::::::::::::::::::: */
  2082.     }
  2083.       break;
  2084.  
  2085.     case FFELEX_typeEQUALS:
  2086.       switch (c)
  2087.     {
  2088.     case '=':        /* == */
  2089.       ffelex_token_->type = FFELEX_typeREL_EQ;
  2090.       ffelex_send_token_ ();
  2091.       break;
  2092.  
  2093.     case '>':        /* => */
  2094.       ffelex_token_->type = FFELEX_typePOINTS;
  2095.       ffelex_send_token_ ();
  2096.       break;
  2097.  
  2098.     default:
  2099.       ffelex_send_token_ ();
  2100.       goto parse_next_character;    /* :::::::::::::::::::: */
  2101.     }
  2102.       break;
  2103.  
  2104.     case FFELEX_typeCLOSE_ANGLE:
  2105.       switch (c)
  2106.     {
  2107.     case '=':        /* >= */
  2108.       ffelex_token_->type = FFELEX_typeREL_GE;
  2109.       ffelex_send_token_ ();
  2110.       break;
  2111.  
  2112.     default:
  2113.       ffelex_send_token_ ();
  2114.       goto parse_next_character;    /* :::::::::::::::::::: */
  2115.     }
  2116.       break;
  2117.  
  2118.     default:
  2119.       assert ("Serious error!!" == NULL);
  2120.       abort ();
  2121.       break;
  2122.     }
  2123.  
  2124.   c = ffelex_card_image_[++column];
  2125.  
  2126. parse_next_character:        /* :::::::::::::::::::: */
  2127.  
  2128.   if (ffelex_raw_mode_ != 0)
  2129.     goto parse_raw_character;    /* :::::::::::::::::::: */
  2130.  
  2131.   while (c == ' ')
  2132.     c = ffelex_card_image_[++column];
  2133.  
  2134.   if ((c == '\0')
  2135.       || (c == '!')
  2136.       || ((c == '/')
  2137.       && (ffelex_card_image_[column + 1] == '*')))
  2138.     {
  2139.       if ((ffelex_number_of_tokens_ == ffelex_label_tokens_)
  2140.       && (ffelex_token_->type == FFELEX_typeNAMES)
  2141.       && (ffelex_token_->length == 3)
  2142.       && (ffesrc_strncmp_2c (ffe_case_match (),
  2143.                  ffelex_token_->text,
  2144.                  "END", "end", "End",
  2145.                  3)
  2146.        == 0))
  2147.     {
  2148.       ffelex_finish_statement_ ();
  2149.       disallow_continuation_line = TRUE;
  2150.       ignore_disallowed_continuation = FALSE;
  2151.       goto beginning_of_line_again;    /* :::::::::::::::::::: */
  2152.     }
  2153.       goto beginning_of_line;    /* :::::::::::::::::::: */
  2154.     }
  2155.   goto parse_nonraw_character;    /* :::::::::::::::::::: */
  2156. }
  2157.  
  2158. /* ffelex_file_free -- Lex a given file in free source form
  2159.  
  2160.    ffewhere wf;
  2161.    FILE *f;
  2162.    ffelex_file_free(wf,f);
  2163.  
  2164.    Lexes the file according to Fortran 90 ANSI + VXT specifications.  */
  2165.  
  2166. ffelexHandler
  2167. ffelex_file_free (ffewhereFile wf, FILE *f)
  2168. {
  2169.   register int c;        /* Character currently under consideration. */
  2170.   register ffewhereColumnNumber column;    /* Not really; 0 means column 1... */
  2171.   bool continuation_line;
  2172.   ffewhereColumnNumber continuation_column;
  2173.   int latest_char_in_file;    /* For getting back into comment-skipping
  2174.                    code. */
  2175.  
  2176.   /* Lex is called for a particular file, not for a particular program unit.
  2177.      Yet the two events do share common characteristics.  The first line in a
  2178.      file or in a program unit cannot be a continuation line.  No token can
  2179.      be in mid-formation.  No current label for the statement exists, since
  2180.      there is no current statement. */
  2181.  
  2182.   assert (ffelex_handler_ != NULL);
  2183.  
  2184. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  2185.   lineno = 0;
  2186.   input_filename = ffewhere_file_name (wf);
  2187. #endif
  2188.   ffelex_current_wf_ = wf;
  2189.   continuation_line = FALSE;
  2190.   ffelex_token_->type = FFELEX_typeNONE;
  2191.   ffelex_number_of_tokens_ = 0;
  2192.   ffelex_current_wl_ = ffewhere_line_unknown ();
  2193.   ffelex_current_wc_ = ffewhere_column_unknown ();
  2194.   latest_char_in_file = '\n';
  2195.  
  2196.   /* Come here to get a new line. */
  2197.  
  2198. beginning_of_line:        /* :::::::::::::::::::: */
  2199.  
  2200.   c = latest_char_in_file;
  2201.   if ((c == EOF) || ((c = getc (f)) == EOF))
  2202.     {
  2203.  
  2204.      end_of_file:        /* :::::::::::::::::::: */
  2205.  
  2206.       ffelex_finish_statement_ ();
  2207.       if (!ffewhere_line_is_unknown (ffelex_current_wl_))
  2208.     ffewhere_line_kill (ffelex_current_wl_);
  2209.       if (!ffewhere_column_is_unknown (ffelex_current_wc_))
  2210.     ffewhere_column_kill (ffelex_current_wc_);
  2211.       return (ffelexHandler) ffelex_handler_;
  2212.       /* Line ending in EOF instead of \n still counts as a whole line. */
  2213.     }
  2214.  
  2215.   ffelex_linecount_current_ = ffelex_linecount_next_;
  2216.   ++ffelex_linecount_next_;
  2217. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  2218.   ++lineno;
  2219. #endif
  2220.  
  2221.   ffelex_bad_line_ = FALSE;
  2222.  
  2223.   /* Skip over initial-comment and empty lines as quickly as possible! */
  2224.  
  2225.   while ((c == '\n') || (c == '!'))
  2226.     {
  2227.      comment_line:        /* :::::::::::::::::::: */
  2228.  
  2229.       while ((c != '\n') && (c != EOF))
  2230.     c = getc (f);
  2231.  
  2232.       if (c == EOF)
  2233.     {
  2234.       ffelex_linecount_current_ = ffelex_linecount_next_;
  2235.       ++ffelex_linecount_next_;
  2236. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  2237.       ++lineno;
  2238. #endif
  2239.  
  2240.       ffelex_finish_statement_ ();
  2241.       ffewhere_line_kill (ffelex_current_wl_);
  2242.       ffewhere_column_kill (ffelex_current_wc_);
  2243.       return (ffelexHandler) ffelex_handler_;
  2244.     }
  2245.  
  2246.       c = getc (f);
  2247.  
  2248.       ffelex_linecount_current_ = ffelex_linecount_next_;
  2249.       ++ffelex_linecount_next_;
  2250. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  2251.       ++lineno;
  2252. #endif
  2253.  
  2254.       if (c == EOF)
  2255.     goto end_of_file;    /* :::::::::::::::::::: */
  2256.     }
  2257.  
  2258.   ffelex_saw_tab_ = FALSE;
  2259.  
  2260.   column = ffelex_image_char_ (c, 0);
  2261.  
  2262.   /* Read the entire line in as is (with whitespace processing).  */
  2263.  
  2264.   while (((c = getc (f)) != '\n') && (c != EOF))
  2265.     column = ffelex_image_char_ (c, column);
  2266.  
  2267.   if (ffelex_bad_line_)
  2268.     goto comment_line;        /* :::::::::::::::::::: */
  2269.  
  2270.   /* If no tab, cut off line after column 132.  */
  2271.  
  2272.   if (!ffelex_saw_tab_ && (column > FFELEX_FREE_MAX_COLUMNS_))
  2273.     column = FFELEX_FREE_MAX_COLUMNS_;
  2274.  
  2275.   ffelex_card_image_[column] = '\0';
  2276.   ffelex_card_length_ = column;
  2277.  
  2278.   /* Save next char in file so we can use register-based c while analyzing
  2279.      line we just read. */
  2280.  
  2281.   latest_char_in_file = c;    /* Should be either '\n' or EOF. */
  2282.  
  2283.   column = 0;
  2284.   continuation_column = 0;
  2285.  
  2286.   /* Skip over initial spaces to see if the first nonblank character
  2287.      is exclamation point, newline, or EOF (line is therefore a comment) or
  2288.      ampersand (line is therefore a continuation line). */
  2289.  
  2290.   while ((c = ffelex_card_image_[column]) == ' ')
  2291.     ++column;
  2292.  
  2293.   switch (c)
  2294.     {
  2295.     case '!':
  2296.     case '\0':
  2297.       goto beginning_of_line;    /* :::::::::::::::::::: */
  2298.  
  2299.     case '&':
  2300.       continuation_column = column + 1;
  2301.       /* Fall through. */
  2302.     default:
  2303.       break;
  2304.     }
  2305.  
  2306.   /* The line definitely has content of some kind, install new end-statement
  2307.      point for error messages. */
  2308.  
  2309.   ffewhere_line_kill (ffelex_current_wl_);
  2310.   ffewhere_column_kill (ffelex_current_wc_);
  2311.   ffelex_current_wl_ = ffewhere_line_new (ffelex_linecount_current_);
  2312.   ffelex_current_wc_ = ffewhere_column_new (ffelex_card_length_ + 1);
  2313.  
  2314.   /* Figure out which column to start parsing at. */
  2315.  
  2316.   if (continuation_line)
  2317.     {
  2318.       if (continuation_column == 0)
  2319.     {
  2320.       if (ffelex_raw_mode_ != 0)
  2321.         {
  2322.           ffelex_bad_1_ (FFEBAD_BAD_CHAR_CONTINUE,
  2323.                  ffelex_linecount_current_, column + 1);
  2324.         }
  2325.       else if (ffelex_token_->type != FFELEX_typeNONE)
  2326.         {
  2327.           ffelex_bad_1_ (FFEBAD_BAD_LEXTOK_CONTINUE,
  2328.                  ffelex_linecount_current_, column + 1);
  2329.         }
  2330.     }
  2331.       else if (ffelex_is_free_char_ctx_contin_ (continuation_column))
  2332.     {            /* Line contains only a single "&" as only
  2333.                    nonblank character. */
  2334.       ffelex_bad_1_ (FFEBAD_BAD_FREE_CONTINUE,
  2335.              ffelex_linecount_current_, continuation_column);
  2336.       goto beginning_of_line;    /* :::::::::::::::::::: */
  2337.     }
  2338.       column = continuation_column;
  2339.     }
  2340.   else
  2341.     column = 0;
  2342.  
  2343.   c = ffelex_card_image_[column];
  2344.   continuation_line = FALSE;
  2345.  
  2346.   /* Here is the main engine for parsing.  c holds the character at column.
  2347.      It is already known that c is not a blank, end of line, or shriek,
  2348.      unless ffelex_raw_mode_ is not 0 (indicating we are in a
  2349.      character/hollerith constant).  A partially filled token may already
  2350.      exist in ffelex_token_. */
  2351.  
  2352.   if (ffelex_raw_mode_ != 0)
  2353.     {
  2354.  
  2355.     parse_raw_character:    /* :::::::::::::::::::: */
  2356.  
  2357.       switch (c)
  2358.     {
  2359.     case '&':
  2360.       if (ffelex_is_free_char_ctx_contin_ (column + 1))
  2361.         {
  2362.           continuation_line = TRUE;
  2363.           goto beginning_of_line;    /* :::::::::::::::::::: */
  2364.         }
  2365.       break;
  2366.  
  2367.     case '\0':
  2368.       ffelex_finish_statement_ ();
  2369.       goto beginning_of_line;    /* :::::::::::::::::::: */
  2370.  
  2371.     default:
  2372.       break;
  2373.     }
  2374.  
  2375.       switch (ffelex_raw_mode_)
  2376.     {
  2377.     case -3:
  2378.       c = ffelex_backslash_ (c, column);
  2379.       if (c == EOF)
  2380.         break;
  2381.  
  2382.       if (!ffelex_backslash_reconsider_)
  2383.         ffelex_append_to_token_ (c);
  2384.       ffelex_raw_mode_ = -1;
  2385.       break;
  2386.  
  2387.     case -2:
  2388.       if (c == ffelex_raw_char_)
  2389.         {
  2390.           ffelex_raw_mode_ = -1;
  2391.           ffelex_append_to_token_ (c);
  2392.         }
  2393.       else
  2394.         {
  2395.           ffelex_raw_mode_ = 0;
  2396.           ffelex_backslash_reconsider_ = TRUE;
  2397.         }
  2398.       break;
  2399.  
  2400.     case -1:
  2401.       if (c == ffelex_raw_char_)
  2402.         ffelex_raw_mode_ = -2;
  2403.       else
  2404.         {
  2405.           c = ffelex_backslash_ (c, column);
  2406.           if (c == EOF)
  2407.         {
  2408.           ffelex_raw_mode_ = -3;
  2409.           break;
  2410.         }
  2411.  
  2412.           ffelex_append_to_token_ (c);
  2413.         }
  2414.       break;
  2415.  
  2416.     default:
  2417.       c = ffelex_backslash_ (c, column);
  2418.       if (c == EOF)
  2419.         break;
  2420.  
  2421.       if (!ffelex_backslash_reconsider_)
  2422.         {
  2423.           ffelex_append_to_token_ (c);
  2424.           --ffelex_raw_mode_;
  2425.         }
  2426.       break;
  2427.     }
  2428.  
  2429.       if (ffelex_backslash_reconsider_)
  2430.     ffelex_backslash_reconsider_ = FALSE;
  2431.       else
  2432.     c = ffelex_card_image_[++column];
  2433.  
  2434.       if (ffelex_raw_mode_ == 0)
  2435.     {
  2436.       ffelex_send_token_ ();
  2437.       assert (ffelex_raw_mode_ == 0);
  2438.       while (c == ' ')
  2439.         c = ffelex_card_image_[++column];
  2440.       if ((c == '\0') || (c == '!'))
  2441.         {
  2442.           ffelex_finish_statement_ ();
  2443.           goto beginning_of_line;    /* :::::::::::::::::::: */
  2444.         }
  2445.       if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
  2446.         {
  2447.           continuation_line = TRUE;
  2448.           goto beginning_of_line;    /* :::::::::::::::::::: */
  2449.         }
  2450.       goto parse_nonraw_character_noncontin;    /* :::::::::::::::::::: */
  2451.     }
  2452.       goto parse_raw_character;    /* :::::::::::::::::::: */
  2453.     }
  2454.  
  2455. parse_nonraw_character:    /* :::::::::::::::::::: */
  2456.  
  2457.   if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
  2458.     {
  2459.       continuation_line = TRUE;
  2460.       goto beginning_of_line;    /* :::::::::::::::::::: */
  2461.     }
  2462.  
  2463. parse_nonraw_character_noncontin:    /* :::::::::::::::::::: */
  2464.  
  2465.   switch (ffelex_token_->type)
  2466.     {
  2467.     case FFELEX_typeNONE:
  2468.       if (c == ' ')
  2469.     {            /* Otherwise
  2470.                    finish-statement/continue-statement
  2471.                    already checked. */
  2472.       while (c == ' ')
  2473.         c = ffelex_card_image_[++column];
  2474.       if ((c == '\0') || (c == '!'))
  2475.         {
  2476.           ffelex_finish_statement_ ();
  2477.           goto beginning_of_line;    /* :::::::::::::::::::: */
  2478.         }
  2479.       if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
  2480.         {
  2481.           continuation_line = TRUE;
  2482.           goto beginning_of_line;    /* :::::::::::::::::::: */
  2483.         }
  2484.     }
  2485.  
  2486.       switch (c)
  2487.     {
  2488.     case '\"':
  2489.       ffelex_token_->type = FFELEX_typeQUOTE;
  2490.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2491.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2492.       ffelex_send_token_ ();
  2493.       break;
  2494.  
  2495.     case '$':
  2496.       ffelex_token_->type = FFELEX_typeDOLLAR;
  2497.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2498.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2499.       ffelex_send_token_ ();
  2500.       break;
  2501.  
  2502.     case '%':
  2503.       ffelex_token_->type = FFELEX_typePERCENT;
  2504.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2505.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2506.       ffelex_send_token_ ();
  2507.       break;
  2508.  
  2509.     case '&':
  2510.       ffelex_token_->type = FFELEX_typeAMPERSAND;
  2511.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2512.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2513.       ffelex_send_token_ ();
  2514.       break;
  2515.  
  2516.     case '\'':
  2517.       ffelex_token_->type = FFELEX_typeAPOSTROPHE;
  2518.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2519.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2520.       ffelex_send_token_ ();
  2521.       break;
  2522.  
  2523.     case '(':
  2524.       ffelex_token_->type = FFELEX_typeOPEN_PAREN;
  2525.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2526.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2527.       break;
  2528.  
  2529.     case ')':
  2530.       ffelex_token_->type = FFELEX_typeCLOSE_PAREN;
  2531.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2532.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2533.       ffelex_send_token_ ();
  2534.       break;
  2535.  
  2536.     case '*':
  2537.       ffelex_token_->type = FFELEX_typeASTERISK;
  2538.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2539.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2540.       break;
  2541.  
  2542.     case '+':
  2543.       ffelex_token_->type = FFELEX_typePLUS;
  2544.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2545.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2546.       ffelex_send_token_ ();
  2547.       break;
  2548.  
  2549.     case ',':
  2550.       ffelex_token_->type = FFELEX_typeCOMMA;
  2551.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2552.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2553.       ffelex_send_token_ ();
  2554.       break;
  2555.  
  2556.     case '-':
  2557.       ffelex_token_->type = FFELEX_typeMINUS;
  2558.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2559.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2560.       ffelex_send_token_ ();
  2561.       break;
  2562.  
  2563.     case '.':
  2564.       ffelex_token_->type = FFELEX_typePERIOD;
  2565.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2566.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2567.       ffelex_send_token_ ();
  2568.       break;
  2569.  
  2570.     case '/':
  2571.       ffelex_token_->type = FFELEX_typeSLASH;
  2572.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2573.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2574.       break;
  2575.  
  2576.     case '0':
  2577.     case '1':
  2578.     case '2':
  2579.     case '3':
  2580.     case '4':
  2581.     case '5':
  2582.     case '6':
  2583.     case '7':
  2584.     case '8':
  2585.     case '9':
  2586.       ffelex_token_->type
  2587.         = ffelex_hexnum_ ? FFELEX_typeNAME : FFELEX_typeNUMBER;
  2588.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2589.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2590.       ffelex_append_to_token_ (c);
  2591.       break;
  2592.  
  2593.     case ':':
  2594.       ffelex_token_->type = FFELEX_typeCOLON;
  2595.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2596.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2597.       break;
  2598.  
  2599.     case ';':
  2600.       ffelex_token_->type = FFELEX_typeSEMICOLON;
  2601.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2602.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2603.       ffelex_permit_include_ = TRUE;
  2604.       ffelex_send_token_ ();
  2605.       ffelex_permit_include_ = FALSE;
  2606.       break;
  2607.  
  2608.     case '<':
  2609.       ffelex_token_->type = FFELEX_typeOPEN_ANGLE;
  2610.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2611.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2612.       break;
  2613.  
  2614.     case '=':
  2615.       ffelex_token_->type = FFELEX_typeEQUALS;
  2616.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2617.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2618.       break;
  2619.  
  2620.     case '>':
  2621.       ffelex_token_->type = FFELEX_typeCLOSE_ANGLE;
  2622.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2623.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2624.       break;
  2625.  
  2626.     case '?':
  2627.       ffelex_token_->type = FFELEX_typeQUESTION;
  2628.       ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
  2629.       ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2630.       ffelex_send_token_ ();
  2631.       break;
  2632.  
  2633.     case '_':
  2634.       if (ffe_is_90 ())
  2635.         {
  2636.           ffelex_token_->type = FFELEX_typeUNDERSCORE;
  2637.           ffelex_token_->where_line
  2638.         = ffewhere_line_use (ffelex_current_wl_);
  2639.           ffelex_token_->where_col
  2640.         = ffewhere_column_new (column + 1);
  2641.           ffelex_send_token_ ();
  2642.           break;
  2643.         }
  2644.       /* Fall through. */
  2645.     case 'A':
  2646.     case 'B':
  2647.     case 'C':
  2648.     case 'D':
  2649.     case 'E':
  2650.     case 'F':
  2651.     case 'G':
  2652.     case 'H':
  2653.     case 'I':
  2654.     case 'J':
  2655.     case 'K':
  2656.     case 'L':
  2657.     case 'M':
  2658.     case 'N':
  2659.     case 'O':
  2660.     case 'P':
  2661.     case 'Q':
  2662.     case 'R':
  2663.     case 'S':
  2664.     case 'T':
  2665.     case 'U':
  2666.     case 'V':
  2667.     case 'W':
  2668.     case 'X':
  2669.     case 'Y':
  2670.     case 'Z':
  2671.     case 'a':
  2672.     case 'b':
  2673.     case 'c':
  2674.     case 'd':
  2675.     case 'e':
  2676.     case 'f':
  2677.     case 'g':
  2678.     case 'h':
  2679.     case 'i':
  2680.     case 'j':
  2681.     case 'k':
  2682.     case 'l':
  2683.     case 'm':
  2684.     case 'n':
  2685.     case 'o':
  2686.     case 'p':
  2687.     case 'q':
  2688.     case 'r':
  2689.     case 's':
  2690.     case 't':
  2691.     case 'u':
  2692.     case 'v':
  2693.     case 'w':
  2694.     case 'x':
  2695.     case 'y':
  2696.     case 'z':
  2697.       c = ffesrc_char_source (c);
  2698.  
  2699.       if (ffesrc_char_match_init (c, 'H', 'h')
  2700.           && ffelex_expecting_hollerith_ != 0)
  2701.         {
  2702.           ffelex_raw_mode_ = ffelex_expecting_hollerith_;
  2703.           ffelex_token_->type = FFELEX_typeHOLLERITH;
  2704.           ffelex_token_->where_line = ffelex_raw_where_line_;
  2705.           ffelex_token_->where_col = ffelex_raw_where_col_;
  2706.           ffelex_raw_where_line_ = ffewhere_line_unknown ();
  2707.           ffelex_raw_where_col_ = ffewhere_column_unknown ();
  2708.           c = ffelex_card_image_[++column];
  2709.           goto parse_raw_character;    /* :::::::::::::::::::: */
  2710.         }
  2711.  
  2712.       if (ffelex_names_pure_)
  2713.         {
  2714.           ffelex_token_->where_line
  2715.         = ffewhere_line_use (ffelex_token_->currentnames_line
  2716.                      = ffewhere_line_use (ffelex_current_wl_));
  2717.           ffelex_token_->where_col
  2718.         = ffewhere_column_use (ffelex_token_->currentnames_col
  2719.                        = ffewhere_column_new (column + 1));
  2720.           ffelex_token_->type = FFELEX_typeNAMES;
  2721.         }
  2722.       else
  2723.         {
  2724.           ffelex_token_->where_line
  2725.         = ffewhere_line_use (ffelex_current_wl_);
  2726.           ffelex_token_->where_col = ffewhere_column_new (column + 1);
  2727.           ffelex_token_->type = FFELEX_typeNAME;
  2728.         }
  2729.       ffelex_append_to_token_ (c);
  2730.       break;
  2731.  
  2732.     default:
  2733.       ffelex_bad_1_ (FFEBAD_UNRECOGNIZED_CHARACTER,
  2734.              ffelex_linecount_current_, column + 1);
  2735.       ffelex_finish_statement_ ();
  2736.       goto beginning_of_line;    /* :::::::::::::::::::: */
  2737.     }
  2738.       break;
  2739.  
  2740.     case FFELEX_typeNAME:
  2741.       switch (c)
  2742.     {
  2743.     case 'A':
  2744.     case 'B':
  2745.     case 'C':
  2746.     case 'D':
  2747.     case 'E':
  2748.     case 'F':
  2749.     case 'G':
  2750.     case 'H':
  2751.     case 'I':
  2752.     case 'J':
  2753.     case 'K':
  2754.     case 'L':
  2755.     case 'M':
  2756.     case 'N':
  2757.     case 'O':
  2758.     case 'P':
  2759.     case 'Q':
  2760.     case 'R':
  2761.     case 'S':
  2762.     case 'T':
  2763.     case 'U':
  2764.     case 'V':
  2765.     case 'W':
  2766.     case 'X':
  2767.     case 'Y':
  2768.     case 'Z':
  2769.     case 'a':
  2770.     case 'b':
  2771.     case 'c':
  2772.     case 'd':
  2773.     case 'e':
  2774.     case 'f':
  2775.     case 'g':
  2776.     case 'h':
  2777.     case 'i':
  2778.     case 'j':
  2779.     case 'k':
  2780.     case 'l':
  2781.     case 'm':
  2782.     case 'n':
  2783.     case 'o':
  2784.     case 'p':
  2785.     case 'q':
  2786.     case 'r':
  2787.     case 's':
  2788.     case 't':
  2789.     case 'u':
  2790.     case 'v':
  2791.     case 'w':
  2792.     case 'x':
  2793.     case 'y':
  2794.     case 'z':
  2795.       c = ffesrc_char_source (c);
  2796.       /* Fall through.  */
  2797.     case '0':
  2798.     case '1':
  2799.     case '2':
  2800.     case '3':
  2801.     case '4':
  2802.     case '5':
  2803.     case '6':
  2804.     case '7':
  2805.     case '8':
  2806.     case '9':
  2807.     case '_':
  2808.     case '$':
  2809.       if ((c == '$')
  2810.           && !ffe_is_dollar_ok ())
  2811.         {
  2812.           ffelex_send_token_ ();
  2813.           goto parse_next_character;    /* :::::::::::::::::::: */
  2814.         }
  2815.       ffelex_append_to_token_ (c);
  2816.       break;
  2817.  
  2818.     default:
  2819.       ffelex_send_token_ ();
  2820.       goto parse_next_character;    /* :::::::::::::::::::: */
  2821.     }
  2822.       break;
  2823.  
  2824.     case FFELEX_typeNAMES:
  2825.       switch (c)
  2826.     {
  2827.     case 'A':
  2828.     case 'B':
  2829.     case 'C':
  2830.     case 'D':
  2831.     case 'E':
  2832.     case 'F':
  2833.     case 'G':
  2834.     case 'H':
  2835.     case 'I':
  2836.     case 'J':
  2837.     case 'K':
  2838.     case 'L':
  2839.     case 'M':
  2840.     case 'N':
  2841.     case 'O':
  2842.     case 'P':
  2843.     case 'Q':
  2844.     case 'R':
  2845.     case 'S':
  2846.     case 'T':
  2847.     case 'U':
  2848.     case 'V':
  2849.     case 'W':
  2850.     case 'X':
  2851.     case 'Y':
  2852.     case 'Z':
  2853.     case 'a':
  2854.     case 'b':
  2855.     case 'c':
  2856.     case 'd':
  2857.     case 'e':
  2858.     case 'f':
  2859.     case 'g':
  2860.     case 'h':
  2861.     case 'i':
  2862.     case 'j':
  2863.     case 'k':
  2864.     case 'l':
  2865.     case 'm':
  2866.     case 'n':
  2867.     case 'o':
  2868.     case 'p':
  2869.     case 'q':
  2870.     case 'r':
  2871.     case 's':
  2872.     case 't':
  2873.     case 'u':
  2874.     case 'v':
  2875.     case 'w':
  2876.     case 'x':
  2877.     case 'y':
  2878.     case 'z':
  2879.       c = ffesrc_char_source (c);
  2880.       /* Fall through.  */
  2881.     case '0':
  2882.     case '1':
  2883.     case '2':
  2884.     case '3':
  2885.     case '4':
  2886.     case '5':
  2887.     case '6':
  2888.     case '7':
  2889.     case '8':
  2890.     case '9':
  2891.     case '_':
  2892.     case '$':
  2893.       if ((c == '$')
  2894.           && !ffe_is_dollar_ok ())
  2895.         {
  2896.           ffelex_send_token_ ();
  2897.           goto parse_next_character;    /* :::::::::::::::::::: */
  2898.         }
  2899.       if (ffelex_token_->length < FFEWHERE_indexMAX)
  2900.         {
  2901.           ffewhere_track (&ffelex_token_->currentnames_line,
  2902.                   &ffelex_token_->currentnames_col,
  2903.                   ffelex_token_->wheretrack,
  2904.                   ffelex_token_->length,
  2905.                   ffelex_linecount_current_,
  2906.                   column + 1);
  2907.         }
  2908.       ffelex_append_to_token_ (c);
  2909.       break;
  2910.  
  2911.     default:
  2912.       ffelex_send_token_ ();
  2913.       goto parse_next_character;    /* :::::::::::::::::::: */
  2914.     }
  2915.       break;
  2916.  
  2917.     case FFELEX_typeNUMBER:
  2918.       switch (c)
  2919.     {
  2920.     case '0':
  2921.     case '1':
  2922.     case '2':
  2923.     case '3':
  2924.     case '4':
  2925.     case '5':
  2926.     case '6':
  2927.     case '7':
  2928.     case '8':
  2929.     case '9':
  2930.       ffelex_append_to_token_ (c);
  2931.       break;
  2932.  
  2933.     default:
  2934.       ffelex_send_token_ ();
  2935.       goto parse_next_character;    /* :::::::::::::::::::: */
  2936.     }
  2937.       break;
  2938.  
  2939.     case FFELEX_typeASTERISK:
  2940.       switch (c)
  2941.     {
  2942.     case '*':        /* ** */
  2943.       ffelex_token_->type = FFELEX_typePOWER;
  2944.       ffelex_send_token_ ();
  2945.       break;
  2946.  
  2947.     default:        /* * not followed by another *. */
  2948.       ffelex_send_token_ ();
  2949.       goto parse_next_character;    /* :::::::::::::::::::: */
  2950.     }
  2951.       break;
  2952.  
  2953.     case FFELEX_typeCOLON:
  2954.       switch (c)
  2955.     {
  2956.     case ':':        /* :: */
  2957.       ffelex_token_->type = FFELEX_typeCOLONCOLON;
  2958.       ffelex_send_token_ ();
  2959.       break;
  2960.  
  2961.     default:        /* : not followed by another :. */
  2962.       ffelex_send_token_ ();
  2963.       goto parse_next_character;    /* :::::::::::::::::::: */
  2964.     }
  2965.       break;
  2966.  
  2967.     case FFELEX_typeSLASH:
  2968.       switch (c)
  2969.     {
  2970.     case '/':        /* // */
  2971.       ffelex_token_->type = FFELEX_typeCONCAT;
  2972.       ffelex_send_token_ ();
  2973.       break;
  2974.  
  2975.     case ')':        /* /) */
  2976.       ffelex_token_->type = FFELEX_typeCLOSE_ARRAY;
  2977.       ffelex_send_token_ ();
  2978.       break;
  2979.  
  2980.     case '=':        /* /= */
  2981.       ffelex_token_->type = FFELEX_typeREL_NE;
  2982.       ffelex_send_token_ ();
  2983.       break;
  2984.  
  2985.     default:
  2986.       ffelex_send_token_ ();
  2987.       goto parse_next_character;    /* :::::::::::::::::::: */
  2988.     }
  2989.       break;
  2990.  
  2991.     case FFELEX_typeOPEN_PAREN:
  2992.       switch (c)
  2993.     {
  2994.     case '/':        /* (/ */
  2995.       ffelex_token_->type = FFELEX_typeOPEN_ARRAY;
  2996.       ffelex_send_token_ ();
  2997.       break;
  2998.  
  2999.     default:
  3000.       ffelex_send_token_ ();
  3001.       goto parse_next_character;    /* :::::::::::::::::::: */
  3002.     }
  3003.       break;
  3004.  
  3005.     case FFELEX_typeOPEN_ANGLE:
  3006.       switch (c)
  3007.     {
  3008.     case '=':        /* <= */
  3009.       ffelex_token_->type = FFELEX_typeREL_LE;
  3010.       ffelex_send_token_ ();
  3011.       break;
  3012.  
  3013.     default:
  3014.       ffelex_send_token_ ();
  3015.       goto parse_next_character;    /* :::::::::::::::::::: */
  3016.     }
  3017.       break;
  3018.  
  3019.     case FFELEX_typeEQUALS:
  3020.       switch (c)
  3021.     {
  3022.     case '=':        /* == */
  3023.       ffelex_token_->type = FFELEX_typeREL_EQ;
  3024.       ffelex_send_token_ ();
  3025.       break;
  3026.  
  3027.     case '>':        /* => */
  3028.       ffelex_token_->type = FFELEX_typePOINTS;
  3029.       ffelex_send_token_ ();
  3030.       break;
  3031.  
  3032.     default:
  3033.       ffelex_send_token_ ();
  3034.       goto parse_next_character;    /* :::::::::::::::::::: */
  3035.     }
  3036.       break;
  3037.  
  3038.     case FFELEX_typeCLOSE_ANGLE:
  3039.       switch (c)
  3040.     {
  3041.     case '=':        /* >= */
  3042.       ffelex_token_->type = FFELEX_typeREL_GE;
  3043.       ffelex_send_token_ ();
  3044.       break;
  3045.  
  3046.     default:
  3047.       ffelex_send_token_ ();
  3048.       goto parse_next_character;    /* :::::::::::::::::::: */
  3049.     }
  3050.       break;
  3051.  
  3052.     default:
  3053.       assert ("Serious error!" == NULL);
  3054.       abort ();
  3055.       break;
  3056.     }
  3057.  
  3058.   c = ffelex_card_image_[++column];
  3059.  
  3060. parse_next_character:        /* :::::::::::::::::::: */
  3061.  
  3062.   if (ffelex_raw_mode_ != 0)
  3063.     goto parse_raw_character;    /* :::::::::::::::::::: */
  3064.  
  3065.   if ((c == '\0') || (c == '!'))
  3066.     {
  3067.       ffelex_finish_statement_ ();
  3068.       goto beginning_of_line;    /* :::::::::::::::::::: */
  3069.     }
  3070.   goto parse_nonraw_character;    /* :::::::::::::::::::: */
  3071. }
  3072.  
  3073. void
  3074. ffelex_init_1 ()
  3075. {
  3076.   unsigned int i;
  3077.  
  3078.   ffelex_final_nontab_column_ = ffe_fixed_line_length ();
  3079.   ffelex_card_size_ = FFELEX_columnINITIAL_SIZE_;
  3080.   ffelex_card_image_ = malloc_new_ksr (malloc_pool_image (),
  3081.                        "FFELEX card image",
  3082.                        FFELEX_columnINITIAL_SIZE_ + 9);
  3083.   ffelex_card_image_[0] = '\0';
  3084.  
  3085.   for (i = 0; i < 256; ++i)
  3086.     ffelex_first_char_[i] = FFELEX_typeERROR;
  3087.  
  3088.   ffelex_first_char_['\t'] = FFELEX_typeRAW;
  3089.   ffelex_first_char_['\n'] = FFELEX_typeCOMMENT;
  3090.   ffelex_first_char_['\v'] = FFELEX_typeCOMMENT;
  3091.   ffelex_first_char_['\f'] = FFELEX_typeCOMMENT;
  3092.   ffelex_first_char_['\r'] = FFELEX_typeRAW;
  3093.   ffelex_first_char_[' '] = FFELEX_typeRAW;
  3094.   ffelex_first_char_['!'] = FFELEX_typeCOMMENT;
  3095.   ffelex_first_char_['*'] = FFELEX_typeCOMMENT;
  3096.   ffelex_first_char_['/'] = FFELEX_typeSLASH;
  3097.   ffelex_first_char_['&'] = FFELEX_typeRAW;
  3098.  
  3099.   for (i = '0'; i <= '9'; ++i)
  3100.     ffelex_first_char_[i] = FFELEX_typeRAW;
  3101.  
  3102.   if ((ffe_case_match () == FFE_caseNONE)
  3103.       || ((ffe_case_match () == FFE_caseUPPER)
  3104.       && (ffe_case_source () != FFE_caseLOWER))    /* Idiot!  :-) */
  3105.       || ((ffe_case_match () == FFE_caseLOWER)
  3106.       && (ffe_case_source () == FFE_caseLOWER)))
  3107.     {
  3108.       ffelex_first_char_['C'] = FFELEX_typeCOMMENT;
  3109.       ffelex_first_char_['D'] = FFELEX_typeCOMMENT;
  3110.     }
  3111.   if ((ffe_case_match () == FFE_caseNONE)
  3112.       || ((ffe_case_match () == FFE_caseLOWER)
  3113.       && (ffe_case_source () != FFE_caseUPPER))    /* Idiot!  :-) */
  3114.       || ((ffe_case_match () == FFE_caseUPPER)
  3115.       && (ffe_case_source () == FFE_caseUPPER)))
  3116.     {
  3117.       ffelex_first_char_['c'] = FFELEX_typeCOMMENT;
  3118.       ffelex_first_char_['d'] = FFELEX_typeCOMMENT;
  3119.     }
  3120.  
  3121.   ffelex_linecount_current_ = 0;
  3122.   ffelex_linecount_next_ = 1;
  3123.   ffelex_raw_mode_ = 0;
  3124.   ffelex_set_include_ = FALSE;
  3125.   ffelex_permit_include_ = FALSE;
  3126.   ffelex_names_ = TRUE;        /* First token in program is a names. */
  3127.   ffelex_names_pure_ = FALSE;    /* Free-form lexer does NAMES only for
  3128.                    FORMAT. */
  3129.   ffelex_hexnum_ = FALSE;
  3130.   ffelex_expecting_hollerith_ = 0;
  3131.   ffelex_raw_where_line_ = ffewhere_line_unknown ();
  3132.   ffelex_raw_where_col_ = ffewhere_column_unknown ();
  3133.  
  3134.   ffelex_token_ = ffelex_token_new_ ();
  3135.   ffelex_token_->type = FFELEX_typeNONE;
  3136.   ffelex_token_->uses = 1;
  3137.   ffelex_token_->where_line = ffewhere_line_unknown ();
  3138.   ffelex_token_->where_col = ffewhere_column_unknown ();
  3139.   ffelex_token_->text = NULL;
  3140.  
  3141.   ffelex_handler_ = NULL;
  3142. }
  3143.  
  3144. /* ffelex_is_names_expected -- Is the current parser expecting NAMES vs. NAME?
  3145.  
  3146.    if (ffelex_is_names_expected())
  3147.        // Deliver NAMES token
  3148.      else
  3149.        // Deliver NAME token
  3150.  
  3151.    Must be called while lexer is active, obviously.  */
  3152.  
  3153. bool
  3154. ffelex_is_names_expected ()
  3155. {
  3156.   return ffelex_names_;
  3157. }
  3158.  
  3159. /* Current card image, which has the master linecount number
  3160.    ffelex_linecount_current_.  */
  3161.  
  3162. char *
  3163. ffelex_line ()
  3164. {
  3165.   return ffelex_card_image_;
  3166. }
  3167.  
  3168. /* ffelex_line_length -- Return length of current lexer line
  3169.  
  3170.    printf("Length is %lu\n",ffelex_line_length());
  3171.  
  3172.    Must be called while lexer is active, obviously.  */
  3173.  
  3174. ffewhereColumnNumber
  3175. ffelex_line_length ()
  3176. {
  3177.   return ffelex_card_length_;
  3178. }
  3179.  
  3180. /* Master line count of current card image, or 0 if no card image
  3181.    is current.  */
  3182.  
  3183. ffewhereLineNumber
  3184. ffelex_line_number ()
  3185. {
  3186.   return ffelex_linecount_current_;
  3187. }
  3188.  
  3189. /* ffelex_set_expecting_hollerith -- Set hollerith expectation status
  3190.  
  3191.    ffelex_set_expecting_hollerith(0);
  3192.  
  3193.    Lex initially assumes no hollerith constant is about to show up.  If
  3194.    syntactic analysis expects one, it should call this function with the
  3195.    number of characters expected in the constant immediately after recognizing
  3196.    the decimal number preceding the "H" and the constant itself.  Then, if
  3197.    the next character is indeed H, the lexer will interpret it as beginning
  3198.    a hollerith constant and ship the token formed by reading the specified
  3199.    number of characters (interpreting blanks and otherwise-comments too)
  3200.    from the input file.     It is up to syntactic analysis to call this routine
  3201.    again with 0 to turn hollerith detection off immediately upon receiving
  3202.    the token that might or might not be HOLLERITH.
  3203.  
  3204.    Also call this after seeing an APOSTROPHE or QUOTE token that begins a
  3205.    character constant.    Pass the expected termination character (apostrophe
  3206.    or quote).
  3207.  
  3208.    Pass for length either the length of the hollerith (must be > 0), -1
  3209.    meaning expecting a character constant, or 0 to cancel expectation of
  3210.    a hollerith only after calling it with a length of > 0 and receiving the
  3211.    next token (which may or may not have been a HOLLERITH token).
  3212.  
  3213.    Pass for which either an apostrophe or quote when passing length of -1.
  3214.    Else which is a don't-care.
  3215.  
  3216.    Pass for line and column the line/column info for the token beginning the
  3217.    character or hollerith constant, for use in error messages, when passing
  3218.    a length of -1 -- this function will invoke ffewhere_line/column_use to
  3219.    make its own copies.     Else line and column are don't-cares (when length
  3220.    is 0) and the outstanding copies of the previous line/column info, if
  3221.    still around, are killed.
  3222.  
  3223.    21-Feb-90  JCB  3.1
  3224.       When called with length of 0, also zero ffelex_raw_mode_.     This is
  3225.       so ffest_save_ can undo the effects of replaying tokens like
  3226.       APOSTROPHE and QUOTE.
  3227.    25-Jan-90  JCB  3.0
  3228.       New line, column arguments allow error messages to point to the true
  3229.       beginning of a character/hollerith constant, rather than the beginning
  3230.       of the content part, which makes them more consistent and helpful.
  3231.    05-Nov-89  JCB  2.0
  3232.       New "which" argument allows caller to specify termination character,
  3233.       which should be apostrophe or double-quote, to support Fortran 90.  */
  3234.  
  3235. void
  3236. ffelex_set_expecting_hollerith (long length, char which,
  3237.                 ffewhereLine line, ffewhereColumn column)
  3238. {
  3239.  
  3240.   /* First kill the pending line/col info, if any (should only be pending
  3241.      when this call has length==0, the previous call had length>0, and a
  3242.      non-HOLLERITH token was sent in between the calls, but play it safe). */
  3243.  
  3244.   if (!ffewhere_line_is_unknown (ffelex_raw_where_line_))
  3245.     ffewhere_line_kill (ffelex_raw_where_line_);
  3246.   if (!ffewhere_column_is_unknown (ffelex_raw_where_col_))
  3247.     ffewhere_column_kill (ffelex_raw_where_col_);
  3248.  
  3249.   /* Now handle the length function. */
  3250.   switch (length)
  3251.     {
  3252.     case 0:
  3253.       ffelex_expecting_hollerith_ = 0;
  3254.       ffelex_raw_mode_ = 0;
  3255.       ffelex_raw_where_line_ = ffewhere_line_unknown ();
  3256.       ffelex_raw_where_col_ = ffewhere_column_unknown ();
  3257.       return;            /* Don't set new line/column info from args. */
  3258.  
  3259.     case -1:
  3260.       ffelex_raw_mode_ = -1;
  3261.       ffelex_raw_char_ = which;
  3262.       break;
  3263.  
  3264.     default:            /* length > 0 */
  3265.       ffelex_expecting_hollerith_ = length;
  3266.       break;
  3267.     }
  3268.  
  3269.   /* Now set new line/column information from passed args. */
  3270.  
  3271.   ffelex_raw_where_line_ = ffewhere_line_use (line);
  3272.   ffelex_raw_where_col_ = ffewhere_column_use (column);
  3273. }
  3274.  
  3275. /* ffelex_set_handler -- Set handler for tokens before calling _fixed or _free
  3276.  
  3277.    ffelex_set_handler((ffelexHandler) my_first_handler);
  3278.  
  3279.    Must be called before calling ffelex_file_fixed or ffelex_file_free or
  3280.    after they return, but not while they are active.  */
  3281.  
  3282. void
  3283. ffelex_set_handler (ffelexHandler first)
  3284. {
  3285.   ffelex_handler_ = first;
  3286. }
  3287.  
  3288. /* ffelex_set_hexnum -- Set hexnum flag
  3289.  
  3290.    ffelex_set_hexnum(TRUE);
  3291.  
  3292.    Lex normally interprets a token starting with [0-9] as a NUMBER token,
  3293.    so if it sees a [A-Za-z] in it, it stops parsing the NUMBER and leaves
  3294.    the character as the first of the next token.  But when parsing a
  3295.    hexadecimal number, by calling this function with TRUE before starting
  3296.    the parse of the token itself, lex will interpret [0-9] as the start
  3297.    of a NAME token.  */
  3298.  
  3299. void
  3300. ffelex_set_hexnum (bool f)
  3301. {
  3302.   ffelex_hexnum_ = f;
  3303. }
  3304.  
  3305. /* ffelex_set_include -- Set INCLUDE file to be processed next
  3306.  
  3307.    ffewhereFile wf;  // The ffewhereFile object for the file.
  3308.    bool free_form;  // TRUE means read free-form file, FALSE fixed-form.
  3309.    FILE *fi;  // The file to INCLUDE.
  3310.    ffelex_set_include(wf,free_form,fi);
  3311.  
  3312.    Must be called only after receiving the EOS token following a valid
  3313.    INCLUDE statement specifying a file that has already been successfully
  3314.    opened.  */
  3315.  
  3316. void
  3317. ffelex_set_include (ffewhereFile wf, bool free_form, FILE *fi)
  3318. {
  3319.   assert (ffelex_permit_include_);
  3320.   assert (!ffelex_set_include_);
  3321.   ffelex_set_include_ = TRUE;
  3322.   ffelex_include_free_form_ = free_form;
  3323.   ffelex_include_file_ = fi;
  3324.   ffelex_include_wherefile_ = wf;
  3325. }
  3326.  
  3327. /* ffelex_set_names -- Set names/name flag, names = TRUE
  3328.  
  3329.    ffelex_set_names(FALSE);
  3330.  
  3331.    Lex initially assumes multiple names should be formed.  If this function is
  3332.    called with FALSE, then single names are formed instead.  The differences
  3333.    are a difference in the token type (FFELEX_typeNAMES vs. FFELEX_typeNAME)
  3334.    and in whether full source-location tracking is performed (it is for
  3335.    multiple names, not for single names), which is more expensive in terms of
  3336.    CPU time.  */
  3337.  
  3338. void
  3339. ffelex_set_names (bool f)
  3340. {
  3341.   ffelex_names_ = f;
  3342.   if (!f)
  3343.     ffelex_names_pure_ = FALSE;
  3344. }
  3345.  
  3346. /* ffelex_set_names_pure -- Set names/name (pure) flag, names = TRUE
  3347.  
  3348.    ffelex_set_names_pure(FALSE);
  3349.  
  3350.    Like ffelex_set_names, except affects both lexers.  Normally, the
  3351.    free-form lexer need not generate NAMES tokens because adjacent NAME
  3352.    tokens must be separated by spaces which causes the lexer to generate
  3353.    separate tokens for analysis (whereas in fixed-form the spaces are
  3354.    ignored resulting in one long token).  But in FORMAT statements, for
  3355.    some reason, the Fortran 90 standard specifies that spaces can occur
  3356.    anywhere within a format-item-list with no effect on the format spec
  3357.    (except of course within character string edit descriptors), which means
  3358.    that "1PE14.2" and "1 P E 1 4 . 2" are equivalent.  For the FORMAT
  3359.    statement handling, the existence of spaces makes it hard to deal with,
  3360.    because each token is seen distinctly (i.e. seven tokens in the latter
  3361.    example).  But when no spaces are provided, as in the former example,
  3362.    then only four tokens are generated, NUMBER("1"), NAME("PE14"), PERIOD,
  3363.    NUMBER ("2").  By generating a NAMES instead of NAME, three things happen:
  3364.    One, ffest_kw_format_ does a substring rather than full-string match,
  3365.    and thus matches "PE14" to "PE"; two, ffelex_token_xyz_from_names functions
  3366.    may be used to pull NAME/NAMES and NUMBER tokens out of the NAMES token;
  3367.    and three, error reporting can point to the actual character rather than
  3368.    at or prior to it.  The first two things could be resolved by providing
  3369.    alternate functions fairly easy, thus allowing FORMAT handling to expect
  3370.    both lexers to generate NAME tokens instead of NAMES (with otherwise minor
  3371.    changes to FORMAT parsing), but the third, error reporting, would suffer,
  3372.    and when one makes mistakes in a FORMAT, believe me, one wants a pointer
  3373.    to exactly where the compilers thinks the problem is, to even begin to get
  3374.    a handle on it.  So there.  */
  3375.  
  3376. void
  3377. ffelex_set_names_pure (bool f)
  3378. {
  3379.   ffelex_names_pure_ = f;
  3380.   ffelex_names_ = f;
  3381. }
  3382.  
  3383. /* ffelex_splice_tokens -- Splice off and send tokens from a NAMES
  3384.  
  3385.    return (ffelexHandler) ffelex_splice_tokens(first_handler,master_token,
  3386.      start_char_index);
  3387.  
  3388.    Returns first_handler if start_char_index chars into master_token (which
  3389.    must be a NAMES token) is '\0'. Else, creates a subtoken from that
  3390.    char, either NUMBER (if it is a digit), a NAME (if a valid firstnamechar),
  3391.    an UNDERSCORE (if an underscore), or DOLLAR (if a dollar sign)
  3392.    and sends it to first_handler. If anything other than NAME is sent, the
  3393.    character at the end of it in the master token is examined to see if it
  3394.    begins a NAME, NUMBER, UNDERSCORE, or DOLLAR, and, if so,
  3395.    the handler returned by first_handler is invoked with that token, and
  3396.    this process is repeated until the end of the master token or a NAME
  3397.    token is reached.  */
  3398.  
  3399. ffelexHandler
  3400. ffelex_splice_tokens (ffelexHandler first, ffelexToken master,
  3401.               ffeTokenLength start)
  3402. {
  3403.   char *p;
  3404.   ffeTokenLength i;
  3405.   ffelexToken t;
  3406.  
  3407.   p = ffelex_token_text (master) + (i = start);
  3408.  
  3409.   while (*p != '\0')
  3410.     {
  3411.       if (isdigit (*p))
  3412.     {
  3413.       t = ffelex_token_number_from_names (master, i);
  3414.       p += ffelex_token_length (t);
  3415.       i += ffelex_token_length (t);
  3416.     }
  3417.       else if (ffesrc_is_name_init (*p))
  3418.     {
  3419.       t = ffelex_token_name_from_names (master, i, 0);
  3420.       p += ffelex_token_length (t);
  3421.       i += ffelex_token_length (t);
  3422.     }
  3423.       else if ((*p == '$')
  3424.            && !ffe_is_dollar_ok ())
  3425.     {
  3426.       t = ffelex_token_dollar_from_names (master, i);
  3427.       ++p;
  3428.       ++i;
  3429.     }
  3430.       else if (*p == '_')
  3431.     {
  3432.       t = ffelex_token_uscore_from_names (master, i);
  3433.       ++p;
  3434.       ++i;
  3435.     }
  3436.       else
  3437.     {
  3438.       assert ("not a valid NAMES character" == NULL);
  3439.       t = NULL;
  3440.     }
  3441.       assert (first != NULL);
  3442.       first = (ffelexHandler) (*first) (t);
  3443.       ffelex_token_kill (t);
  3444.     }
  3445.  
  3446.   return first;
  3447. }
  3448.  
  3449. /* ffelex_swallow_tokens -- Eat all tokens delivered to me
  3450.  
  3451.    return ffelex_swallow_tokens;
  3452.  
  3453.    Return this handler when you don't want to look at any more tokens in the
  3454.    statement because you've encountered an unrecoverable error in the
  3455.    statement.  */
  3456.  
  3457. ffelexHandler
  3458. ffelex_swallow_tokens (ffelexToken t, ffelexHandler handler)
  3459. {
  3460.   assert (handler != NULL);
  3461.  
  3462.   if ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeEOS)
  3463.               || (ffelex_token_type (t) == FFELEX_typeSEMICOLON)))
  3464.     return (ffelexHandler) (*handler) (t);
  3465.  
  3466.   ffelex_eos_handler_ = handler;
  3467.   return (ffelexHandler) ffelex_swallow_tokens_;
  3468. }
  3469.  
  3470. /* ffelex_token_dollar_from_names -- Return a dollar from within a names token
  3471.  
  3472.    ffelexToken t;
  3473.    t = ffelex_token_dollar_from_names(t,6);
  3474.  
  3475.    It's as if you made a new token of dollar type having the dollar
  3476.    at, in the example above, the sixth character of the NAMES token.  */
  3477.  
  3478. ffelexToken
  3479. ffelex_token_dollar_from_names (ffelexToken t, ffeTokenLength start)
  3480. {
  3481.   ffelexToken nt;
  3482.  
  3483.   assert (t != NULL);
  3484.   ffelex_total_tokens_++;
  3485.   assert (ffelex_token_type (t) == FFELEX_typeNAMES);
  3486.   assert (start < t->length);
  3487.   assert (t->text[start] == '$');
  3488.  
  3489.   /* Now make the token. */
  3490.  
  3491.   nt = ffelex_token_new_ ();
  3492.   nt->type = FFELEX_typeDOLLAR;
  3493.   nt->length = 0;
  3494.   nt->uses = 1;
  3495.   ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
  3496.                t->where_col, t->wheretrack, start);
  3497.   nt->text = NULL;
  3498.   return nt;
  3499. }
  3500.  
  3501. /* ffelex_token_kill -- Decrement use count for token, kill if no uses left
  3502.  
  3503.    ffelexToken t;
  3504.    ffelex_token_kill(t);
  3505.  
  3506.    Complements a call to ffelex_token_use or ffelex_token_new_....  */
  3507.  
  3508. void
  3509. ffelex_token_kill (ffelexToken t)
  3510. {
  3511.   assert (t != NULL);
  3512.   ffelex_total_tokens_--;
  3513.  
  3514.   assert (t->uses > 0);
  3515.  
  3516.   if (--t->uses != 0)
  3517.     return;
  3518.  
  3519.   if (t->type == FFELEX_typeNAMES)
  3520.     ffewhere_track_kill (t->where_line, t->where_col,
  3521.              t->wheretrack, t->length);
  3522.   ffewhere_line_kill (t->where_line);
  3523.   ffewhere_column_kill (t->where_col);
  3524.   if (t->text != NULL)
  3525.     malloc_kill_ksr (malloc_pool_image (), t->text, t->size + 1);
  3526.   malloc_kill_ks (malloc_pool_image (), t, sizeof (*t));
  3527. }
  3528.  
  3529. /* Make a new NAME token that is a substring of a NAMES token.  */
  3530.  
  3531. ffelexToken
  3532. ffelex_token_name_from_names (ffelexToken t, ffeTokenLength start,
  3533.                   ffeTokenLength len)
  3534. {
  3535.   ffelexToken nt;
  3536.  
  3537.   assert (t != NULL);
  3538.   ffelex_total_tokens_++;
  3539.   assert (ffelex_token_type (t) == FFELEX_typeNAMES);
  3540.   assert (start < t->length);
  3541.   if (len == 0)
  3542.     len = t->length - start;
  3543.   else
  3544.     {
  3545.       assert (len > 0);
  3546.       assert ((start + len) <= t->length);
  3547.     }
  3548.   assert (ffelex_is_firstnamechar (t->text[start]));
  3549.  
  3550.   nt = ffelex_token_new_ ();
  3551.   nt->type = FFELEX_typeNAME;
  3552.   nt->size = len;        /* Assume nobody's gonna fiddle with token
  3553.                    text. */
  3554.   nt->length = len;
  3555.   nt->uses = 1;
  3556.   ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
  3557.                t->where_col, t->wheretrack, start);
  3558.   nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
  3559.                  len + 1);
  3560.   strncpy (nt->text, t->text + start, len);
  3561.   nt->text[len] = '\0';
  3562.   return nt;
  3563. }
  3564.  
  3565. /* Make a new NAMES token that is a substring of another NAMES token.  */
  3566.  
  3567. ffelexToken
  3568. ffelex_token_names_from_names (ffelexToken t, ffeTokenLength start,
  3569.                    ffeTokenLength len)
  3570. {
  3571.   ffelexToken nt;
  3572.  
  3573.   assert (t != NULL);
  3574.   ffelex_total_tokens_++;
  3575.   assert (ffelex_token_type (t) == FFELEX_typeNAMES);
  3576.   assert (start < t->length);
  3577.   if (len == 0)
  3578.     len = t->length - start;
  3579.   else
  3580.     {
  3581.       assert (len > 0);
  3582.       assert ((start + len) <= t->length);
  3583.     }
  3584.   assert (ffelex_is_firstnamechar (t->text[start]));
  3585.  
  3586.   nt = ffelex_token_new_ ();
  3587.   nt->type = FFELEX_typeNAMES;
  3588.   nt->size = len;        /* Assume nobody's gonna fiddle with token
  3589.                    text. */
  3590.   nt->length = len;
  3591.   nt->uses = 1;
  3592.   ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
  3593.                t->where_col, t->wheretrack, start);
  3594.   ffewhere_track_copy (nt->wheretrack, t->wheretrack, start, len);
  3595.   nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
  3596.                  len + 1);
  3597.   strncpy (nt->text, t->text + start, len);
  3598.   nt->text[len] = '\0';
  3599.   return nt;
  3600. }
  3601.  
  3602. /* Make a new CHARACTER token.  */
  3603.  
  3604. ffelexToken
  3605. ffelex_token_new_character (char *s, ffewhereLine l, ffewhereColumn c)
  3606. {
  3607.   ffelexToken t;
  3608.  
  3609.   ffelex_total_tokens_++;
  3610.  
  3611.   t = ffelex_token_new_ ();
  3612.   t->type = FFELEX_typeCHARACTER;
  3613.   t->length = t->size = strlen (s);    /* Assume it won't get bigger. */
  3614.   t->uses = 1;
  3615.   t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
  3616.                 t->size + 1);
  3617.   strcpy (t->text, s);
  3618.   t->where_line = ffewhere_line_use (l);
  3619.   t->where_col = ffewhere_column_new (c);
  3620.   return t;
  3621. }
  3622.  
  3623. /* Make a new EOF token right after end of file.  */
  3624.  
  3625. ffelexToken
  3626. ffelex_token_new_eof ()
  3627. {
  3628.   ffelexToken t;
  3629.  
  3630.   ffelex_total_tokens_++;
  3631.  
  3632.   t = ffelex_token_new_ ();
  3633.   t->type = FFELEX_typeEOF;
  3634.   t->uses = 1;
  3635.   t->text = NULL;
  3636.   t->where_line = ffewhere_line_new (ffelex_linecount_current_);
  3637.   t->where_col = ffewhere_column_new (1);
  3638.   return t;
  3639. }
  3640.  
  3641. /* Make a new NAME token.  */
  3642.  
  3643. ffelexToken
  3644. ffelex_token_new_name (char *s, ffewhereLine l, ffewhereColumn c)
  3645. {
  3646.   ffelexToken t;
  3647.  
  3648.   ffelex_total_tokens_++;
  3649.  
  3650.   assert (ffelex_is_firstnamechar (*s));
  3651.  
  3652.   t = ffelex_token_new_ ();
  3653.   t->type = FFELEX_typeNAME;
  3654.   t->length = t->size = strlen (s);    /* Assume it won't get bigger. */
  3655.   t->uses = 1;
  3656.   t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
  3657.                 t->size + 1);
  3658.   strcpy (t->text, s);
  3659.   t->where_line = ffewhere_line_use (l);
  3660.   t->where_col = ffewhere_column_new (c);
  3661.   return t;
  3662. }
  3663.  
  3664. /* Make a new NAMES token.  */
  3665.  
  3666. ffelexToken
  3667. ffelex_token_new_names (char *s, ffewhereLine l, ffewhereColumn c)
  3668. {
  3669.   ffelexToken t;
  3670.  
  3671.   ffelex_total_tokens_++;
  3672.  
  3673.   assert (ffelex_is_firstnamechar (*s));
  3674.  
  3675.   t = ffelex_token_new_ ();
  3676.   t->type = FFELEX_typeNAMES;
  3677.   t->length = t->size = strlen (s);    /* Assume it won't get bigger. */
  3678.   t->uses = 1;
  3679.   t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
  3680.                 t->size + 1);
  3681.   strcpy (t->text, s);
  3682.   t->where_line = ffewhere_line_use (l);
  3683.   t->where_col = ffewhere_column_new (c);
  3684.   ffewhere_track_clear (t->wheretrack, t->length);    /* Assume contiguous
  3685.                                names. */
  3686.   return t;
  3687. }
  3688.  
  3689. /* Make a new NUMBER token.
  3690.  
  3691.    The first character of the string must be a digit, and only the digits
  3692.    are copied into the new number.  So this may be used to easily extract
  3693.    a NUMBER token from within any text string.  Then the length of the
  3694.    resulting token may be used to calculate where the digits stopped
  3695.    in the original string.  */
  3696.  
  3697. ffelexToken
  3698. ffelex_token_new_number (char *s, ffewhereLine l, ffewhereColumn c)
  3699. {
  3700.   ffelexToken t;
  3701.   ffeTokenLength len;
  3702.  
  3703.   ffelex_total_tokens_++;
  3704.  
  3705.   /* How long is the string of decimal digits at s? */
  3706.  
  3707.   len = strspn (s, "0123456789");
  3708.  
  3709.   /* Make sure there is at least one digit. */
  3710.  
  3711.   assert (len != 0);
  3712.  
  3713.   /* Now make the token. */
  3714.  
  3715.   t = ffelex_token_new_ ();
  3716.   t->type = FFELEX_typeNUMBER;
  3717.   t->length = t->size = len;    /* Assume it won't get bigger. */
  3718.   t->uses = 1;
  3719.   t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
  3720.                 len + 1);
  3721.   strncpy (t->text, s, len);
  3722.   t->text[len] = '\0';
  3723.   t->where_line = ffewhere_line_use (l);
  3724.   t->where_col = ffewhere_column_new (c);
  3725.   return t;
  3726. }
  3727.  
  3728. /* Make a new token of any type that doesn't contain text.  A private
  3729.    function that is used by public macros in the interface file.  */
  3730.  
  3731. ffelexToken
  3732. ffelex_token_new_simple_ (ffelexType type, ffewhereLine l, ffewhereColumn c)
  3733. {
  3734.   ffelexToken t;
  3735.  
  3736.   t = ffelex_token_new_ ();
  3737.   t->type = type;
  3738.   t->uses = 1;
  3739.   t->text = NULL;
  3740.   t->where_line = ffewhere_line_use (l);
  3741.   t->where_col = ffewhere_column_new (c);
  3742.   return t;
  3743. }
  3744.  
  3745. /* Make a new NUMBER token from an existing NAMES token.
  3746.  
  3747.    Like ffelex_token_new_number, this function calculates the length
  3748.    of the digit string itself.  */
  3749.  
  3750. ffelexToken
  3751. ffelex_token_number_from_names (ffelexToken t, ffeTokenLength start)
  3752. {
  3753.   ffelexToken nt;
  3754.   ffeTokenLength len;
  3755.  
  3756.   assert (t != NULL);
  3757.   ffelex_total_tokens_++;
  3758.   assert (ffelex_token_type (t) == FFELEX_typeNAMES);
  3759.   assert (start < t->length);
  3760.  
  3761.   /* How long is the string of decimal digits at s? */
  3762.  
  3763.   len = strspn (t->text + start, "0123456789");
  3764.  
  3765.   /* Make sure there is at least one digit. */
  3766.  
  3767.   assert (len != 0);
  3768.  
  3769.   /* Now make the token. */
  3770.  
  3771.   nt = ffelex_token_new_ ();
  3772.   nt->type = FFELEX_typeNUMBER;
  3773.   nt->size = len;        /* Assume nobody's gonna fiddle with token
  3774.                    text. */
  3775.   nt->length = len;
  3776.   nt->uses = 1;
  3777.   ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
  3778.                t->where_col, t->wheretrack, start);
  3779.   nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
  3780.                  len + 1);
  3781.   strncpy (nt->text, t->text + start, len);
  3782.   nt->text[len] = '\0';
  3783.   return nt;
  3784. }
  3785.  
  3786. /* Make a new UNDERSCORE token from a NAMES token.  */
  3787.  
  3788. ffelexToken
  3789. ffelex_token_uscore_from_names (ffelexToken t, ffeTokenLength start)
  3790. {
  3791.   ffelexToken nt;
  3792.  
  3793.   assert (t != NULL);
  3794.   ffelex_total_tokens_++;
  3795.   assert (ffelex_token_type (t) == FFELEX_typeNAMES);
  3796.   assert (start < t->length);
  3797.   assert (t->text[start] == '_');
  3798.  
  3799.   /* Now make the token. */
  3800.  
  3801.   nt = ffelex_token_new_ ();
  3802.   nt->type = FFELEX_typeUNDERSCORE;
  3803.   nt->uses = 1;
  3804.   ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
  3805.                t->where_col, t->wheretrack, start);
  3806.   nt->text = NULL;
  3807.   return nt;
  3808. }
  3809.  
  3810. /* ffelex_token_use -- Return another instance of a token
  3811.  
  3812.    ffelexToken t;
  3813.    t = ffelex_token_use(t);
  3814.  
  3815.    In a sense, the new token is a copy of the old, though it might be the
  3816.    same with just a new use count.
  3817.  
  3818.    We use the use count method (easy).    */
  3819.  
  3820. ffelexToken
  3821. ffelex_token_use (ffelexToken t)
  3822. {
  3823.   if (t == NULL)
  3824.     assert ("_token_use: null token" == NULL);
  3825.   ffelex_total_tokens_++;
  3826.   t->uses++;
  3827.   return t;
  3828. }
  3829.