/* bld.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995, 1996 Free Software Foundation, Inc.
- Contributed by James Craig Burley (burley@gnu.org).
+ Contributed by James Craig Burley.
This file is part of GNU Fortran.
#include "malloc.h"
#include "target.h"
#include "where.h"
+#include "real.h"
/* Externals defined here. */
-ffebldArity ffebld_arity_op_[]
+const ffebldArity ffebld_arity_op_[(int) FFEBLD_op]
=
{
#define FFEBLD_OP(KWD,NAME,ARITY) ARITY,
static ffebldConstant ffebld_constant_typeless_[FFEBLD_constTYPELESS_LAST
- FFEBLD_constTYPELESS_FIRST + 1];
-static char *ffebld_op_string_[]
+static const char *const ffebld_op_string_[]
=
{
#define FFEBLD_OP(KWD,NAME,ARITY) NAME,
}
}
-/* 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;
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);
+/* ffebld_constantarray_get -- Get a value from an array of constants
- 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. */
+ See prototype. */
-#if FFECOM_targetCURRENT == FFECOM_targetFFE
-void
-ffebld_constantarray_dump (ffebldConstantArray array, ffeinfoBasictype bt,
- ffeinfoKindtype kt, ffetargetOffset size, ffebit bits)
+ffebldConstantUnion
+ffebld_constantarray_get (ffebldConstantArray array, ffeinfoBasictype bt,
+ ffeinfoKindtype kt, ffetargetOffset offset)
{
- ffetargetOffset i;
- ffebitCount j;
-
- ffebld_dump_prefix (dmpout, bt, kt);
-
- fprintf (dmpout, "\\(");
+ ffebldConstantUnion u;
- 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)
+ switch (bt)
{
case FFEINFO_basictypeINTEGER:
switch (kt)
}
}
-/* ffebld_constantunion_dump -- Dump a constant
+/* ffebld_init_0 -- Initialize the module
- See prototype. */
+ ffebld_init_0(); */
-#if FFECOM_targetCURRENT == FFECOM_targetFFE
void
-ffebld_constantunion_dump (ffebldConstantUnion u, ffeinfoBasictype bt,
- ffeinfoKindtype kt)
+ffebld_init_0 ()
{
- switch (bt)
- {
- case FFEINFO_basictypeINTEGER:
- switch (kt)
- {
+ 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
- case FFEINFO_kindtypeINTEGER1:
- ffetarget_print_integer1 (dmpout, u.integer1);
- break;
+ ffebld_constant_integer1_ = NULL;
#endif
-
#if FFETARGET_okINTEGER2
- case FFEINFO_kindtypeINTEGER2:
- ffetarget_print_integer2 (dmpout, u.integer2);
- break;
+ ffebld_constant_integer2_ = NULL;
#endif
-
#if FFETARGET_okINTEGER3
- case FFEINFO_kindtypeINTEGER3:
- ffetarget_print_integer3 (dmpout, u.integer3);
- break;
+ ffebld_constant_integer3_ = NULL;
#endif
-
#if FFETARGET_okINTEGER4
- case FFEINFO_kindtypeINTEGER4:
- ffetarget_print_integer4 (dmpout, u.integer4);
- break;
+ ffebld_constant_integer4_ = NULL;
#endif
-
#if FFETARGET_okINTEGER5
- case FFEINFO_kindtypeINTEGER5:
- ffetarget_print_integer5 (dmpout, u.integer5);
- break;
+ ffebld_constant_integer5_ = NULL;
#endif
-
#if FFETARGET_okINTEGER6
- case FFEINFO_kindtypeINTEGER6:
- ffetarget_print_integer6 (dmpout, u.integer6);
- break;
+ ffebld_constant_integer6_ = NULL;
#endif
-
#if FFETARGET_okINTEGER7
- case FFEINFO_kindtypeINTEGER7:
- ffetarget_print_integer7 (dmpout, u.integer7);
- break;
+ ffebld_constant_integer7_ = NULL;
#endif
-
#if FFETARGET_okINTEGER8
- case FFEINFO_kindtypeINTEGER8:
- ffetarget_print_integer8 (dmpout, u.integer8);
- break;
+ ffebld_constant_integer8_ = NULL;
#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;
+ ffebld_constant_logical1_ = NULL;
#endif
-
#if FFETARGET_okLOGICAL2
- case FFEINFO_kindtypeLOGICAL2:
- ffetarget_print_logical2 (dmpout, u.logical2);
- break;
+ ffebld_constant_logical2_ = NULL;
#endif
-
#if FFETARGET_okLOGICAL3
- case FFEINFO_kindtypeLOGICAL3:
- ffetarget_print_logical3 (dmpout, u.logical3);
- break;
+ ffebld_constant_logical3_ = NULL;
#endif
-
#if FFETARGET_okLOGICAL4
- case FFEINFO_kindtypeLOGICAL4:
- ffetarget_print_logical4 (dmpout, u.logical4);
- break;
+ ffebld_constant_logical4_ = NULL;
#endif
-
#if FFETARGET_okLOGICAL5
- case FFEINFO_kindtypeLOGICAL5:
- ffetarget_print_logical5 (dmpout, u.logical5);
- break;
+ ffebld_constant_logical5_ = NULL;
#endif
-
#if FFETARGET_okLOGICAL6
- case FFEINFO_kindtypeLOGICAL6:
- ffetarget_print_logical6 (dmpout, u.logical6);
- break;
+ ffebld_constant_logical6_ = NULL;
#endif
-
#if FFETARGET_okLOGICAL7
- case FFEINFO_kindtypeLOGICAL7:
- ffetarget_print_logical7 (dmpout, u.logical7);
- break;
+ ffebld_constant_logical7_ = NULL;
#endif
-
#if FFETARGET_okLOGICAL8
- case FFEINFO_kindtypeLOGICAL8:
- ffetarget_print_logical8 (dmpout, u.logical8);
- break;
+ ffebld_constant_logical8_ = NULL;
#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;
+ ffebld_constant_real1_ = NULL;
#endif
-
#if FFETARGET_okREAL2
- case FFEINFO_kindtypeREAL2:
- ffetarget_print_real2 (dmpout, u.real2);
- break;
+ ffebld_constant_real2_ = NULL;
#endif
-
#if FFETARGET_okREAL3
- case FFEINFO_kindtypeREAL3:
- ffetarget_print_real3 (dmpout, u.real3);
- break;
+ ffebld_constant_real3_ = NULL;
#endif
-
#if FFETARGET_okREAL4
- case FFEINFO_kindtypeREAL4:
- ffetarget_print_real4 (dmpout, u.real4);
- break;
+ ffebld_constant_real4_ = NULL;
#endif
-
#if FFETARGET_okREAL5
- case FFEINFO_kindtypeREAL5:
- ffetarget_print_real5 (dmpout, u.real5);
- break;
+ ffebld_constant_real5_ = NULL;
#endif
-
#if FFETARGET_okREAL6
- case FFEINFO_kindtypeREAL6:
- ffetarget_print_real6 (dmpout, u.real6);
- break;
+ ffebld_constant_real6_ = NULL;
#endif
-
#if FFETARGET_okREAL7
- case FFEINFO_kindtypeREAL7:
- ffetarget_print_real7 (dmpout, u.real7);
- break;
+ ffebld_constant_real7_ = NULL;
#endif
-
#if FFETARGET_okREAL8
- case FFEINFO_kindtypeREAL8:
- ffetarget_print_real8 (dmpout, u.real8);
- break;
+ ffebld_constant_real8_ = NULL;
#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;
+ ffebld_constant_hollerith_ = NULL;
+ for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
+ ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
#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
+/* ffebld_init_2 -- Initialize the module
-#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
+ ffebld_init_2(); */
-#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;
+void
+ffebld_init_2 ()
+{
+#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
+ int i;
#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;
+ 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_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;
+#if FFETARGET_okCHARACTER2
+ ffebld_constant_character2_ = NULL;
#endif
#if FFETARGET_okCHARACTER3
ffebld_constant_character3_ = NULL;
x->op = FFEBLD_opACCTER;
x->u.accter.array = a;
x->u.accter.bits = b;
+ x->u.accter.pad = 0;
return x;
}
x->op = FFEBLD_opARRTER;
x->u.arrter.array = a;
x->u.arrter.size = size;
+ x->u.arrter.pad = 0;
return x;
}
x->op = FFEBLD_opCONTER;
x->u.conter.expr = c;
x->u.conter.orig = o;
+ x->u.conter.pad = 0;
return x;
}
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;
}
#endif
x->op = o;
x->u.nonter.left = left;
+#ifdef FFECOM_nonterHOOK
+ x->u.nonter.hook = FFECOM_nonterNULL;
+#endif
return x;
}
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;
}
Returns a short string (uppercase) containing the name of the op. */
-char *
+const char *
ffebld_op_string (ffebldOp o)
{
if (o >= ARRAY_SIZE (ffebld_op_string_))
OSDN Git Service
