contrib/gcc/f/src.h

   1 /* src.h -- Public #include File
   2    Copyright (C) 1995 Free Software Foundation, Inc.
   3    Contributed by James Craig Burley.
   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, 59 Temple Place - Suite 330, Boston, MA
  20 02111-1307, USA.
  21
  22    Owning Modules:
  23       src.c
  24
  25    Modifications:
  26 */
  27
  28 /* Allow multiple inclusion to work. */
  29
  30 #ifndef _H_f_src
  31 #define _H_f_src
  32
  33 #include "bad.h"
  34 #include "top.h"
  35
  36 extern char ffesrc_toupper_[256];
  37 extern char ffesrc_tolower_[256];
  38 extern char ffesrc_char_match_init_[256];
  39 extern char ffesrc_char_match_noninit_[256];
  40 extern char ffesrc_char_source_[256];
  41 extern char ffesrc_char_internal_init_[256];
  42 extern ffebad ffesrc_bad_symbol_init_[256];
  43 extern ffebad ffesrc_bad_symbol_noninit_[256];
  44 extern bool ffesrc_check_symbol_;
  45 extern bool ffesrc_ok_match_init_upper_;
  46 extern bool ffesrc_ok_match_init_lower_;
  47 extern bool ffesrc_ok_match_noninit_upper_;
  48 extern bool ffesrc_ok_match_noninit_lower_;
  49
  50 /* These C-language-syntax modifiers could avoid the match arg if gcc's
  51    extension allowing macros to generate dynamic labels was used.  They
  52    could use the no_match arg (and the "caller's" label defs) if there
  53    was a way to say "goto default" in a switch statement.  Oh well.
  54
  55    NOTE: These macro assume "case FFESRC_CASE_MATCH_[NON]INIT(...):" is used
  56    to invoke them, and thus assume the "above" case does not fall through to
  57    this one.  This syntax was chosen to keep indenting tools working.  */
  58
  59 #define FFESRC_CASE_MATCH_INIT(upper, lower, match, no_match) \
  60  upper: if (!ffesrc_ok_match_init_upper_) goto no_match; \
  61   else goto match; \
  62  case lower: if (!ffesrc_ok_match_init_lower_) goto no_match; \
  63  match
  64
  65 #define FFESRC_CASE_MATCH_NONINIT(upper, lower, match, no_match) \
  66  upper: if (!ffesrc_ok_match_noninit_upper_) goto no_match; \
  67   else goto match; \
  68  case lower: if (!ffesrc_ok_match_noninit_lower_) goto no_match; \
  69  match
  70
  71 /* If character is ok in a symbol name (not including intrinsic names),
  72    returns FFEBAD, else returns something else, type ffebad.  */
  73
  74 #define ffesrc_bad_char_symbol_init(c) \
  75   (ffesrc_bad_symbol_init_[(unsigned int) (c)])
  76 #define ffesrc_bad_char_symbol_noninit(c) \
  77   (ffesrc_bad_symbol_noninit_[(unsigned int) (c)])
  78
  79 /* Returns TRUE if character is ok in a symbol name (including
  80    intrinsic names).  Doesn't care about case settings, this is
  81    used just for parsing (before semantic complaints about symbol-
  82    name casing and such).  One specific usage is to decide whether
  83    an underscore is valid as the first or subsequent character in
  84    some symbol name -- if not, an underscore is a separate token
  85    (while lexing, for example).  Note that ffesrc_is_name_init
  86    must return TRUE for a (not necessarily proper) subset of
  87    characters for which ffelex_is_firstnamechar returns TRUE.  */
  88
  89 #define ffesrc_is_name_init(c) \
  90   ((ISALPHA ((c))) || (! (1 || ffe_is_90 ()) && ((c) == '_')))
  91 #define ffesrc_is_name_noninit(c) \
  92   ((ISALNUM ((c))) || (! (1 || ffe_is_90 ()) && ((c) == '_')))
  93
  94 /* Test if source-translated character matches given alphabetic character
  95    (passed in both uppercase and lowercase, to allow for custom speedup
  96    of compilation in environments where compile-time options aren't needed
  97    for casing).  */
  98
  99 #define ffesrc_char_match_init(c, up, low) \
 100   (ffesrc_char_match_init_[(unsigned int) (c)] == up)
 101
 102 #define ffesrc_char_match_noninit(c, up, low) \
 103   (ffesrc_char_match_noninit_[(unsigned int) (c)] == up)
 104
 105 /* Translate character from input-file form to source form.  */
 106
 107 #define ffesrc_char_source(c) (ffesrc_char_source_[(unsigned int) (c)])
 108
 109 /* Translate internal character (upper/lower) to source form in an
 110    initial-character context (i.e. ffesrc_char_match_init of the result
 111    will always succeed).  */
 112
 113 #define ffesrc_char_internal_init(up, low) \
 114   (ffesrc_char_internal_init_[(unsigned int) (up)])
 115
 116 /* Returns TRUE if a name representing a symbol should be checked for
 117    validity according to compile-time options.  That is, if it is possible
 118    that ffesrc_bad_char_symbol(c) can return something other than FFEBAD
 119    for any valid character in an ffelex NAME(S) token.  */
 120
 121 #define ffesrc_check_symbol() ffesrc_check_symbol_
 122
 123 #define ffesrc_init_0()
 124 void ffesrc_init_1 (void);
 125 #define ffesrc_init_2()
 126 #define ffesrc_init_3()
 127 #define ffesrc_init_4()
 128 int ffesrc_strcmp_1ns2i (ffeCase mcase, const char *var, int len,
 129                          const char *str_ic);
 130 int ffesrc_strcmp_2c (ffeCase mcase, const char *var, const char *str_uc,
 131                       const char *str_lc, const char *str_ic);
 132 int ffesrc_strncmp_2c (ffeCase mcase, const char *var, const char *str_uc,
 133                        const char *str_lc, const char *str_ic, int len);
 134 #define ffesrc_terminate_0()
 135 #define ffesrc_terminate_1()
 136 #define ffesrc_terminate_2()
 137 #define ffesrc_terminate_3()
 138 #define ffesrc_terminate_4()
 139 #define ffesrc_toupper(c) (ffesrc_toupper_[(unsigned int) (c)])
 140 #define ffesrc_tolower(c) (ffesrc_tolower_[(unsigned int) (c)])
 141
 142 /* End of #include file. */
 143
 144 #endif