1 /*
2 * Copyright (c) 1995-2018, NVIDIA CORPORATION. All rights reserved.
3 *
4 * Licensed under the Apache License, Version 2.0 (the "License");
5 * you may not use this file except in compliance with the License.
6 * You may obtain a copy of the License at
7 *
8 * http://www.apache.org/licenses/LICENSE-2.0
9 *
10 * Unless required by applicable law or agreed to in writing, software
11 * distributed under the License is distributed on an "AS IS" BASIS,
12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 * See the License for the specific language governing permissions and
14 * limitations under the License.
15 *
16 */
17
18 /* const.c -- constants */
19
20 #include "fioMacros.h"
21 #include "cnfg.h"
22
23 #define MAXDOUBLE ((double)1.797693134862315708e+308)
24 #define MAXFLOAT ((float)3.40282346638528860e+38)
25
26 /* shift values for each data type (used by other modules) */
27 int __fort_shifts[__NTYPES]; /* initialized by __fort_init_consts */
28
29 /* size of data type */
30
31 int __fort_size_of[__NTYPES] = {
32 0, /* no type (absent optional argument) */
33 sizeof(__SHORT_T), /* C signed short */
34 sizeof(__USHORT_T), /* C unsigned short */
35 sizeof(__CINT_T), /* C signed int */
36 sizeof(__UINT_T), /* C unsigned int */
37 sizeof(__LONG_T), /* C signed long int */
38 sizeof(__ULONG_T), /* C unsigned long int */
39 sizeof(__FLOAT_T), /* C float */
40 sizeof(__DOUBLE_T), /* C double */
41 sizeof(__CPLX8_T), /* F complex*8 (2x real*4) */
42 sizeof(__CPLX16_T), /* F complex*16 (2x real*8) */
43 sizeof(__CHAR_T), /* C signed char */
44 sizeof(__UCHAR_T), /* C unsigned char */
45 sizeof(__LONGDOUBLE_T), /* C long double */
46 sizeof(__STR_T), /* F character */
47 sizeof(__LONGLONG_T), /* C long long */
48 sizeof(__ULONGLONG_T), /* C unsigned long long */
49 sizeof(__LOG1_T), /* F logical*1 */
50 sizeof(__LOG2_T), /* F logical*2 */
51 sizeof(__LOG4_T), /* F logical*4 */
52 sizeof(__LOG8_T), /* F logical*8 */
53 sizeof(__WORD4_T), /* F typeless */
54 sizeof(__WORD8_T), /* F double typeless */
55 sizeof(__NCHAR_T), /* F ncharacter - kanji */
56 sizeof(__INT2_T), /* F integer*2 */
57 sizeof(__INT4_T), /* F integer*4 */
58 sizeof(__INT8_T), /* F integer*8 */
59 sizeof(__REAL4_T), /* F real*4 */
60 sizeof(__REAL8_T), /* F real*8 */
61 sizeof(__REAL16_T), /* F real*16 */
62 sizeof(__CPLX32_T), /* F complex*32 (2x real*16) */
63 sizeof(__WORD16_T), /* F quad typeless */
64 sizeof(__INT1_T), /* F integer*1 */
65 sizeof(__DERIVED_T), /* F derived type */
66 sizeof(__PROC_T), /* __PROC */
67 sizeof(__DESC_T), /* __DESC */
68 sizeof(__SKED_T), /* __SKED */
69 16, /* __M128 */
70 32, /* __M256 */
71 16, /* F integer*16 */
72 16, /* F logical*16 */
73 16, /* F real*16 */
74 32, /* F complex*32 */
75 sizeof(__POLY_T), /* F polymorphic derived type */
76 sizeof(__PROCPTR_T), /* F procedure pointer */
77 };
78
79 char *__fort_typenames[__NTYPES] = {
80 "none", /* no type (absent optional argument) */
81 "short", /* C signed short */
82 "unsigned short", /* C unsigned short */
83 "int", /* C signed int */
84 "unsigned int", /* C unsigned int */
85 "long", /* C signed long int */
86 "unsigned long", /* C unsigned long int */
87 "float", /* C float */
88 "double", /* C double */
89 "complex*8", /* F complex*8 (2x real*4) */
90 "complex*16", /* F complex*16 (2x real*8) */
91 "char", /* C signed char */
92 "unsigned char", /* C unsigned char */
93 "long double", /* C long double */
94 "character*(*)", /* F character */
95 "long long", /* C long long */
96 "unsigned long long", /* C unsigned long long */
97 "logical*1", /* F logical*1 */
98 "logical*2", /* F logical*2 */
99 "logical*4", /* F logical*4 */
100 "logical*8", /* F logical*8 */
101 "word*4", /* F typeless */
102 "word*8", /* F double typeless */
103 "nchar*2", /* F ncharacter - kanji */
104 "integer*2", /* F integer*2 */
105 "integer*4", /* F integer*4 */
106 "integer*8", /* F integer*8 */
107 "real*4", /* F real*4 */
108 "real*8", /* F real*8 */
109 "real*16", /* F real*16 */
110 "complex*32", /* F complex*32 (2x real*16) */
111 "word*16", /* F quad typeless */
112 "integer*1", /* F integer*1 */
113 "type()", /* F derived type */
114 "rte34", /* __PROC */
115 "rte35", /* __DESC */
116 "rte36", /* __SKED */
117 "m128", /* __M128 */
118 "m256", /* __M256 */
119 "integer*16", /* F integer*16 */
120 "logical*16", /* F logical*16 */
121 "real*16", /* F real*16 */
122 "complex*32", /* F complex*32 */
123 "class()", /* F polymorphic variable */
124 "procedure ptr", /* F procedure pointer */
125 };
126
127 /* internal datatype array, -42:42
128 * These values should be the same as what's in rest.c
129 */
130 __INT_T ENTCOMN(TYPE, type)[] = {
131 -43, -42, -41, -40, -39, -38, -37, -36, -35, -34, -33, -32, -31, -30, -29,
132 -28, -27, -26, -25, -24, -23, -22, -21, -20, -19, -18, -17, -16, -15, -14,
133 -13, -12, -11, -10, -9, -8, -7, -6, -5, -4, -3, -2, -1, 0, 1,
134 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,
135 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
136 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43};
137
138 #if defined(WINNT) && !defined(WIN64) && !defined(WIN32)
139 char *
__get_fort_type_addr(void)140 __get_fort_type_addr(void)
141 {
142 return (char *)ENTCOMN(TYPE, type);
143 }
144 #endif
145
146 /* universal constants */
147
148 long long int __fort_one[4] = {~0, ~0, ~0, ~0};
149 long long int __fort_zed[4] = {0, 0, 0, 0};
150
151 /* maximum values */
152
153 static __INT1_T max_int1 = 0; /* initialized */
154 static __INT2_T max_int2 = 0; /* initialized */
155 static __INT4_T max_int4 = 0; /* initialized */
156 static __INT8_T max_int8 = 0; /* initialized */
157 static __STR_T max_str = (__STR_T) 255; /* initialized */
158 static __REAL4_T max_real4 = MAXFLOAT;
159 static __REAL8_T max_real8 = MAXDOUBLE;
160 static __REAL16_T max_real16 = MAXDOUBLE;
161
162 void *__fort_maxs[__NTYPES] = {
163 (void *)0, /* 0 __NONE no type */
164 (void *)0, /* 1 __SHORT short */
165 (void *)0, /* 2 __USHORT unsigned short */
166 (void *)0, /* 3 __CINT int */
167 (void *)0, /* 4 __UINT unsigned int */
168 (void *)0, /* 5 __LONG long */
169 (void *)0, /* 6 __ULONG unsigned long */
170 (void *)0, /* 7 __FLOAT float */
171 (void *)0, /* 8 __DOUBLE double */
172 (void *)0, /* 9 __CPLX8 float complex */
173 (void *)0, /* 10 __CPLX16 double complex */
174 (void *)0, /* 11 __CHAR char */
175 (void *)0, /* 12 __UCHAR unsigned char */
176 (void *)0, /* 13 __LONGDOUBLE long double */
177 (char *) & max_str, /* 14 __STR string */
178 (void *)0, /* 15 __LONGLONG long long */
179 (void *)0, /* 16 __ULONGLONG unsigned long long */
180 __fort_zed, /* 17 __LOG1 logical*1 */
181 __fort_zed, /* 18 __LOG2 logical*2 */
182 __fort_zed, /* 19 __LOG4 logical*4*/
183 __fort_zed, /* 20 __LOG8 logical*8 */
184 (void *)0, /* 21 __WORD4 typeless */
185 (void *)0, /* 22 __WORD8 double typeless */
186 (void *)0, /* 23 __NCHAR ncharacter - kanji */
187 &max_int2, /* 24 __INT2 integer*2 */
188 &max_int4, /* 25 __INT4 integer*4 */
189 &max_int8, /* 26 __INT8 integer*8 */
190 &max_real4, /* 27 __REAL4 real*4 */
191 &max_real8, /* 28 __REAL8 real*8 */
192 &max_real16, /* 29 __REAL16 real*16 */
193 (void *)0, /* 30 __CPLX32 complex*32 */
194 (void *)0, /* 31 __WORD16 quad typeless */
195 &max_int1, /* 32 __INT1 integer*1 */
196 (void *)0, /* 33 __DERIVED derived type */
197 (void *)0, /* 34 __PROC processors descriptor */
198 (void *)0, /* 35 __DESC section descriptor */
199 (void *)0, /* 36 __SKED communication schedule */
200 (void *)0, /* 37 __M128 128-bit type */
201 (void *)0, /* 38 __M256 256-bit type */
202 (void *)0, /* 39 __INT16 integer(16) */
203 (void *)0, /* 40 __LOG16 logical(16) */
204 (void *)0, /* 41 __QREAL16 real(16) */
205 (void *)0, /* 42 __QCPLX32 complex(32) */
206 (void *)0, /* 43 __POLY polymorphic derived type */
207 (void *)0, /* 44 __PROCPTR procedure pointer */
208 };
209
210 /* minimum values */
211
212 static __INT1_T min_int1 = 0; /* initialized */
213 static __INT2_T min_int2 = 0; /* initialized */
214 static __INT4_T min_int4 = 0; /* initialized */
215 static __INT8_T min_int8 = 0; /* initialized */
216 static __STR_T min_str = 0; /* initialized */
217 static __REAL4_T min_real4 = -MAXFLOAT;
218 static __REAL8_T min_real8 = -MAXDOUBLE;
219 static __REAL16_T min_real16 = -MAXDOUBLE;
220
221 void *__fort_mins[__NTYPES] = {
222 (void *)0, /* 0 __NONE no type */
223 (void *)0, /* 1 __SHORT short */
224 (void *)0, /* 2 __USHORT unsigned short */
225 (void *)0, /* 3 __CINT int */
226 (void *)0, /* 4 __UINT unsigned int */
227 (void *)0, /* 5 __LONG long */
228 (void *)0, /* 6 __ULONG unsigned long */
229 (void *)0, /* 7 __FLOAT float */
230 (void *)0, /* 8 __DOUBLE double */
231 (void *)0, /* 9 __CPLX8 float complex */
232 (void *)0, /* 10 __CPLX16 double complex */
233 (void *)0, /* 11 __CHAR char */
234 (void *)0, /* 12 __UCHAR unsigned char */
235 (void *)0, /* 13 __LONGDOUBLE long double */
236 (char *) & min_str, /* 14 __STR string */
237 (void *)0, /* 15 __LONGLONG long long */
238 (void *)0, /* 16 __ULONGLONG unsigned long long */
239 __fort_zed, /* 17 __LOG1 logical*1 */
240 __fort_zed, /* 18 __LOG2 logical*2 */
241 __fort_zed, /* 19 __LOG4 logical*4*/
242 __fort_zed, /* 20 __LOG8 logical*8 */
243 (void *)0, /* 21 __WORD4 typeless */
244 (void *)0, /* 22 __WORD8 double typeless */
245 (void *)0, /* 23 __NCHAR ncharacter - kanji */
246 &min_int2, /* 24 __INT2 integer*2 */
247 &min_int4, /* 25 __INT4 integer*4 */
248 &min_int8, /* 26 __INT8 integer*8 */
249 &min_real4, /* 27 __REAL4 real*4 */
250 &min_real8, /* 28 __REAL8 real*8 */
251 &min_real16, /* 29 __REAL16 real*16 */
252 (void *)0, /* 30 __CPLX32 complex*32 */
253 (void *)0, /* 31 __WORD16 quad typeless */
254 &min_int1, /* 32 __INT1 integer*1 */
255 (void *)0, /* 33 __DERIVED derived type */
256 (void *)0, /* 34 __PROC processors descriptor */
257 (void *)0, /* 35 __DESC section descriptor */
258 (void *)0, /* 36 __SKED communication schedule */
259 (void *)0, /* 37 __M128 128-bit type */
260 (void *)0, /* 38 __M256 256-bit type */
261 (void *)0, /* 39 __INT16 integer(16) */
262 (void *)0, /* 40 __LOG16 logical(16) */
263 (void *)0, /* 41 __QREAL16 real(16) */
264 (void *)0, /* 42 __QCPLX32 complex(32) */
265 (void *)0, /* 43 __POLY polymorphic derived type */
266 (void *)0, /* 44 __PROCPTR procedure pointer */
267 };
268
269 /* units */
270
271 static __INT1_T unit_int1 = 1;
272 static __INT2_T unit_int2 = 1;
273 static __INT4_T unit_int4 = 1;
274 static __INT8_T unit_int8 = 1;
275 static __REAL4_T unit_real4 = 1.0;
276 static __REAL8_T unit_real8 = 1.0;
277 static __REAL16_T unit_real16 = 1.0;
278 static __CPLX8_T unit_cplx8 = {1.0, 0.0};
279 static __CPLX16_T unit_cplx16 = {1.0, 0.0};
280 static __CPLX32_T unit_cplx32 = {1.0, 0.0};
281
282 void *__fort_units[__NTYPES] = {
283 (void *)0, /* 0 __NONE no type */
284 (void *)0, /* 1 __SHORT short */
285 (void *)0, /* 2 __USHORT unsigned short */
286 (void *)0, /* 3 __CINT int */
287 (void *)0, /* 4 __UINT unsigned int */
288 (void *)0, /* 5 __LONG long */
289 (void *)0, /* 6 __ULONG unsigned long */
290 (void *)0, /* 7 __FLOAT float */
291 (void *)0, /* 8 __DOUBLE double */
292 &unit_cplx8, /* 9 __CPLX8 float complex */
293 &unit_cplx16, /* 10 __CPLX16 double complex */
294 (void *)0, /* 11 __CHAR char */
295 (void *)0, /* 12 __UCHAR unsigned char */
296 (void *)0, /* 13 __LONGDOUBLE long double */
297 (void *)0, /* 14 __STR string */
298 (void *)0, /* 15 __LONGLONG long long */
299 (void *)0, /* 16 __ULONGLONG unsigned long long */
300 __fort_one, /* 17 __LOG1 logical*1 */
301 __fort_one, /* 18 __LOG2 logical*2 */
302 __fort_one, /* 19 __LOG4 logical*4*/
303 __fort_one, /* 20 __LOG8 logical*8 */
304 (void *)0, /* 21 __WORD4 typeless */
305 (void *)0, /* 22 __WORD8 double typeless */
306 (void *)0, /* 23 __NCHAR ncharacter - kanji */
307 &unit_int2, /* 24 __INT2 integer*2 */
308 &unit_int4, /* 25 __INT4 integer*4 */
309 &unit_int8, /* 26 __INT8 integer*8 */
310 &unit_real4, /* 27 __REAL4 real*4 */
311 &unit_real8, /* 28 __REAL8 real*8 */
312 &unit_real16, /* 29 __REAL16 real*16 */
313 (void *)0, /* 30 __CPLX32 complex*32 */
314 (void *)0, /* 31 __WORD16 quad typeless */
315 &unit_int1, /* 32 __INT1 integer*1 */
316 (void *)0 /* 33 __DERIVED derived type */
317 };
318
319 /* logical trues - initialized from __fort_cnfg_.ftn_true */
320
321 __LOG_T __fort_true_log = 1;
322 __LOG1_T __fort_true_log1;
323 __LOG2_T __fort_true_log2;
324 __LOG4_T __fort_true_log4;
325 __LOG8_T __fort_true_log8;
326 static __INT1_T __fort_true_int1;
327 static __INT2_T __fort_true_int2;
328 static __INT4_T __fort_true_int4;
329 static __INT8_T __fort_true_int8;
330 static __REAL4_T __fort_true_real4;
331 static __REAL8_T __fort_true_real8;
332 static __REAL16_T __fort_true_real16;
333 static __CPLX8_T __fort_true_cplx8;
334 static __CPLX16_T __fort_true_cplx16;
335 static __CPLX32_T __fort_true_cplx32;
336
337 void *__fort_trues[__NTYPES] = {
338 (void *)0, /* 0 __NONE no type */
339 (void *)0, /* 1 __SHORT short */
340 (void *)0, /* 2 __USHORT unsigned short */
341 (void *)0, /* 3 __CINT int */
342 (void *)0, /* 4 __UINT unsigned int */
343 (void *)0, /* 5 __LONG long */
344 (void *)0, /* 6 __ULONG unsigned long */
345 (void *)0, /* 7 __FLOAT float */
346 (void *)0, /* 8 __DOUBLE double */
347 &__fort_true_cplx8, /* 9 __CPLX8 float complex */
348 &__fort_true_cplx16, /* 10 __CPLX16 double complex */
349 (void *)0, /* 11 __CHAR char */
350 (void *)0, /* 12 __UCHAR unsigned char */
351 (void *)0, /* 13 __LONGDOUBLE long double */
352 (void *)0, /* 14 __STR string */
353 (void *)0, /* 15 __LONGLONG long long */
354 (void *)0, /* 16 __ULONGLONG unsigned long long */
355 &__fort_true_log1, /* 17 __LOG1 logical*1 */
356 &__fort_true_log2, /* 18 __LOG2 logical*2 */
357 &__fort_true_log4, /* 19 __LOG4 logical*4 */
358 &__fort_true_log8, /* 20 __LOG8 logical*8 */
359 (void *)0, /* 21 __WORD4 typeless */
360 (void *)0, /* 22 __WORD8 double typeless */
361 (void *)0, /* 23 __NCHAR ncharacter - kanji */
362 &__fort_true_int2, /* 24 __INT2 integer*2 */
363 &__fort_true_int4, /* 25 __INT4 integer*4 */
364 &__fort_true_int8, /* 26 __INT8 integer*8 */
365 &__fort_true_real4, /* 27 __REAL4 real*4 */
366 &__fort_true_real8, /* 28 __REAL8 real*8 */
367 &__fort_true_real16, /* 29 __REAL16 real*16 */
368 &__fort_true_cplx32, /* 30 __CPLX32 complex*32 */
369 (void *)0, /* 31 __WORD16 quad typeless */
370 &__fort_true_int1, /* 32 __INT1 integer*1 */
371 (void *)0 /* 33 __DERIVED derived type */
372 };
373
374 /* logical masks - initialized from __fort_cnfg_.true_mask */
375 __LOG_T __fort_mask_log;
376
377 __LOG1_T __fort_mask_log1;
378 __LOG2_T __fort_mask_log2;
379 __LOG4_T __fort_mask_log4;
380 __LOG8_T __fort_mask_log8;
381 __INT1_T __fort_mask_int1;
382 __INT2_T __fort_mask_int2;
383 __INT4_T __fort_mask_int4;
384 __INT8_T __fort_mask_int8;
385 static __REAL4_T __fort_mask_real4;
386 static __REAL8_T __fort_mask_real8;
387 static __REAL16_T __fort_mask_real16;
388 static __CPLX8_T __fort_mask_cplx8;
389 static __CPLX16_T __fort_mask_cplx16;
390 static __CPLX32_T __fort_mask_cplx32;
391 static __STR_T __fort_mask_str;
392
393 void *__fort_masks[__NTYPES] = {
394 (void *)0, /* 0 __NONE no type */
395 (void *)0, /* 1 __SHORT short */
396 (void *)0, /* 2 __USHORT unsigned short */
397 (void *)0, /* 3 __CINT int */
398 (void *)0, /* 4 __UINT unsigned int */
399 (void *)0, /* 5 __LONG long */
400 (void *)0, /* 6 __ULONG unsigned long */
401 (void *)0, /* 7 __FLOAT float */
402 (void *)0, /* 8 __DOUBLE double */
403 &__fort_mask_cplx8, /* 9 __CPLX8 float complex */
404 &__fort_mask_cplx16, /* 10 __CPLX16 double complex */
405 (void *)0, /* 11 __CHAR char */
406 (void *)0, /* 12 __UCHAR unsigned char */
407 (void *)0, /* 13 __LONGDOUBLE long double */
408 &__fort_mask_str, /* 14 __STR string */
409 (void *)0, /* 15 __LONGLONG long long */
410 (void *)0, /* 16 __ULONGLONG unsigned long long */
411 &__fort_mask_log1, /* 17 __LOG1 logical*1 */
412 &__fort_mask_log2, /* 18 __LOG2 logical*2 */
413 &__fort_mask_log4, /* 19 __LOG4 logical*4*/
414 &__fort_mask_log8, /* 20 __LOG8 logical*8 */
415 (void *)0, /* 21 __WORD4 typeless */
416 (void *)0, /* 22 __WORD8 double typeless */
417 (void *)0, /* 23 __NCHAR ncharacter - kanji */
418 &__fort_mask_int2, /* 24 __INT2 integer*2 */
419 &__fort_mask_int4, /* 25 __INT4 integer*4 */
420 &__fort_mask_int8, /* 26 __INT8 integer*8 */
421 &__fort_mask_real4, /* 27 __REAL4 real*4 */
422 &__fort_mask_real8, /* 28 __REAL8 real*8 */
423 &__fort_mask_real16, /* 29 __REAL16 real*16 */
424 &__fort_mask_cplx32, /* 30 __CPLX32 complex*32 */
425 (void *)0, /* 31 __WORD16 quad typeless */
426 &__fort_mask_log1, /* 32 __INT1 integer*1 */
427 (void *)0 /* 33 __DERIVED derived type */
428 };
429
430 int
__get_size_of(int * idx)431 __get_size_of(int* idx)
432 {
433 return __fort_size_of[*idx];
434 }
435
436 #ifdef WINNT
437
438 /* pg access routines for data shared between windows dlls */
439
440 __LOG_T
__get_fort_true_log(void)441 __get_fort_true_log(void) { return __fort_true_log; }
442
443 __LOG_T *
__get_fort_true_log_addr(void)444 __get_fort_true_log_addr(void)
445 {
446 return &__fort_true_log;
447 }
448
449 __LOG1_T
__get_fort_true_log1(void)450 __get_fort_true_log1(void) { return __fort_true_log1; }
451
452 __LOG2_T
__get_fort_true_log2(void)453 __get_fort_true_log2(void) { return __fort_true_log2; }
454
455 __LOG4_T
__get_fort_true_log4(void)456 __get_fort_true_log4(void) { return __fort_true_log4; }
457
458 __LOG8_T
__get_fort_true_log8(void)459 __get_fort_true_log8(void) { return __fort_true_log8; }
460
461 void
__set_fort_true_log(__LOG_T t)462 __set_fort_true_log(__LOG_T t)
463 {
464 __fort_true_log = t;
465 }
466
467 void
__set_fort_true_log1(__LOG1_T t)468 __set_fort_true_log1(__LOG1_T t)
469 {
470 __fort_true_log1 = t;
471 }
472
473 void
__set_fort_true_log2(__LOG2_T t)474 __set_fort_true_log2(__LOG2_T t)
475 {
476 __fort_true_log2 = t;
477 }
478
479 void
__set_fort_true_log4(__LOG4_T t)480 __set_fort_true_log4(__LOG4_T t)
481 {
482 __fort_true_log4 = t;
483 }
484
485 void
__set_fort_true_log8(__LOG8_T t)486 __set_fort_true_log8(__LOG8_T t)
487 {
488 __fort_true_log8 = t;
489 }
490
491 __LOG_T
__get_fort_mask_log(void)492 __get_fort_mask_log(void) { return __fort_mask_log; }
493
494 __LOG1_T
__get_fort_mask_log1(void)495 __get_fort_mask_log1(void) { return __fort_mask_log1; }
496
497 __LOG2_T
__get_fort_mask_log2(void)498 __get_fort_mask_log2(void) { return __fort_mask_log2; }
499
500 __LOG4_T
__get_fort_mask_log4(void)501 __get_fort_mask_log4(void) { return __fort_mask_log4; }
502
503 __LOG8_T
__get_fort_mask_log8(void)504 __get_fort_mask_log8(void) { return __fort_mask_log8; }
505
506 __INT1_T
__get_fort_mask_int1(void)507 __get_fort_mask_int1(void) { return __fort_mask_int1; }
508
509 __INT2_T
__get_fort_mask_int2(void)510 __get_fort_mask_int2(void) { return __fort_mask_int2; }
511
512 __INT4_T
__get_fort_mask_int4(void)513 __get_fort_mask_int4(void) { return __fort_mask_int4; }
514
515 __INT8_T
__get_fort_mask_int8(void)516 __get_fort_mask_int8(void) { return __fort_mask_int8; }
517
518 __STR_T
__get_fort_mask_str(void)519 __get_fort_mask_str(void) { return __fort_mask_str; }
520
521 void
__set_fort_mask_log(__LOG_T m)522 __set_fort_mask_log(__LOG_T m)
523 {
524 __fort_mask_log = m;
525 }
526
527 void
__set_fort_mask_log1(__LOG1_T m)528 __set_fort_mask_log1(__LOG1_T m)
529 {
530 __fort_mask_log1 = m;
531 }
532
533 void
__set_fort_mask_log2(__LOG2_T m)534 __set_fort_mask_log2(__LOG2_T m)
535 {
536 __fort_mask_log2 = m;
537 }
538
539 void
__set_fort_mask_log4(__LOG4_T m)540 __set_fort_mask_log4(__LOG4_T m)
541 {
542 __fort_mask_log4 = m;
543 }
544
545 void
__set_fort_mask_log8(__LOG8_T m)546 __set_fort_mask_log8(__LOG8_T m)
547 {
548 __fort_mask_log8 = m;
549 }
550
551 void
__set_fort_mask_int1(__INT1_T m)552 __set_fort_mask_int1(__INT1_T m)
553 {
554 __fort_mask_int1 = m;
555 }
556
557 void
__set_fort_mask_int2(__INT2_T m)558 __set_fort_mask_int2(__INT2_T m)
559 {
560 __fort_mask_int2 = m;
561 }
562
563 void
__set_fort_mask_int4(__INT4_T m)564 __set_fort_mask_int4(__INT4_T m)
565 {
566 __fort_mask_int4 = m;
567 }
568
569 void
__set_fort_mask_int8(__INT8_T m)570 __set_fort_mask_int8(__INT8_T m)
571 {
572 __fort_mask_int8 = m;
573 }
574
575 void *
__get_fort_maxs(int idx)576 __get_fort_maxs(int idx)
577 {
578 return __fort_maxs[idx];
579 }
580
581 void *
__get_fort_mins(int idx)582 __get_fort_mins(int idx)
583 {
584 return __fort_mins[idx];
585 }
586
587 int
__get_fort_shifts(int idx)588 __get_fort_shifts(int idx)
589 {
590 return __fort_shifts[idx];
591 }
592
593 int
__get_fort_size_of(int idx)594 __get_fort_size_of(int idx)
595 {
596 return __fort_size_of[idx];
597 }
598
599 void *
__get_fort_trues(int idx)600 __get_fort_trues(int idx)
601 {
602 return __fort_trues[idx];
603 }
604
605 char *
__get_fort_typenames(int idx)606 __get_fort_typenames(int idx)
607 {
608 return __fort_typenames[idx];
609 }
610
611 void *
__get_fort_units(int idx)612 __get_fort_units(int idx)
613 {
614 return __fort_units[idx];
615 }
616
617 void
__set_fort_maxs(int idx,void * val)618 __set_fort_maxs(int idx, void *val)
619 {
620 __fort_maxs[idx] = val;
621 }
622
623 void
__set_fort_mins(int idx,void * val)624 __set_fort_mins(int idx, void *val)
625 {
626 __fort_mins[idx] = val;
627 }
628
629 void
__set_fort_shifts(int idx,int val)630 __set_fort_shifts(int idx, int val)
631 {
632 __fort_shifts[idx] = val;
633 }
634
635 void
__set_fort_size_of(int idx,int val)636 __set_fort_size_of(int idx, int val)
637 {
638 __fort_size_of[idx] = val;
639 }
640
641 void
__set_fort_trues(int idx,void * val)642 __set_fort_trues(int idx, void *val)
643 {
644 __fort_trues[idx] = val;
645 }
646
647 void
__set_fort_typenames(int idx,char * val)648 __set_fort_typenames(int idx, char *val)
649 {
650 __fort_typenames[idx] = val;
651 }
652
653 void
__set_fort_units(int idx,void * val)654 __set_fort_units(int idx, void *val)
655 {
656 __fort_units[idx] = val;
657 }
658
659 long long int *
__get_fort_one(void)660 __get_fort_one(void)
661 {
662 return __fort_one;
663 }
664
665 long long int *
__get_fort_zed(void)666 __get_fort_zed(void)
667 {
668 return __fort_zed;
669 }
670
671 #endif /* WINNT */
672
673 void
__fort_init_consts()674 __fort_init_consts()
675 {
676 int i, j, k;
677 char *m, *t;
678
679 /* Compute max value for N bits: 2**(N-1)-1 can overflow so use 2**(N-2) - 1 + 2**(N-2) */
680 #define MAX_FOR_INT_TYPE(type) \
681 ((type)1 << (8*sizeof(type) - 2)) - 1 + ((type)1 << (8*sizeof(type) - 2));
682 max_int1 = MAX_FOR_INT_TYPE(__INT1_T);
683 max_int2 = MAX_FOR_INT_TYPE(__INT2_T);
684 max_int4 = MAX_FOR_INT_TYPE(__INT4_T);
685 max_int8 = MAX_FOR_INT_TYPE(__INT8_T);
686 #undef MAX_FOR_INT_TYPE
687
688 max_str = (__STR_T) 255;
689
690 min_int1 = -max_int1;
691 min_int2 = -max_int2;
692 min_int4 = -max_int4;
693 min_int8 = -max_int8;
694 min_str = 0;
695
696 __fort_shifts[__NONE] = 0;
697
698 for (i = __NONE + 1; i < __NTYPES; ++i) {
699
700 /* initialize __fort_shifts */
701
702 for (j = 0, k = 1; k < __fort_size_of[i]; ++j, k <<= 1)
703 ;
704 #if defined(DEBUG)
705 if (k != __fort_size_of[i])
706 __fort_abort("init_consts: type size not a power of two");
707 #endif
708 __fort_shifts[i] = j;
709
710 /* initialize logical trues */
711
712 m = (char *)GET_FIO_CNFG_FTN_TRUE_ADDR;
713 t = __fort_trues[i];
714 if (t != (void *)0) {
715 for (j = 0; j < k; ++j)
716 t[j] = m[1];
717 t[0] |= m[0];
718 t[k - 1] |= m[sizeof(GET_FIO_CNFG_FTN_TRUE) - 1];
719 }
720
721 /* initialize logical masks */
722
723 m = (char *)GET_FIO_CNFG_TRUE_MASK_ADDR;
724 t = __fort_masks[i];
725 if (t != (void *)0) {
726 for (j = 0; j < k; ++j)
727 t[j] = m[1];
728 t[0] |= m[0];
729 t[k - 1] |= m[sizeof(GET_FIO_CNFG_TRUE_MASK) - 1];
730 }
731 }
732 __fort_true_log = *(__LOG_T *)__fort_trues[__LOG];
733 __fort_mask_log = *(__LOG_T *)__fort_masks[__LOG];
734
735 #if defined(DEBUG)
736
737 /* check compiler-runtime descriptor interface constants */
738
739 if (sizeof(__POINT_T) != sizeof(char *))
740 __fort_abort("init_consts: __POINT_T is not pointer size");
741
742 if (sizeof(F90_Desc) !=
743 (F90_DESC_HDR_INT_LEN * sizeof(__INT_T) +
744 F90_DESC_HDR_PTR_LEN * sizeof(__POINT_T) +
745 MAXDIMS * (F90_DESC_DIM_INT_LEN * sizeof(__INT_T) +
746 F90_DESC_DIM_PTR_LEN * sizeof(__POINT_T))))
747 __fort_abort("init_consts: F90_DESC_HDR INT/PTR_LEN incorrect");
748
749 if (sizeof(DIST_Desc) !=
750 (DIST_DESC_HDR_INT_LEN * sizeof(__INT_T) +
751 DIST_DESC_HDR_PTR_LEN * sizeof(__POINT_T) +
752 MAXDIMS * (DIST_DESC_DIM_INT_LEN * sizeof(__INT_T) +
753 DIST_DESC_DIM_PTR_LEN * sizeof(__POINT_T))))
754 __fort_abort("init_consts: DIST_DESC_HDR INT/PTR_LEN incorrect");
755
756 /* check reciprocal operations */
757
758 for (j = 1; j <= 10; ++j) {
759 __INT_T j_recip = RECIP(j);
760 for (i = 0; i < 100; ++i) {
761 int quo, rem;
762 RECIP_DIV(&quo, i, j);
763 if (quo != i / j)
764 __fort_abort("init_consts: RECIP_DIV failed");
765 RECIP_MOD(&rem, i, j);
766 if (rem != i % j)
767 __fort_abort("init_consts: RECIP_MOD failed");
768 RECIP_DIVMOD(&quo, &rem, i, j);
769 if (quo != i / j || rem != i % j)
770 __fort_abort("init_consts: RECIP_DIVMOD failed");
771 }
772 }
773 #endif
774 }
775
776 /*
777 * Always emit the comms for non-windows systems.
778 */
779 #ifdef WINNT
780 /*
781 * Emit the comms for win if pg.dll is not used -- PGDLL is defined
782 * if we need to revert to pg.dll.
783 */
784 #endif
785 __INT_T ENTCOMN(0, 0)[4];
786 __STR_T ENTCOMN(0C, 0c)[1];
787 __INT_T ENTCOMN(LOCAL_MODE, local_mode)[1];
788 __INT_T ENTCOMN(NP, np)[1];
789 __INT_T ENTCOMN(ME, me)[1];
790 __INT_T LINENO[1];
791
792