5804 lines
128 KiB
C
5804 lines
128 KiB
C
/* bld.c -- Implementation File (module.c template V1.0)
|
||
Copyright (C) 1995, 1996 Free Software Foundation, Inc.
|
||
Contributed by James Craig Burley.
|
||
|
||
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.
|
||
|
||
Related Modules:
|
||
None
|
||
|
||
Description:
|
||
The primary "output" of the FFE includes ffebld objects, which
|
||
connect expressions, operators, and operands together, along with
|
||
connecting lists of expressions together for argument or dimension
|
||
lists.
|
||
|
||
Modifications:
|
||
30-Aug-92 JCB 1.1
|
||
Change names of some things for consistency.
|
||
*/
|
||
|
||
/* Include files. */
|
||
|
||
#include "proj.h"
|
||
#include "bld.h"
|
||
#include "bit.h"
|
||
#include "info.h"
|
||
#include "lex.h"
|
||
#include "malloc.h"
|
||
#include "target.h"
|
||
#include "where.h"
|
||
|
||
/* Externals defined here. */
|
||
|
||
ffebldArity ffebld_arity_op_[]
|
||
=
|
||
{
|
||
#define FFEBLD_OP(KWD,NAME,ARITY) ARITY,
|
||
#include "bld-op.def"
|
||
#undef FFEBLD_OP
|
||
};
|
||
struct _ffebld_pool_stack_ ffebld_pool_stack_;
|
||
|
||
/* Simple definitions and enumerations. */
|
||
|
||
|
||
/* Internal typedefs. */
|
||
|
||
|
||
/* Private include files. */
|
||
|
||
|
||
/* Internal structure definitions. */
|
||
|
||
|
||
/* Static objects accessed by functions in this module. */
|
||
|
||
#if FFEBLD_BLANK_
|
||
static struct _ffebld_ ffebld_blank_
|
||
=
|
||
{
|
||
0,
|
||
{FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0, FFEINFO_kindNONE,
|
||
FFEINFO_whereNONE, FFETARGET_charactersizeNONE},
|
||
{NULL, NULL}
|
||
};
|
||
#endif
|
||
#if FFETARGET_okCHARACTER1
|
||
static ffebldConstant ffebld_constant_character1_;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER2
|
||
static ffebldConstant ffebld_constant_character2_;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER3
|
||
static ffebldConstant ffebld_constant_character3_;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER4
|
||
static ffebldConstant ffebld_constant_character4_;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER5
|
||
static ffebldConstant ffebld_constant_character5_;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER6
|
||
static ffebldConstant ffebld_constant_character6_;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER7
|
||
static ffebldConstant ffebld_constant_character7_;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER8
|
||
static ffebldConstant ffebld_constant_character8_;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX1
|
||
static ffebldConstant ffebld_constant_complex1_;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX2
|
||
static ffebldConstant ffebld_constant_complex2_;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX3
|
||
static ffebldConstant ffebld_constant_complex3_;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX4
|
||
static ffebldConstant ffebld_constant_complex4_;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX5
|
||
static ffebldConstant ffebld_constant_complex5_;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX6
|
||
static ffebldConstant ffebld_constant_complex6_;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX7
|
||
static ffebldConstant ffebld_constant_complex7_;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX8
|
||
static ffebldConstant ffebld_constant_complex8_;
|
||
#endif
|
||
#if FFETARGET_okINTEGER1
|
||
static ffebldConstant ffebld_constant_integer1_;
|
||
#endif
|
||
#if FFETARGET_okINTEGER2
|
||
static ffebldConstant ffebld_constant_integer2_;
|
||
#endif
|
||
#if FFETARGET_okINTEGER3
|
||
static ffebldConstant ffebld_constant_integer3_;
|
||
#endif
|
||
#if FFETARGET_okINTEGER4
|
||
static ffebldConstant ffebld_constant_integer4_;
|
||
#endif
|
||
#if FFETARGET_okINTEGER5
|
||
static ffebldConstant ffebld_constant_integer5_;
|
||
#endif
|
||
#if FFETARGET_okINTEGER6
|
||
static ffebldConstant ffebld_constant_integer6_;
|
||
#endif
|
||
#if FFETARGET_okINTEGER7
|
||
static ffebldConstant ffebld_constant_integer7_;
|
||
#endif
|
||
#if FFETARGET_okINTEGER8
|
||
static ffebldConstant ffebld_constant_integer8_;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL1
|
||
static ffebldConstant ffebld_constant_logical1_;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL2
|
||
static ffebldConstant ffebld_constant_logical2_;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL3
|
||
static ffebldConstant ffebld_constant_logical3_;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL4
|
||
static ffebldConstant ffebld_constant_logical4_;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL5
|
||
static ffebldConstant ffebld_constant_logical5_;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL6
|
||
static ffebldConstant ffebld_constant_logical6_;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL7
|
||
static ffebldConstant ffebld_constant_logical7_;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL8
|
||
static ffebldConstant ffebld_constant_logical8_;
|
||
#endif
|
||
#if FFETARGET_okREAL1
|
||
static ffebldConstant ffebld_constant_real1_;
|
||
#endif
|
||
#if FFETARGET_okREAL2
|
||
static ffebldConstant ffebld_constant_real2_;
|
||
#endif
|
||
#if FFETARGET_okREAL3
|
||
static ffebldConstant ffebld_constant_real3_;
|
||
#endif
|
||
#if FFETARGET_okREAL4
|
||
static ffebldConstant ffebld_constant_real4_;
|
||
#endif
|
||
#if FFETARGET_okREAL5
|
||
static ffebldConstant ffebld_constant_real5_;
|
||
#endif
|
||
#if FFETARGET_okREAL6
|
||
static ffebldConstant ffebld_constant_real6_;
|
||
#endif
|
||
#if FFETARGET_okREAL7
|
||
static ffebldConstant ffebld_constant_real7_;
|
||
#endif
|
||
#if FFETARGET_okREAL8
|
||
static ffebldConstant ffebld_constant_real8_;
|
||
#endif
|
||
static ffebldConstant ffebld_constant_hollerith_;
|
||
static ffebldConstant ffebld_constant_typeless_[FFEBLD_constTYPELESS_LAST
|
||
- FFEBLD_constTYPELESS_FIRST + 1];
|
||
|
||
static const char *ffebld_op_string_[]
|
||
=
|
||
{
|
||
#define FFEBLD_OP(KWD,NAME,ARITY) NAME,
|
||
#include "bld-op.def"
|
||
#undef FFEBLD_OP
|
||
};
|
||
|
||
/* Static functions (internal). */
|
||
|
||
|
||
/* Internal macros. */
|
||
|
||
#define integerdefault_ CATX(integer,FFETARGET_ktINTEGERDEFAULT)
|
||
#define logicaldefault_ CATX(logical,FFETARGET_ktLOGICALDEFAULT)
|
||
#define realdefault_ CATX(real,FFETARGET_ktREALDEFAULT)
|
||
#define realdouble_ CATX(real,FFETARGET_ktREALDOUBLE)
|
||
#define realquad_ CATX(real,FFETARGET_ktREALQUAD)
|
||
|
||
/* ffebld_constant_cmp -- Compare two constants a la strcmp
|
||
|
||
ffebldConstant c1, c2;
|
||
if (ffebld_constant_cmp(c1,c2) == 0)
|
||
// they're equal, else they're not.
|
||
|
||
Returns -1 if c1 < c2, 0 if c1 == c2, +1 if c1 == c2. */
|
||
|
||
int
|
||
ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2)
|
||
{
|
||
if (c1 == c2)
|
||
return 0;
|
||
|
||
assert (ffebld_constant_type (c1) == ffebld_constant_type (c2));
|
||
|
||
switch (ffebld_constant_type (c1))
|
||
{
|
||
#if FFETARGET_okINTEGER1
|
||
case FFEBLD_constINTEGER1:
|
||
return ffetarget_cmp_integer1 (ffebld_constant_integer1 (c1),
|
||
ffebld_constant_integer1 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER2
|
||
case FFEBLD_constINTEGER2:
|
||
return ffetarget_cmp_integer2 (ffebld_constant_integer2 (c1),
|
||
ffebld_constant_integer2 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER3
|
||
case FFEBLD_constINTEGER3:
|
||
return ffetarget_cmp_integer3 (ffebld_constant_integer3 (c1),
|
||
ffebld_constant_integer3 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER4
|
||
case FFEBLD_constINTEGER4:
|
||
return ffetarget_cmp_integer4 (ffebld_constant_integer4 (c1),
|
||
ffebld_constant_integer4 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER5
|
||
case FFEBLD_constINTEGER5:
|
||
return ffetarget_cmp_integer5 (ffebld_constant_integer5 (c1),
|
||
ffebld_constant_integer5 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER6
|
||
case FFEBLD_constINTEGER6:
|
||
return ffetarget_cmp_integer6 (ffebld_constant_integer6 (c1),
|
||
ffebld_constant_integer6 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER7
|
||
case FFEBLD_constINTEGER7:
|
||
return ffetarget_cmp_integer7 (ffebld_constant_integer7 (c1),
|
||
ffebld_constant_integer7 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER8
|
||
case FFEBLD_constINTEGER8:
|
||
return ffetarget_cmp_integer8 (ffebld_constant_integer8 (c1),
|
||
ffebld_constant_integer8 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL1
|
||
case FFEBLD_constLOGICAL1:
|
||
return ffetarget_cmp_logical1 (ffebld_constant_logical1 (c1),
|
||
ffebld_constant_logical1 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL2
|
||
case FFEBLD_constLOGICAL2:
|
||
return ffetarget_cmp_logical2 (ffebld_constant_logical2 (c1),
|
||
ffebld_constant_logical2 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL3
|
||
case FFEBLD_constLOGICAL3:
|
||
return ffetarget_cmp_logical3 (ffebld_constant_logical3 (c1),
|
||
ffebld_constant_logical3 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL4
|
||
case FFEBLD_constLOGICAL4:
|
||
return ffetarget_cmp_logical4 (ffebld_constant_logical4 (c1),
|
||
ffebld_constant_logical4 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL5
|
||
case FFEBLD_constLOGICAL5:
|
||
return ffetarget_cmp_logical5 (ffebld_constant_logical5 (c1),
|
||
ffebld_constant_logical5 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL6
|
||
case FFEBLD_constLOGICAL6:
|
||
return ffetarget_cmp_logical6 (ffebld_constant_logical6 (c1),
|
||
ffebld_constant_logical6 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL7
|
||
case FFEBLD_constLOGICAL7:
|
||
return ffetarget_cmp_logical7 (ffebld_constant_logical7 (c1),
|
||
ffebld_constant_logical7 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL8
|
||
case FFEBLD_constLOGICAL8:
|
||
return ffetarget_cmp_logical8 (ffebld_constant_logical8 (c1),
|
||
ffebld_constant_logical8 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL1
|
||
case FFEBLD_constREAL1:
|
||
return ffetarget_cmp_real1 (ffebld_constant_real1 (c1),
|
||
ffebld_constant_real1 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL2
|
||
case FFEBLD_constREAL2:
|
||
return ffetarget_cmp_real2 (ffebld_constant_real2 (c1),
|
||
ffebld_constant_real2 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL3
|
||
case FFEBLD_constREAL3:
|
||
return ffetarget_cmp_real3 (ffebld_constant_real3 (c1),
|
||
ffebld_constant_real3 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL4
|
||
case FFEBLD_constREAL4:
|
||
return ffetarget_cmp_real4 (ffebld_constant_real4 (c1),
|
||
ffebld_constant_real4 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL5
|
||
case FFEBLD_constREAL5:
|
||
return ffetarget_cmp_real5 (ffebld_constant_real5 (c1),
|
||
ffebld_constant_real5 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL6
|
||
case FFEBLD_constREAL6:
|
||
return ffetarget_cmp_real6 (ffebld_constant_real6 (c1),
|
||
ffebld_constant_real6 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL7
|
||
case FFEBLD_constREAL7:
|
||
return ffetarget_cmp_real7 (ffebld_constant_real7 (c1),
|
||
ffebld_constant_real7 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL8
|
||
case FFEBLD_constREAL8:
|
||
return ffetarget_cmp_real8 (ffebld_constant_real8 (c1),
|
||
ffebld_constant_real8 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER1
|
||
case FFEBLD_constCHARACTER1:
|
||
return ffetarget_cmp_character1 (ffebld_constant_character1 (c1),
|
||
ffebld_constant_character1 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER2
|
||
case FFEBLD_constCHARACTER2:
|
||
return ffetarget_cmp_character2 (ffebld_constant_character2 (c1),
|
||
ffebld_constant_character2 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER3
|
||
case FFEBLD_constCHARACTER3:
|
||
return ffetarget_cmp_character3 (ffebld_constant_character3 (c1),
|
||
ffebld_constant_character3 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER4
|
||
case FFEBLD_constCHARACTER4:
|
||
return ffetarget_cmp_character4 (ffebld_constant_character4 (c1),
|
||
ffebld_constant_character4 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER5
|
||
case FFEBLD_constCHARACTER5:
|
||
return ffetarget_cmp_character5 (ffebld_constant_character5 (c1),
|
||
ffebld_constant_character5 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER6
|
||
case FFEBLD_constCHARACTER6:
|
||
return ffetarget_cmp_character6 (ffebld_constant_character6 (c1),
|
||
ffebld_constant_character6 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER7
|
||
case FFEBLD_constCHARACTER7:
|
||
return ffetarget_cmp_character7 (ffebld_constant_character7 (c1),
|
||
ffebld_constant_character7 (c2));
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER8
|
||
case FFEBLD_constCHARACTER8:
|
||
return ffetarget_cmp_character8 (ffebld_constant_character8 (c1),
|
||
ffebld_constant_character8 (c2));
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad constant type" == NULL);
|
||
return 0;
|
||
}
|
||
}
|
||
|
||
/* ffebld_constant_dump -- Display summary of constant's contents
|
||
|
||
ffebldConstant c;
|
||
ffebld_constant_dump(c);
|
||
|
||
Displays the constant in summary form. */
|
||
|
||
#if FFECOM_targetCURRENT == FFECOM_targetFFE
|
||
void
|
||
ffebld_constant_dump (ffebldConstant c)
|
||
{
|
||
switch (ffebld_constant_type (c))
|
||
{
|
||
#if FFETARGET_okINTEGER1
|
||
case FFEBLD_constINTEGER1:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
|
||
FFEINFO_kindtypeINTEGER1);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER2
|
||
case FFEBLD_constINTEGER2:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
|
||
FFEINFO_kindtypeINTEGER2);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER3
|
||
case FFEBLD_constINTEGER3:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
|
||
FFEINFO_kindtypeINTEGER3);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER4
|
||
case FFEBLD_constINTEGER4:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
|
||
FFEINFO_kindtypeINTEGER4);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER5
|
||
case FFEBLD_constINTEGER5:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
|
||
FFEINFO_kindtypeINTEGER5);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER6
|
||
case FFEBLD_constINTEGER6:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
|
||
FFEINFO_kindtypeINTEGER6);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER7
|
||
case FFEBLD_constINTEGER7:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
|
||
FFEINFO_kindtypeINTEGER7);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER8
|
||
case FFEBLD_constINTEGER8:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
|
||
FFEINFO_kindtypeINTEGER8);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER8);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL1
|
||
case FFEBLD_constLOGICAL1:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
|
||
FFEINFO_kindtypeLOGICAL1);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL2
|
||
case FFEBLD_constLOGICAL2:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
|
||
FFEINFO_kindtypeLOGICAL2);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL3
|
||
case FFEBLD_constLOGICAL3:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
|
||
FFEINFO_kindtypeLOGICAL3);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL4
|
||
case FFEBLD_constLOGICAL4:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
|
||
FFEINFO_kindtypeLOGICAL4);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL5
|
||
case FFEBLD_constLOGICAL5:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
|
||
FFEINFO_kindtypeLOGICAL5);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL6
|
||
case FFEBLD_constLOGICAL6:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
|
||
FFEINFO_kindtypeLOGICAL6);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL7
|
||
case FFEBLD_constLOGICAL7:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
|
||
FFEINFO_kindtypeLOGICAL7);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL8
|
||
case FFEBLD_constLOGICAL8:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
|
||
FFEINFO_kindtypeLOGICAL8);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL8);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL1
|
||
case FFEBLD_constREAL1:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
|
||
FFEINFO_kindtypeREAL1);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL2
|
||
case FFEBLD_constREAL2:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
|
||
FFEINFO_kindtypeREAL2);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL3
|
||
case FFEBLD_constREAL3:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
|
||
FFEINFO_kindtypeREAL3);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL4
|
||
case FFEBLD_constREAL4:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
|
||
FFEINFO_kindtypeREAL4);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL5
|
||
case FFEBLD_constREAL5:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
|
||
FFEINFO_kindtypeREAL5);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL6
|
||
case FFEBLD_constREAL6:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
|
||
FFEINFO_kindtypeREAL6);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL7
|
||
case FFEBLD_constREAL7:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
|
||
FFEINFO_kindtypeREAL7);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL8
|
||
case FFEBLD_constREAL8:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
|
||
FFEINFO_kindtypeREAL8);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL8);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX1
|
||
case FFEBLD_constCOMPLEX1:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
|
||
FFEINFO_kindtypeREAL1);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX2
|
||
case FFEBLD_constCOMPLEX2:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
|
||
FFEINFO_kindtypeREAL2);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX3
|
||
case FFEBLD_constCOMPLEX3:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
|
||
FFEINFO_kindtypeREAL3);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX4
|
||
case FFEBLD_constCOMPLEX4:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
|
||
FFEINFO_kindtypeREAL4);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX5
|
||
case FFEBLD_constCOMPLEX5:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
|
||
FFEINFO_kindtypeREAL5);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX6
|
||
case FFEBLD_constCOMPLEX6:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
|
||
FFEINFO_kindtypeREAL6);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX7
|
||
case FFEBLD_constCOMPLEX7:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
|
||
FFEINFO_kindtypeREAL7);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX8
|
||
case FFEBLD_constCOMPLEX8:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
|
||
FFEINFO_kindtypeREAL8);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL8);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER1
|
||
case FFEBLD_constCHARACTER1:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
|
||
FFEINFO_kindtypeCHARACTER1);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER2
|
||
case FFEBLD_constCHARACTER2:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
|
||
FFEINFO_kindtypeCHARACTER2);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER3
|
||
case FFEBLD_constCHARACTER3:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
|
||
FFEINFO_kindtypeCHARACTER3);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER4
|
||
case FFEBLD_constCHARACTER4:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
|
||
FFEINFO_kindtypeCHARACTER4);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER5
|
||
case FFEBLD_constCHARACTER5:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
|
||
FFEINFO_kindtypeCHARACTER5);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER6
|
||
case FFEBLD_constCHARACTER6:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
|
||
FFEINFO_kindtypeCHARACTER6);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER7
|
||
case FFEBLD_constCHARACTER7:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
|
||
FFEINFO_kindtypeCHARACTER7);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER8
|
||
case FFEBLD_constCHARACTER8:
|
||
ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
|
||
FFEINFO_kindtypeCHARACTER8);
|
||
ffebld_constantunion_dump (ffebld_constant_union (c),
|
||
FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER8);
|
||
break;
|
||
#endif
|
||
|
||
case FFEBLD_constHOLLERITH:
|
||
fprintf (dmpout, "H%" ffetargetHollerithSize_f "u/",
|
||
ffebld_constant_hollerith (c).length);
|
||
ffetarget_print_hollerith (dmpout, ffebld_constant_hollerith (c));
|
||
break;
|
||
|
||
case FFEBLD_constBINARY_MIL:
|
||
fprintf (dmpout, "BM/");
|
||
ffetarget_print_binarymil (dmpout, ffebld_constant_typeless (c));
|
||
break;
|
||
|
||
case FFEBLD_constBINARY_VXT:
|
||
fprintf (dmpout, "BV/");
|
||
ffetarget_print_binaryvxt (dmpout, ffebld_constant_typeless (c));
|
||
break;
|
||
|
||
case FFEBLD_constOCTAL_MIL:
|
||
fprintf (dmpout, "OM/");
|
||
ffetarget_print_octalmil (dmpout, ffebld_constant_typeless (c));
|
||
break;
|
||
|
||
case FFEBLD_constOCTAL_VXT:
|
||
fprintf (dmpout, "OV/");
|
||
ffetarget_print_octalvxt (dmpout, ffebld_constant_typeless (c));
|
||
break;
|
||
|
||
case FFEBLD_constHEX_X_MIL:
|
||
fprintf (dmpout, "XM/");
|
||
ffetarget_print_hexxmil (dmpout, ffebld_constant_typeless (c));
|
||
break;
|
||
|
||
case FFEBLD_constHEX_X_VXT:
|
||
fprintf (dmpout, "XV/");
|
||
ffetarget_print_hexxvxt (dmpout, ffebld_constant_typeless (c));
|
||
break;
|
||
|
||
case FFEBLD_constHEX_Z_MIL:
|
||
fprintf (dmpout, "ZM/");
|
||
ffetarget_print_hexzmil (dmpout, ffebld_constant_typeless (c));
|
||
break;
|
||
|
||
case FFEBLD_constHEX_Z_VXT:
|
||
fprintf (dmpout, "ZV/");
|
||
ffetarget_print_hexzvxt (dmpout, ffebld_constant_typeless (c));
|
||
break;
|
||
|
||
default:
|
||
assert ("bad constant type" == NULL);
|
||
fprintf (dmpout, "?/?");
|
||
break;
|
||
}
|
||
}
|
||
#endif
|
||
|
||
/* ffebld_constant_is_magical -- Determine if integer is "magical"
|
||
|
||
ffebldConstant c;
|
||
if (ffebld_constant_is_magical(c))
|
||
// it is 2**(n-1), where n is # bits in ffetargetIntegerDefault type
|
||
// (this test is important for 2's-complement machines only). */
|
||
|
||
bool
|
||
ffebld_constant_is_magical (ffebldConstant c)
|
||
{
|
||
switch (ffebld_constant_type (c))
|
||
{
|
||
case FFEBLD_constINTEGERDEFAULT:
|
||
return ffetarget_integerdefault_is_magical (ffebld_constant_integer1 (c));
|
||
|
||
default:
|
||
return FALSE;
|
||
}
|
||
}
|
||
|
||
/* Determine if constant is zero. Used to ensure step count
|
||
for DO loops isn't zero, also to determine if values will
|
||
be binary zeros, so not entirely portable at this point. */
|
||
|
||
bool
|
||
ffebld_constant_is_zero (ffebldConstant c)
|
||
{
|
||
switch (ffebld_constant_type (c))
|
||
{
|
||
#if FFETARGET_okINTEGER1
|
||
case FFEBLD_constINTEGER1:
|
||
return ffebld_constant_integer1 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER2
|
||
case FFEBLD_constINTEGER2:
|
||
return ffebld_constant_integer2 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER3
|
||
case FFEBLD_constINTEGER3:
|
||
return ffebld_constant_integer3 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER4
|
||
case FFEBLD_constINTEGER4:
|
||
return ffebld_constant_integer4 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER5
|
||
case FFEBLD_constINTEGER5:
|
||
return ffebld_constant_integer5 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER6
|
||
case FFEBLD_constINTEGER6:
|
||
return ffebld_constant_integer6 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER7
|
||
case FFEBLD_constINTEGER7:
|
||
return ffebld_constant_integer7 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER8
|
||
case FFEBLD_constINTEGER8:
|
||
return ffebld_constant_integer8 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL1
|
||
case FFEBLD_constLOGICAL1:
|
||
return ffebld_constant_logical1 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL2
|
||
case FFEBLD_constLOGICAL2:
|
||
return ffebld_constant_logical2 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL3
|
||
case FFEBLD_constLOGICAL3:
|
||
return ffebld_constant_logical3 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL4
|
||
case FFEBLD_constLOGICAL4:
|
||
return ffebld_constant_logical4 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL5
|
||
case FFEBLD_constLOGICAL5:
|
||
return ffebld_constant_logical5 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL6
|
||
case FFEBLD_constLOGICAL6:
|
||
return ffebld_constant_logical6 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL7
|
||
case FFEBLD_constLOGICAL7:
|
||
return ffebld_constant_logical7 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL8
|
||
case FFEBLD_constLOGICAL8:
|
||
return ffebld_constant_logical8 (c) == 0;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL1
|
||
case FFEBLD_constREAL1:
|
||
return ffetarget_iszero_real1 (ffebld_constant_real1 (c));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL2
|
||
case FFEBLD_constREAL2:
|
||
return ffetarget_iszero_real2 (ffebld_constant_real2 (c));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL3
|
||
case FFEBLD_constREAL3:
|
||
return ffetarget_iszero_real3 (ffebld_constant_real3 (c));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL4
|
||
case FFEBLD_constREAL4:
|
||
return ffetarget_iszero_real4 (ffebld_constant_real4 (c));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL5
|
||
case FFEBLD_constREAL5:
|
||
return ffetarget_iszero_real5 (ffebld_constant_real5 (c));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL6
|
||
case FFEBLD_constREAL6:
|
||
return ffetarget_iszero_real6 (ffebld_constant_real6 (c));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL7
|
||
case FFEBLD_constREAL7:
|
||
return ffetarget_iszero_real7 (ffebld_constant_real7 (c));
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL8
|
||
case FFEBLD_constREAL8:
|
||
return ffetarget_iszero_real8 (ffebld_constant_real8 (c));
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX1
|
||
case FFEBLD_constCOMPLEX1:
|
||
return ffetarget_iszero_real1 (ffebld_constant_complex1 (c).real)
|
||
&& ffetarget_iszero_real1 (ffebld_constant_complex1 (c).imaginary);
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX2
|
||
case FFEBLD_constCOMPLEX2:
|
||
return ffetarget_iszero_real2 (ffebld_constant_complex2 (c).real)
|
||
&& ffetarget_iszero_real2 (ffebld_constant_complex2 (c).imaginary);
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX3
|
||
case FFEBLD_constCOMPLEX3:
|
||
return ffetarget_iszero_real3 (ffebld_constant_complex3 (c).real)
|
||
&& ffetarget_iszero_real3 (ffebld_constant_complex3 (c).imaginary);
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX4
|
||
case FFEBLD_constCOMPLEX4:
|
||
return ffetarget_iszero_real4 (ffebld_constant_complex4 (c).real)
|
||
&& ffetarget_iszero_real4 (ffebld_constant_complex4 (c).imaginary);
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX5
|
||
case FFEBLD_constCOMPLEX5:
|
||
return ffetarget_iszero_real5 (ffebld_constant_complex5 (c).real)
|
||
&& ffetarget_iszero_real5 (ffebld_constant_complex5 (c).imaginary);
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX6
|
||
case FFEBLD_constCOMPLEX6:
|
||
return ffetarget_iszero_real6 (ffebld_constant_complex6 (c).real)
|
||
&& ffetarget_iszero_real6 (ffebld_constant_complex6 (c).imaginary);
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX7
|
||
case FFEBLD_constCOMPLEX7:
|
||
return ffetarget_iszero_real7 (ffebld_constant_complex7 (c).real)
|
||
&& ffetarget_iszero_real7 (ffebld_constant_complex7 (c).imaginary);
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX8
|
||
case FFEBLD_constCOMPLEX8:
|
||
return ffetarget_iszero_real8 (ffebld_constant_complex8 (c).real)
|
||
&& ffetarget_iszero_real8 (ffebld_constant_complex8 (c).imaginary);
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER1
|
||
case FFEBLD_constCHARACTER1:
|
||
return ffetarget_iszero_character1 (ffebld_constant_character1 (c));
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER2 || FFETARGET_okCHARACTER3 /* ... */
|
||
#error "no support for these!!"
|
||
#endif
|
||
|
||
case FFEBLD_constHOLLERITH:
|
||
return ffetarget_iszero_hollerith (ffebld_constant_hollerith (c));
|
||
|
||
case FFEBLD_constBINARY_MIL:
|
||
case FFEBLD_constBINARY_VXT:
|
||
case FFEBLD_constOCTAL_MIL:
|
||
case FFEBLD_constOCTAL_VXT:
|
||
case FFEBLD_constHEX_X_MIL:
|
||
case FFEBLD_constHEX_X_VXT:
|
||
case FFEBLD_constHEX_Z_MIL:
|
||
case FFEBLD_constHEX_Z_VXT:
|
||
return ffetarget_iszero_typeless (ffebld_constant_typeless (c));
|
||
|
||
default:
|
||
return FALSE;
|
||
}
|
||
}
|
||
|
||
/* ffebld_constant_new_character1 -- Return character1 constant object from token
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okCHARACTER1
|
||
ffebldConstant
|
||
ffebld_constant_new_character1 (ffelexToken t)
|
||
{
|
||
ffetargetCharacter1 val;
|
||
|
||
ffetarget_character1 (&val, t, ffebld_constant_pool());
|
||
return ffebld_constant_new_character1_val (val);
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_character1_val -- Return an character1 constant object
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okCHARACTER1
|
||
ffebldConstant
|
||
ffebld_constant_new_character1_val (ffetargetCharacter1 val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
ffetarget_verify_character1 (ffebld_constant_pool(), val);
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_character1_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
malloc_verify_kp (ffebld_constant_pool(),
|
||
c->next,
|
||
sizeof (*(c->next)));
|
||
ffetarget_verify_character1 (ffebld_constant_pool(),
|
||
ffebld_constant_character1 (c->next));
|
||
cmp = ffetarget_cmp_character1 (val,
|
||
ffebld_constant_character1 (c->next));
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constCHARACTER1",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constCHARACTER1;
|
||
nc->u.character1 = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_complex1 -- Return complex1 constant object from token
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okCOMPLEX1
|
||
ffebldConstant
|
||
ffebld_constant_new_complex1 (ffebldConstant real,
|
||
ffebldConstant imaginary)
|
||
{
|
||
ffetargetComplex1 val;
|
||
|
||
val.real = ffebld_constant_real1 (real);
|
||
val.imaginary = ffebld_constant_real1 (imaginary);
|
||
return ffebld_constant_new_complex1_val (val);
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_complex1_val -- Return a complex1 constant object
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okCOMPLEX1
|
||
ffebldConstant
|
||
ffebld_constant_new_complex1_val (ffetargetComplex1 val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_complex1_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_real1 (val.real, ffebld_constant_complex1 (c->next).real);
|
||
if (cmp == 0)
|
||
cmp = ffetarget_cmp_real1 (val.imaginary,
|
||
ffebld_constant_complex1 (c->next).imaginary);
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constCOMPLEX1",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constCOMPLEX1;
|
||
nc->u.complex1 = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_complex2 -- Return complex2 constant object from token
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okCOMPLEX2
|
||
ffebldConstant
|
||
ffebld_constant_new_complex2 (ffebldConstant real,
|
||
ffebldConstant imaginary)
|
||
{
|
||
ffetargetComplex2 val;
|
||
|
||
val.real = ffebld_constant_real2 (real);
|
||
val.imaginary = ffebld_constant_real2 (imaginary);
|
||
return ffebld_constant_new_complex2_val (val);
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_complex2_val -- Return a complex2 constant object
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okCOMPLEX2
|
||
ffebldConstant
|
||
ffebld_constant_new_complex2_val (ffetargetComplex2 val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_complex2_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_real2 (val.real, ffebld_constant_complex2 (c->next).real);
|
||
if (cmp == 0)
|
||
cmp = ffetarget_cmp_real2 (val.imaginary,
|
||
ffebld_constant_complex2 (c->next).imaginary);
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constCOMPLEX2",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constCOMPLEX2;
|
||
nc->u.complex2 = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_hollerith -- Return hollerith constant object from token
|
||
|
||
See prototype. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_hollerith (ffelexToken t)
|
||
{
|
||
ffetargetHollerith val;
|
||
|
||
ffetarget_hollerith (&val, t, ffebld_constant_pool());
|
||
return ffebld_constant_new_hollerith_val (val);
|
||
}
|
||
|
||
/* ffebld_constant_new_hollerith_val -- Return an hollerith constant object
|
||
|
||
See prototype. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_hollerith_val (ffetargetHollerith val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_hollerith_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_hollerith (val, ffebld_constant_hollerith (c->next));
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constHOLLERITH",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constHOLLERITH;
|
||
nc->u.hollerith = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
/* ffebld_constant_new_integer1 -- Return integer1 constant object from token
|
||
|
||
See prototype.
|
||
|
||
Parses the token as a decimal integer constant, thus it must be an
|
||
FFELEX_typeNUMBER. */
|
||
|
||
#if FFETARGET_okINTEGER1
|
||
ffebldConstant
|
||
ffebld_constant_new_integer1 (ffelexToken t)
|
||
{
|
||
ffetargetInteger1 val;
|
||
|
||
assert (ffelex_token_type (t) == FFELEX_typeNUMBER);
|
||
|
||
ffetarget_integer1 (&val, t);
|
||
return ffebld_constant_new_integer1_val (val);
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_integer1_val -- Return an integer1 constant object
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okINTEGER1
|
||
ffebldConstant
|
||
ffebld_constant_new_integer1_val (ffetargetInteger1 val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_integer1_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_integer1 (val, ffebld_constant_integer1 (c->next));
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constINTEGER1",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constINTEGER1;
|
||
nc->u.integer1 = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_integer2_val -- Return an integer2 constant object
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okINTEGER2
|
||
ffebldConstant
|
||
ffebld_constant_new_integer2_val (ffetargetInteger2 val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_integer2_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_integer2 (val, ffebld_constant_integer2 (c->next));
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constINTEGER2",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constINTEGER2;
|
||
nc->u.integer2 = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_integer3_val -- Return an integer3 constant object
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okINTEGER3
|
||
ffebldConstant
|
||
ffebld_constant_new_integer3_val (ffetargetInteger3 val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_integer3_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_integer3 (val, ffebld_constant_integer3 (c->next));
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constINTEGER3",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constINTEGER3;
|
||
nc->u.integer3 = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_integer4_val -- Return an integer4 constant object
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okINTEGER4
|
||
ffebldConstant
|
||
ffebld_constant_new_integer4_val (ffetargetInteger4 val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_integer4_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_integer4 (val, ffebld_constant_integer4 (c->next));
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constINTEGER4",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constINTEGER4;
|
||
nc->u.integer4 = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_integerbinary -- Return binary constant object from token
|
||
|
||
See prototype.
|
||
|
||
Parses the token as a binary integer constant, thus it must be an
|
||
FFELEX_typeNUMBER. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_integerbinary (ffelexToken t)
|
||
{
|
||
ffetargetIntegerDefault val;
|
||
|
||
assert ((ffelex_token_type (t) == FFELEX_typeNAME)
|
||
|| (ffelex_token_type (t) == FFELEX_typeNUMBER));
|
||
|
||
ffetarget_integerbinary (&val, t);
|
||
return ffebld_constant_new_integerdefault_val (val);
|
||
}
|
||
|
||
/* ffebld_constant_new_integerhex -- Return hex constant object from token
|
||
|
||
See prototype.
|
||
|
||
Parses the token as a hex integer constant, thus it must be an
|
||
FFELEX_typeNUMBER. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_integerhex (ffelexToken t)
|
||
{
|
||
ffetargetIntegerDefault val;
|
||
|
||
assert ((ffelex_token_type (t) == FFELEX_typeNAME)
|
||
|| (ffelex_token_type (t) == FFELEX_typeNUMBER));
|
||
|
||
ffetarget_integerhex (&val, t);
|
||
return ffebld_constant_new_integerdefault_val (val);
|
||
}
|
||
|
||
/* ffebld_constant_new_integeroctal -- Return octal constant object from token
|
||
|
||
See prototype.
|
||
|
||
Parses the token as a octal integer constant, thus it must be an
|
||
FFELEX_typeNUMBER. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_integeroctal (ffelexToken t)
|
||
{
|
||
ffetargetIntegerDefault val;
|
||
|
||
assert ((ffelex_token_type (t) == FFELEX_typeNAME)
|
||
|| (ffelex_token_type (t) == FFELEX_typeNUMBER));
|
||
|
||
ffetarget_integeroctal (&val, t);
|
||
return ffebld_constant_new_integerdefault_val (val);
|
||
}
|
||
|
||
/* ffebld_constant_new_logical1 -- Return logical1 constant object from token
|
||
|
||
See prototype.
|
||
|
||
Parses the token as a decimal logical constant, thus it must be an
|
||
FFELEX_typeNUMBER. */
|
||
|
||
#if FFETARGET_okLOGICAL1
|
||
ffebldConstant
|
||
ffebld_constant_new_logical1 (bool truth)
|
||
{
|
||
ffetargetLogical1 val;
|
||
|
||
ffetarget_logical1 (&val, truth);
|
||
return ffebld_constant_new_logical1_val (val);
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_logical1_val -- Return a logical1 constant object
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okLOGICAL1
|
||
ffebldConstant
|
||
ffebld_constant_new_logical1_val (ffetargetLogical1 val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_logical1_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_logical1 (val, ffebld_constant_logical1 (c->next));
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constLOGICAL1",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constLOGICAL1;
|
||
nc->u.logical1 = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_logical2_val -- Return a logical2 constant object
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okLOGICAL2
|
||
ffebldConstant
|
||
ffebld_constant_new_logical2_val (ffetargetLogical2 val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_logical2_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_logical2 (val, ffebld_constant_logical2 (c->next));
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constLOGICAL2",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constLOGICAL2;
|
||
nc->u.logical2 = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_logical3_val -- Return a logical3 constant object
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okLOGICAL3
|
||
ffebldConstant
|
||
ffebld_constant_new_logical3_val (ffetargetLogical3 val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_logical3_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_logical3 (val, ffebld_constant_logical3 (c->next));
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constLOGICAL3",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constLOGICAL3;
|
||
nc->u.logical3 = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_logical4_val -- Return a logical4 constant object
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okLOGICAL4
|
||
ffebldConstant
|
||
ffebld_constant_new_logical4_val (ffetargetLogical4 val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_logical4_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_logical4 (val, ffebld_constant_logical4 (c->next));
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constLOGICAL4",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constLOGICAL4;
|
||
nc->u.logical4 = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_real1 -- Return real1 constant object from token
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okREAL1
|
||
ffebldConstant
|
||
ffebld_constant_new_real1 (ffelexToken integer, ffelexToken decimal,
|
||
ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
|
||
ffelexToken exponent_digits)
|
||
{
|
||
ffetargetReal1 val;
|
||
|
||
ffetarget_real1 (&val,
|
||
integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
|
||
return ffebld_constant_new_real1_val (val);
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_real1_val -- Return an real1 constant object
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okREAL1
|
||
ffebldConstant
|
||
ffebld_constant_new_real1_val (ffetargetReal1 val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_real1_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_real1 (val, ffebld_constant_real1 (c->next));
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constREAL1",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constREAL1;
|
||
nc->u.real1 = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_real2 -- Return real2 constant object from token
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okREAL2
|
||
ffebldConstant
|
||
ffebld_constant_new_real2 (ffelexToken integer, ffelexToken decimal,
|
||
ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
|
||
ffelexToken exponent_digits)
|
||
{
|
||
ffetargetReal2 val;
|
||
|
||
ffetarget_real2 (&val,
|
||
integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
|
||
return ffebld_constant_new_real2_val (val);
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_real2_val -- Return an real2 constant object
|
||
|
||
See prototype. */
|
||
|
||
#if FFETARGET_okREAL2
|
||
ffebldConstant
|
||
ffebld_constant_new_real2_val (ffetargetReal2 val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_real2_;
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_real2 (val, ffebld_constant_real2 (c->next));
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constREAL2",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = FFEBLD_constREAL2;
|
||
nc->u.real2 = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
#endif
|
||
/* ffebld_constant_new_typeless_bm -- Return typeless constant object from token
|
||
|
||
See prototype.
|
||
|
||
Parses the token as a decimal integer constant, thus it must be an
|
||
FFELEX_typeNUMBER. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_typeless_bm (ffelexToken t)
|
||
{
|
||
ffetargetTypeless val;
|
||
|
||
ffetarget_binarymil (&val, t);
|
||
return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_MIL, val);
|
||
}
|
||
|
||
/* ffebld_constant_new_typeless_bv -- Return typeless constant object from token
|
||
|
||
See prototype.
|
||
|
||
Parses the token as a decimal integer constant, thus it must be an
|
||
FFELEX_typeNUMBER. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_typeless_bv (ffelexToken t)
|
||
{
|
||
ffetargetTypeless val;
|
||
|
||
ffetarget_binaryvxt (&val, t);
|
||
return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_VXT, val);
|
||
}
|
||
|
||
/* ffebld_constant_new_typeless_hxm -- Return typeless constant object from token
|
||
|
||
See prototype.
|
||
|
||
Parses the token as a decimal integer constant, thus it must be an
|
||
FFELEX_typeNUMBER. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_typeless_hxm (ffelexToken t)
|
||
{
|
||
ffetargetTypeless val;
|
||
|
||
ffetarget_hexxmil (&val, t);
|
||
return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_MIL, val);
|
||
}
|
||
|
||
/* ffebld_constant_new_typeless_hxv -- Return typeless constant object from token
|
||
|
||
See prototype.
|
||
|
||
Parses the token as a decimal integer constant, thus it must be an
|
||
FFELEX_typeNUMBER. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_typeless_hxv (ffelexToken t)
|
||
{
|
||
ffetargetTypeless val;
|
||
|
||
ffetarget_hexxvxt (&val, t);
|
||
return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_VXT, val);
|
||
}
|
||
|
||
/* ffebld_constant_new_typeless_hzm -- Return typeless constant object from token
|
||
|
||
See prototype.
|
||
|
||
Parses the token as a decimal integer constant, thus it must be an
|
||
FFELEX_typeNUMBER. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_typeless_hzm (ffelexToken t)
|
||
{
|
||
ffetargetTypeless val;
|
||
|
||
ffetarget_hexzmil (&val, t);
|
||
return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_MIL, val);
|
||
}
|
||
|
||
/* ffebld_constant_new_typeless_hzv -- Return typeless constant object from token
|
||
|
||
See prototype.
|
||
|
||
Parses the token as a decimal integer constant, thus it must be an
|
||
FFELEX_typeNUMBER. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_typeless_hzv (ffelexToken t)
|
||
{
|
||
ffetargetTypeless val;
|
||
|
||
ffetarget_hexzvxt (&val, t);
|
||
return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_VXT, val);
|
||
}
|
||
|
||
/* ffebld_constant_new_typeless_om -- Return typeless constant object from token
|
||
|
||
See prototype.
|
||
|
||
Parses the token as a decimal integer constant, thus it must be an
|
||
FFELEX_typeNUMBER. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_typeless_om (ffelexToken t)
|
||
{
|
||
ffetargetTypeless val;
|
||
|
||
ffetarget_octalmil (&val, t);
|
||
return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_MIL, val);
|
||
}
|
||
|
||
/* ffebld_constant_new_typeless_ov -- Return typeless constant object from token
|
||
|
||
See prototype.
|
||
|
||
Parses the token as a decimal integer constant, thus it must be an
|
||
FFELEX_typeNUMBER. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_typeless_ov (ffelexToken t)
|
||
{
|
||
ffetargetTypeless val;
|
||
|
||
ffetarget_octalvxt (&val, t);
|
||
return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_VXT, val);
|
||
}
|
||
|
||
/* ffebld_constant_new_typeless_val -- Return a typeless constant object
|
||
|
||
See prototype. */
|
||
|
||
ffebldConstant
|
||
ffebld_constant_new_typeless_val (ffebldConst type, ffetargetTypeless val)
|
||
{
|
||
ffebldConstant c;
|
||
ffebldConstant nc;
|
||
int cmp;
|
||
|
||
for (c = (ffebldConstant) &ffebld_constant_typeless_[type
|
||
- FFEBLD_constTYPELESS_FIRST];
|
||
c->next != NULL;
|
||
c = c->next)
|
||
{
|
||
cmp = ffetarget_cmp_typeless (val, ffebld_constant_typeless (c->next));
|
||
if (cmp == 0)
|
||
return c->next;
|
||
if (cmp > 0)
|
||
break;
|
||
}
|
||
|
||
nc = malloc_new_kp (ffebld_constant_pool(),
|
||
"FFEBLD_constTYPELESS",
|
||
sizeof (*nc));
|
||
nc->next = c->next;
|
||
nc->consttype = type;
|
||
nc->u.typeless = val;
|
||
#ifdef FFECOM_constantHOOK
|
||
nc->hook = FFECOM_constantNULL;
|
||
#endif
|
||
c->next = nc;
|
||
|
||
return nc;
|
||
}
|
||
|
||
/* ffebld_constantarray_dump -- Display summary of array's contents
|
||
|
||
ffebldConstantArray a;
|
||
ffeinfoBasictype bt;
|
||
ffeinfoKindtype kt;
|
||
ffetargetOffset size;
|
||
ffebld_constant_dump(a,bt,kt,size,NULL);
|
||
|
||
Displays the constant array in summary form. The fifth argument, if
|
||
supplied, is an ffebit object that is consulted as to whether the
|
||
constant at a particular offset is valid. */
|
||
|
||
#if FFECOM_targetCURRENT == FFECOM_targetFFE
|
||
void
|
||
ffebld_constantarray_dump (ffebldConstantArray array, ffeinfoBasictype bt,
|
||
ffeinfoKindtype kt, ffetargetOffset size, ffebit bits)
|
||
{
|
||
ffetargetOffset i;
|
||
ffebitCount j;
|
||
|
||
ffebld_dump_prefix (dmpout, bt, kt);
|
||
|
||
fprintf (dmpout, "\\(");
|
||
|
||
if (bits == NULL)
|
||
{
|
||
for (i = 0; i < size; ++i)
|
||
{
|
||
ffebld_constantunion_dump (ffebld_constantarray_get (array, bt, kt, i), bt,
|
||
kt);
|
||
if (i != size - 1)
|
||
fputc (',', dmpout);
|
||
}
|
||
}
|
||
else
|
||
{
|
||
bool value;
|
||
ffebitCount length;
|
||
ffetargetOffset offset = 0;
|
||
|
||
do
|
||
{
|
||
ffebit_test (bits, offset, &value, &length);
|
||
if (value && (length != 0))
|
||
{
|
||
if (length == 1)
|
||
fprintf (dmpout, "[%" ffetargetOffset_f "d]:", offset);
|
||
else
|
||
fprintf (dmpout,
|
||
"[%" ffetargetOffset_f "u..%" ffetargetOffset_f "d]:",
|
||
offset, offset + (ffetargetOffset) length - 1);
|
||
for (j = 0; j < length; ++j, ++offset)
|
||
{
|
||
ffebld_constantunion_dump (ffebld_constantarray_get (array, bt, kt,
|
||
offset), bt, kt);
|
||
if (j != length - 1)
|
||
fputc (',', dmpout);
|
||
}
|
||
fprintf (dmpout, ";");
|
||
}
|
||
else
|
||
offset += length;
|
||
}
|
||
while (length != 0);
|
||
}
|
||
fprintf (dmpout, "\\)");
|
||
|
||
}
|
||
#endif
|
||
|
||
/* ffebld_constantarray_get -- Get a value from an array of constants
|
||
|
||
See prototype. */
|
||
|
||
ffebldConstantUnion
|
||
ffebld_constantarray_get (ffebldConstantArray array, ffeinfoBasictype bt,
|
||
ffeinfoKindtype kt, ffetargetOffset offset)
|
||
{
|
||
ffebldConstantUnion u;
|
||
|
||
switch (bt)
|
||
{
|
||
case FFEINFO_basictypeINTEGER:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okINTEGER1
|
||
case FFEINFO_kindtypeINTEGER1:
|
||
u.integer1 = *(array.integer1 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER2
|
||
case FFEINFO_kindtypeINTEGER2:
|
||
u.integer2 = *(array.integer2 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER3
|
||
case FFEINFO_kindtypeINTEGER3:
|
||
u.integer3 = *(array.integer3 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER4
|
||
case FFEINFO_kindtypeINTEGER4:
|
||
u.integer4 = *(array.integer4 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER5
|
||
case FFEINFO_kindtypeINTEGER5:
|
||
u.integer5 = *(array.integer5 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER6
|
||
case FFEINFO_kindtypeINTEGER6:
|
||
u.integer6 = *(array.integer6 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER7
|
||
case FFEINFO_kindtypeINTEGER7:
|
||
u.integer7 = *(array.integer7 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER8
|
||
case FFEINFO_kindtypeINTEGER8:
|
||
u.integer8 = *(array.integer8 + offset);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad INTEGER kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeLOGICAL:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okLOGICAL1
|
||
case FFEINFO_kindtypeLOGICAL1:
|
||
u.logical1 = *(array.logical1 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL2
|
||
case FFEINFO_kindtypeLOGICAL2:
|
||
u.logical2 = *(array.logical2 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL3
|
||
case FFEINFO_kindtypeLOGICAL3:
|
||
u.logical3 = *(array.logical3 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL4
|
||
case FFEINFO_kindtypeLOGICAL4:
|
||
u.logical4 = *(array.logical4 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL5
|
||
case FFEINFO_kindtypeLOGICAL5:
|
||
u.logical5 = *(array.logical5 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL6
|
||
case FFEINFO_kindtypeLOGICAL6:
|
||
u.logical6 = *(array.logical6 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL7
|
||
case FFEINFO_kindtypeLOGICAL7:
|
||
u.logical7 = *(array.logical7 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL8
|
||
case FFEINFO_kindtypeLOGICAL8:
|
||
u.logical8 = *(array.logical8 + offset);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad LOGICAL kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeREAL:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okREAL1
|
||
case FFEINFO_kindtypeREAL1:
|
||
u.real1 = *(array.real1 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL2
|
||
case FFEINFO_kindtypeREAL2:
|
||
u.real2 = *(array.real2 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL3
|
||
case FFEINFO_kindtypeREAL3:
|
||
u.real3 = *(array.real3 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL4
|
||
case FFEINFO_kindtypeREAL4:
|
||
u.real4 = *(array.real4 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL5
|
||
case FFEINFO_kindtypeREAL5:
|
||
u.real5 = *(array.real5 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL6
|
||
case FFEINFO_kindtypeREAL6:
|
||
u.real6 = *(array.real6 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL7
|
||
case FFEINFO_kindtypeREAL7:
|
||
u.real7 = *(array.real7 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL8
|
||
case FFEINFO_kindtypeREAL8:
|
||
u.real8 = *(array.real8 + offset);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad REAL kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCOMPLEX:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okCOMPLEX1
|
||
case FFEINFO_kindtypeREAL1:
|
||
u.complex1 = *(array.complex1 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX2
|
||
case FFEINFO_kindtypeREAL2:
|
||
u.complex2 = *(array.complex2 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX3
|
||
case FFEINFO_kindtypeREAL3:
|
||
u.complex3 = *(array.complex3 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX4
|
||
case FFEINFO_kindtypeREAL4:
|
||
u.complex4 = *(array.complex4 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX5
|
||
case FFEINFO_kindtypeREAL5:
|
||
u.complex5 = *(array.complex5 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX6
|
||
case FFEINFO_kindtypeREAL6:
|
||
u.complex6 = *(array.complex6 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX7
|
||
case FFEINFO_kindtypeREAL7:
|
||
u.complex7 = *(array.complex7 + offset);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX8
|
||
case FFEINFO_kindtypeREAL8:
|
||
u.complex8 = *(array.complex8 + offset);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad COMPLEX kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCHARACTER:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okCHARACTER1
|
||
case FFEINFO_kindtypeCHARACTER1:
|
||
u.character1.length = 1;
|
||
u.character1.text = array.character1 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER2
|
||
case FFEINFO_kindtypeCHARACTER2:
|
||
u.character2.length = 1;
|
||
u.character2.text = array.character2 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER3
|
||
case FFEINFO_kindtypeCHARACTER3:
|
||
u.character3.length = 1;
|
||
u.character3.text = array.character3 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER4
|
||
case FFEINFO_kindtypeCHARACTER4:
|
||
u.character4.length = 1;
|
||
u.character4.text = array.character4 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER5
|
||
case FFEINFO_kindtypeCHARACTER5:
|
||
u.character5.length = 1;
|
||
u.character5.text = array.character5 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER6
|
||
case FFEINFO_kindtypeCHARACTER6:
|
||
u.character6.length = 1;
|
||
u.character6.text = array.character6 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER7
|
||
case FFEINFO_kindtypeCHARACTER7:
|
||
u.character7.length = 1;
|
||
u.character7.text = array.character7 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER8
|
||
case FFEINFO_kindtypeCHARACTER8:
|
||
u.character8.length = 1;
|
||
u.character8.text = array.character8 + offset;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad CHARACTER kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
default:
|
||
assert ("bad basictype" == NULL);
|
||
break;
|
||
}
|
||
|
||
return u;
|
||
}
|
||
|
||
/* ffebld_constantarray_new -- Make an array of constants
|
||
|
||
See prototype. */
|
||
|
||
ffebldConstantArray
|
||
ffebld_constantarray_new (ffeinfoBasictype bt,
|
||
ffeinfoKindtype kt, ffetargetOffset size)
|
||
{
|
||
ffebldConstantArray ptr;
|
||
|
||
switch (bt)
|
||
{
|
||
case FFEINFO_basictypeINTEGER:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okINTEGER1
|
||
case FFEINFO_kindtypeINTEGER1:
|
||
ptr.integer1 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetInteger1),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER2
|
||
case FFEINFO_kindtypeINTEGER2:
|
||
ptr.integer2 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetInteger2),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER3
|
||
case FFEINFO_kindtypeINTEGER3:
|
||
ptr.integer3 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetInteger3),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER4
|
||
case FFEINFO_kindtypeINTEGER4:
|
||
ptr.integer4 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetInteger4),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER5
|
||
case FFEINFO_kindtypeINTEGER5:
|
||
ptr.integer5 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetInteger5),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER6
|
||
case FFEINFO_kindtypeINTEGER6:
|
||
ptr.integer6 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetInteger6),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER7
|
||
case FFEINFO_kindtypeINTEGER7:
|
||
ptr.integer7 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetInteger7),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER8
|
||
case FFEINFO_kindtypeINTEGER8:
|
||
ptr.integer8 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetInteger8),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad INTEGER kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeLOGICAL:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okLOGICAL1
|
||
case FFEINFO_kindtypeLOGICAL1:
|
||
ptr.logical1 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetLogical1),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL2
|
||
case FFEINFO_kindtypeLOGICAL2:
|
||
ptr.logical2 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetLogical2),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL3
|
||
case FFEINFO_kindtypeLOGICAL3:
|
||
ptr.logical3 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetLogical3),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL4
|
||
case FFEINFO_kindtypeLOGICAL4:
|
||
ptr.logical4 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetLogical4),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL5
|
||
case FFEINFO_kindtypeLOGICAL5:
|
||
ptr.logical5 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetLogical5),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL6
|
||
case FFEINFO_kindtypeLOGICAL6:
|
||
ptr.logical6 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetLogical6),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL7
|
||
case FFEINFO_kindtypeLOGICAL7:
|
||
ptr.logical7 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetLogical7),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL8
|
||
case FFEINFO_kindtypeLOGICAL8:
|
||
ptr.logical8 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetLogical8),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad LOGICAL kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeREAL:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okREAL1
|
||
case FFEINFO_kindtypeREAL1:
|
||
ptr.real1 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetReal1),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL2
|
||
case FFEINFO_kindtypeREAL2:
|
||
ptr.real2 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetReal2),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL3
|
||
case FFEINFO_kindtypeREAL3:
|
||
ptr.real3 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetReal3),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL4
|
||
case FFEINFO_kindtypeREAL4:
|
||
ptr.real4 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetReal4),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL5
|
||
case FFEINFO_kindtypeREAL5:
|
||
ptr.real5 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetReal5),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL6
|
||
case FFEINFO_kindtypeREAL6:
|
||
ptr.real6 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetReal6),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL7
|
||
case FFEINFO_kindtypeREAL7:
|
||
ptr.real7 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetReal7),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL8
|
||
case FFEINFO_kindtypeREAL8:
|
||
ptr.real8 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetReal8),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad REAL kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCOMPLEX:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okCOMPLEX1
|
||
case FFEINFO_kindtypeREAL1:
|
||
ptr.complex1 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetComplex1),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX2
|
||
case FFEINFO_kindtypeREAL2:
|
||
ptr.complex2 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetComplex2),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX3
|
||
case FFEINFO_kindtypeREAL3:
|
||
ptr.complex3 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetComplex3),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX4
|
||
case FFEINFO_kindtypeREAL4:
|
||
ptr.complex4 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetComplex4),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX5
|
||
case FFEINFO_kindtypeREAL5:
|
||
ptr.complex5 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetComplex5),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX6
|
||
case FFEINFO_kindtypeREAL6:
|
||
ptr.complex6 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetComplex6),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX7
|
||
case FFEINFO_kindtypeREAL7:
|
||
ptr.complex7 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetComplex7),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX8
|
||
case FFEINFO_kindtypeREAL8:
|
||
ptr.complex8 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size *= sizeof (ffetargetComplex8),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad COMPLEX kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCHARACTER:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okCHARACTER1
|
||
case FFEINFO_kindtypeCHARACTER1:
|
||
ptr.character1 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size
|
||
*= sizeof (ffetargetCharacterUnit1),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER2
|
||
case FFEINFO_kindtypeCHARACTER2:
|
||
ptr.character2 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size
|
||
*= sizeof (ffetargetCharacterUnit2),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER3
|
||
case FFEINFO_kindtypeCHARACTER3:
|
||
ptr.character3 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size
|
||
*= sizeof (ffetargetCharacterUnit3),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER4
|
||
case FFEINFO_kindtypeCHARACTER4:
|
||
ptr.character4 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size
|
||
*= sizeof (ffetargetCharacterUnit4),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER5
|
||
case FFEINFO_kindtypeCHARACTER5:
|
||
ptr.character5 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size
|
||
*= sizeof (ffetargetCharacterUnit5),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER6
|
||
case FFEINFO_kindtypeCHARACTER6:
|
||
ptr.character6 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size
|
||
*= sizeof (ffetargetCharacterUnit6),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER7
|
||
case FFEINFO_kindtypeCHARACTER7:
|
||
ptr.character7 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size
|
||
*= sizeof (ffetargetCharacterUnit7),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER8
|
||
case FFEINFO_kindtypeCHARACTER8:
|
||
ptr.character8 = malloc_new_zkp (ffebld_constant_pool(),
|
||
"ffebldConstantArray",
|
||
size
|
||
*= sizeof (ffetargetCharacterUnit8),
|
||
0);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad CHARACTER kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
default:
|
||
assert ("bad basictype" == NULL);
|
||
break;
|
||
}
|
||
|
||
return ptr;
|
||
}
|
||
|
||
/* ffebld_constantarray_preparray -- Prepare for copy between arrays
|
||
|
||
See prototype.
|
||
|
||
Like _prepare, but the source is an array instead of a single-value
|
||
constant. */
|
||
|
||
void
|
||
ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size,
|
||
ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
|
||
ffetargetOffset offset, ffebldConstantArray source_array,
|
||
ffeinfoBasictype cbt, ffeinfoKindtype ckt)
|
||
{
|
||
switch (abt)
|
||
{
|
||
case FFEINFO_basictypeINTEGER:
|
||
switch (akt)
|
||
{
|
||
#if FFETARGET_okINTEGER1
|
||
case FFEINFO_kindtypeINTEGER1:
|
||
*aptr = array.integer1 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER2
|
||
case FFEINFO_kindtypeINTEGER2:
|
||
*aptr = array.integer2 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER3
|
||
case FFEINFO_kindtypeINTEGER3:
|
||
*aptr = array.integer3 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER4
|
||
case FFEINFO_kindtypeINTEGER4:
|
||
*aptr = array.integer4 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER5
|
||
case FFEINFO_kindtypeINTEGER5:
|
||
*aptr = array.integer5 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER6
|
||
case FFEINFO_kindtypeINTEGER6:
|
||
*aptr = array.integer6 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER7
|
||
case FFEINFO_kindtypeINTEGER7:
|
||
*aptr = array.integer7 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER8
|
||
case FFEINFO_kindtypeINTEGER8:
|
||
*aptr = array.integer8 + offset;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad INTEGER akindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeLOGICAL:
|
||
switch (akt)
|
||
{
|
||
#if FFETARGET_okLOGICAL1
|
||
case FFEINFO_kindtypeLOGICAL1:
|
||
*aptr = array.logical1 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL2
|
||
case FFEINFO_kindtypeLOGICAL2:
|
||
*aptr = array.logical2 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL3
|
||
case FFEINFO_kindtypeLOGICAL3:
|
||
*aptr = array.logical3 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL4
|
||
case FFEINFO_kindtypeLOGICAL4:
|
||
*aptr = array.logical4 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL5
|
||
case FFEINFO_kindtypeLOGICAL5:
|
||
*aptr = array.logical5 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL6
|
||
case FFEINFO_kindtypeLOGICAL6:
|
||
*aptr = array.logical6 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL7
|
||
case FFEINFO_kindtypeLOGICAL7:
|
||
*aptr = array.logical7 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL8
|
||
case FFEINFO_kindtypeLOGICAL8:
|
||
*aptr = array.logical8 + offset;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad LOGICAL akindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeREAL:
|
||
switch (akt)
|
||
{
|
||
#if FFETARGET_okREAL1
|
||
case FFEINFO_kindtypeREAL1:
|
||
*aptr = array.real1 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL2
|
||
case FFEINFO_kindtypeREAL2:
|
||
*aptr = array.real2 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL3
|
||
case FFEINFO_kindtypeREAL3:
|
||
*aptr = array.real3 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL4
|
||
case FFEINFO_kindtypeREAL4:
|
||
*aptr = array.real4 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL5
|
||
case FFEINFO_kindtypeREAL5:
|
||
*aptr = array.real5 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL6
|
||
case FFEINFO_kindtypeREAL6:
|
||
*aptr = array.real6 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL7
|
||
case FFEINFO_kindtypeREAL7:
|
||
*aptr = array.real7 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL8
|
||
case FFEINFO_kindtypeREAL8:
|
||
*aptr = array.real8 + offset;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad REAL akindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCOMPLEX:
|
||
switch (akt)
|
||
{
|
||
#if FFETARGET_okCOMPLEX1
|
||
case FFEINFO_kindtypeREAL1:
|
||
*aptr = array.complex1 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX2
|
||
case FFEINFO_kindtypeREAL2:
|
||
*aptr = array.complex2 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX3
|
||
case FFEINFO_kindtypeREAL3:
|
||
*aptr = array.complex3 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX4
|
||
case FFEINFO_kindtypeREAL4:
|
||
*aptr = array.complex4 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX5
|
||
case FFEINFO_kindtypeREAL5:
|
||
*aptr = array.complex5 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX6
|
||
case FFEINFO_kindtypeREAL6:
|
||
*aptr = array.complex6 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX7
|
||
case FFEINFO_kindtypeREAL7:
|
||
*aptr = array.complex7 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX8
|
||
case FFEINFO_kindtypeREAL8:
|
||
*aptr = array.complex8 + offset;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad COMPLEX akindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCHARACTER:
|
||
switch (akt)
|
||
{
|
||
#if FFETARGET_okCHARACTER1
|
||
case FFEINFO_kindtypeCHARACTER1:
|
||
*aptr = array.character1 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER2
|
||
case FFEINFO_kindtypeCHARACTER2:
|
||
*aptr = array.character2 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER3
|
||
case FFEINFO_kindtypeCHARACTER3:
|
||
*aptr = array.character3 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER4
|
||
case FFEINFO_kindtypeCHARACTER4:
|
||
*aptr = array.character4 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER5
|
||
case FFEINFO_kindtypeCHARACTER5:
|
||
*aptr = array.character5 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER6
|
||
case FFEINFO_kindtypeCHARACTER6:
|
||
*aptr = array.character6 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER7
|
||
case FFEINFO_kindtypeCHARACTER7:
|
||
*aptr = array.character7 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER8
|
||
case FFEINFO_kindtypeCHARACTER8:
|
||
*aptr = array.character8 + offset;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad CHARACTER akindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
default:
|
||
assert ("bad abasictype" == NULL);
|
||
break;
|
||
}
|
||
|
||
switch (cbt)
|
||
{
|
||
case FFEINFO_basictypeINTEGER:
|
||
switch (ckt)
|
||
{
|
||
#if FFETARGET_okINTEGER1
|
||
case FFEINFO_kindtypeINTEGER1:
|
||
*cptr = source_array.integer1;
|
||
*size = sizeof (*source_array.integer1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER2
|
||
case FFEINFO_kindtypeINTEGER2:
|
||
*cptr = source_array.integer2;
|
||
*size = sizeof (*source_array.integer2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER3
|
||
case FFEINFO_kindtypeINTEGER3:
|
||
*cptr = source_array.integer3;
|
||
*size = sizeof (*source_array.integer3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER4
|
||
case FFEINFO_kindtypeINTEGER4:
|
||
*cptr = source_array.integer4;
|
||
*size = sizeof (*source_array.integer4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER5
|
||
case FFEINFO_kindtypeINTEGER5:
|
||
*cptr = source_array.integer5;
|
||
*size = sizeof (*source_array.integer5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER6
|
||
case FFEINFO_kindtypeINTEGER6:
|
||
*cptr = source_array.integer6;
|
||
*size = sizeof (*source_array.integer6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER7
|
||
case FFEINFO_kindtypeINTEGER7:
|
||
*cptr = source_array.integer7;
|
||
*size = sizeof (*source_array.integer7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER8
|
||
case FFEINFO_kindtypeINTEGER8:
|
||
*cptr = source_array.integer8;
|
||
*size = sizeof (*source_array.integer8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad INTEGER ckindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeLOGICAL:
|
||
switch (ckt)
|
||
{
|
||
#if FFETARGET_okLOGICAL1
|
||
case FFEINFO_kindtypeLOGICAL1:
|
||
*cptr = source_array.logical1;
|
||
*size = sizeof (*source_array.logical1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL2
|
||
case FFEINFO_kindtypeLOGICAL2:
|
||
*cptr = source_array.logical2;
|
||
*size = sizeof (*source_array.logical2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL3
|
||
case FFEINFO_kindtypeLOGICAL3:
|
||
*cptr = source_array.logical3;
|
||
*size = sizeof (*source_array.logical3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL4
|
||
case FFEINFO_kindtypeLOGICAL4:
|
||
*cptr = source_array.logical4;
|
||
*size = sizeof (*source_array.logical4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL5
|
||
case FFEINFO_kindtypeLOGICAL5:
|
||
*cptr = source_array.logical5;
|
||
*size = sizeof (*source_array.logical5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL6
|
||
case FFEINFO_kindtypeLOGICAL6:
|
||
*cptr = source_array.logical6;
|
||
*size = sizeof (*source_array.logical6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL7
|
||
case FFEINFO_kindtypeLOGICAL7:
|
||
*cptr = source_array.logical7;
|
||
*size = sizeof (*source_array.logical7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL8
|
||
case FFEINFO_kindtypeLOGICAL8:
|
||
*cptr = source_array.logical8;
|
||
*size = sizeof (*source_array.logical8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad LOGICAL ckindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeREAL:
|
||
switch (ckt)
|
||
{
|
||
#if FFETARGET_okREAL1
|
||
case FFEINFO_kindtypeREAL1:
|
||
*cptr = source_array.real1;
|
||
*size = sizeof (*source_array.real1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL2
|
||
case FFEINFO_kindtypeREAL2:
|
||
*cptr = source_array.real2;
|
||
*size = sizeof (*source_array.real2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL3
|
||
case FFEINFO_kindtypeREAL3:
|
||
*cptr = source_array.real3;
|
||
*size = sizeof (*source_array.real3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL4
|
||
case FFEINFO_kindtypeREAL4:
|
||
*cptr = source_array.real4;
|
||
*size = sizeof (*source_array.real4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL5
|
||
case FFEINFO_kindtypeREAL5:
|
||
*cptr = source_array.real5;
|
||
*size = sizeof (*source_array.real5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL6
|
||
case FFEINFO_kindtypeREAL6:
|
||
*cptr = source_array.real6;
|
||
*size = sizeof (*source_array.real6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL7
|
||
case FFEINFO_kindtypeREAL7:
|
||
*cptr = source_array.real7;
|
||
*size = sizeof (*source_array.real7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL8
|
||
case FFEINFO_kindtypeREAL8:
|
||
*cptr = source_array.real8;
|
||
*size = sizeof (*source_array.real8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad REAL ckindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCOMPLEX:
|
||
switch (ckt)
|
||
{
|
||
#if FFETARGET_okCOMPLEX1
|
||
case FFEINFO_kindtypeREAL1:
|
||
*cptr = source_array.complex1;
|
||
*size = sizeof (*source_array.complex1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX2
|
||
case FFEINFO_kindtypeREAL2:
|
||
*cptr = source_array.complex2;
|
||
*size = sizeof (*source_array.complex2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX3
|
||
case FFEINFO_kindtypeREAL3:
|
||
*cptr = source_array.complex3;
|
||
*size = sizeof (*source_array.complex3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX4
|
||
case FFEINFO_kindtypeREAL4:
|
||
*cptr = source_array.complex4;
|
||
*size = sizeof (*source_array.complex4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX5
|
||
case FFEINFO_kindtypeREAL5:
|
||
*cptr = source_array.complex5;
|
||
*size = sizeof (*source_array.complex5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX6
|
||
case FFEINFO_kindtypeREAL6:
|
||
*cptr = source_array.complex6;
|
||
*size = sizeof (*source_array.complex6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX7
|
||
case FFEINFO_kindtypeREAL7:
|
||
*cptr = source_array.complex7;
|
||
*size = sizeof (*source_array.complex7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX8
|
||
case FFEINFO_kindtypeREAL8:
|
||
*cptr = source_array.complex8;
|
||
*size = sizeof (*source_array.complex8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad COMPLEX ckindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCHARACTER:
|
||
switch (ckt)
|
||
{
|
||
#if FFETARGET_okCHARACTER1
|
||
case FFEINFO_kindtypeCHARACTER1:
|
||
*cptr = source_array.character1;
|
||
*size = sizeof (*source_array.character1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER2
|
||
case FFEINFO_kindtypeCHARACTER2:
|
||
*cptr = source_array.character2;
|
||
*size = sizeof (*source_array.character2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER3
|
||
case FFEINFO_kindtypeCHARACTER3:
|
||
*cptr = source_array.character3;
|
||
*size = sizeof (*source_array.character3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER4
|
||
case FFEINFO_kindtypeCHARACTER4:
|
||
*cptr = source_array.character4;
|
||
*size = sizeof (*source_array.character4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER5
|
||
case FFEINFO_kindtypeCHARACTER5:
|
||
*cptr = source_array.character5;
|
||
*size = sizeof (*source_array.character5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER6
|
||
case FFEINFO_kindtypeCHARACTER6:
|
||
*cptr = source_array.character6;
|
||
*size = sizeof (*source_array.character6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER7
|
||
case FFEINFO_kindtypeCHARACTER7:
|
||
*cptr = source_array.character7;
|
||
*size = sizeof (*source_array.character7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER8
|
||
case FFEINFO_kindtypeCHARACTER8:
|
||
*cptr = source_array.character8;
|
||
*size = sizeof (*source_array.character8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad CHARACTER ckindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
default:
|
||
assert ("bad cbasictype" == NULL);
|
||
break;
|
||
}
|
||
}
|
||
|
||
/* ffebld_constantarray_prepare -- Prepare for copy between value and array
|
||
|
||
See prototype.
|
||
|
||
Like _put, but just returns the pointers to the beginnings of the
|
||
array and the constant and returns the size (the amount of info to
|
||
copy). The idea is that the caller can use memcpy to accomplish the
|
||
same thing as _put (though slower), or the caller can use a different
|
||
function that swaps bytes, words, etc for a different target machine.
|
||
Also, the type of the array may be different from the type of the
|
||
constant; the array type is used to determine the meaning (scale) of
|
||
the offset field (to calculate the array pointer), the constant type is
|
||
used to determine the constant pointer and the size (amount of info to
|
||
copy). */
|
||
|
||
void
|
||
ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size,
|
||
ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
|
||
ffetargetOffset offset, ffebldConstantUnion *constant,
|
||
ffeinfoBasictype cbt, ffeinfoKindtype ckt)
|
||
{
|
||
switch (abt)
|
||
{
|
||
case FFEINFO_basictypeINTEGER:
|
||
switch (akt)
|
||
{
|
||
#if FFETARGET_okINTEGER1
|
||
case FFEINFO_kindtypeINTEGER1:
|
||
*aptr = array.integer1 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER2
|
||
case FFEINFO_kindtypeINTEGER2:
|
||
*aptr = array.integer2 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER3
|
||
case FFEINFO_kindtypeINTEGER3:
|
||
*aptr = array.integer3 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER4
|
||
case FFEINFO_kindtypeINTEGER4:
|
||
*aptr = array.integer4 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER5
|
||
case FFEINFO_kindtypeINTEGER5:
|
||
*aptr = array.integer5 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER6
|
||
case FFEINFO_kindtypeINTEGER6:
|
||
*aptr = array.integer6 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER7
|
||
case FFEINFO_kindtypeINTEGER7:
|
||
*aptr = array.integer7 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER8
|
||
case FFEINFO_kindtypeINTEGER8:
|
||
*aptr = array.integer8 + offset;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad INTEGER akindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeLOGICAL:
|
||
switch (akt)
|
||
{
|
||
#if FFETARGET_okLOGICAL1
|
||
case FFEINFO_kindtypeLOGICAL1:
|
||
*aptr = array.logical1 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL2
|
||
case FFEINFO_kindtypeLOGICAL2:
|
||
*aptr = array.logical2 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL3
|
||
case FFEINFO_kindtypeLOGICAL3:
|
||
*aptr = array.logical3 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL4
|
||
case FFEINFO_kindtypeLOGICAL4:
|
||
*aptr = array.logical4 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL5
|
||
case FFEINFO_kindtypeLOGICAL5:
|
||
*aptr = array.logical5 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL6
|
||
case FFEINFO_kindtypeLOGICAL6:
|
||
*aptr = array.logical6 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL7
|
||
case FFEINFO_kindtypeLOGICAL7:
|
||
*aptr = array.logical7 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL8
|
||
case FFEINFO_kindtypeLOGICAL8:
|
||
*aptr = array.logical8 + offset;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad LOGICAL akindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeREAL:
|
||
switch (akt)
|
||
{
|
||
#if FFETARGET_okREAL1
|
||
case FFEINFO_kindtypeREAL1:
|
||
*aptr = array.real1 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL2
|
||
case FFEINFO_kindtypeREAL2:
|
||
*aptr = array.real2 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL3
|
||
case FFEINFO_kindtypeREAL3:
|
||
*aptr = array.real3 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL4
|
||
case FFEINFO_kindtypeREAL4:
|
||
*aptr = array.real4 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL5
|
||
case FFEINFO_kindtypeREAL5:
|
||
*aptr = array.real5 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL6
|
||
case FFEINFO_kindtypeREAL6:
|
||
*aptr = array.real6 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL7
|
||
case FFEINFO_kindtypeREAL7:
|
||
*aptr = array.real7 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL8
|
||
case FFEINFO_kindtypeREAL8:
|
||
*aptr = array.real8 + offset;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad REAL akindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCOMPLEX:
|
||
switch (akt)
|
||
{
|
||
#if FFETARGET_okCOMPLEX1
|
||
case FFEINFO_kindtypeREAL1:
|
||
*aptr = array.complex1 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX2
|
||
case FFEINFO_kindtypeREAL2:
|
||
*aptr = array.complex2 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX3
|
||
case FFEINFO_kindtypeREAL3:
|
||
*aptr = array.complex3 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX4
|
||
case FFEINFO_kindtypeREAL4:
|
||
*aptr = array.complex4 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX5
|
||
case FFEINFO_kindtypeREAL5:
|
||
*aptr = array.complex5 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX6
|
||
case FFEINFO_kindtypeREAL6:
|
||
*aptr = array.complex6 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX7
|
||
case FFEINFO_kindtypeREAL7:
|
||
*aptr = array.complex7 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX8
|
||
case FFEINFO_kindtypeREAL8:
|
||
*aptr = array.complex8 + offset;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad COMPLEX akindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCHARACTER:
|
||
switch (akt)
|
||
{
|
||
#if FFETARGET_okCHARACTER1
|
||
case FFEINFO_kindtypeCHARACTER1:
|
||
*aptr = array.character1 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER2
|
||
case FFEINFO_kindtypeCHARACTER2:
|
||
*aptr = array.character2 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER3
|
||
case FFEINFO_kindtypeCHARACTER3:
|
||
*aptr = array.character3 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER4
|
||
case FFEINFO_kindtypeCHARACTER4:
|
||
*aptr = array.character4 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER5
|
||
case FFEINFO_kindtypeCHARACTER5:
|
||
*aptr = array.character5 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER6
|
||
case FFEINFO_kindtypeCHARACTER6:
|
||
*aptr = array.character6 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER7
|
||
case FFEINFO_kindtypeCHARACTER7:
|
||
*aptr = array.character7 + offset;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER8
|
||
case FFEINFO_kindtypeCHARACTER8:
|
||
*aptr = array.character8 + offset;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad CHARACTER akindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
default:
|
||
assert ("bad abasictype" == NULL);
|
||
break;
|
||
}
|
||
|
||
switch (cbt)
|
||
{
|
||
case FFEINFO_basictypeINTEGER:
|
||
switch (ckt)
|
||
{
|
||
#if FFETARGET_okINTEGER1
|
||
case FFEINFO_kindtypeINTEGER1:
|
||
*cptr = &constant->integer1;
|
||
*size = sizeof (constant->integer1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER2
|
||
case FFEINFO_kindtypeINTEGER2:
|
||
*cptr = &constant->integer2;
|
||
*size = sizeof (constant->integer2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER3
|
||
case FFEINFO_kindtypeINTEGER3:
|
||
*cptr = &constant->integer3;
|
||
*size = sizeof (constant->integer3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER4
|
||
case FFEINFO_kindtypeINTEGER4:
|
||
*cptr = &constant->integer4;
|
||
*size = sizeof (constant->integer4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER5
|
||
case FFEINFO_kindtypeINTEGER5:
|
||
*cptr = &constant->integer5;
|
||
*size = sizeof (constant->integer5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER6
|
||
case FFEINFO_kindtypeINTEGER6:
|
||
*cptr = &constant->integer6;
|
||
*size = sizeof (constant->integer6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER7
|
||
case FFEINFO_kindtypeINTEGER7:
|
||
*cptr = &constant->integer7;
|
||
*size = sizeof (constant->integer7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER8
|
||
case FFEINFO_kindtypeINTEGER8:
|
||
*cptr = &constant->integer8;
|
||
*size = sizeof (constant->integer8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad INTEGER ckindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeLOGICAL:
|
||
switch (ckt)
|
||
{
|
||
#if FFETARGET_okLOGICAL1
|
||
case FFEINFO_kindtypeLOGICAL1:
|
||
*cptr = &constant->logical1;
|
||
*size = sizeof (constant->logical1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL2
|
||
case FFEINFO_kindtypeLOGICAL2:
|
||
*cptr = &constant->logical2;
|
||
*size = sizeof (constant->logical2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL3
|
||
case FFEINFO_kindtypeLOGICAL3:
|
||
*cptr = &constant->logical3;
|
||
*size = sizeof (constant->logical3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL4
|
||
case FFEINFO_kindtypeLOGICAL4:
|
||
*cptr = &constant->logical4;
|
||
*size = sizeof (constant->logical4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL5
|
||
case FFEINFO_kindtypeLOGICAL5:
|
||
*cptr = &constant->logical5;
|
||
*size = sizeof (constant->logical5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL6
|
||
case FFEINFO_kindtypeLOGICAL6:
|
||
*cptr = &constant->logical6;
|
||
*size = sizeof (constant->logical6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL7
|
||
case FFEINFO_kindtypeLOGICAL7:
|
||
*cptr = &constant->logical7;
|
||
*size = sizeof (constant->logical7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL8
|
||
case FFEINFO_kindtypeLOGICAL8:
|
||
*cptr = &constant->logical8;
|
||
*size = sizeof (constant->logical8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad LOGICAL ckindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeREAL:
|
||
switch (ckt)
|
||
{
|
||
#if FFETARGET_okREAL1
|
||
case FFEINFO_kindtypeREAL1:
|
||
*cptr = &constant->real1;
|
||
*size = sizeof (constant->real1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL2
|
||
case FFEINFO_kindtypeREAL2:
|
||
*cptr = &constant->real2;
|
||
*size = sizeof (constant->real2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL3
|
||
case FFEINFO_kindtypeREAL3:
|
||
*cptr = &constant->real3;
|
||
*size = sizeof (constant->real3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL4
|
||
case FFEINFO_kindtypeREAL4:
|
||
*cptr = &constant->real4;
|
||
*size = sizeof (constant->real4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL5
|
||
case FFEINFO_kindtypeREAL5:
|
||
*cptr = &constant->real5;
|
||
*size = sizeof (constant->real5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL6
|
||
case FFEINFO_kindtypeREAL6:
|
||
*cptr = &constant->real6;
|
||
*size = sizeof (constant->real6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL7
|
||
case FFEINFO_kindtypeREAL7:
|
||
*cptr = &constant->real7;
|
||
*size = sizeof (constant->real7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL8
|
||
case FFEINFO_kindtypeREAL8:
|
||
*cptr = &constant->real8;
|
||
*size = sizeof (constant->real8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad REAL ckindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCOMPLEX:
|
||
switch (ckt)
|
||
{
|
||
#if FFETARGET_okCOMPLEX1
|
||
case FFEINFO_kindtypeREAL1:
|
||
*cptr = &constant->complex1;
|
||
*size = sizeof (constant->complex1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX2
|
||
case FFEINFO_kindtypeREAL2:
|
||
*cptr = &constant->complex2;
|
||
*size = sizeof (constant->complex2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX3
|
||
case FFEINFO_kindtypeREAL3:
|
||
*cptr = &constant->complex3;
|
||
*size = sizeof (constant->complex3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX4
|
||
case FFEINFO_kindtypeREAL4:
|
||
*cptr = &constant->complex4;
|
||
*size = sizeof (constant->complex4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX5
|
||
case FFEINFO_kindtypeREAL5:
|
||
*cptr = &constant->complex5;
|
||
*size = sizeof (constant->complex5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX6
|
||
case FFEINFO_kindtypeREAL6:
|
||
*cptr = &constant->complex6;
|
||
*size = sizeof (constant->complex6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX7
|
||
case FFEINFO_kindtypeREAL7:
|
||
*cptr = &constant->complex7;
|
||
*size = sizeof (constant->complex7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX8
|
||
case FFEINFO_kindtypeREAL8:
|
||
*cptr = &constant->complex8;
|
||
*size = sizeof (constant->complex8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad COMPLEX ckindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCHARACTER:
|
||
switch (ckt)
|
||
{
|
||
#if FFETARGET_okCHARACTER1
|
||
case FFEINFO_kindtypeCHARACTER1:
|
||
*cptr = ffetarget_text_character1 (constant->character1);
|
||
*size = ffetarget_length_character1 (constant->character1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER2
|
||
case FFEINFO_kindtypeCHARACTER2:
|
||
*cptr = ffetarget_text_character2 (constant->character2);
|
||
*size = ffetarget_length_character2 (constant->character2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER3
|
||
case FFEINFO_kindtypeCHARACTER3:
|
||
*cptr = ffetarget_text_character3 (constant->character3);
|
||
*size = ffetarget_length_character3 (constant->character3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER4
|
||
case FFEINFO_kindtypeCHARACTER4:
|
||
*cptr = ffetarget_text_character4 (constant->character4);
|
||
*size = ffetarget_length_character4 (constant->character4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER5
|
||
case FFEINFO_kindtypeCHARACTER5:
|
||
*cptr = ffetarget_text_character5 (constant->character5);
|
||
*size = ffetarget_length_character5 (constant->character5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER6
|
||
case FFEINFO_kindtypeCHARACTER6:
|
||
*cptr = ffetarget_text_character6 (constant->character6);
|
||
*size = ffetarget_length_character6 (constant->character6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER7
|
||
case FFEINFO_kindtypeCHARACTER7:
|
||
*cptr = ffetarget_text_character7 (constant->character7);
|
||
*size = ffetarget_length_character7 (constant->character7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER8
|
||
case FFEINFO_kindtypeCHARACTER8:
|
||
*cptr = ffetarget_text_character8 (constant->character8);
|
||
*size = ffetarget_length_character8 (constant->character8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad CHARACTER ckindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
default:
|
||
assert ("bad cbasictype" == NULL);
|
||
break;
|
||
}
|
||
}
|
||
|
||
/* ffebld_constantarray_put -- Put a value into an array of constants
|
||
|
||
See prototype. */
|
||
|
||
void
|
||
ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt,
|
||
ffeinfoKindtype kt, ffetargetOffset offset, ffebldConstantUnion constant)
|
||
{
|
||
switch (bt)
|
||
{
|
||
case FFEINFO_basictypeINTEGER:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okINTEGER1
|
||
case FFEINFO_kindtypeINTEGER1:
|
||
*(array.integer1 + offset) = constant.integer1;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER2
|
||
case FFEINFO_kindtypeINTEGER2:
|
||
*(array.integer2 + offset) = constant.integer2;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER3
|
||
case FFEINFO_kindtypeINTEGER3:
|
||
*(array.integer3 + offset) = constant.integer3;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER4
|
||
case FFEINFO_kindtypeINTEGER4:
|
||
*(array.integer4 + offset) = constant.integer4;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER5
|
||
case FFEINFO_kindtypeINTEGER5:
|
||
*(array.integer5 + offset) = constant.integer5;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER6
|
||
case FFEINFO_kindtypeINTEGER6:
|
||
*(array.integer6 + offset) = constant.integer6;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER7
|
||
case FFEINFO_kindtypeINTEGER7:
|
||
*(array.integer7 + offset) = constant.integer7;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER8
|
||
case FFEINFO_kindtypeINTEGER8:
|
||
*(array.integer8 + offset) = constant.integer8;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad INTEGER kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeLOGICAL:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okLOGICAL1
|
||
case FFEINFO_kindtypeLOGICAL1:
|
||
*(array.logical1 + offset) = constant.logical1;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL2
|
||
case FFEINFO_kindtypeLOGICAL2:
|
||
*(array.logical2 + offset) = constant.logical2;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL3
|
||
case FFEINFO_kindtypeLOGICAL3:
|
||
*(array.logical3 + offset) = constant.logical3;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL4
|
||
case FFEINFO_kindtypeLOGICAL4:
|
||
*(array.logical4 + offset) = constant.logical4;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL5
|
||
case FFEINFO_kindtypeLOGICAL5:
|
||
*(array.logical5 + offset) = constant.logical5;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL6
|
||
case FFEINFO_kindtypeLOGICAL6:
|
||
*(array.logical6 + offset) = constant.logical6;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL7
|
||
case FFEINFO_kindtypeLOGICAL7:
|
||
*(array.logical7 + offset) = constant.logical7;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL8
|
||
case FFEINFO_kindtypeLOGICAL8:
|
||
*(array.logical8 + offset) = constant.logical8;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad LOGICAL kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeREAL:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okREAL1
|
||
case FFEINFO_kindtypeREAL1:
|
||
*(array.real1 + offset) = constant.real1;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL2
|
||
case FFEINFO_kindtypeREAL2:
|
||
*(array.real2 + offset) = constant.real2;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL3
|
||
case FFEINFO_kindtypeREAL3:
|
||
*(array.real3 + offset) = constant.real3;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL4
|
||
case FFEINFO_kindtypeREAL4:
|
||
*(array.real4 + offset) = constant.real4;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL5
|
||
case FFEINFO_kindtypeREAL5:
|
||
*(array.real5 + offset) = constant.real5;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL6
|
||
case FFEINFO_kindtypeREAL6:
|
||
*(array.real6 + offset) = constant.real6;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL7
|
||
case FFEINFO_kindtypeREAL7:
|
||
*(array.real7 + offset) = constant.real7;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL8
|
||
case FFEINFO_kindtypeREAL8:
|
||
*(array.real8 + offset) = constant.real8;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad REAL kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCOMPLEX:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okCOMPLEX1
|
||
case FFEINFO_kindtypeREAL1:
|
||
*(array.complex1 + offset) = constant.complex1;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX2
|
||
case FFEINFO_kindtypeREAL2:
|
||
*(array.complex2 + offset) = constant.complex2;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX3
|
||
case FFEINFO_kindtypeREAL3:
|
||
*(array.complex3 + offset) = constant.complex3;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX4
|
||
case FFEINFO_kindtypeREAL4:
|
||
*(array.complex4 + offset) = constant.complex4;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX5
|
||
case FFEINFO_kindtypeREAL5:
|
||
*(array.complex5 + offset) = constant.complex5;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX6
|
||
case FFEINFO_kindtypeREAL6:
|
||
*(array.complex6 + offset) = constant.complex6;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX7
|
||
case FFEINFO_kindtypeREAL7:
|
||
*(array.complex7 + offset) = constant.complex7;
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX8
|
||
case FFEINFO_kindtypeREAL8:
|
||
*(array.complex8 + offset) = constant.complex8;
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad COMPLEX kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCHARACTER:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okCHARACTER1
|
||
case FFEINFO_kindtypeCHARACTER1:
|
||
memcpy (array.character1 + offset,
|
||
ffetarget_text_character1 (constant.character1),
|
||
ffetarget_length_character1 (constant.character1));
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER2
|
||
case FFEINFO_kindtypeCHARACTER2:
|
||
memcpy (array.character2 + offset,
|
||
ffetarget_text_character2 (constant.character2),
|
||
ffetarget_length_character2 (constant.character2));
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER3
|
||
case FFEINFO_kindtypeCHARACTER3:
|
||
memcpy (array.character3 + offset,
|
||
ffetarget_text_character3 (constant.character3),
|
||
ffetarget_length_character3 (constant.character3));
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER4
|
||
case FFEINFO_kindtypeCHARACTER4:
|
||
memcpy (array.character4 + offset,
|
||
ffetarget_text_character4 (constant.character4),
|
||
ffetarget_length_character4 (constant.character4));
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER5
|
||
case FFEINFO_kindtypeCHARACTER5:
|
||
memcpy (array.character5 + offset,
|
||
ffetarget_text_character5 (constant.character5),
|
||
ffetarget_length_character5 (constant.character5));
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER6
|
||
case FFEINFO_kindtypeCHARACTER6:
|
||
memcpy (array.character6 + offset,
|
||
ffetarget_text_character6 (constant.character6),
|
||
ffetarget_length_character6 (constant.character6));
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER7
|
||
case FFEINFO_kindtypeCHARACTER7:
|
||
memcpy (array.character7 + offset,
|
||
ffetarget_text_character7 (constant.character7),
|
||
ffetarget_length_character7 (constant.character7));
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER8
|
||
case FFEINFO_kindtypeCHARACTER8:
|
||
memcpy (array.character8 + offset,
|
||
ffetarget_text_character8 (constant.character8),
|
||
ffetarget_length_character8 (constant.character8));
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad CHARACTER kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
default:
|
||
assert ("bad basictype" == NULL);
|
||
break;
|
||
}
|
||
}
|
||
|
||
/* ffebld_constantunion_dump -- Dump a constant
|
||
|
||
See prototype. */
|
||
|
||
#if FFECOM_targetCURRENT == FFECOM_targetFFE
|
||
void
|
||
ffebld_constantunion_dump (ffebldConstantUnion u, ffeinfoBasictype bt,
|
||
ffeinfoKindtype kt)
|
||
{
|
||
switch (bt)
|
||
{
|
||
case FFEINFO_basictypeINTEGER:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okINTEGER1
|
||
case FFEINFO_kindtypeINTEGER1:
|
||
ffetarget_print_integer1 (dmpout, u.integer1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER2
|
||
case FFEINFO_kindtypeINTEGER2:
|
||
ffetarget_print_integer2 (dmpout, u.integer2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER3
|
||
case FFEINFO_kindtypeINTEGER3:
|
||
ffetarget_print_integer3 (dmpout, u.integer3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER4
|
||
case FFEINFO_kindtypeINTEGER4:
|
||
ffetarget_print_integer4 (dmpout, u.integer4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER5
|
||
case FFEINFO_kindtypeINTEGER5:
|
||
ffetarget_print_integer5 (dmpout, u.integer5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER6
|
||
case FFEINFO_kindtypeINTEGER6:
|
||
ffetarget_print_integer6 (dmpout, u.integer6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER7
|
||
case FFEINFO_kindtypeINTEGER7:
|
||
ffetarget_print_integer7 (dmpout, u.integer7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER8
|
||
case FFEINFO_kindtypeINTEGER8:
|
||
ffetarget_print_integer8 (dmpout, u.integer8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad INTEGER kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeLOGICAL:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okLOGICAL1
|
||
case FFEINFO_kindtypeLOGICAL1:
|
||
ffetarget_print_logical1 (dmpout, u.logical1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL2
|
||
case FFEINFO_kindtypeLOGICAL2:
|
||
ffetarget_print_logical2 (dmpout, u.logical2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL3
|
||
case FFEINFO_kindtypeLOGICAL3:
|
||
ffetarget_print_logical3 (dmpout, u.logical3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL4
|
||
case FFEINFO_kindtypeLOGICAL4:
|
||
ffetarget_print_logical4 (dmpout, u.logical4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL5
|
||
case FFEINFO_kindtypeLOGICAL5:
|
||
ffetarget_print_logical5 (dmpout, u.logical5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL6
|
||
case FFEINFO_kindtypeLOGICAL6:
|
||
ffetarget_print_logical6 (dmpout, u.logical6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL7
|
||
case FFEINFO_kindtypeLOGICAL7:
|
||
ffetarget_print_logical7 (dmpout, u.logical7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL8
|
||
case FFEINFO_kindtypeLOGICAL8:
|
||
ffetarget_print_logical8 (dmpout, u.logical8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad LOGICAL kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeREAL:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okREAL1
|
||
case FFEINFO_kindtypeREAL1:
|
||
ffetarget_print_real1 (dmpout, u.real1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL2
|
||
case FFEINFO_kindtypeREAL2:
|
||
ffetarget_print_real2 (dmpout, u.real2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL3
|
||
case FFEINFO_kindtypeREAL3:
|
||
ffetarget_print_real3 (dmpout, u.real3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL4
|
||
case FFEINFO_kindtypeREAL4:
|
||
ffetarget_print_real4 (dmpout, u.real4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL5
|
||
case FFEINFO_kindtypeREAL5:
|
||
ffetarget_print_real5 (dmpout, u.real5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL6
|
||
case FFEINFO_kindtypeREAL6:
|
||
ffetarget_print_real6 (dmpout, u.real6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL7
|
||
case FFEINFO_kindtypeREAL7:
|
||
ffetarget_print_real7 (dmpout, u.real7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL8
|
||
case FFEINFO_kindtypeREAL8:
|
||
ffetarget_print_real8 (dmpout, u.real8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad REAL kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCOMPLEX:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okCOMPLEX1
|
||
case FFEINFO_kindtypeREAL1:
|
||
fprintf (dmpout, "(");
|
||
ffetarget_print_real1 (dmpout, u.complex1.real);
|
||
fprintf (dmpout, ",");
|
||
ffetarget_print_real1 (dmpout, u.complex1.imaginary);
|
||
fprintf (dmpout, ")");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX2
|
||
case FFEINFO_kindtypeREAL2:
|
||
fprintf (dmpout, "(");
|
||
ffetarget_print_real2 (dmpout, u.complex2.real);
|
||
fprintf (dmpout, ",");
|
||
ffetarget_print_real2 (dmpout, u.complex2.imaginary);
|
||
fprintf (dmpout, ")");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX3
|
||
case FFEINFO_kindtypeREAL3:
|
||
fprintf (dmpout, "(");
|
||
ffetarget_print_real3 (dmpout, u.complex3.real);
|
||
fprintf (dmpout, ",");
|
||
ffetarget_print_real3 (dmpout, u.complex3.imaginary);
|
||
fprintf (dmpout, ")");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX4
|
||
case FFEINFO_kindtypeREAL4:
|
||
fprintf (dmpout, "(");
|
||
ffetarget_print_real4 (dmpout, u.complex4.real);
|
||
fprintf (dmpout, ",");
|
||
ffetarget_print_real4 (dmpout, u.complex4.imaginary);
|
||
fprintf (dmpout, ")");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX5
|
||
case FFEINFO_kindtypeREAL5:
|
||
fprintf (dmpout, "(");
|
||
ffetarget_print_real5 (dmpout, u.complex5.real);
|
||
fprintf (dmpout, ",");
|
||
ffetarget_print_real5 (dmpout, u.complex5.imaginary);
|
||
fprintf (dmpout, ")");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX6
|
||
case FFEINFO_kindtypeREAL6:
|
||
fprintf (dmpout, "(");
|
||
ffetarget_print_real6 (dmpout, u.complex6.real);
|
||
fprintf (dmpout, ",");
|
||
ffetarget_print_real6 (dmpout, u.complex6.imaginary);
|
||
fprintf (dmpout, ")");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX7
|
||
case FFEINFO_kindtypeREAL7:
|
||
fprintf (dmpout, "(");
|
||
ffetarget_print_real7 (dmpout, u.complex7.real);
|
||
fprintf (dmpout, ",");
|
||
ffetarget_print_real7 (dmpout, u.complex7.imaginary);
|
||
fprintf (dmpout, ")");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX8
|
||
case FFEINFO_kindtypeREAL8:
|
||
fprintf (dmpout, "(");
|
||
ffetarget_print_real8 (dmpout, u.complex8.real);
|
||
fprintf (dmpout, ",");
|
||
ffetarget_print_real8 (dmpout, u.complex8.imaginary);
|
||
fprintf (dmpout, ")");
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad COMPLEX kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCHARACTER:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okCHARACTER1
|
||
case FFEINFO_kindtypeCHARACTER1:
|
||
ffetarget_print_character1 (dmpout, u.character1);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER2
|
||
case FFEINFO_kindtypeCHARACTER2:
|
||
ffetarget_print_character2 (dmpout, u.character2);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER3
|
||
case FFEINFO_kindtypeCHARACTER3:
|
||
ffetarget_print_character3 (dmpout, u.character3);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER4
|
||
case FFEINFO_kindtypeCHARACTER4:
|
||
ffetarget_print_character4 (dmpout, u.character4);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER5
|
||
case FFEINFO_kindtypeCHARACTER5:
|
||
ffetarget_print_character5 (dmpout, u.character5);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER6
|
||
case FFEINFO_kindtypeCHARACTER6:
|
||
ffetarget_print_character6 (dmpout, u.character6);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER7
|
||
case FFEINFO_kindtypeCHARACTER7:
|
||
ffetarget_print_character7 (dmpout, u.character7);
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER8
|
||
case FFEINFO_kindtypeCHARACTER8:
|
||
ffetarget_print_character8 (dmpout, u.character8);
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad CHARACTER kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
default:
|
||
assert ("bad basictype" == NULL);
|
||
break;
|
||
}
|
||
}
|
||
#endif
|
||
|
||
/* ffebld_dump -- Dump expression tree in concise form
|
||
|
||
ffebld b;
|
||
ffebld_dump(b); */
|
||
|
||
#if FFECOM_targetCURRENT == FFECOM_targetFFE
|
||
void
|
||
ffebld_dump (ffebld b)
|
||
{
|
||
ffeinfoKind k;
|
||
ffeinfoWhere w;
|
||
|
||
if (b == NULL)
|
||
{
|
||
fprintf (dmpout, "(null)");
|
||
return;
|
||
}
|
||
|
||
switch (ffebld_op (b))
|
||
{
|
||
case FFEBLD_opITEM:
|
||
fputs ("[", dmpout);
|
||
while (b != NULL)
|
||
{
|
||
ffebld_dump (ffebld_head (b));
|
||
if ((b = ffebld_trail (b)) != NULL)
|
||
fputs (",", dmpout);
|
||
}
|
||
fputs ("]", dmpout);
|
||
return;
|
||
|
||
case FFEBLD_opSTAR:
|
||
case FFEBLD_opBOUNDS:
|
||
case FFEBLD_opREPEAT:
|
||
case FFEBLD_opLABTER:
|
||
case FFEBLD_opLABTOK:
|
||
case FFEBLD_opIMPDO:
|
||
fputs (ffebld_op_string (ffebld_op (b)), dmpout);
|
||
break;
|
||
|
||
default:
|
||
if (ffeinfo_size (ffebld_info (b)) != FFETARGET_charactersizeNONE)
|
||
fprintf (dmpout, "%s%d%s%s*%" ffetargetCharacterSize_f "u",
|
||
ffebld_op_string (ffebld_op (b)),
|
||
(int) ffeinfo_rank (ffebld_info (b)),
|
||
ffeinfo_basictype_string (ffeinfo_basictype (ffebld_info (b))),
|
||
ffeinfo_kindtype_string (ffeinfo_kindtype (ffebld_info (b))),
|
||
ffeinfo_size (ffebld_info (b)));
|
||
else
|
||
fprintf (dmpout, "%s%d%s%s", ffebld_op_string (ffebld_op (b)),
|
||
(int) ffeinfo_rank (ffebld_info (b)),
|
||
ffeinfo_basictype_string (ffeinfo_basictype (ffebld_info (b))),
|
||
ffeinfo_kindtype_string (ffeinfo_kindtype (ffebld_info (b))));
|
||
if ((k = ffeinfo_kind (ffebld_info (b))) != FFEINFO_kindNONE)
|
||
fprintf (dmpout, "/%s", ffeinfo_kind_string (k));
|
||
if ((w = ffeinfo_where (ffebld_info (b))) != FFEINFO_whereNONE)
|
||
fprintf (dmpout, "@%s", ffeinfo_where_string (w));
|
||
break;
|
||
}
|
||
|
||
switch (ffebld_arity (b))
|
||
{
|
||
case 2:
|
||
fputs ("(", dmpout);
|
||
ffebld_dump (ffebld_left (b));
|
||
fputs (",", dmpout);
|
||
ffebld_dump (ffebld_right (b));
|
||
fputs (")", dmpout);
|
||
break;
|
||
|
||
case 1:
|
||
fputs ("(", dmpout);
|
||
ffebld_dump (ffebld_left (b));
|
||
fputs (")", dmpout);
|
||
break;
|
||
|
||
default:
|
||
switch (ffebld_op (b))
|
||
{
|
||
case FFEBLD_opCONTER:
|
||
fprintf (dmpout, "<");
|
||
ffebld_constant_dump (b->u.conter.expr);
|
||
fprintf (dmpout, ">");
|
||
break;
|
||
|
||
case FFEBLD_opACCTER:
|
||
fprintf (dmpout, "<");
|
||
ffebld_constantarray_dump (b->u.accter.array,
|
||
ffeinfo_basictype (ffebld_info (b)),
|
||
ffeinfo_kindtype (ffebld_info (b)),
|
||
ffebit_size (b->u.accter.bits), b->u.accter.bits);
|
||
fprintf (dmpout, ">");
|
||
break;
|
||
|
||
case FFEBLD_opARRTER:
|
||
fprintf (dmpout, "<");
|
||
ffebld_constantarray_dump (b->u.arrter.array,
|
||
ffeinfo_basictype (ffebld_info (b)),
|
||
ffeinfo_kindtype (ffebld_info (b)),
|
||
b->u.arrter.size, NULL);
|
||
fprintf (dmpout, ">");
|
||
break;
|
||
|
||
case FFEBLD_opLABTER:
|
||
if (b->u.labter == NULL)
|
||
fprintf (dmpout, "<>");
|
||
else
|
||
fprintf (dmpout, "<%" ffelabValue_f "u>", ffelab_value (b->u.labter));
|
||
break;
|
||
|
||
case FFEBLD_opLABTOK:
|
||
fprintf (dmpout, "<%s>", ffelex_token_text (b->u.labtok));
|
||
break;
|
||
|
||
case FFEBLD_opSYMTER:
|
||
fprintf (dmpout, "<");
|
||
ffesymbol_dump (b->u.symter.symbol);
|
||
if ((b->u.symter.generic != FFEINTRIN_genNONE)
|
||
|| (b->u.symter.specific != FFEINTRIN_specNONE))
|
||
fprintf (dmpout, "{%s:%s:%s}",
|
||
ffeintrin_name_generic (b->u.symter.generic),
|
||
ffeintrin_name_specific (b->u.symter.specific),
|
||
ffeintrin_name_implementation (b->u.symter.implementation));
|
||
if (b->u.symter.do_iter)
|
||
fprintf (dmpout, "{/do-iter}");
|
||
fprintf (dmpout, ">");
|
||
break;
|
||
|
||
default:
|
||
break;
|
||
}
|
||
}
|
||
}
|
||
#endif
|
||
|
||
/* ffebld_dump_prefix -- Dump the prefix for a constant of a given type
|
||
|
||
ffebld_dump_prefix(dmpout,FFEINFO_basictypeINTEGER,
|
||
FFEINFO_kindtypeINTEGER1); */
|
||
|
||
#if FFECOM_targetCURRENT == FFECOM_targetFFE
|
||
void
|
||
ffebld_dump_prefix (FILE *out, ffeinfoBasictype bt, ffeinfoKindtype kt)
|
||
{
|
||
switch (bt)
|
||
{
|
||
case FFEINFO_basictypeINTEGER:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okINTEGER1
|
||
case FFEINFO_kindtypeINTEGER1:
|
||
fprintf (out, "I" STRX (FFETARGET_kindINTEGER1) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER2
|
||
case FFEINFO_kindtypeINTEGER2:
|
||
fprintf (out, "I" STRX (FFETARGET_kindINTEGER2) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER3
|
||
case FFEINFO_kindtypeINTEGER3:
|
||
fprintf (out, "I" STRX (FFETARGET_kindINTEGER3) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER4
|
||
case FFEINFO_kindtypeINTEGER4:
|
||
fprintf (out, "I" STRX (FFETARGET_kindINTEGER4) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER5
|
||
case FFEINFO_kindtypeINTEGER5:
|
||
fprintf (out, "I" STRX (FFETARGET_kindINTEGER5) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER6
|
||
case FFEINFO_kindtypeINTEGER6:
|
||
fprintf (out, "I" STRX (FFETARGET_kindINTEGER6) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER7
|
||
case FFEINFO_kindtypeINTEGER7:
|
||
fprintf (out, "I" STRX (FFETARGET_kindINTEGER7) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okINTEGER8
|
||
case FFEINFO_kindtypeINTEGER8:
|
||
fprintf (out, "I" STRX (FFETARGET_kindINTEGER8) "/");
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad INTEGER kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeLOGICAL:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okLOGICAL1
|
||
case FFEINFO_kindtypeLOGICAL1:
|
||
fprintf (out, "L" STRX (FFETARGET_kindLOGICAL1) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL2
|
||
case FFEINFO_kindtypeLOGICAL2:
|
||
fprintf (out, "L" STRX (FFETARGET_kindLOGICAL2) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL3
|
||
case FFEINFO_kindtypeLOGICAL3:
|
||
fprintf (out, "L" STRX (FFETARGET_kindLOGICAL3) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL4
|
||
case FFEINFO_kindtypeLOGICAL4:
|
||
fprintf (out, "L" STRX (FFETARGET_kindLOGICAL4) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL5
|
||
case FFEINFO_kindtypeLOGICAL5:
|
||
fprintf (out, "L" STRX (FFETARGET_kindLOGICAL5) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL6
|
||
case FFEINFO_kindtypeLOGICAL6:
|
||
fprintf (out, "L" STRX (FFETARGET_kindLOGICAL6) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL7
|
||
case FFEINFO_kindtypeLOGICAL7:
|
||
fprintf (out, "L" STRX (FFETARGET_kindLOGICAL7) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okLOGICAL8
|
||
case FFEINFO_kindtypeLOGICAL8:
|
||
fprintf (out, "L" STRX (FFETARGET_kindLOGICAL8) "/");
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad LOGICAL kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeREAL:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okREAL1
|
||
case FFEINFO_kindtypeREAL1:
|
||
fprintf (out, "R" STRX (FFETARGET_kindREAL1) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL2
|
||
case FFEINFO_kindtypeREAL2:
|
||
fprintf (out, "R" STRX (FFETARGET_kindREAL2) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL3
|
||
case FFEINFO_kindtypeREAL3:
|
||
fprintf (out, "R" STRX (FFETARGET_kindREAL3) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL4
|
||
case FFEINFO_kindtypeREAL4:
|
||
fprintf (out, "R" STRX (FFETARGET_kindREAL4) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL5
|
||
case FFEINFO_kindtypeREAL5:
|
||
fprintf (out, "R" STRX (FFETARGET_kindREAL5) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL6
|
||
case FFEINFO_kindtypeREAL6:
|
||
fprintf (out, "R" STRX (FFETARGET_kindREAL6) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL7
|
||
case FFEINFO_kindtypeREAL7:
|
||
fprintf (out, "R" STRX (FFETARGET_kindREAL7) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okREAL8
|
||
case FFEINFO_kindtypeREAL8:
|
||
fprintf (out, "R" STRX (FFETARGET_kindREAL8) "/");
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad REAL kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCOMPLEX:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okCOMPLEX1
|
||
case FFEINFO_kindtypeREAL1:
|
||
fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX1) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX2
|
||
case FFEINFO_kindtypeREAL2:
|
||
fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX2) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX3
|
||
case FFEINFO_kindtypeREAL3:
|
||
fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX3) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX4
|
||
case FFEINFO_kindtypeREAL4:
|
||
fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX4) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX5
|
||
case FFEINFO_kindtypeREAL5:
|
||
fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX5) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX6
|
||
case FFEINFO_kindtypeREAL6:
|
||
fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX6) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX7
|
||
case FFEINFO_kindtypeREAL7:
|
||
fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX7) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCOMPLEX8
|
||
case FFEINFO_kindtypeREAL8:
|
||
fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX8) "/");
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad COMPLEX kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case FFEINFO_basictypeCHARACTER:
|
||
switch (kt)
|
||
{
|
||
#if FFETARGET_okCHARACTER1
|
||
case FFEINFO_kindtypeCHARACTER1:
|
||
fprintf (out, "A" STRX (FFETARGET_kindCHARACTER1) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER2
|
||
case FFEINFO_kindtypeCHARACTER2:
|
||
fprintf (out, "A" STRX (FFETARGET_kindCHARACTER2) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER3
|
||
case FFEINFO_kindtypeCHARACTER3:
|
||
fprintf (out, "A" STRX (FFETARGET_kindCHARACTER3) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER4
|
||
case FFEINFO_kindtypeCHARACTER4:
|
||
fprintf (out, "A" STRX (FFETARGET_kindCHARACTER4) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER5
|
||
case FFEINFO_kindtypeCHARACTER5:
|
||
fprintf (out, "A" STRX (FFETARGET_kindCHARACTER5) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER6
|
||
case FFEINFO_kindtypeCHARACTER6:
|
||
fprintf (out, "A" STRX (FFETARGET_kindCHARACTER6) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER7
|
||
case FFEINFO_kindtypeCHARACTER7:
|
||
fprintf (out, "A" STRX (FFETARGET_kindCHARACTER7) "/");
|
||
break;
|
||
#endif
|
||
|
||
#if FFETARGET_okCHARACTER8
|
||
case FFEINFO_kindtypeCHARACTER8:
|
||
fprintf (out, "A" STRX (FFETARGET_kindCHARACTER8) "/");
|
||
break;
|
||
#endif
|
||
|
||
default:
|
||
assert ("bad CHARACTER kindtype" == NULL);
|
||
break;
|
||
}
|
||
break;
|
||
|
||
default:
|
||
assert ("bad basictype" == NULL);
|
||
fprintf (out, "?/?");
|
||
break;
|
||
}
|
||
}
|
||
#endif
|
||
|
||
/* ffebld_init_0 -- Initialize the module
|
||
|
||
ffebld_init_0(); */
|
||
|
||
void
|
||
ffebld_init_0 ()
|
||
{
|
||
assert (FFEBLD_op == ARRAY_SIZE (ffebld_op_string_));
|
||
assert (FFEBLD_op == ARRAY_SIZE (ffebld_arity_op_));
|
||
}
|
||
|
||
/* ffebld_init_1 -- Initialize the module for a file
|
||
|
||
ffebld_init_1(); */
|
||
|
||
void
|
||
ffebld_init_1 ()
|
||
{
|
||
#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
|
||
int i;
|
||
|
||
#if FFETARGET_okCHARACTER1
|
||
ffebld_constant_character1_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER2
|
||
ffebld_constant_character2_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER3
|
||
ffebld_constant_character3_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER4
|
||
ffebld_constant_character4_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER5
|
||
ffebld_constant_character5_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER6
|
||
ffebld_constant_character6_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER7
|
||
ffebld_constant_character7_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER8
|
||
ffebld_constant_character8_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX1
|
||
ffebld_constant_complex1_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX2
|
||
ffebld_constant_complex2_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX3
|
||
ffebld_constant_complex3_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX4
|
||
ffebld_constant_complex4_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX5
|
||
ffebld_constant_complex5_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX6
|
||
ffebld_constant_complex6_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX7
|
||
ffebld_constant_complex7_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX8
|
||
ffebld_constant_complex8_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER1
|
||
ffebld_constant_integer1_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER2
|
||
ffebld_constant_integer2_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER3
|
||
ffebld_constant_integer3_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER4
|
||
ffebld_constant_integer4_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER5
|
||
ffebld_constant_integer5_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER6
|
||
ffebld_constant_integer6_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER7
|
||
ffebld_constant_integer7_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER8
|
||
ffebld_constant_integer8_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL1
|
||
ffebld_constant_logical1_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL2
|
||
ffebld_constant_logical2_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL3
|
||
ffebld_constant_logical3_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL4
|
||
ffebld_constant_logical4_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL5
|
||
ffebld_constant_logical5_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL6
|
||
ffebld_constant_logical6_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL7
|
||
ffebld_constant_logical7_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL8
|
||
ffebld_constant_logical8_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL1
|
||
ffebld_constant_real1_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL2
|
||
ffebld_constant_real2_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL3
|
||
ffebld_constant_real3_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL4
|
||
ffebld_constant_real4_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL5
|
||
ffebld_constant_real5_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL6
|
||
ffebld_constant_real6_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL7
|
||
ffebld_constant_real7_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL8
|
||
ffebld_constant_real8_ = NULL;
|
||
#endif
|
||
ffebld_constant_hollerith_ = NULL;
|
||
for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
|
||
ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
|
||
#endif
|
||
}
|
||
|
||
/* ffebld_init_2 -- Initialize the module
|
||
|
||
ffebld_init_2(); */
|
||
|
||
void
|
||
ffebld_init_2 ()
|
||
{
|
||
#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
|
||
int i;
|
||
#endif
|
||
|
||
ffebld_pool_stack_.next = NULL;
|
||
ffebld_pool_stack_.pool = ffe_pool_program_unit ();
|
||
#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
|
||
#if FFETARGET_okCHARACTER1
|
||
ffebld_constant_character1_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER2
|
||
ffebld_constant_character2_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER3
|
||
ffebld_constant_character3_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER4
|
||
ffebld_constant_character4_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER5
|
||
ffebld_constant_character5_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER6
|
||
ffebld_constant_character6_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER7
|
||
ffebld_constant_character7_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCHARACTER8
|
||
ffebld_constant_character8_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX1
|
||
ffebld_constant_complex1_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX2
|
||
ffebld_constant_complex2_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX3
|
||
ffebld_constant_complex3_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX4
|
||
ffebld_constant_complex4_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX5
|
||
ffebld_constant_complex5_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX6
|
||
ffebld_constant_complex6_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX7
|
||
ffebld_constant_complex7_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okCOMPLEX8
|
||
ffebld_constant_complex8_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER1
|
||
ffebld_constant_integer1_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER2
|
||
ffebld_constant_integer2_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER3
|
||
ffebld_constant_integer3_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER4
|
||
ffebld_constant_integer4_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER5
|
||
ffebld_constant_integer5_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER6
|
||
ffebld_constant_integer6_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER7
|
||
ffebld_constant_integer7_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okINTEGER8
|
||
ffebld_constant_integer8_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL1
|
||
ffebld_constant_logical1_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL2
|
||
ffebld_constant_logical2_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL3
|
||
ffebld_constant_logical3_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL4
|
||
ffebld_constant_logical4_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL5
|
||
ffebld_constant_logical5_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL6
|
||
ffebld_constant_logical6_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL7
|
||
ffebld_constant_logical7_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okLOGICAL8
|
||
ffebld_constant_logical8_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL1
|
||
ffebld_constant_real1_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL2
|
||
ffebld_constant_real2_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL3
|
||
ffebld_constant_real3_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL4
|
||
ffebld_constant_real4_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL5
|
||
ffebld_constant_real5_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL6
|
||
ffebld_constant_real6_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL7
|
||
ffebld_constant_real7_ = NULL;
|
||
#endif
|
||
#if FFETARGET_okREAL8
|
||
ffebld_constant_real8_ = NULL;
|
||
#endif
|
||
ffebld_constant_hollerith_ = NULL;
|
||
for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
|
||
ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
|
||
#endif
|
||
}
|
||
|
||
/* ffebld_list_length -- Return # of opITEMs in list
|
||
|
||
ffebld list; // Must be NULL or opITEM
|
||
ffebldListLength length;
|
||
length = ffebld_list_length(list);
|
||
|
||
Returns 0 if list is NULL, 1 if it's ffebld_trail is NULL, and so on. */
|
||
|
||
ffebldListLength
|
||
ffebld_list_length (ffebld list)
|
||
{
|
||
ffebldListLength length;
|
||
|
||
for (length = 0; list != NULL; ++length, list = ffebld_trail (list))
|
||
;
|
||
|
||
return length;
|
||
}
|
||
|
||
/* ffebld_new_accter -- Create an ffebld object that is an array
|
||
|
||
ffebld x;
|
||
ffebldConstantArray a;
|
||
ffebit b;
|
||
x = ffebld_new_accter(a,b); */
|
||
|
||
ffebld
|
||
ffebld_new_accter (ffebldConstantArray a, ffebit b)
|
||
{
|
||
ffebld x;
|
||
|
||
x = ffebld_new ();
|
||
#if FFEBLD_BLANK_
|
||
*x = ffebld_blank_;
|
||
#endif
|
||
x->op = FFEBLD_opACCTER;
|
||
x->u.accter.array = a;
|
||
x->u.accter.bits = b;
|
||
x->u.accter.pad = 0;
|
||
return x;
|
||
}
|
||
|
||
/* ffebld_new_arrter -- Create an ffebld object that is an array
|
||
|
||
ffebld x;
|
||
ffebldConstantArray a;
|
||
ffetargetOffset size;
|
||
x = ffebld_new_arrter(a,size); */
|
||
|
||
ffebld
|
||
ffebld_new_arrter (ffebldConstantArray a, ffetargetOffset size)
|
||
{
|
||
ffebld x;
|
||
|
||
x = ffebld_new ();
|
||
#if FFEBLD_BLANK_
|
||
*x = ffebld_blank_;
|
||
#endif
|
||
x->op = FFEBLD_opARRTER;
|
||
x->u.arrter.array = a;
|
||
x->u.arrter.size = size;
|
||
x->u.arrter.pad = 0;
|
||
return x;
|
||
}
|
||
|
||
/* ffebld_new_conter_with_orig -- Create an ffebld object that is a constant
|
||
|
||
ffebld x;
|
||
ffebldConstant c;
|
||
x = ffebld_new_conter_with_orig(c,NULL); */
|
||
|
||
ffebld
|
||
ffebld_new_conter_with_orig (ffebldConstant c, ffebld o)
|
||
{
|
||
ffebld x;
|
||
|
||
x = ffebld_new ();
|
||
#if FFEBLD_BLANK_
|
||
*x = ffebld_blank_;
|
||
#endif
|
||
x->op = FFEBLD_opCONTER;
|
||
x->u.conter.expr = c;
|
||
x->u.conter.orig = o;
|
||
x->u.conter.pad = 0;
|
||
return x;
|
||
}
|
||
|
||
/* ffebld_new_item -- Create an ffebld item object
|
||
|
||
ffebld x,y,z;
|
||
x = ffebld_new_item(y,z); */
|
||
|
||
ffebld
|
||
ffebld_new_item (ffebld head, ffebld trail)
|
||
{
|
||
ffebld x;
|
||
|
||
x = ffebld_new ();
|
||
#if FFEBLD_BLANK_
|
||
*x = ffebld_blank_;
|
||
#endif
|
||
x->op = FFEBLD_opITEM;
|
||
x->u.item.head = head;
|
||
x->u.item.trail = trail;
|
||
#ifdef FFECOM_itemHOOK
|
||
x->u.item.hook = FFECOM_itemNULL;
|
||
#endif
|
||
return x;
|
||
}
|
||
|
||
/* ffebld_new_labter -- Create an ffebld object that is a label
|
||
|
||
ffebld x;
|
||
ffelab l;
|
||
x = ffebld_new_labter(c); */
|
||
|
||
ffebld
|
||
ffebld_new_labter (ffelab l)
|
||
{
|
||
ffebld x;
|
||
|
||
x = ffebld_new ();
|
||
#if FFEBLD_BLANK_
|
||
*x = ffebld_blank_;
|
||
#endif
|
||
x->op = FFEBLD_opLABTER;
|
||
x->u.labter = l;
|
||
return x;
|
||
}
|
||
|
||
/* ffebld_new_labtok -- Create object that is a label's NUMBER token
|
||
|
||
ffebld x;
|
||
ffelexToken t;
|
||
x = ffebld_new_labter(c);
|
||
|
||
Like the other ffebld_new_ functions, the
|
||
supplied argument is stored exactly as is: ffelex_token_use is NOT
|
||
called, so the token is "consumed", if one is indeed supplied (it may
|
||
be NULL). */
|
||
|
||
ffebld
|
||
ffebld_new_labtok (ffelexToken t)
|
||
{
|
||
ffebld x;
|
||
|
||
x = ffebld_new ();
|
||
#if FFEBLD_BLANK_
|
||
*x = ffebld_blank_;
|
||
#endif
|
||
x->op = FFEBLD_opLABTOK;
|
||
x->u.labtok = t;
|
||
return x;
|
||
}
|
||
|
||
/* ffebld_new_none -- Create an ffebld object with no arguments
|
||
|
||
ffebld x;
|
||
x = ffebld_new_none(FFEBLD_opWHATEVER); */
|
||
|
||
ffebld
|
||
ffebld_new_none (ffebldOp o)
|
||
{
|
||
ffebld x;
|
||
|
||
x = ffebld_new ();
|
||
#if FFEBLD_BLANK_
|
||
*x = ffebld_blank_;
|
||
#endif
|
||
x->op = o;
|
||
return x;
|
||
}
|
||
|
||
/* ffebld_new_one -- Create an ffebld object with one argument
|
||
|
||
ffebld x,y;
|
||
x = ffebld_new_one(FFEBLD_opWHATEVER,y); */
|
||
|
||
ffebld
|
||
ffebld_new_one (ffebldOp o, ffebld left)
|
||
{
|
||
ffebld x;
|
||
|
||
x = ffebld_new ();
|
||
#if FFEBLD_BLANK_
|
||
*x = ffebld_blank_;
|
||
#endif
|
||
x->op = o;
|
||
x->u.nonter.left = left;
|
||
#ifdef FFECOM_nonterHOOK
|
||
x->u.nonter.hook = FFECOM_nonterNULL;
|
||
#endif
|
||
return x;
|
||
}
|
||
|
||
/* ffebld_new_symter -- Create an ffebld object that is a symbol
|
||
|
||
ffebld x;
|
||
ffesymbol s;
|
||
ffeintrinGen gen; // Generic intrinsic id, if any
|
||
ffeintrinSpec spec; // Specific intrinsic id, if any
|
||
ffeintrinImp imp; // Implementation intrinsic id, if any
|
||
x = ffebld_new_symter (s, gen, spec, imp); */
|
||
|
||
ffebld
|
||
ffebld_new_symter (ffesymbol s, ffeintrinGen gen, ffeintrinSpec spec,
|
||
ffeintrinImp imp)
|
||
{
|
||
ffebld x;
|
||
|
||
x = ffebld_new ();
|
||
#if FFEBLD_BLANK_
|
||
*x = ffebld_blank_;
|
||
#endif
|
||
x->op = FFEBLD_opSYMTER;
|
||
x->u.symter.symbol = s;
|
||
x->u.symter.generic = gen;
|
||
x->u.symter.specific = spec;
|
||
x->u.symter.implementation = imp;
|
||
x->u.symter.do_iter = FALSE;
|
||
return x;
|
||
}
|
||
|
||
/* ffebld_new_two -- Create an ffebld object with two arguments
|
||
|
||
ffebld x,y,z;
|
||
x = ffebld_new_two(FFEBLD_opWHATEVER,y,z); */
|
||
|
||
ffebld
|
||
ffebld_new_two (ffebldOp o, ffebld left, ffebld right)
|
||
{
|
||
ffebld x;
|
||
|
||
x = ffebld_new ();
|
||
#if FFEBLD_BLANK_
|
||
*x = ffebld_blank_;
|
||
#endif
|
||
x->op = o;
|
||
x->u.nonter.left = left;
|
||
x->u.nonter.right = right;
|
||
#ifdef FFECOM_nonterHOOK
|
||
x->u.nonter.hook = FFECOM_nonterNULL;
|
||
#endif
|
||
return x;
|
||
}
|
||
|
||
/* ffebld_pool_pop -- Pop ffebld's pool stack
|
||
|
||
ffebld_pool_pop(); */
|
||
|
||
void
|
||
ffebld_pool_pop ()
|
||
{
|
||
ffebldPoolstack_ ps;
|
||
|
||
assert (ffebld_pool_stack_.next != NULL);
|
||
ps = ffebld_pool_stack_.next;
|
||
ffebld_pool_stack_.next = ps->next;
|
||
ffebld_pool_stack_.pool = ps->pool;
|
||
malloc_kill_ks (malloc_pool_image (), ps, sizeof (*ps));
|
||
}
|
||
|
||
/* ffebld_pool_push -- Push ffebld's pool stack
|
||
|
||
ffebld_pool_push(); */
|
||
|
||
void
|
||
ffebld_pool_push (mallocPool pool)
|
||
{
|
||
ffebldPoolstack_ ps;
|
||
|
||
ps = malloc_new_ks (malloc_pool_image (), "Pool stack", sizeof (*ps));
|
||
ps->next = ffebld_pool_stack_.next;
|
||
ps->pool = ffebld_pool_stack_.pool;
|
||
ffebld_pool_stack_.next = ps;
|
||
ffebld_pool_stack_.pool = pool;
|
||
}
|
||
|
||
/* ffebld_op_string -- Return short string describing op
|
||
|
||
ffebldOp o;
|
||
ffebld_op_string(o);
|
||
|
||
Returns a short string (uppercase) containing the name of the op. */
|
||
|
||
const char *
|
||
ffebld_op_string (ffebldOp o)
|
||
{
|
||
if (o >= ARRAY_SIZE (ffebld_op_string_))
|
||
return "?\?\?";
|
||
return ffebld_op_string_[o];
|
||
}
|
||
|
||
/* ffebld_size_max -- Return maximum possible size of CHARACTER-type expr
|
||
|
||
ffetargetCharacterSize sz;
|
||
ffebld b;
|
||
sz = ffebld_size_max (b);
|
||
|
||
Like ffebld_size_known, but if that would return NONE and the expression
|
||
is opSUBSTR, opCONVERT, opPAREN, or opCONCATENATE, returns ffebld_size_max
|
||
of the subexpression(s). */
|
||
|
||
ffetargetCharacterSize
|
||
ffebld_size_max (ffebld b)
|
||
{
|
||
ffetargetCharacterSize sz;
|
||
|
||
recurse: /* :::::::::::::::::::: */
|
||
|
||
sz = ffebld_size_known (b);
|
||
|
||
if (sz != FFETARGET_charactersizeNONE)
|
||
return sz;
|
||
|
||
switch (ffebld_op (b))
|
||
{
|
||
case FFEBLD_opSUBSTR:
|
||
case FFEBLD_opCONVERT:
|
||
case FFEBLD_opPAREN:
|
||
b = ffebld_left (b);
|
||
goto recurse; /* :::::::::::::::::::: */
|
||
|
||
case FFEBLD_opCONCATENATE:
|
||
sz = ffebld_size_max (ffebld_left (b))
|
||
+ ffebld_size_max (ffebld_right (b));
|
||
return sz;
|
||
|
||
default:
|
||
return sz;
|
||
}
|
||
}
|