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