src.h 5.26 KB
Newer Older
Jeff Law committed
1 2
/* src.h -- Public #include File
   Copyright (C) 1995 Free Software Foundation, Inc.
3
   Contributed by James Craig Burley.
Jeff Law committed
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29

This file is part of GNU Fortran.

GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Fortran; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.

   Owning Modules:
      src.c

   Modifications:
*/

/* Allow multiple inclusion to work. */

30 31
#ifndef GCC_F_SRC_H
#define GCC_F_SRC_H
Jeff Law committed
32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87

#include "bad.h"
#include "top.h"

extern char ffesrc_char_match_init_[256];
extern char ffesrc_char_match_noninit_[256];
extern char ffesrc_char_source_[256];
extern char ffesrc_char_internal_init_[256];
extern ffebad ffesrc_bad_symbol_init_[256];
extern ffebad ffesrc_bad_symbol_noninit_[256];
extern bool ffesrc_check_symbol_;
extern bool ffesrc_ok_match_init_upper_;
extern bool ffesrc_ok_match_init_lower_;
extern bool ffesrc_ok_match_noninit_upper_;
extern bool ffesrc_ok_match_noninit_lower_;

/* These C-language-syntax modifiers could avoid the match arg if gcc's
   extension allowing macros to generate dynamic labels was used.  They
   could use the no_match arg (and the "caller's" label defs) if there
   was a way to say "goto default" in a switch statement.  Oh well.

   NOTE: These macro assume "case FFESRC_CASE_MATCH_[NON]INIT(...):" is used
   to invoke them, and thus assume the "above" case does not fall through to
   this one.  This syntax was chosen to keep indenting tools working.  */

#define FFESRC_CASE_MATCH_INIT(upper, lower, match, no_match) \
 upper: if (!ffesrc_ok_match_init_upper_) goto no_match; \
  else goto match; \
 case lower: if (!ffesrc_ok_match_init_lower_) goto no_match; \
 match

#define FFESRC_CASE_MATCH_NONINIT(upper, lower, match, no_match) \
 upper: if (!ffesrc_ok_match_noninit_upper_) goto no_match; \
  else goto match; \
 case lower: if (!ffesrc_ok_match_noninit_lower_) goto no_match; \
 match

/* If character is ok in a symbol name (not including intrinsic names),
   returns FFEBAD, else returns something else, type ffebad.  */

#define ffesrc_bad_char_symbol_init(c) \
  (ffesrc_bad_symbol_init_[(unsigned int) (c)])
#define ffesrc_bad_char_symbol_noninit(c) \
  (ffesrc_bad_symbol_noninit_[(unsigned int) (c)])

/* Returns TRUE if character is ok in a symbol name (including
   intrinsic names).  Doesn't care about case settings, this is
   used just for parsing (before semantic complaints about symbol-
   name casing and such).  One specific usage is to decide whether
   an underscore is valid as the first or subsequent character in
   some symbol name -- if not, an underscore is a separate token
   (while lexing, for example).  Note that ffesrc_is_name_init
   must return TRUE for a (not necessarily proper) subset of
   characters for which ffelex_is_firstnamechar returns TRUE.  */

#define ffesrc_is_name_init(c) \
Craig Burley committed
88
  ((ISALPHA ((c))) || (! (1 || ffe_is_90 ()) && ((c) == '_')))
Jeff Law committed
89
#define ffesrc_is_name_noninit(c) \
Craig Burley committed
90
  ((ISALNUM ((c))) || (! (1 || ffe_is_90 ()) && ((c) == '_')))
Jeff Law committed
91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139

/* Test if source-translated character matches given alphabetic character
   (passed in both uppercase and lowercase, to allow for custom speedup
   of compilation in environments where compile-time options aren't needed
   for casing).	 */

#define ffesrc_char_match_init(c, up, low) \
  (ffesrc_char_match_init_[(unsigned int) (c)] == up)

#define ffesrc_char_match_noninit(c, up, low) \
  (ffesrc_char_match_noninit_[(unsigned int) (c)] == up)

/* Translate character from input-file form to source form.  */

#define ffesrc_char_source(c) (ffesrc_char_source_[(unsigned int) (c)])

/* Translate internal character (upper/lower) to source form in an
   initial-character context (i.e. ffesrc_char_match_init of the result
   will always succeed).  */

#define ffesrc_char_internal_init(up, low) \
  (ffesrc_char_internal_init_[(unsigned int) (up)])

/* Returns TRUE if a name representing a symbol should be checked for
   validity according to compile-time options.	That is, if it is possible
   that ffesrc_bad_char_symbol(c) can return something other than FFEBAD
   for any valid character in an ffelex NAME(S) token.	*/

#define ffesrc_check_symbol() ffesrc_check_symbol_

#define ffesrc_init_0()
void ffesrc_init_1 (void);
#define ffesrc_init_2()
#define ffesrc_init_3()
#define ffesrc_init_4()
int ffesrc_strcmp_1ns2i (ffeCase mcase, const char *var, int len,
			 const char *str_ic);
int ffesrc_strcmp_2c (ffeCase mcase, const char *var, const char *str_uc,
		      const char *str_lc, const char *str_ic);
int ffesrc_strncmp_2c (ffeCase mcase, const char *var, const char *str_uc,
		       const char *str_lc, const char *str_ic, int len);
#define ffesrc_terminate_0()
#define ffesrc_terminate_1()
#define ffesrc_terminate_2()
#define ffesrc_terminate_3()
#define ffesrc_terminate_4()

/* End of #include file. */

140
#endif /* ! GCC_F_SRC_H */