1
2
3
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
30
31
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
88
89
90
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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
|
/* com.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995-1997 Free Software Foundation, Inc.
Contributed by James Craig Burley (burley@gnu.org).
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:
com.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef _H_f_com
#define _H_f_com
/* Simple definitions and enumerations. */
#define FFECOM_dimensionsMAX 7 /* Max # dimensions (quick hack). */
#define FFECOM_targetFFE 1
#define FFECOM_targetGCC 2
#ifndef FFE_STANDALONE
#define FFECOM_targetCURRENT FFECOM_targetGCC /* Backend! */
#define FFECOM_ONEPASS 0
#else
#define FFECOM_targetCURRENT FFECOM_targetFFE
#define FFECOM_ONEPASS 0
#endif
#if FFECOM_ONEPASS
#define FFECOM_TWOPASS 0
#else
#define FFECOM_TWOPASS 1
#endif
#define FFECOM_SIZE_UNIT "byte" /* Singular form. */
#define FFECOM_SIZE_UNITS "bytes" /* Plural form. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#define FFECOM_constantNULL NULL_TREE
#define FFECOM_globalNULL NULL_TREE
#define FFECOM_labelNULL NULL_TREE
#define FFECOM_storageNULL NULL_TREE
#define FFECOM_symbolNULL ffecom_symbol_null_
/* Shorthand for types used in f2c.h and that g77 perhaps allows some
flexibility regarding in the section below. I.e. the actual numbers
below aren't important, as long as they're unique. */
#define FFECOM_f2ccodeCHAR 1
#define FFECOM_f2ccodeSHORT 2
#define FFECOM_f2ccodeINT 3
#define FFECOM_f2ccodeLONG 4
#define FFECOM_f2ccodeLONGLONG 5
#define FFECOM_f2ccodeCHARPTR 6 /* char * */
#define FFECOM_f2ccodeFLOAT 7
#define FFECOM_f2ccodeDOUBLE 8
#define FFECOM_f2ccodeLONGDOUBLE 9
#define FFECOM_f2ccodeTWOREALS 10
#define FFECOM_f2ccodeTWODOUBLEREALS 11
#if FFECOM_DETERMINE_TYPES /* only for com.c and configure */
/* Begin f2c.h information. This must match the info in the f2c.h used
to build the libf2c with which g77-generated code is linked, or there
will probably be bugs, some of them difficult to detect or even trigger. */
/* Do we need int (for 32-bit or 64-bit systems) or long (16-bit or
normally 32-bit) for f2c-type integers? */
#ifndef BITS_PER_WORD
#define BITS_PER_WORD 32
#endif
#ifndef CHAR_TYPE_SIZE
#define CHAR_TYPE_SIZE BITS_PER_UNIT
#endif
#ifndef SHORT_TYPE_SIZE
#define SHORT_TYPE_SIZE (BITS_PER_UNIT * MIN ((UNITS_PER_WORD + 1) / 2, 2))
#endif
#ifndef INT_TYPE_SIZE
#define INT_TYPE_SIZE BITS_PER_WORD
#endif
#ifndef LONG_TYPE_SIZE
#define LONG_TYPE_SIZE BITS_PER_WORD
#endif
#ifndef LONG_LONG_TYPE_SIZE
#define LONG_LONG_TYPE_SIZE (BITS_PER_WORD * 2)
#endif
#ifndef WCHAR_UNSIGNED
#define WCHAR_UNSIGNED 0
#endif
#ifndef FLOAT_TYPE_SIZE
#define FLOAT_TYPE_SIZE BITS_PER_WORD
#endif
#ifndef DOUBLE_TYPE_SIZE
#define DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
#endif
#ifndef LONG_DOUBLE_TYPE_SIZE
#define LONG_DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
#endif
#if LONG_TYPE_SIZE == FLOAT_TYPE_SIZE
# define FFECOM_f2cINTEGER FFECOM_f2ccodeLONG
# define FFECOM_f2cLOGICAL FFECOM_f2ccodeLONG
#elif INT_TYPE_SIZE == FLOAT_TYPE_SIZE
# define FFECOM_f2cINTEGER FFECOM_f2ccodeINT
# define FFECOM_f2cLOGICAL FFECOM_f2ccodeINT
#else
# error Cannot find a suitable type for FFECOM_f2cINTEGER
#endif
#if LONG_TYPE_SIZE == (FLOAT_TYPE_SIZE * 2)
# define FFECOM_f2cLONGINT FFECOM_f2ccodeLONG
#elif LONG_LONG_TYPE_SIZE == (FLOAT_TYPE_SIZE * 2)
# define FFECOM_f2cLONGINT FFECOM_f2ccodeLONGLONG
#else
# error Cannot find a suitable type for FFECOM_f2cLONGINT
#endif
#define FFECOM_f2cADDRESS FFECOM_f2ccodeCHARPTR
#define FFECOM_f2cSHORTINT FFECOM_f2ccodeSHORT
#define FFECOM_f2cREAL FFECOM_f2ccodeFLOAT
#define FFECOM_f2cDOUBLEREAL FFECOM_f2ccodeDOUBLE
#define FFECOM_f2cCOMPLEX FFECOM_f2ccodeTWOREALS
#define FFECOM_f2cDOUBLECOMPLEX FFECOM_f2ccodeTWODOUBLEREALS
#define FFECOM_f2cSHORTLOGICAL FFECOM_f2ccodeSHORT
#define FFECOM_f2cLOGICAL1 FFECOM_f2ccodeCHAR
#define FFECOM_f2cINTEGER1 FFECOM_f2ccodeCHAR
/* These must be f2c's INTEGER type, to match runtime/f2c.h.in. */
#define FFECOM_f2cFLAG FFECOM_f2cINTEGER
#define FFECOM_f2cFTNINT FFECOM_f2cINTEGER
#define FFECOM_f2cFTNLEN FFECOM_f2cINTEGER
#endif /* #if FFECOM_DETERMINE_TYPES */
/* Everything else in f2c.h, specifically the structures used in
interfacing compiled code with the library, must remain exactly
as delivered, or g77 internals (mostly com.c and ste.c) must
be modified accordingly to compensate. Or there will be...trouble. */
typedef enum
{
#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) CODE,
#include "com-rt.def"
#undef DEFGFRT
FFECOM_gfrt
} ffecomGfrt;
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
/* Typedefs. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#ifndef TREE_CODE
#include "tree.j"
#endif
#ifndef BUILT_FOR_270
#ifdef DECL_STATIC_CONSTRUCTOR /* In gcc/tree.h. */
#define BUILT_FOR_270 1
#else
#define BUILT_FOR_270 0
#endif
#endif /* !defined (BUILT_FOR_270) */
#ifndef BUILT_FOR_280
#ifdef DECL_ONE_ONLY /* In gcc/tree.h. */
#define BUILT_FOR_280 1
#else
#define BUILT_FOR_280 0
#endif
#endif /* !defined (BUILT_FOR_280) */
typedef tree ffecomConstant;
#define FFECOM_constantHOOK
typedef tree ffecomLabel;
#define FFECOM_globalHOOK
typedef tree ffecomGlobal;
#define FFECOM_labelHOOK
typedef tree ffecomStorage;
#define FFECOM_storageHOOK
typedef struct _ffecom_symbol_ ffecomSymbol;
#define FFECOM_symbolHOOK
struct _ffecom_symbol_
{
tree decl_tree;
tree length_tree; /* For CHARACTER dummies. */
tree vardesc_tree; /* For NAMELIST. */
tree assign_tree; /* For ASSIGN'ed vars. */
bool addr; /* Is address of item instead of item. */
};
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
/* Include files needed by this one. */
#include "bld.h"
#include "info.h"
#include "lab.h"
#include "storag.h"
#include "symbol.h"
/* Structure definitions. */
/* Global objects accessed by users of this module. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
extern tree long_integer_type_node;
extern tree complex_double_type_node;
extern tree string_type_node;
extern tree ffecom_integer_type_node;
extern tree ffecom_integer_zero_node;
extern tree ffecom_integer_one_node;
extern tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];
extern ffecomSymbol ffecom_symbol_null_;
extern ffeinfoKindtype ffecom_pointer_kind_;
extern ffeinfoKindtype ffecom_label_kind_;
extern int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype];
extern tree ffecom_f2c_integer_type_node;
extern tree ffecom_f2c_address_type_node;
extern tree ffecom_f2c_real_type_node;
extern tree ffecom_f2c_doublereal_type_node;
extern tree ffecom_f2c_complex_type_node;
extern tree ffecom_f2c_doublecomplex_type_node;
extern tree ffecom_f2c_longint_type_node;
extern tree ffecom_f2c_logical_type_node;
extern tree ffecom_f2c_flag_type_node;
extern tree ffecom_f2c_ftnlen_type_node;
extern tree ffecom_f2c_ftnlen_zero_node;
extern tree ffecom_f2c_ftnlen_one_node;
extern tree ffecom_f2c_ftnlen_two_node;
extern tree ffecom_f2c_ptr_to_ftnlen_type_node;
extern tree ffecom_f2c_ftnint_type_node;
extern tree ffecom_f2c_ptr_to_ftnint_type_node;
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
/* Declare functions with prototypes. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
tree ffecom_1 (enum tree_code code, tree type, tree node);
tree ffecom_1_fn (tree node);
tree ffecom_2 (enum tree_code code, tree type, tree node1, tree node2);
bool ffecom_2pass_advise_entrypoint (ffesymbol entry);
void ffecom_2pass_do_entrypoint (ffesymbol entry);
tree ffecom_2s (enum tree_code code, tree type, tree node1, tree node2);
tree ffecom_3 (enum tree_code code, tree type, tree node1, tree node2,
tree node3);
tree ffecom_3s (enum tree_code code, tree type, tree node1, tree node2,
tree node3);
tree ffecom_arg_expr (ffebld expr, tree *length);
tree ffecom_arg_ptr_to_expr (ffebld expr, tree *length);
tree ffecom_call_gfrt (ffecomGfrt ix, tree args);
tree ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
ffeinfoKindtype kt, tree tree_type);
tree ffecom_decl_field (tree context, tree prevfield, char *name,
tree type);
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
void ffecom_close_include (FILE *f);
int ffecom_decode_include_option (char *spec);
void ffecom_end_transition (void);
void ffecom_exec_transition (void);
void ffecom_expand_let_stmt (ffebld dest, ffebld source);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
tree ffecom_expr (ffebld expr);
tree ffecom_expr_assign (ffebld expr);
tree ffecom_expr_assign_w (ffebld expr);
tree ffecom_expr_rw (ffebld expr);
void ffecom_finish_compile (void);
void ffecom_finish_decl (tree decl, tree init, bool is_top_level);
void ffecom_finish_progunit (void);
tree ffecom_get_invented_identifier (char *pattern, char *text,
int number);
ffeinfoKindtype ffecom_gfrt_basictype (ffecomGfrt ix);
ffeinfoKindtype ffecom_gfrt_kindtype (ffecomGfrt ix);
void ffecom_init_0 (void);
void ffecom_init_2 (void);
tree ffecom_list_expr (ffebld list);
tree ffecom_list_ptr_to_expr (ffebld list);
tree ffecom_lookup_label (ffelab label);
tree ffecom_modify (tree newtype, tree lhs, tree rhs);
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
void ffecom_file (char *name);
void ffecom_notify_init_storage (ffestorag st);
void ffecom_notify_init_symbol (ffesymbol s);
void ffecom_notify_primary_entry (ffesymbol fn);
FILE *ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
void ffecom_pop_calltemps (void);
void ffecom_pop_tempvar (tree var);
tree ffecom_ptr_to_expr (ffebld expr);
void ffecom_push_calltemps (void);
tree ffecom_push_tempvar (tree type, ffetargetCharacterSize size,
int elements, bool auto_pop);
tree ffecom_return_expr (ffebld expr);
tree ffecom_save_tree (tree t);
tree ffecom_start_decl (tree decl, bool is_init);
void ffecom_sym_commit (ffesymbol s);
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
ffesymbol ffecom_sym_end_transition (ffesymbol s);
ffesymbol ffecom_sym_exec_transition (ffesymbol s);
ffesymbol ffecom_sym_learned (ffesymbol s);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
void ffecom_sym_retract (ffesymbol s);
tree ffecom_temp_label (void);
tree ffecom_truth_value (tree expr);
tree ffecom_truth_value_invert (tree expr);
tree ffecom_which_entrypoint_decl (void);
/* These need to be in the front end with exactly these interfaces,
as they're called by the back end. */
int mark_addressable (tree expr);
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
/* Define macros. */
#if FFECOM_targetCURRENT == FFECOM_targetFFE
#define ffecom_expr(e) (e)
#define ffecom_init_0()
#define ffecom_init_2()
#define ffecom_label_kind() FFEINFO_kindtypeINTEGERDEFAULT
#define ffecom_pointer_kind() FFEINFO_kindtypeINTEGERDEFAULT
#define ffecom_ptr_to_expr(e) (e)
#define ffecom_sym_commit(s)
#define ffecom_sym_retract(s)
#endif /* FFECOM_targetCURRENT == FFECOM_targetFFE */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#define ffecom_f2c_typecode(bt,kt) ffecom_f2c_typecode_[(bt)][(kt)]
#define ffecom_label_kind() ffecom_label_kind_
#define ffecom_pointer_kind() ffecom_pointer_kind_
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
#define ffecom_init_1()
#define ffecom_init_3()
#define ffecom_init_4()
#define ffecom_terminate_0()
#define ffecom_terminate_1()
#define ffecom_terminate_2()
#define ffecom_terminate_3()
#define ffecom_terminate_4()
/* End of #include file. */
#endif
|