/*gpc-defs.h -- global definitions for GNU Pascal
  Copyright (C) 1997-2002 Free Software Foundation, Inc.

  Authors: Peter Gerwinski <peter@gerwinski.de>
           Frank Heckenbach <frank@pascal.gnu.de>

  This file is part of GNU Pascal.

  GNU Pascal 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 Pascal 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 Pascal; see the file COPYING. If not, write to the
  Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  02111-1307, USA. */

#ifndef _GPC_DEFS_H_
#define _GPC_DEFS_H_

/* GPC compile time configuration switches */

#define USE_GPI_DEBUG_KEY       /* Use debugging keys in GPI files */

/* #undef DEBUG */              /* Used in execute() in module.c */

/* Include files everyone gets. */

#include "system.h"             /* Should be included before gpc-defs.h anyway */

#ifdef abort
#undef abort
#endif
#if 0
#define abort() fatal ("Internal compiler error in `%s', at %s:%d\n" \
  "Please submit a full bug report to the GPC mailing list <gpc@gnu.de>.\n"  \
  "See <URL:http://www.gnu-pascal.de/todo.html> for details.", \
  __PRETTY_FUNCTION__, trim_filename (__FILE__), __LINE__)
#else
#define abort() USE_ASSERT_RATHER_THAN_ABORT
#endif

/* Don't use the system's <assert.h>, see the comments in ../dwarfout.c */
#ifdef GPC_NO_ASSERTIONS
#define assert(expression) ((void) (expression))  /* Do evaluate expression */
#else
#ifndef __GNUC__
#define __PRETTY_FUNCTION__ "(unknown function)"
#endif
#if 0  /* @@ I'm not 100% sure if "void" operands to ?: are standard C. If not, use this alternative. -- Frank */
#define assert(expression) \
  ((void) ((expression) ? 0 : (assert_fail (#expression, __FILE__, __PRETTY_FUNCTION__, __LINE__), 0)))
#else
#define assert(expression) \
  ((expression) ? (void) 0 : assert_fail (#expression, __FILE__, __PRETTY_FUNCTION__, __LINE__))

/* @@ gcc-3 has a similar mechanism via abort(). Check this after porting to gcc-3. */
#define assert_no_error_mark(t) \
  ((TREE_CODE (t) != ERROR_MARK) ? (void) 0 : (error ("confused by previous errors, bailing out"), exit (FATAL_EXIT_CODE)))
#endif
#endif

#ifdef EGCS
/* copied from egcs c-decl.c */
/* Add qualifiers to a type, in the fashion for C.  */
extern tree c_build_qualified_type PARAMS ((tree, int));
#define c_build_type_variant(TYPE, CONST_P, VOLATILE_P)           \
  c_build_qualified_type (TYPE,                                   \
                          ((CONST_P) ? TYPE_QUAL_CONST : 0) |     \
                          ((VOLATILE_P) ? TYPE_QUAL_VOLATILE : 0))
#else
#include <stdio.h>

#ifdef HAVE_STRING_H
# include <string.h>
#else
# ifdef HAVE_STRINGS_H
#  include <strings.h>
# endif
#endif

#ifndef bcopy
# ifdef HAVE_BCOPY
#  ifdef NEED_DECLARATION_BCOPY
extern void bcopy ();
#  endif
# else /* ! HAVE_BCOPY */
#  define bcopy(src,dst,len) memcpy ((dst),(src),(len))
# endif
#endif

#ifndef bcmp
# ifdef HAVE_BCMP
#  ifdef NEED_DECLARATION_BCMP
extern int bcmp ();
#  endif
# else /* ! HAVE_BCMP */
#  define bcmp(left,right,len) memcmp ((left),(right),(len))
# endif
#endif

#ifndef bzero
# ifdef HAVE_BZERO
#  ifdef NEED_DECLARATION_BZERO
extern void bzero ();
#  endif
# else /* ! HAVE_BZERO */
#  define bzero(dst,len) memset ((dst),0,(len))
# endif
#endif

#ifndef index
# ifdef HAVE_INDEX
#  ifdef NEED_DECLARATION_INDEX
extern char *index ();
#  endif
# else /* ! HAVE_INDEX */
#  define index strchr
# endif
#endif

#ifndef rindex
# ifdef HAVE_RINDEX
#  ifdef NEED_DECLARATION_RINDEX
extern char *rindex ();
#  endif
# else /* ! HAVE_RINDEX */
#  define rindex strrchr
# endif
#endif

/* Macro that inserts it's argument in double quotes */
#ifndef STRINGIFY
# if defined(HAVE_CPP_STRINGIFY) || (defined(__GNUC__) && defined(__STDC__))
#  define STRINGIFY(STRING) #STRING
# else
#  define STRINGIFY(STRING) "STRING"
# endif
#endif

#endif /* ! EGCS */

#ifndef PATH_SEPARATOR
# define PATH_SEPARATOR ':'
#endif

#ifndef DIR_SEPARATOR
# define DIR_SEPARATOR '/'
#endif

/* Define IS_DIR_SEPARATOR. */
#ifndef IS_DIR_SEPARATOR
# ifndef DIR_SEPARATOR_2
#  define IS_DIR_SEPARATOR(CH) \
     (((CH) == DIR_SEPARATOR) || ((CH) == '/'))
# else /* DIR_SEPARATOR_2 */
#  define IS_DIR_SEPARATOR(CH) \
     (((CH) == DIR_SEPARATOR) || ((CH) == DIR_SEPARATOR_2) || ((CH) == '/'))
# endif /* DIR_SEPARATOR_2 */
#endif

#include "lang.h"

/* Define the type of Pascal we are compiling.
 * Used for reserved word recognition, warning messages, etc.
 * Let's hope that there will not be more than 32 important dialects ...
 */
#define CLASSIC_PASCAL_LEVEL_0   0x1  /* ISO 7185 Pascal, level 0 */
#define CLASSIC_PASCAL_LEVEL_1   0x2  /* ISO 7185 Pascal, level 1 */
#define EXTENDED_PASCAL          0x4  /* ISO 10206 Extended Pascal */
#define OBJECT_PASCAL            0x8  /* ANSI draft Object Pascal */
#define UCSD_PASCAL             0x10  /* UCSD Pascal */
#define BORLAND_PASCAL          0x20  /* Borland Pascal 7.0 */
#define BORLAND_DELPHI          0x40  /* Borland Delphi */
#define PASCAL_SC               0x80  /* Pascal-SC (PXSC) */
#define VAX_PASCAL             0x100  /* VAX Pascal */
/* to be continued ... */
#define GNU_PASCAL        0x40000000  /* GNU Pascal (default) */
#define DIALECT_MASK_MAX  0x40000000
#define ANY_PASCAL        0xFFFFFFFF

/* Abbreviations for combinations of these flags */
#define CLASSIC_PASCAL (CLASSIC_PASCAL_LEVEL_0 | CLASSIC_PASCAL_LEVEL_1)
#define E_O_PASCAL (EXTENDED_PASCAL | OBJECT_PASCAL)
#define S_E_O_PASCAL (CLASSIC_PASCAL | E_O_PASCAL)
#define ISO_PASCAL (CLASSIC_PASCAL | E_O_PASCAL)
#define B_D_PASCAL (BORLAND_PASCAL | BORLAND_DELPHI)
#define U_B_D_PASCAL (UCSD_PASCAL | B_D_PASCAL)
#define E_O_B_D_PASCAL (E_O_PASCAL | B_D_PASCAL)
#define O_G_PASCAL (OBJECT_PASCAL | GNU_PASCAL)
#define E_O_G_PASCAL (EXTENDED_PASCAL | O_G_PASCAL)
#define S_E_O_G_PASCAL (CLASSIC_PASCAL | E_O_G_PASCAL)
#define S1_E_O_G_PASCAL (CLASSIC_PASCAL_LEVEL_1 | E_O_G_PASCAL)
#define D_G_PASCAL (BORLAND_DELPHI | GNU_PASCAL)
#define E_O_D_G_PASCAL (E_O_G_PASCAL | D_G_PASCAL)
#define B_D_G_PASCAL (BORLAND_PASCAL | D_G_PASCAL)
#define U_B_D_G_PASCAL (UCSD_PASCAL | B_D_G_PASCAL)
#define O_B_D_G_PASCAL (OBJECT_PASCAL | B_D_G_PASCAL)
#define E_O_B_D_G_PASCAL (EXTENDED_PASCAL | O_B_D_G_PASCAL)
#define O_D_G_PASCAL (OBJECT_PASCAL | D_G_PASCAL)
#define SC_G_PASCAL (PASCAL_SC | GNU_PASCAL)
#define NOT_CLASSIC_PASCAL (ANY_PASCAL & ~CLASSIC_PASCAL)

/* Check whether we must warn.  The argument specifies the Pascal
 * dialect(s) in which the construct in question is valid; in all
 * the other cases, a warning is triggered.  Always warn if we are
 * --pedantic.
 */
#define PEDANTIC(flags) (pedantic || \
                         (flag_what_pascal && (flag_what_pascal & flags) == 0))

/* Some Pascal set constructors do not allow us to derive the
 * set size from anywhere. In such cases, the maximum allowed
 * members in the set is defined here. (Otherwise, there is no limit)
 *
 * By default the size of these sets is DEFAULT_SET_SIZE bits
 *
 * Users may change this with a `--setlimit=NUMBER' switch at compile time.
 */

/* This is the size in bits */
#define DEFAULT_SET_SIZE        (8 * BITS_PER_WORD)

#define ORDINAL_TYPE(code) \
 ((code) == INTEGER_TYPE || (code) == CHAR_TYPE || \
  (code) == BOOLEAN_TYPE || (code) == ENUMERAL_TYPE)

#define ORDINAL_OR_REAL_TYPE(c) (ORDINAL_TYPE(c) || (c) == REAL_TYPE)

#define ORDINAL_REAL_OR_COMPLEX_TYPE(c) (ORDINAL_OR_REAL_TYPE(c) || (c) == COMPLEX_TYPE)

#define SCALAR_TYPE(c) (ORDINAL_REAL_OR_COMPLEX_TYPE (c) || (c) == POINTER_TYPE)

#define INT_REAL(c) ((c) == INTEGER_TYPE || (c) == REAL_TYPE)

#define IS_NUMERIC(c) ((c) == INTEGER_TYPE || (c) == REAL_TYPE || (c) == COMPLEX_TYPE)

/* If c is SET_TYPE or a set CONSTRUCTOR */
#define SET_OR_CONST(c) ((c) == SET_TYPE || (c) == CONSTRUCTOR)

/* This is a schema type on which `New' is just being called. Tells
   init_any() not to bother prediscriminating the type (which is
   thrown away afterwards, anyway). Therefore only used temporarily. */
#define TYPE_SCHEMA_NEW_CALL    TYPE_MIN_VALUE

/* Misuse DECL_INITIAL in VAR_DECL and FIELD_DECL nodes to hold
 * a fix-up list for schema discriminants.
 *
 * @@ Maybe this should be moved to DECL_LANG_SPECIFIC?
 */
#define PASCAL_DECL_FIXUPLIST(decl) DECL_INITIAL (decl)

/* This flag is set if the type is `packed' */
#define PASCAL_TYPE_PACKED(type)        TYPE_PACKED (type)

/* TYPE_LANG_FLAG_0 and 1 are used by C.
 * @@@ Check whether we really use those C constructs.
 */

/* `restricted' type qualified. */
#define PASCAL_TYPE_RESTRICTED(type)    TYPE_LANG_FLAG_2 (type)

/* Bindable types get this flag. */
#define PASCAL_TYPE_BINDABLE(type)      TYPE_LANG_FLAG_3 (type)

/* This is a TEXT file type node */
#define TYPE_FILE_TEXT(type)            TYPE_LANG_FLAG_4 (type)

/* Flag conformant array schema index types.
 * Only used in ORDINAL *_TYPE nodes (indices of conformant arrays).
 */
#define PASCAL_TYPE_CONFORMANT_INDEX(type) TYPE_LANG_FLAG_5 (type)

/* Borland Pascal `typed const' type qualifier ("almost readonly"). */
#define PASCAL_TYPE_TYPEDCONST(type)    TYPE_LANG_FLAG_6 (type)

/* Use some fields in DECL_LANG_SPECIFIC. */
#define DECL_LANG_DIRECTIVE(decl) (DECL_LANG_SPECIFIC ((decl))->directive)
#define DECL_LANG_PARMS(decl) (DECL_LANG_SPECIFIC ((decl))->parms)

/* Use some fields in TYPE_LANG_SPECIFIC. */

/* Use TYPE_LANG_SPECIFIC (type)->code to identify variant records,
 * objects, strings, and schemata.
 */
#define TYPE_LANG_CODE(type) (TYPE_LANG_SPECIFIC (type)->code)

#define PASCAL_LANG_NOTHING_SPECIAL     0
#define PASCAL_LANG_VARIANT_RECORD      1
#define PASCAL_LANG_OBJECT              2
#define PASCAL_LANG_ABSTRACT_OBJECT     3
#define PASCAL_LANG_STRING              4
#define PASCAL_LANG_SCHEMA              5

/* Use TYPE_LANG_SPECIFIC (type)->info to store the name of an object. */
#define TYPE_LANG_NAME(type) (TYPE_LANG_SPECIFIC (type)->info)

/* Also use TYPE_LANG_SPECIFIC (type)->info to store variant tag info. */
#define TYPE_LANG_INFO(type) (TYPE_LANG_SPECIFIC (type)->info)

/* Also use TYPE_LANG_SPECIFIC (type)->info to store the
 * declared string capacity.
 */
#define TYPE_LANG_DECLARED_CAPACITY(type) (TYPE_LANG_SPECIFIC (type)->info)

/* Use TYPE_LANG_SPECIFIC (type)->base to store base type info
 * about objects and schemata.
 */
#define TYPE_LANG_BASE(type) (TYPE_LANG_SPECIFIC (type)->base)

/* Determine if a given TYPE node represents a conformant array type. */
#define PASCAL_TYPE_CONFORMANT_ARRAY(type)           \
    (TREE_CODE (type) == ARRAY_TYPE                  \
     && TREE_TYPE (TYPE_DOMAIN (type))               \
     && PASCAL_TYPE_CONFORMANT_INDEX (TREE_TYPE (TYPE_DOMAIN (type))))

/* Determine if a given TYPE node represents a variant record type. */
#define PASCAL_TYPE_VARIANT_RECORD(type)             \
    (TREE_CODE (type) == RECORD_TYPE                 \
     && TYPE_LANG_SPECIFIC (type)                    \
     && TYPE_LANG_CODE (type) == PASCAL_LANG_VARIANT_RECORD)

/* Determine if a given TYPE node represents an object type. */
#define PASCAL_TYPE_OBJECT(type)                     \
    (TREE_CODE (type) == RECORD_TYPE                 \
     && TYPE_LANG_SPECIFIC (type)                    \
     && (TYPE_LANG_CODE (type) == PASCAL_LANG_OBJECT \
         || TYPE_LANG_CODE (type) == PASCAL_LANG_ABSTRACT_OBJECT))

/* Determine if a given TYPE node represents a string type. */
#define PASCAL_TYPE_STRING(type)                     \
    (TREE_CODE (type) == RECORD_TYPE                 \
     && TYPE_LANG_SPECIFIC (type)                    \
     && TYPE_LANG_CODE (type) == PASCAL_LANG_STRING)

/* Determine if a given TYPE node represents a schema type. */
#define PASCAL_TYPE_SCHEMA(type)                     \
    (TREE_CODE (type) == RECORD_TYPE                 \
     && TYPE_LANG_SPECIFIC (type)                    \
     && TYPE_LANG_CODE (type) == PASCAL_LANG_SCHEMA)

/* Determine whether some TYPE is an undiscriminated string. */
#define PASCAL_TYPE_UNDISCRIMINATED_STRING(type)                    \
    (TYPE_MAIN_VARIANT (type) == string_schema_proto_type           \
     || TYPE_MAIN_VARIANT (type) == const_string_schema_proto_type)

/* Determine whether some TYPE is a pre-discriminated string. */
#ifdef PG__NEW_STRINGS
#define PASCAL_TYPE_PREDISCRIMINATED_STRING(type)                   \
    (PASCAL_TYPE_UNDISCRIMINATED_STRING (type))
#else
#define PASCAL_TYPE_PREDISCRIMINATED_STRING(type)                   \
    (PASCAL_TYPE_STRING (type)                                      \
     && (! TYPE_SIZE (type)                                         \
         || (TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST            \
             && TREE_CODE (TYPE_SIZE (type)) != SAVE_EXPR)))
#endif

/* Determine whether some TYPE is a discriminated string. */
#define PASCAL_TYPE_DISCRIMINATED_STRING(type)                      \
    (PASCAL_TYPE_STRING (type)                                      \
     && ! PASCAL_TYPE_UNDISCRIMINATED_STRING (type)                 \
     && ! PASCAL_TYPE_PREDISCRIMINATED_STRING (type))               \

/* Return the pascal string value of DECL. */
#define PASCAL_STRING_VALUE(decl) (PASCAL_TYPE_STRING (TREE_TYPE (decl)) ? \
                                   build_component_ref (decl, string_id) : \
                                   decl)

/* Each variable length string has a "current length" field,
 * CHAR_TYPE length is always 1,
 * fixed-length-string length is the size of the domain range.
 */
#define PASCAL_STRING_LENGTH(decl)                                          \
         (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK ? error_mark_node :    \
          (PASCAL_TYPE_STRING (TREE_TYPE (decl))                 ?          \
           build_component_ref (decl, get_identifier ("length")) :          \
           ((TREE_CODE (TREE_TYPE (decl)) == CHAR_TYPE)  ?                  \
            integer_one_node                             :                  \
            ((TREE_CODE (decl) == STRING_CST)                    ?          \
             build_int_2 (TREE_STRING_LENGTH (decl) - 1, 0)      :          \
             fold (build_binary_op (PLUS_EXPR,                              \
                     build_binary_op (MINUS_EXPR,                           \
                       TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (decl))),     \
                       TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (decl))), 0), \
                     integer_one_node, 0))))))

/* Each variable length string has a "Capacity" field. */
#define PASCAL_STRING_CAPACITY(decl) build_component_ref (decl, get_identifier ("Capacity"))

/* The meaning of PASCAL_DECL_FIXUPLIST:
   - list: undiscriminated schema, pointing to fixup places
   - void_type_node: prediscriminated schema (nothing to fixup)
   - expression: discriminated schema, contains discriminant initializer */

/* Determine whether some TYPE is an undiscriminated schema. */
#define PASCAL_TYPE_UNDISCRIMINATED_SCHEMA(type)             \
    (PASCAL_TYPE_SCHEMA (type)                               \
     && TYPE_FIELDS (type)                                   \
     && TREE_CODE (PASCAL_DECL_FIXUPLIST (TYPE_FIELDS (type))) == TREE_LIST)

/* Determine whether some TYPE is a prediscriminated schema. */
#define PASCAL_TYPE_PREDISCRIMINATED_SCHEMA(type)            \
    (PASCAL_TYPE_SCHEMA (type)                               \
     && TYPE_FIELDS (type)                                   \
     && TREE_CODE (PASCAL_DECL_FIXUPLIST (TYPE_FIELDS (type))) == VOID_TYPE)

/* Determine whether some TYPE is a discriminated schema. */
#define PASCAL_TYPE_DISCRIMINATED_SCHEMA(type)               \
    (PASCAL_TYPE_SCHEMA (type)                               \
     && TYPE_FIELDS (type)                                   \
     && TREE_CODE (PASCAL_DECL_FIXUPLIST (TYPE_FIELDS (type))) != TREE_LIST \
     && TREE_CODE (PASCAL_DECL_FIXUPLIST (TYPE_FIELDS (type))) != VOID_TYPE)

/* TREE_LANG_FLAG_1 and 2 are used by C.
 * @@@ Check whether we really use those C constructs.
 * TREE_LANG_FLAG_0 seems to be unused yet :-)
 */

/* Nonzero if the PARM_DECL is a value parameter passed by reference.
 * This is necessary for Strings and other Schema types when passed as
 * value args without specified capacity.
 * Only used in *_TYPE nodes.
 */
#define PASCAL_TYPE_VAL_REF_PARM(type)   TREE_LANG_FLAG_3 (type)

/* Flag for Schema discriminants.
 * Used in VAR_DECL, FIELD_DECL, and CONVERT_EXPR nodes.
 */
#define PASCAL_TREE_DISCRIMINANT(decl)   TREE_LANG_FLAG_3 (decl)

/* Flag for user-defined operators.
 * Used in FUNCTION_DECL and CALL_EXPR nodes.
 */
#define PASCAL_OPERATOR_FUNCTION(decl)   TREE_LANG_FLAG_3 (decl)

/* Borland Pascal "open array" parameter.
 * (I would prefer to use a TYPE_LANG_FLAG here, but they are all busy.)
 * Only used in ARRAY_TYPE and INTEGER_TYPE nodes.
 */
#define PASCAL_TYPE_OPEN_ARRAY(type)     TREE_LANG_FLAG_4 (type)

/* In a method field: Nonzero indicates that the method
 * is a constructor or destructor.
 * Used in FIELD_DECL, FUNCTION_DECL, and CALL_EXPR nodes.
 */
#define PASCAL_STRUCTOR_METHOD(decl)     TREE_LANG_FLAG_4 (decl)

/* Identify constructor and destructor methods as such.
 * This only checks for function declarations, not for
 * field declarations and call expressions.
 */
#define PASCAL_CONSTRUCTOR_METHOD(decl)                 \
    (PASCAL_STRUCTOR_METHOD (decl)                      \
     && TREE_CODE (decl) == FUNCTION_DECL               \
     && TREE_TYPE (decl)                                \
     && TREE_TYPE (TREE_TYPE (decl)) == boolean_type_node)
#define PASCAL_DESTRUCTOR_METHOD(decl)                  \
    (PASCAL_STRUCTOR_METHOD ((decl))                    \
     && TREE_CODE (decl) == FUNCTION_DECL               \
     && TREE_TYPE (decl)                                \
     && TREE_TYPE (TREE_TYPE (decl)) == void_type_node)

/* Flag for packed array access constructs.
 * Only used in *_EXPR and VAR_DECL nodes.
 */
#define PASCAL_TREE_PACKED_ACCESS(expr)  TREE_LANG_FLAG_5 (expr)

/* Flag for fresh integer constants.
 * Only used in INTEGER_CST nodes.
 */
#define PASCAL_TREE_FRESH_INT_CST(expr)  TREE_LANG_FLAG_5 (expr)

/* In a method field (FUNCTION_DECL record field): Nonzero indicates that
 * the method is virtual.
 */
#define PASCAL_VIRTUAL_METHOD(decl)      TREE_LANG_FLAG_5 (decl)

/* In a method field (FUNCTION_DECL record field): Nonzero indicates that
 * the method is abstract.
 */
#define PASCAL_ABSTRACT_METHOD(decl)     TREE_LANG_FLAG_6 (decl)

/* This flag distinguishes a variable initial value from an
 * `absolute' clause (in Borland sense). Nonzero -> absolute clause.
 * Used in *_EXPR nodes.
 */
#define PASCAL_ABSOLUTE_CLAUSE(init)     TREE_LANG_FLAG_6 (init)

/* This object is `external' in Pascal sense; it has been
 * mentioned in the program heading. Used in VAR_DECL nodes.
 * (In Extended Pascal it does not have to be a file.)
 */
#define PASCAL_EXTERNAL_OBJECT(object)   TREE_LANG_FLAG_6 (object)

/* DECL_LANG_FLAG_0 through 4 are used by C.
 * @@@ Check whether we really use those C constructs.
 */

/* Nonzero if the PARM_DECL is a standard pascal procedure parameter.
 *
 * If it is a non-standard function pointer parameter, this is not set,
 * in which case the procedure is not automatically called when
 * referenced.
 */
#define PASCAL_PROCEDURE_PARAMETER(decl) DECL_LANG_FLAG_5 (decl)

/* When a VAR_DECL node is directly assigned to we mark it.
 * (Currently only used to find out if a value is assigned to
 * a function via it's name or a user defined return value name)
 */
#define PASCAL_VALUE_ASSIGNED(decl)      DECL_LANG_FLAG_6 (decl)

/* Set this if NODE refers to a known identifier in Pascal.
 * It's used in gpc-lex.c yylex() to return correct tokens to the parser
 * when a Pascal predefined word is seen. Also it allows redefinition of
 * the known identifiers in pushdecl().
 */
#define PASCAL_REDEFINABLE_DECL(decl)    DECL_LANG_FLAG_7 (decl)

/* Set this when compiler is checking if a `for' loop should be
 * executed at all (just to prevent the warnings in limited range
 * comparisons). Reset the bit after comparison.
 */
#define PASCAL_LOOP_CHECK(decl) PASCAL_VALUE_ASSIGNED(decl)

/* Pascal type variants.  32 different types fit in one integer */
#define TYPE_QUALIFIER_PACKED        1
#define TYPE_QUALIFIER_PROTECTED     2
#define TYPE_QUALIFIER_QUALIFIED     4
#define TYPE_QUALIFIER_BINDABLE      8
#define TYPE_QUALIFIER_RESTRICTED   16
#define TYPE_QUALIFIER_CONFORMANT   32

#define TYPE_VARIANT (TYPE_QUALIFIER_BINDABLE           \
                      | TYPE_QUALIFIER_RESTRICTED)

/* Determine if something may be a function call. */
#define MAYBE_CALL_FUNCTION(target) (TREE_CODE (target) == FUNCTION_DECL      \
    || (TREE_TYPE (target)                                                    \
        && (TREE_CODE (TREE_TYPE (target)) == REFERENCE_TYPE                  \
            || TREE_CODE (TREE_TYPE (target)) == POINTER_TYPE)                \
        && TREE_CODE (TREE_TYPE (TREE_TYPE (target))) == FUNCTION_TYPE))

/* Determine if something is a method call. */
#define CALL_METHOD(target) (TREE_CODE (target) == COMPONENT_REF             \
                         && TREE_CODE (TREE_TYPE (target)) == FUNCTION_TYPE)

/* Determine if something is a procedural variable. */
#define PASCAL_PROCEDURAL_VARIABLE(target)                               \
    (target                                                              \
     && TREE_TYPE (target)                                               \
     && TREE_CODE (TREE_TYPE (target)) == REFERENCE_TYPE                 \
     && TREE_CODE (TREE_TYPE (TREE_TYPE (target))) == FUNCTION_TYPE)

/* In a VAR_DECL node: check if it represents an ABSOLUTE
 * declared variable (in Borland sense)
 */
#define IS_ABSOLUTE_VAR(decl) (TREE_CODE (decl) == VAR_DECL                  \
                               && DECL_INITIAL (decl)                        \
                               && PASCAL_ABSOLUTE_CLAUSE (DECL_INITIAL (decl)))

/* Prefixes used for internal identifiers */
#define PTR_XREF_PREFIX "ptr_xref_"
#define REF_XREF_PREFIX "ref_xref_"

/* ------------------------------------------------------------------ */

/* These should be in parse.h ??? */

extern int this_is_an_interface_module;

/* A list of types already defined in this type_declaration_part */
extern tree current_type_list;

/* This is TRUE if we are in 'TYPE' declaration part.
 * It is written by the parser, checked in build_pascal_pointer_type().
 */
extern int defining_types;

extern tree main_program_name;

/* ------------------------------------------------------------------ */

/* These should be in gpc-common.h */

extern tree asm_combine_strings PARAMS ((tree));
extern void new_main_variant PARAMS ((tree));
extern tree pascal_type_variant PARAMS ((tree, int));
extern tree p_build_type_variant PARAMS ((tree, int, int));
extern tree build_pascal_unary_op PARAMS ((enum tree_code, tree, int));
extern tree build_pascal_pointer_reference PARAMS ((tree));
extern tree build_pascal_address_expression PARAMS ((tree));

/* construct an identifier_node for the assembler-name
 * of a user-defined operator
 */
extern tree get_operator_identifier PARAMS ((char*, tree, tree, int));

/* convert set operations to their bitwise form;
 * handle user-defined operators;
 * for others just call build_binary_op_nodefault.
 */
extern tree build_pascal_binary_op PARAMS ((enum tree_code, tree, tree));

/* convert PXSC operators to function calls */
extern tree build_pxsc_operator PARAMS ((char*, tree, tree));

/* Make a variant type in the proper way for C/C++ */
extern tree c_build_type_variant PARAMS ((tree, int, int));

/* ------------------------------------------------------------------ */

/* These should be in gpc-decl.h */

enum rid
{
  RID_UNUSED,
  RID_INT,
  RID_CHAR,
  RID_FLOAT,
  RID_DOUBLE,
  RID_VOID,
  RID_UNUSED1,

  RID_UNSIGNED,
  RID_SHORT,
  RID_LONG,
  RID_AUTO,
  RID_STATIC,
  RID_EXTERN,
  RID_REGISTER,
  RID_TYPEDEF,
  RID_SIGNED,
  RID_CONST,
  RID_RESTRICT,
  RID_VOLATILE,
  RID_INLINE,
  RID_NOALIAS,
  RID_ITERATOR,
  RID_COMPLEX,

  RID_IN,
  RID_OUT,
  RID_INOUT,
  RID_BYCOPY,
  RID_BYREF,
  RID_ONEWAY,
  RID_ID,

  RID_MAX
};

/* Nonzero means that the size of a type
 * may vary within one function context.
 */
extern int size_volatile;

extern tree current_function_return_variable;

#if 0 /* unused */
extern int current_function_assigned_value;
#endif
extern int warn_write_strings;

#ifndef EGCS97
extern tree ptr_type_node;
extern tree null_pointer_node;
#endif
extern tree boolean_false_node;
extern tree boolean_true_node;
extern tree real_zero_node;
extern tree complex_zero_node;
extern tree real_half_node;
extern tree empty_set_node;

extern tree ptrsize_unsigned_type_node;
extern tree ptrsize_integer_type_node;
extern tree packed_array_unsigned_long_type_node;
extern tree packed_array_unsigned_short_type_node;
extern tree int_array_type_node;
extern tree const_string_type_node;
extern tree signed_wchar_type_node;
extern tree unsigned_wchar_type_node;
extern tree void_ftype_ptr;
extern tree default_function_type;
extern tree int_ftype_int;

/* Node for marking virtual methods while parsing. */
extern tree virtual_mark_node;

/* Node for marking abstract methods while parsing. */
extern tree abstract_mark_node;

/* Identifier node for implicit `Self' formal parameter. */
extern tree self_name_node;

/* Extended Pascal nodes */
extern tree real_max_node;
extern tree real_min_node;
extern tree real_eps_node;
extern tree char_max_node;

/* Other type nodes */
extern tree boolean_type_node;
extern tree byte_boolean_type_node;
extern tree short_boolean_type_node;
extern tree word_boolean_type_node;
extern tree long_boolean_type_node;
extern tree long_long_boolean_type_node;

/* directives */
extern tree d_forward;
extern tree d_external;
extern tree d_extern;
extern tree d_c_lang;
extern tree d_c_lang1;
extern tree d_asmname;
extern tree d_o_override;
extern tree d_static;

/* To allow build_enumerator() to set up the correct type for
 * enumerated type elements (In C they are all ints).
 * Think about [ enumtype ] set constructor.
 */
extern tree current_enum_type;

/* A place to look up the name of a currently declared type
 * (needed to define assembler-names for object methods).
 */
extern tree current_type_name;

/* Labels declared at the current level. */
extern tree declared_labels;

/* Must a function get an implicit "Self" parameter or not? */
extern int defining_methods;

/* For giving the correct --pedantic warning only ... */
extern int defining_pointers;
extern int defining_operators;

/* Build a FUNCTION_DECL node to define the DECL_CONTEXT of the
 * main program before start_function() is called to make non-local
 * gotos to main program work.
 */
extern tree declare_main_program_context PARAMS ((tree,tree));

extern struct lang_type *allocate_type_lang_specific PARAMS ((void));
extern struct lang_decl *allocate_decl_lang_specific PARAMS ((void));

extern int pascal_global_bindings_p PARAMS ((void));
extern int top_level_p PARAMS ((void));

extern tree grok_directive PARAMS ((tree, tree, tree, int));

/* Nonzero means to check for IOresult after each I/O operation. */
extern int flag_io_checking;

/* Nonzero means to do range checking on `readln' and such. */
extern int flag_input_range_checking;

/* The endianness as given by a command-line option (-1 means none given). */
extern int option_big_endian;

/* Nonzero means printing of needed options was requested. */
extern int flag_print_needed_options;

/* Nonzero means to warn about a semicolon after `then', `else' or `do'. */
extern int warn_semicolon;

/* Nonzero means always use short circuit boolean `and' and `or'. */
extern int flag_short_circuit;

/* Level of the language we recognize. */
extern unsigned long flag_what_pascal;

/* Nonzero means don't warn about "extended syntax". */
extern int flag_extended_syntax;

/* Nonzero means print GPI debugging information to stderr. */
extern int flag_debug_gpi;

/* Nonzero means print automake debugging information to stderr. */
extern int flag_debug_automake;

/* Nonzero means to dump source to stderr. */
extern int flag_debug_source;

/* If non-null, it gives the identifier of a procedure to be called
   automatically before each statement. */
extern tree debug_statement;

/* Nonzero means to output progress report messages. */
extern int flag_progress_messages;

/* Nonzero means to output progress bar information. */
extern int flag_progress_bar;

/* Nonzero means allow mixed comments;
 * then (* } and { *) are okay, according to ISO standard. */
extern int flag_mixed_comments;

/* Nonzero means allow nested comments;
 * then (* (* *) *) and { { } } are okay (optional GPC extension). */
extern int flag_nested_comments;

/* Nonzero means allow Delphi comments. */
extern int flag_delphi_comments;

/* Nonzero allows GPC to ignore function results without warning. */
extern int flag_ignore_function_results;

/* Nonzero means allow GPC to read Borland-style
 * `#' and `^' character constants. */
extern int flag_borland_char_constants;

/* Nonzero means: In read statements, allow non-decimal input with `n#' */
extern int flag_read_base_specifier;

/* Nonzero means: In read statements, allow hexadecimal input with `$' */
extern int flag_read_hex;

/* Nonzero means: In read statements, require whitespace after numbers */
extern int flag_read_white_space;

/* Nonzero means to allow string clipping: "write ( 'foobar' : 3 )" --> "foo". */
extern int flag_clip_strings;

/* Option -ffield-widths=NN:NN:NN changes default field widths `write' operations. */
extern int int_out_width;
extern int real_out_width;
extern int bool_out_width;
extern int long_int_out_width;
extern int long_real_out_width;

/* Nonzero means to allow string truncation: "writestr ( s3, 'foobar' )"
 * with `s3' having a capacity of 3 --> "foo".  Zero means to produce a
 * runtime error.
 */
extern int flag_truncate_strings;

/* Nonzero means to do exact (lexicographic) string comparisons with
 * operators like `<'.  Zero means to pad with spaces as ISO requires.
 */
extern int flag_exact_compare_strings;

/* Nonzero means allow strings enclosed in "". */
extern int flag_double_quoted_strings;

/* Nonzero means to produce a blank in front of positive reals.
 * (Required by ISO.)
 */
extern int flag_real_blank;

/* Nonzero means to write exponents with a capital 'E'.
 * Zero means to write a lowercase 'e'.
 */
extern int flag_capital_exponent;

/* Nonzero means to derive the external file name from
 * the name of the file variable.
 */
extern int flag_transparent_file_names;

/* Nonzero means the result of the address is a typed pointer. */
extern int flag_typed_address;

extern tree main_program_context;

extern int in_main_program;

extern tree create_boolean_type_node PARAMS ((unsigned));

extern tree get_variant_tag_info PARAMS ((tree));
extern void store_variant_tag_info PARAMS ((tree, tree));
extern int is_known_directive PARAMS ((tree));

/* Handles directives, calls start_function and returns the function
 * return type or 0.
 */
extern tree start_pascal_function PARAMS ((tree, tree, int));

extern tree de_capitalize PARAMS ((tree));

extern tree integer_maxint_node;

extern void declare_label PARAMS ((tree, int));
extern void handle_forward_pointers PARAMS ((tree));
extern int pascal_shadow_record_fields PARAMS ((tree, int));
extern void check_variant_record PARAMS ((tree, tree));

/* ------------------------------------------------------------------ */

/* Pointer to token buffer. Actual allocated length is maxtoken + 2. */
extern char *token_buffer;

/* The declaration found for the last LEX_ID token read in. */
extern tree lastiddecl;

/*
  Determines what the lexer returns for `=':
  < 0 means: `='
  = 0 means: LEX_CONST_EQUAL
  > 0 means: `=', but after that many closing parentheses/brackets, return LEX_CONST_EQUAL
*/
extern int lex_const_equal;

/* Nonzero means: don't recognize BP style `^a' character constants. */
extern int lex_caret;

extern void yyerror PARAMS ((const char *));
extern void position_after_white_space PARAMS ((void));

/* Warn about redeclaration of keywords. */
extern char *which_language PARAMS ((int));
extern void warning_list_languages PARAMS ((unsigned long, int));
extern void warn_about_keyword_redeclaration PARAMS ((char*));

/* Enable/disable keywords in certain contexts.
 * With this strategy we can avoid shift/reduce
 * and/or reduce/reduce conflicts while keeping
 * all keywords redefinable.
 */
extern void enable_keyword PARAMS ((char*));
extern void disable_keyword PARAMS ((char*));
extern int keyword_enabled PARAMS ((char*));

extern tree lookup_forward_pointer PARAMS ((tree, int));

extern tree check_if_predefined_type PARAMS ((tree));

extern void init_language_specification PARAMS ((void));

extern int check_newline PARAMS ((void));

extern int yylex PARAMS ((void));

extern void reinit_parse_for_function PARAMS ((void));

/* ------------------------------------------------------------------ */

/* These should be in gpc-typeck.h */

/* Nonzero if we warn about void type pointer dereferences. */
extern int warn_void_dereference;

extern tree bit_sizeof PARAMS ((tree));
extern int contains_discriminant PARAMS ((tree, tree));
extern tree build_discriminated_schema_type PARAMS ((tree, tree));
extern tree build_modify_expr PARAMS ((tree, enum tree_code, tree));
extern tree build_string_constant_pointer PARAMS ((tree, tree));
extern tree convert_array_to_pointer PARAMS ((tree));

/* Check whether an initializer matches a type */
extern int check_pascal_initializer PARAMS ((tree, tree));

/* Locates from structure/union DATUM the field NAME, and constructs
 * an expression to refer to that field
 */
extern tree find_field PARAMS ((tree, tree));

/* ------------------------------------------------------------------ */

/* These should be in gpc-lex.h */

struct gpc_option
{
  int source;
  char *name;
};

extern struct gpc_option gpc_options[];

/* @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ Only to let it compile.
   Does not work yet! */
#ifdef EGCS97
#define DECL_FIELD_BITPOS(t) (*((tree *) 0))
#endif

#endif /* _GPC_DEFS_H_ */
