/* * $Id: F-ident.h,v 1.38 2000/12/15 05:25:29 m-hirano Exp $ * $RWC_Release: Omni-1.6 $ * $RWC_Copyright: * Omni Compiler Software Version 1.5-1.6 * Copyright (C) 2002 PC Cluster Consortium * * This software is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License version * 2.1 published by the Free Software Foundation. * * Omni Compiler Software Version 1.0-1.4 * Copyright (C) 1999, 2000, 2001. * Tsukuba Research Center, Real World Computing Partnership, Japan. * * Please check the Copyright and License information in the files named * COPYRIGHT and LICENSE under the top directory of the Omni Compiler * Software release kit. * * * $ */ /* Fortran name class */ enum name_class { CL_UNKNOWN = 0, CL_PARAM, /* parameter */ CL_VAR, /* variable name */ CL_ENTRY, /* entry name */ CL_MAIN, /* program name */ CL_BLOCK, /* data block name */ CL_PROC, /* procedure name (subroutine, function, statement func,..) */ CL_LABEL, /* label entry */ CL_FORMAT, /* format entry */ CL_NAMELIST /* name list name (not implmented) */ }; extern char *name_class_names[]; #define NAME_CLASS_NAMES \ { \ "CL_UNKNOWN", \ "CL_PARAM", \ "CL_VAR", \ "CL_ENTRY", \ "CL_MAIN", \ "CL_BLOCK", \ "CL_PROC", \ "CL_LABEL", \ "CL_FORMAT", \ "CL_NAMELIST" \ } /* for CL_PROC */ enum proc_class { P_UNKNOWN, P_EXTERNAL, P_INTRINSIC, P_STFUNCT, P_THISPROC }; extern char *proc_class_names[]; #define PROC_CLASS_NAMES \ { \ "P_UNKNOWN", \ "P_EXTERNAL", \ "P_INTRINSIC", \ "P_STFUNCT", \ "P_THISPROC" \ } /* storage class */ enum storage_class { STG_UNKNOWN = 0, STG_ARG, /* dummy argument */ STG_AUTO, /* auto variable */ STG_BSS, /* allocated in bss */ STG_EXT, /* external function */ STG_COMMON, /* allocated in common */ STG_EQUIV, /* allocated in equive */ STG_EQBLK, /* equivalence block, consist of STG_EQUIV, allocated in stack */ STG_COMEQ, /* allocated in common and equive */ STG_TEMP, /* tempoary storage */ STG_CTEMP, /* read-only tempoary storage */ STG_PTRBASE, /* cray pointer base */ STG_NONE /* for intrinsic, stfunction */ }; extern char *storage_class_names[]; #define STORAGE_CLASS_NAMES \ {\ "STG_UNKNOWN",\ "STG_ARG", \ "STG_AUTO", \ "STG_BSS", \ "STG_EXT", \ "STG_COMMON", \ "STG_EQUIV", \ "STG_EQBLK", \ "STG_COMEQ", \ "STG_TEMP", \ "STG_CTEMP", \ "STG_PTRBASE", \ "STG_NONE" \ } /* statement label for CL_LABEL */ typedef enum statement_label_type { LAB_UNKNOWN = 0, /* yet unknown type */ LAB_EXEC, /* label at exectuable statment */ LAB_FORMAT /* label to format statment */ } LABEL_TYPE; /* FORTRAN identifier structure */ typedef struct ident_descriptor { struct ident_descriptor *next; /* linked list */ enum name_class class; /* name class */ char is_declared; enum storage_class stg; SYMBOL name; /* key */ struct type_descriptor *type; /* its type */ expv addr; union { struct { enum proc_class pclass; /* for CL_PROC */ expr args; expv return_value; } proc_info; struct { char is_save; /* for STG_COMMON */ struct external_symbol *common_name; /* for STG_EQUIV */ struct ident_descriptor *equivId; /* pointer for shared * storage area. */ int isDummy; int byDATAstate; /* for STG_EQBLK */ expv equivSpec; /* equivalence * structure data */ int equivIsString; /* TRUE if character based * share */ int equivType; #define EQUIV_TYPE_PURE 0 #define EQUIV_TYPE_COM 1 int equivStructNo; /* for STG_PTRBASE and pointer variable */ struct ident_descriptor *ptrPair; /* for CL_VAR */ expv initValues; /* initial value list */ expv arrayInfo; /* If variable is array, not NULL. */ int initType; #define VAR_INIT_NEVER 0 #define VAR_INIT_WHOLE 1 #define VAR_INIT_SUBSTR 2 #define VAR_INIT_PARTIAL 3 #define VAR_INIT_EQUIV 4 int useRaw; int isInitFinalized; int isImpDoDummy; /* for CL_PARAM */ expv complexConstV; /* If the parameter is * COMPLEX_CONSTANT, * ID_CONST(id) is not a * constant expression, but * this is a true constant * expression. */ #ifdef ENABLE_QREAL expv qrealConstV; /* If the parameter is * QREAL_CONSTANT, * If this is not a NULL, it * is a variable initialized * with DATA statement. */ #endif /* ENABLE_QREAL */ } var_info; struct { LABEL_TYPE lab_type; char lab_blklevel; char lab_cannot_jmp; /* can jump or not */ char lab_is_used; int lab_st_no; } label_info; struct { /* for CL_FORMAT */ expv formatStrV; } format_info; struct { /* for CL_NAMELIST */ expr list; } nl_info; } info; } *ID; #define ID_NEXT(id) ((id)->next) #define ID_CLASS(id) ((id)->class) #define ID_STORAGE(id) ((id)->stg) #define ID_SYM(id) ((id)->name) #define ID_NAME(id) SYM_NAME((id)->name) #define ID_TYPE(id) ((id)->type) #define ID_IS_DECLARED(id) ((id)->is_declared) #define ID_ADDR(id) ((id)->addr) #define ID_CONST(id) ((id)->addr) /* for CL_PROC */ #define PROC_CLASS(id) ((id)->info.proc_info.pclass) #define PROC_ARGS(id) ((id)->info.proc_info.args) #define PROC_STBODY(id) ((id)->addr) #define PROC_RET_VAL(id)((id)->info.proc_info.return_value) /* for CL_VAR */ #define VAR_IS_SAVE(id) ((id)->info.var_info.is_save) #define VAR_COM_NAME(id) ((id)->info.var_info.common_name) #define VAR_EQUIV_ID(id) ((id)->info.var_info.equivId) #define VAR_EQUIV_NAME(id) ID_SYM(VAR_EQUIV_ID(id)) #define VAR_EQUIV_SPEC(id) ((id)->info.var_info.equivSpec) #define VAR_EQUIV_IS_DUMMY(id) ((id)->info.var_info.isDummy) #define VAR_EQUIV_IS_STRING(id) ((id)->info.var_info.equivIsString) #define VAR_EQUIV_TYPE(id) ((id)->info.var_info.equivType) #define VAR_EQUIV_STRUCT_NO(id) ((id)->info.var_info.equivStructNo) #define VAR_EQUIV_BY_DATA(id) ((id)->info.var_info.byDATAstate) #define VAR_POINTER_ID(id) ((id)->info.var_info.ptrPair) #define VAR_POINTER_BASE_ID(id) ((id)->info.var_info.ptrPair) #define VAR_ARRAY_INFO(id) ((id)->info.var_info.arrayInfo) #define VAR_INIT_LIST(id) ((id)->info.var_info.initValues) #define VAR_INIT_TYPE(id) ((id)->info.var_info.initType) #define VAR_INIT_USE_RAW(id) ((id)->info.var_info.useRaw) #define VAR_INIT_FINALIZED(id) ((id)->info.var_info.isInitFinalized) #define VAR_IS_IMPLIED_DO_DUMMY(id) ((id)->info.var_info.isImpDoDummy) /* for CL_PARAM */ #define PARAM_COMPLEX(id) ((id)->info.var_info.complexConstV) #ifdef ENABLE_QREAL #define PARAM_QREAL(id) ((id)->info.var_info.qrealConstV) #endif /* ENABLE_QREAL */ /* for CL_LABEL */ #define LAB_TYPE(l) ((l)->info.label_info.lab_type) #define LAB_ST_NO(l) ((l)->info.label_info.lab_st_no) #define LAB_BLK_LEVEL(l) ((l)->info.label_info.lab_blklevel) #define LAB_IS_USED(l) ((l)->info.label_info.lab_is_used) #define LAB_CANNOT_JUMP(l) ((l)->info.label_info.lab_cannot_jmp) #define LAB_IS_DEFINED(l) ((l)->is_declared) /* for CL_FORMAT */ #define FORMAT_STR(id) ((id)->info.format_info.formatStrV) /* for CL_NAMELIST */ #define NL_LIST(id) ((id)->info.nl_info.list) /* external symbol */ typedef struct external_symbol { struct external_symbol *next; SYMBOL name; /* key */ enum storage_class stg; /* STG_UNKNOWN, STG_EXT, STG_COMMON, STG_LIB */ char is_defined; /* defined or not */ char is_save; /* saved */ union { struct { TYPE_DESC type; /* type in Fortran */ TYPE_DESC C_type; /* type in C */ expr args; expv body; /* body of defined procedure */ ID id_list; ID label_list; int isRuntime; /* 1 if this proc is runtime routine */ struct external_symbol *entry_next; SYMBOL entry_label; int entry_no; expv decl_directives; } proc_info; struct { expr lists; /* all members for common block */ int length; /* common block length for check */ expr list; /* common block list */ int inBlockData; /* common in BLOCK DATA statement */ int markAsSave; /* mark as save with save statement */ expv initValues; /* common initializer list */ int isInitFinalized; } common_info; } info; } *EXT_ID; #define EXT_NEXT(ep) ((ep)->next) #define EXT_SYM(ep) ((ep)->name) #define EXT_TAG(ep) ((ep)->stg) #define EXT_IS_DEFINED(ep) ((ep)->is_defined) #define EXT_IS_SAVE(ep) ((ep)->is_save) #define EXT_PROC_TYPE(ep) ((ep)->info.proc_info.type) #define EXT_PROC_C_TYPE(ep) ((ep)->info.proc_info.C_type) #define EXT_PROC_BODY(ep) ((ep)->info.proc_info.body) #define EXT_PROC_ARGS(ep) ((ep)->info.proc_info.args) #define EXT_PROC_ID_LIST(ep) ((ep)->info.proc_info.id_list) #define EXT_PROC_LABEL_LIST(ep) ((ep)->info.proc_info.label_list) #define EXT_PROC_IS_RUNTIME(ep) ((ep)->info.proc_info.isRuntime) #define EXT_PROC_ENTRY_NEXT(ep) ((ep)->info.proc_info.entry_next) #define EXT_PROC_ENTRY_LABEL(ep)((ep)->info.proc_info.entry_label) #define EXT_PROC_ENTRY_NO(ep) ((ep)->info.proc_info.entry_no) #define EXT_PROC_DIRECTIVES(ep) ((ep)->info.proc_info.decl_directives) #define EXT_COM_LIST(ep) ((ep)->info.common_info.list) #define EXT_COM_LISTS(ep) ((ep)->info.common_info.lists) #define EXT_COM_LEN(ep) ((ep)->info.common_info.length) #define EXT_COM_INIT_FINALIZED(ep) \ ((ep)->info.common_info.isInitFinalized) #define EXT_COM_INIT_LIST(ep) ((ep)->info.common_info.initValues) #define EXT_COM_IN_BLOCKDATA(ep) ((ep)->info.common_info.inBlockData) #define EXT_COM_IS_SAVE(ep) ((ep)->info.common_info.markAsSave) #ifndef BLANK_COMMON_NAME #define BLANK_COMMON_NAME "_____BLANK_COMMON_____" #endif /* !BLANK_COMMON_NAME */